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 (bounced :initarg :bounced
37 (jump-accel :accessor jump-accel
39 (mayjump :accessor mayjump
41 (maycontjump :accessor maycontjump
43 (autojump :accessor autojump
45 :documentation "push jump-events even though no key is
46 pressed for n invocations.")
47 (overjump :initarg :overjump
50 :documentation "How many Frames to overjump until movement. Default 0.")
51 (overjumped :accessor overjumped
53 :documentation "DO NOT SET MANUALLY - counter for overjumped frames")
54 (width :initarg :width
57 (height :initarg :height
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
72 (tulips :initform 0 :accessor tulips :initarg :tulips)
73 (immortable :initform 0
75 :documentation "after hit by an enemy you wont be
76 wounded by another enemy for that ammount of
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
86 ;; Interaction with enemies
87 (defgeneric player-hits-enemy (player enemy &rest args)
89 "To be called when a player collides with an enemy."))
91 (defmethod player-hits-enemy ((player t) (enemy t) &rest args)
92 (declare (ignore args))
93 "Shouldnt be called - warn only"
95 "player-hits-enemy called with non-fitting classes: ~A ~A~%"
96 (class-name (class-of player))
97 (class-name (class-of enemy))))
99 (defgeneric enemy-hits-player (enemy player &rest args)
101 "To be called when an enemy collides with a player."))
103 (defmethod enemy-hits-player ((enemy t) (player t) &rest args)
104 (declare (ignore args))
105 "Shouldnt be called - warn only"
107 "player-hits-enemy called with non-fitting classes: ~A ~A~%"
108 (class-name (class-of enemy))
109 (class-name (class-of player))))
111 ;; interaction with items
113 (defgeneric item-catch (item player &rest args)
114 (:documentation "Obvious"))
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))))
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))
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))))
134 (defmethod on-key-down ((obj player) key)
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))
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))
154 (defmethod on-key-up ((obj player) key)
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)))))
167 (defmethod invoke ((obj player))
168 "Do whatever a player does ^^"
172 (setf (bounced obj) nil))
175 (< (last-y obj) (y obj)))
176 (setf (mayjump obj) nil)))
178 (setf (last-y obj) (y obj))
180 ;; SIMPLE GRAVITY HACK
181 (setf (key-pressed-down obj) (not (key-pressed-up obj)))
183 (if (not (zerop (immortable obj))) (decf (immortable obj)))
185 (let ((go-left (if (key-pressed-left obj) 10 0))
186 (go-right (if (key-pressed-right obj) 10 0))
190 (setf (mayjump obj) nil)
191 (setf (maycontjump obj) t)
192 (setf go-up (jump-accel obj))
193 (setf (jump-accel obj) -49))
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))))))
201 ((key-pressed-up obj)
203 ((> (autojump obj) 0)
205 (decf (autojump obj)))
206 (T (setf (maycontjump obj) nil)))
208 (move-about obj (make-xy (- go-right go-left) go-up)))))