home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / games / wator.zip / REN0057.REN < prev    next >
Text File  |  1984-12-23  |  34KB  |  1,029 lines
  1. {$C-}
  2. Program WaTor (input,output);                                      {.CP48}
  3.   {An implementation of the "Wa-tor" world program described in
  4.    A. K. Dewdney's column in Scientific American, Dec., 1984,
  5.    pp. 14-22.  Dewdney described a program built on arrays, but
  6.    suggested that it might go faster if built on linked lists.
  7.    This version was made by R. N. Wisan in Dec. 1984 using that
  8.    linked lists method.}
  9.  
  10. {If requested, this program makes a data file which can be printed out
  11.  and the first 320 Chronons can be graphed}
  12.  
  13. Type
  14.    Spoint    =     ^Shark;
  15.    Fpoint    =     ^Fish;
  16.    Shark     =     record
  17.                       Row:   0..24;
  18.                       Col:   0..49;
  19.                       age:   byte;
  20.                       ate:   byte;
  21.                       next:  Spoint;
  22.                       last:  Spoint;
  23.                    end;
  24.    Fish      =     record
  25.                       Row:   0..24;
  26.                       Col:   0..49;
  27.                       age:   byte;
  28.                       next:  Fpoint;
  29.                    end;
  30.    FileRec   =      record
  31.                        Sharks: integer;
  32.                        Fhigh:  integer;
  33.                        Flow:   integer;
  34.                        Sbred:  integer;
  35.                        Sdied:  integer;
  36.                        Fbred:  integer;
  37.                        Featen: integer;
  38.                     end;
  39.    regpack   =     record
  40.                       ax,bx,cx,dx,bp,si,di,ds,es,flags: integer;
  41.                    end;
  42.    Str255    =     string[255];
  43.    Str3      =     string[3];
  44.  
  45. Var
  46.    Fil:            File of FileRec;
  47.    Dat:            FileRec;
  48.    GrafOrTable:    (Graf,Table,Quit);
  49.  
  50.    X,S1,S2,
  51.    Fh1,Fh2,
  52.    Fl1,Fl2,
  53.    Sbr,Sdie,Fbr:   integer;
  54.    Ch:             char;
  55.  
  56.    R,Lin,Chron,
  57.    Seg,Page:       integer;
  58.    Op:             text;
  59.  
  60.  
  61. Procedure GetScreen;                                                  {.CP11}
  62. {Determine whether color or mono board is present}
  63. Var
  64.    Regs:           RegPack;
  65.    B:              byte;
  66. Begin
  67.    intr($11,Regs);
  68.    if (Regs.Ax and 48)=48 then             {Monochrome board}
  69.       Seg := $B000
  70.    else                                    {Color/Graphics board}
  71.       Seg := $B800
  72. end; {GetScreen}
  73.  
  74. Procedure Ctr(Line:Str255; row:byte);                                 {.CP10}
  75. Var
  76.    I,L:           byte;
  77. Begin
  78.    L := 40 - (Length(Line)div 2);
  79.    LowVideo;
  80.    GotoXY(1,Row);
  81.    For I := 1 to L do
  82.       write(' ');
  83.    write(Line);
  84. (*   For I := (L+Length(Line)) to 79 do
  85.       write(' ') *)
  86. End; {Ctr}
  87.  
  88. Procedure GetGrafOrTable;                                             {.CP28}
  89. Var
  90.    Ch:             char;
  91.    Lin:            byte;
  92. Begin
  93.    ClrScr;
  94.    LowVideo;
  95.    Lin := 3;
  96.    Ctr('You can make a graph or a table of the last recorded run',Lin);
  97.    Lin := Lin + 1;
  98.    Ctr('(Enter G for a graph, T for a table, or Q to quit: ',Lin);
  99.    Lin := Lin + 1;
  100.    Repeat
  101.       read(Trm,Ch);
  102.       Lin := Lin + 2;
  103.       if not (Ch in ['G','g','T','t','Q','q']) then begin
  104.          Ctr('You must answer G, T, or Q ',Lin);
  105.          Lin := Lin + 1
  106.       end {if}
  107.    Until Ch in ['G','g','T','t','Q','q'];
  108.    If Ch in ['G','g'] then
  109.       GrafOrTable := Graf
  110.    else if Ch in ['T','t'] then
  111.       GrafOrTable := Table
  112.    else
  113.       GrafOrTable := Quit
  114. End; {GetGrafOrTable}
  115.  
  116. Procedure GetTableOrQuit;
  117. Var
  118.    Ch:             char;
  119.    Lin:            byte;
  120. Begin
  121.    ClrScr;
  122.    LowVideo;
  123.    Lin := 3;
  124.    Repeat
  125.       Ctr('Do you want a readout of the last recorded run? (Y/N) ',Lin);
  126.       read(Trm,Ch);
  127.       If Not (Ch in ['Y','y','N','n']) then begin
  128.          Lin := Lin + 2;
  129.          Ctr('You must answer Y or N ',Lin);
  130.          Lin := Lin + 1
  131.       end {if}
  132.    until Ch in ['Y','y','N','n'];
  133.    If Ch in ['Y','y'] then
  134.       GrafOrTable := Table
  135.    else
  136.       GrafOrTable :=  Quit
  137. End; {TableOrQuit}
  138.  
  139. Procedure OpenDataFile;                                               {.CP13}
  140. Begin
  141.    Assign(Fil,'WA-TOR.DAT');
  142.    {$I-} Reset(Fil) {$I+};
  143.    If IOresult<>0 then begin
  144.       ClrScr;
  145.       LowVideo;
  146.       GotoXY(20,10); Write('     Oh! Oh!  Can''t find the Data File.');
  147.       GotoXY(20,12); write('File WA-TOR.DAT should be on the default drive.');
  148.       GotoXY(20,13); write('        Check it out and try again.');
  149.       Halt
  150.    End {If}
  151. End; {OpenDataFile}
  152.  
  153. Overlay Procedure WaGraf;                                             {.CP13}
  154. Var
  155. Fish,Shark:        integer;
  156.    
  157.  
  158.    Function Pct(X: integer): integer; forward;
  159.  
  160.    Procedure GetInitial;
  161.    Begin
  162.       Read(Fil,Dat);
  163.       Shark := Dat.Sharks;
  164.       Fish  := Dat.Fhigh;
  165.       Sbr   := Dat.Sbred;
  166.       Sdie  := Dat.Sdied;
  167.       Fbr   := Dat.Fbred;
  168.    End; {GetInitial}
  169.  
  170.    Procedure GrBox;                                                   {.CP11}
  171.    Var
  172.      X,Y:             integer;
  173.  
  174.       Procedure Outline;
  175.       Begin
  176.          Draw(0,0,319,0,3);
  177.          Draw(319,0,319,199,3);
  178.          Draw(319,199,0,199,3);
  179.          Draw(0,199,0,0,3);
  180.       End; {OutLine}
  181.  
  182.       Procedure Verticals;                                            {.CP13}
  183.       Var
  184.          I:           integer;
  185.       Begin
  186.          For I := 1 to 3 do begin
  187.             X := I*100 - 1;
  188.             Y := 2;
  189.             While Y<200 do begin
  190.                Plot(X,Y,3);
  191.                Y := Y + 2
  192.             end {while}
  193.          end {For I}
  194.       End; {Verticals}
  195.  
  196.       Procedure Horizontals;                                           {CP19}
  197.       Var
  198.          I:           integer;
  199.       Begin
  200.          For I := 1 to 3 do begin
  201.             Y := I*50 - 1;
  202.             X := 2;
  203.             While X<319 do begin
  204.                Plot(X,Y,3);
  205.                X := X + 2
  206.             end {while}
  207.          end {for I}
  208.       End; {Horizontals}
  209.  
  210.    Begin {GrBox}
  211.       Outline;
  212.       Verticals;
  213.       Horizontals
  214.    End; {GrBox}
  215.  
  216.    Procedure DrawLine;                                                 {.CP8}
  217.    Begin
  218.       Draw(X,S2,X-1,S1,3);
  219.       Draw(X,Fl2,X-1,Fl1,3);
  220.       Draw(X,Fh2,X-1,Fh1,3);
  221.    End; {DrawLine}
  222.  
  223.    Procedure Opening;                                                 {.CP14}
  224.    Var
  225.       Ch:             char;
  226.    Begin
  227.       ClrScr;
  228.       LowVideo;
  229.       GotoXY(15,3);  write(' IF YOU WANT A GRAPH OF THE DATA:');
  230.       GotoXY(15,5);  write('    1. WA-TOR.DAT must be on default drive,');
  231.       GotoXY(15,7);  write('    2. If you want the graph printed out,');
  232.       GotoXY(15,8);  write('       DOS 2.0 GRAPHICS must be installed.');
  233.       GotoXY(15,12); write(' WHEN THE GRAPH IS FINISHED:');
  234.       GotoXY(15,14); write('    Press P if you want it printed out,');
  235.       GotoXY(15,15); write('    Press any other key to skip printout.');
  236.       GotoXY(40,24); write('---Press any key to continue.');
  237.       Read(Kbd,Ch);
  238.    End; {Opening}
  239.  
  240.    Procedure Grafit;                                                  {.CP15}
  241.    Begin
  242.       X := 0;
  243.       While Not(EOF(Fil)) and (X<319) do begin
  244.          read(Fil,Dat);
  245.          S2  := 199 - Pct(Dat.Sharks);
  246.          Fh2 := 199 - Pct(Dat.Fhigh);
  247.          Fl2 := 199 - Pct(Dat.Flow);
  248.          if X>0 then DrawLine;
  249.          S1  := S2;
  250.          Fh1 := Fh2;
  251.          Fl1 := Fl2;
  252.          X   := X + 1
  253.       End {while}
  254.    End; {Grafit}
  255.  
  256.    Procedure PrintGraf;                                               {.CP29}
  257.    Var
  258.       Regs: regpack;
  259.    Begin
  260.       writeln(Lst);
  261.       writeln(Lst);
  262.       writeln(Lst);
  263.       writeln(Lst);
  264.       Writeln(Lst,' ':14,#27,'E',#14,'1st 320 Chronons on Wa-Tor',#27,'F');
  265.       Intr(5,Regs);
  266.       Writeln(lst,#27,'E');
  267.       Writeln(Lst,' ':15,'Verticals indicate 100 Chronons.');
  268.       writeln(Lst);
  269.       Writeln(Lst,' ':15,'Double line indicates % of Ocean occupied by fish.');
  270.       writeln(Lst,' ':18,'Lower line shows low after sharks have fed.');
  271.       writeln(Lst,' ':18,'Upper line shows fish recovery after breeding.');
  272.       writeln(Lst);
  273.       writeln(Lst,' ':15,'Single line indicates % of Ocean occupied by sharks.');
  274.       writeln(Lst);
  275.       writeln(Lst,' ':15,'Initial Conditions:');
  276.       writeln(Lst);
  277.       writeln(Lst,' ':15,'    Number of sharks:    ',Shark:5,' (',
  278.           round(Pct(Shark)/2),'% of Ocean)');
  279.       writeln(Lst,' ':15,'    Number of fish:      ',Fish:5,' (',
  280.           round(Pct(Fish)/2),'% of Ocean)');
  281.       writeln(Lst,' ':15,'    Fish breeding cycle: ',Fbr:5,' chronons');
  282.       writeln(Lst,' ':15,'    Shark breeding cycle:',Sbr:5,' chronons');
  283.       writeln(Lst,' ':15,'    Sharks starve after: ',Sdie:5,
  284.                                 ' chronons without feeding');
  285.       writeln(Lst,#27,'F',#12);
  286.    End; {PrintGraf}
  287.  
  288.    Function Pct;                                                       {.CP7}
  289.    Var
  290.       R:              real;
  291.    Begin
  292.       R := X/6.25;
  293.       Pct := Round(R)
  294.    End; {Function Pct}
  295.  
  296.    Begin {WaGraf}                                                     {.CP15}
  297.       OpenDataFile;
  298.       Opening;
  299.       GraphMode;
  300.       GraphBackGround(0);
  301.       Palette(0);
  302.       GrBox;
  303.       GetInitial;
  304.       Grafit;
  305.       Close(Fil);
  306.       Read(Kbd,Ch);
  307.       if Ch in ['P','p'] then PrintGraf;
  308.       TextMode(BW80)
  309.    End; {WaGraf}
  310.  
  311. Overlay Procedure WaRead;                                             {.CP22}
  312.  
  313.    Procedure GetChoice;
  314.    Begin
  315.       Ch := #0;
  316.       writeln;
  317.       repeat
  318.          writeln;
  319.          write('Do you want the table on the Screen or on Paper? (S/P) ':67);
  320.          Read(trm,Ch);
  321.          Writeln;
  322.          if not (Ch in ['S','s','P','p']) then
  323.             writeln('You must answer S or P ':51)
  324.       until Ch in ['S','s','P','p'];
  325.       Case Ch of
  326.          'S','s':    Begin
  327.                         assign(Op,'Con:');
  328.                         Lin := 21
  329.                      end;
  330.          'P','p':    Begin
  331.                         assign(Op,'Lst:');
  332.                         Lin := 59
  333.                      end;
  334.       end {case}
  335.    End; {GetChoice}
  336.  
  337.  
  338.    Procedure Header;                                                  {.CP17}
  339.    Begin
  340.       Read(Fil,Dat);
  341.       Writeln(Op);
  342.       If Lin>40 then write(Op,' ':10);
  343.       Writeln(Op,'Wa-Tor World Record':45);
  344.       If Lin>40 then write(Op,' ':10);
  345.       Writeln(Op,'Initial Data:');
  346.       With Dat do begin
  347.          If Lin>40 then write(Op,' ':10);
  348.          writeln(Op,'Number of sharks: ':31,Sharks,
  349.             'Number of Fish: ':20,Fhigh);
  350.          If Lin>40 then write(Op,' ':10);
  351.          writeln(Op,'Sharks starve: ':25,Sdied,'   Sharks breed: ',Sbred,
  352.             '   Fish breed: ',Fbred);
  353.       end {with Dat}
  354.    End; {Header}
  355.  
  356.       Procedure PrintLine;                                             {.CP6}
  357.       Begin
  358.          If Lin>40 then write(Op,' ':10);
  359.          writeln(Op,Chron:4,'   ',Dat.Sharks:7,Dat.Fhigh:9,Dat.Flow:9,
  360.             Dat.Sbred:12,Dat.Fbred:8,Dat.Sdied:8,Dat.Featen:8)
  361.       end; {PrintLine}
  362.  
  363.       Procedure PrintPage;                                             {.CP9}
  364.       Begin
  365.          While (not EOF(Fil)) and (R<Lin) do begin
  366.             read(Fil,Dat);
  367.             PrintLine;
  368.             R := R + 1;
  369.             Chron := Chron + 1;
  370.          End {While}
  371.       End; {PrintPage}
  372.  
  373.       Procedure PrintHead;                                            {.CP12}
  374.       Begin
  375.          If page>1 then writeln(Op);
  376.          If (Lin>40) and (Page>1) then
  377.             writeln(Op,'Page ':75, Page)
  378.          else
  379.             writeln(Op);
  380.          If Lin>40 then write(Op,' ':10);
  381.          Writeln(Op,'Chronon   Sharks  Fish Hi  Fish Lo',
  382.             'S Bred':11,'F Bred':8,'S Died':8,'  F Eaten');
  383.          Writeln(Op);
  384.       End; {PrintHead}
  385.  
  386.       Procedure PrintText;                                            {.CP21}
  387.       Begin
  388.          While not EOF(Fil) do Begin
  389.             If page=1 then
  390.                R := 4
  391.             else
  392.                R := 1;
  393.             PrintHead;
  394.             PrintPage;
  395.             If Lin<40 then begin
  396.                write('---Press any key to continue':70);
  397.                read(kbd,Ch);
  398.                ClrScr
  399.             end {if Lin}
  400.             else
  401.                write(Op, #12);
  402.             Page := Page + 1
  403.          end {while}
  404.       End; {PrintText}
  405.  
  406.    Begin {WaRead}                                                     {.CP11}
  407.       LowVideo;
  408.       GetChoice;
  409.       OpenDataFile;
  410.       Chron := 1;
  411.       Page := 1;
  412.       rewrite(Op);
  413.       Header;
  414.       PrintText;
  415.       close(Fil)
  416.    end; {WaRead}
  417.  
  418. Overlay Procedure WaTorRun;                                           {.CP20}
  419.    Const
  420.       Fsymb: char    =  #250;     {Symbol for fish}
  421.       Ssymb: char    =  #33;      {Symbol for shark}
  422.       BabySSymb:Char =  #39;      {Symbol for newborn shark}
  423.  
  424.    Var
  425.       Fbr:            byte;       {Fish breeds on Nth Chronon after breeding}
  426.       Sbr:            byte;       {Shark breeds on Nth Chronon}
  427.       Sdie:           byte;       {Shark dies on Nth day after eating}
  428.       MaxF, MaxS,
  429.       MinS, MinF,
  430.       Chronon,
  431.       Nfish, Nshark:  integer;
  432.       Ocean:          array[0..24,0..49] of byte;
  433.       F, Fbase,
  434.       LastF, NewF:    Fpoint;
  435.       S, SBase,
  436.       LastS, NewS:    Spoint;
  437.       KeepRec:        boolean;
  438.  
  439.    Function Strs(B: integer): Str3; forward;
  440.  
  441.    Function LocF(F: Fpoint): byte; forward;
  442.    
  443.    Function LocS(S: Spoint): byte; forward;
  444.  
  445.    Procedure Markit(Row,Col,B: byte);                                 {.CP24}
  446.    Begin
  447.       Ocean[Row,Col]:= B;
  448.       Row := Row+1;
  449.       Col := Col+14;
  450.       case B of
  451.          0:  Begin
  452.                 Mem[Seg:(Col*2+(Row-1)*160)+1] := 7;
  453.                 Mem[Seg:(Col*2+(Row-1)*160)] := 32
  454.              End;
  455.          1:  Begin
  456.                 Mem[Seg:(Col*2+(Row-1)*160)+1] := 7;
  457.                 Mem[Seg:(Col*2+(Row-1)*160)] := ord(Fsymb)
  458.              End;
  459.          2:  Begin
  460.                 Mem[Seg:(Col*2+(Row-1)*160)+1] := 7;
  461.                 Mem[Seg:(Col*2+(Row-1)*160)] := ord(Ssymb)
  462.              End;
  463.          3:  begin
  464.                 Mem[Seg:(Col*2+(Row-1)*160)+1] := 15;
  465.                 Mem[Seg:(Col*2+(Row-1)*160)] := ord(BabySsymb)
  466.              end
  467.       end {case}
  468.    End; {Markit}
  469.    
  470.    Procedure Billboard(FS: char);                                     {.CP20}
  471.    Begin
  472.       LowVideo;
  473.       If (FS='F') or (FS='B') then begin
  474.          GotoXY(66,3); write(' Fish:  ',NFish:5);
  475.          GotoXY(66,13); write('     ',MaxF:4);
  476.          GotoXY(66,11); write('     ',MinF:4)
  477.       end; {if F}
  478.       If (FS='S') or (FS='B') then begin
  479.          GotoXY(1,3);  write(' Shark: ',NShark:5);
  480.          GotoXY(1,13);  write('     ',MaxS:4);
  481.          GotoXY(1,11);  write('     ',MinS:4)
  482.       end; {else}
  483.       GotoXY(1,10);  write(' Range:');
  484.       GotoXY(66,10); write(' Range:');
  485.       GotoXY(1,12);  write('      to');
  486.       GotoXY(66,12); write('      to');
  487.       GotoXY(1,1); write('Chronon ',Chronon,': ');
  488.       GotoXY(66,1); write('Chronon ',Chronon,': ')
  489.    End; {Billboard}
  490.    
  491.    Procedure Initialize;                                              {.CP19}
  492.    var
  493.       R,C:            byte;
  494.       Ch:             char;
  495.       LineNum:        integer;
  496.  
  497.       Procedure StartFile;
  498.       Begin
  499.          Assign(Fil,'WA-TOR.DAT');
  500.          Rewrite(Fil);
  501.          Dat.Sharks := Nshark;
  502.          Dat.Fhigh  := Nfish;
  503.          Dat.Flow   := Nfish;
  504.          Dat.SBred  := Sbr;
  505.          Dat.Sdied  := Sdie;
  506.          Dat.Fbred  := Fbr;
  507.          Dat.Featen := 0;
  508.          write(Fil, Dat)
  509.       End; {StartFile}
  510.    
  511.       Procedure Logo;                                                 {.CP18}
  512.       Const
  513.         A = '  █           █     █          █████████   █████    ██████   ';
  514.         B = '   █         █     █ █             █      █     █   █     █  ';
  515.         C = '    █   █   █     █   █   ████     █     █       █  ██████   ';
  516.         D = '     █ █ █ █     ███████           █      █     █   █   █    ';
  517.         E = '      █   █     █       █          █       █████    █    █   ';
  518.         LN = 3;
  519.  
  520.       Begin
  521.          LowVideo;
  522.          Ctr('WELCOME TO',2);
  523.          Ctr(A,LN+1);
  524.          Ctr(B,LN+2);
  525.          Ctr(C,LN+3);
  526.          Ctr(D,LN+4);
  527.          Ctr(E,LN+5);
  528.       end; {Logo}
  529.  
  530.       Procedure NextPage;                                              {.CP6}
  531.       Begin
  532.          GotoXY(40,25); write('---To continue press any key.');
  533.          Read(Kbd,Ch);
  534.          ClrScr
  535.       End; {NextPage}
  536.  
  537.      Procedure Palaver;                                               {.CP17}
  538.      Begin
  539.       LowVideo;
  540.       Ctr('Wa-Tor is a distant planet, discovered by A. K. Dewdney in  ',10);
  541.       Ctr('the Scientific American in December of 1984.  It is toroidal',11);
  542.       Ctr('in form and entirely covered with a liquid, largely composed',12);
  543.       Ctr('of an oxide of hydrogen.  Its fauna consists of two species:',13);
  544.       Ctr('a predator sufficiently comparable to the terrestrial shark ',14);
  545.       Ctr('to permit the use of that name, and a prey species which we ',15);
  546.       Ctr('may refer to as "fish".  Both species are parthenogenic.    ',16);
  547.       Ctr('The interest which this simple biosystem holds for us is due',18);
  548.       Ctr('to the fact that the frequency with which the "sharks" must ',19);
  549.       Ctr('feed, the breeding rates, and even the initial numbers of   ',20);
  550.       Ctr('the two species are entirely determinable by the observer.  ',21);
  551.       Ctr('This makes the planet an excellent site for ecological ex-  ',22);
  552.       Ctr('periment free of extraneous factors affecting species sur-  ',23);
  553.       Ctr('vival.                                                      ',24);
  554.       NextPage;
  555.       LowVideo;                                                     {.CP19}
  556.       Ctr('The behavior of the two species are as follows:              ',1);
  557.       Ctr('The ocean in which the "sharks" and "fish" swim forms a rect-',3);
  558.       Ctr('angular grid, and once every chronon, each organism moves one',4);
  559.       Ctr('step along this grid, space permitting.                      ',5);
  560.       Ctr('"Fish" move at random if an unoccupied place is available.   ',7);
  561.       Ctr('"Sharks" also move at random except that they will always    ',9);
  562.       Ctr('move to catch a fish if one adjoins.                         ',10);
  563.       Ctr('At breeding age, "fish" divide, after the manner of amoeba,  ',12);
  564.       Ctr('provided space is available.                                 ',13);
  565.       Ctr('"Sharks" breed by calving.  The calf emerges alongside its   ',15);
  566.       Ctr('mother, fully fed.  The mother, however, has sacrificed her  ',16);
  567.       Ctr('chance to feed during that chronon.  A calf will not enter   ',17);
  568.       Ctr('it''s breeding cycle until it has fed at least once.          ',18);
  569.       Ctr('"Sharks" must feed at regular intervals, the length of which ',20);
  570.       Ctr('varies with the observer''s choice.  A "shark" will die if it ',21);
  571.       Ctr('fails to feed within the required time period.               ',22);
  572.       NextPage;
  573.      end; {Palaver}
  574.  
  575.       Procedure GetParameters;                                        {.CP18}
  576.       Var
  577.          Ans:         char;
  578.  
  579.          Procedure WantRec;
  580.          Begin
  581.             writeln;
  582.             repeat
  583.                write('Keep a record (Y/N)? ':50);
  584.                read(Trm,Ans); writeln; writeln;
  585.                If not (Ans in ['Y','y','N','n']) then
  586.                   writeln('You must answer Y or N ':51)
  587.             until Ans in ['Y','y','N','n'];
  588.             If Ans in ['Y','y'] then
  589.                KeepRec := True
  590.             else
  591.                KeepRec := False;
  592.          End; {WantRec}
  593.  
  594.       Begin {GetParameters}                                           {.CP19}
  595.          LowVideo;
  596.          Fbr := 0; Sbr := 0; Sdie := 0; Nfish := 0; Nshark := 0;
  597.          Ctr('Now you may specify the parameters for your experiment.',1);
  598.          Ctr('Breeding age for "fish" (in chronons): ',3);
  599.          Read(Fbr);
  600.          Ctr('Breeding age for "sharks" (chronons):  ',5);
  601.          Read(Sbr);
  602.          Ctr('"Shark" starvation time (chronons):    ',7);
  603.          Read(Sdie);
  604.          Ctr('Initial number of "fish":              ',9);
  605.          Read(Nfish);
  606.          Ctr('Initial number of "sharks":            ',11);
  607.          Readln(Nshark);
  608.          MaxF := Nfish; MinF := Nfish;
  609.          MaxS := Nshark; MinS := Nshark;
  610.          WantRec;
  611.          NextPage
  612.       End; {GetParameters}
  613.    
  614.       Procedure MakeFish;                                             {.CP17}
  615.       Var
  616.          I:           integer;
  617.       Begin
  618.          FBase := nil;
  619.          for I := 1 to NFish do begin
  620.             New(F);
  621.             F^.age := Random(Fbr);
  622.             Repeat                                           {Find a place}
  623.                F^.Row := random(25);
  624.                F^.Col := random(50)
  625.             until Ocean[F^.Row,F^.Col] = 0;
  626.             Markit(F^.Row,F^.Col,1);                         {Put a Fish there}
  627.             F^.next := FBase;
  628.             FBase := F
  629.          End {For I}
  630.       End; {MakeFish}
  631.    
  632.       Procedure MakeShark;                                            {.CP21}
  633.       Var
  634.          I:           integer;
  635.       Begin
  636.          SBase := nil;
  637.          for i := 1 to Nshark do begin
  638.             New(S);                    New(S);
  639.             S^.age := random(Sbr);
  640.             S^.ate := random(Sdie);
  641.             repeat
  642.                S^.Row := random(25);
  643.                S^.Col := random(50);
  644.             until Ocean[S^.Row,S^.Col] = 0;
  645.             Markit(S^.Row,S^.Col,2);                      {put shark in  Ocean}
  646.             S^.next := Sbase;
  647.             S^.Last := Nil;
  648.             If Sbase<>Nil then
  649.                SBase^.Last := S;
  650.             Sbase := S
  651.          End {for I}
  652.       End; {MakeShark}
  653.    
  654.       Procedure WriteItUp;                                            {.CP11}
  655.       Begin
  656.          LowVideo;
  657.          GotoXY(1,16);  write('Initial No:');
  658.          GotoXY(66,16); write('Initial No:');
  659.          GotoXY(1,17);  write(Nshark:5);
  660.          GotoXY(66,17);  write(Nfish:5);
  661.          GotoXY(1,19);  write(' Breed: ',Sbr:3);
  662.          GotoXY(66,19); write(' Breed: ',Fbr:3);
  663.          GotoXY(1,20);  write(' Starve:',Sdie:3);
  664.       End; {WriteItUp}
  665.  
  666.       Procedure WantPalaver;                                          {.CP11}
  667.       Begin
  668.          Ctr('Do you need an explanation? (Y/N) ',LineNum);
  669.          Repeat
  670.             Read(Trm,Ch);
  671.             If not (Ch in ['Y','y','N','n']) then begin
  672.                LineNum := LineNum + 1;
  673.                Ctr('You must answer Y or N ',LineNum)
  674.             end {if}
  675.          Until Ch in ['Y','y','N','n'];
  676.       End; {WantPalaver}
  677.  
  678.       Procedure ClearOcean;                                            {.CP6}
  679.       Begin
  680.          For R := 0 to 24 do
  681.             For C := 0 to 49 do
  682.                Ocean[R,C] := 0
  683.       End; {ClearOcean}
  684.    
  685.    Begin {Initialize}                                                 {.CP18}
  686.       ClrScr;
  687.       Logo;
  688.       LineNum := 10;
  689.       WantPalaver;
  690.       If Ch in ['Y','y'] then
  691.          Palaver
  692.       else
  693.          ClrScr;
  694.       GetParameters;
  695.       WriteItUp;
  696.       Chronon := 1;
  697.       ClearOcean;
  698.       MakeFish;
  699.       MakeShark;
  700.       If KeepRec then StartFile
  701.     end; {Initialize}
  702.    
  703.    Procedure SharkMove;                                               {.CP24}
  704.    Var
  705.       Moveable,
  706.       Fed:            boolean;
  707.       Place:          byte;
  708.       X,Meals,
  709.       BredS,DeadS:    integer;
  710.       TempS:          Spoint;
  711.    
  712.       Procedure KillShark(var S: Spoint);
  713.       Begin
  714.          Markit(S^.Row,S^.Col,0);
  715.          TempS := S;
  716.          If S^.next<>Nil then
  717.             S^.next^.last := S^.last;
  718.          If S=Sbase then
  719.             Sbase := S^.next
  720.          else
  721.             S^.last^.next := S^.next;
  722.          S := S^.next;
  723.          Dispose(TempS);
  724.          NShark := NShark - 1;
  725.          DeadS := DeadS+1;
  726.       End; {KillShark}
  727.    
  728.       Procedure SearchPlaces;                                         {.CP30}
  729.       Var
  730.          Tries:       byte;
  731.       Begin
  732.          X := random(4);
  733.          Moveable := false;
  734.          Tries := 1;
  735.          Repeat
  736.             Case X of
  737.                0 : Place := Ocean[(S^.Row + 1) mod 25, S^.Col];
  738.                1 : Place := Ocean[S^.Row, (S^.Col+1) mod 50];
  739.                2 : If S^.Row = 0 then
  740.                       Place := Ocean[24, S^.Col]
  741.                    else
  742.                       Place := Ocean[S^.Row - 1, S^.Col];
  743.                3 : if S^.Col = 0 then
  744.                       Place := Ocean[S^.Row, 49]
  745.                    else
  746.                       Place := Ocean[S^.Row, S^.Col-1];
  747.             end; {Case}
  748.             If Place=1 then                           {fish there}
  749.                Moveable := True
  750.             Else if (Tries>4) and (Place=0) then      {empty place}
  751.                Moveable := True
  752.             Else begin
  753.                X := (X + 1) mod 4;
  754.                Tries := Tries + 1
  755.             End {else}
  756.          Until Moveable or (Tries>8)
  757.       End; {SearchPlaces}
  758.    
  759.       Procedure BreedShark;                                          {.CP18}
  760.       Begin
  761.          New(NewS);
  762.          S^.age := 0;
  763.          NewS^.age := 100;
  764.          NewS^.ate := 0;
  765.          NewS^.Row := S^.Row;
  766.          NewS^.Col := S^.Col;
  767.          NewS^.next := S^.next;
  768.          NewS^.Last := S;
  769.          If S^.next<>Nil then
  770.             S^.next^.last := NewS;
  771.          S^.next := NewS;
  772.          S := NewS;
  773.          Markit(S^.row,S^.Col,2);
  774.          NShark := NShark + 1;
  775.          BredS := BredS + 1;
  776.       End; {BreedShark}
  777.  
  778.       Procedure UpDate;                                               {.CP16}
  779.       Begin
  780.          If Nshark>MaxS then MaxS := Nshark;
  781.          If Nshark<MinS then MinS :=Nshark;
  782.          If MaxF<Nfish then MaxF := Nfish;
  783.          If MinF>Nfish then MinF := Nfish;
  784.          GotoXY(1,5);  write(' Died:  ',DeadS:5);
  785.          GotoXY(1,4);  write(' Bred:  ',BredS:5);
  786.          GotoXY(66,5); write(' Eaten: ',Meals:5);
  787.          GotoXY(1,25); write('            ');
  788.          Dat.Sharks := Nshark;
  789.          Dat.Flow   := Nfish;
  790.          Dat.Sbred  := BredS;
  791.          Dat.Sdied  := DeadS;
  792.          Dat.Featen := Meals
  793.       End; {UpDate}
  794.    
  795.    Begin {SharkMove}                                                  {.CP24}
  796.       Meals := 0; DeadS := 0; BredS := 0;
  797.       LowVideo;
  798.       GotoXY(1,25); write('Sharks move');
  799.       S := SBase;
  800.       While S<>Nil do begin
  801.          S^.age := S^.age + 1;
  802.          S^.ate := S^.ate + 1;
  803.          SearchPlaces;
  804.          If Moveable then Begin       {if not moved, do not change or breed}
  805.             MarkIt(S^.row, S^.Col,0);
  806.             If (S^.age >=Sbr) and (S^.age<100) then
  807.                BreedShark;
  808.             Case X of                                   {Move}
  809.                0: S^.Row := ((S^.Row + 1) mod 25);
  810.                1: S^.Col := ((S^.Col + 1) mod 50);
  811.                2: If S^.Row = 0 then
  812.                      S^.Row := 24
  813.                   else S^.Row := S^.Row - 1;
  814.                3: If S^.Col = 0 then
  815.                      S^.Col := 49
  816.                   else S^.Col := S^.Col - 1
  817.             End; {case}
  818.             If LocS(S)=1 then                       {Got a fish}      {.CP21}
  819.                Fed := true
  820.             else
  821.                Fed := False;
  822.             If S^.age>99 then                       {if immature, so marked}
  823.                MarkIt(S^.row, S^.Col,3)               {for one more chronon}
  824.             else
  825.                MarkIt(S^.row, S^.Col,2);
  826.             if Fed then begin
  827.                If S^.age>99 then S^.age := 0;           {calf matures}
  828.                S^.ate := 0;                             {full-fed}
  829.                Meals := Meals + 1;
  830.                Nfish := Nfish-1;
  831.             end; {if fish}
  832.          End; {if moveable}
  833.          If S^.ate>=Sdie then
  834.             KillShark(S)                  {KillShark returns S = next shark}
  835.          else
  836.             S := S^.next
  837.       End; {while}
  838.       UpDate
  839.    End; {Procedure SharkMove}
  840.    
  841.    Procedure FishMove;                                                 {.CP8}
  842.    Var
  843.       DoAgain,
  844.       Moveable:       boolean;
  845.       Place:          byte;
  846.       X:              byte;
  847.       TempF:          Fpoint;
  848.       BredF:          integer;
  849.    
  850.       Procedure SearchPlaces;                                         {.CP28}
  851.       Var
  852.          Tries:       byte;
  853.       Begin
  854.          X := random(4);
  855.          Moveable := false;
  856.          Tries := 1;
  857.          Repeat
  858.             Case X of
  859.                0 : Place := Ocean[(F^.Row + 1) mod 25, F^.Col];
  860.                1 : Place := Ocean[F^.Row, (F^.Col+1) mod 50];
  861.                2 : If F^.Row = 0 then
  862.                       Place := Ocean[24, F^.Col]
  863.                    else
  864.                       Place := Ocean[F^.Row - 1, F^.Col];
  865.                3 : if F^.Col = 0 then
  866.                       Place := Ocean[F^.Row, 49]
  867.                    else
  868.                       Place := Ocean[F^.Row, F^.Col-1];
  869.             end; {Case}
  870.             If Place=0  then
  871.                Moveable := True
  872.             else begin
  873.                X := (X + 1) mod 4;
  874.                Tries := Tries + 1
  875.             end {else}
  876.          Until Moveable or (Tries>4)
  877.       End; {SearchPlaces}
  878.    
  879.       Procedure BreedFish;                                            {.CP13}
  880.       Begin
  881.          New(NewF);
  882.          F^.age := 0;
  883.          NewF^.age := 0;
  884.          NewF^.Row := F^.Row;
  885.          NewF^.Col := F^.Col;
  886.          NewF^.next := F^.next;
  887.          F^.next := NewF;
  888.          Markit(NewF^.row,NewF^.Col,1);
  889.          NFish := NFish + 1;
  890.          BredF := BredF + 1;
  891.       End; {BreedFish}
  892.  
  893.       Procedure UpDate;                                               {.CP10}
  894.       Begin
  895.          If MaxF<Nfish then MaxF := Nfish;
  896.          If MinF>Nfish then MinF := Nfish;
  897.          LowVideo;
  898.          GotoXY(66,4); write(' Bred:  ',BredF:5);
  899.          GotoXY(66,25); write('          ');
  900.          Dat.Fhigh  := Nfish;
  901.          Dat.Fbred  := BredF
  902.       End; {UpDate}
  903.    
  904.       Procedure FindFirstFish;                                        {.CP17}
  905.       Begin
  906.          If Fbase<>Nil then
  907.             repeat
  908.                if (LocF(Fbase) in [2,3]) then begin        {eaten by a shark}
  909.                   TempF := Fbase;
  910.                   Fbase := Fbase^.next;
  911.                   Dispose(TempF);
  912.                end; {if}
  913.                If Fbase=Nil then
  914.                   DoAgain := false
  915.                else if (LocF(Fbase) in [2,3]) then
  916.                   DoAgain := true
  917.                else
  918.                   DoAgain := false
  919.             until not DoAgain
  920.       End; {FindFirstFish}
  921.    
  922.    Begin {FishMove}                                                   {.CP26}
  923.       LowVideo;
  924.       GotoXY(66,25); write('Fish move  ');
  925.       BredF := 0;
  926.       FindFirstFish;
  927.       F := FBase;
  928.       While (F<>Nil) and ((Nfish+Nshark)<1250) do begin
  929.          F^.age := F^.age + 1;
  930.          SearchPlaces;
  931.          If Moveable then Begin       {if immoveable, do not change or breed}
  932.             MarkIt(F^.row, F^.Col,0);
  933.             If F^.age >=Fbr then
  934.                BreedFish;
  935.             Case X of                                                  {Move}
  936.                0: F^.Row := ((F^.Row + 1) mod 25);
  937.                1: F^.Col := ((F^.Col + 1) mod 50);
  938.                2: If F^.Row = 0 then
  939.                      F^.Row := 24
  940.                   else F^.Row := F^.Row - 1;
  941.                3: If F^.Col = 0 then
  942.                      F^.Col := 49
  943.                   else F^.Col := F^.Col - 1
  944.             End; {case}
  945.             MarkIt(F^.row, F^.Col,1);
  946.          End; {if moveable}
  947.          If F^.Next<>Nil then                 {Get to next living fish}  {.CP18}
  948.             repeat
  949.                if (LocF(F^.next) in [2,3]) then begin        {eaten by a shark}
  950.                   TempF := F^.next;
  951.                   F^.next := F^.next^.next;
  952.                   Dispose(TempF)
  953.                end; {if}
  954.                If F^.next=Nil then
  955.                   DoAgain := false
  956.                else if LocF(F^.next) in [2,3] then
  957.                   DoAgain := true
  958.                else
  959.                   DoAgain := false
  960.             until not DoAgain;
  961.          F := F^.next
  962.       End; {while}
  963.       UpDate
  964.    End; {Procedure FishMove}
  965.    
  966.    Function Strs;                                                      {.CP7}
  967.    Var
  968.       S:              str3;
  969.    Begin
  970.       Str(B,S);
  971.       Strs := S
  972.    End;
  973.    
  974.    Function LocF;                                                      {.CP4}
  975.    Begin
  976.       LocF := Ocean[F^.Row, F^.Col]
  977.    End; {Loc}
  978.    
  979.    Function LocS;                                                      {.CP4}
  980.    Begin
  981.       LocS := Ocean[S^.Row, S^.Col]
  982.    End; {Loc}
  983.    
  984.    Procedure RunIt;                                                   {.CP15}
  985.    Var
  986.       StopIt:         char;
  987.    Begin
  988.       StopIt := #0;
  989.       repeat
  990.          SharkMove;
  991.          Billboard('B');
  992.          FishMove;
  993.          Billboard('F');
  994.          Chronon := Chronon + 1;
  995.          If KeepRec then write(Fil,Dat);
  996.          If KeyPressed then read(Kbd,StopIt)
  997.       until (StopIt<>#0) or ((Nfish+Nshark) = 0)
  998.    End; {Runit}
  999.  
  1000.    Begin {WaTorRun}                                                    {.CP9}
  1001.       LowVideo;
  1002.       Initialize;
  1003.       Billboard('B');
  1004.       If (Nfish>0) or (Nshark>0) then RunIt;
  1005.       If KeepRec then Close(Fil);
  1006.       HighVideo;
  1007.       GotoXY(35,12); write('All Over');
  1008.       GotoXY(25,13); write('--Press any key to continue--');
  1009.       Read(Kbd,Ch);
  1010.       LowVideo
  1011.    End; {WaTorRun}
  1012.  
  1013. Begin {main}
  1014.    GetScreen;
  1015.    WaTorRun;
  1016.    Repeat
  1017.       If Seg = $B800 then
  1018.          GetGrafOrTable
  1019.       else
  1020.          GetTableOrQuit;
  1021.       Case GrafOrTable of
  1022.          Graf:   WaGraf;
  1023.          Table:  WaRead
  1024.       End; {case}
  1025.    Until GrafOrTable = Quit;
  1026.    ClrScr;
  1027.    LowVideo;
  1028.    Ctr('That''s it.  Signing off.',11);
  1029. end.