1 ! Copyright (C) 2009 Joe Groff.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alien alien.c-types alien.data arrays
4 assocs classes classes.mixin classes.parser classes.singleton classes.struct
5 classes.tuple classes.tuple.private combinators combinators.tuple destructors fry
6 generic generic.parser gpu gpu.buffers gpu.framebuffers
7 gpu.framebuffers.private gpu.shaders gpu.shaders.private gpu.state
8 gpu.textures gpu.textures.private math.floats.half images kernel
9 lexer locals math math.order math.parser namespaces opengl
10 opengl.gl parser quotations sequences slots sorting
11 specialized-arrays strings ui.gadgets.worlds variants
12 vocabs.parser words math.vectors.simd ;
14 QUALIFIED-WITH: alien.c-types c
15 SPECIALIZED-ARRAYS: c:float c:int c:uchar c:ushort c:uint c:void* ;
50 ALIAS: mat2x2-uniform mat2-uniform
51 ALIAS: mat3x3-uniform mat3-uniform
52 ALIAS: mat4x4-uniform mat4-uniform
55 { name string read-only initial: "" }
56 { uniform-type class read-only initial: float-uniform }
57 { dim maybe{ integer } read-only initial: f } ;
65 { start integer read-only }
66 { count integer read-only } ;
68 C: <index-range> index-range
70 TUPLE: multi-index-range
71 { starts uint-array read-only }
72 { counts uint-array read-only } ;
74 C: <multi-index-range> multi-index-range
78 { count integer read-only }
79 { index-type index-type read-only } ;
81 C: <index-elements> index-elements
83 TUPLE: multi-index-elements
84 { buffer maybe{ buffer } read-only }
86 { counts uint-array read-only }
87 { index-type index-type read-only } ;
89 C: <multi-index-elements> multi-index-elements
100 VARIANT: primitive-mode
104 lines-with-adjacency-mode
105 line-strip-with-adjacency-mode
109 triangles-with-adjacency-mode
110 triangle-strip-with-adjacency-mode
113 TUPLE: uniform-tuple ;
115 ERROR: invalid-uniform-type uniform ;
119 : gl-index-type ( index-type -- gl-index-type )
121 { ubyte-indexes [ GL_UNSIGNED_BYTE ] }
122 { ushort-indexes [ GL_UNSIGNED_SHORT ] }
123 { uint-indexes [ GL_UNSIGNED_INT ] }
126 : gl-primitive-mode ( primitive-mode -- gl-primitive-mode )
128 { points-mode [ GL_POINTS ] }
129 { lines-mode [ GL_LINES ] }
130 { line-strip-mode [ GL_LINE_STRIP ] }
131 { line-loop-mode [ GL_LINE_LOOP ] }
132 { triangles-mode [ GL_TRIANGLES ] }
133 { triangle-strip-mode [ GL_TRIANGLE_STRIP ] }
134 { triangle-fan-mode [ GL_TRIANGLE_FAN ] }
135 { lines-with-adjacency-mode [ GL_LINES_ADJACENCY ] }
136 { line-strip-with-adjacency-mode [ GL_LINE_STRIP_ADJACENCY ] }
137 { triangles-with-adjacency-mode [ GL_TRIANGLES_ADJACENCY ] }
138 { triangle-strip-with-adjacency-mode [ GL_TRIANGLE_STRIP_ADJACENCY ] }
141 GENERIC: render-vertex-indexes ( primitive-mode vertex-indexes -- )
143 GENERIC#: render-vertex-indexes-instanced 1 ( primitive-mode vertex-indexes instances -- )
145 GENERIC: gl-array-element-type ( array -- type )
146 M: uchar-array gl-array-element-type drop GL_UNSIGNED_BYTE ; inline
147 M: ushort-array gl-array-element-type drop GL_UNSIGNED_SHORT ; inline
148 M: uint-array gl-array-element-type drop GL_UNSIGNED_INT ; inline
150 M: index-range render-vertex-indexes
151 [ gl-primitive-mode ] [ [ start>> ] [ count>> ] bi ] bi* glDrawArrays ;
153 M: index-range render-vertex-indexes-instanced
154 [ gl-primitive-mode ] [ [ start>> ] [ count>> ] bi ] [ ] tri*
155 glDrawArraysInstanced ;
157 M: multi-index-range render-vertex-indexes
158 [ gl-primitive-mode ] [ [ starts>> ] [ counts>> dup length ] bi ] bi*
161 M: index-elements render-vertex-indexes
162 [ gl-primitive-mode ]
163 [ [ count>> ] [ index-type>> gl-index-type ] [ ptr>> ] tri ] bi*
164 index-buffer [ glDrawElements ] with-gpu-data-ptr ;
166 M: index-elements render-vertex-indexes-instanced
167 [ gl-primitive-mode ]
168 [ [ count>> ] [ index-type>> gl-index-type ] [ ptr>> ] tri ]
170 swap index-buffer [ swap glDrawElementsInstanced ] with-gpu-data-ptr ;
172 M: specialized-array render-vertex-indexes
173 GL_ELEMENT_ARRAY_BUFFER 0 glBindBuffer
174 [ gl-primitive-mode ]
175 [ [ length ] [ gl-array-element-type ] [ >c-ptr ] tri ] bi*
178 M: specialized-array render-vertex-indexes-instanced
179 GL_ELEMENT_ARRAY_BUFFER 0 glBindBuffer
180 [ gl-primitive-mode ]
181 [ [ length ] [ gl-array-element-type ] [ >c-ptr ] tri ]
182 [ ] tri* glDrawElementsInstanced ;
184 M: multi-index-elements render-vertex-indexes
185 [ gl-primitive-mode ]
186 [ { [ counts>> ] [ index-type>> gl-index-type ] [ ptrs>> dup length ] [ buffer>> ] } cleave ]
188 GL_ELEMENT_ARRAY_BUFFER swap [ handle>> ] [ 0 ] if* glBindBuffer glMultiDrawElements ;
190 : (bind-texture-unit) ( texture texture-unit -- )
191 swap [ GL_TEXTURE0 + glActiveTexture ] [ bind-texture drop ] bi* ; inline
193 GENERIC: (bind-uniform-textures) ( program-instance uniform-tuple -- )
194 GENERIC: (bind-uniforms) ( program-instance uniform-tuple -- )
196 M: uniform-tuple (bind-uniform-textures)
198 M: uniform-tuple (bind-uniforms)
201 : uniform-slot-type ( uniform -- type )
202 dup dim>> [ drop sequence ] [
204 { bool-uniform [ boolean ] }
205 { uint-uniform [ integer ] }
206 { int-uniform [ integer ] }
207 { float-uniform [ float ] }
208 { texture-uniform [ texture ] }
213 : uniform>slot ( uniform -- slot )
214 [ name>> ] [ uniform-slot-type ] bi 2array ;
216 : uniform-type-texture-units ( uniform-type -- units )
217 dup texture-uniform = [ drop 1 ] [ "uniform-tuple-texture-units" word-prop 0 or ] if ;
219 : all-uniform-tuple-slots ( class -- slots )
220 dup "uniform-tuple-slots" word-prop
221 [ [ superclass-of all-uniform-tuple-slots ] dip append ] [ drop { } ] if* ;
223 DEFER: uniform-texture-accessors
225 : uniform-type-texture-accessors ( uniform-type -- accessors )
226 texture-uniform = [ { [ ] } ] [ { } ] if ;
228 : uniform-slot-texture-accessor ( uniform -- accessor )
229 [ name>> reader-word ] [ [ uniform-type>> ] [ dim>> ] bi uniform-texture-accessors ] bi
230 dup length 1 = [ first swap prefix ] [ [ ] 2sequence ] if ;
232 : uniform-tuple-texture-accessors ( uniform-type -- accessors )
233 all-uniform-tuple-slots [ uniform-type>> uniform-type-texture-units zero? ] reject
234 [ uniform-slot-texture-accessor ] map ;
236 : uniform-texture-accessors ( uniform-type dim -- accessors )
239 [ uniform-type-texture-accessors ]
240 [ uniform-tuple-texture-accessors ] if
242 2dup swap empty? not and [
244 [ swap nth ] swap prefix
245 over length 1 = [ swap first append ] [ swap suffix ] if
250 : texture-accessor>cleave ( unit accessors -- unit' cleaves )
252 [ [ last [ texture-accessor>cleave ] map ] [ but-last ] bi swap suffix \ cleave suffix ]
253 [ over suffix \ (bind-texture-unit) suffix [ 1 + ] dip ] if ;
255 : [bind-uniform-textures] ( class -- quot )
256 f uniform-texture-accessors
257 0 swap [ texture-accessor>cleave ] map nip
258 \ nip swap \ cleave [ ] 3sequence ;
261 c-ptr specialized-array struct simd-128 ;
263 GENERIC: >uniform-bool-array ( sequence -- c-array )
264 GENERIC: >uniform-int-array ( sequence -- c-array )
265 GENERIC: >uniform-uint-array ( sequence -- c-array )
266 GENERIC: >uniform-float-array ( sequence -- c-array )
268 GENERIC#: >uniform-bvec-array 1 ( sequence dim -- c-array )
269 GENERIC#: >uniform-ivec-array 1 ( sequence dim -- c-array )
270 GENERIC#: >uniform-uvec-array 1 ( sequence dim -- c-array )
271 GENERIC#: >uniform-vec-array 1 ( sequence dim -- c-array )
273 GENERIC#: >uniform-matrix 2 ( sequence cols rows -- c-array )
275 GENERIC#: >uniform-matrix-array 2 ( sequence cols rows -- c-array )
277 GENERIC: bind-uniform-bvec2 ( index sequence -- )
278 GENERIC: bind-uniform-bvec3 ( index sequence -- )
279 GENERIC: bind-uniform-bvec4 ( index sequence -- )
280 GENERIC: bind-uniform-ivec2 ( index sequence -- )
281 GENERIC: bind-uniform-ivec3 ( index sequence -- )
282 GENERIC: bind-uniform-ivec4 ( index sequence -- )
283 GENERIC: bind-uniform-uvec2 ( index sequence -- )
284 GENERIC: bind-uniform-uvec3 ( index sequence -- )
285 GENERIC: bind-uniform-uvec4 ( index sequence -- )
286 GENERIC: bind-uniform-vec2 ( index sequence -- )
287 GENERIC: bind-uniform-vec3 ( index sequence -- )
288 GENERIC: bind-uniform-vec4 ( index sequence -- )
290 M: object >uniform-bool-array [ >c-bool ] int-array{ } map-as ; inline
291 M: binary-data >uniform-bool-array ; inline
293 M: object >uniform-int-array c:int >c-array ; inline
294 M: binary-data >uniform-int-array ; inline
296 M: object >uniform-uint-array c:uint >c-array ; inline
297 M: binary-data >uniform-uint-array ; inline
299 M: object >uniform-float-array c:float >c-array ; inline
300 M: binary-data >uniform-float-array ; inline
302 M: object >uniform-bvec-array '[ _ head-slice [ >c-bool ] int-array{ } map-as ] map concat ; inline
303 M: binary-data >uniform-bvec-array drop ; inline
305 M: object >uniform-ivec-array '[ _ head ] map int-array{ } concat-as ; inline
306 M: binary-data >uniform-ivec-array drop ; inline
308 M: object >uniform-uvec-array '[ _ head ] map uint-array{ } concat-as ; inline
309 M: binary-data >uniform-uvec-array drop ; inline
311 M: object >uniform-vec-array '[ _ head ] map float-array{ } concat-as ; inline
312 M: binary-data >uniform-vec-array drop ; inline
314 M:: object >uniform-matrix ( sequence cols rows -- c-array )
315 sequence flip cols head-slice
316 [ rows head-slice c:float >c-array ] { } map-as concat ; inline
317 M: binary-data >uniform-matrix 2drop ; inline
319 M: object >uniform-matrix-array
320 '[ _ _ >uniform-matrix ] map concat ; inline
321 M: binary-data >uniform-matrix-array 2drop ; inline
323 M: object bind-uniform-bvec2 ( index sequence -- )
324 1 swap 2 head-slice [ >c-bool ] int-array{ } map-as glUniform2iv ; inline
325 M: binary-data bind-uniform-bvec2 ( index sequence -- )
326 1 swap glUniform2iv ; inline
327 M: object bind-uniform-bvec3 ( index sequence -- )
328 1 swap 3 head-slice [ >c-bool ] int-array{ } map-as glUniform3iv ; inline
329 M: binary-data bind-uniform-bvec3 ( index sequence -- )
330 1 swap glUniform3iv ; inline
331 M: object bind-uniform-bvec4 ( index sequence -- )
332 1 swap 4 head-slice [ >c-bool ] int-array{ } map-as glUniform4iv ; inline
333 M: binary-data bind-uniform-bvec4 ( index sequence -- )
334 1 swap glUniform4iv ; inline
336 M: object bind-uniform-ivec2 ( index sequence -- ) first2 glUniform2i ; inline
337 M: binary-data bind-uniform-ivec2 ( index sequence -- ) 1 swap glUniform2iv ; inline
339 M: object bind-uniform-ivec3 ( index sequence -- ) first3 glUniform3i ; inline
340 M: binary-data bind-uniform-ivec3 ( index sequence -- ) 1 swap glUniform3iv ; inline
342 M: object bind-uniform-ivec4 ( index sequence -- ) first4 glUniform4i ; inline
343 M: binary-data bind-uniform-ivec4 ( index sequence -- ) 1 swap glUniform4iv ; inline
345 M: object bind-uniform-uvec2 ( index sequence -- ) first2 glUniform2ui ; inline
346 M: binary-data bind-uniform-uvec2 ( index sequence -- ) 1 swap glUniform2uiv ; inline
348 M: object bind-uniform-uvec3 ( index sequence -- ) first3 glUniform3ui ; inline
349 M: binary-data bind-uniform-uvec3 ( index sequence -- ) 1 swap glUniform3uiv ; inline
351 M: object bind-uniform-uvec4 ( index sequence -- ) first4 glUniform4ui ; inline
352 M: binary-data bind-uniform-uvec4 ( index sequence -- ) 1 swap glUniform4uiv ; inline
354 M: object bind-uniform-vec2 ( index sequence -- ) first2 glUniform2f ; inline
355 M: binary-data bind-uniform-vec2 ( index sequence -- ) 1 swap glUniform2fv ; inline
357 M: object bind-uniform-vec3 ( index sequence -- ) first3 glUniform3f ; inline
358 M: binary-data bind-uniform-vec3 ( index sequence -- ) 1 swap glUniform3fv ; inline
360 M: object bind-uniform-vec4 ( index sequence -- ) first4 glUniform4f ; inline
361 M: binary-data bind-uniform-vec4 ( index sequence -- ) 1 swap glUniform4fv ; inline
363 DEFER: [bind-uniform-tuple]
365 :: [bind-uniform-array] ( value>>-quot type texture-unit name dim -- texture-unit' quot )
366 { name uniform-index } >quotation :> index-quot
367 { index-quot value>>-quot bi* } >quotation :> pre-quot
370 { bool-uniform { dim swap >uniform-bool-array glUniform1iv } }
371 { int-uniform { dim swap >uniform-int-array glUniform1iv } }
372 { uint-uniform { dim swap >uniform-uint-array glUniform1uiv } }
373 { float-uniform { dim swap >uniform-float-array glUniform1fv } }
375 { bvec2-uniform { dim swap 2 >uniform-bvec-array glUniform2iv } }
376 { ivec2-uniform { dim swap 2 >uniform-ivec-array glUniform2i } }
377 { uvec2-uniform { dim swap 2 >uniform-uvec-array glUniform2ui } }
378 { vec2-uniform { dim swap 2 >uniform-vec-array glUniform2f } }
380 { bvec3-uniform { dim swap 3 >uniform-bvec-array glUniform3iv } }
381 { ivec3-uniform { dim swap 3 >uniform-ivec-array glUniform3i } }
382 { uvec3-uniform { dim swap 3 >uniform-uvec-array glUniform3ui } }
383 { vec3-uniform { dim swap 3 >uniform-vec-array glUniform3f } }
385 { bvec4-uniform { dim swap 4 >uniform-bvec-array glUniform4iv } }
386 { ivec4-uniform { dim swap 4 >uniform-ivec-array glUniform4iv } }
387 { uvec4-uniform { dim swap 4 >uniform-uvec-array glUniform4uiv } }
388 { vec4-uniform { dim swap 4 >uniform-vec-array glUniform4fv } }
390 { mat2-uniform { [ dim 0 ] dip 2 2 >uniform-matrix-array glUniformMatrix2fv } }
391 { mat2x3-uniform { [ dim 0 ] dip 2 3 >uniform-matrix-array glUniformMatrix2x3fv } }
392 { mat2x4-uniform { [ dim 0 ] dip 2 4 >uniform-matrix-array glUniformMatrix2x4fv } }
394 { mat3x2-uniform { [ dim 0 ] dip 3 2 >uniform-matrix-array glUniformMatrix3x2fv } }
395 { mat3-uniform { [ dim 0 ] dip 3 3 >uniform-matrix-array glUniformMatrix3fv } }
396 { mat3x4-uniform { [ dim 0 ] dip 3 4 >uniform-matrix-array glUniformMatrix3x4fv } }
398 { mat4x2-uniform { [ dim 0 ] dip 4 2 >uniform-matrix-array glUniformMatrix4x2fv } }
399 { mat4x3-uniform { [ dim 0 ] dip 4 3 >uniform-matrix-array glUniformMatrix4x3fv } }
400 { mat4-uniform { [ dim 0 ] dip 4 4 >uniform-matrix-array glUniformMatrix4fv } }
402 { texture-uniform { drop dim dup <iota> [ texture-unit + ] int-array{ } map-as glUniform1iv } }
403 } at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot
405 type uniform-type-texture-units dim * texture-unit +
406 pre-quot value-quot append ;
408 :: [bind-uniform-value] ( value>>-quot type texture-unit name -- texture-unit' quot )
409 { name uniform-index } >quotation :> index-quot
410 { index-quot value>>-quot bi* } >quotation :> pre-quot
413 { bool-uniform [ >c-bool glUniform1i ] }
414 { int-uniform [ glUniform1i ] }
415 { uint-uniform [ glUniform1ui ] }
416 { float-uniform [ glUniform1f ] }
418 { bvec2-uniform [ bind-uniform-bvec2 ] }
419 { ivec2-uniform [ bind-uniform-ivec2 ] }
420 { uvec2-uniform [ bind-uniform-uvec2 ] }
421 { vec2-uniform [ bind-uniform-vec2 ] }
423 { bvec3-uniform [ bind-uniform-bvec3 ] }
424 { ivec3-uniform [ bind-uniform-ivec3 ] }
425 { uvec3-uniform [ bind-uniform-uvec3 ] }
426 { vec3-uniform [ bind-uniform-vec3 ] }
428 { bvec4-uniform [ bind-uniform-bvec4 ] }
429 { ivec4-uniform [ bind-uniform-ivec4 ] }
430 { uvec4-uniform [ bind-uniform-uvec4 ] }
431 { vec4-uniform [ bind-uniform-vec4 ] }
433 { mat2-uniform [ [ 1 0 ] dip 2 2 >uniform-matrix glUniformMatrix2fv ] }
434 { mat2x3-uniform [ [ 1 0 ] dip 2 3 >uniform-matrix glUniformMatrix2x3fv ] }
435 { mat2x4-uniform [ [ 1 0 ] dip 2 4 >uniform-matrix glUniformMatrix2x4fv ] }
437 { mat3x2-uniform [ [ 1 0 ] dip 3 2 >uniform-matrix glUniformMatrix3x2fv ] }
438 { mat3-uniform [ [ 1 0 ] dip 3 3 >uniform-matrix glUniformMatrix3fv ] }
439 { mat3x4-uniform [ [ 1 0 ] dip 3 4 >uniform-matrix glUniformMatrix3x4fv ] }
441 { mat4x2-uniform [ [ 1 0 ] dip 4 2 >uniform-matrix glUniformMatrix4x2fv ] }
442 { mat4x3-uniform [ [ 1 0 ] dip 4 3 >uniform-matrix glUniformMatrix4x3fv ] }
443 { mat4-uniform [ [ 1 0 ] dip 4 4 >uniform-matrix glUniformMatrix4fv ] }
445 { texture-uniform { drop texture-unit glUniform1i } }
446 } at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot
448 type uniform-type-texture-units texture-unit +
449 pre-quot value-quot append ;
451 :: [bind-uniform-struct] ( value>>-quot type texture-unit name dim -- texture-unit' quot )
455 [ [ [ swap nth ] swap prefix ] map ]
456 [ [ number>string name "[" append "]." surround ] map ] bi
459 name "." append 1array
460 ] if* :> ( quot-prefixes name-prefixes )
461 type all-uniform-tuple-slots :> uniforms
463 texture-unit quot-prefixes name-prefixes [| quot-prefix name-prefix |
464 uniforms name-prefix [bind-uniform-tuple]
466 ] 2map :> ( texture-unit' value-cleave )
469 value>>-quot { value-cleave 2cleave } append ;
471 :: [bind-uniform] ( texture-unit uniform prefix -- texture-unit' quot )
472 prefix uniform name>> append hyphens>underscores :> name
473 uniform uniform-type>> :> type
475 uniform name>> reader-word 1quotation :> value>>-quot
477 value>>-quot type texture-unit name {
478 { [ type uniform-type? dim and ] [ dim [bind-uniform-array] ] }
479 { [ type uniform-type? dim not and ] [ [bind-uniform-value] ] }
480 [ dim [bind-uniform-struct] ]
483 :: [bind-uniform-tuple] ( texture-unit uniforms prefix -- texture-unit' quot )
484 texture-unit uniforms [ prefix [bind-uniform] ] map :> ( texture-unit' uniforms-cleave )
487 { uniforms-cleave 2cleave } >quotation ;
489 :: [bind-uniforms] ( superclass uniforms -- quot )
490 superclass "uniform-tuple-texture-units" word-prop 0 or :> first-texture-unit
491 superclass \ (bind-uniforms) lookup-method :> next-method
492 first-texture-unit uniforms "" [bind-uniform-tuple] nip :> bind-quot
494 { 2dup next-method } bind-quot [ ] append-as ;
496 : define-uniform-tuple-methods ( class superclass uniforms -- )
499 [ \ (bind-uniform-textures) create-method-in ]
500 [ [bind-uniform-textures] ] bi define
502 [ \ (bind-uniforms) create-method-in ] 2dip
503 [bind-uniforms] define
506 : parse-uniform-tuple-definition ( -- class superclass uniforms )
507 scan-new-class scan-token {
508 { ";" [ uniform-tuple f ] }
509 { "<" [ scan-word parse-array-def [ first3 uniform boa ] map ] }
512 \ } parse-until parse-array-def swap prefix
513 [ first3 uniform boa ] map
517 : (define-uniform-tuple) ( class superclass uniforms -- )
519 [ [ uniform>slot ] map define-tuple-class ]
521 [ uniform-type-texture-units ]
523 [ [ uniform-type>> uniform-type-texture-units ] [ dim>> 1 or ] bi * ]
526 "uniform-tuple-texture-units" set-word-prop
528 [ nip "uniform-tuple-slots" set-word-prop ]
529 [ define-uniform-tuple-methods ]
532 : true-subclasses ( class -- seq )
533 [ subclasses ] keep [ = ] curry reject ;
537 : define-uniform-tuple ( class superclass uniforms -- )
538 (define-uniform-tuple) ; inline
540 SYNTAX: UNIFORM-TUPLE:
541 parse-uniform-tuple-definition define-uniform-tuple ;
545 : bind-unnamed-output-attachments ( framebuffer attachments -- )
546 [ gl-attachment ] with map
548 [ first glDrawBuffer ]
549 [ [ length ] [ c:int >c-array ] bi glDrawBuffers ] if ;
551 : bind-named-output-attachments ( program-instance framebuffer attachments -- )
552 rot '[ first _ swap output-index ] sort-with values
553 bind-unnamed-output-attachments ;
555 : bind-output-attachments ( program-instance framebuffer attachments -- )
557 [ bind-named-output-attachments ] [ nipd bind-unnamed-output-attachments ] if ;
559 GENERIC: bind-transform-feedback-output ( output -- )
561 M: buffer bind-transform-feedback-output
562 [ GL_TRANSFORM_FEEDBACK_BUFFER 0 ] dip handle>> glBindBufferBase ; inline
564 M: buffer-range bind-transform-feedback-output
565 [ GL_TRANSFORM_FEEDBACK_BUFFER 0 ] dip
566 [ handle>> ] [ offset>> ] [ size>> ] tri glBindBufferRange ; inline
568 M: buffer-ptr bind-transform-feedback-output
569 buffer-ptr>range bind-transform-feedback-output ; inline
571 : gl-feedback-primitive-mode ( primitive-mode -- gl-mode )
573 { points-mode [ GL_POINTS ] }
574 { lines-mode [ GL_LINES ] }
575 { line-strip-mode [ GL_LINES ] }
576 { line-loop-mode [ GL_LINES ] }
577 { triangles-mode [ GL_TRIANGLES ] }
578 { triangle-strip-mode [ GL_TRIANGLES ] }
579 { triangle-fan-mode [ GL_TRIANGLES ] }
584 UNION: transform-feedback-output buffer buffer-range POSTPONE: f ;
587 { primitive-mode primitive-mode read-only }
588 { vertex-array vertex-array initial: T{ vertex-array-collection } read-only }
589 { uniforms uniform-tuple read-only }
590 { indexes vertex-indexes initial: T{ index-range } read-only }
591 { instances maybe{ integer } initial: f read-only }
592 { framebuffer maybe{ any-framebuffer } initial: system-framebuffer read-only }
593 { output-attachments sequence initial: { default-attachment } read-only }
594 { transform-feedback-output transform-feedback-output initial: f read-only } ;
596 : <render-set> ( x quot-assoc -- render-set )
597 render-set swap make-tuple ; inline
599 : 2<render-set> ( x y quot-assoc -- render-set )
600 render-set swap 2make-tuple ; inline
602 : 3<render-set> ( x y z quot-assoc -- render-set )
603 render-set swap 3make-tuple ; inline
605 : bind-uniforms ( program-instance uniforms -- )
606 [ (bind-uniform-textures) ] [ (bind-uniforms) ] 2bi ; inline
608 : render ( render-set -- )
610 [ vertex-array>> program-instance>> handle>> glUseProgram ]
612 [ vertex-array>> program-instance>> ] [ uniforms>> ] bi
617 [ GL_DRAW_FRAMEBUFFER swap framebuffer-handle glBindFramebuffer ]
618 [ GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer GL_RASTERIZER_DISCARD glEnable ] if*
621 [ vertex-array>> program-instance>> ]
623 [ output-attachments>> ] tri
624 bind-output-attachments
626 [ vertex-array>> bind-vertex-array ]
628 dup transform-feedback-output>> [
629 [ primitive-mode>> gl-feedback-primitive-mode glBeginTransformFeedback ]
630 [ bind-transform-feedback-output ] bi*
635 [ primitive-mode>> ] [ indexes>> ] [ instances>> ] tri
636 [ render-vertex-indexes-instanced ]
637 [ render-vertex-indexes ] if*
640 [ transform-feedback-output>> [ glEndTransformFeedback ] when ]
641 [ framebuffer>> [ GL_RASTERIZER_DISCARD glDisable ] unless ]