diff options
| -rw-r--r-- | wheelwork.lisp | 46 |
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 |