flying-nasobem.lisp

   1 ;;; Copyright 2009-2011 Christoph Senjak
   2
   3 (in-package :uxul-world)
   4
   5 ;;; Desired behaviour: Fly around, and if uxul gets near, try to crash
   6 ;;; it. When Uxul jumps on top of it, then get broken.
   7
   8
   9 (defclass flying-nasobem (simple-enemy)
  10   ((animation :initarg :animation
  11               :initform
  12               (make-animation 3 |blue_nasobem| |blue_nasobem2|)
  13               :accessor animation)
  14    (animation-translation :accessor animation-translation
  15                           :initarg :animation-translation
  16                           :initform (make-xy -100 -50))
  17
  18    (flat-animation :initform (make-animation 0 |blue_nasobem3|)
  19                    :accessor flat-animation)
  20
  21    (invoke-continuation :initform #'invoke-flying-nasobem)
  22    (dont-ignore :accessor dont-ignore :initform t)
  23    (width :initarg :width :initform 64 :accessor width)
  24    (active :initarg :active :initform t :accessor active)
  25    (height :initarg :height :initform 64 :accessor height)
  26    (direction :initarg :direction :initform :left :accessor direction)))
  27
  28 (defun invoke-flying-nasobem-wait (flying-nasobem frames)
  29   (if (zerop frames)
  30       #'invoke-flying-nasobem
  31       #'(lambda (fn) (invoke-flying-nasobem-wait fn (1- frames)))))
  32
  33 (defun invoke-flying-nasobem-playerhunt (flying-nasobem x y maxtime)
  34   (move-about flying-nasobem
  35               (make-xy
  36                (if (< (x flying-nasobem) x) 20 -20)
  37                (if (< (y flying-nasobem) y) 20 -20)))
  38   (if (zerop maxtime)
  39            #'(lambda (k) (invoke-flying-nasobem-wait k 16))
  40            #'(lambda (k) (invoke-flying-nasobem-playerhunt
  41                           k x y (1- maxtime)))))
  42
  43
  44 (defun invoke-flying-nasobem (flying-nasobem)
  45   (block return-here
  46     (dolist (player (get-objects *current-room* 'player))
  47       (if (and
  48            (< (abs (- (x player) (x flying-nasobem))) 700)
  49            (< (abs (- (y player) (y flying-nasobem))) 700))
  50           (return-from return-here #'(lambda (fn)
  51                                        (invoke-flying-nasobem-playerhunt
  52                                        fn (x player) (y player) 25)))
  53           (return-from return-here #'invoke-flying-nasobem)))))
  54
  55
  56
  57
  58 (defmethod invoke ((obj flying-nasobem))
  59   (setf (slot-value obj 'invoke-continuation)
  60         (funcall (slot-value obj 'invoke-continuation) obj)))