-! (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
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 } ;
} 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
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
from-buffer-ptr offset>> to-buffer-ptr offset>>
size glCopyBufferSubData ;
+: (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
target glUnmapBuffer drop ; inline
+:: 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
pick buffer-ptr?
[ with-buffer-ptr ]
[ [ gl-target 0 glBindBuffer ] dip call ] if ; inline
-