QB64 Phoenix Edition
My Lunar Lander bloatware! (ver 0.33) - 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: My Lunar Lander bloatware! (ver 0.33) (/showthread.php?tid=654)

Pages: 1 2

My Lunar Lander bloatware! (ver 0.33) - madscijr - 07-19-2022

I took the 30 line game by BPlus and force fed it, and now it's 1500+ lines!

It's still not Atari Lunar Lander, but getting there...!

My current challenge is doing sound effects from code without resorting to using separate sound files. The rocket sounds keep playing after the player stops pressing keys. How to make it stop? 

Enjoy

Code: (Select All)
' Looney Lander 1562 LOC, v0.33, mostly 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, fuel, etc. on screen

' DONE:
' Change input to use _BUTTON instead of KeyHit
' Track velocity + lateral momentum + fuel
' Display altitude, velocity, fuel, etc.
' Pressing arrow up/down/left/right and 1-7 simultaneously selects which direction to thrust in, and power level.

' TODO:
' Better (graphic) display for fuel gauge, air speed, etc.
' If speed too fast, display in a different color or graphically warn player.
' Sound effects: engines, crash, warning beeps (low fuel, moving too fast, etc.)
' Simplify flames? Just draw a couple of lines instead of semicircles?
' Change surface of moon to vector lines.
' 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?
' Get out and walk on the moon, collect rocks, meet moonmen, blast back off, rendevous, go home, splashdown, 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 dblMinX As Double
    Dim dblMaxX As Double
    Dim dblMinY As Double
    Dim dblMaxY As Double
    Dim iFuel As Integer
    Dim iThrust As Integer
    Dim iOldThrust As Integer
    Dim bFlicker As Integer
    Dim iThrustDirection 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 bCrash As Integer: bCrash = FALSE
    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)
    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 Or 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
        intMinX = -2
        intMaxX = 101
        intMinY = 0
        intMaxY = 39
        dblMinX = intMinX * 8
        dblMaxX = intMaxX * 8
        dblMinY = intMinY * 8
        dblMaxY = intMaxY * 8 ' 622
       
        ' -----------------------------------------------------------------------------
        ' PUT LANDER IN ORBIT
        dblX = RandomNumber%(intMinX, intMaxX) * 8
        dblY = intMinY * 16
        dblDX = 0.0
        dblDY = 0.5
        iFuel = iStartFuel
        iThrust = 0
        iOldThrust = 0
        bFlicker = FALSE
        iThrustDirection = cNone
        iDrawThrust = 0
        bCrash = FALSE
       
        ' -----------------------------------------------------------------------------
        ' CONFIGURE PRINTING FOR _PrintString
        _PrintMode _FillBackground
        '_PrintMode _KEEPBACKGROUND
       
        ' -----------------------------------------------------------------------------
        ' MAIN LOOP
        While TRUE = TRUE
            ' REDRAW MOON
            _PutImage , imgMoon&, 0
           
            ' 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
           
            Color cWhite
            PrintAt 1, 1, "Velocity X: " + Left$(DblRoundedToStr$(dblDX, 3), 5) + "     "
            PrintAt 1, 20, "Latitude  : " + cstr$(iX) + "     " '+ Left$(DblRoundedToStr$(dblX, 3), 5) + "     "
           
            PrintAt 3, 1, "Velocity Y: " + Left$(DblRoundedToStr$(dblDY, 3), 5) + "     "
            PrintAt 3, 20, "Altitude  : " + cstr$(iY) + "     " '+ Left$(DblRoundedToStr$(dblY, 3), 5) + "     "
           
            Color cGray
            PrintAt 5, 20, "Surface   : " + _Trim$(Str$(arrMoon(iX - 1)))
            PrintAt 6, 20, "            " + _Trim$(Str$(arrMoon(iX)))
            PrintAt 7, 20, "            " + _Trim$(Str$(arrMoon(iX + 1)))
           
            Color cYellow
            If iFuel > 0 Then
                PrintAt 9, 1, "Fuel      : " + _Trim$(Str$(iFuel))
            Else
                PrintAt 9, 1, "Fuel      : EMPTY"
            End If
           
            Color cCyan
            PrintAt 11, 1, "Controls  : " + sKey
           
            Color cDodgerBlue
            PrintAt 1, 40, Chr$(34) + "One Small Step" + Chr$(34)
            Color cMagenta
            PrintAt 4, 40, "Land on an even surface."
            PrintAt 2, 40, "Arrow keys: select which rocket engine, up slows descent."
            PrintAt 3, 40, "1-7   keys: fire thrusters, 1=lightest, 7=heaviest."
            Color cLime
            PrintAt 5, 40, "Maximum x velocity: " + Left$(DblRoundedToStr$(dblMinSpeedX, 3), 5) + "     "
            PrintAt 6, 40, "Maximum y velocity: " + Left$(DblRoundedToStr$(dblMinSpeedY, 3), 5) + "     "
            Color cMagenta
            PrintAt 7, 40, "Good Luck!"
           
            ' 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
           
            ' THRUST (CURRENTLY ONLY BOTTOM ENGINE)
            If iThrust > 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 = iThrust
                    Else
                        iDrawThrust = arrThrust(iThrust).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
                        ' TOUCH DOWN!
                        Color cLime
                        PrintAt 20, 50, "That's one small step for (wo)man kind!"
                        Exit While
                    Else
                        ' TOO FAST HORIZONTALLY
                        bCrash = TRUE
                    End If
                Else
                    ' TOO FAST VERTICALLY
                    bCrash = TRUE
                End If
               
                ' DID WE LAND ON UNEVEN SURFACE?
            ElseIf iY = arrHeight(0) Or iY = arrHeight(1) Or iY = arrHeight(2) Or iY > intMaxY Then
                ' CRASHED ON UNEVEN SURFACE
                bCrash = TRUE
               
                ' DID WE LEAVE THE MOON'S ORBIT?
            ElseIf iY < intMinY Then
                ' FLEW OFF INTO SPACE
                Color cCyan
                PrintAt 20, 50, "Lost in space!"
                _KeyClear: _Delay 2
                Exit While
            End If
           
            ' EXIT IF WE CRASHED
            If bCrash = TRUE Then
                Color cRed
                PrintAt 20, 50, "Crash!"
                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 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
           
            ' -----------------------------------------------------------------------------
            ' Get power level (1=weakest, 7=strongest)
            If iThrustDirection <> cNone Then
                If _Button(KeyCode_1%) Then
                    iOldThrust = iThrust: iThrust = 1: sKey = sKey + "1,"
                ElseIf _Button(KeyCode_2%) Then
                    iOldThrust = iThrust: iThrust = 2: sKey = sKey + "2,"
                ElseIf _Button(KeyCode_3%) Then
                    iOldThrust = iThrust: iThrust = 3: sKey = sKey + "3,"
                ElseIf _Button(KeyCode_4%) Then
                    iOldThrust = iThrust: iThrust = 4: sKey = sKey + "4,"
                ElseIf _Button(KeyCode_5%) Then
                    iOldThrust = iThrust: iThrust = 5: sKey = sKey + "5,"
                ElseIf _Button(KeyCode_6%) Then
                    iOldThrust = iThrust: iThrust = 6: sKey = sKey + "6,"
                ElseIf _Button(KeyCode_7%) Then
                    iOldThrust = iThrust: iThrust = 7: sKey = sKey + "7,"
                Else
                    iOldThrust = 0: iThrust = 0: bFlicker = FALSE
                End If
            Else
                iOldThrust = 0: iThrust = 0: bFlicker = FALSE
            End If
           
            ' -----------------------------------------------------------------------------
            ' Fire the engines
            If iThrust > 0 Then
                ' Make sure we have enough fuel for thrust level.
                ' (Else adjust based on available fuel.)
                For iLoop = iThrust To 0 Step -1
                    If iFuel >= arrThrust(iLoop).FuelUsed Then
                        iThrust = iLoop
                        Exit For
                    End If
                Next iLoop
               
                ' If we had enough fuel that engines are firing
                If iThrust > 0 Then
                    ' Consume fuel
                    iFuel = iFuel - arrThrust(iLoop).FuelUsed
                   
                    ' Apply force
                    If iThrustDirection = cLeft Then
                        dblDX = dblDX - arrThrust(iThrust).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(iThrust).Power
                        'SLIME_BAS_SOUND_11
                    ElseIf iThrustDirection = cUp Then
                        dblDY = dblDY - arrThrust(iThrust).Power
                        'SLIME_BAS_SOUND_11
                    ElseIf iThrustDirection = cDown Then
                        dblDY = dblDY + arrThrust(iThrust).Power
                        'snatch_bas_sound_6
                        ''SLIME_BAS_SOUND_11
                    End If
                   
                    ' Animate the rocket flames
                    If iThrust = iOldThrust Then bFlicker = Not (bFlicker)
                Else
                    ' Engines off
                    iOldThrust = 0: bFlicker = FALSE
                End If
            End If
           
            ' -----------------------------------------------------------------------------
            ' MOVE LANDER
            dblX = dblX + dblDX
            dblY = dblY + dblDY
           
            ' -----------------------------------------------------------------------------
            ' CONTROL GAME SPEED
            _Limit iFPS
            '_Limit 2
            '_Limit 30
        Wend
       
        ' PLAY ANOTHER ROUND OR QUIT?
        If bQuit = FALSE Then
            _KeyClear: _Delay 1: Sleep
        Else
            Exit Do
        End If
    Loop
