aboutsummaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorColin Okay <colin@cicadas.surf>2022-06-22 10:13:04 -0500
committerColin Okay <colin@cicadas.surf>2022-06-22 10:13:04 -0500
commitd9fba3559d77e96f145ab1fd968bce868074044e (patch)
treef6b7414b2d82ebc4671299e54ae09c0929cd11d4
parent0aa537c44cf6924f0a63453545ebdbad315c8c51 (diff)
[add] funcallable event handlers; defhandler macro
-rw-r--r--wheelwork.lisp46
1 files changed, 31 insertions, 15 deletions
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