player.lisp

   1 ;;; Copyright 2009 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 0
  79          :accessor keys
  80          :documentation "Number of keys for doors")
  81    ))
  82
  83
  84 ;; Interaction with enemies
  85 (defgeneric player-hits-enemy (player enemy &rest args)
  86   (:documentation
  87 "To be called when a player collides with an enemy."))
  88
  89 (defmethod player-hits-enemy ((player t) (enemy t) &rest args)
  90   (declare (ignore args))
  91   "Shouldnt be called - warn only"
  92   (format t
  93           "player-hits-enemy called with non-fitting classes: ~A ~A~%"
  94           (class-name (class-of player))
  95           (class-name (class-of enemy))))
  96
  97 (defgeneric enemy-hits-player (enemy player &rest args)
  98   (:documentation
  99 "To be called when an enemy collides with a player."))
 100
 101 (defmethod enemy-hits-player ((enemy t) (player t) &rest args)
 102   (declare (ignore args))
 103   "Shouldnt be called - warn only"
 104   (format t
 105           "player-hits-enemy called with non-fitting classes: ~A ~A~%"
 106           (class-name (class-of enemy))
 107           (class-name (class-of player))))
 108
 109 ;; interaction with items
 110
 111 (defgeneric item-catch (item player &rest args)
 112   (:documentation "Obvious"))
 113
 114 (defmethod item-catch ((item t) (player t) &rest args)
 115   (declare (ignore args))
 116   "Do nothing, just warn."
 117   (format t "item-catch called with non-fitting classes: ~A ~A~%"
 118           (class-name (class-of item))
 119           (class-name (class-of player))))
 120
 121 (defmethod (setf animation) ((new-value animation) (object player))
 122   (setf (x new-value) (+ (x object) (x(animation-translation object))))
 123   (setf (y new-value) (+ (y object) (y(animation-translation object))))
 124   (call-next-method))
 125
 126 (defmethod on-key-down ((obj player) key)
 127   (cond
 128     ((sdl:key= key :SDL-KEY-UP)
 129      (setf (key-pressed-up obj) T))
 130     ((sdl:key= key :SDL-KEY-DOWN)
 131      (setf (key-pressed-down obj) T))
 132     ((sdl:key= key :SDL-KEY-LEFT)
 133      (setf (key-pressed-left obj) T)
 134      (setf (animation obj) (animation-left obj))
 135      (setf (animation-translation obj) (make-xy -40 -20))
 136      (ensure-playing (animation obj))
 137      )
 138     ((sdl:key= key :SDL-KEY-RIGHT)
 139      (setf (key-pressed-right obj) T)
 140      (setf (animation obj) (animation-right obj))
 141      (ensure-playing (animation obj))
 142      (setf (animation-translation obj) (make-xy -20 -20))
 143      )
 144     ))
 145
 146 (defmethod on-key-up ((obj player) key)
 147   (cond
 148     ((sdl:key= key :SDL-KEY-UP )
 149      (setf (key-pressed-up obj) NIL))
 150     ((sdl:key= key :SDL-KEY-DOWN)
 151      (setf (key-pressed-down obj) NIL))
 152     ((sdl:key= key :SDL-KEY-LEFT)
 153      (setf (key-pressed-left obj) NIL)
 154      (ensure-pause (animation obj)))
 155     ((sdl:key= key :SDL-KEY-RIGHT)
 156      (setf (key-pressed-right obj) NIL)
 157      (ensure-pause (animation obj)))))
 158
 159 (defmethod invoke ((obj player))
 160   "Do whatever a player does ^^"
 161
 162   (cond
 163     ((bounced obj)
 164      (setf (bounced obj) nil))
 165     ((and
 166       (last-y obj)
 167       (< (last-y obj) (y obj)))
 168      (setf (mayjump obj) nil)))
 169
 170   (setf (last-y obj) (y obj))
 171
 172   ;; SIMPLE GRAVITY HACK
 173   (setf (key-pressed-down obj) (not (key-pressed-up obj)))
 174
 175   (if (not (zerop (immortable obj))) (decf (immortable obj)))
 176
 177   (let ((go-left (if (key-pressed-left obj) 10 0))
 178         (go-right (if (key-pressed-right obj) 10 0))
 179         (go-up 30))
 180     (labels ((jump ()
 181               (cond ((mayjump obj)
 182               (setf (mayjump obj) nil)
 183               (setf (maycontjump obj) t)
 184               (setf go-up (jump-accel obj))
 185               (setf (jump-accel obj) -49))
 186              ((maycontjump obj)
 187               (setf go-up (jump-accel obj))
 188               (incf (jump-accel obj) 3)
 189               (when (zerop (jump-accel obj))
 190                   (setf (maycontjump obj) nil)
 191                   (setf (jump-accel obj) -50))))))
 192       (cond
 193         ((key-pressed-up obj)
 194          (jump))
 195         ((> (autojump obj) 0)
 196          (jump)
 197          (decf (autojump obj)))
 198         (T (setf (maycontjump obj) nil)))
 199
 200     (move-about obj (make-xy (- go-right go-left) go-up)))))