Code: Select all
/' -- staged fireworks - 2023 Aug 14 - by dafhi
known issue: movement is not congruent at different frame rates
gcc optimization recommended - try these by UEZ / deltarho[1859]
-arch native -Wc -Ofast,-mfpmath=sse,-funroll-loops
be sure to check out stereo / quality settings below
update: stereo / x-eye needed switching
'/
#define stereo '' comment this out for regular view
' #define quality '' comment this out for flat particles
/' -- boilerplate.bas - 2023 May 12 - by dafhi
+ ------------------------ +
| freebasic | c++ |
+ ----------- + ---------- +
| true = -1 | true = 1 |
| 0.99 = 1 | 0.99 = 0 | .. i hope that covers it
+------------- ----------- +
'/
'' replaces int (and faster) - http://www.freebasic.net/forum/viewtopic.php?p=118633
#define flo(x) (((x)*2.0-0.5)shr 1)
'' gcc make this obsolete with speed options
#undef int
#define int as integer
#define sng as single
#define dbl as double
#define decl declare
#define oper operator
#define prop property
#define csr constructor
#define ac as const
function min( a as double, b as double ) as double
return iif( a < b, a, b)
end function
function max( a as double, b as double ) as double
return iif( a > b, a, b)
end function
sub change_filename_if_exists( byref filename_out as string ) '' March 5
var f = freefile
open filename_out for input as f
if lof(f) > 0 then filename_out = "-" + filename_out
close f
end sub
function clamp( in dbl, hi dbl = 1, lo dbl = 0) dbl
return min( max(in, lo), hi ) '' June 12
End Function
function bclamp( i sng ) as ubyte '' Feb 23
return min( max( i, 0), 255 )
End Function
function int2float( i as ulong) as single
return i / (2 ^ 32 + 128)
end function
function round(in dbl, places as ubyte = 2) as string
dim as integer mul = 10 ^ places
return str(csng(flo(in * mul + .5) / mul))
End Function
const tau = 8 * atn(1)
#macro sw( a, b, tmp )
tmp = a: a = b: b = tmp
#endmacro
namespace defocus_dot
/'
- defocus dot - 2023 June 12 - by dafhi --
effect of a dot passing through a focus
usage:
1. var a = defocus_dot.new_alpha( rad, z )
2. var m = defocus_dot.rad_mul
renamed: alpha_thresh -> pixel_budget
'/
dim as single iris_diam = .1
dim as single focus_z = 10
dim as single _m, _a
function new_alpha( rad as single, z as single ) as single
var r_expan = rad + iris_diam * abs(z - focus_z)
_m = r_expan / rad
_a = rad^2 / r_expan^2
return _a
End function
function rad_mul( pixel_budget as single = 1 / 60 ) as single
'' pixel budget -> reduce radius
return iif( _a < pixel_budget, _m * _a / pixel_budget, _m )
end function
end namespace
type imvars
declare constructor
declare constructor( byref as any ptr = 0 )
decl sub get_info( byref p as any ptr = 0 )
as long w '' apparently imageinfo no longer likes integer
as long h
as long pitch,rate
as long bypp,bpp
as any ptr pixels
as any ptr im
as string driver_name
end type
constructor imvars
end constructor
constructor imvars( byref p as any ptr )
get_info p
end constructor
sub imvars.get_info( byref p as any ptr )
if p = 0 then
ScreenInfo w,h, bpp, bypp, pitch, rate, driver_name
pixels = screenptr
else
ImageInfo p, w, h, bypp, pitch, pixels
if bypp = 0 then p = 0
endif
im = p
end sub
function triwave( i sng ) sng
return abs( i - flo(i) - .5 ) - .25 '' by Stonemonkey
end function
function _cchsv(h sng, s sng, v sng) as ubyte
var wave_hgt = s * v
var elevate = v - wave_hgt
return 255.499 * (wave_hgt * clamp(triwave(h)*6 + .5) + elevate)
end function
function hsv( h sng=0, s sng=1, v sng=1 ) as ulong '' 2023 April 8
return rgb( _
_cchsv( h + 0/3, s,v ), _
_cchsv( h + 2/3, s,v ), _
_cchsv( h + 1/3, s,v ) )
end function
Union UnionARGB
As Ulong col
Type: As UByte B,G,R,A
End Type
declare operator cast as ulong
declare operator let( as ulong )
End Union
operator unionargb.cast as ulong
return col
end operator
operator unionargb.let( i as ulong )
col = i
end operator
#Macro Alpha256(ret,back, fore, a256) '2017 Mar 26
ret=((_
(fore And &Hff00ff) * a256 + _
(back And &Hff00ff) * (256-a256) + &H800080) And &Hff00ff00 Or (_
(fore And &H00ff00) * a256 + _
(back And &H00ff00) * (256-a256) + &H008000) And &H00ff0000) Shr 8
#EndMacro
type tStackInfo '' 2023 July 12
declare constructor
declare sub reset
declare function yep_resize( int = 0) as boolean
dim int i, u
end type
constructor tStackInfo: reset
end constructor
sub tStackInfo.reset: u = -1: i = -1
end sub
function tStackInfo.yep_resize( _u int ) as boolean
i = max(i,_u): var ret_val = i > u
u = iif( ret_val, 1.2*i, u )
return ret_val
end function
type v3float sng
type v3 '' dodicat introduced us to this wild nomenclature
declare operator cast as string
declare function rodrigues( as v3, sng, sng) as v3
as v3float x,y,z
declare prop magSq as v3float '' 2023 June 24
declare prop norm as v3
End Type
operator v3.cast as string
return "x: "+str(x)+" y: "+str(y)+" z: "+str(z)
end operator
prop v3.magSq as v3float
return (x*x+y*y+z*z)
end prop
prop v3.norm as v3
var s = 1/ max( sqr(magSq), .001 )
return type(x*s,y*s,z*s)
end prop
function v3.rodrigues( _norm as v3, cosa sng, sina sng) as v3
static sng dot: dot=(1-cosa)*(_norm.x*x+_norm.y*y+_norm.z*z)
return type(_
_norm.x*dot + x*cosa + (_norm.y*z - _norm.z*y)*sina, _
_norm.y*dot + y*cosa + (_norm.z*x - _norm.x*z)*sina, _
_norm.z*dot + z*cosa + (_norm.x*y - _norm.y*x)*sina)
End function
function v3rnd( mag sng=1 ) as v3
static sng _y, a, r
_y=2*(rnd-.5): r = sqr(1-_y*_y) * mag
a=rnd*tau
return type( r*cos(a), _y*mag, r*sin(a) )
end function
operator -(r as v3) as v3: return type(-r.x, -r.y, -r.z): end operator
operator -(l as v3,r as v3) as v3: return type(l.x-r.x,l.y-r.y,l.z-r.z): end operator
operator +(l as v3,r as v3) as v3: return type(l.x+r.x, l.y+r.y, l.z+r.z): end operator
operator /(l as v3,r as v3float) as v3: dim as v3float s = 1/r: return type(l.x*s,l.y*s,l.z*s): end operator
operator *(l as v3,r as v3float) as v3: return type(l.x*r,l.y*r,l.z*r): end operator
operator *(l as v3float, r as v3) as v3: return type(l*r.x,l*r.y,l*r.z): end operator
operator *(l as v3,r as v3) as v3: return type(l.x*r.x,l.y*r.y,l.z*r.z): end operator
type axis3
declare constructor
declare function pt_rot8( byref as v3 ) as v3
declare sub self_rot8( byref as v3, sng, sng )
as v3 vx,vy,vz
as v3 pos
end type
constructor axis3
vx = type(1,0,0)
vy = type(0,1,0)
vz = type(0,0,1)
end constructor
function axis3.pt_rot8( byref i as v3 ) as v3
#if 1
return vx * i.x + vy * i.y + vz * i.z
#else
return type( _
vx.x * i.x + vy.x * i.y + vz.x * i.z, _
vx.y * i.x + vy.y * i.y + vz.y * i.z, _
vx.z * i.x + vy.z * i.y + vz.z * i.z)
#endif
end function
sub axis3.self_rot8( byref n as v3, cosa sng, sina sng )
vx = vx.rodrigues( n, cosa, sina )
vy = vy.rodrigues( n, cosa, sina )
vz = vz.rodrigues( n, cosa, sina )
end sub
namespace curve_funcs
function impulse( s sng ) sng '' thebookofshaders.com - inigo quilez
return s*exp(1.0-s)
end function
function parabola( s sng ) sng '' thebookofshaders.com - inigo quilez
return ( 1 - 4*(.5-s)^2 )
end function
end namespace ' ------ curve_funcs
type statRand '' development
'' read like a normal variable
declare operator cast ac single
declare operator cast as string
'' output range (base, variance)
sng b
sng v
'' call .new_epoch to make adjustments to b, v
declare sub new_epoch
'' adjustment amounts
sng bv_epoch
sng vv_epoch
declare sub set_unit_range( sng = .0, sng = .0 )
declare sub set_epoch_range( sng = .0, sng = .0 )
declare sub set_vals( sng = .0, sng = .0, sng = .0, sng = .0 )
'' used by cast()
sng _bas, _vari
end type
operator statRand.cast as string
return str( cast(single, this) )
end operator
operator statRand.cast ac single
return _bas + _vari * rnd
end operator
sub statRand.set_vals( a sng, b sng, c sng, d sng )
set_epoch_range b, c '' July 23
set_unit_range a, d
end sub
sub statRand.set_epoch_range( bve sng, vve sng )
bv_epoch = bve
vv_epoch = vve
end sub
sub statRand.set_unit_range( _b sng, _v sng )
b = _b
v = _v
new_epoch
end sub
sub statRand.new_epoch
_bas = b + bv_epoch * rnd
_vari = v + vv_epoch * rnd
end sub
function gsum(k sng = .5, t sng = 1) sng
/' --- geometric sum ---
1. s = k +k^2 .. k^t
2. s-ks = k +k^2 .. k^t
-k^2 .. -k^(t+1)
------------------
= k - k^(t+1)
'/
return (k-k^(t+1)) / (1-k)
end function
function sgs(k sng, n sng) sng
/' -- sum of geometric sum
inputs particle density, time
output: position
k*(1-k^1)/(1-k) + .. k*(1-k^n)/(1-k)
'/
static sng r: r = k/(1*(1-k))
return r * ( n - r*(1-k^n) )
end function
' ------------------- util
' - sRGB_workspace.bas continued ..
namespace sRGB_workspace
function c( _c as ubyte) int
return _c
end function
type pixel
sng x,y,z
decl oper cast as ulong
decl sub in_rgb( as ulong, sng = 1)
decl sub subm_rgb( as ulong, sng = 1) '' Feb 19
decl sub add( as pixel, sng = 1) '' Feb 19
end type
sub pixel.add( in as pixel, alpha sng) '' Feb 19
x += alpha * in.x
y += alpha * in.y
z += alpha * in.z
end sub
sub pixel.subm_rgb( col as ulong, alpha sng) '' Feb 19 (old name add_rgb)
x += alpha * ( c( col shr 16 )-127.5 )
y += alpha * ( c( col shr 8 )-127.5 )
z += alpha * ( c( col shr 0 )-127.5 )
end sub
sub pixel.in_rgb( col as ulong, alpha sng)
x = alpha * c( col shr 16 )
y = alpha * c( col shr 8 )
z = alpha * c( col shr 0 )
end sub
oper pixel.cast as ulong
return rgb( bclamp(x), bclamp(y), bclamp(z) )
end oper
dim as pixel buf(any, any)
dim int wm
dim int hm
sub setup( w as short, h as short )
const dimension_thresh = 11000
if w > dimension_thresh orelse h > dimension_thresh then exit sub
if w < 1 orelse h < 1 then exit sub
wm = w - 1
hm = h - 1
redim buf(wm, hm)
end sub
sub fill( col as ulong = rgb(128,128,128), stren sng = 0.5)
dim as pixel iwa: iwa.in_rgb col, stren
for p as pixel ptr = @buf(0,0) to @buf(wm,hm)
*p = iwa
next
end sub
sub render( byref imv as imvars )
var wm = imv.w - 1
dim as any ptr pp = imv.pixels
for y int = 0 to imv.h-1
dim as ulong ptr p = pp + y * imv.pitch
for x int = 0 to wm
p[x] = sRGB_workspace.buf(x,y)
next
next
end sub
end namespace ' ------ sRGB_workspace
type t_cliprect field = 2
as ushort x0, x1
as ushort y0, y1
decl oper cast as string
end type
oper t_cliprect.cast as string
#if 1
return _
"x0: " + str(x0) + _
" x1:" + str(x1) + _
" y0:" + str(y0) + _
" y1:" + str(y1)
#else
return "rect (" + str(x0) + "," + str(y0) + _
") - " + str(x1) + "," + str(y1) + ")"
#endif
end oper
namespace metaball2D
/' -- unique metaballs - 2023 June 27 - by dafhi
no alpha blending here .. just adds, where r,g,b can be negative.
'/
dim as t_cliprect _clipped '' namespace globals
dim sng _slope_by_rad', _clipSQ '' April 11
dim sng _metaball_alpha_scalar '' March 21
dim sng draw_dist_from_center '' May 12
dim sng dx, dy, dx0, dySQ
function _cliplo( s sng, lim sng = 0) as typeof(_clipped.x0)
return clamp( flo( s ), 9999, lim )
end function
function _cliphi( s sng, lim sng ) as typeof(_clipped.x0)
return clamp( flo( s ), lim )
end function
sub _cliprect_calc( x sng, y sng, rad_multed sng ) '' Feb 24
_clipped.x0 = _cliplo( x - rad_multed )
_clipped.x1 = _cliphi( x + rad_multed, sRGB_workspace.wm )
_clipped.y0 = _cliplo( y - rad_multed )
_clipped.y1 = _cliphi( y + rad_multed, sRGB_workspace.hm )
end sub
dim as sRGB_workspace.pixel sRGBpel '' March 24
sub _precalcs( x sng, y sng, col as ulong = -1, rad sng = 10)
draw_dist_from_center = .45 '' .65 for large metas
_metaball_alpha_scalar = min( rad, .003 ) * (col shr 24) / 255
_cliprect_calc x, y, rad * draw_dist_from_center
_slope_by_rad = 1 / max(rad, .001)
dx0 = (_clipped.x0 - x) * _slope_by_rad
sRGBpel = type(0,0,0)
sRGBpel.subm_rgb col '' Feb 19
end sub
sub _scan( col as ulong, plot_y int )
dySQ = dy * dy
dx = dx0
for plot_x int = _clipped.x0 to _clipped.x1
var alpha = _metaball_alpha_scalar / ((dx*dx+dySQ)^2 + .001)
sRGB_workspace.buf(plot_x, plot_y).add sRGBpel, alpha '' Feb 19
dx += _slope_by_rad
next
dy += _slope_by_rad
end sub
sub _draw( x sng, y sng, col as ulong = -1, rad sng = 10)
dy = (_clipped.y0 - y) * _slope_by_rad
for plot_y int = _clipped.y0 to _clipped.y1
_scan col, plot_y
next
end sub
sub draw( x sng, y sng, col as ulong = -1, rad sng = 10)
_precalcs x, y, col, rad
dy = (_clipped.y0 - y) * _slope_by_rad
for plot_y int = _clipped.y0 to _clipped.y1
_scan col, plot_y
next
end sub
end namespace ' ---- metaball2D
namespace fireworks
'' putting as many randomize-worthy properties discovered in dev process
type _species_randomization
declare constructor
declare sub new_eco_common
'' a species may use all or none of these
as statRand hue, sat
as statRand accel, accel_dura
as statRand brightness_formula
as statRand dens, size
as statRand pps, lifetime
as statRand explo
sng ratio
end type
constructor _species_randomization
new_eco_common
end constructor
sub _species_randomization.new_eco_common
'' params 1,2: base, layer fuzz variance
'' params 3,4: layer max distance, base fuzz
brightness_formula.set_vals 0, 0, 0, 1.5 '' c++ .. 2
hue.set_vals 0, .03, 1, 0
sat.set_vals 0,1
end sub
type _ecosystem
declare sub set_species_count( as byte = 1 )
declare property rand_index_from_ratios int
int _i
declare sub _create_softmax '' ML terminology
as _species_randomization sr( any )
end type
property _ecosystem.rand_index_from_ratios int
var s = csng(rnd)
for i int = 0 to ubound( sr )
if s <= sr(i).ratio then return i
next
end property
sub _ecosystem.set_species_count( c as byte )
c = max(c, 1)
redim sr(c-1)
_create_softmax
end sub
sub _ecosystem._create_softmax
var s = 0f
for i int = 0 to ubound(sr)
s += rnd
sr(i).ratio = s
next
for i int = 0 to ubound(sr)
sr(i).ratio /= s
next
end sub
enum en_stage
fuse
tube_eject
propel
explode
end enum
sub defs_fw( byref e as _ecosystem, stage int, c_specie int = 1 )
e.set_species_count c_specie
for i int = 0 to ubound( e.sr )
'' .explo parameter only used in defs_emi() and defs_par()
'' glomping before select case for convenience
e.sr(i).accel.set_vals
e.sr(i).accel_dura.set_vals 1
e.sr(i).pps.set_vals 1,90
e.sr(i).size.set_vals 1.9, 1.4
e.sr(i).dens.set_vals .3, .45
select case ac stage '' ac ~ as const
case fuse
'' params 1,2: base, layer fuzz variance
'' params 3,4: layer max distance, base fuzz
e.sr(i).lifetime.set_vals 1', 4, 0, 0
e.sr(i).accel.set_vals
e.sr(i).pps.set_vals
case tube_eject
e.sr(i).lifetime.set_vals .7, 1.2
e.sr(i).accel.set_vals 80,50
e.sr(i).accel_dura.set_vals .01, .02
case propel
e.sr(i).lifetime.set_vals 1.3, 3.4
e.sr(i).accel.set_vals 50, 60
e.sr(i).accel_dura.set_vals .7, 2.5
case explode
e.sr(i).pps.set_vals 1, 250
e.sr(i).lifetime.set_vals .0, 1.1
end select
next
end sub
sub defs_emi( byref e as _ecosystem, stage int, c_specie int = 2 )
e.set_species_count c_specie
for i int = 0 to ubound( e.sr )
e.sr(i).accel_dura.set_vals 1
e.sr(i).accel.set_vals
e.sr(i).explo.set_vals
e.sr(i).size.set_vals 1.1, .9
e.sr(i).dens.set_vals .4, .4
e.sr(i).pps.set_vals 0, 3
select case ac stage '' ac ~ as const
case fuse
e.sr(i).lifetime.set_vals .1, 2.5
case tube_eject
e.sr(i).lifetime.set_vals .01, .3
case propel
e.sr(i).explo.set_vals 0, 340 * rnd '* rnd
e.sr(i).lifetime.set_vals .1, 4
e.sr(i).pps.set_vals 0, 70 * rnd
case explode
e.sr(i).lifetime.set_vals .1, 8
e.sr(i).pps.set_vals 0, 50
e.sr(i).explo.set_vals 40, 120
end select
next
end sub
sub defs_par( byref e as _ecosystem, stage int, c_specie int = 2 )
e.set_species_count c_specie
for i int = 0 to ubound( e.sr )
e.sr(i).size.set_vals .9, .6
e.sr(i).explo.set_vals
e.sr(i).dens.set_vals .01, .7
e.sr(i).lifetime.set_vals .1, 2.3
select case ac stage '' ac ~ as const
case fuse
e.sr(i).lifetime.set_vals .01, 1.1
case tube_eject
e.sr(i).explo.set_vals '1',45*rnd*rnd
case propel
e.sr(i).explo.set_vals 0,15*rnd
case explode
e.sr(i).explo.set_vals 0, 49 * rnd'*rnd
end select
next
end sub
dim as v3 wind, grav
dim as double t, tp, dt, dt2, t0
dim as _species_randomization ptr gsr
type _particle
declare constructor
declare function dp( dbl, byref as v3 = type(0,0,0) ) as v3
declare function fv( dbl, byref as v3 = type(0,0,0) ) as v3
as v3 p
as v3 v
sng hue
sng sat
sng dens
sng lifetime
sng size
dbl t
declare sub _exotic_propulsion( as long = false )
declare sub _procedural_stats( byref as _ecosystem, sng = 0 )', byref as v3, byref as v3 )
declare sub _phys_update( dbl, byref as v3 = type(0,0,0) )
as function ( as _particle, as double, as v3 = type(0,0,0) ) ac v3 _dpos
as function ( as _particle, as double, as v3 = type(0,0,0) ) ac v3 _fvel
as function ( sng ) sng bright
end type
constructor _particle
_exotic_propulsion false
' bright = @curve_funcs.parabola
end constructor
'' physics
function f_vel( byref p as _particle, t as double, byref accel as v3 = type(0,0,0) ) as v3
return p.v * p.dens^t + wind * gsum( 1-p.dens, t) + accel * gsum( p.dens, t )
end function
function f_dpos( byref p as _particle, t as double, byref accel as v3 = type(0,0,0) ) as v3
return p.v * gsum(p.dens,t) + wind * sgs( 1-p.dens, t) + accel * sgs( p.dens, t )
end function
'' fuse physics
function f_vel_nowind( byref p as _particle, t as double, byref accel as v3 = type(0,0,0) ) as v3
return p.v * p.dens^t + accel * gsum( p.dens, t )
end function
function f_dpos_nowind( byref p as _particle, t as double, byref accel as v3 = type(0,0,0) ) as v3
return p.v * gsum(p.dens,t) + accel * sgs( p.dens, t )
end function
'' class funcs point to regular funcs
function _particle.dp( _t dbl, byref accel as v3 ) as v3
return _dpos( this, _t, accel )
end function
function _particle.fv( _t dbl, byref accel as v3 ) as v3
return _fvel( this, _t, accel )
end function
'' set pointed-to funcs
sub _particle._exotic_propulsion( i as long )
_dpos = iif( i, @f_dpos_nowind, @f_dpos )
_fvel = iif( i, @f_vel_nowind, @f_vel )
end sub
sub _particle._procedural_stats( byref src as _ecosystem, hue_base sng )', byref vel as v3, byref acc as v3 )
src._i = src.rand_index_from_ratios
gsr = @src.sr( src._i ) '' gsr for reduced text
with *gsr
hue = .hue + hue_base
sat = .sat
size = max(.size, .3)
lifetime = .lifetime
dens = .dens / ( 1 + 1 / size ^ 3 )
dim int j = .brightness_formula
select case j
case 0
bright = @curve_funcs.impulse
case 1
bright = @curve_funcs.parabola
end select
end with
end sub
sub _particle._phys_update( dt dbl, byref accel as v3 )
p += dp( dt, accel )
v = fv( dt, accel )
t += dt
end sub
type eco_pair
as _ecosystem e,et
end type
type emitter extends _particle
as eco_pair ep
as v3 accel
sng accel_dura
sng pps
int i_stage
int is_fw_base
sng y0, dy0, explo_pps', y_explo
as _ecosystem ett
end type
type firework extends emitter
declare constructor
end type
constructor firework
is_fw_base = 1
end constructor
sub _dy0( byref e as emitter )
e.dy0 = ( e.p.y - e.y0 ) / 999 + .1
end sub
sub _emi_startvals( byref des as emitter )
dim as v3 acc
select case des.i_stage
case tube_eject
acc = type(0, 7+rnd,0) + v3rnd
case propel
acc = type(0, .4+rnd,0) + v3rnd + des.v
end select
_dy0 des
with des
._procedural_stats .ep.e
.explo_pps = .dy0 * gsr->explo / 199 + 1
.accel_dura = gsr->accel_dura
.accel = (acc.norm) * (gsr->accel / .accel_dura) / .dens
.pps = (.explo_pps * gsr->pps + .0) / gsr->lifetime
select case .i_stage
case fuse
._exotic_propulsion true
case else
._exotic_propulsion false
.accel += grav
end select
end with
end sub
sub _split_accel( t1 dbl, byref e as emitter, dt dbl )
if t1 > e.accel_dura then
dim sng st = e.accel_dura - e.t
if st > 0 then
e._phys_update st, e.accel
e.accel = iif( e.i_stage = fuse, type(0,0,0), grav ) '' stop accel
e._phys_update dt - st, e.accel
else
e.accel = iif( e.i_stage = fuse, type(0,0,0), grav ) '' stop accel
endif
e.accel_dura += e.lifetime '' move the finish line so no retrigger
else
e._phys_update dt, e.accel
endif
end sub
#macro _possible_stage_chamge( _dt )
t1 = e.t + _dt
if t1 > e.lifetime then
if e.i_stage = explode orelse e.is_fw_base = false then e.t = t1: exit sub
e.t -= e.lifetime
e.i_stage += 1
defs_fw e.ep.e, e.i_stage, 1 '' species count
defs_emi e.ep.et, e.i_stage, .5 + rnd * 2
defs_par e.ett, e.i_stage, 1 + rnd
_emi_startvals e
t1 = e.t + dt
endif
#endmacro
#macro _fw_emi_common()
static int k
k = (e.dy0 + 1) * iif( e.i_stage = explode, _
e.pps * dt * curve_funcs.parabola( e.t / e.lifetime ), _
e.pps * dt ) + rnd - .5
static dbl tt, t1
if k = 0 then
_possible_stage_chamge( dt )
_split_accel t1, e, dt
exit sub
endif
static dbl ddt: ddt = dt / k
' static dbl t0: t0 = e.t
' static int k0: k0=k
#endmacro
sub emit_emitters( byref appen as sub( byref as firework), _
byref si as tStackInfo, des() as emitter, byref e as firework )
_fw_emi_common()
while k > 0
appen( e )
des(si.i).i_stage = e.i_stage
des(si.i).t = min( rnd, rnd * min( ddt, des(si.i).lifetime ) )
tt = des(si.i).t
_emi_startvals des(si.i)
des(si.i).p = e.p + e.dp( tt )
des(si.i).v = e.fv( tt, e.accel ) + _
v3rnd * ( gsr->explo * e.dy0 )'* (1-des(si.i).dens)/e.dens )
des(si.i).y0 = e.y0 '' for explosion intensity
_possible_stage_chamge( ddt )
_split_accel t1, e, ddt
k -= 1
wend
end sub
sub emit_particles( appen as sub( byref as emitter), _
byref si as tStackInfo, des() as _particle, byref e as emitter )
_fw_emi_common()
while k > 0
#if 1
appen( e )
des(si.i).t = min( rnd, rnd * min( ddt, des(si.i).lifetime ) )
tt = des(si.i).t
des(si.i)._procedural_stats e.ep.et, e.hue
des(si.i).v = e.fv( tt, e.accel ) + _
v3rnd * ( ( gsr->explo ) * (1-des(si.i).dens)/e.dens )
des(si.i).p = e.p + e.dp( tt )
#endif
t1 = e.t + ddt
if t1 > e.lifetime then e.t = t1: e.i_stage += 1: exit while
_split_accel t1, e, ddt
_dy0 e
k -= 1
wend
end sub
dim as _particle par(any)
dim as emitter emi()
dim as firework fw()
dim as tStackInfo si
dim as tStackInfo emi_si
dim as tStackInfo fw_si
sub fw_append( byref p as v3=type(0,0,0), _
stage_type int = en_stage.fuse )
if fw_si.yep_resize( fw_si.i+1) then redim preserve fw(fw_si.u)
with fw( fw_si.i )
.t = 0
defs_fw .ep.e, stage_type, 1 '' species count
defs_emi .ep.et, stage_type, 1 + rnd
defs_par .ett, stage_type, 1 + rnd
.i_stage = stage_type
.p = p
.y0 = p.y '' height as explosion variable
.v = type(0,0,0)
_emi_startvals fw( fw_si.i )
end with
end sub
sub par_append( byref e as emitter )
if si.i > 4999 then exit sub
if si.yep_resize(si.i+1) then redim preserve par( si.u )
with par(si.i)
._procedural_stats e.ep.et
end with
end sub
sub emi_append( byref fw as firework )
if emi_si.i > 3500 then exit sub
if emi_si.yep_resize( emi_si.i+1) then redim preserve emi(emi_si.u)
with emi(emi_si.i)
.ep.e = fw.ep.et
.ep.et = fw.ett
.i_stage = fw.i_stage
end with
end sub
sub par_remove( i int ): static as _particle tmp
if si.i < 0 then exit sub
sw( par(i), par( si.i), tmp )
si.i -= 1
end sub
sub emi_remove( i int ): static as emitter tmp
if i < 0 then exit sub
sw( emi(i), emi( emi_si.i ), tmp )
emi_si.i -= 1
end sub
sub fw_remove( i int ): static as firework tmp
if i < 0 then exit sub
sw( fw(i), fw( fw_si.i ), tmp )
fw_si.i -= 1
end sub
dim sng scale_2d = 1
dim sng w, h', wh, hh
dim sng _scalar
dim as axis3 world
sub initialize( _w int, _h int )
w = _w': wh = w/2
h = _h': hh = h/2
world.pos.z = 550
_scalar = world.pos.z * scale_2d
defocus_dot.focus_z = _scalar
defocus_dot.iris_diam = .002
world.vy.y = -1
grav = type(0,-1,0).norm * 9.8 * 2
t0 = timer: tp = 0
end sub
sub _update_time
t = timer - t0
dt2 = dt
dt = t - tp
tp = t
end sub
'' output format
type _pdata extends v3
as v3 p
sng hue
sng sat
sng r
sng f '' age / lifetime
as function( sng ) sng bright
end type
dim as _pdata pdata()
dim as tStackInfo pd_si
sub _par_to_pdata( byref src as _particle )
pd_si.i += 1
with src
pdata(pd_si.i).p = src.p'world.pt_rot8( src.p )
pdata(pd_si.i).hue = .hue
pdata(pd_si.i).sat = .sat
pdata(pd_si.i).f = .t / .lifetime
pdata(pd_si.i).bright = src.bright
pdata(pd_si.i).r = .size
end with
end sub
#macro to_pdata__common( _si, a )
for i int = 0 to _si.i
_par_to_pdata a(i)
next
#endmacro
sub _all_to_pdata
if pd_si.yep_resize( si.i + 1 + emi_si.i + 1 + fw_si.i ) then _
redim preserve pdata(pd_si.u)
pd_si.i = -1
to_pdata__common( fw_si, fw )
to_pdata__common( emi_si, emi )
to_pdata__common( si, par )
end sub
sub _fw_phys
dim int i
while i <= fw_si.i
emit_emitters @emi_append, emi_si, emi(), fw(i)
if fw(i).t > fw(i).lifetime then
fw_remove i
else
i += 1
endif
wend
end sub
sub _emi_phys
dim int i
while i <= emi_si.i
emit_particles @par_append, si, par(), emi(i)
if emi(i).t > emi(i).lifetime then
emi_remove i
else
i += 1
endif
wend
end sub
sub _par_phys
dim int i
while i <= si.i
par(i)._phys_update dt, grav
if par(i).t > par(i).lifetime then
par_remove i
else
i += 1
endif
wend
end sub
sub calc
_fw_phys
_emi_phys
_par_phys
_all_to_pdata
_update_time
end sub
end namespace ' ------- fireworks
' -------------------------------------
Type sort_type as fireworks._pdata
' -------------------------------------
'' comment out the .z for plain var type
#define dot .p.z
'' sort direction
#define direction >
namespace sorts '' namespacing allows local globals
#macro pred(x,y)
clng( x dot direction y dot )
#endmacro
#macro sw2(x,y)
tmp= x: x= y: y=tmp
#endmacro
type sortindex as integer
dim as sortindex j, k, m
dim as sort_type piv, tmp
Sub qs_osp(a() as sort_type, r int, L int=0)
if r<=L then exit sub '' 2023 July 20
'' one swap partition quicksort - by dafhi
if r-L = 1 andalso pred( a(r), a(L) ) then sw2( a(r), a(L) ): exit sub
j = (L+1+r)\2 '' int divide
if pred( a(L), a(j) ) then sw2( a(L), a(j) )
piv = a(L) '' global piv
j = r
var i = L
do
while pred( piv, a(j) ): j-=1: wend
a(i) = a(j)
i += 1
while pred( a(i), piv )andalso i<j: i+=1: wend
if i>=j then exit do
a(j) = a(i)
j -= 1
loop
i = (i+j)\2 '' integer divide
if clng( a(i)dot <> piv dot ) then a(i) = piv
qs_osp a(), i-1, L
qs_osp a(), r, i+1
end sub
end namespace
sub test_draw( byref imv as imvars, byref axis as axis3 )
if imv.h < 1 then exit sub
var wh = imv.w / 2
var hh = imv.h / 2
#ifdef quality
srgb_workspace.fill hsv(.65,.5,.1), .4
#else
line imv.im,(0,0)-(imv.w,imv.h),hsv(.65,.5,.1), bf
#endif
static as unionargb uar
static sng bright
static as v3 p
using fireworks
for i int = 0 to pd_si.i
with pdata(i)
p = axis.pt_rot8(.p) + axis.pos
if p.z < .1 then continue for
var z_inv = _scalar / p.z
var x = p.x * z_inv + wh
var y = p.y * z_inv + hh
uar = hsv( .hue, .sat, 1 )
bright = 255.5 * pdata(i).bright( pdata(i).f ) '' c++ 256
'' defocus_dot example
'' new_alpha must be first
uar.a = (1 - pdata(i).f) * bright * defocus_dot.new_alpha( .r, p.z )
var r = pdata(i).r * z_inv * defocus_dot.rad_mul
#ifdef quality
metaball2d.draw x,y,uar, r*2.9
#else
circle imv.im, (x, y), r, uar,,,, f
#endif
end with
next
#ifdef quality
srgb_workspace.render imv
#endif
end sub
'
' ----------- test draw
#ifdef stereo
const scalar = .8
const w = 1280 * scalar
#else
const scalar = 1
const w = 800 * scalar
#endif
const h = 720 * scalar
dim shared sng diagonal = sqr(w*w+h*h)
sub fw_next
using fireworks
var a = tau * rnd
var r = 250 * sqr(rnd)
fw_append r*type( cos(a), 0, 1*sin(a) )', propel
end sub
#include "fbgfx.bi"
screenres w,h,32,, fb.gfx_alpha_primitives
#ifdef stereo
dim as imvars imv = imagecreate(w/2,h)
#else
dim as imvars imv = imagecreate(w,h)
#endif
var demo_seconds = 200
randomize
fireworks.scale_2d = scalar
fireworks.initialize w,h
fireworks.world.pos.y += 290 '' towards bottom
fireworks.wind = type(-1,0,0).norm * 0
dim as string kstr
dim as double report_next = .5, pps
dim as double firework_next = 1, cfps, afps = 0
dim as double print_next = 4
dim as long c = 0
#ifdef quality
srgb_workspace.setup w,h
#endif
fw_next
dim as axis3 eye
using fireworks
dim int stereo_parallel = true
while fireworks.t < demo_seconds
fireworks.calc
sorts.qs_osp fireworks.pdata(), fireworks.pd_si.i
eye = fireworks.world
dim sng angle = tau / 59 '' world top slightly toward viewer
angle = 0
eye.self_rot8 eye.vx, cos(angle), sin(angle)
angle = iif(stereo_parallel,1,-1) * tau / 300
eye.self_rot8 world.vy, cos(angle), sin(angle)
' eye.pos = world.pos - type( w/80,0,0)
' eye.self_rot8 eye.vy, cos(angle), sin(angle)
test_draw imv, eye
put (0,0), imv.im, pset
#ifdef stereo
' eye.pos = world.pos + type( w/80,0,0)
angle = iif(stereo_parallel,-1,1) * tau / 150
eye.self_rot8 world.vy, cos(angle), sin(angle)
test_draw imv, eye
put (imv.w,0), imv.im, pset
#endif
locate 2,2
if fireworks.t < 2.1 then
? "demo runs "; demo_seconds; " seconds"
elseif fireworks.t < 4 then
#ifdef stereo
? "keys: X (x-eye / parallel)"
#endif
elseif fireworks.t < print_next then
#ifdef stereo
? iif( stereo_parallel, "parallel", "x-eye" )
#endif
endif
screenlock
screenunlock
if fireworks.t > firework_next then
fw_next
firework_next += .05 + (rnd*rnd) * 2.7
endif
if fireworks.t > report_next then
cfps = 2 / (fireworks.dt + fireworks.dt2)
afps += cfps
windowtitle "time: " + round( fireworks.t ) + _
" .. FPS: " + round( cfps ) + ", " + round(afps / c)
report_next += 1
c += 1
endif
kstr = lcase(inkey)
select case kstr
case chr(27)
end
case "v"
fw_next
case "z", "x", "c"
stereo_parallel = not stereo_parallel
print_next = fireworks.t + 1
end select
sleep 20
wend
? " Done !"
sleep
