Claude Authored This

[bplus]

I am impressed, no, zero, nada fixes were needed to get this to run in QB64:

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 Sub

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?

[CharlieJV]

I am impressed, no, zero, nada fixes were needed to get this to run in QB64:

Code: (Select All)

...

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?

Hey, thanks for sharing.  What BASIC did you port from ?

BTW BAM version: https://basicanywheremachine-news.blogsp...l-sim.html

[bplus]

Hi Charlie, It was written directly for QB64 according to issues37.

Update: Oh you have your BAM version up and running OK!