Playing with fire (again)

[bplus]

bplus is into letters now instead of graphics, sad times

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

Code: QB64: [Select]

1. _Title "Jolly Roger on Fire" 'b+ 2022-01-17
2.  
3. Const xmax = 500, ymax = 400
4. Screen _NewImage(xmax, ymax, 32)
5. _ScreenMove 360, 160
6.  
7. Dim p&(300) 'pallette
8. For i = 1 To 100
9.     fr = 240 * i / 100 + 15
10.     p&(i) = _RGB(fr, 0, 0)
11.     p&(i + 100) = _RGB(255, fr, 0)
12.     p&(i + 200) = _RGB(255, 255, fr)
13. Next
14. w~& = _RGB32(255)
15. jr& = _LoadImage("Jolly Roger.png") '
16. _PutImage , jr&, 0
17. xxmax = 500: yymax = 200 'pixels too slow
18. xstep = xmax / xxmax: ystep = ymax / yymax
19. Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
20. For y = 0 To yymax - 1
21.     For x = 0 To xxmax - 1
22.         If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
23.     Next
24. Next
25.  
26. While 1 'main fire
27.     Cls
28.     For y = 1 To yymax - 1
29.         For x = 1 To xxmax - 1 'shift fire seed a bit
30.             r = Rnd
31.             If r > .9 Then f(x, y) = ff(x, y)
32.         Next
33.     Next
34.     For y = 0 To yymax - 2 'fire based literally on 4 pixels below it like cellular automata
35.         For x = 1 To xxmax - 1
36.             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)
37.             Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
38.         Next
39.     Next
40.     _Display
41.     _Limit 30
42. Wend
43.  
44. Function max (a, b)
45.     If a > b Then max = a Else max = b
46. End Function
47.  
48.  

And this might look familiar:

Code: QB64: [Select]

1. Option _Explicit
2. _Title "Jolly Roger on Fire: try spacebar" 'b+ 2022-01-17
3. DefLng A-Z
4. Const sw = 700, sh = 500, fw = 600, fh = 400
5. Screen _NewImage(sw, sh, 32)
6. _ScreenMove 230, 60
7. Dim i, fr, w~&, jr, img, xxmax, yymax, xstep, ystep, x, y, a, x0, y0, r!
8. Dim p(300) 'pallette
9. For i = 1 To 100
10.     fr = 240 * i / 100 + 15
11.     p(i) = _RGB(fr, 0, 0)
12.     p(i + 100) = _RGB(255, fr, 0)
13.     p(i + 200) = _RGB(255, 255, fr)
14. Next
15. w~& = _RGB32(255)
16. jr = _LoadImage("Jolly Roger.png")
17.  
18. img = _NewImage(fw, fh, 32)
19. _PutImage , jr&, img
20. xxmax = fh: yymax = 200
21. xstep = fw / xxmax: ystep = fh / yymax
22. Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
23. _Source img
24. For y = 0 To yymax - 1
25.     For x = 0 To xxmax - 1
26.         If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
27.     Next
28. Next
29.  
30. ' from _vince flag wave
31. a = fh / 20
32. x0 = (sw - fw) / 2 'center flag on screen top left corner
33. y0 = (sh - fh) / 2
34.  
35. Dim r, g, b, toggle
36. Dim As Double t, z, xx, yy, dx, dy, dz
37. Dim As _Unsigned Long tl, tr, bl, br
38. Color , &HFF9999BB
39. Do
40.     If InKey$ = " " Then toggle = 1 - toggle
41.     ' update the img
42.     _Dest img
43.     If toggle Then Line (0, 0)-(fw, fh), &HFF000000, BF Else _PutImage , jr&, img ' blank out image or not either way is interesting
44.     For y = 1 To yymax - 1
45.         For x = 1 To xxmax - 1 'refuel fire seed
46.             r! = Rnd
47.             If r! > .7 Then f(x, y) = ff(x, y)
48.         Next
49.     Next
50.     For y = 0 To yymax - 2 'fire based literally on 4 pixels below it like cellular automata
51.         For x = 1 To xxmax - 1
52.             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)
53.             Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
54.         Next
55.     Next
56.     _Dest 0
57.     'source is still img
58.     t = t + 0.2
59.     Cls
60.     For y = 0 To fh + a * 0.707 Step 1
61.         For x = 0 To fw + a * 0.707 Step 1
62.             z = (0.1 + 0.4 * (x / fw)) * a * Sin(x / 35 - y / 70 - t) + 0.5 * a
63.             dz = 50 * a * Cos(x / 35 - y / 70 - t) / 35
64.  
65.             xx = x + z * 0.707 - a * 0.707
66.             yy = y - z * 0.707
67.  
68.             If (Int(xx) >= 0 And Int(xx) < fw - 1 And Int(yy) >= 0 And Int(yy) < fh - 1) Then
69.                 tl = Point(Int(xx), Int(yy))
70.                 tr = Point(Int(xx) + 1, Int(yy))
71.                 bl = Point(Int(xx), Int(yy) + 1)
72.                 br = Point(Int(xx) + 1, Int(yy) + 1)
73.  
74.                 dx = xx - Int(xx)
75.                 dy = yy - Int(yy)
76.  
77.                 r = _Round((1 - dy) * ((1 - dx) * _Red(tl) + dx * _Red(tr)) + dy * ((1 - dx) * _Red(bl) + dx * _Red(br)))
78.                 g = _Round((1 - dy) * ((1 - dx) * _Green(tl) + dx * _Green(tr)) + dy * ((1 - dx) * _Green(bl) + dx * _Green(br)))
79.                 b = _Round((1 - dy) * ((1 - dx) * _Blue(tl) + dx * _Blue(tr)) + dy * ((1 - dx) * _Blue(bl) + dx * _Blue(br)))
80.  
81.                 r = r + dz
82.                 g = g + dz
83.                 b = b + dz
84.  
85.                 If r < 0 Then r = 0
86.                 If r > 255 Then r = 255
87.                 If g < 0 Then g = 0
88.                 If g > 255 Then g = 255
89.                 If b < 0 Then b = 0
90.                 If b > 255 Then b = 255
91.                 PSet (x0 + x, y0 - a * 0.707 + y), _RGB(r, g, b)
92.             End If
93.         Next
94.     Next
95.     Line (0, 0)-(x0 + 15, y0 - 4), &HFF000000
96.     Line (0, 1)-(x0 + 15, y0 - 3), &HFF000000
97.     Line (20, sh)-(x0 + 10, y0 - 9 + fh), &HFF000000
98.     Line (20, sh + 1)-(x0 + 10, y0 - 9 + fh + 1), &HFF000000
99.     _Display
100.     _Limit 50
101. Loop Until _KeyHit = 27
102.  
103. Function max (a, b)
104.     If a > b Then max = a Else max = b
105. End Function
106.  
107.  

