uses dos,crt; { Life Game } { Turbo Pascal Source } { Constructed by John H. Conway } { Adapted by Joao Paulo Schwarz Schuler } procedure DMG(b:BYTE); VAR R:REGISTERS; BEGIN R.AL:=B; R.AH:=0; INTR($10,R); END; type matr = array[0..199,0..319] of boolean ; var cel ,cel2 :^matr; function visit(x,y:integer):byte; var co:byte; begin co:=0; if cel2^[pred(Y),pred(X)] then co:=co+1; if cel2^[pred(Y),x ] then co:=co+1; if cel2^[pred(Y),succ(X)] then co:=co+1; if cel2^[Y, pred(X)] then co:=co+1; if cel2^[Y, succ(X)] then co:=co+1; if cel2^[succ(Y),pred(X)] then co:=co+1; if cel2^[succ(Y),X ] then co:=co+1; if cel2^[succ(Y),succ(X)] then co:=co+1; visit:=co; end; var RVIDEO: array[0..199,0..319] of byte absolute $a000:0000; procedure invis; var i,i2:integer; begin for i:=0 to 319 do for i2:=0 to 199 do cel^[i2,i] := (RVIDEO[i2,i] <> 0); end; procedure invis2; var i,i2:integer; begin cel2^:=cel^; end; var c:byte; xc,yc:integer; bo:boolean; CA:CHAR; TODOSMORTOS:boolean; begin (* begin of program *) TODOSMORTOS:=true; new(CEL); new(CEL2); randomize; dmg($13); invis; repeat cel2^:=cel^; for yc:= 1 to 198 do for xc:=1 to 318 do begin (* BEGIN of FOR *) c:=visit(xc,yc); if c=0 then begin if TODOSMORTOS and (yc>50) and (yc<66) and (xc>50) and (xc<250) then cel^[yc,xc]:=(random(64)<1) else cel^[yc,xc]:=false; end else cel^[yc,xc]:=( (c=2) and (cel2^[yc,xc])) or (c=3) {or (c=6)}; end; (* END of FOR *) TODOSMORTOS:=true; for yc:= 1 to 199 do for xc:= 1 to 319 do begin if cel^[yc,xc] then begin {TODOSMORTOS:=false;} (* BEGIN of IF *) c:=RVIDEO[yc,xc]; if c=0 then c:=24; if c=255 then { testa longenvidade } begin cel^[yc,xc]:=false; end else begin RVIDEO[yc,xc]:=c+1; end; end (* END of IF *) else begin RVIDEO[yc,xc]:=0; end; end; until keypressed; dispose(CEL); dispose(CEL2); dmg(2); clrscr; highvideo; textbackground(2); writeln(' Life Game',' ':38); normvideo; Writeln(' Turbo Pascal Source'); Writeln(' Constructed by John H. Conway '); Writeln(' Adapted by Joao Paulo Schwarz Schuler '); Writeln(' You can find the source! http://www.schulers.com/jpss/pascal/fontes.htm'); end.
Leia mais sobre o life.
Return to the Home Page
Return to the Fontes em Pascal Page
I want to read your E-Mail