[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]

'
' 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]

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]

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.