1 import "Simantics/DB" hiding (resourceId)
\r
2 import "Simantics/GShow"
\r
3 import "ArrayList" as ArrayList
\r
4 import "http://www.simantics.org/Layer0-1.1" as L0
\r
5 import "http://www.simantics.org/Structural-1.2" as STR
\r
6 import "http://www.simantics.org/Diagram-2.2" as DIA
\r
7 import "http://www.simantics.org/Modeling-1.2" as MOD
\r
9 importJava "org.simantics.modeling.scl.RouteGraphMatching" where
\r
10 matchRouteGraph :: [Resource] -> Integer -> [Integer] -> <ReadGraph> Maybe [Resource]
\r
12 data ConnectorIdentification =
\r
13 ConnectionPoint String // component name
\r
14 String // connection point name
\r
15 | Element String // element name
\r
17 deriving instance Show ConnectorIdentification
\r
20 The structure of the route graph.
\r
22 data RouteGraphStructure = RouteGraphStructure
\r
23 Resource // Composite
\r
24 [ConnectorIdentification] // Connectors
\r
25 Integer // Number of route lines
\r
26 [Integer] // Links between route nodes
\r
28 instance GShow RouteGraphStructure where
\r
29 gappend ctx sb (RouteGraphStructure composite connectors routeLineCount routeLinks) = do
\r
30 sb << "RouteGraphStructure "
\r
31 gappend ctx sb (Par 0 composite)
\r
32 sb << " " <+ connectors << " " <+ routeLineCount << " " <+ routeLinks
\r
33 graphPrecedence _ = 1
\r
37 breakableFor :: [a] -> (a -> <e> Boolean) -> <e> Boolean
\r
38 breakableFor l f = loop 0
\r
41 loop i | i < len = if f (l!i) then loop (i+1) else False
\r
46 Finds connectors by given component and connection point names that
\r
47 belong to the same connection.
\r
50 resolveConnectors :: Resource -> Resource -> [ConnectorIdentification] -> <ReadGraph> Maybe (Resource, [Resource])
\r
51 resolveConnectors composite diagram descs = let
\r
52 findCandidateConnectors (ConnectionPoint componentName connectionPointName) =
\r
53 match possibleResourceChild composite componentName with
\r
55 Just component -> match possibleObject component MOD.ComponentToElement with
\r
57 Just element -> [ objectOf stat
\r
58 | stat <- statements element STR.IsConnectedTo
\r
59 , nameOf (predicateOf stat) == connectionPointName
\r
61 findCandidateConnectors (Element elementName) =
\r
62 match possibleResourceChild diagram elementName with
\r
64 Just element -> element # STR.IsConnectedTo
\r
65 candidateConnectors = map findCandidateConnectors descs
\r
66 connections = foldl1 intersect (map (map (`singleObject` DIA.IsConnectorOf)) candidateConnectors)
\r
67 in if length connections != 1
\r
69 else let connection = connections!0
\r
70 chooseCandidate l = filter (\r -> singleObject r DIA.IsConnectorOf == connection) l ! 0
\r
71 in Just (connection, map chooseCandidate candidateConnectors)
\r
74 Finds the resource encoding the route graph structure or Nothing
\r
75 if the structure does not match any route graph.
\r
78 resolveRouteGraph :: RouteGraphStructure -> <Proc,ReadGraph> Maybe (Resource, [Resource])
\r
79 resolveRouteGraph (RouteGraphStructure composite connectorDescs routeLineCount routeLinks) =
\r
80 match resolveConnectors composite (singleObject composite MOD.CompositeToDiagram) connectorDescs with
\r
82 Just (connection, connectors) -> map (\nodes -> (connection,nodes))
\r
83 (matchRouteGraph connectors routeLineCount routeLinks)
\r
88 Atomic modifications to route graph
\r
90 data RouteGraphModification =
\r
91 UpdateLine RId Double Boolean
\r
92 | RemoveLink RId RId
\r
94 | CreateLink RId RId
\r
95 | CreateLine Double Boolean
\r
97 deriving instance Show RouteGraphModification
\r
98 instance GShow RouteGraphModification where
\r
100 graphPrecedence = precedence
\r
103 importJava "org.simantics.diagram.content.ConnectionUtil" where
\r
104 data ConnectionUtil
\r
107 createConnectionUtil :: <WriteGraph> ConnectionUtil
\r
109 removeConnectionPart :: ConnectionUtil -> Resource -> <WriteGraph> ()
\r
112 Executes one modification in the given connection with given connection node resources. May add a new route line
\r
113 to @resources@ array.
\r
116 executeAtomicModification :: Resource -> ArrayList.T Resource -> RouteGraphModification -> <Proc,WriteGraph> ()
\r
117 executeAtomicModification connection resources modi = match modi with
\r
118 UpdateLine a position isHorizontal -> do
\r
120 claimRelatedValue r DIA.HasPosition position
\r
121 claimRelatedValue r DIA.IsHorizontal isHorizontal
\r
122 RemoveLink a b -> deny (toR a) DIA.AreConnected (toR b)
\r
123 RemoveNode a -> removeConnectionPart createConnectionUtil (toR a)
\r
124 //denyAllStatements (toR a)
\r
125 CreateLink a b -> claim (toR a) DIA.AreConnected (toR b)
\r
126 CreateLine position isHorizontal -> do
\r
128 claim r L0.InstanceOf DIA.RouteLine
\r
129 claimRelatedValue r DIA.HasPosition position
\r
130 claimRelatedValue r DIA.IsHorizontal isHorizontal
\r
131 claim connection DIA.HasInteriorRouteNode r
\r
132 ArrayList.add resources r
\r
134 toR id = ArrayList.get resources id
\r
136 modifyRouteGraph :: RouteGraphStructure -> [RouteGraphModification] -> <Proc,WriteGraph> [Resource]
\r
137 modifyRouteGraph structure modis =
\r
138 match resolveRouteGraph structure with
\r
139 Just (connection, nodes) -> do
\r
140 ra = ArrayList.fromList nodes
\r
141 for modis (executeAtomicModification connection ra)
\r
142 ArrayList.freeze ra
\r
143 Nothing -> fail "Couldn't resolve route graph structure."