Print Page - Playing with fire (again)

Title: Playing with fire (again)
Post by: bplus on January 17, 2022, 10:31:44 pm

Quote

bplus is into letters now instead of graphics, sad times

OK @_vince maybe this will cheer your up. ;-))

Code: QB64: [Select]

_Title "Jolly Roger on Fire" 'b+ 2022-01-17
 
Const xmax = 500, ymax = 400
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 160
 
Dim p&(300) 'pallette
For i = 1 To 100
    fr = 240 * i / 100 + 15
    p&(i) = _RGB(fr, 0, 0)
    p&(i + 100) = _RGB(255, fr, 0)
    p&(i + 200) = _RGB(255, 255, fr)
Next
w~& = _RGB32(255)
jr& = _LoadImage("Jolly Roger.png") '
_PutImage , jr&, 0
xxmax = 500: yymax = 200 'pixels too slow
xstep = xmax / xxmax: ystep = ymax / yymax
Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
For y = 0 To yymax - 1
    For x = 0 To xxmax - 1
        If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
    Next
Next
 
While 1 'main fire
    Cls
    For y = 1 To yymax - 1
        For x = 1 To xxmax - 1 'shift fire seed a bit
            r = Rnd
            If r > .9 Then f(x, y) = ff(x, y)
        Next
    Next
    For y = 0 To yymax - 2 '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
    _Limit 30
Wend
 
Function max (a, b)
    If a > b Then max = a Else max = b
End Function
 
 

[ This attachment cannot be displayed inline in 'Print Page' view ]

And this might look familiar:

Code: QB64: [Select]

Option _Explicit
_Title "Jolly Roger on Fire: try spacebar" 'b+ 2022-01-17
DefLng A-Z
Const sw = 700, sh = 500, fw = 600, fh = 400
Screen _NewImage(sw, sh, 32)
_ScreenMove 230, 60
Dim i, fr, w~&, jr, img, xxmax, yymax, xstep, ystep, x, y, a, x0, y0, r!
Dim p(300) 'pallette
For i = 1 To 100
    fr = 240 * i / 100 + 15
    p(i) = _RGB(fr, 0, 0)
    p(i + 100) = _RGB(255, fr, 0)
    p(i + 200) = _RGB(255, 255, fr)
Next
w~& = _RGB32(255)
jr = _LoadImage("Jolly Roger.png")
 
img = _NewImage(fw, fh, 32)
_PutImage , jr&, img
xxmax = fh: yymax = 200
xstep = fw / xxmax: ystep = fh / yymax
Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
_Source img
For y = 0 To yymax - 1
    For x = 0 To xxmax - 1
        If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
    Next
Next
 
' from _vince flag wave
a = fh / 20
x0 = (sw - fw) / 2 'center flag on screen top left corner
y0 = (sh - fh) / 2
 
Dim r, g, b, toggle
Dim As Double t, z, xx, yy, dx, dy, dz
Dim As _Unsigned Long tl, tr, bl, br
Color , &HFF9999BB
Do
    If InKey$ = " " Then toggle = 1 - toggle
    ' update the img
    _Dest img
    If toggle Then Line (0, 0)-(fw, fh), &HFF000000, BF Else _PutImage , jr&, img ' blank out image or not either way is interesting
    For y = 1 To yymax - 1
        For x = 1 To xxmax - 1 'refuel fire seed
            r! = Rnd
            If r! > .7 Then f(x, y) = ff(x, y)
        Next
    Next
    For y = 0 To yymax - 2 '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
    _Dest 0
    'source is still img
    t = t + 0.2
    Cls
    For y = 0 To fh + a * 0.707 Step 1
        For x = 0 To fw + a * 0.707 Step 1
            z = (0.1 + 0.4 * (x / fw)) * a * Sin(x / 35 - y / 70 - t) + 0.5 * a
            dz = 50 * a * Cos(x / 35 - y / 70 - t) / 35
 
            xx = x + z * 0.707 - a * 0.707
            yy = y - z * 0.707
 
            If (Int(xx) >= 0 And Int(xx) < fw - 1 And Int(yy) >= 0 And Int(yy) < fh - 1) Then
                tl = Point(Int(xx), Int(yy))
                tr = Point(Int(xx) + 1, Int(yy))
                bl = Point(Int(xx), Int(yy) + 1)
                br = Point(Int(xx) + 1, Int(yy) + 1)
 
                dx = xx - Int(xx)
                dy = yy - Int(yy)
 
                r = _Round((1 - dy) * ((1 - dx) * _Red(tl) + dx * _Red(tr)) + dy * ((1 - dx) * _Red(bl) + dx * _Red(br)))
                g = _Round((1 - dy) * ((1 - dx) * _Green(tl) + dx * _Green(tr)) + dy * ((1 - dx) * _Green(bl) + dx * _Green(br)))
                b = _Round((1 - dy) * ((1 - dx) * _Blue(tl) + dx * _Blue(tr)) + dy * ((1 - dx) * _Blue(bl) + dx * _Blue(br)))
 
                r = r + dz
                g = g + dz
                b = b + dz
 
                If r < 0 Then r = 0
                If r > 255 Then r = 255
                If g < 0 Then g = 0
                If g > 255 Then g = 255
                If b < 0 Then b = 0
                If b > 255 Then b = 255
                PSet (x0 + x, y0 - a * 0.707 + y), _RGB(r, g, b)
            End If
        Next
    Next
    Line (0, 0)-(x0 + 15, y0 - 4), &HFF000000
    Line (0, 1)-(x0 + 15, y0 - 3), &HFF000000
    Line (20, sh)-(x0 + 10, y0 - 9 + fh), &HFF000000
    Line (20, sh + 1)-(x0 + 10, y0 - 9 + fh + 1), &HFF000000
    _Display
    _Limit 50
