diff options
| -rw-r--r-- | examples/02-image-transforms-and-events.lisp | 143 | ||||
| -rw-r--r-- | examples/02-moving-bitmp.lisp | 8 | ||||
| -rw-r--r-- | examples/03-font-render.lisp | 1 | ||||
| -rw-r--r-- | examples/README.txt | 2 |
4 files changed, 149 insertions, 5 deletions
diff --git a/examples/02-image-transforms-and-events.lisp b/examples/02-image-transforms-and-events.lisp new file mode 100644 index 0000000..bb348a1 --- /dev/null +++ b/examples/02-image-transforms-and-events.lisp @@ -0,0 +1,143 @@ +;;; 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 app bm) + (ww::add-unit app 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))))) + + + diff --git a/examples/02-moving-bitmp.lisp b/examples/02-moving-bitmp.lisp index d0a5598..bb348a1 100644 --- a/examples/02-moving-bitmp.lisp +++ b/examples/02-moving-bitmp.lisp @@ -1,4 +1,4 @@ -;;; 01-image-display.lisp +;;; 01-image-transforms-and-events.lisp (defpackage #:ww.examples/2 (:use #:cl) @@ -6,7 +6,7 @@ (in-package :ww.examples/2) -(defclass image-display (ww::application ) ()) +(defclass image-transforms-etc (ww::application ) ()) (defvar *shared-anim-table* (make-hash-table :synchronized t)) @@ -100,7 +100,7 @@ (ww::on-mousewheel () (print (list :mousewheel horiz vert dir)))) -(defmethod ww::boot ((app image-display)) +(defmethod ww::boot ((app image-transforms-etc)) (let ((bm (make-instance 'ww::image :texture (ww::get-asset "Fezghoul.png"))) @@ -130,7 +130,7 @@ (defun start () - (ww::start (make-instance 'image-display + (ww::start (make-instance 'image-transforms-etc :scale 2.0 :fps 60 :width 800 diff --git a/examples/03-font-render.lisp b/examples/03-font-render.lisp index bdd1c6e..c8188df 100644 --- a/examples/03-font-render.lisp +++ b/examples/03-font-render.lisp @@ -1,3 +1,4 @@ +;;; 03-font-render.lisp (defpackage #:ww.examples/3 (:use #:cl) diff --git a/examples/README.txt b/examples/README.txt index ac2d40f..4896a20 100644 --- a/examples/README.txt +++ b/examples/README.txt @@ -10,7 +10,7 @@ It also shows off mousevent bubbling to some extent by letting you click and drag the image. +---------------------------------- -| 02-moving-bitmp.lisp +| 02-image-transforms-and-events.lisp +---------------------------------- This is a grab bag of various features. You should just look at the |