' Program to render flying and bouncing cubes on top of a grid-like floor
'
' By Svjatoslav Agejenko
' Email: svjatoslav@svjatoslav.eu
' Homepage: http://www.svjatoslav.eu
'
' Changelog:
' 2001, Initial version
' 2024 - 2025, Improved program readability
'
' Navigation controls:
' Arrow keys - Move forward/backward/left/right
' 2,6,4,8 - Look around (up/down/left/right)
' -       - Fly upward
' +       - Fly downward


DECLARE SUB updateColliders()
DECLARE SUB initializeColliders()
DECLARE SUB renderScene()
DECLARE SUB initializeEnvironment()
DECLARE SUB initializeProgram()

DIM SHARED initialNumPoints, initialNumLines, numPoints, numLines
DIM SHARED pointXCoord(1 TO 1000) AS SINGLE
DIM SHARED pointYCoord(1 TO 1000) AS SINGLE
DIM SHARED pointZCoord(1 TO 1000) AS SINGLE
DIM SHARED renderedXCoord(1 TO 1000) AS SINGLE
DIM SHARED renderedYCoord(1 TO 1000) AS SINGLE
DIM SHARED prevRenderedXCoord(1 TO 1000) AS SINGLE
DIM SHARED prevRenderedYCoord(1 TO 1000) AS SINGLE
DIM SHARED lineStart(1 TO 1000) AS INTEGER
DIM SHARED lineEnd(1 TO 1000) AS INTEGER
DIM SHARED lineColor(1 TO 1000) AS INTEGER
DIM SHARED prevLineStart(1 TO 1000) AS INTEGER
DIM SHARED prevLineEnd(1 TO 1000) AS INTEGER
DIM SHARED prevLineCount AS INTEGER
DIM SHARED cameraXPos AS SINGLE, cameraXSpeed AS SINGLE
DIM SHARED cameraYPos AS SINGLE, cameraYSpeed AS SINGLE
DIM SHARED cameraZPos AS SINGLE, cameraZSpeed AS SINGLE
DIM SHARED cameraAngleX AS SINGLE, cameraAngleXSpeed AS SINGLE
DIM SHARED cameraAngleY AS SINGLE, cameraAngleYSpeed AS SINGLE
DIM SHARED cubeXPos(1 TO 10) AS SINGLE
DIM SHARED cubeYPos(1 TO 10) AS SINGLE
DIM SHARED cubeZPos(1 TO 10) AS SINGLE
DIM SHARED cubeXSpeed(1 TO 10) AS SINGLE
DIM SHARED cubeYSpeed(1 TO 10) AS SINGLE
DIM SHARED cubeZSpeed(1 TO 10) AS SINGLE
DIM SHARED numCubes AS INTEGER

ON ERROR GOTO ErrorHandler

initializeProgram
initializeEnvironment
initializeColliders

' The main loop of the program
MainLoop:

SOUND 0, .5

numPoints = initialNumPoints
numLines = initialNumLines

updateColliders
renderScene

' Update positions and angles
cameraXPos = cameraXPos + cameraXSpeed
cameraYPos = cameraYPos + cameraYSpeed
cameraZPos = cameraZPos + cameraZSpeed
cameraAngleX = cameraAngleX + cameraAngleXSpeed
cameraAngleY = cameraAngleY + cameraAngleYSpeed

userInput$ = INKEY$
IF userInput$ <> "" THEN
    ' Handle arrow keys for movement
    IF userInput$ = CHR$(0) + "H" THEN
        cameraZSpeed = cameraZSpeed - SIN(cameraAngleX) / 100
        cameraXSpeed = cameraXSpeed - COS(cameraAngleX) / 100
    END IF
    IF userInput$ = CHR$(0) + "P" THEN
        cameraZSpeed = cameraZSpeed + SIN(cameraAngleX) / 100
        cameraXSpeed = cameraXSpeed + COS(cameraAngleX) / 100
    END IF
    IF userInput$ = CHR$(0) + "M" THEN
        cameraZSpeed = cameraZSpeed + COS(cameraAngleX) / 100
        cameraXSpeed = cameraXSpeed - SIN(cameraAngleX) / 100
    END IF
    IF userInput$ = CHR$(0) + "K" THEN
        cameraZSpeed = cameraZSpeed - COS(cameraAngleX) / 100
        cameraXSpeed = cameraXSpeed + SIN(cameraAngleX) / 100
    END IF
    ' Handle number keys for looking around
    IF userInput$ = "6" THEN cameraAngleXSpeed = cameraAngleXSpeed - 0.01
    IF userInput$ = "4" THEN cameraAngleXSpeed = cameraAngleXSpeed + 0.01
    IF userInput$ = "8" THEN cameraAngleYSpeed = cameraAngleYSpeed - 0.01
    IF userInput$ = "2" THEN cameraAngleYSpeed = cameraAngleYSpeed + 0.01
    ' Handle plus and minus keys for flying up and down
    IF userInput$ = "+" THEN cameraYSpeed = cameraYSpeed - 0.01
    IF userInput$ = "-" THEN cameraYSpeed = cameraYSpeed + 0.01
    ' Exit the program on pressing ESC
    IF userInput$ = CHR$(27) THEN SYSTEM
