Results 1 to 9 of 9

Thread: Another simple snake game (no OOP)

  1. #1

    Another simple snake game (no OOP)

    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
    Code:
    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:
    Code:
    {
       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.
    Best regards,
    Cybermonkey

    Pulsar2D framework:
    http://pulsar2d.org

  2. #2
    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.

  3. #3
    Quote Originally Posted by Cybermonkey View Post
    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.

  4. #4
    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 ?

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

  5. #5
    Quote Originally Posted by Roland Chastain View Post
    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 ...
    Best regards,
    Cybermonkey

    Pulsar2D framework:
    http://pulsar2d.org

  6. #6
    Quote Originally Posted by Roland Chastain View Post
    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 ?

    Code:
        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.
    Best regards,
    Cybermonkey

    Pulsar2D framework:
    http://pulsar2d.org

  7. #7
    Quote Originally Posted by Cybermonkey View Post
    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.

  8. #8
    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

    Best regards,
    Cybermonkey

    Pulsar2D framework:
    http://pulsar2d.org

  9. #9
    Quote Originally Posted by Cybermonkey View Post
    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.

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  
Comodo SSL