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 bc6f089db95885871aec1796b5e83a71caafd2a4..7e2268dbba96c701d0877ce3055ba6b4aa1686eb 100644 (file)
--- a/extra/gpu/buffers/buffers.factor
+++ b/extra/gpu/buffers/buffers.factor
@@ -1,6 +1,7 @@
-! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types arrays byte-arrays
-combinators destructors gpu kernel locals math opengl opengl.gl
+! 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
 
@@ -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,7 +58,7 @@ TUPLE: buffer < gpu-object
     } case ; inline
 
 : get-buffer-int ( target enum -- value )
-    0 <int> [ glGetBufferParameteriv ] keep *int ; inline
+    0 int <ref> [ glGetBufferParameteriv ] keep int deref ; inline
 
 : bind-buffer ( buffer -- target )
     [ kind>> gl-target dup ] [ handle>> glBindBuffer ] bi ; inline
@@ -67,7 +68,7 @@ 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
@@ -132,7 +133,14 @@ TYPED:: copy-buffer ( to-buffer-ptr: buffer-ptr from-buffer-ptr: buffer-ptr size
     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
 
@@ -140,16 +148,19 @@ TYPED:: copy-buffer ( to-buffer-ptr: buffer-ptr from-buffer-ptr: buffer-ptr size
 
     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
-