;;; 01-image-transforms-and-events.lisp (defpackage #:ww.examples/2 (:use #:cl) (:export #:start)) (in-package :ww.examples/2) (defclass image-transforms-etc (ww::application ) ()) (defvar *shared-anim-table* (make-hash-table :synchronized t)) (ww::defhandler move-thing (ww::on-keydown () "Move the target around, grow and shrink it. Print out its position no matter what happens." (case scancode (:scancode-left (decf (ww::x target) 4)) (:scancode-right (incf (ww::x target) 4)) (:scancode-down (decf (ww::y target) 4)) (:scancode-up (incf (ww::y target) 4)) (:scancode-w (incf (ww::width target) 20)) (:scancode-r (incf (ww::rotation target) (/ pi 3))) (:scancode-l (decf (ww::rotation target) (/ pi 3))) (:scancode-equals (when (or (member :lshift modifiers) (member :rshift modifiers)) (ww::scale-by target 1.10))) (:scancode-minus (ww::scale-by target 0.9))) (format t "ghoul pos: ~a,~a~%" (ww::x target) (ww::y target)))) (ww::defhandler animate-move-thing (ww::on-keydown () "If the target is not already involved in an animation, add a perframe handler to the target that animates it to a new position." (when (member scancode '(:scancode-left :scancode-right :scancode-down :scancode-up)) (unless (gethash target *shared-anim-table*) (setf (gethash target *shared-anim-table*) t) (let* ((tx (ww::x target)) (ty (ww::y target)) (destx tx) (desty ty) (dx 0) (dy 0)) (case scancode (:scancode-down (setf dy -1 desty (- ty (ww::height target)))) (:scancode-up (setf dy 1 desty (+ ty (ww::height target)))) (:scancode-left (setf dx -1 destx (- tx (ww::width target)))) (:scancode-right (setf dx 1 destx (+ tx (ww::width target))))) (ww::add-handler target (ww::on-perframe () (with-accessors ((cx ww::x) (cy ww::y)) target (if (and (= cx destx) (= cy desty)) (progn (remhash target *shared-anim-table*) (ww::remove-handler target 'ww::perframe)) (setf cx (+ cx dx) cy (+ cy dy))))))))))) (ww::defhandler thing-clicked (ww::on-mousedown () (format t "~a was clicked at ~a,~a!~%" target x y))) (ww::defhandler flip-on-click (ww::on-mousedown () (incf (ww::rotation target) (ww::radians 180) ))) (ww::defhandler twirl-on-click (ww::on-mousedown () (unless (gethash target *shared-anim-table*) (let ((rot 0)) (setf (gethash target *shared-anim-table*) t) (ww::add-handler target (ww::on-perframe () (if (< rot (* 8 pi)) (setf rot (+ 0.3 rot) (ww::rotation target) rot) (progn (setf (ww::rotation target) 0.0) (ww::remove-handler target 'ww::perframe) (remhash target *shared-anim-table*))))))))) (ww::defhandler mouse-over (ww::on-mousemotion () (print (list target x y xrel yrel state)))) (ww::defhandler look-at-me (ww::on-focus () (format t "~a got focus~%" target))) (ww::defhandler look-away (ww::on-blur () (format t "~a lost focus~%" target))) (ww::defhandler wheelie (ww::on-mousewheel () (print (list :mousewheel horiz vert dir)))) (defmethod ww::boot ((app image-transforms-etc)) (let ((bm (make-instance 'ww::image :texture (ww::get-asset "Fezghoul.png"))) (bm2 (make-instance 'ww::image :texture (ww::get-asset "GelatinousCube.png") :alpha 0.5))) (ww::add-handler app #'wheelie) ;; first (ww::refocus-on bm) (ww::add-handler bm #'animate-move-thing ) (ww::add-handler bm #'thing-clicked) (ww::add-handler bm #'mouse-over) ;;second (setf (ww::x bm2) 90 (ww::y bm2) 90) (ww::add-handler bm2 #'move-thing) (ww::add-handler bm2 #'twirl-on-click ) (ww::add-handler bm2 #'look-at-me) (ww::add-handler bm2 #'look-away) (ww::add-handler bm2 #'wheelie) (ww::add-unit bm) (ww::add-unit bm2))) (defun start () (ww::start (make-instance 'image-transforms-etc :scale 2.0 :fps 60 :width 800 :height 600 :asset-root (merge-pathnames "examples/" (asdf:system-source-directory :wheelwork)))))