`CODE BASED ON:
`   http://2dnow.zenzer.net/viewarticle.php?a=10
set display mode 1280, 1024, 32
sync on
sync rate 0
 
`Define the required constants for the fire
#constant MAX_CHANGES          6
#constant SECTOR_WIDTH         128
#constant SECTOR_HEIGHT        128
#constant COOLING_RATE         1
#constant NUM_COALS_PER_UPDATE 1
#constant UPDATE_RATE          20
global SPARK_HEAT = 192
 
#constant MEMBLOCK_ID   1
#constant IMAGE_ID      1
 
 
`Define image
dim FireData(SECTOR_WIDTH, SECTOR_HEIGHT)
for x = 0 to SECTOR_WIDTH-1
   for y = 0 to SECTOR_HEIGHT-1
      FireData(x, y) = 0
   next y
next x
 
 
 
`Create a memblock for it
make memblock MEMBLOCK_ID, 12 + (SECTOR_WIDTH * SECTOR_HEIGHT * 4)
write memblock dword 1, 0, SECTOR_WIDTH
write memblock dword 1, 4, SECTOR_HEIGHT
write memblock dword 1, 8, 32
 
 
 
 
`Define Flame Colors
Type FireColour
   Red
   Green
   Blue
   Alpha
   Temperature as Byte
EndType
Dim ColourChanges(MAX_CHANGES) as FireColour
 
ColourChanges(0).Red = 255
ColourChanges(0).Green = 255
ColourChanges(0).Blue = 255
ColourChanges(0).Alpha = 255
ColourChanges(0).Temperature = 255
 
 
ColourChanges(1).Red = 255
ColourChanges(1).Green = 255
ColourChanges(1).Blue = 0
ColourChanges(1).Alpha = 160
ColourChanges(1).Temperature = 64
 
 
ColourChanges(2).Red = 255
ColourChanges(2).Green = 128
ColourChanges(2).Blue = 0
ColourChanges(2).Alpha = 160
ColourChanges(2).Temperature = 48
 
 
ColourChanges(3).Red = 128
ColourChanges(3).Green = 64
ColourChanges(3).Blue = 64
ColourChanges(3).Alpha = 128
ColourChanges(3).Temperature = 32
 
 
ColourChanges(4).Red = 64
ColourChanges(4).Green = 32
ColourChanges(4).Blue = 0
ColourChanges(4).Alpha = 64
ColourChanges(4).Temperature = 16
 
 
ColourChanges(5).Red = 0
ColourChanges(5).Green = 0
ColourChanges(5).Blue = 0
ColourChanges(5).Alpha = 0
ColourChanges(5).Temperature = 0
 
`Create the fire color interpolation
currentC as FireColour
nextC as FireColour
CurrentEntry = 255
r as byte
g as byte
b as byte
 
Dim FireColours(255) as DWORD
for i = 0 to 4
   currentC = ColourChanges(i)
   nextC = ColourChanges(i+1)
   for j = currentC.Temperature to nextC.Temperature + 1 step -1
      interpFactor# = (currentC.Temperature - CurrentEntry) / (1.0 * (currentC.Temperature - nextC.Temperature))
      r = currentC.Red   + (nextC.Red   - currentC.Red)   * interpFactor#
      g = currentC.Green + (nextC.Green - currentC.Green) * interpFactor#
      b = currentC.Blue  + (nextC.Blue  - currentC.Blue)  * interpFactor#
      a = currentC.Alpha + (nextC.Alpha - currentC.Alpha) * interpFactor#
      FireColours(CurrentEntry) = rgba(r, g, b, a)
      dec CurrentEntry
   next j
next i
 
 
 
 
make object plain 1, 2, 1
position object 1, 0.0, 0.5, 0.0
point object    1, 0.0, 0.5, 1.0
set object transparency 1, 3
set object light 1, 0
UpdateFire()
texture object 1, 1
 
 
 
`Create a room
`left wall to fire
make object box 100,  3.0, 4.0, 1.0
position object 100, -2.5, 2.0, 0.0
 
`right wall to fire
make object box 101, 3.0, 4.0, 1.0
position object 101, 2.5, 2.0, 0.0
 
`top wall above fire
make object box 102, 2.0, 3.0, 1.0
position object 102, 0.0, 2.5, 0.0
`back of fire
make object box 103, 2.0, 1.0, 0.25
position object 103, 0.0, 0.5, -0.375
 
 
`make floor
make object plain 110, 8.0, 11.0
position object   110, 0.0, 0.0, 5.0
point object      110, 0.0, 1.0, 5.0
 
 
`make other walls
make object box 120, 10.0, 4.0, 1.0
position object 120, -3.5, 2.0, 5.0
point object    120,  0.0, 2.0, 5.0
 
