burning-marshmallow.lisp

   1 ;;; Copyright 2009-2011 Christoph Senjak
   2
   3 (in-package :uxul-world)
   4
   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)
  12    ;; FIXME
  13    (animation :initarg :animation :initform
  14               (make-animation 2
  15                               |burning_marshmallow_lu1|
  16                               |burning_marshmallow_lu2|)
  17               :accessor animation)
  18
  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
  33                     :initform nil
  34                     :documentation
  35 "An additional rectangle which the burning-marshmallow wont leave. Form: '(x1 y1 x2 y2). If nil, no bounds."
  36    )
  37    (horizontal-speed :initarg :horizontal-speed
  38                      :accessor horizontal-speed
  39                      :initform 20)
  40    (vertical-speed :initarg :vertical-speed
  41                    :accessor vertical-speed
  42                    :initform 20)
  43    (horizontal-direction :initarg :horizontal-direction
  44                          :accessor horizontal-direction
  45                          :initform :left)
  46    (vertical-direction :initarg :vertical-direction
  47                        :accessor vertical-direction
  48                        :initform :up)))
  49
  50 (defmethod invoke ((obj burning-marshmallow))
  51   (cond
  52     ((activated obj)
  53      (when (inner-rectangle obj)
  54        (cond
  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))))
  65        (cond
  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)))))
  81     (T
  82      (dolist (player (get-objects *current-room* 'player))
  83        (if (and
  84             (< (abs (- (x player) (x obj))) (+ +screen-width+ 300))
  85             (< (abs (- (y player) (y obj))) (+ +screen-height+ 300)))
  86            (setf (activated obj) T))))))
  87
  88 (defun set-burning-marshmallow-animation (obj)
  89   (cond
  90     ((eql (horizontal-direction obj) :LEFT)
  91      (cond
  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)
  97      (cond
  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)))))))
 102
 103
 104 ; already defined in simple-enemy.lisp - possibly a bug?
 105
 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))
 111
 112 (defmethod player-hits-enemy ((player player) (enemy burning-marshmallow) &rest args)
 113   (declare (ignore args))
 114   (decf (power player)))
 115
 116 (defmethod enemy-hits-player ((enemy burning-marshmallow) (player player) &rest args)
 117   (declare (ignore args))
 118   (decf (power player)))