Nibbles en qbasic

Soyez le premier à donner votre avis sur cette source.

Snippet vu 12 077 fois - Téléchargée 50 fois

Contenu du snippet

Ce n'est pas du Visual Basic mais presque.. c'est du QBASIC.. le basic de Microsoft.. Bon pk je met ca la ?? Lire un code en QBasic est le meilleur moyen dapprendre le VBasic..

Source / Exemple :


DECLARE SUB Newfeat ()

'

'                         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%, score3%, lives1%, lives2%, lives3%)

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 arena(1 To 50, 1 To 80) As arenaType

Dim curLevel, colorTable(11)

    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   snake3   Walls  Background  Dialogs-Fore  Back

mono:   Data 15, 7, 2, 7, 0, 15, 0

normal: Data 14, 13, 10, 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(5)

    Cls

    'Print title & message

    center 2, "Nibbles!"

    center 11, "Initializing arena..."

    

    '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(5)

        Next b

    Next c

    

End Sub

'GetInputs:

'  Gets player inputs

Sub GetInputs(NumPlayers, speed, diff$, monitor$)

    Color 7, 0

    Cls

    Do

        LOCATE 4, 47: Print Space$(34);

        LOCATE 4, 20

        INPUT "How many players (1, 2 or 3)"; num$

    Loop Until Val(num$) = 1 Or Val(num$) = 2 Or Val(num$) = 3 Or Val(num$) = q

    NumPlayers = Val(num$)

        If Val(num$) = q Then

        End

        End If

        If Val(num$) = 3 Then

    Do

        LOCATE 6, 2

        INPUT "Game 1 (2 survivors) or 2 (1 Survivor)"; gameno$

        Loop Until Val(gameno$) = 1 Or Val(gameno$) = 2

        End If

    LOCATE 8, 21: Print "Skill level (1 to 100)"

    LOCATE 9, 22: Print "1   = Laughable, yet quietly pathetic"

    LOCATE 10, 22: Print "90  = Zippier than a very zippy thing"

    LOCATE 11, 22: Print "100 = Whoa! Twiddle fingers!"

    LOCATE 12, 15: Print "(Computer speed may affect your skill level, especially with 3 players)"

    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$

        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 Until monitor$ = "M" Or monitor$ = "C" Or monitor$ = ""

    If monitor$ = "" Then monitor$ = "C"

    startTime# = Timer                          ' Calculate speed of system

    For I# = 1 To 1000: Next I#                 ' and do some compensation

    stopTime# = Timer

    speed = speed * 0.5 / (stopTime# - startTime#)

End Sub

'InitColors:

'Initializes playing field colors

Sub InitColors()

    

    For row = 1 To 50

        For col = 1 To 80

            arena(row, col).acolor = colorTable(5)

        Next col

    Next row

    Cls

   

    'Set (turn on) pixels for screen border

    For col = 1 To 80

        Set 3, col, colorTable(4)

        Set 50, col, colorTable(4)

    Next col

    For row = 4 To 49

        Set row, 1, colorTable(4)

        Set row, 80, colorTable(4)

    Next row

End Sub

'Intro:

'  Displays game introduction

Sub Intro()

    Screen 0

    WIDTH 80, 25

    Color 15, 0

    Cls

    center 3, "Q B a s i c   N i b b l e s   M k . I I"

    Color 7

    center 5, "Copyright (C) Microsoft Corporation 1990"

    center 6, ""

    Print "    Nibbles is one groovy game for up to THREE players, so get all your"

    Print "  friends round and enough beer for the month. Whizz your snakes around"

    Print "  the arena trying to eat up numbers while avoiding running into walls"

    Print "  or other snakes.  The more numbers you eat up, the more points you"

    Print "  gain and the longer your snake becomes. Master this game."

    center 12, "All thanks for the 3 player addition must go to Sammy. &B-)"

    center 14, " Game Controls: "

    Print

    Color 14

    LOCATE 16, 13: Print "Player 1"

    Color 13

    LOCATE 16, 36: Print "Player 2":

    Color 10

    LOCATE 16, 59: Print "Player 3"

    Color 7

    Print "               " + Chr$(24) + "                      W                      8"

    Print "             " + Chr$(27) + "   " + Chr$(26) + "                  A   D                  4   6"

    Print "               " + Chr$(25) + "                      S                      2   (Num Pad)"

    center 21, "In game: P for Pause, Q for quit"

    center 25, "Let battle commence..."

    PLAY "MBT160O1L8CDEDCDL4ECC"

    SparklePause

End Sub

'Level:

'Sets game level

Static Sub Level(WhatToDO, sammy() As snaketype)

    

    Select Case (WhatToDO)

    Case STARTOVER

        curLevel = 1

    Case 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

    sammy(3).head = 1

    sammy(3).length = 2

    sammy(3).alive = True

    

    InitColors

    

    Select Case curLevel

    Case 1

        sammy(1).row = 25: sammy(2).row = 25: sammy(3).row = 25

        sammy(1).col = 50: sammy(2).col = 30: sammy(3).col = 40

        sammy(1).direction = 4: sammy(2).direction = 3: sammy(3).direction = 2

    Case 2

        For I = 20 To 60

            Set 25, I, colorTable(4)

        Next I

        sammy(1).row = 7: sammy(2).row = 43: sammy(3).row = 43

        sammy(1).col = 60: sammy(2).col = 20: sammy(3).col = 60

        sammy(1).direction = 3: sammy(2).direction = 4: sammy(3).direction = 3

    Case 3

        For I = 10 To 40

            Set I, 20, colorTable(4)

            Set I, 60, colorTable(4)

        Next I

        sammy(1).row = 25: sammy(2).row = 25: sammy(3).row = 27

        sammy(1).col = 50: sammy(2).col = 30: sammy(3).col = 40

        sammy(1).direction = 1: sammy(2).direction = 2: sammy(3).direction = 4

    Case 4

        For I = 4 To 30

            Set I, 20, colorTable(4)

            Set 53 - I, 60, colorTable(4)

        Next I

        For I = 2 To 40

            Set 38, I, colorTable(4)

            Set 15, 81 - I, colorTable(4)

        Next I

        sammy(1).row = 7: sammy(2).row = 43: sammy(3).row = 20

        sammy(1).col = 60: sammy(2).col = 20: sammy(3).col = 4

        sammy(1).direction = 3: sammy(2).direction = 4: sammy(3).direction = 2

   

    Case 5

        For I = 13 To 39

            Set I, 21, colorTable(4)

            Set I, 59, colorTable(4)

        Next I

        For I = 23 To 57

            Set 11, I, colorTable(4)

            Set 41, I, colorTable(4)

        Next I

        sammy(1).row = 25: sammy(2).row = 25: sammy(3).row = 27

        sammy(1).col = 50: sammy(2).col = 30: sammy(3).col = 40

        sammy(1).direction = 1: sammy(2).direction = 2: sammy(3).direction = 4

    Case 6

        For I = 4 To 49

            If I > 30 Or I < 23 Then

                Set I, 10, colorTable(4)

                Set I, 20, colorTable(4)

                Set I, 30, colorTable(4)

                Set I, 40, colorTable(4)

                Set I, 50, colorTable(4)

                Set I, 60, colorTable(4)

                Set I, 70, colorTable(4)

            End If

        Next I

        sammy(1).row = 7: sammy(2).row = 43: sammy(3).row = 7

        sammy(1).col = 65: sammy(2).col = 15: sammy(3).col = 40

        sammy(1).direction = 2: sammy(2).direction = 1: sammy(3).direction = 2

   

    Case 7

        For I = 6 To 47

            Set I, I, colorTable(4)

            Set I, I + 28, colorTable(4)

        Next I

        sammy(1).row = 40: sammy(2).row = 15: sammy(3).row = 28

        sammy(1).col = 75: sammy(2).col = 5: sammy(3).col = 15

        sammy(1).direction = 1: sammy(2).direction = 2: sammy(3).direction = 4

      

    Case 8

        For I = 4 To 49 Step 2

            Set I, 40, colorTable(4)

        Next I

        sammy(1).row = 7: sammy(2).row = 43: sammy(3).row = 6

        sammy(1).col = 65: sammy(2).col = 15: sammy(3).col = 40

        sammy(1).direction = 2: sammy(2).direction = 1: sammy(3).direction = 4

    

    Case 9

        For I = 4 To 40

            Set I, 10, colorTable(4)

            Set 53 - I, 20, colorTable(4)

            Set I, 30, colorTable(4)

            Set 53 - I, 40, colorTable(4)

            Set I, 50, colorTable(4)

            Set 53 - I, 60, colorTable(4)

            Set I, 70, colorTable(4)

        Next I

        sammy(1).row = 7: sammy(2).row = 43: sammy(3).row = 7

        sammy(1).col = 65: sammy(2).col = 15: sammy(3).col = 38

        sammy(1).direction = 2: sammy(2).direction = 1: sammy(3).direction = 2

    Case Else

        For I = 4 To 49 Step 2

            Set I, 10, colorTable(4)

            Set I + 1, 20, colorTable(4)

            Set I, 30, colorTable(4)

            Set I + 1, 40, colorTable(4)

            Set I, 50, colorTable(4)

            Set I + 1, 60, colorTable(4)

            Set I, 70, colorTable(4)

        Next I

        sammy(1).row = 7: sammy(2).row = 43: sammy(3).row = 7

        sammy(1).col = 65: sammy(2).col = 15: sammy(3).col = 40

        sammy(1).direction = 2: sammy(2).direction = 1: sammy(3).direction = 2

    End Select

End Sub

'Newfeatures:

'Displays new features added by Sammy the man

    Sub Newfeat()

    Screen 0

    WIDTH 80, 25

    Color 15, 0

    Cls

    center 3, "Nibbles Mk. II - New Features"

    Color 7

    center 5, "Added 1995, by Sammy the Man " + Chr$(2)

    center 6, ""

    Print "    The original Nibbles was good, but (hopefully) this is better."

    Print "  All the original bits are in here, I've just added some extra"

    Print "  stuff in. Some are just to make life easier, others are there to"

    Print "  make it fun. 3 players especially. So just give it a go..."

    Print ""

    Print "  So, the new features then:"

    Print "       3rd player option, quit when press q, Improved intro"

    Print "  screen, this bit, change of snake names."

    Print ""

    Print "  Hopefully features to be added:"

    Print "       Improved 3 player option - 1 survivor/match, more levels."

    Print " "

    SparklePause

End Sub

'PlayNibbles:

'  Main routine that controls game play

Sub PlayNibbles(NumPlayers, speed, diff$)

    'Initialize Snakes

    Dim sammyBody(MAXSNAKELENGTH - 1, 1 To 3) As snakeBody

    Dim sammy(1 To 3) 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)

    sammy(3).lives = 5

    sammy(3).score = 0

    sammy(3).scolor = colorTable(3)

    Level STARTOVER, sammy()

    startRow1 = sammy(1).row: startCol1 = sammy(1).col

    startRow2 = sammy(2).row: startCol2 = sammy(2).col

    startRow3 = sammy(3).row: startCol3 = sammy(3).col

    curSpeed = speed

    'play Nibbles until finished

    SpacePause "  Enter arena" + Str$(curLevel) + ", Push Space  "

    gameOver = False

    Do

        If NumPlayers = 1 Then

            sammy(2).row = 0

            sammy(3).row = 0

        End If

        If NumPlayers = 2 Then

            sammy(3).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 screen

                

        playerDied = False

        PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(3).score, sammy(1).lives, sammy(2).lives, sammy(3).lives

        PLAY "T160O1>L20CDEDCDL10ECC"

        Do

            'Print number if no number exists

            If nonum = 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(5)) And Not PointIsThere(sisterRow, NumberCol, colorTable(5))

                numberRow = arena(numberRow, NumberCol).realRow

                nonum = False

                Color colorTable(1), colorTable(5)

                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 "8": If sammy(3).direction <> 2 Then sammy(3).direction = 1

                Case "5": If sammy(3).direction <> 1 Then sammy(3).direction = 2

                Case "4": If sammy(3).direction <> 4 Then sammy(3).direction = 3

                Case "6": If sammy(3).direction <> 3 Then sammy(3).direction = 4

                Case "p", "P": SpacePause " Game Paused ... Push Space  "

                CASE "q", "Q": LOCATE 11, 27: INPUT "  Really quit? (y/n)   ", quit$

                    If quit$ = "y" Then

                    Cls

                    End

                    Else

                    For I = 10 To 12

                        For j = 26 To 52

                            Set I, j, arena(I, j).acolor

                        Next j

                    Next I

                    SpacePause " Push Space to continue  "

                    End If

                Case Else

            End Select

            For 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 Then

                    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(3).score, sammy(1).lives, sammy(2).lives, sammy(3).lives

                    Number = Number + 1

                    If Number = 10 Then

                        EraseSnake sammy(), sammyBody(), 1

                        EraseSnake sammy(), sammyBody(), 2

                        EraseSnake sammy(), sammyBody(), 3

                        LOCATE numberRow, NumberCol: Print " "

                        Level NEXTLEVEL, sammy()

                        PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(3).score, sammy(1).lives, sammy(2).lives, sammy(3).lives

                        SpacePause "  Enter Arena" + Str$(curLevel) + ",  Push Space"

                        If NumPlayers = 1 Then sammy(2).row = 0 And sammy(3).row = 0

                        If NumPlayers = 2 Then sammy(3).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 other snake, it dies

