Another simple snake game (no OOP)

[Cybermonkey]

Since I don't want to hijack Roland's thread i thought I might post my own snake game made 4 years ago. It uses the ptcgraph library. It has a highscore table and a graphical input function (which needs almost half of the source code). It does not use objects only types. Please note, for compiling the lazutf8sysutils unit is needed which usually not comes with a plain FPC installation. Besides of that you do not need Lazarus for compiling. It should compile on both Windows and Linux. I compile it usually with

fpc snake.pas -Sd -O2

Gameplay might be a little bit different from classical snake. One has only 10 seconds to get the bait. If you get it 1 point will be added to your score. If you fail 3 points are subtracted from your score. There is only one life.

A screenshot:
snake.jpg

And the source:

{
   snake.pas
   
   Copyright 2014 Markus Mangold <cybermonkey@retrogamecoding.org>
   
   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, write to the Free Software
   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
   MA 02110-1301, USA.
   
   
}
{$ifdef Windows}
    {$apptype gui}
{$endif}

program snake;

uses ptccrt,ptcgraph,lazutf8sysutils,sysutils;

type TBody = record
x,y: array of integer;
xoffset,yoffset,xcount,ycount,width,height,length:integer ;
direction: string;
end;

type TApple = record
x,y,xoffset,yoffset,xcount,ycount,width,height:integer;
end;

type TScore = record
    score:integer;
    name:ansistring;
    date:ansistring;
end;

var gd,gm:smallint;
    page,ch,i:integer;
    TICK_INTERVAL:integer = 1000 div 60;
    next_time : cardinal = 0;
    score:integer = 0;
    snake:TBody;
    bait:TApple;
    speed:real=50;
    lasttime:integer = 0;
    nowtime:integer=0;
    seconds:integer = 10;
    endgame:boolean = false;
    name: string;
    hiscore: array [1..10] of TScore;
    
const CRSLEFT = 19200;
    CRSRIGHT = 19712;
    CRSUP = 18432;
    CRSDOWN = 20480;

FUNCTION GetKey:LONGINT;
VAR InKey: LONGINT;
BEGIN
 InKey:=ORD(ReadKey);
 IF InKey=0 THEN InKey:=ORD(ReadKey) SHL 8;
 result:=InKey;
END;

function grinput (xold,y,lengthy:integer):ansistring;
var key,x,ins:integer;
    ch:char;
    answer:ansistring;
    mysize:word;
    getsize:TextSettingsType;

begin
    GetTextSettings (getsize);
       mysize:=getsize.charsize*8;
    answer:='';
    ins:=(length (answer)+1);     
    x:=xold;
 repeat
    setfillstyle (solidfill,getcolor());
    if ins > length (answer) then begin
    bar (x,y,x+mysize-1,y+mysize);
    end else begin
    bar (x,y+mysize-1,x+mysize-1,y+mysize);
    end;
    key:=getkey;
    ch:=chr(key);
    setfillstyle (solidfill,getbkcolor());
    bar (x,y,x+mysize-1,y+mysize);
    
    if key = 3 then begin
    closegraph;
    halt (0);
    end;
    
        
    if (key <> 8) and (key <>13) and (key<>18432) and (key<>19712) and (key<>19200) and (key<>20480) and (key<>15104) and (key<>15360)and (key<>15616)and (key<>15872)and (key<>16128)and (key<>16384)and (key<>16640) and (key<>21248) and (key<>20992) and (key<>18176) and (key<>18688) and (key<>21248) and (key<>20224) and (key<>20736) and (key<>16896) and (key<>17152) and (key<>17408) and (length (answer)<=lengthy-1) then begin
        insert (ch,answer,ins);
        x:=x+mysize;
        ins:=ins+1;
    end;
    
    if key=15104 then begin
        insert (chr (142),answer,ins);
        x:=x+mysize;
        ins:=ins+1;
    end;
    
    if key=15360 then begin
        insert (chr(153),answer,ins);
        ins:=ins+1;
        x:=x+mysize;
    end;
    if key=15616 then begin
        insert (chr(154),answer,ins);
        ins:=ins+1;
        x:=x+mysize;
    end;
    if key=15872 then begin
        insert (chr(225),answer,ins);
        ins:=ins+1;
        x:=x+mysize;
    end;
    if key=16128 then begin
        insert (chr(132),answer,ins);
        x:=x+mysize;
        ins:=ins+1;
    end;
    if key=16384 then begin
        insert (chr(148),answer,ins);
        ins:=ins+1;
        x:=x+mysize;
    end;
    if key=16640 then begin
        insert (chr(129),answer,ins);
        ins:=ins+1;
        x:=x+mysize;
    end;
    
    if key=19200 then begin
        if (x >= xold) and (ins>1) then begin
            ins:=ins-1;
            x:=x-mysize;
            if ins <=1 then begin
                ins:=1;
            end;
    end;
    end;
    
    if key=19712 then begin
        if (x>= xold) and (ins<=length (answer)) then begin
            ins:=ins+1;
            x:=x+mysize;
        end;
    end;
    
    if key=8 then begin
        if x >= xold then begin
            x:=x-mysize;
            ins:=ins-1;
            delete (answer,ins,1);
        end;
        if ins <=1 then begin
                ins:=1;
            end;
    end;
    
    if key=21248 then begin
        if x >= xold then begin
            delete (answer,ins,1);
        end;
        if ins <=1 then begin
                ins:=1;
            end;
     end;
    
    if key=18176 then begin
      x:=xold;
      ins:=1;
     end;
    
    if key=20224 then begin
     x:=(length (answer))*mysize+xold;     
     ins:=(length (answer)+1);     
    end;

    
    if x<= xold then begin
        x:=xold;
    end;
    
    setfillstyle (solidfill,getbkcolor());
     bar (x,y,xold*mysize,y+mysize);
     
     moveto (xold,y);
     OutText (answer);
         
    until (key=13) or (key=27) ;
    
    Result:=answer;
 end;

