Proggies

[bplus]

The Hypotrochoid Show

Code: (Select All)

_Title "The Hypotrochoid Show" 'for QB64 B+ 2019-07-18
Const xmax = 700, ymax = 700
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 100, 20
c2~& = &HFFBB0000
xc = xmax / 2: yc = ymax / 2: r = yc * .5: st = 1 / (2 * _Pi * r)
n = 0: m = 3
While _KeyDown(27) = 0
    m = m + 1
    For n = 5 To 30 Step .05
        Cls
        For a = 0 To 2 * _Pi Step st
            xReturn = xc + r * (Cos(a) + Cos(n * a) / 3 + Sin(m * a) / 2)
            yReturn = yc + r * (Sin(a) + Sin(n * a) / 3 + Cos(m * a) / 2)
            fcirc xReturn, yReturn, 10, _RGB32(0, 200, 0, n)
            fcirc xReturn, yReturn, 4, c2~&
        Next
        Print "m = "; m; "  n = "; n
        _Display
    Next
    _Delay 1
Wend

Sub fcirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    Dim Radius As Long, RadiusError As Long
    Dim X As Long, Y As Long
    Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
    If Radius = 0 Then PSet (CX, CY), C: 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, BF
                Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
        Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
    Wend
End Sub

Update: This runs in QBJS but it is slow compared to QB64pe straight up, also modified to work in QBJS
https://qbjs.org/index.html?code=J09wdGl...+uQAhuQCBQ==