If PointIsThere(sammy(a).row, sammy(a).col, colorTable(5)) Or (sammy(1).row = sammy(2).row And sammy(1).col = sammy(2).col) Or (sammy(1).row = sammy(3).row And sammy(1).col = sammy(3).col) Or (sammy(2).row = sammy(3).row And sammy(2).col = sammy(3).col) Then

                    PLAY "MBO0L32EFGEFDC"

                    Color , colorTable(5)

                    LOCATE numberRow, NumberCol

                    Print " "

                   

                    playerDied = True

                    sammy(a).alive = False

                    sammy(a).lives = sammy(a).lives - 1

'----

'            FOR a = 1 TO NumPlayers

'                'If player runs into any point, or the head of the other snake, it dies

'IF PointIsThere(sammy(a).row, sammy(a).col, colorTable(5)) OR (sammy(1).row = sammy(2).row AND sammy(1).col = sammy(2).col) OR (sammy(1).row = sammy(3).row AND sammy(1).col = sammy(3).col) OR (sammy(2).row = sammy(3).row AND sammy(2).col = sammy(3).col) THEN

'                    PLAY "MBO0L32EFGEFDC"

'                    COLOR , colorTable(5)

'                    LOCATE numberRow, NumberCol

'                    PRINT " "

'

'                    playerDied = TRUE

