Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: Clyde on June 22, 2009
-
Hey ho!
made this a few days ago, hope its usefull and sheds some light for you ;)
'
' 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.]
-
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:
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.
-
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.
-
Nice work Clyde - I love fire . . . ;)
It is a routine that I have tried so many times and failed miserably! Well done!
DrewPee
-
Heres an idea to get you going along the right path..
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 :)
-
N1, Clyde dude.
-
Thanks to all!!! ++ Karma for pointing me in that direction! :D
-
Nice fx! I think if you follow Shockwave's code pattern you can do that entire update_fire routine without a single multiply.
Jim
-
Just to add one more little optimization: multiplies by 2 can be replaced by shl 1.
-
very good Clyde... ;)
Keep on going..... i like that..
and thanx for sharing the source!!
-
You know how much I love fire effects, and this one's fantastic :D
-
Cheers Dudes & Yuppies!
Will have to put this on my lengthy 'Thing to Do in C before I kick the bucket' list.