heres something ive never tried before,
this is what a couple of hours bored this afternoon produced.
have fun and excuse the messy slow code.
'fire works demo by nino coded on 15 july '06
'have fun'
defint a-z
'$include: 'tinyptc.bi'
const SCR_WIDTH = 640
const SCR_HEIGHT = 480
const SCR_SIZE = SCR_WIDTH*SCR_HEIGHT
RANDOMIZE TIMER
Type partical
partical_x as double
partical_y as double
partical_x_direction as double
partical_y_direction as double
partical_color as double
End Type
Type firework
x as double
y as integer
r as double
dist as double
bloom_switch as double
init_speed as double
frames as double
firework_color as double
firework_bloom(250) as partical
End Type
'raise or lower the fireworks number to how ever many fireworks you wish
dim shared fireworks(10) as firework
dim shared buffer( 0 to SCR_SIZE-1 ) as integer
declare function smooth( screen_ptr() )
declare function put_ptc_pixel( screen_ptr() , byval x as integer ,byval y as integer ,byval col as integer)
declare function explode(fireworks as firework)
declare function draw_and_animate_firework(fireworks as firework)
declare function flush_partical_buffer(fireworks as firework)
ptc_open( "freeBASIC v0.01 - tinyPTC test", SCR_WIDTH, SCR_HEIGHT )
for x=0 to ubound(fireworks)
fireworks(x).x = 50 + int(rnd(1)*540)
fireworks(x).y = 480
fireworks(x).r = 40+int(rnd(1) * 40)
fireworks(x).dist = 100+int(rnd(1)*300)
fireworks(x).bloom_switch = 0
fireworks(x).init_speed = 1+int(rnd(1)*4)
fireworks(x).frames = 40+int(rnd(1)*100)
'firework color 1 = red 2 = green 3 = blue 4 = white 5 = randome
fireworks(x).firework_color = 1+int(rnd(1)*5)
next
do
for x=0 to ubound(fireworks)
if ( SCR_HEIGHT - fireworks(x).y ) >= fireworks(x).dist then
if fireworks(x).bloom_switch = 0 then
explode fireworks(x)
fireworks(x).bloom_switch = 1
else
fireworks(x).frames = fireworks(x).frames - 1
draw_and_animate_firework fireworks(x)
if fireworks(x).frames <= 1 then
flush_partical_buffer fireworks(x)
fireworks(x).r = 40+int(rnd(1) * 40)
fireworks(x).bloom_switch = 0
fireworks(x).dist = 100+int(rnd(1)*300)
fireworks(x).x = 50 + int(rnd(1)*540)
fireworks(x).init_speed = 1+int(rnd(1)*4)
fireworks(x).y = 480
fireworks(x).frames = 40+int(rnd(1)*100)
fireworks(x).firework_color = 1+int(rnd(1)*5)
end if
endif
else
fireworks(x).y = fireworks(x).y - fireworks(x).init_speed
if fireworks(x).firework_color = 1 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(255,0,0)
elseif fireworks(x).firework_color = 2 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(0,255,0)
elseif fireworks(x).firework_color = 3 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(0,0,255)
elseif fireworks(x).firework_color = 4 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(255,255,255)
elseif fireworks(x).firework_color = 5 then
put_ptc_pixel buffer() , fireworks(x).x , fireworks(x).y , rgb(255,0,255)
endif
endif
next
smooth buffer()
ptc_update @buffer(0)
loop until( inkey$ = chr$( 27 ) )
ptc_close
function explode(fireworks as firework)
dim r2 as double
dim z as double
dim w as double
dim fireworksize as integer
dim partical_speed as double
r2 = ( fireworks.r * fireworks.r )
for z = -fireworks.r to fireworks.r
w=sqr( r2 - z * z )
fireworks.firework_bloom(fireworksize).partical_x = ( fireworks.x-w ) + ( RND( 1 ) * ( w * 2 ) )
fireworks.firework_bloom(fireworksize).partical_y = z+fireworks.y
if fireworks.firework_bloom(fireworksize).partical_x < fireworks.x then
partical_speed = ( fireworks.x - fireworks.firework_bloom(fireworksize).partical_x )/50
fireworks.firework_bloom(fireworksize).partical_x_direction = -partical_speed
elseif fireworks.firework_bloom(fireworksize).partical_x > fireworks.x then
partical_speed = ( fireworks.firework_bloom(fireworksize).partical_x - fireworks.x )
fireworks.firework_bloom(fireworksize).partical_x_direction = partical_speed/50
endif
fireworks.firework_bloom(fireworksize).partical_y_direction = z/50
if fireworks.firework_color = 1 then
fireworks.firework_bloom(fireworksize).partical_color = rgb(255,0,0)
elseif fireworks.firework_color = 2 then
fireworks.firework_bloom(fireworksize).partical_color = rgb(0,255,0)
elseif fireworks.firework_color = 3 then
fireworks.firework_bloom(fireworksize).partical_color = rgb(0,0,255)
elseif fireworks.firework_color = 4 then
fireworks.firework_bloom(fireworksize).partical_color = rgb(255,255,255)
elseif fireworks.firework_color = 5 then
fireworks.firework_bloom(fireworksize).partical_color = rgb( int( rnd(1) * 255 ) , int( rnd(1) * 255 ) , int( rnd(1) * 255 ) )
endif
fireworksize = fireworksize + 1
next
end function
function draw_and_animate_firework(fireworks as firework)
dim x as integer
for x=0 to ubound(fireworks.firework_bloom)
fireworks.firework_bloom(x).partical_x = fireworks.firework_bloom(x).partical_x + fireworks.firework_bloom(x).partical_x_direction
fireworks.firework_bloom(x).partical_y = fireworks.firework_bloom(x).partical_y + fireworks.firework_bloom(x).partical_y_direction
put_ptc_pixel buffer() , fireworks.firework_bloom(x).partical_x , fireworks.firework_bloom(x).partical_y , fireworks.firework_bloom(x).partical_color
next
end function
function flush_partical_buffer(fireworks as firework)
for x=0 to ubound(fireworks.firework_bloom)
fireworks.firework_bloom(x).partical_x = 0
fireworks.firework_bloom(x).partical_x_direction = 0
fireworks.firework_bloom(x).partical_y = 0
fireworks.firework_bloom(x).partical_y_direction = 0
fireworks.firework_bloom(x).partical_color =0
next
end function
function put_ptc_pixel(screen_ptr(),byval x as integer ,byval y as integer ,byval col as integer)
if x<4 or x>SCR_WIDTH-4 then exit function
if y<4 or y>SCR_HEIGHT-4 then exit function
screen_ptr(y*SCR_WIDTH+x) = col
screen_ptr((y+1)*SCR_WIDTH+x) = col
screen_ptr((y-1)*SCR_WIDTH+x) = col
screen_ptr(y*SCR_WIDTH+(x+1)) = col
screen_ptr(y*SCR_WIDTH+(x-1)) = col
screen_ptr((y+1)*SCR_WIDTH+(x+1)) = col
screen_ptr((y+1)*SCR_WIDTH+(x-1)) = col
screen_ptr((y-1)*SCR_WIDTH+(x+1)) = col
screen_ptr((y-1)*SCR_WIDTH+(x-1)) = col
end function
function smooth( screen_ptr())
dim maxpixel as integer
dim offset as integer
dim pixel as unsigned integer
dim r as integer
dim g as integer
dim b as integer
dim nr as integer
dim ng as integer
dim nb as integer
maxpixel = ubound(buffer)
for offset = SCR_WIDTH to maxpixel - SCR_WIDTH
pixel = buffer(offset-1)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = r shr 2
ng = g shr 2
nb = b shr 2
pixel = buffer(offset+1)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = nr + ( r shr 2 )
ng = ng + ( g shr 2 )
nb = nb + ( b shr 2 )
pixel = buffer(offset+SCR_WIDTH)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = nr + ( r shr 2 )
ng = ng + ( g shr 2 )
nb = nb + ( b shr 2 )
pixel = buffer(offset-SCR_WIDTH)
r = pixel shr 16
g = pixel shr 8 and 255
b = pixel and 255
nr = nr + ( r shr 2 )
ng = ng + ( g shr 2 )
nb = nb + ( b shr 2 )
buffer(offset) = nr shl 16 or ng shl 8 or nb
next i
end function
There's nothing messy about that code Nino :)
Nice effect, looks wicked! I think it would look even nicer if gravity affected the particles.
Very effective though and it ran fast and smooth.
That's neato mate!
I've always wondered how to send a type to a sub / function.
Cheers and all the very best,
Clyde.
Doesn't eork with .17b.
And the smooth funk looks the same as mine. :*)
cheers guys!
@relsoft
sorry relsoft i should have credited you for the smooth func i know how to do this effect but as it was just a mess around i grabed your func from the examples for quickness and i have an older version of freebasic so i dont know why it wouldnt work?
@shockwave
i was going to add gravity to the particles but didnt realy have enough time might give it a blast though.
Looks really cool! It runs under .17s, but not .17b. :)
No problem. Functions should have a return in 17b.
That looks really nice :) nice one Nino