X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;f=src%2FCube.hs;h=8287177ed17edf6307a9517d06e11548320fa7da;hb=1cd046dec9888b04b8687759282880194117736e;hp=ad3d3c7567a343f57a5ecbcda85394b96500b06d;hpb=190b6c22ab150e1877b0b94a33253832eb7764d2;p=spline3.git diff --git a/src/Cube.hs b/src/Cube.hs index ad3d3c7..8287177 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -128,9 +128,9 @@ 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) + 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) @@ -178,15 +178,9 @@ right_face c = Face.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 = - reorient $ Tetrahedron (Cube.fv c) v0' v1' v2' v3' + Tetrahedron (Cube.fv c) v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) @@ -195,7 +189,7 @@ tetrahedron0 c = tetrahedron1 :: Cube -> Tetrahedron tetrahedron1 c = - reorient $ Tetrahedron fv' v0' v1' v2' v3' + Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) @@ -205,7 +199,7 @@ tetrahedron1 c = tetrahedron2 :: Cube -> Tetrahedron tetrahedron2 c = - reorient $ Tetrahedron fv' v0' v1' v2' v3' + Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) @@ -215,7 +209,7 @@ tetrahedron2 c = tetrahedron3 :: Cube -> Tetrahedron tetrahedron3 c = - reorient $ Tetrahedron fv' v0' v1' v2' v3' + Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (front_face c) @@ -225,7 +219,7 @@ tetrahedron3 c = tetrahedron4 :: Cube -> Tetrahedron tetrahedron4 c = - reorient $ Tetrahedron fv' v0' v1' v2' v3' + Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) @@ -235,33 +229,75 @@ tetrahedron4 c = tetrahedron5 :: Cube -> Tetrahedron tetrahedron5 c = - reorient $ Tetrahedron fv' v0' v1' v2' v3' + Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) v2' = Face.v1 (top_face c) v3' = Face.v2 (top_face c) - fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwx + fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) ccwz tetrahedron6 :: Cube -> Tetrahedron tetrahedron6 c = - reorient $ Tetrahedron fv' v0' v1' v2' v3' + Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) v2' = Face.v2 (top_face c) v3' = Face.v3 (top_face c) - fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) (ccwx . ccwx) + fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) (ccwz . ccwz) tetrahedron7 :: Cube -> Tetrahedron tetrahedron7 c = - reorient $ Tetrahedron fv' v0' v1' v2' v3' + Tetrahedron fv' v0' v1' v2' v3' where v0' = center c v1' = center (top_face c) v2' = Face.v3 (top_face c) v3' = Face.v0 (top_face c) - fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwx + fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) cwz + +tetrahedron8 :: Cube -> Tetrahedron +tetrahedron8 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (back_face c) + v2' = Face.v0 (back_face c) + v3' = Face.v1 (back_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron4 c)) cwy + +tetrahedron9 :: Cube -> Tetrahedron +tetrahedron9 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (back_face c) + v2' = Face.v1 (back_face c) + v3' = Face.v2 (back_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) ccwx + +tetrahedron10 :: Cube -> Tetrahedron +tetrahedron10 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (back_face c) + v2' = Face.v2 (back_face c) + v3' = Face.v3 (back_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) (ccwx . ccwx) + + +tetrahedron11 :: Cube -> Tetrahedron +tetrahedron11 c = + Tetrahedron fv' v0' v1' v2' v3' + where + v0' = center c + v1' = center (back_face c) + v2' = Face.v3 (back_face c) + v3' = Face.v0 (back_face c) + fv' = rotate (Tetrahedron.fv (tetrahedron8 c)) cwx + tetrahedrons :: Cube -> [Tetrahedron] tetrahedrons c = @@ -272,13 +308,12 @@ tetrahedrons c = tetrahedron4 c, tetrahedron5 c, tetrahedron6 c, - tetrahedron7 c - -- , - -- tetrahedron8 c, - -- tetrahedron9 c, - -- tetrahedron10 c, - -- tetrahedron11 c, - -- tetrahedron12 c, + tetrahedron7 c, + tetrahedron8 c, + tetrahedron9 c, + tetrahedron10 c, + tetrahedron11 c + --tetrahedron12 c, -- tetrahedron13 c, -- tetrahedron14 c, -- tetrahedron15 c,