make object box 121, 10.0, 4.0, 1.0
position object 121,  3.5, 2.0, 5.0
point object    121,  0.0, 2.0, 5.0
 
 
 
 
 
 
`Make a tree
#CONSTANT tX 256
#CONSTANT tY 256
make memblock 2, 12 + (tX * tY * 4)
write memblock dword 2, 0, tX
write memblock dword 2, 4, tY
write memblock dword 2, 8, 32
for x = 0 to tX-1
   for y = 0 to tY-1
      write memblock dword 2, 12 + ((x + (y*tX))*4), rgba(64,    192 + rnd(63),    64,   128 + rnd(96))
   next y
next x
make image from memblock 2, 2
delete memblock 2
make object cone 2, 1
scale object 2, 100, 200, 100
texture object 2, 2
set object transparency 2, 3
position object 2, 2, 1, 4
 
 
 
 
 
 
 
 
 
 
autocam off
CAM_D# = 10.0
CAM_A# = 0.0
CAM_Cx# = object size z(110) * 0.5
CAM_Cz# = object size y(110) * 0.5
gosub POSITION_CAMERA
 
 
 
 
 
 
set point light 0, 0, 1.0, 1.0
global LIGHT_COLOR as DWORD
 
`Start the firedrawing!!
frameTime# = 1.0
startTime = timer()
FLAME_UPDATE# = 0
do
   frameTime# = (frameTime# * 0.8) + ((timer() - startTime) * 0.2)
   startTime = timer()
 
   CAM_A# = sin(timer() * 0.0225) * 30.0
   gosub POSITION_CAMERA
 
 
   text 0, 0, "FPS: " + str$(screen fps())
   text 0, 10, "Flame heat: " + str$(SPARK_HEAT)
 
   y = SECTOR_HEIGHT - ((SPARK_HEAT * SECTOR_HEIGHT) / 756)
   text 0, 20, "Y: " + str$(y)
   LIGHT_COLOR = FireColours(FireData(SECTOR_WIDTH / 2, y))
   color light 0, LIGHT_COLOR
 
 
 
 
   z = mousemovez()
   if SPARK_HEAT < 250 AND z > 0 then inc SPARK_HEAT, 5
   if SPARK_HEAT > 5   AND z < 0 then dec SPARK_HEAT, 5
 
   if FLAME_UPDATE# >= UPDATE_RATE
      UpdateFire()
      FLAME_UPDATE# = 0
   else
      inc FLAME_UPDATE#, frameTime#
   endif
   sync
loop
 
 
 
POSITION_CAMERA:
   position camera CAM_Cx# + (sin(CAM_A#) * CAM_D#),      8,      CAM_Cz# + (cos(CAM_A#) * CAM_D#)
   point camera CAM_Cx#, 0, CAM_Cz#
return
 
 
 
 
 
 
 
 
 
 
 
function UpdateFire()
   Dim FireDataCopy(SECTOR_WIDTH, SECTOR_HEIGHT)
`   clr as byte
 
   for x = 0 to SECTOR_WIDTH - 2
      for y = 0 to SECTOR_HEIGHT - 2
         clr = FireData(x, y)
         write memblock dword 1, 12 + ((y * SECTOR_WIDTH) + x) * 4, FireColours(clr)
         FireDataCopy(x, y) = clr
      next y
   next x
   make image from memblock 1, 1
 
 
   `Scroll the flame
   for x = 0 to SECTOR_WIDTH - 1
      for y = 0 to SECTOR_HEIGHT - 2
         FireDataCopy(x, y) = FireDataCopy(x, y + 1)
      next y
   next x
 
 
   `Create sparks
   for y = SECTOR_HEIGHT - 4 to SECTOR_HEIGHT -2
      for x = 1 to SECTOR_WIDTH - 2
         FireDataCopy(x, y) = rand() * SPARK_HEAT
      next x
   next y
 
 
   `Create coals
   y = SECTOR_HEIGHT -2
   For i = 0 to NUM_COALS_PER_UPDATE -1
      x = rand() * (SECTOR_WIDTH - 2)
 
      FireDataCopy(x - 1, y - 1) = 255
      FireDataCopy(x - 1, y    ) = 255
      FireDataCopy(x - 1, y + 1) = 255
      FireDataCopy(x    , y - 1) = 255
      FireDataCopy(x    , y    ) = 255
      FireDataCopy(x    , y + 1) = 255
      FireDataCopy(x + 1, y - 1) = 255
      FireDataCopy(x + 1, y    ) = 255
      FireDataCopy(x + 1, y + 1) = 255
   next i
 
 
 
   `Blur the image
   for x = 1 to SECTOR_WIDTH - 1
      for y = 1 to SECTOR_HEIGHT -1
         clr = (_
                  FireDataCopy(x - 1, y    ) +_
                  FireDataCopy(x + 1, y    ) +_
                  FireDataCopy(x    , y - 1) +_
                  FireDataCopy(x    , y + 1) +_
                  FireDataCopy(x - 1, y - 1) +_
                  FireDataCopy(x - 1, y + 1) +_
                  FireDataCopy(x + 1, y - 1) +_
                  FireDataCopy(x + 1, y + 1)  _
                ) / 8.0
 
         if clr >= COOLING_RATE then dec clr, COOLING_RATE
 
         FireData(x, y) = clr
      next y
   next x
endfunction
 
 
function rand()
   rndVal# = rnd(1000000) / 1000000.0
endfunction rndVal#
 
function rgba(r as integer,g as integer,b as integer,a as integer)
  colour as dword
  colour = (b)+(g*256)+(r*65536)+(a*16777216)
endfunction colour