+- QB64 Phoenix Edition (https://qb64phoenix.com/forum)
+-- Forum: QB64 Rising (https://qb64phoenix.com/forum/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://qb64phoenix.com/forum/forumdisplay.php?fid=3)
+---- Forum: Programs (https://qb64phoenix.com/forum/forumdisplay.php?fid=7)
+---- Thread: New Years Eve Fireworks! (/showthread.php?tid=3328)
RE: New Years Eve Fireworks! - SierraKen - 12-29-2024
OK, I didn't see your DIM C() _Unsigned Long so I added that. I wondered where all the colors were.
I reduced it down to around the amount of explosions you had.
CLS after trajectile doesn't seem to clear the shadows, but that's OK, they are cleared when a new one starts anyway.
I also edited the booms numbers to the amount used. Here is the code. A background image would be cool!
Code: (Select All)
'Fireworks by SierraKen and Bplus
'December 29, 2024
'Firework sounds from https://pixabay.com/sound-effects/search/fireworks/
'Thanks B+ for the inspiration and help.
Screen _NewImage(800, 600, 32)
Dim x(200), y(200), xx(200), yy(200)
Dim centerx(200), centery(200)
Dim c(200) As _Unsigned Long
_Title "Fireworks by SierraKen and Bplus"
file$ = "firework_single.mp3"
file2$ = "firework_single_small.mp3"
Song = _SndOpen(file$)
song2 = _SndOpen(file2$)
If Song < 1 Then
Print "Failed to load sound file!"
End
End If
GoSub more
Randomize Timer
Do
ce = ce + 1
If ce > 200 Then ce = 1
centerx(ce) = (Rnd * 400) + 200
centery(ce) = (Rnd * 100) + 300
red = (Rnd * 155) + 100: green = (Rnd * 155) + 100: blue = (Rnd * 155) + 100
c(ce) = _RGB32(red, green, blue)
If booms < 20 Then _SndPlay Song
If booms > 19 Then _SndPlay song2
If booms < 20 Then GoSub trajectile
For b = 1 To 300
For e = 1 To 200
x(e) = x(e) + xx(e)
y(e) = y(e) + yy(e)
cx = x(e) + centerx(ce)
cy = y(e) + centery(ce)
fillCircle cx, cy, 2, c(ce)
Next e
If booms < 10 Then _Limit (300 - b) + 60 Else _Limit 500
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF
Next b
booms = booms + 1
_Title "Explosions: " + Str$(booms)
t = 1
GoSub more
If booms = 19 Then
_SndStop Song
End If
If booms = 40 Then
For ending = 1 To 8
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 60), BF
_Delay .1
Next ending
_SndStop song2
End
End If
Loop Until InKey$ = Chr$(27)
End
more:
For t = 1 To 200
r = Rnd * 2
a = Rnd * _Pi(2)
x(t) = r * Cos(a)
y(t) = r * Sin(a)
xx(t) = r * Cos(a): yy(t) = r * Sin(a)
Next t
Return
trajectile:
For ty = 600 To centery(ce) Step -1
fillCircle centerx(ce), ty, 2, _RGB32(255, 255, 255)
_Delay .002
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF
Next ty
Cls
Return
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
RE: New Years Eve Fireworks! - bplus - 12-29-2024
Ken, I hope you don't find me picky but when my name is on there too...
Up to you, of course, but I made some changes to your last. CLS before next rocket goes up really does clear all traces of last firework. I added _delay for first 20 booms and when the sound changes at 20, so should the limit change to 500 for rapid fire. I also changed the spread of firework to rnd from rnd*2. That's my taste, if you prefer rnd* 2, OK.
Here is my suggested edits:
Code: (Select All)
'Fireworks by SierraKen and Bplus
'December 29, 2024
'Firework sounds from https://pixabay.com/sound-effects/search/fireworks/
'Thanks B+ for the inspiration and help.
Screen _NewImage(800, 600, 32)
Dim x(200), y(200), xx(200), yy(200)
Dim centerx(200), centery(200)
Dim c(200) As _Unsigned Long
_Title "Fireworks by SierraKen and Bplus"
file$ = "firework_single.mp3"
file2$ = "firework_single_small.mp3"
Song = _SndOpen(file$)
song2 = _SndOpen(file2$)
If Song < 1 Then
Print "Failed to load sound file!"
End
End If
GoSub more
Randomize Timer
Do
ce = ce + 1
If ce > 200 Then ce = 1
centerx(ce) = (Rnd * 400) + 200
centery(ce) = (Rnd * 100) + 300
red = (Rnd * 155) + 100: green = (Rnd * 155) + 100: blue = (Rnd * 155) + 100
c(ce) = _RGB32(red, green, blue)
If booms < 20 Then _SndPlay Song ' <<<< songs switch at 20 to rapid fire
' so limit should change too, not at 10
If booms > 19 Then _SndPlay song2
If booms < 20 Then GoSub trajectile
For b = 1 To 300
For e = 1 To 200
x(e) = x(e) + xx(e)
y(e) = y(e) + yy(e)
cx = x(e) + centerx(ce)
cy = y(e) + centery(ce)
fillCircle cx, cy, 2, c(ce)
Next e
' >>>> so Limit should switch to 20 when song switches, not 10
If booms < 20 Then _Limit (300 - b) + 60 Else _Limit 500 ' 500 when goes to rapid fire
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF
Next b
booms = booms + 1
_Title "Explosions: " + Str$(booms)
If booms < 20 Then _Delay .5 ' <<< I added tiny delay between firework end and next rocket
t = 1
GoSub more
If booms = 19 Then
_SndStop Song
End If
If booms = 40 Then
For ending = 1 To 8
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 60), BF
_Delay .1
Next ending
_SndStop song2
End
End If
Loop Until InKey$ = Chr$(27)
End
more:
For t = 1 To 200
r = Rnd ' <<< still too wide a spread took out * 2
a = Rnd * _Pi(2)
x(t) = r * Cos(a)
y(t) = r * Sin(a)
xx(t) = r * Cos(a): yy(t) = r * Sin(a)
Next t
Return
trajectile:
Cls ' <<< this really does make a difference as the rocket goes up into a black sky
' no traces of old firework
For ty = 600 To centery(ce) Step -1
fillCircle centerx(ce), ty, 2, _RGB32(255, 255, 255)
_Delay .002
Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF
Next ty
Cls
Return
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End SubRE: New Years Eve Fireworks! - SierraKen - 12-29-2024
Looks great B+! One thing you should know, that you might not know, is that I actually had it speed up twice, the middle one still showed the rocket but it was blasting off a a lot sooner than the first 10 ones. That is why that delay line was set to 10. But it's OK, I still like your version. Your new delay wouldn't be compatible with the faster shooting rockets anyway.
RE: New Years Eve Fireworks! - SierraKen - 12-30-2024
OK, here it is all packaged up. Thanks for your help B+, I really like it. I didn't add or change anything from your edit above. By the way, this will be my last version. I need to relax now and not think about this anymore. I do like it though!
Download the file: fireworks 3.zip
It has Fireworks 3.bas and 2 mp3 sound files.
RE: New Years Eve Fireworks! - bplus - 12-31-2024
"I need to relax now and not think about this anymore. I do like it though!"
Well the creative muse will do that to you but what an improvement! what a growth experience!
That fade method is nice way to do fireworks, for me the question remains how to get a background behind it to stay visible while fading the trails of burst.
RE: New Years Eve Fireworks! - SierraKen - 12-31-2024
Thanks B+.
Yeah I tried a background, I'll post it here if anyone wants to try adding it. The way the loops are, I don't know if it's possible, even without trails. But most likely I just don't know the right code. I used the flipping code from my Christmas Balls (except loading a picture instead), but no luck.
RE: New Years Eve Fireworks! - bplus - 12-31-2024
Nice background! Yeah the way we fade trails also ends up blocking out the background.
It would be nice trick to do background and multi-rockets all on same screen with the fade technique.
Maybe someone might have idea on that?
RE: New Years Eve Fireworks! - SMcNeill - 12-31-2024
(12-31-2024, 06:57 PM)bplus Wrote: Nice background! Yeah the way we fade trails also ends up blocking out the background.
It would be nice trick to do background and multi-rockets all on same screen with the fade technique.
Maybe someone might have idea on that?
Layer 2 screens, only fade 1.
RE: New Years Eve Fireworks! - SierraKen - 12-31-2024
Thanks Steve, but I did it another way! Instead of using LINE to erase the whole screen to make trails, I made the trails themselves fade! It works!!!!!
The trail graphics actually don't change, but using the 4th color number as 10, the more trails that are together makes it brighter and the more the trail scatters it is less.
Check this out guys. The fireworks themselves aren't as bright, but I like the effect.
Here is also the zip file which includes all the needed files, including the sky, 2 mp3 files, and .bas file.
@bplus
Code: (Select All)
'Fireworks by SierraKen and Bplus
'December 31, 2024
'Firework sounds from https://pixabay.com/sound-effects/search/fireworks/
'Thanks B+ for the inspiration and help.
Screen _NewImage(1280, 853, 32)
Dim x(200), y(200), xx(200), yy(200)
Dim cx(200), cy(200)
Dim centerx(200), centery(200)
Dim c(200) As _Unsigned Long
_Title "Fireworks by SierraKen and Bplus"
file$ = "firework_single.mp3"
file2$ = "firework_single_small.mp3"
Song = _SndOpen(file$)
song2 = _SndOpen(file2$)
If Song < 1 Then
Print "Failed to load sound file!"
End
End If
GoSub more
Randomize Timer
image& = _LoadImage("sky.jpg", 32)
Screen image&
image2& = _CopyImage(0)
Do
ce = ce + 1
If ce > 200 Then ce = 1
centerx(ce) = (Rnd * 1000) + 200
centery(ce) = (Rnd * 100) + 300
red = (Rnd * 155) + 100: green = (Rnd * 155) + 100: blue = (Rnd * 155) + 100
c(ce) = _RGB32(red, green, blue, 10)
If booms < 20 Then _SndPlay Song
If booms > 19 Then _SndPlay song2
If booms < 20 Then GoSub trajectile
For b = 1 To 300
For e = 1 To 200
x(e) = x(e) + xx(e)
y(e) = y(e) + yy(e)
cx(e) = x(e) + centerx(ce)
cy(e) = y(e) + centery(ce)
fillCircle cx(e), cy(e), 1, c(ce)
Next e
If booms < 20 Then _Limit (300 - b) + 60 Else _Limit 500
Next b
If booms < 19 Then _Delay 2.5
_PutImage (0, 0), image&
booms = booms + 1
_Title "Explosions: " + Str$(booms)
t = 1
GoSub more
If booms = 19 Then
_SndStop Song
End If
If booms = 50 Then
For ending = 1 To 8
_Delay 2.5
_PutImage (0, 0), image&
_Delay .1
Next ending
_SndStop song2
End
End If
Loop Until InKey$ = Chr$(27)
End
more:
For t = 1 To 200
r = Rnd
a = Rnd * _Pi(2)
x(t) = r * Cos(a)
y(t) = r * Sin(a)
xx(t) = r * Cos(a): yy(t) = r * Sin(a)
Next t
Return
trajectile:
For ty = 753 To centery(ce) Step -1
fillCircle centerx(ce), ty, 2, _RGB32(255, 255, 255, 10)
_Delay .002
'Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF
Screen image2&
Next ty
Return
'from Steve Gold standard
Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
RE: New Years Eve Fireworks! - bplus - 12-31-2024
@SierraKen eh, not quite the same, but man was that a simple change!
@SMcNeill I never worked with layers before, I sure could use an example of blocking/fading by using fade technique with Line (0,0)-(_width, _Height), _Rgb32(0,0,0,10), BF ie fix this and add your name to the developers.
Seems to me that line/tinting buildup is going to block out anything underneath.