Q B a s i c N i b b l e s

''''
''''                         Q B a s i c   N i b b l e 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.  The more numbers you eat up,
'''' the more points you gain and the longer your snake becomes.
''''
'''' 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 play
DEFINT A-Z

''''User-defined TYPEs
TYPE snakeBody
    row AS INTEGER
    col AS INTEGER
END TYPE

''''This type defines the player''''s snake
TYPE 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 INTEGER
END 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
''''programs
TYPE 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 is
END TYPE                          ''''-1 if sister point is above, +1 if below

''''Sub Declarations
DECLARE SUB SpacePause (text$)
DECLARE SUB PrintScore (NumPlayers%, score1%, score2%, 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() AS ANY, snakeNum%)
DECLARE FUNCTION StillWantsToPlay ()
DECLARE FUNCTION PointIsThere (row, col, backColor)

''''Constants
CONST TRUE = -1
CONST FALSE = NOT TRUE
CONST MAXSNAKELENGTH = 1000
CONST STARTOVER = 1             '''' Parameters to ''''Level'''' SUB
CONST SAMELEVEL = 2
CONST NEXTLEVEL = 3

''''Global Variables
DIM SHARED arena(1 TO 50, 1 TO 80) AS arenaType
DIM 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
    CLS
END

ClearKeyLocks:
    DEF SEG = 0                     '''' Turn off CapLock, NumLock and ScrollLock
    KeyFlags = PEEK(1047)
    POKE 1047, &H0
    DEF SEG
    RETURN

RestoreKeyLocks:
    DEF SEG = 0                     '''' Restore CapLock, NumLock and ScrollLock states
    POKE 1047, KeyFlags
    DEF SEG
    RETURN

SetColors:
    IF monitor$ = "M" THEN
        RESTORE mono
    ELSE
        RESTORE normal
    END IF

    FOR a = 1 TO 6
        READ colorTable(a)
    NEXT a
    RETURN

           ''''snake1     snake2   Walls  Background  Dialogs-Fore  Back
mono:   DATA 15,         7,       7,     0,          15,            0
normal: DATA 14,         13,      12,    1,          15,            4
END

''''Center:
''''  Centers text on given row
SUB Center (row, text$)
    LOCATE row, 41 - LEN(text$) / 2
    PRINT text$;
END SUB

''''DrawScreen:
''''  Draws playing field
SUB 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).sister = (row MOD 2) * 2 - 1
        NEXT col
    NEXT row
END SUB

''''EraseSnake:
''''  Erases snake to facilitate moving through playing field
SUB EraseSnake (snake() AS snaketype, snakeBod() AS snakeBody, snakeNum)

    FOR c = 0 TO 9
        FOR b = snake(snakeNum).length - c TO 0 STEP -10
            tail = (snake(snakeNum).head + MAXSNAKELENGTH - b) MOD MAXSNAKELENGTH
            Set snakeBod(tail, snakeNum).row, snakeBod(tail, snakeNum).col, colorTable(4)
        NEXT b
    NEXT c
   
END SUB

''''GetInputs:
''''  Gets player inputs
SUB 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   = Novice"
    LOCATE 10, 22: PRINT "90  = Expert"
    LOCATE 11, 22: PRINT "100 = Twiddle Fingers"
    LOCATE 12, 15: PRINT "(Computer speed may affect your skill level)"
    DO
        LOCATE 8, 44: PRINT SPACE$(35);
        LOCATE 8, 43
        INPUT gamespeed$
    LOOP UNTIL VAL(gamespeed$) >= 1 AND VAL(gamespeed$) <= 100
    speed = VAL(gamespeed$)
 
    speed = (100 - speed) * 2 + 1

    DO
        LOCATE 15, 56: PRINT SPACE$(25);
        LOCATE 15, 15
        INPUT "Increase game speed during play (Y or N)"; diff$
      &nb

[1] [2] [3] [4] [5] [6]  下一页

Copyright ＠ 2007-2012 敏韬网(敏而好学，文韬武略--MinTao.Net)（学习笔记） Inc All Rights Reserved.
闵涛 E_mail:admin@mintao.net(欢迎提供学习资源)

鄂公网安备 42011102001154号

站长：MinTao ICP备案号：鄂ICP备11006601号-18