Posts: 545
Threads: 116
Joined: Apr 2022
Reputation:
39
(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://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
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.
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
07-16-2022, 12:50 AM
(This post was last modified: 07-16-2022, 04:17 AM by bplus.)
I found the Lander when I commented out all the dang printing. Then I saw it was crashing in mid space. My guess is you did not adjust the land heights for the new screen size in pixels not chars cells 8x16, yeah you are changing some but you missed the land heights I am pretty sure.
Here I fixed it back in 2018, I have InForm version of it too.
From 30 lines to over 300! Code: (Select All) _Title "Lander B+ started 2018-06-02"
' Lander update.bas SmallBASIC 0.12.11 (B+=MGA) 2018-06-01
'modified code from my 2nd mod of:
'Lander mod 2.txt for JB v2 B+ 2018-05-29 big mod of
'Lander by Carl mod Rod mod B+.txt for JB v2 started 2018-05-26
'where I rewired controls and changed physics of Lander Model.
'This will further depart from Carls's original by hand drawing Lander
'at different angles instead of using sprites and, alas, landscape will
'have to be updated each frame because there is no drawing on top of images
'in SmallBASIC.
' INSTRUCTIONS:
'Use the left or right arrow keys to rotate Lander left or right.
'Use the up arrow for thruster burst. These moves cost fuel!
'The Fuel Gage is Red Horizontal line below landscape.
'The fuel level is Yellow.
'You must make a VERY gentle and level landing
'on one of the flat areas!
'Horizontal location, speed in green.
' Vertical location, speed inblue
Dim Shared main&
Const xmax = 1200
Const ymax = 720
main& = _NewImage(xmax, ymax, 32)
Screen main&
_ScreenMove 100, 10
Randomize Timer
Const ns = 75
Dim Shared pi, d2r
pi = _Pi
d2r = pi / 180
'stars
Dim Shared sx(ns), sy(ns), sr(ns), sc&(ns)
'terrain
Dim Shared terraH(xmax), terraC(xmax)
'vehicle globals
Dim Shared fuel, vda, speed, vx, vy, dx, dy, dg, dat
restart: ' ========================================= initialize Game
makeStars
makeTerra
fuel = 500 'this is the space vehicle's fuel
'vda is vehicle degree angle = orientation of the vehicle, mainly it's thrusters
vda = 0 'the vehicle is traveling right across screen due East = 0 degrees = 0 Radians
speed = 6 'this is the speed the vehicle is moving in the vda direction
vx = 50 'this is current x position of vehicle 10 pixles from left side
vy = 30 'this is current y position of vehicle 10 pixels down from top of screen
'd stands for delta with stands for change dx = change in x, dy = change in y
'dg is change due to gravity (vertical)
'dat is change of acceleration due to thrust
dx = speed * Cos(d2r * vda) 'this is the horizontal x change on screen due to speed and angle
dy = speed * Sin(d2r * vda) 'this is the vertical y change on screen due to speed and angle
dg = .1 'this is the constant acceleration gravity applies to the vehicle
dat = 2 'this is burst of acceleration a thrust or reverse thrust will apply to speed and angle
Color _RGB32(0, 0, 0), _RGB32(0, 45, 90)
Cls
'buttons
drwbtn 290, ymax - 80, "Rotate Left"
drwbtn 500, ymax - 80, "Forward Thrust"
drwbtn 710, ymax - 80, "Rotate Right"
While 1
'respond to button clicks
Do While _MouseInput: Loop
mx = _MouseX
my = _MouseY
mb = _MouseButton(1)
If mb Then
If my > ymax - 80 And my < ymax - 30 Then
If mx > 290 And mx < 490 Then
moveLeft
ElseIf mx > 500 And mx < 700 Then
moveUp
ElseIf mx > 710 And mx < 910 Then
moveRight
End If
End If
End If
'respond to key press
k$ = InKey$
If Len(k$) = 2 Then
Select Case Asc(Right$(k$, 1))
Case 72: moveUp
Case 75: moveLeft
Case 77: moveRight
End Select
ElseIf Len(k$) = 1 Then
If Asc(k$) = 27 Then End
End If
scene
'fuel line
rgb 300
recf 10, ymax - 25, xmax - 10, ymax - 5
ff = fuel / 500 * (xmax - 20)
rgb 860
recf 10, ymax - 20, ff + 10, ymax - 10
Color _RGB32(200, 200, 250), _RGB32(0, 45, 90)
_PrintString (10, ymax - 70), "Horizontal:" + Str$(Int(vx)) + "," + Str$(Int(dx))
_PrintString (10, ymax - 50), " Vertical:" + Str$(Int(vy)) + "," + Str$(Int(dy))
'vehicle falls faster and faster, because gravity effects the vertical speed
dy = dy + dg 'speed up falling due to gravity acceleration
'new position = last postion plus the horizontal and vertical changes from momentum
vx = vx + dx
vy = vy + dy
Lander vx, vy, d2r * vda
If vx < 30 Or vx > xmax - 30 Or vy < -50 Then 'edit keep Lander legs inside boundries of terraH()
_Title "You have drifted off screen. Press p to play again..."
Exit While
End If
If vy > terraH(vx) Or fuel <= 0 Then
crash$ = ""
If fuel <= 0 Then
crash$ = crash$ + "Ran out of fuel. "
Else
If vda <> 270 Then crash$ = crash$ + "Vehicle not upright. "
If dy > 4 Then crash$ = crash$ + "Came down too fast. "
If Abs(dx) > 4 Then crash$ = crash$ + "Still moving hoizontally too fast. "
If terraH(vx - 10) <> terraH(vx + 10) Then crash$ = crash$ + "Did not land on level site. "
End If
If crash$ <> "" Then
_Title "You crashed! because: " + crash$ + " Press p to play again..."
Else
_Title "Nice job! Successful landing! Press p to play again..."
End If
Exit While
End If
_Display
_Limit 10
Wend
k$ = ""
drwbtn 990, ymax - 80, "Restart"
_Display
While Len(k$) = 0
k$ = InKey$
Do While _MouseInput: Loop
mx = _MouseX
my = _MouseY
mb = _MouseButton(1)
If mb Then
If my > ymax - 80 And my < ymax - 30 Then
If mx > 990 And mx < 1190 Then
k$ = "p"
End If
End If
End If
_Limit 200
Wend
If k$ = "p" Then GoTo restart
End
Sub scene
rgb 101
recf 4, 4, xmax - 5, ymax - 85
For i = 0 To ns
Color sc&(i)
fcirc sx(i), sy(i), sr(i)
Next
For i = 4 To xmax - 5
rgb terraC(i) * 100 + terraC(i) * 10 + terraC(i)
ln i, terraH(i), i, ymax - 86
Next
End Sub
' arrow + esc key
Sub moveUp
'here is the vertical and horizontal change from a burst of fuel for thrust
thrustx = dat * Cos(d2r * vda)
thrusty = dat * Sin(d2r * vda)
'now change the horizontal and vertical momentums from the thrust
dx = dx + thrustx
dy = dy + thrusty
'update the position
vx = vx + dx
vy = vy + dy
rgb 990
fcirc vx, vy, 5
_Display
'the thrust cost fuel
fuel = fuel - 10
End Sub
Sub moveLeft
x1 = vx + 10 * Cos(d2r * vda + .5 * pi)
y1 = vy + 10 * Sin(d2r * vda + .5 * pi)
rgb 990
fcirc x1, y1, 5
_Display
vda = vda - 22.5
If vda < -0.01 Then vda = 360
fuel = fuel - 10
End Sub
Sub moveRight
x1 = vx + 10 * Cos(d2r * vda - .5 * pi)
y1 = vy + 10 * Sin(d2r * vda - .5 * pi)
rgb 990
fcirc x1, y1, 5
_Display
vda = vda + 22.5
If vda > 337.51 Then vda = 0
fuel = fuel - 10
End Sub
Sub Lander (x0, y0, rAngle) 'rebuilt from ground up literally!
'x0, y0 are at the base of the lander, the rocket will point rAngle up when landing
rgb 333
x1 = x0 + 10 * Cos(rAngle - .5 * pi)
y1 = y0 + 10 * Sin(rAngle - .5 * pi)
x2 = x0 + 10 * Cos(rAngle + .5 * pi)
y2 = y0 + 10 * Sin(rAngle + .5 * pi)
x3 = x0 + 10 * Cos(rAngle)
y3 = y0 + 10 * Sin(rAngle)
x4 = x0 + 25 * Cos(rAngle)
y4 = y0 + 25 * Sin(rAngle)
'legs/fins
ln x3, y3, x1, y1
ln x3, y3, x2, y2
ln x4, y4, x1, y1
ln x4, y4, x2, y2
pangle = 2 * pi / 5
Color _RGB32(20, 0, 0)
For i = 0 To 5
Select Case i
Case 0, 5: r = 20
Case 2, 3: r = 15
Case 1, 4: r = 25
End Select
x1 = x4 + r * Cos(i * pangle + rAngle)
y1 = y4 + r * Sin(i * pangle + rAngle)
If i <> 0 Then ln lx, ly, x1, y1
lx = x1: ly = y1
Next
Paint (x4, y4), _RGB(160, 120, 120), _RGB32(20, 0, 0)
End Sub
Sub ln (x1, y1, x2, y2)
Line (x1, y1)-(x2, y2)
End Sub
Sub rec (x1, y1, x2, y2)
Line (x1, y1)-(x2, y2), , B
End Sub
Sub recf (x1, y1, x2, y2)
Line (x1, y1)-(x2, y2), , BF
End Sub
Sub rgb (n) ' New (even less typing!) New Color System 1000 colors with up to 3 digits
s3$ = Right$("000" + LTrim$(Str$(n)), 3)
r = Val(Mid$(s3$, 1, 1)): If r Then r = 28 * r + 3
g = Val(Mid$(s3$, 2, 1)): If g Then g = 28 * g + 3
b = Val(Mid$(s3$, 3, 1)): If b Then b = 28 * b + 3
Color _RGB32(r, g, b)
End Sub
'Steve McNeil's copied from his forum note: Radius is too common a name
Sub fcirc (CX As Long, CY As Long, R As Long)
Dim subRadius As Long, RadiusError As Long
Dim X As Long, Y As Long
subRadius = Abs(R)
RadiusError = -subRadius
X = subRadius
Y = 0
If subRadius = 0 Then PSet (CX, CY): Exit Sub
' Draw the middle span here so we don't draw it twice in the main loop,
' which would be a problem with blending turned on.
Line (CX - X, CY)-(CX + X, CY), , BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), , BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), , BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), , BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), , BF
Wend
End Sub
Function min (a, b)
If a > b Then min = b Else min = a
End Function
Function max (a, b)
If a > b Then max = a Else max = b
End Function
Sub drwbtn (x, y, s$)
th = 16: tw = Len(s$) * 8
rgb 0
recf x, y, x + 200, y + 50
rgb 999
recf x, y, x + 198, y + 48
rgb 666
recf x + 2, y + 2, x + 198, y + 48
xoff = 100 - tw \ 2: yoff = 25 - th \ 2
Color _RGB(0, 0, 0), _RGB32(171, 171, 171)
_PrintString (x + xoff, y + yoff), s$
Color _RGB(0, 0, 0), _RGB(0, 0, 0)
End Sub
Sub makeStars
For i = 0 To ns
sx(i) = Rnd * (xmax - 16) + 8
sy(i) = Rnd * (ymax - 96) + 8
r = Rnd
If r < .8 Then
sr(i) = 1
ElseIf r < .95 Then
sr(i) = 2
Else
sr(i) = 3
End If
sc&(i) = _RGB32(Rnd * 74 + 180, Rnd * 74 + 180, Rnd * 74 + 180)
Next
End Sub
Sub makeTerra
For x = 4 To xmax - 5
If x > 5 And Rnd < 0.06 Then
xstop = min(xmax - 5, x + 50)
For lz = x To xstop
terraH(lz) = y
c = Int(Rnd * 3) + 1
terraC(lz) = c
Next
x = lz - 1
Else
xstop = min(xmax - 5, x + Rnd * 25)
If Rnd < .5 Then yd = 1 Else yd = -1
yd = yd * Rnd * 2
For xx = x To xstop
y = min(ymax - 90, y + yd)
y = max(y, ymax - 240)
terraH(xx) = y
c = Int(Rnd * 2) + 1
terraC(xx) = c
Next
x = xx - 1
End If
Next
End Sub
BTW Crash or Success Reports are in the Title Bar and a Fuel Gauge is shown below 700 pixels, (I can no longer see it on my refurbished laptop).
b = b + ...
Posts: 2,700
Threads: 124
Joined: Apr 2022
Reputation:
134
Why am I missing posts made 15 minutes before mine? Jarvis just said same thing but did he post a working game? ;-))
b = b + ...
Posts: 529
Threads: 67
Joined: Apr 2022
Reputation:
11
07-16-2022, 03:22 AM
(This post was last modified: 07-16-2022, 03:22 AM by madscijr.)
(07-16-2022, 12:57 AM)bplus Wrote: Why am I missing posts made 15 minutes before mine? Jarvis just said same thing but did he post a working game? ;-))
Thankee you both, I'll check it out when I'm back on a computer proper.
I am most ashamed of that hack dblToInt function, I was jut being lazy, we have a couple good Rounding functions Steve and the regular crew made a couple of years back, I just have to find it.
Posts: 296
Threads: 14
Joined: Jul 2022
Reputation:
15
yes, I have taken a look in it and after some controls on graphic output (destination and circle functions) I moved the draw lander after output info on the screen and I saw an alien starship landing for some pixels and then crushing in text output area.
So you simply were printing text on the starship!
Now your goal will be fix the landig state function.
Posts: 529
Threads: 67
Joined: Apr 2022
Reputation:
11
(07-17-2022, 10:28 AM)TempodiBasic Wrote: yes, I have taken a look in it and after some controls on graphic output (destination and circle functions) I moved the draw lander after output info on the screen and I saw an alien starship landing for some pixels and then crushing in text output area.
So you simply were printing text on the starship!
Now your goal will be fix the landig state function.
Very good.
If we put the printing _before_ the lander, it should be drawn on top of the text, right?
(Again I am not at my PC to test this!)
|
