Dark Bit Factory & Gravity
PROGRAMMING => Freebasic => Topic started by: docgen on March 25, 2007
-
Hi!
This is just a particletest.
Must say that I'm impressed from graphics-capabilities of FB
Just click a mousebutton
WARNING:Don't use middle mousebutton when/if you suffer from Epilepsia
EDIT: I "defused" the code a bit!
Greetings
stef
' Fireworks
' by stef
OPTION STATIC
OPTION EXPLICIT
CONST MAXPARTICLES=3600 '300;600;900;1500;3000; 6000; 12000;24000;48000
CONST SCREENW=800
CONST SCREENH=600
declare sub initparticles()
declare sub calcparticles()
declare sub drawparticles()
declare sub createcolours()
declare sub createstars()
declare sub drawstars()
dim shared grav as single =0.02
dim shared posx as integer
dim shared posy as integer
dim shared buttons as integer
dim shared col as integer
dim shared col_red as integer
dim shared col_green as integer
dim shared col_blue as integer=255
dim shared colfactor as integer =5 ' only: 1; 5; 15
dim shared counter as integer
dim shared mousestatus as integer
dim shared colourstatus as integer
type tstars
x as integer
y as integer
end type
type tparticles
x as single
y as single
dx as single
dy as single
size as integer
angle as single
speed as single
col as integer
end type
dim shared stars(100) as tstars
dim shared particle(MAXPARTICLES) as tparticles
SCREEN 19, 16, 2, 1
SCREENSET 1, 0
RANDOMIZE TIMER
Dim Im As Byte Ptr
Im = Imagecreate(SCREENW, SCREENH, RGB(5, 5, 5))
createstars()
DO
GETMOUSE posx, posy,, buttons
if buttons=0 then
'if not Bit(buttons, 0) THEN
mousestatus=0
endif
if mousestatus=0 then
IF Bit(buttons, 0) THEN
initparticles()
mousestatus=1
colourstatus=1
endif
IF Bit(buttons, 2) THEN
initparticles()
mousestatus=1
colourstatus=2
endif
IF Bit(buttons, 1) THEN
initparticles()
mousestatus=1
colourstatus=3
endif
endif
drawstars()
calcparticles()
drawparticles()
put (0,0),im,alpha,5
locate 1,1,0
print "click LM/RM/MM"
SCREENCOPY
LOOP UNTIL INKEY$=CHR$(27)
Imagedestroy Im
end
sub initparticles()
dim x as integer
for x= 0 to MAXPARTICLES
createcolours()
particle(x).col=rgb(col_red,col_green,col_blue)
particle(x).x=posx
particle(x).y=posy
particle(x).size=Rnd*3+1
particle(x).angle=(Rnd*360)*0.017453293
particle(x).speed=Rnd*5+0.1
particle(x).dx=sin(particle(x).angle)*particle(x).speed
particle(x).dy=cos(particle(x).angle)*particle(x).speed
next
end sub
sub calcparticles()
dim x as integer
if colourstatus= 1 then
createcolours()
col=rgb(col_red,col_green,col_blue)
endif
for x= 0 to MAXPARTICLES
if colourstatus= 2 then
createcolours()
col=rgb(col_red,col_green,col_blue)
particle(x).size=1
endif
if colourstatus<3 then
particle(x).col=col
endif
particle(x).x=particle(x).x+particle(x).dx
particle(x).y=particle(x).y+particle(x).dy
particle(x).dy=particle(x).dy+grav
next
end sub
sub drawparticles()
dim x as integer
for x= 0 to MAXPARTICLES
circle (particle(x).x,particle(x).y),particle(x).size,particle(x).col,,,,F
next
end sub
sub createcolours()
If col_red<255 And col_green =0 And col_blue =255 Then col_red=col_red+colfactor
If col_red=255 And col_green=0 And col_blue >0 Then col_blue=col_blue-colfactor
If col_red=255 And col_green < 255 And col_blue =0 Then col_green=col_green+colfactor
If col_red>0 And col_green = 255 And col_blue =0 Then col_red=col_red-colfactor
If col_red=0 And col_green = 255 And col_blue <255 Then col_blue=col_blue+colfactor
If col_red=0 And col_green >0 And col_blue =255 Then col_green=col_green-colfactor
end sub
sub drawstars()
dim c as integer
for counter =0 to 100
c=rnd*255
if c>127 then
circle (stars(counter).x,stars(counter).y),rnd*2,rgb(c,c,c),,,,F
endif
next
end sub
sub createstars()
dim c as integer
for counter =0 to 100
stars(counter).x=rnd*SCREENW
stars(counter).y=rnd*SCREENH
next
end sub
-
wow thats nice:)
middle mouse doesn't do anything here, I have some fancy mousedriver that might be the prblem.
-
Vey nice.... Could be the start of a very nice particle engine... Good Work
-
Nice particles, great work.
-
Wow! Really smooth!
You got a nice distribution of points too. Lots of people try fireworks, not many get it right. In this you have the movement right, if I was to give any advice it would be to make the explosion less dense and out of smaller particles with better colours.
If you used more realistic colours then this would look really genuine, it would only take a few small adjustments, I am really impressed :)
-
VERY NICE!!
Like Nick said, many people try fireworks and you hit it right on the head!!
-
Just excellent. Middle mouse button works here well !
Like SW says. The movement of the firework particles is perfect. I would also have
a try to make smaller explosions but maybe some more at the same time. And if
possible try some blending fx.
Anyway. Great fx !!!
-
Nice work.