module Language.Mecha.Solid
( Solid
, sphere
, cube
, cylinder
) where
import Language.Mecha.Types
import Text.Printf
data Solid
= Primitive Primitive [Transform] Color
| Union Solid Solid
| Intersection Solid Solid
| Difference Solid Solid
data Primitive = Sphere | Cube | Cylinder
data Transform
= Scale (Vector)
| Move (Vector)
| RotateX Double
| RotateY Double
| RotateZ Double
transform :: Transform -> Solid -> Solid
transform t a = case a of
Primitive a b c -> Primitive a (b ++ [t]) 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 b c
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)
grey = (0.5, 0.5, 0.5)
sphere :: Solid
sphere = Primitive Sphere [] grey
cube :: Solid
cube = Primitive Cube [] grey
cylinder :: Solid
cylinder = Primitive Cylinder [] grey
instance Show Solid where
show a = case a of
Primitive a t (r, g, b) -> case a of
Sphere -> "sphere { <0, 0, 0> 1\n" ++ trans ++ color ++ "}\n"
Cube -> "box { <1, 1, 1>, <-1, -1, -1>\n" ++ trans ++ color ++ "}\n"
Cylinder -> "cylinder { <0, 1, 0>, <0, -1, 0>, 1\n" ++ trans ++ color ++ "}\n"
where
color = printf " pigment { rgb <%f, %f, %f> }\n" r g b
trans = concatMap show t
Union a b -> printf "union {\n%s%s}\n" (show a) (show b)
Intersection a b -> printf "intersection {\n%s%s}\n" (show a) (show b)
Difference a b -> printf "difference {\n%s%s}\n" (show a) (show b)
instance Show Transform where
show a = case a of
Scale (x, y, z) -> printf " scale <%f, %f, %f>\n" x z y
Move (x, y, z) -> printf " translate <%f, %f, %f>\n" x z y
RotateX a -> printf " rotate <%f, 0, 0>\n" (a * 180 / pi)
RotateY a -> printf " rotate <0, 0, %f>\n" (a * 180 / pi)
RotateZ a -> printf " rotate <0, %f, 0>\n" (a * 180 / pi)