program wator;
{$C-}
{***************************************************************************}
{DECLARE GLOBAL VARIABLES USED BY ALL PROCEDURES}
label start;
var
  fish,sharks,fishmove,sharkmove,starve:array [0..1919]
  of integer;
  nfish,nsharks,fbreed,sbreed,slife:integer;
  i,j,k,l,m,n:integer;
  movup,movdn,movrt,movlt,nmoves,nmeals:integer;
  moveopts:array[1..4] of integer;
  currpos,newpos:integer;
  inchar:char;
  cycle,ncycles:integer;
  sumfish,sumsharks:integer;
  maxfish,minfish,maxsharks,minsharks:integer;
  sharkcycle,fishcycle:array[0..2000] of integer;
  screen1:array [0..1999] of integer absolute $b000:$0000;
{*************************************************************************}
procedure intro; {**AN INTRODUCTION TO THE PROGRAM**}
begin
writeln('This program simulates the planet WATOR as described in Scientific');
writeln('American Computer Recreations column, December, 1984.  WATOR is a');
writeln('toroidal (donut-shaped) planet inhabited by fish and sharks.  The');
writeln('fish feed on a ubiquitous plankton and the sharks feed on the fish.');
writeln('Time passes in discrete jumps or cycles.  During each cycle, fish');
writeln('move randomly to an unoccupied square, and reproduce if old enough.');
writeln('Sharks move to a square occupied by a fish and eat it, if possible,');
writeln('or move to an open square if no meals are available.  Sharks will also');
writeln('breed if old enough, but will starve if they do not eat within a specified');
writeln('period of time.  Parameters selected at the beginning of the run are as');
writeln('follows:');
writeln('  nfish:    Number of fish at start of run-distributed randomly.');
writeln('  nsharks:  Number of sharks at start, also distributed randomly.');
writeln('  fbreed:   Number of cycles a fish must exist before reproducing.');
writeln('  sbreed:   Number of cycles sharks must exist before reproducing.');
writeln('  starve:   Number of cycles a shark has to find food before starving.');
writeln('  ncycles:  Number of cycles for this run (maximum of 2000).');
writeln('On the screen, fish look like a dot (.) and sharks like a "O".');
writeln('After the initial screen is displayed, press any key to start the');
writeln('simulation.  During the run, pressing any key will stop the program,');
writeln('or the run will continue until ncycles is reached.');
writeln('Press any key now to continue.');
end;
{*******************END PROCEDURE INTRO************************************}
{**************************************************************************}
procedure display;
begin
for i:=0 to 1919 do
    begin
    if fish[i]>-1 then screen1[i]:=3886
    else if sharks[i]>-1 then screen1[i]:=3919
      else screen1[i]:=3872;
    sharkmove[i]:=-1;
    end;
end;
{**********************END PROCEDURE DISPLAY*******************************}
{**************************************************************************}
procedure count;
begin
sumfish:=0;sumsharks:=0;
  for i:=0 to 1919 do
      begin
        if fish[i]>-1 then sumfish:=sumfish+1;
        if sharks[i]>-1 then sumsharks:=sumsharks+1;
        end;
  gotoxy(1,25);clreol;
  write('TOTAL FISH=',sumfish:4,'(MAX:',maxfish:4,',MIN:',minfish:4,') TOTAL');
  write(' SHARKS=',sumsharks:4,'(MAX:',maxsharks:4,',MIN:',minsharks:4,') ');
  write(cycle);
end;
{***************************************************************************}
{PROCEDURE INITIALIZES ARRAYS, GETS STARTING PARAMETERS, SETS UP SCREEN*****}
procedure initialize;
begin
cycle:=0;
maxfish:=0;minfish:=0;maxsharks:=0;minsharks:=0;
write ('nfish=? '); readln(nfish);
write('nsharks=? ');readln(nsharks);
write('fbreed=? ');readln(fbreed);
write('sbreed=? ');readln(sbreed);
write('slife=? ');readln(slife);
write('how many cycles? ');readln(ncycles);
for i:=0 to 1919 do
  begin
  fish[i]:=-1;sharks[i]:=-1;fishmove[i]:=-1;sharkmove[i]:=-1;
  starve[i]:=-1;
  end;
