From b464597069999b138bcb1f7e1de14c7036ebb40c Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 30 Nov 2014 13:24:50 -0500
Subject: render: mesh: Add a finalizer to reclaim memory used by OpenGL.

* sly/render/mesh.scm (<mesh>) [mesh-vbos]: New field.
  (mesh-guardian): New guardian.
  (make-mesh): Add new meshes to guardian.
* sly/wrappers/gl.scm (glDeleteVertexArrays): New procedure.
---
 sly/render/mesh.scm | 24 ++++++++++++++++++------
 sly/wrappers/gl.scm |  6 ++++++
 2 files changed, 24 insertions(+), 6 deletions(-)

diff --git a/sly/render/mesh.scm b/sly/render/mesh.scm
index 98510d3..dc1a1ca 100644
--- a/sly/render/mesh.scm
+++ b/sly/render/mesh.scm
@@ -29,6 +29,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (gl)
   #:use-module (gl low-level)
+  #:use-module (sly utils)
   #:use-module (sly wrappers gl)
   #:use-module (sly math vector)
   #:use-module (sly render color)
@@ -134,10 +135,19 @@
 ;;;
 
 (define-record-type <mesh>
-  (%make-mesh id length)
+  (%make-mesh id length vbos)
   mesh?
   (id mesh-id)
-  (length mesh-length))
+  (length mesh-length)
+  (vbos mesh-vbos))
+
+(define-guardian mesh-guardian
+  (lambda (mesh)
+    ;; Delete vertex array and vertex buffers.
+    (glDeleteVertexArrays 1 (u32vector (mesh-id mesh)))
+    (let ((buffers (mesh-vbos mesh)))
+      (glDeleteBuffers (length buffers)
+                       (list->u32vector (map vertex-buffer-id buffers))))))
 
 (define (generate-vertex-array)
   (let ((bv (u32vector 1)))
@@ -161,13 +171,15 @@
                            (data-type float) #f 0 %null-pointer)))
 
 (define (make-mesh indices positions textures)
-  (let ((mesh (%make-mesh (generate-vertex-array)
-                          (vector-length indices)))
-        (positions (make-vertex-buffer positions))
-        (textures (make-vertex-buffer textures)))
+  (let* ((positions (make-vertex-buffer positions))
+         (textures (make-vertex-buffer textures))
+         (mesh (%make-mesh (generate-vertex-array)
+                           (vector-length indices)
+                           (list positions textures))))
     (with-mesh mesh
       (vertex-attrib-pointer vertex-position-location positions)
       (if textures
           (vertex-attrib-pointer vertex-texture-location textures))
       (bind-vertex-buffer (make-vertex-buffer indices #t)))
+    (mesh-guardian mesh)
     mesh))
diff --git a/sly/wrappers/gl.scm b/sly/wrappers/gl.scm
index 2d251dc..25d6dd4 100644
--- a/sly/wrappers/gl.scm
+++ b/sly/wrappers/gl.scm
@@ -127,11 +127,17 @@ instanced rendering.")
                                         -> void)
   "Generate N vertex arrays.")
 
+(define-gl-procedure (glDeleteVertexArrays (n GLsizei)
+                                           (arrays GLuint-*)
+                                           -> void)
+  "Delete vertex array objects.")
+
 (define-gl-procedure (glBindVertexArray (array GLuint)
                                         -> void)
   "Bind vertex array object ARRAY.")
 
 (export glGenVertexArrays
+        glDeleteVertexArrays
         glBindVertexArray)
 
 (define-syntax-rule (with-gl-client-state state body ...)
-- 
cgit v1.2.3