From: Michael Orlitzky Date: Sun, 4 Sep 2011 13:02:01 +0000 (-0400) Subject: Use one top-level function, 'tetrahedron', and take an Int parameter rather than... X-Git-Tag: 0.0.1~163 X-Git-Url: https://gitweb.michael.orlitzky.com/?a=commitdiff_plain;h=e5151f5050e80027f69640813db618aaea54946e;p=spline3.git Use one top-level function, 'tetrahedron', and take an Int parameter rather than enumerating 24 different functions. --- diff --git a/src/Cube.hs b/src/Cube.hs index ef2d9ce..6e31f19 100644 --- a/src/Cube.hs +++ b/src/Cube.hs @@ -199,9 +199,10 @@ right_face c = Face.Face v0' v1' v2' v3' v3' = (center c) + (-delta, delta, -delta) -tetrahedron0 :: Cube -> Tetrahedron -tetrahedron0 c = - Tetrahedron (Cube.fv c) v0' v1' v2' v3' vol +tetrahedron :: Cube -> Int -> Tetrahedron + +tetrahedron c 0 = + Tetrahedron (Cube.fv c) v0' v1' v2' v3' vol 0 where v0' = center c v1' = center (front_face c) @@ -209,9 +210,8 @@ tetrahedron0 c = v3' = Face.v1 (front_face c) vol = tetrahedra_volume c -tetrahedron1 :: Cube -> Tetrahedron -tetrahedron1 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 1 = + Tetrahedron fv' v0' v1' v2' v3' vol 1 where v0' = center c v1' = center (front_face c) @@ -220,9 +220,8 @@ tetrahedron1 c = fv' = rotate ccwx (Cube.fv c) vol = tetrahedra_volume c -tetrahedron2 :: Cube -> Tetrahedron -tetrahedron2 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 2 = + Tetrahedron fv' v0' v1' v2' v3' vol 2 where v0' = center c v1' = center (front_face c) @@ -231,9 +230,8 @@ tetrahedron2 c = fv' = rotate ccwx $ rotate ccwx $ Cube.fv c vol = tetrahedra_volume c -tetrahedron3 :: Cube -> Tetrahedron -tetrahedron3 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 3 = + Tetrahedron fv' v0' v1' v2' v3' vol 3 where v0' = center c v1' = center (front_face c) @@ -242,9 +240,8 @@ tetrahedron3 c = fv' = rotate cwx (Cube.fv c) vol = tetrahedra_volume c -tetrahedron4 :: Cube -> Tetrahedron -tetrahedron4 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 4 = + Tetrahedron fv' v0' v1' v2' v3' vol 4 where v0' = center c v1' = center (top_face c) @@ -253,20 +250,18 @@ tetrahedron4 c = fv' = rotate cwy (Cube.fv c) vol = tetrahedra_volume c -tetrahedron5 :: Cube -> Tetrahedron -tetrahedron5 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 5 = + Tetrahedron fv' v0' v1' v2' v3' vol 5 where v0' = center c v1' = center (top_face c) v2' = Face.v1 (top_face c) v3' = Face.v2 (top_face c) - fv' = rotate cwy $ rotate cwz $ Tetrahedron.fv (tetrahedron0 c) + fv' = rotate cwy $ rotate cwz $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c -tetrahedron6 :: Cube -> Tetrahedron -tetrahedron6 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 6 = + Tetrahedron fv' v0' v1' v2' v3' vol 6 where v0' = center c v1' = center (top_face c) @@ -274,34 +269,31 @@ tetrahedron6 c = v3' = Face.v3 (top_face c) fv' = rotate cwy $ rotate cwz $ rotate cwz - $ Tetrahedron.fv (tetrahedron0 c) + $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c -tetrahedron7 :: Cube -> Tetrahedron -tetrahedron7 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 7 = + Tetrahedron fv' v0' v1' v2' v3' vol 7 where v0' = center c v1' = center (top_face c) v2' = Face.v3 (top_face c) v3' = Face.v0 (top_face c) - fv' = rotate cwy $ rotate ccwz $ Tetrahedron.fv (tetrahedron0 c) + fv' = rotate cwy $ rotate ccwz $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c -tetrahedron8 :: Cube -> Tetrahedron -tetrahedron8 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 8 = + Tetrahedron fv' v0' v1' v2' v3' vol 8 where v0' = center c v1' = center (back_face c) v2' = Face.v0 (back_face c) v3' = Face.v1 (back_face c) - fv' = rotate cwy $ rotate cwy $ Tetrahedron.fv (tetrahedron0 c) + fv' = rotate cwy $ rotate cwy $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c -tetrahedron9 :: Cube -> Tetrahedron -tetrahedron9 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 9 = + Tetrahedron fv' v0' v1' v2' v3' vol 9 where v0' = center c v1' = center (back_face c) @@ -309,12 +301,11 @@ tetrahedron9 c = v3' = Face.v2 (back_face c) fv' = rotate cwy $ rotate cwy $ rotate cwx - $ Tetrahedron.fv (tetrahedron0 c) + $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c -tetrahedron10 :: Cube -> Tetrahedron -tetrahedron10 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 10 = + Tetrahedron fv' v0' v1' v2' v3' vol 10 where v0' = center c v1' = center (back_face c) @@ -323,13 +314,12 @@ tetrahedron10 c = fv' = rotate cwy $ rotate cwy $ rotate cwx $ rotate cwx - $ Tetrahedron.fv (tetrahedron0 c) + $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c -tetrahedron11 :: Cube -> Tetrahedron -tetrahedron11 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 11 = + Tetrahedron fv' v0' v1' v2' v3' vol 11 where v0' = center c v1' = center (back_face c) @@ -337,37 +327,31 @@ tetrahedron11 c = v3' = Face.v0 (back_face c) fv' = rotate cwy $ rotate cwy $ rotate ccwx - $ Tetrahedron.fv (tetrahedron0 c) + $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c - -tetrahedron12 :: Cube -> Tetrahedron -tetrahedron12 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 12 = + Tetrahedron fv' v0' v1' v2' v3' vol 12 where v0' = center c v1' = center (down_face c) v2' = Face.v0 (down_face c) v3' = Face.v1 (down_face c) - fv' = rotate ccwy (Tetrahedron.fv (tetrahedron0 c)) + fv' = rotate ccwy (Tetrahedron.fv (tetrahedron c 0)) vol = tetrahedra_volume c - -tetrahedron13 :: Cube -> Tetrahedron -tetrahedron13 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 13 = + Tetrahedron fv' v0' v1' v2' v3' vol 13 where v0' = center c v1' = center (down_face c) v2' = Face.v1 (down_face c) v3' = Face.v2 (down_face c) - fv' = rotate ccwy $ rotate ccwz $ Tetrahedron.fv (tetrahedron0 c) + fv' = rotate ccwy $ rotate ccwz $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c - -tetrahedron14 :: Cube -> Tetrahedron -tetrahedron14 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 14 = + Tetrahedron fv' v0' v1' v2' v3' vol 14 where v0' = center c v1' = center (down_face c) @@ -375,49 +359,41 @@ tetrahedron14 c = v3' = Face.v3 (down_face c) fv' = rotate ccwy $ rotate ccwz $ rotate ccwz - $ Tetrahedron.fv (tetrahedron0 c) + $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c - -tetrahedron15 :: Cube -> Tetrahedron -tetrahedron15 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 15 = + Tetrahedron fv' v0' v1' v2' v3' vol 15 where v0' = center c v1' = center (down_face c) v2' = Face.v3 (down_face c) v3' = Face.v0 (down_face c) - fv' = rotate ccwy $ rotate cwz $ Tetrahedron.fv (tetrahedron0 c) + fv' = rotate ccwy $ rotate cwz $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c - -tetrahedron16 :: Cube -> Tetrahedron -tetrahedron16 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 16 = + Tetrahedron fv' v0' v1' v2' v3' vol 16 where v0' = center c v1' = center (right_face c) v2' = Face.v0 (right_face c) v3' = Face.v1 (right_face c) - fv' = rotate ccwz (Tetrahedron.fv (tetrahedron0 c)) + fv' = rotate ccwz (Tetrahedron.fv (tetrahedron c 0)) vol = tetrahedra_volume c - -tetrahedron17 :: Cube -> Tetrahedron -tetrahedron17 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 17 = + Tetrahedron fv' v0' v1' v2' v3' vol 17 where v0' = center c v1' = center (right_face c) v2' = Face.v1 (right_face c) v3' = Face.v2 (right_face c) - fv' = rotate ccwz $ rotate cwy $ Tetrahedron.fv (tetrahedron0 c) + fv' = rotate ccwz $ rotate cwy $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c - -tetrahedron18 :: Cube -> Tetrahedron -tetrahedron18 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 18 = + Tetrahedron fv' v0' v1' v2' v3' vol 18 where v0' = center c v1' = center (right_face c) @@ -425,50 +401,42 @@ tetrahedron18 c = v3' = Face.v3 (right_face c) fv' = rotate ccwz $ rotate cwy $ rotate cwy - $ Tetrahedron.fv (tetrahedron0 c) + $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c - -tetrahedron19 :: Cube -> Tetrahedron -tetrahedron19 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 19 = + Tetrahedron fv' v0' v1' v2' v3' vol 19 where v0' = center c v1' = center (right_face c) v2' = Face.v3 (right_face c) v3' = Face.v0 (right_face c) fv' = rotate ccwz $ rotate ccwy - $ Tetrahedron.fv (tetrahedron0 c) + $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c - -tetrahedron20 :: Cube -> Tetrahedron -tetrahedron20 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 20 = + Tetrahedron fv' v0' v1' v2' v3' vol 20 where v0' = center c v1' = center (left_face c) v2' = Face.v0 (left_face c) v3' = Face.v1 (left_face c) - fv' = rotate cwz (Tetrahedron.fv (tetrahedron0 c)) + fv' = rotate cwz (Tetrahedron.fv (tetrahedron c 0)) vol = tetrahedra_volume c - -tetrahedron21 :: Cube -> Tetrahedron -tetrahedron21 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 21 = + Tetrahedron fv' v0' v1' v2' v3' vol 21 where v0' = center c v1' = center (left_face c) v2' = Face.v1 (left_face c) v3' = Face.v2 (left_face c) - fv' = rotate cwz $ rotate ccwy $ Tetrahedron.fv (tetrahedron0 c) + fv' = rotate cwz $ rotate ccwy $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c - -tetrahedron22 :: Cube -> Tetrahedron -tetrahedron22 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 22 = + Tetrahedron fv' v0' v1' v2' v3' vol 22 where v0' = center c v1' = center (left_face c) @@ -476,127 +444,57 @@ tetrahedron22 c = v3' = Face.v3 (left_face c) fv' = rotate cwz $ rotate ccwy $ rotate ccwy - $ Tetrahedron.fv (tetrahedron0 c) + $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c - -tetrahedron23 :: Cube -> Tetrahedron -tetrahedron23 c = - Tetrahedron fv' v0' v1' v2' v3' vol +tetrahedron c 23 = + Tetrahedron fv' v0' v1' v2' v3' vol 23 where v0' = center c v1' = center (left_face c) v2' = Face.v3 (left_face c) v3' = Face.v0 (left_face c) fv' = rotate cwz $ rotate cwy - $ Tetrahedron.fv (tetrahedron0 c) + $ Tetrahedron.fv (tetrahedron c 0) vol = tetrahedra_volume c +-- Feels dirty, but whatever. +tetrahedron _ _ = error "asked for a nonexistent tetrahedron" + tetrahedra :: Cube -> [Tetrahedron] tetrahedra 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, - tetrahedron22 c, - tetrahedron23 c] + [ tetrahedron c n | n <- [0..23] ] -- | All completely contained in the front half of the cube. front_half_tetrahedra :: Cube -> [Tetrahedron] front_half_tetrahedra c = - [tetrahedron0 c, - tetrahedron1 c, - tetrahedron2 c, - tetrahedron3 c, - tetrahedron6 c, - tetrahedron12 c, - tetrahedron19 c, - tetrahedron21 c] - + [ tetrahedron c n | n <- [0,1,2,3,6,12,19,21] ] -- | All tetrahedra completely contained in the top half of the cube. top_half_tetrahedra :: Cube -> [Tetrahedron] top_half_tetrahedra c = - [tetrahedron4 c, - tetrahedron5 c, - tetrahedron6 c, - tetrahedron7 c, - tetrahedron0 c, - tetrahedron10 c, - tetrahedron16 c, - tetrahedron20 c] - + [ tetrahedron c n | n <- [4,5,6,7,0,10,16,20] ] -- | All tetrahedra completely contained in the back half of the cube. back_half_tetrahedra :: Cube -> [Tetrahedron] back_half_tetrahedra c = - [tetrahedron8 c, - tetrahedron9 c, - tetrahedron10 c, - tetrahedron11 c, - tetrahedron4 c, - tetrahedron14 c, - tetrahedron17 c, - tetrahedron23 c] - + [ tetrahedron c n | n <- [8,9,10,11,4,14,17,23] ] -- | All tetrahedra completely contained in the down half of the cube. down_half_tetrahedra :: Cube -> [Tetrahedron] down_half_tetrahedra c = - [tetrahedron12 c, - tetrahedron13 c, - tetrahedron14 c, - tetrahedron15 c, - tetrahedron2 c, - tetrahedron8 c, - tetrahedron18 c, - tetrahedron22 c] - + [ tetrahedron c n | n <- [12,13,14,15,2,8,18,22] ] -- | All tetrahedra completely contained in the right half of the cube. right_half_tetrahedra :: Cube -> [Tetrahedron] right_half_tetrahedra c = - [tetrahedron16 c, - tetrahedron17 c, - tetrahedron18 c, - tetrahedron19 c, - tetrahedron1 c, - tetrahedron5 c, - tetrahedron9 c, - tetrahedron13 c] - + [ tetrahedron c n | n <- [16,17,18,19,1,5,9,13] ] -- | All tetrahedra completely contained in the left half of the cube. left_half_tetrahedra :: Cube -> [Tetrahedron] left_half_tetrahedra c = - [tetrahedron20 c, - tetrahedron21 c, - tetrahedron22 c, - tetrahedron23 c, - tetrahedron3 c, - tetrahedron7 c, - tetrahedron11 c, - tetrahedron15 c] - + [ tetrahedron c n | n <- [20,21,22,23,3,7,11,15] ] in_top_half :: Cube -> Point -> Bool in_top_half c (_,_,z) = @@ -662,3 +560,4 @@ find_containing_tetrahedron c p = contains_our_point = flip contains_point p containing_tetrahedra = filter contains_our_point candidates_xyz +