wh-engine/wh-engine/global.lisp

;;;; wh-engine/global.lisp
;;;; global variables and utility functions
(in-package wh-engine)

;; FIXME this should be a defconst
(defvar +version+ (list 0 1 0)
  "Engine version.")

(defun ensure-version (expected-version)
  "Ensure this version of wh-engine is compatible with the expected version."
  (if (= (nth 0 +version+) 0)
      (unless (equal +version+ expected-version)
        (error "engine version ~S incompatible with expected-version ~S (pre-1.0 mismatch)"
               +version+ expected-version))
      (progn
        (unless (= (nth 0 +version+) (nth 0 expected-version))
          (error "engine version ~S incompatible with expected-version ~S (major-version mismatch)"
                 +version+ expected-version))
        (unless (>= (nth 1 +version+) (nth 1 expected-version))
          (error "engine version ~S incompatible with expected-version ~S (minor-version too low)"
                 +version+ expected-version))
        (unless (equal +version+ expected-version)
          (warn "engine version ~S differs from expected-version ~S, but is still compatible"
                +version+ expected-version)))))

(declaim (inline deref-pointer))
(defun deref-pointer (ptr)
  "Dereference ptr if it's non-nil."
  (declare (type (or weak-pointer null) ptr))
  (when ptr (weak-pointer-value ptr)))

(defun points-to (ptr obj)
  "Return true if ptr points to obj."
  (declare (type weak-pointer ptr))

  (eq (weak-pointer-value ptr) obj))

(defun ensure-live (obj)
  "Ensure obj is live (non-destroyed)."
  (when (o! obj destroyed-p)
        (error "~S was used after it was destroyed" obj))
  obj)

(declaim (inline vxy1))
(defun vxy1 (vector)
  "Convert vector to a vec3, with a Z component of 1."
  (declare (type vec2 vector))
  (vec3 (vx2 vector) (vy2 vector) 1))

(declaim (inline vxy-trunc))
(defun vxy-trunc (vector)
  "Convert vector to a vec2 and truncate its X and Y components to the nearest integer."
  (declare (type vec3 vector))
  (vec2 (ftruncate (vx3 vector)) (ftruncate (vy3 vector))))

(defvar *id-counter* 0
  "Counter for assigning unique IDs.")

(defun make-id ()
  "Return a unique ID."
  (setf *id-counter* (+ *id-counter* 1)))

(defun fixed-id (id)
  "Ensure the given ID won't be returned by make-id."
  (declare (type fixnum id))

  (when (>= id *id-counter*)
    (setf *id-counter* (+ id 1)))
  id)

(defstruct id-ref
  (scene 0 :type fixnum)
  (actor nil :type (or fixnum null))
  (component nil :type (or symbol null)))

(deftype pointer () '(or id-ref weak-pointer null))

(declaim (inline deref-sus-pointer))
(defun deref-sus-pointer (val)
  "Dereference val, and warn if it's suspended."
  (declare (type pointer val))
  (etypecase val
    (weak-pointer (weak-pointer-value val))
    (id-ref (warn "dereferencing sus pointer ~S" val)
     (weak-pointer-value (pointerize val)))
    (null nil)))

(defun referize (ptr)
  "Convert ptr into an id-ref."

  (let ((target (etypecase ptr
                  (weak-pointer (weak-pointer-value ptr))
                  ((or scene actor component) ptr))))
    (etypecase target
      (scene
       (make-id-ref :scene (o! target id)))
      (actor
       (make-id-ref :scene (etypecase (o! target :slot scene)
                                      (weak-pointer (o! target scene id))
                                      (id-ref (id-ref-scene (o! target :slot scene))))
                    :actor (o! target id)))
      (component
       (make-id-ref :scene (etypecase (o! target :slot actor)
                                      (weak-pointer (o! target scene id))
                                      (id-ref (id-ref-scene (o! target :slot actor))))
                    :actor (etypecase (o! target :slot actor)
                                      (weak-pointer (o! target actor id))
                                      (id-ref (id-ref-actor (o! target :slot actor))))
                    :component (class-name (class-of target))))
      )))

(defun dereferize (ref)
  "Return the object specified by id-ref ref."
  (declare (type id-ref ref))

  (let ((scene (get-scene (id-ref-scene ref))) actor component)
    (unless scene
      (error "can't dereferize ~S (scene not found)" ref))
    (if (id-ref-actor ref)
        (if (setf actor (o! scene (get-actor (id-ref-actor ref))))
            (if (id-ref-component ref)
                (if (setf component (o! actor (get-component (find-class (id-ref-component ref)))))
                    component
                    (error "can't dereferize ~S (component not found)" ref))
                actor)
            (error "can't dereferize ~S (actor not found)" ref))
        scene)))

(defun pointerize (ref)
  "Convert id-ref ref into a weak-pointer."
  (declare (type id-ref ref))

  (make-weak-pointer (dereferize ref)))

(defmacro referize-setf (place)
  `(when (typep ,place 'weak-pointer)
     (setf ,place (referize ,place))))
(defmacro pointerize-setf (place)
  `(when (typep ,place 'id-ref)
     (setf ,place (pointerize ,place))))

(defvar *world* ()
  "List of all running scenes.")

(defun get-scene (scene-id)
  "Get a scene by its ID."
  (find-if (lambda (scene) (eql (o! scene id) scene-id)) *world*))