[add] frameset class and an [exmaple] using it

16 files changed, 191 insertions, 4 deletions

diff --git a/examples/05-frameset-animation.lisp b/examples/05-frameset-animation.lisp
new file mode 100644
index 0000000..4686ecc
--- /dev/null
+++ b/examples/05-frameset-animation.lisp
@@ -0,0 +1,41 @@
+;;;; examples/05-frameset-animation.lisp
+
+(defpackage #:ww.examples/5
+  (:use #:cl))
+
+(in-package #:ww.examples/5)
+
+(defclass frameset-example (ww::application) ())
+
+(ww::defhandler toggle-on-click
+    (ww::on-mousedown ()
+      (setf (ww::runningp target)
+            (not (ww::runningp target)))))
+
+(defmethod ww::boot ((app frameset-example))
+  (let ((fs
+          (ww::make-frameset
+           '("dude/Front_Stand.png"
+             "dude/Front_Left.png"
+             "dude/Front_Stand.png"
+             "dude/Front_Right.png")
+           :fps 3)))
+
+    (setf (ww::x fs) 380
+          (ww::y fs) 200)
+
+    (ww::add-handler fs #'toggle-on-click)
+    
+    (ww::add-unit app fs)))
+
+
+(defun start ()
+  (ww::start (make-instance
+              'frameset-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/examples/dude/Back_Left.png b/examples/dude/Back_Left.png
new file mode 100644
index 0000000..e6f478a
--- /dev/null
+++ b/examples/dude/Back_Left.png
diff --git a/examples/dude/Back_Right.png b/examples/dude/Back_Right.png
new file mode 100644
index 0000000..f6ea62b
--- /dev/null
+++ b/examples/dude/Back_Right.png
diff --git a/examples/dude/Back_Stand.png b/examples/dude/Back_Stand.png
new file mode 100644
index 0000000..e19a445
--- /dev/null
+++ b/examples/dude/Back_Stand.png
diff --git a/examples/dude/Front_Left.png b/examples/dude/Front_Left.png
new file mode 100644
index 0000000..b2c2982
--- /dev/null
+++ b/examples/dude/Front_Left.png
diff --git a/examples/dude/Front_Right.png b/examples/dude/Front_Right.png
new file mode 100644
index 0000000..4ca4936
--- /dev/null
+++ b/examples/dude/Front_Right.png
diff --git a/examples/dude/Front_Stand.png b/examples/dude/Front_Stand.png
new file mode 100644
index 0000000..43c2171
--- /dev/null
+++ b/examples/dude/Front_Stand.png
diff --git a/examples/dude/Left_Left.png b/examples/dude/Left_Left.png
new file mode 100644
index 0000000..1739101
--- /dev/null
+++ b/examples/dude/Left_Left.png
diff --git a/examples/dude/Left_Right.png b/examples/dude/Left_Right.png
new file mode 100644
index 0000000..d9c82e1
--- /dev/null
+++ b/examples/dude/Left_Right.png
diff --git a/examples/dude/Left_Stand.png b/examples/dude/Left_Stand.png
new file mode 100644
index 0000000..ae0379d
--- /dev/null
+++ b/examples/dude/Left_Stand.png
diff --git a/examples/dude/Right_Left.png b/examples/dude/Right_Left.png
new file mode 100644
index 0000000..90137a8
--- /dev/null
+++ b/examples/dude/Right_Left.png
diff --git a/examples/dude/Right_Right.png b/examples/dude/Right_Right.png
new file mode 100644
index 0000000..0e5aa39
--- /dev/null
+++ b/examples/dude/Right_Right.png
diff --git a/examples/dude/Right_Stand.png b/examples/dude/Right_Stand.png
new file mode 100644
index 0000000..6763b43
--- /dev/null
+++ b/examples/dude/Right_Stand.png
diff --git a/src/application.lisp b/src/application.lisp
index 2f6747e..d38cd8a 100644
--- a/src/application.lisp
+++ b/src/application.lisp
@@ -18,7 +18,7 @@
    (window :with :a)
    (refocus-on-mousedown-p :std t)
    (focus last-motion-target :with :a)
-   (fps :with :std 30 :doc "Frames Per Second")
+   (fps :std 30 :doc "Frames Per Second")
    (frame-wait :r)))
 
 
@@ -82,7 +82,7 @@
   "Runs all of the handlers objects listening for perframe events, if
 those objects are currently part of the scene tree."
   (let ((table (perframe-table (listener app)))
-        (time (get-universal-time)))
+        (time (sdl2:get-ticks)))
     (loop for target being the hash-key of table
           for handlers = (slot-value (listener target) 'perframe)
           ;; only fire perframe when target is in scene
diff --git a/src/interactive/button.lisp b/src/interactive/button.lisp
index 1c546ba..a885ef0 100644
--- a/src/interactive/button.lisp
+++ b/src/interactive/button.lisp
@@ -27,6 +27,12 @@
         (when on-press
           (funcall on-press target)))))
 
+(defmethod (setf closer-mop:slot-value-using-class) :before
+    (newval class (button button) slot)
+  (case (closer-mop:slot-definition-name slot)
+    ((up down bg)
+     (error "Swapping Button Faces Not Presently Supported"))))
+
 (defmethod initialize-instance :after ((button button) &key)
   (add-handler button #'button-pressed)
   (add-handler button #'button-released)
@@ -123,8 +129,6 @@
     (setf (height up) newval
           (height down) newval)))
 
-
-
 (defun make-texture-button (up down &key pressed released)
   "UP and DOWN should be strings naming assets to use as the up and
   down images for the button."
diff --git a/src/interactive/frameset.lisp b/src/interactive/frameset.lisp
new file mode 100644
index 0000000..521b73c
--- /dev/null
+++ b/src/interactive/frameset.lisp
@@ -0,0 +1,142 @@
+;;;; frameset.lisp
+
+(in-package #:wheelwork)
+
+(defclass/std frameset (unit interactive)
+  ((frames :with :doc "an array of renderable frames")
+   (sequence :with :doc "an array of indices into frames")
+   (runningp  :std t)
+   (wait-time :std (/ 1000.0 2) :with :doc "milliseconds between frames")
+   (count index next-time :with :std 0 :a)))
+
+(defmethod (setf fps) (newval (fs frameset))
+  (setf (frameset-wait-time fs) (/ 1000.0 newval)))
+
+(defmethod (setf frameset-index) :before (newval (fs frameset))
+  (setf (unit-visiblep (current-frame-unit fs)) nil))
+
+(defmethod (setf frameset-index) :after (newval (fs frameset))
+  (with-slots (count index) fs 
+    (setf (unit-visiblep (current-frame-unit fs)) t
+          index (mod index count))))
+
+(defmethod (setf runningp) :after (newval (fs frameset))
+  ;; to prevent speedup after restart
+  (setf (frameset-next-time fs) (sdl2:get-ticks)))
+
+(defhandler check-advance-frameset-index
+    (on-perframe (target time)
+      (when (and (runningp target)
+                 (<= (frameset-next-time target) time))
+        (incf (frameset-index target))
+        (incf (frameset-next-time target) (frameset-wait-time target)))))
+
+(defmethod cleanup ((frameset frameset))
+  (loop for frame across (frameset-frames frameset) do (cleanup frame)))
+
+(defmethod initialize-instance :after ((fs frameset) &key)
+  (add-handler fs #'check-advance-frameset-index)
+  (with-slots (index sequence count frames) fs 
+    (setf index 0
+          count (length sequence))
+    (loop for frame across frames
+          when frame
+            do (setf (unit-container frame) fs
+                     (unit-visiblep frame) nil))))
+
+(defun current-frame-unit (fs)
+  "Returns the unit  be currently displaayed as the animation's frame."
+  (with-slots (index sequence count frames) fs
+    (aref frames (aref sequence (mod index count )))))
+
+(defmethod render ((fs frameset))
+  (render (current-frame-unit fs)))
+
+(defmethod x ((fs frameset))
+  (x (current-frame-unit fs)))
+
+(defmethod (setf x) (newval (frameset frameset))
+  (with-slots (frames) frameset
+    (loop for frame across frames
+          when frame
+            do (setf (x frame) newval)))
+  newval)
+
+(defmethod y ((frameset frameset))
+  (y (current-frame-unit frameset)))
+
+(defmethod (setf y) (newval (frameset frameset))
+  (with-slots (frames) frameset
+    (loop for frame across frames
+          when frame
+            do (setf (y frame) newval)))
+  newval)
+
+(defmethod scale-x ((frameset frameset))
+  (scale-x (current-frame-unit frameset)))
+
+(defmethod (setf scale-x) (newval (frameset frameset))
+  (with-slots (frames) frameset
+    (loop for frame across frames
+          when frame
+            do (setf (scale-x frame) newval)))
+  newval)
+
+(defmethod scale-y ((frameset frameset))
+  (scale-y (current-frame-unit frameset)))
+
+(defmethod (setf scale-y) (newval (frameset frameset))
+  (with-slots (frames) frameset
+    (loop for frame across frames
+          when frame
+            do (setf (scale-y frame) newval)))
+  newval)
+
+(defmethod rotation ((frameset frameset))
+  (rotation (current-frame-unit frameset)))
+
+(defmethod (setf rotation) (newval (frameset frameset))
+  (with-slots (frames) frameset
+    (loop for frame across frames
+          when frame
+            do (setf (rotation frame) newval)))
+  newval)
+
+(defmethod width ((frameset frameset))
+  (width (current-frame-unit frameset)))
+
+(defmethod (setf width) (newval (frameset frameset))
+  (with-slots (frames) frameset
+    (loop for frame across frames
+          when frame
+            do (setf (width frame) newval)))
+  newval)
+
+(defmethod height ((frameset frameset))
+  (height (current-frame-unit frameset)))
+
+(defmethod (setf height) (newval (frameset frameset))
+  (with-slots (frames) frameset
+    (loop for frame across frames
+          when frame
+            do (setf (height frame) newval)))
+  newval)
+
+
+(defun make-frameset (sequenced-assets &key (fps 2) asset-args)
+  (let* ((asset-names
+           (remove-duplicates sequenced-assets :test #'equal))
+         (assets
+           (loop for name in asset-names
+                 collect
+                 (make-instance
+                  'bitmap
+                  :texture (get-asset name :asset-args asset-args))))
+         (sequence
+           (loop for name in sequenced-assets
+                 collect (position name asset-names :test #'equal))))
+    (make-instance
+     'frameset
+     :frames (make-array (length assets) :initial-contents assets)
+     :sequence (make-array (length sequence) :initial-contents sequence)
+     :wait-time (/ 1000.0 fps))))