05-08-2022, 11:01 AM
I took this code from bplus. I lightened it up a bit.
Alien Trees Reflection - Plasma Mod.
5.9x seconds : program compiled with qb64 -Ofast
9.2x seconds : program compiled with original qb64
the speed gain is confirmed for the graphic controls.
Alien Trees Reflection - Plasma Mod.
5.9x seconds : program compiled with qb64 -Ofast
9.2x seconds : program compiled with original qb64
the speed gain is confirmed for the graphic controls.
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)
_Delay 0.2
_ScreenMove _Middle
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
start = Timer
For boucle% = 1 To 500
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
Next boucle%
Print Timer - start
End
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