X-Git-Url: http://gitweb.michael.orlitzky.com/?a=blobdiff_plain;ds=sidebyside;f=src%2FCube.hs;h=78c5ec21e266a2cc33308bd23a98e67c96577673;hb=a5c2a06421f9faf2c58831f1ac296bc6b8e7e040;hp=23cbe4da70383d80c8fbf1f43d1ccc16a0260620;hpb=6fb9ab6b6068870323e996da931fc04c7710e3e4;p=spline3.git diff --git a/src/Cube.hs b/src/Cube.hs index 23cbe4d..78c5ec2 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 @@ -156,10 +162,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 +197,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 +224,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 + ]