' Code adapted from http://fabiensanglard.net/doom_fire_psx/index.html and slightly modified

uses "ui"

type DoomPsxFire

  fire_width  as int32
  fire_height as int32

  palette(37) as int32  ' Holds palette of fire colors
  fire()      as Int32  ' Holds indices referencing the paletter

  function _Create(fire_width as int32, fire_height as int32)
    me.fire_width  = fire_width
    me.fire_height = fire_height
    
    me.palette(1)  = bgr(0x07,0x07,0x07), bgr(0x1F,0x07,0x07), bgr(0x2F,0x0F,0x07), bgr(0x47,0x0F,0x07), bgr(0x57,0x17,0x07), bgr(0x67,0x1F,0x07),
                     bgr(0x77,0x1F,0x07), bgr(0x8F,0x27,0x07), bgr(0x9F,0x2F,0x07), bgr(0xAF,0x3F,0x07), bgr(0xBF,0x47,0x07), bgr(0xC7,0x47,0x07),
                     bgr(0xDF,0x4F,0x07), bgr(0xDF,0x57,0x07), bgr(0xDF,0x57,0x07), bgr(0xD7,0x5F,0x07), bgr(0xD7,0x5F,0x07), bgr(0xD7,0x67,0x0F),
                     bgr(0xCF,0x6F,0x0F), bgr(0xCF,0x77,0x0F), bgr(0xCF,0x7F,0x0F), bgr(0xCF,0x87,0x17), bgr(0xC7,0x87,0x17), bgr(0xC7,0x8F,0x17),
                     bgr(0xC7,0x97,0x1F), bgr(0xBF,0x9F,0x1F), bgr(0xBF,0x9F,0x1F), bgr(0xBF,0xA7,0x27), bgr(0xBF,0xA7,0x27), bgr(0xBF,0xAF,0x2F),
                     bgr(0xB7,0xAF,0x2F), bgr(0xB7,0xB7,0x2F), bgr(0xB7,0xB7,0x37), bgr(0xCF,0xCF,0x6F), bgr(0xDF,0xDF,0x9F), bgr(0xEF,0xEF,0xC7), bgr(0xFF,0xFF,0xFF)
    
    redim me.fire(me.fire_width*me.fire_height)
    
    int32 i
    
    ' Initialize screen
    for i = 1 to me.fire_width
      me.fire(i) = 37 ' Initial color, just for one row
    next
    
    for i = me.fire_width+1 to me.fire_width*me.fire_height
      me.fire(i) = 1  ' Background color
    next
  end function
  
  function DoFire()
    int32 x, y
    for x = 1 to me.fire_width
      for y = 1 to me.fire_height-1
        me.SpreadFire((y-1) * me.fire_width + x)
      Next
    Next
  end function
  
  ' --
  
  function SpreadFire(src as int32)
    int32 rand = rnd(0, 3) and 3
    int32 target_pixel = minMax(src + rand - 2 + me.FIRE_WIDTH, 1, ubound(me.fire))
    me.fire(target_pixel) = minmax(me.fire(src) - (rand and 1), 1, 37)
  end function
  
  function GetBitmap() as String
    dim trueColors(me.fire_width * me.fire_height) as Int32
    
    int32 fire_index, true_color_index
    int32 fire_color_index
    
    ' We need to convert palette colors to real colors
    for fire_index = ubound(me.fire) to 1 step -1
        fire_color_index = me.fire(fire_index)

        incr true_color_index
        trueColors(true_color_index) = me.palette(fire_color_index)
    next

    ' Once the conversion is done, we lick part of the memory to get bitmap
    return peek$(VarPtr(trueColors(1)), sizeof(int32) * countof(trueColors))
  end function

end type

%FIRE_WIDTH  = 128
%FIRE_HEIGHT = 96

function TBMain()

  uint32 hCanvas = Canvas_Window("Doom PSX Fire", 100, 100, %FIRE_WIDTH, %FIRE_HEIGHT)
  Canvas_attach(hCanvas, 0, FALSE)

  dim doom as DoomPsxFire(%FIRE_WIDTH, %FIRE_HEIGHT)

  while IsWindow(hCanvas)

    doom.DoFire()
    
    Canvas_BitmapSet(doom.GetBitmap(), %FIRE_WIDTH, %FIRE_HEIGHT)
    Canvas_Redraw
    
  wend
   
  Canvas_Window End
  
end Function
