HetPrinter.hs revision e9458b1a7a19a63aa4c179f9ab20f4d50681c168
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski{- |
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiModule : ./FreeCAD/HetPrinter.hs
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiDescription : print the HasCASL representation of FreeCAD terms
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiCopyright : (c) Robert Savu and Uni Bremen 2011
97018cf5fa25b494adffd7e9b4e87320dae6bf47Christian MaederLicense : GPLv2 or higher, see LICENSE.txt
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
b4fbc96e05117839ca409f5f20f97b3ac872d1edTill MossakowskiMaintainer : Robert.Savu@dfki.de
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiStability : experimental
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiPortability : portable
f3a94a197960e548ecd6520bb768cb0d547457bbChristian Maeder
f3a94a197960e548ecd6520bb768cb0d547457bbChristian MaederPrinting of the HasCASL specification of a FreeCAD document
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-}
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskimodule FreeCAD.HetPrinter where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiimport FreeCAD.As
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiimport Common.DocUtils
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiimport Common.Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiimport Common.Id
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- | Pretty printing 'Double'
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty Double where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = sidDoc . mkSimpleId . show
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty Vector3 where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty v = hcat [text "V", lparen, sepByCommas $ map pretty [x v, y v, z v], rparen]
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty Vector4 where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty v = hcat [text "Q", lparen, sepByCommas $ map pretty [q0 v, q1 v, q2 v, q3 v], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty Placement where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty p1 =
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski hcat [text "Placement", lparen, sepByCommas [pretty $ position p1, pretty $ orientation p1], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintBO :: BaseObject -> Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintBO (Box h w l) = hcat [text "BBox", lparen, sepByCommas [pretty l, pretty w, pretty h], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintBO (Cylinder a h r) = hcat [text "BCylinder" , lparen, sepByCommas [pretty a, pretty h, pretty r], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintBO (Sphere a1 a2 a3 r) = hcat [text "BCylinder" , lparen, sepByCommas [pretty a1, pretty a2, pretty a3, pretty r], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintBO (Cone a r1 r2 h) = hcat [text "BCone" , lparen, sepByCommas [pretty a, pretty r1, pretty r2, pretty h], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintBO (Torus a1 a2 a3 r1 r2) = hcat [text "BTorus" , lparen, sepByCommas [pretty a1, pretty a2, pretty a3, pretty r1, pretty r2], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintBO (Line a) = hcat [text "BLine" , lparen, pretty a, rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintBO (Circle sa ea r) = hcat [text "BCircle" , lparen, sepByCommas [pretty sa, pretty ea, pretty r], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintBO (Rectangle h w) = hcat [text "BRectangle" , lparen, sepByCommas [pretty h, pretty w], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty BaseObject where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = printBO
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintObject :: Object -> Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintObject (BaseObject bo) = pretty bo
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintObject ( Cut eo1 eo2) = text "Cut" <+> hcat [lparen, sepByCommas [pretty eo1, pretty eo2], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintObject ( Common eo1 eo2) = text "Common" <+> hcat [lparen, sepByCommas [pretty eo1, pretty eo2], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintObject ( Fusion eo1 eo2) = text "Fusion" <+> hcat [lparen, sepByCommas [pretty eo1, pretty eo2], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- printObject ( Section eo1 eo2) = text "Section" <+> brackets $ sepByCommas [pretty eo1, pretty eo2]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintObject ( Extrusion eo d) = text "Extrusion" <+> hcat [lparen, sepByCommas [pretty eo, pretty d], rparen]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty Object where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = printObject
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintEO :: ExtendedObject -> Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintEO (Placed po) = pretty po
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintEO (Ref s) = text s
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintPO :: PlacedObject -> Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintPO (PlacedObject plc obj) = text "PObj = " <+> hcat [text "PObj", lparen, sepByCommas [pretty obj, pretty plc], rparen, text ";"]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintDoc :: String -> Document -> Doc
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till MossakowskiprintDoc name a = vcat [header, vcat [text " ops", hcat [text " ", vcat $ map pretty a]], end]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski header = vcat [logic, imports, specname]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski logic = text "logic HasCASL"
88ece6e49930670e8fd3ee79c89a2e918d2fbd0cChristian Maeder imports = text "from HasCASL/Real3D/FreeCAD/FreeCAD get FCObject"
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski specname = hcat [text "spec ", text name, text " = FCObject ", text "then"]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski end = text "end"
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty ExtendedObject where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = printEO
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty PlacedObject where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = printPO
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty NamedObject where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty no = hcat [pretty (name no), colon, pretty $ object no]
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski -- $+$
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski-- instance GetRange NamedObject
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowskiinstance Pretty Sign where
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski pretty = pretty . objects
df11e5eab86d8247f58e301d8f0a2c6ecf4c9541Till Mossakowski