-import "Simantics/DB" hiding (resourceId)\r
-import "Simantics/GShow"\r
-import "ArrayList" as ArrayList\r
-import "http://www.simantics.org/Layer0-1.1" as L0\r
-import "http://www.simantics.org/Structural-1.2" as STR\r
-import "http://www.simantics.org/Diagram-2.2" as DIA\r
-import "http://www.simantics.org/Modeling-1.2" as MOD\r
-\r
-importJava "org.simantics.modeling.scl.RouteGraphMatching" where\r
- matchRouteGraph :: [Resource] -> Integer -> [Integer] -> <ReadGraph> Maybe [Resource]\r
-\r
-data ConnectorIdentification =\r
- ConnectionPoint String // component name \r
- String // connection point name\r
- | Element String // element name\r
-\r
-deriving instance Show ConnectorIdentification\r
-\r
-"""\r
-The structure of the route graph.\r
-"""\r
-data RouteGraphStructure = RouteGraphStructure\r
- Resource // Composite\r
- [ConnectorIdentification] // Connectors\r
- Integer // Number of route lines\r
- [Integer] // Links between route nodes\r
-\r
-instance GShow RouteGraphStructure where\r
- gappend ctx sb (RouteGraphStructure composite connectors routeLineCount routeLinks) = do \r
- sb << "RouteGraphStructure "\r
- gappend ctx sb (Par 0 composite)\r
- sb << " " <+ connectors << " " <+ routeLineCount << " " <+ routeLinks\r
- graphPrecedence _ = 1\r
-\r
-@private\r
-@inline\r
-breakableFor :: [a] -> (a -> <e> Boolean) -> <e> Boolean\r
-breakableFor l f = loop 0\r
- where\r
- len = length l\r
- loop i | i < len = if f (l!i) then loop (i+1) else False\r
- | otherwise = True\r
-\r
-\r
-"""\r
-Finds connectors by given component and connection point names that\r
-belong to the same connection.\r
-"""\r
-@private\r
-resolveConnectors :: Resource -> Resource -> [ConnectorIdentification] -> <ReadGraph> Maybe (Resource, [Resource])\r
-resolveConnectors composite diagram descs = let\r
- findCandidateConnectors (ConnectionPoint componentName connectionPointName) =\r
- match possibleResourceChild composite componentName with\r
- Nothing -> []\r
- Just component -> match possibleObject component MOD.ComponentToElement with\r
- Nothing -> []\r
- Just element -> [ objectOf stat\r
- | stat <- statements element STR.IsConnectedTo\r
- , nameOf (predicateOf stat) == connectionPointName \r
- ]\r
- findCandidateConnectors (Element elementName) =\r
- match possibleResourceChild diagram elementName with\r
- Nothing -> []\r
- Just element -> element # STR.IsConnectedTo\r
- candidateConnectors = map findCandidateConnectors descs\r
- connections = foldl1 intersect (map (map (`singleObject` DIA.IsConnectorOf)) candidateConnectors)\r
- in if length connections != 1\r
- then Nothing\r
- else let connection = connections!0\r
- chooseCandidate l = filter (\r -> singleObject r DIA.IsConnectorOf == connection) l ! 0\r
- in Just (connection, map chooseCandidate candidateConnectors)\r
-\r
-"""\r
-Finds the resource encoding the route graph structure or Nothing\r
-if the structure does not match any route graph.\r
-"""\r
-@private\r
-resolveRouteGraph :: RouteGraphStructure -> <Proc,ReadGraph> Maybe (Resource, [Resource])\r
-resolveRouteGraph (RouteGraphStructure composite connectorDescs routeLineCount routeLinks) = \r
- match resolveConnectors composite (singleObject composite MOD.CompositeToDiagram) connectorDescs with \r
- Nothing -> Nothing\r
- Just (connection, connectors) -> map (\nodes -> (connection,nodes)) \r
- (matchRouteGraph connectors routeLineCount routeLinks)\r
-\r
-type RId = Integer\r
-\r
-"""\r
-Atomic modifications to route graph\r
-"""\r
-data RouteGraphModification =\r
- UpdateLine RId Double Boolean\r
- | RemoveLink RId RId\r
- | RemoveNode RId\r
- | CreateLink RId RId\r
- | CreateLine Double Boolean\r
-\r
-deriving instance Show RouteGraphModification\r
-instance GShow RouteGraphModification where\r
- gappend _ = (<+)\r
- graphPrecedence = precedence\r
-\r
-@private\r
-importJava "org.simantics.diagram.content.ConnectionUtil" where\r
- data ConnectionUtil\r
- \r
- @JavaName "<init>"\r
- createConnectionUtil :: <WriteGraph> ConnectionUtil\r
- \r
- removeConnectionPart :: ConnectionUtil -> Resource -> <WriteGraph> ()\r
-\r
-"""\r
-Executes one modification in the given connection with given connection node resources. May add a new route line \r
-to @resources@ array. \r
-"""\r
-@private\r
-executeAtomicModification :: Resource -> ArrayList.T Resource -> RouteGraphModification -> <Proc,WriteGraph> ()\r
-executeAtomicModification connection resources modi = match modi with\r
- UpdateLine a position isHorizontal -> do\r
- r = toR a\r
- claimRelatedValue r DIA.HasPosition position\r
- claimRelatedValue r DIA.IsHorizontal isHorizontal\r
- RemoveLink a b -> deny (toR a) DIA.AreConnected (toR b)\r
- RemoveNode a -> removeConnectionPart createConnectionUtil (toR a)\r
- //denyAllStatements (toR a)\r
- CreateLink a b -> claim (toR a) DIA.AreConnected (toR b)\r
- CreateLine position isHorizontal -> do\r
- r = newResource ()\r
- claim r L0.InstanceOf DIA.RouteLine \r
- claimRelatedValue r DIA.HasPosition position\r
- claimRelatedValue r DIA.IsHorizontal isHorizontal\r
- claim connection DIA.HasInteriorRouteNode r\r
- ArrayList.add resources r\r
- where\r
- toR id = ArrayList.get resources id\r
-\r
-modifyRouteGraph :: RouteGraphStructure -> [RouteGraphModification] -> <Proc,WriteGraph> [Resource]\r
-modifyRouteGraph structure modis = \r
- match resolveRouteGraph structure with\r
- Just (connection, nodes) -> do\r
- ra = ArrayList.fromList nodes\r
- for modis (executeAtomicModification connection ra)\r
- ArrayList.freeze ra\r
+import "Simantics/DB" hiding (resourceId)
+import "Simantics/GShow"
+import "ArrayList" as ArrayList
+import "http://www.simantics.org/Layer0-1.1" as L0
+import "http://www.simantics.org/Structural-1.2" as STR
+import "http://www.simantics.org/Diagram-2.2" as DIA
+import "http://www.simantics.org/Modeling-1.2" as MOD
+
+importJava "org.simantics.modeling.scl.RouteGraphMatching" where
+ matchRouteGraph :: [Resource] -> Integer -> [Integer] -> <ReadGraph> Maybe [Resource]
+
+data ConnectorIdentification =
+ ConnectionPoint String // component name
+ String // connection point name
+ | Element String // element name
+
+deriving instance Show ConnectorIdentification
+
+"""
+The structure of the route graph.
+"""
+data RouteGraphStructure = RouteGraphStructure
+ Resource // Composite
+ [ConnectorIdentification] // Connectors
+ Integer // Number of route lines
+ [Integer] // Links between route nodes
+
+instance GShow RouteGraphStructure where
+ gappend ctx sb (RouteGraphStructure composite connectors routeLineCount routeLinks) = do
+ sb << "RouteGraphStructure "
+ gappend ctx sb (Par 0 composite)
+ sb << " " <+ connectors << " " <+ routeLineCount << " " <+ routeLinks
+ graphPrecedence _ = 1
+
+@private
+@inline
+breakableFor :: [a] -> (a -> <e> Boolean) -> <e> Boolean
+breakableFor l f = loop 0
+ where
+ len = length l
+ loop i | i < len = if f (l!i) then loop (i+1) else False
+ | otherwise = True
+
+
+"""
+Finds connectors by given component and connection point names that
+belong to the same connection.
+"""
+@private
+resolveConnectors :: Resource -> Resource -> [ConnectorIdentification] -> <ReadGraph> Maybe (Resource, [Resource])
+resolveConnectors composite diagram descs = let
+ findCandidateConnectors (ConnectionPoint componentName connectionPointName) =
+ match possibleResourceChild composite componentName with
+ Nothing -> []
+ Just component -> match possibleObject component MOD.ComponentToElement with
+ Nothing -> []
+ Just element -> [ objectOf stat
+ | stat <- statements element STR.IsConnectedTo
+ , nameOf (predicateOf stat) == connectionPointName
+ ]
+ findCandidateConnectors (Element elementName) =
+ match possibleResourceChild diagram elementName with
+ Nothing -> []
+ Just element -> element # STR.IsConnectedTo
+ candidateConnectors = map findCandidateConnectors descs
+ connections = foldl1 intersect (map (map (`singleObject` DIA.IsConnectorOf)) candidateConnectors)
+ in if length connections != 1
+ then Nothing
+ else let connection = connections!0
+ chooseCandidate l = filter (\r -> singleObject r DIA.IsConnectorOf == connection) l ! 0
+ in Just (connection, map chooseCandidate candidateConnectors)
+
+"""
+Finds the resource encoding the route graph structure or Nothing
+if the structure does not match any route graph.
+"""
+@private
+resolveRouteGraph :: RouteGraphStructure -> <Proc,ReadGraph> Maybe (Resource, [Resource])
+resolveRouteGraph (RouteGraphStructure composite connectorDescs routeLineCount routeLinks) =
+ match resolveConnectors composite (singleObject composite MOD.CompositeToDiagram) connectorDescs with
+ Nothing -> Nothing
+ Just (connection, connectors) -> map (\nodes -> (connection,nodes))
+ (matchRouteGraph connectors routeLineCount routeLinks)
+
+type RId = Integer
+
+"""
+Atomic modifications to route graph
+"""
+data RouteGraphModification =
+ UpdateLine RId Double Boolean
+ | RemoveLink RId RId
+ | RemoveNode RId
+ | CreateLink RId RId
+ | CreateLine Double Boolean
+
+deriving instance Show RouteGraphModification
+instance GShow RouteGraphModification where
+ gappend _ = (<+)
+ graphPrecedence = precedence
+
+@private
+importJava "org.simantics.diagram.content.ConnectionUtil" where
+ data ConnectionUtil
+
+ @JavaName "<init>"
+ createConnectionUtil :: <WriteGraph> ConnectionUtil
+
+ removeConnectionPart :: ConnectionUtil -> Resource -> <WriteGraph> ()
+
+"""
+Executes one modification in the given connection with given connection node resources. May add a new route line
+to @resources@ array.
+"""
+@private
+executeAtomicModification :: Resource -> ArrayList.T Resource -> RouteGraphModification -> <Proc,WriteGraph> ()
+executeAtomicModification connection resources modi = match modi with
+ UpdateLine a position isHorizontal -> do
+ r = toR a
+ claimRelatedValue r DIA.HasPosition position
+ claimRelatedValue r DIA.IsHorizontal isHorizontal
+ RemoveLink a b -> deny (toR a) DIA.AreConnected (toR b)
+ RemoveNode a -> removeConnectionPart createConnectionUtil (toR a)
+ //denyAllStatements (toR a)
+ CreateLink a b -> claim (toR a) DIA.AreConnected (toR b)
+ CreateLine position isHorizontal -> do
+ r = newResource ()
+ claim r L0.InstanceOf DIA.RouteLine
+ claimRelatedValue r DIA.HasPosition position
+ claimRelatedValue r DIA.IsHorizontal isHorizontal
+ claim connection DIA.HasInteriorRouteNode r
+ ArrayList.add resources r
+ where
+ toR id = ArrayList.get resources id
+
+modifyRouteGraph :: RouteGraphStructure -> [RouteGraphModification] -> <Proc,WriteGraph> [Resource]
+modifyRouteGraph structure modis =
+ match resolveRouteGraph structure with
+ Just (connection, nodes) -> do
+ ra = ArrayList.fromList nodes
+ for modis (executeAtomicModification connection ra)
+ ArrayList.freeze ra
Nothing -> fail "Couldn't resolve route graph structure."
\ No newline at end of file
Code Review / simantics / platform.git / blobdiff