05-08-2022, 02:13 AM (This post was last modified: 05-08-2022, 04:14 AM by 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
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.
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
05-16-2022, 12:58 AM (This post was last modified: 05-16-2022, 01:23 AM by 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:
(05-16-2022, 12:58 AM)bplus Wrote: 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:
![[Image: New-Desk-Top.png]](https://i.ibb.co/fQtZ6W9/New-Desk-Top.png)
