program Colorama;

{
adapted from Gary Johnson's CELLAUTO by Jim Lill, 12/15/86
for use with Apple //e with PCPI card.
}

{$i pcpistuf.inc}

{C-,R+,U-,X+}

CONST
     yes = TRUE;
     no  = FALSE;
     textxmin =  1;
     textxmax = 39;
     cvmin =  0;
     cvmax = 10;

VAR
   endofcellauto : BOOLEAN;
   cd : ARRAY [cvmin..cvmax] OF CHAR;
   cv : ARRAY [cvmin..cvmax] OF INTEGER;
   ca : ARRAY [textxmin..textxmax] OF INTEGER;

{***********************************************************************}

procedure lores;

{turn on apple low res graphics}

begin
  pokeapple($C050,0)
end;

{***********************************************}

procedure text;

{enable apple text mode}

begin
  pokeapple($C051,0)
end;

{**********************************************************************}

PROCEDURE Bleed_Keypress;
VAR
   press : CHAR;
BEGIN
     WHILE (KEYPRESSED = yes) DO READ (KBD,press);
END;

PROCEDURE Stall_Keypress;
VAR
   press : CHAR;
BEGIN
     Bleed_Keypress;
     READ (KBD,press);
END;

PROCEDURE Initialize_Cellular_Automata_Arrays;
VAR
   l, middle : INTEGER;
BEGIN
     FOR l := cvmin TO cvmax DO cd[l] := CHR(random(16) + 32);
     FOR l := cvmin TO cvmax DO cv[l] := RANDOM(cvmax);
     FOR l := textxmin TO textxmax DO ca[l] := 0;
     cd[0] := ' ';
     cv[cvmin] := 0;
     cv[(cvmin + 1)] := 1;
     middle := textxmax DIV 2;
     IF ((textxmax MOD middle) = 0) THEN
     BEGIN
          ca[middle] := 1;
     END;
     ca[(middle + 1)] := 1;
END;

PROCEDURE Plot_Cellular_Automata_Array;
VAR
   x : INTEGER;
BEGIN
     FOR x := textxmin TO textxmax DO
     BEGIN
          lores;
          WRITE (cd[ca[x]]);
     END;
     WRITELN
END;

PROCEDURE Process_Keypress;
VAR
   press : CHAR;
BEGIN
     READ (KBD,press);
     press := UPCASE(press);
     IF (press <> ' ') THEN endofcellauto := yes;
     IF (press = ' ') THEN READ (KBD,press);
END;

PROCEDURE Display_Instructions;
BEGIN
     clrscr;
     text;                             {make sure were in text}
     WRITELN;
     WRITELN;
     WRITELN;
     WRITELN;
     WRITELN('Press the space bar to freeze the display.');
     WRITELN('Press any other key to exit the current automata.');
     WRITELN;
     WRITE('Press any key to continue : ');
     Stall_Keypress;
     WRITELN;
     WRITELN;
     WRITELN;
END;

PROCEDURE Create_Cellular_Automata;
VAR
   a, b, c, abc : INTEGER;
   x, y : INTEGER;
BEGIN
     Display_Instructions;
     clrscr;
     endofcellauto := no;
     WHILE (endofcellauto = no) DO
     BEGIN
          Plot_Cellular_Automata_Array;
          a := 0;
          b := ca[textxmin];
          c := ca[(textxmin + 1)];
          endofcellauto := yes;
          FOR x := (textxmin + 1) TO (textxmax - 1) DO
          BEGIN
               a := b;
               b := c;
               c := ca[(x + 1)];
               abc := a + b + c;
               IF (abc > cvmax) THEN abc := cvmin;
               IF (abc < cvmin) THEN abc := cvmin;
               IF (ca[x] <> cv[abc]) THEN
               BEGIN
                    ca[x] := cv[abc];
                    endofcellauto := no;
               END;
          END;
          IF (KEYPRESSED = yes) THEN Process_Keypress;
     END;
     WRITELN;
END;

PROCEDURE Cellular_Automata;
BEGIN
     RANDOMIZE;
     Initialize_Cellular_Automata_Arrays;
     Create_Cellular_Automata;
END;

PROCEDURE Continue_Here;
VAR
   press : CHAR;
BEGIN
     Cellular_Automata;
     clrscr;
     text;                          {make sure we're in text}
     WRITELN;
     WRITE ('Press 1 to run CELLAUTO again, ');
     WRITE ('9 to exit to the operating system : ');
     Bleed_Keypress;
     REPEAT
          READ (KBD,press);
     UNTIL (press IN ['1','9']);
     IF (press = '1') THEN Continue_Here;
END;

PROCEDURE Start_Here;
VAR
   press : CHAR;
BEGIN
     clrscr;
     text;                           {make sure we're in text}
     WRITELN;
     WRITE ('Press 1 to run COLORAMA, ');
     WRITE ('9 to exit to the operating system : ');
     Bleed_Keypress;
     REPEAT
          READ (KBD,press);
     UNTIL (press IN ['1','9']);
     IF (press = '1') THEN
     BEGIN
          Continue_Here;
     END;
     Bleed_Keypress;
END;

BEGIN
     Start_Here;
END.