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