new transform classes

Fixes #43
Fixes #44
Fixes #47

src/graphics/opengl/opengl.lisp

@@ -162,13 +162,9 @@
 
 ;;; 3d display =================================================================
 
-(defun 3d-push-matrix (translate rotate scale)
+(defun 3d-push-matrix (matrix)
   (gl:push-matrix)
-  (gl:translate (x translate) (y translate) (z translate))
-  (gl:rotate (x rotate) 1.0 0.0 0.0)
-  (gl:rotate (y rotate) 0.0 1.0 0.0)
-  (gl:rotate (z rotate) 0.0 0.0 1.0)
-  (gl:scale (x scale) (y scale) (z scale)))
+  (gl:mult-matrix (matrix->vector matrix))) ;is order correct?
 
 (defun 3d-draw-marker (size)
   (gl:color 1.0 1.0 0.0)

src/kernel/matrix.lisp

@@ -42,15 +42,32 @@
          (list 0.0       0.0       1.0       0.0)
          (list (x point) (y point) (z point) 1.0))))
 
-(defun make-rotation-matrix (point &optional (center nil))
+(defun make-rotation-matrix (point order &optional (pivot nil))
   (let ((rot-matrix
-         (matrix-multiply-n (make-x-rotation-matrix (x point))
-                            (make-y-rotation-matrix (y point))
-                            (make-z-rotation-matrix (z point)))))
-    (if center
-      (matrix-multiply-n (make-translation-matrix (p-negate center))
+          (case order
+            (:xyz (matrix-multiply-n (make-x-rotation-matrix (x point))
+                                     (make-y-rotation-matrix (y point))
+                                     (make-z-rotation-matrix (z point))))
+            (:xzy (matrix-multiply-n (make-x-rotation-matrix (x point))
+                                     (make-z-rotation-matrix (z point))
+                                     (make-y-rotation-matrix (y point))))
+            (:yxz (matrix-multiply-n (make-y-rotation-matrix (y point))
+                                     (make-x-rotation-matrix (x point))
+                                     (make-z-rotation-matrix (z point))))
+            (:yzx (matrix-multiply-n (make-y-rotation-matrix (y point))
+                                     (make-z-rotation-matrix (z point))
+                                     (make-x-rotation-matrix (x point))))
+            (:zxy (matrix-multiply-n (make-z-rotation-matrix (y point))
+                                     (make-x-rotation-matrix (x point))
+                                     (make-z-rotation-matrix (z point))))
+            (:zyx (matrix-multiply-n (make-z-rotation-matrix (z point))
+                                     (make-y-rotation-matrix (y point))
+                                     (make-x-rotation-matrix (x point))))
+            (otherwise (error "Unknown rotate order ~a in MAKE-ROTATION-MATRIX" order)))))
+    (if pivot
+      (matrix-multiply-n (make-translation-matrix (p-negate pivot))
                          rot-matrix
-                         (make-translation-matrix center))
+                         (make-translation-matrix pivot))
       rot-matrix)))
 
 (defun make-x-rotation-matrix (angle)
@@ -80,7 +97,7 @@
            (list 0.0   0.0 1.0 0.0)
            (list 0.0   0.0 0.0 1.0)))))
 
-(defun make-axis-rotation-matrix (angle axis &optional (center nil))
+(defun make-axis-rotation-matrix (angle axis &optional (pivot nil))
   (let* ((s (sin angle))
          (c (cos angle))
          (c1 (- 1 c))
@@ -106,23 +123,23 @@
 		       (list (- xyc1 sz)   (+ y2 cy2)    (+ yzc1 sx)   0.0)
 		       (list (+ xzc1 sy)   (- yzc1 sx)   (+ z2 cz2)    0.0)
 		       (list 0.0           0.0           0.0           1.0)))))
-    (if center
-	(matrix-multiply-n (make-translation-matrix (p-negate center))
+    (if pivot
+	(matrix-multiply-n (make-translation-matrix (p-negate pivot))
 			   rot-matrix
-			   (make-translation-matrix center))
+			   (make-translation-matrix pivot))
 	rot-matrix)))
 
 