End Sub ' main

' ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
' 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#)
    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
        DblToStr$ = value$
        Exit Function
    End If
    DblToStr$ = _Trim$(sign$ + DP$ + min$ + num$ + add$)
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$

' /////////////////////////////////////////////////////////////////////////////

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: My Lunar Lander bloatware! (ver 0.33) - SierraKen - 07-20-2022

LOL that is fun! For the sound, you might want to try short bursts of sound if it's possible. Or use the PLAY command to play an A note at 16 or 32. https://qb64phoenix.com/qb64wiki/index.php/PLAY

There might be other ways to do it too, I know that I use Dav's chimes for my clock that doesn't use either of those, it uses the _SndRawLen, _SndRaw, and _SndRate commands that I still have to figure out myself.

RE: My Lunar Lander bloatware! (ver 0.33) - madscijr - 07-20-2022

(07-20-2022, 04:08 PM)SierraKen Wrote: LOL that is fun! For the sound, you might want to try short bursts of sound if it's possible. Or use the PLAY command to play an A note at 16 or 32. https://qb64phoenix.com/qb64wiki/index.php/PLAY

There might be other ways to do it too, I know that I use Dav's chimes for my clock that doesn't use either of those, it uses the _SndRawLen, _SndRaw, and _SndRate commands that I still have to figure out myself.

