src/Cube.hs

   1 module Cube
   2 where
   3
   4 import Cardinal
   5 import Face (Face(Face, v0, v1, v2, v3))
   6 import FunctionValues
   7 import Point
   8 import Tetrahedron (Tetrahedron(Tetrahedron), fv)
   9 import ThreeDimensional
  10
  11 data Cube = Cube { h :: Double,
  12                    i :: Int,
  13                    j :: Int,
  14                    k :: Int,
  15                    fv :: FunctionValues }
  16             deriving (Eq)
  17
  18
  19 instance Show Cube where
  20     show c =
  21         "Cube_" ++ subscript ++ "\n" ++
  22         " h: " ++ (show (h c)) ++ "\n" ++
  23         " Center: " ++ (show (center c)) ++ "\n" ++
  24         " xmin: " ++ (show (xmin c)) ++ "\n" ++
  25         " xmax: " ++ (show (xmax c)) ++ "\n" ++
  26         " ymin: " ++ (show (ymin c)) ++ "\n" ++
  27         " ymax: " ++ (show (ymax c)) ++ "\n" ++
  28         " zmin: " ++ (show (zmin c)) ++ "\n" ++
  29         " zmax: " ++ (show (zmax c)) ++ "\n"
  30         where
  31           subscript =
  32               (show (i c)) ++ "," ++ (show (j c)) ++ "," ++ (show (k c))
  33
  34
  35 empty_cube :: Cube
  36 empty_cube = Cube 0 0 0 0 empty_values
  37
  38
  39 -- | The left-side boundary of the cube. See Sorokina and Zeilfelder,
  40 --   p. 76.
  41 xmin :: Cube -> Double
  42 xmin c = (2*i' - 1)*delta / 2
  43     where
  44       i' = fromIntegral (i c) :: Double
  45       delta = h c
  46
  47 -- | The right-side boundary of the cube. See Sorokina and Zeilfelder,
  48 --   p. 76.
  49 xmax :: Cube -> Double
  50 xmax c = (2*i' + 1)*delta / 2
  51     where
  52       i' = fromIntegral (i c) :: Double
  53       delta = h c
  54
  55 -- | The front boundary of the cube. See Sorokina and Zeilfelder,
  56 --   p. 76.
  57 ymin :: Cube -> Double
  58 ymin c = (2*j' - 1)*delta / 2
  59     where
  60       j' = fromIntegral (j c) :: Double
  61       delta = h c
  62
  63 -- | The back boundary of the cube. See Sorokina and Zeilfelder,
  64 --   p. 76.
  65 ymax :: Cube -> Double
  66 ymax c = (2*j' + 1)*delta / 2
  67     where
  68       j' = fromIntegral (j c) :: Double
  69       delta = h c
  70
  71 -- | The bottom boundary of the cube. See Sorokina and Zeilfelder,
  72 --   p. 76.
  73 zmin :: Cube -> Double
  74 zmin c = (2*k' - 1)*delta / 2
  75     where
  76       k' = fromIntegral (k c) :: Double
  77       delta = h c
  78
  79 -- | The top boundary of the cube. See Sorokina and Zeilfelder,
  80 --   p. 76.
  81 zmax :: Cube -> Double
  82 zmax c = (2*k' + 1)*delta / 2
  83     where
  84       k' = fromIntegral (k c) :: Double
  85       delta = h c
  86
  87 instance ThreeDimensional Cube where
  88     -- | The center of Cube_ijk coincides with v_ijk at
  89     --   (ih, jh, kh). See Sorokina and Zeilfelder, p. 76.
  90     center c = (x, y, z)
  91            where
  92              delta = h c
  93              i' = fromIntegral (i c) :: Double
  94              j' = fromIntegral (j c) :: Double
  95              k' = fromIntegral (k c) :: Double
  96              x = delta * i'
  97              y = delta * j'
  98              z = delta * k'
  99
 100     contains_point c p
 101         | (x_coord p) < (xmin c) = False
 102         | (x_coord p) > (xmax c) = False
 103         | (y_coord p) < (ymin c) = False
 104         | (y_coord p) > (ymax c) = False
 105         | (z_coord p) < (zmin c) = False
 106         | (z_coord p) > (zmax c) = False
 107         | otherwise = True
 108
 109
 110
 111 -- Face stuff.
 112
 113 -- | The top (in the direction of z) face of the cube.
 114 top_face :: Cube -> Face
 115 top_face c = Face v0' v1' v2' v3'
 116     where
 117       delta = (1/2)*(h c)
 118       v0' = (center c) + (delta, delta, delta)
 119       v1' = (center c) + (delta, -delta, delta)
 120       v2' = (center c) + (-delta, -delta, delta)
 121       v3' = (center c) + (-delta, delta, delta)
 122
 123
 124
 125 -- | The back (in the direction of x) face of the cube.
 126 back_face :: Cube -> Face
 127 back_face c = Face v0' v1' v2' v3'
 128     where
 129       delta = (1/2)*(h c)
 130       v0' = (center c) + (delta, delta, delta)
 131       v1' = (center c) + (delta, delta, -delta)
 132       v2' = (center c) + (delta, -delta, -delta)
 133       v3' = (center c) + (delta, -delta, delta)
 134
 135
 136 -- The bottom face (in the direction of -z) of the cube.
 137 down_face :: Cube -> Face
 138 down_face c = Face v0' v1' v2' v3'
 139     where
 140       delta = (1/2)*(h c)
 141       v0' = (center c) + (delta, delta, -delta)
 142       v1' = (center c) + (-delta, delta, -delta)
 143       v2' = (center c) + (-delta, -delta, -delta)
 144       v3' = (center c) + (delta, -delta, -delta)
 145
 146
 147
 148 -- | The front (in the direction of -x) face of the cube.
 149 front_face :: Cube -> Face
 150 front_face c = Face v0' v1' v2' v3'
 151     where
 152       delta = (1/2)*(h c)
 153       v0' = (center c) + (-delta, -delta, delta)
 154       v1' = (center c) + (-delta, delta, delta)
 155       v2' = (center c) + (-delta, delta, -delta)
 156       v3' = (center c) + (-delta, -delta, -delta)
 157
 158
 159 -- | The left (in the direction of -y) face of the cube.
 160 left_face :: Cube -> Face
 161 left_face c = Face v0' v1' v2' v3'
 162     where
 163       delta = (1/2)*(h c)
 164       v0' = (center c) + (-delta, -delta, delta)
 165       v1' = (center c) + (delta, -delta, delta)
 166       v2' = (center c) + (delta, -delta, -delta)
 167       v3' = (center c) + (-delta, -delta, -delta)
 168
 169
 170 -- | The right (in the direction of y) face of the cube.
 171 right_face :: Cube -> Face
 172 right_face c = Face v0' v1' v2' v3'
 173     where
 174       delta = (1/2)*(h c)
 175       v0' = (center c) + (-delta, delta, -delta)
 176       v1' = (center c) + (delta, delta, -delta)
 177       v2' = (center c) + (delta, delta, delta)
 178       v3' = (center c) + (-delta, delta, delta)
 179
 180
 181
 182 tetrahedron0 :: Cube -> Tetrahedron
 183 tetrahedron0 c =
 184     Tetrahedron (Cube.fv c) v0' v1' v2' v3'
 185     where
 186       v0' = center c
 187       v1' = center (front_face c)
 188       v2' = v0 (front_face c)
 189       v3' = v1 (front_face c)
 190
 191 tetrahedron1 :: Cube -> Tetrahedron
 192 tetrahedron1 c =
 193     Tetrahedron fv' v0' v1' v2' v3'
 194     where
 195       v0' = center c
 196       v1' = center (front_face c)
 197       v2' = v1 (front_face c)
 198       v3' = v2 (front_face c)
 199       fv' = rotate (Cube.fv c) ccwx
 200
 201 tetrahedron2 :: Cube -> Tetrahedron
 202 tetrahedron2 c =
 203     Tetrahedron fv' v0' v1' v2' v3'
 204     where
 205       v0' = center c
 206       v1' = center (front_face c)
 207       v2' = v2 (front_face c)
 208       v3' = v3 (front_face c)
 209       fv' = rotate (Cube.fv c) (ccwx . ccwx)
 210
 211 tetrahedron3 :: Cube -> Tetrahedron
 212 tetrahedron3 c =
 213     Tetrahedron fv' v0' v1' v2' v3'
 214     where
 215       v0' = center c
 216       v1' = center (front_face c)
 217       v2' = v3 (front_face c)
 218       v3' = v1 (front_face c)
 219       fv' = rotate (Cube.fv c) cwx
 220
 221 tetrahedron4 :: Cube -> Tetrahedron
 222 tetrahedron4 c =
 223     Tetrahedron fv' v0' v1' v2' v3'
 224     where
 225       v0' = center c
 226       v1' = center (top_face c)
 227       v2' = v0 (front_face c)
 228       v3' = v1 (front_face c)
 229       fv' = rotate (Cube.fv c) cwy
 230
 231 tetrahedron5 :: Cube -> Tetrahedron
 232 tetrahedron5 c =
 233     Tetrahedron fv' v0' v1' v2' v3'
 234     where
 235       v0' = center c
 236       v1' = center (top_face c)
 237       v2' = v1 (top_face c)
 238       v3' = v2 (top_face c)
 239       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) ccwx
 240
 241 tetrahedron6 :: Cube -> Tetrahedron
 242 tetrahedron6 c =
 243     Tetrahedron fv' v0' v1' v2' v3'
 244     where
 245       v0' = center c
 246       v1' = center (top_face c)
 247       v2' = v2 (top_face c)
 248       v3' = v3 (top_face c)
 249       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) (ccwx . ccwx)
 250
 251 tetrahedron7 :: Cube -> Tetrahedron
 252 tetrahedron7 c =
 253     Tetrahedron fv' v0' v1' v2' v3'
 254     where
 255       v0' = center c
 256       v1' = center (top_face c)
 257       v2' = v3 (top_face c)
 258       v3' = v1 (top_face c)
 259       fv' = rotate (Tetrahedron.fv (tetrahedron0 c)) cwx
 260
 261 tetrahedrons :: Cube -> [Tetrahedron]
 262 tetrahedrons c =
 263     [tetrahedron0 c,
 264      tetrahedron1 c,
 265      tetrahedron2 c,
 266      tetrahedron3 c,
 267      tetrahedron4 c,
 268      tetrahedron5 c,
 269      tetrahedron6 c,
 270      tetrahedron7 c
 271                 -- ,
 272                 --  tetrahedron8 c,
 273                 --  tetrahedron9 c,
 274                 --  tetrahedron10 c,
 275                 --  tetrahedron11 c,
 276                 --  tetrahedron12 c,
 277                 --  tetrahedron13 c,
 278                 --  tetrahedron14 c,
 279                 --  tetrahedron15 c,
 280                 --  tetrahedron16 c,
 281                 --  tetrahedron17 c,
 282                 --  tetrahedron18 c,
 283                 --  tetrahedron19 c,
 284                 --  tetrahedron20 c,
 285                 --  tetrahedron21 c,
 286                 --  tetrahedron21 c,
 287                 --  tetrahedron22 c,
 288                 --  tetrahedron23 c,
 289                 --  tetrahedron24 c
 290     ]