Skip to content
Find file
Fetching contributors…
Cannot retrieve contributors at this time
1620 lines (1411 sloc) 51.7 KB
' FruitySnake --- a buggy and lame snake game written in QBasic
' Copyright (C) 1999, 2004 Daniel Brockman
' Version: 0.5
' 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.
' To receive a copy of the GNU General Public License, write to the
' Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
' MA 02111-1307 USA.
' Wishlist (in rough order of importance):
' The speed check worked on a computer that was old in 1999, but it
' does not work very well on today's computers.
' The top panel does not show the scores and other information
' correctly. Among other things, it needs to handle both players.
' Most levels are not yet adapted to two-player mode. In particular,
' they have only one starting place.
' It would be nice to get rid of all the visual glitches, even though
' they are somewhat charming.
' The snakes should not be able to run over one another.
' More levels!
' The code could use a major clean-up. Even though QBasic provides
' fairly limited tools for abstraction, this code could look
' significantly better than it currently does.
' Possibility to shop for cool stuff using the credits. Perhaps extra
' lives could be available for purchase. Or how about some weapons to
' disrupt the other player in their fruit quest? I can imagine lots of
' cool stuff for which a shopping system could be used.
' -----------------------
' Subroutine declarations
' -----------------------
DECLARE SUB RESETALL ()
DECLARE FUNCTION MAKETINYNUMBER$ (nr%)
DECLARE SUB CLEARSQUARECURRENT (myX%, myY%)
DECLARE SUB SETCOLORS ()
DECLARE SUB ADDHEADTEXT (myX, myY, myNUMBER%)
DECLARE SUB CLEARSQUARE (myX%, myY%)
DECLARE SUB EATPEACH (who%)
DECLARE FUNCTION ISPEACH! (myX!, myY!)
DECLARE SUB PUTPEACH ()
DECLARE FUNCTION ISICE! (myX!, myY!)
DECLARE FUNCTION ISMUD! (myX!, myY!)
DECLARE SUB PAUSEGAME ()
DECLARE SUB DISABLEKEYS ()
DECLARE SUB TELEPORT (who%, WHERE!)
DECLARE FUNCTION ISTELEPORT! (myX!, myY!)
DECLARE SUB DRAWLEVEL (LVL%)
DECLARE FUNCTION YESNO! ()
DECLARE SUB DIE (who%)
DECLARE SUB UPDATESTATS ()
DECLARE SUB GRIDLINE (STARTX!, STARTY!, ENDX!, ENDY!, CLR!)
DECLARE SUB NEXTLEVEL ()
DECLARE SUB DRAWBODYPART (myPart%)
DECLARE FUNCTION ISSNAKE! (myX!, myY!)
DECLARE FUNCTION ISSOLID! (myX!, myY!)
DECLARE FUNCTION ISAPPLE! (myX!, myY!)
DECLARE FUNCTION ISBACKGROUND! (myX!, myY!)
DECLARE SUB PLAYSOUND (WHATSOUND$)
DECLARE SUB PUTAPPLE ()
DECLARE SUB EATAPPLE (who%)
DECLARE SUB GAMEOVER ()
DECLARE SUB LOADLEVEL (LVL%)
DECLARE SUB INITKEYS ()
DECLARE SUB ENABLEKEYS ()
DECLARE SUB BUFFERKEYS ()
DECLARE SUB CENTER (TEXT$, ROW%, ROWSPACING%, BOXWIDTH%, CLEARSCREEN%, FADEOUT%, R!, G!, B!, COLORSLOT%)
DECLARE SUB CHPAL (c%, R%, G%, B%)
DECLARE SUB PAUSE ()
DECLARE SUB DELAY (iterations&)
' -------------------------
' General-purpose constants
' -------------------------
CONST TRUE = -1, FALSE = 0, YES = 1, NO = 0
' --------------------
' Color slot constants
' --------------------
CONST DARK = 11, BRIGHT = 10
CONST WHITE = 13, BLACK = 12, GRAY = 14, PURPLE = 15, LIGHTPURPLE = 16
CONST SOLID = 50, ENDSOLID = 99
CONST WALL = SOLID + 0, ENDWALL = SOLID + 9
CONST SNAKE1 = SOLID + 10, ENDSNAKE1 = SOLID + 14
CONST SNAKE2 = SOLID + 15, ENDSNAKE2 = SOLID + 19
CONST BACKGROUND = 100, ENDBACKGROUND = 149
CONST NORMALBG = BACKGROUND + 0, ENDNORMALBG = BACKGROUND + 9
CONST MUD = BACKGROUND + 10, ENDMUD = BACKGROUND + 19
CONST ICE = BACKGROUND + 20, ENDICE = BACKGROUND + 29
CONST SNAKESPAWN = BACKGROUND + 30, ENDSNAKESPAWN = BACKGROUND + 34
CONST SPECIAL = 150, ENDSPECIAL = 199
CONST APPLE = SPECIAL + 0, ENDAPPLE = SPECIAL + 4
CONST PEACH = SPECIAL + 5, ENDPEACH = SPECIAL + 9
CONST TELEPORT1 = SPECIAL + 10, ENDTELEPORT1 = SPECIAL + 14
CONST TELEPORT2 = SPECIAL + 15, ENDTELEPORT2 = SPECIAL + 19
CONST TELEPORT3 = SPECIAL + 20, ENDTELEPORT3 = SPECIAL + 24
CONST TELEPORT4 = SPECIAL + 25, ENDTELEPORT4 = SPECIAL + 29
CONST HEADTEXT = 200, ENDHEADTEXT = 219
' ------------------------
' Snake body part graphics
' -------------------------
'CONST LEFTGFX = "U1L2R4D1L4D1R4"
'CONST UPGFX = "L1U2D4R1U4R1D4"
'CONST RIGHTGFX = "U1L2R4D1L4D1R4"
'CONST DOWNGFX = "L1U2D4R1U4R1D4"
DIM SHARED HORIZONTALGFX AS STRING
HORIZONTALGFX = "U1L2R4D1L4D1R4"
DIM SHARED HORIZONTAL1GFX1 AS STRING, HORIZONTAL2GFX1 AS STRING
HORIZONTAL1GFX1 = "C" + STR$(SNAKE1 + 0) + HORIZONTALGFX
HORIZONTAL2GFX1 = "C" + STR$(SNAKE1 + 1) + HORIZONTALGFX
DIM SHARED HORIZONTAL1GFX2 AS STRING, HORIZONTAL2GFX2 AS STRING
HORIZONTAL1GFX2 = "C" + STR$(SNAKE2 + 0) + HORIZONTALGFX
HORIZONTAL2GFX2 = "C" + STR$(SNAKE2 + 1) + HORIZONTALGFX
DIM SHARED VERTICALGFX AS STRING
VERTICALGFX = "L1U2D4R1U4R1D4"
DIM SHARED VERTICAL1GFX1 AS STRING, VERTICAL2GFX1 AS STRING
VERTICAL1GFX1 = "C" + STR$(SNAKE1 + 0) + VERTICALGFX
VERTICAL2GFX1 = "C" + STR$(SNAKE1 + 1) + VERTICALGFX
DIM SHARED VERTICAL1GFX2 AS STRING, VERTICAL2GFX2 AS STRING
VERTICAL1GFX2 = "C" + STR$(SNAKE2 + 0) + VERTICALGFX
VERTICAL2GFX2 = "C" + STR$(SNAKE2 + 1) + VERTICALGFX
DIM SHARED APPLEHORIZONTALGFX AS STRING, APPLEVERTICALGFX AS STRING
APPLEHORIZONTALGFX = "U1L1D2R2U3L3D4R4U4"
APPLEVERTICALGFX = "U1L1D2R2U3L3D4R4U4"
DIM SHARED APPLEHORIZONTALGFX1 AS STRING, APPLEVERTICALGFX1 AS STRING
APPLEHORIZONTALGFX1 = "C" + STR$(APPLE) + APPLEHORIZONTALGFX
APPLEVERTICALGFX1 = "C" + STR$(APPLE) + APPLEVERTICALGFX
DIM SHARED APPLEHORIZONTALGFX2 AS STRING, APPLEVERTICALGFX2 AS STRING
APPLEHORIZONTALGFX2 = "C" + STR$(APPLE) + APPLEHORIZONTALGFX
APPLEVERTICALGFX2 = "C" + STR$(APPLE) + APPLEVERTICALGFX
DIM SHARED HEADLEFTGFX AS STRING, HEADDOWNGFX AS STRING, HEADRIGHTGFX AS STRING, HEADUPGFX AS STRING
HEADLEFTGFX = "U1R1D1L3U1E1R2F1D2L3"
HEADDOWNGFX = "R1U1L1D3R1E1U2H1L2D3"
HEADRIGHTGFX = "U1L1D1R3U1H1L2G1D2R3"
HEADUPGFX = "R1D1L1U3R1F1D2G1L2U3"
DIM SHARED HEADLEFTGFX1 AS STRING, HEADDOWNGFX1 AS STRING, HEADRIGHTGFX1 AS STRING, HEADUPGFX1 AS STRING
HEADLEFTGFX1 = "C" + STR$(SNAKE1) + HEADLEFTGFX
HEADDOWNGFX1 = "C" + STR$(SNAKE1) + HEADDOWNGFX
HEADRIGHTGFX1 = "C" + STR$(SNAKE1) + HEADRIGHTGFX
HEADUPGFX1 = "C" + STR$(SNAKE1) + HEADUPGFX
DIM SHARED HEADLEFTGFX2 AS STRING, HEADDOWNGFX2 AS STRING, HEADRIGHTGFX2 AS STRING, HEADUPGFX2 AS STRING
HEADLEFTGFX2 = "C" + STR$(SNAKE2) + HEADLEFTGFX
HEADDOWNGFX2 = "C" + STR$(SNAKE2) + HEADDOWNGFX
HEADRIGHTGFX2 = "C" + STR$(SNAKE2) + HEADRIGHTGFX
HEADUPGFX2 = "C" + STR$(SNAKE2) + HEADUPGFX
DIM SHARED TAILLEFTGFX AS STRING, TAILDOWNGFX AS STRING, TAILRIGHTGFX AS STRING, TAILUPGFX AS STRING
TAILLEFTGFX = "R1L2D1L1U2R4"
TAILDOWNGFX = "U1D2R1D1L2U4"
TAILRIGHTGFX = "L1R2U1R1D2L4"
TAILUPGFX = "D1U2L1U1R2D4"
DIM SHARED TAILLEFTGFX1 AS STRING, TAILDOWNGFX1 AS STRING, TAILRIGHTGFX1 AS STRING, TAILUPGFX1 AS STRING
TAILLEFTGFX1 = "C" + STR$(SNAKE1) + TAILLEFTGFX
TAILDOWNGFX1 = "C" + STR$(SNAKE1) + TAILDOWNGFX
TAILRIGHTGFX1 = "C" + STR$(SNAKE1) + TAILRIGHTGFX
TAILUPGFX1 = "C" + STR$(SNAKE1) + TAILUPGFX
DIM SHARED TAILLEFTGFX2 AS STRING, TAILDOWNGFX2 AS STRING, TAILRIGHTGFX2 AS STRING, TAILUPGFX2 AS STRING
TAILLEFTGFX2 = "C" + STR$(SNAKE2) + TAILLEFTGFX
TAILDOWNGFX2 = "C" + STR$(SNAKE2) + TAILDOWNGFX
TAILRIGHTGFX2 = "C" + STR$(SNAKE2) + TAILRIGHTGFX
TAILUPGFX2 = "C" + STR$(SNAKE2) + TAILUPGFX
' -------------
' Sharp corners
' -------------
'CONST ULCORNERGFX = "L1D2U3 R1D3 R1U3 R1D2"
'CONST URCORNERGFX = "R1D2U3 L1D3 L1U3 L1D2"
'CONST DLCORNERGFX = "L1U2D3 R1U3 R1D3 R1U2"
'CONST DRCORNERGFX = "R1U2D3 L1U3 L1D3 L1U2"
' -------------
' Round corners
' -------------
DIM SHARED ULCORNERGFX AS STRING, URCORNERGFX AS STRING, DLCORNERGFX AS STRING, DRCORNERGFX AS STRING
ULCORNERGFX = "R1D1L1D1L1R3U3"
URCORNERGFX = "L1D1R1D1R1L3U3"
DLCORNERGFX = "R1U1L1U1L1R3D3"
DRCORNERGFX = "L1U1R1U1R1L3D3"
DIM SHARED ULCORNER1GFX1 AS STRING, URCORNER1GFX1 AS STRING, DLCORNER1GFX1 AS STRING, DRCORNER1GFX1 AS STRING
ULCORNER1GFX1 = "C" + STR$(SNAKE1 + 0) + ULCORNERGFX
URCORNER1GFX1 = "C" + STR$(SNAKE1 + 0) + URCORNERGFX
DLCORNER1GFX1 = "C" + STR$(SNAKE1 + 0) + DLCORNERGFX
DRCORNER1GFX1 = "C" + STR$(SNAKE1 + 0) + DRCORNERGFX
DIM SHARED ULCORNER2GFX1 AS STRING, URCORNER2GFX1 AS STRING, DLCORNER2GFX1 AS STRING, DRCORNER2GFX1 AS STRING
ULCORNER2GFX1 = "C" + STR$(SNAKE1 + 1) + ULCORNERGFX
URCORNER2GFX1 = "C" + STR$(SNAKE1 + 1) + URCORNERGFX
DLCORNER2GFX1 = "C" + STR$(SNAKE1 + 1) + DLCORNERGFX
DRCORNER2GFX1 = "C" + STR$(SNAKE1 + 1) + DRCORNERGFX
DIM SHARED ULCORNER1GFX2 AS STRING, URCORNER1GFX2 AS STRING, DLCORNER1GFX2 AS STRING, DRCORNER1GFX2 AS STRING
ULCORNER1GFX2 = "C" + STR$(SNAKE2 + 0) + ULCORNERGFX
URCORNER1GFX2 = "C" + STR$(SNAKE2 + 0) + URCORNERGFX
DLCORNER1GFX2 = "C" + STR$(SNAKE2 + 0) + DLCORNERGFX
DRCORNER1GFX2 = "C" + STR$(SNAKE2 + 0) + DRCORNERGFX
DIM SHARED ULCORNER2GFX2 AS STRING, URCORNER2GFX2 AS STRING, DLCORNER2GFX2 AS STRING, DRCORNER2GFX2 AS STRING
ULCORNER2GFX2 = "C" + STR$(SNAKE2 + 1) + ULCORNERGFX
URCORNER2GFX2 = "C" + STR$(SNAKE2 + 1) + URCORNERGFX
DLCORNER2GFX2 = "C" + STR$(SNAKE2 + 1) + DLCORNERGFX
DRCORNER2GFX2 = "C" + STR$(SNAKE2 + 1) + DRCORNERGFX
' --------------
' Other graphics
' --------------
DIM SHARED SQUARE AS STRING
SQUARE = "U1L1D2R2U3L3D4R4U4"
DIM SHARED PEACHGFX AS STRING, APPLEGFX AS STRING, APPLEBELLYGFX AS STRING
APPLEBELLYGFX = "D2 L1R2L1 U1 L2R4L2 U1 L2R4L2 U1 L2R4L2 U1 L1R2"
PEACHGFX = "L1R2L1U1D2 C" + STR$(PEACH + 1) + " BL1L0 BU2U0 BR2R0 BD2D0"
APPLEGFX = "L1E1F1G1H1 L1E2F2G2H2 C" + STR$(PEACH + 1) + " BU1 E1 BR2 F1 BD2 G1 BL2 H1"
' ---------------------
' Variable declarations
' ---------------------
DIM SHARED X(2, 1800), Y(2, 1800)
DIM SHARED BODYPART(2, 1800) AS STRING, DIRECTION(2, 1800) AS INTEGER, STOMACH(2, 1800, 2) AS LONG
DIM SHARED LENGTH(2) AS INTEGER, CURRENTLENGTH(2) AS INTEGER, LENGTHNEEDED AS INTEGER
DIM SHARED PEACHX AS INTEGER, PEACHY AS INTEGER, PEACHEXISTS AS INTEGER
DIM SHARED PEACHPROBABILITY AS DOUBLE, PEACHTIMEOUT AS INTEGER, PEACHCREDITS AS LONG
DIM SHARED GOSTEP AS INTEGER, SNAKECOLORTOGGLE(2) AS INTEGER
DIM SHARED GOX(2) AS INTEGER, GOY(2) AS INTEGER, FROZEN AS INTEGER
DIM SHARED CHX(2) AS INTEGER, CHY(2) AS INTEGER
DIM SHARED RUNNING(2) AS INTEGER, EXITSUB AS INTEGER, BONUSLEVEL AS INTEGER
DIM SHARED SPEED AS LONG, CURRENTSPEED AS LONG, LIVES(2) AS INTEGER
DIM SHARED LEVEL AS INTEGER, CREDITS(2) AS LONG, BONUSCREDITS AS LONG, LEVELCREDITS(2) AS LONG
DIM SHARED UNLOADLEVEL AS INTEGER, UNLOADDELAY AS INTEGER
DIM SHARED OFFSETWIDTH AS INTEGER, OFFSETHEIGHT AS INTEGER
DIM SHARED RESTART AS INTEGER, REDRAWLAST(2) AS INTEGER
DIM SHARED TELEPORT1X AS INTEGER, TELEPORT1Y AS INTEGER, TELEPORT1DIRECTION AS INTEGER
DIM SHARED TELEPORT2X AS INTEGER, TELEPORT2Y AS INTEGER, TELEPORT2DIRECTION AS INTEGER
DIM SHARED TELEPORT3X AS INTEGER, TELEPORT3Y AS INTEGER, TELEPORT3DIRECTION AS INTEGER
DIM SHARED TELEPORT4X AS INTEGER, TELEPORT4Y AS INTEGER, TELEPORT4DIRECTION AS INTEGER
DIM SHARED PLAYFIELD(60, 30) AS INTEGER, STARTX(2) AS INTEGER, STARTY(2) AS INTEGER
DIM SHARED CURRENTPLAYFIELD(60, 30) AS INTEGER, BODYPARTCOORDS(60, 30) AS STRING
DIM SHARED SCREENBUFFER1(160 * 100) AS INTEGER
DIM SHARED SCREENBUFFER2(160 * 100) AS INTEGER
DIM SHARED SCREENBUFFER3(160 * 100) AS INTEGER
DIM SHARED SCREENBUFFER4(160 * 100) AS INTEGER
DIM SHARED HEADTEXTDATA(100, 5) AS INTEGER, HEADTEXTS AS INTEGER
DIM SHARED HEADTEXTPATTERN(100) AS STRING
DIM SHARED PLAYERS AS INTEGER
CLS
PRINT "Estimating computer speed...";
pre = TIMER
FOR i& = 1 TO 2000000: NEXT
rawspd = TIMER - pre
SPEED = 120000 * (1.3 / rawspd)
PRINT " done."
PRINT "Initializing..."
START:
' -------------------
' Reset all variables
' -------------------
RESTART = FALSE
CALL RESETALL
' --------------
' Default values
' --------------
PLAYERS = 2
GOSTEP = 5
LEVEL = 1
LIVES(1) = 3
LIVES(2) = 3
PEACHPROBABILITY = .5
SCREEN 13
RANDOMIZE TIMER
CALL SETCOLORS
'ON PLAY(1) GOSUB BGMUSIC
'PLAY ON
'GOSUB BGMUSIC
MAIN:
' --------------------------------
' Welcome message and instructions
' --------------------------------
IF TRUE = TRUE THEN
CLS
CALL CENTER("FRUITY ", 8, 1, 0, 0, 0, 1, .5, 0, 10)
CALL CENTER(" SNAKE ", 9, 1, 0, 0, 0, 1, 1, 0, 11)
DELAY (SPEED * 2)
LINE (170, 50)-(176, 75), LIGHTPURPLE, BF
LINE (186, 50)-(192, 75), LIGHTPURPLE, BF
LINE (202, 50)-(208, 75), LIGHTPURPLE, BF
LINE (165, 44)-(213, 50), LIGHTPURPLE, BF
LINE (165, 75)-(213, 81), LIGHTPURPLE, BF
LOCATE 10, 14: COLOR WHITE: PRINT "0.5"
CALL CENTER("SEE INSTRUCTIONS? (Y/N)", 15, 1, 0, 0, 0, 1, 1, 1, 12)
CALL CENTER("PRESS Y IF YOU ENCOUNTER PROBLEMS TRYING TO PLAY", 17, 0, 25, 0, -1, 1, 1, 1, 12)
IF YESNO = YES THEN
CALL CENTER("YOU PLAY FRUITY SNAKE USING YOUR ARROW KEYS. AVOID RUNNING INTO WALLS OR YOUR OWN TAIL. TRY NOT TO BE TOO QUICK WITH THE KEYS, ESPECIALLY IF YOU HAVE A SLOWER COMPUTER.", 0, 1, 30, 1, 0, 1, 1, 1, 10): CALL PAUSE
CALL CENTER("MAKE SURE CAPS LOCK, NUM LOCK AND SCROLL LOCK ARE OFF! PRESS Q ANYTIME TO QUIT IMMEDIATLEY OR P TO PAUSE THE GAME.", 0, 1, 30, 1, 0, 1, 1, 1, 10): CALL PAUSE
CALL CENTER("YOU CAN SEE WHERE YOUR FRUITY SNAKE WILL SPAWN WHEN YOU START BY LOOKING FOR A SLIGHTLY DARKER SPOT ON THE GROUND.", 0, 1, 30, 1, 0, 1, 1, 1, 10): CALL PAUSE
CALL CENTER( _
"YOUR GOAL IS TO GROW LARGE ENOUGH TO QUALIFY FOR THE NEXT LEVEL. YOU GROW BY EATING THE YELLOW GRAPEFRUITS. IF YOU WANT CREDITS, AIM FOR THE LITTLE ORANGE PEACHES. BUT YOU MUST HURRY! THEIR CREDITS ARE DRAINED FAST UNTIL THEY DISAPPEAR.", 0, 1 _
, 30, 1, 0, 1, 1, 1, 10): CALL PAUSE
CALL CENTER("IF YOU RUN INTO THE PURPLE SURFACES, YOU WILL BE MAGICALLY TELEPORTED TO ANOTHER LOCATION.", 0, 1, 30, 1, 0, 1, 1, 1, 10): CALL PAUSE
CALL CENTER("THERE ARE DIFFERENT GROUND TYPES. THE BLUE ONE IS ICE, IT WILL SPEED YOU UP. THE BROWN ONE IS MUD AND WILL SLOW YOU DOWN.", 0, 1, 30, 1, 0, 1, 1, 1, 10): CALL PAUSE
CALL CENTER("WELL, THATS ALL. HAVE FUN!", 0, 1, 30, 1, 0, 1, 1, 1, 10): CALL PAUSE
END IF
END IF
CALL INITKEYS
CALL ENABLEKEYS
CALL LOADLEVEL(LEVEL)
MAINLOOP:
IF RESTART = TRUE THEN GOTO START
DO
FOR i% = 1 TO HEADTEXTS
HEADTEXTDATA(i%, 3) = HEADTEXTDATA(i%, 3) + 1
myYOFFSET = HEADTEXTDATA(i%, 3) / GOSTEP
FOR myXOFFSET = 0 TO 6
CALL CLEARSQUARECURRENT(HEADTEXTDATA(i%, 1) + myXOFFSET, HEADTEXTDATA(i%, 2) - myYOFFSET)
CALL CLEARSQUARECURRENT(HEADTEXTDATA(i%, 1) + myXOFFSET, HEADTEXTDATA(i%, 2) - (myYOFFSET - 1))
NEXT
IF HEADTEXTDATA(i%, 3) > 30 OR HEADTEXTDATA(i%, 2) - HEADTEXTDATA(i%, 3) / GOSTEP < 1 THEN
HEADTEXTS = HEADTEXTS - 1
ELSE
DRAW "BM" + STR$(HEADTEXTDATA(i%, 1) * GOSTEP + OFFSETWIDTH) + "," + STR$(HEADTEXTDATA(i%, 2) * GOSTEP + OFFSETHEIGHT - HEADTEXTDATA(i%, 3))
DRAW HEADTEXTPATTERN(i%)
END IF
NEXT
IF UNLOADLEVEL = TRUE THEN
UNLOADDELAY = UNLOADDELAY - 1
IF UNLOADDELAY <= 0 THEN
IF BONUSLEVEL = TRUE THEN
CALL CENTER("WOW! YOU GOT" + STR$(LEVELCREDITS) + " CREDITS! PRESS ANY KEY TO MOVE ON TO LEVEL" + STR$(LEVEL + 1) + ".", 0, 1, 36, 1, 0, .8, .8, .2, 2)
BONUSLEVEL = FALSE
ELSE
CALL CENTER("CONGRATULATIONS! YOU GOT A BONUS OF" + STR$(BONUSCREDITS) + " CREDITS! PRESS ANY KEY TO MOVE ON TO LEVEL" + STR$(LEVEL) + ".", 0, 1, 36, 1, 0, .8, .8, .2, 2)
END IF
CALL PAUSE
CALL LOADLEVEL(LEVEL)
END IF
END IF
ENABLEKEYS
CALL DELAY(CURRENTSPEED)
BUFFERKEYS
FOR i% = 1 TO PLAYERS
GOX(i%) = CHX(i%): GOY(i%) = CHY(i%)
NEXT
IF (NOT GOX(1) = 0 OR NOT GOY(1) = 0) AND (NOT GOX(2) = 0 OR NOT GOY(2) = 0) THEN
FROZEN = FALSE
END IF
IF NOT FROZEN THEN
' Peaches -- the small bonuses
IF PEACHEXISTS = TRUE THEN
PEACHCREDITS = PEACHCREDITS - 5
IF PEACHCREDITS <= 0 THEN
PEACHEXISTS = FALSE
CALL CLEARSQUARE(PEACHX, PEACHY)
PLAYSOUND ("PEACHTIMEOUT")
END IF
END IF
' Expand the snake if the actual length is smaller than the desired one
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
IF CURRENTLENGTH(i%) < LENGTH(i%) THEN
CURRENTLENGTH(i%) = CURRENTLENGTH(i%) + 1
CREDITS(i%) = CREDITS(i%) + 12
LEVELCREDITS(i%) = LEVELCREDITS(i%) + 12
' Advance to the next level if qualified
IF LENGTH(i%) >= LENGTHNEEDED THEN
CALL NEXTLEVEL
GOTO MAINLOOP
END IF
END IF
END IF
NEXT
' Erase the last piece of tail
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
IF CURRENTLENGTH(i%) > 1 THEN
CURRENTPLAYFIELD(X(i%, CURRENTLENGTH(i%) - 1), Y(i%, CURRENTLENGTH(i%) - 1)) = PLAYFIELD(X(i%, CURRENTLENGTH(i%) - 1), Y(i%, CURRENTLENGTH(i%) - 1))
BODYPARTCOORDS(X(i%, CURRENTLENGTH(i%) - 1), Y(i%, CURRENTLENGTH(i%) - 1)) = ""
PSET (X(i%, CURRENTLENGTH(i%) - 1) * GOSTEP + OFFSETWIDTH, Y(i%, CURRENTLENGTH(i%) - 1) * GOSTEP + OFFSETHEIGHT), PLAYFIELD(X(i%, CURRENTLENGTH(i%) - 1), Y(i%, CURRENTLENGTH(i%) - 1))
DRAW SQUARE
END IF
END IF
NEXT
' Shift the whole snake
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
FOR j% = CURRENTLENGTH(i%) TO 2 STEP -1
X(i%, j%) = X(i%, j% - 1)
Y(i%, j%) = Y(i%, j% - 1)
BODYPART(i%, j%) = BODYPART(i%, j% - 1)
BODYPARTCOORDS(X(i%, j%), Y(i%, j%)) = BODYPARTCOORDS(X(i%, j% - 1), Y(i%, j% - 1))
DIRECTION(i%, j%) = DIRECTION(i%, j% - 1)
STOMACH(i%, j%, 1) = STOMACH(i%, j% - 1, 1)
STOMACH(i%, j%, 2) = STOMACH(i%, j% - 1, 2)
NEXT
END IF
NEXT
' Teleport collision detection
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
myTELEPORT = ISTELEPORT((X(i%, 1) + GOX(i%)) * GOSTEP + OFFSETWIDTH, (Y(i%, 1) + GOY(i%)) * GOSTEP + OFFSETHEIGHT)
IF myTELEPORT > 0 THEN CALL TELEPORT(i%, myTELEPORT)
END IF
NEXT
' Move
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
X(i%, 1) = X(i%, 1) + GOX(i%)
Y(i%, 1) = Y(i%, 1) + GOY(i%)
END IF
NEXT
' Choose the appropriate body part for the head and any corner
FOR i% = 1 TO PLAYERS
IF i% = 1 THEN
IF SNAKECOLORTOGGLE(i%) = TRUE THEN
CRNTCLR$ = "C" + STR$(SNAKE1 + 0)
ELSE
CRNTCLR$ = "C" + STR$(SNAKE1 + 1)
END IF
ELSE
IF SNAKECOLORTOGGLE(i%) = TRUE THEN
CRNTCLR$ = "C" + STR$(SNAKE2 + 0)
ELSE
CRNTCLR$ = "C" + STR$(SNAKE2 + 1)
END IF
END IF
IF RUNNING(i%) THEN
SNAKECOLORTOGGLE(i%) = NOT SNAKECOLORTOGGLE(i%)
IF (X(i%, 1) > 60 OR Y(i%, 1) > 30) THEN DIE (i%)
IF GOX(i%) THEN
BODYPART(i%, 1) = CRNTCLR$ + HORIZONTALGFX
BODYPARTCOORDS(X(i%, 1), Y(i%, 1)) = CRNTCLR$ + HORIZONTALGFX
IF GOX(i%) = 1 THEN
DIRECTION(i%, 1) = 4
ELSE
DIRECTION(i%, 1) = 3
END IF
IF BODYPART(i%, 2) = VERTICAL1GFX1 OR BODYPART(i%, 2) = VERTICAL2GFX1 OR BODYPART(i%, 2) = VERTICAL1GFX2 OR BODYPART(i%, 2) = VERTICAL2GFX2 THEN
REDRAWLAST(i%) = TRUE
IF GOX(i%) = 1 THEN
IF SNAKECOLORTOGGLE(i%) = TRUE THEN
IF Y(i%, 3) > Y(i%, 2) THEN
BODYPART(i%, 2) = CRNTCLR$ + ULCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + ULCORNERGFX
ELSE
BODYPART(i%, 2) = CRNTCLR$ + DLCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + DLCORNERGFX
END IF
ELSE
IF Y(i%, 3) > Y(i%, 2) THEN
BODYPART(i%, 2) = CRNTCLR$ + ULCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + ULCORNERGFX
ELSE
BODYPART(i%, 2) = CRNTCLR$ + DLCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + DLCORNERGFX
END IF
END IF
ELSE
IF SNAKECOLORTOGGLE(i%) = TRUE THEN
IF Y(i%, 3) > Y(i%, 2) THEN
BODYPART(i%, 2) = CRNTCLR$ + URCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + URCORNERGFX
ELSE
BODYPART(i%, 2) = CRNTCLR$ + DRCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + DRCORNERGFX
END IF
ELSE
IF Y(i%, 3) > Y(i%, 2) THEN
BODYPART(i%, 2) = CRNTCLR$ + URCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + URCORNERGFX
ELSE
BODYPART(i%, 2) = CRNTCLR$ + DRCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + DRCORNERGFX
END IF
END IF
END IF
END IF
ELSE
BODYPART(i%, 1) = CRNTCLR$ + VERTICALGFX
BODYPARTCOORDS(X(i%, 1), Y(i%, 1)) = CRNTCLR$ + VERTICALGFX
IF GOY(i%) = 1 THEN
DIRECTION(i%, 1) = 2
ELSE
DIRECTION(i%, 1) = 1
END IF
IF BODYPART(i%, 2) = HORIZONTAL1GFX1 OR BODYPART(i%, 2) = HORIZONTAL2GFX1 OR BODYPART(i%, 2) = HORIZONTAL1GFX2 OR BODYPART(i%, 2) = HORIZONTAL2GFX2 THEN
REDRAWLAST(i%) = TRUE
IF GOY(i%) = 1 THEN
IF SNAKECOLORTOGGLE(i%) = TRUE THEN
IF X(i%, 3) > X(i%, 2) THEN
BODYPART(i%, 2) = CRNTCLR$ + ULCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + ULCORNERGFX
ELSE
BODYPART(i%, 2) = CRNTCLR$ + URCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + URCORNERGFX
END IF
ELSE
IF X(i%, 3) > X(i%, 2) THEN
BODYPART(i%, 2) = CRNTCLR$ + ULCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + ULCORNERGFX
ELSE
BODYPART(i%, 2) = CRNTCLR$ + URCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + URCORNERGFX
END IF
END IF
ELSE
IF SNAKECOLORTOGGLE(i%) = TRUE THEN
IF X(i%, 3) > X(i%, 2) THEN
BODYPART(i%, 2) = CRNTCLR$ + DLCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + DLCORNERGFX
ELSE
BODYPART(i%, 2) = CRNTCLR$ + DRCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + DRCORNERGFX
END IF
ELSE
IF X(i%, 3) > X(i%, 2) THEN
BODYPART(i%, 2) = CRNTCLR$ + DLCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + DLCORNERGFX
ELSE
BODYPART(i%, 2) = CRNTCLR$ + DRCORNERGFX
BODYPARTCOORDS(X(i%, 2), Y(i%, 2)) = CRNTCLR$ + DRCORNERGFX
END IF
END IF
END IF
END IF
END IF
END IF
NEXT
' Main drawing routines
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
IF CURRENTLENGTH(i%) > 1 THEN
PSET (X(i%, 2) * GOSTEP + OFFSETWIDTH, Y(i%, 2) * GOSTEP + OFFSETHEIGHT), PLAYFIELD(X(i%, 2), Y(i%, 2))
DRAW SQUARE
IF i% = 1 THEN
myCOLOR = SNAKE1
ELSE
myCOLOR = SNAKE2
END IF
IF STOMACH(i%, 2, 1) = 0 AND STOMACH(i%, 2, 2) = 0 THEN
PSET (X(i%, 2) * GOSTEP + OFFSETWIDTH, Y(i%, 2) * GOSTEP + OFFSETHEIGHT), myCOLOR
DRAW BODYPART(i%, 2)
ELSE
IF STOMACH(i%, 2, 1) > 0 THEN
PSET (X(i%, 2) * GOSTEP + OFFSETWIDTH, Y(i%, 2) * GOSTEP + OFFSETHEIGHT), myCOLOR + 4
ELSE
PSET (X(i%, 2) * GOSTEP + OFFSETWIDTH, Y(i%, 2) * GOSTEP + OFFSETHEIGHT), myCOLOR + 5
END IF
DRAW APPLEBELLYGFX
' SELECT CASE BODYPART(i%,2)
' CASE HORIZONTALGFX
' DRAW APPLEHORIZONTALGFX
' CASE VERTICALGFX
' DRAW APPLEVERTICALGFX
' CASE ELSE
' DRAW BODYPART(i%,2)
' END SELECT
END IF
END IF
END IF
NEXT
' Check stomach for stuff
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
STOMACH(i%, 1, 1) = 0
IF NOT STOMACH(i%, CURRENTLENGTH(i%), 1) = 0 THEN
CALL ADDHEADTEXT(X(i%, CURRENTLENGTH(i%)), Y(i%, CURRENTLENGTH(i%)), INT(STOMACH(i%, CURRENTLENGTH(i%), 1)))
LENGTH(i%) = LENGTH(i%) + STOMACH(i%, CURRENTLENGTH(i%), 1)
STOMACH(i%, CURRENTLENGTH(i%), 1) = 0
END IF
STOMACH(i%, 1, 2) = 0
IF NOT STOMACH(i%, CURRENTLENGTH(i%), 2) = 0 THEN
STOMACH(i%, CURRENTLENGTH(i%), 2) = 0
END IF
END IF
NEXT
' Detect collisions and fire events
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
IF CURRENTPLAYFIELD(X(i%, 1), Y(i%, 1)) >= SOLID AND CURRENTPLAYFIELD(X(i%, 1), Y(i%, 1)) < ENDSOLID THEN
CALL DIE(i%): GOTO MAINLOOP
END IF
IF CURRENTPLAYFIELD(X(i%, 1), Y(i%, 1)) >= APPLE AND CURRENTPLAYFIELD(X(i%, 1), Y(i%, 1)) < ENDAPPLE THEN
CALL EATAPPLE(i%)
END IF
IF CURRENTPLAYFIELD(X(i%, 1), Y(i%, 1)) >= PEACH AND CURRENTPLAYFIELD(X(i%, 1), Y(i%, 1)) < ENDPEACH THEN
CALL EATPEACH(i%)
END IF
END IF
NEXT
CURRENTSPEED = SPEED: CREDITLOSS = 1
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
IF ISMUD(X(i%, 1) * GOSTEP + OFFSETWIDTH, Y(i%, 1) * GOSTEP + OFFSETHEIGHT) THEN CURRENTSPEED = SPEED * 3: CREDITLOSS = 2
IF ISICE(X(i%, 1) * GOSTEP + OFFSETWIDTH, Y(i%, 1) * GOSTEP + OFFSETHEIGHT) THEN CURRENTSPEED = SPEED / 4: CREDITLOSS = .5
END IF
NEXT
IF RESTART = TRUE THEN GOTO START
' Draw the tail
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
IF CURRENTLENGTH(i%) > 1 THEN
THEBODYPART$ = BODYPART(i%, CURRENTLENGTH(i%) - 1)
IF THEBODYPART$ = VERTICAL1GFX1 OR THEBODYPART$ = VERTICAL2GFX1 OR THEBODYPART$ = VERTICAL1GFX2 OR THEBODYPART$ = VERTICAL2GFX2 OR THEBODYPART$ = HORIZONTAL1GFX1 OR THEBODYPART$ = HORIZONTAL2GFX1 OR THEBODYPART$ = HORIZONTAL1GFX2 OR _
THEBODYPART$ = HORIZONTAL2GFX2 THEN
PSET (X(i%, CURRENTLENGTH(i%) - 1) * GOSTEP + OFFSETWIDTH, Y(i%, CURRENTLENGTH(i%) - 1) * GOSTEP + OFFSETHEIGHT), PLAYFIELD(X(i%, CURRENTLENGTH(i%) - 1), Y(i%, CURRENTLENGTH(i%) - 1))
DRAW SQUARE
CURRENTPLAYFIELD(X(i%, CURRENTLENGTH(i%) - 1), Y(i%, CURRENTLENGTH(i%) - 1)) = PLAYFIELD(X(i%, CURRENTLENGTH(i%) - 1), Y(i%, CURRENTLENGTH(i%) - 1))
PSET (X(i%, CURRENTLENGTH(i%) - 1) * GOSTEP + OFFSETWIDTH, Y(i%, CURRENTLENGTH(i%) - 1) * GOSTEP + OFFSETHEIGHT), SNAKE
IF i% = 1 THEN
GFX$ = "C" + STR$(SNAKE1)
ELSE
GFX$ = "C" + STR$(SNAKE2)
END IF
SELECT CASE DIRECTION(i%, CURRENTLENGTH(i%) - 1)
CASE 1
GFX$ = GFX$ + TAILUPGFX
CASE 2
GFX$ = GFX$ + TAILDOWNGFX
CASE 3
GFX$ = GFX$ + TAILLEFTGFX
CASE 4
GFX$ = GFX$ + TAILRIGHTGFX
END SELECT
BODYPARTCOORDS(X(i%, CURRENTLENGTH(i%) - 1), Y(i%, CURRENTLENGTH(i%) - 1)) = GFX$
DRAW GFX$
END IF
END IF
END IF
NEXT
' Draw the head
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
CURRENTPLAYFIELD(X(i%, 1), Y(i%, 1)) = SNAKE
PSET (X(i%, 1) * GOSTEP + OFFSETWIDTH, Y(i%, 1) * GOSTEP + OFFSETHEIGHT), PLAYFIELD(X(i%, 1), Y(i%, 1))
DRAW SQUARE
PSET (X(i%, 1) * GOSTEP + OFFSETWIDTH, Y(i%, 1) * GOSTEP + OFFSETHEIGHT), myCOLOR
IF i% = 1 THEN
GFX$ = "C" + STR$(SNAKE1)
ELSE
GFX$ = "C" + STR$(SNAKE2)
END IF
SELECT CASE DIRECTION(i%, 1)
CASE 1
GFX$ = GFX$ + HEADUPGFX
CASE 2
GFX$ = GFX$ + HEADDOWNGFX
CASE 3
GFX$ = GFX$ + HEADLEFTGFX
CASE 4
GFX$ = GFX$ + HEADRIGHTGFX
END SELECT
DRAW GFX$
END IF
NEXT
FOR i% = 1 TO PLAYERS
IF RUNNING(i%) THEN
CREDITS(i%) = CREDITS(i%) - CREDITLOSS
LEVELCREDITS(i%) = LEVELCREDITS(i%) - CREDITLOSS
IF CREDITS(i%) < 0 THEN CREDITS(i%) = 0
IF LEVELCREDITS(i%) < 0 THEN LEVELCREDITS(i%) = 0
END IF
NEXT
END IF
CALL UPDATESTATS
LOOP UNTIL LCASE$(INKEY$) = "q"
CALL GAMEOVER
IF RESTART = TRUE THEN GOTO START
END
BGMUSIC:
PLAY "MB L16 acbdbfg"
RETURN
PAUSEGAME:
CALL PAUSEGAME
RETURN
ONUPP1:
CALL BUFFERKEYS
IF GOY(1) = 0 THEN
CHX(1) = 0: CHY(1) = -1
RUNNING(1) = TRUE
END IF
CALL ENABLEKEYS
RETURN
ONLEFTP1:
CALL BUFFERKEYS
IF GOX(1) = 0 THEN
CHX(1) = -1: CHY(1) = 0
RUNNING(1) = TRUE
END IF
CALL ENABLEKEYS
RETURN
ONRIGHTP1:
CALL BUFFERKEYS
IF GOX(1) = 0 THEN
CHX(1) = 1: CHY(1) = 0
RUNNING(1) = TRUE
END IF
CALL ENABLEKEYS
RETURN
ONDOWNP1:
CALL BUFFERKEYS
IF GOY(1) = 0 THEN
CHX(1) = 0: CHY(1) = 1
RUNNING(1) = TRUE
END IF
CALL ENABLEKEYS
RETURN
ONUPP2:
CALL BUFFERKEYS
IF GOY(2) = 0 THEN
CHX(2) = 0: CHY(2) = -1
RUNNING(2) = TRUE
END IF
CALL ENABLEKEYS
RETURN
ONLEFTP2:
CALL BUFFERKEYS
IF GOX(2) = 0 THEN
CHX(2) = -1: CHY(2) = 0
RUNNING(2) = TRUE
END IF
CALL ENABLEKEYS
RETURN
ONRIGHTP2:
CALL BUFFERKEYS
IF GOX(2) = 0 THEN
CHX(2) = 1: CHY(2) = 0
RUNNING(2) = TRUE
END IF
CALL ENABLEKEYS
RETURN
ONDOWNP2:
CALL BUFFERKEYS
IF GOY(2) = 0 THEN
CHX(2) = 0: CHY(2) = 1
RUNNING(2) = TRUE
END IF
CALL ENABLEKEYS
RETURN
SUB ADDHEADTEXT (myX, myY, myNUMBER%)
FOR i% = HEADTEXTS + 1 TO 2 STEP -1
HEADTEXTDATA(i%, 1) = HEADTEXTDATA(i% - 1, 1)
HEADTEXTDATA(i%, 2) = HEADTEXTDATA(i% - 1, 2)
HEADTEXTDATA(i%, 3) = HEADTEXTDATA(i% - 1, 3)
NEXT
HEADTEXTS = HEADTEXTS + 1
HEADTEXTDATA(1, 1) = myX - LEN(STR$(myNUMBER%)) / 2
HEADTEXTDATA(1, 2) = myY
HEADTEXTDATA(1, 3) = 0
HEADTEXTPATTERN(1) = MAKETINYNUMBER(myNUMBER%)
END SUB
SUB BUFFERKEYS
KEY(15) STOP
KEY(16) STOP
KEY(17) STOP
KEY(18) STOP
KEY(20) STOP
KEY(21) STOP
KEY(22) STOP
KEY(23) STOP
END SUB
SUB CENTER (TEXT$, ROW%, ROWSPACING%, BOXWIDTH%, CLEARSCREEN%, FADEOUT%, R!, G!, B!, COLORSLOT%)
FADESPEED& = 100
IF FADEOUT% = -1 THEN FADESPEED& = 0
IF ROW% < 0 THEN ROW% = 25 / 2 + ROW%
'IF R! = 0 THEN R! = 1: IF G! = 0 THEN G! = 1: IF B! = 0 THEN B! = 1
CALL CHPAL(COLORSLOT%, 63 * R!, 63 * G!, 63 * B!)
IF CLEARSCREEN% THEN CLS
SCREENWIDTH% = 40
IF BOXWIDTH% = 0 THEN BOXWIDTH% = SCREENWIDTH%
IF ROW% = 0 THEN
IF LEN(TEXT$) > BOXWIDTH% THEN
DO UNTIL OFFSET% >= LEN(TEXT$)
FOR i% = OFFSET% + BOXWIDTH% TO OFFSET% + 1 STEP -1
IF INSTR(i%, TEXT$, " ") < OFFSET% + BOXWIDTH% THEN
IF INSTR(i%, TEXT$, " ") - OFFSET% > OFFSETINCREASE% THEN
OFFSETINCREASE% = INSTR(i%, TEXT$, " ") - OFFSET%
END IF
END IF
NEXT
IF OFFSETINCREASE% <= 0 THEN OFFSETINCREASE% = BOXWIDTH%
OFFSET% = OFFSET% + OFFSETINCREASE%
ROWS% = ROWS% + 1
LOOP
ELSE
ROWS% = 1
END IF
ROW% = (25 / 2) - (ROWS% + (ROWS% - 1) * ROWSPACING%) / 2
END IF
OFFSET% = 0
OFFSETINCREASE% = 0
DO
IF OFFSET% >= LEN(TEXT$) THEN
IF FADEOUT% = 1 THEN
FOR i% = 63 TO 1 STEP -1
CALL DELAY(FADESPEED&)
CALL CHPAL(COLORSLOT%, i% * R!, i% * G!, i% * B!)
NEXT
END IF
EXIT SUB
END IF
IF LEN(TEXT$) > BOXWIDTH% THEN
IF LEN(TEXT$) - OFFSET% > BOXWIDTH% THEN
OFFSETINCREASE% = 0
FOR i% = OFFSET% + BOXWIDTH% TO OFFSET% + 1 STEP -1
IF INSTR(i%, TEXT$, " ") < OFFSET% + BOXWIDTH% THEN
IF INSTR(i%, TEXT$, " ") - OFFSET% > OFFSETINCREASE% THEN
OFFSETINCREASE% = INSTR(i%, TEXT$, " ") - OFFSET%
END IF
END IF
NEXT
IF OFFSETINCREASE% <= 0 THEN OFFSETINCREASE% = BOXWIDTH%
END IF
ELSE
OFFSETINCREASE% = LEN(TEXT$)
END IF
TEXTSLICE$ = MID$(TEXT$, OFFSET% + 1, OFFSETINCREASE%)
GOSUB FADE
ROW% = ROW% + 1 + ROWSPACING%
OFFSET% = OFFSET% + OFFSETINCREASE%
LOOP
FADE:
COL% = INT(BOXWIDTH% / 2 - (INT(LEN(TEXTSLICE$) / 2 + .5)))
COL% = COL% + INT((SCREENWIDTH% - BOXWIDTH%) / 2)
COL% = COL% + 1 ' I dont know why I have to do this.
IF COL% <= 0 THEN COL% = 1
CALL CHPAL(1, 0, 0, 0)
COLOR 1: LOCATE ROW%, COL%: PRINT TEXTSLICE$
FOR i% = 1 TO 63 STEP 1
CALL DELAY(FADESPEED&)
CALL CHPAL(1, i% * R!, i% * G!, i% * B!)
NEXT
COLOR COLORSLOT%: LOCATE ROW%, COL%: PRINT TEXTSLICE$
RETURN
END SUB
SUB CHPAL (c%, R%, G%, B%)
PALETTE c%, B% * 65536 + R% + 256 * G%
END SUB
SUB CLEARSQUARE (myX%, myY%)
PSET (myX% * GOSTEP + OFFSETWIDTH, myY% * GOSTEP + OFFSETHEIGHT), PLAYFIELD(myX%, myY%)
DRAW SQUARE
CURRENTPLAYFIELD(myX%, myY%) = NORMALBG
BODYPARTCOORDS(myX%, myY%) = ""
END SUB
SUB CLEARSQUARECURRENT (myX%, myY%)
IF myX% < 0 OR myY% < 0 OR myX% > 60 OR myY% > 30 THEN
PSET (myX% * GOSTEP + OFFSETWIDTH, myY% * GOSTEP + OFFSETHEIGHT), 0
DRAW SQUARE
ELSE
PSET (myX% * GOSTEP + OFFSETWIDTH, myY% * GOSTEP + OFFSETHEIGHT), PLAYFIELD(myX%, myY%)
DRAW SQUARE
PSET (myX% * GOSTEP + OFFSETWIDTH, myY% * GOSTEP + OFFSETHEIGHT), PLAYFIELD(myX%, myY%)
IF NOT BODYPARTCOORDS(myX%, myY%) = "" THEN
DRAW BODYPARTCOORDS(myX%, myY%)
ELSE
DRAW SQUARE
END IF
END IF
END SUB
SUB DELAY (iterations&)
FOR i& = 1 TO iterations&: NEXT i&
END SUB
SUB DIE (who%)
CALL PLAYSOUND("DIE")
LIVES(who%) = LIVES(who%) - 1
'CREDITS(who%) = CREDITS(who%) - LEVELCREDITS(who%)
IF BONUSLEVEL = TRUE THEN
CALL NEXTLEVEL
EXIT SUB
END IF
IF LIVES(who%) <= 0 THEN
CALL GAMEOVER
RESTART = TRUE
EXIT SUB
END IF
FOR i% = 1 TO CURRENTLENGTH(who%)
IF X(who%, i%) > 60 AND Y(who%, i%) > 30 THEN
CALL CLEARSQUARE(INT(X(who%, i%)), INT(Y(who%, i%)))
END IF
NEXT
CURRENTLENGTH(who%) = 0
RUNNING(who%) = FALSE
X(who%, 1) = STARTX(who%): Y(who%, 1) = STARTY(who%)
GOX(who%) = 0: GOY(who%) = 0
CHX(who%) = 0: CHY(who%) = 0
END SUB
SUB DISABLEKEYS
KEY(15) OFF
KEY(16) OFF
KEY(17) OFF
KEY(18) OFF
KEY(20) OFF
KEY(21) OFF
KEY(22) OFF
KEY(23) OFF
END SUB
SUB DRAWLEVEL (LVL%)
OFFSETWIDTH = 10: OFFSETHEIGHT = 40
CALL GRIDLINE(0, 0, 60, 30, NORMALBG)
CALL GRIDLINE(0, 0, 60, 0, WALL)
CALL GRIDLINE(0, 0, 0, 30, WALL)
CALL GRIDLINE(60, 0, 60, 30, WALL)
CALL GRIDLINE(0, 30, 60, 30, WALL)
TELEPORT1X = 59: TELEPORT1Y = 0: TELEPORT1DIRECTION = 3
TELEPORT2X = -59: TELEPORT2Y = 0: TELEPORT2DIRECTION = 4
TELEPORT3X = 0: TELEPORT3Y = 29: TELEPORT3DIRECTION = 1
TELEPORT4X = 0: TELEPORT4Y = -29: TELEPORT4DIRECTION = 2
SELECT CASE LVL%
CASE 1:
LENGTHNEEDED = 80
STARTX(1) = 40
STARTY(1) = 15
CALL GRIDLINE(39, 14, 41, 16, SNAKESPAWN)
STARTX(2) = 20
STARTY(2) = 15
CALL GRIDLINE(19, 14, 21, 16, SNAKESPAWN)
CASE 2:
LENGTHNEEDED = 90
STARTX(1) = 30
STARTY(1) = 7
CALL GRIDLINE(29, 6, 31, 8, SNAKESPAWN)
STARTX(2) = 30
STARTY(2) = 23
CALL GRIDLINE(29, 22, 31, 24, SNAKESPAWN)
CALL GRIDLINE(20, 15, 40, 15, WALL)
CASE 3:
LENGTHNEEDED = 110
STARTX = 30
STARTY = 15
CALL GRIDLINE(29, 14, 31, 16, SNAKESPAWN)
CALL GRIDLINE(20, 10, 20, 20, WALL)
CALL GRIDLINE(40, 10, 40, 20, WALL)
CASE 4:
STARTX = 30
STARTY = 15
LENGTHNEEDED = 1000
BONUSCREDITS = 0
BONUSLEVEL = TRUE
CALL CENTER("BONUS LEVEL!", 10, 1, 0, 1, 0, 1, 1, 1, 2)
CALL CENTER("FRUITY", 12, 1, 0, 0, 0, 1, .5, .2, 3)
CALL CENTER("MADNESS!", 14, 1, 0, 0, 0, 1, 1, .2, 4)
CALL PAUSE
CALL GRIDLINE(0, 0, 0, 30, TELEPORT1 + 1)
CALL GRIDLINE(60, 0, 60, 30, TELEPORT2 + 1)
CALL GRIDLINE(0, 0, 60, 0, TELEPORT3 + 1)
CALL GRIDLINE(0, 30, 60, 30, TELEPORT4 + 1)
CALL GRIDLINE(1, 1, 59, 29, ICE + 0)
CALL GRIDLINE(3, 3, 57, 27, ICE + 1)
CALL GRIDLINE(5, 5, 55, 25, ICE + 2)
CALL GRIDLINE(7, 7, 53, 23, ICE + 3)
CALL GRIDLINE(9, 9, 51, 21, ICE + 4)
CALL GRIDLINE(10, 10, 20, 10, WALL)
CALL GRIDLINE(20, 10, 20, 5, WALL)
CALL GRIDLINE(40, 10, 50, 10, WALL)
CALL GRIDLINE(40, 10, 40, 5, WALL)
CALL GRIDLINE(10, 20, 20, 20, WALL)
CALL GRIDLINE(20, 20, 20, 25, WALL)
CALL GRIDLINE(40, 20, 50, 20, WALL)
CALL GRIDLINE(40, 20, 40, 25, WALL)
FOR i% = 1 TO 100
PUTAPPLE
NEXT
CASE 5:
LENGTHNEEDED = 110
STARTX = 15
STARTY = 7
CALL GRIDLINE(14, 6, 16, 8, SNAKESPAWN)
CALL GRIDLINE(10, 15, 50, 15, WALL)
CALL GRIDLINE(30, 10, 30, 20, WALL)
CASE 6:
LENGTHNEEDED = 120
STARTX = 15
STARTY = 15
CALL GRIDLINE(14, 14, 16, 16, SNAKESPAWN)
CALL GRIDLINE(30, 0, 30, 30, WALL)
CALL GRIDLINE(0, 14, 0, 16, TELEPORT1)
CALL GRIDLINE(60, 14, 60, 16, TELEPORT2)
CASE 7:
LENGTHNEEDED = 80
STARTX = 30
STARTY = 15
CALL GRIDLINE(29, 14, 31, 16, SNAKESPAWN)
CALL GRIDLINE(5, 5, 25, 25, ICE + 0)
CALL GRIDLINE(6, 6, 24, 24, ICE + 1)
CALL GRIDLINE(7, 7, 23, 23, ICE + 2)
CALL GRIDLINE(8, 8, 22, 22, ICE + 3)
CALL GRIDLINE(9, 9, 21, 21, ICE + 4)
CALL GRIDLINE(35, 5, 55, 25, MUD + 2)
CALL GRIDLINE(36, 6, 54, 24, MUD + 1)
CALL GRIDLINE(37, 7, 53, 23, MUD + 2)
CALL GRIDLINE(38, 8, 52, 22, MUD + 3)
CALL GRIDLINE(39, 9, 51, 21, MUD + 4)
CASE 8:
LENGTHNEEDED = 120
STARTX = 30
STARTY = 15
CALL GRIDLINE(29, 14, 31, 16, SNAKESPAWN)
TELEPORT1X = 19: TELEPORT1Y = 0: TELEPORT1DIRECTION = 4
TELEPORT2X = -21: TELEPORT2Y = 0: TELEPORT2DIRECTION = 4
TELEPORT3X = 21: TELEPORT3Y = 0: TELEPORT3DIRECTION = 3
TELEPORT4X = -19: TELEPORT4Y = 0: TELEPORT4DIRECTION = 3
CALL GRIDLINE(19, 0, 20, 30, WALL)
CALL GRIDLINE(40, 0, 41, 30, WALL)
CALL GRIDLINE(0, 14, 0, 16, TELEPORT1)
CALL GRIDLINE(20, 14, 20, 16, TELEPORT2)
CALL GRIDLINE(40, 14, 40, 16, TELEPORT3)
CALL GRIDLINE(60, 14, 60, 16, TELEPORT4)
CASE ELSE
CALL CENTER("YOU DID IT! YEAH, I'M SORRY, BUT THAT'S ALL THERE IS FOR NOW...", 0, 1, 36, 1, 0, .8, .2, .8, 2)
CALL PAUSE
CALL GAMEOVER
EXITSUB = TRUE
EXIT SUB
END SELECT
FOR myX = 0 TO 60
FOR myY = 0 TO 30
PLAYFIELD(myX, myY) = POINT(myX * GOSTEP + OFFSETWIDTH, myY * GOSTEP + OFFSETHEIGHT)
CURRENTPLAYFIELD(myX, myY) = POINT(myX * GOSTEP + OFFSETWIDTH, myY * GOSTEP + OFFSETHEIGHT)
NEXT
NEXT
FOR i% = 1 TO PLAYERS
X(i%, 1) = STARTX(i%): Y(i%, 1) = STARTY(i%)
NEXT
END SUB
SUB EATAPPLE (who%)
STOMACH(who%, 1, 1) = 2 + INT(RND * 10 + 1)
CALL CHPAL(NORMALBG, 5 * 3, 0 * 3, 15 * 3)
CALL PLAYSOUND("EATAPPLE")
CALL CHPAL(NORMALBG, 5, 0, 15)
PSET (X(who%, 1) * GOSTEP + OFFSETWIDTH, Y(who%, 1) * GOSTEP + OFFSETHEIGHT), NORMALBG
DRAW APPLEGFX
CALL PUTAPPLE
IF PEACHEXISTS = FALSE THEN
IF RND < PEACHPROBABILITY THEN PUTPEACH
END IF
END SUB
SUB EATPEACH (who%)
STOMACH(who%, 1, 2) = STOMACH(who%, 1, 2) + PEACHCREDITS
CREDITS(who%) = CREDITS(who%) + PEACHCREDITS
CALL ADDHEADTEXT(X(who%, 1), Y(who%, 1), INT(PEACHCREDITS))
PEACHCREDITS = 0
CALL CHPAL(NORMALBG, 30, 20, 10)
CALL PLAYSOUND("EATPEACH")
CALL CHPAL(NORMALBG, 5, 0, 15)
CALL CLEARSQUARE(PEACHX, PEACHY)
PEACHEXISTS = FALSE
PEACHX = 0: PEACHY = 0
PEACHTIMEOUT = 0: PEACHCREDITS = 0
END SUB
SUB ENABLEKEYS
KEY(15) ON
KEY(16) ON
KEY(17) ON
KEY(18) ON
KEY(20) ON
KEY(21) ON
KEY(22) ON
KEY(23) ON
END SUB
SUB GAMEOVER
CALL PLAYSOUND("GAMEOVER")
CLS
CALL CENTER("GAME OVER.", 10, 1, 30, 0, 0, 1, .5, 0, 10)
CALL CENTER("YOU COLLECTED" + STR$(CREDITS) + " CREDITS!", 12, 1, 30, 0, 0, 1, 1, 0, 11)
CALL CENTER("PLAY AGAIN? (Y/N)", 14, 1, 30, 0, 0, 1, 1, 1, 12)
IF YESNO = YES THEN
RESTART = TRUE
EXIT SUB
END IF
END
END SUB
SUB GRIDLINE (STARTX, STARTY, ENDX, ENDY, CLR)
LINE ((STARTX * GOSTEP + OFFSETWIDTH) - INT(GOSTEP / 2), (STARTY * GOSTEP + OFFSETHEIGHT) - INT(GOSTEP / 2))-((ENDX * GOSTEP + OFFSETWIDTH) + INT(GOSTEP / 2), (ENDY * GOSTEP + OFFSETHEIGHT) + INT(GOSTEP / 2)), CLR, BF
END SUB
SUB INITKEYS
KEY 15, CHR$(128) + CHR$(72)
KEY 16, CHR$(128) + CHR$(80)
KEY 17, CHR$(128) + CHR$(75)
KEY 18, CHR$(128) + CHR$(77)
ON KEY(15) GOSUB ONUPP1
ON KEY(16) GOSUB ONDOWNP1
ON KEY(17) GOSUB ONLEFTP1
ON KEY(18) GOSUB ONRIGHTP1
KEY 20, CHR$(&H0) + CHR$(17)
KEY 21, CHR$(&H0) + CHR$(31)
KEY 22, CHR$(&H0) + CHR$(30)
KEY 23, CHR$(&H0) + CHR$(32)
ON KEY(20) GOSUB ONUPP2
ON KEY(21) GOSUB ONDOWNP2
ON KEY(22) GOSUB ONLEFTP2
ON KEY(23) GOSUB ONRIGHTP2
KEY 25, CHR$(&H0) + CHR$(25)
ON KEY(25) GOSUB PAUSEGAME
KEY(25) ON
END SUB
FUNCTION ISAPPLE (myX, myY)
IF POINT(myX, myY) >= APPLE AND POINT(myX, myY) <= ENDAPPLE THEN
ISAPPLE = TRUE
ELSE
ISAPPLE = FALSE
END IF
END FUNCTION
FUNCTION ISBACKGROUND (myX, myY)
IF POINT(myX, myY) >= BACKGROUND AND POINT(myX, myY) <= ENDBACKGROUND THEN
ISBACKGROUND = TRUE
ELSE
ISBACKGROUND = FALSE
END IF
END FUNCTION
FUNCTION ISICE (myX, myY)
IF POINT(myX, myY) >= ICE AND POINT(myX, myY) <= ENDICE THEN
ISICE = TRUE
ELSE
ISICE = FALSE
END IF
END FUNCTION
FUNCTION ISMUD (myX, myY)
IF POINT(myX, myY) >= MUD AND POINT(myX, myY) <= ENDMUD THEN
ISMUD = TRUE
ELSE
ISMUD = FALSE
END IF
END FUNCTION
FUNCTION ISPEACH (myX, myY)
IF POINT(myX, myY) >= PEACH AND POINT(myX, myY) <= ENDPEACH THEN
ISPEACH = TRUE
ELSE
ISPEACH = FALSE
END IF
END FUNCTION
FUNCTION ISSNAKE (myX, myY)
IF POINT(myX, myY) >= SNAKE AND POINT(myX, myY) <= ENDSNAKE THEN
ISSNAKE = TRUE
ELSE
ISSNAKE = FALSE
END IF
END FUNCTION
FUNCTION ISSOLID (myX, myY)
IF POINT(myX, myY) >= SOLID AND POINT(myX, myY) <= ENDSOLID THEN
ISSOLID = TRUE
ELSE
ISSOLID = FALSE
END IF
END FUNCTION
FUNCTION ISTELEPORT (myX, myY)
IF POINT(myX, myY) >= TELEPORT1 AND POINT(myX, myY) <= ENDTELEPORT1 THEN
ISTELEPORT = 1
ELSEIF POINT(myX, myY) >= TELEPORT2 AND POINT(myX, myY) <= ENDTELEPORT2 THEN
ISTELEPORT = 2
ELSEIF POINT(myX, myY) >= TELEPORT3 AND POINT(myX, myY) <= ENDTELEPORT3 THEN
ISTELEPORT = 3
ELSEIF POINT(myX, myY) >= TELEPORT4 AND POINT(myX, myY) <= ENDTELEPORT4 THEN
ISTELEPORT = 4
ELSE
ISTELEPORT = 0
END IF
END FUNCTION
SUB LOADLEVEL (LVL%)
CLS
ERASE X, Y, DIRECTION, STOMACH, BODYPART, BODYPARTCOORDS
UNLOADLEVEL = FALSE: UNLOADDELAY = 0
PEACHEXISTS = FALSE: PEACHCREDITS = 0: PEACHX = 0: PEACHY = 0
ERASE CURRENTLENGTH: FROZEN = TRUE
ERASE HEADTEXTDATA: HEADTEXTS = 0
FOR i% = 1 TO PLAYERS
LENGTH(i%) = 10
LEVELCREDITS(i%) = 0
RUNNING(i%) = TRUE
NEXT
BONUSCREDITS = 100 * LEVEL * (RND + 1)
CALL DRAWLEVEL(LVL%)
IF EXITSUB = TRUE THEN EXITSUB = FALSE: EXIT SUB
CALL SETCOLORS
FOR i% = 1 TO 2
CALL PUTAPPLE
NEXT
END SUB
FUNCTION MAKETINYNUMBER$ (nr%)
FOR i% = 1 TO LEN(STR$(nr%))
SELECT CASE MID$(STR$(nr%), i%, 1)
CASE "1"
s$ = "BR1 U2D4U2 BL1"
CASE "2"
s$ = "BU2BL1 R2D2L2D2R2 BU2BL1"
CASE "3"
s$ = "R2D2L2 BU4 R2D2L1"
CASE "4"
s$ = "L1U2D2R2U2D4U2L1"
CASE "5"
s$ = "BU2BR1 L2D2R2D2L2 BU2BR1"
CASE "6"
s$ = "R1D2L2U4R2 BD2BL1"
CASE "7"
s$ = "BL1BU2 R2D4U2 BL1"
CASE "8"
s$ = "R1L2U2R2D4L2U2R1"
CASE "9"
s$ = "L1U2R2D4L2 BU2BR1"
CASE "0"
s$ = "BL1 U2R2D4L2U2 BR1"
END SELECT
nr$ = nr$ + s$ + "BR4"
NEXT
'PTS$ = "R1D2L2D2U4R1 BR4 D2R1L1U4D2L1R2L1 BR4 BR1 L1D2L1"
DLR$ = "U3D6 U1L1R2U2L2U2R2 BD2BL1"
IF nr% >= 50 THEN
MAKETINYNUMBER = "C" + STR$(HEADTEXT + 1) + DLR$ + nr$
ELSE
MAKETINYNUMBER = "C" + STR$(HEADTEXT) + nr$
END IF
END FUNCTION
SUB NEXTLEVEL
CALL DISABLEKEYS
UNLOADLEVEL = TRUE: UNLOADDELAY = 20
ERASE RUNNING: GOX = 0: GOY = 0
CALL PLAYSOUND("NEXTLEVEL")
CREDITS = CREDITS + BONUSCREDITS
LEVEL = LEVEL + 1
LIVES(1) = LIVES(1) + 1
LIVES(2) = LIVES(2) + 1
END SUB
SUB OPTIONS
END SUB
SUB PAUSE
DO WHILE INKEY$ = "": LOOP
END SUB
SUB PAUSEGAME
CALL PLAYSOUND("PAUSE")
DISABLEKEYS
KEY(20) OFF
GET (0, 0)-(159, 99), SCREENBUFFER1
GET (160, 0)-(319, 99), SCREENBUFFER2
GET (0, 100)-(159, 199), SCREENBUFFER3
GET (160, 100)-(319, 199), SCREENBUFFER4
CALL CENTER("GAME PAUSED. PRESS ANY KEY TO RESUME.", 0, 1, 40, -1, 0, 1, 1, 1, 10)
CALL PAUSE
PUT (0, 0), SCREENBUFFER1, PSET
PUT (160, 0), SCREENBUFFER2, PSET
PUT (0, 100), SCREENBUFFER3, PSET
PUT (160, 100), SCREENBUFFER4, PSET
KEY(20) ON
ENABLEKEYS
CALL PLAYSOUND("UNPAUSE")
END SUB
SUB PLAYSOUND (WHATSOUND$)
SELECT CASE WHATSOUND$
CASE "EATAPPLE"
FOR snd% = 400 TO 1000 STEP 200
SOUND snd%, .5
NEXT
CASE "EATPEACH"
FOR snd% = 400 TO 4000 STEP 400
SOUND snd%, .3
NEXT
CASE "DIE"
FOR snd% = 1000 TO 400 STEP -200
SOUND snd%, .5
NEXT
CASE "NEXTLEVEL"
FOR snd% = 1000 TO 400 STEP -100
SOUND snd%, .4
NEXT
FOR snd% = 400 TO 2000 STEP 100
SOUND snd%, .2
NEXT
CASE "TELEPORT"
FOR snd% = 300 TO 400 STEP 50
SOUND snd%, .5
NEXT
CASE "GAMEOVER"
FOR snd% = 1000 TO 400 STEP -50
SOUND snd%, 1
NEXT
CASE "PAUSE"
FOR snd% = 800 TO 100 STEP -20
SOUND snd%, .5
NEXT
CASE "UNPAUSE"
FOR snd% = 100 TO 800 STEP 20
SOUND snd%, .5
NEXT
END SELECT
END SUB
SUB PUTAPPLE
DO
APPLEX = INT(RND * 100 + 1)
APPLEY = INT(RND * 53 + 1)
LOOP WHILE NOT ISBACKGROUND(APPLEX * GOSTEP + OFFSETWIDTH, APPLEY * GOSTEP + OFFSETHEIGHT)
CURRENTPLAYFIELD(APPLEX, APPLEY) = APPLE
PSET (APPLEX * GOSTEP + OFFSETWIDTH, APPLEY * GOSTEP + OFFSETHEIGHT), APPLE
DRAW APPLEGFX
BODYPARTCOORDS(APPLEX, APPLEY) = APPLEGFX
END SUB
SUB PUTPEACH
DO
PEACHX = INT(RND * 100 + 1)
PEACHY = INT(RND * 53 + 1)
LOOP WHILE NOT ISBACKGROUND(PEACHX * GOSTEP + OFFSETWIDTH, PEACHY * GOSTEP + OFFSETHEIGHT)
PEACHCREDITS = INT(RND * 400) + 200
PEACHEXISTS = TRUE
CALL PLAYSOUND("PUTPEACH")
CURRENTPLAYFIELD(PEACHX, PEACHY) = PEACH
PSET (PEACHX * GOSTEP + OFFSETWIDTH, PEACHY * GOSTEP + OFFSETHEIGHT), PEACH
DRAW PEACHGFX
END SUB
SUB RESETALL
ERASE X, Y, BODYPART, BODYPARTCOORDS, DIRECTION
GOX = 0: GOY = 0: RUNNING = FALSE
UNLOADLEVEL = FALSE: UNLOADDELAY = 0: RESTART = FALSE
LENGTH(i%) = 0: CURRENTLENGTH(i%) = 0: LENGTHNEEDED = 0
CREDITS = 0: BONUSCREDITS = 0
END SUB
SUB SETCOLORS
CALL CHPAL(NORMALBG, 5, 0, 15)
CALL CHPAL(SNAKESPAWN, 0, 0, 10)
CALL CHPAL(HEADTEXT, 60, 60, 60)
CALL CHPAL(HEADTEXT + 1, 60, 30, 10)
CALL CHPAL(MUD + 0, 20, 10, 0)
CALL CHPAL(MUD + 1, 18, 8, 0)
CALL CHPAL(MUD + 2, 16, 6, 0)
CALL CHPAL(MUD + 3, 14, 4, 0)
CALL CHPAL(MUD + 4, 12, 2, 0)
CALL CHPAL(ICE + 0, 0, 0, 30)
CALL CHPAL(ICE + 1, 5, 5, 35)
CALL CHPAL(ICE + 2, 10, 10, 40)
CALL CHPAL(ICE + 3, 15, 15, 45)
CALL CHPAL(ICE + 4, 20, 20, 50)
CALL CHPAL(SNAKE1 + 0, 50, 30, 0)
CALL CHPAL(SNAKE1 + 1, 40, 20, 0)
CALL CHPAL(SNAKE1 + 4, 40, 20, 0)
CALL CHPAL(SNAKE1 + 5, 50, 30, 0)
CALL CHPAL(SNAKE2 + 0, 30, 30, 30)
CALL CHPAL(SNAKE2 + 1, 20, 20, 20)
CALL CHPAL(SNAKE2 + 4, 30, 30, 30)
CALL CHPAL(SNAKE2 + 5, 20, 20, 20)
CALL CHPAL(WALL, 40, 60, 40)
CALL CHPAL(APPLE + 0, 60, 60, 0)
CALL CHPAL(APPLE + 1, 43, 40, 7)
CALL CHPAL(PEACH + 0, 60, 30, 0)
CALL CHPAL(PEACH + 1, 33, 15, 7)
CALL CHPAL(TELEPORT1, 30, 0, 30)
CALL CHPAL(TELEPORT2, 30, 0, 30)
CALL CHPAL(TELEPORT3, 30, 0, 30)
CALL CHPAL(TELEPORT4, 30, 0, 30)
CALL CHPAL(TELEPORT1 + 1, 0, 0, 0)
CALL CHPAL(TELEPORT2 + 1, 0, 0, 0)
CALL CHPAL(TELEPORT3 + 1, 0, 0, 0)
CALL CHPAL(TELEPORT4 + 1, 0, 0, 0)
CALL CHPAL(DARK, 40, 40, 10)
CALL CHPAL(BRIGHT, 60, 60, 60)
CALL CHPAL(WHITE, 63, 63, 63)
CALL CHPAL(GRAY, 30, 30, 30)
CALL CHPAL(BLACK, 0, 0, 0)
CALL CHPAL(PURPLE, 5, 0, 15)
CALL CHPAL(LIGHTPURPLE, 10, 0, 20)
END SUB
SUB TELEPORT (who%, myWHERE)
oldX = X(who%, 1): oldY = Y(who%, 1)
SELECT CASE myWHERE
CASE 1
X(who%, 1) = X(who%, 1) + TELEPORT1X
Y(who%, 1) = Y(who%, 1) + TELEPORT1Y
myDIRECTION = TELEPORT1DIRECTION
CASE 2
X(who%, 1) = X(who%, 1) + TELEPORT2X
Y(who%, 1) = Y(who%, 1) + TELEPORT2Y
myDIRECTION = TELEPORT2DIRECTION
CASE 3
X(who%, 1) = X(who%, 1) + TELEPORT3X
Y(who%, 1) = Y(who%, 1) + TELEPORT3Y
myDIRECTION = TELEPORT3DIRECTION
CASE 4
X(who%, 1) = X(who%, 1) + TELEPORT4X
Y(who%, 1) = Y(who%, 1) + TELEPORT4Y
myDIRECTION = TELEPORT4DIRECTION
END SELECT
IF X(who%, 1) < 0 OR X(who%, 1) > 60 THEN X(who%, 1) = oldX
IF Y(who%, 1) < 0 OR Y(who%, 1) > 30 THEN Y(who%, 1) = oldY
SELECT CASE myDIRECTION
CASE 1
GOX = 0: CHX = 0
GOY = -1: CHY = -1
CASE 2
GOX = 0: CHX = 0
GOY = 1: CHY = 1
CASE 3
GOX = -1: CHX = -1
GOY = 0: CHY = 0
CASE 4
GOX = 1: CHX = 1
GOY = 0: CHY = 0
END SELECT
PLAYSOUND ("TELEPORT")
END SUB
SUB UPDATESTATS
COLOR DARK
LOCATE 1, 2: PRINT "LENGTH:"
COLOR BRIGHT
LOCATE 1, 9: PRINT CURRENTLENGTH
COLOR DARK
LOCATE 1, 15: PRINT "NEEDED:"
COLOR BRIGHT
LOCATE 1, 22: PRINT LENGTHNEEDED
COLOR DARK
LOCATE 1, 28: PRINT "LIVES:"
COLOR BRIGHT
LOCATE 1, 34: PRINT LIVES
COLOR DARK
LOCATE 3, 2: PRINT "CREDITS:"
COLOR BRIGHT
LOCATE 3, 10: PRINT CREDITS
COLOR DARK
LOCATE 3, 28: PRINT "LEVEL:"
COLOR BRIGHT
LOCATE 3, 34: PRINT LEVEL
END SUB
FUNCTION YESNO
DO
KEYPRESSED$ = LCASE$(INKEY$)
IF KEYPRESSED$ = "y" THEN YESNO = YES: EXIT FUNCTION
IF KEYPRESSED$ = "n" THEN YESNO = NO: EXIT FUNCTION
LOOP
END FUNCTION
Jump to Line
Something went wrong with that request. Please try again.