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."