'----

                '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, colorTable(5)

                    sammyBody(tail, a).row = 0

                    Set sammy(a).row, sammy(a).col, sammy(a).scolor

                End If

            Next a

        Loop Until playerDied

        curSpeed = speed                ' reset speed to initial value

       

        For a = 1 To NumPlayers

            EraseSnake sammy(), sammyBody(), a

            'If dead, then erase snake in really cool way

            If sammy(a).alive = False Then

                'Update score

                sammy(a).score = sammy(a).score - 10

                PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(3).score, sammy(1).lives, sammy(2).lives, sammy(3).lives

                

                If a = 1 Then

                    SpacePause "     Sammy dies! Happy now? "

                Else

                    If a = 2 Then

                    SpacePause "     Jake Dies! Satisfied? "

                Else

                    SpacePause "      Dez dies! Pleased?  "

                    End If

                End If

            End If

        Next a

        Level SAMELEVEL, sammy()

        PrintScore NumPlayers, sammy(1).score, sammy(2).score, sammy(3).score, sammy(1).lives, sammy(2).lives, sammy(3).lives

     

    'Play next round, until either of snake's lives have run out.

    Loop Until sammy(1).lives = 0 Or sammy(2).lives = 0 Or sammy(3).lives = 0

End Sub

'PointIsThere:

