My mini physics engine in QBASIC

wonder

Expert
Licensed User
Longtime User
Sometimes I like to prototype stuff in QBASIC.

For anyone who's interested, here's a small physics engine I created in the past two days using QB64.
Hopefully I'll be able to port it to B4A without any problems. :)

Note: I don't know how to use timers with precision in QBASIC, so I'm using a FOR...NEXT cycle as a workaround. You'll have to adjust the cycle_speed value to your PC:
B4X:
'Cycle Speed
    IF ballz = 1 THEN cycle_speed = 2000000
    IF ballz = 2 THEN cycle_speed = 1400000
    IF ballz = 3 THEN cycle_speed = 700000
    IF ballz = 4 THEN cycle_speed = 650000
    IF ballz = 5 THEN cycle_speed = 500000
    IF ballz = 6 THEN cycle_speed = 450000
    IF ballz = 7 THEN cycle_speed = 400000
    IF ballz = 8 THEN cycle_speed = 300000
    IF ballz = 9 THEN cycle_speed = 250000
    IF ballz = 10 THEN cycle_speed = 200000

Looking forward for your opinions! :D

B4X:
CONTROLS:
    Left:       ARROW LEFT
    Right:      ARROW RIGHT
    Jump:       ARROW UP
    Canon Mode: ARROW DOWN

    Inc Angle:  NUM 8
    Dec Angle:  NUM 2
    Inc Power:  NUM 6
    Dec Power:  NUM 4
B4X:
CLS
SCREEN 12
RANDOMIZE TIMER

INPUT "How many balls? ", ballz
'IF ballz > 10 THEN ballz = 10
IF ballz < 1 THEN ballz = 1

'World Setup
    gravity = 2
    bg_color = 0
    ground_color = 2

'Platforms Setup
    platz = 4

    DIM plat_center_x(platz) AS SINGLE
    DIM plat_center_y(platz) AS SINGLE
    DIM plat_size_x(platz) AS SINGLE
    DIM plat_size_y(platz) AS SINGLE
    DIM plat_frix(platz) AS SINGLE
    DIM plat_color(platz) AS SINGLE

    'GRASS
        plat_size_x(0) = 1000
        plat_size_y(0) = 100
        plat_center_x(0) = 320
        plat_center_y(0) = 480 - (plat_size_y(0) / 2)
        plat_frix(0) = 1
        plat_color(0) = 2

    'SAND
        plat_size_x(1) = 80
        plat_size_y(1) = 80
        plat_center_x(1) = 480
        plat_center_y(1) = 380 - (plat_size_y(1) / 2)
        plat_frix(1) = 1
        plat_color(1) = 14

    'ICE
        plat_size_x(2) = 200
        plat_size_y(2) = 40
        plat_center_x(2) = 180
        plat_center_y(2) = 300 - (plat_size_y(1) / 2)
        plat_frix(2) = 1
        plat_color(2) = 3

    'NORMAL
        plat_size_x(3) = 40
        plat_size_y(3) = 40
        plat_center_x(3) = 180
        plat_center_y(3) = 200 - (plat_size_y(1) / 2)
        plat_frix(3) = 1
        plat_color(3) = 12


'Objects Setup
    DIM ball_color(ballz) AS INTEGER
    DIM x(ballz) AS SINGLE
    DIM y(ballz) AS SINGLE
    DIM old_x(ballz) AS SINGLE
    DIM old_y(ballz) AS SINGLE
    DIM ox(ballz) AS SINGLE
    DIM oy(ballz) AS SINGLE
    DIM r(ballz) AS SINGLE
    DIM x_speed(ballz) AS SINGLE
    DIM y_speed(ballz) AS SINGLE
    DIM elasticity(ballz) AS SINGLE
    DIM jump(ballz) AS SINGLE
    DIM mass(ballz) AS SINGLE
    DIM colision(ballz) AS INTEGER


    'Player
        player = 0
        ball_color(player) = 15
        x(player) = 32
        y(player) = 10
        r(player) = 5
        x_speed(player) = INT(RND * 21) - 10
        y_speed(player) = 0
        elasticity(player) = 0.60
        jump(player) = -30
        mass(player) = 10

    'Others
        FOR i = 1 TO (ballz - 1)
            ball_color(i) = INT(RND * 15)
            IF ball_color(i) = bg_color OR ball_color(i) = ground_color THEN ball_color(i) = ball_color(i) + 1
            x(i) = x(i - 1) + 10
            y(i) = 10
            IF x(i) > 640 - r(i) THEN
                x(i) = 10
                y(i) = y(i) + 10
            END IF
            r(i) = 5
            x_speed(i) = INT(RND * 21) - 10
            y_speed(i) = 0
            elasticity(i) = (INT(RND * 80) + 20) / 100
            jump(i) = -30
            mass(i) = 10
        NEXT i


