[TINY PTC_EXT] Fire Routine

[Clyde]

Hey ho!

made this a few days ago, hope its usefull and sheds some light for you

Code Select Expand


'
' f-i-r-e  r-o-u-t-i-n-e.
' f-r-o-m  c-l-y-d-e.
'
' p-r-e-s-s  k-e-y-s  o-n-e  o-r  t-w-o,
' f-o-r  a-l-t-e-r-i-n-g  m-e-t-h-o-d-s.
'
option explicit
option static

#include once "tinyptc_ext.bi"

const as integer XRES=640
const as integer YRES=480
const as integer ARES=XRES*YRES

const as integer XRES2=XRES/2
const as integer YRES2=YRES/2
const as integer ARES2=XRES2*YRES2

declare sub create_palette                          ( byval red_inc         as integer,_
                                                     byval grn_inc         as integer,_
                                                     byval blu_inc         as integer )
                           
declare sub clear_screen                            ( byval colour          as uinteger=&H000000 )
declare sub fuel_the_fire_method1                   ()
declare sub fuel_the_fire_method2                   ( byval fire_portions   as integer=1 )
declare sub initialize_fire_routine                 ()
declare sub mr_mouse_gets_a_tad_hot_under_the_collar()
declare sub run_fire_routine                        ()
declare sub update_fire                             ()

declare function keyhit                             ( byval keychar         as integer ) as integer

declare function random_int                         ( byval val1            as integer=0,_
                                                     byval val2            as integer   ) as integer

dim shared as uinteger screen_buffer ( 0 to ARES-1  ),_
                      fire_buffer   ( 0 to ARES2-1 ),_
                      palette_buffer( 0 to 255 )

dim shared as integer cool_down


initialize_fire_routine()
run_fire_routine()
ptc_close()
end


sub clear_screen( byval colour as uinteger=&H000000 )
   
   dim as integer a

   for a=0 to ARES2-1
       screen_buffer( a       )=colour
       screen_buffer( a+ARES2 )=colour
   next

end sub


sub create_palette( byval red_inc as integer, byval grn_inc as integer, byval blu_inc as integer )

   dim as integer x,y,a
   dim as integer red, grn, blu
   
   for a=0 to 255
       
       red+=red_inc
       grn+=grn_inc
       blu+=blu_inc
       
       if red>255 then red=255
       if grn>255 then grn=255
       if blu>255 then blu=255
       
       palette_buffer( a )=( red shl 16 ) or ( grn shl 8 ) or blu
   
   next

end sub


sub fuel_the_fire_method1()

   dim as integer x
   
   for x = 2 to XRES2 - 2
       fire_buffer   ( x+( YRES2-2 )*XRES2 )+= random_int( ,178 )
       if fire_buffer( x+( YRES2-2 )*XRES2 )>=255 then fire_buffer( x+( YRES2-2 )*XRES2 )=255
   next
   
end sub

sub fuel_the_fire_method2( byval fire_portions as integer=2 )

   dim as integer x,xx
   
   For x = 1 To XRES2 - 2 Step fire_portions

fire_buffer( x+( YRES2-1 )*XRES2 ) = random_int( ,064 )
fire_buffer( x+( YRES2-2 )*XRES2 ) = random_int( ,128 )
fire_buffer( x+( YRES2-3 )*XRES2 ) = random_int( ,255 )

       '
' Create chunks of colors, it looks better
'
For xx = 1 To fire_portions-2
           
           fire_buffer(( x+xx )+( YRES2-1 )*XRES2 ) = fire_buffer( x+( YRES2-1 )*XRES2 )
           fire_buffer(( x+xx )+( YRES2-2 )*XRES2 ) = fire_buffer( x+( YRES2-2 )*XRES2 )
fire_buffer(( x+xx )+( YRES2-3 )*XRES2 ) = fire_buffer( x+( YRES2-3 )*XRES2 )

       next
next
   
end sub


sub initialize_fire_routine()

   ptc_allowclose(1)
   ptc_setdialog(0,"",0,1)
   ptc_open( "oUcH!!", XRES, YRES )
   
   create_palette( 5, 3, 2 )
   
   cool_down=1
   
end sub


sub mr_mouse_gets_a_tad_hot_under_the_collar()
   
   dim as integer mousex, mousey
   
   mousex=ptc_getmousex()
   if mousex<1         then mousex=1
   if mousex>XRES2-2   then mousex=XRES2-2
       
   mousey=ptc_getmousey()
   if mousey<1         then mousey=1
   if mousey>YRES2-2   then mousey=YRES2-2
       
   fire_buffer( mousex + mousey * XRES2 )+=random_int(164,255)
   if fire_buffer( mousex + mousey * XRES2 )>255 then fire_buffer( mousex + mousey * XRES2 )=255
   
   
end sub


sub run_fire_routine()
   
   dim as integer fire_method
   
   while inkey<>chr(27)
       
       clear_screen()
       
       select case as const fire_method
       
           case 0: fuel_the_fire_method1()
           case 1: fuel_the_fire_method2()
       
       end select
       
       if keyhit( VK_1 )=true then fire_method=0
       if keyhit( VK_2 )=true then fire_method=1
       
       'mr_mouse_gets_a_tad_hot_under_the_collar()
       
       update_fire()
       
       ptc_update @screen_buffer(0)
       
   wend
   
end sub


