1 ;;; Copyright 2009 Christoph Senjak
3 (in-package :uxul-world)
5 ;; define the standard-class player, which will represent the
9 (defclass player (game-object-with-animation)
10 ((dont-ignore :initarg :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
22 (animation-right :accessor animation-right
23 :initform (make-animation 7
26 (animation :initarg :animation
28 :initform (make-animation 7
31 (last-y :initarg :last-pos
34 (jump-accel :accessor jump-accel
36 (mayjump :accessor mayjump
38 (maycontjump :accessor maycontjump
40 (autojump :accessor autojump
42 :documentation "push jump-events even though no key is
43 pressed for n invocations.")
44 (overjump :initarg :overjump
47 :documentation "How many Frames to overjump until movement. Default 0.")
48 (overjumped :accessor overjumped
50 :documentation "DO NOT SET MANUALLY - counter for overjumped frames")
51 (width :initarg :width
54 (height :initarg :height
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
69 (tulips :initform 0 :accessor tulips :initarg :tulips)
70 (immortable :initform 0
72 :documentation "after hit by an enemy you wont be
73 wounded by another enemy for that ammount of
77 :documentation "Number of keys for doors")
81 ;; Interaction with enemies
82 (defgeneric player-hits-enemy (player enemy &rest args)
84 "To be called when a player collides with an enemy."))
86 (defmethod player-hits-enemy ((player t) (enemy t) &rest args)
87 (declare (ignore args))
88 "Shouldnt be called - warn only"
90 "player-hits-enemy called with non-fitting classes: ~A ~A~%"
91 (class-name (class-of player))
92 (class-name (class-of enemy))))
94 (defgeneric enemy-hits-player (enemy player &rest args)
96 "To be called when an enemy collides with a player."))
98 (defmethod enemy-hits-player ((enemy t) (player t) &rest args)
99 (declare (ignore args))
100 "Shouldnt be called - warn only"
102 "player-hits-enemy called with non-fitting classes: ~A ~A~%"
103 (class-name (class-of enemy))
104 (class-name (class-of player))))
106 ;; interaction with items
108 (defgeneric item-catch (item player &rest args)
109 (:documentation "Obvious"))
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))))
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))))
123 (defmethod on-key-down ((obj player) key)
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))
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))
143 (defmethod on-key-up ((obj player) key)
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)))))
156 (defmethod invoke ((obj player))
157 "Do whatever a player does ^^"
161 (< (last-y obj) (y obj)))
162 (setf (mayjump obj) nil))
164 (setf (last-y obj) (y obj))
166 ;; SIMPLE GRAVITY HACK
167 (setf (key-pressed-down obj) (not (key-pressed-up obj)))
169 (if (not (zerop (immortable obj))) (decf (immortable obj)))
171 (let ((go-left (if (key-pressed-left obj) 10 0))
172 (go-right (if (key-pressed-right obj) 10 0))
176 (setf (mayjump obj) nil)
177 (setf (maycontjump obj) t)
178 (setf go-up (jump-accel obj))
179 (setf (jump-accel obj) -49))
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))))))
187 ((key-pressed-up obj)
189 ((> (autojump obj) 0)
191 (decf (autojump obj)))
192 (T (setf (maycontjump obj) nil)))
194 (move-about obj (make-xy (- go-right go-left) go-up)))))