rebol [ title: "Fire and Smoke particles generator." purpose: "A particle engine demo which generates fire and smoke, with a lot of control and some compositing built-in" version: 1.0.2 date: 2010-09-18 file: %fire-smoke-particle-generator.r library: [ level: 'intermediate platform: 'all type: [demo fun ] domain: [animation game graphics math visualization ] tested-under: [view 2.7.7] support: none license: 'MIT ] ] ;save %particle-fire-setup.r fire-setup ;save %particle-smoke-setup.r smoke-setup ;---------------------------------- ;- SETUP PROPERTIES ;- fire-setup: fire-setup: any [ all [ exists? %particle-fire-setup.r attempt [load %particle-fire-setup.r] ] load decompress 64#{ eJztl19qwzAMxt8Hu0MukKB/tuUD7Cgb7HVPPf7sMGiULI4VGuhgpVCX74f6WZLl dIxwG0mG15fyGWHAAaZQvn18fr0PY5bbGKAh0kKcyLwsS7dROlktjFAfi7GauMMy ZVZKGEHmxdu44kM0ph/P58JjPx/ZyZOPD2zKCxMHBZKYcV4Em/myWYzLzLOEmDJg XWyC16KidOOlVD7aNleTTuCivbFRu2klF62WXrBlsc42UR9a6tiLzod4UfJ+MWmZ DXRGXJ1Zjwi2QftFDPbgrFW0s2yrYtpVW46P1NhS59m866qtzvs9q0pTjeddRTth YEJ7Piyt1scBXXuun1Zw0S4nSqaqR75rPrmTzjY0/5J83VXLDzHsqGWHi3uCpwR8 f2/G1nPAiZZz/JHwqov/DI1JzH1/gAc7pv/pn0tP4nU0dTuhuZj6LDhdidfZdCHu NOPDA5jHpCNc1IeTC2d1eXfizq3WPxR873edomBOgUHnxYavt5uLl0vjMxaOxcGT k1cnH0/EBwcvLp6yfd445JNtnzb/DRBrc6mbEAAA } ] ;- smoke-setup: smoke-setup: any [ all [ exists? %particle-smoke-setup.r attempt [load %particle-smoke-setup.r] ] load decompress 64#{ eJytlDEOwzAIRfdKuYMvgGRTTMmBOkVVhy4cP5C5n0pWN8tPmM8HQ2OaE1vbbt3p 3hu3EefP6308G42pAbmC/Tu8GHh1ZycFcXuVUBMKgI+oQ/8PTQqovBppGQmNNQzT vKmACTYv1SDvStbXmJozkBmuwRfNB5iaEImGzRTmKtD6UIRKEpQwGSohe4f6UzAV F2RzgRSiMfOy/NdwI8gqFMPr4hKEOv8DSgXhOjkBDzAYsvkEAAA= }] ;---------------------------------- ;- SMOKE PROPERTIES ;- smoke-lift: smoke-lift: 5 ;- smoke-clr: smoke-clr: 175.175.175 ;- smoke-opacity: smoke-opacity: 0.0.0.160 ;- smoke-life: smoke-life: 2 ;- smoke-life-variance: smoke-life-variance: 1 ;---------------------------------- ;- FIRE PROPERTIES ;- fire-life: fire-life: 1 ;- fire-life-variance: fire-life-variance: 0.5 ;- fire-clr: fire-clr: gold ;- fire-Opacity: fire-Opacity: 0.0.0.150 ;- ENVIRONMENT CONTROLS ;- wind-strength: wind-strength: 3 ;- air-turbulence: air-turbulence: 5x5 ; a which adds random variation in all directions to all particle movement note that this value becomes +/- n ;- GENERAL VIEW AND SIMULATION CONTROLS unless exists? %house.png [ house-url: http://www.pointillistic.com/open-REBOL/moa/files/house.png branches-url: http://www.pointillistic.com/open-REBOL/moa/files/branches.png print "--------------------------------------------------------------" print "this script will download two images from the web to your disk." print "they will be saved at the same location as this script." print "--------------------------------------------------------------" print "" probe house-url probe branches-url print "" ask"press enter to continue..." write/binary %house.png read/binary house-url write/binary %branches.png read/binary branches-url ] bg-img: load %house.png fg-img: load %branches.png ;- view-scale: view-scale: 0.5 ;- view-offset: view-offset: 0x0 ;- view-origin: view-origin: 200x200 ;- paused?: paused?: false ;- update?: update?: false ;- gradients?: gradients?: none ;- gen-rate: gen-rate: 400 ;- particles: ; stored as sets of: position [pair!] velocity [pair!] age [decimal!] life [decimal!] ; ; ; position: last pair position of a particle ; ; velocity: its last known velocity in termes of /second ; ; age: its current age, accumulated via all previous move-particles() ; ; life: particle's life expectancy ; ; type: particle type as a word, used for later use. (ex: fire generates smoke, smoke dies) ; particles: [] ;- particle-items: particle-items: 5 ;- birth-points: ; stored as sets of: ; position [pair!] velocity [pair!] life [decimal!] life-variance [decimal!] type [word!] ; ; position: birth place of a particle ; ; velocity: launch velocity ; ; life: particle's minimal life expectancy ; ; life-variance: a paiitcle's life variance (a random amount added to life at each birth) ; ; type: particle type as a word, used for later use. (ex: fire generates smoke, smoke dies) ; birth-points: [] append birth-points fire-setup append birth-points smoke-setup ;- birth-point-items: birth-point-items: 5 ;- simulation: ; ; holds the particle draw block simulation: make block! 100000 ;- ;- FUNCTIONS ;------------------------ ;- birth-particles() ;------------------------ birth-particles: func [ rate [integer!] "number of particles to generate" density [decimal!] "a percentage for each birth points (usually equal to time delta)" /local pos vel life type life-variance origins ][ ;print to-time rate unless empty? birth-points [ origins: (length? birth-points) / birth-point-items loop rate [ birth-point: at birth-points (birth-point-items * (random origins) - birth-point-items + 1) set [pos vel life life-variance type] birth-point if density > ( (0.0001 * random 10000)) [ ;prin "!" insert particles reduce [ pos vel 0.0 (life + random life-variance) type ] ] ] ] ] ;----------------- ;- distance() ;----------------- distance: func [ a b ][ square-root (power (b/x - a/x) 2) + power (b/y - a/y) 2 ] ;------------------------ ;- age-particles() ;------------------------ age-particles: func [ delta [decimal!] "how much age to add to particles" /local pos vel age life type ][ ;prin ">" unless empty? particles [ ;delta: delta - (0.000001 * random 10000) until [ set [pos vel age life type] particles either age > life [ ; particle is too old we must kill it remove/part particles particle-items ][ ; print "---" ; ?? pos ; ?? vel ; ?? age ; ?? life ; ?? type vel: variate-velocity pos vel age delta type age: age + delta ; for now the only real property is position, but eventually, we could ; fork this process to a per particle process, to allow more powerfull ; effects like death based on proximity, collisions, color variance, etc. pos: pos + (vel * delta) ; unfortunately the integer nature of R2 pairs can make some movements static. ; one way to cure this is to multiply the amounts and downscale them via a scale matrix in AGG. change particles reduce [pos vel age] particles: skip particles particle-items ] tail? particles ] particles: head particles ] ] ;------------------------ ;- variate-velocity() ;------------------------ variate-velocity: func [ pos vel age delta type ][ ; no variance for now ; eventually, each type will have an algorithm to control movement, which might even require ; particle list inspection (proximity, etc) switch/default type [ smoke [ vel: vel + (age * wind-strength * 1x0) vel: vel + (smoke-lift * 0x-1 ) vel: vel + (random (2 * air-turbulence)) - air-turbulence ] fire [ ;vel: vel + (smoke-lift * 0x-1 ) vel: vel + (age * wind-strength * 1x0) vel: vel + (random (2 * air-turbulence)) - air-turbulence ] ][ vel ] ] ;----------------- ;- hose-fire() ; removes particle sources near position. ;----------------- hose-fire: func [ blk [block!] offset [pair!] /local pos vel life life-variance type ][ until [ set [pos vel life life-variance type] blk either (10 > distance pos offset) [ ; particle is too old we must kill it remove/part blk birth-point-items ][ blk: skip blk birth-point-items ] tail? blk ] ] ;------------------------ ;- generate-simulation-results() ; ; returns a draw block which represents the particles ; ; the particles types are currently hard-coded, but can ; this can easily be modified for more control. ;------------------------ generate-simulation-results: func [ /local pos vel age life type fade clr fade-clr rad age-ratio ][ ; first we clear previous simulation results. clear simulation append simulation [ pen none ; center the view translate view-origin translate view-offset scale view-scale view-scale ] prin "." foreach [pos vel age life type] particles [ switch type [ smoke [ either gradients? [ fade-clr: 0.0.0.255 - smoke-opacity fade: (smoke-opacity + (fade-clr * (age / life))) rad: (60 * age / 5) clr: smoke-clr + fade append simulation compose [ fill-pen radial (pos) 0 (rad) 0 1 1 (clr )(clr + (fade * .08))(clr + 0.0.0.255) circle (pos) (rad) ] ][ fade-clr: 0.0.0.255 - smoke-opacity fade: (smoke-opacity + (fade-clr * (age / life))) append simulation compose [ fill-pen (smoke-clr + fade) circle (pos) (40 * age / 5) ] ] ] fire [ fade: (life - age ) / life spent: age / life ; either gradients? [ ; clr: red + 0.20.0 + (gold + 0.0.30 * fade) ; iclr: clr ; if fade > .75 [ ; iclr: white - clr ; iclr: clr + ( iclr * (fade - 0.75 * 4 ));white * 0.75 + (white * fade ; ] ; clr: clr + fire-Opacity ; fade: 0.0.0.255 - fire-opacity ; rad: 7 * (life - age) / life ; append simulation compose [ ; ;pen black ; fill-pen radial (pos) 0 (rad) 0 1 2 (iclr )((clr + (fade / 2)))(clr + 0.0.0.255) ; circle (pos) (rad * 2) (rad * 4) ; ] ; ][ rad: 3 rad: either spent < 0.2 [ clr: red + 0.20.0 + (gold + 0.0.30 * fade) clr: gold * (0.2 - spent * 2) + clr spent * rad * 5 ][ clr: red + 0.20.0 + (gold + 0.0.30 * fade) 1 - (spent - 0.2 * 1.25) * rad ] clr: clr + fire-Opacity append simulation compose [ fill-pen (clr) circle (pos) (rad) (rad * 1.4) ] ; ] ] ] ] ] ; show the console behind the rest. print "" ;- ;- WINDOW: win: view/new/options layout [ style scroller scroller 300x15 style text text right 110x18 space 2x2 across simulation-pane: box with [ image: bg-img text: none color: none effect: [draw simulation ] size: 400x400 offset: 50x50 edge: none rate: 30 ] return ;- commands btn 100 "pause" [ paused?: not paused? face/text: either paused? ["play"]["pause"] simulation-pane/feel/last-time: now/precise - 0:0:0.006 show face ] btn 100 "reset"[ clear birth-points clear particles ] btn 100 "restart"[ clear particles ] return pad 0x5 text -1x-1"use gradients (CPU intensive)" pad 0x2 check [ gradients?: face/data update?: true ] origin 420x20 h3 "Environment:" left return text "Wind" scroller 0.1 [ wind-strength: face/data * 30 ?? wind-strength ] return text "Turbulence" scroller 0.2 [ air-turbulence: face/data * 30x30 ?? air-turbulence ] return pad 0x10 h3 "Birth Control:" return ;- particle properties text "Rate" scroller 260x15 0.4 [ gen-rate: to-integer (face/data * 1000) ?? gen-rate rate-txt/text: to-string gen-rate show rate-txt ] rate-txt: text right 40x15 "200" edge [size: 1x1 effect: 'ibevel] para [origin: 0x-2] return text "Fire life" scroller 0.2 [ fire-life: face/data * 3 fire-life ] return text "Smoke life" scroller 0.2 [ smoke-life: face/data * 3 smoke-life ] return pad 0x20 h3 "Looks" return text "Smoke Opacity" scroller 0.2 [ smoke-Opacity: 0.0.0.255 * (1 - face/data) smoke-Opacity update?: true ] return text "Smoke Darkness" scroller 0.93 [ smoke-clr: white * (1 - face/data) smoke-clr update?: true ] return text "Fire Opacity" scroller 0.4 [ fire-Opacity: 0.0.0.255 * (1 - face/data) fire-Opacity update?: true ] return pad 0x20 h3 "view:" return text "Scale" scroller [ view-scale: face/data * 30 view-scale: (3 * face/data) + 0.5 update?: true ] space 5x5 return pad 0x20 h3 "Notes:" return pad 20x0 text left as-is 400x140 wrap {*Click for new fire origin, right-click for smoke! *Shift Click & Drag to move the whole setup. *Control-Click near a particle source to REMOVE it. *If you reduce Fire or Smoke Life *before* creating new fires or smoke sources, they will die out sooner (i.e. smaller flames). *Rate is shared accross all particle sources, so the more sources you have, the more you will have to crank up the rate. *When too many particles are visible, refresh will start to slow down, but speed is preserved.} return origin 20x20 ][all-over] fg-pane: make face [ size: 400x400 text: none effect: none image: fg-img edge: none ] fg-pane/effect: [merge] simulation-pane/pane: fg-pane ;- ;------------------------ ;- simulation-feel() ;------------------------ simulation-pane/feel: make face/feel [ last-time: now/precise current-time: none drag-pos: none setup: none engage: func [face action event][ ;?? action switch action [ over [ if drag-pos [ view-offset: event/offset - drag-pos update?: true ] ] away [ ] time [ if any [update? not paused?] [ unless paused? [ current-time: now/precise delta: to-decimal difference current-time last-time birth-particles gen-rate (delta * 2) age-particles delta last-time: current-time ] generate-simulation-results prin (length? particles) / particle-items show simulation-pane update?: false ] ] ;- -down down [ either event/shift [ drag-pos: event/offset - view-offset ][ either event/control [ hose-fire birth-points ( ((event/offset - view-origin - view-offset) * (1 / view-scale)) ) hose-fire fire-setup ( ((event/offset - view-origin - view-offset) * (1 / view-scale)) ) hose-fire smoke-setup ( ((event/offset - view-origin - view-offset) * (1 / view-scale)) ) ][ setup: compose [ ( ((event/offset - view-origin - view-offset) * (1 / view-scale)) ) 0x-60 (fire-life) (fire-life-variance) fire ] append birth-points setup append fire-setup setup ] ] ] up [ drag-pos: none ] ;- -alt-down alt-down [ setup: compose [ ( ((event/offset - view-origin - view-offset) * (1 / view-scale)) ) 0x-30 (smoke-life) (smoke-life-variance) smoke ] append birth-points setup append smoke-setup setup ] ] ] ] ;- start do-events save %particle-fire-setup.r fire-setup save %particle-smoke-setup.r smoke-setup