1 ;;; Copyright 2009-2011 Christoph Senjak
3 (in-package :uxul-world)
5 (defclass anchor (game-object)
6 ((dungeon :initform nil
9 (:documentation "This object ist just to make it easier to handle
10 positions in the game, i.e. for bounding-rects for
11 burning-marshmallows, etc."))
13 (defclass leaf (bottom)
14 ((animation :initarg :animation
16 :initform (make-animation 0 |leaf|))
17 (width :initarg :width
20 (height :initarg :height
23 (animation-translation :initarg :animation-translation
24 :accessor animation-translation
25 :initform (make-xy -7 -30))
28 (defclass tulip (standing-item)
29 ((animation :initarg :animation
31 :initform (make-animation 10 |tulip| |tulip2| |tulip| |tulip3|))
32 (width :initarg :width
35 (height :initarg :height
39 (defclass key (standing-item)
40 ((animation :initarg :animation
42 :initform (make-animation 0 |key|))
43 (width :initarg :width
46 (height :initarg :height
49 (dungeon :initarg :dungeon
52 :documentation "To provide information in which rooms this key can be used.")))
54 (defclass door (stone)
55 ((animation :initarg :animation
57 :initform (make-animation 0 |door|))
58 (width :initarg :width
61 (height :initarg :height
64 (dungeon :initarg :dungeon
67 :documentation "To provide information in which room this door is.")))
69 (defclass teleporter (game-object-with-animation)
70 ((animation :initarg :animation
72 :initform (make-animation 0 |teleporter|))
73 (width :initarg :width
76 (height :initarg :height
79 (next-room-function :initarg :next-room-function
80 :accessor next-room-function
81 :initform (lambda () *current-room*))))
83 (defmethod invoke ((obj teleporter))
85 ((player (car (get-objects *current-room* 'player))))
87 ((rectangles-overlap (x obj) (y obj)
88 (+ (x obj) (width obj))
89 (+ (y obj) (height obj))
91 (+ (x player) (width player))
92 (+ (y player) (height player)))
93 (if (key-pressed-up player)
95 (setf *current-room* (funcall (next-room-function obj)))))
96 (T (setf (active obj) nil)))))