Math interface unification

borodust · Nov 3, 2016 · 2a545d7 · 2a545d7
1 parent 0f582f1
commit 2a545d7
Show file tree

Hide file tree

Showing 6 changed files with 48 additions and 53 deletions.
diff --git a/math/matrix.lisp b/math/matrix.lisp
@@ -1,27 +1,8 @@
 (in-package :cl-bodge.math)
 
 
-(defgeneric m* (mat &rest matricies)
-  (:method ((this mat4) &rest matricies)
-    (make-instance 'mat4 :value
-                   (apply #'sb-cga:matrix*
-                          (loop for mat in matricies
-                             collecting (value-of mat) into mats
-                             finally (return (cons (value-of this) mats)))))))
-
-
-(defgeneric mat-dimensions (matrix))
-
-(defmethod mat-dimensions ((this mat2))
-  '(2 2))
-
-
-(defmethod mat-dimensions ((this mat3))
-  '(3 3))
-
-
-(defmethod mat-dimensions ((this mat4))
-  '(4 4))
+(defmethod multiply ((this mat4) (that mat4))
+  (make-instance 'mat4 :value (sb-cga:matrix* (value-of this) (value-of that))))
 
 
 (definline mat->array (mat)

diff --git a/math/matvec.lisp b/math/matvec.lisp
@@ -1,10 +1,7 @@
 (in-package :cl-bodge.math)
 
 
-(defgeneric mv* (mat vec))
-
-
-(defmethod mv* ((this-mat mat3) (this-vec vec3))
+(defmethod multiply ((this-mat mat3) (this-vec vec3))
   (macrolet ((mul (m v r)
                (once-only (m v r)
                  `(progn

diff --git a/math/types.lisp b/math/types.lisp
@@ -1,7 +1,26 @@
 (in-package :cl-bodge.math)
 
-;;; Vectors
+(defgeneric lerp (this that f))
+(defgeneric multiply (this that))
+(defgeneric summarize (this that))
+(defgeneric divide (this that))
+(defgeneric subtract (this that))
+
+
+(macrolet ((defreduced (name generic)
+             `(defun ,name (arg0 &rest args)
+                (reduce (lambda (this that) (,generic this that))
+                        args :initial-value arg0))))
+
+  (defreduced mult multiply)
+  (defreduced sum summarize)
+  (defreduced div divide)
+  (defreduced subt subtract))
 
+
+;;;
+;;; Vectors
+;;;
 (defclass vec () ())
 
 
@@ -19,9 +38,9 @@
   ((value :initarg :value :initform (sb-cga:vec4 #f0 #f0 #f0 #f0) :type sb-cga:vec4
           :reader value-of)))
 
-
+;;;
 ;;; Matricies
-
+;;;
 (defclass mat () ())
 
 
@@ -53,4 +72,8 @@
     (mat4 4)))
 
 
-(defgeneric lerp (this that f))
+;;;
+;;; Quaternions
+;;;
+(defclass quaternion ()
+  ((value :initarg :value :type (simple-array single-float (4)))))
diff --git a/math/vector.lisp b/math/vector.lisp
@@ -39,16 +39,8 @@
   (setf (aref (value-of vec) idx) value))
 
 
-(defgeneric v+ (vec &rest vectors))
-
-
-(defmethod v+ ((this vec3) &rest others)
-  (let ((sum (make-vec3 this)))
-    (reduce (lambda (result val)
-              (sb-cga:%vec+ result result (value-of val)))
-            others
-            :initial-value (value-of sum))
-    sum))
+(defmethod summarize ((this vec3) (that vec3))
+  (make-instance 'vec3 :value (sb-cga:vec+ (value-of this) (value-of that))))
 
 
 (defmethod lerp ((this vec3) (that vec3) f)

diff --git a/packages.lisp b/packages.lisp
@@ -114,7 +114,12 @@
 (defpackage :cl-bodge.math
   (:nicknames :ge.math)
   (:use :cl :cl-bodge.utils)
-  (:export interpolate
+  (:export lerp
+           mult
+           sum
+           div
+           subt
+
            vec
            vec2
            vec3
@@ -125,7 +130,6 @@
            make-vec2*
            make-vec4*
            sequence->vec3
-           v+
            vref
 
            mat
@@ -144,9 +148,7 @@
            scaling-mat4*
            mat4->mat3
            make-mat3
-           perspective-projection-mat
-           m*
-           mv*))
+           perspective-projection-mat))
 
 
 (defpackage :cl-bodge.memory

diff --git a/scene/transformations.lisp b/scene/transformations.lisp
@@ -40,18 +40,18 @@
 (defgeneric translate-node (node x y z)
   (:method ((this transform-node) x y z)
     (with-slots (mat) this
-      (setf mat (m* (translation-mat4* #f x #f y #f z) mat)))))
+      (setf mat (mult (translation-mat4* #f x #f y #f z) mat)))))
 
 
 (defgeneric rotate-node (node x y z)
   (:method ((this transform-node) x y z)
     (with-slots (mat) this
-      (setf mat (m* (rotation-mat4* #f x #f y #f z) mat)))))
+      (setf mat (mult (rotation-mat4* #f x #f y #f z) mat)))))
 
 
 (defmethod rendering-pass ((this transform-node))
   (with-slots (mat) this
-    (let ((*transform-matrix* (m* *transform-matrix* mat)))
+    (let ((*transform-matrix* (mult *transform-matrix* mat)))
       (call-next-method))))
 ;;;
 ;;;
@@ -62,20 +62,20 @@
 
 (defmethod rendering-pass ((this camera-node))
   (with-slots (camera-mat) this
-    (let ((*transform-matrix* (m* *transform-matrix* camera-mat)))
+    (let ((*transform-matrix* (mult *transform-matrix* camera-mat)))
       (call-next-method))))
 
 
 (defgeneric translate-camera (camera-node x y z)
   (:method ((this camera-node) x y z)
     (with-slots (camera-mat) this
-      (setf camera-mat (m* (translation-mat4* #f(- x) #f(- y) #f(- z)) camera-mat)))))
+      (setf camera-mat (mult (translation-mat4* #f(- x) #f(- y) #f(- z)) camera-mat)))))
 
 
 (defgeneric rotate-camera (camera-node x y z)
   (:method ((this camera-node) x y z)
     (with-slots (camera-mat) this
-      (setf camera-mat (m* (rotation-mat4* #f(- x) #f(- y) #f(- z)) camera-mat)))))
+      (setf camera-mat (mult (rotation-mat4* #f(- x) #f(- y) #f(- z)) camera-mat)))))
 
 ;;;
 ;;;
@@ -94,7 +94,7 @@
 
 (defmethod rendering-pass ((this body-transform-node))
   (with-slots (position rotation) this
-    (let ((*transform-matrix* (m* *transform-matrix*
-                                  (translation-mat4 position)
-                                  rotation)))
+    (let ((*transform-matrix* (mult *transform-matrix*
+                                    (translation-mat4 position)
+                                    rotation)))
       (call-next-method))))