[add] cleanup functions

1 files changed, 51 insertions, 21 deletions

diff --git a/wheelwork.lisp b/wheelwork.lisp
index 799f28c..6ad9107 100644
--- a/wheelwork.lisp
+++ b/wheelwork.lisp
@@ -62,7 +62,7 @@ order). Makes sure to remove the unit from its current container if necessary."
        (slot-boundp app 'scale)))
 
 (defun set-projection (app)
-  (when (can-set-projection-p app)q
+  (when (can-set-projection-p app)
     (with-slots (projection scale width height) app 
       ;; set projection matrix
       (setf projection (mat:mortho 0.0 (/ width scale) 0 (/ height scale) -1.0 1.0)))))
@@ -86,6 +86,15 @@ order). Makes sure to remove the unit from its current container if necessary."
   (:documentation "Clean up applications, textures, and so on.")
   (:method ((any t)) nil))
 
+(defmethod cleanup ((app application))
+  (loop for asset being the hash-value of (application-assets app)
+        do (cleanup asset))
+  (call-next-method))
+
+(defmethod cleanup ((container container))
+  (dolist (u (container-units container))
+    (cleanup u)))
+
 (defun start (app &key (x :centered) (y :centered))
   (sdl2:with-init (:everything)
     (sdl2:with-window (window
@@ -99,9 +108,11 @@ order). Makes sure to remove the unit from its current container if necessary."
         (sdl2:gl-make-current window ctx)
         (gl:viewport 0 0 (application-width app) (application-height app))
         (let ((*application* app)) 
-          (boot app)
-          (eventloop app)
-          (cleanup app))))))
+          (unwind-protect
+               (progn 
+                 (boot app)
+                 (eventloop app))
+            (cleanup app)))))))
 
 (defvar *frame-time* nil
   "Bound and available once per frame. The result of GET-UNIVERSAL-TIME.")
@@ -110,7 +121,7 @@ order). Makes sure to remove the unit from its current container if necessary."
 (defmethod render ((app application))
   (gl:clear-color 0.0 0.0 0.0 1.0)
   (gl:clear :depth-buffer-bit :color-buffer-bit)
-  (dolist (thing (display-root app))
+  (dolist (thing (container-units app))
     (render thing))
   (sdl2:gl-swap-window (application-window app)))
 
@@ -158,40 +169,50 @@ order). Makes sure to remove the unit from its current container if necessary."
 (defgeneric ensure-loaded (asset)
   (:documentation "Ensures that the asset is loaded into memory and ready for use. Returns the asset."))
 
-(defmethod ensure-loaded :around ((thing asset))
-  (unless (asset-loadedp thing) 
-    (call-next-method)
-    (setf (asset-loadedp thing) t)
-    thing))
-
 (defclass/std asset ()
   ((path :with :ri :std (error "An asset requires a path"))
    (loadedp :with :a)))
 
+(defmethod cleanup :around ((asset asset))
+  (when (asset-loadedp asset)
+    (call-next-method))
+  (setf (asset-loadedp asset) nil))
+
+(defmethod ensure-loaded :around ((thing asset))
+  (unless (asset-loadedp thing) 
+    (call-next-method)
+    (setf (asset-loadedp thing) t))
+  thing) 
+
 (defclass/std texture (asset)
   ((width height id mipmap :with :r)
    (internal-format image-format :ri :with :std :rgba)
    (wrap-s wrap-t :ri :with :std :repeat)
    (min-filter mag-filter :ri :with :std :nearest)))
 
+(defmethod cleanup ((texture texture))
+  (gl:delete-texture (texture-id texture)))
+
 (defmethod ensure-loaded ((texture texture))
-  (with-slots (width height id) texture 
+  (with-slots
+        (width height id wrap-s wrap-t min-filter mag-filter internal-format image-format)
+      texture 
     (pngload:with-png-in-static-vector (png (asset-path texture) :flip-y t)
       (setf width (pngload:width png)
             height (pngload:height png)
             id (gl:gen-texture))
-      (gl:bind-texture :texture-2d (texture-id texture))
-      (gl:tex-parameter :texture-2d :texture-wrap-s (texture-wrap-s texture))
-      (gl:tex-parameter :texture-2d :texture-wrap-t (texture-wrap-t texture))
-      (gl:tex-parameter :texture-2d :texture-min-filter (texture-min-filter texture))
-      (gl:tex-parameter :texture-2d :texture-min-filter (texture-mag-filter texture))
+      (gl:bind-texture :texture-2d id)
+      (gl:tex-parameter :texture-2d :texture-wrap-s wrap-s)
+      (gl:tex-parameter :texture-2d :texture-wrap-t wrap-t)
+      (gl:tex-parameter :texture-2d :texture-min-filter min-filter)
+      (gl:tex-parameter :texture-2d :texture-min-filter mag-filter)
       (gl:tex-image-2d :texture-2d
                        0
-                       (texture-internal-format texture)
-                       (texture-width texture)
-                       (texture-height texture)
+                       internal-format
+                       width
+                       height
                        0
-                       (texture-image-format texture)
+                       image-format
                        :unsigned-byte
                        (pngload:data png)))))
 
@@ -199,6 +220,15 @@ order). Makes sure to remove the unit from its current container if necessary."
   ((texture :ri :std (error "A bitmap requires a texture."))
    (vao shader :with :r :static)))
 
+(defmethod cleanup ((bitmap bitmap))
+  (with-slots (vao shader) bitmap
+    (when vao
+      (gl:delete-vertex-arrays (list vao)))
+    (when shader
+      (gl:delete-program shader))
+    (setf vao nil
+          shader nil)))
+
 (defun shader-by-type (type)
   (case type
     (:vertex :vertex-shader)