{- |
Module      :  $Header$
Description :  print the HasCASL representation of FreeCAD terms
Copyright   :  (c) Robert Savu and Uni Bremen 2011
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  Robert.Savu@dfki.de
Stability   :  experimental
Portability :  portable

Printing of the HasCASL specification of a FreeCAD document
-}

module FreeCAD.HetPrinter where

import FreeCAD.As
import Common.DocUtils
import Common.Doc
import Common.Id

-- | Pretty printing 'Double'
instance Pretty Double where
    pretty = sidDoc . mkSimpleId . show

instance Pretty Vector3 where
    pretty v =  hcat[text "V", lparen, sepByCommas $ map pretty [x v, y v, z v], rparen]

instance Pretty Vector4 where
    pretty v = hcat[text "Q", lparen, sepByCommas $ map pretty [q0 v, q1 v, q2 v, q3 v], rparen]

instance Pretty Placement where
    pretty p1 =
      hcat[text "Placement", lparen, sepByCommas [pretty $ position p1, pretty $ orientation p1], rparen]

printBO:: BaseObject -> Doc
printBO (Box h w l) = hcat[text "BBox", lparen, sepByCommas [pretty l,pretty  w,pretty  h], rparen]
printBO (Cylinder a h r) = hcat[text "BCylinder" , lparen, sepByCommas [pretty a,pretty  h,pretty  r], rparen]
printBO (Sphere a1 a2 a3 r)= hcat[text "BCylinder" , lparen, sepByCommas [pretty a1,pretty  a2,pretty  a3,pretty  r],rparen]
printBO (Cone a r1 r2 h) = hcat[text "BCone" , lparen, sepByCommas [pretty a,pretty r1,pretty r2,pretty h],rparen]
printBO (Torus a1 a2 a3 r1 r2) = hcat[text "BTorus" , lparen, sepByCommas [pretty a1,pretty a2,pretty a3,pretty r1,pretty r2],rparen]
printBO (Line a) = hcat[text "BLine" , lparen, pretty a,rparen]
printBO (Circle sa ea r) = hcat[text "BCircle" , lparen, sepByCommas [pretty sa,pretty ea,pretty r],rparen]
printBO (Rectangle h w) = hcat[text "BRectangle" , lparen, sepByCommas [pretty h,pretty w],rparen]
  
instance Pretty BaseObject where
    pretty bo = printBO bo

printObject:: Object -> Doc
printObject (BaseObject bo) = pretty bo
printObject ( Cut eo1 eo2) = text "Cut" <+> hcat[lparen, sepByCommas [pretty eo1, pretty eo2], rparen]
printObject ( Common eo1 eo2) = text "Common" <+> hcat[lparen, sepByCommas [pretty eo1, pretty eo2], rparen]
printObject ( Fusion eo1 eo2) = text "Fusion" <+> hcat[lparen, sepByCommas [pretty eo1, pretty eo2], rparen]
--printObject ( Section eo1 eo2) = text "Section" <+> brackets $ sepByCommas [pretty eo1, pretty eo2]
printObject ( Extrusion eo d) = text "Extrusion" <+> hcat[lparen, sepByCommas [pretty eo, pretty d], rparen]

instance Pretty Object where
    pretty obj = printObject obj

printEO:: ExtendedObject -> Doc
printEO (Placed po) = pretty po
printEO (Ref s) = text s

printPO:: PlacedObject -> Doc
printPO (PlacedObject plc obj) = text "PObj = " <+> hcat[text "PObj", lparen, sepByCommas [pretty obj, pretty plc], rparen, text ";"]

printDoc:: String -> Document -> Doc
printDoc name a = vcat[header, vcat[text "  ops", hcat[text "    ", vcat $ map pretty a]], end] 
  where
    header = vcat[logic, imports, specname]
    logic = text "logic HasCASL"
    imports = text "from HasCASL/Real3D/FreeCAD/FreeCAD get FCObject"
    specname = hcat[text "spec ", text name, text " = FCObject ", text "then"]
    end = text "end"

instance Pretty ExtendedObject where
    pretty eo = printEO eo

instance Pretty PlacedObject where
    pretty po = printPO po

instance Pretty NamedObject where
    pretty no = hcat[pretty (name no), colon, pretty $ object no]
  --      $+$

--instance GetRange NamedObject

instance Pretty Sign where
    pretty = pretty . objects