'Object Interaction
    DIM grounded(ballz, platz) AS STRING
    DIM where(ballz, platz) AS STRING
    DIM ontop(ballz) AS STRING

'Cycle Speed
    IF ballz = 1 THEN cycle_speed = 2000000
    IF ballz = 2 THEN cycle_speed = 1400000
    IF ballz = 3 THEN cycle_speed = 700000
    IF ballz = 4 THEN cycle_speed = 650000
    IF ballz = 5 THEN cycle_speed = 500000
    IF ballz = 6 THEN cycle_speed = 450000
    IF ballz = 7 THEN cycle_speed = 400000
    IF ballz = 8 THEN cycle_speed = 300000
    IF ballz = 9 THEN cycle_speed = 250000
    IF ballz = 10 THEN cycle_speed = 200000


'Physics Engine
    DO WHILE INKEY$ <> "q" OR INKEY$ <> "Q"

        FOR i = 0 TO (ballz - 1)
            'TIMER: Adapt to your computer
                FOR z = 0 TO cycle_speed
                NEXT z

            'Last Position
                ox(i) = x(i)
                oy(i) = y(i)

            'LOGIC: Apply Physics
                y_speed(i) = y_speed(i) + gravity
                x(i) = x(i) + x_speed(i)
                y(i) = y(i) + y_speed(i)


            'LOGIC: Round Object Collision Detector / Rebound Physics
                true_counter = 0
                FOR j = 0 TO (ballz - 1)
                    IF i <> j THEN
                        'Calculate the X,Y direction for Object A
                            delta_x = x(i) - old_x(i)
                            delta_y = y(i) - old_y(i)

                        'Calculate Speed Vector
                            vector_size = SQR((delta_x * delta_x) + (delta_y * delta_y))
                            vector_angle = ATAN2(delta_x, delta_y)

                        'Calculate the distance between Object A and Object B
                            dist_x = x(i) - x(j)
                            dist_y = y(i) - y(j)
                            distance = SQR((dist_x * dist_x) + (dist_y * dist_y))

                            IF distance <= (r(i) + r(j)) THEN

                                'Prevent objects from intersecting with each other
                                    IF delta_x > 0 AND x(i) < x(j) THEN
                                        x(i) = x(j) - r(j) - r(i)
                                    ELSEIF delta_x < 0 AND x(i) > x(j) THEN
                                        x(i) = x(j) + r(j) + r(i)
                                    END IF
                                    IF delta_y > 0 AND y(i) < y(j) THEN
                                        y(i) = y(j) - r(j) - r(i)
                                    ELSEIF delta_y < 0 AND y(i) > y(j) THEN
                                        y(i) = y(j) + r(j) + r(i)
                                    END IF

                                'Rebound Physics
                                     rebound = (elasticity(i) + elasticity(j)) / 2

                                'Conservation of Momentum: (m1*u1)+(m2*u2) = (m1*v1)+(m2*v2)
                                    m1 = mass(i)
                                    m2 = mass(j)

                                    'Object A:

                                        'Calculate the final X speed for Object A
                                            u1x = x_speed(i)
                                            u2x = x_speed(j)
                                            v1x = ((u1x * (m1 - m2)) + (2 * m2 * u2x)) / (m1 + m2)
                                            x_speed(i) = v1x * rebound + INT(RND * 3) - 1

                                        'Calculate the final Y speed for Object A
                                            u1y = y_speed(i)
                                            u2y = y_speed(j)
                                            v1y = ((u1y * (m1 - m2)) + (2 * m2 * u2y)) / (m1 + m2)
                                            y_speed(i) = v1y * rebound

                                    'Object B:

                                        'Calculate the final X speed for Object B
                                            v2x = ((u2x * (m2 - m1)) + (2 * m1 * u1x)) / (m1 + m2)
                                            x_speed(j) = v2x * rebound + INT(RND * 3) - 1

                                        'Calculate the final Y speed for Object B
                                            v2y = ((u2y * (m2 - m1)) + (2 * m1 * u1y)) / (m1 + m2)
                                            y_speed(j) = v2y * rebound

                                        ontop(i) = "TRUE"
                                        true_counter = true_conter + 1
                            END IF
                    END IF
                NEXT j
                IF true_counter = 0 THEN ontop(i) = "FALSE"


            'LOGIC: Square Object Collision Detector / Friction and Rebound Physics
                FOR k = 0 TO (platz - 1)
                    top = plat_center_y(k) - (plat_size_y(k) / 2)
                    bottom = plat_center_y(k) + (plat_size_y(k) / 2)
                    left = plat_center_x(k) - (plat_size_x(k) / 2)
                    right = plat_center_x(k) + (plat_size_x(k) / 2)

                    IF x(i) + r(i) > left AND x(i) - r(i) < right AND y(i) + r(i) > top AND y(i) - r(i) < bottom THEN
                        'Calculate the X,Y direction for Object A
                            delta_x = x(i) - old_x(i)
                            delta_y = y(i) - old_y(i)

                        'Detect where the collision is occurring
                            IF old_x(i) - r(i) < left AND x(i) + r(i) > left THEN where(i, k) = "LEFT"
                            IF old_x(i) + r(i) > right AND x(i) - r(i) < right THEN where(i, k) = "RIGHT"
                            IF old_y(i) - r(i) < top AND y(i) + r(i) > top THEN where(i, k) = "TOP"
                            IF old_y(i) + r(i) > bottom AND y(i) - r(i) < bottom THEN where(i, k) = "BOTTOM"

                            IF where(i, k) = "TOP" THEN
                                grounded(i, k) = "TRUE"
                                y(i) = top - r(i)
                                y_speed(i) = -y_speed(i) * elasticity(i)
                            ELSEIF where(i, k) = "BOTTOM" THEN
                                grounded(i, k) = "FALSE"
                                y(i) = bottom + r(i)
                                y_speed(i) = -y_speed(i) * elasticity(i)
                            ELSEIF where(i, k) = "LEFT" THEN
                                grounded(i, k) = "FALSE"
                                x(i) = left - r(i)
                                x_speed(i) = -x_speed(i) * elasticity(i)
                            ELSEIF where(i, k) = "RIGHT" THEN
                                grounded(i, k) = "FALSE"
                                x(i) = right + r(i)
                                x_speed(i) = -x_speed(i) * elasticity(i)
                            END IF
                     ELSE
                        'Verify if the velocity vector crosses the current object k
                            delta_x = x(i) - old_x(i)
                            delta_y = y(i) - old_y(i)
                            vector_size = SQR((delta_x * delta_x) + (delta_y * delta_y))
                            vector_angle = ATAN2(delta_x, delta_y)

                            FOR pnt = 0 TO (INT(vector_size) - 1)
                                pnt_x = old_x(i) + (COS(vector_angle) * pnt)
                                pnt_y = old_y(i) + (SIN(vector_angle) * pnt)
                                IF pnt_x >= left AND pnt_x <= right AND pnt_y >= top AND pnt_y <= bottom THEN
                                    IF old_x(i) < left THEN where(i, k) = "LEFT"
                                    IF old_x(i) > right THEN where(i, k) = "RIGHT"
                                    IF old_y(i) < top THEN where(i, k) = "TOP"
                                    IF old_y(i) > bottom THEN where(i, k) = "BOTTOM"
                                    EXIT FOR
                                ELSE
                                    where(i, k) = ""
                                END IF
                            NEXT pnt

                            IF where(i, k) = "TOP" THEN
                                grounded(i, k) = "TRUE"
                                y(i) = top - r(i)
                                y_speed(i) = -y_speed(i) * elasticity(i)
                            ELSEIF where(i, k) = "BOTTOM" THEN
                                grounded(i, k) = "FALSE"
                                y(i) = bottom + r(i)
                                y_speed(i) = -y_speed(i) * elasticity(i)
                            ELSEIF where(i, k) = "LEFT" THEN
                                grounded(i, k) = "FALSE"
                                x(i) = left - r(i)
                                x_speed(i) = -x_speed(i) * elasticity(i)
                            ELSEIF where(i, k) = "RIGHT" THEN
                                grounded(i, k) = "FALSE"
                                x(i) = right + r(i)
                                x_speed(i) = -x_speed(i) * elasticity(i)
                            ELSE
                                grounded(i, k) = "FALSE"
                            END IF
                     END IF

                'Apply Friction
                    IF grounded(i, k) = "TRUE" THEN
                        x_speed(i) = x_speed(i) * plat_frix(k)
                    END IF
                NEXT k


            'LOGIC: Wall Collision Detector / Rebound Physics
                IF ((x(i) - r(i)) <= 0 AND old_x(i) > x(i)) OR ((x(i) + r(i)) >= 640 AND old_x(i) < x(i)) THEN
                    IF x(i) - r(i) <= 0 THEN x(i) = 0 + r(i)
                    IF x(i) + r(i) >= 640 THEN x(i) = 640 - r(i)
                    bounce = elasticity(i) * -x_speed(i)
                    x_speed(i) = bounce
                END IF


            'LOGIC: Get last position
                old_x(i) = x(i)
                old_y(i) = y(i)


            'INPUT: User input
                KEY(11) ON
                KEY(12) ON
                KEY(13) ON
                KEY(14) ON
                ON KEY(11) GOSUB KEY_UP
                ON KEY(12) GOSUB KEY_LEFT
                ON KEY(13) GOSUB KEY_RIGHT
                ON KEY(14) GOSUB KEY_DOWN


            'GRAPHICS: Draw everything
                'PSET (x(i) - 1, y(i) - 1), 15
                'PSET (x(i) + 0, y(i) - 1), 15
                'PSET (x(i) + 1, y(i) - 1), 15
                'PSET (x(i) - 1, y(i) + 0), 15
                'PSET (x(i) + 0, y(i) + 0), 15
                'PSET (x(i) + 1, y(i) + 0), 15
                'PSET (x(i) - 1, y(i) + 1), 15
                'PSET (x(i) + 0, y(i) + 1), 15
                'PSET (x(i) + 1, y(i) + 1), 15
        NEXT i

        PAINT (320, 0), bg_color

        FOR obj = 0 TO (ballz - 1)
            'GRAPHICS: Erase Last Position
                'PSET (ox(obj), oy(obj)), bg_color
                CIRCLE (ox(obj), oy(obj)), r(obj), bg_color
                PAINT (ox(obj), oy(obj)), bg_color
                'PSET (x(obj), y(obj)), ball_color(obj)
                CIRCLE (x(obj), y(obj)), r(obj), ball_color(obj)
                PAINT (x(obj), y(obj)), ball_color(obj)
        NEXT obj

        FOR k = 0 TO (platz - 1)
                    top = plat_center_y(k) - (plat_size_y(k) / 2)
                    bottom = plat_center_y(k) + (plat_size_y(k) / 2)
                    left = plat_center_x(k) - (plat_size_x(k) / 2)
                    right = plat_center_x(k) + (plat_size_x(k) / 2)

                    LINE (left, bottom)-(left, top), plat_color(k)
                    LINE (left, top)-(right, top), plat_color(k)
                    LINE (right, top)-(right, bottom), plat_color(k)
                    LINE (right, bottom)-(left, bottom), plat_color(k)
                    PAINT (plat_center_x(k), plat_center_y(k)), plat_color(k)
        NEXT k