I saw those _SndRaw commands, briefly played with them, and didn't get too far.
It does look like it gives you low-level control, and I will spend more time reading about it.
Sound is one of those areas of QB64 that I need to learn more about. I would like to see the language expanded with higher level commands that let you have more control over audio, but maybe some of that functionality is already present. I need to study some _SndRaw examples and see what it can do...

RE: My Lunar Lander bloatware! (ver 0.33) - SierraKen - 07-20-2022

Here is one of my simple clocks using Dav's chimes. The chimes section is towards the bottom. When you run it, press the Space Bar to hear the chimes anytime. They also play at the top of the hour.

Code: (Select All)
_Title "Clock by Ken G."
Screen _NewImage(350, 350, 32)
_Limit 500
Do
    a$ = InKey$
    If a$ = " " Then chimes = 1
    Circle (180, 184), 140, _RGB32(127, 249, 255)
    hours = Timer \ 3600
    minutes = Timer \ 60 - hours * 60
    seconds = (Timer - hours * 3600 - minutes * 60)
    ho$ = Left$(Time$, 2): hou = Val(ho$)
    min$ = Mid$(Time$, 4, 2): minu = Val(min$)
    seco$ = Right$(Time$, 2): secon = Val(seco$)

    'Minutes
    m = 180 - minutes * 6
    xx = Int(Sin(m / 180 * 3.141592) * 120) + 180
    yy = Int(Cos(m / 180 * 3.141592) * 120) + 184
    For b = -5 To 5 Step .1
        Line (180 + b, 184)-(xx, yy), _RGB32(0, 255, 255)
        Line (180, 184 + b)-(xx, yy), _RGB32(0, 255, 255)
    Next b
    'Hours
    h = 360 - hours * 30 + 180
    xxx = Int(Sin(h / 180 * 3.141592) * 100) + 180
    yyy = Int(Cos(h / 180 * 3.141592) * 100) + 184
    For b = -5 To 5 Step .1
        Line (180 + b, 184)-(xxx, yyy), _RGB32(0, 255, 0)
        Line (180, 184 + b)-(xxx, yyy), _RGB32(0, 255, 0)
    Next b
    'Seconds
    s = (60 - seconds) * 6 + 180
    x = Int(Sin(s / 180 * 3.141592) * 125) + 180
    y = Int(Cos(s / 180 * 3.141592) * 125) + 184
    For b = -5 To 5 Step .1
        Line (180 + b, 184)-(x, y), _RGB32(255, 0, 0)
        Line (180, 184 + b)-(x, y), _RGB32(255, 0, 0)
    Next b

    'Dav's Chimes
    If (minu = 0 And secon = 0) Or chimes = 1 Then
        hour2 = hou
        If hour2 > 12 Then hour2 = hour2 - 12
        If hour2 = 0 Then hour2 = 12
        For chimes = 1 To hour2
            ttt = 0
            Do
                'queue some sound
                Do While _SndRawLen < 0.1 'you may wish to adjust this
                    sample = Sin(ttt * 340 * Atn(1) * 8) '340Hz sine wave (ttt * 440 * 2p)
                    sample = sample * Exp(-ttt * 3) 'fade out eliminates clicks after sound
                    _SndRaw sample
                    ttt = ttt + 1 / _SndRate 'sound card sample frequency determines time
                Loop
                'do other stuff, but it may interrupt sound
            Loop While ttt < 2 'play for 2 seconds
            Do While _SndRawLen > 0 'Finish any left over queued sound!
            Loop
        Next chimes
    End If
    chimes = 0
    two:
    _Display
    Cls
