X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=bundles%2Forg.simantics.modeling%2Fscl%2FSimantics%2FDiagram.scl;fp=bundles%2Forg.simantics.modeling%2Fscl%2FSimantics%2FDiagram.scl;h=93a60f3017df0d5d080bf4b181e29abd76f573a4;hp=0000000000000000000000000000000000000000;hb=969bd23cab98a79ca9101af33334000879fb60c5;hpb=866dba5cd5a3929bbeae85991796acb212338a08 diff --git a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl new file mode 100644 index 000000000..93a60f301 --- /dev/null +++ b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl @@ -0,0 +1,831 @@ +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] -> () \ No newline at end of file