Misc fixes. Def-tuple-op functions again.

Ferada · Oct 5, 2011 · d485849 · d485849
1 parent b020501
commit d485849
Show file tree

Hide file tree

Showing 15 changed files with 502 additions and 584 deletions.
diff --git a/aabb.lisp b/aabb.lisp
@@ -6,52 +6,53 @@
 ;; axis aligned bounding boxes
 
 (def-tuple-type aabb
-    :tuple-element-type fast-float 
+	:tuple-element-type fast-float
 	:initial-element 0.0f0
-    :elements (minx maxx miny maxy minz maxz))
+	:elements (minx maxx miny maxy minz maxz))
 
 (export-tuple-operations aabb)
 
-(def-tuple-op intersect 
-    ((aabb0 aabb (minx0 maxx0 miny0 maxy0 minz0 maxz0))
-     (aabb1 aabb (minx1 maxx1 miny1 maxy1 minz1 maxz1)))
-  (let ((depth0 (- maxz0 minz0))
-        (depth1 (- maxz1 minz1))
-        (height0 (- maxy0 miny0))
-        (height1 (- maxy1 miny1))
-        (width0 (- maxx0 minx0))
-        (width1 (- maxx1 minx1))
-        (centrex0 (- maxx0 (* 0.5f0 width0)))
-        (centrex1 (- maxx1 (/ 0.5f0 width1)))
-        (centrey0 (- maxx0 (/ 0.5f0 height0)))
-        (centrey1 (- maxx1 (/ 0.5f0 height1)))
-        (centrez0 (- maxx0 (/ 0.5f0 depth0)))
-        (centrez1 (- maxx1 (/ 0.5f0 depth1))))
-    (and (<= (abs (- centrex0 centrex1)) (+ (width0 width1)))
-         (<= (abs (- centrey0 centrey1)) (+ (height0 height1)))
-         (<= (abs (- centrez0 centrez1)) (+ (depth0 depth1))))))
-
-
-(def-tuple-op transform-aabb
-    ((mat matrix44
-          (e00 e01 e02 e03
-           e10 e11 e12 e13
-           e20 e21 e22 e23
-           e30 e31 e32 e33))
-     (box aabb (minx0 maxx0 miny0 maxy0 minz0 maxz0)))
+(def-tuple-op intersect-aabb*
+	((aabb0 aabb (minx0 maxx0 miny0 maxy0 minz0 maxz0))
+	 (aabb1 aabb (minx1 maxx1 miny1 maxy1 minz1 maxz1)))
+  (:return boolean
+		   (let ((depth0 (- maxz0 minz0))
+				 (depth1 (- maxz1 minz1))
+				 (height0 (- maxy0 miny0))
+				 (height1 (- maxy1 miny1))
+				 (width0 (- maxx0 minx0))
+				 (width1 (- maxx1 minx1))
+				 (centrex0 (- maxx0 (* 0.5f0 width0)))
+				 (centrex1 (- maxx1 (/ 0.5f0 width1)))
+				 (centrey0 (- maxx0 (/ 0.5f0 height0)))
+				 (centrey1 (- maxx1 (/ 0.5f0 height1)))
+				 (centrez0 (- maxx0 (/ 0.5f0 depth0)))
+				 (centrez1 (- maxx1 (/ 0.5f0 depth1))))
+			 (and (<= (abs (- centrex0 centrex1)) (+ (width0 width1)))
+				  (<= (abs (- centrey0 centrey1)) (+ (height0 height1)))
+				  (<= (abs (- centrez0 centrez1)) (+ (depth0 depth1)))))))
+
+
+(def-tuple-op transform-aabb*
+	((mat matrix44
+		  (e00 e01 e02 e03
+			   e10 e11 e12 e13
+			   e20 e21 e22 e23
+			   e30 e31 e32 e33))
+	 (box aabb (minx0 maxx0 miny0 maxy0 minz0 maxz0)))
   (:return aabb
-           (aabb*
-            (+ (* minx e00) (* miny e01) (* minz e02)  e03)
-            (+ (* minx e10) (* miny e11) (* minz e12)  e13)
-            (+ (* minx e20) (* miny e21) (* minz e22)  e23)
-            (+ (* maxx e00) (* maxy e01) (* maxz e02)  e03)
-            (+ (* maxx e10) (* maxy e11) (* maxz e12)  e13)
-            (+ (* maxx e20) (* maxy e21) (* maxz e22)  e23))))
+		   (aabb-values*
+			(+ (* minx e00) (* miny e01) (* minz e02)  e03)
+			(+ (* minx e10) (* miny e11) (* minz e12)  e13)
+			(+ (* minx e20) (* miny e21) (* minz e22)  e23)
+			(+ (* maxx e00) (* maxy e01) (* maxz e02)  e03)
+			(+ (* maxx e10) (* maxy e11) (* maxz e12)  e13)
+			(+ (* maxx e20) (* maxy e21) (* maxz e22)  e23))))
+
+
+
+
+
 
 
-
-
-
 
-
-
diff --git a/cl-tuples.asd b/cl-tuples.asd
@@ -14,21 +14,17 @@
   :depends-on (:iterate)
   :serial t
   :components ((:file "package")
-               (:file "utils")
-               (:file "symbols")
-               (:file "tuple-expander")
-               (:file "tuples")
-			   ;;(:file "tuples-test")
-               ;; (:file "clos-wrapper")
-               ;; (:file "clos-wrapper-macro")
-               ;; (:file "vector")
-               ;; (:file "quaternion")
-               ;; (:file "matrix")
-               ;; (:file "colour")
-               ;; (:file "triangle")
-               ;; (:file "rect")
-               ;; (:file "aabb")
-))
+			   (:file "utils")
+			   (:file "symbols")
+			   (:file "tuple-expander")
+			   (:file "tuples")
+			   (:file "vector")
+			   (:file "quaternion")
+			   (:file "matrix")
+			   (:file "colour")
+			   (:file "triangle")
+			   (:file "rect")
+			   (:file "aabb")))
 
 (defsystem :cl-tuples-infix
   :name "paip-infix"
@@ -38,9 +34,9 @@
   :serial t
   :depends-on (:cl-tuples)
   :components ((:file "auxfns")
-               (:file "patmatch")
-               (:file "prefix-infix")
-               (:file "tuple-infix")))
+			   (:file "patmatch")
+			   (:file "prefix-infix")
+			   (:file "tuple-infix")))
 
 (defsystem :cl-tuples-tests
   :serial t
@@ -53,4 +49,4 @@
 (defmethod perform ((o test-op) (c (eql (find-system :cl-tuples))))
   (operate 'asdf:load-op :cl-tuples-tests)
   (operate 'asdf:test-op :cl-tuples-tests))
-                  
+
diff --git a/color.lisp b/color.lisp
@@ -0,0 +1,6 @@
+
+(def-tuple-type color
+	:tuple-element-type fast-float
+	:initial-element 0.0f0
+	:elements (r g b a))
+