Fire effect

[Flype]

Hi, here is a useless fire effect quickly done (turn debugger off preferably) :

Code: Select all

;====================================
; Fire Effect, flype
;====================================

EnableExplicit

#W = 200
#H = 150
#Z = 2

Global Dim pix.l(#W+2, #H+2)

;====================================

Procedure FireEffect_Calc()
  Protected x, y
  For y = 0 To #H + 1
    For x = 1 To #W - 1
      pix(x, y) = (pix(x-1, y) + pix(x+1, y) + pix(x, y+1) + pix(x, y+1)) >> 2
    Next
  Next
EndProcedure

Procedure FireEffect_Draw()
  Protected x, y
  If StartDrawing(CanvasOutput(0))
    For y = 0 To #H - 1
      For x = 0 To #W - 1
        Box(x*#Z, y*#Z, #Z, #Z, pix(x, y))
      Next
    Next
    StopDrawing()
  EndIf
EndProcedure

Procedure FireEffect_Feed()
  Protected i
  For i = 0 To 255 Step 32
    pix(Random(#W, 0), #H+2) = i
  Next
EndProcedure

Procedure FireEffect_Update()
  FireEffect_Calc()
  FireEffect_Feed()
  FireEffect_Draw()
EndProcedure

;====================================

If OpenWindow(0, 0, 0, #W*#Z, #H*#Z, "Fire Effect", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(0, 0, 0, #W*#Z, #H*#Z)
  AddWindowTimer(0, 0, 5)
  BindEvent(#PB_Event_Timer, @FireEffect_Update(), 0, 0)
  Repeat : Until WaitWindowEvent() = #PB_Event_CloseWindow
EndIf

;====================================

[RSBasic]

Nice effect

[Flype]

an another example to show how to play with it - by modifying some values :

(use mousewheel, lmb, rmb)

EDIT: fixed some problems.

Code: Select all

;====================================
; Fire Effect, flype
;====================================

EnableExplicit

#W = 200
#H = 150
#Z = 2

Global pow = 30
Global Dim pix.l(#W+2, #H+2)

;====================================

Procedure Clamp(x, min, max)
  If x > max
    ProcedureReturn max
  EndIf
  If x < min
    ProcedureReturn min
  EndIf
  ProcedureReturn x
EndProcedure

Procedure FireEffect_Calc()
  Protected x, y
  For y = 0 To #H + 1
    For x = 1 To #W - 1
      pix(x, y) = (pix(x-1, y) + pix(x+1, y) + pix(x, y+1) + pix(x, y+1)) >> 2
    Next
  Next
EndProcedure

Procedure FireEffect_Clear(color)
  Protected x, y
  For y = 0 To #H + 2
    For x = 0 To #W + 2
      pix(x, y) = color
    Next
  Next
EndProcedure

Procedure FireEffect_Draw()
  Protected x, y
  If StartDrawing(CanvasOutput(0))
    For y = 0 To #H - 1
      For x = 0 To #W - 1
        Box(x*#Z, y*#Z, #Z, #Z, RGB(255, pix(x, y), 0))
      Next
    Next
    DrawingMode(#PB_2DDrawing_Transparent)
    DrawText(10, 10, Str(pow), $00ffff)
    StopDrawing()
  EndIf
EndProcedure

Procedure FireEffect_Feed()
  Protected i
  For i = 0 To 5
   pix(Random(#W, 0), #H+2) = Clamp(Random(pow, 1)*2, 0, 255)
  Next
EndProcedure

Procedure FireEffect_FeedMouse(color)
  Protected x, y
  Protected md = Random(20, 0)
  Protected mx = ( WindowMouseX(0) + 1 ) / #Z
  Protected my = ( WindowMouseY(0) + 1 ) / #Z
  For y = -md To md
    For x = -md To md
      pix(Clamp(mx + x, 0, #W), #H+2) = color
    Next
  Next
EndProcedure

Procedure FireEffect_Pow()
  pow + ( 5 * GetGadgetAttribute(0, #PB_Canvas_WheelDelta) )
  pow = Clamp(pow, 1, 255)
EndProcedure

Procedure FireEffect_Update()
  FireEffect_Calc()
  FireEffect_Feed()
  FireEffect_Draw()
  FireEffect_FeedMouse(Random(200, 128))
EndProcedure

;====================================

If OpenWindow(0, 0, 0, #W*#Z, #H*#Z, "Fire Effect", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(0, 0, 0, #W*#Z, #H*#Z)
  FireEffect_Clear(0)
  Repeat
    Select WaitWindowEvent(1)
      Case #PB_Event_Gadget
        Select EventType()
          Case #PB_EventType_MouseWheel: FireEffect_Pow()
          Case #PB_EventType_LeftClick:  FireEffect_Clear(255)
          Case #PB_EventType_RightClick: FireEffect_Clear(0)
        EndSelect
      Case #PB_Event_CloseWindow
        Break
    EndSelect
    FireEffect_Update()
  ForEver
EndIf

;====================================

[davido]

@Flype,
Very nice.
One hell of a fire, though.

[heartbone]

Nice effect.

[dige]

Cool!

[Flype]

With a more appropriate palette, the fire effect is much better :

Code: Select all

EnableExplicit

#W = 200
#H = 150
#Z = 2

Define x, y, i
Dim cmap.l(256)
Dim pix.l(#W+2, #H+2)

For i = 0 To 31
  cmap(i +   0) = RGB(     0,      0,         i << 1)
  cmap(i +  32) = RGB(i << 3,      0,  64 - (i << 1))
  cmap(i +  64) = RGB(   255, i << 3,              0)
  cmap(i +  96) = RGB(   255,    255,         i << 2)
  cmap(i + 128) = RGB(   255,    255,  64 + (i << 2))
  cmap(i + 160) = RGB(   255,    255, 128 + (i << 2))
  cmap(i + 192) = RGB(   255,    255,        192 + i)
  cmap(i + 224) = RGB(   255,    255,        224 + i)
Next

If OpenWindow(0, 0, 0, #W*#Z, #H*#Z, "Fire Effect", #PB_Window_SystemMenu|#PB_Window_ScreenCentered)
  CanvasGadget(0, 0, 0, #W*#Z, #H*#Z)
  Repeat
    pix(Random(#W, 0), #H+2) = Random(255, 0)
    pix(Random(#W, 0), #H+2) = Random(255, 0)
    pix(Random(#W, 0), #H+2) = Random(255, 0)
    For y = 0 To #H + 1
      For x = 1 To #W - 1
        pix(x, y) = (pix(x-1, y) + pix(x+1, y) + pix(x, y+1) + pix(x, y+1)) >> 2
      Next
    Next
    StartDrawing(CanvasOutput(0))
    For y = 0 To #H - 1
      For x = 0 To #W - 1
        Box(x*#Z, y*#Z, #Z, #Z, cmap(pix(x, y)))
      Next
    Next
    StopDrawing()
  Until WaitWindowEvent(1) = #PB_Event_CloseWindow
EndIf

[VB6_to_PBx]

With a more appropriate palette, the fire effect is much better :

i agree , much more realistic effect

[Kukulkan]

Very nice!

[Little John]

With a more appropriate palette, the fire effect is much better :

Yep.
Very cool ... uh ... hot!

[Flype]

Wants to see this effect on Amiga

Ok, here we go :

1st try in C :

https://www.youtube.com/watch?v=44xO2e0YhoA

2nd try in C + M68K ASM optimized parts :

https://www.youtube.com/watch?v=qJFKT97FPKo

Written on Amiga 600 + Vampire accel board.

[skywalk]

Awesome. Add sound and a log below