--- /dev/null
+'\r
+' Q B a s i c N i b b l e s\r
+'\r
+' Copyright (C) Microsoft Corporation 1990\r
+'\r
+' Nibbles is a game for one or two players. Navigate your snakes\r
+' around the game board trying to eat up numbers while avoiding\r
+' running into walls or other snakes. The more numbers you eat up,\r
+' the more points you gain and the longer your snake becomes.\r
+'\r
+' To run this game, press Shift+F5.\r
+'\r
+' To exit QBasic, press Alt, F, X.\r
+'\r
+' To get help on a BASIC keyword, move the cursor to the keyword and press\r
+' F1 or click the right mouse button.\r
+'\r
+\r
+'Set default data type to integer for faster game play\r
+DEFINT A-Z\r
+\r
+'User-defined TYPEs\r
+TYPE snakeBody\r
+ row AS INTEGER\r
+ col AS INTEGER\r
+END TYPE\r
+\r
+'This type defines the player's snake\r
+TYPE snaketype\r
+ head AS INTEGER\r
+ length AS INTEGER\r
+ row AS INTEGER\r
+ col AS INTEGER\r
+ direction AS INTEGER\r
+ lives AS INTEGER\r
+ score AS INTEGER\r
+ scolor AS INTEGER\r
+ alive AS INTEGER\r
+END TYPE\r
+\r
+'This type is used to represent the playing screen in memory\r
+'It is used to simulate graphics in text mode, and has some interesting,\r
+'and slightly advanced methods to increasing the speed of operation.\r
+'Instead of the normal 80x25 text graphics using chr$(219) "Û", we will be\r
+'using chr$(220)"Ü" and chr$(223) "ß" and chr$(219) "Û" to mimic an 80x50\r
+'pixel screen.\r
+'Check out sub-programs SET and POINTISTHERE to see how this is implemented\r
+'feel free to copy these (as well as arenaType and the DIM ARENA stmt and the\r
+'initialization code in the DrawScreen subprogram) and use them in your own\r
+'programs\r
+TYPE arenaType\r
+ realRow AS INTEGER 'Maps the 80x50 point into the real 80x25\r
+ acolor AS INTEGER 'Stores the current color of the point\r
+ sister AS INTEGER 'Each char has 2 points in it. .SISTER is\r
+END TYPE '-1 if sister point is above, +1 if below\r
+\r
+'Sub Declarations\r
+DECLARE SUB SpacePause (text$)\r
+DECLARE SUB PrintScore (NumPlayers%, score1%, score2%, lives1%, lives2%)\r
+DECLARE SUB Intro ()\r
+DECLARE SUB GetInputs (NumPlayers, speed, diff$, monitor$)\r
+DECLARE SUB DrawScreen ()\r
+DECLARE SUB PlayNibbles (NumPlayers, speed, diff$)\r
+DECLARE SUB Set (row, col, acolor)\r
+DECLARE SUB Center (row, text$)\r
+DECLARE SUB DoIntro ()\r
+DECLARE SUB Initialize ()\r
+DECLARE SUB SparklePause ()\r
+DECLARE SUB Level (WhatToDO, sammy() AS snaketype)\r
+DECLARE SUB InitColors ()\r
+DECLARE SUB EraseSnake (snake() AS ANY, snakeBod() AS ANY, snakeNum%)\r
+DECLARE FUNCTION StillWantsToPlay ()\r
+DECLARE FUNCTION PointIsThere (row, col, backColor)\r
+\r
+'Constants\r
+CONST TRUE = -1\r
+CONST FALSE = NOT TRUE\r
+CONST MAXSNAKELENGTH = 1000\r
+CONST STARTOVER = 1 ' Parameters to 'Level' SUB\r
+CONST SAMELEVEL = 2\r
+CONST NEXTLEVEL = 3\r
+\r
+'Global Variables\r
+DIM SHARED arena(1 TO 50, 1 TO 80) AS arenaType\r
+DIM SHARED curLevel, colorTable(10)\r
+\r
+ RANDOMIZE TIMER\r
+ GOSUB ClearKeyLocks\r
+ Intro\r
+ GetInputs NumPlayers, speed, diff$, monitor$\r
+ GOSUB SetColors\r
+ DrawScreen\r
+\r
+ DO\r
+ PlayNibbles NumPlayers, speed, diff$\r
+ LOOP WHILE StillWantsToPlay\r
+\r
+ GOSUB RestoreKeyLocks\r
+ COLOR 15, 0\r
+ CLS\r
+END\r
+\r
+ClearKeyLocks:\r
+ DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock\r
+ KeyFlags = PEEK(1047)\r
+ POKE 1047, &H0\r
+ DEF SEG\r
+ RETURN\r
+\r
+RestoreKeyLocks:\r
+ DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states\r
+ POKE 1047, KeyFlags\r
+ DEF SEG\r
+ RETURN\r
+\r
+SetColors:\r
+ IF monitor$ = "M" THEN\r
+ RESTORE mono\r
+ ELSE\r
+ RESTORE normal\r
+ END IF\r
+\r
+ FOR a = 1 TO 6\r
+ READ colorTable(a)\r
+ NEXT a\r
+ RETURN\r
+\r
+ 'snake1 snake2 Walls Background Dialogs-Fore Back\r
+mono: DATA 15, 7, 7, 0, 15, 0\r
+normal: DATA 14, 13, 12, 1, 15, 4\r
+END\r
+\r
+'Center:\r
+' Centers text on given row\r
+SUB Center (row, text$)\r
+ LOCATE row, 41 - LEN(text$) / 2\r
+ PRINT text$;\r
+END SUB\r
+\r
+'DrawScreen:\r
+' Draws playing field\r
+SUB DrawScreen\r
+\r
+ 'initialize screen\r
+ VIEW PRINT\r
+ COLOR colorTable(1), colorTable(4)\r
+ CLS\r
+\r
+ 'Print title & message\r
+ Center 1, "Nibbles!"\r
+ Center 11, "Initializing Playing Field..."\r
+ \r
+ 'Initialize arena array\r
+ FOR row = 1 TO 50\r
+ FOR col = 1 TO 80\r
+ arena(row, col).realRow = INT((row + 1) / 2)\r
+ arena(row, col).sister = (row MOD 2) * 2 - 1\r
+ NEXT col\r
+ NEXT row\r
+END SUB\r
+\r
+'EraseSnake:\r
+' Erases snake to facilitate moving through playing field\r
+SUB EraseSnake (snake() AS snaketype, snakeBod() AS snakeBody, snakeNum)\r
+\r
+ FOR c = 0 TO 9\r
+ FOR b = snake(snakeNum).length - c TO 0 STEP -10\r
+ tail = (snake(snakeNum).head + MAXSNAKELENGTH - b) MOD MAXSNAKELENGTH\r
+ Set snakeBod(tail, snakeNum).row, snakeBod(tail, snakeNum).col, colorTable(4)\r
+ NEXT b\r
+ NEXT c\r
+ \r
+END SUB\r
+\r
+'GetInputs:\r
+' Gets player inputs\r
+SUB GetInputs (NumPlayers, speed, diff$, monitor$)\r
+\r
+ COLOR 7, 0\r
+ CLS\r
+\r
+ DO\r
+ LOCATE 5, 47: PRINT SPACE$(34);\r
+ LOCATE 5, 20\r
+ INPUT "How many players (1 or 2)"; num$\r
+ LOOP UNTIL VAL(num$) = 1 OR VAL(num$) = 2\r
+ NumPlayers = VAL(num$)\r
+\r
+ LOCATE 8, 21: PRINT "Skill level (1 to 100)"\r
+ LOCATE 9, 22: PRINT "1 = Novice"\r
+ LOCATE 10, 22: PRINT "90 = Expert"\r
+ LOCATE 11, 22: PRINT "100 = Twiddle Fingers"\r
+ LOCATE 12, 15: PRINT "(Computer speed may affect your skill level)"\r
+ DO\r
+ LOCATE 8, 44: PRINT SPACE$(35);\r
+ LOCATE 8, 43\r
+ INPUT gamespeed$\r
+ LOOP UNTIL VAL(gamespeed$) >= 1 AND VAL(gamespeed$) <= 100\r
+ speed = VAL(gamespeed$)\r
+ \r
+ speed = (100 - speed) * 2 + 1\r
+\r
+ DO\r
+ LOCATE 15, 56: PRINT SPACE$(25);\r
+ LOCATE 15, 15\r
+ INPUT "Increase game speed during play (Y or N)"; diff$\r
+ diff$ = UCASE$(diff$)\r
+ LOOP UNTIL diff$ = "Y" OR diff$ = "N"\r
+\r
+ DO\r
+ LOCATE 17, 46: PRINT SPACE$(34);\r
+ LOCATE 17, 17\r
+ INPUT "Monochrome or color monitor (M or C)"; monitor$\r
+ monitor$ = UCASE$(monitor$)\r
+ LOOP UNTIL monitor$ = "M" OR monitor$ = "C"\r
+\r
+ startTime# = TIMER ' Calculate speed of system\r
+ FOR i# = 1 TO 1000: NEXT i# ' and do some compensation\r
+ stopTime# = TIMER\r
+ speed = speed * .5 / (stopTime# - startTime#)\r
+\r
+END SUB\r
+\r
+'InitColors:\r
+'Initializes playing field colors\r
+SUB InitColors\r
+ \r
+ FOR row = 1 TO 50\r
+ FOR col = 1 TO 80\r
+ arena(row, col).acolor = colorTable(4)\r
+ NEXT col\r
+ NEXT row\r
+\r
+ CLS\r
+ \r
+ 'Set (turn on) pixels for screen border\r
+ FOR col = 1 TO 80\r
+ Set 3, col, colorTable(3)\r
+ Set 50, col, colorTable(3)\r
+ NEXT col\r
+\r
+ FOR row = 4 TO 49\r
+ Set row, 1, colorTable(3)\r
+ Set row, 80, colorTable(3)\r
+ NEXT row\r
+\r
+END SUB\r
+\r
+'Intro:\r
+' Displays game introduction\r
+SUB Intro\r
+ SCREEN 0\r
+ WIDTH 80, 25\r
+ COLOR 15, 0\r
+ CLS\r
+\r
+ Center 4, "Q B a s i c N i b b l e s"\r
+ COLOR 7\r
+ Center 6, "Copyright (C) Microsoft Corporation 1990"\r
+ Center 8, "Nibbles is a game for one or two players. Navigate your snakes"\r
+ Center 9, "around the game board trying to eat up numbers while avoiding"\r
+ Center 10, "running into walls or other snakes. The more numbers you eat up,"\r
+ Center 11, "the more points you gain and the longer your snake becomes."\r
+ Center 13, " Game Controls "\r
+ Center 15, " General Player 1 Player 2 "\r
+ Center 16, " (Up) (Up) "\r
+ Center 17, "P - Pause " + CHR$(24) + " W "\r
+ Center 18, " (Left) " + CHR$(27) + " " + CHR$(26) + " (Right) (Left) A D (Right) "\r
+ Center 19, " " + CHR$(25) + " S "\r
+ Center 20, " (Down) (Down) "\r
+ Center 24, "Press any key to continue"\r
+\r
+ PLAY "MBT160O1L8CDEDCDL4ECC"\r
+ SparklePause\r
+\r
+END SUB\r
+\r
+'Level:\r
+'Sets game level\r
+SUB Level (WhatToDO, sammy() AS snaketype) STATIC\r
+ \r
+ SELECT CASE (WhatToDO)\r
+\r
+ CASE STARTOVER\r
+ curLevel = 1\r
+ CASE NEXTLEVEL\r
+ curLevel = curLevel + 1\r
+ END SELECT\r
+\r
+ sammy(1).head = 1 'Initialize Snakes\r
+ sammy(1).length = 2\r
+ sammy(1).alive = TRUE\r
+ sammy(2).head = 1\r
+ sammy(2).length = 2\r
+ sammy(2).alive = TRUE\r
+\r
+ InitColors\r
+ \r
+ SELECT CASE curLevel\r
+ CASE 1\r
+ sammy(1).row = 25: sammy(2).row = 25\r
+ sammy(1).col = 50: sammy(2).col = 30\r
+ sammy(1).direction = 4: sammy(2).direction = 3\r
+\r
+\r
+ CASE 2\r
+ FOR i = 20 TO 60\r
+ Set 25, i, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 60: sammy(2).col = 20\r
+ sammy(1).direction = 3: sammy(2).direction = 4\r
+\r
+ CASE 3\r
+ FOR i = 10 TO 40\r
+ Set i, 20, colorTable(3)\r
+ Set i, 60, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 25: sammy(2).row = 25\r
+ sammy(1).col = 50: sammy(2).col = 30\r
+ sammy(1).direction = 1: sammy(2).direction = 2\r
+\r
+ CASE 4\r
+ FOR i = 4 TO 30\r
+ Set i, 20, colorTable(3)\r
+ Set 53 - i, 60, colorTable(3)\r
+ NEXT i\r
+ FOR i = 2 TO 40\r
+ Set 38, i, colorTable(3)\r
+ Set 15, 81 - i, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 60: sammy(2).col = 20\r
+ sammy(1).direction = 3: sammy(2).direction = 4\r
+ \r
+ CASE 5\r
+ FOR i = 13 TO 39\r
+ Set i, 21, colorTable(3)\r
+ Set i, 59, colorTable(3)\r
+ NEXT i\r
+ FOR i = 23 TO 57\r
+ Set 11, i, colorTable(3)\r
+ Set 41, i, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 25: sammy(2).row = 25\r
+ sammy(1).col = 50: sammy(2).col = 30\r
+ sammy(1).direction = 1: sammy(2).direction = 2\r
+\r
+ CASE 6\r
+ FOR i = 4 TO 49\r
+ IF i > 30 OR i < 23 THEN\r
+ Set i, 10, colorTable(3)\r
+ Set i, 20, colorTable(3)\r
+ Set i, 30, colorTable(3)\r
+ Set i, 40, colorTable(3)\r
+ Set i, 50, colorTable(3)\r
+ Set i, 60, colorTable(3)\r
+ Set i, 70, colorTable(3)\r
+ END IF\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 65: sammy(2).col = 15\r
+ sammy(1).direction = 2: sammy(2).direction = 1\r
+\r
+ CASE 7\r
+ FOR i = 4 TO 49 STEP 2\r
+ Set i, 40, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 65: sammy(2).col = 15\r
+ sammy(1).direction = 2: sammy(2).direction = 1\r
+\r
+ CASE 8\r
+ FOR i = 4 TO 40\r
+ Set i, 10, colorTable(3)\r
+ Set 53 - i, 20, colorTable(3)\r
+ Set i, 30, colorTable(3)\r
+ Set 53 - i, 40, colorTable(3)\r
+ Set i, 50, colorTable(3)\r
+ Set 53 - i, 60, colorTable(3)\r
+ Set i, 70, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 65: sammy(2).col = 15\r
+ sammy(1).direction = 2: sammy(2).direction = 1\r
+\r
+ CASE 9\r
+ FOR i = 6 TO 47\r
+ Set i, i, colorTable(3)\r
+ Set i, i + 28, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 40: sammy(2).row = 15\r
+ sammy(1).col = 75: sammy(2).col = 5\r
+ sammy(1).direction = 1: sammy(2).direction = 2\r
+ \r
+ CASE ELSE\r
+ FOR i = 4 TO 49 STEP 2\r
+ Set i, 10, colorTable(3)\r
+ Set i + 1, 20, colorTable(3)\r
+ Set i, 30, colorTable(3)\r
+ Set i + 1, 40, colorTable(3)\r
+ Set i, 50, colorTable(3)\r
+ Set i + 1, 60, colorTable(3)\r
+ Set i, 70, colorTable(3)\r
+ NEXT i\r
+ sammy(1).row = 7: sammy(2).row = 43\r
+ sammy(1).col = 65: sammy(2).col = 15\r
+ sammy(1).direction = 2: sammy(2).direction = 1\r
+\r
+ END SELECT\r
+END SUB\r
+\r
+'PlayNibbles:\r
+' Main routine that controls game play\r
+SUB PlayNibbles (NumPlayers, speed, diff$)\r
+\r
+ 'Initialize Snakes\r
+ DIM sammyBody(MAXSNAKELENGTH - 1, 1 TO 2) AS snakeBody\r
+ DIM sammy(1 TO 2) AS snaketype\r
+ sammy(1).lives = 5\r
+ sammy(1).score = 0\r
+ sammy(1).scolor = colorTable(1)\r
+ sammy(2).lives = 5\r
+ sammy(2).score = 0\r
+ sammy(2).scolor = colorTable(2)\r
+ \r
+ Level STARTOVER, sammy()\r
+ startRow1 = sammy(1).row: startCol1 = sammy(1).col\r
+ startRow2 = sammy(2).row: startCol2 = sammy(2).col\r
+\r
+ curSpeed = speed\r
+\r
+ 'play Nibbles until finished\r
+\r
+ SpacePause " Level" + STR$(curLevel) + ", Push Space"\r
+ gameOver = FALSE\r
+ DO\r
+ IF NumPlayers = 1 THEN\r
+ sammy(2).row = 0\r
+ END IF\r
+\r
+ number = 1 'Current number that snakes are trying to run into\r
+ nonum = TRUE 'nonum = TRUE if a number is not on the screen\r
+\r
+ playerDied = FALSE\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ PLAY "T160O1>L20CDEDCDL10ECC"\r
+\r
+ DO\r
+ 'Print number if no number exists\r
+ IF nonum = TRUE THEN\r
+ DO\r
+ numberRow = INT(RND(1) * 47 + 3)\r
+ NumberCol = INT(RND(1) * 78 + 2)\r
+ sisterRow = numberRow + arena(numberRow, NumberCol).sister\r
+ LOOP UNTIL NOT PointIsThere(numberRow, NumberCol, colorTable(4)) AND NOT PointIsThere(sisterRow, NumberCol, colorTable(4))\r
+ numberRow = arena(numberRow, NumberCol).realRow\r
+ nonum = FALSE\r
+ COLOR colorTable(1), colorTable(4)\r
+ LOCATE numberRow, NumberCol\r
+ PRINT RIGHT$(STR$(number), 1);\r
+ count = 0\r
+ END IF\r
+\r
+ 'Delay game\r
+ FOR a# = 1 TO curSpeed: NEXT a#\r
+\r
+ 'Get keyboard input & Change direction accordingly\r
+ kbd$ = INKEY$\r
+ SELECT CASE kbd$\r
+ CASE "w", "W": IF sammy(2).direction <> 2 THEN sammy(2).direction = 1\r
+ CASE "s", "S": IF sammy(2).direction <> 1 THEN sammy(2).direction = 2\r
+ CASE "a", "A": IF sammy(2).direction <> 4 THEN sammy(2).direction = 3\r
+ CASE "d", "D": IF sammy(2).direction <> 3 THEN sammy(2).direction = 4\r
+ CASE CHR$(0) + "H": IF sammy(1).direction <> 2 THEN sammy(1).direction = 1\r
+ CASE CHR$(0) + "P": IF sammy(1).direction <> 1 THEN sammy(1).direction = 2\r
+ CASE CHR$(0) + "K": IF sammy(1).direction <> 4 THEN sammy(1).direction = 3\r
+ CASE CHR$(0) + "M": IF sammy(1).direction <> 3 THEN sammy(1).direction = 4\r
+ CASE "p", "P": SpacePause " Game Paused ... Push Space "\r
+ CASE ELSE\r
+ END SELECT\r
+\r
+ FOR a = 1 TO NumPlayers\r
+ 'Move Snake\r
+ SELECT CASE sammy(a).direction\r
+ CASE 1: sammy(a).row = sammy(a).row - 1\r
+ CASE 2: sammy(a).row = sammy(a).row + 1\r
+ CASE 3: sammy(a).col = sammy(a).col - 1\r
+ CASE 4: sammy(a).col = sammy(a).col + 1\r
+ END SELECT\r
+\r
+ 'If snake hits number, respond accordingly\r
+ IF numberRow = INT((sammy(a).row + 1) / 2) AND NumberCol = sammy(a).col THEN\r
+ PLAY "MBO0L16>CCCE"\r
+ IF sammy(a).length < (MAXSNAKELENGTH - 30) THEN\r
+ sammy(a).length = sammy(a).length + number * 4\r
+ END IF\r
+ sammy(a).score = sammy(a).score + number\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ number = number + 1\r
+ IF number = 10 THEN\r
+ EraseSnake sammy(), sammyBody(), 1\r
+ EraseSnake sammy(), sammyBody(), 2\r
+ LOCATE numberRow, NumberCol: PRINT " "\r
+ Level NEXTLEVEL, sammy()\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ SpacePause " Level" + STR$(curLevel) + ", Push Space"\r
+ IF NumPlayers = 1 THEN sammy(2).row = 0\r
+ number = 1\r
+ IF diff$ = "P" THEN speed = speed - 10: curSpeed = speed\r
+ END IF\r
+ nonum = TRUE\r
+ IF curSpeed < 1 THEN curSpeed = 1\r
+ END IF\r
+ NEXT a\r
+\r
+ FOR a = 1 TO NumPlayers\r
+ 'If player runs into any point, or the head of the other snake, it dies.\r
+ IF PointIsThere(sammy(a).row, sammy(a).col, colorTable(4)) OR (sammy(1).row = sammy(2).row AND sammy(1).col = sammy(2).col) THEN\r
+ PLAY "MBO0L32EFGEFDC"\r
+ COLOR , colorTable(4)\r
+ LOCATE numberRow, NumberCol\r
+ PRINT " "\r
+ \r
+ playerDied = TRUE\r
+ sammy(a).alive = FALSE\r
+ sammy(a).lives = sammy(a).lives - 1\r
+\r
+ 'Otherwise, move the snake, and erase the tail\r
+ ELSE\r
+ sammy(a).head = (sammy(a).head + 1) MOD MAXSNAKELENGTH\r
+ sammyBody(sammy(a).head, a).row = sammy(a).row\r
+ sammyBody(sammy(a).head, a).col = sammy(a).col\r
+ tail = (sammy(a).head + MAXSNAKELENGTH - sammy(a).length) MOD MAXSNAKELENGTH\r
+ Set sammyBody(tail, a).row, sammyBody(tail, a).col, colorTable(4)\r
+ sammyBody(tail, a).row = 0\r
+ Set sammy(a).row, sammy(a).col, sammy(a).scolor\r
+ END IF\r
+ NEXT a\r
+\r
+ LOOP UNTIL playerDied\r
+\r
+ curSpeed = speed ' reset speed to initial value\r
+ \r
+ FOR a = 1 TO NumPlayers\r
+ EraseSnake sammy(), sammyBody(), a\r
+\r
+ 'If dead, then erase snake in really cool way\r
+ IF sammy(a).alive = FALSE THEN\r
+ 'Update score\r
+ sammy(a).score = sammy(a).score - 10\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ \r
+ IF a = 1 THEN\r
+ SpacePause " Sammy Dies! Push Space! --->"\r
+ ELSE\r
+ SpacePause " <---- Jake Dies! Push Space "\r
+ END IF\r
+ END IF\r
+ NEXT a\r
+\r
+ Level SAMELEVEL, sammy()\r
+ PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives\r
+ \r
+ 'Play next round, until either of snake's lives have run out.\r
+ LOOP UNTIL sammy(1).lives = 0 OR sammy(2).lives = 0\r
+\r
+END SUB\r
+\r
+'PointIsThere:\r
+' Checks the global arena array to see if the boolean flag is set\r
+FUNCTION PointIsThere (row, col, acolor)\r
+ IF row <> 0 THEN\r
+ IF arena(row, col).acolor <> acolor THEN\r
+ PointIsThere = TRUE\r
+ ELSE\r
+ PointIsThere = FALSE\r
+ END IF\r
+ END IF\r
+END FUNCTION\r
+\r
+'PrintScore:\r
+' Prints players scores and number of lives remaining\r
+SUB PrintScore (NumPlayers, score1, score2, lives1, lives2)\r
+ COLOR 15, colorTable(4)\r
+\r
+ IF NumPlayers = 2 THEN\r
+ LOCATE 1, 1\r
+ PRINT USING "#,###,#00 Lives: # <--JAKE"; score2; lives2\r
+ END IF\r
+\r
+ LOCATE 1, 49\r
+ PRINT USING "SAMMY--> Lives: # #,###,#00"; lives1; score1\r
+END SUB\r
+\r
+'Set:\r
+' Sets row and column on playing field to given color to facilitate moving\r
+' of snakes around the field.\r
+SUB Set (row, col, acolor)\r
+ IF row <> 0 THEN\r
+ arena(row, col).acolor = acolor 'assign color to arena\r
+ realRow = arena(row, col).realRow 'Get real row of pixel\r
+ topFlag = arena(row, col).sister + 1 / 2 'Deduce whether pixel\r
+ 'is on topß, or bottomÜ\r
+ sisterRow = row + arena(row, col).sister 'Get arena row of sister\r
+ sisterColor = arena(sisterRow, col).acolor 'Determine sister's color\r
+\r
+ LOCATE realRow, col\r
+\r
+ IF acolor = sisterColor THEN 'If both points are same\r
+ COLOR acolor, acolor 'Print chr$(219) "Û"\r
+ PRINT CHR$(219);\r
+ ELSE\r
+ IF topFlag THEN 'Since you cannot have\r
+ IF acolor > 7 THEN 'bright backgrounds\r
+ COLOR acolor, sisterColor 'determine best combo\r
+ PRINT CHR$(223); 'to use.\r
+ ELSE\r
+ COLOR sisterColor, acolor\r
+ PRINT CHR$(220);\r
+ END IF\r
+ ELSE\r
+ IF acolor > 7 THEN\r
+ COLOR acolor, sisterColor\r
+ PRINT CHR$(220);\r
+ ELSE\r
+ COLOR sisterColor, acolor\r
+ PRINT CHR$(223);\r
+ END IF\r
+ END IF\r
+ END IF\r
+ END IF\r
+END SUB\r
+\r
+'SpacePause:\r
+' Pauses game play and waits for space bar to be pressed before continuing\r
+SUB SpacePause (text$)\r
+\r
+ COLOR colorTable(5), colorTable(6)\r
+ Center 11, "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"\r
+ Center 12, "Û " + LEFT$(text$ + SPACE$(29), 29) + " Û"\r
+ Center 13, "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"\r
+ WHILE INKEY$ <> "": WEND\r
+ WHILE INKEY$ <> " ": WEND\r
+ COLOR 15, colorTable(4)\r
+\r
+ FOR i = 21 TO 26 ' Restore the screen background\r
+ FOR j = 24 TO 56\r
+ Set i, j, arena(i, j).acolor\r
+ NEXT j\r
+ NEXT i\r
+\r
+END SUB\r
+\r
+'SparklePause:\r
+' Creates flashing border for intro screen\r
+SUB SparklePause\r
+\r
+ COLOR 4, 0\r
+ a$ = "* * * * * * * * * * * * * * * * * "\r
+ WHILE INKEY$ <> "": WEND 'Clear keyboard buffer\r
+\r
+ WHILE INKEY$ = ""\r
+ FOR a = 1 TO 5\r
+ LOCATE 1, 1 'print horizontal sparkles\r
+ PRINT MID$(a$, a, 80);\r
+ LOCATE 22, 1\r
+ PRINT MID$(a$, 6 - a, 80);\r
+\r
+ FOR b = 2 TO 21 'Print Vertical sparkles\r
+ c = (a + b) MOD 5\r
+ IF c = 1 THEN\r
+ LOCATE b, 80\r
+ PRINT "*";\r
+ LOCATE 23 - b, 1\r
+ PRINT "*";\r
+ ELSE\r
+ LOCATE b, 80\r
+ PRINT " ";\r
+ LOCATE 23 - b, 1\r
+ PRINT " ";\r
+ END IF\r
+ NEXT b\r
+ NEXT a\r
+ WEND\r
+\r
+END SUB\r
+\r
+'StillWantsToPlay:\r
+' Determines if users want to play game again.\r
+FUNCTION StillWantsToPlay\r
+\r
+ COLOR colorTable(5), colorTable(6)\r
+ Center 10, "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"\r
+ Center 11, "Û G A M E O V E R Û"\r
+ Center 12, "Û Û"\r
+ Center 13, "Û Play Again? (Y/N) Û"\r
+ Center 14, "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"\r
+\r
+ WHILE INKEY$ <> "": WEND\r
+ DO\r
+ kbd$ = UCASE$(INKEY$)\r
+ LOOP UNTIL kbd$ = "Y" OR kbd$ = "N"\r
+\r
+ COLOR 15, colorTable(4)\r
+ Center 10, " "\r
+ Center 11, " "\r
+ Center 12, " "\r
+ Center 13, " "\r
+ Center 14, " "\r
+\r
+ IF kbd$ = "Y" THEN\r
+ StillWantsToPlay = TRUE\r
+ ELSE\r
+ StillWantsToPlay = FALSE\r
+ COLOR 7, 0\r
+ CLS\r
+ END IF\r
+\r
+END FUNCTION\r
+\r
+\1a
\ No newline at end of file
GIT.Harvie.CZ / mirrors / Programs.git / blobdiff