Ascii snake game

Game development specific discussions.
Post Reply
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Ascii snake game

Post by neil »

Here's a playable snake game I translated from qbasic. Changes I added Fullscreen and hide mouse cursor. I also added 2 custom fonts for snake and food and no more screen flicker. Keyboard bug is fixed. Now you can go in diagonal directions. It has 5 lives and a pause feature.

Code: Select all

''Ascii Snake Game
top:
Screen 12,8,1,1 '' Fullscreen
''Screen 12 '' Small Console
setmouse 0,0,0

''---------------- start of custom font----------------------
type Font
  w as long
  h as long
  d as any ptr
end type

enum
  FB_FONT_8 = 0,
  FB_FONT_14
  FB_FONT_16
end enum

extern Fonts(2)  alias "__fb_font"  as Font

sub EditChar cdecl (byref f as Font, c as ubyte, ...)
	Dim As cva_list args
	cva_start(args,c)
	dim as long y,yend,code
	dim row as ubyte ptr
	yend=f.h

	code=c:code*=f.h:row=f.d+code
	for y = 1 to yend
		*row=cva_arg(args, ubyte)
		row+=1
	next

end sub
editchar (Fonts(FB_FONT_16),asc("@"), 60,60,60,126,126,126,255,255,255,255,126,126,126,60,60,60 )
editchar (Fonts(FB_FONT_16),asc("#"), 0,0,60,126,126,255,255,255,255,255,255,126,126,60,0,0 )
''-----------------End of custom font------------------------

Dim snake(1 TO 500, 0 TO 1) AS UShort
Dim As UShort score,snakelength,sn,xd,yd
Dim As Byte i,x,y,fy,fx,died,kb,l,p

Randomize


newgame:
l = 5:score = 0

resume_game:
fy = int(rnd * 26) + 3: fx = int(rnd * 76) + 3
yd = 1: xd = 0:x = 15: y = 1:snakeLength = 1:died = 0
Cls

Do

kb =  0
If MultiKey(&H48) and Multikey(&H50) = 0 and yd = 0 Then kb = 1 ''up
If MultiKey(&H50) and Multikey(&H48) = 0 and yd = 0 Then kb = 2 ''down
IF MultiKey(&H4D) and Multikey(&H4B) = 0 and xd = 0 Then kb = 3 ''right
If MultiKey(&H4B) and Multikey(&H4D) = 0 and xd = 0 Then kb = 4 ''left
If MultiKey(&H19) Then p = 1 '' pause
If MultiKey(&H01) Then End '' Esc Key

Select Case kb
Case 1 
  xd = 0:yd = -1 '' up
Case 2 
  xd = 0:yd = 1 '' down
Case 3
  xd = 1:yd = 0 '' right
Case 4 
xd = -1:yd = 0'' left
End Select

    x = x + xd
    y = y + yd

    ''did snake just die by hitting wall boundry?
    IF x < 2 OR x > 79 THEN died = -1
    IF y < 2 OR y > 29 THEN died = -1

    ''did  snake run into itself
    For sn = 2 TO snakeLength
        IF y = snake(sn, 0) AND x = snake(sn, 1) Then died = -1
    Next

    ''did snake eat food
    If x = fx AND y = fy Then
        score += 1
        While fx = x and fy = y
            fy = int(rnd * 26) + 3: fx = int(rnd * 75) + 3
        Wend
        snakeLength += 1
    End If


 '' pause game
     if p = 1 Then
       Draw String(460,0),"Paused   Press Space"      
       p = 0
       Do
       If Multikey(&h39) Then Cls:exit do
       sleep 100
       Loop
     End If

    If died Then Exit Do

    Screenlock
    Cls
    '' show border
    Line (4, 14)-(634, 466), 15, B
    
    '' show food  
    Locate fy, fx:color 10:PRINT "#"
    '' show snake
    snake(1, 0) = y: snake(1, 1) = x
    For sn = snakeLength TO 1 STEP -1
        snake(sn + 1, 0) = snake(sn, 0): snake(sn + 1, 1) = snake(sn, 1)
        Locate snake(sn, 0), snake(sn, 1):Color 12: PRINT "@" ''snake body as it grows
    Next
    snake(1, 0) = y: snake(1, 1) = x
    Locate y, x:color 14:PRINT "@"'' snake head
    
    Draw String(20,0),"Lives " + Str(l)    
    Draw String(222,0),"SNAKE GAME : SCORE: " + Str(score)
    
    Screenunlock
 
 '' game speed adjust as needed
    sleep 80,1 
      
