952777ffbefca642d799990410a635b7963f87d7Robert SavuDescription : print the HasCASL representation of FreeCAD terms
952777ffbefca642d799990410a635b7963f87d7Robert SavuCopyright : (c) Robert Savu and Uni Bremen 2011
952777ffbefca642d799990410a635b7963f87d7Robert SavuLicense : GPLv2 or higher, see LICENSE.txt
952777ffbefca642d799990410a635b7963f87d7Robert SavuMaintainer : Robert.Savu@dfki.de
952777ffbefca642d799990410a635b7963f87d7Robert SavuStability : experimental
952777ffbefca642d799990410a635b7963f87d7Robert SavuPortability : portable
952777ffbefca642d799990410a635b7963f87d7Robert SavuPrinting of the HasCASL specification of a FreeCAD document
952777ffbefca642d799990410a635b7963f87d7Robert Savu-- | Pretty printing 'Double'
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty Double where
952777ffbefca642d799990410a635b7963f87d7Robert Savu pretty = sidDoc . mkSimpleId . show
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty Vector3 where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder pretty v = hcat [text "V", lparen, sepByCommas $ map pretty [x v, y v, z v], rparen]
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty Vector4 where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder pretty v = hcat [text "Q", lparen, sepByCommas $ map pretty [q0 v, q1 v, q2 v, q3 v], rparen]
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty Placement where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder hcat [text "Placement", lparen, sepByCommas [pretty $ position p1, pretty $ orientation p1], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBO :: BaseObject -> Doc
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBO (Box h w l) = hcat [text "BBox", lparen, sepByCommas [pretty l, pretty w, pretty h], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBO (Cylinder a h r) = hcat [text "BCylinder" , lparen, sepByCommas [pretty a, pretty h, pretty r], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBO (Sphere a1 a2 a3 r) = hcat [text "BCylinder" , lparen, sepByCommas [pretty a1, pretty a2, pretty a3, pretty r], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBO (Cone a r1 r2 h) = hcat [text "BCone" , lparen, sepByCommas [pretty a, pretty r1, pretty r2, pretty h], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBO (Torus a1 a2 a3 r1 r2) = hcat [text "BTorus" , lparen, sepByCommas [pretty a1, pretty a2, pretty a3, pretty r1, pretty r2], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBO (Line a) = hcat [text "BLine" , lparen, pretty a, rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBO (Circle sa ea r) = hcat [text "BCircle" , lparen, sepByCommas [pretty sa, pretty ea, pretty r], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintBO (Rectangle h w) = hcat [text "BRectangle" , lparen, sepByCommas [pretty h, pretty w], rparen]
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty BaseObject where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder pretty = printBO
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintObject :: Object -> Doc
952777ffbefca642d799990410a635b7963f87d7Robert SavuprintObject (BaseObject bo) = pretty bo
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintObject ( Cut eo1 eo2) = text "Cut" <+> hcat [lparen, sepByCommas [pretty eo1, pretty eo2], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintObject ( Common eo1 eo2) = text "Common" <+> hcat [lparen, sepByCommas [pretty eo1, pretty eo2], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintObject ( Fusion eo1 eo2) = text "Fusion" <+> hcat [lparen, sepByCommas [pretty eo1, pretty eo2], rparen]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- printObject ( Section eo1 eo2) = text "Section" <+> brackets $ sepByCommas [pretty eo1, pretty eo2]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintObject ( Extrusion eo d) = text "Extrusion" <+> hcat [lparen, sepByCommas [pretty eo, pretty d], rparen]
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty Object where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder pretty = printObject
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintEO :: ExtendedObject -> Doc
952777ffbefca642d799990410a635b7963f87d7Robert SavuprintEO (Placed po) = pretty po
952777ffbefca642d799990410a635b7963f87d7Robert SavuprintEO (Ref s) = text s
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintPO :: PlacedObject -> Doc
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintPO (PlacedObject plc obj) = text "PObj = " <+> hcat [text "PObj", lparen, sepByCommas [pretty obj, pretty plc], rparen, text ";"]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintDoc :: String -> Document -> Doc
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von SchroederprintDoc name a = vcat [header, vcat [text " ops", hcat [text " ", vcat $ map pretty a]], end]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder header = vcat [logic, imports, specname]
952777ffbefca642d799990410a635b7963f87d7Robert Savu logic = text "logic HasCASL"
952777ffbefca642d799990410a635b7963f87d7Robert Savu imports = text "from HasCASL/Real3D/FreeCAD/FreeCAD get FCObject"
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder specname = hcat [text "spec ", text name, text " = FCObject ", text "then"]
952777ffbefca642d799990410a635b7963f87d7Robert Savu end = text "end"
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty ExtendedObject where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder pretty = printEO
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty PlacedObject where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder pretty = printPO
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty NamedObject where
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder pretty no = hcat [pretty (name no), colon, pretty $ object no]
3d3889e0cefcdce9b3f43c53aaa201943ac2e895Jonathan von Schroeder-- instance GetRange NamedObject
952777ffbefca642d799990410a635b7963f87d7Robert Savuinstance Pretty Sign where
952777ffbefca642d799990410a635b7963f87d7Robert Savu pretty = pretty . objects