actor.lisp

   1
   2
   3 (in-package :lambdamundo)
   4
   5 (defparameter *actors* (make-hash-table :test 'eql))
   6
   7 (def-tuple-class actor
   8     (:tuples
   9      ((location :type vertex3d)
  10       (velocity :type vector3d)
  11       (orientation :type quaternion)
  12       (w-velocity :type vector3d))
  13      :slots
  14      ((id :allocation :class :reader id-of :initform (get-universal-time))
  15       (dv :type single-float :intiarg :dv :initform 0.0 :accessor dv-of)
  16       (dw :type single-float :initarg :dw :initform 0.0 :accessor dw-of))))
  17
  18
  19 (defmethod initialize-instance :after ((self actor) &rest args)
  20   (declare (ignore args))
  21   (setf (gethash (id-of self) *actors*) self))
  22
  23 (defun make-actor (actor-type &rest args)
  24   (let* ((actor
  25           (apply #'make-instance actor-type args))
  26          (result (id-of actor)))
  27     (incf (slot-value actor 'id))
  28     result))
  29
  30
  31 (def-tuple-op angular-velocity
  32   ((vector vector3d (vx vy vz))
  33    (quat quaternion (qx qy qz qw)))
  34   "Calculate dq/dt as a quat from an angular velocity"
  35   (:return quaternion
  36            (quaternion-scale
  37             (quaternion-product
  38              (vector3d-quaternion vector)
  39              quat)  0.5)))
  40
  41 (defmethod update-position ((a actor))
  42   ;; update position
  43   (setf (location-of a)
  44         (vector3d-vertex3d
  45          (vector3d-sum
  46           (vertex3d-vector3d (location-of a))
  47                              (velocity-of a)))))
  48
  49 (defmethod update-dv ((a actor))
  50   ;; update velocity
  51   (setf (velocity-of a)
  52          (vector3d-scale
  53           (velocity-of a)
  54           (dv-of a))))
  55
  56 (defmethod update-dw ((a actor))
  57   ;; update angluar velocity
  58   (setf (w-velocity-of a)
  59         (vector3d-scale (w-velocity-of a) (dw-of a))))
  60
  61 (defmethod update-orientation ((a actor))
  62   ;; update orientation
  63   (setf (orientation-of a)
  64         (quaternion-unitize
  65          (quaternion-sum
  66           (orientation-of a)
  67           (angular-velocity
  68            (w-velocity-of a)
  69            (orientation-of a))))))
  70
  71
  72
  73 (defmethod update ((a actor))
  74   (update-dv a)
  75   (update-dw a)
  76   (update-position a)
  77   (update-orientation a))
  78
  79
  80 (defmethod up-of ((a actor))
  81   "Return a tuple vector representing the up axis of the camera."
  82   (quaternion-transform-vector3d
  83    (vector3d* 0.0 1.0 0.0)
  84    (orientation-of a)))
  85
  86 (defmethod direction-of ((a actor))
  87   "Return a tuple vector representing the z axis of the camera."
  88   (quaternion-transform-vector3d
  89    (vector3d* 0.0 0.0 1.0)
  90    (orientation-of a)))
  91
  92 (defmethod cross-of ((a actor))
  93   "Return a tuple vector representing the x axis of the camera."
  94   (quaternion-transform-vector3d
  95    (vector3d* 1.0 0.0 0.0)
  96    (orientation-of a)))
  97
  98 (defun destroy-actor (actor)
  99   (format *debug-io* "Goodbye ~A@%" actor)
 100   (let ((destructee (gethash actor *actors*)))
 101     (destroy destructee)
 102     (values))
 103   (values))
 104
 105 (defmethod destroy ((a actor))
 106   (values))