--- /dev/null
+include "Simantics/Model"\r
+include "Simantics/WorkbenchSelection"\r
+include "Simantics/Library"\r
+include "File"\r
+import "Simantics/GUID" as GUID\r
+\r
+import "http://www.simantics.org/Layer0-1.1" as L0\r
+import "http://www.simantics.org/Diagram-2.2" as DIA\r
+import "http://www.simantics.org/G2D-1.1" as G2D\r
+import "http://www.simantics.org/Modeling-1.2" as MOD\r
+import "http://www.simantics.org/Simulation-1.1" as SIMU\r
+import "http://www.simantics.org/Structural-1.2" as STR\r
+\r
+// --- Entity types -------------------------------------------------\r
+\r
+type Diagram = Resource\r
+type DiagramFolder = Resource\r
+type Component = Resource\r
+type Element = Resource\r
+type ComponentType = Resource\r
+type Terminal = Resource\r
+type Connection = Resource\r
+type ConnectionType = Resource\r
+\r
+// --- Position -----------------------------------------------------\r
+\r
+data Position = Position Double Double Double Double Double Double\r
+\r
+deriving instance Show Position\r
+\r
+location :: Double -> Double -> Position\r
+location x y = Position 1 0 0 1 x y\r
+\r
+move :: (Double,Double) -> Position -> Position\r
+move (dx,dy) (Position xx xy yx yy x y) = Position xx xy yx yy (x+dx) (y+dy)\r
+\r
+rotate :: Integer -> Position -> Position\r
+rotate angle (Position xx xy yx yy x y) =\r
+ Position (c*xx + s*xy) (c*xy - s*xx)\r
+ (c*yx + s*yy) (c*yy - s*yx)\r
+ x y\r
+ where\r
+ a = if angle < 0 \r
+ then (angle `mod` 4) + 4\r
+ else angle `mod` 4\r
+ s = match a with 1 -> 1.0 ; 3 -> -1.0 ; _ -> 0.0\r
+ c = match a with 0 -> 1.0 ; 2 -> -1.0 ; _ -> 0.0\r
+\r
+scale :: Double -> Position -> Position\r
+scale s (Position xx xy yx yy x y) = Position (s*xx) (s*xy) (s*yx) (s*yy) x y\r
+\r
+flipX :: Position -> Position\r
+flipX (Position xx xy yx yy x y) = Position (-xx) xy (-yx) yy x y \r
+\r
+flipY :: Position -> Position\r
+flipY (Position xx xy yx yy x y) = Position xx (-xy) yx (-yy) x y\r
+\r
+positionToDoubleArray (Position a b c d e f) = toDoubleArray [a,b,c,d,e,f]\r
+\r
+// --- Diagram element data types -----------------------------------\r
+\r
+data Property res = Property res Dynamic\r
+instance (Show res) => Show (Property res) where\r
+ show (Property r _) = "Property " + show r \r
+\r
+data Edge = Edge Integer Integer\r
+deriving instance Show Edge\r
+data ConnectionNode res = Terminal String res\r
+ | RouteLine\r
+ Boolean // is horizontal \r
+ Double // position\r
+deriving instance (Show res) => Show (ConnectionNode res)\r
+\r
+data Font = Font String Integer Integer\r
+deriving instance Show Font\r
+\r
+data Alignment =\r
+ Baseline\r
+ | Center\r
+ | Leading\r
+ | Trailing\r
+deriving instance Show Alignment\r
+\r
+resourceToAlignment res = match (possibleNameOf res) with\r
+ Just "Baseline" -> Baseline\r
+ Just "Center" -> Center\r
+ Just "Leading" -> Leading\r
+ Just "Trailing" -> Trailing\r
+ _ -> fail ("Couldn't convert " + show res + " to Alignment.")\r
+\r
+alignmentToResource Baseline = G2D.Alignment.Baseline\r
+alignmentToResource Center = G2D.Alignment.Center\r
+alignmentToResource Leading = G2D.Alignment.Leading\r
+alignmentToResource Trailing = G2D.Alignment.Trailing\r
+\r
+data MonitorReference = MonitorReference String String\r
+deriving instance Show MonitorReference\r
+\r
+data MonitorVisuals = MonitorVisuals (Maybe Font) Double Alignment Alignment\r
+deriving instance Show MonitorVisuals\r
+\r
+data TextVisuals = TextVisuals (Maybe Font) Alignment Alignment\r
+deriving instance Show TextVisuals\r
+\r
+data DiagramElement res = \r
+ Component\r
+ res // component type\r
+ String // name\r
+ Position // position\r
+ [Property res] // properties\r
+ | SimpleConnection String res String res (Maybe String)\r
+ | Connection [ConnectionNode res] [Edge] (Maybe String)\r
+ | Flag \r
+ res \r
+ String // name \r
+ String // label\r
+ Boolean // output\r
+ Boolean // external\r
+ (Maybe String) // IOTableBinding\r
+ (Maybe Integer) // IOTableRowIndex\r
+ Position // position \r
+ [Dynamic] // references to the joins\r
+ | SVG String Position\r
+ | Monitor String (Maybe MonitorReference) MonitorVisuals Position\r
+ | Text\r
+ Resource // element type\r
+ String // Text shown by the element\r
+ TextVisuals // text element visual attributes\r
+ Position // position on diagram\r
+deriving instance (Show res) => Show (DiagramElement res)\r
+\r
+// --- Functions ----------------------------------------------------\r
+\r
+"""Creates a random GUID L0.identifier property for the specified entity resource.""" \r
+@private\r
+hasRandomIdentifier :: Resource -> <ReadGraph,WriteGraph> ()\r
+hasRandomIdentifier entity = runProc (claimRelatedValue_ entity L0.identifier GUID.randomGUID GUID.guidBinding)\r
+\r
+"""Returns all diagrams of the given model."""\r
+diagramsOf :: Model -> <ReadGraph> [Diagram]\r
+diagramsOf model = recurse\r
+ DIA.Diagram \r
+ (toResource (configurationOf model))\r
+ where\r
+ recurse t r = do\r
+ cs = resourceChildrenOf r \r
+ dias = map fromResource $ filter isDiagramComposite cs\r
+ folders = filter (not . isDiagramComposite) cs\r
+ dias + concatMap (recurse t) folders\r
+ isDiagramComposite r = existsStatement r MOD.CompositeToDiagram\r
+\r
+"""Returns a model relative path of the given diagram."""\r
+pathOf :: Diagram -> <ReadGraph> [String]\r
+pathOf diagram = map nameOf $ unfoldl aux $ toResource diagram\r
+ where\r
+ aux r = if existsStatement r SIMU.IsConfigurationOf\r
+ then Nothing\r
+ else do\r
+ parents = r # L0.PartOf\r
+ if length parents == 1\r
+ then Just (r, parents!0)\r
+ else Nothing\r
+ nameOf r = relatedValue r $ L0.HasName\r
+\r
+pathNameOf :: Diagram -> <ReadGraph> String\r
+pathNameOf diagram = do\r
+ path = pathOf diagram\r
+ foldl1 (\s s1 -> s + " / " + s1) path\r
+\r
+// @Private?\r
+diagramResourceOf :: Diagram -> <ReadGraph> Resource\r
+diagramResourceOf d = singleObject (toResource d) MOD.CompositeToDiagram\r
+\r
+import "Extras/HashMap" as Map\r
+\r
+"""Constructs a transformation for a diagram element."""\r
+mapDiagramElement :: (a -> <e> b) -> (a -> <e> b) -> (a -> <e> Maybe b) -> (a -> <e> b) -> DiagramElement a -> <e> DiagramElement b\r
+mapDiagramElement mapComponentType mapTerminal mapAttribute mapFlagType diagramElement =\r
+ (match diagramElement with\r
+ Component componentType name position properties -> do\r
+ Component (mapComponentType componentType) name position\r
+ (filterJust (map mapProperty properties))\r
+ SimpleConnection e1 r1 e2 r2 possibleName ->\r
+ SimpleConnection e1 (mapTerminal r1) e2 (mapTerminal r2) possibleName\r
+ Connection nodes edges possibleName ->\r
+ Connection\r
+ (map mapConnectionNode nodes)\r
+ edges possibleName\r
+ Flag t e e2 e3 e4 e5 p p2 joins -> Flag (mapFlagType t) e e2 e3 e4 e5 p p2 joins\r
+ SVG d p -> SVG d p\r
+ Monitor label ref visuals position -> Monitor label ref visuals position\r
+ Text elementType text visuals position -> Text elementType text visuals position\r
+) where\r
+ mapProperty (Property p v) = \r
+ match (mapAttribute p) with\r
+ Just mp -> Just (Property mp v)\r
+ Nothing -> Nothing\r
+ mapConnectionNode (Terminal e r) = Terminal e (mapTerminal r)\r
+ mapConnectionNode (RouteLine iv p) = RouteLine iv p\r
+\r
+importJava "org.simantics.structural2.utils.StructuralUtils" where\r
+ @JavaName newComponent\r
+ createComposite_ :: Resource -> String -> Resource -> <WriteGraph> Resource \r
+\r
+data DiagramSpec = NewDiagram \r
+ Model // root \r
+ [String] // path to the diagram\r
+ Resource // folder type \r
+ Resource // composite type\r
+ | ExistingDiagram Diagram\r
+\r
+compositeToDiagram' c = singleObject c MOD.CompositeToDiagram\r
+\r
+"""Creates or modifies an existing diagram to contain the given diagram elements.""" \r
+createDiagramR :: DiagramSpec -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <WriteGraph> (Diagram, [Resource])\r
+createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do\r
+ configuration = toResource diagram'\r
+ diagram = compositeToDiagram' configuration\r
+ hasName = L0.HasName\r
+ componentMap = Map.fromList [ (c `relatedValue` hasName :: String, c)\r
+ | c <- resourceChildrenOf configuration\r
+ ]\r
+ denyByPredicate diagram L0.ConsistsOf\r
+ elements = setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs\r
+ claimRelatedValue diagram DIA.HasModCount \r
+ (fromInteger (length elements) :: Long)\r
+ (diagram', elements)\r
+\r
+createDiagramR (NewDiagram model path folderType compositeType) joinMap elementSpecs = (runProc do\r
+ configuration = createConfiguration () \r
+ diagram = compositeToDiagram' configuration\r
+ elements = setElements (DiagramInfo diagram configuration (Map.create ())) joinMap elementSpecs\r
+ claimRelatedValue diagram DIA.HasModCount \r
+ (fromInteger (length elements) :: Long)\r
+ (fromResource configuration, elements)\r
+) where\r
+ createConfiguration () = do\r
+ lastId = length path - 1\r
+ parentFolder = foldl (\p id -> getOrCreateFolder p (path!id)) \r
+ (toResource (configurationOf model)) \r
+ [0..lastId-1] \r
+ createComposite_ parentFolder (path!lastId) compositeType\r
+ getOrCreateFolder parentFolder name =\r
+ match possibleResourceChild parentFolder name with\r
+ Just child -> child\r
+ Nothing ->\r
+ createComposite_ parentFolder name folderType\r
+\r
+claimFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource\r
+claimFolder model path folderType = do\r
+ lastId = length path\r
+ foldl (\p id -> getOrCreateFolder p folderType (path!id)) \r
+ (toResource (configurationOf model)) \r
+ [0..lastId-1]\r
+\r
+claimModelFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource\r
+claimModelFolder model path folderType = do\r
+ lastId = length path\r
+ foldl (\p id -> getOrCreateFolder p folderType (path!id)) \r
+ (toResource model) \r
+ [0..lastId-1] \r
+\r
+getOrCreateFolder :: Resource -> Resource -> String -> <Proc,WriteGraph> Resource\r
+getOrCreateFolder parentFolder folderType name = do\r
+ match possibleResourceChild parentFolder name with\r
+ Just child -> child\r
+ Nothing ->\r
+ createComposite_ parentFolder name folderType\r
+\r
+relatedValueWithDefault :: Serializable a => a -> Resource -> Resource -> <ReadGraph> a\r
+relatedValueWithDefault def r p =\r
+ if existsStatement r p\r
+ then relatedValue r p\r
+ else def\r
+\r
+applyConnectionType :: Resource -> <Proc,WriteGraph,ReadGraph> ()\r
+applyConnectionType res = do\r
+ t = determineConnectionType res\r
+ match t with\r
+ Just t -> claim res STR.HasConnectionType t\r
+ Nothing -> print ("No connection type " + (show res))\r
+ () \r
+\r
+importJava "org.simantics.modeling.utils.JoinMap" where\r
+ @JavaName "<init>"\r
+ createJoinMap :: () -> <Proc> (Dynamic -> <WriteGraph> Resource)\r
+ \r
+/*\r
+createJoin :: (Dynamic -> <WriteGraph> Resource) -> Dynamic -> <Proc,WriteGraph> Resource\r
+createJoin joinMap key = if Map.contains joinMap key\r
+ then Map.unsafeGet joinMap key\r
+ else do\r
+ j = newEntity [\r
+ hasType STR.ConnectionJoin\r
+ ]\r
+ Map.put joinMap key j \r
+ j\r
+*/\r
+data DiagramInfo = DiagramInfo\r
+ Resource // diagram\r
+ Resource // configuration\r
+ (Map.T String Resource) // existing components\r
+\r
+"""\r
+Sets the elements of the diagram. Diagram is assumed to be empty,\r
+but the configuration may contain existing components that can be found\r
+from the given existing components map.\r
+"""\r
+setElements :: DiagramInfo -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <Proc,WriteGraph> [Resource]\r
+setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs = (do\r
+ /*elements = map createElement (filter (not . isConnection) elementSpecs)\r
+ + map createElement (filter isConnection elementSpecs)*/\r
+ elements = mapMaybe createElement elementSpecs\r
+ for elements \r
+ (claim diagram L0.ConsistsOf)\r
+ setOrderedSet diagram elements\r
+ iter applyConnectionType (filter isConnectionResource elements)\r
+ syncActivateOnce diagram\r
+ for (zip elementSpecs elements) setConnectionName\r
+ elements\r
+) where\r
+ elementMap = Map.create ()\r
+ idRef = ref (0 :: Integer)\r
+\r
+ isConnectionResource r = isInstanceOf r DIA.Connection\r
+ isConnection (Connection _ _ _) = True\r
+ isConnection (SimpleConnection _ _ _ _ _) = True\r
+ isConnection _ = False\r
+\r
+ freshElementName () = do\r
+ id = getRef idRef\r
+ idRef := id + 1\r
+ show id\r
+ createElement (Component componentType name position properties) = do\r
+ component = if Map.contains componentMap name \r
+ then Map.unsafeGet componentMap name \r
+ else newEntity [\r
+ hasName name,\r
+ hasParent configuration,\r
+ hasRandomIdentifier\r
+ ]\r
+ for properties (\(Property prop value) ->\r
+ untypedClaimRelatedValue component prop value\r
+ )\r
+ element = newOrMappedElement name \r
+ element = updateEntity element [\r
+ hasName (freshElementName ()),\r
+ hasType componentType,\r
+ hasTypedProperty \r
+ DIA.HasTransform\r
+ (positionToDoubleArray position)\r
+ G2D.Transform,\r
+ hasStatement \r
+ MOD.ElementToComponent\r
+ component\r
+ ]\r
+ Map.put elementMap name element\r
+ Just element\r
+ newOrMappedElement eName = do\r
+ element = match Map.get elementMap eName with\r
+ Just element -> element\r
+ Nothing -> newEntity []\r
+ Map.put elementMap eName element\r
+ element\r
+ createElement (SimpleConnection aName ar bName br _) = do\r
+ connection = newEntity [\r
+ hasName (freshElementName ()),\r
+ hasType DIA.RouteGraphConnection\r
+ ]\r
+ a = newOrMappedElement aName\r
+ b = newOrMappedElement bName\r
+ ca = createConnector connection a ar\r
+ cb = createConnector connection b br\r
+ connectNodes ca cb\r
+ Just connection\r
+ createElement (Flag t name label output external tableBinding tableRow position joins) = do\r
+ flag = newOrMappedElement name \r
+ flag = updateEntity flag [\r
+ hasName (freshElementName ()),\r
+ hasLabel label,\r
+ hasType t,\r
+ hasTypedProperty \r
+ DIA.HasTransform\r
+ (positionToDoubleArray position)\r
+ G2D.Transform,\r
+ hasPossibleProperty \r
+ DIA.Flag.HasIOTableBinding\r
+ tableBinding,\r
+ hasPossibleProperty \r
+ DIA.Flag.HasIOTableRowIndex\r
+ tableRow\r
+ ]\r
+ iter (\jRef -> claim\r
+ (joinMap jRef)\r
+ DIA.JoinsFlag\r
+ flag\r
+ ) \r
+ joins\r
+ if output \r
+ then do\r
+ claim flag DIA.HasFlagType DIA.FlagType.OutputFlag\r
+ else ()\r
+ if external \r
+ then do\r
+ claim flag DIA.ExternalFlag flag\r
+ else ()\r
+ Map.put elementMap name flag\r
+ Just flag\r
+ createElement (Connection nodeSpecs edges _) = do\r
+ connection = newEntity [\r
+ hasName (freshElementName ()),\r
+ hasType DIA.RouteGraphConnection\r
+ ]\r
+ \r
+ nodes = map (createNode connection) nodeSpecs\r
+ for edges (\(Edge a b) -> connectNodes (nodes!a) (nodes!b))\r
+ Just connection\r
+ createNode connection (Terminal elementName terminal) = do\r
+ element = newOrMappedElement elementName\r
+ createConnector connection element terminal \r
+ createNode connection (RouteLine isHorizontal position) = do\r
+ newEntity [\r
+ hasName (freshElementName ()),\r
+ hasType DIA.RouteLine,\r
+ hasProperty DIA.HasPosition\r
+ position,\r
+ hasProperty DIA.IsHorizontal\r
+ isHorizontal,\r
+ hasStatement DIA.HasInteriorRouteNode.Inverse\r
+ connection\r
+ ]\r
+ createConnector connection component terminal = do\r
+ connector = newResource ()\r
+ claim connector\r
+ L0.InstanceOf\r
+ DIA.Connector\r
+ claim component terminal connector\r
+ claim connection \r
+ DIA.HasPlainConnector \r
+ connector\r
+ connector\r
+ connectNodes a b = \r
+ claim a DIA.AreConnected b\r
+ createElement (SVG document position) =\r
+ Just $ newEntity [\r
+ hasName (freshElementName ()),\r
+ hasType DIA.SVGElement,\r
+ hasProperty \r
+ G2D.HasSVGDocument\r
+ document,\r
+ hasTypedProperty \r
+ DIA.HasTransform\r
+ (positionToDoubleArray position)\r
+ G2D.Transform\r
+ ]\r
+ createRealizedFont (Font family size style) = do\r
+ font = newResource ()\r
+ claim font\r
+ L0.InstanceOf\r
+ DIA.RealizedFont\r
+ claimRelatedValue font DIA.RealizedFont.HasFamily family\r
+ claimRelatedValue font DIA.RealizedFont.HasSize size\r
+ claimRelatedValue font DIA.RealizedFont.HasStyle style\r
+ font\r
+ hasFont (Just font) = hasStatement DIA.HasFont (createRealizedFont font)\r
+ hasFont Nothing = const ()\r
+ createElement (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) position) = do\r
+ Just $ newEntity [\r
+ hasName (freshElementName ()),\r
+ hasType DIA.Monitor,\r
+ hasProperty \r
+ L0.HasLabel\r
+ label,\r
+ hasTypedProperty \r
+ DIA.HasTransform\r
+ (positionToDoubleArray position)\r
+ G2D.Transform,\r
+ hasTypedProperty \r
+ G2D.HasStrokeWidth\r
+ strokeWidth\r
+ L0.Double,\r
+ hasStatement \r
+ G2D.HasHorizontalAlignment\r
+ (alignmentToResource hAlign),\r
+ hasStatement \r
+ G2D.HasVerticalAlignment\r
+ (alignmentToResource vAlign),\r
+ hasFont font\r
+ ]\r
+ createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do\r
+ match (Map.get elementMap componentName) with\r
+ Nothing -> Nothing // Monitored component is not on the same diagram as the monitor. Not supported by this routine.\r
+ Just element -> do\r
+ component = singleObject element MOD.ElementToComponent\r
+ Just $ newEntity [\r
+ hasName (freshElementName ()),\r
+ hasType DIA.Monitor,\r
+ hasProperty \r
+ L0.HasLabel\r
+ label,\r
+ hasProperty \r
+ DIA.HasMonitorSuffix\r
+ suffix,\r
+ hasStatement DIA.HasMonitorComponent component,\r
+ hasTypedProperty \r
+ DIA.HasTransform\r
+ (positionToDoubleArray position)\r
+ G2D.Transform,\r
+ hasTypedProperty \r
+ G2D.HasStrokeWidth\r
+ strokeWidth\r
+ L0.Double,\r
+ hasStatement \r
+ G2D.HasHorizontalAlignment\r
+ (alignmentToResource hAlign),\r
+ hasStatement \r
+ G2D.HasVerticalAlignment\r
+ (alignmentToResource vAlign),\r
+ hasFont font\r
+ ]\r
+ createElement (Text elementType text (TextVisuals font hAlign vAlign) position) =\r
+ Just $ newEntity [\r
+ hasName (freshElementName ()),\r
+ hasType elementType,\r
+ hasProperty \r
+ DIA.HasText\r
+ text,\r
+ hasTypedProperty \r
+ DIA.HasTransform\r
+ (positionToDoubleArray position)\r
+ G2D.Transform,\r
+ hasStatement \r
+ G2D.HasHorizontalAlignment\r
+ (alignmentToResource hAlign),\r
+ hasStatement \r
+ G2D.HasVerticalAlignment\r
+ (alignmentToResource vAlign),\r
+ hasFont font\r
+ ]\r
+ setConnectionName (Connection _ _ (Just name), element) = \r
+ match possibleObject element MOD.ElementToComponent with\r
+ Just c -> claimRelatedValue c L0.HasName name\r
+ Nothing -> print ("Failed to set the name of the connection '" + name + "'.")\r
+ setConnectionName (SimpleConnection _ _ _ _ (Just name), element) = \r
+ match possibleObject element MOD.ElementToComponent with\r
+ Just c -> claimRelatedValue c L0.HasName name\r
+ Nothing -> print ("Failed to set the name of the connection '" + name + "'.")\r
+ setConnectionName (Flag _ name _ _ _ _ _ _ _, element) =\r
+ match possibleObject element MOD.ElementToComponent with\r
+ Just c -> claimRelatedValue c L0.HasName name\r
+ Nothing -> () // This is a typical case\r
+ setConnectionName _ = ()\r
+\r
+"""Returns a diagram in the given model with the given model relative path.""" \r
+diagram :: Model -> [String] -> <ReadGraph> Diagram\r
+diagram model path = \r
+ fromResource $ foldl \r
+ (\r name -> match possibleResourceChild r name with\r
+ Just c -> c\r
+ Nothing -> fail ("Didn't find " + name + ".") \r
+ ) \r
+ (toResource (configurationOf model)) path\r
+\r
+possibleDiagram :: Model -> [String] -> <ReadGraph> (Maybe Diagram)\r
+possibleDiagram model path = \r
+ map fromResource (foldl\r
+ (\r name -> match r with\r
+ Just p -> possibleResourceChild p name\r
+ Nothing -> Nothing \r
+ ) \r
+ (Just $ toResource (configurationOf model)) path)\r
+\r
+/*\r
+"""FIXME: doesn't work anymore with the elementsOfR spec\r
+elementsOf :: Diagram -> <ReadGraph> [DiagramElement String]\r
+elementsOf diagram = map (mapDiagramElement nameOf mapTerminal possibleNameOf nameOf)\r
+ $ elementsOfR diagram\r
+ where\r
+ nameOf r = relatedValue r L0.HasName\r
+ mapTerminal r = do\r
+ name = nameOf r\r
+ if name == "ConnectionPoint" &&\r
+ r == DIA.Flag.ConnectionPoint\r
+ then "FlagTerminal"\r
+ else name\r
+*/\r
+\r
+"""Returns the elements of the given diagram.""" \r
+elementsOfR :: Diagram -> <ReadGraph> [(DiagramElement Resource, Resource)]\r
+elementsOfR diagram = filterJust $ map readElement' \r
+ (diagramResourceOf diagram # L0.ConsistsOf)\r
+ where\r
+ readElement' element = match readElement element with\r
+ Just el -> Just (el, element)\r
+ Nothing -> Nothing\r
+ readElement element =\r
+ if element `isInstanceOf` DIA.Flag\r
+ then readFlag element\r
+ else if element `isInstanceOf` DIA.SVGElement\r
+ then readSVG element\r
+ else if element `isInstanceOf` DIA.Monitor\r
+ then readMonitor element\r
+ else if element `isInstanceOf` DIA.RouteGraphConnection\r
+ then readConnection element\r
+ else if element `isInstanceOf` DIA.TextElement\r
+ then readText element\r
+ else if element `isInstanceOf` DIA.Element\r
+ then readComponent element\r
+ else Nothing\r
+ readFlag flag = Just $ Flag\r
+ (singleTypeOf \r
+ flag \r
+ DIA.Flag)\r
+ (idOf flag) \r
+ (labelOf flag)\r
+ (existsStatement3 flag DIA.HasFlagType DIA.FlagType.OutputFlag)\r
+ (existsStatement flag DIA.ExternalFlag)\r
+ ((possibleRelatedString flag DIA.Flag.HasIOTableBinding) :: (Maybe String))\r
+ ((possibleRelatedInteger flag DIA.Flag.HasIOTableRowIndex) :: (Maybe Integer))\r
+ (transformOf flag)\r
+ (map toDynamic $ flag # DIA.FlagIsJoinedBy)\r
+ readComponent element = do\r
+ component = singleObject \r
+ element \r
+ MOD.ElementToComponent\r
+ Just (Component \r
+ (singleTypeOf \r
+ element \r
+ DIA.Element)\r
+ (nameOf component) \r
+ (transformOf element)\r
+ (readAttributes component))\r
+ readSVG element = do\r
+ Just (SVG \r
+ (relatedValue element G2D.HasSVGDocument) \r
+ (transformOf element)\r
+ )\r
+ readMonitor element = do\r
+ font = readFont element (singleObject element DIA.HasFont)\r
+ hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)\r
+ vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)\r
+ label = (relatedValue2 element L0.HasLabel)\r
+ strokeWidth = relatedValueWithDefault (-1.0) element G2D.HasStrokeWidth \r
+ transform = (transformOf element) \r
+ match (existsStatement element DIA.HasMonitorSuffix) with\r
+ True -> do\r
+ suffix = (relatedValue element DIA.HasMonitorSuffix)\r
+ monitorComponent = (singleObject element DIA.HasMonitorComponent)\r
+ componentName = relatedValue monitorComponent L0.HasName\r
+ Just (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) transform) \r
+ False -> Just (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) transform)\r
+ readText element = do\r
+ elementType = singleTypeOf element DIA.Element\r
+ font = readPossibleFont element \r
+ hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)\r
+ vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)\r
+ text = relatedValueWithDefault "" element DIA.HasText \r
+ transform = (transformOf element)\r
+ Just (Text elementType text (TextVisuals font hAlign vAlign) transform)\r
+ readPossibleFont element =\r
+ match possibleObject element DIA.HasFont with\r
+ Just f -> readFont element f\r
+ Nothing -> Nothing\r
+ readFont element font = do\r
+ if font `isInstanceOf` DIA.RealizedFont\r
+ then do\r
+ family = (relatedValue font DIA.RealizedFont.HasFamily)\r
+ size = (relatedValue font DIA.RealizedFont.HasSize)\r
+ style = (relatedValue font DIA.RealizedFont.HasStyle)\r
+ Just (Font family size style)\r
+ else Nothing\r
+ readAttributes component = let\r
+ allPredicates = map objectOf (statements (singleTypeOf component L0.Entity) L0.DomainOf)\r
+ is p = isSubrelationOf p L0.HasProperty\r
+ hasPropertyPredicates = filter is allPredicates\r
+ propertyStatements = map (singleStatement component) hasPropertyPredicates\r
+ p stm = match (untypedPossibleValueOf (objectOf stm)) with\r
+ Just v -> Just (Property (predicateOf stm) v)\r
+ _ -> Nothing\r
+ in mapMaybe p propertyStatements\r
+ \r
+ readConnection element = do\r
+ connectors = element # DIA.HasConnector\r
+ routeLines = element # DIA.HasInteriorRouteNode\r
+ nodes = map (readConnector element) connectors\r
+ + map readRouteLine routeLines\r
+ \r
+ nodeResources = connectors + routeLines\r
+ nodeResourceWithIds = zip nodeResources [0..length nodeResources-1]\r
+ edges = runProc do\r
+ rMap = Map.fromList nodeResourceWithIds\r
+ edgesOf (node,i) = \r
+ [ Edge i j\r
+ | r <- node # DIA.AreConnected\r
+ , j = Map.unsafeGet rMap r\r
+ , j > i ]\r
+ concatMap edgesOf nodeResourceWithIds\r
+ \r
+ Just $ Connection nodes edges (readConnectionName element)\r
+ readConnectionName element = \r
+ match possibleObject element MOD.ElementToComponent with\r
+ Just c -> possibleNameOf c\r
+ Nothing -> Nothing\r
+ readConnector connection r = Terminal\r
+ (idOf $ objectOf stat)\r
+ (inverseOf $ predicateOf stat)\r
+ where\r
+ stat = [ stat\r
+ | stat <- statements r STR.Connects\r
+ , objectOf stat != connection \r
+ ]!0\r
+ readRouteLine r = RouteLine\r
+ (relatedValue r DIA.IsHorizontal) \r
+ (relatedValue r DIA.HasPosition)\r
+ transformOf element = do \r
+ da = fromDoubleArray $\r
+ relatedValue element DIA.HasTransform\r
+ Position (da!0) (da!1) (da!2) (da!3) (da!4) (da!5)\r
+ nameOf r = relatedValue r L0.HasName\r
+ labelOf r = relatedValue2 r L0.HasLabel\r
+ idOf r = match possibleObject r MOD.ElementToComponent with\r
+ Just c -> nameOf c\r
+ Nothing -> if r `isInstanceOf` DIA.Flag\r
+ then "FLAG_" + nameOf r\r
+ else fail ("Element " + show r + " was not mapped to a component.")\r
+\r
+importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where\r
+ """Takes one connection element and returns possible diagram type.""" \r
+ determineConnectionType :: Resource -> <ReadGraph> Maybe Resource\r
+ \r
+ rotateConnection :: Resource -> Double -> Double -> Boolean -> <WriteGraph> ()\r
+ flipConnection :: Resource -> Boolean -> Double -> <WriteGraph> () \r
+\r
+applyDiagramMapping :: Resource -> <Proc,WriteGraph> ()\r
+applyDiagramMapping diagram = do\r
+ syncActivateOnce diagram\r
+ ()\r
+\r
+"""Returns the diagram flag type resource used for all generic diagram flags."""\r
+genericFlagType :: () -> <ReadGraph> Resource\r
+genericFlagType _ = DIA.Flag\r
+\r
+/* Use functions in Simantics/PageSettings\r
+importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where\r
+ @JavaName setPageBordersVisible\r
+ setPageBordersVisible :: Diagram -> Boolean -> <WriteGraph> ()\r
+ \r
+ @JavaName setMarginsVisible\r
+ setMarginsVisible :: Diagram -> Boolean -> <WriteGraph> ()\r
+*/\r
+importJava "org.simantics.modeling.typicals.TypicalUtil" where\r
+ @JavaName newMasterTypical\r
+ newTypicalDiagram :: Library -> Diagram\r
+\r
+ @JavaName syncTypicalInstance\r
+ syncTypicalInstance :: Resource -> <WriteGraph> ()\r
+ \r
+syncActivateDiagram :: Diagram -> <WriteGraph, Proc> Boolean\r
+syncActivateDiagram composite = do\r
+ diagram = compositeToDiagram' $ toResource composite\r
+ syncActivateOnce diagram\r
+ True\r
+\r
+// --- Diagrams ---------------------------------------------------\r
+\r
+importJava "org.simantics.structural2.utils.StructuralUtils" where\r
+ @JavaName newComponent\r
+ createComposite__ :: Configuration -> String -> Resource -> <WriteGraph> Diagram\r
+\r
+compositeToDiagram :: Resource -> <ReadGraph> Diagram\r
+compositeToDiagram c = fromResource (singleObject c MOD.CompositeToDiagram) \r
+\r
+createComposite :: Configuration -> String -> Resource -> <WriteGraph> Diagram\r
+createComposite diagramFolder name compositeType = do\r
+ newName = findFreshName name (toResource diagramFolder)\r
+ createComposite__ diagramFolder newName compositeType\r
+\r
+elementToComponent :: Element -> <ReadGraph> Component\r
+elementToComponent element = do\r
+ component = singleObject (toResource element) MOD.ElementToComponent\r
+ fromResource component\r
+ \r
+componentToElement :: Component -> <ReadGraph> Element\r
+componentToElement component = do\r
+ element = singleObject (toResource component) MOD.ComponentToElement\r
+ fromResource element\r
+\r
+getConnections :: Diagram -> <ReadGraph> [Resource]\r
+getConnections diagram = [object | object <- (toResource $ compositeToDiagram $ toResource diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection]\r
+\r
+getConnection :: Diagram -> String -> <ReadGraph> [Resource]\r
+getConnection diagram name = do\r
+ connections = getConnections diagram\r
+ filter (\x -> relatedValue2 x L0.HasName == name) connections\r
+\r
+setTransform :: Resource -> DoubleArray -> <WriteGraph> ()\r
+setTransform element transform = claimRelatedValueWithType element DIA.HasTransform G2D.Transform transform \r
+ \r
+importJava "org.simantics.modeling.svg.CreateSVGElement" where\r
+ createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> ()\r
+ \r
+ importSVGElement :: Resource -> File -> Double -> Double -> <WriteGraph> ()\r
+ \r
+importJava "org.simantics.diagram.synchronization.graph.RemoveElement" where\r
+ removeElement :: Resource -> Resource -> <WriteGraph> ()\r
+\r
+setStraightConnectionLines :: Resource -> Boolean -> <WriteGraph> ()\r
+setStraightConnectionLines element v =\r
+ for (element # STR.IsConnectedTo) $ \connector ->\r
+ claimRelatedValue connector DIA.Connector.straight v\r
+\r
+showProfileMonitors :: Resource -> Boolean -> <WriteGraph> ()\r
+showProfileMonitors element v = claimRelatedValue element DIA.Element.hideProfileMonitors (not v)\r
+\r
+setProfileMonitorsDirectionUp :: Resource -> Boolean -> <WriteGraph> ()\r
+setProfileMonitorsDirectionUp element v = claimRelatedValue element DIA.Element.upProfileMonitors v\r
+\r
+importJava "org.simantics.diagram.flag.Joiner" where\r
+ joinFlagsLocal :: [Resource] -> <WriteGraph> ()\r
+\r
+importJava "org.simantics.diagram.flag.RouteGraphConnectionSplitter" where\r
+ splitConnection :: Resource -> Double -> Double -> <WriteGraph> ()\r
+\r
+importJava "org.simantics.diagram.handler.CopyPasteUtil" where\r
+ moveConnection :: Resource -> Double -> Double -> <WriteGraph> ()\r
+\r
+importJava "org.simantics.diagram.content.ConnectionUtil" where\r
+ translateRouteNodes :: Resource -> Double -> Double -> <WriteGraph> ()\r
+ \r
+importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where\r
+ defaultSymbolDropHandler :: [WorkbenchSelectionElement] -> <WriteGraph> ()
\ No newline at end of file
Code Review / simantics / platform.git / blobdiff