procedure InitHighScores;
var i:byte;
begin
for i:= 1 to 10 do begin
    hiscore[i].score:=0;
    hiscore[i].name:='No Name';
    hiscore[i].date:=FormatDateTime('yyyy-mm-dd',now);
end;
end;

procedure SortHighScores;
var getauscht : boolean;
    i, temp   : integer;
    tempdate,tempstr : ansistring;
    
begin
  repeat
    getauscht:=false;
    for i:=1 to 9 do
      if hiscore[i].score < hiscore[i+1].score then begin
        temp:=hiscore[i].score;
        tempstr:=hiscore[i].name;
        tempdate:=hiscore[i].date;
        hiscore[i].score:=hiscore[i+1].score;
        hiscore[i].name:=hiscore[i+1].name;
        hiscore[i].date:=hiscore[i+1].date;
        hiscore[i+1].score:=temp;
        hiscore[i+1].name:=tempstr;
        hiscore[i+1].date:=tempdate;
        getauscht:=true;
      end;
  until getauscht = false;
end;

procedure LoadHighscores;
var userfile: text;
    filename:ansistring;
begin
InitHighScores;
filename := 'snakehigh.dat';
if fileexists (filename) = false then begin
    assign (userfile, filename);
    begin
    {$I-}  
    rewrite (userfile);
    {$I+}
    end;
    for i:= 1 to 10 do begin
    writeln (userfile,hiscore[i].score);
    writeln    (userfile,hiscore[i].name);
    writeln    (userfile,hiscore[i].date);
    end;
     If (IOResult <> 0) then
        Begin
            Writeln('ERROR: File not found');
            closegraph;
            halt(0);
    end;
    close (userfile);
    
 end;
 
 if fileexists (filename) then begin
     assign (userfile, filename);
    begin
    {$I-}  
    reset (userfile);
    {$I+}
    end;
    for i:= 1 to 10 do begin
    readln (userfile,hiscore[i].score);
    readln    (userfile,hiscore[i].name);
    readln    (userfile,hiscore[i].date);
    end;
     If (IOResult <> 0) then
        Begin
            Writeln('ERROR: File not found');
            closegraph;
            halt(0);
    end;
    close (userfile);
    
end;
    
end;

procedure SaveHighScores;
var userfile: text;
    filename:ansistring;
begin
filename := 'snakehigh.dat';

if fileexists (filename) then begin
     assign (userfile, filename);
    begin
    {$I-}  
    rewrite (userfile);
    {$I+}
    end;
    for i:= 1 to 10 do begin
    writeln (userfile,hiscore[i].score);
    writeln    (userfile,hiscore[i].name);
    writeln    (userfile,hiscore[i].date);
    end;
     If (IOResult <> 0) then
        Begin
            Writeln('ERROR: File not found');
            closegraph;
            halt(0);
    end;
    close (userfile);
    
end;

end;

procedure DisplayHighScores;
var i:byte;
begin
SetTextStyle(DefaultFont, HorizDir,3);
 OutTextXY (200,50,'HIGHSCORES');
 
 for i:=1 to 10 do begin
 OutTextXY (40,120+i*30,hiscore[i].name);
 OutTextXY (320,120+i*30,IntToStr (hiscore[i].score));
 OutTextXY (550,120+i*30,hiscore[i].date);
 end;
 
 OutTextXY (20,600,'Press any key to go on!');
 
