'' QB asic N ibble s '' Copyright (C) Microsoft Corporation 1990 '' Nibbles is a game for one or two players. Navigate your snakes 'around the game board trying to eat up numbers while avoiding' running into walls or other snakes . '' 'To Run this game, Press Shift F5.' 'To EXIT QBASIC, PRESS ALT, F, X.' 'TO GET Help ON A Basic Keyword, Move The Cursor To The Keyword and Press 'F1 Or Click The Right Mouse Button.'
'Set default data type to integer for faster game playdefint a-z
'User-Defined TypeStype Snakebody Row As INTEGER COL AS INTEGEREND TYPE
'This type defines the player's snakeTYPE snaketype head AS INTEGER length AS INTEGER row AS INTEGER col AS INTEGER direction AS INTEGER lives AS INTEGER score AS INTEGER scolor AS INTEGER alive AS INTEGEREND TYPE
'This type is used to represent the playing screen in memory'It is used to simulate graphics in text mode, and has some interesting,' and slightly advanced methods to increasing the speed of operation.'Instead of the normal 80x25 text graphics using chr $ (219) "?, WE WILL BE'USING CHR $ (220)"? And chr $ (223) "and chr $ (219)"? To mimic an 80x50'pixel screen.'Check out sub-programs set and POINTISTHERE to see how this is implemented'feel free to copy these (as well as arenaType and the DIM ARENA stmt and the'initialization code in the DrawScreen subprogram) and use them in your own'programsTYPE arenaType realRow AS INTEGER 'Maps the 80x50 point into the real 80x25 acolor AS INTEGER 'Stores the current color of the point sister AS INTEGER' Each char has 2 points in it. .SISTER isEND TYPE '-1 if sister point is above, 1 if below'Sub DeclarationsDECLARE SUB SpacePause (Text $) Declare Sub PRINTSCORE (Numplayers%, Score1%, SC ore2%, lives1%, lives2%) DECLARE SUB Intro () DECLARE SUB GetInputs (NumPlayers, speed, diff $, monitor $) DECLARE SUB DrawScreen () DECLARE SUB PlayNibbles (NumPlayers, speed, diff $) DECLARE SUB Set (row, col, acolor) DECLARE SUB Center (row, text $) DECLARE SUB DoIntro () DECLARE SUB Initialize () DECLARE SUB SparklePause () DECLARE SUB Level (WhatToDO, sammy () AS snaketype) DECLARE SUB InitColors () DECLARE SUB EraseSnake (snake () AS Any, Snakebod () ANY, Snakeum%) Declare Function StillwantStoplay () Declare Function Pointisthere (Row, Col, Backcolor)
'ConstantsCONST TRUE = -1CONST FALSE = NOT TRUECONST MAXSNAKELENGTH = 1000CONST STARTOVER = 1' Parameters to 'Level' SUBCONST SAMELEVEL = 2CONST NEXTLEVEL = 3'Global VariablesDIM SHARED arena (1 TO 50, 1 TO 80) AS arenaTypeDIM SHARED curLevel, colorTable ( 10)
Randomize Timer Gosub Clearkeylocks Intro GetInputs Numplayers, Speed, Diff $, Monitor $ Gosub SetColors DrawScreen
Do Playnibbles Numplayers, Speed, Diff $ Loop While StillwantStoplay
Gosub RestoreKeylocks Color 15, 0 Clsend
ClearKeylocks: Def seg = 0 'Turn Off Caplock, Numlock and Scrollock Keyflags = Peek (1047) Poke 1047, & H0 Def Seg Return
RESTOREKEYLOCKS: Def seg = 0 'Restore Caplock, Numlock and Scrolllick State Poke 1047, Keyflags Def Seg Return
SetColors: if Monitor $ = "m" The Restore Mono else Restore Normal End IF
For a = 1 to 6 read colorable (a) Next A return
'snake1 snake2 Walls Background Dialogs-Fore Backmono: Data 15, 7, 7, 0, 15, 0NORMAL: DATA 14, 13, 12, 1, 15, 4END
'Center:' Centers Text On Given RowsUB Center (Row, Text $) Locate Row, 41 - Len (Text $) / 2 Print Text $; End Sub
'DrawScreen:' Draws Playing Fieldsub DrawScreen
'Initialize Screen View Print Color ColorTable (1), ColORTABLE (4) CLS
'Print Title & Message Center 1, "Nibbles!" Center 11, "Initializing Playing Field ..."' Initialize Arena Array for Row = 1 to 50 for col = 1 to 80 Arena (Row, Col) .realrow = Int (ROW 1) / 2) ARENA (ROW, Col) .ssister = (Row MOD 2) * 2 - 1 Next Col next Rownd Sub'RasesNake: 'EraseS Snake To Facilitate Moving Through Playing Fieldsub EraseNake (Snake () AS SnakeType , SnakeBod () as snakebody, snakeum)
For c = 0 to 9 for b = snake (snakeum) .length - c to 0 step -10 tail = (Snake (snakeum). HEAD MAXSNAKELENGTH - B) Mod MaxSnakeLength Set Snakebod (Tail, Snakenum) .row, Snakebod Tail, snakeum) .col, ColorTable (4) Next B Next C end SUB
'GetInputs:' Gets Player Inputssub GetInputs (Numplayers, Speed, Diff $, Monitor $)
Color 7, 0 CLS
Do Locate 5, 47: Print Space $ (34); Locate 5, 20 Input "How Many Players (1 or 2)"; Num $ Loop Until Val (Num $) = 1 or Val (Num $) = 2 Numplayers = Val (Num $)
Locate 8, 21: Print "Skill Level (1 to 100)" Locate 9, 22: Print "1 = Nov" Locate 10, 22: Print "90 = Expert" Locate 11, 22: Print "100 = twiddle fingers" locate 12, 15: Print Your Skill Level "Do Locate 8, 44: Print Space $ (35); LOCATE 8, 43 Input Gamespeed $ Loop Until Val (Gamespeed $)> = 1 And Val $) <= 100 speted = val (gameespeed $) speed = (100 - speed) * 2 1
Do Locate 15, 56: Print Space $ (25); Locate 15, 15 Input "Input" Increase Game Speed During Play (Y OR N) "; Diff $ DIFF $ = UCase $ (Diff $) Loop Until Diff $ =" Y " OR DIFF $ = "N" Do Locate 17, 46: Print Space $ (34); Locate 17, 17 Input "Monochrome Or Color Monitor (M or C)"; Monitor $ MONITOR $ = UCase $ (Monitor $) loop unsil Monitor $ = "m" or monitor $ = "c"
StartTime # = Timer 'Calculate Speed of System for i # = 1 To 1000: Next I #' and do some compension stoptime # = Timer speed = speed * .5 / (stOptime # - StartTime #)
End Sub
'INITCOLORS:' Initializes Playing Field ColorsSub INITCOLORS for ROW = 1 To 50 for col = 1 To 80 Arena (Row, Col) .acolor = ColorTable (4) Next Col Next Row
CLS 'Set (Turn ON) Pixels for Screen Border for Col = 1 To 80 Set 3, Col, ColorTable (3) Set 50, Col, ColorTable (3) Next Col
For row = 4 to 49 set row, 1, colorable (3) Set row, 80, colorable (3) Next Row
End Sub
'Intro:' Displays Game IntroductionsUB Intro Screen 0 Width 80, 25 Color 15, 0 CLS
Center 4, "QB ASIC N IBBLES" Color 7 Center 6, "Copyright (c) Microsoft Corporation 1990" Center 8, "NIBBLES IS A GAME for One or Two Players. Navigate Your Snakes" Center 9, "Around the Game Board Trying To Eat Up Numbers While Avoiding "Center 10," Running Into Walls or Other Snakes. The More Numbers You Eat Up, "Center 11" The More Points You Gain and the longer your snake becomes. "Center 13," Game Controls " Center 15, "General Player 1 Player 2" Center 16, "(UP)" Center 17, "P - PAUSE" CHR $ (24) "W" Center 18, "(Left) chr $ (27) " " "" "" CHR $ (25) "S" Center 20, "(Down) (Down) (Down) ) "Center 24," Press Any Key to CONT InUe "Play" MBT160O1L8cDedcdl4ec "SparklePause
End Sub
'Level:' sets game levelsub level
Case Startover Curlevel = 1 Case Next NexTlevel Curlevel = Curlevel 1 End Select
Sammy (1) .Head = 1 'Initialize Snakes Sammy (1) .length = 2 Sammy (1) .alive = True Sammy (2) .Head = 1 Sammy (2) .length = 2 sammy (2) .alive = True
INITCOLORS SELECT CASE CURLEVEL CASE 1 Sammy (1) .row = 25: Sammy (2) .Row = 25 Sammy (1) .col = 50: Sammy (2) .col = 30 Sammy (1) .direction = 4: Sammy (2) .direction = 3case 2 for i = 20 to 60 set 25, i, colorable (3) Next i sammy (1 ).Row = 7: sammy (2) .ROW = 43 Sammy (1) .col = 60 : Sammy (2) .col = 20 Sammy (1) .direction = 3: Sammy (2) .direction = 4
Case 3 for i = 10 to 40 set i, 20, colorable (3) set i, 60, colorable (3) Next I Sammy (1) .row = 25: Sammy (2) .row = 25 Sammy (1). COL = 50: Sammy (2) .col = 30 Sammy (1) .direction = 1: Sammy (2) .direction = 2
Case 4 for i = 4 to 30 set i, 20, colorable (3) set 53 - i, 60, colorable (3) Next I for i = 2 to 40 set 38, i, colorTable (3) set 15, 81 - I, ColORTABLE (3) Next I Sammy (1 ).Row = 7: Sammy (2) .ROW = 43 Sammy (1) .col = 60: Sammy (2) .col = 20 Sammy (1) .direction = 3 : Sammy (2) .direction = 4 case 5 for i = 13 To 39 Set I, 21, ColORTABLE (3) Set i, 59, colorable (3) Next I for i = 23 to 57 set 11, i, colortable 3) SET 41, I, ColORTABLE (3) Next I Sammy (1 ).Row = 25: Sammy (2) .row = 25 Sammy (1) .col = 50: Sammy (2) .col = 30 Sammy (1 ) .direction = 1: sammy (2) .direction = 2
Case 6 for i = 4 to 49 if i> 30 or i <23 TENSET I, 10, ColORTABLE (3) Set i, 20, ColORTABLE (3) Set i, 30, ColORTABLE (3) Set i, 40, ColORTABLE (3) Set I, 50, ColORTABLE (3) Set I, 60, ColORTABLE (3) SET I, 70, ColORTABLE (3) end if next i sammy (1) .row = 7: Sammy (2) .row = 43 Sammy (1) .col = 65: Sammy (2) .col = 15 Sammy (1) .direction = 2: Sammy (2) .direction = 1case 7 for i = 4 to 49 Step 2 Set i, 40, ColORTABLE (3) Next I sammy (1 ).ROW = 7: Sammy (2 ).Row = 43 Sammy (1) .col = 65: Sammy (2) .col = 15 Sammy (1) .direction = 2: Sammy 2) .direction = 1
Case 8 for i = 4 to 40 set i, 10, colorable (3) set 53 - i, 20, colorable (3) set i, 30, colorable (3) set 53 - i, 40, colortable (3) set i , 50, ColORTABLE (3) Set 53 - I, 60, ColORTABLE (3) Set I, 70, ColORTABLE (3) Next I Sammy (1) .row = 7: Sammy (2) .row = 43 Sammy (1) .col = 65: sammy (2) .col = 15 Sammy (1) .direction = 2: Sammy (2) .direction = 1
Case 9 for i = 6 to 47 Set I, I, ColORTABLE (3) Set I, I 28, ColORTABLE (3) Next I Sammy (1 ).Row = 40: Sammy (2) .row = 15 Sammy (1 ) .COL = 75: sammy (2) .col = 5 sammy (1) .direction = 1: sammy (2) .direction = 2 case else for i = 4 to 49 Step 2 set i, 10, colorTable (3) Set i 1, 20, ColORTABLE (3) Set I, 30, ColORTABLE (3) Set i 1, 40, ColORTABLE (3) Set i, 50, ColorTable (3) Set i 1, 60, ColorTable (3 ) Set I, 70, ColORTABLE (3) Next I Sammy (1) .row = 7: Sammy (2) .ROW = 43 Sammy (1) .col = 65: Sammy (2) .col = 15 Sammy (1) .direction = 2: sammy (2) .direction = 1END SELECTEND SUB
'Playnibbles:' Main Routine That Controls Game Playsus PLAYNIBBLES (Numplayers, Speed, Diff $)
'Initialize Snakes Dim SammyBody (MaxSnakeLength - 1, 1 to 2) AS Snakebody Dim Sammy (1 To 2) as SnakeType Sammy (1) .lives = 5 Sammy (1) .score = 0 Sammy (1). Scolor = ColorTable 1) Sammy (2) .lives = 5 Sammy (2) .score = 0 Sammy (2). Scolor = ColorTable (2) Level Startover, Sammy () Startrow1 = Sammy (1) .row: startcol1 = sammy (1) .col startrow2 = sammy (2) .row: startcol2 = sammy (2) .col
Curspeed = Speed
'Play Nibbles UnTil Finished
Spacepause "Level" STR $ (Curlevel) ", Push Space" GameOver = False Do IF Numplayers = 1 Then Sammy (2) .row = 0 End IF
number = 1 'Current number that snakes are trying to run into nonum = TRUE' nonum = TRUE if a number is not on the screenplayerDied = FALSE PrintScore NumPlayers, sammy (1) .score, sammy (2) .score, sammy (1 ) .lives, sammy (2) .lives Play "T160O1> L20cdedCDL10ECC"
Do 'Print Number if no Number EXISTS IF Num = True Then Do Numberrow = INT (RND (1) * 47 3) Numbercol = INT (RND (1) * 78 2) Sisterrow = Numberrow Arena (Numberrow, Numbercol) .sister LOOP UNTIL NOT PointIsThere (numberRow, NumberCol, colorTable (4)) AND NOT PointIsThere (sisterRow, NumberCol, colorTable (4)) numberRow = arena (numberRow, NumberCol) .realRow nonum = FALSE COLOR colorTable (1), colorTable ( 4) Locate Numberrow, Numbercol Print Right $ (Str $ (Number), 1); Count = 0 End IF
'Delay game for a # = 1 to curspeed: Next A #
'Get Keyboard Input & Change Direction Accordingly Kbd $ = INKEY $ SELECT CASE KBD $ CASE "W", "W": if Sammy (2) .direction <> 2 Then Sammy (2) .direction = 1 Case "S", "S": if sammy (2) .direction <> 1 Then Sammy (2) .direction = 2 case "a", "a": if sammy (2) .direction <> 4 THEN SAMMY (2) .direction = 3 case "d", "d": if sammy (2) .direction <> 3 Then Sammy (2) .direction = 4 case chr $ (0) "h": if sammy (1) .direction <> 2 Then Sammy (1) .direction = 1 case chr $ (0) "p": if sammy (1) .direction <> 1 Then Sammy (1) .direction = 2 case chr $ (0) "k": IF Sammy (1) .direction <> 4 Then Sammy (1) .direction = 3 case chr $ (0) "m": if sammy (1) .direction <> 3 Then Sammy (1) .direction = 4 case "p", "p": spacepause "Game Paused ... Push Space" case else end selectfor a = 1 to Numplayers' Move Snake Select Case Sammy (a) .direction case 1: sammy (a) .row = sammy (a) .row - 1 case 2: sammy (a) .row = sammy (a) .row 1 case 3: sammy (a). COL = Sammy (a) .col - 1 case 4: Sammy (a) .col = Sammy (a) .col 1 End Select
'If snake hits number, respond accordingly if Numberrow = INT ((Sammy (a) .row 1) / 2) And Numbercol = Sammy (a) .col the play "MBO0L16> CCCE" if sammy (a) .length < (MaxSnakeLength - 30) THEN Sammy (a) .length = Sammy (a) .length number * 4 end if sammy (a) .score = sammy (a) .score Number Printscore Numplayers, Sammy (1) .score, Sammy (2). Score, Sammy (1) .lives, Sammy (2) .lives Number = Number 1 if Number = 10 Then Erasenake Sammy (), SammyBody (), 1 EraseNake Sammy (), SammyBody (), 2 Locate Numberrow, Numbercol: Print "" Level Next Numplayers, Sammy (1) .score, Sammy (2) .score, Sammy (1) .lives, Sammy (2) .lives Spacepause "Level" Str $ (Curlevel) ", Push Space" If Numplayers = 1 Then Sammy (2) .row = 0 Number = 1 if Diff $ = "P" Then Speed = Speed - 10: Curspeed = Speed End if Nonum = True IF Curspeed <1 THEN CURSPEED = 1 End If Next A
For a = 1 to Numplayers' if Player Runs Into Any Point, or the head of the kether snake, it dies. If pointisthere (sammy (a) .row, sammy (a) .col, colorable (4)) or (Sammy (1 ).Row = Sammy (2 ).Row and sammy (1) .col = Sammy (2) .col) Then Play "MBO0L32EFGEFDC" Color, ColorTable (4) Locate Numberrow, Numbercol Print "" Playerdied = true sammy a) .alive = false sammy (a) .lives = Sammy (a) .lives - 1 'otherwise, move the snake, and erase the tail else sammy (a) .HEAD = (Sammy (a) .Head 1) MOD MAXSNAKELENGTH SAMMYBODY (Sammy (a). HEAD, A) .ROW = Sammy (a) .Row SammyBody (Sammy (a) .head, a) .col = sammy (a) .col tail = (Sammy (a). HEAD MAXSNAKELENGTH - Sammy (a) .length) Mod MaxSnakeLength Set SammyBody (Tail, A) .row, SammyBody (Tail, A) .col, colorable (4) sammybody (tail, a) .row = 0 set sammy (a) .row, sammy (a) .col, sammy (a) .scolor end if Next A
Loop unsil playerdied
Curspeed = Speed 'reset speed to initial value for a = 1 to numplayers EraseNake Sammy (), SammyBody (), A
'IF dead, the erase snake in real color = false kiln .score = sammy (a) .score = sammy (a) .score - 10 Printscore Numplayers, Sammy (1) .score, Sammy (2). Score, Sammy (1) .lives, Sammy (2) .lives if a = 1 THEN SPACEPAUSE "Sammy Dies! Push Space! --->" else spacepause "<---- Jake Dies! Push Space "End if End if Next Alevel Samelevel, Sammy () Printscore Numplayers, Sammy (1) .score, Sammy (2) .score, Sammy (1) .lives, Sammy (2) .lives' Play Next Round, unsil Either of Snake's live run out. loop untric sammy (1) .lives = 0 or sammy (2) .lives = 0
End Sub
'PointIsThere:' Checks the global arena array to see if the boolean flag is setFUNCTION PointIsThere (row, col, acolor) IF row <> 0 THEN IF arena (row, col) .acolor <> acolor THEN PointIsThere = TRUE ELSE PointIsThere = False end if end ifend function
'Printscore:' Prints Players Scores and Number of lives Remainingsub Printscore (Numplayers, Score1, Score2, Lives1, Lives2) Color 15, ColorTable (4)
If NumPlayers = 2 Then Locate 1, 1 Print Using "#, ###, # 00 Lives: # <- jake"; score2; limited
LOCATE 1, 49 Print Using "Sammy -> Lives: #, ###, # 00; lives1; scorend sub
'Set:' sets row and color to facilitate moving 'of snakes around the field.sub set (row, col, acolor) if row <> 0 Then Arena (Row, Col) .acolor = acolor' Assign Color To Arena Realrow = ARENA (Row, Col) .realrow 'Get Real Row of Pixel Topflag = Arena (Row, Col) .ssister 1/2' DEDUCE WHETHER PIXEL 'IS on top? or bottom? Sisterrow = ROW Arena (Row, Col). Sister 'Get Arena Row of Sister SisterColor = ARENA (Sisterrow, Col) .acolor' DETERMINE SISTER's ColorLocate Realrow, Color
IF acolor = sisterColor THEN 'If both points are same COLOR acolor, acolor' Print chr $ (219) "PRINT CHR $ (219);? ELSE IF topFlag THEN 'Since you can not have IF acolor> 7 THEN' bright backgrounds COLOR acolor SisterColor 'DETERMINE BEST Combo Print Chr $ (223);' To Use. Else Color SisterColor, Acolor Print ChR $ (220); Endiff Acolor, SisterColor Print Chr $ (220); Else Color SisterColor, Acolor Print Chr $ (223); End if End if end if end ifend sub
'Spacepause:' Pauses Game Play and Waits for Space Bar To Be Pressed Before Continuingsub Spacepause (Text $)
COLOR colorTable (5), colorTable (6) Center 11, "Qi l l l l l l l l l l l l l l l? Center 12,"? " LEFT $ (text $ SPACE $ (29), 29) "Center 13," 圮苘 苘 苘 苘 苘 苘 苘 苘 苘 苘 苘 苘 苘 苘? While Inkey $ <> ": Wend While Inkey $ <>": Wend Color 15, ColorTable (4 ) For i = 21 to 26 'restore the screen background for j = 24 to 56 set i, j, para (i, j) .acolor next j next i
End Sub
'Sparklepause:' Creates Flaseing Border for Intro ScreenSub SparklePause
Color 4, 0 a $ = "* * * * * * * * * * * * * * * *" While Inkey $ <> ": Wend 'Clear Keyboard Buffer
While Inkey $ = "" for a = 1 to 5 Locate 1, 1 'Print Horizontal Sparkles Print MID $ (A $, A, 80); Locate 22, 1 Print MID $ ($, 6 - A, 80);
For b = 2 to 21 'Print Vertical Sparkles C = (A B) MOD 5 IF C = 1 THEN LOCATE B, 80 Print "*"; Locate 23 - B, 1 Print "*"; Else Locate B, 80 Print ""; Locate 23 - B, 1 Print ""; END IF Next B Next A Wend
End Sub
'StillwantStoplay:' DETERMINES IF Uses Want To Play Game Again.Function StillwantStoplay
Color ColorTable (5), ColORTABLE (6) Center 10, "Pipepiiipiiiiiiiiiiiiipiiiiipiiiiiiiiiiiiiiipiipiipiipiipiipiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiipiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiiipiipipter 12,"? Center 13, "? Play Again? (Y / N)? Center 14, "圮苘 苘 苘 苘 苘 苘 苘 苘 苘 苘 苘 苘 苘 苘 苘? While Inkey $ <>": Wend Do KBD $ = UCase $ (Inkey $) loop Until KBD $ = "y" or kbd $ = "n"
Color 15, ColORTABLE (4) Center 10, "" Center 11, "" Center 12, "" "" "" "Center 14," "
IF KBD $ = "y" Then StillwantStoplay = true else stillwantstoplay = false Color 7, 0 CLS End IF
END FUNCTION
