Написание программы игры "Жизнь" на Pascal 7.0

Задание 2

Игра “Жизнь”. Игра написана на Pascal 7.0, содержит простой и понятный интерфейс, высокую скорость, возможность управления в любой момент игры. Есть возможность наблюдения итоги игры во время работы программы. Есть и недостаток: она написана под MS-DOS. Тест игры успешно прошёл на Pentium II – 233 MГц.

Исходный код игры:

Program Life;

Uses Crt,Graph;

Const up=215;

      sipe=300;

      color:byte=$B8;{ColTrue and ColFalse}

      time:word=0;{Time -> ms}

      Q:word=100;{Quantity repeat -> thing}

Type  TBool=array(.0..up,0..sipe-1.)of byte;

      PBool=^TBool;

      TSosedy=array(.0..3,0..sipe-1.)of byte;

      PSosedy=TSosedy;

Label Conting,Meny,Start,ExitGlob,ExitSmol,ReStart;

Var   bool:PBool;

      a:PSosedy;

      Povtor,LastStep,k,Step,Schet,PodSchet,Sector,j,i,NachX,NachY:word;

      Nj,Kj,Ni,Ki:word;

      Number:longint;

      ExitNow,ExitBool:boolean;

      Col,size:byte;

      List:string;

      Command:string[2];

{IntroduceGraph - func}

Function IntroduceGraph:boolean;

Var grDriver,grMode,ErrCode:Integer;

Label ExitGraph;

Begin

grDriver:=Detect;

InitGraph(grDriver, grMode, '');

ErrCode:=GraphResult;IntroduceGraph:=false;

If ErrCode<>grOk then Begin

  Write('Mistake initiales graph: ',GraphErrorMsg(ErrCode));ReadLn;

  IntroduceGraph:=true;goto ExitGraph;end;

If GetMaxX<319then Begin

  OutTextXY(0,0,'MaxX<320. Exit: press "ENTER".');ReadLn;

  CloseGraph;IntroduceGraph:=true;goto ExitGraph;end;

If GetMaxColor<>15 then Begin

  OutTextXY(0,0,'Enough color. Exit: press "ENTER".');ReadLn;

  CloseGraph;IntroduceGraph:=true;end;

ExitGraph:End;

{CleenDisplay - proc}

Procedure CleanDisplay(Ky:word);

Begin SetFillStyle(1,0);Bar(0,0,GetMaxX,Ky);

End;

{PrintList - proc}

Procedure PrintList(Var j,i:word;ListDop:string);

Begin

OutTextXY(i*7,9*j,ListDop);

i:=i+length(ListDop);

End;

{PrintNumber - proc}

Procedure PrintNumber(MaximX:Longint;n:shortint;Var List:string);

Var NumbersList:string[11];

Begin

Str(MaximX,NumbersList);List:=List+NumbersList;

MaximX:=MaximX div 10;

While MaximX<>0do Begin

MaximX:=MaximX div 10;n:=n-1;end;

If n<0 then n:=0;

While n<>0 do Begin

 List:=List+' ';

 n:=n-1;end;

End;

{IntroduceFacts - proc}

Procedure IntroduceFacts(up,sipe,Sector:word);

Var   j,i,Code1,Code2,w,SectorA,SectorB:word;predel,k,Step:byte;

Begin

SectorB:=Sector-(Sector div $FF)*$FF;

SectorA:=Sector div $FF;

If (SectorA=255)or(SectorA=0)then SectorA:=1;

If SectorB=255then SectorB:=1;

predel:=sipe-((sipe-1)div 8)*8;

For j:=up-1downto 0do Begin k:=predel;

  For i:=(sipe-1)div 8downto 0do Begin Step:=1;

  While k<>0do Begin k:=k-1;For W:=SectorB to 0do Code1:=Random($FF)+Random(SectorB);

    For W:=SectorA+i to 0 do Code2:=Random(SectorB)+Random($ff);

    Code1:=Code1+Code2+(Random(SectorB) div 16)*Code1 div (Random(SectorA)*Code2+1)-j+i;

    bool^(.j,i*8+k.):=(Code1-(Code1 div(Step*2))*Step*2)div step;

    If bool^(.j,i*8+k.)=1then Schet:=Schet+1;

    If k<>0then Step:=Step*2;end;k:=8;end;end;

End;

{PrintDisplay - proc}

Procedure PrintDisplay(bool:PBool;up,sipe,NachX,NachY:word;size,color,col:byte);

Var i,j:word;

Begin

For j:=0to up-1 do For i:=0to sipe-1do Begin

  If bool^(.j,i.)=1then SetFillStyle(1,Color)else SetFillStyle(1,Col);

  Bar(NachX+size*i,NachY+size*j,NachX+size*(i+1)-2,NachY+size*(j+1)-2);

end;End;

{LifeInToroid - proc}

Procedure LifeInToroid(up,sipe:word;color,col:byte);

Var Dj,Di,DNj,DKj,DNi,DKi,Nj,Ni,Kj,Ki,x,y,z:word;i,j:word;

Procedure Translyator;

Var k:word;

Begin

If Dj=0then DNj:=up-1 else DNj:=Dj-1;If Dj=up-1 then DKj:=0 else DKj:=Dj+1;

For k:=0to sipe-1do begin If k=0then DNi:=sipe-1 else DNi:=k-1;If k=sipe-1 then DKi:=0 else DKi:=k+1;

a(.z,k.):=bool^(.DNj,DNi.)+bool^(.DNj,k.)+bool^(.DNj,DKi.)+bool^(.Dj,DNi.)+bool^(.Dj,DKi.)+bool^(.DKj,DNi.)+bool^(.DKj,k.)

+bool^(.DKj,DKi.);end;

End;

Begin PodSchet:=0;Schet:=0;

z:=3;Dj:=up-1;Translyator;

z:=0;Dj:=0;Translyator;

z:=1;Dj:=1;Translyator;

y:=0;z:=1;

For j:=0to up-1do begin

x:=y;y:=z;z:=z+1-((z+1)div 3)*3;

  If j=0then Nj:=up-1 else Nj:=j-1;

  If j=up-1then Begin For Di:=0to sipe-1do a(.x,Di.):=a(.3,Di.);Kj:=0;end else Kj:=j+1;

  If j<up-3then Begin Dj:=j+2;Translyator;end;

  For i:=0to sipe-1do begin

    If i=0then Ni:=sipe-1 else Ni:=i-1;

    If i=sipe-1 then Ki:=0 else Ki:=i+1;

    If (bool^(.j,i.)=1)then Begin Schet:=Schet+1;If((a(.x,i.)<2)or(a(.x,i.)>3)) then Begin Schet:=Schet-1;SetFillStyle(1,col);

      bool^(.j,i.):=0;PodSchet:=PodSchet+1;Bar(NachX+size*i,NachY+size*j,NachX+size*(i+1)-2,NachY+size*(j+1)-2);

    end;end;

    If (bool^(.j,i.)=0)and(a(.x,i.)=3)then Begin bool^(.j,i.):=1;SetFillStyle(1,color);Schet:=Schet+1;PodSchet:=PodSchet+1;

      Bar(NachX+size*i,NachY+size*j,NachX+size*(i+1)-2,NachY+size*(j+1)-2);

end;end;end;

Number:=Number+1;If Number>2000000000 then Number:=0;

End;

{START}

Begin

TextMode(CO80+Font8x8);

TextColor(15);

If IntroduceGraph then goto ExitGlob;

SetColor(15);

j:=(GetMaxY-16)div up;

i:=GetMaxX div sipe;