Author Topic: Lander project  (Read 460 times)

Offline bplus

  • B = B + geberation
Lander project
« on: June 04, 2018, 03:26:26 AM »
Well I have it setup the way I want to do it with InForm:

In SmallBASIC I could do a message box, here I used the _title for messages.
Code: [Select]
_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

2nd EDIT to fix the reasons for crash report.
3rd EDIT need ABS(dx) in crash report because could be moving too fast in minus direction.
« Last Edit: June 04, 2018, 12:19:53 PM by bplus »
B = B + ...

Offline roadbloc

  • I am me.
    • roadbloc
Re: Lander project
« Reply #1 on: June 04, 2018, 08:16:55 AM »
This is neat! Took quite a few goes before I managed to do it. I got an error on line 130 whenever I got too close to the edge of the window. :)
Loading Signature....

Offline johnno56

  • Live long and prosper.
Re: Lander project
« Reply #2 on: June 04, 2018, 10:17:47 AM »
This is pretty cool.. First time I tried it, I landed as slow as I could, then a 'restart' button pops up. I figured I landed ok because I didn't see any of the 'crash' type comments. Usually, when I play 'lander-type' games, my ship hits the ground, bounces a little, then scatters itself across the terrain... lol Landing good. Crashing bad. Still a cool game... Well done!

J

ps: Just noticed the messages popping up on the Title Bar... Hey. I did land it ok... Who woulda thought?
« Last Edit: June 04, 2018, 10:24:07 AM by johnno56 »
Logic is the beginning of wisdom.

Offline bplus

  • B = B + geberation
Re: Lander project
« Reply #3 on: June 04, 2018, 10:33:50 AM »
Hi roadbloc,

This edit should fix the boundary problem (right after Lander vx, vy updated and Lander drawn in main loop):
Code: [Select]
    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
I will change it in OP (original post). When I changed picture window and TerraH(), I forgot to update this part.
Thanks for your report and interest. (OK changed.)

Hi Johnno,

Glad you found the message center, way up top. Yikes!
Good, you are landing OK so maybe one you can win at? ;-))

Maybe points given for amount of fuel left?

And a Text Box for messages nearer the controls, maybe under the fuel gage.

Hint: the arrow keys (left right and up) work a little better than clicking buttons but with buttons it should work with touch screens.

update: my touch screen not very responsive to my button "clicks".
« Last Edit: June 04, 2018, 10:55:10 AM by bplus »
B = B + ...

Offline bplus

  • B = B + geberation
Re: Lander project
« Reply #4 on: June 04, 2018, 11:33:24 AM »
Found another bug due to last minute changes before post.


I was working from a list of reasons for crash, building up a report of all things wrong, that worked fine.

But when you run out of gas, all the other reasons don't make sense, so I tried to isolate that one reason with the remainder list. I used ELSEIF and meant ELSE here is the fix, that I will also use to edit OP:
Code: [Select]
        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 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
B = B + ...

Offline bplus

  • B = B + geberation
Re: Lander project
« Reply #5 on: June 04, 2018, 12:23:46 PM »
Dang, another one. In crash report, it is suppose to be a crash if you moving too fast in either direction horizontally (the dx variable) correction made in 3rd edit of OP.
B = B + ...

Re: Lander project
« Reply #6 on: June 04, 2018, 12:47:58 PM »
Nice work, Bplus!
Coding is relax (At least sometimes)

Offline bplus

  • B = B + geberation
Re: Lander project
« Reply #7 on: June 04, 2018, 01:00:28 PM »
Thanks Petr,

I am hoping to get it going with InForm beta 7. I am hoping the buttons will work better, be more responsive to clicks. Problems are either over rotate or not rotate at all or thruster jams a bit, some of the time. Probably could be tweaked in regular code? The arrow keys work great!
B = B + ...

Offline johnno56

  • Live long and prosper.
Re: Lander project
« Reply #8 on: June 04, 2018, 06:08:14 PM »
Bplus,

May I suggest that the 'controls' be 'not so responsive'? Just like accelerating an object, then release the thrust, then 'gradually' slow down. It may add to the 'realism' and possibly the difficulty... Hmm... Nuts! More difficult means I might crash more... How about some sound effects instead? lol

J

ps: Thought of this AFTER I logged out... Joystick. Does QB64 interface with a joystick? I know it sounds nuts, and most people may not have a 'stick', but it would be so cool... My suggestion is a wee bit selfish as my poor joystick has been gathering dust for quite some time... Fight sims of ANY kind do not pass by very often... lol
« Last Edit: June 04, 2018, 06:45:53 PM by johnno56 »
Logic is the beginning of wisdom.

Re: Lander project
« Reply #9 on: June 04, 2018, 06:43:16 PM »
Hi Johnno56,
 yes joystick IS supported. BUT i never try it because have none. But: STICK function return joystick coordinates, STRIG(0) return if is fire pressed, for initializing use ON STRIG GOSUB....
Hi Bplus,
For delay after mouse operations - limit it with TIMER in this way: IF _MOUSEBUTTON(1) AND TimeLimit > TIMER THEN TimeLimit = TIMER + .01 : your action
Coding is relax (At least sometimes)

Offline johnno56

  • Live long and prosper.
Re: Lander project
« Reply #10 on: June 04, 2018, 06:48:57 PM »
Thanks Petr. I will check it out...

J
Logic is the beginning of wisdom.

Offline johnno56

  • Live long and prosper.
Re: Lander project
« Reply #11 on: June 04, 2018, 07:47:15 PM »
I popped in the stick() and strig() commands and they worked. A little too well. x/y controls were 'very' sensitive. (a little 'heavy handed one time and the ship spun like a top... lol) Strig() worked fine. One click. One thruster burn... Took me 3 attempts before I got the hang of using a joystick... I think I might stick with the cursor keys... lol

J
Logic is the beginning of wisdom.

Offline bplus

  • B = B + geberation
Re: Lander project
« Reply #12 on: June 04, 2018, 08:24:31 PM »
Hi Petr,

Yes I have used the delay trick many a time, not just QB64, it also will likely help Johnno with his joystick too.

I don't think a timer need be involved, just a _DELAY x might do?

I am saving that problem for later and want to see performance in InForm'd system. I have the form mapped out and plan on adding code tonight.

Hi Fellippe,

I do have a question. Under the Edit Menu of UiEditor, I found this (see attached) should I use Windows option if I have Windows?
B = B + ...

Online FellippeHeitor

  • QB64 Developer
  • LET IT = BE
    • QB64.org
Re: Lander project
« Reply #13 on: June 04, 2018, 10:14:16 PM »
Use codepage 437 for English-only programs; use codepage Windows-1252 for any programs that need to display diacritic marks, like "maçã" or something like that. I basically save my forms with codepage 1252 when I write programs in Portuguese (not related to the target operating system, despite its name - see more here: https://msdn.microsoft.com/en-us/library/cc195054.aspx).

I mention (and demonstrate) that in the video for Beta 6. See it at ~2:33: https://youtu.be/S4d5nmu_gjQ?t=153
« Last Edit: June 04, 2018, 10:17:56 PM by FellippeHeitor »

Offline bplus

  • B = B + geberation
Re: Lander project
« Reply #14 on: June 05, 2018, 02:30:02 AM »
Still have to rework numbers but basic program is working under InForm.

And! as I suspected the response to button clicking was accurate, no jamming. I have included some notes in comments in .bas file.
B = B + ...