Proggies

[bplus]

Alien Trees Reflection Mod #2

This is something to behold while running! less than 100 LOC

Code: (Select All)

_Title "Alien Trees Reflection - Plasma Mod 2, spacebar for new set" 'b+ 2022-05-07
Randomize Timer
Const xmax = 1024, ymax = 600

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 200, 80 ' clear sides
Dim Shared As _Unsigned Long star: star = _RGB32(0, 255, 255)
Dim Shared As Long seed(1 To 3), start, cN
Dim Shared As Single rd(1 To 3), gn(1 To 3), bl(1 To 3)
ref& = _NewImage(xmax, ymax * .2, 32)
bk& = _NewImage(xmax, ymax, 32)
restart:
Randomize Timer
seed(1) = Rnd * 1000
seed(2) = Rnd * 1000
seed(3) = Rnd * 1000
For i = 1 To 3
    rd(i) = Rnd * Rnd
    gn(i) = Rnd * Rnd
    bl(i) = Rnd * Rnd
Next
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), star
Next
stars = stars / 2
For i = 1 To stars
    fcirc Rnd * xmax, Rnd * horizon, 1, star
Next
stars = stars / 2
For i = 1 To stars
    fcirc Rnd * xmax, Rnd * horizon, 2, star
Next
For i = .67 * ymax To .8 * ymax
    gc = 100 - (i - .67 * ymax) * .5
    Line (0, i)-(xmax, i), _RGB32(gc, gc, gc)
Next

Do
    start = start + 1
    cN = start
    Randomize Using seed(1)
    branch xmax * .6 + Rnd * .3 * xmax, ymax * .75 - .07 * ymax, 6, 90, xmax / 20, 0, 1
    cN = start
    Randomize Using seed(2)
    branch Rnd * .3 * xmax, ymax * .75 - .05 * ymax, 7, 90, xmax / 18, 0, 2
    cN = start
    Randomize Using seed(3)
    branch xmax / 2, ymax * .77, 8, 90, xmax / 16, 0, 3
    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 branch (x, y, startr, angD, lngth, lev, tree)
    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 - 1 < 0 Or lev > 11 Or lngth < 5 Then Exit Sub
    lev2 = lev + 1
    branch x2, y2, startr - 1, angD + 10 + 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree
    branch x2, y2, startr - 1, angD - 10 - 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2, tree
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)
    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), 127 + 127 * Sin(bl(n) * cN))
End Function

   

Interesting story: When I was developing the code for moving the plasma through the trees, I had it going really nice and then made some edits and suddenly all trees were drawing way too slow! What happened? I didn't change that much. I tried to undo all the changes I did to get that speed back, noth'in! I switched from circles to squares and did one tree, still too slow. Then I saw way at the top the word Debug. How did that get there? I must of clicked too close to left edge and I did get a marker placed in line numbers. I clicked the marker back out and thought it was undone.

When I deleted Debug at the top I got all my speed back and Wow! with the _PutImage method for refection this guy was fast and worked exactly as I had imagined it.