Loop


RE: My Lunar Lander bloatware! (ver 0.33) - vince - 07-21-2022

Does B+ also have a lunar lander or is it a JB original?

RE: My Lunar Lander bloatware! (ver 0.33) - madscijr - 07-21-2022

(07-21-2022, 01:50 AM)vince Wrote: Does B+ also have a lunar lander or is it a JB original?

I link to BPlus' 30-line original in the comments at the top of my code ^^^

Here's the original:

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:

Quote: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.


RE: My Lunar Lander bloatware! (ver 0.33) - madscijr - 07-21-2022

(07-20-2022, 06:47 PM)SierraKen Wrote: Here is one of my simple clocks using Dav's chimes. The chimes section is towards the bottom. When you run it, press the Space Bar to hear the chimes anytime. They also play at the top of the hour.

Thanks! The fade out that eliminates the clicks after the sound is helpful. 

I see the comment "do other stuff, but it may interrupt sound" which leads to my next question - 
if it's a sound effect for a game, where we're constantly redrawing the screen, reading the keyboard for input, and making calculations, 
the sound effects need to be asynchronous. How do we get it to NOT interrupt the sound? 
When the player lets go of the "thrust" button, the engine sound should stop immediately, without any clicks. 

Here's my test harness where I am playing with your "chimes" code: 
Code: (Select All)
' SierraKen
' Here is one of my simple clocks using Dav's chimes.
' The chimes section is towards the bottom.
' When you run it, press the Space Bar to hear the chimes anytime.
' They also play at the top of the hour.

' https://qb64phoenix.com/forum/showthread.php?tid=654&pid=4228#pid4228

_Title "Chimes #1"

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

Dim HZ&
Dim iCount%
Dim iIncrement&
Dim iDirection&
Dim iMinHZ&
Dim iMaxHZ&
Dim bQuit%

iCount% = 0
iMinHZ& = 1
iMaxHZ& = 20000
iMinInc& = 1
iMaxInc& = 16384
iIncrement& = 40
iDirection& = 1
HZ& = iMinHZ& ' start at 128 Hz
'HZ& = 340 ' 340Hz
bQuit% = FALSE

