{- |
Module      :  ./FreeCAD/XMLPrinter.hs
Description :  XML Printer function for FreeCAD datatypes
Copyright   :  (c) Robert Savu and Uni Bremen 2011
License     :  GPLv2 or higher, see LICENSE.txt

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

Declaration of the abstract datatypes of FreeCAD terms
-}


module FreeCAD.XMLPrinter where

import Text.XML.Light
import FreeCAD.As
import qualified Data.Set as Set

exportXMLFC :: Sign -> String
exportXMLFC :: Sign -> String
exportXMLFC = Element -> String
ppTopElement (Element -> String) -> (Sign -> Element) -> Sign -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Document -> Element
doc2XML (Document -> Element) -> (Sign -> Document) -> Sign -> Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set NamedObject -> Document
forall a. Set a -> [a]
Set.toList (Set NamedObject -> Document)
-> (Sign -> Set NamedObject) -> Sign -> Document
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Sign -> Set NamedObject
objects

makeAttr :: String -> String -> Attr
makeAttr :: String -> String -> Attr
makeAttr key :: String
key = QName -> String -> Attr
Attr (String -> QName
unqual String
key)

doc2XML :: Document -> Element
doc2XML :: Document -> Element
doc2XML list :: Document
list = String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode "document" ((NamedObject -> Element) -> Document -> [Element]
forall a b. (a -> b) -> [a] -> [b]
map NamedObject -> Element
sendNamedObj Document
list)

sendNamedObj :: NamedObject -> Element
sendNamedObj :: NamedObject -> Element
sendNamedObj no :: NamedObject
no = Attr -> Element -> Element
add_attr Attr
att (String -> [Element] -> Element
forall t. Node t => String -> t -> Element
unode "Object" (NamedObject -> [Element]
getNOChildren NamedObject
no)) where
    att :: Attr
att = QName -> String -> Attr
Attr (String -> QName
unqual "name") (NamedObject -> String
name NamedObject
no)

getNOChildren :: NamedObject -> [Element]
getNOChildren :: NamedObject -> [Element]
getNOChildren no :: NamedObject
no = [Placement -> Element
makePlaceElem Placement
place, Object -> Element
makeObjElem Object
obj] where
    pobj :: PlacedObject
pobj = NamedObject -> PlacedObject
object NamedObject
no
    obj :: Object
obj = PlacedObject -> Object
o PlacedObject
pobj
    place :: Placement
place = PlacedObject -> Placement
p PlacedObject
pobj

makePlaceElem :: Placement -> Element
makePlaceElem :: Placement -> Element
makePlaceElem pl :: Placement
pl = String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode "placement" [Attr]
attrList
    where
      attrList :: [Attr]
attrList = [Attr
xAt, Attr
yAt, Attr
zAt, Attr
q0At, Attr
q1At, Attr
q2At, Attr
q3At]
      mkp :: String -> a -> Attr
mkp a :: String
a b :: a
b = QName -> String -> Attr
Attr (String -> QName
unqual String
a) (a -> String
forall a. Show a => a -> String
show a
b)
      mko :: String -> a -> Attr
mko a :: String
a b :: a
b = QName -> String -> Attr
Attr (String -> QName
unqual String
a) (a -> String
forall a. Show a => a -> String
show a
b)
      xAt :: Attr
xAt = String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkp "x" (Vector3 -> Double
x (Vector3 -> Double) -> Vector3 -> Double
forall a b. (a -> b) -> a -> b
$ Placement -> Vector3
position Placement
pl)
      yAt :: Attr
yAt = String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkp "y" (Vector3 -> Double
y (Vector3 -> Double) -> Vector3 -> Double
forall a b. (a -> b) -> a -> b
$ Placement -> Vector3
position Placement
pl)
      zAt :: Attr
zAt = String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkp "z" (Vector3 -> Double
z (Vector3 -> Double) -> Vector3 -> Double
forall a b. (a -> b) -> a -> b
$ Placement -> Vector3
position Placement
pl)
      q0At :: Attr
q0At = String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mko "q0" (Vector4 -> Double
q0 (Vector4 -> Double) -> Vector4 -> Double
forall a b. (a -> b) -> a -> b
$ Placement -> Vector4
orientation Placement
pl)
      q1At :: Attr
q1At = String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mko "q1" (Vector4 -> Double
q1 (Vector4 -> Double) -> Vector4 -> Double
forall a b. (a -> b) -> a -> b
$ Placement -> Vector4
orientation Placement
pl)
      q2At :: Attr
q2At = String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mko "q2" (Vector4 -> Double
q2 (Vector4 -> Double) -> Vector4 -> Double
forall a b. (a -> b) -> a -> b
$ Placement -> Vector4
orientation Placement
pl)
      q3At :: Attr
q3At = String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mko "q3" (Vector4 -> Double
q3 (Vector4 -> Double) -> Vector4 -> Double
forall a b. (a -> b) -> a -> b
$ Placement -> Vector4
orientation Placement
pl)

mkNumAtt :: Show a => String -> a -> Attr
mkNumAtt :: String -> a -> Attr
mkNumAtt key :: String
key num :: a
num = QName -> String -> Attr
Attr (String -> QName
unqual String
key) (a -> String
forall a. Show a => a -> String
show a
num)