Loop
l -= 1
sleep 3000,1
if l > 0 Then goto resume_game


Cls
Draw String(20,0),"Lives " + Str(l)
Draw String(222,0),"SNAKE GAME : SCORE: " + Str(score)
Color 11
Locate 8,35:Print "GAME OVER"
Locate 12,31:Print "Play Again?  (Y/N)"

Do
If Multikey(&H15) Then goto newgame
If multikey(&H31)Then exit do
If Multikey(&H01) Then exit do
sleep 100,1
Loop
Last edited by neil on Apr 27, 2023 3:37, edited 6 times in total.
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: Ascii snake game

Post by neil »

I updated the snake game I added angros47's redefining internal font (a.k.a custom characters) in graphic mode. Now the snake and food are custom characters.

The screen flickers. Is there anyway to fix this?
Last edited by neil on Apr 21, 2023 18:33, edited 1 time in total.
fxm
Moderator
Posts: 12082
Joined: Apr 22, 2009 12:46
Location: Paris suburbs, FRANCE

Re: Ascii snake game

Post by fxm »

neil wrote: Apr 21, 2023 5:13 The screen flickers. Is there anyway to fix this?

In the loop code, place all the graphics screen update in a [Screenlock...Screenunlock] block:

Code: Select all

''Ascii Snake Game
Screen 12,8,1,1 '' Fullscreen
''Screen 12 '' Small Console
setmouse 0,0,0

''---------------- start of custom font----------------------
type Font
  w as long
  h as long
  d as any ptr
end type

enum
  FB_FONT_8 = 0,
  FB_FONT_14
  FB_FONT_16
end enum

extern Fonts(2)  alias "__fb_font"  as Font

sub EditChar cdecl (byref f as Font, c as ubyte, ...)
	Dim As cva_list args
	cva_start(args,c)
	dim as long y,yend,code
	dim row as ubyte ptr
	yend=f.h

	code=c:code*=f.h:row=f.d+code
	for y = 1 to yend
		*row=cva_arg(args, ubyte)
		row+=1
	next

end sub
editchar (Fonts(FB_FONT_16),asc("@"), 60,60,60,126,126,126,255,255,255,255,126,126,126,60,60,60 )
editchar (Fonts(FB_FONT_16),asc("#"), 0,0,60,126,126,255,255,255,255,255,255,126,126,60,0,0 )
''-----------------End of custom font------------------------

Dim snake(1 TO 500, 0 TO 1) AS UShort
Dim As UShort score,snakelength,sn,xd,yd
Dim As UByte i,x,y,fy,fx,died

Randomize
fy = int(rnd * 26) + 3: fx = int(rnd * 76) + 3
x = 15: y = 1: died = 0
yd = 1: xd = 0: snakeLength = 1

