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
8 SPECIALIZED-ARRAY: c:float
11 UNION: ?rect rect POSTPONE: f ;
12 UNION: ?float float POSTPONE: f ;
15 { rect rect read-only } ;
16 C: <viewport-state> viewport-state
19 { rect ?rect read-only } ;
20 C: <scissor-state> scissor-state
22 TUPLE: multisample-state
23 { multisample? boolean read-only }
24 { sample-alpha-to-coverage? boolean read-only }
25 { sample-alpha-to-one? boolean read-only }
26 { sample-coverage ?float read-only }
27 { invert-sample-coverage? boolean read-only } ;
28 C: <multisample-state> multisample-state
32 cmp-less cmp-less-equal cmp-equal
33 cmp-greater-equal cmp-greater cmp-not-equal ;
38 op-inc-wrap op-dec-wrap ;
40 UNION: ?comparison comparison POSTPONE: f ;
43 { value integer initial: 0 read-only }
44 { mask integer initial: HEX: FFFFFFFF read-only }
45 { comparison comparison initial: cmp-always read-only }
46 { stencil-fail-op stencil-op initial: op-keep read-only }
47 { depth-fail-op stencil-op initial: op-keep read-only }
48 { depth-pass-op stencil-op initial: op-keep read-only } ;
49 C: <stencil-mode> stencil-mode
51 UNION: ?stencil-mode stencil-mode POSTPONE: f ;
54 { front-mode ?stencil-mode initial: f read-only }
55 { back-mode ?stencil-mode initial: f read-only } ;
56 C: <stencil-state> stencil-state
58 TUPLE: depth-range-state
59 { near float initial: 0.0 read-only }
60 { far float initial: 1.0 read-only } ;
61 C: <depth-range-state> depth-range-state
64 { comparison ?comparison initial: f read-only } ;
65 C: <depth-state> depth-state
67 VARIANT: blend-equation
68 eq-add eq-subtract eq-reverse-subtract eq-min eq-max ;
69 VARIANT: blend-function
71 func-source func-one-minus-source
72 func-dest func-one-minus-dest
73 func-constant func-one-minus-constant
74 func-source-alpha func-one-minus-source-alpha
75 func-dest-alpha func-one-minus-dest-alpha
76 func-constant-alpha func-one-minus-constant-alpha ;
78 VARIANT: source-only-blend-function
79 func-source-alpha-saturate ;
81 UNION: source-blend-function blend-function source-only-blend-function ;
84 { equation blend-equation initial: eq-add read-only }
85 { source-function source-blend-function initial: func-source-alpha read-only }
86 { dest-function blend-function initial: func-one-minus-source-alpha read-only } ;
87 C: <blend-mode> blend-mode
89 UNION: ?blend-mode blend-mode POSTPONE: f ;
92 { constant-color sequence initial: f read-only }
93 { rgb-mode ?blend-mode read-only }
94 { alpha-mode ?blend-mode read-only } ;
95 C: <blend-state> blend-state
98 { color sequence initial: { t t t t } read-only }
99 { depth boolean initial: t read-only }
100 { stencil-front integer initial: HEX: FFFFFFFF read-only }
101 { stencil-back integer initial: HEX: FFFFFFFF read-only } ;
102 C: <mask-state> mask-state
104 VARIANT: triangle-face
106 VARIANT: triangle-cull
107 cull-front cull-back cull-all ;
108 VARIANT: triangle-mode
109 triangle-points triangle-lines triangle-fill ;
111 UNION: ?triangle-cull triangle-cull POSTPONE: f ;
113 TUPLE: triangle-cull-state
114 { front-face triangle-face initial: face-ccw read-only }
115 { cull ?triangle-cull initial: f read-only } ;
116 C: <triangle-cull-state> triangle-cull-state
118 TUPLE: triangle-state
119 { front-mode triangle-mode initial: triangle-fill read-only }
120 { back-mode triangle-mode initial: triangle-fill read-only }
121 { antialias? boolean initial: f read-only } ;
122 C: <triangle-state> triangle-state
124 VARIANT: point-sprite-origin
125 origin-upper-left origin-lower-left ;
128 { size ?float initial: 1.0 read-only }
129 { sprite-origin point-sprite-origin initial: origin-upper-left read-only }
130 { fade-threshold float initial: 1.0 read-only } ;
131 C: <point-state> point-state
134 { width float initial: 1.0 read-only }
135 { antialias? boolean initial: f read-only } ;
136 C: <line-state> line-state
154 : gl-triangle-face ( triangle-face -- face )
156 { face-ccw [ GL_CCW ] }
157 { face-cw [ GL_CW ] }
160 : gl-triangle-face> ( triangle-face -- face )
162 { $ GL_CCW [ face-ccw ] }
163 { $ GL_CW [ face-cw ] }
166 : gl-triangle-cull ( triangle-cull -- cull )
168 { cull-front [ GL_FRONT ] }
169 { cull-back [ GL_BACK ] }
170 { cull-all [ GL_FRONT_AND_BACK ] }
173 : gl-triangle-cull> ( triangle-cull -- cull )
175 { $ GL_FRONT [ cull-front ] }
176 { $ GL_BACK [ cull-back ] }
177 { $ GL_FRONT_AND_BACK [ cull-all ] }
180 : gl-triangle-mode ( triangle-mode -- mode )
182 { triangle-points [ GL_POINT ] }
183 { triangle-lines [ GL_LINE ] }
184 { triangle-fill [ GL_FILL ] }
187 : gl-triangle-mode> ( triangle-mode -- mode )
189 { $ GL_POINT [ triangle-points ] }
190 { $ GL_LINE [ triangle-lines ] }
191 { $ GL_FILL [ triangle-fill ] }
194 : gl-point-sprite-origin ( point-sprite-origin -- sprite-origin )
196 { origin-upper-left [ GL_UPPER_LEFT ] }
197 { origin-lower-left [ GL_LOWER_LEFT ] }
200 : gl-point-sprite-origin> ( point-sprite-origin -- sprite-origin )
202 { $ GL_UPPER_LEFT [ origin-upper-left ] }
203 { $ GL_LOWER_LEFT [ origin-lower-left ] }
206 : gl-comparison ( comparison -- comparison )
208 { cmp-never [ GL_NEVER ] }
209 { cmp-always [ GL_ALWAYS ] }
210 { cmp-less [ GL_LESS ] }
211 { cmp-less-equal [ GL_LEQUAL ] }
212 { cmp-equal [ GL_EQUAL ] }
213 { cmp-greater-equal [ GL_GEQUAL ] }
214 { cmp-greater [ GL_GREATER ] }
215 { cmp-not-equal [ GL_NOTEQUAL ] }
218 : gl-comparison> ( comparison -- comparison )
220 { $ GL_NEVER [ cmp-never ] }
221 { $ GL_ALWAYS [ cmp-always ] }
222 { $ GL_LESS [ cmp-less ] }
223 { $ GL_LEQUAL [ cmp-less-equal ] }
224 { $ GL_EQUAL [ cmp-equal ] }
225 { $ GL_GEQUAL [ cmp-greater-equal ] }
226 { $ GL_GREATER [ cmp-greater ] }
227 { $ GL_NOTEQUAL [ cmp-not-equal ] }
230 : gl-stencil-op ( stencil-op -- op )
232 { op-keep [ GL_KEEP ] }
233 { op-zero [ GL_ZERO ] }
234 { op-replace [ GL_REPLACE ] }
235 { op-invert [ GL_INVERT ] }
236 { op-inc-sat [ GL_INCR ] }
237 { op-dec-sat [ GL_DECR ] }
238 { op-inc-wrap [ GL_INCR_WRAP ] }
239 { op-dec-wrap [ GL_DECR_WRAP ] }
242 : gl-stencil-op> ( op -- op )
244 { $ GL_KEEP [ op-keep ] }
245 { $ GL_ZERO [ op-zero ] }
246 { $ GL_REPLACE [ op-replace ] }
247 { $ GL_INVERT [ op-invert ] }
248 { $ GL_INCR [ op-inc-sat ] }
249 { $ GL_DECR [ op-dec-sat ] }
250 { $ GL_INCR_WRAP [ op-inc-wrap ] }
251 { $ GL_DECR_WRAP [ op-dec-wrap ] }
254 : (set-stencil-mode) ( gl-face stencil-mode -- )
256 [ [ comparison>> gl-comparison ] [ value>> ] [ mask>> ] tri glStencilFuncSeparate ]
258 [ stencil-fail-op>> ] [ depth-fail-op>> ] [ depth-pass-op>> ] tri
259 [ gl-stencil-op ] tri@ glStencilOpSeparate
263 : gl-blend-equation ( blend-equation -- blend-equation )
265 { eq-add [ GL_FUNC_ADD ] }
266 { eq-subtract [ GL_FUNC_SUBTRACT ] }
267 { eq-reverse-subtract [ GL_FUNC_REVERSE_SUBTRACT ] }
268 { eq-min [ GL_MIN ] }
269 { eq-max [ GL_MAX ] }
272 : gl-blend-equation> ( blend-equation -- blend-equation )
274 { $ GL_FUNC_ADD [ eq-add ] }
275 { $ GL_FUNC_SUBTRACT [ eq-subtract ] }
276 { $ GL_FUNC_REVERSE_SUBTRACT [ eq-reverse-subtract ] }
277 { $ GL_MIN [ eq-min ] }
278 { $ GL_MAX [ eq-max ] }
281 : gl-blend-function ( blend-function -- blend-function )
283 { func-zero [ GL_ZERO ] }
284 { func-one [ GL_ONE ] }
285 { func-source [ GL_SRC_COLOR ] }
286 { func-one-minus-source [ GL_ONE_MINUS_SRC_COLOR ] }
287 { func-dest [ GL_DST_COLOR ] }
288 { func-one-minus-dest [ GL_ONE_MINUS_DST_COLOR ] }
289 { func-constant [ GL_CONSTANT_COLOR ] }
290 { func-one-minus-constant [ GL_ONE_MINUS_CONSTANT_COLOR ] }
291 { func-source-alpha [ GL_SRC_ALPHA ] }
292 { func-one-minus-source-alpha [ GL_ONE_MINUS_SRC_ALPHA ] }
293 { func-dest-alpha [ GL_DST_ALPHA ] }
294 { func-one-minus-dest-alpha [ GL_ONE_MINUS_DST_ALPHA ] }
295 { func-constant-alpha [ GL_CONSTANT_ALPHA ] }
296 { func-one-minus-constant-alpha [ GL_ONE_MINUS_CONSTANT_ALPHA ] }
297 { func-source-alpha-saturate [ GL_SRC_ALPHA_SATURATE ] }
300 : gl-blend-function> ( blend-function -- blend-function )
302 { $ GL_ZERO [ func-zero ] }
303 { $ GL_ONE [ func-one ] }
304 { $ GL_SRC_COLOR [ func-source ] }
305 { $ GL_ONE_MINUS_SRC_COLOR [ func-one-minus-source ] }
306 { $ GL_DST_COLOR [ func-dest ] }
307 { $ GL_ONE_MINUS_DST_COLOR [ func-one-minus-dest ] }
308 { $ GL_CONSTANT_COLOR [ func-constant ] }
309 { $ GL_ONE_MINUS_CONSTANT_COLOR [ func-one-minus-constant ] }
310 { $ GL_SRC_ALPHA [ func-source-alpha ] }
311 { $ GL_ONE_MINUS_SRC_ALPHA [ func-one-minus-source-alpha ] }
312 { $ GL_DST_ALPHA [ func-dest-alpha ] }
313 { $ GL_ONE_MINUS_DST_ALPHA [ func-one-minus-dest-alpha ] }
314 { $ GL_CONSTANT_ALPHA [ func-constant-alpha ] }
315 { $ GL_ONE_MINUS_CONSTANT_ALPHA [ func-one-minus-constant-alpha ] }
316 { $ GL_SRC_ALPHA_SATURATE [ func-source-alpha-saturate ] }
321 GENERIC: set-gpu-state* ( state -- )
323 M: viewport-state set-gpu-state*
324 rect>> [ loc>> first2 ] [ dim>> first2 ] bi glViewport ;
326 M: triangle-cull-state set-gpu-state*
328 [ front-face>> gl-triangle-face glFrontFace ]
329 [ GL_CULL_FACE swap cull>> [ gl-triangle-cull glCullFace glEnable ] [ glDisable ] if* ]
332 M: triangle-state set-gpu-state*
334 [ GL_FRONT swap front-mode>> gl-triangle-mode glPolygonMode ]
335 [ GL_BACK swap back-mode>> gl-triangle-mode glPolygonMode ]
336 [ GL_POLYGON_SMOOTH swap antialias?>> [ glEnable ] [ glDisable ] if ]
339 M: point-state set-gpu-state*
341 [ GL_VERTEX_PROGRAM_POINT_SIZE swap size>> [ glPointSize glDisable ] [ glEnable ] if* ]
342 [ GL_POINT_SPRITE_COORD_ORIGIN swap sprite-origin>> gl-point-sprite-origin glPointParameteri ]
343 [ GL_POINT_FADE_THRESHOLD_SIZE swap fade-threshold>> glPointParameterf ]
346 M: line-state set-gpu-state*
348 [ width>> glLineWidth ]
349 [ GL_LINE_SMOOTH swap antialias?>> [ glEnable ] [ glDisable ] if ]
352 M: scissor-state set-gpu-state*
353 GL_SCISSOR_TEST swap rect>>
354 [ [ loc>> first2 ] [ dim>> first2 ] bi glViewport glEnable ]
357 M: multisample-state set-gpu-state*
359 GL_MULTISAMPLE glEnable
361 [ GL_SAMPLE_ALPHA_TO_COVERAGE swap sample-alpha-to-coverage?>>
362 [ glEnable ] [ glDisable ] if
364 [ GL_SAMPLE_ALPHA_TO_ONE swap sample-alpha-to-one?>>
365 [ glEnable ] [ glDisable ] if
367 [ GL_SAMPLE_COVERAGE swap [ invert-sample-coverage?>> >c-bool ] [ sample-coverage>> ] bi
368 [ swap glSampleCoverage glEnable ] [ drop glDisable ] if*
371 ] [ drop GL_MULTISAMPLE glDisable ] if ;
373 M: stencil-state set-gpu-state*
374 [ ] [ front-mode>> ] [ back-mode>> ] tri or
376 GL_STENCIL_TEST glEnable
377 [ front-mode>> GL_FRONT swap (set-stencil-mode) ]
378 [ back-mode>> GL_BACK swap (set-stencil-mode) ] bi
379 ] [ drop GL_STENCIL_TEST glDisable ] if ;
381 M: depth-range-state set-gpu-state*
382 [ near>> ] [ far>> ] bi glDepthRange ;
384 M: depth-state set-gpu-state*
385 GL_DEPTH_TEST swap comparison>> [ gl-comparison glDepthFunc glEnable ] [ glDisable ] if* ;
387 M: blend-state set-gpu-state*
388 [ ] [ rgb-mode>> ] [ alpha-mode>> ] tri or
391 [ constant-color>> [ first4 glBlendColor ] when* ]
393 [ rgb-mode>> ] [ alpha-mode>> ] bi {
394 [ [ equation>> gl-blend-equation ] bi@ glBlendEquationSeparate ]
397 [ source-function>> gl-blend-function ]
398 [ dest-function>> gl-blend-function ] bi
399 ] bi@ glBlendFuncSeparate
403 ] [ drop GL_BLEND glDisable ] if ;
405 M: mask-state set-gpu-state*
407 [ color>> [ >c-bool ] map first4 glColorMask ]
408 [ depth>> >c-bool glDepthMask ]
409 [ GL_FRONT swap stencil-front>> glStencilMaskSeparate ]
410 [ GL_BACK swap stencil-back>> glStencilMaskSeparate ]
413 : set-gpu-state ( states -- )
415 [ [ set-gpu-state* ] each ]
416 [ set-gpu-state* ] if ; inline
418 : get-gl-bool ( enum -- value )
419 0 uchar <ref> [ glGetBooleanv ] keep uchar deref c-bool> ;
420 : get-gl-int ( enum -- value )
421 0 int <ref> [ glGetIntegerv ] keep int deref ;
422 : get-gl-float ( enum -- value )
423 0 c:float <ref> [ glGetFloatv ] keep c:float deref ;
425 : get-gl-bools ( enum count -- value )
426 <byte-array> [ glGetBooleanv ] keep [ c-bool> ] { } map-as ;
427 : get-gl-ints ( enum count -- value )
428 <int-array> [ glGetIntegerv ] keep ;
429 : get-gl-floats ( enum count -- value )
430 <float-array> [ glGetFloatv ] keep ;
432 : get-gl-rect ( enum -- value )
433 4 get-gl-ints first4 [ 2array ] 2bi@ <rect> ;
435 : gl-enabled? ( enum -- ? )
436 glIsEnabled c-bool> ;
438 TYPED: get-viewport-state ( -- viewport-state: viewport-state )
439 GL_VIEWPORT get-gl-rect <viewport-state> ;
441 TYPED: get-scissor-state ( -- scissor-state: scissor-state )
442 GL_SCISSOR_TEST get-gl-bool
443 [ GL_SCISSOR_BOX get-gl-rect ] [ f ] if
446 TYPED: get-multisample-state ( -- multisample-state: multisample-state )
447 GL_MULTISAMPLE gl-enabled?
448 GL_SAMPLE_ALPHA_TO_COVERAGE gl-enabled?
449 GL_SAMPLE_ALPHA_TO_ONE gl-enabled?
450 GL_SAMPLE_COVERAGE gl-enabled? [
451 GL_SAMPLE_COVERAGE_VALUE get-gl-float
452 GL_SAMPLE_COVERAGE_INVERT get-gl-bool
454 <multisample-state> ;
456 TYPED: get-stencil-state ( -- stencil-state: stencil-state )
457 GL_STENCIL_TEST gl-enabled? [
458 GL_STENCIL_REF get-gl-int
459 GL_STENCIL_VALUE_MASK get-gl-int
460 GL_STENCIL_FUNC get-gl-int gl-comparison>
461 GL_STENCIL_FAIL get-gl-int gl-stencil-op>
462 GL_STENCIL_PASS_DEPTH_FAIL get-gl-int gl-stencil-op>
463 GL_STENCIL_PASS_DEPTH_PASS get-gl-int gl-stencil-op>
466 GL_STENCIL_BACK_REF get-gl-int
467 GL_STENCIL_BACK_VALUE_MASK get-gl-int
468 GL_STENCIL_BACK_FUNC get-gl-int gl-comparison>
469 GL_STENCIL_BACK_FAIL get-gl-int gl-stencil-op>
470 GL_STENCIL_BACK_PASS_DEPTH_FAIL get-gl-int gl-stencil-op>
471 GL_STENCIL_BACK_PASS_DEPTH_PASS get-gl-int gl-stencil-op>
476 TYPED: get-depth-range-state ( -- depth-range-state: depth-range-state )
477 GL_DEPTH_RANGE 2 get-gl-floats first2 <depth-range-state> ;
479 TYPED: get-depth-state ( -- depth-state: depth-state )
480 GL_DEPTH_TEST gl-enabled?
481 [ GL_DEPTH_FUNC get-gl-int gl-comparison> ] [ f ] if
484 TYPED: get-blend-state ( -- blend-state: blend-state )
485 GL_BLEND gl-enabled? [
486 GL_BLEND_COLOR 4 get-gl-floats
488 GL_BLEND_EQUATION_RGB get-gl-int gl-blend-equation>
489 GL_BLEND_SRC_RGB get-gl-int gl-blend-function>
490 GL_BLEND_DST_RGB get-gl-int gl-blend-function>
493 GL_BLEND_EQUATION_ALPHA get-gl-int gl-blend-equation>
494 GL_BLEND_SRC_ALPHA get-gl-int gl-blend-function>
495 GL_BLEND_DST_ALPHA get-gl-int gl-blend-function>
500 TYPED: get-mask-state ( -- mask-state: mask-state )
501 GL_COLOR_WRITEMASK 4 get-gl-bools
502 GL_DEPTH_WRITEMASK get-gl-bool
503 GL_STENCIL_WRITEMASK get-gl-int
504 GL_STENCIL_BACK_WRITEMASK get-gl-int
507 TYPED: get-triangle-cull-state ( -- triangle-cull-state: triangle-cull-state )
508 GL_FRONT_FACE get-gl-int gl-triangle-face>
509 GL_CULL_FACE gl-enabled?
510 [ GL_CULL_FACE_MODE get-gl-int gl-triangle-cull> ]
512 <triangle-cull-state> ;
514 TYPED: get-triangle-state ( -- triangle-state: triangle-state )
515 GL_POLYGON_MODE 2 get-gl-ints
516 first2 [ gl-triangle-mode> ] bi@
517 GL_POLYGON_SMOOTH gl-enabled?
520 TYPED: get-point-state ( -- point-state: point-state )
521 GL_VERTEX_PROGRAM_POINT_SIZE gl-enabled?
522 [ f ] [ GL_POINT_SIZE get-gl-float ] if
523 GL_POINT_SPRITE_COORD_ORIGIN get-gl-int gl-point-sprite-origin>
524 GL_POINT_FADE_THRESHOLD_SIZE get-gl-float
527 TYPED: get-line-state ( -- line-state: line-state )
528 GL_LINE_WIDTH get-gl-float
529 GL_LINE_SMOOTH gl-enabled?