program corelife;

uses crt,graph;

const
  wide = 160;
  max = 6880;
  min = 9;

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,gd,gm,z:integer;
  f:file of code;
  blah:string;
  wrap,radiation,back,fore,mutate:boolean;

  procedure drawit;
  var xx,yy,e,col:integer;
  begin
    cleardevice;
    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>wide do
      begin
        yy := yy + 1;
        xx := xx - wide;
      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 putpixel(xx,yy+i,col); e := e - 8; end;
        if e >= 4 then begin putpixel(xx+1,yy+i,col); e := e - 4; end;
        if e >= 2 then begin putpixel(xx+2,yy+i,col); e := e - 2; end;
        if e >= 1 then putpixel(xx+3,yy+i,col);
        end;
      end;
    end;
  end;

  function xxx(xx:integer):integer;
  begin
    if wrap = true then
    begin
      while xx>wide do
      begin
        xx := xx - wide;
      end;
    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)<wide 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)<wide) then
    begin
      for i:= 1 to min-1 do
        if random(20)>0 then core[x+1,i] := core[x,i] or core[x+1,i];
      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
        if random(20)>0 then core[x-1,i] := core[x,i] or core[x-1,i];
      end;
      core[x-1,min] := core[x,min];
    end;
  end;

  procedure setup;
  begin
    readln(randseed);
    for x:=1 to max do
    begin
      for i:=1 to min do
        core[x,i] := 0;
{      core[x,min] := random(5)+1;}
    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;}
    Gd := Detect;
    InitGraph(Gd, Gm, 'c:\tp\bgi');
    if GraphResult <> grOk then begin writeln('dead');Halt(1);end;
  end;

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

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

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

  procedure mul_up;
  begin
    if x>wide then
    begin
      for i:= 1 to min-1 do
      begin
        if random(20)>0 then core[x-wide,i] := core[x,i] or core[x-wide,i];
      end;
     core[x-wide,min] := core[x,min];
    end;
  end;

  procedure kil_fd;
  begin
    {write('mul_fd ');}
    if (x<max) and (xxx(x)<wide) 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>wide then
    begin
      for i:= 1 to min-1 do
      begin
        core[x-wide,i] := 0;
      end;
     core[x-wide,min] := core[x,min];
    end;
  end;

  procedure kil_dn;
  begin
    if x<(max - wide) then
    begin
      for i:= 1 to min-1 do
      begin
        core[x+wide,i] := 0;
      end;
      core[x+wide,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 cross;
  var
    cod:code;
    n:integer;
  begin
    n := random(max)+1;
    for i:=1 to min-1 do
      if random(2)=0 then
      begin
        cod := core[x,i];
        core[x,i] := core[n,i];
        core[n,i] := cod;
      end;
    core[n,min] := core[x,min];
  end;

  procedure mut(c:boolean);
  begin
    i := random(min-1)+1;
    core[x,i] := random(15);
    if c then core[x,min] := random(15)+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_up;
      10 : kil_dn;
      11 : cross;
      12 : if mutate then mut(fore);
      13 : jump;
      14 : swap;
      15 : explode;
    end;
  end;

  procedure whiteout;
  begin
    for i:=1 to max do
      core[i,min] := 15;
  end;

  procedure randout;
  begin
    for i:=1 to max do
      core[i,min] := i mod 14 + 1;
  end;

  function strs(a:integer):string;
  var
    s:string;
  begin
    str(a,s);
    strs := s;
  end;

begin
  radiation := true;
  back := true;
  fore := true;
  mutate := true;
  wrap := false;
  ch := ' ';
  z := 0;
  setup;
  cc := -1;
  x := 1;
  drawit;
  h := 0;
  repeat begin
  for n := 1 to min-1 do
    doit;
  h := h+1;
  x := x + 1;
  if h>=max*2 then
  begin
    for h:=1 to 5 do
    begin
      x := random(max)+1;
      if radiation then mut(back);
    end;
    h := 0;
    drawit;
    z := z + 1;
    outtextxy(50,400,'Year: '+strs(z*2));
    if keypressed then begin
      ch := readkey;
      case ch of
        'w':whiteout;
        'c':randout;
        'r':radiation := not radiation;
        'b':back := not back;
        'f':fore := not fore;
        'u':wrap := not wrap;
        'm':mutate := not mutate;
      end;
    end;
  end;
  x := random(max)+1;
  end;
  until ch ='q';
  closegraph;
end.