bundles/org.simantics.modeling/scl/Simantics/RouteGraph.scl

   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
   8 \r
   9 importJava "org.simantics.modeling.scl.RouteGraphMatching" where\r
  10     matchRouteGraph :: [Resource] -> Integer -> [Integer] -> <ReadGraph> Maybe [Resource]\r
  11 \r
  12 data ConnectorIdentification =\r
  13     ConnectionPoint String // component name \r
  14                     String // connection point name\r
  15   | Element String // element name\r
  16 \r
  17 deriving instance Show ConnectorIdentification\r
  18 \r
  19 """\r
  20 The structure of the route graph.\r
  21 """\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
  27 \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
  34 \r
  35 @private\r
  36 @inline\r
  37 breakableFor :: [a] -> (a -> <e> Boolean) -> <e> Boolean\r
  38 breakableFor l f = loop 0\r
  39   where\r
  40     len = length l\r
  41     loop i | i < len = if f (l!i) then loop (i+1) else False\r
  42            | otherwise = True\r
  43 \r
  44 \r
  45 """\r
  46 Finds connectors by given component and connection point names that\r
  47 belong to the same connection.\r
  48 """\r
  49 @private\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
  54                 Nothing -> []\r
  55                 Just component -> match possibleObject component MOD.ComponentToElement with\r
  56                     Nothing -> []\r
  57                     Just element -> [ objectOf stat\r
  58                                     | stat <- statements element STR.IsConnectedTo\r
  59                                     , nameOf (predicateOf stat) == connectionPointName \r
  60                                     ]\r
  61     findCandidateConnectors (Element elementName) =\r
  62         match possibleResourceChild diagram elementName with\r
  63                 Nothing -> []\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
  68     then Nothing\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
  72 \r
  73 """\r
  74 Finds the resource encoding the route graph structure or Nothing\r
  75 if the structure does not match any route graph.\r
  76 """\r
  77 @private\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
  81       Nothing -> Nothing\r
  82       Just (connection, connectors) -> map (\nodes -> (connection,nodes)) \r
  83                                       (matchRouteGraph connectors routeLineCount routeLinks)\r
  84 \r
  85 type RId = Integer\r
  86 \r
  87 """\r
  88 Atomic modifications to route graph\r
  89 """\r
  90 data RouteGraphModification =\r
  91     UpdateLine RId Double Boolean\r
  92   | RemoveLink RId RId\r
  93   | RemoveNode RId\r
  94   | CreateLink RId RId\r
  95   | CreateLine Double Boolean\r
  96 \r
  97 deriving instance Show RouteGraphModification\r
  98 instance GShow RouteGraphModification where\r
  99     gappend _ = (<+)\r
 100     graphPrecedence = precedence\r
 101 \r
 102 @private\r
 103 importJava "org.simantics.diagram.content.ConnectionUtil" where\r
 104     data ConnectionUtil\r
 105     \r
 106     @JavaName "<init>"\r
 107     createConnectionUtil :: <WriteGraph> ConnectionUtil\r
 108     \r
 109     removeConnectionPart :: ConnectionUtil -> Resource -> <WriteGraph> ()\r
 110 \r
 111 """\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
 114 """\r
 115 @private\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
 119         r = toR a\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
 127         r = newResource ()\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
 133   where\r
 134     toR id = ArrayList.get resources id\r
 135 \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."