BallParts!
OK I look at this and realize, there is a much easier way to do this. I was wondering way back before doing Demos...
Steve will tell us. ;-))
Code: (Select All)
_Title "Demo 6 Circle Part Random Circle color" ' b+ mod Old Moses 2023-01-17
'OldMoses' mod of Steve's circle fill
'drawing only those portions that fit the bounding box
Randomize Timer
Type bx
As Single x, y, w, h
As _Unsigned Long c
End Type
Type circ
As Single x, y, dx, dy, r
As _Unsigned Long c
End Type
Dim Shared nBoxes, nCircs
nBoxes = 70
nCircs = 50
Dim Shared b(1 To nBoxes) As bx
Dim Shared c(1 To nCircs) As circ
_Title "Spacebar for different view..."
Screen _NewImage(1024, 512, 32)
newStuff
Do
Cls
If _KeyHit = 32 Then newStuff
For j = 1 To nCircs
For i = 1 To nBoxes
drawBallPart c(j).x, c(j).y, c(j).r, c(j).c, b(i).x, b(i).x + b(i).w, b(i).y, b(i).y + b(i).h ' modified partial circle fill
Next
c(j).x = c(j).x + c(j).dx
If c(j).x - c(j).r < 0 Then c(j).dx = -c(j).dx: c(j).x = c(j).r
If c(j).x + c(j).r > _Width Then c(j).dx = -c(j).dx: c(j).x = _Width - c(j).r
c(j).y = c(j).y + c(j).dy
If c(j).y - c(j).r < 0 Then c(j).dy = -c(j).dy: c(j).y = c(j).r
If c(j).y + c(j).r > _Height Then c(j).dy = -c(j).dy: c(j).y = _Height - c(j).r
Next
_Display
_Limit 30
Loop Until _KeyDown(27)
Sub newStuff
For i = 1 To nBoxes
b(i).w = Rnd * 100 + 10
b(i).x = Rnd * (_Width - b(i).w)
b(i).h = Rnd * 100 + 10
b(i).y = Rnd * (_Height - b(i).h)
b(i).c = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255, Rnd * 240 + 15)
Next
For i = 1 To nCircs
c(i).r = Rnd * 50 + 10
c(i).x = Rnd * (_Width - 2 * c(i).r) + c(i).r
c(i).y = Rnd * (_Height - 2 * c(i).r) + c(i).r
c(i).dx = Rnd * 5
If Rnd < .5 Then c(i).dx = -c(i).dx
c(i).dy = Rnd * 5
If Rnd < .5 Then c(i).dy = -c(i).dy
c(i).c = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
Next
End Sub
Sub drawBallPart (x, y, r, c As _Unsigned Long, left, right, top, bottom)
Dim rred As Long, grn As Long, blu As Long, rr As Long, f
rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)
For rr = r To 0 Step -1
f = 1 - Sin(rr / r) ' thank OldMoses for Sin ;-))
FCircPart x, y, rr, _RGB32(rred * f, grn * f, blu * f), left, right, top, bottom
Next
End Sub
Sub FCircPart (CX As Long, CY As Long, RR As Long, C As _Unsigned Long, lt As Long, rt As Long, t As Long, b As Long) 'modified circle fill
If rt < CX - RR Or lt > CX + RR Or t > CY + RR Or b < CY - RR Then Exit Sub 'leave if box not intersecting circle
Dim As Long R, RError, X, Y
R = Abs(RR) ' radius value along positive x
RError = -R ' opposite side of circle? negative x
X = R ' point along positive x position
Y = 0 ' starting at the equator
If R = 0 Then PSet (CX, CY), C: Exit Sub ' zero radius is point, not circle
If CY >= t And CY <= b Then Line (MinOf&(CX - X, lt), CY)-(MaxOf&(CX + X, rt), CY), C, BF 'draw equatorial line if applicable
While X > Y
RError = RError + Y * 2 + 1 '
If RError >= 0 Then
If X <> Y + 1 Then
If CY - X >= t And CY - X <= b And CX - Y <= rt And CX + Y >= lt Then
Line (MinOf&(CX - Y, lt), CY - X)-(MaxOf&(CX + Y, rt), CY - X), C, BF ' draw lines for south polar latitudes
End If
If CY + X <= b And CY + X >= t And CX - Y <= rt And CX + Y >= lt Then
Line (MinOf&(CX - Y, lt), CY + X)-(MaxOf&(CX + Y, rt), CY + X), C, BF ' draw lines for north polar latitudes
End If
End If
X = X - 1
RError = RError - X * 2
End If
Y = Y + 1
If CY - Y >= t And CY - Y <= b And CX - X <= rt And CX + X >= lt Then
Line (MinOf&(CX - X, lt), CY - Y)-(MaxOf&(CX + X, rt), CY - Y), C, BF ' draw lines north equatorial latitudes
End If
If CY + Y <= b And CY + Y >= t And CX - X <= rt And CX + X >= lt Then
Line (MinOf&(CX - X, lt), CY + Y)-(MaxOf&(CX + X, rt), CY + Y), C, BF ' draw lines south equatorial latitudes
End If
Wend
End Sub 'FCircPart
Function MaxOf& (value As Long, max As Long)
MaxOf& = -value * (value <= max) - max * (value > max)
End Function 'MaxOf%
Function MinOf& (value As Integer, minimum As Integer)
MinOf& = -value * (value >= minimum) - minimum * (value < minimum)
End Function 'MinOf%OK I look at this and realize, there is a much easier way to do this. I was wondering way back before doing Demos...
Steve will tell us. ;-))
b = b + ...