change GLSL-PROGRAM: syntax to allow for vertex formats to be specified for link-time attribute index assignment with glBindAttribLocation. the transform feedback format now needs to be marked with "feedback-format:"

extra/gpu/demos/bunny/bunny.factor

@@ -13,20 +13,33 @@ SPECIALIZED-ARRAY: float
 SPECIALIZED-VECTOR: uint
 IN: gpu.demos.bunny
 
+VERTEX-FORMAT: bunny-vertex
+    { "vertex" float-components 3 f }
+    { f        float-components 1 f }
+    { "normal" float-components 3 f }
+    { f        float-components 1 f } ;
+
+STRUCT: bunny-vertex-struct
+    { vertex float-4 }
+    { normal float-4 } ;
+
 GLSL-SHADER-FILE: bunny-vertex-shader vertex-shader "bunny.v.glsl"
 GLSL-SHADER-FILE: bunny-fragment-shader fragment-shader "bunny.f.glsl"
 GLSL-PROGRAM: bunny-program
-    bunny-vertex-shader bunny-fragment-shader ;
+    bunny-vertex-shader bunny-fragment-shader
+    bunny-vertex ;
 
 GLSL-SHADER-FILE: window-vertex-shader vertex-shader "window.v.glsl"
 
 GLSL-SHADER-FILE: sobel-fragment-shader fragment-shader "sobel.f.glsl"
 GLSL-PROGRAM: sobel-program
-    window-vertex-shader sobel-fragment-shader ;
+    window-vertex-shader sobel-fragment-shader
+    window-vertex ;
 
 GLSL-SHADER-FILE: loading-fragment-shader fragment-shader "loading.f.glsl"
 GLSL-PROGRAM: loading-program
-    window-vertex-shader loading-fragment-shader ;
+    window-vertex-shader loading-fragment-shader
+    window-vertex ;
 
 TUPLE: bunny-state
     vertexes
@@ -48,16 +61,6 @@ TUPLE: loading-state
 TUPLE: bunny-world < wasd-world
     bunny sobel loading ;
 
-VERTEX-FORMAT: bunny-vertex
-    { "vertex" float-components 3 f }
-    { f        float-components 1 f }
-    { "normal" float-components 3 f }
-    { f        float-components 1 f } ;
-
-STRUCT: bunny-vertex-struct
-    { vertex float-4 }
-    { normal float-4 } ;
-
 SPECIALIZED-VECTOR: bunny-vertex-struct
 
 UNIFORM-TUPLE: bunny-uniforms < mvp-uniforms

extra/gpu/demos/raytrace/raytrace.factor

@@ -9,7 +9,8 @@ IN: gpu.demos.raytrace
 GLSL-SHADER-FILE: raytrace-vertex-shader vertex-shader "raytrace.v.glsl"
 GLSL-SHADER-FILE: raytrace-fragment-shader fragment-shader "raytrace.f.glsl"
 GLSL-PROGRAM: raytrace-program
-    raytrace-vertex-shader raytrace-fragment-shader ;
+    raytrace-vertex-shader raytrace-fragment-shader
+    window-vertex ;
 
 UNIFORM-TUPLE: sphere-uniforms
     { "center" vec3-uniform  f }

extra/gpu/shaders/shaders-docs.factor

@@ -24,9 +24,13 @@ HELP: <vertex-array>
 }
 { $description "Creates a new " { $link vertex-array } " to feed data to " { $snippet "program-instance" } " from the set of " { $link buffer } "s specified in " { $snippet "vertex-formats" } "." } ;
 
+HELP: feedback-format:
+{ $syntax "feedback-format: vertex-format" }
+{ $description "When used as part of a " { $link GLSL-PROGRAM: } " definition, this syntax specifies the " { $link vertex-format } " in which transform feedback output will be generated." } ;
+
 HELP: GLSL-PROGRAM:
-{ $syntax "GLSL-PROGRAM: program-name shader shader ... shader [vertex-format] ;" }
+{ $syntax "GLSL-PROGRAM: program-name shader shader ... [vertex-format vertex-format ...] [feedback-format: vertex-format] ;" }
-{ $description "Defines a new " { $link program } " named " { $snippet "program-name" } ". When the program is instantiated with " { $link <program-instance> } ", it will link together instances of all of the specified " { $link shader } "s to create the program instance. A single " { $link vertex-array } " may optionally be specified; if the program is used to collect transform feedback, this format will be used for the output." }
+{ $description "Defines a new " { $link program } " named " { $snippet "program-name" } ". When the program is instantiated with " { $link <program-instance> } ", it will link together instances of all of the specified " { $link shader } "s to create the program instance. If any " { $link vertex-format } "s are specified, their attributes will be pre-assigned attribute indexes at link time, to ensure that their indexes remain constant if the program is refreshed with " { $link refresh-program } ". A trasform feedback vertex format may optionally be specified with " { $link feedback-format: } "; if the program is used to collect transform feedback, the given vertex format will be used for the output." }
 { $notes "Transform feedback requires OpenGL 3.0 or one of the " { $snippet "GL_EXT_transform_feedback" } " or " { $snippet "GL_ARB_transform_feedback" } " extensions." } ;
 
 HELP: GLSL-SHADER-FILE:

