[add] sprite class and example

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))