]> gitweb.factorcode.org Git - factor.git/blobdiff - extra/gpu/buffers/buffers.factor
factor: trim using lists
[factor.git] / extra / gpu / buffers / buffers.factor
index 187f194e7daf54c7ab9da932249ecba83770c021..7e2268dbba96c701d0877ce3055ba6b4aa1686eb 100644 (file)
@@ -1,7 +1,8 @@
-! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types arrays byte-arrays
-combinators destructors gpu kernel locals math opengl opengl.gl
-ui.gadgets.worlds variants ;
+! Copyright (C) 2009 Joe Groff.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors alien alien.c-types alien.data arrays byte-arrays
+combinators destructors gpu kernel math opengl opengl.gl
+typed ui.gadgets.worlds variants ;
 IN: gpu.buffers
 
 VARIANT: buffer-upload-pattern
@@ -15,9 +16,10 @@ VARIANT: buffer-access-mode
 
 VARIANT: buffer-kind
     vertex-buffer index-buffer
-    pixel-unpack-buffer pixel-pack-buffer ;
+    pixel-unpack-buffer pixel-pack-buffer
+    transform-feedback-buffer ;
 
-TUPLE: buffer < gpu-object 
+TUPLE: buffer < gpu-object
     { upload-pattern buffer-upload-pattern }
     { usage-pattern buffer-usage-pattern }
     { kind buffer-kind } ;
@@ -52,48 +54,78 @@ TUPLE: buffer < gpu-object
         { index-buffer [ GL_ELEMENT_ARRAY_BUFFER ] }
         { pixel-unpack-buffer [ GL_PIXEL_UNPACK_BUFFER ] }
         { pixel-pack-buffer [ GL_PIXEL_PACK_BUFFER ] }
+        { transform-feedback-buffer [ GL_TRANSFORM_FEEDBACK_BUFFER ] }
     } case ; inline
 
+: get-buffer-int ( target enum -- value )
+    0 int <ref> [ glGetBufferParameteriv ] keep int deref ; inline
+
+: bind-buffer ( buffer -- target )
+    [ kind>> gl-target dup ] [ handle>> glBindBuffer ] bi ; inline
+
 PRIVATE>
 
 M: buffer dispose
     [ [ delete-gl-buffer ] when* f ] change-handle drop ;
 
-TUPLE: buffer-ptr 
+TUPLE: buffer-ptr
     { buffer buffer read-only }
     { 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 ;
 
-:: allocate-buffer ( buffer size initial-data -- )
-    buffer kind>> gl-target :> target
-    target buffer handle>> glBindBuffer
-    target size initial-data buffer gl-buffer-usage glBufferData ;
+TYPED: buffer-size ( buffer: buffer -- size: integer )
+    bind-buffer GL_BUFFER_SIZE get-buffer-int ;
+
+: buffer-ptr>range ( buffer-ptr -- buffer-range )
+    [ buffer>> ] [ offset>> ] bi
+    2dup [ buffer-size ] dip -
+    buffer-range boa ; inline
 
-: <buffer> ( upload usage kind size initial-data -- buffer )
+:: allocate-buffer ( buffer size initial-data -- )
+    buffer bind-buffer :> target
+    target size initial-data buffer gl-buffer-usage glBufferData ; inline
+
+: allocate-byte-array ( buffer byte-array -- )
+    [ byte-length ] [ ] bi allocate-buffer ; inline
+
+TYPED: <buffer> ( upload: buffer-upload-pattern
+                  usage: buffer-usage-pattern
+                  kind: buffer-kind
+                  size: integer
+                  initial-data
+                  --
+                  buffer: buffer )
     [ [ gen-gl-buffer ] 3dip buffer boa dup ] 2dip allocate-buffer
     window-resource ;
 
-: byte-array>buffer ( byte-array upload usage kind -- buffer )
+TYPED: byte-array>buffer ( byte-array
+                           upload: buffer-upload-pattern
+                           usage: buffer-usage-pattern
+                           kind: buffer-kind
+                           --
+                           buffer: buffer )
     [ ] 3curry dip
     [ byte-length ] [ ] bi <buffer> ;
 
-:: update-buffer ( buffer-ptr size data -- )
+TYPED:: update-buffer ( buffer-ptr: buffer-ptr size: integer data -- )
     buffer-ptr buffer>> :> buffer
-    buffer kind>> gl-target :> target
-    target buffer handle>> glBindBuffer
+    buffer bind-buffer :> target
     target buffer-ptr offset>> size data glBufferSubData ;
 
-:: read-buffer ( buffer-ptr size -- data )
+TYPED:: read-buffer ( buffer-ptr: buffer-ptr size: integer -- data: byte-array )
     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 ;
 
-:: copy-buffer ( to-buffer-ptr from-buffer-ptr size -- )
+TYPED:: copy-buffer ( to-buffer-ptr: buffer-ptr from-buffer-ptr: buffer-ptr size: integer -- )
     GL_COPY_WRITE_BUFFER to-buffer-ptr buffer>> glBindBuffer
     GL_COPY_READ_BUFFER from-buffer-ptr buffer>> glBindBuffer
 
@@ -101,26 +133,34 @@ UNION: gpu-data-ptr buffer-ptr c-ptr ;
     from-buffer-ptr offset>> to-buffer-ptr offset>>
     size glCopyBufferSubData ;
 
-:: with-mapped-buffer ( buffer access quot: ( alien -- ) -- )
-    buffer kind>> gl-target :> target
+: (grow-buffer-size) ( target-size old-size -- new-size )
+    [ 2dup > ] [ 2 * ] while nip ; inline
+
+TYPED: grow-buffer ( buffer: buffer target-size: integer -- )
+    over buffer-size 2dup >
+    [ (grow-buffer-size) f allocate-buffer ] [ 3drop ] if ; inline
 
-    target buffer handle>> glBindBuffer
+:: with-mapped-buffer ( ..a buffer access quot: ( ..a alien -- ..b ) -- ..b )
+    buffer bind-buffer :> target
     target access gl-access glMapBuffer
 
     quot call
 
-    target glUnmapBuffer ; inline
+    target glUnmapBuffer drop ; inline
 
-:: with-bound-buffer ( buffer target quot: ( -- ) -- )
+:: with-mapped-buffer-array ( ..a buffer access c-type quot: ( ..a array -- ..b ) -- ..b )
+    buffer buffer-size c-type heap-size /i :> len
+    buffer access [ len c-type <c-direct-array> quot call ] with-mapped-buffer ; inline
+
+:: with-bound-buffer ( ..a buffer target quot: ( ..a -- ..b ) -- ..b )
     target gl-target buffer glBindBuffer
     quot call ; inline
 
-: with-buffer-ptr ( buffer-ptr target quot: ( c-ptr -- ) -- )
+: with-buffer-ptr ( ..a buffer-ptr target quot: ( ..a c-ptr -- ..b ) -- ..b )
     [ [ offset>> <alien> ] [ buffer>> handle>> ] bi ] 2dip
     with-bound-buffer ; inline
 
-: with-gpu-data-ptr ( gpu-data-ptr target quot: ( c-ptr -- ) -- )
+: with-gpu-data-ptr ( ..a gpu-data-ptr target quot: ( ..a c-ptr -- ..b ) -- ..b )
     pick buffer-ptr?
     [ with-buffer-ptr ]
     [ [ gl-target 0 glBindBuffer ] dip call ] if ; inline
-