Proggies

[bplus]

Already with a mod!

Code: (Select All)

_Title "SpiderMans Crop Circle mod" ' b+ 2023-07-24

Screen _NewImage(800, 600, 32)
_ScreenMove 250, 50
grass~& = &HFF008800: light~& = &HFFDDFF00
Color , grass~&: Cls
cx = 300
lx = 150
rx = 550
cy = 300
dleft = (cx - lx) / 10
dright = (rx - cx) / 10
drr = (250 - 20) / 10
drl = (150 - 20) / 10
For i = 0 To 4
    If i Mod 2 = 0 Then c~& = light~& Else c~& = grass~&
    If i < 4 Then adj = 10 Else adj = 0
    FCirc lx + dleft * i - adj, cy, lx - i * drl + 2 * adj, c~&
    FCirc rx - dright * i + adj, cy, 250 - i * drr + 2 * adj, c~&
Next
FCirc 0, cy, 100, grass~&
FCirc 800, cy, 170, grass~&
FCirc 110, cy - 30, 20, light~&
FCirc 110, cy + 30, 20, light~&

Sub FCirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)
    $If WEB Then
            G2D.FillCircle CX, CY, R, C
    $Else
        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 If
End Sub