Proggies

[bplus]

Man I thought I had a decent Phoenix image but I like this one allot too!

and as requested by our Super Moderator a live fire!

Code: (Select All)

_Title "Test Rainbow 3 add fire" ' b+ 2022-05-15
' 2022-05-17  New image for risen above the fire

w = _DesktopWidth: h = _DesktopHeight: hd2 = h / 2
Screen _NewImage(w, h, 32)
_FullScreen

img& = _LoadImage("clipart4468176.png") ' !!!  thanks clipartmax !!!
' ref https://www.clipartmax.com/middle/m2H7d3G6d3i8H7Z5_phoenix-clipart-firebird-phoenix-bird-transparent-background/

dt = .001058321
For x = 0 To w
    For y = 0 To h
        r = Sin(1.1 * t) * hd2 - y + hd2
        Line (x, y)-Step(1, 1), _RGB(-r, r - y, r), BF ' white , blue,  red
    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
back& = _NewImage(_Width, _Height, 32)
_PutImage , 0, back&

xmax = w: ymax = h
xxmax = 500: yymax = 100 'pixels too slow
xstep = xmax / xxmax: ystep = ymax / yymax
Dim p~&(300) 'pallette
For i = 1 To 100
    fr = 240 * i / 100 + 15
    p~&(i) = _RGB32(fr, 0, 0)
    p~&(i + 100) = _RGB32(255, fr, 0)
    p~&(i + 200) = _RGB32(255, 255, fr)
Next
Dim f(xxmax, yymax + 2) 'fire array and seed
For x = 0 To xxmax
    f(x, yymax + 1) = Int(Rnd * 2) * 300
    f(x, yymax + 2) = 300
Next

While _KeyDown(27) = 0 'main fire
    _PutImage , back&, 0
    For x = 1 To xxmax - 1 'shift fire seed a bit
        r = Rnd
        If r < .15 Then
            f(x, yymax + 1) = f(x - 1, yymax + 1)
        ElseIf r < .3 Then
            f(x, yymax + 1) = f(x + 1, yymax + 1)
        ElseIf r < .35 Then
            f(x, yymax + 1) = Int(Rnd * 2) * 300
        End If
    Next
    For y = 0 To yymax 'fire based literally on 4 pixels below it like cellular automata
        For x = 1 To xxmax - 1
            f(x, y) = max((f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1) + f(x - 1, y + 2)) / 4 - 5, 0)
            If f(x, y) > 100 Then
                Line (x * xstep, y * ystep)-Step(xstep, ystep), p~&(f(x, y)), BF
            End If
        Next
    Next
    _Display
Wend
Function max (a, b)
    If a > b Then max = a Else max = b
End Function