END IF

GOTO MainLoop

ErrorHandler:
END
RESUME

SUB initializeEnvironment
' This subroutine initializes environment points
FOR z = -5 TO 5
    FOR x = -5 TO 5
        numPoints = numPoints + 1
        pointXCoord(numPoints) = x
        pointYCoord(numPoints) = 0
        pointZCoord(numPoints) = z
        ' Add lines between points
        IF x > -5 THEN
            numLines = numLines + 1
            lineStart(numLines) = numPoints
            lineEnd(numLines) = numPoints - 1
            lineColor(numLines) = 3
        END IF
        IF z > -5 THEN
            numLines = numLines + 1
            lineStart(numLines) = numPoints
            lineEnd(numLines) = numPoints - 11
            lineColor(numLines) = 3
        END IF
    NEXT x
NEXT z
' Store the number of points and lines
initialNumPoints = numPoints
initialNumLines = numLines
END SUB

SUB updateColliders
' This subroutine updates the positions and angles of colliders
FOR a = 1 TO numCubes
    x = cubeXPos(a)
    y = cubeYPos(a)
    z = cubeZPos(a)
    xs = cubeXSpeed(a)
    ys = cubeYSpeed(a)
    zs = cubeZSpeed(a)
    ' Update the Y-axis position
    ys = ys - 0.01
    ' Update the X and Z positions
    x = x + xs
    y = y + ys
    z = z + zs
    ' Bounce off walls
    IF x > 5 THEN xs = -0.1
    IF z > 5 THEN zs = -0.1
    IF x < -5 THEN xs = 0.1
    IF z < -5 THEN zs = 0.1
    ' Reset Y position if it falls below a threshold
    IF y < 0.5 THEN ys = RND * 0.2 + 0.1
    ' Create lines for visualization
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 1
    lineEnd(numLines) = numPoints + 2
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 3
    lineEnd(numLines) = numPoints + 2
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 3
    lineEnd(numLines) = numPoints + 4
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 1
    lineEnd(numLines) = numPoints + 4
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 1
    lineEnd(numLines) = numPoints + 5
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 2
    lineEnd(numLines) = numPoints + 6
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 3
    lineEnd(numLines) = numPoints + 7
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 4
    lineEnd(numLines) = numPoints + 8
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 5
    lineEnd(numLines) = numPoints + 6
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 7
    lineEnd(numLines) = numPoints + 6
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 7
    lineEnd(numLines) = numPoints + 8
    lineColor(numLines) = 14
    numLines = numLines + 1
    lineStart(numLines) = numPoints + 5
    lineEnd(numLines) = numPoints + 8
    lineColor(numLines) = 14
    ' Update the array with new positions and speeds
    numPoints = numPoints + 1
    pointXCoord(numPoints) = x - 0.5
    pointYCoord(numPoints) = y - 0.5
    pointZCoord(numPoints) = z - 0.5
    numPoints = numPoints + 1
    pointXCoord(numPoints) = x + 0.5
    pointYCoord(numPoints) = y - 0.5
    pointZCoord(numPoints) = z - 0.5
    numPoints = numPoints + 1
    pointXCoord(numPoints) = x + 0.5
    pointYCoord(numPoints) = y + 0.5
    pointZCoord(numPoints) = z - 0.5
    numPoints = numPoints + 1
    pointXCoord(numPoints) = x - 0.5
    pointYCoord(numPoints) = y + 0.5
    pointZCoord(numPoints) = z - 0.5
    numPoints = numPoints + 1
    pointXCoord(numPoints) = x - 0.5
    pointYCoord(numPoints) = y - 0.5
    pointZCoord(numPoints) = z + 0.5
    numPoints = numPoints + 1
    pointXCoord(numPoints) = x + 0.5
    pointYCoord(numPoints) = y - 0.5
    pointZCoord(numPoints) = z + 0.5
    numPoints = numPoints + 1
    pointXCoord(numPoints) = x + 0.5
    pointYCoord(numPoints) = y + 0.5
    pointZCoord(numPoints) = z + 0.5
    numPoints = numPoints + 1
    pointXCoord(numPoints) = x - 0.5
    pointYCoord(numPoints) = y + 0.5
    pointZCoord(numPoints) = z + 0.5
    ' Update the collider array with new positions and speeds
    cubeXPos(a) = x
    cubeYPos(a) = y
    cubeZPos(a) = z
    cubeXSpeed(a) = xs
    cubeYSpeed(a) = ys
    cubeZSpeed(a) = zs
