player.lisp

   1 ;;; Copyright 2009-2011 Christoph Senjak
   2
   3 (in-package :uxul-world)
   4
   5 ;; define the standard-class player, which will represent the
   6 ;; player.
   7
   8
   9 (defclass player (game-object-with-animation)
  10   ((dont-ignore :initarg :dont-ignore
  11                 :initform T
  12                 :accessor dont-ignore
  13                 :documentation "When we're testing whether we can go
  14                 on or not without colliding, we will set this flag to
  15                 nil, which means, that all collision-methods should
  16                 ONLY set the player to the position when it collides,
  17                 but NOT have any other effect (since its only a test)")
  18    (animation-left :accessor animation-left
  19                    :initform (make-animation 7
  20                                              |uxul_small1|
  21                                              |uxul_small2|))
  22    (animation-right :accessor animation-right
  23                     :initform (make-animation 7
  24                                               |uxul_small3|
  25                                               |uxul_small4|))
  26    (animation :initarg :animation
  27               :accessor animation
  28               :initform  (make-animation 7
  29                                         |uxul_small1|
  30                                         |uxul_small2|))
  31    (last-y :initarg :last-pos
  32              :accessor last-y
  33              :initform nil)
  34    (bounced :initarg :bounced
  35             :accessor bounced
  36             :initform nil)
  37    (jump-accel :accessor jump-accel
  38                :initform -50)
  39    (mayjump :accessor mayjump
  40             :initform t)
  41    (maycontjump :accessor maycontjump
  42                 :initform t)
  43    (autojump :accessor autojump
  44              :initform 0
  45              :documentation "push jump-events even though no key is
  46              pressed for n invocations.")
  47    (overjump :initarg :overjump
  48              :accessor overjump
  49              :initform 0
  50              :documentation "How many Frames to overjump until movement. Default 0.")
  51    (overjumped :accessor overjumped
  52                :initform 0
  53                :documentation "DO NOT SET MANUALLY - counter for overjumped frames")
  54    (width :initarg :width
  55           :accessor width
  56           :initform 60)
  57    (height :initarg :height
  58            :accessor height
  59            :initform 75)
  60    (animation-translation :initarg :animation-translation
  61                           :accessor animation-translation
  62                           :initform (make-xy -40 -20))
  63    (key-pressed-up :initform nil :accessor key-pressed-up :initarg :key-pressed-up)
  64    (key-pressed-down :initform nil :accessor key-pressed-down :initarg :key-pressed-down)
  65    (key-pressed-left :initform nil :accessor key-pressed-left :initarg :key-pressed-left)
  66    (key-pressed-right :initform nil :accessor key-pressed-right :initarg :key-pressed-right)
  67    (go-down :initform 0 :accessor go-down :initarg :go-down)
  68    (go-right :initform 0 :accessor go-right :initarg :go-right)
  69    (power :initform 10 :accessor
  70    power :initarg :power :documentation "power - will be decreased if
  71    enemy touches.")
  72    (tulips :initform 0 :accessor tulips :initarg :tulips)
  73    (immortable :initform 0
  74                :accessor immortable
  75                :documentation "after hit by an enemy you wont be
  76                wounded by another enemy for that ammount of
  77                frames.")
  78    (keys :initform nil
  79          :initarg :keys
  80          :accessor keys
  81          :documentation "List of Key-Dungeons of keys (i.e. for every
  82    key its key-dungeon is pushed on that list, for every door, its
  83    removed again).")  ))
  84
  85
  86 ;; Interaction with enemies
  87 (defgeneric player-hits-enemy (player enemy &rest args)
  88   (:documentation
  89 "To be called when a player collides with an enemy."))
  90
  91 (defmethod player-hits-enemy ((player t) (enemy t) &rest args)
  92   (declare (ignore args))
  93   "Shouldnt be called - warn only"
  94   (format t
  95           "player-hits-enemy called with non-fitting classes: ~A ~A~%"
  96           (class-name (class-of player))
  97           (class-name (class-of enemy))))
  98
  99 (defgeneric enemy-hits-player (enemy player &rest args)
 100   (:documentation
 101 "To be called when an enemy collides with a player."))
 102
 103 (defmethod enemy-hits-player ((enemy t) (player t) &rest args)
 104   (declare (ignore args))
 105   "Shouldnt be called - warn only"
 106   (format t
 107           "player-hits-enemy called with non-fitting classes: ~A ~A~%"
 108           (class-name (class-of enemy))
 109           (class-name (class-of player))))
 110
 111 ;; interaction with items
 112
 113 (defgeneric item-catch (item player &rest args)
 114   (:documentation "Obvious"))
 115
 116 (defmethod item-catch ((item t) (player t) &rest args)
 117   (declare (ignore args))
 118   "Do nothing, just warn."
 119   (format t "item-catch called with non-fitting classes: ~A ~A~%"
 120           (class-name (class-of item))
 121           (class-name (class-of player))))
 122
 123 (defmethod item-catch ((item key) (player player) &rest args)
 124   (declare (ignore args))
 125   (push (dungeon item) (keys player))
 126   (setf (visible item) nil)
 127   (setf (colliding item) nil))
 128
 129 (defmethod (setf animation) ((new-value animation) (object player))
 130   (setf (x new-value) (+ (x object) (x(animation-translation object))))
 131   (setf (y new-value) (+ (y object) (y(animation-translation object))))
 132   (call-next-method))
 133
 134 (defmethod on-key-down ((obj player) key)
 135   (cond
 136     ((sdl:key= key :SDL-KEY-UP)
 137      (setf (key-pressed-up obj) T))
 138     ((sdl:key= key :SDL-KEY-DOWN)
 139      (setf (key-pressed-down obj) T))
 140     ((sdl:key= key :SDL-KEY-LEFT)
 141      (setf (key-pressed-left obj) T)
 142      (setf (animation obj) (animation-left obj))
 143      (setf (animation-translation obj) (make-xy -40 -20))
 144      (ensure-playing (animation obj))
 145      )
 146     ((sdl:key= key :SDL-KEY-RIGHT)
 147      (setf (key-pressed-right obj) T)
 148      (setf (animation obj) (animation-right obj))
 149      (ensure-playing (animation obj))
 150      (setf (animation-translation obj) (make-xy -20 -20))
 151      )
 152     ))
 153
 154 (defmethod on-key-up ((obj player) key)
 155   (cond
 156     ((sdl:key= key :SDL-KEY-UP )
 157      (setf (key-pressed-up obj) NIL))
 158     ((sdl:key= key :SDL-KEY-DOWN)
 159      (setf (key-pressed-down obj) NIL))
 160     ((sdl:key= key :SDL-KEY-LEFT)
 161      (setf (key-pressed-left obj) NIL)
 162      (ensure-pause (animation obj)))
 163     ((sdl:key= key :SDL-KEY-RIGHT)
 164      (setf (key-pressed-right obj) NIL)
 165      (ensure-pause (animation obj)))))
 166
 167 (defmethod invoke ((obj player))
 168   "Do whatever a player does ^^"
 169
 170   (cond
 171     ((bounced obj)
 172      (setf (bounced obj) nil))
 173     ((and
 174       (last-y obj)
 175       (< (last-y obj) (y obj)))
 176      (setf (mayjump obj) nil)))
 177
 178   (setf (last-y obj) (y obj))
 179
 180   ;; SIMPLE GRAVITY HACK
 181   (setf (key-pressed-down obj) (not (key-pressed-up obj)))
 182
 183   (if (not (zerop (immortable obj))) (decf (immortable obj)))
 184
 185   (let ((go-left (if (key-pressed-left obj) 10 0))
 186         (go-right (if (key-pressed-right obj) 10 0))
 187         (go-up 30))
 188     (labels ((jump ()
 189               (cond ((mayjump obj)
 190               (setf (mayjump obj) nil)
 191               (setf (maycontjump obj) t)
 192               (setf go-up (jump-accel obj))
 193               (setf (jump-accel obj) -49))
 194              ((maycontjump obj)
 195               (setf go-up (jump-accel obj))
 196               (incf (jump-accel obj) 3)
 197               (when (zerop (jump-accel obj))
 198                   (setf (maycontjump obj) nil)
 199                   (setf (jump-accel obj) -50))))))
 200       (cond
 201         ((key-pressed-up obj)
 202          (jump))
 203         ((> (autojump obj) 0)
 204          (jump)
 205          (decf (autojump obj)))
 206         (T (setf (maycontjump obj) nil)))
 207
 208     (move-about obj (make-xy (- go-right go-left) go-up)))))