for i:=1 to nfish do
  begin
  repeat
  j:=random(1920);
  until fish[j]=-1;
  fish[j]:=random(fbreed);
  end;
for i:=1 to nsharks do
  begin
  repeat
  j:=random(1920);
  until (fish[j]=-1)and(sharks[j]=-1);
  sharks[j]:=random (sbreed);
  starve[j]:=random (slife);
  end;
display;
gotoxy(1,25);
end;
{*****************END PROCEDURE INITIALIZE**********************************}
{}
{*****************PROCEDURE MOVEFISH***************************************}
procedure movefish;
begin
for j:=0 to 23 do begin
  k:=j*80;
  for i:=0 to 80 do begin
    {LOOK THROUGH ARRAY FOR FISH, CHECK IF ALREADY MOVED.  IF NOT, THEN }
    currpos:=i+k;
    if (fish[currpos]>-1) and (fishmove[currpos]=-1) then begin
      if i=0 then movlt:=currpos+79 else movlt:=currpos-1;
      if i=79 then movrt:=currpos-79 else movrt:=currpos+1;
      if j=0 then movup:=currpos+1840 else movup:=currpos-80;
      if j=23 then movdn:=currpos-1840 else movdn:=currpos+80;
      nmoves:=0;
      {LOOK AROUND TO SEE WHERE FISH CAN BE MOVED}
      if (fish[movlt]=-1) and (sharks[movlt]=-1) then begin
        nmoves:=nmoves+1;
        moveopts[nmoves]:=1;
        end;
      if (fish[movrt]=-1) and (sharks[movrt]=-1) then begin
        nmoves:=nmoves+1;
        moveopts[nmoves]:=2;
        end;
      if (fish[movup]=-1) and (sharks[movup]=-1) then begin
        nmoves:=nmoves+1;
        moveopts[nmoves]:=3;
        end;
      if (fish[movdn]=-1) and (sharks[movdn]=-1) then begin
        nmoves:=nmoves+1;
        moveopts[nmoves]:=4;
        end;
      {IF NOWHERE TO GO THEY JUST GET OLDER}
      if nmoves=0 then begin if fish[currpos]=fbreed then fish[currpos]:=0
        else fish[currpos]:=fish[currpos]+1 end
      {OTHERWISE, PICK A MOVE TO MAKE}
      else begin
        l:=random (nmoves)+1;
        case moveopts[l] of
          1:newpos:=movlt;
          2:newpos:=movrt;
          3:newpos:=movup;
          4:newpos:=movdn;
          end; {END CASE STATEMENT}
        {THEN MAKE MOVE, FISH BREEDS IF OLD ENOUGH TO REPRODUCE}
        fishmove[newpos]:=1;
        if fish[currpos]=fbreed then begin
          fish[newpos]:=0;fish[currpos]:=0;end
          else begin fish[newpos]:=fish[currpos]+1;fish[currpos]:=-1;end;
        end;
      end;
    end;
  end;
