REBOL Demo: Fireworks

Here's a submission I'm making to the REBOLDemo contest. It was done quickly and could probably be improved in many ways. I'm posting it here (watch for word wrap!) so others can take a crack at improving it if they want. I'm sure some of you wizards out there could apply some really nice effects to it, or come up with interesting patterns, or use it as a core like the samples Rebolek has posted. Enjoy! --Gregg REBOL [ Title: "REBOL Fireworks" file: %REBoom.r date: 8-mar-2002 Author: "Gregg Irwin" email: [greggirwin--acm--org] Comment: { I helped to optimize some VB fireworks code many years ago. This is a heavily modified adaptation of that old code. There are lots of empirical numbers in here because of the scale mode used in the original. That's really bad and a more REBOLish implementation really needs to be done. } TBD: { * Particles shouldn't wrap around edges. * One pattern dribbles a particle straight down. } ] ; Play with different combinations of settings and effects here. trails: true multi-color: false world-size: 320x240 ;512x384 ; Using a negative luma effect fades out the particles over time ; but makes the explosions much harder to see eff: [luma (negate multiply t 4) blur] ;eff: [blur sharpen] ;eff: [] sparkle-offset: 0.0025 ; Damping factor = the length of time the particles expand. ; Damping factor: 1 means expand forever. damping-factor: .92 ; If you need to slow things down. delay: 0 index-from-xy: func [num-cols[integer!] x[integer!] y[integer!]] [ return 1 + ((y - 1) * num-cols) + ((x - 1) // num-cols) ] get-value-xy: func [img[image!] x[integer!] y[integer!]] [ pick img index-from-xy img/size/x x y ] put-value-xy: func [img[image!] x[integer!] y[integer!] value[tuple!]] [ error? try [ poke img index-from-xy img/size/x x y value ] ] PSet: func [face x y /color colr /local col] [ col: either color [colr][ForeColor] put-value-xy face/image to-integer x * 100 to-integer y * 100 col ] Boom: func [face] [ n: t: lifetime: s: numparticles: 0 a: b: r1: r2: r3: r4: d: 0.0 pattern: random 5 face/effect: compose eff random/seed now/time/precise ; s controls size of explosion. Larger numbers mean smaller size. s: 10 ; Starting center point for explosion a: 12 * (divide random 50 100) b: 4 * (divide random 50 100) lifetime: 30 + random 30 ;ForeColor: random 192.192.192 + 128 ForeColor: 255.255.255 - random 128.128.128 p: make block! NumParticles: 90 loop NumParticles [append/only p copy [x 0 y 0 vx 0 vy 0]] repeat n NumParticles [ ; random direction r1: divide random 50 100 r2: divide random 50 100 r3: divide random 50 100 ; random velocity r4: .5 + divide random 30 100 r5: .3 + divide random 50 2000 ; start at a random position on the screen p/:n/x: a p/:n/y: b d: ((r1 ** 2) + (r2 ** 2) + (r3 ** 2)) ** 0.5 ; Pattern 1 is kind of a standard fireworks pattern. ; The others are just experiements. switch pattern [ 1 [ p/:n/vx: r4 * r1 / (d * s) p/:n/vy: r4 * r2 / (d * s) ] 2 [ p/:n/vx: (sine n) / s p/:n/vy: (cosine n) / s ] 3 [ if n // 5 = 0 [ p/:n/vx: (sine n) / s p/:n/vy: (cosine n) / s ] ] 4 [ p/:n/vx: (sine n) / (s / r5) p/:n/vy: (cosine n) / (s / r5) ] 5 [ p/:n/vx: (sine n) / (s * d) p/:n/vy: (cosine n) / (s * d) ] ] ;-- We don't have a 0x0 center coordinate, so we need to have ; negative velocities to keep things from all going the same ; direction. We'll say 50% of them for now. if random 100 > 50 [p/:n/vx: negate p/:n/vx] if random 100 > 50 [p/:n/vy: negate p/:n/vy] ] PSet face p/1/x - sparkle-offset p/1/y - sparkle-offset PSet face p/1/x p/1/y ;<-- Use this line with XOR mode ; variable lifetime t: 1 While [t < lifetime] [ repeat n NumParticles [ ; The Mod 2 stuff is here so we only add sparkle to half ; the particles. This keeps the overhead down. if not trails [ If n // 2 = 0 [ PSet/color face p/:n/x - sparkle-offset p/:n/y - sparkle-offset black ] PSet/color face p/:n/x p/:n/y black ] ; Reposition each particle according to it's velocity ; superimpose a constant -.1 downward velocity on the motion ; assume each particle has reached it's terminal velocity p/:n/x: p/:n/x + p/:n/vx p/:n/y: p/:n/y + p/:n/vy + .01 ; Damp the motion each pass p/:n/vx: p/:n/vx * damping-factor p/:n/vy: p/:n/vy * damping-factor If n // 2 = 0 [ PSet face p/:n/x - sparkle-offset p/:n/y - sparkle-offset ] either multi-color [ PSet/color face p/:n/x p/:n/y random 192.192.192 + 128 ][ PSet face p/:n/x p/:n/y ] ] ; clock tick t: t + 1 face/effect: compose eff show face ;img-2/effect: append compose eff 'fit ;img-2/image: :face/image ;show img-2 wait delay ] ; Erase the blast either trails [ face/image: make image! face/size show face ][ repeat n NumParticles [ If n // 2 = 0 [ PSet/color face p/:n/x - sparkle-offset p/:n/y - sparkle-offset black ] PSet/color face p/:n/x p/:n/y black ] ] ] view layout [ ; If we assign a color to the image here, it overrides the colored ; pixels we poke into the image! data. img: image make image! world-size ; img-2 is just an expanded window on the world for testing. ; The explosions are hard to see sometimes. Stretching them ; in a larger world causes some ugliness, but it's more visible. ;return ;img-2: image 640x480 across button "Go" [forever [boom img]] button "Quit" [quit] ]