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

PROGRAM Worms; {Adapted from A.K. Dewdney, Sci Am, Dec. '87}
{Sets colored worms a-crawling. Blue and green tend to loop
clockwise, red and cyan counterclockwise. Purple just wanders,
twice as fast as the others.
by Hugh Kenner
Nov. 20, 1987; rev 11/26/87, 3/17/90.
This version for Turbo Pascal 5.5}

USES CRT, Graph, GrDrivers;

CONST
Radius = 4; Esc = #27; TenDegrees = 0.1745;
Black = 0; Blue = 9; Green = 10;
Cyan = 11; Red = 12; Magenta = 13;
Yellow = 14; WormLength = 35;


TYPE
CircArray = ARRAY [1..WormLength] OF INTEGER;
WormRec = RECORD
XCirc, YCirc : CircArray;
XDot, YDot, Tail, OldTail : INTEGER;
WormColor, DotColor : BYTE;
Dir : REAL
END;

VAR
RedWorm, CyanWorm, GreenWorm, MagentaWorm, BlueWorm : WormRec;
GraphDriver, GraphMode, GraphError, XMax, YMax : INTEGER;

PROCEDURE Initialize;
{Kills cursor and sets up WormRecords}

PROCEDURE PrepRec (VAR ThisWorm : WormRec;
BodyColor, TrailColor : BYTE;
Direction : REAL);
BEGIN
WITH ThisWorm DO
BEGIN {With}
FILLCHAR (XCirc, SIZEOF (XCirc), 0);
FILLCHAR (YCirc, SIZEOF (YCirc), 0);
XCirc [1] := XMax DIV 2;
YCirc [1] := YMax DIV 2; {Start at screen center}
XDot := XMax DIV 2;
YDot := YMax DIV 2;
WormColor := BodyColor;
DotColor := TrailColor;
Dir := Direction;
Tail := 1
END {With}
END; {Procedure PrepRec}

BEGIN {Procedure Initialize: BodyColor, TrailColor, Direction}
RANDOMIZE;
CLRSCR;
DetectGraph (GraphDriver, GraphMode);
InitGraph (GraphDriver, GraphMode, '');
GraphError := GraphResult;
IF GraphError <> GrOK
THEN WRITELN ('Graphics error : ', GraphErrorMsg (GraphError))
ELSE
BEGIN {Else}
XMax := GetMaxX;
YMax := GetMaxY;
LINE (0, 0, XMax, 0);
LINE (XMax, 0, XMax, YMax);
LINE (XMax, YMax, 0, YMax);
LINE (0, YMax, 0, 0);
SetViewPort (1, 1, XMax-1, YMax-1, ClipOn);
PrepRec (RedWorm, Red, Yellow, 1.5);
PrepRec (CyanWorm, Cyan, Cyan, 4.6);
PrepRec (GreenWorm, Green, Green, 3.0);
PrepRec (MagentaWorm, Magenta, Magenta, -3.0);
PrepRec (BlueWorm, Blue, Blue, 0.0)
END {Else}
END; {Procedure Initialize}

PROCEDURE BlankTail (VAR ThisWorm : WormRec);
{Removes the final circle on a worm}
BEGIN
WITH ThisWorm DO
BEGIN
OldTail := Tail;
Tail := SUCC (Tail MOD WormLength);
SetColor (Black);
Circle (XCirc [Tail], YCirc [Tail], Radius)
END {With}
END; {Procedure BlankTail}

PROCEDURE PlaceDot (VAR ThisWorm : WormRec);
{Leaves a colored dot behind a worm}
BEGIN
WITH ThisWorm DO
BEGIN
SetColor (DotColor);
IF XDot > 0 THEN PutPixel (XDot, YDot, DotColor);
XDot := XCirc [Tail]; {Record for next time}
YDot := YCirc [Tail] {Record for next time}
END {With}
END; {Procedure PlaceDot}

PROCEDURE GetDirection (VAR ThisWorm : WormRec);
{Decides which way a worm heads next}
VAR
Pivot, Change : REAL;
BEGIN
Change := RANDOM;
WITH ThisWorm DO
BEGIN
IF WormColor <> Magenta
THEN Pivot := 0.33 {Looping}
ELSE
BEGIN {Magenta!}
Pivot := 0.5; {Wandering}
IF Change < Pivot
THEN Dir := Dir - TenDegrees
ELSE Dir := Dir + TenDegrees;
EXIT
END; {Magenta!}
IF Change < Pivot THEN {More probable}
BEGIN
IF (WormColor = Green) OR (WormColor = Blue) THEN
Dir := Dir - TenDegrees {Clockwise}
ELSE Dir := Dir + TenDegrees {CounterClockwise}
END
ELSE {If Change > Pivot} {Less probable}
BEGIN
IF (WormColor = Green) OR (WormColor = Blue) THEN
Dir := Dir + TenDegrees {CounterClockwise}
ELSE Dir := Dir - TenDegrees {Clockwise}
END
END {With}
END; {Procedure GetDirection}

PROCEDURE NewHead (VAR ThisWorm : WormRec);
{Gives the worm a newly oriented head}
VAR
X, Y : INTEGER;
BEGIN
WITH ThisWorm DO
BEGIN
X := (TRUNC (XCirc [OldTail] + Radius * COS (Dir))) MOD XMax;
Y := (TRUNC (YCirc [OldTail] + Radius * SIN (Dir))) MOD YMax;
IF X < 0 THEN X := X + XMax; {Handle edge conditions}
IF Y < 0 THEN Y := Y + YMax;
XCirc [Tail] := X; {Save position}
YCirc [Tail] := Y;
SetColor (WormColor);
Circle (X, Y, Radius) {Draw new head}
END {With}
END; {Procedure NewHead}

PROCEDURE DrawWorm (VAR ThisWorm : WormRec);
BEGIN
BlankTail (ThisWorm);
PlaceDot (ThisWorm);
GetDirection (ThisWorm);
NewHead (ThisWorm)
END; {Procedure DrawWorm}

BEGIN {Main program}
Initialize;
REPEAT
DrawWorm (GreenWorm);
DrawWorm (RedWorm);
DrawWorm (CyanWorm);
DrawWorm (BlueWorm);
DrawWorm (MagentaWorm);
DrawWorm (MagentaWorm) {Speedup}
UNTIL KeyPressed;
REPEAT UNTIL KeyPressed; {Freeze display}
CloseGraph
END.