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=2490acc5b916b52ccd6e05e8b26accfcf15abce8;hp=93a60f3017df0d5d080bf4b181e29abd76f573a4;hb=0ae2b770234dfc3cbb18bd38f324125cf0faca07;hpb=24e2b34260f219f0d1644ca7a138894980e25b14 diff --git a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl index 93a60f301..2490acc5b 100644 --- a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl +++ b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl @@ -1,831 +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 +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