Fireworks Demo

Post your FreeBASIC source, examples, tips and tricks here. Please don’t post code without including an explanation.
Post Reply
David Watson
Posts: 59
Joined: May 15, 2013 16:48
Location: England

Fireworks Demo

Post by David Watson »

Everyone seems obsessed with Cairo at the moment so I thought I'd have a go. Sit back and enjoy the show (make your own noises).

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

dodicat
Posts: 7993
Joined: Jan 10, 2006 20:30
Location: Scotland

Re: Fireworks Demo

Post by dodicat »

Thanks David, nice use of some Cairo instructions, I have put your code in my Cairo folder in Windows 11.
David Watson
Posts: 59
Joined: May 15, 2013 16:48
Location: England

Re: Fireworks Demo

Post by David Watson »

Thanks for the thanks dodicat.

I was expecting dozens of posts by neil with improved versions... he must be busy transcending to a higher being or learning Lisp or something.
Post Reply