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    (jump-accel :accessor jump-accel
  35                :initform -50)
  36    (mayjump :accessor mayjump
  37             :initform t)
  38    (maycontjump :accessor maycontjump
  39                 :initform t)
  40    (autojump :accessor autojump
  41              :initform 0
  42              :documentation "push jump-events even though no key is
  43              pressed for n invocations.")
  44    (overjump :initarg :overjump
  45              :accessor overjump
  46              :initform 0
  47              :documentation "How many Frames to overjump until movement. Default 0.")
  48    (overjumped :accessor overjumped
  49                :initform 0
  50                :documentation "DO NOT SET MANUALLY - counter for overjumped frames")
  51    (width :initarg :width
  52           :accessor width
  53           :initform 60)
  54    (height :initarg :height
  55            :accessor height
  56            :initform 75)
  57    (animation-translation :initarg :animation-translation
  58                           :accessor animation-translation
  59                           :initform (make-xy -40 -20))
  60    (key-pressed-up :initform nil :accessor key-pressed-up :initarg :key-pressed-up)
  61    (key-pressed-down :initform nil :accessor key-pressed-down :initarg :key-pressed-down)
  62    (key-pressed-left :initform nil :accessor key-pressed-left :initarg :key-pressed-left)
  63    (key-pressed-right :initform nil :accessor key-pressed-right :initarg :key-pressed-right)
  64    (go-down :initform 0 :accessor go-down :initarg :go-down)
  65    (go-right :initform 0 :accessor go-right :initarg :go-right)
  66    (power :initform 10 :accessor
  67    power :initarg :power :documentation "power - will be decreased if
  68    enemy touches.")
  69    (tulips :initform 0 :accessor tulips :initarg :tulips)
  70    (immortable :initform 0
  71                :accessor immortable
  72                :documentation "after hit by an enemy you wont be
  73                wounded by another enemy for that ammount of
  74                frames.")
  75    (keys :initform 0
  76          :accessor keys
  77          :documentation "Number of keys for doors")
  78    ))
  79
  80
  81 ;; Interaction with enemies
  82 (defgeneric player-hits-enemy (player enemy &rest args)
  83   (:documentation
  84 "To be called when a player collides with an enemy."))
  85
  86 (defmethod player-hits-enemy ((player t) (enemy t) &rest args)
  87   (declare (ignore args))
  88   "Shouldnt be called - warn only"
  89   (format t
  90           "player-hits-enemy called with non-fitting classes: ~A ~A~%"
  91           (class-name (class-of player))
  92           (class-name (class-of enemy))))
  93
  94 (defgeneric enemy-hits-player (enemy player &rest args)
  95   (:documentation
  96 "To be called when an enemy collides with a player."))
  97
  98 (defmethod enemy-hits-player ((enemy t) (player t) &rest args)
  99   (declare (ignore args))
 100   "Shouldnt be called - warn only"
 101   (format t
 102           "player-hits-enemy called with non-fitting classes: ~A ~A~%"
 103           (class-name (class-of enemy))
 104           (class-name (class-of player))))
 105
 106 ;; interaction with items
 107
 108 (defgeneric item-catch (item player &rest args)
 109   (:documentation "Obvious"))
 110
 111 (defmethod item-catch ((item t) (player t) &rest args)
 112   (declare (ignore args))
 113   "Do nothing, just warn."
 114   (format t "item-catch called with non-fitting classes: ~A ~A~%"
 115           (class-name (class-of item))
 116           (class-name (class-of player))))
 117
 118 (defmethod (setf animation) ((new-value animation) (object player))
 119   (setf (x new-value) (+ (x object) (x(animation-translation object))))
 120   (setf (y new-value) (+ (y object) (y(animation-translation object))))
 121   (call-next-method))
 122
 123 (defmethod on-key-down ((obj player) key)
 124   (cond
 125     ((sdl:key= key :SDL-KEY-UP)
 126      (setf (key-pressed-up obj) T))
 127     ((sdl:key= key :SDL-KEY-DOWN)
 128      (setf (key-pressed-down obj) T))
 129     ((sdl:key= key :SDL-KEY-LEFT)
 130      (setf (key-pressed-left obj) T)
 131      (setf (animation obj) (animation-left obj))
 132      (setf (animation-translation obj) (make-xy -40 -20))
 133      (ensure-playing (animation obj))
 134      )
 135     ((sdl:key= key :SDL-KEY-RIGHT)
 136      (setf (key-pressed-right obj) T)
 137      (setf (animation obj) (animation-right obj))
 138      (ensure-playing (animation obj))
 139      (setf (animation-translation obj) (make-xy -20 -20))
 140      )
 141     ))
 142
 143 (defmethod on-key-up ((obj player) key)
 144   (cond
 145     ((sdl:key= key :SDL-KEY-UP )
 146      (setf (key-pressed-up obj) NIL))
 147     ((sdl:key= key :SDL-KEY-DOWN)
 148      (setf (key-pressed-down obj) NIL))
 149     ((sdl:key= key :SDL-KEY-LEFT)
 150      (setf (key-pressed-left obj) NIL)
 151      (ensure-pause (animation obj)))
 152     ((sdl:key= key :SDL-KEY-RIGHT)
 153      (setf (key-pressed-right obj) NIL)
 154      (ensure-pause (animation obj)))))
 155
 156 (defmethod invoke ((obj player))
 157   "Do whatever a player does ^^"
 158
 159   (if (and
 160        (last-y obj)
 161        (< (last-y obj) (y obj)))
 162       (setf (mayjump obj) nil))
 163
 164   (setf (last-y obj) (y obj))
 165
 166   ;; SIMPLE GRAVITY HACK
 167   (setf (key-pressed-down obj) (not (key-pressed-up obj)))
 168
 169   (if (not (zerop (immortable obj))) (decf (immortable obj)))
 170
 171   (let ((go-left (if (key-pressed-left obj) 10 0))
 172         (go-right (if (key-pressed-right obj) 10 0))
 173         (go-up 30))
 174     (labels ((jump ()
 175               (cond ((mayjump obj)
 176               (setf (mayjump obj) nil)
 177               (setf (maycontjump obj) t)
 178               (setf go-up (jump-accel obj))
 179               (setf (jump-accel obj) -49))
 180              ((maycontjump obj)
 181               (setf go-up (jump-accel obj))
 182               (incf (jump-accel obj) 3)
 183               (when (zerop (jump-accel obj))
 184                   (setf (maycontjump obj) nil)
 185                   (setf (jump-accel obj) -50))))))
 186       (cond
 187         ((key-pressed-up obj)
 188          (jump))
 189         ((> (autojump obj) 0)
 190          (jump)
 191          (decf (autojump obj)))
 192         (T (setf (maycontjump obj) nil)))
 193
 194     (move-about obj (make-xy (- go-right go-left) go-up)))))