]> gitweb.factorcode.org Git - factor.git/blob - extra/fluids/fluids.factor
Get fluids working on Mac
[factor.git] / 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.framebuffers gpu.render gpu.shaders
5 gpu.state gpu.textures gpu.util images images.loader kernel literals
6 locals make math math.rectangles math.vectors namespaces opengl.gl
7 sequences specialized-arrays ui.gadgets.worlds images.ppm
8 ui.gestures ui.pixel-formats images.pgm gpu.effects.blur
9 gpu.effects.step ;
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 framebuffer color-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
104     RGB float-components T{ texture-parameters
105                             { wrap clamp-texcoord-to-edge }
106                             { min-filter filter-linear }
107                             { min-mipmap-filter f } }
108     <texture-2d> >>color-texture
109
110     dup color-texture>> 0 <texture-2d-attachment> 1array f f { 320 240 } <framebuffer> >>framebuffer
111     drop ;
112
113 M: fluids-world end-game-world
114     framebuffer>> dispose ;
115
116 M: fluids-world tick-game-world
117     dup paused>> [ drop ] [ integrate ] if ;
118
119 M:: fluids-world draw-world* ( world -- )
120     world framebuffer>> { { default-attachment { 0 0 0 } } } clear-framebuffer
121     system-framebuffer { { default-attachment { 0 0 0 } } } clear-framebuffer
122
123     f eq-add func-one func-one <blend-mode> dup <blend-state> set-gpu-state
124     f origin-upper-left 1.0 <point-state> set-gpu-state
125     world particles>> [
126         [ p>> [ x>> , ] [ y>> , ] bi ] each
127     ] curry float-array{ } make :> verts
128     
129     { 0 0 } { 320 240 } <rect> <viewport-state> set-gpu-state
130     GL_POINT_SPRITE glEnable
131     world verts {
132         { "primitive-mode" [ 2drop points-mode ] }
133         { "uniforms"       [ drop texture>> 50.0 window-point-uniforms boa ] }
134         { "vertex-array"   [ nip stream-upload draw-usage vertex-buffer byte-array>buffer &dispose window-point-program <program-instance> &dispose <vertex-array> &dispose ] }
135         { "indexes"        [ nip length 2 / 0 swap <index-range> ] }
136         { "framebuffer"    [ drop framebuffer>> ] }
137     } 2<render-set> render
138
139     world color-texture>> gaussian-blur
140     { 0 0 } { 640 480 } <rect> <viewport-state> set-gpu-state
141     world ramp>> {
142         { "primitive-mode" [ 2drop triangle-strip-mode ] }
143         { "uniforms"       [ step-uniforms boa ] }
144         { "vertex-array"   [ 2drop <window-vertex-buffer> step-program <program-instance> <vertex-array> ] }
145         { "indexes"        [ 2drop T{ index-range f 0 4 } ] }
146     } 2<render-set> render
147     ;
148
149 GAME: fluids {
150     { world-class fluids-world }
151     { title "Fluids Test" }
152     { pixel-format-attributes {
153         windowed double-buffered T{ depth-bits { value 24 } } } }
154     { pref-dim { 640 480 } }
155     { tick-interval-micros $[ 60 fps ] }
156 } ;
157
158 MAIN: fluids
159
160 fluids-world H{
161     { T{ button-down } [ [
162         hand-loc get { 640 480 } v/ 2 v*n 1 v-n { 1 -1 } v* first2 float2_t <struct-boa>
163         dup 2.0 particle_t <struct-boa> suffix
164     ] change-particles drop ] }
165 } set-gestures