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

uses "ui"
uses "oxygen"
'
int32 p1,p2,p3,p4
o2_basic "uses doom_psx_fire.inc"
if o2_errno then
  msgbox 0,o2_error
  stop
else
  o2_exec
end if
declare sub finish() at p1
declare function render_fire(byval b as int32, pfr as int32, pcp as int32 , ptc as int32) as int32 at p2
declare function Do_Fire(byval me_fire_height as int32, byval me_fire_width as int32, byval ubound_me_fire as int32, me_fire as int32) at p3


%FIRE_WIDTH  = 512 '128
%FIRE_HEIGHT = 96

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
  fire(%FIRE_WIDTH * %FIRE_HEIGHT) as Int32 'static array

  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) 'dynamic array
    
    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()
    Do_Fire(me.fire_height, me.fire_width, ubound(me.fire), me.fire(1))
    '
    'int32 x, y
    'int32 src
    'int32 rand
    'int32 target_pixel
    '
    'for x = 1 to me.fire_width
    '  for y = 1 to me.fire_height-1
    '    'me.SpreadFire((y-1) * me.fire_width + x)
    '    src=(y-1) * me.fire_width + x
    '    'SpreadFire:
    '    rand = rnd(0, 3) and 3
    '    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)
    '  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
    
    render_fire(ubound(me.fire),me.fire(1),me.palette(1),trueColors(1))

    '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


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
  finish()
  
end Function
 