diff options
| -rw-r--r-- | examples/02-moving-bitmp.lisp | 37 |
1 files changed, 21 insertions, 16 deletions
diff --git a/examples/02-moving-bitmp.lisp b/examples/02-moving-bitmp.lisp index 53f9229..a132e9f 100644 --- a/examples/02-moving-bitmp.lisp +++ b/examples/02-moving-bitmp.lisp @@ -10,8 +10,29 @@ (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::unit-x target) (ww::unit-width target))) + (:scancode-right (incf (ww::unit-x target) (ww::unit-width target))) + (:scancode-down (decf (ww::unit-y target) (ww::unit-height target))) + (:scancode-up (incf (ww::unit-y target) (ww::unit-height target))) + (:scancode-equals + (when (or (member :lshift modifiers) (member :rshift modifiers)) + (incf (ww::unit-height target) 20.0) + (incf (ww::unit-width target) 20.0))) + (:scancode-minus + (decf (ww::unit-height target) 20.0) + (decf (ww::unit-width target) 20.0))) + (format t "ghoul pos: ~a,~a~%" + (ww::unit-x target) (ww::unit-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) @@ -37,22 +58,6 @@ (setf cx (+ cx dx) cy (+ cy dy))))))))))) -(ww::defhandler move-thing - (ww::on-keydown () - (case scancode - (:scancode-left (decf (ww::unit-x target) (ww::unit-width target))) - (:scancode-right (incf (ww::unit-x target) (ww::unit-width target))) - (:scancode-down (decf (ww::unit-y target) (ww::unit-height target))) - (:scancode-up (incf (ww::unit-y target) (ww::unit-height target))) - (:scancode-equals - (when (or (member :lshift modifiers) (member :rshift modifiers)) - (incf (ww::unit-height target) 20.0) - (incf (ww::unit-width target) 20.0))) - (:scancode-minus - (decf (ww::unit-height target) 20.0) - (decf (ww::unit-width target) 20.0))) - (format t "ghoul pos: ~a,~a~%" - (ww::unit-x target) (ww::unit-y target)))) (ww::defhandler thing-clicked (ww::on-mousedown () |