end;

function hrgb (red,green,blue:byte):word;
begin
result:=  (((red Shr 3) Shl 11) + ((green Shr 2) Shl 5) + (blue Shr 3));
end;

procedure SetFrameTimer (frames:integer);
begin
 if frames = 0 then
    frames := 1;
  TICK_INTERVAL:=1000 div frames;
end;

function TimeLeft : UInt32;
var
  now : UInt32;
begin
  now := gettickcount64;
  if next_time <= now then
  begin
    next_time := now + TICK_INTERVAL;
    result := 0;
    exit;
  end;
  result := next_time - now;
end;


BEGIN
    randomize;
    gd:=d16bit;
    gm:=m1024x768;
    initgraph (gd,gm,'');
    
    snake.xoffset:=111;
    snake.yoffset:=111;
    snake.xcount:=10;
    snake.ycount:=10;
    snake.width:=8;
    snake.height:=8;
    snake.direction :='right';
    snake.length := 1;
    setlength (snake.x, snake.length+1);
    setlength (snake.y, snake.length+1);
    snake.x [1]:=5;
    snake.y [1]:=5;

    bait.x:=30;
    bait.y:=30;
    bait.xoffset:=111;
    bait.yoffset:=111;
    bait.xcount:=10;
    bait.ycount:=10;
    bait.width:=8;
    bait.height:=8;
    
    setbkcolor (hrgb (0,0,150));
    cleardevice;
    ch:=0;
    page:=0;
    LoadHighScores;
    setcolor (65535);
    DisplayHighScores;
    readkey;
    cleardevice;
    SetTextStyle(DefaultFont, HorizDir,8);
    setcolor (hrgb (250,0,0));
    OutTextXY (10,10,'SNAKE');
    setcolor (hrgb (250,250,0));
    OutTextXY (15,15,'SNAKE');
    
    
    SetTextStyle(DefaultFont, HorizDir,2);
    SetFrameTimer (60);
    setcolor (65535);
    OutTextXy (0,160,'Please enter your name: ');
    name := grinput (380,160,20);
    
    LoadHighscores;
    SortHighscores;
    lasttime:=gettickcount64();

repeat
    
    nowtime:=gettickcount64();
    if nowtime>=lasttime+1000 then begin
        lasttime:=nowtime;
        seconds:=seconds-1;
            if seconds <=0 then begin
                bait.x := random (72);
                bait.y := random (52);
                seconds := 10;
                score := score - 3;
            end;
    end;

    
    setactivepage (page);
    cleardevice;    
    
    
    if keypressed then begin
        ch:=getkey();
            case ch of
                CRSLEFT: snake.direction := 'left';
                CRSRIGHT:snake.direction := 'right';
                CRSUP:      snake.direction := 'up';
                CRSDOWN: snake.direction := 'down';
                27:endgame:=true;
                112: readkey();
                3:begin 
                    closegraph;
                    halt;
                end;    
                
            end;
    end;
    
    if (snake.x[1]=bait.x) and (snake.y[1]=bait.y) then begin
    score := score + 1;
    bait.x := random (72);
    bait.y := random  (52);
    snake.length:=snake.length + 1;
    setlength (snake.x, snake.length+1);
    setlength (snake.y, snake.length+1);
    speed := speed - 0.2;
    nowtime:=gettickcount64();
    seconds := 10;
    end;

    
    if snake.direction ='right' then begin
        for i:=snake.length downto 2 do begin
            snake.x[i]:=snake.x[i-1];
            snake.y[i]:=snake.y[i-1];
        end;
    snake.x[1]:=snake.x[1] + 1;
    sleep (round(speed));
    end;

    if snake.direction ='down' then begin
        for i:=snake.length downto 2 do begin
            snake.x[i]:=snake.x[i-1];
            snake.y[i]:=snake.y[i-1];
        end;
    snake.y[1]:=snake.y[1] + 1;
    sleep (round(speed));
    end;

    if snake.direction ='left' then begin
        for i:=snake.length downto 2 do begin
            snake.x[i]:=snake.x[i-1];
            snake.y[i]:=snake.y[i-1];
        end;
    snake.x[1]:=snake.x[1] - 1;
    sleep (round(speed));
    end;

    if snake.direction ='up' then begin
        for i:=snake.length downto 2 do begin
            snake.x[i]:=snake.x[i-1];
            snake.y[i]:=snake.y[i-1];
        end;
    snake.y[1]:=snake.y[1] - 1;
    sleep (round(speed));
    end;

for i:=2 to snake.length do begin
    if (snake.x[1]=snake.x[i]) and (snake.y[1]=snake.y[i]) then begin
        endgame := true;
    end;