Loop Until _KeyHit = 27
 
Function max (a, b)
    If a > b Then max = a Else max = b
End Function
 
 

[ This attachment cannot be displayed inline in 'Print Page' view ]

Zip with bas sources and image

Title: Re: Playing with fire (again)
Post by: Petr on January 18, 2022, 11:40:04 am

This just wants an answer with a little modification :)

external files is not need

Code: QB64: [Select]

_Title "Jolly Roger on Fire" 'b+ 2022-01-17
 
Const xmax = 500, ymax = 400
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 160
 
Dim p&(300) 'pallette
For i = 1 To 100
    fr = 240 * i / 100 + 15
    p&(i) = _RGB(fr, 0, 0)
    p&(i + 100) = _RGB(255, fr, 0)
    p&(i + 200) = _RGB(255, 255, fr)
Next
w~& = _RGB32(255)
jr& = _NewImage(188, 154, 32) '_LoadImage("Jolly Roger.png") '
D = _Dest: _Dest jr&
F = _LoadFont("arial.ttf", 64, "bold")
_Font F, jr&
_PrintString (10, 60), "NICE!"
_Dest D
_PutImage , jr&, 0
xxmax = 500: yymax = 200 'pixels too slow
xstep = xmax / xxmax: ystep = ymax / yymax
Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
For y = 0 To yymax - 1
    For x = 0 To xxmax - 1
        If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
    Next
Next
 
While 1 'main fire
    Cls
    For y = 1 To yymax - 1
        For x = 1 To xxmax - 1 'shift fire seed a bit
            r = Rnd
            If r > .9 Then f(x, y) = ff(x, y)
        Next
    Next
    For y = 0 To yymax - 2 '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
    _Limit 30
Wend
 
Function max (a, b)
    If a > b Then max = a Else max = b
End Function
 

Title: Re: Playing with fire (again)
Post by: bplus on January 18, 2022, 12:17:29 pm

@Petr beautiful! I tried an ICE mod

Code: QB64: [Select]

_Title "Jolly Roger on Fire" 'b+ 2022-01-17
 
Const xmax = 500, ymax = 400
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 160
 
Dim p&(300) 'pallette
For i = 1 To 100
    fr = 240 * i / 100 + 15
    p&(i) = _RGB(fr, fr, fr)
    p&(i + 100) = _RGB(fr, fr, 225)
    p&(i + 200) = _RGB(fr, fr, 225)
Next
w~& = _RGB32(255)
jr& = _NewImage(188, 154, 32) '_LoadImage("Jolly Roger.png") '
D = _Dest: _Dest jr&
f = _LoadFont("arial.ttf", 64, "bold")
_Font f, jr&
_PrintString (10, 60), " ICE!"
_Dest D
_PutImage , jr&, 0
xxmax = 500: yymax = 200 'pixels too slow
xstep = xmax / xxmax: ystep = ymax / yymax
Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
For y = 0 To yymax - 1
    For x = 0 To xxmax - 1
        If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
    Next
Next
 
