Category : Printer + Display Graphics
Archive   : WAVE.ZIP
Filename : WAVE.PAS

program Wave; {*****************************************}
{ *** WAVE *** ver 1.01 }
uses { by: Bill Reamy }
Graph, { Wave is program that generates some }
Crt; { interesting patterns in 16 colors. }
{ }
{ EGA is required. }
const {*****************************************}
XMax = 639;
YMax = 349;

type
AxisNames = ( X, Y, P, D );
Position = array[ X..Y, P..D, 1..2 ] of integer;

var
Start,
Points : Position;

Locked : array[ 1..2, X..Y ] of boolean;

Step, Gd,
Count, Gm,
Next, Pause : integer;

Dummy : char;

Abort,
LockedIn,
BeenLocked,
Terminate : boolean;


procedure GMode;
var
Gd, Gm : integer;
begin
Gd := Detect;
InitGraph( Gd, Gm, '' );
SetWriteMode( XorPut );
SetLineStyle( Solidln, 0, 1 );
end;


procedure ProgInfo;
begin
RestoreCrtMode;
ClrScr;
Writeln('ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿');
Writeln('³ *** WAVE *** v1.01 ³');
Writeln('³ ³');
Writeln('³ This program generates some unusual patterns on an EGA screen. ³');
Writeln('³ ³');
Writeln('³ Most patterns only take a few seconds to make, but some take longer. ³');
Writeln('³ If a pattern is taking to long to generate, press ESC to skip to the ³');
Writeln('³ next pattern. ³');
Writeln('³ ³');
Writeln('³ F1 pops up this screen. ³');
Writeln('³ ³');
Writeln('³ If you wish, a command-line parameter may be used to define the delay. ³');
Writeln('³ Use a letter from A to Z ( i.e.: C> WAVE L ) A is shortest, Z is longest.³');
Writeln('³ ³');
Writeln('³ When you are done viewing patterns press Q or X to exit Wave. ³');
Writeln('³ ³');
Writeln('³ Written by: Bill Reamy ( GEnie Mail: W.Reamy ) ³');
Writeln('³ ³');
Writeln('³ This program is public domain and may be freely copied & used. ³');
Writeln('³ ³');
Writeln('³ Created using Turbo Pascal, Copyright (c) Borland International 1987,1988³');
Writeln('³ The file EGAVGA.BGI must be in the same directory as Wave.exe. ³');
Writeln('³ The file EGAVGA.BGI is Copyright (c) Borland International. ³');
Writeln('ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ');
Write ('press any key to start patterns...');
if ReadKey = #0
then Dummy := ReadKey;
GMode;
end;


procedure StartOne;
begin
Step := ( Random(15)*2 ) + 3;
for Count := 1 to 2 do
begin
Points[ X, D, Count] := Step;
Points[ Y, D, Count] := Step;
Points[ X, P, Count] := Random( Xmax )+1;
Points[ Y, P, Count] := Random( Ymax )+1;
end;
Start := Points;
ClearDevice;
Locked[ 1, X ] := false; Locked[ 2, X ] := false;
Locked[ 1, Y ] := false; Locked[ 2, Y ] := false;
LockedIn := false;
BeenLocked := false;
Abort := false;
end;


procedure Init;
var
Count : integer;
PStr : string;
begin
Randomize;
GMode;
PStr := ParamStr(1);
if (ParamCount > 0)
and (UpCase( PStr[1] ) >= 'A')
and (UpCase( PStr[1] ) <= 'Z')
then Pause := ( Ord( UpCase(PStr[1]) )-65 ) * 1000
else Pause := 12000;
StartOne;
Terminate := false;
end;


procedure Move( var Points : Position;
Count : integer );
begin
Inc (Points[ X, P, Count],Points[ X, D, Count]);
if Points[ X, P, Count] < 0 then
begin
Locked[ Count, X ] := true;
Points[ X, P, Count] := 0;
Points[ X, D, Count] := Step;
end;
if Points[ X, P, Count] > XMax then
begin
Locked[ Count, X ] := true;
Points[ X, P, Count] := XMax;
Points[ X, D, Count] := -Step;
end;
Inc (Points[ Y, P, Count],Points[ Y, D, Count]);
if Points[ Y, P, Count] < 0 then
begin
Locked[ Count, Y ] := true;
Points[ Y, P, Count] := 0;
Points[ Y, D, Count] := Step;
end;
if Points[ Y, P, Count] > YMax then
begin
Locked[ Count, Y ] := true;
Points[ Y, P, Count] := YMax;
Points[ Y, D, Count] := -Step;
end;
end;{move}


procedure DrawLine;
var
Count, Next : integer;
begin
for Count := 1 to 2
do Move( Points, Count );
SetColor( ( Points[ Y, P, 1 ] + Points[ Y, D, 2 ] )
mod 16 );
if LockedIn

then Line( Points[ X, P, 1 ], Points[ Y, P, 1 ],
Points[ X, P, 2 ], Points[ Y, P, 2 ])

else if Locked[ 1, X ] and Locked[ 2, X ]
and Locked[ 1, Y ] and Locked[ 2, Y ]
then begin LockedIn := true;
Start := Points;
end;
end;

procedure UserInput;
begin
case Upcase( ReadKey ) of
'Q','X' : Terminate := true;
#27 : Abort := true;
#0 : case ReadKey of
#59{F1} : begin
Abort := true;
ProgInfo;
end;
end;
end;
end;


function PatternDone : boolean;
var
TempB : boolean;
Temp,
Count : integer;
begin
if BeenLocked
then begin
TempB := true;
for Count := 1 to 2 do
if (Points[ X, P, Count ] <> Start[ X, P, Count])
or (Points[ Y, P, Count ] <> Start[ Y, P, Count])
or (Points[ X, D, Count ] <> Start[ X, D, Count])
or (Points[ Y, D, Count ] <> Start[ Y, D, Count])
then TempB := false;
end
else if LockedIn then begin
BeenLocked := true;
TempB := false;
end
else TempB := false;
PatternDone := TempB;
end;

procedure Wait( Time : word );
var
C1, C2 : word;
begin
for C1 := 0 to 4 do
for C2 := 0 to Time
do begin
if KeyPressed
then UserInput;
if Abort or Terminate
then EXIT;
end;
end;


begin
Init;
ProgInfo;
repeat
StartOne;
repeat
if KeyPressed
then UserInput;
DrawLine;
until PatternDone or Abort or Terminate;
if not ( Abort or Terminate )
then Wait( Pause );
until Terminate;
CloseGraph;
end.