LOOP

END

KEY_UP:
    FOR z = 0 TO (platz - 1)
        IF grounded(0, z) = "TRUE" OR ontop(0) = "TRUE" THEN
            y_speed(0) = jump(0)
            EXIT FOR
        END IF
    NEXT z
RETURN

KEY_LEFT:
    x_speed(0) = x_speed(0) - 2
RETURN

KEY_RIGHT:
    x_speed(0) = x_speed(0) + 2
RETURN

KEY_DOWN:
    DO
        i$ = INKEY$

        IF i$ = "4" THEN
            LINE (x(0), y(0))-((COS(angle_rad) * power) + x(0), (SIN(angle_rad) * power) + y(0)), bg_color
            power = power - 1
            IF power < 0 THEN power = 0
        ELSEIF i$ = "6" THEN
            LINE (x(0), y(0))-((COS(angle_rad) * power) + x(0), (SIN(angle_rad) * power) + y(0)), bg_color
            power = power + 1
        ELSEIF i$ = "8" THEN
            LINE (x(0), y(0))-((COS(angle_rad) * power) + x(0), (SIN(angle_rad) * power) + y(0)), bg_color
            angle = angle - 1
        ELSEIF i$ = "2" THEN
            LINE (x(0), y(0))-((COS(angle_rad) * power) + x(0), (SIN(angle_rad) * power) + y(0)), bg_color
            angle = angle + 1
        END IF

        LOCATE 1, 1
        COLOR 15, bg_color
        PRINT "Cannon Mode"
        PRINT "Angle: "; angle; "           "
        PRINT "Power: "; power; "           "
        pi = 3.14159265359
        angle_rad = angle * (pi / 180)

        CIRCLE (x(0), y(0)), r(0), ball_color(0)
        PAINT (x(0), y(0)), ball_color(0)
        LINE (x(0), y(0))-((COS(angle_rad) * power) + x(0), (SIN(angle_rad) * power) + y(0)), 0

    LOOP UNTIL i$ = "5"
    CLS
    x_speed(0) = COS(angle_rad) * power
    y_speed(0) = SIN(angle_rad) * power
    LOCATE 1, 1
    PRINT "                                                                                "
    PRINT "                                                                                "
