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 import "Logging" as LOGGER
  10
  11 importJava "org.simantics.modeling.scl.RouteGraphMatching" where
  12     matchRouteGraph :: [Resource] -> Integer -> [Integer] -> <ReadGraph> Maybe [Resource]
  13
  14 data ConnectorIdentification =
  15     ConnectionPoint String // component name
  16                     String // connection point name
  17   | Element String // element name
  18
  19 deriving instance Show ConnectorIdentification
  20
  21 """
  22 The structure of the route graph.
  23 """
  24 data RouteGraphStructure = RouteGraphStructure
  25     Resource // Composite
  26     [ConnectorIdentification] // Connectors
  27     Integer   // Number of route lines
  28     [Integer] // Links between route nodes
  29
  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
  35     graphPrecedence _ = 1
  36
  37 @private
  38 @inline
  39 breakableFor :: [a] -> (a -> <e> Boolean) -> <e> Boolean
  40 breakableFor l f = loop 0
  41   where
  42     len = length l
  43     loop i | i < len = if f (l!i) then loop (i+1) else False
  44            | otherwise = True
  45
  46
  47 """
  48 Finds connectors by given component and connection point names that
  49 belong to the same connection.
  50 """
  51 @private
  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
  56                 Nothing -> []
  57                 Just component -> match possibleObject component MOD.ComponentToElement with
  58                     Nothing -> []
  59                     Just element -> [ objectOf stat
  60                                     | stat <- statements element STR.IsConnectedTo
  61                                     , nameOf (predicateOf stat) == connectionPointName
  62                                     ]
  63     findCandidateConnectors (Element elementName) =
  64         match possibleResourceChild diagram elementName with
  65                 Nothing -> []
  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
  70     then Nothing
  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)
  74
  75 """
  76 Finds the resource encoding the route graph structure or Nothing
  77 if the structure does not match any route graph.
  78 """
  79 @private
  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
  83       Nothing -> Nothing
  84       Just (connection, connectors) -> map (\nodes -> (connection,nodes))
  85                                       (matchRouteGraph connectors routeLineCount routeLinks)
  86
  87 type RId = Integer
  88
  89 """
  90 Atomic modifications to route graph
  91 """
  92 data RouteGraphModification =
  93     UpdateLine RId Double Boolean
  94   | RemoveLink RId RId
  95   | RemoveNode RId
  96   | CreateLink RId RId
  97   | CreateLine Double Boolean
  98
  99 deriving instance Show RouteGraphModification
 100 instance GShow RouteGraphModification where
 101     gappend _ = (<+)
 102     graphPrecedence = precedence
 103
 104 @private
 105 importJava "org.simantics.diagram.content.ConnectionUtil" where
 106     data ConnectionUtil
 107
 108     @JavaName "<init>"
 109     createConnectionUtil :: <WriteGraph> ConnectionUtil
 110
 111     removeConnectionPart :: ConnectionUtil -> Resource -> <WriteGraph> ()
 112
 113 """
 114 Executes one modification in the given connection with given connection node resources. May add a new route line
 115 to @resources@ array.
 116 """
 117 @private
 118 executeAtomicModification :: Resource -> ArrayList.T Resource -> RouteGraphModification -> <Proc,WriteGraph> ()
 119 executeAtomicModification connection resources modi = match modi with
 120     UpdateLine a position isHorizontal -> do
 121         r = toR a
 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
 129         r = newResource ()
 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
 135   where
 136     toR id = ArrayList.get resources id
 137
 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)
 144             ArrayList.freeze ra
 145         Nothing -> fail "Couldn't resolve route graph structure."
 146
 147 // Connection and terminal judgements
 148 importJava "org.simantics.structural2.modelingRules.CPTerminal" where
 149     makeIConnectionPoint :: Resource -> Resource -> <Proc> IConnectionPoint
 150
 151 importJava "org.simantics.structural2.modelingRules.ConnectionJudgementType" where
 152     data ConnectionJudgementType
 153     LEGAL :: ConnectionJudgementType
 154     ILLEGAL :: ConnectionJudgementType
 155     CANBEMADELEGAL :: ConnectionJudgementType
 156
 157 importJava "org.simantics.structural2.modelingRules.ConnectionJudgement" where
 158     data ConnectionJudgement
 159     @private
 160     @JavaName "type"
 161     getConnectionJudgementType :: ConnectionJudgement -> ConnectionJudgementType
 162
 163 importJava "org.simantics.structural2.modelingRules.IConnectionPoint" where
 164     data IConnectionPoint
 165
 166
 167 importJava "org.simantics.modeling.ModelingUtils" where
 168     getModelingRules :: Resource -> <ReadGraph, Proc> Maybe IModelingRules
 169
 170 importJava "org.simantics.structural2.modelingRules.IModelingRules" where
 171     data IModelingRules
 172
 173     judgeConnection :: IModelingRules -> [IConnectionPoint] -> <ReadGraph, Proc> ConnectionJudgement
 174
 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)"
 182         canBeConnected
 183     Nothing -> do
 184         LOGGER.warn $ "No modeling rules available for diagram \(diagram) to resolve connection judgement"
 185         False // true or false when no modeling rules available ?