X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=8d978f732ffeb8fe2acd7f04b46a5912ede43168;hb=d8bb807e89fbb193b373be111217813d5a4222e9;hp=23cbe4da70383d80c8fbf1f43d1ccc16a0260620;hpb=6fb9ab6b6068870323e996da931fc04c7710e3e4;p=spline3.git

diff --git a/src/Cube.hs b/src/Cube.hs
index 23cbe4d..8d978f7 100644
--- a/src/Cube.hs
+++ b/src/Cube.hs
@@ -1,10 +1,11 @@
 module Cube
 where
 
-import Face
+import Cardinal
+import Face (Face(Face, v0, v1, v2, v3))
 import FunctionValues
---import Grid
 import Point
+import Tetrahedron (Tetrahedron(Tetrahedron), fv)
 import ThreeDimensional
 
 data Cube = Cube { h :: Double,
@@ -17,14 +18,19 @@ data Cube = Cube { h :: Double,
 
 instance Show Cube where
     show c =
-        "Cube_" ++ (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c)) ++
-        " (Center: " ++ (show (center c)) ++ ")" ++
-        " (xmin: " ++ (show (xmin c)) ++ ")" ++
-        " (xmax: " ++ (show (xmax c)) ++ ")" ++
-        " (ymin: " ++ (show (ymin c)) ++ ")" ++
-        " (ymax: " ++ (show (ymax c)) ++ ")" ++
-        " (zmin: " ++ (show (zmin c)) ++ ")" ++
-        " (zmax: " ++ (show (zmax c)) ++ ")"
+        "Cube_" ++ subscript ++ "\n" ++
+        " h: " ++ (show (h c)) ++ "\n" ++
+        " Center: " ++ (show (center c)) ++ "\n" ++
+        " xmin: " ++ (show (xmin c)) ++ "\n" ++
+        " xmax: " ++ (show (xmax c)) ++ "\n" ++
+        " ymin: " ++ (show (ymin c)) ++ "\n" ++
+        " ymax: " ++ (show (ymax c)) ++ "\n" ++
+        " zmin: " ++ (show (zmin c)) ++ "\n" ++
+        " zmax: " ++ (show (zmax c)) ++ "\n"
+        where
+          subscript =
+              (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c))
+
 
 empty_cube :: Cube
 empty_cube = Cube 0 0 0 0 empty_values
@@ -101,53 +107,6 @@ instance ThreeDimensional Cube where
         | otherwise = True
 
 
--- instance Num Cube where
---     (Cube g1 i1 j1 k1 d1) + (Cube _ i2 j2 k2 d2) =
---         Cube g1 (i1 + i2) (j1 + j2) (k1 + k2) (d1 + d2)
-
---     (Cube g1 i1 j1 k1 d1) - (Cube _ i2 j2 k2 d2) =
---         Cube g1 (i1 - i2) (j1 - j2) (k1 - k2) (d1 - d2)
-
---     (Cube g1 i1 j1 k1 d1) * (Cube _ i2 j2 k2 d2) =
---         Cube g1 (i1 * i2) (j1 * j2) (k1 * k2) (d1 * d2)
-
---     abs (Cube g1 i1 j1 k1 d1) =
---         Cube g1 (abs i1) (abs j1) (abs k1) (abs d1)
-
---     signum (Cube g1 i1 j1 k1 d1) =
---         Cube g1 (signum i1) (signum j1) (signum k1) (signum d1)
-
---     fromInteger x = empty_cube { datum = (fromIntegral x) }
-
--- instance Fractional Cube where
---     (Cube g1 i1 j1 k1 d1) / (Cube _ _ _ _ d2) =
---         Cube g1 i1 j1 k1 (d1 / d2)
-
---     recip (Cube g1 i1 j1 k1 d1) =
---         Cube g1 i1 j1 k1 (recip d1)
-
---     fromRational q = empty_cube { datum = fromRational q }
-
-
-
--- | Return the cube corresponding to the grid point i,j,k. The list
---   of cubes is stored as [z][y][x] but we'll be requesting it by
---   [x][y][z] so we flip the indices in the last line.
--- cube_at :: Grid -> Int -> Int -> Int -> Cube
--- cube_at g i' j' k'
---         | i' >= length (function_values g) = Cube g i' j' k' 0
---         | i' < 0                          = Cube g i' j' k' 0
---         | j' >= length ((function_values g) !! i') = Cube g i' j' k' 0
---         | j' < 0                                  = Cube g i' j' k' 0
---         | k' >= length (((function_values g) !! i') !! j') = Cube g i' j' k' 0
---         | k' < 0                                          = Cube g i' j' k' 0
---         | otherwise =
---             (((cubes g) !! k') !! j') !! i'
-
-
-
-
-
 
 -- Face stuff.
 
@@ -156,10 +115,10 @@ top_face :: Cube -> Face
 top_face c = Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h c)