RETURN

FUNCTION ATAN2 (x, y)
    pi = 3.14159265
    Result$ = "Undetermined"
    IF (x = 0) AND (y > 0) THEN
        ATAN2 = pi / 2
        Result$ = "Determined"
    END IF
    IF (x = 0) AND (y < 0) THEN
        ATAN2 = 3 * pi / 2
        Result$ = "Determined"
    END IF
    IF (x > 0) AND (y = 0) THEN
        ATAN2 = 0
        Result$ = "Determined"
    END IF
    IF (x < 0) AND (y = 0) THEN
        ATAN2 = pi
        Result$ = "Determined"
    END IF

    IF Result$ = "Determined" THEN EXIT FUNCTION

    BaseAngle = ATN(ABS(y) / ABS(x))
    IF (x > 0) AND (y > 0) THEN ATAN2 = BaseAngle
    IF (x < 0) AND (y > 0) THEN ATAN2 = pi - BaseAngle
    IF (x < 0) AND (y < 0) THEN ATAN2 = pi + BaseAngle
    IF (x > 0) AND (y < 0) THEN ATAN2 = 2 * pi - BaseAngle
END FUNCTION
 
Last edited:

Beja

Expert
Licensed User
Longtime User
Hi wonder and thanks for sharing..
will it run in Quick Basic 4.5? I have that compiler still.... lol
 

