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