1 ! (c)2010 Joe Groff bsd license
2 USING: accessors alien.c-types alien.data.map arrays assocs
3 combinators fry game.input game.input.scancodes game.loop
4 game.worlds gpu gpu.buffers gpu.framebuffers gpu.render
5 gpu.shaders gpu.state gpu.textures hashtables images kernel
6 literals math math.matrices.simd math.order math.vectors
7 math.vectors.simd papier.map papier.render papier.sprites
8 sequences sorting typed ui ui.gadgets ui.gadgets.worlds
9 ui.gestures ui.pixel-formats math.functions ;
13 CONSTANT: near-plane 0.25
14 CONSTANT: far-plane 1024.0
15 CONSTANT: move-rate 0.05
16 CONSTANT: eye float-4{ 0.0 2.5 7.0 0.0 }
18 CONSTANT: 1/√2 $[ 0.5 sqrt ]
19 CONSTANT: -1/√2 $[ 0.5 sqrt neg ]
21 TUPLE: papier-world < game-world
23 { slabs-by-name hashtable }
24 { slab-images hashtable }
26 { uniforms papier-uniforms }
27 { renderer papier-renderer } ;
29 : load-slabs ( -- slabs )
32 { "backdrop.png" } >>images
34 float-4{ 0 9.0 -2.0 1 } >>center
35 float-4{ 10 10 1 1 } >>size
36 float-4{ 1 0 0 0 } >>orient
37 float-4{ 1 1 1 1 } >>color
38 { { T{ animation-frame f 0 1 } } } swap set-up-sprite
39 dup update-slab-matrix
43 { "ground.png" } >>images
45 float-4{ 0 -1 0 1 } >>center
46 float-4{ 10 2 2 1 } >>size
47 float-4{ $ 1/√2 $ 1/√2 0 0 } >>orient
48 float-4{ 1 1 1 1 } >>color
49 { { T{ animation-frame f 0 1 } } } swap set-up-sprite
50 dup update-slab-matrix
69 float-4{ 3 -0.25 -0.1 1 } >>center
70 float-4{ 0.75 0.75 1.0 1.0 } >>size
71 float-4{ 1 0 0 0 } >>orient
72 float-4{ 1 1 1 1 } >>color
75 T{ animation-frame f 0 2 }
76 T{ animation-frame f 1 2 }
77 T{ animation-frame f 2 2 }
78 T{ animation-frame f 3 2 }
79 T{ animation-frame f 4 2 }
80 T{ animation-frame f 5 2 }
81 T{ animation-frame f 6 2 }
82 T{ animation-frame f 7 2 }
83 T{ animation-frame f 8 2 }
84 T{ animation-frame f 9 2 }
85 T{ animation-frame f 10 2 }
86 T{ animation-frame f 11 2 }
89 dup update-slab-matrix
111 float-4{ -3 0 0 1 } >>center
112 float-4{ 0.75 1.0 1.0 1.0 } >>size
113 float-4{ 1 0 0 0 } >>orient
114 float-4{ 1 1 1 1 } >>color
117 T{ animation-frame f 0 1 }
120 T{ animation-frame f 3 2 }
121 T{ animation-frame f 4 2 }
122 T{ animation-frame f 5 2 }
123 T{ animation-frame f 6 2 }
124 T{ animation-frame f 7 2 }
125 T{ animation-frame f 8 2 }
126 T{ animation-frame f 9 2 }
127 T{ animation-frame f 10 2 }
128 T{ animation-frame f 11 2 }
129 T{ animation-frame f 12 2 }
130 T{ animation-frame f 13 2 }
131 T{ animation-frame f 14 2 }
132 T{ animation-frame f 1 2 }
133 T{ animation-frame f 2 2 }
136 dup update-slab-matrix
140 : load-images ( -- images atlas )
141 "vocab:papier/_resources" load-papier-images ;
143 TYPED: prepare-world-slabs ( world: papier-world -- )
144 [ dup slabs>> slabs-by-name >>slabs-by-name drop ]
145 [ [ slabs>> ] [ slab-images>> ] bi update-slabs-for-atlas ]
146 [ [ uniforms>> atlas>> 0 ] [ atlas>> ] bi allocate-texture-image ] tri ;
148 : dim4 ( world -- dim ) dim>> first2 0 0 float-4-boa ; inline
150 M: papier-world begin-game-world
154 <papier-renderer> >>renderer
156 load-images [ >>slab-images ] [ >>atlas ] bi*
159 over dim4 fov near-plane far-plane <p-matrix> >>p_matrix
161 RGBA ubyte-components T{ texture-parameters
162 { min-mipmap-filter f }
163 } <texture-2d> >>atlas
166 prepare-world-slabs ;
168 : move-eye ( world amount -- )
169 [ uniforms>> ] dip '[ _ v+ ] change-eye drop ; inline
171 : keyboard-input ( papier-world -- movement/f face/f )
172 read-keyboard keys>> {
173 { [ key-left-arrow over nth ] [ 2drop float-4{ $ move-rate 0 0 0 } vneg float-4{ 0 0 1 0 } ] }
174 { [ key-right-arrow over nth ] [ 2drop float-4{ $ move-rate 0 0 0 } float-4{ 1 0 0 0 } ] }
175 { [ key-escape over nth ] [ drop close-window f f ] }
179 : update-slabs ( slabs -- )
180 [ inc-sprite drop ] each ;
182 : move-player ( world move face -- )
183 [ slabs-by-name>> "marco" swap at dup animations>> second switch-animation ] 2dip
184 [ '[ _ v+ ] change-center ] [ >>orient ] bi* update-slab-matrix ;
186 : stop-player ( world -- )
187 slabs-by-name>> "marco" swap at dup animations>> first switch-animation drop ;
189 M: papier-world tick-game-world
190 dup slabs>> update-slabs
194 [ drop stop-player ] if*
197 M: papier-world draw-world*
198 [ renderer>> ] [ uniforms>> ] [ slabs>> ] tri draw-slabs ;
200 M: papier-world resize-world
202 [ dim4 fov near-plane far-plane <p-matrix> ] bi
206 { world-class papier-world }
208 { pixel-format-attributes {
211 T{ depth-bits { value 24 } }
213 { use-game-input? t }
214 { pref-dim { 1024 768 } }
215 { tick-interval-nanos $[ 24 fps ] }