program corelife;

uses crt,graph3;

const
  max = 1600;
  min = 8;

type
  code = 0..15;
  len = 1..max;

var
  core:array [1..max,1..min] of code;
  x:len;
  ch:char;
  i,n,g,h,cc:integer;
  f:file of code;
  blah:string;
  
  procedure drawit;
  var xx,yy,e,col:integer;
  begin
    fillscreen(0);
    for x := 1 to max do
    begin
      g := 0;
      for i:=1 to min do
      begin
        if core[x,i]>15 then core[x,i] := 15;
        if core[x,i]<0 then core[x,i] := 0;
      end;
      xx := x;
      yy := 1;
      while xx>80 do
      begin
        yy := yy + 1;
        xx := xx - 80;
      end;
      xx := xx*4;
      yy := yy*(min-1);
      col := core[x,min];
      for i:=0 to min - 2 do
      begin
        e := core[x,i+1];
        if e>0 then begin
        if e >= 8 then begin plot(xx,yy+i,col); e := e - 8; end;
        if e >= 4 then begin plot(xx+1,yy+i,col); e := e - 4; end;
        if e >= 2 then begin plot(xx+2,yy+i,col); e := e - 2; end;
        if e >= 1 then plot(xx+3,yy+i,col);
        end;
      end;
    end;
  end;

  function xxx(xx:integer):integer;
  begin
    {while xx>80 do
    begin
      xx := xx - 80;
    end;}
    xxx := xx;
  end;

  procedure saveit;
  var  
    i,j:integer;
  begin
    assign(f,'core.dat');
    rewrite(f);
    for i:=1 to max do
      for j:=1 to min do
        write(f,core[i,j]);
    close(f);
  end;
  
  procedure loadit;
  var  
    i,j:integer;
  begin
    assign(f,'core.dat');
    reset(f);
    for i:=1 to max do
      for j:=1 to min do
        read(f,core[i,j]);
    close(f);
  end;



  procedure noth;
  begin
  {  write('not ');}
  end;

  procedure mov_fd;
  begin
    {write('mov_fd ');}
    if xxx(x)<80 then
    begin
      for i:= 1 to min do
      begin
        core[x+1,i] := core[x,i];
        core[x,i] := 0;
      end;
      core[x,min] := 3;
      x := x + 1;
    end;
  end;

  procedure mov_bk;
  begin
    {write('mov_bk ');}
    if xxx(x)>1 then
    begin
      for i:= 1 to min do
      begin
        core[x-1,i] := core[x,i];
        core[x,i] := 0;
      end;
      core[x,min] := 3;
      x := x - 1;
    end;
  end;
  
  procedure mul_fd;
  begin
    {write('mul_fd ');}
    if (x<max) and (xxx(x)<80) then
    begin
      for i:= 1 to min-1 do
      begin
        core[x+1,i] := core[x,i];
      end;
      core[x+1,min] := core[x,min];
    end;
  end;

  procedure mul_bk;
  begin
    {write('mul_bk ');}
    if (x>1) and (xxx(x)>1) then
    begin
      for i:= 1 to min-1 do
      begin
        core[x-1,i] := core[x,i];
      end;
      core[x-1,min] := core[x,min];
    end;
  end;

  procedure setup;
  begin
    clrscr;
    randomize;
    for x:=1 to max do
    begin
      for i:=1 to min-1 do
        core[x,i] := 0;
      core[x,min] := 3;
    end;
    writeln('1:mov_fd 2:mov_bk 3:mov_up 4:mov_dn 5:mul_fd 6:mul_bk 7:mul_up 8:mul_dn');
    writeln('9:kil_fd 10:kil_bk 11:kil_up 12:kil_dn 13:jump 14:swap 15:mut');
    writeln('Enter #1');
    for i:=1 to min-1 do readln(core[81,i]);
    writeln('Enter #2');
    for i:=1 to min-1 do readln(core[max-81,i]);
    core[max-81,min] := 2;
    core[81,min] := 1;
  end;

  procedure mov_up;
  begin
    if x>80 then
    begin
      for i:= 1 to min do
      begin
        core[x-80,i] := core[x,i];
        core[x,i] := 0;
      end;
      x := x - 80;
    end;
  end;

  procedure mov_dn;
  begin
    if x<(max - 80) then
    begin
      for i:= 1 to min do
      begin
        core[x+80,i] := core[x,i];
        core[x,i] := 0;
      end;
      x := x+80;
    end;
  end;
  
  procedure mul_dn;
  begin
    if x<(max - 80) then
    begin
      for i:= 1 to min-1 do
      begin
        core[x+80,i] := core[x+80,i] or core[x,i];
      end;
      core[x+80,min] := core[x,min];
    end;
  end;

  procedure mul_up;
  begin
    if x>80 then
    begin
      for i:= 1 to min-1 do
      begin
        core[x-80,i] := core[x,i];
      end;
     core[x-80,min] := core[x,min];
    end;
  end; 

  procedure kil_fd;
  begin
    {write('mul_fd ');}
    if (x<max) and (xxx(x)<80) then
    begin
      for i:= 1 to min-1 do
      begin
        core[x+1,i] := 0;
      end;
      core[x+1,min] := core[x,min];
    end;
  end;

  procedure kil_bk;
  begin
    {write('mul_bk ');}
    if (x>1) and (xxx(x)>1) then
    begin
      for i:= 1 to min-1 do
      begin
        core[x-1,i] := 0;
      end;
      core[x-1,min] := core[x,min];
    end;
  end;

  procedure kil_up;
  begin
    if x>80 then
    begin
      for i:= 1 to min-1 do
      begin
        core[x-80,i] := 0;
      end;
     core[x-80,min] := core[x,min];
    end;
  end; 

  procedure kil_dn;
  begin
    if x<(max - 80) then
    begin
      for i:= 1 to min-1 do
      begin
        core[x+80,i] := 0;
      end;
      core[x+80,min] := core[x,min];
    end;
  end;

  procedure explode;
  begin
    kil_up;
    kil_dn;
    kil_fd;
    kil_bk;
    for i:=1 to min-1 do core[x,i] := 0;
  end;

  procedure swap;
  var
    cod:code;
  begin
    cod := core[x,1];
    core[x,1] := core[x,min-1];
    core[x,min-1] := cod;
  end;

  procedure mut;
  begin  
    i := random(min-1)+1;
    core[x,i] := random(15);
    if i=min then core[x,i] := random(3)+1;
  end;

  procedure jump;
  var
    zzz:len;
  begin
    zzz := random(4);
    case zzz of
      0 : mov_up;
      1 : mov_dn;
      3 : mov_fd;
      4 : mov_bk;
    end;
    case zzz of
      0 : mov_up;
      1 : mov_dn;
      3 : mov_fd;
      4 : mov_bk;
    end;
  end; 

  procedure doit;
  begin
    case core[x,n] of
      1 : mov_fd;
      2 : mov_bk;
      3 : mul_fd;
      4 : mul_bk;
      5 : mov_up;
      6 : mov_dn;
      7 : mul_up;
      8 : mul_dn;
      9 : kil_fd;
      10 : kil_bk;
      11 : kil_up;
      12 : kil_dn;
      13 : jump;
      14 : swap;
      15 : mut;
    end;
  end;

begin
  setup;
  cc := -1;
  x := 1;
  graphcolormode;
  clrscr;
  drawit;
  h := 0;
  repeat begin
  for n := 1 to min do
    doit;
  h := h+1;
  x := x + 1;
  if h>=max then
  begin
    for h:=1 to 5 do
    begin
      x := random(max)+1;
     {mut;}
    end;
    h := 0;
    drawit;
  end;
  x := random(max)+1;
  end;
  until keypressed;
  textmode(4);
end.