end;

if snake.x[1] < 0 then begin
    endgame:=true;
end;
if snake.x[1] > 72 then begin
    endgame:=true
end;
if snake.y[1] < 0 then begin
    endgame:=true;
end;
if snake.y[1] > 52 then begin
    endgame:=true;
end;

if score < 0 then begin
    endgame := true;
end;

setcolor (hrgb (255,0,0));
setfillstyle (solidfill,getcolor());
fillellipse ((bait.xoffset+bait.x*bait.xcount)+bait.width div 2,(bait.yoffset+bait.y*bait.ycount)+bait.width div 2,bait.width div 2,bait.width div 2);

setcolor (hrgb (255,255,0));
setfillstyle (solidfill,getcolor());
for i:=1 to snake.length do begin
     bar (snake.xoffset+snake.x[i]*snake.xcount,snake.yoffset+snake.y[i]*snake.ycount,(snake.xoffset+snake.x[i]*snake.xcount)+snake.width,(snake.yoffset+snake.y[i]*snake.ycount)+snake.height);
end;

    setcolor (65535);
    setfillstyle (solidfill,getcolor());
    bar (100,100,850,110);
    bar (100,100,110,650);
    bar (100,641,850,650);
    bar (841,100,850,650);
    OutTextXY (100,80,name);
    OutTextXY (700,80,'Score: '+IntToStr(score));
    OutTextXY (500,80,'Time: '+IntToStr(seconds));
        
    setvisualpage (page);
    inc (page);
    if page >1 then begin
        page:=0;
    end;
    sleep (timeleft());
    until endgame = true;
    
    setcolor (65535);
    OutTextXY (GetMaxX() div 2-100,GetMaxY() div 2-8,'GAME OVER!');
    OutTextXY (GetMaxX() div 2-200,GetMaxY() div 2+8,'Press any key to exit.');
    readkey;

    if score > hiscore[10].score then begin
      hiscore[10].score := score;
    hiscore [10].name := name;
    hiscore [10].date := FormatDateTime ('yyyy-mm-dd',now);
    SortHighScores;
    SaveHighScores;
    end;
    cleardevice;
    DisplayHighScores;
    readkey;

    closegraph;
    
END.

[SilverWarior]

Impressive!
You know what would be nice? If you could go and comment your code a bit so that it would become more understandable for beginners.
Too often I see little pieces of code that have potential to serve as learning examples but don't have any comments and therefore are not suitable for learning for beginners. Well not without the need to load this code into debugger and walk through it step by step.

[Roland Chastain]

Please note, for compiling the lazutf8sysutils unit is needed which usually not comes with a plain FPC installation.

Hello! Thank you for your code. In fact, the LazUtf8SysUtils unit doesn't seem to be used.

[Roland Chastain]

Very nice program! I think I will copy your high scores management code.

The graphic input routine is also very useful. Where did you take these key values ? Aren't there constants declared somewhere for these values ?

    if (key <> 8) and (key <> 13) and (key <> 18432) and (key <> 19712) and
      (key <> 19200) and (key <> 20480) and (key <> 15104) and (key <> 15360)

[Cybermonkey]

Hello! Thank you for your code. In fact, the LazUtf8SysUtils unit doesn't seem to be used.

Actually you are right. Strange enough, I thought I need it for gettickcount64 ...

[Cybermonkey]

Very nice program! I think I will copy your high scores management code.

The graphic input routine is also very useful. Where did you take these key values ? Aren't there constants declared somewhere for these values ?

    if (key <> 8) and (key <> 13) and (key <> 18432) and (key <> 19712) and
      (key <> 19200) and (key <> 20480) and (key <> 15104) and (key <> 15360)

I can't remember anymore ... Maybe I wrote a simple program which outputs the values. At least it isn't on my harddisk anymore.

[Roland Chastain]

Maybe I wrote a simple program which outputs the values. At least it isn't on my harddisk anymore.

I see. Thank you for your answer.

[Cybermonkey]

By the way, maybe I can advertise my Lua interpreter in this case.
It's completely made with Free Pascal and the ptcgraph unit. You can find it on the following site: http://cmlua.retrogamecoding.org/

Here's a little demonstation

[SilverWarior]

By the way, maybe I can advertise my Lua interpreter in this case.

No you should create a new thread in "Your projects" section for this instead. Post about LUA interpreter is actually off-topic in here and will thus probably be overlooked by most people.
By creating a separate thread you maximize the chance for other people to learn about the existence of your LUA interpreter. And I think several members of PGD will be very interested in it since they have desire to add LUA scripting support to their games/game engines.