more source code and tutorials for making games

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%