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)

-- | A sphere with radius 1 centered at origin.
sphere :: Solid
sphere = Primitive Sphere [] grey

-- | A sphere with edge length 2 centered at origin.
cube :: Solid
cube = Primitive Cube [] grey

-- | A cylinder with radius 1 and height 2 centered at origin.
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)