aboutsummaryrefslogtreecommitdiffhomepage
path: root/examples/02-moving-bitmp.lisp
diff options
context:
space:
mode:
Diffstat (limited to 'examples/02-moving-bitmp.lisp')
-rw-r--r--examples/02-moving-bitmp.lisp143
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)))))
-
-
-