module Language.Mecha.Assembly
  ( Asm
  , part
  , assemble
  , view
  ) where

import Language.Mecha.Solid
import Language.Mecha.Types
import System.IO
import Text.Printf

-- | The Asm holds all the parts and sub-assemblies.
newtype Asm = Asm [Solid]

instance Colorable Asm where
  color c (Asm a) = Asm $ map (color c) a

instance Moveable Asm where
  move a (Asm b)    = Asm $ map (move a) b
  rotateX a (Asm b) = Asm $ map (rotateX a) b
  rotateY a (Asm b) = Asm $ map (rotateY a) b
  rotateZ a (Asm b) = Asm $ map (rotateZ a) b

-- | Place a part (Solid) in an assembly.
part :: Solid -> Asm
part a = Asm [a]

-- | Assemble multiple sub-assemblies together.
assemble :: [Asm] -> Asm
assemble a = Asm $ concat [ a | Asm a <- a ]

-- | Generate a POVRay file given a file name, camera location, target location, and assembly.
view :: FilePath -> Vector -> Vector -> Asm -> IO ()
view file (ax, ay, az) (bx, by, bz) (Asm a) = do
  writeFile file $ unlines
    [ "#include \"colors.inc\""
    , "background { color White }"
    , printf "camera { location <%f, %f, %f>  look_at <%f, %f, %f> }" ax az ay bx bz by
    , "light_source { <2, 4, -3> color White }"
    ] ++ concatMap show a