2 ' Q B a s i c N i b b l e s
4 ' Copyright (C) Microsoft Corporation 1990
6 ' Nibbles is a game for one or two players. Navigate your snakes
7 ' around the game board trying to eat up numbers while avoiding
8 ' running into walls or other snakes. The more numbers you eat up,
9 ' the more points you gain and the longer your snake becomes.
11 ' To run this game, press Shift+F5.
13 ' To exit QBasic, press Alt, F, X.
15 ' To get help on a BASIC keyword, move the cursor to the keyword and press
16 ' F1 or click the right mouse button.
19 'Set default data type to integer for faster game play
28 'This type defines the player's snake
41 'This type is used to represent the playing screen in memory
42 'It is used to simulate graphics in text mode, and has some interesting,
43 'and slightly advanced methods to increasing the speed of operation.
44 'Instead of the normal 80x25 text graphics using chr$(219) "Û", we will be
45 'using chr$(220)"Ü" and chr$(223) "ß" and chr$(219) "Û" to mimic an 80x50
47 'Check out sub-programs SET and POINTISTHERE to see how this is implemented
48 'feel free to copy these (as well as arenaType and the DIM ARENA stmt and the
49 'initialization code in the DrawScreen subprogram) and use them in your own
52 realRow AS INTEGER 'Maps the 80x50 point into the real 80x25
53 acolor AS INTEGER 'Stores the current color of the point
54 sister AS INTEGER 'Each char has 2 points in it. .SISTER is
55 END TYPE '-1 if sister point is above, +1 if below
58 DECLARE SUB SpacePause (text$)
59 DECLARE SUB PrintScore (NumPlayers%, score1%, score2%, lives1%, lives2%)
61 DECLARE SUB GetInputs (NumPlayers, speed, diff$, monitor$)
62 DECLARE SUB DrawScreen ()
63 DECLARE SUB PlayNibbles (NumPlayers, speed, diff$)
64 DECLARE SUB Set (row, col, acolor)
65 DECLARE SUB Center (row, text$)
66 DECLARE SUB DoIntro ()
67 DECLARE SUB Initialize ()
68 DECLARE SUB SparklePause ()
69 DECLARE SUB Level (WhatToDO, sammy() AS snaketype)
70 DECLARE SUB InitColors ()
71 DECLARE SUB EraseSnake (snake() AS ANY, snakeBod() AS ANY, snakeNum%)
72 DECLARE FUNCTION StillWantsToPlay ()
73 DECLARE FUNCTION PointIsThere (row, col, backColor)
77 CONST FALSE = NOT TRUE
78 CONST MAXSNAKELENGTH = 1000
79 CONST STARTOVER = 1 ' Parameters to 'Level' SUB
84 DIM SHARED arena(1 TO 50, 1 TO 80) AS arenaType
85 DIM SHARED curLevel, colorTable(10)
90 GetInputs NumPlayers, speed, diff$, monitor$
95 PlayNibbles NumPlayers, speed, diff$
96 LOOP WHILE StillWantsToPlay
104 DEF SEG = 0 ' Turn off CapLock, NumLock and ScrollLock
105 KeyFlags = PEEK(1047)
111 DEF SEG = 0 ' Restore CapLock, NumLock and ScrollLock states
117 IF monitor$ = "M" THEN
128 'snake1 snake2 Walls Background Dialogs-Fore Back
129 mono: DATA 15, 7, 7, 0, 15, 0
130 normal: DATA 14, 13, 12, 1, 15, 4
134 ' Centers text on given row
135 SUB Center (row, text$)
136 LOCATE row, 41 - LEN(text$) / 2
141 ' Draws playing field
146 COLOR colorTable(1), colorTable(4)
149 'Print title & message
151 Center 11, "Initializing Playing Field..."
153 'Initialize arena array
156 arena(row, col).realRow = INT((row + 1) / 2)
157 arena(row, col).sister = (row MOD 2) * 2 - 1
163 ' Erases snake to facilitate moving through playing field
164 SUB EraseSnake (snake() AS snaketype, snakeBod() AS snakeBody, snakeNum)
167 FOR b = snake(snakeNum).length - c TO 0 STEP -10
168 tail = (snake(snakeNum).head + MAXSNAKELENGTH - b) MOD MAXSNAKELENGTH
169 Set snakeBod(tail, snakeNum).row, snakeBod(tail, snakeNum).col, colorTable(4)
177 SUB GetInputs (NumPlayers, speed, diff$, monitor$)
183 LOCATE 5, 47: PRINT SPACE$(34);
185 INPUT "How many players (1 or 2)"; num$
186 LOOP UNTIL VAL(num$) = 1 OR VAL(num$) = 2
187 NumPlayers = VAL(num$)
189 LOCATE 8, 21: PRINT "Skill level (1 to 100)"
190 LOCATE 9, 22: PRINT "1 = Novice"
191 LOCATE 10, 22: PRINT "90 = Expert"
192 LOCATE 11, 22: PRINT "100 = Twiddle Fingers"
193 LOCATE 12, 15: PRINT "(Computer speed may affect your skill level)"
195 LOCATE 8, 44: PRINT SPACE$(35);
198 LOOP UNTIL VAL(gamespeed$) >= 1 AND VAL(gamespeed$) <= 100
199 speed = VAL(gamespeed$)
201 speed = (100 - speed) * 2 + 1
204 LOCATE 15, 56: PRINT SPACE$(25);
206 INPUT "Increase game speed during play (Y or N)"; diff$
207 diff$ = UCASE$(diff$)
208 LOOP UNTIL diff$ = "Y" OR diff$ = "N"
211 LOCATE 17, 46: PRINT SPACE$(34);
213 INPUT "Monochrome or color monitor (M or C)"; monitor$
214 monitor$ = UCASE$(monitor$)
215 LOOP UNTIL monitor$ = "M" OR monitor$ = "C"
217 startTime# = TIMER ' Calculate speed of system
218 FOR i# = 1 TO 1000: NEXT i# ' and do some compensation
220 speed = speed * .5 / (stopTime# - startTime#)
225 'Initializes playing field colors
230 arena(row, col).acolor = colorTable(4)
236 'Set (turn on) pixels for screen border
238 Set 3, col, colorTable(3)
239 Set 50, col, colorTable(3)
243 Set row, 1, colorTable(3)
244 Set row, 80, colorTable(3)
250 ' Displays game introduction
257 Center 4, "Q B a s i c N i b b l e s"
259 Center 6, "Copyright (C) Microsoft Corporation 1990"
260 Center 8, "Nibbles is a game for one or two players. Navigate your snakes"
261 Center 9, "around the game board trying to eat up numbers while avoiding"
262 Center 10, "running into walls or other snakes. The more numbers you eat up,"
263 Center 11, "the more points you gain and the longer your snake becomes."
264 Center 13, " Game Controls "
265 Center 15, " General Player 1 Player 2 "
266 Center 16, " (Up) (Up) "
267 Center 17, "P - Pause " + CHR$(24) + " W "
268 Center 18, " (Left) " + CHR$(27) + " " + CHR$(26) + " (Right) (Left) A D (Right) "
269 Center 19, " " + CHR$(25) + " S "
270 Center 20, " (Down) (Down) "
271 Center 24, "Press any key to continue"
273 PLAY "MBT160O1L8CDEDCDL4ECC"
280 SUB Level (WhatToDO, sammy() AS snaketype) STATIC
282 SELECT CASE (WhatToDO)
287 curLevel = curLevel + 1
290 sammy(1).head = 1 'Initialize Snakes
292 sammy(1).alive = TRUE
295 sammy(2).alive = TRUE
301 sammy(1).row = 25: sammy(2).row = 25
302 sammy(1).col = 50: sammy(2).col = 30
303 sammy(1).direction = 4: sammy(2).direction = 3
308 Set 25, i, colorTable(3)
310 sammy(1).row = 7: sammy(2).row = 43
311 sammy(1).col = 60: sammy(2).col = 20
312 sammy(1).direction = 3: sammy(2).direction = 4
316 Set i, 20, colorTable(3)
317 Set i, 60, colorTable(3)
319 sammy(1).row = 25: sammy(2).row = 25
320 sammy(1).col = 50: sammy(2).col = 30
321 sammy(1).direction = 1: sammy(2).direction = 2
325 Set i, 20, colorTable(3)
326 Set 53 - i, 60, colorTable(3)
329 Set 38, i, colorTable(3)
330 Set 15, 81 - i, colorTable(3)
332 sammy(1).row = 7: sammy(2).row = 43
333 sammy(1).col = 60: sammy(2).col = 20
334 sammy(1).direction = 3: sammy(2).direction = 4
338 Set i, 21, colorTable(3)
339 Set i, 59, colorTable(3)
342 Set 11, i, colorTable(3)
343 Set 41, i, colorTable(3)
345 sammy(1).row = 25: sammy(2).row = 25
346 sammy(1).col = 50: sammy(2).col = 30
347 sammy(1).direction = 1: sammy(2).direction = 2
351 IF i > 30 OR i < 23 THEN
352 Set i, 10, colorTable(3)
353 Set i, 20, colorTable(3)
354 Set i, 30, colorTable(3)
355 Set i, 40, colorTable(3)
356 Set i, 50, colorTable(3)
357 Set i, 60, colorTable(3)
358 Set i, 70, colorTable(3)
361 sammy(1).row = 7: sammy(2).row = 43
362 sammy(1).col = 65: sammy(2).col = 15
363 sammy(1).direction = 2: sammy(2).direction = 1
366 FOR i = 4 TO 49 STEP 2
367 Set i, 40, colorTable(3)
369 sammy(1).row = 7: sammy(2).row = 43
370 sammy(1).col = 65: sammy(2).col = 15
371 sammy(1).direction = 2: sammy(2).direction = 1
375 Set i, 10, colorTable(3)
376 Set 53 - i, 20, colorTable(3)
377 Set i, 30, colorTable(3)
378 Set 53 - i, 40, colorTable(3)
379 Set i, 50, colorTable(3)
380 Set 53 - i, 60, colorTable(3)
381 Set i, 70, colorTable(3)
383 sammy(1).row = 7: sammy(2).row = 43
384 sammy(1).col = 65: sammy(2).col = 15
385 sammy(1).direction = 2: sammy(2).direction = 1
389 Set i, i, colorTable(3)
390 Set i, i + 28, colorTable(3)
392 sammy(1).row = 40: sammy(2).row = 15
393 sammy(1).col = 75: sammy(2).col = 5
394 sammy(1).direction = 1: sammy(2).direction = 2
397 FOR i = 4 TO 49 STEP 2
398 Set i, 10, colorTable(3)
399 Set i + 1, 20, colorTable(3)
400 Set i, 30, colorTable(3)
401 Set i + 1, 40, colorTable(3)
402 Set i, 50, colorTable(3)
403 Set i + 1, 60, colorTable(3)
404 Set i, 70, colorTable(3)
406 sammy(1).row = 7: sammy(2).row = 43
407 sammy(1).col = 65: sammy(2).col = 15
408 sammy(1).direction = 2: sammy(2).direction = 1
414 ' Main routine that controls game play
415 SUB PlayNibbles (NumPlayers, speed, diff$)
418 DIM sammyBody(MAXSNAKELENGTH - 1, 1 TO 2) AS snakeBody
419 DIM sammy(1 TO 2) AS snaketype
422 sammy(1).scolor = colorTable(1)
425 sammy(2).scolor = colorTable(2)
427 Level STARTOVER, sammy()
428 startRow1 = sammy(1).row: startCol1 = sammy(1).col
429 startRow2 = sammy(2).row: startCol2 = sammy(2).col
433 'play Nibbles until finished
435 SpacePause " Level" + STR$(curLevel) + ", Push Space"
438 IF NumPlayers = 1 THEN
442 number = 1 'Current number that snakes are trying to run into
443 nonum = TRUE 'nonum = TRUE if a number is not on the screen
446 PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives
447 PLAY "T160O1>L20CDEDCDL10ECC"
450 'Print number if no number exists
453 numberRow = INT(RND(1) * 47 + 3)
454 NumberCol = INT(RND(1) * 78 + 2)
455 sisterRow = numberRow + arena(numberRow, NumberCol).sister
456 LOOP UNTIL NOT PointIsThere(numberRow, NumberCol, colorTable(4)) AND NOT PointIsThere(sisterRow, NumberCol, colorTable(4))
457 numberRow = arena(numberRow, NumberCol).realRow
459 COLOR colorTable(1), colorTable(4)
460 LOCATE numberRow, NumberCol
461 PRINT RIGHT$(STR$(number), 1);
466 FOR a# = 1 TO curSpeed: NEXT a#
468 'Get keyboard input & Change direction accordingly
471 CASE "w", "W": IF sammy(2).direction <> 2 THEN sammy(2).direction = 1
472 CASE "s", "S": IF sammy(2).direction <> 1 THEN sammy(2).direction = 2
473 CASE "a", "A": IF sammy(2).direction <> 4 THEN sammy(2).direction = 3
474 CASE "d", "D": IF sammy(2).direction <> 3 THEN sammy(2).direction = 4
475 CASE CHR$(0) + "H": IF sammy(1).direction <> 2 THEN sammy(1).direction = 1
476 CASE CHR$(0) + "P": IF sammy(1).direction <> 1 THEN sammy(1).direction = 2
477 CASE CHR$(0) + "K": IF sammy(1).direction <> 4 THEN sammy(1).direction = 3
478 CASE CHR$(0) + "M": IF sammy(1).direction <> 3 THEN sammy(1).direction = 4
479 CASE "p", "P": SpacePause " Game Paused ... Push Space "
483 FOR a = 1 TO NumPlayers
485 SELECT CASE sammy(a).direction
486 CASE 1: sammy(a).row = sammy(a).row - 1
487 CASE 2: sammy(a).row = sammy(a).row + 1
488 CASE 3: sammy(a).col = sammy(a).col - 1
489 CASE 4: sammy(a).col = sammy(a).col + 1
492 'If snake hits number, respond accordingly
493 IF numberRow = INT((sammy(a).row + 1) / 2) AND NumberCol = sammy(a).col THEN
495 IF sammy(a).length < (MAXSNAKELENGTH - 30) THEN
496 sammy(a).length = sammy(a).length + number * 4
498 sammy(a).score = sammy(a).score + number
499 PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives
502 EraseSnake sammy(), sammyBody(), 1
503 EraseSnake sammy(), sammyBody(), 2
504 LOCATE numberRow, NumberCol: PRINT " "
505 Level NEXTLEVEL, sammy()
506 PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives
507 SpacePause " Level" + STR$(curLevel) + ", Push Space"
508 IF NumPlayers = 1 THEN sammy(2).row = 0
510 IF diff$ = "P" THEN speed = speed - 10: curSpeed = speed
513 IF curSpeed < 1 THEN curSpeed = 1
517 FOR a = 1 TO NumPlayers
518 'If player runs into any point, or the head of the other snake, it dies.
519 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
520 PLAY "MBO0L32EFGEFDC"
521 COLOR , colorTable(4)
522 LOCATE numberRow, NumberCol
526 sammy(a).alive = FALSE
527 sammy(a).lives = sammy(a).lives - 1
529 'Otherwise, move the snake, and erase the tail
531 sammy(a).head = (sammy(a).head + 1) MOD MAXSNAKELENGTH
532 sammyBody(sammy(a).head, a).row = sammy(a).row
533 sammyBody(sammy(a).head, a).col = sammy(a).col
534 tail = (sammy(a).head + MAXSNAKELENGTH - sammy(a).length) MOD MAXSNAKELENGTH
535 Set sammyBody(tail, a).row, sammyBody(tail, a).col, colorTable(4)
536 sammyBody(tail, a).row = 0
537 Set sammy(a).row, sammy(a).col, sammy(a).scolor
541 LOOP UNTIL playerDied
543 curSpeed = speed ' reset speed to initial value
545 FOR a = 1 TO NumPlayers
546 EraseSnake sammy(), sammyBody(), a
548 'If dead, then erase snake in really cool way
549 IF sammy(a).alive = FALSE THEN
551 sammy(a).score = sammy(a).score - 10
552 PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives
555 SpacePause " Sammy Dies! Push Space! --->"
557 SpacePause " <---- Jake Dies! Push Space "
562 Level SAMELEVEL, sammy()
563 PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(1).lives, sammy(2).lives
565 'Play next round, until either of snake's lives have run out.
566 LOOP UNTIL sammy(1).lives = 0 OR sammy(2).lives = 0
571 ' Checks the global arena array to see if the boolean flag is set
572 FUNCTION PointIsThere (row, col, acolor)
574 IF arena(row, col).acolor <> acolor THEN
583 ' Prints players scores and number of lives remaining
584 SUB PrintScore (NumPlayers, score1, score2, lives1, lives2)
585 COLOR 15, colorTable(4)
587 IF NumPlayers = 2 THEN
589 PRINT USING "#,###,#00 Lives: # <--JAKE"; score2; lives2
593 PRINT USING "SAMMY--> Lives: # #,###,#00"; lives1; score1
597 ' Sets row and column on playing field to given color to facilitate moving
598 ' of snakes around the field.
599 SUB Set (row, col, acolor)
601 arena(row, col).acolor = acolor 'assign color to arena
602 realRow = arena(row, col).realRow 'Get real row of pixel
603 topFlag = arena(row, col).sister + 1 / 2 'Deduce whether pixel
604 'is on topß, or bottomÜ
605 sisterRow = row + arena(row, col).sister 'Get arena row of sister
606 sisterColor = arena(sisterRow, col).acolor 'Determine sister's color
610 IF acolor = sisterColor THEN 'If both points are same
611 COLOR acolor, acolor 'Print chr$(219) "Û"
614 IF topFlag THEN 'Since you cannot have
615 IF acolor > 7 THEN 'bright backgrounds
616 COLOR acolor, sisterColor 'determine best combo
617 PRINT CHR$(223); 'to use.
619 COLOR sisterColor, acolor
624 COLOR acolor, sisterColor
627 COLOR sisterColor, acolor
636 ' Pauses game play and waits for space bar to be pressed before continuing
637 SUB SpacePause (text$)
639 COLOR colorTable(5), colorTable(6)
640 Center 11, "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"
641 Center 12, "Û " + LEFT$(text$ + SPACE$(29), 29) + " Û"
642 Center 13, "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"
643 WHILE INKEY$ <> "": WEND
644 WHILE INKEY$ <> " ": WEND
645 COLOR 15, colorTable(4)
647 FOR i = 21 TO 26 ' Restore the screen background
649 Set i, j, arena(i, j).acolor
656 ' Creates flashing border for intro screen
660 a$ = "* * * * * * * * * * * * * * * * * "
661 WHILE INKEY$ <> "": WEND 'Clear keyboard buffer
665 LOCATE 1, 1 'print horizontal sparkles
666 PRINT MID$(a$, a, 80);
668 PRINT MID$(a$, 6 - a, 80);
670 FOR b = 2 TO 21 'Print Vertical sparkles
690 ' Determines if users want to play game again.
691 FUNCTION StillWantsToPlay
693 COLOR colorTable(5), colorTable(6)
694 Center 10, "ÛßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßßÛ"
695 Center 11, "Û G A M E O V E R Û"
697 Center 13, "Û Play Again? (Y/N) Û"
698 Center 14, "ÛÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÜÛ"
700 WHILE INKEY$ <> "": WEND
702 kbd$ = UCASE$(INKEY$)
703 LOOP UNTIL kbd$ = "Y" OR kbd$ = "N"
705 COLOR 15, colorTable(4)
713 StillWantsToPlay = TRUE
715 StillWantsToPlay = FALSE