I am impressed, no, zero, nada fixes were needed to get this to run in QB64:
Well maybe a little cut here and a little paste there, but that's how we all start.
The singularity is coming... are we ready?
Code: (Select All)
_Title "Isometric Bouncing Ball Simulation Claude per issues37" ' 2025-03-01 wow
' Creates a 3D-like environment with balls dropping onto an isometric grid
' and bouncing in random directions before falling off the edge
Screen _NewImage(1280, 720, 32)
_Title "Isometric Bouncing Ball Simulation"
Const GRID_SIZE = 400 ' Size of the isometric grid
Const GRAVITY = 0.2 ' Gravity constant
Const BOUNCE_FACTOR = 0.8 ' Energy retained after bounce
Const MAX_BALLS = 50 ' Maximum number of active balls
Const SPAWN_RATE = 3 ' Frames between new ball spawns
' Ball properties
Type BallType
x As Single ' 3D coordinates
y As Single
z As Single
vx As Single ' Velocity components
vy As Single
vz As Single
size As Integer ' Ball size in pixels
color As _Unsigned Long ' Ball color
active As Integer ' 1 = active, 0 = inactive
End Type
Dim Shared balls(1 To MAX_BALLS) As BallType
Dim Shared frameCounter As Integer
Dim Shared ballsCreated As Integer
' Origin of isometric grid (center of screen, base level)
Const ORIGIN_X = 640
Const ORIGIN_Y = 500
' Initialize random seed
Randomize Timer
' Main program loop
Do
' Clear screen
Cls , _RGB32(0, 0, 0)
' Draw isometric grid
DrawIsometricGrid
' Process and draw balls
ProcessBalls
' Spawn new balls at regular intervals
frameCounter = frameCounter + 1
If frameCounter Mod SPAWN_RATE = 0 And ballsCreated < MAX_BALLS Then
CreateNewBall
End If
' Display frame
_Display
' Check for ESC key to exit
k$ = InKey$
If k$ = Chr$(27) Then Exit Do
' Control frame rate
_Limit 60
Loop
End
' Create a new ball
Sub CreateNewBall
Dim i As Integer
' Find an available slot for a new ball
For i = 1 To MAX_BALLS
If balls(i).active = 0 Then
' Initialize ball properties
balls(i).x = 0
balls(i).y = 0
balls(i).z = 300
balls(i).vx = (Rnd - 0.5) * 2 ' Small random initial velocity
balls(i).vy = (Rnd - 0.5) * 2
balls(i).vz = 0
balls(i).size = 5 + Int(Rnd * 8)
balls(i).color = _RGB32(128 + Rnd * 127, 128 + Rnd * 127, 128 + Rnd * 127)
balls(i).active = 1
ballsCreated = ballsCreated + 1
Exit For
End If
Next i
End Sub
' Draw isometric grid
Sub DrawIsometricGrid
Dim x As Integer, y As Integer
Dim screenX As Integer, screenY As Integer
Dim gridStep As Integer
gridStep = 50 ' Space between grid lines
' Draw grid lines
For x = -GRID_SIZE / 2 To GRID_SIZE / 2 Step gridStep
' Draw line along the x-axis
Line3D x, -GRID_SIZE / 2, 0, x, GRID_SIZE / 2, 0, _RGB32(255, 255, 255)
' Draw line along the y-axis
Line3D -GRID_SIZE / 2, x, 0, GRID_SIZE / 2, x, 0, _RGB32(255, 255, 255)
Next x
End Sub
' Process and draw all active balls
Sub ProcessBalls
Dim i As Integer
Dim screenX As Integer, screenY As Integer
For i = 1 To MAX_BALLS
If balls(i).active = 1 Then
' Apply gravity
balls(i).vz = balls(i).vz - GRAVITY
' Update position
balls(i).x = balls(i).x + balls(i).vx
balls(i).y = balls(i).y + balls(i).vy
balls(i).z = balls(i).z + balls(i).vz
' Check for collision with the floor
If balls(i).z <= 0 Then
' Bounce on the grid
balls(i).z = 0
balls(i).vz = -balls(i).vz * BOUNCE_FACTOR
' Add random horizontal movement after bounce
balls(i).vx = balls(i).vx + (Rnd - 0.5) * 3
balls(i).vy = balls(i).vy + (Rnd - 0.5) * 3
End If
' Check if ball is outside grid boundaries
If Abs(balls(i).x) > GRID_SIZE / 2 Or Abs(balls(i).y) > GRID_SIZE / 2 Then
' Reset ball position to top
balls(i).x = 0
balls(i).y = 0
balls(i).z = 300
balls(i).vx = (Rnd - 0.5) * 2
balls(i).vy = (Rnd - 0.5) * 2
balls(i).vz = 0
End If
' Convert 3D coordinates to isometric screen position
' and draw the ball
Convert3DToScreen balls(i).x, balls(i).y, balls(i).z, screenX, screenY
Circle (screenX, screenY), balls(i).size, balls(i).color
Paint (screenX, screenY), balls(i).color, balls(i).color
End If
Next i
End Sub
' Convert 3D coordinates to isometric screen coordinates
Sub Convert3DToScreen (x As Single, y As Single, z As Single, screenX As Integer, screenY As Integer)
' Isometric projection factors
Const ISO_X1 = 0.866 ' cos(30?)
Const ISO_X2 = 0.866 ' cos(30?)
Const ISO_Y1 = 0.5 ' sin(30?)
Const ISO_Y2 = -0.5 ' -sin(30?)
' Convert 3D to isometric 2D
screenX = ORIGIN_X + (x * ISO_X1 + y * ISO_X2)
screenY = ORIGIN_Y + (x * ISO_Y1 + y * ISO_Y2) - z
End Sub
' Draw a line in 3D space
Sub Line3D (x1 As Single, y1 As Single, z1 As Single, x2 As Single, y2 As Single, z2 As Single, c As _Unsigned Long)
Dim sx1 As Integer, sy1 As Integer
Dim sx2 As Integer, sy2 As Integer
' Convert 3D points to screen coordinates
Convert3DToScreen x1, y1, z1, sx1, sy1
Convert3DToScreen x2, y2, z2, sx2, sy2
' Draw the line
Line (sx1, sy1)-(sx2, sy2), c
End SubWell maybe a little cut here and a little paste there, but that's how we all start.
The singularity is coming... are we ready?
b = b + ...
