more source code and tutorials for making games
#12
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 + ...
Reply


Messages In This Thread
RE: more source code and tutorials for making games - by bplus - 07-16-2022, 12:50 AM



Users browsing this thread: 4 Guest(s)