Zip with bas sources and image

[Petr]

This just wants an answer with a little modification :)

external files is not need

Code: QB64: [Select]

1. _Title "Jolly Roger on Fire" 'b+ 2022-01-17
2.  
3. Const xmax = 500, ymax = 400
4. Screen _NewImage(xmax, ymax, 32)
5. _ScreenMove 360, 160
6.  
7. Dim p&(300) 'pallette
8. For i = 1 To 100
9.     fr = 240 * i / 100 + 15
10.     p&(i) = _RGB(fr, 0, 0)
11.     p&(i + 100) = _RGB(255, fr, 0)
12.     p&(i + 200) = _RGB(255, 255, fr)
13. Next
14. w~& = _RGB32(255)
15. jr& = _NewImage(188, 154, 32) '_LoadImage("Jolly Roger.png") '
16. D = _Dest: _Dest jr&
17. F = _LoadFont("arial.ttf", 64, "bold")
18. _Font F, jr&
19. _PrintString (10, 60), "NICE!"
20. _Dest D
21. _PutImage , jr&, 0
22. xxmax = 500: yymax = 200 'pixels too slow
23. xstep = xmax / xxmax: ystep = ymax / yymax
24. Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
25. For y = 0 To yymax - 1
26.     For x = 0 To xxmax - 1
27.         If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
28.     Next
29. Next
30.  
31. While 1 'main fire
32.     Cls
33.     For y = 1 To yymax - 1
34.         For x = 1 To xxmax - 1 'shift fire seed a bit
35.             r = Rnd
36.             If r > .9 Then f(x, y) = ff(x, y)
37.         Next
38.     Next
39.     For y = 0 To yymax - 2 'fire based literally on 4 pixels below it like cellular automata
40.         For x = 1 To xxmax - 1
41.             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)
42.             Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
43.         Next
44.     Next
45.     _Display
46.     _Limit 30
47. Wend
48.  
49. Function max (a, b)
50.     If a > b Then max = a Else max = b
51. End Function
52.  

[bplus]

@Petr beautiful! I tried an ICE mod

Code: QB64: [Select]

1. _Title "Jolly Roger on Fire" 'b+ 2022-01-17
2.  
3. Const xmax = 500, ymax = 400
4. Screen _NewImage(xmax, ymax, 32)
5. _ScreenMove 360, 160
6.  
7. Dim p&(300) 'pallette
8. For i = 1 To 100
9.     fr = 240 * i / 100 + 15
10.     p&(i) = _RGB(fr, fr, fr)
11.     p&(i + 100) = _RGB(fr, fr, 225)
12.     p&(i + 200) = _RGB(fr, fr, 225)
13. Next
14. w~& = _RGB32(255)
15. jr& = _NewImage(188, 154, 32) '_LoadImage("Jolly Roger.png") '
16. D = _Dest: _Dest jr&
17. f = _LoadFont("arial.ttf", 64, "bold")
18. _Font f, jr&
19. _PrintString (10, 60), " ICE!"
20. _Dest D
21. _PutImage , jr&, 0
22. xxmax = 500: yymax = 200 'pixels too slow
23. xstep = xmax / xxmax: ystep = ymax / yymax
24. Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
25. For y = 0 To yymax - 1
26.     For x = 0 To xxmax - 1
27.         If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
28.     Next
29. Next
30.  
31. While 1 'main fire
32.     Cls
33.     For y = 1 To yymax - 1
34.         For x = 1 To xxmax - 1 'shift fire seed a bit
35.             r = Rnd
36.             If r > .9 Then f(x, y) = ff(x, y)
37.         Next
38.     Next
39.     For y = 1 To yymax - 2 'fire based literally on 4 pixels below it like cellular automata
40.         For x = 1 To xxmax - 2
41.             If ff(x, y) = 300 Then
42.                 Line (x * xstep, y * ystep)-Step(xstep, ystep), &HFFBBCCFF
43.             Else
44.                 f(x, y) = max((f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1)) / 4 - 4, 0)
45.                 Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
46.             End If
47.         Next
48.     Next
49.     _Display
50.     _Limit 30
51. Wend
52.  
53. Function max (a, b)
54.     If a > b Then max = a Else max = b
55. End Function
56.  
57.  

