common/transformation.lisp

   1 (in-package #:existenz-common)
   2
   3 (defun ones-vector3d ()
   4   (make-vector3d 1.0 1.0 1.0))
   5
   6 (defun identity-matrix44 ()
   7   (make-matrix44* (identity-matrix44*)))
   8
   9 (defclass transformation ()
  10   ((relative-position
  11     :initarg :relative-position
  12     :accessor relative-position
  13     :initform (new-vector3d))
  14    (relative-rotation
  15     :initarg :relative-rotation
  16     :accessor relative-rotation
  17     :initform (new-quaternion))
  18    (relative-scale
  19     :initarg :relative-scale
  20     :accessor relative-scale
  21     :initform (ones-vector3d))
  22    (relative-dirty-p
  23     :initarg :relative-dirty-p
  24     :accessor relative-dirty-p
  25     :initform T)
  26    (relative-transformation
  27     :initarg :relative-transformation
  28     :accessor relative-transformation
  29     :initform (new-matrix44))
  30    (absolute-transformation
  31     :initarg :absolute-transformation
  32     :accessor absolute-transformation
  33     :initform (new-matrix44)))
  34   (:documentation "Contains information about the position, rotation and
  35 scale relative to some other entity (usually the parent), or the
  36 coordinate origin.  Also contains a scratch slot
  37 ABSOLUTE-TRANSFORMATION, which is used destructively to calculate the
  38 absolute transformation, i.e. relative to the coordinate origin."))
  39
  40 (defgeneric relative-transformation (object)
  41   (:documentation "Returns the transformation of the OBJECT relative
  42 to its parent as a MATRIX44."))
  43
  44 (defmethod relative-transformation (object)
  45   (relative-transformation (transformation object)))
  46
  47 (defgeneric absolute-transformation (object)
  48   (:documentation "Returns the transformation of the OBJECT relative to
  49 the coordinate origin."))
  50
  51 (defmethod absolute-transformation (object)
  52   (absolute-transformation (transformation object)))
  53
  54 (defmethod (setf relative-position) :after (new-value (transformation transformation))
  55   (setf (relative-dirty-p transformation) T))
  56
  57 (defmethod (setf relative-rotation) :after (new-value (transformation transformation))
  58   (setf (relative-dirty-p transformation) T))
  59
  60 (defmethod (setf relative-scale) :after (new-value (transformation transformation))
  61   (setf (relative-dirty-p transformation) T))
  62
  63 (defun calculate-relative-transformation (position rotation scale relative-transformation)
  64   (matrix44-setter*
  65    relative-transformation
  66    (matrix44-product*
  67     (matrix44-product*
  68      (matrix33-matrix44* (quaternion-matrix33* (quaternion* rotation)))
  69      (with-vector3d position (tx ty tz) (translation-matrix44* tx ty tz)))
  70     (with-vector3d scale (sx sy sz) (scaling-matrix44* sx sy sz)))))
  71
  72 (defmethod relative-transformation :before ((transformation transformation))
  73   (when (relative-dirty-p transformation)
  74     (calculate-relative-transformation
  75      (relative-position transformation)
  76      (relative-rotation transformation)
  77      (relative-scale transformation)
  78      (slot-value transformation 'relative-transformation))
  79     (setf (relative-dirty-p transformation) NIL)))
  80
  81 (defmethod update-absolute-transformation (object parent-transformation)
  82   "Calculates the absolute transformation, returns and stores it in the
  83 slot ABSOLUTE-TRANSFORMATION of OBJECT."
  84   (let ((transformation (absolute-transformation object)))
  85     (matrix44-setter*
  86      transformation
  87      (matrix44-product*
  88       (matrix44* (relative-transformation object))
  89       (matrix44* parent-transformation)))))
  90
  91 (defun make-transformation ()
  92   (make-instance 'transformation))