add a buffer-range tuple to represent a subset of a buffer. add support for specifying a transform feedback format to GLSL-PROGRAM: syntax

extra/gpu/buffers/buffers.factor

@@ -54,6 +54,12 @@ TUPLE: buffer < gpu-object
         { pixel-pack-buffer [ GL_PIXEL_PACK_BUFFER ] }
     } case ; inline
 
+: get-buffer-int ( target enum -- value )
+    0 <int> [ glGetBufferParameteriv ] keep *int ;
+
+: bind-buffer ( buffer -- target )
+    [ kind>> gl-target dup ] [ handle>> glBindBuffer ] bi ;
+
 PRIVATE>
 
 M: buffer dispose
@@ -64,11 +70,17 @@ TUPLE: buffer-ptr
     { offset integer read-only } ;
 C: <buffer-ptr> buffer-ptr
 
+TUPLE: buffer-range < buffer-ptr
+    { size integer read-only } ;
+C: <buffer-range> buffer-range
+
 UNION: gpu-data-ptr buffer-ptr c-ptr ;
 
+: buffer-size ( buffer -- size )
+    bind-buffer GL_BUFFER_SIZE get-buffer-int ;
+
 :: allocate-buffer ( buffer size initial-data -- )
-    buffer kind>> gl-target :> target
+    buffer bind-buffer :> target
-    target buffer handle>> glBindBuffer
     target size initial-data buffer gl-buffer-usage glBufferData ;
 
 : <buffer> ( upload usage kind size initial-data -- buffer )
@@ -81,15 +93,13 @@ UNION: gpu-data-ptr buffer-ptr c-ptr ;
 
 :: update-buffer ( buffer-ptr size data -- )
     buffer-ptr buffer>> :> buffer
-    buffer kind>> gl-target :> target
+    buffer bind-buffer :> target
-    target buffer handle>> glBindBuffer
     target buffer-ptr offset>> size data glBufferSubData ;
 
 :: read-buffer ( buffer-ptr size -- data )
     buffer-ptr buffer>> :> buffer
-    buffer kind>> gl-target :> target
+    buffer bind-buffer :> target
     size <byte-array> :> data
-    target buffer handle>> glBindBuffer
     target buffer-ptr offset>> size data glGetBufferSubData
     data ;
 
@@ -102,9 +112,7 @@ UNION: gpu-data-ptr buffer-ptr c-ptr ;
     size glCopyBufferSubData ;
 
 :: with-mapped-buffer ( buffer access quot: ( alien -- ) -- )
-    buffer kind>> gl-target :> target
+    buffer bind-buffer :> target
-
-    target buffer handle>> glBindBuffer
     target access gl-access glMapBuffer
 
     quot call

extra/gpu/render/render.factor

@@ -386,33 +386,6 @@ TR: hyphens>underscores "-" "_" ;
         ] }
     } case ;
 
-: component-type>c-type ( component-type -- c-type )
-    {
-        { ubyte-components [ "uchar" ] }
-        { ushort-components [ "ushort" ] }
-        { uint-components [ "uint" ] }
-        { half-components [ "half" ] }
-        { float-components [ "float" ] }
-        { byte-integer-components [ "char" ] }
-        { ubyte-integer-components [ "uchar" ] }
-        { short-integer-components [ "short" ] }
-        { ushort-integer-components [ "ushort" ] }
-        { int-integer-components [ "int" ] }
-        { uint-integer-components [ "uint" ] }
-    } case ;
-
-: c-array-dim ( dim -- string )
-    dup 1 = [ drop "" ] [ number>string "[" "]" surround ] if ;
-
-SYMBOL: padding-no
-padding-no [ 0 ] initialize
-
-: padding-name ( -- name )
-    "padding-"
-    padding-no get number>string append
-    "(" ")" surround
-    padding-no inc ;
-
 : (define-uniform-tuple) ( class superclass uniforms -- )
     {
         [ [ uniform>slot ] map define-tuple-class ]
@@ -490,7 +463,7 @@ TUPLE: render-set
         [
             framebuffer>> 
             [ GL_DRAW_FRAMEBUFFER swap framebuffer-handle glBindFramebuffer ]
-            [ GL_RASTERIZER_DISCARD glEnable ] if*
+            [ GL_DRAW_FRAMEBUFFER 0 glBindFramebuffer GL_RASTERIZER_DISCARD glEnable ] if*
         ]
         [
             [ vertex-array>> program-instance>> ]

extra/gpu/shaders/prettyprint/prettyprint.factor

@@ -3,10 +3,14 @@ IN: gpu.shaders.prettyprint
 
 M: compile-shader-error error.
     "The GLSL shader " write
-    [ shader>> name>> pprint-short " failed to compile." write nl ]
+    [ shader>> name>> pprint-short " failed to compile." print ]
-    [ log>> write nl ] bi ;
+    [ log>> print ] bi ;
 
 M: link-program-error error.
     "The GLSL program " write
-    [ shader>> name>> pprint-short " failed to link." write nl ]
+    [ shader>> name>> pprint-short " failed to link." print ]
-    [ log>> write nl ] bi ;
+    [ log>> print ] bi ;
+
+M: too-many-feedback-formats-error error.
+    drop
+    "Only one transform feedback format can be specified for a program." print ;

extra/gpu/shaders/shaders.factor

@@ -16,6 +16,8 @@ VARIANT: shader-kind
 
 UNION: ?string string POSTPONE: f ;
 
+ERROR: too-many-feedback-formats-error formats ;
+
 TUPLE: vertex-attribute
     { name            ?string        read-only initial: f }
     { component-type  component-type read-only initial: float-components }
@@ -23,6 +25,7 @@ TUPLE: vertex-attribute
     { normalize?      boolean        read-only initial: f } ;
 
 MIXIN: vertex-format
+UNION: ?vertex-format vertex-format POSTPONE: f ;
 
 TUPLE: shader
     { name word read-only initial: t }
@@ -37,7 +40,7 @@ TUPLE: program
     { filename read-only }
     { line integer read-only }
     { shaders array read-only }
-    { feedback-format vertex-format read-only }
+    { feedback-format ?vertex-format read-only }
     { instances hashtable read-only } ;
 
 TUPLE: shader-instance < gpu-object
@@ -316,6 +319,14 @@ DEFER: <shader-instance>
     world get over instances>> at*
     [ nip ] [ drop link-program ] if ;
 
+: shaders-and-feedback-format ( words -- shaders feedback-format )
+    [ vertex-format? ] partition swap
+    [ [ def>> first ] map ] [
+        dup length 1 <=
+        [ [ f ] [ first ] if-empty ]
+        [ too-many-feedback-formats-error ] if
+    ] bi* ;
+
 PRIVATE>
 
 :: refresh-program ( program -- )
@@ -368,7 +379,7 @@ SYNTAX: GLSL-PROGRAM:
     CREATE-WORD dup
     f
     lexer get line>>
-    \ ; parse-until >array [ def>> first ] map
+    \ ; parse-until >array shaders-and-feedback-format
     H{ } clone
     program boa
     define-constant ;

extra/gpu/textures/textures.factor

@@ -151,7 +151,7 @@ M: cube-map-face     texture-data-gl-target
 
 : get-texture-float ( target level enum -- value )
     0 <float> [ glGetTexLevelParameterfv ] keep *float ;
-: get-texture-int ( texture level enum -- value )
+: get-texture-int ( target level enum -- value )
     0 <int> [ glGetTexLevelParameteriv ] keep *int ;
 
 : ?product ( x -- y )