program Snake(input,output);
(*

Direkte Umsetzung von BASIC in TURBO-PASCAL

*)
const
  BASIC        = 100;                   (* BASIC Geschwindigkeitsdrosselung *)
  nul          = #0;
  cls_s        = #27'E'#27'H';
  lft_s        = #1;
  rht_s        = #6;
  up_s         = #31;
  dwn_s        = #30;
var
  run,
  play,
  v150         : boolean;
  a_s          : char;
  score,
  ds,
  di,
  ps,
  x,
  y,
  hs,
  hz           : integer;
  pg           : real;
  area         : array[0..80,0..27] of integer;

function INKEY_s:char;
var
  c            : char;
Begin
  delay(BASIC);                 (* Langsamer fuer BASIC *)
  if keypressed then read(kbd,c)
                else c:=nul;
  INKEY_s:=c;
End;

procedure l390;
var
  w            : integer;
Begin
  write(#27,'Y',chr(32+y),chr(32+x));
  for w:=1 to ps*BASIC do ;     (* Langsamer fuer BASIC *)
  for w:=1 to ps*BASIC do ;     (* Langsamer fuer BASIC *)
End;

procedure l2000;
var
  a_s          : char;
  a            : integer;
Begin
  write(cls_s);
  for a:=1 to 7 do writeln;
  write('                      WHAT LEVEL OF DIFFICULTY (1-9) ?');
  repeat
    repeat until keypressed;
    read(kbd,a_s);
  until a_s in ['0'..'9'];
  a:=ord(a_s)-ord('0');
  a:=10-a;
  ps:=((a-1)*50)+1;
  write(cls_s);
End;

procedure l70;
var
  x1,
  y1           : integer;

  procedure Rahmen(c1,c2,c3:char);
  begin
    write(c1);
    for y1:=1 to 80 do
        write(c2);
    write(c3);
    writeln;
  end;

Begin (* l70 *)
  for x1:=0 to 80 do
      for y1:=0 to 27 do area[x1,y1]:=0;
  Rahmen(#134,#138,#140);
  for x1:=1 to 25 do
      Rahmen(#133, ' ',#133);
  Rahmen(#131,#138,#137);
  x:=trunc(random*21+30);
  y:=trunc(random* 6+10);
  l390;
  write(#187);
  area[x,y]:=1;
  score:=1;
  x1:=x;
  y1:=y;
  x:=0;
  y:=28;
  l390;
  write('Score =    1');
  x:=x1;
  y:=y1;
  l390;
  di:=trunc(random*4+1);
End;

procedure l150;
Begin
  if v150 then
  begin
    a_s:=INKEY_s;
    if a_s=nul then pg:=random
    else
    begin
      ds:=0;
      case a_s of
        lft_s : di:=4;
        rht_s : di:=2;
        up_s  : di:=1;
        dwn_s : di:=3;
      end;
    end;
  end else v150:=true;
End;

procedure l1000;
var
  w            : integer;
Begin
  for w:=1 to ps*hz*BASIC do ;     (* Langsamer fuer BASIC *)
End;

procedure l360;
var
  x1,
  y1           : integer;
Begin
  x1:=x;
  y1:=y;
  repeat
    x:=trunc(random*80)+1;
    y:=trunc(random*25)+1;
  until area[x,y]=0;
  area[x,y]:=1;
  l390;
  write(#27#3);
  x:=x1;
  y:=y1;
End;

procedure l220;
var
  x1,
  y1           : integer;
Begin
  run:=area[x,y]=0;
  if run then
  begin
    score:=score+1;
    if (score MOD 25)=0 then l360;
    if score>600 then hz:=0;
    x1:=x;
    y1:=y;
    x:=8;
    y:=28;
    if ds=1 then
    begin
      l1000;
      l390;
      write(score:4);
    end;
    x:=x1;
    y:=y1;
    l390;
    write(#187);
    area[x,y]:=1;
  end;
End;

function checkxy:boolean;
Begin
  checkxy:=(x in [1..80]) and (y in [2..26]);
End;

procedure l290;
var
  th,
  i,
  j            : integer;
Begin
  th:=1;
  for i:=1 to 11 do
  begin
    th:=1-th;
    l390;
    write(chr(188-th));
    for j:=1 to 100 do;
  end;
  if score>hs then
  begin
    hs:=score;
    x:=13;
    y:=28;
    l390;
    write('- a new high score!');
  end;
  x:=0;
  y:=29;
  l390;
  write('You Crashed! Another game (y/n)?');
  repeat
    repeat
      a_s:=INKEY_s;
      if a_s=nul then pg:=random;
    until a_s<>nul;
    a_s:=upcase(a_s);
    case a_s of
      'N' : begin
              x:=35;
              l390;
              write('No',#27'e');
            end;
      'Y' : l2000;
    end; 
  until a_s in ['Y','N'];
  play:=a_s='Y';
End;

BEGIN
  hs:=0;
  play:=true;
  v150:=false;
  hz:=50;
  randomize;
  l2000;
  write(#27'0'#27'f');
  write(cls_s);

  while play do
  begin
(* 70 *)
    l70;

    repeat
(* 150 *)
      l150;

(* 200 *)
      case di of
        1 : y:=y-1;
        2 : x:=x+1;
        3 : y:=y+1;
        4 : x:=x-1;
      end;
      if di=(1 or 3) then ds:=1;
      run:=checkxy;
      if run then l220;
    until not run;
(* 290 *)
    l290;
  end;
END.