Dedicated to all farmers who code with Basic ;-))
![[Image: Crop-Circles-3-Mod-2-Blender.png]](https://i.ibb.co/QFjLH74/Crop-Circles-3-Mod-2-Blender.png)
Code: (Select All)
_Title "Crop Circles #3 Mod 2 Blender" 'b+ trans and mod to QB64 2021-01-25
Randomize Timer
Const Xmax = 1024, Ymax = 730, Cx = Xmax / 2, Cy = Ymax / 2, nCrops = 4
ReDim Shared CCircle As Long
Screen _NewImage(Xmax, Ymax, 32)
_Delay .25
_ScreenMove _Middle
ReDim Shared LowColr As _Unsigned Long, HighColr As _Unsigned Long, cNum As Long
HighColr = _RGB32(240, 220, 80): LowColr = _RGB32(100, 50, 10)
crop0
Do
_PutImage , CCircle, 0
While _MouseInput: Wend 'aim with mouse
mx = _MouseX: my = _MouseY: mb = _MouseButton(1)
drawShip mx, my, LowColr
If mb Then
PLC mx, my, Cx, Cy, 360
_Display
_Delay .2
FlagChange = -1
End If
If FlagChange Then
If Rnd < .5 Then
crop3
Else
cNum = (cNum + 1) Mod nCrops
Select Case cNum
Case 0: crop0
Case 1: crop1
Case 2: crop2
Case 3: crop3
End Select
End If
FlagChange = 0
End If
_Display
Loop Until _KeyDown(27)
'crop0 uses this
Sub drawc (mx, my)
ReDim cc As _Unsigned Long
cr = .5 * Sqr((Cx - mx) ^ 2 + (Cy - my) ^ 2): m = .5 * cr
dx = (mx - Cx) / m: dy = (my - Cy) / m: dr = cr / m
For i = m To 0 Step -1
If i Mod 2 = 0 Then cc = HighColr Else cc = LowColr
x = Cx + dx * (m - i): y = Cy + dy * (m - i): r = dr * i
fcirc x, y, r, cc
Next
End Sub
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
Sub PLC (baseX, baseY, targetX, targetY, targetR) ' PLC for PlasmaLaserCannon
r = Rnd ^ 2 * Rnd: g = Rnd ^ 2 * Rnd: b = Rnd ^ 2 * Rnd: hp = _Pi(.5) ' red, green, blue, half pi
ta = _Atan2(targetY - baseY, targetX - baseX) ' angle of target to cannon base
dist = _Hypot(targetY - baseY, targetX - baseX) ' distance cannon to target
dr = targetR / dist
For r = 0 To dist Step .25
x = baseX + r * Cos(ta)
y = baseY + r * Sin(ta)
c = c + .3
fcirc x, y, dr * r, _RGB32(128 + 127 * Sin(r * c), 128 + 127 * Sin(g * c), 128 + 127 * Sin(b * c))
Next
For rr = dr * r To 0 Step -.5
c = c + 1
LowColr = _RGB32(128 + 127 * Sin(r * c), 128 + 127 * Sin(g * c), 128 + 127 * Sin(b * c))
fcirc x, y, rr, LowColr
Next
cAnalysis LowColr, rr, gg, bb, aa
HighColr = _RGB32(255 - rr, 255 - gg, 255 - bb)
End Sub
' PLC uses this
Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub
Sub drawShip (x, y, colr As _Unsigned Long) 'shipType collisions same as circle x, y radius = 30
Static ls
Dim light As Long, r As Long, g As Long, b As Long
r = _Red32(colr): g = _Green32(colr): b = _Blue32(colr)
fellipse x, y, 6, 15, _RGB32(r, g - 120, b - 100)
fellipse x, y, 18, 11, _RGB32(r, g - 60, b - 50)
fellipse x, y, 30, 7, _RGB32(r, g, b)
For light = 0 To 5
fcirc x - 30 + 11 * light + ls, y, 1, _RGB32(ls * 50, ls * 50, ls * 50)
Next
ls = ls + 1
If ls > 5 Then ls = 0
End Sub
' drawShip needs
Sub fellipse (CX As Long, CY As Long, xr As Long, yr As Long, C As _Unsigned Long)
If xr = 0 Or yr = 0 Then Exit Sub
Dim h2 As _Integer64, w2 As _Integer64, h2w2 As _Integer64
Dim x As Long, y As Long
w2 = xr * xr: h2 = yr * yr: h2w2 = h2 * w2
Line (CX - xr, CY)-(CX + xr, CY), C, BF
Do While y < yr
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub
Function rand (low, high)
rand = Rnd * (high - low) + low
End Function
Sub crop0
If CCircle Then _FreeImage CCircle
CCircle = _NewImage(_Width, _Height, 32)
_Dest CCircle
Color , HighColr
Cls
n = 12: stp = -40
For br = 360 To 0 Step stp
shft = shft + 720 / (n * n)
For i = 1 To n
x = Cx + br * Cos(_D2R(i * 360 / n + shft))
y = Cy + br * Sin(_D2R(i * 360 / n + shft))
drawc x, y
Next
Next
_Dest 0
End Sub
Sub crop1
If CCircle Then _FreeImage CCircle
CCircle = _NewImage(_Width, _Height, 32)
_Dest CCircle
Color , HighColr
Cls
ga = 137.5: bn = 800
br = 9.5: lr = .5: r = br: dr = (br - lr) / bn
hc = 180: lc = 120: cr = (hc - lc) / bn
For n = 1 To bn
x = Cx + 10 * Sqr(n) * Cos(_D2R(n * ga))
y = Cy + 10 * Sqr(n) * Sin(_D2R(n * ga))
r = r - dr
fcirc x, y, r, LowColr
Next
_Dest 0
End Sub
Sub crop2
If CCircle Then _FreeImage CCircle
CCircle = _NewImage(_Width, _Height, 32)
_Dest CCircle
'this needs big constrast of color
HighColr = _RGB32(Rnd * 80, Rnd * 80, Rnd * 80) ' field
LowColr = _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Color , HighColr
Cls
For i = 45 To Xmax Step 50
Line (i, 0)-(i + 10, Ymax), LowColr, BF
Line (0, i)-(Xmax, i + 10), LowColr, BF
Next
For y = 50 To 650 Step 50
For x = 50 To Xmax Step 50
fcirc x, y, 10, LowColr
Next
Next
_Dest 0
End Sub
Sub crop3
If CCircle Then _FreeImage CCircle
CCircle = _NewImage(_Width, _Height, 32)
_Dest CCircle
Color , HighColr
Cls
r0 = rand(1, 5) / 5: r1 = rand(1, 5) / 10: r2 = rand(1, 5) / 10
fc = rand(1, 200) / 10: st = rand(10, 500) / 1000
xol = 0
yol = 0
mol = 0
For i = 0 To 120 Step st
a0 = (i / r0) * (2 * _Pi)
a1 = ((i / r1) * (2 * _Pi)) * -1
x1 = Cx + (Sin(a0) * ((r0 - r1) * fc)) * 30
y1 = Cy + (Cos(a0) * ((r0 - r1) * fc)) * 30
x2 = x1 + (Sin(a1) * ((r2) * fc)) * 30
y2 = y1 + (Cos(a1) * ((r2) * fc)) * 30
If mol = 0 Then
mol = 1
xol = x2
yol = y2
Else
Line (xol, yol)-(x2, y2), LowColr
xol = x2
yol = y2
End If
Next
_Dest 0
End Sub
