Nance walk animations

1 files changed, 71 insertions, 0 deletions

diff --git a/macros.lisp b/macros.lisp
new file mode 100644
index 0000000..8f44e68
--- /dev/null
+++ b/macros.lisp
@@ -0,0 +1,71 @@
+(in-package :the-price-of-a-cup-of-coffee)
+
+(defun make-keyword-symbol (s)
+  "Makes a keyword from a string or symbol."
+  (let ((s (format nil "~a" s)))
+    (read-from-string
+     (format nil ":~a"
+             (substitute #\- #\Space s)))))
+
+
+(defmacro def-normal-class (name super &rest slots)
+  "Defines a class with the given name and slots, with accessors and initargs for each slot."
+  `(defclass ,name ,super
+     (,@(loop :for slot :in slots
+              :when (consp slot)
+                :collect (list (car slot)
+                               :accessor (car slot)
+                               :initform (cadr slot)
+                               :initarg (make-keyword-symbol (car slot)))
+              :else
+                :collect (list slot
+                               :accessor slot
+                               :initform nil
+                               :initarg (make-keyword-symbol slot))))))
+
+(defmacro let-cond (&body forms)
+  (let ((tmp-var (gensym)))
+    `(let (,tmp-var)
+       (cond
+         ,@(loop :for (var test . body) :in forms
+                 :if (eq var t)
+                   :collect (list* t (cons test body))
+                 :else
+                   :collect `((setf ,tmp-var ,test)
+                              (let ((,var ,tmp-var))
+                                ,@body)))))))
+(defmacro match-key (key &body clauses)
+  "Each clause is of the form (:scancode-xxx expr1 expr2 ...)"
+  `(cond ,@(loop :for (scancode . actions) :in clauses
+                 :collect `((sdl2:scancode= ,key ,scancode) ,@actions))))
+
+(defmacro let-when ((var test) &body body)
+  `(let ((,var ,test))
+     (when ,var ,@body)))
+
+(defmacro let-if ((var test) then &optional else)
+  `(let ((,var ,test))
+     (if ,var ,then ,else)))
+
+
+(defmacro $ (f &rest args)
+  (let* ((new-args (loop :for a :in args :when (eql a '_) :collect (gensym)))
+         (copy-new (copy-seq new-args))
+         (call-args (loop :for a :in args
+                          :when (eql a '_) :collect (pop copy-new)
+                            :else :collect a)))
+    `(lambda ,new-args (funcall ,f ,@call-args))))
+
+(defmacro with-surface-from-file ((var path) &body body)
+  `(let ((,var (sdl2-image:load-image ,path)))
+     (unwind-protect
+          (progn ,@body)
+       (sdl2:free-surface ,var))))
+
+
+(defmacro with-surface ((var surf) &body body)
+  `(let ((,var ,surf))
+     (unwind-protect
+          (progn ,@body)
+       (sdl2:free-surface ,var))))
+