-- | Export model generation.
module Language.Mecha.Export
  ( povray
  , openSCAD
  ) where

import Text.Printf

import Language.Mecha.Solid

-- Generates a POV-Ray model.
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>" x1 z1 y1 x2 z2 y2)
    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)

-- Generates an OpenSCAD model.
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]) {\n%s}\n" r g b o $ indent $ transform $ reverse t
      where
      transform :: [Transform] -> String
      transform a = case a of
        [] -> primitive p
        Scale (x, y, z) : rest -> printf "scale ([%f, %f, %f])     {\n%s}\n" x y z          $ indent $ transform rest
        Move  (x, y, z) : rest -> printf "translate ([%f, %f, %f]) {\n%s}\n" x y z          $ indent $ transform rest
        RotateX a       : rest -> printf "rotate (%f, [1, 0, 0])   {\n%s}\n" (a * 180 / pi) $ indent $ transform rest
        RotateY a       : rest -> printf "rotate (%f, [0, 1, 0])   {\n%s}\n" (a * 180 / pi) $ indent $ transform rest
        RotateZ a       : rest -> printf "rotate (%f, [0, 0, 1])   {\n%s}\n" (a * 180 / pi) $ indent $ transform rest

      primitive :: Primitive -> String
      primitive a = case a of
        Sphere d     -> printf "sphere(r = %f, $fs = 0.01);\n" (d / 2)
        Cone bd td h -> printf "cylinder(h = %f, r1 = %f, r2 = %f, center = false, $fs = 0.01);\n" h (td / 2) (bd / 2)
        Box (x1, x2) (y1, y2) (z1, z2) -> printf "translate ([%f, %f, %f]) {\n\tcube(size = [%f, %f, %f], center = false);\n}\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

indent :: String -> String
indent a = unlines [ "\t" ++ l | l <- lines a ]