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 (jump-accel :accessor jump-accel
33 (mayjump :accessor mayjump
35 (maycontjump :accessor maycontjump
37 (autojump :accessor autojump
39 :documentation "push jump-events even though no key is
40 pressed for n invocations.")
41 (overjump :initarg :overjump
44 :documentation "How many Frames to overjump until movement. Default 0.")
45 (overjumped :accessor overjumped
47 :documentation "DO NOT SET MANUALLY - counter for overjumped frames")
48 (width :initarg :width
51 (height :initarg :height
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
66 (tulips :initform 0 :accessor tulips :initarg :tulips)
67 (immortable :initform 0
69 :documentation "after hit by an enemy you wont be
70 wounded by another enemy for that ammount of
74 :documentation "Number of keys for doors")
78 ;; Interaction with enemies
79 (defgeneric player-hits-enemy (player enemy &rest args)
81 "To be called when a player collides with an enemy."))
83 (defmethod player-hits-enemy ((player t) (enemy t) &rest args)
84 (declare (ignore args))
85 "Shouldnt be called - warn only"
87 "player-hits-enemy called with non-fitting classes: ~A ~A~%"
88 (class-name (class-of player))
89 (class-name (class-of enemy))))
91 (defgeneric enemy-hits-player (enemy player &rest args)
93 "To be called when an enemy collides with a player."))
95 (defmethod enemy-hits-player ((enemy t) (player t) &rest args)
96 (declare (ignore args))
97 "Shouldnt be called - warn only"
99 "player-hits-enemy called with non-fitting classes: ~A ~A~%"
100 (class-name (class-of enemy))
101 (class-name (class-of player))))
103 ;; interaction with items
105 (defgeneric item-catch (item player &rest args)
106 (:documentation "Obvious"))
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))))
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))))
120 (defmethod on-key-down ((obj player) key)
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))
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))
140 (defmethod on-key-up ((obj player) key)
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)))))
153 (defmethod invoke ((obj player))
154 "Do whatever a player does ^^"
156 ;; SIMPLE GRAVITY HACK
157 (setf (key-pressed-down obj) (not (key-pressed-up obj)))
159 (if (not (zerop (immortable obj))) (decf (immortable obj)))
161 (let ((go-left (if (key-pressed-left obj) 10 0))
162 (go-right (if (key-pressed-right obj) 10 0))
166 (setf (mayjump obj) nil)
167 (setf (maycontjump obj) t)
168 (setf go-up (jump-accel obj))
169 (setf (jump-accel obj) -49))
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))))))
177 ((key-pressed-up obj)
179 ((> (autojump obj) 0)
181 (decf (autojump obj)))
182 (T (setf (maycontjump obj) nil)))
184 (move-about obj (make-xy (- go-right go-left) go-up)))))