diff options
| -rw-r--r-- | examples/05-frameset-animation.lisp | 5 | ||||
| -rw-r--r-- | examples/06-sprite.lisp | 96 | ||||
| -rw-r--r-- | src/interactive/sprite.lisp | 42 |
3 files changed, 141 insertions, 2 deletions
diff --git a/examples/05-frameset-animation.lisp b/examples/05-frameset-animation.lisp index 4686ecc..12207f3 100644 --- a/examples/05-frameset-animation.lisp +++ b/examples/05-frameset-animation.lisp @@ -1,7 +1,8 @@ ;;;; examples/05-frameset-animation.lisp (defpackage #:ww.examples/5 - (:use #:cl)) + (:use #:cl) + (:export #:start)) (in-package #:ww.examples/5) @@ -35,7 +36,7 @@ :fps 30 :width 800 :height 600 - :title "Wheelwork Example: An Animated Sprite" + :title "Wheelwork Example: A framebased animation" :asset-root (merge-pathnames "examples/" (asdf:system-source-directory :wheelwork))))) diff --git a/examples/06-sprite.lisp b/examples/06-sprite.lisp new file mode 100644 index 0000000..2d737e5 --- /dev/null +++ b/examples/06-sprite.lisp @@ -0,0 +1,96 @@ +;;;; examples/06-sprite.lisp + +(defpackage #:ww.examples/6 + (:use #:cl) + (:export #:start)) + +(in-package #:ww.examples/6) + +(defclass sprite-example (ww::application) ()) + +(defun set-key-if-not (sprite key ) + (unless (eql key (ww::frameset-key sprite)) + (setf (ww::runningp (ww::current-frameset sprite)) nil) + (setf (ww::frameset-key sprite) key)) + (unless (ww::runningp (ww::current-frameset sprite)) + (setf (ww::runningp (ww::current-frameset sprite)) t))) + +(define-symbol-macro +walking-speed+ 10) + +(ww::defhandler move-dude + (ww::on-keydown (target scancode) + (case scancode + (:scancode-left + (set-key-if-not target :left) + (decf (ww::x target) +walking-speed+)) + (:scancode-right + (set-key-if-not target :right) + (incf (ww::x target) +walking-speed+)) + (:scancode-up + (set-key-if-not target :back) + (incf (ww::y target) +walking-speed+)) + (:scancode-down + (set-key-if-not target :front) + (decf (ww::y target) +walking-speed+))))) + +(ww::defhandler stand + (ww::on-keyup (target) + (let ((current + (ww::current-frameset target))) + (setf (ww::runningp current) nil + (ww::frameset-index current) 0)))) + + +(defmethod ww::boot ((app sprite-example)) + (let* ((front + (ww::make-frameset + '("dude/Front_Stand.png" + "dude/Front_Left.png" + "dude/Front_Stand.png" + "dude/Front_Right.png") + :fps 3)) + (back + (ww::make-frameset + '("dude/Back_Stand.png" + "dude/Back_Left.png" + "dude/Back_Stand.png" + "dude/Back_Right.png") + :fps 3)) + (left + (ww::make-frameset + '("dude/Left_Stand.png" + "dude/Left_Left.png" + "dude/Left_Stand.png" + "dude/Left_Right.png") + :fps 3)) + (right + (ww::make-frameset + '("dude/Right_Stand.png" + "dude/Right_Left.png" + "dude/Right_Stand.png" + "dude/Right_Right.png") + :fps 3)) + (dude + (make-instance + 'ww::sprite + :framesets (list :front front + :back back + :left left + :right right) + :frameset-key :front))) + + (ww::add-handler dude #'move-dude) + (ww::add-handler dude #'stand) + (ww::refocus-on dude) + (ww::add-unit app dude))) + +(defun start () + (ww::start (make-instance + 'sprite-example + :fps 30 + :width 800 + :height 600 + :title "Wheelwork Example: An Animated Sprite" + :asset-root (merge-pathnames + "examples/" + (asdf:system-source-directory :wheelwork))))) diff --git a/src/interactive/sprite.lisp b/src/interactive/sprite.lisp new file mode 100644 index 0000000..81f5715 --- /dev/null +++ b/src/interactive/sprite.lisp @@ -0,0 +1,42 @@ +;;;; sprite.lisp + +(in-package #:wheelwork) + +(defclass/std sprite (unit interactive) + ((framesets :with :doc "A PLIST whose values are framesets.") + (frameset-key))) + +(defun current-frameset (sprite) + (getf (sprite-framesets sprite) + (frameset-key sprite))) + +(defmethod initialize-instance :after ((sprite sprite) &key) + (with-slots (framesets frameset-key) sprite + (loop for (name fs . more) on framesets by #'cddr + do (setf (unit-container fs) sprite)) + (unless frameset-key + (setf frameset-key (first framesets))))) + +(defmethod cleanup ((sprite sprite)) + (mapc #'cleanup (sprite-framesets sprite))) + +(defmethod render ((sprite sprite)) + (when-let (fs (current-frameset sprite)) + (render fs))) + +(macrolet + ((def-sprite-accessors (&rest accessor-names) + (let ((defs + (loop for accessor-name in accessor-names + collect + `(defmethod ,accessor-name ((sprite sprite)) + (,accessor-name (current-frameset sprite))) + + collect + `(defmethod (setf ,accessor-name) (newval (sprite sprite)) + (loop for (key fs . more) on (sprite-framesets sprite) by #'cddr + do (setf (,accessor-name fs) newval)) + newval)))) + `(progn ,@defs)))) + + (def-sprite-accessors x y scale-x scale-y width height rotation)) |