]> gitweb.factorcode.org Git - factor.git/blob - extra/gpu/state/state.factor
use radix literals
[factor.git] / extra / gpu / state / state.factor
1 ! (c)2009 Joe Groff bsd license
2 USING: accessors alien.c-types alien.data arrays byte-arrays
3 combinators gpu kernel literals math math.rectangles opengl
4 opengl.gl sequences typed variants specialized-arrays ;
5 QUALIFIED-WITH: alien.c-types c
6 FROM: math => float ;
7 SPECIALIZED-ARRAY: c:int
8 SPECIALIZED-ARRAY: c:float
9 IN: gpu.state
10
11 TUPLE: viewport-state
12     { rect rect read-only } ;
13 C: <viewport-state> viewport-state
14
15 TUPLE: scissor-state
16     { rect maybe: rect read-only } ;
17 C: <scissor-state> scissor-state
18
19 TUPLE: multisample-state
20     { multisample? boolean read-only }
21     { sample-alpha-to-coverage? boolean read-only }
22     { sample-alpha-to-one? boolean read-only }
23     { sample-coverage maybe: float read-only }
24     { invert-sample-coverage? boolean read-only } ;
25 C: <multisample-state> multisample-state
26
27 VARIANT: comparison
28     cmp-never cmp-always
29     cmp-less cmp-less-equal cmp-equal
30     cmp-greater-equal cmp-greater cmp-not-equal ;
31 VARIANT: stencil-op
32     op-keep op-zero
33     op-replace op-invert
34     op-inc-sat op-dec-sat
35     op-inc-wrap op-dec-wrap ;
36
37 TUPLE: stencil-mode
38     { value integer initial: 0 read-only }
39     { mask integer initial: 0xFFFFFFFF read-only }
40     { comparison comparison initial: cmp-always read-only }
41     { stencil-fail-op stencil-op initial: op-keep read-only }
42     { depth-fail-op stencil-op initial: op-keep read-only }
43     { depth-pass-op stencil-op initial: op-keep read-only } ;
44 C: <stencil-mode> stencil-mode
45
46 TUPLE: stencil-state
47     { front-mode maybe: stencil-mode initial: f read-only }
48     { back-mode maybe: stencil-mode initial: f read-only } ;
49 C: <stencil-state> stencil-state
50
51 TUPLE: depth-range-state
52     { near float initial: 0.0 read-only }
53     { far  float initial: 1.0 read-only } ;
54 C: <depth-range-state> depth-range-state
55
56 TUPLE: depth-state
57     { comparison maybe: comparison initial: f read-only } ;
58 C: <depth-state> depth-state
59
60 VARIANT: blend-equation
61     eq-add eq-subtract eq-reverse-subtract eq-min eq-max ;
62 VARIANT: blend-function
63     func-zero func-one
64     func-source func-one-minus-source
65     func-dest func-one-minus-dest
66     func-constant func-one-minus-constant
67     func-source-alpha func-one-minus-source-alpha
68     func-dest-alpha func-one-minus-dest-alpha
69     func-constant-alpha func-one-minus-constant-alpha ;
70
71 VARIANT: source-only-blend-function
72     func-source-alpha-saturate ;
73
74 UNION: source-blend-function blend-function source-only-blend-function ;
75
76 TUPLE: blend-mode
77     { equation blend-equation initial: eq-add read-only }
78     { source-function source-blend-function initial: func-source-alpha read-only }
79     { dest-function blend-function initial: func-one-minus-source-alpha read-only } ;
80 C: <blend-mode> blend-mode
81
82 TUPLE: blend-state
83     { constant-color sequence initial: f read-only }
84     { rgb-mode maybe: blend-mode read-only }
85     { alpha-mode maybe: blend-mode read-only } ;
86 C: <blend-state> blend-state
87
88 TUPLE: mask-state
89     { color sequence initial: { t t t t } read-only }
90     { depth boolean initial: t read-only }
91     { stencil-front integer initial: 0xFFFFFFFF read-only }
92     { stencil-back integer initial: 0xFFFFFFFF read-only } ;
93 C: <mask-state> mask-state
94
95 VARIANT: triangle-face
96     face-ccw face-cw ;
97 VARIANT: triangle-cull
98     cull-front cull-back cull-all ;
99 VARIANT: triangle-mode
100     triangle-points triangle-lines triangle-fill ;
101
102 TUPLE: triangle-cull-state
103     { front-face triangle-face initial: face-ccw read-only }
104     { cull maybe: triangle-cull initial: f read-only } ;
105 C: <triangle-cull-state> triangle-cull-state
106
107 TUPLE: triangle-state
108     { front-mode triangle-mode initial: triangle-fill read-only }
109     { back-mode triangle-mode initial: triangle-fill read-only }
110     { antialias? boolean initial: f read-only } ;
111 C: <triangle-state> triangle-state
112
113 VARIANT: point-sprite-origin 
114     origin-upper-left origin-lower-left ;
115
116 TUPLE: point-state
117     { size maybe: float initial: 1.0 read-only }
118     { sprite-origin point-sprite-origin initial: origin-upper-left read-only }
119     { fade-threshold float initial: 1.0 read-only } ;
120 C: <point-state> point-state
121
122 TUPLE: line-state
123     { width float initial: 1.0 read-only }
124     { antialias? boolean initial: f read-only } ;
125 C: <line-state> line-state
126
127 UNION: gpu-state
128     viewport-state
129     triangle-cull-state
130     triangle-state
131     point-state
132     line-state
133     scissor-state
134     multisample-state
135     stencil-state
136     depth-range-state
137     depth-state
138     blend-state
139     mask-state ;
140
141 <PRIVATE
142
143 : gl-triangle-face ( triangle-face -- face )
144     { 
145         { face-ccw [ GL_CCW ] }
146         { face-cw  [ GL_CW  ] }
147     } case ;
148
149 : gl-triangle-face> ( triangle-face -- face )
150     { 
151         { $ GL_CCW [ face-ccw ] }
152         { $ GL_CW  [ face-cw  ] }
153     } case ;
154
155 : gl-triangle-cull ( triangle-cull -- cull )
156     {
157         { cull-front [ GL_FRONT          ] }
158         { cull-back  [ GL_BACK           ] }
159         { cull-all   [ GL_FRONT_AND_BACK ] }
160     } case ;
161
162 : gl-triangle-cull> ( triangle-cull -- cull )
163     {
164         { $ GL_FRONT          [ cull-front ] }
165         { $ GL_BACK           [ cull-back  ] }
166         { $ GL_FRONT_AND_BACK [ cull-all   ] }
167     } case ;
168
169 : gl-triangle-mode ( triangle-mode -- mode )
170     {
171         { triangle-points [ GL_POINT ] }
172         { triangle-lines  [ GL_LINE  ] }
173         { triangle-fill   [ GL_FILL  ] }
174     } case ;
175
176 : gl-triangle-mode> ( triangle-mode -- mode )
177     {
178         { $ GL_POINT [ triangle-points ] }
179         { $ GL_LINE  [ triangle-lines  ] }
180         { $ GL_FILL  [ triangle-fill   ] }
181     } case ;
182
183 : gl-point-sprite-origin ( point-sprite-origin -- sprite-origin )
184     {
185         { origin-upper-left [ GL_UPPER_LEFT ] }
186         { origin-lower-left [ GL_LOWER_LEFT ] }
187     } case ;
188
189 : gl-point-sprite-origin> ( point-sprite-origin -- sprite-origin )
190     {
191         { $ GL_UPPER_LEFT [ origin-upper-left ] }
192         { $ GL_LOWER_LEFT [ origin-lower-left ] }
193     } case ;
194
195 : gl-comparison ( comparison -- comparison )
196     {
197         { cmp-never         [ GL_NEVER    ] } 
198         { cmp-always        [ GL_ALWAYS   ] }
199         { cmp-less          [ GL_LESS     ] }
200         { cmp-less-equal    [ GL_LEQUAL   ] }
201         { cmp-equal         [ GL_EQUAL    ] }
202         { cmp-greater-equal [ GL_GEQUAL   ] }
203         { cmp-greater       [ GL_GREATER  ] }
204         { cmp-not-equal     [ GL_NOTEQUAL ] }
205     } case ;
206
207 : gl-comparison> ( comparison -- comparison )
208     {
209         { $ GL_NEVER    [ cmp-never         ] } 
210         { $ GL_ALWAYS   [ cmp-always        ] }
211         { $ GL_LESS     [ cmp-less          ] }
212         { $ GL_LEQUAL   [ cmp-less-equal    ] }
213         { $ GL_EQUAL    [ cmp-equal         ] }
214         { $ GL_GEQUAL   [ cmp-greater-equal ] }
215         { $ GL_GREATER  [ cmp-greater       ] }
216         { $ GL_NOTEQUAL [ cmp-not-equal     ] }
217     } case ;
218
219 : gl-stencil-op ( stencil-op -- op )
220     {
221         { op-keep [ GL_KEEP ] }
222         { op-zero [ GL_ZERO ] }
223         { op-replace [ GL_REPLACE ] }
224         { op-invert [ GL_INVERT ] }
225         { op-inc-sat [ GL_INCR ] }
226         { op-dec-sat [ GL_DECR ] }
227         { op-inc-wrap [ GL_INCR_WRAP ] }
228         { op-dec-wrap [ GL_DECR_WRAP ] }
229     } case ;
230
231 : gl-stencil-op> ( op -- op )
232     {
233         { $ GL_KEEP      [ op-keep     ] }
234         { $ GL_ZERO      [ op-zero     ] }
235         { $ GL_REPLACE   [ op-replace  ] }
236         { $ GL_INVERT    [ op-invert   ] }
237         { $ GL_INCR      [ op-inc-sat  ] }
238         { $ GL_DECR      [ op-dec-sat  ] }
239         { $ GL_INCR_WRAP [ op-inc-wrap ] }
240         { $ GL_DECR_WRAP [ op-dec-wrap ] }
241     } case ;
242
243 : (set-stencil-mode) ( gl-face stencil-mode -- )
244     {
245         [ [ comparison>> gl-comparison ] [ value>> ] [ mask>> ] tri glStencilFuncSeparate ]
246         [
247             [ stencil-fail-op>> ] [ depth-fail-op>> ] [ depth-pass-op>> ] tri
248             [ gl-stencil-op ] tri@ glStencilOpSeparate
249         ]
250     } 2cleave ;
251
252 : gl-blend-equation ( blend-equation -- blend-equation )
253     {
254         { eq-add              [ GL_FUNC_ADD              ] }
255         { eq-subtract         [ GL_FUNC_SUBTRACT         ] }
256         { eq-reverse-subtract [ GL_FUNC_REVERSE_SUBTRACT ] }
257         { eq-min              [ GL_MIN                   ] }
258         { eq-max              [ GL_MAX                   ] }
259     } case ;
260
261 : gl-blend-equation> ( blend-equation -- blend-equation )
262     {
263         { $ GL_FUNC_ADD              [ eq-add              ] }
264         { $ GL_FUNC_SUBTRACT         [ eq-subtract         ] }
265         { $ GL_FUNC_REVERSE_SUBTRACT [ eq-reverse-subtract ] }
266         { $ GL_MIN                   [ eq-min              ] }
267         { $ GL_MAX                   [ eq-max              ] }
268     } case ;
269
270 : gl-blend-function ( blend-function -- blend-function )
271     {
272         { func-zero                     [ GL_ZERO                     ] }
273         { func-one                      [ GL_ONE                      ] }
274         { func-source                   [ GL_SRC_COLOR                ] }
275         { func-one-minus-source         [ GL_ONE_MINUS_SRC_COLOR      ] }
276         { func-dest                     [ GL_DST_COLOR                ] }
277         { func-one-minus-dest           [ GL_ONE_MINUS_DST_COLOR      ] }
278         { func-constant                 [ GL_CONSTANT_COLOR           ] }
279         { func-one-minus-constant       [ GL_ONE_MINUS_CONSTANT_COLOR ] }
280         { func-source-alpha             [ GL_SRC_ALPHA                ] }
281         { func-one-minus-source-alpha   [ GL_ONE_MINUS_SRC_ALPHA      ] }
282         { func-dest-alpha               [ GL_DST_ALPHA                ] }
283         { func-one-minus-dest-alpha     [ GL_ONE_MINUS_DST_ALPHA      ] }
284         { func-constant-alpha           [ GL_CONSTANT_ALPHA           ] }
285         { func-one-minus-constant-alpha [ GL_ONE_MINUS_CONSTANT_ALPHA ] }
286         { func-source-alpha-saturate    [ GL_SRC_ALPHA_SATURATE       ] }
287     } case ;
288
289 : gl-blend-function> ( blend-function -- blend-function )
290     {
291         { $ GL_ZERO                     [ func-zero                     ] }
292         { $ GL_ONE                      [ func-one                      ] }
293         { $ GL_SRC_COLOR                [ func-source                   ] }
294         { $ GL_ONE_MINUS_SRC_COLOR      [ func-one-minus-source         ] }
295         { $ GL_DST_COLOR                [ func-dest                     ] }
296         { $ GL_ONE_MINUS_DST_COLOR      [ func-one-minus-dest           ] }
297         { $ GL_CONSTANT_COLOR           [ func-constant                 ] }
298         { $ GL_ONE_MINUS_CONSTANT_COLOR [ func-one-minus-constant       ] }
299         { $ GL_SRC_ALPHA                [ func-source-alpha             ] }
300         { $ GL_ONE_MINUS_SRC_ALPHA      [ func-one-minus-source-alpha   ] }
301         { $ GL_DST_ALPHA                [ func-dest-alpha               ] }
302         { $ GL_ONE_MINUS_DST_ALPHA      [ func-one-minus-dest-alpha     ] }
303         { $ GL_CONSTANT_ALPHA           [ func-constant-alpha           ] }
304         { $ GL_ONE_MINUS_CONSTANT_ALPHA [ func-one-minus-constant-alpha ] }
305         { $ GL_SRC_ALPHA_SATURATE       [ func-source-alpha-saturate    ] }
306     } case ;
307
308 PRIVATE>
309
310 GENERIC: set-gpu-state* ( state -- )
311
312 M: viewport-state set-gpu-state*
313     rect>> [ loc>> first2 ] [ dim>> first2 ] bi glViewport ;
314
315 M: triangle-cull-state set-gpu-state*
316     {
317         [ front-face>> gl-triangle-face glFrontFace ]
318         [ GL_CULL_FACE swap cull>> [ gl-triangle-cull glCullFace glEnable ] [ glDisable ] if* ]
319     } cleave ;
320
321 M: triangle-state set-gpu-state*
322     {
323         [ GL_FRONT swap front-mode>> gl-triangle-mode glPolygonMode ]
324         [ GL_BACK swap back-mode>> gl-triangle-mode glPolygonMode ]
325         [ GL_POLYGON_SMOOTH swap antialias?>> [ glEnable ] [ glDisable ] if ]
326     } cleave ;
327
328 M: point-state set-gpu-state*
329     {
330         [ GL_VERTEX_PROGRAM_POINT_SIZE swap size>> [ glPointSize glDisable ] [ glEnable ] if* ]
331         [ GL_POINT_SPRITE_COORD_ORIGIN swap sprite-origin>> gl-point-sprite-origin glPointParameteri ]
332         [ GL_POINT_FADE_THRESHOLD_SIZE swap fade-threshold>> glPointParameterf ]
333     } cleave ;
334
335 M: line-state set-gpu-state*
336     {
337         [ width>> glLineWidth ]
338         [ GL_LINE_SMOOTH swap antialias?>> [ glEnable ] [ glDisable ] if ]
339     } cleave ;
340
341 M: scissor-state set-gpu-state*
342     GL_SCISSOR_TEST swap rect>>
343     [ [ loc>> first2 ] [ dim>> first2 ] bi glViewport glEnable ]
344     [ glDisable ] if* ;
345
346 M: multisample-state set-gpu-state*
347     dup multisample?>> [
348         GL_MULTISAMPLE glEnable
349         {
350             [ GL_SAMPLE_ALPHA_TO_COVERAGE swap sample-alpha-to-coverage?>>
351                 [ glEnable ] [ glDisable ] if
352             ]
353             [ GL_SAMPLE_ALPHA_TO_ONE swap sample-alpha-to-one?>>
354                 [ glEnable ] [ glDisable ] if
355             ]
356             [ GL_SAMPLE_COVERAGE swap [ invert-sample-coverage?>> >c-bool ] [ sample-coverage>> ] bi
357                 [ swap glSampleCoverage glEnable ] [ drop glDisable ] if*
358             ]
359         } cleave
360     ] [ drop GL_MULTISAMPLE glDisable ] if ;
361
362 M: stencil-state set-gpu-state*
363     [ ] [ front-mode>> ] [ back-mode>> ] tri or
364     [
365         GL_STENCIL_TEST glEnable
366         [ front-mode>> GL_FRONT swap (set-stencil-mode) ]
367         [ back-mode>> GL_BACK swap (set-stencil-mode) ] bi
368     ] [ drop GL_STENCIL_TEST glDisable ] if ;
369
370 M: depth-range-state set-gpu-state*
371     [ near>> ] [ far>> ] bi glDepthRange ;
372
373 M: depth-state set-gpu-state*
374     GL_DEPTH_TEST swap comparison>> [ gl-comparison glDepthFunc glEnable ] [ glDisable ] if* ;
375
376 M: blend-state set-gpu-state*
377     [ ] [ rgb-mode>> ] [ alpha-mode>> ] tri or
378     [
379         GL_BLEND glEnable
380         [ constant-color>> [ first4 glBlendColor ] when* ]
381         [
382             [ rgb-mode>> ] [ alpha-mode>> ] bi {
383                 [ [ equation>> gl-blend-equation ] bi@ glBlendEquationSeparate ]
384                 [
385                     [
386                         [ source-function>> gl-blend-function ]
387                         [ dest-function>> gl-blend-function ] bi
388                     ] bi@ glBlendFuncSeparate
389                 ]
390             } 2cleave
391         ] bi
392     ] [ drop GL_BLEND glDisable ] if ;
393
394 M: mask-state set-gpu-state*
395     {
396         [ color>> [ >c-bool ] map first4 glColorMask ]
397         [ depth>> >c-bool glDepthMask ]
398         [ GL_FRONT swap stencil-front>> glStencilMaskSeparate ]
399         [ GL_BACK  swap stencil-back>> glStencilMaskSeparate ]
400     } cleave ;
401
402 : set-gpu-state ( states -- )
403     dup sequence?
404     [ [ set-gpu-state* ] each ]
405     [ set-gpu-state* ] if ; inline
406
407 : get-gl-bool ( enum -- value )
408     0 c:uchar <ref> [ glGetBooleanv ] keep c:uchar deref c-bool> ;
409 : get-gl-int ( enum -- value )
410     0 c:int <ref> [ glGetIntegerv ] keep c:int deref ;
411 : get-gl-float ( enum -- value )
412     0 c:float <ref> [ glGetFloatv ] keep c:float deref ;
413
414 : get-gl-bools ( enum count -- value )
415     <byte-array> [ glGetBooleanv ] keep [ c-bool> ] { } map-as ;
416 : get-gl-ints ( enum count -- value )
417     c:int <c-array> [ glGetIntegerv ] keep ;
418 : get-gl-floats ( enum count -- value )
419     c:float <c-array> [ glGetFloatv ] keep ;
420
421 : get-gl-rect ( enum -- value )
422     4 get-gl-ints first4 [ 2array ] 2bi@ <rect> ;
423
424 : gl-enabled? ( enum -- ? )
425     glIsEnabled c-bool> ;
426
427 TYPED: get-viewport-state ( -- viewport-state: viewport-state )
428     GL_VIEWPORT get-gl-rect <viewport-state> ;
429
430 TYPED: get-scissor-state ( -- scissor-state: scissor-state )
431     GL_SCISSOR_TEST get-gl-bool
432     [ GL_SCISSOR_BOX get-gl-rect ] [ f ] if
433     <scissor-state> ;
434
435 TYPED: get-multisample-state ( -- multisample-state: multisample-state )
436     GL_MULTISAMPLE gl-enabled?
437     GL_SAMPLE_ALPHA_TO_COVERAGE gl-enabled?
438     GL_SAMPLE_ALPHA_TO_ONE gl-enabled?
439     GL_SAMPLE_COVERAGE gl-enabled? [
440         GL_SAMPLE_COVERAGE_VALUE get-gl-float
441         GL_SAMPLE_COVERAGE_INVERT get-gl-bool
442     ] [ f f ] if
443     <multisample-state> ;
444
445 TYPED: get-stencil-state ( -- stencil-state: stencil-state )
446     GL_STENCIL_TEST gl-enabled? [
447         GL_STENCIL_REF get-gl-int
448         GL_STENCIL_VALUE_MASK get-gl-int
449         GL_STENCIL_FUNC get-gl-int gl-comparison>
450         GL_STENCIL_FAIL get-gl-int gl-stencil-op>
451         GL_STENCIL_PASS_DEPTH_FAIL get-gl-int gl-stencil-op>
452         GL_STENCIL_PASS_DEPTH_PASS get-gl-int gl-stencil-op>
453         <stencil-mode>
454
455         GL_STENCIL_BACK_REF get-gl-int
456         GL_STENCIL_BACK_VALUE_MASK get-gl-int
457         GL_STENCIL_BACK_FUNC get-gl-int gl-comparison>
458         GL_STENCIL_BACK_FAIL get-gl-int gl-stencil-op>
459         GL_STENCIL_BACK_PASS_DEPTH_FAIL get-gl-int gl-stencil-op>
460         GL_STENCIL_BACK_PASS_DEPTH_PASS get-gl-int gl-stencil-op>
461         <stencil-mode>
462     ] [ f f ] if
463     <stencil-state> ;
464
465 TYPED: get-depth-range-state ( -- depth-range-state: depth-range-state )
466     GL_DEPTH_RANGE 2 get-gl-floats first2 <depth-range-state> ;
467
468 TYPED: get-depth-state ( -- depth-state: depth-state )
469     GL_DEPTH_TEST gl-enabled?
470     [ GL_DEPTH_FUNC get-gl-int gl-comparison> ] [ f ] if
471     <depth-state> ;
472
473 TYPED: get-blend-state ( -- blend-state: blend-state )
474     GL_BLEND gl-enabled? [
475         GL_BLEND_COLOR 4 get-gl-floats
476
477         GL_BLEND_EQUATION_RGB get-gl-int gl-blend-equation>
478         GL_BLEND_SRC_RGB get-gl-int gl-blend-function>
479         GL_BLEND_DST_RGB get-gl-int gl-blend-function>
480         <blend-mode>
481
482         GL_BLEND_EQUATION_ALPHA get-gl-int gl-blend-equation>
483         GL_BLEND_SRC_ALPHA get-gl-int gl-blend-function>
484         GL_BLEND_DST_ALPHA get-gl-int gl-blend-function>
485         <blend-mode>
486     ] [ f f f ] if
487     <blend-state> ;
488
489 TYPED: get-mask-state ( -- mask-state: mask-state )
490     GL_COLOR_WRITEMASK 4 get-gl-bools 
491     GL_DEPTH_WRITEMASK get-gl-bool
492     GL_STENCIL_WRITEMASK get-gl-int
493     GL_STENCIL_BACK_WRITEMASK get-gl-int
494     <mask-state> ;
495
496 TYPED: get-triangle-cull-state ( -- triangle-cull-state: triangle-cull-state )
497     GL_FRONT_FACE get-gl-int gl-triangle-face>
498     GL_CULL_FACE gl-enabled?
499     [ GL_CULL_FACE_MODE get-gl-int gl-triangle-cull> ]
500     [ f ] if
501     <triangle-cull-state> ;
502
503 TYPED: get-triangle-state ( -- triangle-state: triangle-state )
504     GL_POLYGON_MODE 2 get-gl-ints
505     first2 [ gl-triangle-mode> ] bi@
506     GL_POLYGON_SMOOTH gl-enabled?
507     <triangle-state> ;
508
509 TYPED: get-point-state ( -- point-state: point-state )
510     GL_VERTEX_PROGRAM_POINT_SIZE gl-enabled?
511     [ f ] [ GL_POINT_SIZE get-gl-float ] if
512     GL_POINT_SPRITE_COORD_ORIGIN get-gl-int gl-point-sprite-origin> 
513     GL_POINT_FADE_THRESHOLD_SIZE get-gl-float
514     <point-state> ;
515
516 TYPED: get-line-state ( -- line-state: line-state )
517     GL_LINE_WIDTH get-gl-float
518     GL_LINE_SMOOTH gl-enabled?
519     <line-state> ;