Proggies

[bplus]

don't put off to tomorrow what you can do today

Flame On 2

Code: (Select All)

_Title "Flame on 2, press spacebar for new background color" ' by bplus 2017-11-23
' flame on.bas SmallBASIC 0.12.9 (B+=MGA) 2017-11-22
' 2024-06-20 mod palette to blend with background

Const xmax = 800
Const ymax = 600
Dim back~&

Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 60 'adjust as needed _MIDDLE needs a delay .5 or more for me

xxmax = 400: yymax = 150 'pixels too slow
xstep = xmax / xxmax: ystep = ymax / yymax
Dim p~&(300) 'pallette

restart:
back~& = _RGB32(Rnd * 255, Rnd * 255, Rnd * 255)
cAnalysis back~&, red, green, blu, alph
For i = 1 To 100
    fr = 240 * i / 100 + 15
    If i < 50 Then p~&(i) = midInk~&(red, green, blu, fr, 0, 0, i / 100) Else p~&(i) = _RGB(fr, 0, 0)
    p~&(i + 100) = _RGB(255, fr, 0)
    p~&(i + 200) = _RGB(255, 255, fr)
Next
ReDim 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
Color , back~&
While _KeyDown(32) = 0 'main fire
    Cls
    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)
            Line (x * xstep, y * ystep)-Step(xstep, ystep), p~&(f(x, y)), BF
        Next
    Next
    _Display
Wend
GoTo restart:

Function max (a, b)
    If a > b Then max = a Else max = b
End Function
Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)
    midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)
End Function
Sub cAnalysis (c As _Unsigned Long, outRed, outGrn, outBlu, outAlp)
    outRed = _Red32(c): outGrn = _Green32(c): outBlu = _Blue32(c): outAlp = _Alpha32(c)
End Sub

edit i changed my mind to black smoke instead of white, no pope today