'  Checks the global  arena array to see if the boolean flag is set

Function PointIsThere(row, col, acolor)

    If row <> 0 Then

        If arena(row, col).acolor <> acolor Then

            PointIsThere = True

        Else

            PointIsThere = False

        End If

    End If

End Function

'PrintScore:

'  Prints players scores and number of lives remaining

Sub PrintScore(NumPlayers, score1, score2, score3, lives1, lives2, lives3)

    Color 15, colorTable(5)

   

    If NumPlayers = 3 Then

        LOCATE 1, 33

        Print USING; "Dez:  Lives: #     #,###,#00"; lives3; score3

       

        LOCATE 1, 50

        Print USING; "Jake-->  Lives: #     #,###,#00"; lives2; score2

    End If

    If NumPlayers = 2 Then

        LOCATE 1, 50

        Print USING; "Jake-->  Lives: #     #,###,#00"; lives2; score2

    End If

    LOCATE 1, 1

    Print USING; "#,###,#00  Lives: #  <--Sammy"; score1; lives1

End Sub

'Set:

'  Sets row and column on playing field to given 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).sister + 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 color

        LOCATE realRow, col

        If acolor = sisterColor Then                'If both points are same

            Color acolor, acolor                           'Print chr$(219) "¤"

            Print Chr$(219);

        Else

            If topFlag Then                         'Since you cannot 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);

                End If

            Else

                If acolor > 7 Then

                    Color acolor, sisterColor

                    Print Chr$(220);

                Else

                    Color sisterColor, acolor

                    Print Chr$(223);

                End If

            End If

        End If

    End If

