Code: Select all
'Program Fireworks
'Author David Watson
'Version 1.00
'Language FreeBASIC 1.10 for Linux
'########################## includes and declarations ##########################
#include "cairo/cairo.bi"
declare sub createshell()
declare sub createstars( as short)
'############################## set up variables ###############################
type star_t
as single a, v, x, y
as single r, g, b
as short f, t
end type
dim as short i, ms
dim as double t
dim as single lum
dim as string k
dim as any ptr image, pix
dim as cairo_surface_t ptr surf
dim as cairo_t ptr ctxt
dim shared as integer sx, sy
dim shared as short sc
dim shared as star_t star(1023)
randomize timer
'################################ set up screen ################################
screeninfo sx, sy 'get desktop resolution
'3:2 aspect window that fills most of the screen
'(unless you have a stupidly-shaped monitor)
sy = sy * 0.8
sx = sy * 1.5
screenres sx, sy, 32 'create window
color &h00FF00, 0 'green on black
'create image buffer
image = imagecreate(sx, sy, 0, 32)
'get image start address
imageinfo image, , , , , pix
'create surface
surf = cairo_image_surface_create_for_data(pix, CAIRO_FORMAT_ARGB32, _
sx, sy, cairo_format_stride_for_width(CAIRO_FORMAT_ARGB32, sx))
'create context
ctxt = cairo_create(surf)
'set line width
cairo_set_line_width ctxt, 1
'ensure pretty antialiasing
cairo_set_antialias ctxt, CAIRO_ANTIALIAS_BEST
'################################## main loop ##################################
do
t = timer
screenlock
'clear context to black
cairo_set_source_rgb ctxt, 0, 0, 0
cairo_paint ctxt
if rnd < 0.05 then createshell 'create firework
for i = 0 to 1023
if star(i).t > 0 then 'star is active
'draw star
if star(i).t = 3 then lum = rnd else lum = 1
cairo_set_source_rgb ctxt, star(i).r * lum, star(i).g * lum, _
star(i).b * lum
cairo_rectangle ctxt, star(i).x, star(i).y, 1, 1
cairo_stroke ctxt 'draw to context
'move it
star(i).x = star(i).x + sin(star(i).a) * star(i).v
star(i).y = star(i).y - cos(star(i).a) * star(i).v
'fuse burns down
star(i).f = star(i).f - 1
if star(i).f = 0 then
if star(i).t = 1 then createstars i 'shell becomes stars
star(i).t = 0 'deactivate star
endif
endif
next i
'put image buffer on screen
put (0, 0), image, pset
screenunlock
k = inkey
ms = int((timer - t) * 1000)
if ms < 16 then sleep 16 - ms else sleep 1
loop until k = chr(27) or k = chr(255) + "k"
'############################# finish up and quit ##############################
cairo_destroy ctxt
cairo_surface_destroy surf
imagedestroy image
end
'########################### createshell subroutine ############################
sub createshell()
star(sc).t = 1 'set type (1 = shell)
star(sc).x = sx shr 1 'x position
star(sc).y = sy 'y position
star(sc).v = sy / 200 'velocity
star(sc).a = rnd * 1.4 - 0.7 'angle (-40 -> +40 degrees)
star(sc).f = 140 + rnd * 20 'fuse time (140 -> 160)
star(sc).r = 1 'red component
star(sc).g = 1 'green component
star(sc).b = rnd * 0.3 'blue component
sc = (sc + 1) and 1023 'increment counter
end sub
'########################### createstars subroutine ############################
sub createstars(i as short)
dim as byte c, f, n, t
' red yell oran green blue viol white
static as single colr(6) => {1.00, 1.00, 1.00, 0.25, 0.33, 0.66, 1.00}
static as single colg(6) => {0.25, 0.50, 1.00, 1.00, 0.66, 0.33, 1.00}
static as single colb(6) => {0.25, 0.25, 0.00, 0.25, 1.00, 1.00, 1.00}
t = 2 + int(rnd * 2) 'type (2 -> 3)
c = int(rnd * 7) 'colour (0 -> 6)
f = 20 + rnd * 40 'fuse time (20 -> 60)
'generate 20 -> 50 stars
for n = 1 to 20 + int(rnd * 30)
star(sc).t = t 'set type (2 = solid, 3 = flicker)
star(sc).x = star(i).x 'x position
star(sc).y = star(i).y 'y position
star(sc).v = sy / 500 'velocity
star(sc).a = rnd * 6.28 'angle (full circle)
star(sc).f = f 'fuse time (explosion radius)
star(sc).r = colr(c) 'red component
star(sc).g = colg(c) 'green component
star(sc).b = colb(c) 'blue component
sc = (sc + 1) and 1023 'increment counter
next n
end sub