extra/gpu/shaders/shaders.factor

@@ -2,7 +2,7 @@
 USING: accessors alien alien.c-types alien.data alien.strings
 arrays assocs byte-arrays classes.mixin classes.parser
 classes.singleton classes.struct combinators combinators.short-circuit
-definitions destructors generic.parser gpu gpu.buffers hashtables
+definitions destructors fry generic.parser gpu gpu.buffers hashtables
 images io.encodings.ascii io.files io.pathnames kernel lexer
 literals locals math math.parser memoize multiline namespaces
 opengl opengl.gl opengl.shaders parser quotations sequences
@@ -45,6 +45,7 @@ TUPLE: program
     { filename read-only }
     { line integer read-only }
     { shaders array read-only }
+    { vertex-formats array read-only }
     { feedback-format ?vertex-format read-only }
     { instances hashtable read-only } ;
 
@@ -65,6 +66,9 @@ MEMO: attribute-index ( program-instance attribute-name -- index )
 MEMO: output-index ( program-instance output-name -- index )
     [ handle>> ] dip glGetFragDataLocation ;
 
+: vertex-format-attributes ( vertex-format -- attributes )
+    "vertex-format-attributes" word-prop ; inline    
+
 <PRIVATE
 
 TR: hyphens>underscores "-" "_" ;
@@ -200,6 +204,10 @@ GENERIC: link-feedback-format ( program-handle format -- )
 M: f link-feedback-format
     2drop ;
 
+: link-vertex-formats ( program-handle formats -- )
+    [ vertex-format-attributes [ name>> ] map sift ] map concat
+    swap '[ [ _ ] 2dip swap glBindAttribLocation ] each-index ; 
+
 GENERIC: (verify-feedback-format) ( program-instance format -- )
 
 M: f (verify-feedback-format)
@@ -305,7 +313,7 @@ SYNTAX: VERTEX-FORMAT:
     define-vertex-format ;
 
 : define-vertex-struct ( class vertex-format -- )
-    "vertex-format-attributes" word-prop [ vertex-attribute>struct-slot ] map
+    vertex-format-attributes [ vertex-attribute>struct-slot ] map
     define-struct-class ;
 
 SYNTAX: VERTEX-STRUCT:
@@ -360,8 +368,11 @@ DEFER: <shader-instance>
     [ compile-shader-error ] if ;
 
 : (link-program) ( program shader-instances -- program-instance )
-    [ [ handle>> ] map ] curry
+    '[ _ [ handle>> ] map ]
-    [ feedback-format>> [ link-feedback-format ] curry ] bi (gl-program)
+    [
+        [ vertex-formats>> ] [ feedback-format>> ] bi
+        '[ [ _ link-vertex-formats ] [ _ link-feedback-format ] bi ]
+    ] bi (gl-program)
     dup gl-program-ok?  [
         [ swap world get \ program-instance boa |dispose dup verify-feedback-format ]
         with-destructors window-resource
@@ -400,16 +411,27 @@ DEFER: <shader-instance>
     world get over instances>> at*
     [ nip ] [ drop link-program ] if ;
 
-: shaders-and-feedback-format ( words -- shaders feedback-format )
+TUPLE: feedback-format
-    [ vertex-format? ] partition swap
+    { vertex-format ?vertex-format read-only } ;
-    [ [ def>> first ] map ] [
+
-        dup length 1 <=
+: validate-feedback-format ( sequence -- vertex-format/f )
-        [ [ f ] [ first ] if-empty ]
+    dup length 1 <=
-        [ too-many-feedback-formats-error ] if
+    [ [ f ] [ first vertex-format>> ] if-empty ]
-    ] bi* ;
+    [ too-many-feedback-formats-error ] if ;
+
+: ?shader ( object -- shader/f )
+    dup word? [ def>> first dup shader? [ drop f ] unless ] [ drop f ] if ;
+
+: shaders-and-formats ( words -- shaders vertex-formats feedback-format )
+    [ [ ?shader ] map sift ]
+    [ [ vertex-format? ] filter ]
+    [ [ feedback-format? ] filter validate-feedback-format ] tri ;
 
 PRIVATE>
 
+SYNTAX: feedback-format:
+    scan-object feedback-format boa suffix! ;
+
 TYPED:: refresh-program ( program: program -- )
     program shaders>> [ refresh-shader-source ] each
     program instances>> [| world old-instance |
@@ -475,7 +497,7 @@ SYNTAX: GLSL-PROGRAM:
     dup old-instances [
         f
         lexer get line>>
-        \ ; parse-until >array shaders-and-feedback-format
+        \ ; parse-until >array shaders-and-formats
     ] dip
     program boa
     over reset-generic