Easy Spiral

Charlie Veniot 25th October 2022 at 8:01pm
' Easy spiral
' A QBJS program by bplus (found at https://qb64.boards.net/thread/27/bplus-collection)
' Altered to work in BAM by Charlie Veniot (comments marked with "➡")

' ➡ BAM requires subroutine declaration before any reference to it
DECLARE SUB fcirc (CX As Long, CY As Long, R As Long, C As  Long)

' ➡ Program works better in BAM using screen 19
Screen _NewImage(700, 700, 19)

Dim tick, s, c, h, x, y, lastX, lastY
s = 7
Do
    Cls
    For c = 1 To 2000
        h = c + tick
        x = Sin(6 * h / _Pi) + Sin(3 * h)
        h = c + tick * 2
        y = Cos(6 * h / _Pi) + Cos(3 * h)
        fcirc s * (20 * x + 50), s * (20 * y + 50), 2, _RGB32(255, 255, 255)
    Next
    _Display
    _Limit 120
    tick = tick + .001
Loop

' ➡ C datatype changed to Long (BAM does not have unsigned long)
Sub fcirc (CX As Long, CY As Long, R As Long, C As  Long) '      SMcNeill's fill circle
    Dim subRadius As Long, RadiusError As Long, X As Long, Y As Long
    subRadius = Abs(R): RadiusError = -subRadius: X = subRadius: Y = 0
    If subRadius = 0 Then PSet (CX, CY): Exit Sub
    Line (CX - X, CY)-(CX + X, CY), C, BF
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                Line (CX - Y, CY - X)-(CX + Y, CY - X), C
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C
    Wend
End Sub