_Limit 500
Do
    iCount% = iCount% + 1
    HZ& = HZ& + (iIncrement& * iDirection&)
    ttt = 0
    Cls
    Print "_SndRaw experiment based on Clock by SierraKen"
    Print
    Print "Chime #" + _Trim$(Str$(iCount%))
    Print
    Print "Frequency = " + _Trim$(Str$(HZ&)) + " Hz"
    Print "Increment = " + _Trim$(Str$((iIncrement& * iDirection&))) + " Hz"
    Print "Min freq  = " + _Trim$(Str$(iMinHZ&)) + " Hz"
    Print "Max freq  = " + _Trim$(Str$(iMaxHZ&)) + " Hz"
    Print
    Print "Press 1 to decrease frequency increment by 5."
    Print "Press 2 to increase " + Chr$(34) + " " + Chr$(34)
    Print
    Print "Press Esc to quit."

    Do
        GoSub GetInput

        ' queue some sound
        Do While _SndRawLen < 0.1 ' you may wish to adjust this
            sample = Sin(ttt * HZ& * Atn(1) * 8) ' HZ% HZ sine wave (ttt * 440 * 2p)
            sample = sample * Exp(-ttt * 3) ' fade out eliminates clicks after sound
            _SndRaw sample
            ttt = ttt + 1 / _SndRate ' sound card sample frequency determines time
        Loop
        ' do other stuff, but it may interrupt sound
    Loop While ttt < 2 ' play for 2 seconds

    Do While _SndRawLen > 0 ' Finish any left over queued sound!
        GoSub GetInput
    Loop

    If HZ& < iMinHZ& Or HZ& > iMaxHZ& Then
        iDirection& = iDirection& * -1
    End If

    _KeyClear: '_DELAY 1
    If bQuit% = TRUE Then Exit Do
Loop
End

GetInput:
sKey$ = InKey$
If sKey$ = Chr$(27) Then
    bQuit% = TRUE
ElseIf sKey$ = "1" Then
    iIncrement& = iIncrement& - 5: If iIncrement& < iMinInc& Then iIncrement& = iMinInc&
ElseIf sKey$ = "2" Then
    iIncrement& = iIncrement& + 5: If iIncrement& > iMaxInc& Then iIncrement& = iMaxInc&
End If
Return

' /////////////////////////////////////////////////////////////////////////////

Sub PrintAt (iRow%, iCol%, sText$)
    '_PrintString (iCol% * 8, iRow% * 16), sText$
    _PrintString (iCol% * 8, iRow% * 16), sText$
    '_PrintString (iCol%, iRow%), sText$
End Sub ' PrintAt


RE: My Lunar Lander bloatware! (ver 0.33) - SierraKen - 07-21-2022

Neat little experiment.

Yeah I think the PLAY command might be the only one that can play while the code keeps going. It uses the MB command inside the PLAY command to tell it to play that way. Here is an example I just made. MB sets it to play while it keeps going and the letters are the sound notes and the numbers are the duration of each note. 

You also can see many other commands that PLAY has here. There might be a way to make a ship sound with it, not sure. 
https://qb64phoenix.com/qb64wiki/index.php/PLAY

Code: (Select All)
Do
    t = t + 1
    Print t
    Play "MB a16b16c16d16e16f16g16"
Loop


RE: My Lunar Lander bloatware! (ver 0.33) - SierraKen - 07-21-2022

This might be a good engine sound, you can play around with it. The << sets the octave 2 times lower. 

Code: (Select All)
Do
    t = t + 1
    Print t
    Play "MB <<g32"
Loop


RE: My Lunar Lander bloatware! (ver 0.33) - mnrvovrfc - 07-25-2022

(07-21-2022, 08:23 PM)SierraKen Wrote: This might be a good engine sound, you can play around with it. The << sets the octave 2 times lower. 

Code: (Select All)
Do
    t = t + 1
    Print t
    Play "MB <<g32"
Loop

I might be mistaken but "PLAY" and "SOUND" are part of the deal for QB64 to emulate M$QB and GW-BASIC as closely as possible. Especially people using the latter product entirely expected sounds playing while doing something else such as keyboard input. It was crucial for those who were able to program impressive text-mode animations while complex music arrangements were being played.

You're better off at least using "_SNDOPEN", "_SNDPLAY", "_SNDSTOP", "_SNDVOL", "_SNDPLAYING" and "_SNDCLOSE", with external audio files. They could be in MP3 or OGG format which could be very small if one-channel and maybe 22050Hz sampling rate. Might want to take advantage of "_INFLATE" and "_MEMSOUND" to even include such a file into your source code. Otherwise "_SNDRAW" is the only way to start and stop sound at will.

I have to check out "_MEMSOUND" myself, but I'm not very comfortable programming for the "_MEM" gang. That statement is a lot like "Catchsound" in Purebasic, made it rather easy to bind media files into an EXE file. Sadly it might be for Windows only unless QB64 could recognize "zlib" on Linux.

EDIT: Uh about the code above, what is done with "t"? Because it's an endless loop.