Translator.hs revision 70a23a37b59f9e25c0f4ae47ab449142422bec20
b53688bfed888214b485cf76439d57262d80e0a7Christian Maedertranslate:: Maybe Element -> Document
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederisBaseObject:: Element -> Bool
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetObject:: Element -> NamedObject
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetBaseObject:: Element -> BaseObject
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaedergetExtendedObject:: Element -> ExtendedObject
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaedergetPlacement:: Element -> Placement
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaedergetName:: Element -> String
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaedergetProperty:: Element -> String -> Double
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder--constants used to find the appropriate subtree in the XML file:
ea5ccb1c6e89486a54e1f4bd95840147e96093edChristian MaederobjListQName::QName
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaederobjListQName = makeQName "ObjectData"
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder --qualified name of the element which contains the list of objects
85e1d54a475bfc30b3eac5ae6c5e42a2d7e93f10Christian Maeder --with their properties
85e1d54a475bfc30b3eac5ae6c5e42a2d7e93f10Christian MaederobjQName::QName
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaederobjQName = makeQName "Object"
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder --qualified name for the element which represents an object
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaederobjListEl:: Element -> Maybe Element
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaederobjListEl mbel = findChild objListQName mbel
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder --the xml element containing all objects and their data:: Element
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaederobjList:: Element -> [Element]
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaederobjList mbel= findChildren objQName (fromJust (objListEl mbel))
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian Maeder --list of xml elements containing data for each object:: [Element]
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaederfirstThree :: String -> String
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaederfirstThree x = take 3 x
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaedermakeQName:: String -> QName
bbba6dd86153aacb0f662b182b128df0eb09fd54Christian MaedermakeQName s = QName s Nothing Nothing
a461314c811f4187dff85c8be079a41b2f13f176Christian MaedergetName:: Element -> String
109a53dbf4c9233f869f63ba7a7f3fece49973c3Christian MaedergetName el = fromJust (findAttr (makeQName "name") el)
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederhasName:: String -> Element -> Bool
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederhasName s el = (getName el == s)
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederchildByName:: String -> Element -> Element
16b71dad8d398af412d66a4f4763f1ada5b03d23Christian MaederchildByName s el = fromJust (findChild (makeQName s) el)
f39b8dd9651dfcc38b06191cda23cacbfc298323Christian MaederchildByNameAttr:: String -> Element -> Element
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederchildByNameAttr s el = fromJust (filterChild(hasName s) el)
3a9d784341454573b50b32fa1b494e7418df3086Christian Maeder-- a Set constant -- TODO: find signature
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedersetBaseObjs:: Set.Set [Char]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedersetBaseObjs = fromList["Box", "Sph", "Cyl", "Con", "Tor", "Cir", "Rec"]
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederisBaseObject:: Element -> Bool
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederisBaseObject el = member (firstThree (getName el)) setBaseObjs
be43c3fa0292555bd126784ae27ff5c1d23438cbChristian Maeder -- identify (by its name) whether an object is simpe or extended
7f7460e7095628f3437b116ee78d3043d11f8febChristian Maeder -- returns true if it is a base object and false otherwise
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder--used in order to identify the object constructor from the name
38c817b94e0a5b1ae94178b1075c187e07bcc5e1Christian MaedergetObject:: Element -> FreeCAD.As.NamedObject
38c817b94e0a5b1ae94178b1075c187e07bcc5e1Christian MaedergetObject el | tn == "Box" = makeb el tn
38c817b94e0a5b1ae94178b1075c187e07bcc5e1Christian Maeder | tn == "Sph" = makeb el tn
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | tn == "Cyl" = makeb el tn
2353f65833a3da763392f771223250cd50b8d873Christian Maeder | tn == "Con" = makeb el tn
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | tn == "Tor" = makeb el tn
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | tn == "Cir" = makeb el tn
00df6fd583c19393fa141d5a0e21ac74c7bf5b19Christian Maeder | tn == "Rec" = makeb el tn
cb2044812811d66efe038d914966e04290be93faChristian Maeder | tn == "Cut" = makex el tn
bc263f610d20a9cd3014ddfca903026127fa0d48Christian Maeder | tn == "Com" = makex el tn
8c8545dd3bf34fbcbc16904b65d249658f8f9efcChristian Maeder | tn == "Fus" = makex el tn
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | tn == "Sec" = makex el tn
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder tn = firstThree(getName el)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder makeb el tn = NamedObject (getName el) (PlacedObject (findPlacement el) (BaseObject (bbuild tn el)))
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder makex el tn = NamedObject (getName el) (PlacedObject (findPlacement el) (buildex tn el))
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder bbuild tn el | tn == "Box" = Box (findFloat "Height" el) (findFloat "Width" el) (findFloat "Length" el)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | tn == "Sph" = Sphere (findFloat "Angle1" el) (findFloat "Angle2" el) (findFloat "Angle3" el) (findFloat "Radius" el)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | tn == "Cyl" = Cylinder (findFloat "Angle" el) (findFloat "Height" el) (findFloat "Radius" el)
cb2044812811d66efe038d914966e04290be93faChristian Maeder | tn == "Con" = Cone (findFloat "Angle" el) (findFloat "Radius1" el) (findFloat "Radius2" el) (findFloat "Height" el)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | tn == "Tor" = Torus (findFloat "Angle1" el) (findFloat "Angle2" el) (findFloat "Angle3" el) (findFloat "Radius1" el) (findFloat "Radius2" el)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder | tn == "Cir" = Circle (findFloat "StartAngle" el) (findFloat "EndAngle" el) (findFloat "Radius" el)
083bc1972a66d73749760eab3a90bf4eb9ca7951Christian Maeder | tn == "Rec" = Rectangle (findFloat "Height" el) (findFloat "Length" el)
0ae7a79e865d4a6022d705d160530682b3c1f825Christian Maeder buildex tn el | tn == "Cut" = Cut (findRef "Base" el) (findRef "Tool" el)
00df6fd583c19393fa141d5a0e21ac74c7bf5b19Christian Maeder | tn == "Com" = Common (findRef "Base" el) (findRef "Tool" el)
083bc1972a66d73749760eab3a90bf4eb9ca7951Christian Maeder | tn == "Fus" = Fusion (findRef "Base" el) (findRef "Tool" el)
6352f3c31da3043783a13be6594aacb2147378baRazvan Pascanu | tn == "Sec" = Section (findRef "Base" el) (findRef "Tool" el)
bc263f610d20a9cd3014ddfca903026127fa0d48Christian MaedergetVal:: String -> Element -> String
966519955f5f7111abac20118563132b9dd41165Christian MaedergetVal s el = fromJust (findAttr (makeQName s) el)
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetFloatVal:: Element -> String
33fcc19ef2b59493b4e91eebf701df95fd230765Christian MaedergetFloatVal el = getVal "value" el2
33fcc19ef2b59493b4e91eebf701df95fd230765Christian Maeder el2 = childByName "Float" el
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetPlacementVals::Element -> (String, String, String, String, String, String, String)
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetPlacementVals el = (m "Px", m "Py", m "Pz", m "Q0", m "Q1", m "Q2", m "Q3")
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder m s = getVal s el2
2360728d4185c0c04279c999941c64d36626af79Christian Maeder el2 = childByName "PropertyPlacement" el
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetLinkVal:: Element -> String
b53688bfed888214b485cf76439d57262d80e0a7Christian MaedergetLinkVal el = getVal "value" el2
beff4152e9f0fe90885458d1a1733b183a2a8816Christian Maeder el2 = childByName "Link" el
fdac680252d7347858bd67b4c2a2aaa52e623815Christian MaederfindFloat:: String -> Element -> Double
a9e804dbec424ec36e34bab955cbe90edac5baa6Christian MaederfindFloat s el = read (getFloatVal el2)
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder el2 = childByNameAttr s el
b76d27eba526ecac2a20400fa505ec5c642ae7d2Dominik LueckefindPlacement::Element -> FreeCAD.As.Placement
b76d27eba526ecac2a20400fa505ec5c642ae7d2Dominik LueckefindPlacement el = Placement (Vector3 a b c) (Vector4 d e f g)
8a5c05062ef501bf725a86a370a5145a198e81fdKlaus Luettich (sa, sb, sc, sd, se, sf, sg) = getPlacementVals el2
b53688bfed888214b485cf76439d57262d80e0a7Christian Maeder el2 = childByNameAttr "Placement" el
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederfindRef::String -> Element -> FreeCAD.As.ExtendedObject
b53688bfed888214b485cf76439d57262d80e0a7Christian MaederfindRef s el = Ref (getLinkVal el2)
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder el2 = childByNameAttr s el
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder--Facade function that translates the parsed XML document into Haskell-FreeCAD datatype
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maedertranslate:: Element -> Document
cb2044812811d66efe038d914966e04290be93faChristian Maedertranslate baseElement = document
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder objects = objList baseElement
a3a7d8b3cdf05c8040c62dbcf9a15dc5042cd721Christian Maeder document = Prelude.map getObject objects