X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=ad3d3c7567a343f57a5ecbcda85394b96500b06d;hb=190b6c22ab150e1877b0b94a33253832eb7764d2;hp=8d978f732ffeb8fe2acd7f04b46a5912ede43168;hpb=d8bb807e89fbb193b373be111217813d5a4222e9;p=spline3.git diff --git a/src/Cube.hs b/src/Cube.hs index 8d978f7..ad3d3c7 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -2,10 +2,10 @@ module Cube where import Cardinal -import Face (Face(Face, v0, v1, v2, v3)) +import qualified Face (Face(Face, v0, v1, v2, v3)) import FunctionValues import Point -import Tetrahedron (Tetrahedron(Tetrahedron), fv) +import Tetrahedron hiding (c) import ThreeDimensional data Cube = Cube { h :: Double, @@ -26,7 +26,8 @@ instance Show Cube where " ymin: " ++ (show (ymin c)) ++ "\n" ++ " ymax: " ++ (show (ymax c)) ++ "\n" ++ " zmin: " ++ (show (zmin c)) ++ "\n" ++ - " zmax: " ++ (show (zmax c)) ++ "\n" + " zmax: " ++ (show (zmax c)) ++ "\n" ++ + " fv: " ++ (show (Cube.fv c)) ++ "\n" where subscript = (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c)) @@ -111,20 +112,20 @@ instance ThreeDimensional Cube where -- Face stuff. -- | The top (in the direction of z) face of the cube. -top_face :: Cube -> Face -top_face c = Face v0' v1' v2' v3' +top_face :: Cube -> Face.Face +top_face c = Face.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) -- | The back (in the direction of x) face of the cube. -back_face :: Cube -> Face -back_face c = Face v0' v1' v2' v3' +back_face :: Cube -> Face.Face +back_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (delta, delta, delta) @@ -134,8 +135,8 @@ back_face c = Face v0' v1' v2' v3' -- The bottom face (in the direction of -z) of the cube. -down_face :: Cube -> Face -down_face c = Face v0' v1' v2' v3' +down_face :: Cube -> Face.Face +down_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (delta, delta, -delta) @@ -146,8 +147,8 @@ down_face c = Face v0' v1' v2' v3' -- | The front (in the direction of -x) face of the cube. -front_face :: Cube -> Face -front_face c = Face v0' v1' v2' v3' +front_face :: Cube -> Face.Face +front_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (-delta, -delta, delta) @@ -155,10 +156,9 @@ front_face c = Face v0' v1' v2' v3' v2' = (center c) + (-delta, delta, -delta) v3' = (center c) + (-delta, -delta, -delta) - -- | The left (in the direction of -y) face of the cube. -left_face :: Cube -> Face -left_face c = Face v0' v1' v2' v3' +left_face :: Cube -> Face.Face +left_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (-delta, -delta, delta) @@ -168,8 +168,8 @@ left_face c = Face v0' v1' v2' v3' -- | The right (in the direction of y) face of the cube. -right_face :: Cube -> Face -right_face c = Face v0' v1' v2' v3' +right_face :: Cube -> Face.Face +right_face c = Face.Face v0' v1' v2' v3' where delta = (1/2)*(h c) v0' = (center c) + (-delta, delta, -delta) @@ -178,84 +178,89 @@ right_face c = Face v0' v1' v2' v3' v3' = (center c) + (-delta, delta, delta) +reorient :: Tetrahedron -> Tetrahedron +reorient t = t +-- | volume t > 0 = t +-- | otherwise = t { v2 = (v3 t), +-- v3 = (v2 t) } tetrahedron0 :: Cube -> Tetrahedron tetrahedron0 c = - Tetrahedron (Cube.fv c) v0' v1' v2' v3' + reorient $ 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) + v2' = Face.v0 (front_face c) + v3' = Face.v1 (front_face c) tetrahedron1 :: Cube -> Tetrahedron tetrahedron1 c = - Tetrahedron fv' v0' v1' v2' v3' + reorient $ 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) + v2' = Face.v1 (front_face c) + v3' = Face.v2 (front_face c) fv' = rotate (Cube.fv c) ccwx tetrahedron2 :: Cube -> Tetrahedron tetrahedron2 c = - Tetrahedron fv' v0' v1' v2' v3' + reorient $ 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) + v2' = Face.v2 (front_face c) + v3' = Face.v3 (front_face c) fv' = rotate (Cube.fv c) (ccwx . ccwx) tetrahedron3 :: Cube -> Tetrahedron tetrahedron3 c = - Tetrahedron fv' v0' v1' v2' v3' + reorient $ 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) + v2' = Face.v3 (front_face c) + v3' = Face.v0 (front_face c) fv' = rotate (Cube.fv c) cwx tetrahedron4 :: Cube -> Tetrahedron tetrahedron4 c = - Tetrahedron fv' v0' v1' v2' v3' + reorient $ 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) + v2' = Face.v0 (top_face c) + v3' = Face.v1 (top_face c) fv' = rotate (Cube.fv c) cwy tetrahedron5 :: Cube -> Tetrahedron tetrahedron5 c = - Tetrahedron fv' v0' v1' v2' v3' + reorient $ 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) + v2' = Face.v1 (top_face c) + v3' = Face.v2 (top_face c) fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwx tetrahedron6 :: Cube -> Tetrahedron tetrahedron6 c = - Tetrahedron fv' v0' v1' v2' v3' + reorient $ 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) + v2' = Face.v2 (top_face c) + v3' = Face.v3 (top_face c) fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) (ccwx . ccwx) tetrahedron7 :: Cube -> Tetrahedron tetrahedron7 c = - Tetrahedron fv' v0' v1' v2' v3' + reorient $ 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) + v2' = Face.v3 (top_face c) + v3' = Face.v0 (top_face c) fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwx tetrahedrons :: Cube -> [Tetrahedron]