factor: trim using lists

[factor.git] / extra / gpu / buffers / buffers.factor

diff --git a/extra/gpu/buffers/buffers.factor b/extra/gpu/buffers/buffers.factor
index 3de5a03d3502cb7e0de117713c862c62b3b9e8e4..7e2268dbba96c701d0877ce3055ba6b4aa1686eb 100644 (file)
--- a/extra/gpu/buffers/buffers.factor
+++ b/extra/gpu/buffers/buffers.factor
@@ -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
@@ -18,7 +19,7 @@ VARIANT: buffer-kind
     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 } ;
@@ -57,17 +58,17 @@ TUPLE: buffer < gpu-object
     } case ; inline
 
 : get-buffer-int ( target enum -- value )
-    0 <int> [ glGetBufferParameteriv ] keep *int ;
+    0 int <ref> [ glGetBufferParameteriv ] keep int deref ; inline
 
 : bind-buffer ( buffer -- target )
-    [ kind>> gl-target dup ] [ handle>> glBindBuffer ] bi ;
+    [ 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
@@ -78,7 +79,7 @@ C: <buffer-range> buffer-range
 
 UNION: gpu-data-ptr buffer-ptr c-ptr ;
 
-: buffer-size ( buffer -- size )
+TYPED: buffer-size ( buffer: buffer -- size: integer )
     bind-buffer GL_BUFFER_SIZE get-buffer-int ;
 
 : buffer-ptr>range ( buffer-ptr -- buffer-range )
@@ -88,29 +89,43 @@ UNION: gpu-data-ptr buffer-ptr c-ptr ;
 
 :: allocate-buffer ( buffer size initial-data -- )
     buffer bind-buffer :> target
-    target size initial-data buffer gl-buffer-usage glBufferData ;
-
-: <buffer> ( upload usage kind size initial-data -- buffer )
+    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 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 bind-buffer :> target
     size <byte-array> :> data
     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
 
@@ -118,24 +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 -- ) -- )
+: (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
+
+:: 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
-