home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / cpm / draco / draco-1.ark / WATOR.DRC < prev    next >
Text File  |  1986-11-12  |  13KB  |  553 lines
  1. #util.g
  2. #crt.g
  3.  
  4. /*
  5.  * WATOR - simulation of the torus world of Wa-Tor, with a population of
  6.  *       sharks and fish. Size of display = 23 lines x 80 columns.
  7.  *
  8.  * Idea from: "Computer Recreations" by A. K. Dewdney in December 1984
  9.  *        Scientific American.
  10.  *
  11.  * Programmed: December 10, 1984, by Chris Gray.
  12.  * Language: Draco (systems language for microprocessors from
  13.  *            Northware Systems Corporation)
  14.  */
  15.  
  16. ushort
  17.     NLINES = 23,        /* number of lines displayed and run */
  18.     NCOLUMNS = 80;        /* number of columns displayed and run */
  19.  
  20. /* footer line with statistics:
  21.  
  22. NSharks: xxxx  NFish: xxxx  Time: xxxxx  SBreed: xx  FBreed: xx  Starve: xx
  23.  
  24. */
  25.  
  26. ushort
  27.     NSHARKSCOLUMN = 9,
  28.     NFISHCOLUMN = 22,
  29.     TIMECOLUMN = 34,
  30.     SBREEDCOLUMN = 49,
  31.     FBREEDCOLUMN = 61,
  32.     STARVECOLUMN = 73;
  33.  
  34. byte
  35.     SHARK = 0x01,        /* shark is present in this ocean cell */
  36.     FISH = 0x02,        /* fish is present in this ocean cell */
  37.     NEWSHARK = 0x04,        /* shark has moved here this cronon */
  38.     NEWFISH = 0x08;        /* fish has moved here this cronon */
  39.  
  40. type
  41.     CELL = struct {
  42.     byte f_flags;
  43.     ushort f_age;
  44.     ushort s_age;
  45.     ushort s_eat;
  46.     };
  47.  
  48. word
  49.     NSharks,            /* number of sharks currently alive */
  50.     NFish,            /* number of fish currently alive */
  51.     Time;            /* the current time */
  52.  
  53. ushort
  54.     SBreed,            /* breeding time for sharks */
  55.     FBreed,            /* breeding time for fish */
  56.     Starve;            /* starvation time for sharks */
  57.  
  58. [NLINES, NCOLUMNS] CELL Ocean;    /* the ocean of Wa-Tor */
  59.  
  60. channel output text
  61.     CRTOut,            /* formatted output to screen */
  62.     LogOut;            /* statistics logging */
  63.  
  64. bool Logging;            /* true if logging is enabled */
  65.  
  66. file() File;            /* file for save, restore and logging */
  67.  
  68. /*
  69.  * initialize - set up the screen and the various data structures.
  70.  */
  71.  
  72. proc nonrec initialize()void:
  73.     *CELL p;
  74.     word i;
  75.     ushort l, c;
  76.  
  77.     CRT_ClearScreen();
  78.     p := &Ocean[0, 0];
  79.     for i from 0 upto NLINES * NCOLUMNS - 1 do
  80.     p*.f_flags := 0x00;
  81.     p := p + sizeof(CELL);
  82.     od;
  83.     Time := 0;
  84. corp;
  85.  
  86. /*
  87.  * beep - beep to indicate an error (send BEL to terminal).
  88.  */
  89.  
  90. proc nonrec beep()void:
  91.  
  92.     CRT_PutChar('\(0x07)');
  93. corp;
  94.  
  95. /*
  96.  * findCell - find a random cell meeting the given mask requirements.
  97.  *          Return 'false' if no neighbouring cell is satisfactory.
  98.  */
  99.  
  100. proc nonrec findCell(byte mask, value; **CELL pp; ushort l, c)bool:
  101.     *CELL p, p1;
  102.     ushort count;
  103.     [4] *CELL neighbour;
  104.  
  105.     p1 := pp*;
  106.     count := 0;
  107.     p :=
  108.     if l = NLINES - 1 then
  109.         p1 - ((NLINES - 1) * NCOLUMNS * sizeof(CELL))
  110.     else
  111.         p1 + (NCOLUMNS * sizeof(CELL))
  112.     fi;
  113.     if p*.f_flags & mask = value then
  114.     neighbour[count] := p;
  115.     count := count + 1;
  116.     fi;
  117.     p :=
  118.     if l = 0 then
  119.         p1 + ((NLINES - 1) * NCOLUMNS * sizeof(CELL))
  120.     else
  121.         p1 - (NCOLUMNS * sizeof(CELL))
  122.     fi;
  123.     if p*.f_flags & mask = value then
  124.     neighbour[count] := p;
  125.     count := count + 1;
  126.     fi;
  127.     p :=
  128.     if c = NCOLUMNS - 1 then
  129.         p1 - ((NCOLUMNS - 1) * sizeof(CELL))
  130.     else
  131.         p1 + sizeof(CELL)
  132.     fi;
  133.     if p*.f_flags & mask = value then
  134.     neighbour[count] := p;
  135.     count := count + 1;
  136.     fi;
  137.     p :=
  138.     if c = 0 then
  139.         p1 + ((NCOLUMNS - 1) * sizeof(CELL))
  140.     else
  141.         p1 - sizeof(CELL)
  142.     fi;
  143.     if p*.f_flags & mask = value then
  144.     neighbour[count] := p;
  145.     count := count + 1;
  146.     fi;
  147.     if count = 0 then
  148.     false
  149.     else
  150.     count := CRT_Random(count);
  151.     pp* := neighbour[count];
  152.     true
  153.     fi
  154. corp;
  155.  
  156. /*
  157.  * updateFish - update and regenerate the fish.
  158.  */
  159.  
  160. proc nonrec updateFish()void:
  161.     *CELL p, p1;
  162.     ushort l, c;
  163.  
  164.     p := &Ocean[0, 0];
  165.     for l from 0 upto NLINES - 1 do
  166.     for c from 0 upto NCOLUMNS - 1 do
  167.         if p*.f_flags & FISH ~= 0x00 then
  168.         p1 := p;
  169.         if findCell(NEWFISH | FISH, 0x00, &p1, l, c) then
  170.             p1*.f_flags := p1*.f_flags | NEWFISH;
  171.             p1*.f_age := p*.f_age + 1;
  172.             if p1*.f_age = FBreed then
  173.             /*
  174.              * it's giving birth to a new fish at old position.
  175.              */
  176.             p1*.f_age := 0;
  177.             p*.f_flags := p*.f_flags | NEWFISH;
  178.             p*.f_age := CRT_Random((FBreed + 1) / 2);
  179.             NFish := NFish + 1;
  180.             fi;
  181.         else
  182.             p*.f_flags := p*.f_flags | NEWFISH;
  183.         fi;
  184.         fi;
  185.         p := p + sizeof(CELL);
  186.     od;
  187.     od;
  188. corp;
  189.  
  190. /*
  191.  * updateSharks - update and regenerate the sharks and eat the fish.
  192.  */
  193.  
  194. proc nonrec updateSharks()void:
  195.     *CELL p, p1;
  196.     ushort l, c;
  197.     bool moved;
  198.  
  199.     p := &Ocean[0, 0];
  200.     for l from 0 upto NLINES - 1 do
  201.     for c from 0 upto NCOLUMNS - 1 do
  202.         if p*.f_flags & SHARK ~= 0x00 then
  203.         moved := false;
  204.         p1 := p;
  205.         if findCell(NEWFISH|NEWSHARK|SHARK, NEWFISH, &p1, l, c) then
  206.             /*
  207.              * this shark is eating a fish.
  208.              */
  209.             p1*.f_flags := p1*.f_flags | NEWSHARK;
  210.             p1*.s_eat := 0;
  211.             NFish := NFish - 1;
  212.             moved := true;
  213.         else
  214.             p*.s_eat := p*.s_eat + 1;
  215.             if p*.s_eat = Starve then
  216.             /*
  217.              * this shark has starved to death
  218.              */
  219.             NSharks := NSharks - 1;
  220.             else
  221.             if findCell(FISH|NEWSHARK|SHARK,FISH, &p1, l, c) or
  222.                 findCell(NEWSHARK|SHARK,0x00, &p1, l, c) then
  223.                 /*
  224.                  * shark will chase a fish if one WAS nearby,
  225.                  * otherwise it just wanders.
  226.                  */
  227.                 p1*.f_flags := p1*.f_flags | NEWSHARK;
  228.                 p1*.s_eat := p*.s_eat;
  229.                 moved := true;
  230.             else
  231.                 p*.f_flags := p*.f_flags | NEWSHARK;
  232.                 if p*.f_flags & NEWFISH ~= 0x00 then
  233.                 /*
  234.                  * poor fish swam right to him!
  235.                  */
  236.                 p*.s_eat := 0;
  237.                 NFish := NFish - 1;
  238.                 fi;
  239.             fi;
  240.             fi;
  241.         fi;
  242.         if moved then
  243.             p1*.s_age := p*.s_age + 1;
  244.             if p1*.s_age = SBreed then
  245.             /*
  246.              * it's giving birth to a new shark at old position.
  247.              */
  248.             p1*.s_age := 0;
  249.             if p*.f_flags & NEWFISH ~= 0x00 then
  250.                 /*
  251.                  * unlucky fish there is eaten by newborn!
  252.                  */
  253.                 NFish := NFish - 1;
  254.             fi;
  255.             p*.f_flags := p*.f_flags | NEWSHARK;
  256.             p*.s_age := CRT_Random((SBreed + 1) / 2);
  257.             p*.s_eat := 0;
  258.             NSharks := NSharks + 1;
  259.             fi;
  260.         fi;
  261.         fi;
  262.         p := p + sizeof(CELL);
  263.     od;
  264.     od;
  265. corp;
  266.  
  267. /*
  268.  * updateDisplay - redraw the changes to the screen and reset Ocean.
  269.  */
  270.  
  271. proc nonrec updateDisplay()void:
  272.     *CELL p;
  273.     ushort l, c;
  274.     byte b;
  275.  
  276.     p := &Ocean[0, 0];
  277.     for l from 0 upto NLINES - 1 do
  278.     for c from 0 upto NCOLUMNS - 1 do
  279.         b := p*.f_flags;
  280.         if b & NEWSHARK ~= 0x00 then
  281.         if b & SHARK = 0x00 then
  282.             CRT_Move(l, c);
  283.             CRT_PutChar('0');
  284.         fi;
  285.         p*.f_flags := SHARK;
  286.         elif b & NEWFISH ~= 0x00 then
  287.         if b & FISH = 0x00 then
  288.             CRT_Move(l, c);
  289.             CRT_PutChar('.');
  290.         fi;
  291.         p*.f_flags := FISH;
  292.         elif b ~= 0x00 then
  293.         CRT_Move(l, c);
  294.         CRT_PutChar(' ');
  295.         p*.f_flags := 0x00;
  296.         fi;
  297.         p := p + sizeof(CELL);
  298.     od;
  299.     od;
  300.     Time := Time + 1;
  301.     CRT_Move(NLINES, NSHARKSCOLUMN);
  302.     write(CRTOut; NSharks : 4);
  303.     CRT_Move(NLINES, NFISHCOLUMN);
  304.     write(CRTOut; NFish : 4);
  305.     CRT_Move(NLINES, TIMECOLUMN);
  306.     write(CRTOut; Time : 5);
  307.     if Logging then
  308.     writeln(LogOut; NSharks, ' ', NFish);
  309.     fi;
  310. corp;
  311.  
  312. /*
  313.  * readNumber - read a number in CRT mode from the status line.
  314.  */
  315.  
  316. proc nonrec readNumber(ushort c, digits)word:
  317.     *char p;
  318.     word n;
  319.     [6] char buffer;
  320.  
  321.     while
  322.     CRT_Move(NLINES, c);
  323.     for n from 1 upto digits do
  324.         CRT_PutChar(' ');
  325.     od;
  326.     CRT_Move(NLINES, c);
  327.     CRT_GetLine(&buffer[0], digits + 1);
  328.     p := &buffer[0];
  329.     while p* = ' ' do
  330.         p := p + 1;
  331.     od;
  332.     if p* = '\e' then
  333.         true
  334.     else
  335.         n := 0;
  336.         while p* >= '0' and p* <= '9' do
  337.         n := n * 10 + (p* - '0');
  338.         p := p + 1;
  339.         od;
  340.         p* ~= '\e' or n = 0
  341.     fi
  342.     do
  343.     beep();        /* beep to indicate error */
  344.     od;
  345.     CRT_Move(NLINES, c);
  346.     write(CRTOut; n : (digits));
  347.     n
  348. corp;
  349.  
  350. /*
  351.  * getParameters - read in the five operating parameters.
  352.  */
  353.  
  354. proc nonrec getParameters()void:
  355.  
  356.     CRT_Move(NLINES, 0);
  357.     CRT_PutChars("NSharks:");
  358.     NSharks := readNumber(NSHARKSCOLUMN, 4);
  359.     CRT_Move(NLINES, NSHARKSCOLUMN + 6);
  360.     CRT_PutChars("NFish:");
  361.     NFish := readNumber(NFISHCOLUMN, 4);
  362.     CRT_Move(NLINES, NFISHCOLUMN + 6);
  363.     CRT_PutChars("Time:     0  SBreed:");
  364.     SBreed := readNumber(SBREEDCOLUMN, 2);
  365.     CRT_Move(NLINES, SBREEDCOLUMN + 4);
  366.     CRT_PutChars("FBreed:");
  367.     FBreed := readNumber(FBREEDCOLUMN, 2);
  368.     CRT_Move(NLINES, FBREEDCOLUMN + 4);
  369.     CRT_PutChars("Starve:");
  370.     Starve := readNumber(STARVECOLUMN, 2);
  371. corp;
  372.  
  373. /*
  374.  * initializeOcean - initialize the populations and Ocean.
  375.  *             Note: if NFish and/or NSharks are too large, this
  376.  *             routine will go into an infinite loop.
  377.  */
  378.  
  379. proc nonrec initializeOcean()void:
  380.     *CELL p;
  381.     word i;
  382.     ushort l, c;
  383.  
  384.     for i from 1 upto NFish do
  385.     while
  386.         l := CRT_Random(NLINES);
  387.         c := CRT_Random(NCOLUMNS);
  388.         p := &Ocean[l, c];
  389.         p*.f_flags ~= 0x00
  390.     do
  391.     od;
  392.     p*.f_flags := FISH;
  393.     p*.f_age := CRT_Random(FBreed);
  394.     CRT_Move(l, c);
  395.     CRT_PutChar('.');
  396.     od;
  397.     for i from 1 upto NSharks do
  398.     while
  399.         l := CRT_Random(NLINES);
  400.         c := CRT_Random(NCOLUMNS);
  401.         p := &Ocean[l, c];
  402.         p*.f_flags ~= 0x00
  403.     do
  404.     od;
  405.     p*.f_flags := SHARK;
  406.     p*.s_age := CRT_Random(SBreed);
  407.     p*.s_eat := CRT_Random(Starve);
  408.     CRT_Move(l, c);
  409.     CRT_PutChar('0');
  410.     od;
  411. corp;
  412.  
  413. /*
  414.  * restoreOcean - restore the state from a file and write screen.
  415.  */
  416.  
  417. proc nonrec restoreOcean()void:
  418.     *CELL p;
  419.     word i;
  420.  
  421.     CRT_ClearScreen();
  422.     p := &Ocean[0, 0];
  423.     for i from 0 upto NLINES * NCOLUMNS - 1 do
  424.     CRT_PutChar(
  425.         if p*.f_flags & SHARK ~= 0x00 then
  426.         '0'
  427.         elif p*.f_flags & FISH ~= 0x00 then
  428.         '.'
  429.         else
  430.         ' '
  431.         fi
  432.     );
  433.     p := p + sizeof(CELL);
  434.     od;
  435.     write(CRTOut;
  436.     "NSharks: ", NSharks : 4,
  437.     "  NFish: ", NFish : 4,
  438.     "  Time: ", Time : 5,
  439.     "  SBreed: ", SBreed : 2,
  440.     "  FBreed: ", FBreed : 2,
  441.     "  Starve: ", Starve : 2
  442.     );
  443. corp;
  444.  
  445. /*
  446.  * main - main program - handles setup, restore, save and running.
  447.  */
  448.  
  449. proc nonrec main()void:
  450.     FILENAME fn;
  451.     [15] char buffer;
  452.     *char p;
  453.     channel input binary restore;
  454.     channel output binary save;
  455.  
  456.     Logging := false;
  457.     open(CRTOut, CRT_PutChar);
  458.     p := GetPar();
  459.     if p ~= nil and p* = '-' then
  460.     case (p + 1)*
  461.     incase 'L':
  462.         Logging := true;
  463.     default:
  464.         writeln("*** Invalid flag '", (p + 1)*, "' - aborting. ***");
  465.         exit(1);
  466.     esac;
  467.     p := GetPar();
  468.     fi;
  469.     if p = nil then
  470.     /*
  471.      * start a new run.
  472.      */
  473.     initialize();
  474.     getParameters();
  475.     initializeOcean();
  476.     else
  477.     /*
  478.      * restore a run from a save file.
  479.      */
  480.     SetFileName(fn, p);
  481.     if fn.fn_type[0] = ' ' then
  482.         fn.fn_type[0] := 'W';
  483.         fn.fn_type[1] := 'A';
  484.         fn.fn_type[2] := 'T';
  485.     fi;
  486.     GetFileName(fn, &buffer[0]);
  487.     if not open(restore, File, &buffer[0]) then
  488.         writeln("*** Can't open restore file ",
  489.             &buffer[0], " - aborting. ***");
  490.         exit(1);
  491.     fi;
  492.     read(restore; NFish, NSharks, SBreed, FBreed, Starve, Ocean, Time);
  493.     close(restore);
  494.     restoreOcean();
  495.     fi;
  496.     if Logging then
  497.     SetFileName(fn, "WATOR.LOG");
  498.     pretend(FileDestroy(fn), void);
  499.     if not FileCreate(fn) then
  500.         writeln("*** Can't create log file WATOR.LOG - aborting. ***");
  501.         exit(1);
  502.     fi;
  503.     open(LogOut, File, "WATOR.LOG");
  504.     writeln(LogOut; NSharks, ' ', NFish);
  505.     fi;
  506.     while (NFish ~= 0 or NSharks ~= 0) and CRT_GetChar() = '\e' do
  507.     updateFish();
  508.     updateSharks();
  509.     updateDisplay();
  510.     od;
  511.     if Logging then
  512.     close(LogOut);
  513.     fi;
  514.     while
  515.     CRT_ClearLine(NLINES);
  516.     CRT_PutChars("File to save to (<CR> to abandon run): ");
  517.     CRT_GetLine(&buffer[0], 15);
  518.     p := &buffer[0];
  519.     while p* = ' ' do
  520.         p := p + 1;
  521.     od;
  522.     CRT_ClearLine(NLINES - 1);
  523.     if p* = '\e' then
  524.         CRT_PutChars("Run abandoned.");
  525.         false
  526.     else
  527.         SetFileName(fn, p);
  528.         if fn.fn_type[0] = ' ' then
  529.         fn.fn_type[0] := 'W';
  530.         fn.fn_type[1] := 'A';
  531.         fn.fn_type[2] := 'T';
  532.         fi;
  533.         GetFileName(fn, &buffer[0]);
  534.         pretend(FileDestroy(fn), void);
  535.         if FileCreate(fn) then
  536.         open(save, File, &buffer[0]);
  537.         write(save; NFish, NSharks, SBreed, FBreed, Starve,
  538.                 Ocean, Time);
  539.         close(save);
  540.         CRT_PutChars("Run saved.");
  541.         false
  542.         else
  543.         write(CRTOut; "*** Can't create save file ",
  544.                   &buffer[0], ". ***");
  545.         true
  546.         fi
  547.     fi
  548.     do
  549.     od;
  550.     CRT_ClearLine(NLINES);
  551.     CRT_Move(NLINES - 1, 0);
  552. corp;
  553.