makeObjElem :: Object -> Element
makeObjElem :: Object -> Element
makeObjElem obj :: Object
obj = case Object
obj of
                    BaseObject bo :: BaseObject
bo -> BaseObject -> Element
makeBOElem BaseObject
bo
                    Cut eo1 :: ExtendedObject
eo1 eo2 :: ExtendedObject
eo2 -> String -> ExtendedObject -> ExtendedObject -> Element
mk2refs "cut" ExtendedObject
eo1 ExtendedObject
eo2
                    Common eo1 :: ExtendedObject
eo1 eo2 :: ExtendedObject
eo2 -> String -> ExtendedObject -> ExtendedObject -> Element
mk2refs "common" ExtendedObject
eo1 ExtendedObject
eo2
                    Fusion eo1 :: ExtendedObject
eo1 eo2 :: ExtendedObject
eo2 -> String -> ExtendedObject -> ExtendedObject -> Element
mk2refs "fusion" ExtendedObject
eo1 ExtendedObject
eo2
                    Section eo1 :: ExtendedObject
eo1 eo2 :: ExtendedObject
eo2 -> String -> ExtendedObject -> ExtendedObject -> Element
mk2refs "section" ExtendedObject
eo1 ExtendedObject
eo2
                    Extrusion eo1 :: ExtendedObject
eo1 v3 :: Vector3
v3 -> String -> ExtendedObject -> Vector3 -> Element
mk1refs "extrusion" ExtendedObject
eo1 Vector3
v3
    where
      mkRefAtt :: String -> ExtendedObject -> Attr
mkRefAtt key :: String
key eo :: ExtendedObject
eo = QName -> String -> Attr
Attr (String -> QName
unqual String
key) (ExtendedObject -> String
getEORef ExtendedObject
eo)
      mk2refs :: String -> ExtendedObject -> ExtendedObject -> Element
mk2refs consType :: String
consType ref1 :: ExtendedObject
ref1 ref2 :: ExtendedObject
ref2 =
          String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode String
consType [String -> ExtendedObject -> Attr
mkRefAtt "base" ExtendedObject
ref1, String -> ExtendedObject -> Attr
mkRefAtt "tool" ExtendedObject
ref2]
      mk1refs :: String -> ExtendedObject -> Vector3 -> Element
mk1refs consType :: String
consType ref :: ExtendedObject
ref v3 :: Vector3
v3 =
          String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode String
consType [String -> ExtendedObject -> Attr
mkRefAtt "base" ExtendedObject
ref, String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "xval" (Vector3 -> Double
x Vector3
v3),
                          String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "yval" (Vector3 -> Double
y Vector3
v3), String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "zval" (Vector3 -> Double
z Vector3
v3)]

getEORef :: ExtendedObject -> String
getEORef :: ExtendedObject -> String
getEORef eo :: ExtendedObject
eo = case ExtendedObject
eo of
           Ref s :: String
s -> String
s
           Placed _ -> String -> String
forall a. HasCallStack => String -> a
error "cannot get reference"

makeBOElem :: BaseObject -> Element
makeBOElem :: BaseObject -> Element
makeBOElem obj :: BaseObject
obj = case BaseObject
obj of
                   Box a1 :: Double
a1 a2 :: Double
a2 a3 :: Double
a3 ->
                       String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode "box" [String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "height" Double
a1, String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "width" Double
a2,
                        String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "length" Double
a3]
                   Cylinder a1 :: Double
a1 a2 :: Double
a2 a3 :: Double
a3 ->
                       String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode "cylinder" [String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "angle" Double
a1,
                        String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "height" Double
a2, String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "radius" Double
a3]
                   Sphere a1 :: Double
a1 a2 :: Double
a2 a3 :: Double
a3 a4 :: Double
a4 ->
                       String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode "sphere" [String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "angle1" Double
a1,
                        String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "angle2" Double
a2, String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "angle3" Double
a3,
                        String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "radius" Double
a4]
                   Cone a1 :: Double
a1 a2 :: Double
a2 a3 :: Double
a3 a4 :: Double
a4 ->
                       String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode "cone" [String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "angle" Double
a1, String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "radius1" Double
a2,
                        String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "radius2" Double
a3, String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "height" Double
a4]
                   Torus a1 :: Double
a1 a2 :: Double
a2 a3 :: Double
a3 a4 :: Double
a4 a5 :: Double
a5 ->
                       String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode "torus" [String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "angle1" Double
a1,
                        String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "angle2" Double
a2, String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "angle3" Double
a3,
                        String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "radius1" Double
a4, String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "radius2" Double
a5]
                   Line a1 :: Double
a1 -> String -> Attr -> Element
forall t. Node t => String -> t -> Element
unode "line" (String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "length" Double
a1)
                   Circle a1 :: Double
a1 a2 :: Double
a2 a3 :: Double
a3 ->
                       String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode "circle" [String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "startang" Double
a1,
                        String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "endang" Double
a2, String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "radius" Double
a3]
                   Rectangle a1 :: Double
a1 a2 :: Double
a2 ->
                       String -> [Attr] -> Element
forall t. Node t => String -> t -> Element
unode "rectangle" [String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "height" Double
a1,
                        String -> Double -> Attr
forall a. Show a => String -> a -> Attr
mkNumAtt "length" Double
a2]