1
0
vt100-games/Snake/SNAKE.PAS
2020-06-25 11:35:08 +02:00

381 lines
10 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

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.