10-11-2025, 03:37 PM (This post was last modified: 10-11-2025, 03:45 PM by bplus.)
Candy Corn Trees 1
Code: (Select All)
Option _Explicit
_Title "Candy Corn Trees 1" 'bplus 2025-10-09
' from "Alien Trees Mod 3: Leaves" 'b+ 2022-09-05
' 10/10 good have it growing on trees next step is to drop corn when full size.
Dim Shared As Long bk ' background image
bk = _NewImage(xmax, ymax, 32) 'container for drawings
Dim Shared As Long seed(1 To 3), start, cN ' Randomize seeds for trees and plasma starters
Dim Shared As Single rd(1 To 3), gn(1 To 3), bl(1 To 3) ' plasma colors for trees
Dim Shared leaf ' indexing ends of branches
Dim ref&
ref& = _NewImage(xmax, ymax * .2, 32) 'container for reflection image
Dim Shared corns(448) As corn ' corns / leaves
'Dim Shared leaves(448) As Long ' ship images
'makeShips ' just do this once for images and travel rates
Dim As Long i
restart:
makeBackground
seed(1) = Rnd * 1000 ' get new trees setup including the Plasma generators
seed(2) = Rnd * 1000
seed(3) = Rnd * 1000
For i = 1 To 3
rd(i) = Rnd * Rnd
gn(i) = Rnd * rd(i)
bl(i) = 0 'Rnd * Rnd
Next
leaf = 0
start = 0
cN = start
Randomize Using seed(1)
branch xmax * .6 + Rnd * .3 * xmax, ymax * .8 - 30, 6, 90, xmax / 20, 0, 1, 1
cN = start
Randomize Using seed(2)
branch Rnd * .3 * xmax, ymax * .8 - 15, 7, 90, xmax / 18, 0, 2, 1
cN = start
Randomize Using seed(3)
branch xmax / 2, ymax * .8 - 8, 8, 90, xmax / 16, 0, 3, 1
For i = 1 To 448 'assign rnd sizes
corns(i).fr = Rnd
Next
'start = 0: d = 1300: ds = .01 ' start the show! press spacebar to start a different setting
Do
_PutImage , bk, 0
start = start + 1
cN = start
Randomize Using seed(1)
branch xmax * .6 + Rnd * .3 * xmax, ymax * .8 - 30, 6, 90, xmax / 20, 0, 1, 0
cN = start
Randomize Using seed(2)
branch Rnd * .3 * xmax, ymax * .8 - 15, 7, 90, xmax / 18, 0, 2, 0
cN = start
Randomize Using seed(3)
branch xmax / 2, ymax * .8 - 8, 8, 90, xmax / 16, 0, 3, 0
For i = 448 To 1 Step -1
'FCirc corns(i).x, corns(i).y, 3, &HFF0000FF
RotoZoom corns(i).x, corns(i).y, CC&, corns(i).fr * corns(i).scale / 10, 0
corns(i).fr = corns(i).fr + .001
If corns(i).fr > 1.0 Then corns(i).fr = 0
Next
If _KeyDown(32) Then GoTo restart
_PutImage , 0, ref&, (0, 0)-(xmax, .8 * ymax)
_PutImage (0, .8 * ymax)-(xmax, ymax), ref&, 0, (0, _Height(ref&))-(xmax, 0)
_Display
_Limit 30
Loop Until _KeyDown(27)
Sub makeBackground
Dim As Long i, stars
Dim horizon
_Dest bk
For i = 0 To ymax
Line (0, i)-(xmax, i), _RGB32(70, 60, i / ymax * 160)
Next
stars = xmax * ymax * 10 ^ -4
horizon = .67 * ymax
For i = 1 To stars 'stars in sky
PSet (Rnd * xmax, Rnd * horizon), _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * xmax, Rnd * horizon, 1, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * xmax, Rnd * horizon, 2, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
DrawTerrain 405, 25, &HFF002255
DrawTerrain 420, 15, &HFF224444
DrawTerrain 435, 6, &HFF448855
DrawTerrain 450, 5, &HFF88FF66
_Dest 0
End Sub
Sub branch (x, y, startr, angD, lngth, lev, tree, leafTF)
Dim As Double x2, y2, dx, dy
Dim As Long i, lev2
x2 = x + Cos(_D2R(angD)) * lngth
y2 = y - Sin(_D2R(angD)) * lngth
dx = (x2 - x) / lngth
dy = (y2 - y) / lngth
For i = 0 To lngth
FCirc x + dx * i, y + dy * i, startr, changePlasma~&(tree)
Next
If startr <= 0 Or lev > 11 Or lngth < 5 Then
If leafTF Then
leaf = leaf + 1
corns(leaf).scale = .5 * tree + 1 '.4 - (4 - tree) * .01 ' .075
corns(leaf).x = x2
corns(leaf).y = y2
End If
Exit Sub
Else
lev2 = lev + 1
branch x2, y2, startr - 1, angD + 10 + 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree, leafTF
branch x2, y2, startr - 1, angD - 10 - 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree, leafTF
End If
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
Function changePlasma~& (n) ' red green for reds and yellows
cN = cN - 1 'dim shared cN as _Integer64, pR as long, pG as long, pB as long
changePlasma~& = _RGB32(127 + 127 * Sin(rd(n) * cN), 127 + 127 * Sin(gn(n) * cN), 0)
End Function
Sub DrawTerrain (h, modN, c As _Unsigned Long) ' modN for ruggedness the higher the less smooth
Dim x, dy
For x = 0 To _Width
If x Mod modN = 0 Then ' adjust mod number for ruggedness the higher the number the more jagged
If h < 600 - modN And h > 50 + modN Then
dy = Rnd * 20 - 10
ElseIf h >= 600 - modN Then
dy = Rnd * -10
ElseIf h <= 50 + modN Then
dy = Rnd * 10
End If
End If
h = h + .1 * dy
Line (x, _Height)-(x, h), c
Next
End Sub
Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Double, degreesRotation As Double)
Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
Halloween is Saved! I've got candy corn growing on trees!
Zip has the Candy Corn Image I am using with bas source:
OK now when the Candy Corn ripens, it falls into the water... and a new fruit starts from that branch.
Code: (Select All)
Option _Explicit
_Title "Candy Corn Trees 2" 'bplus 2025-10-11
' from "Alien Trees Mod 3: Leaves" 'b+ 2022-09-05
' 10/10 good have it growing on trees next step is to drop corn when full size.
' 10/11 falling fruit complete next is to distribute to Sugarland Productions.
Dim Shared CC&
CC& = _LoadImage("Candy Corn 1.png")
Dim Shared As Long bk ' background image
bk = _NewImage(xmax, ymax, 32) 'container for drawings
Dim Shared As Long seed(1 To 3), start, cN ' Randomize seeds for trees and plasma starters
Dim Shared As Single rd(1 To 3), gn(1 To 3), bl(1 To 3) ' plasma colors for trees
Dim Shared leaf ' indexing ends of branches
Dim ref&
ref& = _NewImage(xmax, ymax * .2, 32) 'container for reflection image
Dim Shared corns(448) As corn ' corns / leaves
Dim As Long i
restart:
makeBackground
seed(1) = Rnd * 1000 ' get new trees setup including the Plasma generators
seed(2) = Rnd * 1000
seed(3) = Rnd * 1000
For i = 1 To 3
rd(i) = Rnd + .1
gn(i) = Rnd * rd(i)
bl(i) = 0 'Rnd * Rnd
Next
leaf = 0
start = 0
cN = start
Randomize Using seed(1)
branch xmax * .6 + Rnd * .3 * xmax, ymax * .8 - 30, 6, 90, xmax / 20, 0, 1, 1
cN = start
Randomize Using seed(2)
branch Rnd * .3 * xmax, ymax * .8 - 15, 7, 90, xmax / 18, 0, 2, 1
cN = start
Randomize Using seed(3)
branch xmax / 2, ymax * .8 - 8, 8, 90, xmax / 16, 0, 3, 1
For i = 1 To 448 'assign rnd sizes
corns(i).frac = Rnd
Next
Do
_PutImage , bk, 0
start = start + 1
cN = start
Randomize Using seed(1)
branch xmax * .6 + Rnd * .3 * xmax, ymax * .8 - 30, 6, 90, xmax / 20, 0, 1, 0
cN = start
Randomize Using seed(2)
branch Rnd * .3 * xmax, ymax * .8 - 15, 7, 90, xmax / 18, 0, 2, 0
cN = start
Randomize Using seed(3)
branch xmax / 2, ymax * .8 - 8, 8, 90, xmax / 16, 0, 3, 0
For i = 448 To 1 Step -1
'FCirc corns(i).x, corns(i).y, 3, &HFF0000FF
If corns(i).falling Then
corns(i).y = corns(i).y + corns(i).dy
If corns(i).y > _Height Then
corns(i).y = corns(i).savey ' back to start position
corns(i).frac = .1 ' small start
corns(i).falling = 0 ' no longer falling
Else
RotoZoom corns(i).x, corns(i).y, CC&, corns(i).scale / 10, 0
corns(i).dy = corns(i).dy + .5
End If
Else
RotoZoom corns(i).x, corns(i).y, CC&, corns(i).frac * corns(i).scale / 10, 0
corns(i).frac = corns(i).frac + .001
If corns(i).frac > 1.0 Then
corns(i).frac = .1: corns(i).falling = 1: corns(i).dy = 1
End If
End If
Next
If _KeyDown(32) Then GoTo restart
_PutImage , 0, ref&, (0, 0)-(xmax, .8 * ymax)
_PutImage (0, .8 * ymax)-(xmax, ymax), ref&, 0, (0, _Height(ref&))-(xmax, 0)
_Display
_Limit 30
Loop Until _KeyDown(27)
Sub makeBackground
Dim As Long i, stars
Dim horizon
_Dest bk
For i = 0 To ymax
Line (0, i)-(xmax, i), _RGB32(70, 60, i / ymax * 160)
Next
stars = xmax * ymax * 10 ^ -4
horizon = .67 * ymax
For i = 1 To stars 'stars in sky
PSet (Rnd * xmax, Rnd * horizon), _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * xmax, Rnd * horizon, 1, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * xmax, Rnd * horizon, 2, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
DrawTerrain 405, 25, &HFF002255
DrawTerrain 420, 15, &HFF224444
DrawTerrain 435, 6, &HFF448855
DrawTerrain 450, 5, &HFF88FF66
_Dest 0
End Sub
Sub branch (x, y, startr, angD, lngth, lev, tree, leafTF)
Dim As Double x2, y2, dx, dy
Dim As Long i, lev2
x2 = x + Cos(_D2R(angD)) * lngth
y2 = y - Sin(_D2R(angD)) * lngth
dx = (x2 - x) / lngth
dy = (y2 - y) / lngth
For i = 0 To lngth
FCirc x + dx * i, y + dy * i, startr, changePlasma~&(tree)
Next
If startr <= 0 Or lev > 11 Or lngth < 5 Then
If leafTF Then
leaf = leaf + 1
corns(leaf).scale = .5 * tree + 1 '.4 - (4 - tree) * .01 ' .075
corns(leaf).x = x2
corns(leaf).y = y2
corns(leaf).savey = y2
End If
Exit Sub
Else
lev2 = lev + 1
branch x2, y2, startr - 1, angD + 10 + 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree, leafTF
branch x2, y2, startr - 1, angD - 10 - 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree, leafTF
End If
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
Function changePlasma~& (n) ' red green for reds and yellows
cN = cN - 1 'dim shared cN as _Integer64, pR as long, pG as long, pB as long
changePlasma~& = _RGB32(127 + 127 * Sin(rd(n) * cN), 127 + 127 * Sin(gn(n) * cN), 0)
End Function
Sub DrawTerrain (h, modN, c As _Unsigned Long) ' modN for ruggedness the higher the less smooth
Dim x, dy
For x = 0 To _Width
If x Mod modN = 0 Then ' adjust mod number for ruggedness the higher the number the more jagged
If h < 600 - modN And h > 50 + modN Then
dy = Rnd * 20 - 10
ElseIf h >= 600 - modN Then
dy = Rnd * -10
ElseIf h <= 50 + modN Then
dy = Rnd * 10
End If
End If
h = h + .1 * dy
Line (x, _Height)-(x, h), c
Next
End Sub
Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Double, degreesRotation As Double)
Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
(10-12-2025, 01:20 AM)madscijr Wrote: Haha, I love this!
So do I!
Part 3: Corn River
Code: (Select All)
Option _Explicit
_Title "Candy Corn Trees 3" 'bplus 2025-10-12
' from "Alien Trees Mod 3: Leaves" 'b+ 2022-09-05
' 10/10 good have it growing on trees next step is to drop corn when full size.
' 10/11 falling fruit complete next is to distribute to Sugarland Productions.
' 10/12 Part 3: Corn River
Dim Shared CC&
CC& = _LoadImage("Candy Corn 1.png")
Dim Shared As Long BK ' background image
BK = _NewImage(Xmax, Ymax, 32) 'container for drawings
Dim Shared As Long Seed(1 To 3), Start, CN ' Randomize seeds for trees and plasma starters
Dim Shared As Single Rd(1 To 3), Gn(1 To 3), Bl(1 To 3) ' plasma colors for trees
Dim Shared Leaf ' indexing ends of branches
Dim ref&
ref& = _NewImage(Xmax, Ymax * .2, 32) 'container for reflection image
Dim Shared Corns(448) As Corn ' corns / leaves
Dim Shared RiverCorn(250) As Corn
For i = 1 To 448 'assign rnd sizes
Corns(i).frac = Rnd
Next
Do
_PutImage , BK, 0
Start = Start + 1
CN = Start
Randomize Using Seed(1)
branch Xmax * .6 + Rnd * .3 * Xmax, Ymax * .8 - 30, 6, 90, Xmax / 20, 0, 1, 0
CN = Start
Randomize Using Seed(2)
branch Rnd * .3 * Xmax, Ymax * .8 - 15, 7, 90, Xmax / 18, 0, 2, 0
CN = Start
Randomize Using Seed(3)
branch Xmax / 2, Ymax * .8 - 8, 8, 90, Xmax / 16, 0, 3, 0
For i = 448 To 1 Step -1
'FCirc corns(i).x, corns(i).y, 3, &HFF0000FF
If Corns(i).falling Then
Corns(i).y = Corns(i).y + Corns(i).dy
If Corns(i).y > _Height Then
Corns(i).y = Corns(i).savey ' back to start position
Corns(i).frac = .1 ' small start
Corns(i).falling = 0 ' no longer falling
Else
RotoZoom Corns(i).x, Corns(i).y, CC&, Corns(i).scale / 10, 0
Corns(i).dy = Corns(i).dy + .5
End If
Else
RotoZoom Corns(i).x, Corns(i).y, CC&, Corns(i).frac * Corns(i).scale / 10, 0
Corns(i).frac = Corns(i).frac + .0003
If Corns(i).frac > 1.0 Then
Corns(i).frac = .1: Corns(i).falling = 1: Corns(i).dy = 1
End If
End If
Next
If _KeyDown(32) Then GoTo restart
_PutImage , 0, ref&, (0, 0)-(Xmax, .8 * Ymax)
_PutImage (0, .8 * Ymax)-(Xmax, Ymax), ref&, 0, (0, _Height(ref&))-(Xmax, 0)
Line (0, .8 * Ymax)-(Xmax, Ymax), &H88663399, BF
' the river
QuickSort 0, UBound(RiverCorn), RiverCorn() ' to draw corn in back first
For i = 0 To UBound(RiverCorn)
RotoZoom RiverCorn(i).x, RiverCorn(i).y, CC&, RiverCorn(i).scale / 30, RiverCorn(i).dy
RiverCorn(i).x = RiverCorn(i).x + RiverCorn(i).dx 'move along
If RiverCorn(i).x > Xmax + 10 Then RiverCorn(i).x = rndR(-50, 0) ' too far right start another
Next
_Display
_Limit 30
Loop Until _KeyDown(27)
Sub MakeRiverCorn
'Type corn
' As Double x, y, scale, frac, falling, dy, savey, dx
'End Type
Dim r, xoff, yoff, size
Dim As Long i, j
r = 7
For i = 0 To UBound(RiverCorn)
tryAgain:
xoff = Rnd * Xmax
yoff = rndR(.81 * Ymax, Ymax)
size = r + r * (yoff - .81 * Ymax) / (.25 * Ymax)
For j = 0 To i - 1
If _Hypot(xoff - RiverCorn(j).x, yoff - RiverCorn(j).y) < size + RiverCorn(j).scale Then GoTo tryAgain
Next
RiverCorn(i).x = xoff: RiverCorn(i).y = yoff: RiverCorn(i).scale = size
RiverCorn(i).dx = RiverCorn(i).y * rndR(.001, .0017) ' the farther down the faster flow
RiverCorn(i).dy = rndR(-30, 30) ' tilt
' checking distribution
'Circle (RiverCorn(i).x, RiverCorn(i).y), RiverCorn(i).scale
'_Display
Next
'Sleep
'Cls
End Sub
Sub makeBackground
Dim As Long i, stars
Dim horizon
_Dest BK
For i = 0 To Ymax
Line (0, i)-(Xmax, i), _RGB32(70, 60, i / Ymax * 160)
Next
stars = Xmax * Ymax * 10 ^ -4
horizon = .67 * Ymax
For i = 1 To stars 'stars in sky
PSet (Rnd * Xmax, Rnd * horizon), _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * Xmax, Rnd * horizon, 1, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
stars = stars / 2
For i = 1 To stars
FCirc Rnd * Xmax, Rnd * horizon, 2, _RGB32(175 + Rnd * 80, 175 + Rnd * 80, 175 + Rnd * 80)
Next
DrawTerrain 405, 25, &HFF002255
DrawTerrain 420, 15, &HFF224444
DrawTerrain 435, 6, &HFF448855
DrawTerrain 450, 5, &HFF88FF66
_Dest 0
End Sub
Sub branch (x, y, startr, angD, lngth, lev, tree, leafTF)
Dim As Double x2, y2, dx, dy
Dim As Long i, lev2
x2 = x + Cos(_D2R(angD)) * lngth
y2 = y - Sin(_D2R(angD)) * lngth
dx = (x2 - x) / lngth
dy = (y2 - y) / lngth
For i = 0 To lngth
FCirc x + dx * i, y + dy * i, startr, changePlasma~&(tree)
Next
If startr <= 0 Or lev > 11 Or lngth < 5 Then
If leafTF Then
Leaf = Leaf + 1
Corns(Leaf).scale = .5 * tree + 1
Corns(Leaf).x = x2
Corns(Leaf).y = y2
Corns(Leaf).savey = y2
End If
Exit Sub
Else
lev2 = lev + 1
branch x2, y2, startr - 1, angD + 10 + 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree, leafTF
branch x2, y2, startr - 1, angD - 10 - 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree, leafTF
End If
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
Function changePlasma~& (n) ' red green for reds and yellows
CN = CN - 1 'dim shared cN as _Integer64, pR as long, pG as long, pB as long
changePlasma~& = _RGB32(127 + 127 * Sin(Rd(n) * CN), 127 + 127 * Sin(Gn(n) * CN), 0)
End Function
Sub DrawTerrain (h, modN, c As _Unsigned Long) ' modN for ruggedness the higher the less smooth
Dim x, dy
For x = 0 To _Width
If x Mod modN = 0 Then ' adjust mod number for ruggedness the higher the number the more jagged
If h < 600 - modN And h > 50 + modN Then
dy = Rnd * 20 - 10
ElseIf h >= 600 - modN Then
dy = Rnd * -10
ElseIf h <= 50 + modN Then
dy = Rnd * 10
End If
End If
h = h + .1 * dy
Line (x, _Height)-(x, h), c
Next
End Sub
Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Double, degreesRotation As Double)
Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
W& = _Width(Image&): H& = _Height(Image&)
px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
For i& = 0 To 3
x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!)_
* Scale + Y
px(i&) = x2&: py(i&) = y2&
Next
_MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
_MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub
Function rndR (n1, n2) 'return real number (_single, double, _float depending on default / define setup)
rndR = (n2 - n1) * Rnd + n1
End Function
Sub QuickSort (start As Long, finish As Long, array() As Corn)
Dim Hi As Long, Lo As Long, Middle As Single
Hi = finish: Lo = start
Middle = array((Lo + Hi) / 2).y 'find middle of array
Do
Do While array(Lo).y < Middle: Lo = Lo + 1: Loop
Do While array(Hi).y > Middle: Hi = Hi - 1: Loop
If Lo <= Hi Then
Swap array(Lo), array(Hi)
Lo = Lo + 1: Hi = Hi - 1
End If
Loop Until Lo > Hi
If Hi > start Then Call QuickSort(start, Hi, array())
If Lo < finish Then Call QuickSort(Lo, finish, array())
End Sub
To the tune of Moon River:
Corn River
Sweeter than a smile
I'm eating you in style
... Someday___
10-12-2025, 02:56 PM (This post was last modified: 10-12-2025, 02:57 PM by bplus.)
Wait... Sudoku with a Halloween Theme was not enough? I confess I've been playing it and loving it recently helping me through stressful times. Just throw on some tunes and play Sudoku and forget worries until You Tube starts another commercial. I get barraged with Supplements and Health ads, they have me nailed!
But yes! I sure would like to do more. Maybe we can do up Pinball Molly with Halloween theme too.
I wouldn't mind one bit if I got that flipper action improved.
BTW while doing Corn River I ran into an old problem and I have simplified a little code demo for showing how to distribute objects over a landscape such that they are smaller and way more numerous towards the horizon and larger and far fewer as they go towards the bottom of the screen. Horizon infinitely far and infinitely dense extreme forground maybe one object blocking a lot of the view!
I am working up this demo next because it is very interesting problem that has popped up a few times when I do a field of flowers or a banner or a landscape with trees. For Corn River I just doubled the size from far bank of river to nearest in perspective at bottom of screen.