Do

      If MultiKey(&H48) and Multikey(&H50) = 0 Then xd = 0: yd = -1
      If MultiKey(&H50) and Multikey(&H48) = 0 Then xd = 0: yd = 1
      IF MultiKey(&H4D) and Multikey(&H4B) = 0 Then xd = 1: yd = 0
      If MultiKey(&H4B) and Multikey(&H4D) = 0 Then xd = -1: yd = 0
      If MultiKey(&H01) Then exit Do '' Esc Key
    x = x + xd
    y = y + yd

    ''did snake just die by hitting wall boundry?
    IF x < 2 OR x > 79 THEN died = -1
    IF y < 2 OR y > 29 THEN died = -1

    ''did  snake run into itself
    For sn = 2 TO snakeLength
        IF y = snake(sn, 0) AND x = snake(sn, 1) Then died = -1
    Next

    ''did snake eat food
    If x = fx AND y = fy Then
        score += 1
        While fx = x and fy = y
            fy = int(rnd * 26) + 3: fx = int(rnd * 75) + 3
        Wend
        snakeLength += 1

    End If
    IF died THEN Exit Do
    
    Screenlock
    Cls
    '' show border
    Line (4, 14)-(634, 466), 15, B
    
    '' show food  
    Locate fy, fx:color 10:PRINT "#"
    '' show snake
    snake(1, 0) = y: snake(1, 1) = x
    For sn = snakeLength TO 1 STEP -1
        snake(sn + 1, 0) = snake(sn, 0): snake(sn + 1, 1) = snake(sn, 1)
        Locate snake(sn, 0), snake(sn, 1):Color 12: PRINT "@" ''snake body as it grows
    Next
    snake(1, 0) = y: snake(1, 1) = x
    Locate y, x:color 14:PRINT "@"'' snake head
    Draw String(222,0),"SNAKE GAME : SCORE: " + Str(score)
    Screenunlock
 
 '' game speed adjust as needed
    sleep 120,1 
    Loop

Locate 8,36:Print "GAME OVER"
Sleep 3000,1
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: Ascii snake game

Post by neil »

@fxm
It worked. Thanks
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: Ascii snake game

Post by neil »

Another update. It's almost nibbles version a keyboard fix. Now you can go in diagonal directions. I added a more divider walls and a pause feature by pressing "P"  and the "Space Bar" to resume game. You get 5 lives now instead of one. It also has a game speed regulator.

Code: Select all

Screen 12,8,1,1 '' Fullscreen
''Screen 12 ''Small Console
setmouse 0,0,0
      
Type Coord
x As Ushort
y as Ushort
End Type

Dim C(128) As Coord
Dim As Long fps
Dim As UShort m,z,sc,sn
Dim As Byte d,u,v,speed,num,i,p,l,kb
Dim E AS coord

speed = 12 ''game speed regulator
'' larger number = faster
'' smaller number = slower
Randomize

newgame:
sc = 0:l = 5

resume_game:
d = 0:z = 0:sn = 0
E.X=(rnd * 37) + 1
E.Y=(rnd * 26) + 2

if E.X = 20 or E.Y = 15 THEN 
E.X = (rnd * 4) + 18
E.Y = (rnd * 4) + 13
End If

'' e.y =15:e.x = 20
C(0).X = 3
C(0).Y = 2
C(1).X = 3
C(1).Y = 2

sub quad(x as ushort,y as ushort,c as ushort)
line(x,y)-(x+15,y+15),c,bf
end sub

Function Regulate(Byval MyFps As Long,Byref fps As Long) As Long
      Static As Double timervalue,_lastsleeptime,t3,frames
      frames+=1
      If (Timer-t3)>=1 Then t3=Timer:fps=frames:frames=0
      Var sleeptime=_lastsleeptime+((1/myfps)-Timer+timervalue)*1000
      If sleeptime<1 Then sleeptime=1
      _lastsleeptime=sleeptime
      timervalue=Timer
      Return sleeptime
End Function

Color 15,1
Cls

'' show divider walls
line(16 ,240)-(287,255),12,bf
line(368,240)-(623,255),12,bf
line(320 ,15)-(335,207),12,bf 
line(320 ,288)-(335,463),12,bf

'' show border
line(0 ,16)-(638,31),12,bf
line(0 ,464)-(638,478),12,bf
line(0 ,32)-(15,463),12,bf
line(624,32)-(638,463 ),12,bf

Locate 1,3: Print "Lives " + str(l)
locate 1,29:print "SNAKE GAME : SCORE: " + str(sc)
m = 1:u = 1:v = 0:p = 0

Do

kb =  0
If MultiKey(&H48) and Multikey(&H50) = 0 and v = 0 Then kb = 1 ''up
If MultiKey(&H50) and Multikey(&H48) = 0 and v = 0 Then kb = 2 ''down
If MultiKey(&H4B) and Multikey(&H4D) = 0 and u = 0 Then kb = 3 ''left
IF MultiKey(&H4D) and Multikey(&H4B) = 0 and u = 0 Then kb = 4 ''right
If MultiKey(&H19) Then p = 1 '' pause
If MultiKey(&H01) Then exit do '' Esc Key