While 1 'main fire
    Cls
    For y = 1 To yymax - 1
        For x = 1 To xxmax - 1 'shift fire seed a bit
            r = Rnd
            If r > .9 Then f(x, y) = ff(x, y)
        Next
    Next
    For y = 1 To yymax - 2 'fire based literally on 4 pixels below it like cellular automata
        For x = 1 To xxmax - 2
            If ff(x, y) = 300 Then
                Line (x * xstep, y * ystep)-Step(xstep, ystep), &HFFBBCCFF
            Else
                f(x, y) = max((f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1)) / 4 - 4, 0)
                Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
            End If
        Next
    Next
    _Display
    _Limit 30
Wend
 
Function max (a, b)
    If a > b Then max = a Else max = b
End Function
 
 

Title: Re: Playing with fire (again)
Post by: bplus on January 19, 2022, 08:53:57 am

Burn out.

Code: QB64: [Select]

_Title "Jolly Roger on Fire" 'b+ 2022-01-17
 
Const xmax = 500, ymax = 400
Screen _NewImage(xmax, ymax, 32)
_ScreenMove 360, 160
DefLng A-Z
 
Dim p&(300) 'pallette
For i = 1 To 100
    fr! = 240 * i / 100 + 15
    p&(i) = _RGB(fr!, 0, 0)
    p&(i + 100) = _RGB(255, fr!, 0)
    p&(i + 200) = _RGB(255, 255, fr!)
Next
w~& = _RGB32(255)
jr& = _LoadImage("Jolly Roger.png") '
_PutImage , jr&, 0
xxmax = 500: yymax = 200 'pixels too slow
xstep = xmax / xxmax: ystep = ymax / yymax
Dim f(xxmax, yymax), ff(xxmax, yymax), counts(xxmax, yymax) 'fire array and seed
For y = 0 To yymax - 1
    For x = 0 To xxmax - 1
        If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
    Next
Next
 
While 1 'main fire
    Cls
    For y = 1 To yymax - 2
        For x = 1 To xxmax - 2 'shift fire seed a bit
            r! = Rnd
            If r! < .2 Then
                f(x, y + 1) = f(x - 1, y + 1)
            ElseIf r! < .4 Then
                f(x, y + 1) = f(x + 1, y + 1)
            ElseIf r! < .47 Then
                If ff(x, y) Then f(x, y) = 300
            End If
        Next
    Next
    For y = 0 To yymax - 2 '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
            If ff(x, y) = 300 Then
                counts(x, y) = counts(x, y) + 1
                If counts(x, y) > 160 Then ff(x, y) = 0
                If Rnd < .021 And y + 1 < yymax Then ff(x, y + 1) = 300
                If Rnd < .021 And ((x - 1 > 0) And y + 1 < yymax) Then ff(x - 1, y + 1) = 300
                If Rnd < .021 And ((x - 2 > 0) And y + 1 < yymax) Then ff(x - 2, y + 1) = 300
                If Rnd < .021 And ((x + 1 < xxmax) And y + 1 < yymax) Then ff(x + 1, y + 1) = 300
                If Rnd < .021 And ((x + 2 < xxmax) And y + 1 < yymax) Then ff(x + 2, y + 1) = 300
                If Rnd < .021 And x + 2 < xxmax Then ff(x + 2, y) = 300
                If Rnd < .021 And x - 2 > 0 Then ff(x - 2, y) = 300
                If Rnd < .021 And ((x + 1 < xxmax) And y - 1 > 0) Then ff(x + 1, y - 1) = 300
                If Rnd < .021 And ((x - 1 > 0) And y - 1 > 0) Then ff(x - 1, y - 1) = 300
                If Rnd < .06 Then ff(x, y) = 0
            End If
        Next
    Next
    _Display
    _Limit 30
Wend
 
Function max (a, b)
    If a > b Then max = a Else max = b
End Function
 
 

BTW, better fire now, swap this out with other section in JR after While 1 : CLS 'main fire

Code: QB64: [Select]

    For y = 1 To yymax - 2
        For x = 1 To xxmax - 2 'shift fire seed a bit
            r! = Rnd
            If r! < .2 Then
                f(x, y + 1) = f(x - 1, y + 1)
            ElseIf r! < .4 Then
                f(x, y + 1) = f(x + 1, y + 1)
            ElseIf r! < .47 Then
                If ff(x, y) Then f(x, y) = 300
            End If
        Next
    Next

Title: Re: Playing with fire (again)
Post by: Phlashlite on January 22, 2022, 03:20:01 pm

Nice!

Text Only | Text with Attachments

QB64.org Forum

Active Forums => Programs => Topic started by: bplus on January 17, 2022, 10:31:44 pm