PROGRAM LIFE2; {adpated from TURBO PASCAL LIBRARY by D. Stivison (SYBEX)} uses Dos, Crt; {$I Title.inc} {$I+} CONST Height = 24; Width = 80; MinBound = -1; Lively = #79; {Try other characters for different effects.} Deadly = ' '; TYPE State = (Alive, Dead); Cell = RECORD LooksLikeItIs: State; Nearby: INTEGER END; Edges = RECORD Left, Right, Top, Bottom: INTEGER END; ScreenLine = STRING[80]; UniversalString = string[255]; VAR Board: ARRAY[MinBound..Height] OF ARRAY[MinBound..Width] OF Cell; Population, Births, Deaths, Gen: INTEGER; Ch: CHAR; Quit: BOOLEAN; Pause: INTEGER; Edge: Edges; FUNCTION Min(a,b: INTEGER): INTEGER; BEGIN IF a <= b THEN Min := a ELSE Min := b END; {Min} FUNCTION Max(a,b: INTEGER): INTEGER; BEGIN IF a >= b THEN Max := a ELSE Max := b END; {Max} function YesOrNo (PromptMessage: UniversalString): Boolean; var response: Char; begin Write(PromptMessage,' (Y/N): '); repeat response := Readkey; until response in ['Y','y','N','n']; write (response); YesOrNo := response in ['Y','y']; end; {function} Procedure WaitForAnyKey; var AnyKey: Char; begin Writeln('To continue, please strike any key.'); AnyKey := ReadKey; end; {procedure} PROCEDURE ResetEdges; BEGIN Edge.Top := Height-1; Edge.Right := MinBound+1; Edge.Left := Width-1; Edge.Bottom := MinBound+1 END; {ResetEdges} PROCEDURE Initialize; VAR Down, Across: INTEGER; BEGIN For Down := MinBound TO Height DO For Across := MinBound TO Width DO BEGIN Board[Down,Across].LooksLikeItIs := Dead; Board[Down,Across].Nearby := 0 END; ResetEdges END; {Initialize} PROCEDURE Limits(x,y: INTEGER); BEGIN WITH Edge DO BEGIN Left := Min(Left,x); Right := Max(Right,x); Top := Min(Top,y); Bottom := Max(Bottom,y) END END; {Limits} PROCEDURE ClearNearby; VAR Down, Across: INTEGER; BEGIN FOR Down := Edge.Top-1 TO Edge.Bottom+1 DO FOR Across := Edge.Left-1 TO Edge.Right+1 DO Board[Down,Across].Nearby := 0 END; {ClearNearby} PROCEDURE CountNeighbors; VAR Down, Across, DeltaDown, DeltaCross: INTEGER; BEGIN ClearNearby; FOR Down := Edge.Top-1 TO Edge.Bottom+1 DO FOR Across := Edge.Left-1 TO Edge.Right+1 DO IF Board[Down][Across].LooksLikeItIs = Alive THEN FOR DeltaDown := -1 TO 1 DO FOR DeltaCross := -1 To 1 DO Board[Down+DeltaDown][Across+DeltaCross].Nearby := Board[Down+DeltaDown][Across+DeltaCross].Nearby + 1 END; {CountNeighbors} PROCEDURE UpDate; VAR Down, Across: INTEGER; LocalEdge: Edges; BEGIN Births := 0; Deaths := 0; LocalEdge := Edge; ResetEdges; FOR Down := Max(MinBound+1, LocalEdge.Top-1) TO Min(Height-1, LocalEdge.Bottom+1) DO FOR Across := Max(MinBound+1, LocalEdge.Left-1) TO Min(Width-1, LocalEdge.Right+1) DO WITH Board[Down][Across] DO CASE LooksLikeItIs OF Dead: IF Nearby = 3 THEN BEGIN LooksLikeItIs := Alive; GOTOXY(Across+1, Down+1); WRITE(Lively); Limits(Across, Down); Births := Births +1 END; Alive: IF (Nearby = 3) OR (Nearby = 4) THEN Limits(Across, Down) ELSE BEGIN LooksLikeItIs := Dead; GOTOXY(Across+1, Down+1); WRITE(Deadly); Deaths := Deaths + 1 END END; {Case} Population := Population + Births - Deaths; GOTOXY(1,1) END; {UpDate} PROCEDURE GetPositions; VAR Down, Across, Dx, Dy: INTEGER; BEGIN Population := 0; Dx := 37; Dy := 12; CLRSCR; GOTOXY(Dx,Dy); REPEAT Ch := ReadKey; IF KeyPressed THEN BEGIN IF (ORD(Ch) = 27) AND KeyPressed THEN Ch := ReadKey; END; CASE ORD(Ch) OF 75: BEGIN Dx := Dx-1; GOTOXY(Dx,Dy) END; {left arrow} 77: BEGIN Dx := Dx+1; GOTOXY(Dx,Dy) END; {right arrow} 72: BEGIN Dy := Dy-1; GOTOXY(Dx,Dy) END; {up arrow} 80: BEGIN Dy := Dy+1; GOTOXY(Dx,Dy) END; {down arrow} 120,88: BEGIN { x to mark } GOTOXY(Dx,Dy); WRITE('O'); GOTOXY(Dx,Dy); { reposition cursor } Board[Dy-1,Dx-1].LooksLikeItIs := Alive; Limits(Dx-1,Dy-1); Population := Population+1; END; 101,69: BEGIN { e to erase } GOTOXY(Dx,Dy); WRITE(' '); GOTOXY(Dx,Dy); Board[Dy-1,Dx-1].LooksLikeItIs := Dead; { Limits?} Population := Population-1; END END; {Case} UNTIL Ch = '.'; END; {GetPositions} PROCEDURE WindowDressing; BEGIN Textbackground (4); TextColor (14); CLRSCR; PrintMessage ('LIFE',9); GotoXY(5,19); Writeln('[Arrow keys] to move,[x] to mark, [e] to erase, make start pattern,'); Writeln(' [>] to start generating, select speed: 1 slowest..0 fastest;'); Writeln(' any key except numbers will halt program.'); GOTOXY (22,24); WaitForAnyKey; CLRSCR; END; BEGIN {main program} WindowDressing; REPEAT Gen := 0; Initialize; GetPositions; Pause := 32; Quit := FALSE; WHILE NOT Quit DO BEGIN CountNeighbors; UpDate; Gen := Gen+1; WRITE(Gen); FOR Ch := 'A' TO 'Z' DO DELAY(Pause); Quit := (Population = 0) OR ((Births = 0) AND (Deaths = 0)); IF KEYPRESSED THEN BEGIN Ch := ReadKey; CASE Ch of '1': Pause := 80; {tuned to 66 Mhz } '2': Pause := 50; '3': Pause := 32; '4': Pause := 24; '5': Pause := 16; '6': Pause := 9; '7': Pause := 6; '8': Pause := 3; '9': Pause := 1; '0': Pause := 0; else Quit := TRUE; end; {case} END {if keypressed } END; {While} GOTOXY (1,22); IF Population = 0 THEN BEGIN Write(#7); { beep } WRITELN('This colony has died out in ', Gen, ' generations.'); END ELSE WRITELN UNTIL NOT YesOrNo ('Would you like to run LIFE again?') END.