Candy Corn Trees

[bplus]

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

Randomize Timer
DefDbl A-Z
Const Xmax = 1024, Ymax = 600

Type Corn
    As Double x, y, scale, frac, falling, dy, savey, dx, a
End Type

Screen _NewImage(Xmax, Ymax, 32)
_ScreenMove 170, 40 ' clear sides
'_FullScreen
Randomize Timer

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

Dim As Long i

MakeRiverCorn
'Beep

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 + .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___