Start work on making bunny demos use vertex buffers to draw

extra/bunny/bunny.factor

@@ -3,7 +3,8 @@ USING: alien alien.c-types arrays sequences math
 math.vectors math.matrices math.parser io io.files kernel opengl
 opengl.gl opengl.glu shuffle http.client vectors timers
 namespaces ui.gadgets ui.gadgets.canvas ui.render ui splitting
-combinators tools.time system combinators.lib ;
+combinators tools.time system combinators.lib combinators.cleave
+float-arrays ;
 IN: bunny
 
 : numbers ( str -- seq )
@@ -45,6 +46,16 @@ IN: bunny
         <file-reader> parse-model [ normals ] 2keep 3array
     ] time ;
 
+: make-vertex-buffers ( model -- array element-array )
+    [
+        [ first concat ] [ second concat ] bi
+        append >float-array
+        GL_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
+    ] [
+        third concat >c-uint-array
+        GL_ELEMENT_ARRAY_BUFFER swap GL_STATIC_DRAW <gl-buffer>
+    ] bi ;
+
 : model-path "bun_zipper.ply" ;
 
 : model-url "http://factorcode.org/bun_zipper.ply" ;

extra/cel-shading/cel-shading.factor

@@ -4,12 +4,14 @@ USING: arrays bunny combinators.lib io io.files kernel
        sequences ui ui.gadgets ui.render ;
 IN: cel-shading
 
-TUPLE: cel-shading-gadget model program ;
+TUPLE: cel-shading-gadget model program vertices elements ;
 
 : <cel-shading-gadget> ( -- cel-shading-gadget )
     0.0 0.0 0.375 <demo-gadget>
-    maybe-download read-model
-    { set-delegate set-cel-shading-gadget-model } cel-shading-gadget construct ;
+    maybe-download read-model {
+        set-delegate
+        set-cel-shading-gadget-model
+    } cel-shading-gadget construct ;
 
 STRING: cel-shading-vertex-shader-source
 varying vec3 position, normal;
@@ -53,34 +55,58 @@ main()
 
 ;
 
-: cel-shading-program ( -- program )
+: make-cel-shading-program ( -- program )
     cel-shading-vertex-shader-source cel-shading-fragment-shader-source
     <simple-gl-program> ;
 
 M: cel-shading-gadget graft* ( gadget -- )
-    [ "2.0" { "GL_ARB_shader_objects" } require-gl-version-or-extensions
+    "2.0" {
+        "GL_ARB_shader_objects"
+        "GL_ARB_vertex_buffer_object"
+    } require-gl-version-or-extensions
     0.0 0.0 0.0 1.0 glClearColor
     GL_CULL_FACE glEnable
     GL_DEPTH_TEST glEnable
-    cel-shading-program swap set-cel-shading-gadget-program ] [ ] [ :c ] cleanup ;
+    dup cel-shading-gadget-model make-vertex-buffers
+    make-cel-shading-program roll {
+        set-cel-shading-gadget-vertices
+        set-cel-shading-gadget-elements
+        set-cel-shading-gadget-program
+    } set-slots ;
 
 M: cel-shading-gadget ungraft* ( gadget -- )
-    cel-shading-gadget-program [ delete-gl-program ] when* ;
+    {
+        [ cel-shading-gadget-program [ delete-gl-program ] when* ] 
+        [ cel-shading-gadget-elements [ delete-gl-buffer ] when* ]
+        [ cel-shading-gadget-vertices [ delete-gl-buffer ] when* ]
+    } call-with ;
 
 : cel-shading-draw-setup ( gadget -- gadget )
     [ demo-gadget-set-matrices ] keep
