Author Topic: Playing with fire (again)  (Read 4427 times)

0 Members and 1 Guest are viewing this topic.

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Playing with fire (again)
« 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]
  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. w~& = _RGB32(255)
  14. jr& = _LoadImage("Jolly Roger.png") '
  15. _PutImage , jr&, 0
  16. xxmax = 500: yymax = 200 'pixels too slow
  17. xstep = xmax / xxmax: ystep = ymax / yymax
  18. Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
  19. For y = 0 To yymax - 1
  20.     For x = 0 To xxmax - 1
  21.         If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
  22.     Next
  23.  
  24. While 1 'main fire
  25.     Cls
  26.     For y = 1 To yymax - 1
  27.         For x = 1 To xxmax - 1 'shift fire seed a bit
  28.             r = Rnd
  29.             If r > .9 Then f(x, y) = ff(x, y)
  30.         Next
  31.     Next
  32.     For y = 0 To yymax - 2 'fire based literally on 4 pixels below it like cellular automata
  33.         For x = 1 To xxmax - 1
  34.             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)
  35.             Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
  36.         Next
  37.     Next
  38.     _Display
  39.     _Limit 30
  40.  
  41. Function max (a, b)
  42.     If a > b Then max = a Else max = b
  43.  
  44.  
JR on Fire.PNG


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


Zip with bas sources and image

* Playing with Fire.zip (Filesize: 7.62 KB, Downloads: 228)

Offline Petr

  • Forum Resident
  • Posts: 1720
  • The best code is the DNA of the hops.
    • View Profile
Re: Playing with fire (again)
« Reply #1 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]
  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. w~& = _RGB32(255)
  14. jr& = _NewImage(188, 154, 32) '_LoadImage("Jolly Roger.png") '
  15. D = _Dest: _Dest jr&
  16. F = _LoadFont("arial.ttf", 64, "bold")
  17. _Font F, jr&
  18. _PrintString (10, 60), "NICE!"
  19. _PutImage , jr&, 0
  20. xxmax = 500: yymax = 200 'pixels too slow
  21. xstep = xmax / xxmax: ystep = ymax / yymax
  22. Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
  23. For y = 0 To yymax - 1
  24.     For x = 0 To xxmax - 1
  25.         If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
  26.     Next
  27.  
  28. While 1 'main fire
  29.     Cls
  30.     For y = 1 To yymax - 1
  31.         For x = 1 To xxmax - 1 'shift fire seed a bit
  32.             r = Rnd
  33.             If r > .9 Then f(x, y) = ff(x, y)
  34.         Next
  35.     Next
  36.     For y = 0 To yymax - 2 'fire based literally on 4 pixels below it like cellular automata
  37.         For x = 1 To xxmax - 1
  38.             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)
  39.             Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
  40.         Next
  41.     Next
  42.     _Display
  43.     _Limit 30
  44.  
  45. Function max (a, b)
  46.     If a > b Then max = a Else max = b
  47.  

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Playing with fire (again)
« Reply #2 on: January 18, 2022, 12:17:29 pm »
@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. w~& = _RGB32(255)
  14. jr& = _NewImage(188, 154, 32) '_LoadImage("Jolly Roger.png") '
  15. D = _Dest: _Dest jr&
  16. f = _LoadFont("arial.ttf", 64, "bold")
  17. _Font f, jr&
  18. _PrintString (10, 60), " ICE!"
  19. _PutImage , jr&, 0
  20. xxmax = 500: yymax = 200 'pixels too slow
  21. xstep = xmax / xxmax: ystep = ymax / yymax
  22. Dim f(xxmax, yymax), ff(xxmax, yymax) 'fire array and seed
  23. For y = 0 To yymax - 1
  24.     For x = 0 To xxmax - 1
  25.         If Point(x * xstep, y * ystep) = w~& Then f(x, y) = 300: ff(x, y) = 300
  26.     Next
  27.  
  28. While 1 'main fire
  29.     Cls
  30.     For y = 1 To yymax - 1
  31.         For x = 1 To xxmax - 1 'shift fire seed a bit
  32.             r = Rnd
  33.             If r > .9 Then f(x, y) = ff(x, y)
  34.         Next
  35.     Next
  36.     For y = 1 To yymax - 2 'fire based literally on 4 pixels below it like cellular automata
  37.         For x = 1 To xxmax - 2
  38.             If ff(x, y) = 300 Then
  39.                 Line (x * xstep, y * ystep)-Step(xstep, ystep), &HFFBBCCFF
  40.             Else
  41.                 f(x, y) = max((f(x - 1, y + 1) + f(x, y + 1) + f(x + 1, y + 1)) / 4 - 4, 0)
  42.                 Line (x * xstep, y * ystep)-Step(xstep, ystep), p&(f(x, y)), BF
  43.             End If
  44.         Next
  45.     Next
  46.     _Display
  47.     _Limit 30
  48.  
  49. Function max (a, b)
  50.     If a > b Then max = a Else max = b
  51.  
  52.  

Offline bplus

  • Global Moderator
  • Forum Resident
  • Posts: 8053
  • b = b + ...
    • View Profile
Re: Playing with fire (again)
« Reply #3 on: January 19, 2022, 08:53:57 am »
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. 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), counts(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.  
  25. While 1 'main fire
  26.     Cls
  27.     For y = 1 To yymax - 2
  28.         For x = 1 To xxmax - 2 'shift fire seed a bit
  29.             r! = Rnd
  30.             If r! < .2 Then
  31.                 f(x, y + 1) = f(x - 1, y + 1)
  32.             ElseIf r! < .4 Then
  33.                 f(x, y + 1) = f(x + 1, y + 1)
  34.             ElseIf r! < .47 Then
  35.                 If ff(x, y) Then f(x, y) = 300
  36.             End If
  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.             If ff(x, y) = 300 Then
  44.                 counts(x, y) = counts(x, y) + 1
  45.                 If counts(x, y) > 160 Then ff(x, y) = 0
  46.                 If Rnd < .021 And y + 1 < yymax Then ff(x, y + 1) = 300
  47.                 If Rnd < .021 And ((x - 1 > 0) And y + 1 < yymax) Then ff(x - 1, y + 1) = 300
  48.                 If Rnd < .021 And ((x - 2 > 0) And y + 1 < yymax) Then ff(x - 2, y + 1) = 300
  49.                 If Rnd < .021 And ((x + 1 < xxmax) And y + 1 < yymax) Then ff(x + 1, y + 1) = 300
  50.                 If Rnd < .021 And ((x + 2 < xxmax) And y + 1 < yymax) Then ff(x + 2, y + 1) = 300
  51.                 If Rnd < .021 And x + 2 < xxmax Then ff(x + 2, y) = 300
  52.                 If Rnd < .021 And x - 2 > 0 Then ff(x - 2, y) = 300
  53.                 If Rnd < .021 And ((x + 1 < xxmax) And y - 1 > 0) Then ff(x + 1, y - 1) = 300
  54.                 If Rnd < .021 And ((x - 1 > 0) And y - 1 > 0) Then ff(x - 1, y - 1) = 300
  55.                 If Rnd < .06 Then ff(x, y) = 0
  56.             End If
  57.         Next
  58.     Next
  59.     _Display
  60.     _Limit 30
  61.  
  62. Function max (a, b)
  63.     If a > b Then max = a Else max = b
  64.  
  65.  

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

Offline Phlashlite

  • Newbie
  • Posts: 50
    • View Profile
Re: Playing with fire (again)
« Reply #4 on: January 22, 2022, 03:20:01 pm »
Nice!