vt100-games/Snake/SNAKE.PAS

program snake;

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

(*

  Snake game for CP/M-80 V2.2 and VTxx/ANSI terminal

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

  Turbo Pascal conversion and other mods with permission
     (C) 2018, linker3000 (linker3000-at-gmail-dot-com)

  V1.2T: 21-Jul 2019
         Corrected Y boundary max in putFood.

  V1.1T: 14-Oct-2018
         Command line switch -m (monochrome) suppresses all colour codes
         Version numbering detached from Karl A. Brokstad's original

  V23N:  24-Sep-2018 First public release
         Game map used for collision detection and food position
         generation - this takes out several long loops.

 
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <https://www.gnu.org/licenses/>.
*)

Type

  Str255 = string[255];

Const

  progVersion   : string[6] = '1.2acn';
  borderChar    : char = '#';
  snakeHeadChar : char = 'O';
  snakeBodyChar : char = '#';

  xMax          : Byte = 80;
  yMax          : Byte = 25;

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}

   snakeBodyANSI : String[8];
   foodANSI      : String[8];
   snakeHeadANSI : String[8];
   borderANSI    : String[8];
   resetANSI     : String[4];
   msgANSI       : String[8];

   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 centered 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;
end;

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

procedure readKbd; {Check for direction keys}
begin
  if keypressed then case upcase(chr(bdos(6,255))) of

       '4','H','A' : dir  := 'L';    (* left *)
       '8','K','W' : dir  := 'U';    (* up *)
       '2','J','S' : dir  := 'D';    (* down *)
       '6','L','D' : dir  := 'R';    (* right *)
       '+'    : time := (time + 5) and 255;
       '-'    : begin
                  time := time - 5;
                  if time < 0 then time := 0;
                end;
       'Q'    : escaped := true;
     end;
end;

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

function conIn : char;
begin
   conIn := chr(bdos(6, 255)); (* SILENT READ CHARACTER *)
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;
   write (msgANSI);
   writeCtr( 4,'SNAKE '+progVersion+' by Linker3000');
   writeCtr( 5,'From the original by Karl A. Brokstad (www.Z80.no)');
   writeCtr( 7,'This program comes with ABSOLUTELY NO WARRANTY.');
   writeCtr( 9,'This is free software, and you are welcome to redistribute it');
   writeCtr(10,'under certain conditions - see GPLV2 license:');
   writeCtr(11,'https://www.gnu.org/licenses/gpl-2.0.html');
   writeCtr(13,'Requirements:');
   writeCtr(15,'80x25 ANSI/VT100 compatible console');
   if (msgANSI = '') then
     writeCtr(16,'(Monochrome mode was chosen by command line switch)')
   else
     writeCtr(16,'(Start program with -m switch to disable ANSI colors)');
   writeCtr(18,'Movement:');
   writeCtr(20,'4 = left, 8 = up, 2 = down, 6 = right OR use HJKL keys');
   writeCtr(21,'Q = Quit to here during game');
   writeCtr(23,'Press ENTER to START or Q to QUIT');
   repeat
     repeat until keypressed;
     inp := conIn;
     if ((inp = 'Q') or (inp = 'q')) then
     begin
       write (resetANSI);
       halt;
     end;
   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-4);
  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

  snakeBodyANSI := #27'[40m';
  foodANSI      := #27'[33;40m'; {Yellow on black background}
  snakeHeadANSI := #27'[40m';
  borderANSI    := #27'[31;44m';
  resetANSI     := #27'[0m';     {Reset ANSI attributes}
  msgANSI       := #27'[33;40m';

  if (ParamCount > 0) and ((ParamStr(1) = '-m') or (ParamStr(1) = '-M')) then
  begin
    snakeBodyANSI := '';
    foodANSI      := '';
    snakeHeadANSI := '';
    borderANSI    := '';
    resetANSI     := '';
    msgANSI       := '';
  end;

  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;

(* Save 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 * * * * * * * *)

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

      if snakeLength > 99 then                 (* advance to next level *)
      begin
        level := level + 1;
        time := time - 10;
        if (time < 1) then time := 1;
        writeCtr(12,' 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.