[bplus]

Burn out.

Code: QB64: [Select]

1. _Title "Jolly Roger on Fire" 'b+ 2022-01-17
2.  
3. Const xmax = 500, ymax = 400
4. Screen _NewImage(xmax, ymax, 32)
5. _ScreenMove 360, 160
6. DefLng A-Z
7.  
8. Dim p&(300) 'pallette
9. For i = 1 To 100
10.     fr! = 240 * i / 100 + 15
11.     p&(i) = _RGB(fr!, 0, 0)
12.     p&(i + 100) = _RGB(255, fr!, 0)
13.     p&(i + 200) = _RGB(255, 255, fr!)
14. Next
15. w~& = _RGB32(255)
16. jr& = _LoadImage("Jolly Roger.png") '
17. _PutImage , jr&, 0
18. xxmax = 500: yymax = 200 'pixels too slow
19. xstep = xmax / xxmax: ystep = ymax / yymax
20. Dim f(xxmax, yymax), ff(xxmax, yymax), counts(xxmax, yymax) 'fire array and seed
21. For y = 0 To yymax - 1
22.     For x = 0 To xxmax - 1
23.         If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
24.     Next
25. Next
26.  
27. While 1 'main fire
28.     Cls
29.     For y = 1 To yymax - 2
30.         For x = 1 To xxmax - 2 'shift fire seed a bit
31.             r! = Rnd
32.             If r! < .2 Then
33.                 f(x, y + 1) = f(x - 1, y + 1)
34.             ElseIf r! < .4 Then
35.                 f(x, y + 1) = f(x + 1, y + 1)
36.             ElseIf r! < .47 Then
37.                 If ff(x, y) Then f(x, y) = 300
38.             End If
39.         Next
40.     Next
41.     For y = 0 To yymax - 2 'fire based literally on 4 pixels below it like cellular automata
42.         For x = 1 To xxmax - 1
43.             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)
44.             Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
45.             If ff(x, y) = 300 Then
46.                 counts(x, y) = counts(x, y) + 1
47.                 If counts(x, y) > 160 Then ff(x, y) = 0
48.                 If Rnd < .021 And y + 1 < yymax Then ff(x, y + 1) = 300
49.                 If Rnd < .021 And ((x - 1 > 0) And y + 1 < yymax) Then ff(x - 1, y + 1) = 300
50.                 If Rnd < .021 And ((x - 2 > 0) And y + 1 < yymax) Then ff(x - 2, y + 1) = 300
51.                 If Rnd < .021 And ((x + 1 < xxmax) And y + 1 < yymax) Then ff(x + 1, y + 1) = 300
52.                 If Rnd < .021 And ((x + 2 < xxmax) And y + 1 < yymax) Then ff(x + 2, y + 1) = 300
53.                 If Rnd < .021 And x + 2 < xxmax Then ff(x + 2, y) = 300
54.                 If Rnd < .021 And x - 2 > 0 Then ff(x - 2, y) = 300
55.                 If Rnd < .021 And ((x + 1 < xxmax) And y - 1 > 0) Then ff(x + 1, y - 1) = 300
56.                 If Rnd < .021 And ((x - 1 > 0) And y - 1 > 0) Then ff(x - 1, y - 1) = 300
57.                 If Rnd < .06 Then ff(x, y) = 0
58.             End If
59.         Next
60.     Next
61.     _Display
62.     _Limit 30
63. Wend
64.  
65. Function max (a, b)
66.     If a > b Then max = a Else max = b
67. End Function
68.  
69.  

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

Code: QB64: [Select]

1.     For y = 1 To yymax - 2
2.         For x = 1 To xxmax - 2 'shift fire seed a bit
3.             r! = Rnd
4.             If r! < .2 Then
5.                 f(x, y + 1) = f(x - 1, y + 1)
6.             ElseIf r! < .4 Then
7.                 f(x, y + 1) = f(x + 1, y + 1)
8.             ElseIf r! < .47 Then
9.                 If ff(x, y) Then f(x, y) = 300
10.             End If
11.         Next
12.     Next

[Phlashlite]

Nice!