wonder

Expert
Licensed User
Longtime User
Hi wonder and thanks for sharing..
will it run in Quick Basic 4.5? I have that compiler still.... lol
No problem, it's always a pleasure to share with this community. :)

I've used QB64, but hopefully it will run on all QB versions.
 

Beja

Expert
Licensed User
Longtime User
Thanks ilan,
In 2001 I wrote a Hanoi Towers clone in Quick Basic 4.5 (the first and last QBasic compiler) and named it Nubian Columns, I can't attach it because b4x prevented .exe file and unfortunately I lost the source code.
This is a screenshot.

Edit:
I did download qb64.. it is still far from mature.. installation took about 10 minutes and compiling just the hello world took more than 2 minutes (first run) subsequent runs took less time.
 

Attachments

  • Nubian.jpg
    Nubian.jpg
    36 KB · Views: 248
Last edited:

Beja

Expert
Licensed User
Longtime User
I found a way around.. please unzip the attached b4a file .. and you find the game exe file in the files folder lol
 

Attachments

  • Nubian.zip
    10.7 KB · Views: 234
Last edited:

wonder

Expert
Licensed User
Longtime User
I've updated the code. It's a little bit "more realistic" now. :D
Just a reminder, I will be porting this to B4A with pretty graphics and responsive controls.

This kind of engine can be used, for example, for platform or angry birds type games. :)
 
Top