extra/fluids/fluids.factor

   1 ! Copyright (C) 2010 Erik Charlebois.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors arrays classes.struct destructors game.loop
   4 game.worlds gpu gpu.buffers gpu.effects.blur gpu.framebuffers
   5 gpu.render gpu.shaders gpu.state gpu.textures gpu.util images
   6 images.loader kernel literals locals make math math.rectangles
   7 math.vectors namespaces opengl.gl sequences specialized-arrays
   8 ui.gadgets.worlds ui.gestures ui.pixel-formats gpu.effects.step
   9 images.pgm images.ppm ;
  10 FROM: alien.c-types => float ;
  11 SPECIALIZED-ARRAY: float
  12 IN: fluids
  13
  14 STRUCT: float2_t
  15     { x float }
  16     { y float } ;
  17
  18 : f2+ ( lhs rhs -- res )
  19     [ [ x>> ] bi@ + ]
  20     [ [ y>> ] bi@ + ]
  21     2bi float2_t <struct-boa> ; inline
  22
  23 : f2- ( lhs rhs -- res )
  24     [ [ x>> ] bi@ - ]
  25     [ [ y>> ] bi@ - ]
  26     2bi float2_t <struct-boa> ; inline
  27
  28 : f2*n ( lhs rhs -- res )
  29     [ [ x>> ] dip * ]
  30     [ [ y>> ] dip * ]
  31     2bi float2_t <struct-boa> ; inline
  32
  33 STRUCT: particle_t
  34     { p  float2_t }
  35     { p' float2_t }
  36     { m  float    } ;
  37 SPECIALIZED-ARRAY: particle_t
  38
  39 CONSTANT: gravity S{ float2_t f 0.0 -0.1 }
  40
  41 :: verlet-integrate-particle ( p dt -- p' )
  42     p p>> 2.0 f2*n :> v1
  43     p p'>> :> v2
  44     gravity dt dt * 1.0 p m>> 2.0 * / * f2*n :> v3
  45     v1 v2 f2- v3 f2+
  46     p p m>> particle_t <struct-boa> ; inline
  47
  48 CONSTANT: initial-particles
  49 particle_t-array{
  50     S{ particle_t f S{ float2_t f 0.5 0.6 } S{ float2_t f 0.499 0.599 } 1.0 }
  51     S{ particle_t f S{ float2_t f 0.5 0.6 } S{ float2_t f 0.501 0.599 } 3.0 }
  52
  53     S{ particle_t f S{ float2_t f 0.5 0.5 } S{ float2_t f 0.5 0.5 } 2.0 }
  54     S{ particle_t f S{ float2_t f 0.5 0.6 } S{ float2_t f 0.5 0.599 } 1.0 }
  55     S{ particle_t f S{ float2_t f 0.6 0.5 } S{ float2_t f 0.6 0.5 } 3.0 }
  56     S{ particle_t f S{ float2_t f 0.7 0.5 } S{ float2_t f 0.7 0.5 } 1.0 }
  57     S{ particle_t f S{ float2_t f 0.1 0.5 } S{ float2_t f 0.1 0.5 } 5.0 }
  58     S{ particle_t f S{ float2_t f 0.2 0.5 } S{ float2_t f 0.2 0.5 } 1.0 }
  59     S{ particle_t f S{ float2_t f 0.3 0.3 } S{ float2_t f 0.3 0.3 } 4.0 }
  60     S{ particle_t f S{ float2_t f 0.5 0.15 } S{ float2_t f 0.5 0.15 } 1.0 }
  61     S{ particle_t f S{ float2_t f 0.5 0.1 } S{ float2_t f 0.5 0.1 } 9.0 }
  62 }
  63
  64 : integrate-particles! ( particles dt -- particles )
  65     [ verlet-integrate-particle ] curry map! ;
  66
  67 TUPLE: fluids-world < game-world
  68     particles texture ramp { paused boolean initial: f } ;
  69
  70 : make-texture ( pathname -- texture )
  71     load-image
  72     [
  73         [ component-order>> ]
  74         [ component-type>> ] bi
  75         T{ texture-parameters
  76            { wrap clamp-texcoord-to-edge }
  77            { min-filter filter-nearest }
  78            { mag-filter filter-nearest }
  79            { min-mipmap-filter f } }
  80         <texture-2d>
  81     ]
  82     [
  83         0 swap [ allocate-texture-image ] 3keep 2drop
  84     ] bi ;
  85
  86 SYMBOL: fluid
  87
  88 : integrate ( world -- )
  89     particles>> $[ 60 fps 1000000 /f ] integrate-particles! drop ;
  90
  91 : pause ( -- )
  92     fluid get [ not ] change-paused drop ;
  93
  94 : step ( -- )
  95     fluid get paused>> [ fluid get integrate ] when ;
  96
  97 M: fluids-world begin-game-world
  98     dup fluid set
  99     init-gpu
 100     initial-particles clone >>particles
 101     "resource:extra/fluids/particle2.pgm" make-texture >>texture
 102     "resource:extra/fluids/colors.ppm" make-texture >>ramp
 103     drop ;
 104
 105 M: fluids-world end-game-world
 106     drop ;
 107
 108 M: fluids-world tick-game-world
 109     dup paused>> [ drop ] [ integrate ] if ;
 110
 111 M:: fluids-world draw-world* ( world -- )
 112     world particles>> [
 113         [ p>> [ x>> , ] [ y>> , ] bi ] each
 114     ] curry float-array{ } make :> verts
 115
 116     [
 117         verts world texture>> 50.0 { 320 240 } blended-point-sprite-batch &dispose
 118
 119         blend-state new set-gpu-state
 120
 121         gaussian-blur &dispose world ramp>> { 1024 768 } step-texture &dispose
 122         { 1024 768 } draw-texture
 123     ] with-destructors
 124     ;
 125
 126 GAME: fluids {
 127     { world-class fluids-world }
 128     { title "Fluids Test" }
 129     { pixel-format-attributes {
 130         windowed double-buffered T{ depth-bits { value 24 } } } }
 131     { pref-dim { 1024 768 } }
 132     { tick-interval-micros $[ 60 fps ] }
 133 } ;
 134
 135 MAIN: fluids
 136
 137 fluids-world H{
 138     { T{ button-down } [ [
 139         hand-loc get { 1024 768 } v/ 2 v*n 1 v-n { 1 -1 } v* first2 float2_t <struct-boa>
 140         dup 2.0 particle_t <struct-boa> suffix
 141     ] change-particles drop ] }
 142 } set-gestures