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

Joe Groff 2009-07-22 22:32:02 -05:00
parent 93b6b26442
commit adc6ade589
3 changed files with 193 additions and 91 deletions

View File

@ -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 ;

View File

@ -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 ;

View File

@ -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 ]