QB64 Phoenix Edition
latest Lunar Lander Bloatware v0.51 - Printable Version

+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: latest Lunar Lander Bloatware v0.51 (/showthread.php?tid=718)

latest Lunar Lander Bloatware v0.51 - madscijr - 08-03-2022

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 
Code: (Select All)
Line (iLoop * 8, iHeight * 16)-(iLoop * 8 + 8, _Height), _RGB32(128), BF
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:

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%


RE: latest Lunar Lander Bloatware v0.51 - madscijr - 08-03-2022

I did some reading and looking at code and figured out how to play sound files. Woohoo! 
The attached 7zip file contains the test program and the WAV files. 
I will add sounds to the game soon.

PS I would still like to include the sound data in the program itself, 
rather than have to use external resources (sound files). 
I saw Fellippe's "frostbite.bas" generates the files if they are not found. 
It uses ogg format which might be necessary to keep the program size smaller. 
I need to find code to generate the data statements in "LoadAssets" - 
it looks like base64 encoding not entirely sure. 
This method seems easier than trying to generate WAV files from scratch or using _SNDRAW, 
so I will look more into this when I have time...

Code: (Select All)
' Just a little sound test program to see if we can
' play and loop WAV files, change volume,
' and play 2 or more simultaneously.
' It works!

' BOOLEAN CONSTANTS
Const FALSE = 0
Const TRUE = Not FALSE

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

' LOCAL VARIABLES
Dim lngUpSound As Long
Dim lngDownSound As Long
Dim lngLeftSound As Long
Dim lngRightSound As Long
Dim lngEndSound As Long
Dim iPowerLevel As Integer
Dim iOldPowerLevel As Integer
Dim bUpdate As Integer
Dim bUp As Integer
Dim bDown As Integer
Dim bLeft As Integer
Dim bRight As Integer
Dim iWarningCount As Long
Dim bDoCount As Integer
Dim sngVolume As Single
Dim bPowerChanged As Integer
Dim in$
Dim sError As String: sError = ""

' LOAD SOUNDS
lngUpSound = _SndOpen(m_ProgramPath$ + "lunar_thrust1.wav")
lngDownSound = _SndOpen(m_ProgramPath$ + "lunar_alarm2.wav")
lngLeftSound = _SndOpen(m_ProgramPath$ + "lunar_alarm1.wav")
lngRightSound = _SndOpen(m_ProgramPath$ + "lunar_beep1.wav")
lngEndSound = _SndOpen(m_ProgramPath$ + "lunar_explode1.wav")

' ARE SOUNDS LOADED?
If lngUpSound = 0 Then sError = sError + "lngUpSound=0" + Chr$(13)
If lngDownSound = 0 Then sError = sError + "lngDownSound=0" + Chr$(13)
If lngLeftSound = 0 Then sError = sError + "lngLeftSound=0" + Chr$(13)
If lngRightSound = 0 Then sError = sError + "lngRightSound=0" + Chr$(13)
If lngEndSound = 0 Then sError = sError + "lngEndSound=0" + Chr$(13)
If Len(sError) > 0 Then Cls: Print sError: Input "PRESS ENTER TO EXIT"; in$: End

' INITIALIZE
bUpdate = TRUE
iPowerLevel = 1
iOldPowerLevel = 1
bUp = FALSE
bDown = FALSE
bLeft = FALSE
bRight = FALSE
iWarningCount = 100
sngVolume = GetVolumePercent!(iPowerLevel)
bPowerChanged = TRUE
bDoCount = FALSE

