module Language.Mecha.Solid
( Solid (..)
, Primitive (..)
, Transform (..)
, sphere
, cone
, box
, cube
, cylinder
, cylinder'
, tube
, radial
, torus
) where
import Language.Mecha.Types
data Solid
= Primitive [Transform] Color Primitive
| Union Solid Solid
| Intersection Solid Solid
| Difference Solid Solid
deriving Eq
data Primitive
= Sphere Double
| Cone Double Double Double
| Box (Double, Double) (Double, Double) (Double, Double)
| Torus Double Double
deriving Eq
data Transform
= Scale (Vector)
| Move (Vector)
| RotateX Double
| RotateY Double
| RotateZ Double
deriving Eq
transform :: Transform -> Solid -> Solid
transform t a = case a of
Primitive a b c -> Primitive (a ++ [t]) b c
Union a b -> Union (transform t a) (transform t b)
Intersection a b -> Intersection (transform t a) (transform t b)
Difference a b -> Difference (transform t a) (transform t b)
instance Moveable Solid where
move a = transform $ Move a
rotateX a = transform $ RotateX a
rotateY a = transform $ RotateY a
rotateZ a = transform $ RotateZ a
instance Scaleable Solid where
scale a = transform $ Scale a
instance Setable Solid where
union = Union
intersection = Intersection
difference = Difference
instance Colorable Solid where
color c a = case a of
Primitive a _ b -> Primitive a c b
Union a b -> Union (color c a) (color c b)
Intersection a b -> Intersection (color c a) (color c b)
Difference a b -> Difference (color c a) (color c b)
primitive :: Primitive -> Solid
primitive = Primitive [] (0.5, 0.5, 0.5, 1)
sphere :: Double -> Solid
sphere = primitive . Sphere
cube :: Double -> Solid
cube a = box c c c
where
b = a / 2
c = (b, b)
cone :: Double -> Double -> Double -> Solid
cone bd td h = primitive $ Cone bd td h
cylinder :: Double -> Double -> Solid
cylinder d h = cone d d h
cylinder' :: Double -> Double -> Solid
cylinder' d h = moveZ ( h / 2) $ cylinder d h
tube od id h = difference (cylinder od h) (moveZ (h) $ cylinder id (4 * h))
box :: (Double, Double) -> (Double, Double) -> (Double, Double) -> Solid
box x y z = primitive $ Box x y z
radial :: (Double -> Solid) -> Int -> Solid
radial f n = unions [ rotateZ a $ f a | i <- [0 .. n 1], let a = 2 * pi * fromIntegral i / fromIntegral n ]
torus :: Double -> Double -> Solid
torus d1 d2 = primitive $ Torus d1 d2