for i:=0 to 1999 do fishmove[i]:=-1;
end;
{}
{******************END PROCEDURE MOVEFISH***********************************}
{}
procedure movesharks;
begin
for j:=0 to 23 do begin
  k:=j*80;
  for i:=0 to 79 do begin
    currpos:=i+k;
    {LOOK THROUGH ARRAY FOR sharks, CHECK IF ALREADY MOVED.  IF NOT, THEN }
    if (sharks[currpos]>-1) and (sharkmove[currpos]=-1) then begin
      if i=0 then movlt:=currpos+79 else movlt:=currpos-1;
      if i=79 then movrt:=currpos-79 else movrt:=currpos+1;
      if j=0 then movup:=currpos+1840 else movup:=currpos-80;
      if j=23 then movdn:=currpos-1840 else movdn:=currpos+80;
      nmeals:=0;nmoves:=0;
      {LOOK AROUND TO SEE WHERE sharks CAN BE MOVED}
      if fish [movlt]>-1 then begin
        nmeals:=nmeals+1;
        moveopts[nmeals]:=1;
        end;
      if fish [movrt]>-1 then begin
        nmeals:=nmeals+1;
        moveopts[nmeals]:=2;
        end;
      if fish [movup]>-1 then begin
        nmeals:=nmeals+1;
        moveopts[nmeals]:=3;
        end;
      if fish [movdn]>-1 then begin
        nmeals:=nmeals+1;
        moveopts[nmeals]:=4;
        end;
{IF THE SHARK FINDS A FISH TO EAT, THEN PICK ONE, EAT IT, BREED IF POSSIBLE}
      if nmeals>0 then begin
        l:=random(nmeals)+1;
        case moveopts[l] of
          1:newpos:=movlt;
          2:newpos:=movrt;
          3:newpos:=movup;
          4:newpos:=movdn;
          end;
        fish[newpos]:=-1;
        starve[newpos]:=0; sharkmove [newpos]:=1;
        if sharks[currpos]=sbreed then begin
          sharks[newpos]:=0;
          sharks[currpos]:=0; starve [currpos]:=0;
          end
          else begin
          sharks[newpos]:=sharks[currpos]+1;
          sharks[currpos]:=-1; starve [currpos]:=-1;
          end;
        end
        else if starve [currpos]<slife then begin
{IF NO MEALS IN VICINITY, LOOK FOR AN EMPTY SQUARE TO MOVE TO}
          if (sharks[movlt]=-1) then begin
            nmoves:=nmoves+1;
            moveopts[nmoves]:=1;
            end;
          if (sharks[movrt]=-1) then begin
            nmoves:=nmoves+1;
            moveopts[nmoves]:=2;
            end;
          if (sharks[movup]=-1) then begin
            nmoves:=nmoves+1;
            moveopts[nmoves]:=3;
            end;
          if (sharks[movdn]=-1) then begin
            nmoves:=nmoves+1;
            moveopts[nmoves]:=4;
            end;
{IF NOTHING TO EAT AND NO PLACE TO GO, SHARK GETS OLDER}
          if nmoves=0 then begin
              if sharks[currpos]=sbreed then sharks[currpos]:=0
                else sharks[currpos]:=sharks[currpos]+1;
              starve [currpos]:= starve [currpos]+1;
            end
{}
{IF THERE IS A MOVE TO MAKE, PICK ONE FROM AVAILABLE SQUARES}
          else begin
            l:=random (nmoves)+1;
            case moveopts[l] of
              1:newpos:=movlt;
              2:newpos:=movrt;
              3:newpos:=movup;
              4:newpos:=movdn;
              end;
            sharkmove[newpos]:=1;
            starve[newpos]:=starve[currpos]+1;
            if sharks[currpos]=sbreed then begin
              sharks[newpos]:=0;
              sharks[currpos]:=0; starve[currpos]:=0; end
              else begin
              sharks[newpos]:=sharks[currpos]+1;
              sharks[currpos]:=-1;starve[currpos]:=-1; end;
            end;
          end
        else begin
          sharks [currpos]:=-1; starve [currpos]:=-1;
          end;
      end;
    end;
  end;
for i:=0 to 1999 do sharkmove[i]:=-1;
end;
{}
{*********************END PROCEDURE MOVESHARKS******************************}
{}
{*********************BEGINNING OF MAIN PROGRAM*****************************}
begin
intro; repeat until keypressed; read (kbd,inchar);
start:clrscr;initialize;count;
maxfish:=sumfish;minfish:=sumfish;maxsharks:=sumsharks;minsharks:=sumsharks;
fishcycle[0]:=sumfish;sharkcycle[0]:=sumsharks;
repeat until keypressed;
read (kbd,inchar);
repeat
  movefish;
  movesharks;
  display;
  if sumfish>maxfish then maxfish:=sumfish
    else if sumfish<minfish then minfish:=sumfish;
  if sumsharks>maxsharks then maxsharks:=sumsharks
    else if sumsharks<minsharks then minsharks:=sumsharks;
  cycle:=cycle+1;
  count;fishcycle[cycle]:=sumfish;sharkcycle[cycle]:=sumsharks;
until keypressed or (cycle=ncycles); read(kbd,inchar);
clrscr;
write('DO YOU WANT TO DO ANOTHER RUN? (Y/N): ');readln(inchar);
if upcase(inchar)='Y' then goto start;
end.