-(defun make-scale-matrix (point &optional (center nil))
+(defun make-scale-matrix (point &optional (pivot nil))
   (let ((mtx (make-matrix-with
 	      (list (list (x point) 0.0       0.0       0.0)
 		    (list 0.0       (y point) 0.0       0.0)
 		    (list 0.0       0.0       (z point) 0.0)
 		    (list 0.0       0.0       0.0       1.0)))))
-    (if center
-	(matrix-multiply-n (make-translation-matrix (p-negate center))
+    (if pivot
+	(matrix-multiply-n (make-translation-matrix (p-negate pivot))
 			   mtx
-			   (make-translation-matrix center))
+			   (make-translation-matrix pivot))
 	mtx)))
 
 (defun make-shear-matrix (point)

src/kernel/scene-draw.lisp

@@ -13,7 +13,7 @@
   ;; push matrix and do transform operations before drawing
   (:method :before ((shape shape))
     (let ((xform (transform shape)))
-      (3d-push-matrix (translate xform) (rotate xform) (scale xform))))
+      (3d-push-matrix (transform-matrix xform))))
 
   ;; draw a marker as a default
   (:method ((shape shape))

src/kernel/shape.lisp

@@ -3,7 +3,7 @@
 ;;;; shape =====================================================================
 
 (defclass shape (scene-item)
-  ((transform :accessor transform :initarg :transform :initform (make-instance 'transform))
+  ((transform :accessor transform :initarg :transform :initform (make-instance 'euler-transform))
    (show-axis :accessor show-axis :initarg :show-axis :initform nil) ;nil or length
    (show-bounds? :accessor show-bounds? :initarg :show-bounds? :initform nil)))
 
@@ -59,7 +59,7 @@
       (get-bounds self)
     (when (and bounds-lo bounds-hi)
       (let ((center (p-average bounds-lo bounds-hi)))
-        (translate-to self (p-negate (p* center (scale (transform self)))))))))
+        (translate-to self (p-negate (p* center (scaling (scale (transform self))))))))))
 
 (defmethod scale-to-size ((self shape) max-size)
   (multiple-value-bind (bounds-lo bounds-hi)

src/kernel/transform.lisp

@@ -1,77 +1,219 @@
 (in-package #:kons-9)
 
-;;;; transform ==========================================================
+;;;; transform-operator classes ================================================
 
+(defclass transform-operator ()
+  ())
+
+(defclass translate-operator ()
+  ((offset :accessor offset :initarg :offset :initform (p! 0.0 0.0 0.0))))
+
+(defmethod transform-matrix ((self translate-operator) &optional (factor 1.0))
+  (make-translation-matrix (p-lerp factor (p! 0.0 0.0 0.0) (offset self))))
+
+;; TODO: rotate order, rotate pivot
+(defclass euler-rotate-operator ()
+  ((angles :accessor angles :initarg :angles :initform (p! 0.0 0.0 0.0)) ;degrees
+   ;; :xyz :xzy :yxz :yzx :zxy :zyx
+   (rotate-order :accessor rotate-order :initarg :rotate-order :initform :xyz)
+   (pivot :accessor pivot :initarg :pivot :initform (p! 0.0 0.0 0.0))))
+
+
+(defmethod transform-matrix ((self euler-rotate-operator) &optional (factor 1.0))
+  (make-rotation-matrix (p-radians (p-lerp factor (p! 0.0 0.0 0.0) (angles self))) ;convert to radians
+                        (rotate-order self)
+                        (pivot self)))
+
+(defclass angle-axis-rotate-operator ()
+  ((angle :accessor angle :initarg :angle :initform 0.0) ;degrees
+   (axis :accessor axis :initarg :axis :initform (p! 0.0 0.0 1.0))
+   (pivot :accessor pivot :initarg :pivot :initform (p! 0.0 0.0 0.0))))
+
+(defmethod transform-matrix ((self angle-axis-rotate-operator) &optional (factor 1.0))
+  (make-axis-rotation-matrix (radians (lerp factor 0.0 (angle self))) ;convert to radians
+                             (axis self)
+                             (pivot self)))
+
+;; TODO: scale pivot
+(defclass scale-operator ()
+  ((scaling :accessor scaling :initarg :scaling :initform (p! 1.0 1.0 1.0))
+   (pivot :accessor pivot :initarg :pivot :initform (p! 0.0 0.0 0.0))))
+
+(defmethod transform-matrix ((self scale-operator) &optional (factor 1.0))
+  (make-scale-matrix (p-lerp factor (p! 1.0 1.0 1.0) (scaling self))
+                     (pivot self)))
+
+;;; transform ==================================================================
+
+;;; abstract superclass
 (defclass transform ()
-  ((translate :accessor translate :initarg :translate :initform (p! 0.0 0.0 0.0))
-   (rotate :accessor rotate :initarg :rotate :initform (p! 0.0 0.0 0.0)) ;degrees
-   (scale :accessor scale :initarg :scale :initform (p! 1.0 1.0 1.0))))
+  ;; :trs :tsr :rts :rst :str :srt
+  ((operator-order :accessor operator-order :initarg :operator-order :initform :srt)))
 
-(defmethod copy-instance-data ((dst transform) (src transform))
-  (setf (translate dst) (p-copy (translate src)))
-  (setf (rotate    dst) (p-copy (rotate    src)))
-  (setf (scale     dst) (p-copy (scale     src))))
+;;; euler-transform ============================================================
 
-(defun make-transform (translate rotate scale)
-  (make-instance 'transform :translate translate :rotate rotate :scale scale))
+(defclass euler-transform (transform)
+  ((translate :accessor translate :initarg :translate :initform (make-instance 'translate-operator))
+   (rotate :accessor rotate :initarg :rotate :initform (make-instance 'euler-rotate-operator))
+   (scale :accessor scale :initarg :scale :initform (make-instance 'scale-operator))))
 
-(defmethod duplicate-transform ((self transform))
-  (let ((new-transform (make-instance 'transform)))
-    (copy-instance-data new-transform self)
-    new-transform))
+(defmethod transform-matrix ((self euler-transform) &optional (factor 1.0))
+  (let ((t-mtx (transform-matrix (translate self) factor))
+	(r-mtx (transform-matrix (rotate self) factor))
+	(s-mtx (transform-matrix (scale self) factor)))
+    (case (operator-order self)
+      (:trs (matrix-multiply-n t-mtx r-mtx s-mtx))
+      (:tsr (matrix-multiply-n t-mtx s-mtx r-mtx))
+      (:rts (matrix-multiply-n r-mtx t-mtx s-mtx))
+      (:rst (matrix-multiply-n r-mtx s-mtx t-mtx))
+      (:str (matrix-multiply-n s-mtx t-mtx r-mtx))
+      (:srt (matrix-multiply-n s-mtx r-mtx t-mtx))
+      (otherwise (error "Unknown rotate order ~a in TRANSFORM-MATRIX" (operator-order self))))))
 
-(defmethod translate-by ((self transform) (p point))
-  (setf (translate self) (p+ (translate self) p)))
+(defmethod translate-by ((self euler-transform) (p point))
+  (setf (offset (translate self)) (p+ (offset (translate self)) p)))
 
-(defmethod rotate-by ((self transform) (p point))
-  (setf (rotate self) (p+ (rotate self) p)))
+(defmethod rotate-by ((self euler-transform) (p point))
+  (setf (angles (rotate self)) (p+ (angles (rotate self)) p)))
 
-(defmethod scale-by ((self transform) (p point))
-  (setf (scale self) (p* (scale self) p)))
+(defmethod scale-by ((self euler-transform) (p point))
+  (setf (scaling (scale self)) (p* (scaling (scale self)) p)))
 
-(defmethod scale-by ((self transform) (s number))
-  (setf (scale self) (p* (scale self) (p! s s s))))
+(defmethod scale-by ((self euler-transform) (s number))
+  (setf (scaling (scale self)) (p* (scaling (scale self)) s)))
 
-(defmethod translate-to ((self transform) (p point))
-  (setf (translate self) p))
+(defmethod translate-to ((self euler-transform) (p point))
+  (setf (offset (translate self)) p))
 
-(defmethod rotate-to ((self transform) (p point))
-  (setf (rotate self) p))
+(defmethod rotate-to ((self euler-transform) (p point))
+  (setf (angles (rotate self)) p))
 
-(defmethod scale-to ((self transform) (p point))
-  (setf (scale self) p))
+(defmethod scale-to ((self euler-transform) (p point))
+  (setf (scaling (scale self)) p))
 
-(defmethod scale-to ((self transform) (s number))
-  (setf (scale self) (p! s s s)))
+(defmethod scale-to ((self euler-transform) (s number))
+  (setf (scaling (scale self)) (p! s s s)))
 
-(defmethod reset-transform ((self transform))
-  (setf (translate self) (p! 0.0 0.0 0.0))
-  (setf (rotate self) (p! 0.0 0.0 0.0))
-  (setf (scale self) (p! 1.0 1.0 1.0)))
+(defun make-euler-transform (translate rotate scale)
+  (let ((xform (make-instance 'euler-transform)))
+    (translate-to xform translate)
+    (rotate-to xform rotate)
+    (scale-to xform scale)
+    xform))
 
-(defmethod print-object ((self transform) stream)
+(defmethod reset-transform ((self euler-transform))
+  (setf (offset (translate self)) (p! 0.0 0.0 0.0))
+  (setf (angles (rotate self)) (p! 0.0 0.0 0.0))
+  (setf (scaling (scale self)) (p! 1.0 1.0 1.0)))
+
+(defmethod partial-translate ((self euler-transform) factor)
+  (p-scale (offset (translate self)) factor))
+
+(defmethod partial-rotate ((self euler-transform) factor)
+  (p-scale (angles (rotate self)) factor))
+
+(defmethod partial-scale ((self euler-transform) factor)
+  (p-lerp factor (p! 1.0 1.0 1.0) (scaling (scale self))))
+
+(defmethod partial-copy ((dst euler-transform) (src euler-transform) factor)
+  (setf (offset (translate dst)) (partial-translate src factor))
+  (setf (angles (rotate dst)) (partial-rotate src factor))
+  (setf (scaling (scale dst)) (partial-scale src factor)))
+
+(defmethod print-object ((self euler-transform) stream)
   (print-unreadable-object (self stream :type t :identity t)
     (format stream ":TRANSLATE ~a :ROTATE ~a :SCALE ~a"
-	    (translate self) (rotate self) (scale self))))
-
-(defmethod partial-translate ((self transform) factor)
-  (p-scale (translate self) factor))
-
-(defmethod partial-rotate ((self transform) factor)
-  (p-scale (rotate self) factor))
-
-(defmethod partial-scale ((self transform) factor)
-  (p-lerp factor (p! 1.0 1.0 1.0) (scale self)))
-
-(defmethod partial-copy ((dst transform) (src transform) factor)
-  (setf (translate dst) (partial-translate src factor))
-  (setf (rotate dst) (partial-rotate src factor))
-  (setf (scale dst) (partial-scale src factor)))
-
-;;; fixed scale/rotate/translate order for now - add options later
-(defmethod transform-matrix ((self transform) &optional (factor 1.0))
-  (let ((t-mtx (make-translation-matrix (partial-translate self factor)))
-	(r-mtx (make-rotation-matrix (p-radians (partial-rotate self factor)))) ;convert to radians
-	(s-mtx (make-scale-matrix (partial-scale self factor))))
-    (matrix-multiply-n s-mtx r-mtx t-mtx)))
+	    (offset (translate self)) (angles (rotate self)) (scaling (scale self)))))
+
+;;; angle-axis-transform =======================================================
+
+(defclass angle-axis-transform (transform)
+  ((translate :accessor translate :initarg :translate :initform (make-instance 'translate-operator))
+   (rotate :accessor rotate :initarg :rotate :initform (make-instance 'angle-axis-rotate-operator))
+   (scale :accessor scale :initarg :scale :initform (make-instance 'scale-operator))))
+
+(defmethod transform-matrix ((self angle-axis-transform) &optional (factor 1.0))
+  (let ((t-mtx (transform-matrix (translate self) factor))
+	(r-mtx (transform-matrix (rotate self) factor))
+	(s-mtx (transform-matrix (scale self) factor)))
+    (case (operator-order self)
+      (:trs (matrix-multiply-n t-mtx r-mtx s-mtx))
+      (:tsr (matrix-multiply-n t-mtx s-mtx r-mtx))
+      (:rts (matrix-multiply-n r-mtx t-mtx s-mtx))
+      (:rst (matrix-multiply-n r-mtx s-mtx t-mtx))
+      (:str (matrix-multiply-n s-mtx t-mtx r-mtx))
+      (:srt (matrix-multiply-n s-mtx r-mtx t-mtx))
+      (otherwise (error "Unknown operator order ~a in TRANSFORM-MATRIX" (operator-order self))))))
+
+(defmethod translate-by ((self angle-axis-transform) (p point))
+  (setf (offset (translate self)) (p+ (offset (translate self)) p)))
+
+(defmethod rotate-by ((self angle-axis-transform) a)
+  (setf (angle (rotate self)) (+ (angle (rotate self)) a)))
+
+(defmethod scale-by ((self angle-axis-transform) (p point))
+  (setf (scaling (scale self)) (p* (scaling (scale self)) p)))
+
+(defmethod scale-by ((self angle-axis-transform) (s number))
+  (setf (scaling (scale self)) (p* (scaling (scale self)) s)))
+
+(defmethod translate-to ((self angle-axis-transform) (p point))
+  (setf (offset (translate self)) p))
+
+(defmethod rotate-to ((self angle-axis-transform) a)
+  (setf (angle (rotate self)) a))
+
+(defmethod scale-to ((self angle-axis-transform) (p point))
+  (setf (scaling (scale self)) p))
+
+(defmethod scale-to ((self angle-axis-transform) (s number))
+  (setf (scaling (scale self)) (p! s s s)))
+
+(defun make-axis-angle-transform (translate angle axis scale)
+  (let ((xform (make-instance 'angle-axis-transform)))
+    (translate-to xform translate)
+    (rotate-to xform angle)
+    (setf (axis (rotate xform)) axis)
+    (scale-to xform scale)
+    xform))
+
+(defmethod reset-transform ((self angle-axis-transform))
+  (setf (offset (translate self)) (p! 0.0 0.0 0.0))
+  (setf (angle (rotate self)) 0.0)
+  (setf (axis (rotate self)) (p! 0.0 0.0 1.0))
+  (setf (scaling (scale self)) (p! 1.0 1.0 1.0)))
+
+(defmethod partial-translate ((self angle-axis-transform) factor)
+  (p-scale (offset (translate self)) factor))
+
+(defmethod partial-rotate ((self angle-axis-transform) factor)
+  (* (angle (rotate self)) factor))
+
+(defmethod partial-scale ((self angle-axis-transform) factor)
+  (p-lerp factor (p! 1.0 1.0 1.0) (scaling (scale self))))
+
+(defmethod partial-copy ((dst angle-axis-transform) (src angle-axis-transform) factor)
+  (setf (offset (translate dst)) (partial-translate src factor))
+  (setf (angle (rotate dst)) (partial-rotate src factor))
+  (setf (axis (rotate dst)) (axis (rotate src)))
+  (setf (scaling (scale dst)) (partial-scale src factor)))
+
+(defmethod print-object ((self angle-axis-transform) stream)
+  (print-unreadable-object (self stream :type t :identity t)
+    (format stream ":TRANSLATE ~a :ROTATE ~a, ~a :SCALE ~a"
+	    (offset (translate self)) (angle (rotate self)) (axis (rotate self)) (scaling (scale self)))))
+
+;;; generalized-transform ======================================================
+
+(defclass generalized-transform (transform)
+  ((operators :accessor operators :initarg :operators :initform (make-array 0 :adjustable t :fill-pointer t))))
+
+;; TODO: reverse mtx-list for correct transform order -- needs testing
+(defmethod transform-matrix ((self generalized-transform) &optional (factor 1.0))
+  (if (> (length (operators self)) 0)
+      (let ((mtx-list (nreverse (mapcar (lambda (op) (transform-matrix op factor))
+                                        (operators self)))))
+        (apply #'matrix-multiply-n mtx-list))
+      (make-id-matrix)))
+