gpu.buffers: "with-mapped-buffer-array" helper word that wraps a mapped GL buffer...

diff --git a/extra/gpu/buffers/buffers-docs.factor b/extra/gpu/buffers/buffers-docs.factor
index cb1031c7fa8da4915513c92a4684d6afbf824c76..1487fbf4c7f82c2553b3fdc88a70cf16fdfc68ba 100644 (file)
--- a/extra/gpu/buffers/buffers-docs.factor
+++ b/extra/gpu/buffers/buffers-docs.factor
@@ -1,6 +1,6 @@
 ! (c)2009 Joe Groff bsd license
-USING: alien byte-arrays destructors help.markup help.syntax kernel math
-quotations ;
+USING: alien alien.data byte-arrays destructors help.markup help.syntax
+kernel math quotations ;
 IN: gpu.buffers
 
 HELP: <buffer-ptr>
@@ -207,6 +207,13 @@ HELP: with-mapped-buffer
 }
 { $description "Maps " { $snippet "buffer" } " into CPU address space with " { $snippet "access" } " for the dynamic extent of " { $snippet "quot" } ". " { $snippet "quot" } " is called with a pointer to the mapped memory on top of the stack." } ;
 
+HELP: with-mapped-buffer-array
+{ $values
+    { "buffer" buffer } { "access" buffer-access-mode } { "c-type" "a C type" } { "quot" { $quotation "( ..a array -- ..b )" } }
+}
+{ $description "Maps " { $snippet "buffer" } " into CPU address space with " { $snippet "access" } " for the dynamic extent of " { $snippet "quot" } ". " { $snippet "quot" } " is called with the pointer to the mapped memory wrapped in a specialized array of " { $snippet "c-type" } "." }
+{ $notes "The appropriate specialized array vocabulary must be loaded; otherwise, an error will be thrown. The vocabulary can be loaded with the " { $link require-c-array } " word. See the " { $vocab-link "specialized-arrays" } " vocabulary for details on the underlying sequence type constructed." } ;
+
 { allocate-buffer allocate-byte-array buffer-size update-buffer read-buffer copy-buffer with-mapped-buffer } related-words
 
 HELP: write-access
@@ -240,7 +247,7 @@ ARTICLE: "gpu.buffers" "Buffer objects"
     read-buffer
     copy-buffer
     with-mapped-buffer
-}
-;
+    with-mapped-buffer-array
+} ;
 
 ABOUT: "gpu.buffers"

diff --git a/extra/gpu/buffers/buffers.factor b/extra/gpu/buffers/buffers.factor
index 1f764cdfec7286cd4fc779603fad78c48fa27c07..86d51b46ce229176ca39d6120637c29943cd9ccf 100644 (file)
--- a/extra/gpu/buffers/buffers.factor
+++ b/extra/gpu/buffers/buffers.factor
@@ -1,5 +1,5 @@
 ! (c)2009 Joe Groff bsd license
-USING: accessors alien alien.c-types arrays byte-arrays
+USING: accessors alien alien.c-types alien.data arrays byte-arrays
 combinators destructors gpu kernel locals math opengl opengl.gl
 typed ui.gadgets.worlds variants ;
 IN: gpu.buffers
@@ -140,6 +140,10 @@ TYPED:: copy-buffer ( to-buffer-ptr: buffer-ptr from-buffer-ptr: buffer-ptr size
 
     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