Snake again

by FellippeHeitor (Login FellippeHeitor)

 
'This guy wrote a snake clone in ~4:30 minutes.
'https://www.youtube.com/watch?v=xGmXxpIj6vs

'This is the original javascript: https://pastebin.com/Z3zhb7cY

'This is his implementation ported by me to QB64 (with a nod to -
'or a direct ripoff from - beloved nibbles.bas - make sure volume
'is up on your speakers):

SCREEN _NEWIMAGE(600, 600, 32)
RANDOMIZE TIMER

_TITLE "Snake"

TYPE vector
x AS INTEGER
y AS INTEGER
END TYPE

px = 10
py = 10
tc = 20
gs = _WIDTH / tc
ax = 15
ay = 15
xv = 0
yv = 0
REDIM trail(1 TO 100) AS vector
maxtrail = 0
tail = 5
levelSpeed = 10
lives = 5
xv = 1

overlay& = _NEWIMAGE(_WIDTH / 2, _HEIGHT / 2, 32)

PLAY "T160O1>L20CDEDCDL10ECC"

DO
_LIMIT levelSpeed

IF ax = px AND ay = py THEN
tail = tail + 1
score = score + 1
PLAY "MBO0L16>CCCE"
IF score MOD 10 = 0 THEN levelSpeed = levelSpeed + 1

DO
ax = INT(RND * tc)
ay = INT(RND * tc)
FOR i = maxtrail TO 1 STEP -1
IF ax = trail(i).x AND ay = trail(i).y THEN EXIT FOR
NEXT
LOOP UNTIL i = 0
END IF

IF NOT pause THEN
px = px + xv
py = py + yv
IF px < 0 THEN px = tc - 1
IF px > tc - 1 THEN px = 0
IF py < 0 THEN py = tc - 1
IF py > tc - 1 THEN py = 0
END IF

CLS

fill~& = _RGB32(50, 205, 50) 'lime
FOR i = 1 TO maxtrail
LINE (trail(i).x * gs, trail(i).y * gs)-STEP(gs - 2, gs - 2), fill~&, BF
IF trail(i).x = px AND trail(i).y = py THEN
IF NOT pause THEN
tail = 5
maxtrail = 5
lives = lives - 1
PLAY "MBO0L32EFGEFDC"
IF lives = -1 THEN END
EXIT FOR
END IF
END IF
NEXT

IF NOT pause THEN
maxtrail = maxtrail + 1
IF maxtrail > UBOUND(trail) THEN
REDIM _PRESERVE trail(1 TO UBOUND(trail) + 99) AS vector
END IF
trail(maxtrail).x = px
trail(maxtrail).y = py

IF maxtrail > tail THEN
FOR i = 2 TO maxtrail
trail(i - 1) = trail(i)
NEXT
maxtrail = maxtrail - 1
END IF
END IF

fill~& = _RGB32(255, 0, 0) 'red
LINE (ax * gs, ay * gs)-STEP(gs - 2, gs - 2), fill~&, BF

_DEST overlay&
CLS , 0
COLOR _RGB32(0, 0, 0), 0
_PRINTSTRING (1, 1), STR$(score)
_PRINTSTRING (_WIDTH - _PRINTWIDTH(STR$(lives)) + 1, 1), LTRIM$(STR$(lives))
IF pause THEN _PRINTSTRING (_WIDTH / 2 - _PRINTWIDTH("pause") / 2 + 1, _HEIGHT / 2 - _FONTHEIGHT / 2 + 1), "pause"
COLOR _RGB32(255, 255, 255), 0
_PRINTSTRING (0, 0), STR$(score)
_PRINTSTRING (_WIDTH - _PRINTWIDTH(STR$(lives)), 0), LTRIM$(STR$(lives))
IF pause THEN _PRINTSTRING (_WIDTH / 2 - _PRINTWIDTH("pause") / 2, _HEIGHT / 2 - _FONTHEIGHT / 2), "pause"
_DEST 0
_PUTIMAGE , overlay&

_DISPLAY

k = _KEYHIT

SELECT CASE k
CASE 18432 'up
IF yv = 0 AND NOT pause THEN
xv = 0
yv = -1
END IF
CASE 20480 'down
IF yv = 0 AND NOT pause THEN
xv = 0
yv = 1
END IF
CASE 19200 'left
IF xv = 0 AND NOT pause THEN
xv = -1
yv = 0
END IF
CASE 19712 'right
IF xv = 0 AND NOT pause THEN
xv = 1
yv = 0
END IF
CASE 27 'esc
EXIT DO
CASE 32 'spacebar
pause = NOT pause
END SELECT
LOOP
SYSTEM

Posted on May 14, 2017, 12:02 PM

Respond to this message   

Return to Index

Response TitleAuthor and Date
* Works fine! (more colourful than the original, but the sounds are familiar--LOL)TheBOB on May 14
 P.S. I created a graphical version called "Rattler" a few years ago *(URL)TheBOB on May 14
  Rattler looks and sounds amazing, TheBOB!FellippeHeitor on May 14
   Thanks! Actually, older versions did come with the original QBasic RATTLER...TheBOB on May 14
   Sorry, FH...TheBOB on May 15
    *Not an issue at all! :-)FellippeHeitor on May 15
Screen 0 SnakeFellippeHeitor on May 17
 * Works great! I like the fact that you can't go off screen--but no Nibbles sounds! :-(TheBOB on May 17
  My bad... forgot to put them back in! *(URL)FellippeHeitro on May 17
   That's more like it...TheBOB on May 17

 Copyright © 1999-2017 Network54. All rights reserved.   Terms of Use   Privacy Statement  

Quantcast