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!

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
    36 KB · Views: 207
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: 172
Last edited:

wonder

Expert
Licensed User
Longtime User
I've updated the code. It's a little bit "more realistic" now.
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.
 
Cookies are required to use this site. You must accept them to continue using the site. Learn more…