From d9fba3559d77e96f145ab1fd968bce868074044e Mon Sep 17 00:00:00 2001
From: Colin Okay <colin@cicadas.surf>
Date: Wed, 22 Jun 2022 10:13:04 -0500
Subject: [add] funcallable event handlers; defhandler macro

---
 wheelwork.lisp | 46 +++++++++++++++++++++++++++++++---------------
 1 file changed, 31 insertions(+), 15 deletions(-)

(limited to 'wheelwork.lisp')

diff --git a/wheelwork.lisp b/wheelwork.lisp
index fdeee48..d30cf19 100644
--- a/wheelwork.lisp
+++ b/wheelwork.lisp
@@ -212,11 +212,21 @@ order). Makes sure to remove the unit from its current container if necessary."
                        image-format
                        :unsigned-byte
                        (pngload:data png))
-      (gl:bind-texture :texture-2d 0))))
+      (gl:bind-texture :texture-2d 0)
+      (when (texture-mipmap texture)
+        (gl:generate-mipmap :texture-2d)))))
 
 
 (defclass/std event-handler ()
-  ((event-type handler-function :ri)))
+  ((event-type handler-function :ri))
+  (:metaclass closer-mop:funcallable-standard-class))
+
+(defmethod initialize-instance :after ((eh event-handler) &key)
+  (with-slots (handler-function) eh
+    (closer-mop:set-funcallable-instance-function eh handler-function)))
+
+
+
 
 (defclass/std listener ()
   ((keydown keyup mousedown mouseup mousemove mousewheel focus blur perframe
@@ -276,10 +286,10 @@ order). Makes sure to remove the unit from its current container if necessary."
   "Handles changing application focus, calling appropriate blur and focus handlers."
   (when-let (blur-handler (and (application-focus app)
                                (get-handler-for (application-focus app) 'blur)))
-    (funcall (handler-function blur-handler) (application-focus app)))
+    (funcall blur-handler (application-focus app)))
   (setf (application-focus app) target)
   (when-let (focus-handler (get-handler-for target 'focus))
-    (funcall (handler-function focus-handler) target)))
+    (funcall focus-handler target)))
 
 (defun get-focus (&optional (app *application*))
   (or (application-focus app) app))
@@ -291,11 +301,8 @@ order). Makes sure to remove the unit from its current container if necessary."
 
 (defun eventloop-keydown (app sdl-keysym)
   (let ((target (get-focus app))) 
-    (format t "Calling eventloop-keydown~%")
     (when-let (handler (get-handler-for target 'keydown)) 
-      (format t "Handling the event.~%")
-      
-      (apply (handler-function handler)
+      (apply handler
              target
              (sdl2:scancode sdl-keysym)
              (sdl2:mod-keywords (sdl2:mod-value sdl-keysym))))))
@@ -349,7 +356,6 @@ order). Makes sure to remove the unit from its current container if necessary."
              :for source :in sources
              :collect (gl-shader (shader-by-type (car source))
                                  stage)))
-         
          (program (gl:create-program)))
     (dolist (shader shaders) (gl:attach-shader program shader))
     (gl:link-program program)
@@ -408,13 +414,13 @@ order). Makes sure to remove the unit from its current container if necessary."
       (gl:bind-vertex-array vao)
       (let ((vbo (gl:gen-buffer)))
         (with-gl-array (verts :float
-                              0.0 1.0
-                              1.0 0.0
-                              0.0 0.0
+                              0.0 1.0 
+                              1.0 0.0 
+                              0.0 0.0 
                               
-                              0.0 1.0
-                              1.0 1.0
-                              1.0 0.0)
+                              0.0 1.0 
+                              1.0 1.0 
+                              1.0 0.0 )
           (gl:bind-buffer :array-buffer vbo)
           (gl:buffer-data :array-buffer :static-draw verts)))
       (gl:enable-vertex-attrib-array 0)
@@ -454,6 +460,16 @@ disk."
              (make-instance (asset-class-for asset-id)
                             :path (uiop:merge-pathnames* asset-id (asset-root app)))))))
 
+(defmacro defhandler (name handler)
+  (let ((handler-var (gensym)))
+    `(let ((,handler-var ,handler))
+       (if-let (extant (and (fboundp ',name)
+                            (fdefinition ',name)))
+         (closer-mop:set-funcallable-instance-function extant (handler-function ,handler-var))
+         (setf (fdefinition ',name) ,handler-var)))))
+
+
+
 (defmacro on-perframe
     ((target time) &body body)
   `(make-instance
-- 
cgit v1.2.3