NEXT a
END SUB

SUB initializeColliders
' This subroutine initializes colliders with random positions and speeds
FOR a = 1 TO numCubes
    cubeXPos(a) = RND * 10 - 5
    cubeYPos(a) = 2
    cubeZPos(a) = RND * 10 - 5
    cubeXSpeed(a) = RND * 0.5 - 0.25
    cubeYSpeed(a) = RND * 0.5 + 0.1
    cubeZSpeed(a) = RND * 0.5 - 0.25
NEXT a
END SUB

SUB renderScene
' Calculate sine and cosine for angle rotation
s1 = SIN(cameraAngleX)
c1 = COS(cameraAngleX)
s2 = SIN(cameraAngleY)
c2 = COS(cameraAngleY)
' Loop through all points to render them
FOR a = 1 TO numPoints
    x = pointXCoord(a) + cameraXPos
    y = pointYCoord(a) - cameraYPos
    z = pointZCoord(a) + cameraZPos
    ' Rotate the point
    x1 = x * s1 - z * c1
    z1 = x * c1 + z * s1
    y1 = y * s2 - z1 * c2
    z2 = y * c2 + z1 * s2
    ' Project the 3D point to a 2D screen coordinate
    IF z2 < 0.1 THEN
        renderedXCoord(a) = -1
    ELSE
        renderedXCoord(a) = 320 + (x1 / z2 * 400)
        renderedYCoord(a) = 240 - (y1 / z2 * 400)
    END IF
NEXT a
' Render all lines
FOR a = 1 TO numLines
    l1 = prevLineStart(a)
    l2 = prevLineEnd(a)
    ' Skip rendering if either end of the line is out of view
    IF prevRenderedXCoord(l1) = -1 OR prevRenderedXCoord(l2) = -1 THEN
    ELSE
        LINE (prevRenderedXCoord(l1), prevRenderedYCoord(l1))-(prevRenderedXCoord(l2), prevRenderedYCoord(l2)), 0
    END IF
    ' Update line indices for next frame
    l1 = lineStart(a)
    l2 = lineEnd(a)
    ' Skip rendering if either end of the line is out of view
    IF renderedXCoord(l1) = -1 OR renderedXCoord(l2) = -1 THEN
    ELSE
        LINE (renderedXCoord(l1), renderedYCoord(l1))-(renderedXCoord(l2), renderedYCoord(l2)), lineColor(a)
    END IF
NEXT
' Handle lines that were added during the frame
IF numLines < prevLineCount THEN
    FOR a = numLines + 1 TO prevLineCount
        l1 = prevLineStart(a)
        l2 = prevLineEnd(a)
        ' Skip rendering if either end of the line is out of view
        IF prevRenderedXCoord(l1) = -1 OR prevRenderedXCoord(l2) = -1 THEN
        ELSE
            LINE (prevRenderedXCoord(l1), prevRenderedYCoord(l1))-(prevRenderedXCoord(l2), prevRenderedYCoord(l2)), 0
        END IF
    NEXT
END IF
' Save the current frame's points and lines for next frame
FOR a = 1 TO numPoints
    prevRenderedXCoord(a) = renderedXCoord(a)
    prevRenderedYCoord(a) = renderedYCoord(a)
NEXT a
FOR a = 1 TO numLines
    prevLineStart(a) = lineStart(a)
    prevLineEnd(a) = lineEnd(a)
NEXT a
prevLineCount = numLines
END SUB

SUB initializeProgram
' Initialize the screen and variables
SCREEN 12
initialNumPoints = 0
initialNumLines = 0
numPoints = initialNumPoints
numLines = initialNumLines
numCubes = 9
cameraXPos = 0
cameraYPos = 4
cameraZPos = 7
cameraAngleX = 3.14 / 2
cameraAngleY = cameraAngleX + 0.6
' Initialize all lines to have a thickness of 4
FOR a = 1 TO 1000
    lineColor(a) = 4
NEXT a
' Store the initial state of all lines
FOR a = 1 TO 1000
    prevLineStart(a) = 1
    prevLineEnd(a) = 1
NEXT a
END SUB