Proggies

[bplus]

Just sharing the joy

[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.

[OldMoses]

I guess da bug was inhibiting nutrient up take...

[bplus]

Ya de bug all over Earth! LOL

[bplus]

Dav had an interesting way to make a background in the Raw program: Clicking Away Balls. Today I played around with it probably because it has a plasma like feel to it

Maybe it could be useful for something like a simple colorful DeskTop.

Code: (Select All)

_Title "Test Rainbow" ' b+ 2022-05-15
Const w = 1024, h = 600, wd2 = 512, hd2 = 300
Screen _NewImage(w, h, 32)
_ScreenMove 180, 60
Do
    Cls
    dt = 100
    While dt > .002 Or dt < .00095
        dt = Rnd * .0015
    Wend
    rpick = Int(Rnd * 6) + 1
    For x = 0 To w
        For y = 0 To h
            r = Sin(1.1 * t) * hd2 - y + hd2
            Select Case rpick
                Case 1: Line (x, y)-Step(1, 1), _RGB(r, r - y, -r), BF ' yellow top,  red middle, blue bottom
                Case 2: Line (x, y)-Step(1, 1), _RGB(r, -r, r - y), BF ' purple , red , green
                Case 3: Line (x, y)-Step(1, 1), _RGB(-r, r, r - y), BF ' cyan , yellow green, red
                Case 4: Line (x, y)-Step(1, 1), _RGB(-r, r - y, r), BF ' white , blue,  red
                Case 5: Line (x, y)-Step(1, 1), _RGB(r - y, -r, r), BF ' purple, blue ,green
                Case 6: Line (x, y)-Step(1, 1), _RGB(r - y, r, -r), BF ' yellow green blue
            End Select
        Next
        t = t + dt ' <<<<<<<<<<<< put this back in so the background is shaped
    Next
    Print dt
    Sleep
Loop

[bplus]

Say! speaking of Desktops how would you (or I) like a Phoenix DeskTop?

Code: (Select All)

_Title "Test Rainbow 2 add image" ' b+ 2022-05-15
w = _DesktopWidth: h = _DesktopHeight: hd2 = h / 2
Screen _NewImage(w, h, 32)
_FullScreen
img& = _LoadImage("Phoenix A.png")
_ClearColor &HFFFFFFFF, img&
Do
    Cls
    dt = 100
    While dt > .002 Or dt < .00095
        dt = Rnd * .0015
    Wend
    rpick = Int(Rnd * 6) + 1
    For x = 0 To w
        For y = 0 To h
            r = Sin(1.1 * t) * hd2 - y + hd2
            Select Case rpick
                Case 1: Line (x, y)-Step(1, 1), _RGB(r, r - y, -r), BF ' yellow top,  red middle, blue bottom
                Case 2: Line (x, y)-Step(1, 1), _RGB(r, -r, r - y), BF ' purple , red , green
                Case 3: Line (x, y)-Step(1, 1), _RGB(-r, r, r - y), BF ' cyan , yellow green, red
                Case 4: Line (x, y)-Step(1, 1), _RGB(-r, r - y, r), BF ' white , blue,  red
                Case 5: Line (x, y)-Step(1, 1), _RGB(r - y, -r, r), BF ' purple, blue ,green
                Case 6: Line (x, y)-Step(1, 1), _RGB(r - y, r, -r), BF ' yellow green blue
            End Select
        Next
        t = t + dt ' <<<<<<<<<<<< put this back in so the background is shaped
    Next
    _PutImage ((_Width - _Width(img&)) / 2, (_Height - _Height(img&)))-Step(_Width(img&), _Height(img&)), img&, 0
    Sleep
Loop Until _KeyDown(27)

   

   

You can get the Phoenix Image about halfway through the scroll, here:

https://commons.wikimedia.org/w/index.ph...type=image

[bplus]

Hmm... looks pretty good! I think try it.

[PhilOfPerth]

Say! speaking of Desktops how would you (or I) like a Phoenix DeskTop?

Code: (Select All)

_Title "Test Rainbow 2 add image" ' b+ 2022-05-15
w = _DesktopWidth: h = _DesktopHeight: hd2 = h / 2
Screen _NewImage(w, h, 32)
_FullScreen
img& = _LoadImage("Phoenix A.png")
_ClearColor &HFFFFFFFF, img&
Do
    Cls
    dt = 100
    While dt > .002 Or dt < .00095
        dt = Rnd * .0015
    Wend
    rpick = Int(Rnd * 6) + 1
    For x = 0 To w
        For y = 0 To h
            r = Sin(1.1 * t) * hd2 - y + hd2
            Select Case rpick
                Case 1: Line (x, y)-Step(1, 1), _RGB(r, r - y, -r), BF ' yellow top,  red middle, blue bottom
                Case 2: Line (x, y)-Step(1, 1), _RGB(r, -r, r - y), BF ' purple , red , green
                Case 3: Line (x, y)-Step(1, 1), _RGB(-r, r, r - y), BF ' cyan , yellow green, red
                Case 4: Line (x, y)-Step(1, 1), _RGB(-r, r - y, r), BF ' white , blue,  red
                Case 5: Line (x, y)-Step(1, 1), _RGB(r - y, -r, r), BF ' purple, blue ,green
                Case 6: Line (x, y)-Step(1, 1), _RGB(r - y, r, -r), BF ' yellow green blue
            End Select
        Next
        t = t + dt ' <<<<<<<<<<<< put this back in so the background is shaped
    Next
    _PutImage ((_Width - _Width(img&)) / 2, (_Height - _Height(img&)))-Step(_Width(img&), _Height(img&)), img&, 0
    Sleep
Loop Until _KeyDown(27)

You can get the Phoenix Image about halfway through the scroll, here:

https://commons.wikimedia.org/w/index.ph...type=image

Yes, I like the blue/red one.

[SMcNeill]

Does the flames burn? You might be able to do like I did here with them: http://qb64phoenix.com/forum/showthread....16#pid1816

[bplus]

I am sure we could make the fire live.

Cut random flame holes and move fire background behind it should do it.

"Cut random flame holes" ??? ;-))