module Language.Mecha.Export
( povray
, openSCAD
) where
import Text.Printf
import Language.Mecha.Solid
povray :: Solid -> String
povray a = unlines
[ "// Generated by Mecha (https://github.com/tomahawkins/mecha)"
, ""
, solid a
, ""
]
where
solid :: Solid -> String
solid a = case a of
Primitive t (r, g, b, o) a -> printf "%s { %s\n%s%s}\n" a1 a2 (indent $ concatMap transform t) (indent color)
where
color :: String
color = printf "pigment { rgbt <%f, %f, %f, %f> }\n" r g b (1 o)
a1 :: String
a2 :: String
(a1, a2) = case a of
Sphere d -> ("sphere", printf "<0, 0, 0>, %f" (d / 2))
Cone bd td h -> ("cone", printf "<0, 0, 0>, %f <0, %f, 0>, %f" (bd / 2) h (td / 2))
Box (x1, x2) (y1, y2) (z1, z2) -> ("box", printf "<%f, %f, %f>, <%f, %f, %f>" xmin zmin ymin xmax zmax ymax)
where
xmin = min x1 x2
xmax = max x1 x2
ymin = min y1 y2
ymax = max y1 y2
zmin = min z1 z2
zmax = max z1 z2
Torus d1 d2 -> ("torus", printf "%f, %f" (d1 / 2) (d2 / 2))
Union a b -> printf "merge {\n%s%s}\n" (indent $ solid a) (indent $ solid b)
Intersection a b -> printf "intersection {\n%s%s}\n" (indent $ solid a) (indent $ solid b)
Difference a b -> printf "difference {\n%s%s}\n" (indent $ solid a) (indent $ solid b)
transform :: Transform -> String
transform 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)
openSCAD :: Solid -> String
openSCAD a = unlines
[ "// Generated by Mecha (https://github.com/tomahawkins/mecha)"
, ""
, solid a
, ""
]
where
solid :: Solid -> String
solid a = case a of
Union a b -> printf "union() {\n%s%s}\n" (indent $ solid a) (indent $ solid b)
Intersection a b -> printf "intersection() {\n%s%s}\n" (indent $ solid a) (indent $ solid b)
Difference a b -> printf "difference() {\n%s%s}\n" (indent $ solid a) (indent $ solid b)
Primitive t (r, g, b, o) p -> printf "color([%f, %f, %f, %f]) %s\n" r g b o $ transform $ reverse t
where
transform :: [Transform] -> String
transform a = case a of
[] -> primitive p
Scale (x, y, z) : rest -> printf "scale ([%f, %f, %f]) %s" x y z $ transform rest
Move (x, y, z) : rest -> printf "translate ([%f, %f, %f]) %s" x y z $ transform rest
RotateX a : rest -> printf "rotate (%f, [1, 0, 0]) %s" (a * 180 / pi) $ transform rest
RotateY a : rest -> printf "rotate (%f, [0, 1, 0]) %s" (a * 180 / pi) $ transform rest
RotateZ a : rest -> printf "rotate (%f, [0, 0, 1]) %s" (a * 180 / pi) $ transform rest
primitive :: Primitive -> String
primitive a = case a of
Sphere d -> printf "sphere(r = %f, $fn = 100);\n" (d / 2)
Cone bd td h -> printf "cylinder(h = %f, r1 = %f, r2 = %f, center = false, $fn = 100);\n" h (td / 2) (bd / 2)
Box (x1, x2) (y1, y2) (z1, z2) -> printf "translate ([%f, %f, %f]) cube(size = [%f, %f, %f], center = false);\n" xmin ymin zmin (xmax xmin) (ymax ymin) (zmax zmin)
where
xmin = min x1 x2
xmax = max x1 x2
ymin = min y1 y2
ymax = max y1 y2
zmin = min z1 z2
zmax = max z1 z2
Torus d1 d2 -> printf "rotate_extrude($fn = 100) translate([%f, 0, 0]) circle(%f, $fn = 100);" (d1 / 2) (d2 / 2)
indent :: String -> String
indent a = unlines [ "\t" ++ l | l <- lines a ]