CircleFill

[James D Jarvis]

I had fun with this yesterday.  Made variant sub called NoisyCircle.

Code: (Select All)

sc& = _NewImage(800, 500, 256)
Screen sc&
'this would probably look better if you fill the screen with it
Randomize Timer

kk = Int(Rnd * 255)

CircleFill 250, 250, 10, kk
For z = 1 To 10
    _Limit 10
Next z
Locate 1, 1: Print "Let's take a look at that star"
For z = 10 To 100
    _Limit 60
    CircleFill 250, 250, z, kk
Next z
reps = Int(Rnd * 600) + 90
For reps = 1 To reps
    _Limit 60
    If reps < reps / 2 Then NF = NF / 10 + 5
    If reps > reps / 2 - 1 Then NF = 35 - kk / 10
    NoisyCircle 250, 250, 100, kk, Int(Rnd * NF)
    _Display
Next reps
kk = 0
For boom = 1 To 100
    _Limit 60
    'this part bogs down a bit , proabbaly should have swirtched to random points instead of
    'still using the noisycircle but it helps to see how things work
    NoisyCircle 250, 250, 100 + boom * 5, kk, 100 - boom
    If boom > 50 Then
        NoisyCircle 250, 250, (boom - 50) * (boom - 50), kk, 100 - boom
    End If
    _Display
Next boom

Sub CircleFill (CX As Long, CY As Long, R As Long, C As 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

    ' Draw the middle span here so we don't draw it twice in the main loop,
    ' which would be a problem with blending turned on.
    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

Sub NoisyCircle (CX As Long, CY As Long, R As Long, C As Long, CHNC)
    'CX and CY are ti plot of the circle center R is the radius, c is the primary color, CHNC is the chance for noise to vary from from primary color
    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
    'checking to see if we should use the base color of the circle or slap down some random noise
    For tx = CX - X To CX + X
        chance = Rnd * 100
        If chance < CHNC Then
            dotc = Int(Rnd * 256)
        Else
            dotc = C
        End If
        PSet (tx, CY), dotc 'drawing each point in the line because color can change from pixel to pixel
    Next tx
    While X > Y
        RadiusError = RadiusError + Y * 2 + 1
        If RadiusError >= 0 Then
            If X <> Y + 1 Then
                For tx = CX - Y To CX + Y
                    chance = Rnd * 100
                    If chance < CHNC Then
                        dotc = Int(Rnd * 256)
                    Else
                        dotc = C
                    End If
                    PSet (tx, CY - X), dotc
                Next tx
                For tx = CX - Y To CX + Y
                    chance = Rnd * 100
                    If chance < CHNC Then
                        dotc = Int(Rnd * 256)
                    Else
                        dotc = C
                    End If
                    PSet (tx, CY + X), dotc
                Next tx
            End If
            X = X - 1
            RadiusError = RadiusError - X * 2
        End If
        Y = Y + 1
        For tx = CX - X To CX + X
            chance = Rnd * 100
            If chance < CHNC Then
                dotc = Int(Rnd * 256)
            Else
                dotc = C
            End If
            PSet (tx, CY - Y), dotc
        Next tx
        For tx = CX - X To CX + X
            chance = Rnd * 100
            If chance < CHNC Then
                dotc = Int(Rnd * 256)
            Else
                dotc = C
            End If
            PSet (tx, CY + Y), dotc
        Next tx
    Wend
End Sub