home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / TURBOPAS / CELLAUTO.LBR / CELLAUTO.PZS / CELLAUTO.PAS
Pascal/Delphi Source File  |  2000-06-30  |  4KB  |  184 lines
  1.  
  2. (*** Beginning of file CELLAUTO.PAS ***)
  3. (*** Version 1.0   12/11/86 ***)
  4. (*** Written in Turbo Pascal by Gary Johnson ***)
  5.  
  6. {C-,R+,U-,X+}
  7.  
  8. CONST
  9.      yes = TRUE;
  10.      no  = FALSE;
  11.      textxmin =  1;
  12.      textxmax = 39;
  13.      cvmin =  0;
  14.      cvmax = 10;
  15.  
  16. VAR
  17.    endofcellauto : BOOLEAN;
  18.    cd : ARRAY [cvmin..cvmax] OF CHAR;
  19.    cv : ARRAY [cvmin..cvmax] OF INTEGER;
  20.    ca : ARRAY [textxmin..textxmax] OF INTEGER;
  21.  
  22. PROCEDURE Bleed_Keypress;
  23. VAR
  24.    press : CHAR;
  25. BEGIN
  26.      WHILE (KEYPRESSED = yes) DO READ (KBD,press);
  27. END;
  28.  
  29. PROCEDURE Stall_Keypress;
  30. VAR
  31.    press : CHAR;
  32. BEGIN
  33.      Bleed_Keypress;
  34.      READ (KBD,press);
  35. END;
  36.  
  37. PROCEDURE Initialize_Cellular_Automata_Arrays;
  38. VAR
  39.    l, middle : INTEGER;
  40. BEGIN
  41.      FOR l := cvmin TO cvmax DO cd[l] := CHR(RANDOM(16) + 32);
  42.      FOR l := cvmin TO cvmax DO cv[l] := RANDOM(cvmax);
  43.      FOR l := textxmin TO textxmax DO ca[l] := 0;
  44.      cd[0] := ' ';
  45.      cv[cvmin] := 0;
  46.      cv[(cvmin + 1)] := 1;
  47.      middle := textxmax DIV 2;
  48.      IF ((textxmax MOD middle) = 0) THEN
  49.      BEGIN
  50.           ca[middle] := 1;
  51.      END;
  52.      ca[(middle + 1)] := 1;
  53. END;
  54.  
  55. PROCEDURE Plot_Cellular_Automata_Array;
  56. VAR
  57.    x : INTEGER;
  58. BEGIN
  59.      FOR x := textxmin TO textxmax DO
  60.      BEGIN
  61.           WRITE (cd[ca[x]]);
  62.      END;
  63.      WRITELN;
  64. END;
  65.  
  66. PROCEDURE Process_Keypress;
  67. VAR
  68.    press : CHAR;
  69. BEGIN
  70.      READ (KBD,press);
  71.      press := UPCASE(press);
  72.      IF (press <> ' ') THEN endofcellauto := yes;
  73.      IF (press = ' ') THEN READ (KBD,press);
  74. END;
  75.  
  76. PROCEDURE Display_Instructions;
  77. BEGIN
  78.      WRITELN;
  79.      WRITELN;
  80.      WRITELN;
  81.      WRITELN;
  82.      WRITELN('Press the space bar to freeze the display.');
  83.      WRITELN('Press any other key to exit the current automata.');
  84.      WRITELN;
  85.      WRITE('Press any key to continue : ');
  86.      Stall_Keypress;
  87.      WRITELN;
  88.      WRITELN;
  89.      WRITELN;
  90. END;
  91.  
  92. PROCEDURE Create_Cellular_Automata;
  93. VAR
  94.    a, b, c, abc : INTEGER;
  95.    x, y : INTEGER;
  96. BEGIN
  97.      Display_Instructions;
  98.      endofcellauto := no;
  99.      WHILE (endofcellauto = no) DO
  100.      BEGIN
  101.           Plot_Cellular_Automata_Array;
  102.           a := 0;
  103.           b := ca[textxmin];
  104.           c := ca[(textxmin + 1)];
  105.           endofcellauto := yes;
  106.           FOR x := (textxmin + 1) TO (textxmax - 1) DO
  107.           BEGIN
  108.                a := b;
  109.                b := c;
  110.                c := ca[(x + 1)];
  111.                abc := a + b + c;
  112.                IF (abc > cvmax) THEN abc := cvmin;
  113.                IF (abc < cvmin) THEN abc := cvmin;
  114.                IF (ca[x] <> cv[abc]) THEN
  115.                BEGIN
  116.                     ca[x] := cv[abc];
  117.                     endofcellauto := no;
  118.                END;
  119.           END;
  120.           IF (KEYPRESSED = yes) THEN Process_Keypress;
  121.      END;
  122.      WRITELN;
  123. END;
  124.  
  125. PROCEDURE Cellular_Automata;
  126. BEGIN
  127.      RANDOMIZE;
  128.      Initialize_Cellular_Automata_Arrays;
  129.      Create_Cellular_Automata;
  130. END;
  131.  
  132. PROCEDURE Continue_Here;
  133. VAR
  134.    press : CHAR;
  135. BEGIN
  136.      Cellular_Automata;
  137.      WRITELN;
  138.      WRITE ('Press 1 to run CELLAUTO again, ');
  139.      WRITE ('9 to exit to the operating system : ');
  140.      Bleed_Keypress;
  141.      REPEAT
  142.           READ (KBD,press);
  143.      UNTIL (press IN ['1','9']);
  144.      IF (press = '1') THEN Continue_Here;
  145. END;
  146.  
  147. PROCEDURE Start_Here;
  148. VAR
  149.    press : CHAR;
  150. BEGIN
  151.      WRITELN;
  152.      WRITELN('Version 1.0 of program : CELLAUTO');
  153.      WRITELN('');
  154.      WRITELN('This particular CELLAUTO.COM runs on Z80 CP/M 80 computers.');
  155.      WRITELN('');
  156.      WRITELN('This program plots cellular automata.');
  157.      WRITELN('');
  158.      WRITELN('Written in Turbo Pascal by Gary Johnson.');
  159.      WRITELN('');
  160.      WRITELN('CELLAUTO is in the public domain. It may not be sold.');
  161.      WRITELN('');
  162.      WRITELN('');
  163.      WRITELN('');
  164.      WRITE ('Press 1 to run CELLAUTO, ');
  165.      WRITE ('9 to exit to the operating system : ');
  166.      Bleed_Keypress;
  167.      REPEAT
  168.           READ (KBD,press);
  169.      UNTIL (press IN ['1','9']);
  170.      IF (press = '1') THEN
  171.      BEGIN
  172.           Continue_Here;
  173.      END;
  174.      Bleed_Keypress;
  175. END;
  176.  
  177. BEGIN
  178.      Start_Here;
  179. END.
  180.  
  181. (*** Ending of program CELLAUTO.PAS ***)
  182. (*** Version 1.0   12/11/86 ***)
  183. (*** Written in Turbo Pascal by Gary Johnson ***)
  184.