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