I thought I'd start things off with a 'Bang' so to speak.
A bit about myself, I am a hobby programmer and have returned to programming after a period of many years without writing any code.
For the last couple of years I have been trying to catch up.
Programming has changed (a lot) since my first computing days before Windows was an operating system.
I have been using PureBasic for about three months and am very pleased with it so far.
This forum has been very useful in answering many questions I have had as a beginner.
The program I am posting here is one I wrote in a different Basic and have translated to PureBasic.
Press 'Escape' when you want it to end.
BP
Code: Select all
;fireworks by BasicallyPure
;05/24/2011
;PureBasic v4.51 (x86)
If Not InitSprite() Or Not InitKeyboard() : End : EndIf
ExamineDesktops()
ScreenWidth = DesktopWidth(0)
ScreenHeight = DesktopHeight(0)
;{ constant declarations
#Color_Blue = $FF0000
#Color_Red = $0000FF
#Color_Green = $00FF00
#Color_Yellow = $00FFFF
#Color_White = $FFFFFF
#Color_Cyan = $FFFF00
#Color_Pink = $FF00FF
#Color_Black = $000000
;}
Declare.f RandFloat()
;{ variable declarations
Define.l max = 600 ; This sets the size of the ember array
Define.l fuse = 0 ; countdown timer until next burst
Define.l ode = 0 ; index to oldest ember
Define.l youngest = -1 ; index to youngest ember
Define.f drag = 0.91 ; 0 < drag < 1; smaller = more drag
Define.f gravity = 0.1, pow, alfa
Define.f tupi = 2*#PI
Define.l midx = ScreenWidth / 2 ; middle of screen
Define.l devx = midx * 0.75 ; maximum x deviation from center
Define.l nomy = ScreenHeight * 0.45 ; nominal y location
Define.l devy = ScreenHeight * 0.25 ; maximum y deviation from nomy
Define.l a, n, embers, cmix, c1, c2, shape
Dim rm.f(max,3) ;array for erasing previous embers
Dim em.f(max,5) ;this is the ember array
;legend for em(n,n) array
;em(n,0) = x coordinate of ember
;em(n,1) = y coordinate of ember
;em(n,2) = x velocity of ember
;em(n,3) = y velocity of ember
;em(n,4) = color of ember
;em(n,5) = lifetime of ember
;end legend
Dim color.l(6) ;colors for embers
color(0)= #color_red : color(1)=#Color_Cyan : color(2)=#Color_Pink
color(3)=#Color_White : color(4) = #Color_Green
color(5) = #Color_Yellow : color(6) = #Color_Black
;}
flags.l = #PB_Window_BorderLess
title$ = "press escape to exit"
If Not OpenWindow(1,0,0,ScreenWidth,ScreenHeight,title$,flags) : End : EndIf
If Not OpenWindowedScreen(WindowID(1),0,0,ScreenWidth,ScreenHeight,0,0,0) : End : EndIf
Repeat ;here is the endless animation loop
StartDrawing(ScreenOutput())
;decide what to do based on the fuse status
If fuse > 0 ;fuse is still burning so animate the embers
fuse = fuse -1 ;countdown until next burst
;"a" is used to index each ember in array em(a,n)
a = ode -1 ;start with the oldest ember
Repeat ;this loop causes heavy cpu usage
a = a + 1 : If a > max : a = 0 : EndIf ;wrap if needed
;erase the old version of ember "a"
FrontColor(#Color_Black)
LineXY(rm(a,0),rm(a,1),rm(a,2),rm(a,3))
;age the ember
em(a,5) = em(a,5) - 1
If em(a,5) = 0 ;ember burns out
;Erase the oldest ember; it doesn't have To be the one that
;just burned out; it will be erased eventually. No one will
;know the difference. :) Just paint it black.
LineXY(rm(ode,0),rm(ode,1),rm(ode,2),rm(ode,3))
ode = ode + 1 ;adjust the oldest ember pointer
If ode > max : ode = 0 : EndIf ;wrap around if needed
Else ;ember didn't burn out so draw a new version of ember "a"
FrontColor(color(Int(em(a,4)))) ;set the pen's color
LineXY(em(a,0),em(a,1),(em(a,0)-em(a,2)),(em(a,1)-em(a,3)))
;remember how it was drawn so we can erase later
rm(a,0) = em(a,0) ;remember line x1 coord.
rm(a,1) = em(a,1) ;remember line y1 coord.
rm(a,2) = em(a,0)-em(a,2) ;remember line x2 coord.
rm(a,3) = em(a,1)-em(a,3) ;remember line y2 coord.
;move the ember
em(a,0) = em(a,0) + em(a,2) ;adjust ember x position
em(a,1) = em(a,1) + em(a,3) ;adjust ember y position
em(a,2) = em(a,2) * drag ;adjust x speed
em(a,3) = em(a,3) * drag + gravity ;adjust y speed
EndIf
Until a = youngest
Else ;fuse has reached the end so create a new burst
;set location for new burst
x = devx - Random(devx * 2)
y = Random(devy)
embers = 50 + Random(100) ;set number of embers
;set dispersion force
pow = embers / 6 ;larger number of embers get more pow
cmix = Random(100) ;decide color scheme
c1 = Random(5) : c2 = Random(5) ;choose two random colors
shape = Random(100) ;chose the type of burst
a = youngest
For n = 1 To embers
a = a + 1 : If a > max : a = 0 : EndIf ;wrap if needed
em(a,5) = 10 + Random(60) ;set ember lifetime
em(a,0) = x + midx ;set starting x coordinate for new ember
em(a,1) = nomy - y ;set starting y coordinate for new ember
alfa = tupi * RandFloat() ;2 * pi radians in a circle
;the initial velocities must be set to determine burst shape
;apply the magic formulas
If shape > 15 ;sphere
em(a,2) = Sin(alfa) * pow * Sin(RandFloat()*tupi) ;initial x velocity
em(a,3) = Cos(alfa) * pow * Sin(RandFloat()*tupi) ;initial y velocity
Else ;ellipse
em(a,2) = Sin(alfa) * pow + Sin(RandFloat()*tupi) ;initial x velocity
em(a,3) = Cos(alfa) * pow * 0.25 ;initial y velocity
EndIf
;set color scheme
If cmix > 75 ;use one color
em(a,4) = c1
ElseIf cmix < 65 ;use two colors
If Random(1)
em(a,4) = c1
Else
em(a,4) = c2
EndIf
Else ;use all colors
em(a,4) = Random(5)
EndIf
Next n
youngest = a ;remember which ember is youngest
;start fuse for next burst
fuse = Random(15) + 25
EndIf
StopDrawing()
FlipBuffers()
Repeat
event = WindowEvent()
Until event = 0
;control the animation speed
Delay(60)
ExamineKeyboard()
Until KeyboardPushed(#PB_Key_Escape)
End
Procedure.f RandFloat()
;generate a random number ranging >0 and <1
number.f = (Random(2147483645)+1) / (2147483647)
ProcedureReturn number
EndProcedure