program snake;

{$DEFINE WIN}

{$I- No I/O checking}
{$R- No range checking}
{$V- No string checking}

{$IFDEF WIN}
uses crt;
{$ENDIF}
(*

  Original version (c) 2018, Karl A. Brokstad (www.z80.no)

  Turbo Pascal conversion and other mods
               by linker3000 (linker3000-at-gmail-dot-com)

  V23T: Game map used for collision detection and food position
        generation - this takes out several long loops
*)

Type

  Str255 = string[255];

Const

  borderChar    : char = '#';
  snakeHeadChar : char = 'O';
  snakeBodyChar : char = '#';

{$IFDEF CPM}
  xMax          : Byte = 80;
  yMax          : Byte = 25;
  snakeBodyANSI : String[8] = #27'[40m';
  foodANSI      : String[8] = #27'[33;40m'; {Yellow on black background}
  snakeHeadANSI : String[8] = #27'[40m';
  borderANSI    : String[8] = #27'[31;44m';
  resetANSI     : String[4] = #27'[0m'; {Reset ANSI attributes}
  msgANSI       : String[8  = #27'[33;40m';
{$ELSE}
  xMax          : Byte = 79;  {One less column to avoid page scrolling}
  yMax          : Byte = 25;
  snakeBodyANSI : String[1] = '';
  foodANSI      : String[1] = '';
  snakeHeadANSI : String[1] = '';
  borderANSI    : String[1] = '';
  resetANSI     : String[1] = '';
  msgANSI       : String[1] = '';
{$ENDIF}

var
   snakeX   : array [1..100] of byte;
   snakeY   : array [1..100] of byte;
   gameGrid : array [2..80, 2..25] of byte; {Tracks snake body and tail}
   snakeHead, snakeTail, snakeLength : integer;
   I, level, score : integer;
   inp, dir        : char;
   X, Y            : byte;
   crash, escaped  : boolean;
   time            : integer;  {Game delay factor}
   food            : boolean;
   foodX, foodY, foodV : byte;

(* * * * * * * * * * writeCtr * * * * * * * * * *)

procedure writeCtr(Line : Byte; S : Str255);
{ Write a centred line of text}
Var
 I : Integer;

begin
  I := 40 - round(Length(S)/2);
  If I < 1 then I := 1;
  gotoxy(I,Line);
  write(S);
end;

(* * * * * * * * * * clrKbd * * * * * * * * * *)

procedure clrKbd; {Clear keyboard buffer}
begin
  {repeat until (bdos(6,255)) = 0;}
  while keypressed do readKey;
end;

(* * * * * * * * * * readKbd * * * * * * * * * *)

procedure readKbd; {Check for direction keys}
begin
{$IFDEF CPM}
      if keypressed then case upcase(chr(bdos(6,255))) of
{$ELSE}
      if keypressed then case (upcase(readKey)) of
{$ENDIF}

      'Z','A' : dir  := 'L';    (* left *)
      'X','W' : dir  := 'U';    (* up *)
      'N','S' : dir  := 'D';    (* down *)
      'M','D' : dir  := 'R';    (* right *)
       '+'    : time := (time + 5) and 255;
       '-'    : begin
                  time := time - 5;
                  if time < 0 then time := 0;
                end;
       '#'    : escaped := true;
     end;
end;

(* * * * * * * * * conIn * * * * * * * * * * * *)

function conIn : char;
begin
{   conIn := chr(bdos(6, 255)); (* SILENT READ CHARACTER *) }
    conIn := readKey;
end;

(* * * * * * * * * CLRSCRN * * * * * * * * * * *)

{likely not needed}

procedure clrscrn;
begin
{$IFDEF CPM}
   write(ClrScrANSI);
{$ELSE}
   clrscr;
{$ENDIF}
end;

(* * * * * * * * sDelay * * * * * * * * * * * * * *)

{A non-blocking-ish delay during which we check the keyboard}

procedure sDelay (D : integer);
var I : integer;

begin

  for I := 1 to D do
  begin
    Delay(1);
    readKbd;
  end;
end;

(* * * * * * * * * SPLASH SCREEN * * * * * * * * * * * *)

procedure SplashScreen;
begin
   clrscr;
   writeCtr(5,'SNAKE v0.3T');
   writeCtr(6,'(c) 2018, Karl A. Brokstad');
   writeCtr(7,'www.Z80.no');
   writeCtr(9,'Turbo Pascal version by Linker3000');
{$IFDEF WIN}
   writeCtr (11,'DOS/Windows version');
{$ELSE}
   writeCtr(11,'Requirements:');
   writeCtr(13,'ANSI/VT100 compatible console');
   writeCtr(14,'Screen size 80x25');
{$ENDIF}
   writeCtr(16,'Movement:');
   writeCtr(18,'Z = left, X = up, N = down, M = right OR use WASD keys');
   writeCtr(19,'# = Quit to here during game');
   writeCtr(22,'Press RETURN to START or Q to QUIT');
   repeat
     repeat until keypressed;
     inp := conIn;
     if ((inp = 'Q') or (inp = 'q')) then halt;
   until (inp = #13);
end;

(* Put down food *)
Procedure putFood;
begin
  (* food value 1-9 *)
  foodV := 1 + random(9);

  repeat {Find a new food location}
    readKbd;
    foodX := 3 + random(xMax-3);      {Stay within walls}
    foodY := 3 + random(yMax-3);
  until (gameGrid[foodX,foodY] = 0); {Don't put food down over snake}

  food := true;
  gotoXY(foodX,foodY); {Draw food}
  write(foodANSI, foodV ,resetANSI);
  gotoXY(1,1);
  readKbd;
end; {food}

(* * * * * * * * * DRAW SCREEN * * * * * * * * * * * *)

procedure DrawScreen;
var I : integer;
begin
   clrscr;
   write(borderANSI);

   for I:=1 to xMax do
   begin
     gotoXY(I,1);
     write(borderChar);
     gotoXY(I,yMax);
     write(borderChar);
   end;

   for I:=1 to yMax do
   begin
     gotoXY(1,I);
     write(borderChar);
     gotoXY(xMax,I);
     write(borderChar);
   end;

   write(resetANSI);
end;

(* * * * * * * * * * * * * * * * * * * * * * *)
(* * * * * * * * * * MAIN * * * * * * * * * * *)

begin
  repeat
    randomize;
    SplashScreen;  (* show splash screen *)

(* * * * * * * * * INIT GAME * * * * * * * * *)

    escaped := false;
    crash   := false;
    score   := 1;
    level   := 1;
    time    := 100; (* delay time *)

(* * * * * * * * * GAME LOOP * * * * * * * * *)
    while (not escaped) and (not crash) do
    begin
      {Clear the object location grid}
      for Y := 2 to yMax do for X := 2 to xMax do gameGrid[X,Y] := 0;

      DrawScreen;

      snakeHead := 1;               (* first position *)
      snakeLength := 1;             (* length and last position *)
      snakeTail := 2;               (* position to erase snakeTail := snakeHead + snakeLength *)

      X := 39;                      (* position in middle of screen *)
      Y := 12;

      snakeX[snakeLength] := X;
      snakeY[snakeLength] := Y;

      score := score + snakeLength;    (* write level and score *)
      gotoXY(30,1);
      write(' LEVEL ',level,'  SCORE : ',score,' ');

      food := false;

      for I := 5 downto 0 do
      begin
        gotoXY(X,Y);
        write(I);
        delay(500);
      end;

      dir := 'R';

(* * * * * * * * * START GAME LEVEL  * * * * * * * * *)

      repeat {Game level}

        readKbd; {Check keyboard for input}

        case dir of                                          (* MOVE readKbd *)
          'L' : X:=X-1;    (* left *)
          'R' : X:=X+1;    (* right *)
          'D' : Y:=Y+1;    (* down *)
          'U' : Y:=Y-1;    (* up *)
        end;

(* Aave snake position *)
(* PUSH snake positions down the line *)
(* Always use full array size to keep processing speed consistent*)

        for I := 100 downto 2 do
        begin
          readKbd; {Check keyboard for input}
          snakeX[I] := snakeX[I-1];
          snakeY[I] := snakeY[I-1];
        end;

        snakeX[snakeHead] := X;
        snakeY[snakeHead] := Y;

        gotoXY(snakeX[snakeHead],snakeY[snakeHead]);   (* Draw new head *)
        write (snakeHeadANSI,snakeHeadChar);

        if snakeLength > 1 then
        begin
          readKbd;
          gotoXY(snakeX[snakeHead+1],snakeY[snakeHead+1]);   (* Draw body *)
          gameGrid[snakeX[snakeHead+1],snakeY[snakeHead+1]] := 1; {Where the body is}
          write (snakeBodyANSI,snakeBodyChar);
        end;

        gotoXY(snakeX[snakeTail],snakeY[snakeTail]);   (* erase tail *)
        gameGrid[snakeX[snakeTail],snakeY[snakeTail]] := 0; {Remove tail from map}

        write (resetANSI,' ');
        gotoXY(1,1);

        if (food = false) then putFood; {Put down some food}

        {Test snake position}
        if (X < 2) or (X >= xMax)     {Snake crashes into wall or own body }
          or (Y < 2) or (Y >= yMax)
          or (gameGrid[X,Y] = 1) then crash := true;

        if (X = foodX) and (Y = foodY) then {Snake eats food }
        begin
          readKbd;
          snakeLength := snakeLength + foodV;
          food := false;
          snakeTail := snakeLength +1;
          score := score + (foodV * level);
          gotoXY(30,1);
          write(' LEVEL ',level,'  SCORE : ',score,' ');
          gotoXY(1,1);
          readKbd;
        end;

        sDelay(time);                                    (* delay *)

      until crash or escaped or (snakeLength > 99); {game level}

(* * * * * * * * * * END GAME * * * * * * * *)

      if (crash or escaped) then                        (* game over *)
      begin
        if crash then writeCtr(12,msgANSI+' YOU CRASHED ')
          else writeCtr(12,msgANSI+' YOU QUIT! ');
      end;

      if snakeLength > 99 then                 (* advance to next level *)
      begin
        level := level + 1;
        time := time - 10;
        if (time < 1) then time := 1;
        writeCtr(12,msgANSI+' YOU MADE IT TO THE NEXT LEVEL ');
      end;
      write (resetANSI);

      clrKbd;
      writeCtr(14,' PRESS ENTER ');
      repeat until conIn = #13;
    end {while}
  until false;

(* * * * * * * * * * FINISH  * * * * * * * *)

end.