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