Select Case kb
Case 1 
u = 0:v = -1 '' up
Case 2 
u = 0:v = 1 '' down
Case 3
u = -1:v = 0 '' left
Case 4 
u = 1:v = 0 '' right
End Select

Screenlock
Quad C(M).X * 16, C(M).Y * 16,1 ''erase tail 1 = background color blue
For z = m to 1 step -1
c(z) = c(z - 1)
quad c(z).x * 16, c(z).y * 16,14 ''snake body 14 = color yellow
next

c(0).x = c(0).x + U
c(0).y = c(0).y + V

''border wall limits
IF c(0).x < 1 OR C(0).x > 38 THEN d = -1
IF c(0).y < 2 OR c(0).y > 28 THEN d = -1

'' divider wall limits
num = 0
for i = 18 to 22
if c(0).y = 15 and c(0).x = i Then num = 1
next
if c(0).y = 15 and num = 0 Then d = -1

num = 0
for i = 13 to 17
if c(0).x = 20 and c(0).y = i Then num = 1
next
if c(0).x = 20 and num = 0 Then d = -1

''did snake run into itself
For sn = 1 TO m 'm = snake length
if c(sn).y = c(0).y and c(sn).x = c(0).x then d = -1
Next

''did snake eat food
if c(0).x=E.x and c(0).y = E.Y Then

E.x = INT(rnd * 37) + 1
E.y =int(rnd * 26) + 2

if E.X = 20 or E.Y = 15 THEN 
E.X = (rnd * 4) + 18
E.Y = (rnd * 4) + 13
End If

sc += 10
locate 1,29:print "SNAKE GAME : SCORE: " + str(sc)
m += 1
End If 

Quad e.x * 16,e.y * 16,10 ''food 10 = color green
Quad C(0).X * 16, C(0).Y * 16,14 ''snake head 14 = color yellow
Screenunlock

'' game speed regulator adjust at line 17 of code
Sleep regulate(speed,fps),1
locate 1,73:print str(fps) + " FPS "

'' pause game
if p = 1 Then
Locate 1,58: Print "Paused    Press Space"
p = 0
Do
If Multikey(&h39) Then Locate 1,58:Print "                     ":exit do
sleep 100
Loop
End If

if d = -1 and l > 0 Then
l -= 1
locate 1,3:Print "Lives " + str(l)
If l < 1 Then exit do
sleep 3000,1
d = 0
goto resume_game
End if

Loop
Locate 8,35:Print "GAME OVER"
Locate 12,31:Print "Play Again?  (Y/N)"

Do
If Multikey(&H15) Then goto newgame
If multikey(&H31)Then exit do
If Multikey(&H01) Then exit do
sleep 100,1
Loop
Last edited by neil on Apr 26, 2023 22:28, edited 9 times in total.
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: Ascii snake game

Post by neil »

I updated my nibbles type version of the snake game.
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: Ascii snake game

Post by neil »

There was a problem with the snake if you tried to go backwards the game ended. I updated the code again on both snake versions.
Your not allowed to go backwards. If you try to go backwards it's ignored and the games keeps running. This is the same as qbasic nibbles.
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: Ascii snake game

Post by neil »

I updated the code again on the nibbles type version. I added a divider wall obstacle and a game speed regulator.
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: Ascii snake game

Post by neil »

I posted another snake game update; it's almost nibbles version. I added a more divider walls and a pause feature by pressing "P" and the "Space Bar" to resume game. You get 5 lives now instead of one. It also has a game speed regulator.
neil
Posts: 556
Joined: Mar 17, 2022 23:26

Re: Ascii snake game

Post by neil »

I fixed a bug for the both snake versions. If you pressed the (down arrow + left arrow) the snake could go backwards.
The opening post Ascii snake game has been fully updated.

Now you can press 2 arrow keys at once and the snake will go in diagonal directions by stair-stepping.
(right arrow + up arrow) = diagonal up right
(right arrow + down arrow) = diagonal down right
(left arrow + up arrow) = diagonal up left
(left arrow + down arrow) = diagonal down left
Post Reply