animation.lisp

   1 ;;; Copyright 2009 Christoph Senjak
   2
   3 ;; Basic definitions for animations. Needs lispbuilder-sdl.
   4
   5 (in-package :uxul-world)
   6
   7 (defparameter *zoom-ash* -1)
   8 (defmacro zoom-trans (x) `(ash ,x *zoom-ash*))
   9
  10 (defparameter *graphics-table* nil)
  11
  12 ;; the functions may assume that the contents of a graphics-file -
  13 ;; once read - will not change at any time - so it wont reload
  14 ;; graphics with an equivalent path any time you load an image.
  15
  16 (defclass animation (xy-coordinates)
  17   (
  18 ;;   (images :initarg :images
  19 ;;                   :initform (make-array (list 0) :element-type 'sdl:surface)
  20 ;;                   :accessor images
  21 ;; ;                 :type (simple-array 'sdl:surface (*))
  22 ;;                   :documentation "Array with the images")
  23    (images-2x :initarg :images-2x
  24               :initform (make-array (list 0) :element-type 'sdl:surface)
  25               :accessor images-2x
  26               :documentation "Array of double-sized images")
  27    (images-1x :initarg :images-1x
  28               :initform (make-array (list 0) :element-type 'sdl:surface)
  29               :accessor images-1x
  30               :documentation "Array of normal-sized images")
  31    (images-.5x :initarg :images-.5x
  32                :initform (make-array (list 0) :element-type 'sdl:surface)
  33                :accessor images-.5x
  34                :documentation "Array of half-sized images")
  35    (images-.25x :initarg :images-.25x
  36                 :initform (make-array (list 0) :element-type 'sdl:surface)
  37                 :accessor images-.25x
  38                 :documentation "Array of quarter-sized images")
  39    (sprite-image-number :initform 0
  40                         :initarg :sprite-image-number
  41                         :accessor sprite-image-number
  42 ;                       :type xy-struct
  43                         :documentation "The Element-Number of the
  44                        current image. This slot should not be set
  45                        directly.")
  46    (sprite-delay :initarg :sprite-delay
  47                  :initform 0
  48                  :accessor sprite-delay
  49 ;                :type integer
  50                  :documentation "How much frames to overjump on the
  51 whole until changing to the next image of the animation.")
  52    (already-jumped :initform 0
  53                    :initarg :already-jumped
  54                    :accessor already-jumped
  55 ;                  :type integer
  56                    :documentation "How much frames have been already
  57    drawn until the last jump? If this equals to <sprite-delay>, the
  58    next image is selected. Dont set this variable yourself." )
  59    (visible :initarg :visible
  60             :initform T
  61             :accessor visible
  62 ;           :type boolean
  63             :documentation "Should this Animation be visible (i.e. be
  64             drawn when the draw-method is called)? Anyway, the
  65             draw-method will - even if set to false - \"animate\" the
  66             animation, i.e. rotate the image currently drawn, if not
  67             paused. It simply wont draw the graphics to the
  68             screen.")
  69    (reference-to-original :initarg :reference-to-original
  70                           :accessor reference-to-original
  71                           :initform nil
  72                           :documentation "DO NOT SET THIS MANUALLY! DO
  73 NOT USE IT! This may not stay in later versions of this Program. It
  74 will be used to minimize the number of file-accesses for loading
  75 animations. For any animation created from a file by the api from
  76 below, this will refer to an animation in the *graphics-table*." )))
  77
  78 (defmethod images ((obj animation))
  79   (cond
  80     ((= *zoom-ash* 0)
  81      (images-2x obj))
  82     ((= *zoom-ash* -1)
  83      (images-1x obj))
  84     ((= *zoom-ash* -2)
  85      (images-.5x obj))
  86     ((= *zoom-ash* -3)
  87      (images-.25x obj))))
  88
  89
  90 (defmethod draw ((obj animation))
  91   (when (not (<= (sprite-delay obj) 0)) ;<=, because -a means "paused,
  92                                         ;but a is the delay when
  93                                         ;playing again", and 0 means
  94                                         ;"no playing"
  95     (incf (already-jumped obj))
  96     (when (= (sprite-delay obj) (already-jumped obj))
  97       (setf (already-jumped obj) 0)
  98       (setf (sprite-image-number obj) (mod (+ 1 (sprite-image-number obj)) (length (images obj))))))
  99   (when (visible obj)
 100     (sdl:draw-surface-at-* (elt (images obj) (sprite-image-number obj))
 101                            (zoom-trans (+ *current-translation-x* (round (x obj))))
 102                            (zoom-trans (+ *current-translation-y* (round (y obj)))))))
 103
 104 ;additional methods to make life easier
 105 (defmethod pause ((obj animation))
 106   "toggle the playing-flag (sgn sprite-delay), see documentation of draw-method."
 107   (setf (sprite-delay obj) (- (sprite-delay obj))))
 108
 109 (defmethod is-paused ((obj animation))
 110   "is animation paused?"
 111   (< (sprite-delay obj) 0))
 112
 113 (defmethod is-playing ((obj animation))
 114   "is animation playing?"
 115   (< 0 (sprite-delay obj)))
 116
 117 (defmethod ensure-pause ((obj animation))
 118   "ensures that the animation is paused if playing, otherwise, nothing is done."
 119   (when (is-playing obj) (pause obj)))
 120
 121 (defmethod ensure-playing ((obj animation))
 122   "ensures that the animation is playing if paused, otherwise, nothing is done."
 123   (when (is-paused obj) (pause obj)))
 124
 125 (defmethod rewind ((obj animation))
 126   "rewind the animation"
 127   (setf (slot-value obj 'sprite-image-number) 0))
 128
 129 #|(defun load-png-image (filename)
 130   (sdl-image:load-image (gethash filename *file-table*) :image-type :PNG :alpha 1 )) ;; :alpha t))
 131
 132 (defun hashed-load-image (filename)
 133   "loads an image by its filename, if it wasnt loaded yet. returns a
 134 reference, if the current filename already exists."
 135   (let ((ret (gethash filename *graphics-table* nil)))
 136     (cond
 137       (ret ret)
 138       (T
 139        (setf ret (load-png-image filename))
 140        (setf (gethash filename *graphics-table*) ret)
 141        ret))))|#
 142
 143 (defun make-animation (frame-skip &rest image-list)
 144   "Create an animation from the list of animation-names given in the
 145 images-variable."
 146   (make-instance 'animation
 147                  :images-2x (mapcar
 148                              #'(lambda (x)
 149                                  (sdl:convert-surface :surface (sdl-image:load-image
 150                                                                 (car x)
 151                                                                 :image-type :PNG :alpha 1 )))
 152                              image-list)
 153                  :images-1x (mapcar
 154                              #'(lambda (x)
 155                                  (sdl:convert-surface :surface (sdl-image:load-image
 156                                                                 (cadr x)
 157                                                                 :image-type :PNG :alpha 1 )))
 158                              image-list)
 159                  :images-.5x (mapcar
 160                              #'(lambda (x)
 161                                  (sdl:convert-surface :surface (sdl-image:load-image
 162                                                                 (caddr x)
 163                                                                 :image-type :PNG :alpha 1 )))
 164                              image-list)
 165                  :images-.25x (mapcar
 166                              #'(lambda (x)
 167                                  (sdl:convert-surface :surface (sdl-image:load-image
 168                                                                 (cadddr x)
 169                                                                 :image-type :PNG :alpha 1 )))
 170                              image-list)
 171                  :sprite-delay frame-skip))