08-03-2022, 02:43 AM
Added some tweaks:
1. Improved the controls
- arrow keys fire rockets at the current power level (you don't have to simultaneously press 1-7)
- 1-7 sets power level
2. Tweaked messages and displays
TODO next:
1. add sound
2. draw slopes where the mountains rise and fall.
the surface is made with little squares drawn with
Q: How to draw an 8w x 16h right triangle? I briefly looked at _MapTriangle and was confused.
Here is the latest version, it works:
1. Improved the controls
- arrow keys fire rockets at the current power level (you don't have to simultaneously press 1-7)
- 1-7 sets power level
2. Tweaked messages and displays
TODO next:
1. add sound
2. draw slopes where the mountains rise and fall.
the surface is made with little squares drawn with
Code: (Select All)
Line (iLoop * 8, iHeight * 16)-(iLoop * 8 + 8, _Height), _RGB32(128), BFHere is the latest version, it works:
Code: (Select All)
' Lunar Lander 1699 LOC bloatware by madscijr
' based on b+ Lander 30 LOC (double parking cheat) 2020-11-13
' BPlus proggies > Lander
' https://qb64phoenix.com/forum/showthread.php?tid=162&page=3&highlight=Lander
' https://qb64phoenix.com/forum/showthread.php?tid=443
' bplus Wrote:
' I got a little 30 LOC starter kit setup in Proggies for Lander.
' You will feel the need to jazz it up, resistance is futile.
' DATE WHO-DONE-IT DID-WHAT
' 2020-11-15 bplus fix off-sides x,
' add alternate keys: a=left d=right w=up
' so now arrow keys or WAD system works
' 2022-07-15 madscijr changed variables to double to move lander a fraction of a pixel at a time
' display velocity, fule, etc. on screen
' 2022-07-31 madscijr arrow keys fire rockets without needing to hold down 1-7,
' rockets are fired at whatever the last set power level
' keys 1-7 set power level
' tweaked text display and end-of-round messages
' DONE:
' Change input to use _BUTTON instead of KeyHit
' Track velocity + lateral momentum + fuel
' Display altitude, velocity, fuel, etc.
' v0.2: Pressing arrow up/down/left/right and 1-7 simultaneously selects which direction to thrust in, and power level.
' v0.5: Pressing 1-7 sets power level (default=1)
' v0.5: Arrow keys can be pressed without 1-7 to fire engine; engine is fired at last set power level
' v0.5: Added some detail to text display and messages at end of round.
' TODO:
' Sound effects: engines, crash, warning beeps (low fuel, moving too fast, etc.)
' Better (graphic) display for fuel gauge, air speed, etc.
' If speed too fast, display in a different color or graphically warn player.
' Simplify flames? Just draw a couple of lines instead of semicircles?
' Change surface of moon to vector lines.
' Rotate lander Asteroids-style like the arcade game (Atari Lunar Lander).
' Map entire moon and scroll horizontally as lander drifts towards edges of screen.
' Zoom in as lander gets close to surface.
' Stars "cheap planetarium"
' Track + display oxygen
' Meteorites, UFOs + other phenomena
' Support game controllers?
' Persist junk on the moon (crashed landers, stranded astronauts, flags / equipment, etc.)
' Get out and walk on the moon, collect rocks, meet moonmen, blast back off, rendevous, go home, splashdown, etc.
' Fly missions related to past missions (rescue stranded astronauts, recover items, etc.)
' Various missions - land, explore, take readings, rescue, salvage, mining, combat, set up moonbase, etc.
' BOOLEAN CONSTANTS
Const FALSE = 0
Const TRUE = Not FALSE
' FOR THRUST DIRECTION
Const cNone = 0
Const cUp = 1
Const cDown = 2
Const cLeft = 3
Const cRight = 4
' HOLDS INFO ABOUT ROCKET THRUSTERS
Type ThrustType
FuelUsed As Integer
Power As Double
Radius As Single
OffsetX As Single
OffsetY As Single
Color As _Unsigned Long
FlickerIndex As Integer
End Type ' ThrustType
' ENABLE / DISABLE DEBUG CONSOLE
Dim Shared m_bDebug As Integer: m_bDebug = TRUE
' BASIC PROGRAM METADATA
Dim Shared m_ProgramPath$: m_ProgramPath$ = Left$(Command$(0), _InStrRev(Command$(0), "\"))
Dim Shared m_ProgramName$: m_ProgramName$ = Mid$(Command$(0), _InStrRev(Command$(0), "\") + 1)
' ****************************************************************************************************************************************************************
' ACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
$Console
_Delay 4
_Console On
_Echo "Started " + m_ProgramName$
_Echo "Debugging on..."
End If
' ****************************************************************************************************************************************************************
' =============================================================================
' START THE MAIN ROUTINE
main
' =============================================================================
' FINISH
Screen 0
Print m_ProgramName$ + " finished."
Input "Press <ENTER> to continue", in$
' ****************************************************************************************************************************************************************
' DEACTIVATE DEBUGGING WINDOW
If m_bDebug = TRUE Then
_Console Off
End If
' ****************************************************************************************************************************************************************
System ' return control to the operating system
End
' /////////////////////////////////////////////////////////////////////////////
Sub main
' LOCAL VARIABLES
Dim dblGravity As Double: dblGravity = 0.05
Dim iStartFuel As Integer: iStartFuel = 1000
Dim dblMinSpeedY As Double: dblMinSpeedY = 1 ' 0.75
Dim dblMinSpeedX As Double: dblMinSpeedX = .5 ' 0.20
' -----------------------------------------------------------------------------
Dim iFPS As Integer: iFPS = 30
Dim bHorizontalMomentum As Integer: bHorizontalMomentum = FALSE
Dim iLoop As Integer
Dim imgMoon&
ReDim arrMoon(-100 To 200) As Integer
'ReDim arrMoon(-100 To 200) As Double
Dim iHeight As Integer
Dim dblDX As Double
Dim dblDY As Double
'Dim iDX As Integer
'Dim iDY As Integer
Dim dblX As Double
Dim dblY As Double
Dim iX As Integer
Dim iY As Integer
Dim sKey As String
Dim iMinX As Integer
Dim iMaxX As Integer
Dim iMinY As Integer
Dim iMaxY As Integer
Dim iStartY As Integer
Dim dblMinX As Double
Dim dblMaxX As Double
Dim dblMinY As Double
Dim dblMaxY As Double
Dim iFuel As Integer
Dim iEscapeFuel As Integer: iEscapeFuel = 75 ' how much fuel they need to leave
Dim iPowerLevel As Integer
Dim iAvailablePower As Integer
Dim bFlicker As Integer
Dim iThrustDirection As Integer
Dim iOldThrustDirection As Integer
Dim iDrawThrust As Integer
Dim arrThrust(0 To 7) As ThrustType
Dim arrHeight(0 To 2) As Integer
' -----------------------------------------------------------------------------
'RIGHT FLAME:
Dim sngStartRadian1 As Single: sngStartRadian1 = 5.2 ' 0 to 2, -6.1 to 6.1
Dim sngStopRadian1 As Single: sngStopRadian1 = 0.6 ' 0 to 2, -6.1 to 6.1
Dim sngAspect1 As Single: sngAspect1 = -1 ' 0 to 1, -6.1 to 6.1
'LEFT FLAME:
Dim sngStartRadian2 As Single: sngStartRadian2 = 2.5 ' 0 to 2, -6.1 to 6.1
Dim sngStopRadian2 As Single: sngStopRadian2 = 4.1 ' 0 to 2, -6.1 to 6.1
Dim sngAspect2 As Single: sngAspect2 = -1 ' 0 to 1, -6.1 to 6.1
' -----------------------------------------------------------------------------
Dim iLandingSite As Integer
Dim bQuit As Integer: bQuit = FALSE
Dim in$
' INIT THRUSTERS
arrThrust(0).FuelUsed = 0
arrThrust(0).Power = 0
arrThrust(0).Radius = 0
arrThrust(0).OffsetX = 0
arrThrust(0).OffsetY = 0
arrThrust(0).Color = cBlack
arrThrust(0).FlickerIndex = 0
arrThrust(1).FuelUsed = 1
arrThrust(1).Power = .05
arrThrust(1).Radius = 6
arrThrust(1).OffsetX = 0
arrThrust(1).OffsetY = 0
arrThrust(1).Color = cRed
arrThrust(1).FlickerIndex = 2
arrThrust(2).FuelUsed = 2
arrThrust(2).Power = .10
arrThrust(2).Radius = 8
arrThrust(2).OffsetX = -1
arrThrust(2).OffsetY = 1
arrThrust(2).Color = cYellow
arrThrust(2).FlickerIndex = 3
arrThrust(3).FuelUsed = 3
arrThrust(3).Power = .15
arrThrust(3).Radius = 10
arrThrust(3).OffsetX = -2
arrThrust(3).OffsetY = 2
arrThrust(3).Color = cOrange
arrThrust(3).FlickerIndex = 4
arrThrust(4).FuelUsed = 4
arrThrust(4).Power = .20
arrThrust(4).Radius = 12
arrThrust(4).OffsetX = -3
arrThrust(4).OffsetY = 3
arrThrust(4).Color = cRed
arrThrust(4).FlickerIndex = 5
arrThrust(5).FuelUsed = 6
arrThrust(5).Power = .3
arrThrust(5).Radius = 14
arrThrust(5).OffsetX = -4
arrThrust(5).OffsetY = 4
arrThrust(5).Color = cYellow
arrThrust(5).FlickerIndex = 6
arrThrust(6).FuelUsed = 9
arrThrust(6).Power = .4
arrThrust(6).Radius = 18
arrThrust(6).OffsetX = -6
arrThrust(6).OffsetY = 5
arrThrust(6).Color = cOrange
arrThrust(6).FlickerIndex = 7
arrThrust(7).FuelUsed = 12
arrThrust(7).Power = .5
arrThrust(7).Radius = 26
arrThrust(7).OffsetX = -10
arrThrust(7).OffsetY = 9
arrThrust(7).Color = cRed
arrThrust(7).FlickerIndex = 6
' =============================================================================
' INITIALIZE SCREEN
Screen _NewImage(800, 640, 32) ' 40 text rows x 100 text columns
imgMoon& = _NewImage(800, 640, 32)
' =============================================================================
' START NEW GAME
Do
Cls
_KeyClear
' -----------------------------------------------------------------------------
' DRAW RANDOM LUNAR SURFACE
Randomize Timer
iHeight = 30
iLandingSite = RandomNumber%(-9, 108)
For iLoop = -10 To 110
If iLoop = iLandingSite And iLoop <= (iLandingSite + 1) Then
iHeight = arrMoon(iLoop - 1)
Else
' The RND function returns a random number with a value between 0 (inclusive) and 1 (exclusive).
If Rnd < .5 Then iHeight = iHeight + Int(Rnd * 3) - 1
If iHeight > 39 Then iHeight = 39
If iHeight < 25 Then iHeight = 25
End If
Line (iLoop * 8, iHeight * 16)-(iLoop * 8 + 8, _Height), _RGB32(128), BF
arrMoon(iLoop) = iHeight
'arrMoon(iLoop) = iHeight * 16
DebugPrint "arrMoon(" + _Trim$(Str$(iLoop)) + " = " + _Trim$(Str$(arrMoon(iLoop)))
_PutImage , 0, imgMoon&
Next iLoop
DebugPrint "--------------------------------------------------------------------------------"
' -----------------------------------------------------------------------------
' SCREEN BOUNDARIES
iMinX = -2
iMaxX = 101
iMinY = 0 - 10
iMaxY = 39
dblMinX = iMinX * 8
dblMaxX = iMaxX * 8
dblMinY = iMinY * 8
dblMaxY = iMaxY * 8 ' 622
' -----------------------------------------------------------------------------
' PUT LANDER IN ORBIT
iStartY = 0
dblX = RandomNumber%(iMinX, iMaxX) * 8
dblY = iStartY * 16
dblDX = 0.0
dblDY = 0.5
iFuel = iStartFuel
bFlicker = FALSE
iThrustDirection = cNone
iOldThrustDirection = cNone
iDrawThrust = 0
iPowerLevel = 1
' -----------------------------------------------------------------------------
' CONFIGURE PRINTING FOR _PrintString
_PrintMode _FillBackground
'_PrintMode _KEEPBACKGROUND
' -----------------------------------------------------------------------------
' MAIN LOOP
While TRUE = TRUE
' REDRAW MOON
DrawMoon imgMoon&
' APPLY GRAVITY
dblDY = dblDY + dblGravity
' WRAP AROUND SCREEN WHY NOT
If dblX < dblMinX Then
dblX = dblMaxX
ElseIf dblX > dblMaxX Then
dblX = dblMinX
End If
' GET AN INTEGER
iX = DblToInt%(dblX) \ 8
iY = DblToInt%(dblY) \ 16
' SHOW INSTRUMENTS + INSTRUCTIONS
DrawText arrMoon(), dblX, dblY, iX, iY, dblDX, dblDY, dblMinSpeedX, dblMinSpeedY, iFuel, sKey
' DRAW LANDER
DrawLander dblX, dblY
' THRUST (CURRENTLY ONLY BOTTOM ENGINE)
If iAvailablePower > 0 Then
If iThrustDirection = cUp Then
' 2 ways we could draw rocket flame LINE and CIRCLE
'
' CIRCLE Parameters
' Can use STEP for relative coordinate moves from the previous graphic coordinates.
' Coordinates designate the center position of the circle. Can be partially drawn offscreen.
' radius% is an INTEGER value for half of the total circle diameter.
' drawColor% is any available color attribute in the SCREEN mode used.
' startRadian! and stopRadian! can be any SINGLE value from 0 to 2 * π to create partial circles or ellipses.
' aspect! SINGLE values of 0 to 1 affect the vertical height and values over 1 affect the horizontal width of an ellipse. Aspect = 1 is a normal circle.
'''LINE (dblX + 04, dblY + 16)-(dblX + 02, dblY + 20), cOrange
'''LINE (dblX + 04, dblY + 16)-(dblX + 06, dblY + 20), cYellow
'''Circle (dblX + 04, dblY + 16), 4, cRed, 0, 2
''Circle (dblX + 04, dblY + 16), 8, cRed, sngStartRadian, sngStopRadian
''Circle (dblX + 32, dblY + 32), 8, cOrange, sngAspect
''Circle (dblX + 64, dblY + 48), 8, cYellow, sngStartRadian, sngStopRadian, sngAspect
'Circle (dblX + 64, dblY + 48), iRadius, cYellow, sngStartRadian, sngStopRadian, sngAspect
If bFlicker = FALSE Then
iDrawThrust = iAvailablePower
Else
iDrawThrust = arrThrust(iAvailablePower).FlickerIndex
End If
Circle _
(dblX + 00 + arrThrust(iDrawThrust).OffsetX, dblY + 20 + arrThrust(iDrawThrust).OffsetY), _
arrThrust(iDrawThrust).Radius, _
arrThrust(iDrawThrust).Color, _
sngStartRadian1, _
sngStopRadian1, _
sngAspect1
Circle _
(dblX + 08 - arrThrust(iDrawThrust).OffsetX, dblY + 20 + arrThrust(iDrawThrust).OffsetY), _
arrThrust(iDrawThrust).Radius, _
arrThrust(iDrawThrust).Color, _
sngStartRadian2, _
sngStopRadian2, _
sngAspect2
End If
End If
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%
' -----------------------------------------------------------------------------
' HAS LANDER TOUCHED THE SURFACE OR WENT BACK INTO SPACE?
' GET HEIGHT OF SURFACE AROUND LANDER
arrHeight(0) = arrMoon(iX - 1) - 1
arrHeight(1) = arrMoon(iX) - 1
arrHeight(2) = arrMoon(iX + 1) - 1
' DID WE LAND ON EVEN SURFACE?
If iY = arrHeight(0) And iY = arrHeight(1) And iY = arrHeight(2) Then
' DID WE TOUCH DOWN GENTLY ENOUGH?
If dblDY <= dblMinSpeedY Then
' ARE WE MOVING TOO FAST HORIZONTALLY?
If Abs(dblDX) <= dblMinSpeedX Then
' ADJUST LANDER'S VERTICAL POSITION + REDRAW
dblY = (arrHeight(0) * 16) - 5
DrawMoon imgMoon& ' REDRAW MOON
DrawText arrMoon(), dblX, dblY, iX, iY, dblDX, dblDY, dblMinSpeedX, dblMinSpeedY, iFuel, sKey ' REDRAW TEXT
DrawLander dblX, dblY ' REDRAW LANDER
' TOUCH DOWN!
Color cWhite, cDimGray
PrintAt 13, 30, "The Eagle has landed. "
Color cWhite, cDimGray
PrintAt 14, 30, "That's one small step for (wo)man,"
Color cWhite, cDimGray
PrintAt 15, 30, "one giant leap for Earthlings. "
If iFuel < iEscapeFuel Then
Color cWhite, cDimGray
PrintAt 17, 30, "One small problem: "
Color cWhite, cDimGray
PrintAt 18, 30, "Not enough fuel left to leave."
End If
Exit While
Else
' TOO FAST HORIZONTALLY
Color cWhite, cDimGray
PrintAt 20, 30, "Moving too fast sideways."
PrintAt 21, 30, "Landing gear failure. "
Exit While
End If
Else
' TOO FAST VERTICALLY
Color cWhite, cDimGray
PrintAt 20, 30, "Falling too fast. "
PrintAt 21, 30, "Ship destroyed on imact. "
Exit While
End If
' DID WE LAND ON UNEVEN SURFACE?
ElseIf iY >= arrHeight(0) Or iY >= arrHeight(1) Or iY >= arrHeight(2) Or iY > iMaxY Then
' CRASHED DUE TO SPEED OR UNEVEN SURFACE?
If dblDY <= dblMinSpeedY Then
' CRASHED ON UNEVEN SURFACE
Color cWhite, cDimGray
PrintAt 20, 30, "Terrain is too uneven. "
PrintAt 21, 30, "Crash landed on surface. "
Exit While
Else
' TOO FAST VERTICALLY
Color cWhite, cDimGray
PrintAt 20, 30, "Out of control. "
PrintAt 21, 30, "Ship destroyed on imact. "
Exit While
End If
' DID WE LEAVE THE MOON'S ORBIT?
ElseIf iY < iMinY Then
' FLEW OFF INTO SPACE
Color cWhite, cDimGray
PrintAt 20, 30, "Leaving so soon? "
PrintAt 21, 30, "Lost in space. "
Exit While
End If
' =============================================================================
' PROCESS INPUT
While _DeviceInput(1): Wend ' clear and update the keyboard buffer
sKey = ""
' -----------------------------------------------------------------------------
' QUIT?
If _Button(KeyCode_Escape%) Then
bQuit = TRUE
Exit While
End If
' -----------------------------------------------------------------------------
' Get power level (1=weakest, 7=strongest)
If _Button(KeyCode_1%) Then
iPowerLevel = 1: sKey = sKey + "1,"
ElseIf _Button(KeyCode_2%) Then
iPowerLevel = 2: sKey = sKey + "2,"
ElseIf _Button(KeyCode_3%) Then
iPowerLevel = 3: sKey = sKey + "3,"
ElseIf _Button(KeyCode_4%) Then
iPowerLevel = 4: sKey = sKey + "4,"
ElseIf _Button(KeyCode_5%) Then
iPowerLevel = 5: sKey = sKey + "5,"
ElseIf _Button(KeyCode_6%) Then
iPowerLevel = 6: sKey = sKey + "6,"
ElseIf _Button(KeyCode_7%) Then
iPowerLevel = 7: sKey = sKey + "7,"
End If
' -----------------------------------------------------------------------------
' Get direction
If _Button(KeyCode_Left%) Then
sKey = sKey + "LEFT,"
iThrustDirection = cLeft
ElseIf _Button(KeyCode_A%) Then
sKey = sKey + "A,"
iThrustDirection = cLeft
ElseIf _Button(KeyCode_Right%) Then
sKey = sKey + "RIGHT,"
iThrustDirection = cRight
ElseIf _Button(KeyCode_D%) Then
sKey = sKey + "D,"
iThrustDirection = cRight
ElseIf _Button(KeyCode_Up%) Then
sKey = sKey + "UP,"
iThrustDirection = cUp
ElseIf _Button(KeyCode_W%) Then
sKey = sKey + "W,"
iThrustDirection = cUp
ElseIf _Button(KeyCode_Down%) Then
sKey = sKey + "DOWN,"
iThrustDirection = cDown
ElseIf _Button(KeyCode_S%) Then
sKey = sKey + "S,"
iThrustDirection = cDown
Else
iThrustDirection = cNone
End If
' -----------------------------------------------------------------------------
' Fire the engines
iAvailablePower = 0
If iThrustDirection <> cNone Then
' Remember previous
iOldThrustDirection = iThrustDirection
' Make sure we have enough fuel for thrust level.
' (Else adjust based on available fuel.)
For iLoop = iPowerLevel To 0 Step -1
If iFuel >= arrThrust(iLoop).FuelUsed Then
iAvailablePower = iLoop
Exit For
End If
Next iLoop
' If we had enough fuel that engines are firing
If iAvailablePower > 0 Then
' Consume fuel
iFuel = iFuel - arrThrust(iAvailablePower).FuelUsed
' Apply force
If iThrustDirection = cLeft Then
dblDX = dblDX - arrThrust(iAvailablePower).Power
'TODO: need a better way to do sound, these sounds don't stop playing when the player releases the controls
'SLIME_BAS_SOUND_11
ElseIf iThrustDirection = cRight Then
dblDX = dblDX + arrThrust(iAvailablePower).Power
'SLIME_BAS_SOUND_11
ElseIf iThrustDirection = cUp Then
dblDY = dblDY - arrThrust(iAvailablePower).Power
'SLIME_BAS_SOUND_11
ElseIf iThrustDirection = cDown Then
dblDY = dblDY + arrThrust(iAvailablePower).Power
'snatch_bas_sound_6
''SLIME_BAS_SOUND_11
End If
' Animate the rocket flames
If iThrustDirection = iOldThrustDirection Then bFlicker = Not (bFlicker)
Else
' Engines off
iOldThrustDirection = cNone: bFlicker = FALSE
End If
Else
' Engines off
iOldThrustDirection = cNone: bFlicker = FALSE
End If
' -----------------------------------------------------------------------------
' MOVE LANDER
dblX = dblX + dblDX
dblY = dblY + dblDY
' -----------------------------------------------------------------------------
' CONTROL GAME SPEED
_Limit iFPS
'_Limit 2
'_Limit 30
Wend
_KeyClear: _Delay 2
' PLAY ANOTHER ROUND OR QUIT?
If bQuit = FALSE Then
Sleep
Color cWhite, cBlack
Else
Exit Do
End If
Loop
End Sub ' main
' (RE)DRAW MOON
Sub DrawMoon (imgMoon&)
_PutImage , imgMoon&, 0
End Sub ' DrawMoon
' SHOW INSTRUMENTS + INSTRUCTIONS
' 800x600 = 40 rows x 100 columns
sub DrawText( _
arrMoon() As Integer, _
dblX as double, dblY as double, _
iX as integer, iY as integer, _
dblDX as double, dblDY as double, _
dblMinSpeedX as double, dblMinSpeedY as double, _
iFuel as integer, sKey as string _
)
Dim sValue$
' SHOW POSITION + SPEED
Color cWhite
PrintAt 1, 1, "Velocity X: " + Left$(DblRoundedToStr$(dblDX, 3), 5) + " "
Color cGray
PrintAt 2, 1, "Max +/- X: " + Left$(DblRoundedToStr$(dblMinSpeedX, 3), 5) + " "
Color cWhite
PrintAt 1, 21, "Latitude : " + _
LeftPadString$(cstr$(iX), 4, " ") + _
" " + _
LeftPadString$(Left$(DblRoundedToStr$(dblX, 3), 5), 5, " ") + _
" "
Color cWhite
PrintAt 3, 1, "Velocity Y: " + Left$(DblRoundedToStr$(dblDY, 3), 5) + " "
Color cGray
PrintAt 4, 1, "Max Y: " + Left$(DblRoundedToStr$(dblMinSpeedY, 3), 5) + " "
Color cWhite
PrintAt 3, 21, "Altitude : " + _
LeftPadString$(cstr$(iY), 4, " ") + _
" " + _
LeftPadString$(Left$(DblRoundedToStr$(dblY, 3), 5), 5, " ") + _
" "
Color cGray
sValue$ = cstr$(arrMoon(iX - 1))
PrintAt 5, 21, "Surface : " + LeftPadString$(sValue$, 4, " ") + " "
sValue$ = cstr$(arrMoon(iX))
PrintAt 6, 21, " " + LeftPadString$(sValue$, 4, " ") + " "
sValue$ = cstr$(arrMoon(iX + 1))
PrintAt 7, 21, " " + LeftPadString$(sValue$, 4, " ") + " "
Color cYellow
If iFuel > 0 Then
PrintAt 8, 1, "Fuel : " + _Trim$(Str$(iFuel)) + " "
Else
PrintAt 8, 1, "Fuel : EMPTY"
End If
Color cLime
PrintAt 10, 1, "Controls : " + RightPadString$(sKey, 10, " ") + " "
Color cDodgerBlue
PrintAt 1, 48, Chr$(34) + "One Small Step" + Chr$(34)
Color cCyan
PrintAt 3, 48, "Land on an even surface."
Color cMagenta
PrintAt 5, 48, "Arrow keys: direction of thrust"
PrintAt 6, 48, " (up slows descent)"
PrintAt 8, 48, "1-7 keys: burn engine"
PrintAt 9, 48, " (1 = weakest)"
Color cOrange
PrintAt 11, 48, "Good Luck!"
End Sub ' DrawText
Sub DrawLander (dblX, dblY)
' DRAW LANDER
'CIRCLE [[[STEP]]](column, row), radius%, [drawColor%][, startRadian!, stopRadian!] [, aspect!]
Circle (dblX + 4, dblY + 8), 4, cGray
'Circle (dblX - 2, dblY + 16), 4, cGray, 0, _Pi
'Circle (dblX + 10, dblY + 16), 4, cGray, 0, _Pi
Circle (dblX + 0, dblY + 16), 4, cGray, 0, _Pi
Circle (dblX + 8, dblY + 16), 4, cGray, 0, _Pi
''Circle (dblX + 4, dblY + 8), 4, &HFF00FFFF
''Circle (dblX + 0, dblY + 16), 4, &HFFFFFF00, 0, _Pi
''Circle (dblX + 8, dblY + 16), 4, &HFFFFFF00, 0, _Pi
'LINE [STEP] [(column1, row1)]-[STEP] (column2, row2), color[, [{B|BF}], style%]
''LINE (100, 100)-(200, 200), 10
'LINE (dblX + 4, dblY + 16)-(dblX + 0, dblY + 24), cGray
'LINE (dblX + 4, dblY + 16)-(dblX + 8, dblY + 24), cGray
' LEGS:
Line (dblX - 4, dblY + 16)-(dblX - 4, dblY + 20), cGray
Line (dblX + 12, dblY + 16)-(dblX + 12, dblY + 20), cGray
' FEET
Line (dblX - 5, dblY + 20)-(dblX - 3, dblY + 20), cGray
Line (dblX + 11, dblY + 20)-(dblX + 13, dblY + 20), cGray
End Sub ' DrawLander
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
Function cstr$ (myValue)
'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$
' /////////////////////////////////////////////////////////////////////////////
' Hack function, to be replaced with something better
Function DblToInt% (dblOld As Double)
Dim dblNew As Double
Dim sValue As String
Dim iPos As Integer
dblNew = RoundDouble#(dblOld, 0)
'sValue = _Trim$(Str$(dblNew))
sValue = DblToStr$(dblNew)
'iPos = InStr(1, sValue, ".")
'If iPos > 0 Then
' DblToInt% = Val(Left$(sValue, iPos - 1))
'Else
' DblToInt% = Val(sValue)
'End If
DblToInt% = Val(sValue)
End Function ' DblToInt%
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function DblToStr$ (n#)
Dim result$: result$ = ""
Dim value$
Dim Xpos%
Dim expo%
Dim sign$
Dim valu$
Dim dot%
Dim L%
Dim add$
Dim min$
Dim DP$
Dim n%
value$ = UCase$(LTrim$(Str$(n#)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") ' only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n% = 1 To L%
If Mid$(valu$, n%, 1) <> "." Then
num$ = num$ + Mid$(valu$, n%, 1)
End If
Next n%
result$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
Else
result$ = value$
End If
DblToStr$ = result$
End Function ' DblToStr$
' /////////////////////////////////////////////////////////////////////////////
Function DblRoundedToStr$ (dblValue As Double, intNumPlaces As Integer)
Dim dblNew As Double
dblNew = RoundDouble#(dblValue, intNumPlaces)
DblRoundedToStr$ = DblToStr$(dblNew)
End Function ' DblRoundedToStr$
' /////////////////////////////////////////////////////////////////////////////
' Scientific notation - QB64 Wiki
' https://www.qb64.org/wiki/Scientific_notation
' Example: A string function that displays extremely small or large exponential decimal values.
Function FloatToStr$ (n##)
value$ = UCase$(LTrim$(Str$(n##)))
Xpos% = InStr(value$, "D") + InStr(value$, "E") 'only D or E can be present
If Xpos% Then
expo% = Val(Mid$(value$, Xpos% + 1))
If Val(value$) < 0 Then
sign$ = "-"
valu$ = Mid$(value$, 2, Xpos% - 2)
Else
valu$ = Mid$(value$, 1, Xpos% - 1)
End If
dot% = InStr(valu$, ".")
L% = Len(valu$)
If expo% > 0 Then
add$ = String$(expo% - (L% - dot%), "0")
End If
If expo% < 0 Then
min$ = String$(Abs(expo%) - (dot% - 1), "0")
DP$ = "."
End If
For n = 1 To L%
If Mid$(valu$, n, 1) <> "." Then
num$ = num$ + Mid$(valu$, n, 1)
End If
Next n
Else
FloatToStr$ = value$
Exit Function
End If
FloatToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
End Function ' FloatToStr$
' /////////////////////////////////////////////////////////////////////////////
' By sMcNeill from https://www.qb64.org/forum/index.php?topic=896.0
Function IsNum% (text$)
Dim a$
Dim b$
a$ = _Trim$(text$)
b$ = _Trim$(Str$(Val(text$)))
If a$ = b$ Then
IsNum% = TRUE
Else
IsNum% = FALSE
End If
End Function ' IsNum%
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'Combine all elements of in$() into a single string with delimiter$ separating the elements.
Function join$ (in$(), delimiter$)
Dim result$
Dim i As Long
result$ = in$(LBound(in$))
For i = LBound(in$) + 1 To UBound(in$)
result$ = result$ + delimiter$ + in$(i)
Next i
join$ = result$
End Function ' join$
' /////////////////////////////////////////////////////////////////////////////
Function LeftPadString$ (myString$, toWidth%, padChar$)
LeftPadString$ = Right$(String$(toWidth%, padChar$) + myString$, toWidth%)
End Function ' LeftPadString$
' /////////////////////////////////////////////////////////////////////////////
' iRow% and iCol% are 0-based in this version
Sub PrintAt (iRow%, iCol%, sText$)
'_PrintString (iCol% * 8, iRow% * 16), sText$
_PrintString (iCol% * 8, iRow% * 16), sText$
'_PrintString (iCol%, iRow%), sText$
End Sub ' PrintAt
' /////////////////////////////////////////////////////////////////////////////
' Generate random value between Min and Max.
Function RandomNumber% (Min%, Max%)
Dim NumSpread%
' SET RANDOM SEED
'Randomize ' Initialize random-number generator.
Randomize Timer
' GET RANDOM # Min%-Max%
'RandomNumber = Int((Max * Rnd) + Min) ' generate number
NumSpread% = (Max% - Min%) + 1
RandomNumber% = Int(Rnd * NumSpread%) + Min% ' GET RANDOM # BETWEEN Max% AND Min%
End Function ' RandomNumber%
' /////////////////////////////////////////////////////////////////////////////
Function RightPadString$ (myString$, toWidth%, padChar$)
RightPadString$ = Left$(myString$ + String$(toWidth%, padChar$), toWidth%)
End Function ' RightPadString$
' /////////////////////////////////////////////////////////////////////////////
' https://www.qb64.org/forum/index.php?topic=3605.0
' Quote from: SMcNeill on Today at 03:53:48 PM
'
' Sometimes, you guys make things entirely too complicated.
' There ya go! Three functions to either round naturally,
' always round down, or always round up, to whatever number of digits you desire.
' EDIT: Modified to add another option to round scientific,
' since you had it's description included in your example.
' Receives + returns _FLOAT myVar## (-1.18E-4932 to +1.18E+4932)
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE _FLOAT
Function Round## (num##, digits%)
Round## = Int(num## * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUp## (num##, digits%)
RoundUp## = _Ceil(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDown## (num##, digits%)
RoundDown## = Int(num## * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientific## (num##, digits%)
RoundScientific## = _Round(num## * 10 ^ digits%) / 10 ^ digits%
End Function
' =============================================================================
' ROUNDING FUNCTIONS FOR TYPE DOUBLE
Function RoundDouble# (num#, digits%)
RoundDouble# = Int(num# * 10 ^ digits% + .5) / 10 ^ digits%
End Function
Function RoundUpDouble# (num#, digits%)
RoundUpDouble# = _Ceil(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundDownDouble# (num#, digits%)
RoundDownDouble# = Int(num# * 10 ^ digits%) / 10 ^ digits%
End Function
Function RoundScientificDouble# (num#, digits%)
RoundScientificDouble# = _Round(num# * 10 ^ digits%) / 10 ^ digits%
End Function
' /////////////////////////////////////////////////////////////////////////////
' Split and join strings
' https://www.qb64.org/forum/index.php?topic=1073.0
'
' FROM luke, QB64 Developer
' Date: February 15, 2019, 04:11:07 AM
'
' Given a string of words separated by spaces (or any other character),
' splits it into an array of the words. I've no doubt many people have
' written a version of this over the years and no doubt there's a million
' ways to do it, but I thought I'd put mine here so we have at least one
' version. There's also a join function that does the opposite
' array -> single string.
'
' Code is hopefully reasonably self explanatory with comments and a little demo.
' Note, this is akin to Python/JavaScript split/join, PHP explode/implode.
'Split in$ into pieces, chopping at every occurrence of delimiter$. Multiple consecutive occurrences
'of delimiter$ are treated as a single instance. The chopped pieces are stored in result$().
'
'delimiter$ must be one character long.
'result$() must have been REDIMmed previously.
' Modified to handle multi-character delimiters
Sub split (in$, delimiter$, result$())
Dim start As Integer
Dim finish As Integer
Dim iDelimLen As Integer
ReDim result$(-1)
iDelimLen = Len(delimiter$)
start = 1
Do
'While Mid$(in$, start, 1) = delimiter$
While Mid$(in$, start, iDelimLen) = delimiter$
'start = start + 1
start = start + iDelimLen
If start > Len(in$) Then
Exit Sub
End If
Wend
finish = InStr(start, in$, delimiter$)
If finish = 0 Then
finish = Len(in$) + 1
End If
ReDim _Preserve result$(0 To UBound(result$) + 1)
result$(UBound(result$)) = Mid$(in$, start, finish - start)
start = finish + 1
Loop While start <= Len(in$)
End Sub ' split
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END GENERAL PURPOSE FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Function cRed~& ()
cRed = _RGB32(255, 0, 0)
End Function
Function cOrangeRed~& ()
cOrangeRed = _RGB32(255, 69, 0)
End Function ' cOrangeRed~&
Function cDarkOrange~& ()
cDarkOrange = _RGB32(255, 140, 0)
End Function ' cDarkOrange~&
Function cOrange~& ()
cOrange = _RGB32(255, 165, 0)
End Function ' cOrange~&
Function cGold~& ()
cGold = _RGB32(255, 215, 0)
End Function ' cGold~&
Function cYellow~& ()
cYellow = _RGB32(255, 255, 0)
End Function ' cYellow~&
' LONG-HAIRED FRIENDS OF JESUS OR NOT,
' THIS IS NOT YELLOW ENOUGH (TOO CLOSE TO LIME)
' TO USE FOR OUR COMPLEX RAINBOW SEQUENCE:
Function cChartreuse~& ()
cChartreuse = _RGB32(127, 255, 0)
End Function ' cChartreuse~&
' WE SUBSTITUTE THIS CSS3 COLOR FOR INBETWEEN LIME AND YELLOW:
Function cOliveDrab1~& ()
cOliveDrab1 = _RGB32(192, 255, 62)
End Function ' cOliveDrab1~&
Function cLime~& ()
cLime = _RGB32(0, 255, 0)
End Function ' cLime~&
Function cMediumSpringGreen~& ()
cMediumSpringGreen = _RGB32(0, 250, 154)
End Function ' cMediumSpringGreen~&
Function cCyan~& ()
cCyan = _RGB32(0, 255, 255)
End Function ' cCyan~&
Function cDeepSkyBlue~& ()
cDeepSkyBlue = _RGB32(0, 191, 255)
End Function ' cDeepSkyBlue~&
Function cDodgerBlue~& ()
cDodgerBlue = _RGB32(30, 144, 255)
End Function ' cDodgerBlue~&
Function cSeaBlue~& ()
cSeaBlue = _RGB32(0, 64, 255)
End Function ' cSeaBlue~&
Function cBlue~& ()
cBlue = _RGB32(0, 0, 255)
End Function ' cBlue~&
Function cBluePurple~& ()
cBluePurple = _RGB32(64, 0, 255)
End Function ' cBluePurple~&
Function cDeepPurple~& ()
cDeepPurple = _RGB32(96, 0, 255)
End Function ' cDeepPurple~&
Function cPurple~& ()
cPurple = _RGB32(128, 0, 255)
End Function ' cPurple~&
Function cPurpleRed~& ()
cPurpleRed = _RGB32(128, 0, 192)
End Function ' cPurpleRed~&
Function cDarkRed~& ()
cDarkRed = _RGB32(160, 0, 64)
End Function ' cDarkRed~&
Function cBrickRed~& ()
cBrickRed = _RGB32(192, 0, 32)
End Function ' cBrickRed~&
Function cDarkGreen~& ()
cDarkGreen = _RGB32(0, 100, 0)
End Function ' cDarkGreen~&
Function cGreen~& ()
cGreen = _RGB32(0, 128, 0)
End Function ' cGreen~&
Function cOliveDrab~& ()
cOliveDrab = _RGB32(107, 142, 35)
End Function ' cOliveDrab~&
Function cLightPink~& ()
cLightPink = _RGB32(255, 182, 193)
End Function ' cLightPink~&
Function cHotPink~& ()
cHotPink = _RGB32(255, 105, 180)
End Function ' cHotPink~&
Function cDeepPink~& ()
cDeepPink = _RGB32(255, 20, 147)
End Function ' cDeepPink~&
Function cMagenta~& ()
cMagenta = _RGB32(255, 0, 255)
End Function ' cMagenta~&
Function cBlack~& ()
cBlack = _RGB32(0, 0, 0)
End Function ' cBlack~&
Function cDimGray~& ()
cDimGray = _RGB32(105, 105, 105)
End Function ' cDimGray~&
Function cGray~& ()
cGray = _RGB32(128, 128, 128)
End Function ' cGray~&
Function cDarkGray~& ()
cDarkGray = _RGB32(169, 169, 169)
End Function ' cDarkGray~&
Function cSilver~& ()
cSilver = _RGB32(192, 192, 192)
End Function ' cSilver~&
Function cLightGray~& ()
cLightGray = _RGB32(211, 211, 211)
End Function ' cLightGray~&
Function cGainsboro~& ()
cGainsboro = _RGB32(220, 220, 220)
End Function ' cGainsboro~&
Function cWhiteSmoke~& ()
cWhiteSmoke = _RGB32(245, 245, 245)
End Function ' cWhiteSmoke~&
Function cWhite~& ()
cWhite = _RGB32(255, 255, 255)
'cWhite = _RGB32(254, 254, 254)
End Function ' cWhite~&
Function cDarkBrown~& ()
cDarkBrown = _RGB32(128, 64, 0)
End Function ' cDarkBrown~&
Function cLightBrown~& ()
cLightBrown = _RGB32(196, 96, 0)
End Function ' cLightBrown~&
Function cKhaki~& ()
cKhaki = _RGB32(240, 230, 140)
End Function ' cKhaki~&
Function cEmpty~& ()
'cEmpty~& = -1
cEmpty = _RGB32(0, 0, 0, 0)
End Function ' cEmpty~&
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END COLOR FUNCTIONS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' BEGIN KEYBOARD CODE FUNCTIONS
' NOTE: ALL CODES ARE FOR _BUTTON, EXCEPT:
' cF10 (_KEYDOWN)
' cAltLeft (_KEYHIT)
' cAltRight (_KEYHIT)
' cPrintScreen (_KEYHIT) <- may slow down pc?
' cPauseBreak (_KEYHIT) <- may not work?
' ################################################################################################################################################################
Function KeyCode_Escape% ()
KeyCode_Escape% = 2
End Function
Function KeyCode_F1% ()
KeyCode_F1% = 60
End Function
Function KeyCode_F2% ()
KeyCode_F2% = 61
End Function
Function KeyCode_F3% ()
KeyCode_F3% = 62
End Function
Function KeyCode_F4% ()
KeyCode_F4% = 63
End Function
Function KeyCode_F5% ()
KeyCode_F5% = 64
End Function
Function KeyCode_F6% ()
KeyCode_F6% = 65
End Function
Function KeyCode_F7% ()
KeyCode_F7% = 66
End Function
Function KeyCode_F8% ()
KeyCode_F8% = 67
End Function
Function KeyCode_F9% ()
KeyCode_F9% = 68
End Function
'_KEYDOWN CODE, NOT _BUTTON CODE
Function KeyCode_F10% ()
KeyCode_F10% = 17408
End Function
Function KeyCode_F11% ()
KeyCode_F11% = 88
End Function
Function KeyCode_F12% ()
KeyCode_F12% = 89
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PrintScreen% ()
KeyCode_PrintScreen% = -44
End Function
Function KeyCode_ScrollLock% ()
KeyCode_ScrollLock% = 71
End Function
'_KEYHIT CODE, NOT _BUTTON CODE
Function KeyCode_PauseBreak% ()
KeyCode_PauseBreak% = 31053
End Function
Function KeyCode_Tilde% ()
KeyCode_Tilde% = 42
End Function
Function KeyCode_1% ()
KeyCode_1% = 3
End Function
Function KeyCode_2% ()
KeyCode_2% = 4
End Function
Function KeyCode_3% ()
KeyCode_3% = 5
End Function
Function KeyCode_4% ()
KeyCode_4% = 6
End Function
Function KeyCode_5% ()
KeyCode_5% = 7
End Function
Function KeyCode_6% ()
KeyCode_6% = 8
End Function
Function KeyCode_7% ()
KeyCode_7% = 9
End Function
Function KeyCode_8% ()
KeyCode_8% = 10
End Function
Function KeyCode_9% ()
KeyCode_9% = 11
End Function
Function KeyCode_0% ()
KeyCode_0% = 12
End Function
Function KeyCode_Minus% ()
KeyCode_Minus% = 13
End Function
Function KeyCode_Equal% ()
KeyCode_Equal% = 14
End Function
Function KeyCode_BkSp% ()
KeyCode_BkSp% = 15
End Function
Function KeyCode_Ins% ()
KeyCode_Ins% = 339
End Function
Function KeyCode_Home% ()
KeyCode_Home% = 328
End Function
Function KeyCode_PgUp% ()
KeyCode_PgUp% = 330
End Function
Function KeyCode_Del% ()
KeyCode_Del% = 340
End Function
Function KeyCode_End% ()
KeyCode_End% = 336
End Function
Function KeyCode_PgDn% ()
KeyCode_PgDn% = 338
End Function
Function KeyCode_NumLock% ()
KeyCode_NumLock% = 326
End Function
Function KeyCode_KeypadSlash% ()
KeyCode_KeypadSlash% = 310
End Function
Function KeyCode_KeypadMultiply% ()
KeyCode_KeypadMultiply% = 56
End Function
Function KeyCode_KeypadMinus% ()
KeyCode_KeypadMinus% = 75
End Function
Function KeyCode_Keypad7Home% ()
KeyCode_Keypad7Home% = 72
End Function
Function KeyCode_Keypad8Up% ()
KeyCode_Keypad8Up% = 73
End Function
Function KeyCode_Keypad9PgUp% ()
KeyCode_Keypad9PgUp% = 74
End Function
Function KeyCode_KeypadPlus% ()
KeyCode_KeypadPlus% = 79
End Function
Function KeyCode_Keypad4Left% ()
KeyCode_Keypad4Left% = 76
End Function
Function KeyCode_Keypad5% ()
KeyCode_Keypad5% = 77
End Function
Function KeyCode_Keypad6Right% ()
KeyCode_Keypad6Right% = 78
End Function
Function KeyCode_Keypad1End% ()
KeyCode_Keypad1End% = 80
End Function
Function KeyCode_Keypad2Down% ()
KeyCode_Keypad2Down% = 81
End Function
Function KeyCode_Keypad3PgDn% ()
KeyCode_Keypad3PgDn% = 82
End Function
Function KeyCode_KeypadEnter% ()
KeyCode_KeypadEnter% = 285
End Function
Function KeyCode_Keypad0Ins% ()
KeyCode_Keypad0Ins% = 83
End Function
Function KeyCode_KeypadPeriodDel% ()
KeyCode_KeypadPeriodDel% = 84
End Function
Function KeyCode_Tab% ()
KeyCode_Tab% = 16
End Function
Function KeyCode_Q% ()
KeyCode_Q% = 17
End Function
Function KeyCode_W% ()
KeyCode_W% = 18
End Function
Function KeyCode_E% ()
KeyCode_E% = 19
End Function
Function KeyCode_R% ()
KeyCode_R% = 20
End Function
Function KeyCode_T% ()
KeyCode_T% = 21
End Function
Function KeyCode_Y% ()
KeyCode_Y% = 22
End Function
Function KeyCode_U% ()
KeyCode_U% = 23
End Function
Function KeyCode_I% ()
KeyCode_I% = 24
End Function
Function KeyCode_O% ()
KeyCode_O% = 25
End Function
Function KeyCode_P% ()
KeyCode_P% = 26
End Function
Function KeyCode_BracketLeft% ()
KeyCode_BracketLeft% = 27
End Function
Function KeyCode_BracketRight% ()
KeyCode_BracketRight% = 28
End Function
Function KeyCode_Backslash% ()
KeyCode_Backslash% = 44
End Function
Function KeyCode_CapsLock% ()
KeyCode_CapsLock% = 59
End Function
Function KeyCode_A% ()
KeyCode_A% = 31
End Function
Function KeyCode_S% ()
KeyCode_S% = 32
End Function
Function KeyCode_D% ()
KeyCode_D% = 33
End Function
Function KeyCode_F% ()
KeyCode_F% = 34
End Function
Function KeyCode_G% ()
KeyCode_G% = 35
End Function
Function KeyCode_H% ()
KeyCode_H% = 36
End Function
Function KeyCode_J% ()
KeyCode_J% = 37
End Function
Function KeyCode_K% ()
KeyCode_K% = 38
End Function
Function KeyCode_L% ()
KeyCode_L% = 39
End Function
Function KeyCode_Semicolon% ()
KeyCode_Semicolon% = 40
End Function
Function KeyCode_Apostrophe% ()
KeyCode_Apostrophe% = 41
End Function
Function KeyCode_Enter% ()
KeyCode_Enter% = 29
End Function
Function KeyCode_ShiftLeft% ()
KeyCode_ShiftLeft% = 43
End Function
Function KeyCode_Z% ()
KeyCode_Z% = 45
End Function
Function KeyCode_X% ()
KeyCode_X% = 46
End Function
Function KeyCode_C% ()
KeyCode_C% = 47
End Function
Function KeyCode_V% ()
KeyCode_V% = 48
End Function
Function KeyCode_B% ()
KeyCode_B% = 49
End Function
Function KeyCode_N% ()
KeyCode_N% = 50
End Function
Function KeyCode_M% ()
KeyCode_M% = 51
End Function
Function KeyCode_Comma% ()
KeyCode_Comma% = 52
End Function
Function KeyCode_Period% ()
KeyCode_Period% = 53
End Function
Function KeyCode_Slash% ()
KeyCode_Slash% = 54
End Function
Function KeyCode_ShiftRight% ()
KeyCode_ShiftRight% = 55
End Function
Function KeyCode_Up% ()
KeyCode_Up% = 329
End Function
Function KeyCode_Left% ()
KeyCode_Left% = 332
End Function
Function KeyCode_Down% ()
KeyCode_Down% = 337
End Function
Function KeyCode_Right% ()
KeyCode_Right% = 334
End Function
Function KeyCode_CtrlLeft% ()
KeyCode_CtrlLeft% = 30
End Function
Function KeyCode_WinLeft% ()
KeyCode_WinLeft% = 348
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltLeft% ()
KeyCode_AltLeft% = -30764
End Function
Function KeyCode_Spacebar% ()
KeyCode_Spacebar% = 58
End Function
' _KEYHIT CODE NOT _BUTTON CODE
Function KeyCode_AltRight% ()
KeyCode_AltRight% = -30765
End Function
Function KeyCode_WinRight% ()
KeyCode_WinRight% = 349
End Function
Function KeyCode_Menu% ()
KeyCode_Menu% = 350
End Function
Function KeyCode_CtrlRight% ()
KeyCode_CtrlRight% = 286
End Function
' ################################################################################################################################################################
' END KEYBOARD CODE FUNCTIONS
' ################################################################################################################################################################
' ################################################################################################################################################################
' BEGIN SOUND ROUTINES
' ################################################################################################################################################################
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN RUMBLE SOUNDS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' /////////////////////////////////////////////////////////////////////////////
' low warbling rumbly sound (very short version)
Sub SLIME_BAS_SOUND_11
Dim z%
Dim zz%
For z% = 220 To 200 Step -1
Sound Int(100 * Rnd) + 50, .3
For zz% = 1 To 1000: Next zz%
Next z%
End Sub ' SLIME_BAS_SOUND_11
' /////////////////////////////////////////////////////////////////////////////
' medium rumbling type sound
Sub snatch_bas_sound_6
Dim Z As Integer
For Z = 40 To 1 Step -1
'For Z = 10 To 1 Step -1
'Z = 20
Sound Int(60 * Rnd) + 60 + Z, .2
Next Z
End Sub ' snatch_bas_sound_6
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END RUMBLE SOUNDS
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' END SOUND ROUTINES
' ################################################################################################################################################################
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' BEGIN DEBUGGING ROUTINES #DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Sub DebugPrint (MyString As String)
If m_bDebug = TRUE Then
'_Echo MyString
ReDim arrLines(-1) As String
Dim iLoop As Integer
split MyString, Chr$(13), arrLines()
For iLoop = LBound(arrLines) To UBound(arrLines)
_Echo arrLines(iLoop)
Next iLoop
End If
End Sub ' DebugPrint
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' END DEBUGGING ROUTINES @DEBUGGING
' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' ################################################################################################################################################################
' #REFERENCE
' =============================================================================
' SOME USEFUL STUFF FOR REFERENCE:
' Type Name Type suffix symbol Minimum value Maximum value Size in Bytes
' --------------------- ------------------ ---------------------------- -------------------------- -------------
' _BIT ` -1 0 1/8
' _BIT * n `n -128 127 n/8
' _UNSIGNED _BIT ~` 0 1 1/8
' _BYTE %% -128 127 1
' _UNSIGNED _BYTE ~%% 0 255 1
' INTEGER % -32,768 32,767 2
' _UNSIGNED INTEGER ~% 0 65,535 2
' LONG & -2,147,483,648 2,147,483,647 4
' _UNSIGNED LONG ~& 0 4,294,967,295 4
' _INTEGER64 && -9,223,372,036,854,775,808 9,223,372,036,854,775,807 8
' _UNSIGNED _INTEGER64 ~&& 0 18,446,744,073,709,551,615 8
' SINGLE ! or none -2.802597E-45 +3.402823E+38 4
' DOUBLE # -4.490656458412465E-324 +1.797693134862310E+308 8
' _FLOAT ## -1.18E-4932 +1.18E+4932 32(10 used)
' _OFFSET %& -9,223,372,036,854,775,808 9,223,372,036,854,775,807 Use LEN
' _UNSIGNED _OFFSET ~%& 0 18,446,744,073,709,551,615 Use LEN
' _MEM none combined memory variable type N/A Use LEN
' div: int1% = num1% \ den1%
' mod: rem1% = num1% MOD den1%