Play and Learn 2/19941.ZIP/19941/EDUCICAL/PREDPRE/WA-TOR.PAS

Pascal/Delphi Source File | 1994-02-04 | 33.8 KB | 1,029 lines

{$C-}
Program WaTor (input,output);                                      {.CP48}
  {An implementation of the "Wa-tor" world program described in
   A. K. Dewdney's column in Scientific American, Dec., 1984,
   pp. 14-22.  Dewdney described a program built on arrays, but
   suggested that it might go faster if built on linked lists.
   This version was made by R. N. Wisan in Dec. 1984 using that
   linked lists method.}

{If requested, this program makes a data file which can be printed out
 and the first 320 Chronons can be graphed}

Type
   Spoint    =     ^Shark;
   Fpoint    =     ^Fish;
   Shark     =     record
                      Row:   0..24;
                      Col:   0..49;
                      age:   byte;
                      ate:   byte;
                      next:  Spoint;
                      last:  Spoint;
                   end;
   Fish      =     record
                      Row:   0..24;
                      Col:   0..49;
                      age:   byte;
                      next:  Fpoint;
                   end;
   FileRec   =      record
                       Sharks: integer;
                       Fhigh:  integer;
                       Flow:   integer;
                       Sbred:  integer;
                       Sdied:  integer;
                       Fbred:  integer;
                       Featen: integer;
                    end;
   regpack   =     record
                      ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
                   end;
   Str255    =     string[255];
   Str3      =     string[3];

Var
   Fil:            File of FileRec;
   Dat:            FileRec;
   GrafOrTable:    (Graf,Table,Quit);

   X,S1,S2,
   Fh1,Fh2,
   Fl1,Fl2,
   Sbr,Sdie,Fbr:   integer;
   Ch:             char;

   R,Lin,Chron,
   Seg,Page:       integer;
   Op:             text;


Procedure GetScreen;                                                  {.CP11}
{Determine whether color or mono board is present}
Var
   Regs:           RegPack;
   B:              byte;
Begin
   intr($11,Regs);
   if (Regs.Ax and 48)=48 then             {Monochrome board}
      Seg := $B000
   else                                    {Color/Graphics board}
      Seg := $B800
end; {GetScreen}

Procedure Ctr(Line:Str255; row:byte);                                 {.CP10}
Var
   I,L:           byte;
Begin
   L := 40 - (Length(Line)div 2);
   LowVideo;
   GotoXY(1,Row);
   For I := 1 to L do
      write(' ');
   write(Line);
(*   For I := (L+Length(Line)) to 79 do
      write(' ') *)
End; {Ctr}

Procedure GetGrafOrTable;                                             {.CP28}
Var
   Ch:             char;
   Lin:            byte;
Begin
   ClrScr;
   LowVideo;
   Lin := 3;
   Ctr('You can make a graph or a table of the last recorded run',Lin);
   Lin := Lin + 1;
   Ctr('(Enter G for a graph, T for a table, or Q to quit: ',Lin);
   Lin := Lin + 1;
   Repeat
      read(Trm,Ch);
      Lin := Lin + 2;
      if not (Ch in ['G','g','T','t','Q','q']) then begin
         Ctr('You must answer G, T, or Q ',Lin);
         Lin := Lin + 1
      end {if}
   Until Ch in ['G','g','T','t','Q','q'];
   If Ch in ['G','g'] then
      GrafOrTable := Graf
   else if Ch in ['T','t'] then
      GrafOrTable := Table
   else
      GrafOrTable := Quit
End; {GetGrafOrTable}

Procedure GetTableOrQuit;
Var
   Ch:             char;
   Lin:            byte;
Begin
   ClrScr;
   LowVideo;
   Lin := 3;
   Repeat
      Ctr('Do you want a readout of the last recorded run? (Y/N) ',Lin);
      read(Trm,Ch);
      If Not (Ch in ['Y','y','N','n']) then begin
         Lin := Lin + 2;
         Ctr('You must answer Y or N ',Lin);
         Lin := Lin + 1
      end {if}
   until Ch in ['Y','y','N','n'];
   If Ch in ['Y','y'] then
      GrafOrTable := Table
   else
      GrafOrTable :=  Quit
End; {TableOrQuit}

