'Space Port-tris Florida - By codingCat aka Matthew L. Parets -- Released under Creative Commons - Free to use and distribute as long you don't make money and you tell everyone I said high
'Initially Developed as part of the Indie Galactic Space Jam
'import code: NBP313
GraphicsWindow.Show()
GraphicsWindow.Title = "Space Port Florida"
path = Program.Directory + "\"
GraphicsWindow.DrawImage(path + "SpacePortFloirda Background.png", 0,0)
'The game board can be set to any size that will fit on the screen
brdWid = 13 'How many block wide is the board
brdHei = 13 'How many blocks high
sqrSiz = 42 'Size of the blocks in pixels -usable area is square size -12 with 42 as size, shape are is 30 x 30
'Windows size and location (centered) is based on the board size
GraphicsWindow.Width = 800
GraphicsWindow.Height = 670
GraphicsWindow.Top = 0
GraphicsWindow.Left = (Desktop.Width/2) - GraphicsWindow.Width / 2
RequirmentsOffsetX = 650 'location x/y, row/col to display requirements list
RequirmentsOffsetY = 90
RequirmentsBlockOffset = 0
CreateTitleShapes()
notnow = "yes"
If notnow = "yes" then
'Parts List - Originally colors, this will eventually be replaced with sprites
inventory[0] = "Red" 'The reactor - only used at setup
inventory[1] = "Blue" 'Bridge
inventory[2] = "Green" 'Engines
inventory[3] = "Magenta" 'Fuel
inventory[4] = "Cyan" 'Cargo
inventory[5] = "Yellow" 'Crew/Crew quarters
inventory[6] = "DarkKhaki" 'Wepons
inventory[7] = "RosyBrown" 'Passenger modules
inventory[8] = "Navy" 'Communications dish
inventory[9] = "OliveDrab" 'Observation / targetting dome
else
'Parts List - Originally colors, this will eventually be replaced with sprites
inventory[0] = "BlockReactor.png" 'The reactor - only used at setup
inventory[1] = "BlockBridge.png" 'Bridge
inventory[2] = "BlockEngines.png" 'Engines
inventory[3] = "BlockFuel.png" 'Fuel
inventory[4] = "BlockCargo.png" 'Cargo
inventory[5] = "BlockCrew.png" 'Crew/Crew quarters
inventory[6] = "BlocksWepons.png" 'Wepons
inventory[7] = "BlockPassenger.png" 'Passenger modules
inventory[8] = "BlockDish.png" 'Communications dish
inventory[9] = "BlockObservation.png" 'Observation / targetting domeendif
endif
frameRate = 10 'Number of milliseonds each frame (trip through the game loop) should take
frameStart = Clock.ElapsedMilliseconds 'note the time to allow for frame pauses
playerRate = 1000 'How often is a new player block added.
playerRateReduction = (playerRate - 100) / (brdHei * brdWid) 'Speed up the add process with each success
playerStart = Clock.ElapsedMilliseconds 'Track the start of the add process
score = 10 'Zero score at the begining
'Token list = componantCount:componantType-count; -- in any variety or number of componan types
shipTypes[1] = "3:0-1;1-1;2-2;Fast Scout"
shipTypes[2] = "4:0-1;1-1;2-1;4-3;Light Cargo"
shipTypes[3] = "5:0-1;1-1;2-1;3-1;4-1;Space Ferry"
shipTypes[4] = "4:0-1;1-1;2-1;3-2;Endurance Scout"
shipTypes[5] = "10:0-1;1-1;2-1;3-1;4-1;5-1;6-1;7-1;8-1;9-1;Space Train"
shipTypes[6] = "4:0-1;1-1;2-1;9-1;Touring"
'Initialize the array that is used to track to condition of the board and draw the board
GraphicsWindow.BrushColor = GraphicsWindow.GetColorFromRGB(172,156,255) 'A very light version of the default color
For i = 2 To brdHei+1
For j = 1 To brdWid
'Draw a block at the current positon
GraphicsWindow.fillRectangle(sqrSiz*j, sqrSiz*i, sqrSiz-6,sqrSiz-6)
'Add a shadow to the lower right
GraphicsWindow.PenColor = GraphicsWindow.GetColorFromRGB(172-75,156-75,255-75) 'A very light version of the default color
GraphicsWindow.DrawLine(sqrSiz*j + (sqrSiz-6),sqrSiz*i ,(sqrSiz*j) + (sqrSiz-6), (sqrSiz*i) + (sqrSiz-6))
GraphicsWindow.PenColor = GraphicsWindow.GetColorFromRGB(172-50,156-50,255-50) 'A very light version of the default color
GraphicsWindow.DrawLine(sqrSiz*j,sqrSiz*i + (sqrSiz-6) ,(sqrSiz*j) + (sqrSiz-6), (sqrSiz*i) + (sqrSiz-6))
board[i-1][j] = "Empty" 'every position is marked as empty.
partLst[i-1][j] = "Empty"
EndFor
EndFor
PlaceReactor() 'Place the basic reactor piece in the center
SetShipType() 'Choose a ship and set up its requirement list
DisplayPartsRequirement() 'Display the parts needed for launch
GraphicsWindow.KeyDown = OnKeyDown 'Let winows know our key event is waiting for presses.
newBlockAdded = "False" 'Track when new block is added
landCount = 0 'The number of blocks that have been added
'Add the initial player shape
NewBlock() 'Add the first block
Shapes.Move(playerShp,col*sqrSiz+3,(row+1)*sqrSiz+3) 'Show the block
'---------------------------------------------------------------------------------
'Main game loop. Each subroutine that is called from the game loop
'is set as one step to take one step in that loop and advance for the next step
'---------------------------------------------------------------------------------
key = ""
While key <> "Escape" 'Keep going until the escape key is pressed
GetKeyPress() 'Check if a key has been pressed
UpdatePlayer()
FrameWait() 'Pause and wait for just a tick
endwhile
'-----------------------------------------------------------------------------------------------------------
'Score / Credits / Restart Screen
'-----------------------------------------------------------------------------------------------------------
key = ""
While key <> "Escape" 'Keep going until the escape key is pressed
paceMessage = paceMessage + 1
If Math.Remainder(paceMessage,3) = 0 Then
FlashScoreMessage()
endif
FrameWait() 'Pause and wait for just a tick
EndWhile
'---------------------------------------------------------------------------------
' Display Parts Requirment - Give a visual represntation of the parts
' required for launch.
'---------------------------------------------------------------------------------
Sub DisplayPartsRequirement
GraphicsWindow.BrushColor = "white"
GraphicsWindow.FillRectangle(RequirmentsOffsetX-4,RequirmentsOffsetY-5,125,490)
GraphicsWindow.PenColor = "black"
GraphicsWindow.PenWidth = 0.5
GraphicsWindow.DrawRectangle(RequirmentsOffsetX-4,RequirmentsOffsetY-5,125,490)
GraphicsWindow.BrushColor = "red"
dprow = -1
For dpi = 0 To Array.GetItemCount(shipRequirments)-1 'for each ship part
If shipRequirments[dpi] > 0 then
dprow = dprow + 1
for dpj = shipRequirments[dpi] * (sqrSiz / 3) to shipRequirments[dpi] step - (sqrSiz / 3)
If Text.GetIndexOf(inventory[dpi],".") = 0 then
GraphicsWindow.BrushColor = inventory[dpi]
graphicsWindow.fillRectangle(RequirmentsOffsetX + dpj,dprow*sqrSiz+3+(RequirmentsOffsetY+40)+(dpj/2)+RequirmentsBlockOffset+shipName2Offset, sqrSiz-12,sqrSiz-12) 'add the new block
graphicsWindow.drawRectangle(RequirmentsOffsetX + dpj,dprow*sqrSiz+3+(RequirmentsOffsetY+40)+(dpj/2)+RequirmentsBlockOffset+shipName2Offset, sqrSiz-12,sqrSiz-12) 'add the new block
Else
GraphicsWindow.DrawImage(path + inventory[dpi],RequirmentsOffsetX + dpj,dprow*sqrSiz+3+(RequirmentsOffsetY+40)+(dpj/2)+RequirmentsBlockOffset+shipName2Offset)
EndIf
EndFor
EndIf
EndFor
EndSub
'---------------------------------------------------------------------------------
' PlaceReactor - at interval automaticaly move the player block
' towards the center
'---------------------------------------------------------------------------------
Sub PlaceReactor
prt = inventory[0] 'The Reactor
row = Math.Floor(brdHei / 2) + 1
col = Math.Floor(brdWid / 2) + 1
If Text.GetIndexOf(prt,".") = 0 then
GraphicsWindow.BrushColor = prt
GraphicsWindow.PenColor = prt
playerShp = Shapes.AddRectangle(sqrSiz-12,sqrSiz-12) 'add the new block
Else
playerShp = Shapes.AddImage(path + prt)
EndIf
Shapes.Move(playerShp,col*sqrSiz+3,(row+1)*sqrSiz+3) 'Set the recactor in the center
SetPart() 'Set the reactor in place
EndSub
'---------------------------------------------------------------------------------
' Set Ship Type - Parse the ship type string describing the number
' of componants in this hsip
'---------------------------------------------------------------------------------
Sub SetShipType
shipNum =5' Math.GetRandomNumber(array.GetItemCount(shipTypes)) 'choose a ship
For ssi = 0 To Array.GetItemCount(inventory)-1 'clear the requirement list
shipRequirments[ssi] = 0
EndFor
sss = shipTypes[shipNum]
strpos = Text.GetIndexOf(sss,":")
compCnt = Text.GetSubText(sss,1,strpos-1)
sss = Text.GetSubTextToEnd(sss,strpos+1)
For ssi = 1 To compCnt 'For each of the componants types in the ship
strpos = Text.GetIndexOf(sss,"-")
scTyp = Text.GetSubText(sss,1,strpos-1)
sss = Text.GetSubTextToEnd(sss,strpos+1)
strpos = Text.GetIndexOf(sss,";")
scCnt = Text.GetSubText(sss,1,strpos-1)
sss = Text.GetSubTextToEnd(sss,strpos+1)
shipRequirments[scTyp] = scCnt 'Set the required count for that componant
EndFor
shipName = sss
shipName2 = ""
strpos = Text.GetIndexOf(sss," ")
If strpos <> 0 Then
shipName = Text.GetSubText(sss,1,strpos-1)
shipName2 = Text.GetSubTextToEnd(sss,strpos+1)
EndIf
EndSub
'---------------------------------------------------------------------------------
' UpdatePlayer - at interval automaticaly move the player block
' towards the center
'---------------------------------------------------------------------------------
Sub UpdatePlayer
'Only do this at timed intervals.
If Clock.ElapsedMilliseconds - playerStart > playerRate then
DetectLanding()
MoveThePlayer()
playerStart = Clock.ElapsedMilliseconds 'Setup for next block
EndIf
Shapes.Move(playerShp,col*sqrSiz+3,(row+1)*sqrSiz+3) 'Move the current block
EndSub
'---------------------------------------------------------------------------------
' Detect landing - has the player block reached a stoping point (at
' an edge or blocked by a block)
'---------------------------------------------------------------------------------
Sub DetectLanding
If dir = 1 Then
If row = brdHei Then 'Are we at the bottom of the baord?
Landed()
ElseIf board[row+1][col] <> "Empty" then 'Are we at the top of a stack?
Landed()
EndIf
ElseIf dir = 2 then
If row = 1 Then 'Are we at the top of the baord?
Landed()
ElseIf board[row-1][col] <> "Empty" then 'Are we at the top of a stack?
Landed()
EndIf
ElseIf dir = 3 Then
If col = brdWid Then 'Are we at the right side of the baord?
Landed()
ElseIf board[row][col+1] <> "Empty" then 'Are we at the edge of a stack?
Landed()
EndIf
ElseIf dir = 4 Then
If col = 1 Then 'Are we at the left side of the baord?
Landed()
ElseIf board[row][col-1] <> "Empty" then 'Are we at the edge of a stack?
Landed()
EndIf
EndIf
EndSub
'---------------------------------------------------------------------------------
' MoveThe Player - move the player block in the current direction of
' play
'---------------------------------------------------------------------------------
sub MoveThePlayer
If newBlockAdded = "False" And key <> "Escape" Then
If dir = 1 Then 'Down
row = row + 1
ElseIf dir = 2 Then 'Up
row = row - 1
ElseIf dir = 3 Then 'Right
col = col + 1
ElseIf dir = 4 Then 'Left
col = col - 1
EndIf
EndIf
newBlockAdded = "False"
EndSub
'---------------------------------------------------------------------------------
' Landed - The bottom of the board, or the top of the stack has been
' reached, leave the block in place and check for win or lose
'---------------------------------------------------------------------------------
Sub Landed
If row = 0 Or col = 0 Or row = brdHei+1 Or col = brdWid+1 Or landCount+1 = brdHei * brdWid Then 'Still at the top? Board full? Lose condition
GameOverDisplay()
FlashFinal()
Shapes.HideShape(playerShp)
key = "Escape"
Else 'Set up a new block
SuccessfulLand()
NewBlock()
endif
EndSub
'---------------------------------------------------------------------------------
' Flash the location of the final block
'---------------------------------------------------------------------------------
Sub FlashFinal
GraphicsWindow.BrushColor = "Black" 'Create a black block over the last player block
GraphicsWindow.PenColor = "Black"
lastBlock = Shapes.AddRectangle(sqrSiz-12,sqrSiz-12)
Shapes.SetOpacity(lastBlock,65)
Shapes.Move(lastBlock,col*sqrSiz+3,(row+1)*sqrSiz+3)
For fbi = 1 To 3 'Flash the black block on and off
Shapes.HideShape(lastBlock)
Program.Delay(100)
Shapes.ShowShape(lastBlock)
Program.Delay(250)
endfor
Shapes.HideShape(lastBlock) 'Remove the flash block
EndSub
'---------------------------------------------------------------------------------
' Game over display - Display the game over message and the
' final score
'---------------------------------------------------------------------------------
Sub GameOverDisplay
Shapes.ShowShape(GameOverTitle)
Shapes.ShowShape(GameOverTitleShadow)
Shapes.ShowShape(FinalScoreTitle)
Shapes.ShowShape(FinalScoreTitleShadow)
FinalScoreMessage()
EndSub
'---------------------------------------------------------------------------------
' Launch Display - Display when the launch condition is reached
'---------------------------------------------------------------------------------
Sub LaunchDisplay
Shapes.ShowShape(LaunchTitle)
Shapes.ShowShape(LaunchTitleShadow)
EndSub
'---------------------------------------------------------------------------------
' Clear Launch Display - Hide the launch message
'---------------------------------------------------------------------------------
Sub ClearLaunchDisplay
Shapes.HideShape(LaunchTitle)
Shapes.HideShape(LaunchTitleShadow)
EndSub
'---------------------------------------------------------------------------------
' Successful Land - Mark the current block as used, find and flash
' matching for bonus, Calculate and display new score
'---------------------------------------------------------------------------------
Sub SuccessfulLand
SetPart() 'Fix the peice in place
FindMatching() 'Calculate the multiplier - how many blocks of the same color are touching
scoreText = "Score -- " + score
If componantMatch = "True" Then
score = score + (1000 * multiplier)
scoreText = scoreText + " + (1000 x "
Else
score = score + (10 * multiplier)
scoreText = scoreText + " + (10 x "
EndIf
scoreText = scoreText + multiplier + ") = " + score
GraphicsWindow.Title = scoreText
EndSub
'---------------------------------------------------------------------------------
' Set Part - After a successful land, set the part as a piece of the ship
'---------------------------------------------------------------------------------
Sub SetPart
board[row][col] = prt 'Mark the current postion as occupied
landCount = landCount + 1 'Keep track of how many times this has happend
partLst[row][col] = playerShp 'Hang onto the shape handle for launch effect
EndSub
'---------------------------------------------------------------------------------
' New Block - Following a successfull landing add a new player
' block to the board
'---------------------------------------------------------------------------------
Sub NewBlock
dir = Math.GetRandomNumber(4) 'Choose a direction at random
prtNum = Math.GetRandomNumber(Array.GetItemCount(inventory)-1)
prt = inventory[prtNum]
If dir = 1 then 'From the top
row = 0 'reset at the top
col = Math.GetRandomNumber(brdWid) 'random position at the top
ElseIf dir = 2 then 'From the bottom
row = brdHei+1 'reset at the bottom
col = Math.GetRandomNumber(brdWid) 'random position at the bottom
elseIf dir = 3 then 'From the left
row = Math.GetRandomNumber(brdHei) 'random position at the left
col = 0 'reset at the left
elseif dir = 4 then 'From the right
row = Math.GetRandomNumber(brdHei) 'random position at the right
col = brdWid + 1 'reset at the right
EndIf
playerRate = playerRate - playerRateReduction 'speed the game up
If Text.GetIndexOf(prt,".") = 0 then
GraphicsWindow.PenColor = prt
GraphicsWindow.BrushColor = prt
playerShp = Shapes.AddRectangle(sqrSiz-12,sqrSiz-12) 'add the new block
Else
playerShp = Shapes.AddImage(path + prt)
EndIf
playerStart = Clock.ElapsedMilliseconds 'Start a new frame.
pressed = "False" 'Ignore any new key presses
newBlockAdded = "True" 'Note the fact that a new block was added
EndSub
'---------------------------------------------------------------------------------
' Get Key Press - Process all user interaction. 'Key presses are
' ignored unless the event tells us that a new key has been pressed
'---------------------------------------------------------------------------------
Sub GetKeyPress
If pressed = "True" Then 'ignore unless the event tells us there was a press
key = GraphicsWindow.LastKey 'Movement keys
If dir = 1 Then 'Block is moving downward
'Has the left key been press? And is the place we are heading on the board? And is place we heading not full?
If key = "Left" And col > 1 and (row < 1 or board[row][col-1] = "Empty") Then
col = col - 1 'move Left
'Has the right key been pressed? And is the place we are heading on the board? And is place we are heading not full?
ElseIf key = "Right" and col < brdWid and (row < 1 or board[row][col+1] = "Empty") then
col = col + 1 'move right
ElseIf key = "Down" Then
playerStart = playerStart - playerRate 'expire the pacing pause and move DOWN a block NOW
ElseIf (key = "Space" or key = "Return") and row <> 0 then
Landed() 'Place the block at this location
EndIf
ElseIf dir = 2 Then 'Block is moving upward
'Has the left key been press? And is the place we are heading on the board? And is place we heading not full?
If key = "Left" And col > 1 and (row > brdHei or board[row][col-1] = "Empty") Then
col = col - 1 'move left
'Has the left key been pressed? And is the place we are heading on the board? And is place we are heading not full?
ElseIf key = "Right" and col < brdWid and (row > brdHei or board[row][col+1] = "Empty") then
col = col + 1 'move right
ElseIf key = "Up" Then
playerStart = playerStart - playerRate 'expire the pacing pause and move UP a block NOW
ElseIf (key = "Space" or key = "Return") and row<>brdHei+1 then
Landed() 'Place the block at this location
EndIf
ElseIf dir = 3 Then 'Block is moving to the right
'Has the down key been press? And is the place we are heading on the board? And is place we heading not full?
If key = "Down" And row < brdHei and (col < 1 or board[row+1][col] = "Empty") Then
row = row + 1 'move down
'Has the up key been pressed? And is the place we are heading on the board? And is place we are heading not full?
ElseIf key = "Up" and row > 1 and (col < 1 or board[row-1][col] = "Empty") then
row = row - 1 'move up
ElseIf key = "Right" Then
playerStart = playerStart - playerRate 'expire the pacing pause and move RIGHT a block NOW
ElseIf (key = "Space" or key = "Return") and col <> 0 then
Landed() 'Place the block at this location
EndIf
ElseIf dir = 4 Then 'Block is moving to the left
'Has the down key been press? And is the place we are heading on the board? And is place we heading not full?
If key = "Down" And row < brdHei and (col > brdWid or board[row+1][col] = "Empty") Then
row = row + 1 'move down
'Has the up key been pressed? And is the place we are heading on the board? And is place we are heading not full?
ElseIf key = "Up" and row > 1 and (col > brdWid or board[row-1][col] = "Empty") then
row = row - 1 'move up
ElseIf key = "Left" Then
playerStart = playerStart - playerRate 'expire the pacing pause and move LEFT a block NOW
ElseIf (key = "Space" or key = "Return") and col <> brdWid+1 then
Landed() 'Place the block at this location
EndIf
EndIf
pressed = "False"
EndIf
EndSub
'---------------------------------------------------------------------------------
' Launch Ship - When the ship is fully assembled, launch it out of the
' space dock.
'---------------------------------------------------------------------------------
Sub LaunchShip
slice = 2000 / GraphicsWindow.Height
For lsj = 1 To GraphicsWindow.Height
For lsi = 1 To bonusBlockCount
Shapes.Move(matchList[lsi], shapes.GetLeft(matchList[lsi]),Shapes.GetTop(matchList[lsi])-1)
EndFor
Program.Delay(slice)
EndFor
EndSub
'---------------------------------------------------------------------------------
' Setup For New Ship - remove the shapes, choose a new ship,
' clear and redisplay the ship requirments
'---------------------------------------------------------------------------------
Sub SetupForNewShip
For sfi = 1 To brdHei 'Clear the board
For sfj = 1 To brdWid
If partLst[sfi][sfj] <> "Empty" Then 'If there is a shape present, remove it
Shapes.Remove(partLst[sfi][sfj])
EndIf
partLst[sfi][sfj] = "Empty" 'Set the parts list to empty
board[sfi][sfj] = "Empty" 'Set the display board to empty
EndFor
EndFor
ClearLaunchDisplay()
PlaceReactor() 'Place the basic reactor piece in the center
SetShipType() 'Choose a ship and set up its requirement list
DisplayPartsRequirement() 'Display the parts needed for launch
EndSub
'---------------------------------------------------------------------------------
' Find Matching is a helper method that sets up the values for the
' recursive FindMatchingWorker subroutine below.
'---------------------------------------------------------------------------------
Sub FindMatching
multiplier = 0 'Assume no matches
fPrt = prt 'Copies used in the find process
fCol = col
fRow = row
'Setup a work space. This array will keep us from checking a
'block location more than once
For fmi = 1 To brdHei
For fmj = 1 To brdWid
fBoard[fmi][fmj] = "Empty"
EndFor
EndFor
'Stacks needed for the recursion process. In most other languags
'the stack process would be hanlded automatically by the
'subroutine call itself. Smallbasic's single global variable pool
'and lack of subroutine parameters prevents this.
fRowSt = ""
fColSt = ""
'While finding matches, build a list of componants used
For fi = 0 To Array.GetItemCount(shipRequirments)-1
componantList[fi] = 0
EndFor
fReactorFound = "False" 'Assume that this block does not connect to the reactor
bonusBlockCount = 0 'number of matching blocks found
FindMatchingWorker() 'Find the matches
componantMatch = "True"
For fi = 0 To Array.GetItemCount(componantList)-1
If shipRequirments[fi] > componantList[fi] Then
componantMatch = "False"
EndIf
EndFor
If componantMatch = "True" Then
LaunchDisplay()
EndIf
FlashBonus() 'Flash the matching blocks to show the user
If componantMatch = "True" Then
LaunchShip()
SetupForNewShip()
EndIf
EndSub
'---------------------------------------------------------------------------------
' Find Matching Worker - Find all touching blocks that have the
' same color. This is a recursive subroutine. It calls itself four
' separate times, once for each direction a block can be touching:
' Up, Down, Left, and Right.
'This is a basic maze following algorithm.
'---------------------------------------------------------------------------------
Sub FindMatchingWorker
'Base case - Are out outside the board, have we visited this block already, or is this block empty
If fRow > brdHei Or fRow < 1 Or fCol > brdWid Or fCol < 1 Or fBoard[fRow][fCol] <> "Empty" Or board[fRow][fcol] = "Empty" Then
'Do nothing, return to previous call and continue the search
Else
If board[fRow][fCol] = inventory[0] Then 'If this block is a reactor
fReactorFound = "True"
EndIf
For fmi = 0 To array.GetItemCount(shipRequirments)-1
If inventory[fmi] = board[fRow][fCol] Then
componantList[fmi] = componantList[fmi] + 1
EndIf
EndFor
multiplier = multiplier + 1 'Add this block to the multiplier
fBoard[fRow][fCol] = fPrt 'Only count it once
bonusBlockCount = bonusBlockCount + 1 'Add a black block over this position to show the user
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.PenColor = "Black"
bonusBlocks[bonusBlockCount] = Shapes.AddRectangle(sqrSiz-12,sqrSiz-12)
Shapes.SetOpacity(bonusBlocks[bonusBlockCount],65)
Shapes.Move(bonusBlocks[bonusBlockCount],fCol*sqrSiz+3,(fRow+1)*sqrSiz+3)
matchList[bonusBlockCount] = partLst[fRow][fCol] 'make a list of the part shapes for level complete
'Recursive call - Check all positions leading up from current
Stack.PushValue(fRowSt,fRow) 'Store the current row and col
Stack.PushValue(fColSt,fCol)
fRow = fRow - 1 'Move one row up
FindMatchingWorker() 'Check all blocks in that direction
fCol = Stack.PopValue(fColSt) 'Restore the old row and col from before the call
fRow = Stack.PopValue(fRowSt)
'Recursive call - Check all positions leading down from current
Stack.PushValue(fRowSt,fRow) 'Store the current row and col
Stack.PushValue(fColSt,fCol)
fRow = fRow + 1 'Move one row down
FindMatchingWorker() 'Check all blocks in that direction
fCol = Stack.PopValue(fColSt) 'Restore the old row and col from before the call
fRow = Stack.PopValue(fRowSt)
'Recursive call - Check all positions leading left from current
Stack.PushValue(fRowSt,fRow) 'Store the current row and col
Stack.PushValue(fColSt,fCol)
fCol = fCol - 1 'Move one column left
FindMatchingWorker() 'Check all blocks in that direction
fCol = Stack.PopValue(fColSt) 'Restore the old row and col from before the call
fRow = Stack.PopValue(fRowSt)
'Recursive call - Check all positions leading right from current
Stack.PushValue(fRowSt,fRow) 'Store the current row and col
Stack.PushValue(fColSt,fCol)
fCol = fCol + 1 'Move one column right
FindMatchingWorker() 'Check all blocks in that direction
fCol = Stack.PopValue(fColSt) 'Restore the old row and col from before the call
fRow = Stack.PopValue(fRowSt)
EndIf
EndSub
'---------------------------------------------------------------------------------
' Flash Bonus - Flash all the block identifed in FindMatching
'---------------------------------------------------------------------------------
Sub FlashBonus
If bonusBlockCount > 1 And fReactorFound = "True" Then
For fbi = 1 To 3
For fbj = 1 To bonusBlockCount
Shapes.HideShape(bonusBlocks[fbj])
EndFor
Program.Delay(100)
For fbj = 1 To bonusBlockCount
Shapes.ShowShape(bonusBlocks[fbj])
EndFor
Program.Delay(250)
endfor
EndIf
For fbj = 1 To bonusBlockCount
Shapes.Remove(bonusBlocks[fbj])
EndFor
EndSub
'--- AddCommasToNumber --------------------------------------------------------------------------
'--- Add commas every three digits in a number
'-----------------------------------------------------------------------------------------------------------
Sub AddCommasToNumber
commaNumber = "G" + commaNumber + "Q" 'random letters added to enforce concatenation rather than additon
commaResult = "M"
commaPos = 0
For actni = text.GetLength(commaNumber)-1 To 2 Step -1 'Stepping backwards through the number
commaSub = Text.GetSubText(commaNumber,actni,1) 'The next digit
commaPos = commaPos + 1 'The next position in the result
If math.Remainder(commaPos-1,3) = 0 and text.GetLength(commaResult) > 3 Then 'time for a comma?
commaResult = "," + commaResult 'Add a comma
EndIf
commaResult = commaSub + commaResult 'Add the next digit to the result
EndFor
commaNumber = text.GetSubText(commaResult,1,Text.GetLength(commaResult)-1) 'Return the number
EndSub
'--- FinalScoreMessage -------------------------------------------------------------------------------
'--- Display the end of game message showing the players final progress
'-----------------------------------------------------------------------------------------------------------
sub FinalScoreMessage
GraphicsWindow.FontSize = 45 'Setup for flashing score
GraphicsWindow.FontItalic = "True"
commaNumber = score 'format the score with commas and right justify it
AddCommasToNumber()
nudgeNum = ((Text.GetLength(commaNumber)-1) - math.Floor(Text.GetLength(commaNumber) / 4)) * 95
nudgeCom = math.Floor(Text.GetLength(commaNumber) / 4) * 19
nudge = nudgeNum + nudgeCom
nudge = 250
GraphicsWindow.BrushColor = "white" 'display he white shaddow
GraphicsWindow.DrawText(613 - nudge,623, commaNumber)
FlashScoreMessage()
EndSub
'--- FlashScoreMessage -------------------------------------------------------------------------------
'--- Repaint the final score message in a random color
'-----------------------------------------------------------------------------------------------------------
Sub FlashScoreMessage
flshMX = 610 - nudge
flshMY = 620
flshMsg = commaNumber
GraphicsWindow.FontSize = 45
GraphicsWindow.FontBold = "true"
GraphicsWindow.FontItalic = "True"
FlashAnyMessage()
EndSub
'--- FlashAnyMessage ---------------------------------------------------------------------------------
'--- Generic flash routine. Picks a mid-range color at random and displays the message
'-----------------------------------------------------------------------------------------------------------
Sub FlashAnyMessage
flashMsgClr = GraphicsWindow.GetColorFromRGB(Math.GetRandomNumber(180)+75,Math.GetRandomNumber(180)+75,Math.GetRandomNumber(180)+75)
GraphicsWindow.BrushColor = flashMsgClr
GraphicsWindow.DrawText(flshMX,flshMY,flshMsg)
EndSub
'---------------------------------------------------------------------------------
' Frame Wait Sit here and do nothing until the frame clock has run
' out. This wait keeps the automatic operations, like moving the
' block from running too fast.
'This technique is better then using Program.Delay() for two reasons:
' 1) The wait time is based on when we started the frame, not
' when we ended it. In other words, when one of our trips through
' the for loop above takes longer than normal, the delay will be
' reduced, so each frame will be exactly the same length.
' 2) We have the option (even though we are not using it here) of
' doing some extra processing, such as checking the keyboard.
' With Program.Delay() we are stuck, unable to do anything,
' until the delay is complete.
'---------------------------------------------------------------------------------
Sub FrameWait
While Clock.ElapsedMilliseconds - frameStart < frameRate
'As stated... do nothing.
EndWhile
frameStart = Clock.ElapsedMilliseconds 'Start a new frame.
EndSub
'--- 'OnKeyDown ---------------------------------------------------------------------------------------
'--- Take note of the fact that a key has been pressed. This event is
'--- needed because the GraphicsWindow.lastkey property never
'--- clears. Making otherwise impossible to distinguish between
'--- multiple presses of the same key
'-----------------------------------------------------------------------------------------------------------
Sub OnKeyDown
pressed = "True"
EndSub
Program Listing: PTQ565