(if (invocation-function obj)
(funcall (invocation-function obj) obj)
(dolist (invoker (get-objects obj 'uxul-world::game-object))
- (if (active invoker) (invoke invoker)))))
\ No newline at end of file
+ (if (active invoker) (invoke invoker)))))
+
+(defun create-room-from-item-list (item-list)
+ (let*
+ ((player (make-instance 'player
+ :active t
+ :visible t
+ :redraw t))
+ (room (make-instance 'room :width 0 :height 0
+ :graphic-centralizer player
+ :key-listener player
+ :key-up-function #'(lambda (key) (on-key-up player key))
+ :key-down-function #'(lambda (key) (on-key-down player key))))
+ (anchor-table (make-hash-table :test 'equal)))
+ (dolist (item item-list)
+ (let ((y (car item))
+ (x (cadr item))
+ (type (caddr item))
+ (arg1 (cadddr item)))
+ (when (eq type 'anchor)
+ (setf (gethash arg1 anchor-table) (cons x y)))))
+ (dolist (item item-list)
+ (let ((y (car item))
+ (x (cadr item))
+ (type (caddr item))
+ (arg1 (cadddr item))
+ (arg2 (car (cddddr item))))
+ (cond
+ ((eq type 'anchor))
+ ((eq type 'uxul)
+ (setf (x player) (* 128 x))
+ (setf (y player) (* 128 y))
+ (add-object player room))
+ ((eq type 'tulip)
+ (add-object (make-instance 'tulip
+ :x (* 128 x)
+ :y (* 128 y)) room))
+ ((eq type 'brown-stone)
+ (add-object (make-instance 'stone
+ :animation (make-animation 0 |brown_stone|)
+ :x (* 128 x)
+ :y (* 128 y)) room))
+ ((eq type 'gray-stone)
+ (add-object (make-instance 'stone
+ :animation (make-animation 0 |gray_stone|)
+ :x (* 128 x)
+ :y (* 128 y)) room))
+ ((eq type 'nasobem)
+ (add-object (make-instance 'simple-enemy
+ :x (* 128 x)
+ :y (* 128 y)) room))
+ ((eq type 'blue-nasobem)
+ (add-object (make-instance 'flying-nasobem
+ :x (* 128 x)
+ :y (* 128 y)) room))
+ ((eq type 'key)
+ (add-object (make-instance 'key
+ :x (* 128 x)
+ :y (* 128 y)
+ :dungeon arg1) room))
+ ((eq type 'door)
+ (add-object (make-instance 'door
+ :x (* 128 x)
+ :y (* 128 y)
+ :dungeon arg1) room))
+ ((eq type 'burning-marshmallow)
+ (add-object (make-instance 'burning-marshmallow
+ :x (* 128 x)
+ :y (* 128 y)
+ :inner-rectangle
+ (and (not (string= arg1 "")) (not (string= arg2 ""))
+ (list
+ (* 128 (car (gethash arg1 anchor-table)))
+ (* 128 (cdr (gethash arg1 anchor-table)))
+ (* 128 (1+ (car (gethash arg2 anchor-table))))
+ (* 128 (1+ (cdr (gethash arg2 anchor-table))))))) room))
+ (T
+ (add-object (make-instance type
+ :x (* 128 x)
+ :y (* 128 y)) room)))))
+ room))
\ No newline at end of file