alien skies

[bplus]

LOL yeah that's starting to look alien!

Oh ha! another place to try plasma color sequencing! Oh boy!

Code: (Select All)

_Title "Alien Trees Reflection - Plasma Mod" 'b+ trans from SB 2022-05-06
Rem trees reflection.bas 2016-02-22 SmallBASIC 0.12.2 [B+=MGA]
'lakeshore demo repurposed with new and improved trees reflected in lake
Randomize Timer
Const xmax = 1024, ymax = 600

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 200, 80 ' clear sides
Dim Shared As _Unsigned Long qb(15)
Dim Shared pR, pG, pB, cN, dcN

qb(0) = &HFF000000
qb(1) = &HFF000088
qb(2) = &HFF008800
qb(3) = &HFF008888
qb(4) = &HFF880000
qb(5) = &HFF880088
qb(6) = &HFF888800
qb(7) = &HFFCCCCCC
qb(8) = &HFF888888
qb(9) = &HFF0000FF
qb(10) = &HFF00FF00
qb(11) = &HFF00FFFF
qb(12) = &HFFFF0000
qb(13) = &HFFFF00FF
qb(14) = &HFFFFFF00
qb(15) = &HFFFFFFFF

restart:
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), qb(11)
Next
stars = stars / 2
For i = 1 To stars
    fcirc Rnd * xmax, Rnd * horizon, 1, qb(11)
Next
stars = stars / 2
For i = 1 To stars
    fcirc Rnd * xmax, Rnd * horizon, 2, qb(11)
Next
For i = .67 * ymax To .8 * ymax
    gc = max(0, 100 - (i - .67 * ymax) * .5)
    Line (0, i)-(xmax, i), _RGB32(gc, gc, gc)
Next
resetPlasma
branch xmax * .6 + Rnd * .3 * xmax, ymax * .75 - .07 * ymax, 6, 90, xmax / 20, 0
resetPlasma
branch Rnd * .3 * xmax, ymax * .75 - .05 * ymax, 7, 90, xmax / 18, 0
resetPlasma
branch xmax / 2, ymax * .77, 8, 90, xmax / 16, 0

Line (0, .8 * ymax)-(xmax, .8 * ymax + 1), _RGB32(70, 70, 70), BF
For y = .8 * ymax To ymax
    For x = 0 To xmax
        yy = .8 * ymax - (y - .8 * ymax) * 4
        PSet (x, y), Point(x, yy)
    Next
Next
_Display

'code from lakeshore make waves in tree reflection??
' This image size: 1,1-400,270
' Water area: 1,190 - 400,270  that means wh=270-190=80 ww=400-1=399
'now water area is .8*ymax to ymax by 0 to xmax
wh = Int(.2 * ymax): ww = xmax
ReDim t1(.25 * ymax + 3, xmax + 2) As _Unsigned Long ' store water area > t1(), make it slighly bigger
For ii = .8 * ymax To ymax
    For iii = 0 To xmax
        t1(ii - Int(.8 * ymax), iii) = Point(iii, ii)
    Next
Next

' *** Let's wave it ***
waveit:
mo = 3 '  height of strip, bigger > waves, smaller > flickering
If bb < mo Then bb = wh - 3
colp = (colp + 1) Mod 4 'need to random place for to create clickering
aa = 0
For aa1 = 1 To (mo - 1)
    aa = bb - aa1 + Int(.8 * ymax) - 1
    For aaa = 0 To xmax
        PSet (aaa, aa), t1(aa + colp - .8 * ymax, aaa)
        PSet (aaa, aa + 1), t1(aa + colp - Int(.8 * ymax), aaa)
        PSet (aaa, aa + 2), t1(aa + colp - Int(.8 * ymax), aaa)
    Next
Next
bb = bb - (mo + 1) ' next strip place
_Display
_Limit 5
If _KeyDown(32) Then GoTo restart
If _KeyDown(27) Then End
GoTo waveit

Sub branch (x, y, startr, angD, lngth, lev)
    ' local x2,y2,dx,dy,bc,i
    Dim bc As _Unsigned Long
    x2 = x + Cos(_D2R(angD)) * lngth
    y2 = y - Sin(_D2R(angD)) * lngth
    dx = (x2 - x) / lngth
    dy = (y2 - y) / lngth
    'bc = _RGB32(10 + lev, 15 + lev, 10)
    For i = 0 To lngth
        fcirc x + dx * i, y + dy * i, startr, changePlasma~&
    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
    branch x2, y2, startr - 1, angD - 10 - 30 * Rnd, .8 * lngth + .2 * Rnd * lngth, lev2
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 max (x, y)
    If x > y Then max = x Else max = y
End Function

Function changePlasma~& ()
    cN = cN + dcN 'dim shared cN as _Integer64, pR as long, pG as long, pB as long
    changePlasma~& = _RGB32(127 + 127 * Sin(pR * cN), 127 + 127 * Sin(pG * cN), 127 + 127 * Sin(pB * cN))
End Function

Sub resetPlasma ()
    pR = Rnd ^ 2: pG = Rnd ^ 2: pB = Rnd ^ 2: dcN = Rnd
End Sub