-      v0' = (center c) + (-delta, delta, delta)
-      v1' = (center c) + (delta, delta, delta)
-      v2' = (center c) + (delta, -delta, delta)
-      v3' = (center c) + (-delta, -delta, delta)
+      v0' = (center c) + (delta, delta, delta)
+      v1' = (center c) + (delta, -delta, delta)
+      v2' = (center c) + (-delta, -delta, delta)
+      v3' = (center c) + (-delta, delta, delta)
 
 
 
@@ -191,9 +150,9 @@ front_face :: Cube -> Face
 front_face c = Face v0' v1' v2' v3'
     where
       delta = (1/2)*(h c)
-      v0' = (center c) + (-delta, delta, -delta)
+      v0' = (center c) + (-delta, -delta, delta)
       v1' = (center c) + (-delta, delta, delta)
-      v2' = (center c) + (-delta, -delta, delta)
+      v2' = (center c) + (-delta, delta, -delta)
       v3' = (center c) + (-delta, -delta, -delta)
 
 
@@ -218,3 +177,114 @@ right_face c = Face v0' v1' v2' v3'
       v2' = (center c) + (delta, delta, delta)
       v3' = (center c) + (-delta, delta, delta)
 
+
+
+tetrahedron0 :: Cube -> Tetrahedron
+tetrahedron0 c =
+    Tetrahedron (Cube.fv c) v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (front_face c)
+      v2' = v0 (front_face c)
+      v3' = v1 (front_face c)
+
+tetrahedron1 :: Cube -> Tetrahedron
+tetrahedron1 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (front_face c)
+      v2' = v1 (front_face c)
+      v3' = v2 (front_face c)
+      fv' = rotate (Cube.fv c) ccwx
+
+tetrahedron2 :: Cube -> Tetrahedron
+tetrahedron2 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (front_face c)
+      v2' = v2 (front_face c)
+      v3' = v3 (front_face c)
+      fv' = rotate (Cube.fv c) (ccwx . ccwx)
+
+tetrahedron3 :: Cube -> Tetrahedron
+tetrahedron3 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (front_face c)
+      v2' = v3 (front_face c)
+      v3' = v1 (front_face c)
+      fv' = rotate (Cube.fv c) cwx
+
+tetrahedron4 :: Cube -> Tetrahedron
+tetrahedron4 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (top_face c)
+      v2' = v0 (front_face c)
+      v3' = v1 (front_face c)
+      fv' = rotate (Cube.fv c) cwy
+
+tetrahedron5 :: Cube -> Tetrahedron
+tetrahedron5 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (top_face c)
+      v2' = v1 (top_face c)
+      v3' = v2 (top_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwx
+
+tetrahedron6 :: Cube -> Tetrahedron
+tetrahedron6 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (top_face c)
+      v2' = v2 (top_face c)
+      v3' = v3 (top_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) (ccwx . ccwx)
+
+tetrahedron7 :: Cube -> Tetrahedron
+tetrahedron7 c =
+    Tetrahedron fv' v0' v1' v2' v3'
+    where
+      v0' = center c
+      v1' = center (top_face c)
+      v2' = v3 (top_face c)
+      v3' = v1 (top_face c)
+      fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwx
+
+tetrahedrons :: Cube -> [Tetrahedron]
+tetrahedrons c =
+    [tetrahedron0 c,
+     tetrahedron1 c,
+     tetrahedron2 c,
+     tetrahedron3 c,
+     tetrahedron4 c,
+     tetrahedron5 c,
+     tetrahedron6 c,
+     tetrahedron7 c
+                -- ,
+                --  tetrahedron8 c,
+                --  tetrahedron9 c,
+                --  tetrahedron10 c,
+                --  tetrahedron11 c,
+                --  tetrahedron12 c,
+                --  tetrahedron13 c,
+                --  tetrahedron14 c,
+                --  tetrahedron15 c,
+                --  tetrahedron16 c,
+                --  tetrahedron17 c,
+                --  tetrahedron18 c,
+                --  tetrahedron19 c,
+                --  tetrahedron20 c,
+                --  tetrahedron21 c,
+                --  tetrahedron21 c,
+                --  tetrahedron22 c,
+                --  tetrahedron23 c,
+                --  tetrahedron24 c
+    ]