End Sub

'SpacePause:

'  Pauses game play and waits for space bar to be pressed before continuing

Sub SpacePause(text$)

    Color colorTable(6), colorTable(7)

    center 11, "¤þþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþ¤"

    center 12, "¤ " + Left$(text$ + Space$(29), 29) + " ¤"

    center 13, "¤ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐФ"

    While INKEY$ <> "": Wend

    While INKEY$ <> " ": Wend

    Color 15, colorTable(5)

    For I = 21 To 26            ' Restore the screen background

        For j = 24 To 56

            Set I, j, arena(I, j).acolor

        Next j

    Next I

End Sub

'SparklePause:

'  Creates flashing border for intro screen

Sub SparklePause()

    

    Color 4, 0

    a$ = "*    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    *    "

    If INKEY$ = "n" Or INKEY$ = "N" Then

    Newfeat

    End If

    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$(a$, 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 users want to play game again.

Function StillWantsToPlay()

    Color colorTable(6), colorTable(7)

    center 10, "¤þþþþþþþþþþþþþþþþþþþþþþþþþþþþþþþ¤"

    center 11, "¤       G A M E   O V E R       ¤"

    center 12, "¤                               ¤"

    center 13, "¤        Rematch?  (Y/N)        ¤"

    center 14, "¤ÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐÐФ"

    While INKEY$ <> "": Wend

    Do

        kbd$ = UCase$(INKEY$)

    Loop Until kbd$ = "Y" Or kbd$ = "N"

    Color 15, colorTable(5)

    center 10, "                                 "

    center 11, "                                 "

    center 12, "                                 "

    center 13, "                                 "

    center 14, "                                 "

    If kbd$ = "Y" Then

        StillWantsToPlay = True

    Else

        StillWantsToPlay = False

        Color 7, 0

        Cls

    End If

End Function

Conclusion :


GoOoD LooOk :=P

A voir également

Ajouter un commentaire

Commentaires

Messages postés
160
Date d'inscription
jeudi 28 août 2003
Statut
Membre
Dernière intervention
30 juin 2011

En tous cas c'est pas non plus de niveau expert :)


Basic powaaaaa...
Messages postés
214
Date d'inscription
jeudi 10 mars 2005
Statut
Membre
Dernière intervention
12 avril 2008

je trouve que c une bonne idée de mettre des sources en QBasic moi aussi j'ai commencer la prog dessus
Messages postés
3
Date d'inscription
jeudi 9 décembre 2004
Statut
Membre
Dernière intervention
22 décembre 2004

c'est trés bien le qbasic peu nous donne un profi à la programmation
Messages postés
48
Date d'inscription
mardi 28 octobre 2003
Statut
Membre
Dernière intervention
1 août 2005

Cool mec ton jeu en quick basic sa faisait longtemp que javais pas programmer un qbasic
Messages postés
1
Date d'inscription
mardi 20 avril 2004
Statut
Membre
Dernière intervention
12 mai 2004

pas de zip... ne crire riun
Afficher les 15 commentaires

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.