sub update_fire()
   
   dim as integer x,y, avg
   dim as uinteger col
   
   for y=1 to YRES2-2
       for x=1 to XRES2-2
           
           avg=(( fire_buffer(( x-1 )+( y+0 )*XRES2 )+ _
                  fire_buffer(( x+1 )+( y+0 )*XRES2 )+ _
                  fire_buffer(( x+0 )+( y+1 )*XRES2 )+ _
                  fire_buffer(( x+0 )+( y-1 )*XRES2 )) /4 ) - cool_down
           
           if avg<0 then avg=0
           
           fire_buffer( x+( y+0 )*XRES2 )=avg
           fire_buffer( x+( y-1 )*XRES2 )=avg

           col=palette_buffer( avg )
           
           if col>0 then
               screen_buffer(( x*2+0 )+( y*2+0 )*XRES )=col
               screen_buffer(( x*2+0 )+( y*2+1 )*XRES )=col
               screen_buffer(( x*2+1 )+( y*2+0 )*XRES )=col
               screen_buffer(( x*2+1 )+( y*2+1 )*XRES )=col
           end if
           
       next
   next
   
end sub


function keyhit( byval keychar as integer ) as integer
   
   if (getasynckeystate(keychar) = -32767) then
       return true
   else
       return false
   end if
       
end function


function random_int( byval val1 as integer=0,_
                    byval val2 as integer   ) as integer
   
   dim as integer range = abs( val1-val2 )
   
   return ( int(rnd( 1 )*range )+val1 )

end function


[Edit ~ Added Meaningful Topic Title - sw.]

[Shockwave]

Thanks for posting the code Clyde, sadly I can't run it here (I am at work on my lunch break)
There are some easy optimisations you can make to this code, remember that you are doing lots of calculations per pixel the following sub is where most speed would be lost:

Code Select Expand


sub update_fire()
   
    dim as integer x,y, avg
    dim as uinteger col
   
    for y=1 to YRES2-2
        for x=1 to XRES2-2
           
            avg=(( fire_buffer(( x-1 )+( y+0 )*XRES2 )+ _
                   fire_buffer(( x+1 )+( y+0 )*XRES2 )+ _
                   fire_buffer(( x+0 )+( y+1 )*XRES2 )+ _
                   fire_buffer(( x+0 )+( y-1 )*XRES2 )) /4 ) - cool_down
           
            if avg<0 then avg=0
           
            fire_buffer( x+( y+0 )*XRES2 )=avg
            fire_buffer( x+( y-1 )*XRES2 )=avg

            col=palette_buffer( avg )
           
            if col>0 then
                screen_buffer(( x*2+0 )+( y*2+0 )*XRES )=col
                screen_buffer(( x*2+0 )+( y*2+1 )*XRES )=col
                screen_buffer(( x*2+1 )+( y*2+0 )*XRES )=col
                screen_buffer(( x*2+1 )+( y*2+1 )*XRES )=col
            end if
           
        next
    next
   
end sub


This would be a prime candidate to use pointers to save yourself (potentially) a few hundred thousand calculations per frame.
If it's not been done by the time I get hope I will look at optimising it for you.

[Clyde]

Thanks dude, also I didnt know what I had for a topic title after the [TINY PTC_EXT], I posted on the fly for dashing out to for me bus. perhaps that was all I had put, oooops.

I was thinking of having a go at adding Hugo Ellis's Fire method, but Im not too hot on what Im supposed to be adding his routines into. but that's for another day, maybe some ones done it before, and may post that seperately.

I'll keep an eye out for the optimizing; great help and asset.

Cheers and all the very best,
Clyde.

[DrewPee]

Nice work Clyde - I love fire . . .
It is a routine that I have tried so many times and failed miserably! Well done!

DrewPee

[Shockwave]

Heres an idea to get you going along the right path..

Code Select Expand


sub update_fire()
   
    dim as integer x,y, avg
    dim as uinteger col
   
    dim as uinteger ptr pp1,pp2,pp3,pp4
   
   
    for y=1 to YRES2-2
               
            pp1=@fire_buffer( (y*XRES2)   )
            pp2=@fire_buffer( (y*XRES2) +2 )
            pp3=@fire_buffer( ((y-1)*XRES2)+1 )
            pp4=@fire_buffer( ((y+1)*XRES2)+1 )

        for x=1 to XRES2-2
           
            avg=(( *pp1+*pp2+*pp3+*pp4) shr 2 ) - cool_down
            pp1+=1
            pp2+=1
            pp3+=1
            pp4+=1
           
            if avg<0 then avg=0
           
            fire_buffer( x+( y+0 )*XRES2 )=avg
            fire_buffer( x+( y-1 )*XRES2 )=avg

            col=palette_buffer( avg )
           
            if col>0 then
               
                screen_buffer(( x*2+0 )+( y*2+0 )*XRES )=col
                screen_buffer(( x*2+0 )+( y*2+1 )*XRES )=col
                screen_buffer(( x*2+1 )+( y*2+0 )*XRES )=col
                screen_buffer(( x*2+1 )+( y*2+1 )*XRES )=col
            end if
           
        next
    next
   
end sub


I see that you are actually doubling the resolutions and rendering the fire as chunky pixels, hopefully with the optimisation you can have higher resolution fire

[benny!]

N1, Clyde dude.

[Clyde]

Thanks to all!!! ++ Karma for pointing me in that direction!

[Jim]

Nice fx!  I think if you follow Shockwave's code pattern you can do that entire update_fire routine without a single multiply.

Jim

[rdc]

Just to add one more little optimization: multiplies by 2 can be replaced by shl 1.

[energy]

very good Clyde...
Keep on going..... i like that..
and thanx for sharing the source!!

[ferris]

You know how much I love fire effects, and this one's fantastic

[Clyde]

Cheers Dudes & Yuppies!
Will have to put this on my lengthy 'Thing to Do in C before I kick the bucket' list.