+++ /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