improve uniform-tuple interface in gpu.render. uniform-tuples can now contain other uniform-tuples to represent struct uniforms. use glUniform*v to blast uniform arrays in one shot. s/-/_/ in slot names so they look more factorish on the CPU side
parent
93b6b26442
commit
adc6ade589
|
@ -53,22 +53,22 @@ VERTEX-FORMAT: bunny-vertex
|
||||||
VERTEX-STRUCT: bunny-vertex-struct bunny-vertex
|
VERTEX-STRUCT: bunny-vertex-struct bunny-vertex
|
||||||
|
|
||||||
UNIFORM-TUPLE: bunny-uniforms < mvp-uniforms
|
UNIFORM-TUPLE: bunny-uniforms < mvp-uniforms
|
||||||
{ "light_position" float-uniform 3 }
|
{ "light-position" vec3-uniform f }
|
||||||
{ "color" float-uniform 4 }
|
{ "color" vec4-uniform f }
|
||||||
{ "ambient" float-uniform 4 }
|
{ "ambient" vec4-uniform f }
|
||||||
{ "diffuse" float-uniform 4 }
|
{ "diffuse" vec4-uniform f }
|
||||||
{ "shininess" float-uniform 1 } ;
|
{ "shininess" float-uniform f } ;
|
||||||
|
|
||||||
UNIFORM-TUPLE: sobel-uniforms
|
UNIFORM-TUPLE: sobel-uniforms
|
||||||
{ "texcoord_scale" float-uniform 2 }
|
{ "texcoord-scale" vec2-uniform f }
|
||||||
{ "color_texture" texture-uniform 1 }
|
{ "color-texture" texture-uniform f }
|
||||||
{ "normal_texture" texture-uniform 1 }
|
{ "normal-texture" texture-uniform f }
|
||||||
{ "depth_texture" texture-uniform 1 }
|
{ "depth-texture" texture-uniform f }
|
||||||
{ "line_color" float-uniform 4 } ;
|
{ "line-color" vec4-uniform f } ;
|
||||||
|
|
||||||
UNIFORM-TUPLE: loading-uniforms
|
UNIFORM-TUPLE: loading-uniforms
|
||||||
{ "texcoord_scale" float-uniform 2 }
|
{ "texcoord-scale" vec2-uniform f }
|
||||||
{ "loading_texture" texture-uniform 1 } ;
|
{ "loading-texture" texture-uniform f } ;
|
||||||
|
|
||||||
: numbers ( str -- seq )
|
: numbers ( str -- seq )
|
||||||
" " split [ string>number ] map sift ;
|
" " split [ string>number ] map sift ;
|
||||||
|
|
|
@ -11,31 +11,21 @@ GLSL-SHADER-FILE: raytrace-fragment-shader fragment-shader "raytrace.f.glsl"
|
||||||
GLSL-PROGRAM: raytrace-program
|
GLSL-PROGRAM: raytrace-program
|
||||||
raytrace-vertex-shader raytrace-fragment-shader ;
|
raytrace-vertex-shader raytrace-fragment-shader ;
|
||||||
|
|
||||||
|
UNIFORM-TUPLE: sphere-uniforms
|
||||||
|
{ "center" vec3-uniform f }
|
||||||
|
{ "radius" float-uniform f }
|
||||||
|
{ "color" vec4-uniform f } ;
|
||||||
|
|
||||||
UNIFORM-TUPLE: raytrace-uniforms
|
UNIFORM-TUPLE: raytrace-uniforms
|
||||||
{ "mv_inv_matrix" float-uniform { 4 4 } }
|
{ "mv-inv-matrix" mat4-uniform f }
|
||||||
{ "fov" float-uniform 2 }
|
{ "fov" vec2-uniform f }
|
||||||
|
|
||||||
{ "spheres[0].center" float-uniform 3 }
|
{ "spheres" sphere-uniforms 4 }
|
||||||
{ "spheres[0].radius" float-uniform 1 }
|
|
||||||
{ "spheres[0].color" float-uniform 4 }
|
|
||||||
|
|
||||||
{ "spheres[1].center" float-uniform 3 }
|
{ "floor-height" float-uniform f }
|
||||||
{ "spheres[1].radius" float-uniform 1 }
|
{ "floor-color" vec4-uniform 2 }
|
||||||
{ "spheres[1].color" float-uniform 4 }
|
{ "background-color" vec4-uniform f }
|
||||||
|
{ "light-direction" vec3-uniform f } ;
|
||||||
{ "spheres[2].center" float-uniform 3 }
|
|
||||||
{ "spheres[2].radius" float-uniform 1 }
|
|
||||||
{ "spheres[2].color" float-uniform 4 }
|
|
||||||
|
|
||||||
{ "spheres[3].center" float-uniform 3 }
|
|
||||||
{ "spheres[3].radius" float-uniform 1 }
|
|
||||||
{ "spheres[3].color" float-uniform 4 }
|
|
||||||
|
|
||||||
{ "floor_height" float-uniform 1 }
|
|
||||||
{ "floor_color[0]" float-uniform 4 }
|
|
||||||
{ "floor_color[1]" float-uniform 4 }
|
|
||||||
{ "background_color" float-uniform 4 }
|
|
||||||
{ "light_direction" float-uniform 3 } ;
|
|
||||||
|
|
||||||
CONSTANT: reflection-color { 1.0 0.0 1.0 0.0 }
|
CONSTANT: reflection-color { 1.0 0.0 1.0 0.0 }
|
||||||
|
|
||||||
|
@ -64,12 +54,10 @@ TUPLE: raytrace-world < wasd-world
|
||||||
[ fov>> ]
|
[ fov>> ]
|
||||||
[
|
[
|
||||||
spheres>>
|
spheres>>
|
||||||
[ [ sphere-center ] [ radius>> ] [ color>> ] tri 3array ] map
|
[ [ sphere-center ] [ radius>> ] [ color>> ] tri sphere-uniforms boa ] map
|
||||||
first4 [ first3 ] 4 napply
|
|
||||||
] tri
|
] tri
|
||||||
-30.0 ! floor_height
|
-30.0 ! floor_height
|
||||||
{ 1.0 0.0 0.0 1.0 } ! floor_color[0]
|
{ { 1.0 0.0 0.0 1.0 } { 1.0 1.0 1.0 1.0 } } ! floor_color
|
||||||
{ 1.0 1.0 1.0 1.0 } ! floor_color[1]
|
|
||||||
{ 0.15 0.15 1.0 1.0 } ! background_color
|
{ 0.15 0.15 1.0 1.0 } ! background_color
|
||||||
{ 0.0 -1.0 -0.1 } ! light_direction
|
{ 0.0 -1.0 -0.1 } ! light_direction
|
||||||
raytrace-uniforms boa ;
|
raytrace-uniforms boa ;
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
! (c)2009 Joe Groff bsd license
|
! (c)2009 Joe Groff bsd license
|
||||||
USING: accessors alien alien.c-types alien.structs arrays
|
USING: accessors alien alien.c-types alien.structs arrays
|
||||||
assocs classes.mixin classes.parser classes.singleton
|
assocs classes classes.mixin classes.parser classes.singleton
|
||||||
classes.tuple classes.tuple.private combinators combinators.tuple destructors fry
|
classes.tuple classes.tuple.private combinators combinators.tuple destructors fry
|
||||||
generic generic.parser gpu gpu.buffers gpu.framebuffers
|
generic generic.parser gpu gpu.buffers gpu.framebuffers
|
||||||
gpu.framebuffers.private gpu.shaders gpu.state gpu.textures
|
gpu.framebuffers.private gpu.shaders gpu.state gpu.textures
|
||||||
|
@ -8,12 +8,12 @@ gpu.textures.private half-floats images kernel lexer locals
|
||||||
math math.order math.parser namespaces opengl opengl.gl parser
|
math math.order math.parser namespaces opengl opengl.gl parser
|
||||||
quotations sequences slots sorting specialized-arrays.alien
|
quotations sequences slots sorting specialized-arrays.alien
|
||||||
specialized-arrays.float specialized-arrays.int
|
specialized-arrays.float specialized-arrays.int
|
||||||
specialized-arrays.uint strings ui.gadgets.worlds variants
|
specialized-arrays.uint strings tr ui.gadgets.worlds variants
|
||||||
vocabs.parser words ;
|
vocabs.parser words ;
|
||||||
IN: gpu.render
|
IN: gpu.render
|
||||||
|
|
||||||
UNION: ?string string POSTPONE: f ;
|
UNION: ?string string POSTPONE: f ;
|
||||||
UNION: uniform-dim integer sequence ;
|
UNION: ?integer integer POSTPONE: f ;
|
||||||
|
|
||||||
TUPLE: vertex-attribute
|
TUPLE: vertex-attribute
|
||||||
{ name ?string read-only initial: f }
|
{ name ?string read-only initial: f }
|
||||||
|
@ -23,15 +23,44 @@ TUPLE: vertex-attribute
|
||||||
|
|
||||||
VARIANT: uniform-type
|
VARIANT: uniform-type
|
||||||
bool-uniform
|
bool-uniform
|
||||||
|
bvec2-uniform
|
||||||
|
bvec3-uniform
|
||||||
|
bvec4-uniform
|
||||||
uint-uniform
|
uint-uniform
|
||||||
|
uvec2-uniform
|
||||||
|
uvec3-uniform
|
||||||
|
uvec4-uniform
|
||||||
int-uniform
|
int-uniform
|
||||||
|
ivec2-uniform
|
||||||
|
ivec3-uniform
|
||||||
|
ivec4-uniform
|
||||||
float-uniform
|
float-uniform
|
||||||
|
vec2-uniform
|
||||||
|
vec3-uniform
|
||||||
|
vec4-uniform
|
||||||
|
|
||||||
|
mat2-uniform
|
||||||
|
mat2x3-uniform
|
||||||
|
mat2x4-uniform
|
||||||
|
|
||||||
|
mat3x2-uniform
|
||||||
|
mat3-uniform
|
||||||
|
mat3x4-uniform
|
||||||
|
|
||||||
|
mat4x2-uniform
|
||||||
|
mat4x3-uniform
|
||||||
|
mat4-uniform
|
||||||
|
|
||||||
texture-uniform ;
|
texture-uniform ;
|
||||||
|
|
||||||
|
ALIAS: mat2x2-uniform mat2-uniform
|
||||||
|
ALIAS: mat3x3-uniform mat3-uniform
|
||||||
|
ALIAS: mat4x4-uniform mat4-uniform
|
||||||
|
|
||||||
TUPLE: uniform
|
TUPLE: uniform
|
||||||
{ name string read-only initial: "" }
|
{ name string read-only initial: "" }
|
||||||
{ uniform-type uniform-type read-only initial: float-uniform }
|
{ uniform-type class read-only initial: float-uniform }
|
||||||
{ dim uniform-dim read-only initial: 4 } ;
|
{ dim ?integer read-only initial: f } ;
|
||||||
|
|
||||||
VARIANT: index-type
|
VARIANT: index-type
|
||||||
ubyte-indexes
|
ubyte-indexes
|
||||||
|
@ -50,8 +79,6 @@ TUPLE: multi-index-range
|
||||||
|
|
||||||
C: <multi-index-range> multi-index-range
|
C: <multi-index-range> multi-index-range
|
||||||
|
|
||||||
UNION: ?integer integer POSTPONE: f ;
|
|
||||||
|
|
||||||
TUPLE: index-elements
|
TUPLE: index-elements
|
||||||
{ ptr gpu-data-ptr read-only }
|
{ ptr gpu-data-ptr read-only }
|
||||||
{ count integer read-only }
|
{ count integer read-only }
|
||||||
|
@ -242,19 +269,23 @@ M: uniform-tuple bind-uniforms
|
||||||
2drop ;
|
2drop ;
|
||||||
|
|
||||||
: uniform-slot-type ( uniform -- type )
|
: uniform-slot-type ( uniform -- type )
|
||||||
dup dim>> 1 = [
|
dup dim>> [ drop sequence ] [
|
||||||
uniform-type>> {
|
uniform-type>> {
|
||||||
{ bool-uniform [ boolean ] }
|
{ bool-uniform [ boolean ] }
|
||||||
{ uint-uniform [ integer ] }
|
{ uint-uniform [ integer ] }
|
||||||
{ int-uniform [ integer ] }
|
{ int-uniform [ integer ] }
|
||||||
{ float-uniform [ float ] }
|
{ float-uniform [ float ] }
|
||||||
{ texture-uniform [ texture ] }
|
{ texture-uniform [ texture ] }
|
||||||
|
[ drop sequence ]
|
||||||
} case
|
} case
|
||||||
] [ drop sequence ] if ;
|
] if ;
|
||||||
|
|
||||||
: uniform>slot ( uniform -- slot )
|
: uniform>slot ( uniform -- slot )
|
||||||
[ name>> ] [ uniform-slot-type ] bi 2array ;
|
[ name>> ] [ uniform-slot-type ] bi 2array ;
|
||||||
|
|
||||||
|
: uniform-type-texture-units ( uniform-type -- units )
|
||||||
|
dup texture-uniform = [ drop 1 ] [ "uniform-tuple-texture-units" word-prop 0 or ] if ;
|
||||||
|
|
||||||
:: [bind-uniform-texture] ( uniform index -- quot )
|
:: [bind-uniform-texture] ( uniform index -- quot )
|
||||||
uniform name>> reader-word :> value>>-word
|
uniform name>> reader-word :> value>>-word
|
||||||
{ index swap value>>-word (bind-texture-unit) } >quotation ;
|
{ index swap value>>-word (bind-texture-unit) } >quotation ;
|
||||||
|
@ -272,61 +303,144 @@ M: uniform-tuple bind-uniforms
|
||||||
nip texture-uniforms-cleave cleave
|
nip texture-uniforms-cleave cleave
|
||||||
} >quotation ;
|
} >quotation ;
|
||||||
|
|
||||||
:: [bind-uniform] ( texture-unit uniform -- texture-unit' quot )
|
DEFER: [bind-uniform-tuple]
|
||||||
uniform name>> :> name
|
|
||||||
|
:: [bind-uniform-array] ( value>>-quot type texture-unit name dim -- texture-unit' quot )
|
||||||
{ name uniform-index } >quotation :> index-quot
|
{ name uniform-index } >quotation :> index-quot
|
||||||
uniform name>> reader-word 1quotation :> value>>-quot
|
|
||||||
{ index-quot value>>-quot bi* } >quotation :> pre-quot
|
{ index-quot value>>-quot bi* } >quotation :> pre-quot
|
||||||
|
|
||||||
uniform [ uniform-type>> ] [ dim>> ] bi 2array H{
|
type H{
|
||||||
{ { bool-uniform 1 } [ >c-bool glUniform1i ] }
|
{ bool-uniform { dim swap [ >c-bool ] int-array{ } map-as glUniform1iv } }
|
||||||
{ { int-uniform 1 } [ glUniform1i ] }
|
{ int-uniform { dim swap >int-array glUniform1iv } }
|
||||||
{ { uint-uniform 1 } [ glUniform1ui ] }
|
{ uint-uniform { dim swap >uint-array glUniform1uiv } }
|
||||||
{ { float-uniform 1 } [ glUniform1f ] }
|
{ float-uniform { dim swap >float-array glUniform1fv } }
|
||||||
|
|
||||||
{ { bool-uniform 2 } [ [ >c-bool ] map first2 glUniform2i ] }
|
{ bvec2-uniform { dim swap [ [ >c-bool ] map ] map int-array{ } concat-as glUniform2iv } }
|
||||||
{ { int-uniform 2 } [ first2 glUniform2i ] }
|
{ ivec2-uniform { dim swap int-array{ } concat-as glUniform2i } }
|
||||||
{ { uint-uniform 2 } [ first2 glUniform2ui ] }
|
{ uvec2-uniform { dim swap uint-array{ } concat-as glUniform2ui } }
|
||||||
{ { float-uniform 2 } [ first2 glUniform2f ] }
|
{ vec2-uniform { dim swap float-array{ } concat-as glUniform2f } }
|
||||||
|
|
||||||
{ { bool-uniform 3 } [ [ >c-bool ] map first3 glUniform3i ] }
|
{ bvec3-uniform { dim swap [ [ >c-bool ] map ] map int-array{ } concat-as glUniform3iv } }
|
||||||
{ { int-uniform 3 } [ first3 glUniform3i ] }
|
{ ivec3-uniform { dim swap int-array{ } concat-as glUniform3i } }
|
||||||
{ { uint-uniform 3 } [ first3 glUniform3ui ] }
|
{ uvec3-uniform { dim swap uint-array{ } concat-as glUniform3ui } }
|
||||||
{ { float-uniform 3 } [ first3 glUniform3f ] }
|
{ vec3-uniform { dim swap float-array{ } concat-as glUniform3f } }
|
||||||
|
|
||||||
{ { bool-uniform 4 } [ [ >c-bool ] map first4 glUniform4i ] }
|
{ bvec4-uniform { dim swap [ [ >c-bool ] map ] map int-array{ } concat-as glUniform4iv } }
|
||||||
{ { int-uniform 4 } [ first4 glUniform4i ] }
|
{ ivec4-uniform { dim swap int-array{ } concat-as glUniform4iv } }
|
||||||
{ { uint-uniform 4 } [ first4 glUniform4ui ] }
|
{ uvec4-uniform { dim swap uint-array{ } concat-as glUniform4uiv } }
|
||||||
{ { float-uniform 4 } [ first4 glUniform4f ] }
|
{ vec4-uniform { dim swap float-array{ } concat-as glUniform4fv } }
|
||||||
|
|
||||||
{ { float-uniform { 2 2 } } [ [ 1 1 ] dip concat >float-array glUniformMatrix2fv ] }
|
{ mat2-uniform { [ dim 1 ] dip float-array{ } concat-as concat glUniformMatrix2fv } }
|
||||||
{ { float-uniform { 3 2 } } [ [ 1 1 ] dip concat >float-array glUniformMatrix2x3fv ] }
|
{ mat2x3-uniform { [ dim 1 ] dip float-array{ } concat-as concat glUniformMatrix2x3fv } }
|
||||||
{ { float-uniform { 4 2 } } [ [ 1 1 ] dip concat >float-array glUniformMatrix2x4fv ] }
|
{ mat2x4-uniform { [ dim 1 ] dip float-array{ } concat-as concat glUniformMatrix2x4fv } }
|
||||||
|
|
||||||
{ { float-uniform { 2 3 } } [ [ 1 1 ] dip concat >float-array glUniformMatrix3x2fv ] }
|
{ mat3x2-uniform { [ dim 1 ] dip float-array{ } concat-as concat glUniformMatrix3x2fv } }
|
||||||
{ { float-uniform { 3 3 } } [ [ 1 1 ] dip concat >float-array glUniformMatrix3fv ] }
|
{ mat3-uniform { [ dim 1 ] dip float-array{ } concat-as concat glUniformMatrix3fv } }
|
||||||
{ { float-uniform { 4 3 } } [ [ 1 1 ] dip concat >float-array glUniformMatrix3x4fv ] }
|
{ mat3x4-uniform { [ dim 1 ] dip float-array{ } concat-as concat glUniformMatrix3x4fv } }
|
||||||
|
|
||||||
{ { float-uniform { 2 4 } } [ [ 1 1 ] dip concat >float-array glUniformMatrix4x2fv ] }
|
{ mat4x2-uniform { [ dim 1 ] dip float-array{ } concat-as concat glUniformMatrix4x2fv } }
|
||||||
{ { float-uniform { 3 4 } } [ [ 1 1 ] dip concat >float-array glUniformMatrix4x3fv ] }
|
{ mat4x3-uniform { [ dim 1 ] dip float-array{ } concat-as concat glUniformMatrix4x3fv } }
|
||||||
{ { float-uniform { 4 4 } } [ [ 1 1 ] dip concat >float-array glUniformMatrix4fv ] }
|
{ mat4-uniform { [ dim 1 ] dip float-array{ } concat-as concat glUniformMatrix4fv } }
|
||||||
|
|
||||||
{ { texture-uniform 1 } { drop texture-unit glUniform1i } }
|
{ texture-uniform { drop dim iota [ texture-unit + ] int-array{ } map-as glUniform1iv } }
|
||||||
} at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot
|
} at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot
|
||||||
|
|
||||||
uniform uniform-type>> texture-uniform =
|
type uniform-type-texture-units dim * texture-unit +
|
||||||
[ texture-unit 1 + ] [ texture-unit ] if
|
|
||||||
pre-quot value-quot append ;
|
pre-quot value-quot append ;
|
||||||
|
|
||||||
|
:: [bind-uniform-value] ( value>>-quot type texture-unit name -- texture-unit' quot )
|
||||||
|
{ name uniform-index } >quotation :> index-quot
|
||||||
|
{ index-quot value>>-quot bi* } >quotation :> pre-quot
|
||||||
|
|
||||||
|
type H{
|
||||||
|
{ bool-uniform [ >c-bool glUniform1i ] }
|
||||||
|
{ int-uniform [ glUniform1i ] }
|
||||||
|
{ uint-uniform [ glUniform1ui ] }
|
||||||
|
{ float-uniform [ glUniform1f ] }
|
||||||
|
|
||||||
|
{ bvec2-uniform [ [ >c-bool ] map first2 glUniform2i ] }
|
||||||
|
{ ivec2-uniform [ first2 glUniform2i ] }
|
||||||
|
{ uvec2-uniform [ first2 glUniform2ui ] }
|
||||||
|
{ vec2-uniform [ first2 glUniform2f ] }
|
||||||
|
|
||||||
|
{ bvec3-uniform [ [ >c-bool ] map first3 glUniform3i ] }
|
||||||
|
{ ivec3-uniform [ first3 glUniform3i ] }
|
||||||
|
{ uvec3-uniform [ first3 glUniform3ui ] }
|
||||||
|
{ vec3-uniform [ first3 glUniform3f ] }
|
||||||
|
|
||||||
|
{ bvec4-uniform [ [ >c-bool ] map first4 glUniform4i ] }
|
||||||
|
{ ivec4-uniform [ first4 glUniform4i ] }
|
||||||
|
{ uvec4-uniform [ first4 glUniform4ui ] }
|
||||||
|
{ vec4-uniform [ first4 glUniform4f ] }
|
||||||
|
|
||||||
|
{ mat2-uniform [ [ 1 1 ] dip float-array{ } concat-as glUniformMatrix2fv ] }
|
||||||
|
{ mat2x3-uniform [ [ 1 1 ] dip float-array{ } concat-as glUniformMatrix2x3fv ] }
|
||||||
|
{ mat2x4-uniform [ [ 1 1 ] dip float-array{ } concat-as glUniformMatrix2x4fv ] }
|
||||||
|
|
||||||
|
{ mat3x2-uniform [ [ 1 1 ] dip float-array{ } concat-as glUniformMatrix3x2fv ] }
|
||||||
|
{ mat3-uniform [ [ 1 1 ] dip float-array{ } concat-as glUniformMatrix3fv ] }
|
||||||
|
{ mat3x4-uniform [ [ 1 1 ] dip float-array{ } concat-as glUniformMatrix3x4fv ] }
|
||||||
|
|
||||||
|
{ mat4x2-uniform [ [ 1 1 ] dip float-array{ } concat-as glUniformMatrix4x2fv ] }
|
||||||
|
{ mat4x3-uniform [ [ 1 1 ] dip float-array{ } concat-as glUniformMatrix4x3fv ] }
|
||||||
|
{ mat4-uniform [ [ 1 1 ] dip float-array{ } concat-as glUniformMatrix4fv ] }
|
||||||
|
|
||||||
|
{ texture-uniform { drop texture-unit glUniform1i } }
|
||||||
|
} at [ uniform invalid-uniform-type ] unless* >quotation :> value-quot
|
||||||
|
|
||||||
|
type uniform-type-texture-units texture-unit +
|
||||||
|
pre-quot value-quot append ;
|
||||||
|
|
||||||
|
: all-uniform-tuple-slots ( class -- slots )
|
||||||
|
dup "uniform-tuple-slots" word-prop
|
||||||
|
[ swap superclass all-uniform-tuple-slots append ] [ drop { } ] if* ;
|
||||||
|
|
||||||
|
:: [bind-uniform-struct] ( value>>-quot type texture-unit name dim -- texture-unit' quot )
|
||||||
|
dim
|
||||||
|
[
|
||||||
|
iota
|
||||||
|
[ [ [ swap nth ] swap prefix ] map ]
|
||||||
|
[ [ number>string name "[" append "]." surround ] map ] bi
|
||||||
|
] [
|
||||||
|
{ [ ] }
|
||||||
|
name "." append 1array
|
||||||
|
] if* :> name-prefixes :> quot-prefixes
|
||||||
|
type all-uniform-tuple-slots :> uniforms
|
||||||
|
|
||||||
|
texture-unit quot-prefixes name-prefixes [| quot-prefix name-prefix |
|
||||||
|
uniforms name-prefix [bind-uniform-tuple]
|
||||||
|
quot-prefix prepend
|
||||||
|
] 2map :> value-cleave :> texture-unit'
|
||||||
|
|
||||||
|
texture-unit'
|
||||||
|
value>>-quot { value-cleave 2cleave } append ;
|
||||||
|
|
||||||
|
TR: hyphens>underscores "-" "_" ;
|
||||||
|
|
||||||
|
:: [bind-uniform] ( texture-unit uniform prefix -- texture-unit' quot )
|
||||||
|
prefix uniform name>> append hyphens>underscores :> name
|
||||||
|
uniform uniform-type>> :> type
|
||||||
|
uniform dim>> :> dim
|
||||||
|
uniform name>> reader-word 1quotation :> value>>-quot
|
||||||
|
|
||||||
|
value>>-quot type texture-unit name {
|
||||||
|
{ [ type uniform-type? dim and ] [ dim [bind-uniform-array] ] }
|
||||||
|
{ [ type uniform-type? dim not and ] [ [bind-uniform-value] ] }
|
||||||
|
[ dim [bind-uniform-struct] ]
|
||||||
|
} cond ;
|
||||||
|
|
||||||
|
:: [bind-uniform-tuple] ( texture-unit uniforms prefix -- texture-unit' quot )
|
||||||
|
texture-unit uniforms [ prefix [bind-uniform] ] map :> uniforms-cleave :> texture-unit'
|
||||||
|
|
||||||
|
texture-unit'
|
||||||
|
{ uniforms-cleave 2cleave } >quotation ;
|
||||||
|
|
||||||
:: [bind-uniforms] ( superclass uniforms -- quot )
|
:: [bind-uniforms] ( superclass uniforms -- quot )
|
||||||
superclass "uniform-tuple-texture-units" word-prop 0 or :> first-texture-unit
|
superclass "uniform-tuple-texture-units" word-prop 0 or :> first-texture-unit
|
||||||
superclass \ bind-uniforms method :> next-method
|
superclass \ bind-uniforms method :> next-method
|
||||||
first-texture-unit uniforms [ [bind-uniform] ] map nip :> uniforms-cleave
|
first-texture-unit uniforms "" [bind-uniform-tuple] nip :> bind-quot
|
||||||
|
|
||||||
{
|
{ 2dup next-method } bind-quot [ ] append-as ;
|
||||||
2dup next-method
|
|
||||||
uniforms-cleave 2cleave
|
|
||||||
} >quotation ;
|
|
||||||
|
|
||||||
: define-uniform-tuple-methods ( class superclass uniforms -- )
|
: define-uniform-tuple-methods ( class superclass uniforms -- )
|
||||||
[
|
[
|
||||||
|
@ -386,8 +500,8 @@ padding-no [ 0 ] initialize
|
||||||
[ [ uniform>slot ] map define-tuple-class ]
|
[ [ uniform>slot ] map define-tuple-class ]
|
||||||
[ define-uniform-tuple-methods ]
|
[ define-uniform-tuple-methods ]
|
||||||
[
|
[
|
||||||
[ "uniform-tuple-texture-units" word-prop 0 or ]
|
[ uniform-type-texture-units ]
|
||||||
[ [ uniform-type>> texture-uniform = ] filter length ] bi* +
|
[ [ uniform-type>> uniform-type-texture-units ] [ + ] map-reduce ] bi* +
|
||||||
"uniform-tuple-texture-units" set-word-prop
|
"uniform-tuple-texture-units" set-word-prop
|
||||||
]
|
]
|
||||||
[ nip "uniform-tuple-slots" set-word-prop ]
|
[ nip "uniform-tuple-slots" set-word-prop ]
|
||||||
|
|
Loading…
Reference in New Issue