OpenEuphoria

more fires...

• Posted by "BABOR, JIRI" <J.Babor at GNS.CRI.NZ> Jan 15, 1997
• 1533 views

Excuse me, but I want to inject a little bit of real life melodrama
into this forum. Tomorrow morning I shall be already in hospital for
the first of two quite dangerous operations - carotid endarterectomies
(look it up in your on-line 'Family Doctor', ignorant dummy!). The
attached piece is my parting shot. Do you remember the fiery Happy
Xmas message? If you thought that was cute, well, this is not going to
blow your sox off, but it's way, way better! It is also a present for
Michael Packard - he wanted a hires fire routine.    Enjoy!  Jiri

-- snip ------------------------------------------------------------------------
-- burn.ex
-- jiri babor
-- j.babor at gns.cri.nz
-- version 1.00   97-01-15

-- Usage:
--    include graphics.e
--    ...
--    set_fire_palette()
--    ...
--    burn(x1,y1,x2,y2)    - parameters specify a box on the screen.
--    ...
-- This vicious routine will destroy, by fire, anything and everything inside
-- the given box that is not of the background color...
-- Limitations:
--    It's designed for mode 13h (320x200x256) specifically.
--    It uses the top half of the palette (colors 128 to 255) for the fire.
-- Please, allow at least 50 pixel high space above the box for the flames.


include graphics.e

procedure set_fire_palette()
   sequence pal
   pal=repeat({0,0,0},256)
   -- save first half of current palette
   for i = 0 to 127 do
      pal[i+1]=palette(i,{0,0,0})
   end for
   -- yellow-red-slate fire palette
   for i = 1 to 16 do
      pal[i+128]=floor({i-1,(i-1)/2,(i-1)/2})
      pal[i+144]=floor({15+i,8-i/2,8-i/2})
   end for
   for i = 1 to 32 do
      pal[i+160]=floor({31+i,i-1,0})
      pal[i+192]=floor({63,31+i,i-1})
      pal[i+224]=floor({63,63,31+i})
   end for
   all_palette(pal)
end procedure

procedure burn(integer x1, integer y1, integer x2, integer y2)
   integer a, cc, cols, finished, n, p, rows, ymin
   sequence buff,csp

   -- initialize
   finished=0
   cols=x2-x1+3
   ymin=y1-50
   rows=y2-ymin+3
   buff=repeat(repeat(0,cols),rows)
   p=8                    -- average number of horizontal scans per vertical
                           -- pixel - decrease for a faster burn and vice versa
   csp=repeat(50,cols)     -- current seed (vertical) position - for a delayed
                           -- burn change to anything between 0 and 50
   a=#A0000+320*ymin+x1-1  -- address of top left corner fire buffer

   -- read the contents of the box into the buffer
   for r = 51 to rows-2 do
      buff[r]=peek({a+320*(r-1),cols})
   end for

   while not finished and get_key()=-1 do
      -- seed fire
      n=0
      for c = 2 to cols-1 do
         if rand(p)=1 and csp[c]<=rows then
            csp[c]=csp[c]+1
         end if
         if csp[c]<=rows then
            if buff[csp[c]][c] !=0 then
               buff[csp[c]-1][c]=127+rand(128)
               buff[csp[c]][c]=191+rand(64)
            end if
         else n=n+1
         end if
      end for
      finished=(n>=cols-2)

      -- do calcs
      for r = 2 to rows-1 do
         for c = 2 to cols-1 do
            if r<csp[c] then
               cc = floor((buff[r][c-1]+buff[r][c]+
                           buff[r][c+1]+buff[r+1][c])/4)
               if cc>128 then cc=cc-1        -- attenuation
               else cc=128 end if
               buff[r-1][c]=cc
            end if
         end for
      end for

      -- show buffer
      for r = 1 to rows-2 do
         poke(a+320*(r-1),buff[r])
      end for
   end while
end procedure

procedure burn_text(integer row, integer col, integer tcolor, sequence text)
   text_color(tcolor)
   position(row,col)
   puts(1,text)
   burn(8*(col-1),8*(row-1),8*(col+length(text)-1),8*row)
end procedure

-- example ---------------------------------------------------------------------

integer junk
junk = graphics_mode(19)

set_fire_palette()

text_color(9)
position(12,14)
puts(1,"VIVA EUPHORIA")

burn(101,82,210,100)
burn_text(15,13,YELLOW,"HAPPY NEW YEAR")

junk=graphics_mode(-1)