-    [ cel-shading-gadget-program
-        { [ "light_direction" glGetUniformLocation -25.0 45.0 80.0 glUniform3f ]
-          [ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ]
-          [ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ]
-          [ "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ] } call-with
-    ] keep ;
+    [ cel-shading-gadget-program {
+        [ "light_direction" glGetUniformLocation -25.0 45.0 80.0 glUniform3f ]
+        [ "color" glGetUniformLocation 0.6 0.5 0.5 1.0 glUniform4f ]
+        [ "ambient" glGetUniformLocation 0.2 0.2 0.2 0.2 glUniform4f ]
+        [ "diffuse" glGetUniformLocation 0.8 0.8 0.8 0.8 glUniform4f ]
+    } call-with ] keep ;
 
 M: cel-shading-gadget draw-gadget* ( gadget -- )
     dup cel-shading-gadget-program [
         cel-shading-draw-setup
         0.0 -0.12 0.0 glTranslatef
-        cel-shading-gadget-model first3 draw-bunny
+        dup {
+            cel-shading-gadget-vertices
+            cel-shading-gadget-elements
+        } get-slots [
+            GL_VERTEX_ARRAY GL_NORMAL_ARRAY 2array [
+                GL_FLOAT 0 0 buffer-offset glNormalPointer
+                cel-shading-gadget-model dup
+                first length 3 * 4 * buffer-offset
+                3 GL_FLOAT 0 roll glVertexPointer
+                third length 3 *
+                GL_TRIANGLES swap GL_UNSIGNED_INT 0 buffer-offset glDrawElements
+            ] all-enabled-client-state
+        ] with-array-element-buffers
     ] with-gl-program ;
 
 : cel-shading-window ( -- )

extra/line-art/line-art.factor

@@ -187,7 +187,7 @@ main()
     ] if ;
     
 M: line-art-gadget graft* ( gadget -- )
-    [ "2.0" { "GL_ARB_draw_buffers"
+    "2.0" { "GL_ARB_draw_buffers"
             "GL_ARB_shader_objects"
             "GL_ARB_multitexture"
             "GL_ARB_texture_float" }
@@ -196,8 +196,7 @@ M: line-art-gadget graft* ( gadget -- )
     GL_CULL_FACE glEnable
     GL_DEPTH_TEST glEnable
     (line-art-step1-program) over set-line-art-gadget-step1-program
-    (line-art-step2-program) swap set-line-art-gadget-step2-program
-    ] [ ] [ :c ] cleanup ;
+    (line-art-step2-program) swap set-line-art-gadget-step2-program ;
 
 M: line-art-gadget ungraft* ( gadget -- )
     dup line-art-gadget-framebuffer [

extra/opengl/opengl-docs.factor

@@ -65,7 +65,7 @@ HELP: gen-renderbuffer
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glGenRenderbuffersEXT } " to handle the common case of generating a single render buffer ID." } ;
 
-HELP: gen-buffer
+HELP: gen-gl-buffer
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glGenBuffers } " to handle the common case of generating a single buffer ID." } ;
 
@@ -81,14 +81,14 @@ HELP: delete-renderbuffer
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glDeleteRenderbuffersEXT } " to handle the common case of deleting a single render buffer ID." } ;
 
-HELP: delete-buffer
+HELP: delete-gl-buffer
 { $values { "id" integer } }
 { $description "Wrapper for " { $link glDeleteBuffers } " to handle the common case of deleting a single buffer ID." } ;
 
 { gen-texture delete-texture } related-words
 { gen-framebuffer delete-framebuffer } related-words
 { gen-renderbuffer delete-renderbuffer } related-words
-{ gen-buffer delete-buffer } related-words
+{ gen-gl-buffer delete-gl-buffer } related-words
 
 HELP: framebuffer-incomplete?
 { $values { "status/f" "The framebuffer error code, or " { $snippet "f" } " if the framebuffer is render-complete." } }

extra/opengl/opengl.factor

@@ -30,6 +30,13 @@ IN: opengl
 
 : do-enabled ( what quot -- )
     over glEnable dip glDisable ; inline
+: do-enabled-client-state ( what quot -- )
+    over glEnableClientState dip glDisableClientState ; inline
+
+: all-enabled ( seq quot -- )
+    over [ glEnable ] each dip [ glDisable ] each ; inline
+: all-enabled-client-state ( seq quot -- )
+    over [ glEnableClientState ] each dip [ glDisableClientState ] each ; inline
 
 : do-matrix ( mode quot -- )
     swap [ glMatrixMode glPushMatrix call ] keep
@@ -103,7 +110,7 @@ IN: opengl
     [ glGenFramebuffersEXT ] (gen-gl-object) ;
 : gen-renderbuffer ( -- id )
     [ glGenRenderbuffersEXT ] (gen-gl-object) ;
-: gen-buffer ( -- id )
+: gen-gl-buffer ( -- id )
     [ glGenBuffers ] (gen-gl-object) ;
 
 : (delete-gl-object) ( id quot -- )
@@ -114,9 +121,26 @@ IN: opengl
     [ glDeleteFramebuffersEXT ] (delete-gl-object) ;
 : delete-renderbuffer ( id -- )
     [ glDeleteRenderbuffersEXT ] (delete-gl-object) ;
-: delete-buffer ( id -- )
+: delete-gl-buffer ( id -- )
     [ glDeleteBuffers ] (delete-gl-object) ;
 
+: with-gl-buffer ( binding id quot -- )
+    -rot dupd glBindBuffer
+    [ slip ] [ 0 glBindBuffer ] [ ] cleanup ; inline
+
+: with-array-element-buffers ( array-buffer element-buffer quot -- )
+    -rot GL_ELEMENT_ARRAY_BUFFER swap [
+        swap GL_ARRAY_BUFFER -rot with-gl-buffer
+    ] with-gl-buffer ; inline
+
+: <gl-buffer> ( target data hint -- id )
+    pick gen-gl-buffer [ [
+        >r dup byte-length swap r> glBufferData
+    ] with-gl-buffer ] keep ;
+
+: buffer-offset ( int -- alien )
+    <alien> ; inline
+
 : framebuffer-incomplete? ( -- status/f )
     GL_FRAMEBUFFER_EXT glCheckFramebufferStatusEXT
     dup GL_FRAMEBUFFER_COMPLETE_EXT = f rot ? ;