Procedure OpenDataFile;                                               {.CP13}
Begin
   Assign(Fil,'WA-TOR.DAT');
   {$I-} Reset(Fil) {$I+};
   If IOresult<>0 then begin
      ClrScr;
      LowVideo;
      GotoXY(20,10); Write('     Oh! Oh!  Can''t find the Data File.');
      GotoXY(20,12); write('File WA-TOR.DAT should be on the default drive.');
      GotoXY(20,13); write('        Check it out and try again.');
      Halt
   End {If}
End; {OpenDataFile}

Overlay Procedure WaGraf;                                             {.CP13}
Var
Fish,Shark:        integer;


   Function Pct(X: integer): integer; forward;

   Procedure GetInitial;
   Begin
      Read(Fil,Dat);
      Shark := Dat.Sharks;
      Fish  := Dat.Fhigh;
      Sbr   := Dat.Sbred;
      Sdie  := Dat.Sdied;
      Fbr   := Dat.Fbred;
   End; {GetInitial}

   Procedure GrBox;                                                   {.CP11}
   Var
     X,Y:             integer;

      Procedure Outline;
      Begin
         Draw(0,0,319,0,3);
         Draw(319,0,319,199,3);
         Draw(319,199,0,199,3);
         Draw(0,199,0,0,3);
      End; {OutLine}

      Procedure Verticals;                                            {.CP13}
      Var
         I:           integer;
      Begin
         For I := 1 to 3 do begin
            X := I*100 - 1;
            Y := 2;
            While Y<200 do begin
               Plot(X,Y,3);
               Y := Y + 2
            end {while}
         end {For I}
      End; {Verticals}

      Procedure Horizontals;                                           {CP19}
      Var
         I:           integer;
      Begin
         For I := 1 to 3 do begin
            Y := I*50 - 1;
            X := 2;
            While X<319 do begin
               Plot(X,Y,3);
               X := X + 2
            end {while}
         end {for I}
      End; {Horizontals}

   Begin {GrBox}
      Outline;
      Verticals;
      Horizontals
   End; {GrBox}

   Procedure DrawLine;                                                 {.CP8}
   Begin
      Draw(X,S2,X-1,S1,3);
      Draw(X,Fl2,X-1,Fl1,3);
      Draw(X,Fh2,X-1,Fh1,3);
   End; {DrawLine}

   Procedure Opening;                                                 {.CP14}
   Var
      Ch:             char;
   Begin
      ClrScr;
      LowVideo;
      GotoXY(15,3);  write(' IF YOU WANT A GRAPH OF THE DATA:');
      GotoXY(15,5);  write('    1. WA-TOR.DAT must be on default drive,');
      GotoXY(15,7);  write('    2. If you want the graph printed out,');
      GotoXY(15,8);  write('       DOS 2.0 GRAPHICS must be installed.');
      GotoXY(15,12); write(' WHEN THE GRAPH IS FINISHED:');
      GotoXY(15,14); write('    Press P if you want it printed out,');
      GotoXY(15,15); write('    Press any other key to skip printout.');
      GotoXY(40,24); write('---Press any key to continue.');
      Read(Kbd,Ch);
   End; {Opening}

   Procedure Grafit;                                                  {.CP15}
   Begin
      X := 0;
      While Not(EOF(Fil)) and (X<319) do begin
         read(Fil,Dat);
         S2  := 199 - Pct(Dat.Sharks);
         Fh2 := 199 - Pct(Dat.Fhigh);
         Fl2 := 199 - Pct(Dat.Flow);
         if X>0 then DrawLine;
         S1  := S2;
         Fh1 := Fh2;
         Fl1 := Fl2;
         X   := X + 1
      End {while}
   End; {Grafit}

   Procedure PrintGraf;                                               {.CP29}
   Var
      Regs: regpack;
   Begin
      writeln(Lst);
      writeln(Lst);
      writeln(Lst);
      writeln(Lst);
      Writeln(Lst,' ':14,#27,'E',#14,'1st 320 Chronons on Wa-Tor',#27,'F');
      Intr(5,Regs);
      Writeln(lst,#27,'E');
      Writeln(Lst,' ':15,'Verticals indicate 100 Chronons.');
      writeln(Lst);
      Writeln(Lst,' ':15,'Double line indicates % of Ocean occupied by fish.');
      writeln(Lst,' ':18,'Lower line shows low after sharks have fed.');
      writeln(Lst,' ':18,'Upper line shows fish recovery after breeding.');
      writeln(Lst);
      writeln(Lst,' ':15,'Single line indicates % of Ocean occupied by sharks.');
      writeln(Lst);
      writeln(Lst,' ':15,'Initial Conditions:');
      writeln(Lst);
      writeln(Lst,' ':15,'    Number of sharks:    ',Shark:5,' (',
          round(Pct(Shark)/2),'% of Ocean)');
      writeln(Lst,' ':15,'    Number of fish:      ',Fish:5,' (',
          round(Pct(Fish)/2),'% of Ocean)');
      writeln(Lst,' ':15,'    Fish breeding cycle: ',Fbr:5,' chronons');
      writeln(Lst,' ':15,'    Shark breeding cycle:',Sbr:5,' chronons');
      writeln(Lst,' ':15,'    Sharks starve after: ',Sdie:5,
                                ' chronons without feeding');
      writeln(Lst,#27,'F',#12);
   End; {PrintGraf}

   Function Pct;                                                       {.CP7}
   Var
      R:              real;
   Begin
      R := X/6.25;
      Pct := Round(R)
   End; {Function Pct}

   Begin {WaGraf}                                                     {.CP15}
      OpenDataFile;
      Opening;
      GraphMode;
      GraphBackGround(0);
      Palette(0);
      GrBox;
      GetInitial;
      Grafit;
      Close(Fil);
      Read(Kbd,Ch);
      if Ch in ['P','p'] then PrintGraf;
      TextMode(BW80)
   End; {WaGraf}

Overlay Procedure WaRead;                                             {.CP22}

   Procedure GetChoice;
   Begin
      Ch := #0;
      writeln;
      repeat
         writeln;
         write('Do you want the table on the Screen or on Paper? (S/P) ':67);
         Read(trm,Ch);
         Writeln;
         if not (Ch in ['S','s','P','p']) then
            writeln('You must answer S or P ':51)
      until Ch in ['S','s','P','p'];
      Case Ch of
         'S','s':    Begin
                        assign(Op,'Con:');
                        Lin := 21
                     end;
         'P','p':    Begin
                        assign(Op,'Lst:');
                        Lin := 59
                     end;
      end {case}
   End; {GetChoice}


   Procedure Header;                                                  {.CP17}
   Begin
      Read(Fil,Dat);
      Writeln(Op);
      If Lin>40 then write(Op,' ':10);
      Writeln(Op,'Wa-Tor World Record':45);
      If Lin>40 then write(Op,' ':10);
      Writeln(Op,'Initial Data:');
      With Dat do begin
         If Lin>40 then write(Op,' ':10);
         writeln(Op,'Number of sharks: ':31,Sharks,
            'Number of Fish: ':20,Fhigh);
         If Lin>40 then write(Op,' ':10);
         writeln(Op,'Sharks starve: ':25,Sdied,'   Sharks breed: ',Sbred,
            '   Fish breed: ',Fbred);
      end {with Dat}
   End; {Header}

      Procedure PrintLine;                                             {.CP6}
      Begin
         If Lin>40 then write(Op,' ':10);
         writeln(Op,Chron:4,'   ',Dat.Sharks:7,Dat.Fhigh:9,Dat.Flow:9,
            Dat.Sbred:12,Dat.Fbred:8,Dat.Sdied:8,Dat.Featen:8)
      end; {PrintLine}

      Procedure PrintPage;                                             {.CP9}
      Begin
         While (not EOF(Fil)) and (R<Lin) do begin
            read(Fil,Dat);
            PrintLine;
            R := R + 1;
            Chron := Chron + 1;
         End {While}
      End; {PrintPage}

      Procedure PrintHead;                                            {.CP12}
      Begin
         If page>1 then writeln(Op);
         If (Lin>40) and (Page>1) then
            writeln(Op,'Page ':75, Page)
         else
            writeln(Op);
         If Lin>40 then write(Op,' ':10);
         Writeln(Op,'Chronon   Sharks  Fish Hi  Fish Lo',
            'S Bred':11,'F Bred':8,'S Died':8,'  F Eaten');
         Writeln(Op);
      End; {PrintHead}

      Procedure PrintText;                                            {.CP21}
      Begin
         While not EOF(Fil) do Begin
            If page=1 then
               R := 4
            else
               R := 1;
            PrintHead;
            PrintPage;
            If Lin<40 then begin
               write('---Press any key to continue':70);
               read(kbd,Ch);
               ClrScr
            end {if Lin}
            else
               write(Op, #12);
            Page := Page + 1
         end {while}
      End; {PrintText}

   Begin {WaRead}                                                     {.CP11}
      LowVideo;
      GetChoice;
      OpenDataFile;
      Chron := 1;
      Page := 1;
      rewrite(Op);
      Header;
      PrintText;
      close(Fil)
   end; {WaRead}

Overlay Procedure WaTorRun;                                           {.CP20}
   Const
      Fsymb: char    =  #250;     {Symbol for fish}
      Ssymb: char    =  #33;      {Symbol for shark}
      BabySSymb:Char =  #39;      {Symbol for newborn shark}

   Var
      Fbr:            byte;       {Fish breeds on Nth Chronon after breeding}
      Sbr:            byte;       {Shark breeds on Nth Chronon}
      Sdie:           byte;       {Shark dies on Nth day after eating}
      MaxF, MaxS,
      MinS, MinF,
      Chronon,
      Nfish, Nshark:  integer;
      Ocean:          array[0..24,0..49] of byte;
      F, Fbase,
      LastF, NewF:    Fpoint;
      S, SBase,
      LastS, NewS:    Spoint;
      KeepRec:        boolean;

   Function Strs(B: integer): Str3; forward;

   Function LocF(F: Fpoint): byte; forward;

   Function LocS(S: Spoint): byte; forward;

   Procedure Markit(Row,Col,B: byte);                                 {.CP24}
   Begin
      Ocean[Row,Col]:= B;
      Row := Row+1;
      Col := Col+14;
      case B of
         0:  Begin
                Mem[Seg:(Col*2+(Row-1)*160)+1] := 7;
                Mem[Seg:(Col*2+(Row-1)*160)] := 32
             End;
         1:  Begin
                Mem[Seg:(Col*2+(Row-1)*160)+1] := 7;
                Mem[Seg:(Col*2+(Row-1)*160)] := ord(Fsymb)
             End;
         2:  Begin
                Mem[Seg:(Col*2+(Row-1)*160)+1] := 7;
                Mem[Seg:(Col*2+(Row-1)*160)] := ord(Ssymb)
             End;
         3:  begin
                Mem[Seg:(Col*2+(Row-1)*160)+1] := 15;
                Mem[Seg:(Col*2+(Row-1)*160)] := ord(BabySsymb)
             end
      end {case}
   End; {Markit}

   Procedure Billboard(FS: char);                                     {.CP20}
   Begin
      LowVideo;
      If (FS='F') or (FS='B') then begin
         GotoXY(66,3); write(' Fish:  ',NFish:5);
         GotoXY(66,13); write('     ',MaxF:4);
         GotoXY(66,11); write('     ',MinF:4)
      end; {if F}
      If (FS='S') or (FS='B') then begin
         GotoXY(1,3);  write(' Shark: ',NShark:5);
         GotoXY(1,13);  write('     ',MaxS:4);
         GotoXY(1,11);  write('     ',MinS:4)
      end; {else}
      GotoXY(1,10);  write(' Range:');
      GotoXY(66,10); write(' Range:');
      GotoXY(1,12);  write('      to');
      GotoXY(66,12); write('      to');
      GotoXY(1,1); write('Chronon ',Chronon,': ');
      GotoXY(66,1); write('Chronon ',Chronon,': ')
   End; {Billboard}

   Procedure Initialize;                                              {.CP19}
   var
      R,C:            byte;
      Ch:             char;
      LineNum:        integer;

      Procedure StartFile;
      Begin
         Assign(Fil,'WA-TOR.DAT');
         Rewrite(Fil);
         Dat.Sharks := Nshark;
         Dat.Fhigh  := Nfish;
         Dat.Flow   := Nfish;
         Dat.SBred  := Sbr;
         Dat.Sdied  := Sdie;
         Dat.Fbred  := Fbr;
         Dat.Featen := 0;
         write(Fil, Dat)
      End; {StartFile}

      Procedure Logo;                                                 {.CP18}
      Const
        A = '  █           █     █          █████████   █████    ██████   ';
        B = '   █         █     █ █             █      █     █   █     █  ';
        C = '    █   █   █     █   █   ████     █     █       █  ██████   ';
        D = '     █ █ █ █     ███████           █      █     █   █   █    ';
        E = '      █   █     █       █          █       █████    █    █   ';
        LN = 3;

      Begin
         LowVideo;
         Ctr('WELCOME TO',2);
         Ctr(A,LN+1);
         Ctr(B,LN+2);
         Ctr(C,LN+3);
         Ctr(D,LN+4);
         Ctr(E,LN+5);
      end; {Logo}

      Procedure NextPage;                                              {.CP6}
      Begin
         GotoXY(40,25); write('---To continue press any key.');
         Read(Kbd,Ch);
         ClrScr
      End; {NextPage}

     Procedure Palaver;                                               {.CP17}
     Begin
      LowVideo;
      Ctr('Wa-Tor is a distant planet, discovered by A. K. Dewdney in  ',10);
      Ctr('the Scientific American in December of 1984.  It is toroidal',11);
      Ctr('in form and entirely covered with a liquid, largely composed',12);
      Ctr('of an oxide of hydrogen.  Its fauna consists of two species:',13);
      Ctr('a predator sufficiently comparable to the terrestrial shark ',14);
      Ctr('to permit the use of that name, and a prey species which we ',15);
      Ctr('may refer to as "fish".  Both species are parthenogenic.    ',16);
      Ctr('The interest which this simple biosystem holds for us is due',18);
      Ctr('to the fact that the frequency with which the "sharks" must ',19);
      Ctr('feed, the breeding rates, and even the initial numbers of   ',20);
      Ctr('the two species are entirely determinable by the observer.  ',21);
      Ctr('This makes the planet an excellent site for ecological ex-  ',22);
      Ctr('periment free of extraneous factors affecting species sur-  ',23);
      Ctr('vival.                                                      ',24);
      NextPage;
      LowVideo;                                                     {.CP19}
      Ctr('The behavior of the two species are as follows:              ',1);
      Ctr('The ocean in which the "sharks" and "fish" swim forms a rect-',3);
      Ctr('angular grid, and once every chronon, each organism moves one',4);
      Ctr('step along this grid, space permitting.                      ',5);
      Ctr('"Fish" move at random if an unoccupied place is available.   ',7);
      Ctr('"Sharks" also move at random except that they will always    ',9);
      Ctr('move to catch a fish if one adjoins.                         ',10);
      Ctr('At breeding age, "fish" divide, after the manner of amoeba,  ',12);
      Ctr('provided space is available.                                 ',13);
      Ctr('"Sharks" breed by calving.  The calf emerges alongside its   ',15);
      Ctr('mother, fully fed.  The mother, however, has sacrificed her  ',16);
      Ctr('chance to feed during that chronon.  A calf will not enter   ',17);
      Ctr('it''s breeding cycle until it has fed at least once.          ',18);
      Ctr('"Sharks" must feed at regular intervals, the length of which ',20);
      Ctr('varies with the observer''s choice.  A "shark" will die if it ',21);
      Ctr('fails to feed within the required time period.               ',22);
      NextPage;
     end; {Palaver}

      Procedure GetParameters;                                        {.CP18}
      Var
         Ans:         char;

         Procedure WantRec;
         Begin
            writeln;
            repeat
               write('Keep a record (Y/N)? ':50);
               read(Trm,Ans); writeln; writeln;
               If not (Ans in ['Y','y','N','n']) then
                  writeln('You must answer Y or N ':51)
            until Ans in ['Y','y','N','n'];
            If Ans in ['Y','y'] then
               KeepRec := True
            else
               KeepRec := False;
         End; {WantRec}

      Begin {GetParameters}                                           {.CP19}
         LowVideo;
         Fbr := 0; Sbr := 0; Sdie := 0; Nfish := 0; Nshark := 0;
         Ctr('Now you may specify the parameters for your experiment.',1);
         Ctr('Breeding age for "fish" (in chronons): ',3);
         Read(Fbr);
         Ctr('Breeding age for "sharks" (chronons):  ',5);
         Read(Sbr);
         Ctr('"Shark" starvation time (chronons):    ',7);
         Read(Sdie);
         Ctr('Initial number of "fish":              ',9);
         Read(Nfish);
         Ctr('Initial number of "sharks":            ',11);
         Readln(Nshark);
         MaxF := Nfish; MinF := Nfish;
         MaxS := Nshark; MinS := Nshark;
         WantRec;
         NextPage
      End; {GetParameters}

      Procedure MakeFish;                                             {.CP17}
      Var
         I:           integer;
      Begin
         FBase := nil;
         for I := 1 to NFish do begin
            New(F);
            F^.age := Random(Fbr);
            Repeat                                           {Find a place}
               F^.Row := random(25);
               F^.Col := random(50)
            until Ocean[F^.Row,F^.Col] = 0;
            Markit(F^.Row,F^.Col,1);                         {Put a Fish there}
            F^.next := FBase;
            FBase := F
         End {For I}
      End; {MakeFish}

      Procedure MakeShark;                                            {.CP21}
      Var
         I:           integer;
      Begin
         SBase := nil;
         for i := 1 to Nshark do begin
            New(S);                    New(S);
            S^.age := random(Sbr);
            S^.ate := random(Sdie);
            repeat
               S^.Row := random(25);
               S^.Col := random(50);
            until Ocean[S^.Row,S^.Col] = 0;
            Markit(S^.Row,S^.Col,2);                      {put shark in  Ocean}
            S^.next := Sbase;
            S^.Last := Nil;
            If Sbase<>Nil then
               SBase^.Last := S;
            Sbase := S
         End {for I}
      End; {MakeShark}

      Procedure WriteItUp;                                            {.CP11}
      Begin
         LowVideo;
         GotoXY(1,16);  write('Initial No:');
         GotoXY(66,16); write('Initial No:');
         GotoXY(1,17);  write(Nshark:5);
         GotoXY(66,17);  write(Nfish:5);
         GotoXY(1,19);  write(' Breed: ',Sbr:3);
         GotoXY(66,19); write(' Breed: ',Fbr:3);
         GotoXY(1,20);  write(' Starve:',Sdie:3);
      End; {WriteItUp}

      Procedure WantPalaver;                                          {.CP11}
      Begin
         Ctr('Do you need an explanation? (Y/N) ',LineNum);
         Repeat
            Read(Trm,Ch);
            If not (Ch in ['Y','y','N','n']) then begin
               LineNum := LineNum + 1;
               Ctr('You must answer Y or N ',LineNum)
            end {if}
         Until Ch in ['Y','y','N','n'];
      End; {WantPalaver}

      Procedure ClearOcean;                                            {.CP6}
      Begin
         For R := 0 to 24 do
            For C := 0 to 49 do
               Ocean[R,C] := 0
      End; {ClearOcean}

   Begin {Initialize}                                                 {.CP18}
      ClrScr;
      Logo;
      LineNum := 10;
      WantPalaver;
      If Ch in ['Y','y'] then
         Palaver
      else
         ClrScr;
      GetParameters;
      WriteItUp;
      Chronon := 1;
      ClearOcean;
      MakeFish;
      MakeShark;
      If KeepRec then StartFile
    end; {Initialize}

   Procedure SharkMove;                                               {.CP24}
   Var
      Moveable,
      Fed:            boolean;
      Place:          byte;
      X,Meals,
      BredS,DeadS:    integer;
      TempS:          Spoint;

      Procedure KillShark(var S: Spoint);
      Begin
         Markit(S^.Row,S^.Col,0);
         TempS := S;
         If S^.next<>Nil then
            S^.next^.last := S^.last;
         If S=Sbase then
            Sbase := S^.next
         else
            S^.last^.next := S^.next;
         S := S^.next;
         Dispose(TempS);
         NShark := NShark - 1;
         DeadS := DeadS+1;
      End; {KillShark}

      Procedure SearchPlaces;                                         {.CP30}
      Var
         Tries:       byte;
      Begin
         X := random(4);
         Moveable := false;
         Tries := 1;
         Repeat
            Case X of
               0 : Place := Ocean[(S^.Row + 1) mod 25, S^.Col];
               1 : Place := Ocean[S^.Row, (S^.Col+1) mod 50];
               2 : If S^.Row = 0 then
                      Place := Ocean[24, S^.Col]
                   else
                      Place := Ocean[S^.Row - 1, S^.Col];
               3 : if S^.Col = 0 then
                      Place := Ocean[S^.Row, 49]
                   else
                      Place := Ocean[S^.Row, S^.Col-1];
            end; {Case}
            If Place=1 then                           {fish there}
               Moveable := True
            Else if (Tries>4) and (Place=0) then      {empty place}
               Moveable := True
            Else begin
               X := (X + 1) mod 4;
               Tries := Tries + 1
            End {else}
         Until Moveable or (Tries>8)
      End; {SearchPlaces}

      Procedure BreedShark;                                          {.CP18}
      Begin
         New(NewS);
         S^.age := 0;
         NewS^.age := 100;
         NewS^.ate := 0;
         NewS^.Row := S^.Row;
         NewS^.Col := S^.Col;
         NewS^.next := S^.next;
         NewS^.Last := S;
         If S^.next<>Nil then
            S^.next^.last := NewS;
         S^.next := NewS;
         S := NewS;
         Markit(S^.row,S^.Col,2);
         NShark := NShark + 1;
         BredS := BredS + 1;
      End; {BreedShark}

      Procedure UpDate;                                               {.CP16}
      Begin
         If Nshark>MaxS then MaxS := Nshark;
         If Nshark<MinS then MinS :=Nshark;
         If MaxF<Nfish then MaxF := Nfish;
         If MinF>Nfish then MinF := Nfish;
         GotoXY(1,5);  write(' Died:  ',DeadS:5);
         GotoXY(1,4);  write(' Bred:  ',BredS:5);
         GotoXY(66,5); write(' Eaten: ',Meals:5);
         GotoXY(1,25); write('            ');
         Dat.Sharks := Nshark;
         Dat.Flow   := Nfish;
         Dat.Sbred  := BredS;
         Dat.Sdied  := DeadS;
         Dat.Featen := Meals
      End; {UpDate}

   Begin {SharkMove}                                                  {.CP24}
      Meals := 0; DeadS := 0; BredS := 0;
      LowVideo;
      GotoXY(1,25); write('Sharks move');
      S := SBase;
      While S<>Nil do begin
         S^.age := S^.age + 1;
         S^.ate := S^.ate + 1;
         SearchPlaces;
         If Moveable then Begin       {if not moved, do not change or breed}
            MarkIt(S^.row, S^.Col,0);
            If (S^.age >=Sbr) and (S^.age<100) then
               BreedShark;
            Case X of                                   {Move}
               0: S^.Row := ((S^.Row + 1) mod 25);
               1: S^.Col := ((S^.Col + 1) mod 50);
               2: If S^.Row = 0 then
                     S^.Row := 24
                  else S^.Row := S^.Row - 1;
               3: If S^.Col = 0 then
                     S^.Col := 49
                  else S^.Col := S^.Col - 1
            End; {case}
            If LocS(S)=1 then                       {Got a fish}      {.CP21}
               Fed := true
            else
               Fed := False;
            If S^.age>99 then                       {if immature, so marked}
               MarkIt(S^.row, S^.Col,3)               {for one more chronon}
            else
               MarkIt(S^.row, S^.Col,2);
            if Fed then begin
               If S^.age>99 then S^.age := 0;           {calf matures}
               S^.ate := 0;                             {full-fed}
               Meals := Meals + 1;
               Nfish := Nfish-1;
            end; {if fish}
         End; {if moveable}
         If S^.ate>=Sdie then
            KillShark(S)                  {KillShark returns S = next shark}
         else
            S := S^.next
      End; {while}
      UpDate
   End; {Procedure SharkMove}

   Procedure FishMove;                                                 {.CP8}
   Var
      DoAgain,
      Moveable:       boolean;
      Place:          byte;
      X:              byte;
      TempF:          Fpoint;
      BredF:          integer;

      Procedure SearchPlaces;                                         {.CP28}
      Var
         Tries:       byte;
      Begin
         X := random(4);
         Moveable := false;
         Tries := 1;
         Repeat
            Case X of
               0 : Place := Ocean[(F^.Row + 1) mod 25, F^.Col];
               1 : Place := Ocean[F^.Row, (F^.Col+1) mod 50];
               2 : If F^.Row = 0 then
                      Place := Ocean[24, F^.Col]
                   else
                      Place := Ocean[F^.Row - 1, F^.Col];
               3 : if F^.Col = 0 then
                      Place := Ocean[F^.Row, 49]
                   else
                      Place := Ocean[F^.Row, F^.Col-1];
            end; {Case}
            If Place=0  then
               Moveable := True
            else begin
               X := (X + 1) mod 4;
               Tries := Tries + 1
            end {else}
         Until Moveable or (Tries>4)
      End; {SearchPlaces}

      Procedure BreedFish;                                            {.CP13}
      Begin
         New(NewF);
         F^.age := 0;
         NewF^.age := 0;
         NewF^.Row := F^.Row;
         NewF^.Col := F^.Col;
         NewF^.next := F^.next;
         F^.next := NewF;
         Markit(NewF^.row,NewF^.Col,1);
         NFish := NFish + 1;
         BredF := BredF + 1;
      End; {BreedFish}

      Procedure UpDate;                                               {.CP10}
      Begin
         If MaxF<Nfish then MaxF := Nfish;
         If MinF>Nfish then MinF := Nfish;
         LowVideo;
         GotoXY(66,4); write(' Bred:  ',BredF:5);
         GotoXY(66,25); write('          ');
         Dat.Fhigh  := Nfish;
         Dat.Fbred  := BredF
      End; {UpDate}

      Procedure FindFirstFish;                                        {.CP17}
      Begin
         If Fbase<>Nil then
            repeat
               if (LocF(Fbase) in [2,3]) then begin        {eaten by a shark}
                  TempF := Fbase;
                  Fbase := Fbase^.next;
                  Dispose(TempF);
               end; {if}
               If Fbase=Nil then
                  DoAgain := false
               else if (LocF(Fbase) in [2,3]) then
                  DoAgain := true
               else
                  DoAgain := false
            until not DoAgain
      End; {FindFirstFish}

   Begin {FishMove}                                                   {.CP26}
      LowVideo;
      GotoXY(66,25); write('Fish move  ');
      BredF := 0;
      FindFirstFish;
      F := FBase;
      While (F<>Nil) and ((Nfish+Nshark)<1250) do begin
         F^.age := F^.age + 1;
         SearchPlaces;
         If Moveable then Begin       {if immoveable, do not change or breed}
            MarkIt(F^.row, F^.Col,0);
            If F^.age >=Fbr then
               BreedFish;
            Case X of                                                  {Move}
               0: F^.Row := ((F^.Row + 1) mod 25);
               1: F^.Col := ((F^.Col + 1) mod 50);
               2: If F^.Row = 0 then
                     F^.Row := 24
                  else F^.Row := F^.Row - 1;
               3: If F^.Col = 0 then
                     F^.Col := 49
                  else F^.Col := F^.Col - 1
            End; {case}
            MarkIt(F^.row, F^.Col,1);
         End; {if moveable}
         If F^.Next<>Nil then                 {Get to next living fish}  {.CP18}
            repeat
               if (LocF(F^.next) in [2,3]) then begin        {eaten by a shark}
                  TempF := F^.next;
                  F^.next := F^.next^.next;
                  Dispose(TempF)
               end; {if}
               If F^.next=Nil then
                  DoAgain := false
               else if LocF(F^.next) in [2,3] then
                  DoAgain := true
               else
                  DoAgain := false
            until not DoAgain;
         F := F^.next
      End; {while}
      UpDate
   End; {Procedure FishMove}

   Function Strs;                                                      {.CP7}
   Var
      S:              str3;
   Begin
      Str(B,S);
      Strs := S
   End;

   Function LocF;                                                      {.CP4}
   Begin
      LocF := Ocean[F^.Row, F^.Col]
   End; {Loc}

   Function LocS;                                                      {.CP4}
   Begin
      LocS := Ocean[S^.Row, S^.Col]
   End; {Loc}

   Procedure RunIt;                                                   {.CP15}
   Var
      StopIt:         char;
   Begin
      StopIt := #0;
      repeat
         SharkMove;
         Billboard('B');
         FishMove;
         Billboard('F');
         Chronon := Chronon + 1;
         If KeepRec then write(Fil,Dat);
         If KeyPressed then read(Kbd,StopIt)
      until (StopIt<>#0) or ((Nfish+Nshark) = 0)
   End; {Runit}

   Begin {WaTorRun}                                                    {.CP9}
      LowVideo;
      Initialize;
      Billboard('B');
      If (Nfish>0) or (Nshark>0) then RunIt;
      If KeepRec then Close(Fil);
      HighVideo;
      GotoXY(35,12); write('All Over');
      GotoXY(25,13); write('--Press any key to continue--');
      Read(Kbd,Ch);
      LowVideo
   End; {WaTorRun}

Begin {main}
   GetScreen;
   WaTorRun;
   Repeat
      If Seg = $B800 then
         GetGrafOrTable
      else
         GetTableOrQuit;
      Case GrafOrTable of
         Graf:   WaGraf;
         Table:  WaRead
      End; {case}
   Until GrafOrTable = Quit;
   ClrScr;
   LowVideo;
   Ctr('That''s it.  Signing off.',11);
end.