07-24-2023, 07:04 PM
(07-23-2023, 07:35 PM)bplus Wrote: Thankyou at GareBear I hope you are inspired to try a version of your own. My first ever was the first screen shot a long time ago, I was just fooling around with drawing concentric circles off-setting them consistently and next thing I knew I had those petal like things Or find an actual crop circle that you find interesting and try and duplicate it. Sometimes you get a happy accident.
OK so this:
Code: (Select All)
_Title "SpiderMans Crop Circle" ' 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 9
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
b = b + ...