diff options
Diffstat (limited to 'examples/02-moving-bitmp.lisp')
-rw-r--r-- | examples/02-moving-bitmp.lisp | 143 |
1 files changed, 0 insertions, 143 deletions
diff --git a/examples/02-moving-bitmp.lisp b/examples/02-moving-bitmp.lisp deleted file mode 100644 index edc9000..0000000 --- a/examples/02-moving-bitmp.lisp +++ /dev/null @@ -1,143 +0,0 @@ -;;; 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")))) - - (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))))) - - - |