07-16-2022, 12:29 AM
(07-15-2022, 08:39 PM)madscijr Wrote:(05-20-2022, 10:31 PM)bplus Wrote: @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://qb64phoenix.com/forum/showthread.php?tid=162&page=3&highlight=Lander
' https://qb64phoenix.com/forum/showthread.php?tid=443
' bplus Wrote:
' [url=https://qb64phoenix.com/forum/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
Circle (dblX + 4, dblY + 8), 20, _RGB32(200, 200, 200) '<<<<<< this is how I spotted it
_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%
The lander is positioned behind the text and it's crashing too early so you don't see it get out from the area overprinted by the text.