Nibbles en qbasic
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..
GoOoD LooOk :=P
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
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.