' MAIN LOOP
Do
    ' SHOW CHANGES ON SCREEN
    If bUpdate = TRUE Then
        Cls
        Print "SOUND EFFECTS TEST HARNESS"
        Print "-------------------------------------------------------------------------------"
        Print "PRESS 1-7 TO CHANGE POWER (ENGINE VOLUME):"
        Print "iPowerLevel  =" + cstr$(iPowerLevel)
        Print "sngVolume    =" + _Trim$(Str$(sngVolume))
        Print
       
        Print "UP ACTIVATES ENGINE:"
        Print "bUp          =" + TrueFalse$(bUp)
        Print
       
        Print "DOWN STARTS COUNTDOWN TO SELF-DESTRUCT:"
        Print "bDown        =" + TrueFalse$(bDown)
        Print
       
        Print "LEFT ACTIVATES ALARM #1:"
        Print "bLeft        =" + TrueFalse$(bLeft)
        Print
       
        Print "RIGHT ACTIVATES ALARM #2:"
        Print "bRight       =" + TrueFalse$(bRight)
        Print
       
        Print "SELF-DESTRUCT TIMER:"
        Print "iWarningCount=" + cstr$(iWarningCount) + IIFSTR$(bDoCount, " <- COUNTDOWN TO BOOM!", "")
        Print
       
        Print "PRESS ESC TO QUIT"
        bUpdate = FALSE
    End If
   
    While _DeviceInput(1): Wend ' clear and update the keyboard buffer
    If _Button(KeyCode_1%) Then
        iPowerLevel = 1
    ElseIf _Button(KeyCode_2%) Then
        iPowerLevel = 2
    ElseIf _Button(KeyCode_3%) Then
        iPowerLevel = 3
    ElseIf _Button(KeyCode_4%) Then
        iPowerLevel = 4
    ElseIf _Button(KeyCode_5%) Then
        iPowerLevel = 5
    ElseIf _Button(KeyCode_6%) Then
        iPowerLevel = 6
    ElseIf _Button(KeyCode_7%) Then
        iPowerLevel = 7
    End If
    If iPowerLevel <> iOldPowerLevel Then
        bPowerChanged = TRUE
        bUpdate = TRUE
        iOldPowerLevel = iPowerLevel
        sngVolume = GetVolumePercent!(iPowerLevel)
    End If
   
    If _Button(KeyCode_Up%) Then
        If bUp = FALSE Then bUpdate = TRUE
        bUp = TRUE
    Else
        If bUp = TRUE Then bUpdate = TRUE
        bUp = FALSE
    End If
    If _Button(KeyCode_Down%) Then
        If bDown = FALSE Then bUpdate = TRUE
        bDown = TRUE
    Else
        If bDown = TRUE Then bUpdate = TRUE
        bDown = FALSE
    End If
    If _Button(KeyCode_Left%) Then
        If bLeft = FALSE Then bUpdate = TRUE
        bLeft = TRUE
    Else
        If bLeft = TRUE Then bUpdate = TRUE
        bLeft = FALSE
    End If
    If _Button(KeyCode_Right%) Then
        If bRight = FALSE Then bUpdate = TRUE
        bRight = TRUE
    Else
        If bRight = TRUE Then bUpdate = TRUE
        bRight = FALSE
    End If
   
    If _Button(KeyCode_Escape%) Then
        Exit Do
    End If
   
    ' START/STOP SOUNDS AND SET VOLUME
    If bUp = TRUE Then
        If lngUpSound <> 0 Then
            If bPowerChanged = TRUE Then _SndVol lngUpSound, sngVolume
            If _SndPlaying(lngUpSound) = FALSE Then _SndLoop lngUpSound '_SNDPLAY lngUpSound
        End If
    Else
        If lngUpSound <> 0 Then
            If _SndPlaying(lngUpSound) = TRUE Then _SndStop lngUpSound
        End If
    End If
   
    If bDown = TRUE Then
        If bDoCount = FALSE Then
            If lngDownSound <> 0 Then
                bDoCount = TRUE
                iWarningCount = 100
                If _SndPlaying(lngDownSound) = FALSE Then _SndLoop lngDownSound '_SNDPLAY lngDownSound
            End If
        End If
    End If
   
    ' LEFT
    If bLeft = TRUE Then
        If lngLeftSound <> 0 Then
            If _SndPlaying(lngLeftSound) = FALSE Then _SndLoop lngLeftSound '_SNDPLAY lngUpSound
        End If
    Else
        If lngLeftSound <> 0 Then
            If _SndPlaying(lngLeftSound) = TRUE Then _SndStop lngLeftSound
        End If
    End If
   
    ' RIGHT
    If bRight = TRUE Then
        If lngRightSound <> 0 Then
            If _SndPlaying(lngRightSound) = FALSE Then _SndLoop lngRightSound '_SNDPLAY lngUpSound
        End If
    Else
        If lngRightSound <> 0 Then
            If _SndPlaying(lngRightSound) = TRUE Then _SndStop lngRightSound
        End If
    End If
   
    ' COUNTDOWN WITH WARNING
    If bDoCount = TRUE Then
        bUpdate = TRUE
        iWarningCount = iWarningCount - 1
        If iWarningCount < 1 Then
            ' STOP ALL SOUNDS
            If lngUpSound <> 0 Then
                If _SndPlaying(lngUpSound) = TRUE Then _SndStop lngUpSound
            End If
            If lngDownSound <> 0 Then
                If _SndPlaying(lngDownSound) = TRUE Then _SndStop lngDownSound
            End If
            If lngLeftSound <> 0 Then
                If _SndPlaying(lngLeftSound) = TRUE Then _SndStop lngLeftSound
            End If
            If lngRightSound <> 0 Then
                If _SndPlaying(lngRightSound) = TRUE Then _SndStop lngRightSound
            End If
           
            '' WAIT A SECOND
            '_Delay 1
           
            ' SHOW MESSAGE
            Cls
            Print "BOOM!"
           
            ' PLAY FINAL SOUND
            If lngEndSound <> 0 Then
                If _SndPlaying(lngEndSound) = TRUE Then _SndStop lngEndSound
                _SndPlay lngEndSound
            End If
            bDoCount = FALSE
           
            ' PROMPT TO CONTINUE
            Input "PRESS ENTER TO CONTINUE"; in$
        End If
    End If
   
    _Limit 30
Loop

_SndClose lngUpSound
_SndClose lngDownSound
_SndClose lngLeftSound
_SndClose lngEndSound
_SndClose lngRightSound

Function GetVolumePercent! (iPowerLevel As Integer)
    GetVolumePercent! = iPowerLevel / 7
End Function

Function cstr$ (myValue)
    'cstr$ = LTRIM$(RTRIM$(STR$(myValue)))
    cstr$ = _Trim$(Str$(myValue))
End Function ' cstr$

Function IIFSTR$ (Condition, IfTrue$, IfFalse$)
    If Condition Then IIFSTR$ = IfTrue$ Else IIFSTR$ = IfFalse$
End Function

Function TrueFalse$ (myValue)
    If myValue = TRUE Then
        TrueFalse$ = "TRUE"
    Else
        TrueFalse$ = "FALSE"
    End If
End Function ' TrueFalse$

' ################################################################################################################################################################
' BEGIN KEYBOARD _BUTTON CODE FUNCTIONS
' ################################################################################################################################################################

Function KeyCode_Escape% ()
    KeyCode_Escape% = 2
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_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

' ################################################################################################################################################################
' END KEYBOARD _BUTTON CODE FUNCTIONS
' ################################################################################################################################################################