1 ;;; Copyright 2009-2011 Christoph Senjak
3 (in-package :uxul-world)
5 (defclass burning-marshmallow (moving-enemy)
6 ((dont-ignore :accessor dont-ignore :initform t)
7 (width :initarg :width :initform 64 :accessor width)
8 (height :initarg :height :initform 64 :accessor height)
9 (active :initarg :active :initform t :accessor active)
10 (redraw :initarg :redraw :initform t :accessor redraw)
11 (activated :initarg :activated :initform nil :accessor activated)
13 (animation :initarg :animation :initform
15 |burning_marshmallow_lu1|
16 |burning_marshmallow_lu2|)
19 (lu-animation :initform (make-animation 2
20 |burning_marshmallow_lu1|
21 |burning_marshmallow_lu2|))
22 (ld-animation :initform (make-animation 2
23 |burning_marshmallow_ld1|
24 |burning_marshmallow_ld2|))
25 (ru-animation :initform (make-animation 2
26 |burning_marshmallow_ru1|
27 |burning_marshmallow_ru2|))
28 (rd-animation :initform (make-animation 2
29 |burning_marshmallow_rd1|
30 |burning_marshmallow_rd2|))
31 (inner-rectangle :initarg :inner-rectangle
32 :accessor inner-rectangle
35 "An additional rectangle which the burning-marshmallow wont leave. Form: '(x1 y1 x2 y2). If nil, no bounds."
37 (horizontal-speed :initarg :horizontal-speed
38 :accessor horizontal-speed
40 (vertical-speed :initarg :vertical-speed
41 :accessor vertical-speed
43 (horizontal-direction :initarg :horizontal-direction
44 :accessor horizontal-direction
46 (vertical-direction :initarg :vertical-direction
47 :accessor vertical-direction
50 (defmethod invoke ((obj burning-marshmallow))
53 (when (inner-rectangle obj)
55 ((eql (horizontal-direction obj) :right)
56 (when (< (caddr (inner-rectangle obj))
57 (+ (x obj) (horizontal-speed obj)))
58 (setf (horizontal-direction obj) :left)
59 (set-burning-marshmallow-animation obj)))
60 (T ;; (eql (horizontal-direction obj) :left)
61 (when (> (car (inner-rectangle obj))
62 (- (x obj) (horizontal-speed obj)))
63 (setf (horizontal-direction obj) :right)
64 (set-burning-marshmallow-animation obj))))
66 ((eql (vertical-direction obj) :down)
67 (when (< (cadddr (inner-rectangle obj))
68 (+ (y obj) (vertical-speed obj)))
69 (setf (vertical-direction obj) :up)
70 (set-burning-marshmallow-animation obj)))
71 (T ;; (eql (vertical-direction obj) :up)
72 (when (> (cadr (inner-rectangle obj))
73 (- (y obj) (vertical-speed obj)))
74 (setf (vertical-direction obj) :down)
75 (set-burning-marshmallow-animation obj)))))
76 (move-about obj (make-xy
77 (if (eql (horizontal-direction obj) :left)
78 (- (horizontal-speed obj)) (horizontal-speed obj))
79 (if (eql (vertical-direction obj) :up)
80 (- (vertical-speed obj)) (vertical-speed obj)))))
82 (dolist (player (get-objects *current-room* 'player))
84 (< (abs (- (x player) (x obj))) (+ +screen-width+ 300))
85 (< (abs (- (y player) (y obj))) (+ +screen-height+ 300)))
86 (setf (activated obj) T))))))
88 (defun set-burning-marshmallow-animation (obj)
90 ((eql (horizontal-direction obj) :LEFT)
92 ((eql (vertical-direction obj) :UP)
93 (setf (animation obj) (slot-value obj 'lu-animation)))
94 (T ;; (eql (vertical-direction obj) :DOWN)
95 (setf (animation obj) (slot-value obj 'ld-animation)))))
96 (T ;;(eql (horizontal-direction obj) :RIGHT)
98 ((eql (vertical-direction obj) :UP)
99 (setf (animation obj) (slot-value obj 'ru-animation)))
100 (T ;; (eql (vertical-direction obj) :DOWN)
101 (setf (animation obj) (slot-value obj 'rd-animation)))))))
104 ; already defined in simple-enemy.lisp - possibly a bug?
106 ;; (defun simple-enemy-and-player (player enemy)
107 ;; (decf (power player))
108 ;; (setf (active enemy) nil)
109 ;; (setf (visible enemy) nil)
110 ;; (setf (colliding enemy) nil))
112 (defmethod player-hits-enemy ((player player) (enemy burning-marshmallow) &rest args)
113 (declare (ignore args))
114 (decf (power player)))
116 (defmethod enemy-hits-player ((enemy burning-marshmallow) (player player) &rest args)
117 (declare (ignore args))
118 (decf (power player)))