game-object-with-animation.lisp

   1 ;;; Copyright 2009-2011 Christoph Senjak
   2
   3 (in-package :uxul-world)
   4
   5 ;; as many game-objects do have an animation related to them, instead
   6 ;; of just having a draw-method which will manually draw anything, we
   7 ;; declare a standard-class for that, with some useful methods.
   8
   9 (defclass game-object-with-animation (game-object)
  10   ((animation-translation :initarg :animation-translation
  11                           :accessor animation-translation
  12                           :initform (make-xy 0 0)
  13                           :documentation "The translation of the
  14                           animation (in double zoom).")
  15    (animation :initarg :animation
  16               :accessor animation
  17               :documentation "The animation of this object")
  18    (animation-bounds :initarg :animation-bounds
  19                      :accessor animation-bounds
  20                      :initform (make-xy 50 50)
  21                      :documentation "When drawing, objects outside the
  22    screen are tried not to be drawn via SDL. This determines, how far
  23    in every direction the graphics may go outside the
  24    collision-rectangle. Try to keep this number small. If it is too
  25    huge, you may get numeric errors. 50/50 should be sufficient for
  26    most objects. If this value is nil, the object will always be
  27    drawn.")))
  28
  29 (defmethod (setf animation) ((newval animation) (obj game-object-with-animation))
  30   "Sets the animation and x and y-coordinates. Wont rewind the animation."
  31     (setf (slot-value obj 'animation) newval)
  32     (setf (x obj) (x obj))
  33     (setf (y obj) (y obj))
  34     (setf (visible obj) (visible obj)))
  35
  36 (defmethod (setf x) (newval (obj game-object-with-animation))
  37   (call-next-method)
  38   (setf (x (animation obj)) (+ (x obj) (x (animation-translation obj)))))
  39
  40 (defmethod (setf y) (newval (obj game-object-with-animation))
  41   (call-next-method)
  42   (setf (y (animation obj)) (+ (y obj) (y (animation-translation obj)))))
  43
  44 (defmethod (setf visible) (newval (obj game-object-with-animation))
  45   (call-next-method)
  46   (setf (visible (animation obj)) newval))
  47
  48 (defun rectangle-in-screen (obj)
  49   (let ((bounds (animation-bounds obj)))
  50     (if bounds
  51         (rectangles-overlap
  52          ;; HAAAAAAAAAAAAAAACK
  53          (- (x obj) (x bounds))
  54          (- (y obj) (y bounds))
  55          (+ (x obj) (width obj) (x bounds))
  56          (+ (y obj) (height obj) (y bounds))
  57          (- *current-translation-x*)
  58          (- *current-translation-y*)
  59          (- (ash +screen-width+ (- *zoom-ash*)) *current-translation-x*)
  60          (- (ash +screen-height+ (- *zoom-ash*)) *current-translation-y*))
  61         T))
  62 )
  63
  64
  65
  66 (defmethod draw ((obj game-object-with-animation))
  67   ;(if (rectangle-in-screen obj)
  68       (draw (animation obj))
  69 ;)
  70 )
  71
  72 (defmethod shared-initialize :after ((instance game-object-with-animation) spam &rest
  73                                      initargs &key &allow-other-keys)
  74   (declare (ignore initargs))
  75   (declare (ignore spam))
  76   "Set the x and y-Coordinates in the drawable and the rectangle (this
  77 had to be done by hand before)"
  78 ;  (write (x instance))
  79 ;  (write (y instance))
  80   (setf (x instance) (x instance))
  81   (setf (y instance) (y instance))
  82   (setf (visible instance) (visible instance)))
  83