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
9 import "Logging" as LOGGER
11 importJava "org.simantics.modeling.scl.RouteGraphMatching" where
12 matchRouteGraph :: [Resource] -> Integer -> [Integer] -> <ReadGraph> Maybe [Resource]
14 data ConnectorIdentification =
15 ConnectionPoint String // component name
16 String // connection point name
17 | Element String // element name
19 deriving instance Show ConnectorIdentification
22 The structure of the route graph.
24 data RouteGraphStructure = RouteGraphStructure
26 [ConnectorIdentification] // Connectors
27 Integer // Number of route lines
28 [Integer] // Links between route nodes
30 instance GShow RouteGraphStructure where
31 gappend ctx sb (RouteGraphStructure composite connectors routeLineCount routeLinks) = do
32 sb << "RouteGraphStructure "
33 gappend ctx sb (Par 0 composite)
34 sb << " " <+ connectors << " " <+ routeLineCount << " " <+ routeLinks
39 breakableFor :: [a] -> (a -> <e> Boolean) -> <e> Boolean
40 breakableFor l f = loop 0
43 loop i | i < len = if f (l!i) then loop (i+1) else False
48 Finds connectors by given component and connection point names that
49 belong to the same connection.
52 resolveConnectors :: Resource -> Resource -> [ConnectorIdentification] -> <ReadGraph> Maybe (Resource, [Resource])
53 resolveConnectors composite diagram descs = let
54 findCandidateConnectors (ConnectionPoint componentName connectionPointName) =
55 match possibleResourceChild composite componentName with
57 Just component -> match possibleObject component MOD.ComponentToElement with
59 Just element -> [ objectOf stat
60 | stat <- statements element STR.IsConnectedTo
61 , nameOf (predicateOf stat) == connectionPointName
63 findCandidateConnectors (Element elementName) =
64 match possibleResourceChild diagram elementName with
66 Just element -> element # STR.IsConnectedTo
67 candidateConnectors = map findCandidateConnectors descs
68 connections = foldl1 intersect (map (map (`singleObject` DIA.IsConnectorOf)) candidateConnectors)
69 in if length connections != 1
71 else let connection = connections!0
72 chooseCandidate l = filter (\r -> singleObject r DIA.IsConnectorOf == connection) l ! 0
73 in Just (connection, map chooseCandidate candidateConnectors)
76 Finds the resource encoding the route graph structure or Nothing
77 if the structure does not match any route graph.
80 resolveRouteGraph :: RouteGraphStructure -> <Proc,ReadGraph> Maybe (Resource, [Resource])
81 resolveRouteGraph (RouteGraphStructure composite connectorDescs routeLineCount routeLinks) =
82 match resolveConnectors composite (singleObject composite MOD.CompositeToDiagram) connectorDescs with
84 Just (connection, connectors) -> map (\nodes -> (connection,nodes))
85 (matchRouteGraph connectors routeLineCount routeLinks)
90 Atomic modifications to route graph
92 data RouteGraphModification =
93 UpdateLine RId Double Boolean
97 | CreateLine Double Boolean
99 deriving instance Show RouteGraphModification
100 instance GShow RouteGraphModification where
102 graphPrecedence = precedence
105 importJava "org.simantics.diagram.content.ConnectionUtil" where
109 createConnectionUtil :: <WriteGraph> ConnectionUtil
111 removeConnectionPart :: ConnectionUtil -> Resource -> <WriteGraph> ()
114 Executes one modification in the given connection with given connection node resources. May add a new route line
115 to @resources@ array.
118 executeAtomicModification :: Resource -> ArrayList.T Resource -> RouteGraphModification -> <Proc,WriteGraph> ()
119 executeAtomicModification connection resources modi = match modi with
120 UpdateLine a position isHorizontal -> do
122 claimRelatedValue r DIA.HasPosition position
123 claimRelatedValue r DIA.IsHorizontal isHorizontal
124 RemoveLink a b -> deny (toR a) DIA.AreConnected (toR b)
125 RemoveNode a -> removeConnectionPart createConnectionUtil (toR a)
126 //denyAllStatements (toR a)
127 CreateLink a b -> claim (toR a) DIA.AreConnected (toR b)
128 CreateLine position isHorizontal -> do
130 claim r L0.InstanceOf DIA.RouteLine
131 claimRelatedValue r DIA.HasPosition position
132 claimRelatedValue r DIA.IsHorizontal isHorizontal
133 claim connection DIA.HasInteriorRouteNode r
134 ArrayList.add resources r
136 toR id = ArrayList.get resources id
138 modifyRouteGraph :: RouteGraphStructure -> [RouteGraphModification] -> <Proc,WriteGraph> [Resource]
139 modifyRouteGraph structure modis =
140 match resolveRouteGraph structure with
141 Just (connection, nodes) -> do
142 ra = ArrayList.fromList nodes
143 for modis (executeAtomicModification connection ra)
145 Nothing -> fail "Couldn't resolve route graph structure."
147 // Connection and terminal judgements
148 importJava "org.simantics.structural2.modelingRules.CPTerminal" where
149 makeIConnectionPoint :: Resource -> Resource -> <Proc> IConnectionPoint
151 importJava "org.simantics.structural2.modelingRules.ConnectionJudgementType" where
152 data ConnectionJudgementType
153 LEGAL :: ConnectionJudgementType
154 ILLEGAL :: ConnectionJudgementType
155 CANBEMADELEGAL :: ConnectionJudgementType
157 importJava "org.simantics.structural2.modelingRules.ConnectionJudgement" where
158 data ConnectionJudgement
161 getConnectionJudgementType :: ConnectionJudgement -> ConnectionJudgementType
163 importJava "org.simantics.structural2.modelingRules.IConnectionPoint" where
164 data IConnectionPoint
167 importJava "org.simantics.modeling.ModelingUtils" where
168 getModelingRules :: Resource -> <ReadGraph, Proc> Maybe IModelingRules
170 importJava "org.simantics.structural2.modelingRules.IModelingRules" where
173 judgeConnection :: IModelingRules -> [IConnectionPoint] -> <ReadGraph, Proc> ConnectionJudgement
175 canTerminalBeConnected :: Resource -> Resource -> Resource -> <ReadGraph, Proc> Boolean
176 canTerminalBeConnected diagram component terminal = match getModelingRules diagram with
177 Just modelingRules -> do
178 cpTerminal = makeIConnectionPoint component terminal
179 connectionJudgement = judgeConnection modelingRules [cpTerminal]
180 canBeConnected = getConnectionJudgementType connectionJudgement == LEGAL
181 LOGGER.info $ "canBeConnected : \(canBeConnected)"
184 LOGGER.warn $ "No modeling rules available for diagram \(diagram) to resolve connection judgement"
185 False // true or false when no modeling rules available ?