Screen Savers

[bplus]

Alien Trees Mod 3

Code: (Select All)

_Title "Alien Trees Mod 3: Leaves" 'b+ 2022-09-05
Randomize Timer
DefDbl A-Z
Const xmax = 1024, ymax = 600
Type ship
    As Double x, y, dx, dy, scale, tilt
End Type
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 170, 40 ' clear sides
_FullScreen
Randomize Timer
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
ref& = _NewImage(xmax, ymax * .2, 32) 'container for reflection image
Dim Shared ships(448) As ship ' ships / leaves
Dim Shared leaves(448) As Long ' ship images
makeShips ' just do this once for images and travel rates

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 * Rnd
    bl(i) = 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

start = 0: d = 1300: ds = 5 ' 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
        RotoZoom ships(i).x + d * ships(i).dx, ships(i).y + d * ships(i).dy, leaves(i), ships(i).scale, 0
    Next
    d = d + ds
    If d > 1300 Then ds = -3: d = 1300
    If d < 0 Then ds = 7: d = 0: _Delay 2
    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 makeShips
    cN = 0
    rd(1) = Rnd
    gn(1) = Rnd
    bl(1) = Rnd
    For i = 0 To 448
        leaves(i) = _NewImage(61, 31, 32) ' ship is 60 x 30 drawn in top left hand corner
        ' need black backgrounf for ship
        Color , &HFF000000 '= balck background
        Cls
        drawShip 30, 15, changePlasma(1)
        _PutImage , 0, leaves(i), (0, 0)-(61, 31) ' <<<< upper left corner of screen!!!
        ' make the background black of ship transparent
        _ClearColor &HFF000000, leaves(i)
        a = _Pi(2) * Rnd
        ships(i).dx = Cos(a)
        ships(i).dy = Sin(a)
    Next
End Sub

Sub makeBackground
    _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)
    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
            'fcirc x + dx * i, y + dy * i, 5, &HFF008800
            leaf = leaf + 1
            ships(leaf).x = x + dx * i
            ships(leaf).y = y + dy * i
            ships(leaf).scale = .5 - (4 - tree) * .075
        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)
    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

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

' ======== helper subs for drawShip that you can use for other things specially fcirc = fill_circle  x, y, radius, color

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

Sub DrawTerrain (h, modN, c As _Unsigned Long) ' modN for ruggedness the higher the less smooth
    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