more source code and tutorials for making games

[madscijr]

@madscijr 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.

Well now I did it! For some reason I am not seeing the lander on the screen... 
Would anyone be able to give this a look and point out my folly? 
I've been beating my head against the wall and need a second set of eyes! 

Code: (Select All)

' b+ Lander 30 LOC (double parking cheat) 2020-11-13

' BPlus proggies > Lander
' https://staging.qb64phoenix.com/showthread.php?tid=162&page=3&highlight=Lander

' https://staging.qb64phoenix.com/showthread.php?tid=443
' bplus Wrote:
' [url=https://staging.qb64phoenix.com/member.php?action=profile&uid=10]@madscijr[/url] 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      tried to change variables to double and move lander a fraction of a pixel at a time
'                            display velocity, etc. on screen
'                            and broke the whole thing :-O

' TODO:
' Track velocity + lateral momentum + fuel + oxygen
' Display altitude, velocity, fuel, oxygen, etc.
' Get out and walk on the moon, collect rocks, meet moonmen, blast back off, rendevous, go home, etc.

Const FALSE = 0
Const TRUE = Not FALSE

Dim iLoop As Integer
Dim imgMoon&
ReDim arrMoon(-100 To 200) As Integer
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 KeyInput&
Dim sKey As String
Dim iFPS As Integer

Screen _NewImage(800, 640, 32)
imgMoon& = _NewImage(800, 640, 32)

Do
    Cls
    _KeyClear

    ' DRAW RANDOM LUNAR SURFACE
    iHeight = 30
    For iLoop = -10 To 110
        If Rnd < .5 Then iHeight = iHeight + Int(Rnd * 3) - 1
        If iHeight > 39 Then iHeight = 39
        If iHeight < 25 Then iHeight = 25
        Line (iLoop * 8, iHeight * 16)-(iLoop * 8 + 8, _Height), _RGB32(128), BF
        arrMoon(iLoop) = iHeight
        _PutImage , 0, imgMoon&
    Next iLoop

    ' PUT LANDER IN ORBIT
    dblX = 24 ' 3 * 8
    dblY = 10 ' 2 * 16
    dblDX = 0.0
    dblDY = 0.5
    'Input "X?"; dblX
    'Input "Y?"; dblY
    'Input "DX?"; dblDX
    'Input "DY?"; dblDX
    'Input "FPS?"; iFPS
    iFPS = 15

    ' MAIN LOOP
    While TRUE = TRUE
        ' REDRAW MOON
        _PutImage , imgMoon&, 0

        ' DRAW LANDER
        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

        ' WRAP AROUND SCREEN WHY NOT
        If dblX < -5 Then
            dblX = 105
        ElseIf dblX > 105 Then
            dblX = -5
        End If

        ' GET AN INTEGER
        iY = DblToInt%(dblY)
        iX = DblToInt%(dblX)

        Locate 1, 1: Print "dblDY=" + Left$(_Trim$(Str$(dblDY)), 5) + "     ";
        Locate 1, 20: Print "dblDX=" + Left$(_Trim$(Str$(dblDX)), 5) + "     ";

        Locate 2, 1: Print "dblX =" + Left$(_Trim$(Str$(dblX)), 5) + "     ";
        Locate 2, 20: Print "iX=" + cstr$(iX) + "     ";

        Locate 3, 1: Print "dblY =" + Left$(_Trim$(Str$(dblY)), 5) + "     ";
        Locate 3, 20: Print "iY=" + cstr$(iY) + "     ";

        Locate 4, 1: Print "Moon=" + _Trim$(Str$(arrMoon(iX - 1)))
        Locate 4, 20: Print _Trim$(Str$(arrMoon(iX)))
        Locate 4, 40: Print _Trim$(Str$(arrMoon(iX + 1)))

        Locate 5, 1: Print "sKey =" + sKey

        ' DID WE CRASH?
        If iY >= arrMoon(iX - 1) Or iY >= arrMoon(iX + 1) Or iY >= arrMoon(iX) Or iY >= 40 Then
            _PrintString (46 * 8, 2 * 16), "Crash!"
            Exit While
        End If

        ' DID WE LAND?
        If iY = arrMoon(iX - 1) - 1 And iY = arrMoon(iX + 1) - 1 Then
            _PrintString (46 * 8, 2 * 16), "That's one small step for (wo)man kind!"
            Exit While
        End If

        ' PROCESS INPUT
        KeyInput& = _KeyHit: sKey = _Trim$(Str$(KeyInput&))
        If KeyInput& = 19200 Then dblDX = dblDX - .05:
        If KeyInput& = 97 Then dblDX = dblDX - .05:
        If KeyInput& = 19712 Then dblDX = dblDX + .05:
        If KeyInput& = 100 Then dblDX = dblDX + .05:
        If KeyInput& = 18432 Then dblDY = dblDY - .05:
        If KeyInput& = 119 Then dblDY = dblDY - .05:
        ' For testing, down arrow increases velocity:
        If KeyInput& = 20480 Then dblDY = dblDY + .05:

        ' MOVE LANDER
        dblX = dblX + dblDX
        dblY = dblY + dblDY

        _Limit iFPS
        '_Limit 2
        '_Limit 30
    Wend
    _Delay 2
Loop

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

Function DblToInt% (dblValue As Double)
    Dim sValue As String
    Dim iPos As Integer
    sValue = _Trim$(Str$(dblValue))
    iPos = InStr(1, sValue, ".")
    If iPos > 0 Then
        DblToInt% = Val(Left$(sValue, iPos - 1))
    Else
        DblToInt% = Val(sValue)
    End If
End Function ' DblToInt%

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

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

' /////////////////////////////////////////////////////////////////////////////
' 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%