wh-engine/wh-engine/scene.lisp

;;;; wh-engine/scene.lisp
(in-package wh-engine)

(defclass scene ()
  ((id :documentation "This scene's unique ID."
       :reader id
       :type fixnum
       :initarg :id
       :initform 0)
   (name :documentation "This scene's human-readable name."
         :accessor name
         :type string
         :initarg :name
         :initform "")
   (actors :documentation "A list containing all actors in the scene."
           :reader actors
           :type (proper-list actor)
           :initform nil)
   (destroyed-p :documentation "If true, this scene will be unloaded."
                :reader destroyed-p
                :type boolean
                :initform nil))
  (:documentation "A scene containing game entities."))

(defmethod make-load-form ((this scene) &optional environment)
  (make-generic-load-form this :environment environment))

(defmethod print-object ((this scene) stream)
  (print-unreadable-object (this stream :type t :identity t)
    (format stream "~D ~S"
            (o! this :slot id) (o! this :slot name))))

(defmethod add-actor ((this scene) actor)
  "Add an actor to this scene."
  (when (o! actor scene)
        (error "~S is already in scene ~S" actor (o! actor scene)))
  (pushnew actor (o! this :slot actors))
  (setf (o! actor :slot scene) (make-weak-pointer this))
  actor)

(defmethod remove-actor ((this scene) actor)
  "Remove an actor from this scene."
  (unless (eq (o! actor scene) this)
    (error "~S is not in scene ~S" actor this))
  (setf (o! this :slot actors) (delete actor (o! this :slot actors) :count 1))
  (setf (o! actor :slot scene) nil)
  actor)

(defmethod get-actor ((this scene) actor-id)
  "Get the actor with the specified ID in this scene."
  (find-if (lambda (actor) (eql (o! actor id) actor-id)) (o! this actors)))

(defmethod get-tagged-actors ((this scene) tags)
  "Get all actors tagged with the given set of tags."
  (loop for actor in (o! this actors)
        if (subsetp tags (o! actor tags))
          collect actor))

(defmethod update ((this scene))
  "Update all actors in this scene."
  (loop for actor in (o! this actors)
        unless (or (o! actor destroyed-p) (not (o! actor tree-active-p)))
          do (o! actor (update))))

(defmethod destroy ((this scene))
  "Mark this scene for unloading."
  (unless (o! this destroyed-p)
          ;; We're dead, clean up actors
          (loop for actor in (o! this actors)
                do (o! actor (destroy)))
          (remove-scene this))
  (setf (o! this :slot destroyed-p) t))

(defmethod resume ((this scene))
  "Initialize or restore this scene's state."
  ;; Restore actors
  (loop for actor in (o! this actors)
        unless (o! actor :slot parent)
          do (o! actor (resume))))

(defmethod suspend ((this scene))
  "Prepare this scene for serialization."
  ;; Suspend actors
  (loop for actor in (o! this actors)
        unless (o! actor :slot parent)
          do (o! actor (suspend))))

(defun add-scene (scene)
  "Add a scene to the list of running scenes."
  (declare (type scene scene))

  (push scene *world*)
  scene)

(defun remove-scene (scene)
  "Remove a scene from the list of running scenes."
  (declare (type scene scene))

  (setf *world* (remove scene *world*))
  scene)