program Snake(input,output);
(*

Optimierte Umsetzung von BASIC in TURBO-PASCAL

*)
const
  BASIC        = 100;                   (* BASIC Geschwindigkeitsdrosselung *)
  nul          = #00;
  esc          = #27;
  lft          = ^A;                    (* Cursor links  *)
  rht          = ^F;                    (* Cursor rechts *)
  up           = ^_;                    (* Cursor rauf   *)
  dwn          = ^^;                    (* Cursor runter *)
  rauf         = 1;
  rechts       = 2;
  runter       = 3;
  links        = 4;
  ole          = #134;                  (* Obere linke Ecke    *)
  ore          = #140;                  (* Obere rechte Ecke   *)
  ule          = #131;                  (* Untere linke Ecke   *)
  ure          = #137;                  (* Untere rechte Ecke  *)
  wgr          = #138;                  (* Waagerechte Linie   *)
  snk          = #133;                  (* Senkrechte Linie    *)
  figur        = #187;                  (* Spielerfigur        *)
  blinker      = #188;                  (* Spielerfigur blinkt *)
  sperre       = #3;                    (* Sperre              *)
type
  feld         = (frei,besetzt);
var
  ds,
  Lauf,
  Spiel,
  Abfrage      : boolean;
  acs          : char;
  score,
  di,
  ps,
  x,
  y,
  hs,
  hz           : integer;
  pg           : real;
  cls          : string[4];
  area         : array[0..80,0..27] of feld;

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

procedure writectl(c:char);
(* Zeichen im Bereich 0..31 benoetigen beim JOYCE ESC vorweg *)
Begin
  if ord(c)<ord(' ') then write(esc);
  write(c);
End;

procedure CursorYX(r,c:integer);
(* Cursor positionieren *)
var
  w            : integer;
Begin
  write(esc,'Y',chr(32+r),chr(32+c));
  for w:=1 to ps*BASIC*2 do ;              (* Langsamer fuer BASIC *)
End;

procedure Schwierigkeitsstufe;
(* Schwierigkeitsstufe abfragen *)
var
  acs          : char;
  i            : integer;
Begin
  write(cls);
  for i:=1 to 7 do writeln;
  write('                    Welche Schwierigkeitsstufe (1-9) ?');
  repeat
    repeat until keypressed;
    read(kbd,acs);
  until acs in ['0'..'9'];
  ps:=succ(((9-ord(acs)+ord('0'))*50));
  write(cls);
End;

procedure Feldbesetzen;
(* Spieler ausgeben und Feld besetzen *)
Begin
  CursorYX(y,x);
  writectl(figur);
  area[x,y]:=besetzt;
End;

procedure Starteinstellung;
(* Programm initialisieren *)
var
  i,
  j            : integer;

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

Begin (* Starteinstellung *)
  for i:=0 to 80 do
      for j:=0 to 27 do area[i,j]:=frei;
  Rahmen(ole,wgr,ore);
  for i:=1 to 25 do
      Rahmen(snk, ' ',snk);
  Rahmen(ule,wgr,ure);
  x:=trunc(random*21+30);
  y:=trunc(random* 6+10);
  Feldbesetzen;
  score:=1;
  CursorYX(28,0);
  write('Stand =    1');
  CursorYX(y,x);
  di:=trunc(random*4+1);
End;

procedure Tastenbearbeiten;
(* Cursortasten umsetzen *)
Begin
  if Abfrage then
  begin
    acs:=INKEY;
    if acs=nul then pg:=random
    else
    begin
      ds:=false;
      case acs of
        lft : di:=links;
        rht : di:=rechts;
        up  : di:=rauf;
        dwn : di:=runter;
      end;
    end;
  end else Abfrage:=true;
End;

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

procedure Sperresetzen;
(* Sperre setzen *)
var
  x1,
  y1           : integer;
Begin
  repeat
    x1:=succ(trunc(random*80));
    y1:=succ(trunc(random*25));
  until area[x1,y1]=frei;
  area[x1,y1]:=besetzt;
  CursorYX(y1,x1);
  writectl(sperre);
End;

procedure Feldbelegen;
(* Freies Feld belegen *)
Begin
  Lauf:=area[x,y]=frei;
  if Lauf then
  begin
    score:=succ(score);
    if (score MOD 25)=0 then Sperresetzen;
    if score>600 then hz:=0;
    if ds then
    begin
      Verzoegerung;
      CursorYX(28,8);
      write(score:4);
    end;
    Feldbesetzen;
  end;
End;

function Istgueltig:boolean;
(* Test ob noch im gueltigen Bereich *)
Begin
  Istgueltig:=(x in [1..80]) and (y in [1..25]);
End;

procedure Spielende;
(* Spielende *)
var
  i,
  j            : integer;
Begin
  for i:=1 to 11 do
  begin
    CursorYX(y,x);
    if odd(i) then writectl(blinker)
              else writectl(figur);
    for j:=1 to 10*BASIC do ;             (* Langsamer fuer BASIC *)
  end;
  if score>hs then
  begin
    hs:=score;
    CursorYX(28,13);
    write('- ein neuer Beststand!');
  end;
  CursorYX(29,0);
  write('Zusammenstoss! Neues Spiel (j/n)?');
  repeat
    repeat
      acs:=INKEY;
      if acs=nul then pg:=random;
    until acs<>nul;
    acs:=upcase(acs);
    case acs of
      'N' : begin
              CursorYX(29,35);
              write('Nein',esc,'e');
            end;
      'J' : Schwierigkeitsstufe;
    end; 
  until acs in ['J','N'];
  Spiel:=acs='J';
End;

BEGIN (* MAIN *)
  cls:=esc+'E'+esc+'H';
  hs:=0;
  Spiel:=true;
  Abfrage:=false;
  hz:=50;
  randomize;
  Schwierigkeitsstufe;
  write(esc,'0',esc,'f');
  write(cls);
  while Spiel do
  begin
    Starteinstellung;
    repeat
      Tastenbearbeiten;
      case di of
        rauf   : y:=pred(y);
        rechts : x:=succ(x);
        runter : y:=succ(y);
        links  : x:=pred(x);
      end;
      ds:=di in [rauf,runter];
      Lauf:=Istgueltig;
      if Lauf then Feldbelegen;
    until not Lauf;
    Spielende;
  end;
END.