import "Simantics/DB" hiding (resourceId) import "Simantics/GShow" import "ArrayList" as ArrayList import "http://www.simantics.org/Layer0-1.1" as L0 import "http://www.simantics.org/Structural-1.2" as STR import "http://www.simantics.org/Diagram-2.2" as DIA import "http://www.simantics.org/Modeling-1.2" as MOD import "Logging" as LOGGER importJava "org.simantics.modeling.scl.RouteGraphMatching" where matchRouteGraph :: [Resource] -> Integer -> [Integer] -> Maybe [Resource] data ConnectorIdentification = ConnectionPoint String // component name String // connection point name | Element String // element name deriving instance Show ConnectorIdentification """ The structure of the route graph. """ data RouteGraphStructure = RouteGraphStructure Resource // Composite [ConnectorIdentification] // Connectors Integer // Number of route lines [Integer] // Links between route nodes instance GShow RouteGraphStructure where gappend ctx sb (RouteGraphStructure composite connectors routeLineCount routeLinks) = do sb << "RouteGraphStructure " gappend ctx sb (Par 0 composite) sb << " " <+ connectors << " " <+ routeLineCount << " " <+ routeLinks graphPrecedence _ = 1 @private @inline breakableFor :: [a] -> (a -> Boolean) -> Boolean breakableFor l f = loop 0 where len = length l loop i | i < len = if f (l!i) then loop (i+1) else False | otherwise = True """ Finds connectors by given component and connection point names that belong to the same connection. """ @private resolveConnectors :: Resource -> Resource -> [ConnectorIdentification] -> Maybe (Resource, [Resource]) resolveConnectors composite diagram descs = let findCandidateConnectors (ConnectionPoint componentName connectionPointName) = match possibleResourceChild composite componentName with Nothing -> [] Just component -> match possibleObject component MOD.ComponentToElement with Nothing -> [] Just element -> [ objectOf stat | stat <- statements element STR.IsConnectedTo , nameOf (predicateOf stat) == connectionPointName ] findCandidateConnectors (Element elementName) = match possibleResourceChild diagram elementName with Nothing -> [] Just element -> element # STR.IsConnectedTo candidateConnectors = map findCandidateConnectors descs connections = foldl1 intersect (map (map (`singleObject` DIA.IsConnectorOf)) candidateConnectors) in if length connections != 1 then Nothing else let connection = connections!0 chooseCandidate l = filter (\r -> singleObject r DIA.IsConnectorOf == connection) l ! 0 in Just (connection, map chooseCandidate candidateConnectors) """ Finds the resource encoding the route graph structure or Nothing if the structure does not match any route graph. """ @private resolveRouteGraph :: RouteGraphStructure -> Maybe (Resource, [Resource]) resolveRouteGraph (RouteGraphStructure composite connectorDescs routeLineCount routeLinks) = match resolveConnectors composite (singleObject composite MOD.CompositeToDiagram) connectorDescs with Nothing -> Nothing Just (connection, connectors) -> map (\nodes -> (connection,nodes)) (matchRouteGraph connectors routeLineCount routeLinks) type RId = Integer """ Atomic modifications to route graph """ data RouteGraphModification = UpdateLine RId Double Boolean | RemoveLink RId RId | RemoveNode RId | CreateLink RId RId | CreateLine Double Boolean deriving instance Show RouteGraphModification instance GShow RouteGraphModification where gappend _ = (<+) graphPrecedence = precedence @private importJava "org.simantics.diagram.content.ConnectionUtil" where data ConnectionUtil @JavaName "" createConnectionUtil :: ConnectionUtil removeConnectionPart :: ConnectionUtil -> Resource -> () """ Executes one modification in the given connection with given connection node resources. May add a new route line to @resources@ array. """ @private executeAtomicModification :: Resource -> ArrayList.T Resource -> RouteGraphModification -> () executeAtomicModification connection resources modi = match modi with UpdateLine a position isHorizontal -> do r = toR a claimRelatedValue r DIA.HasPosition position claimRelatedValue r DIA.IsHorizontal isHorizontal RemoveLink a b -> deny (toR a) DIA.AreConnected (toR b) RemoveNode a -> removeConnectionPart createConnectionUtil (toR a) //denyAllStatements (toR a) CreateLink a b -> claim (toR a) DIA.AreConnected (toR b) CreateLine position isHorizontal -> do r = newResource () claim r L0.InstanceOf DIA.RouteLine claimRelatedValue r DIA.HasPosition position claimRelatedValue r DIA.IsHorizontal isHorizontal claim connection DIA.HasInteriorRouteNode r ArrayList.add resources r where toR id = ArrayList.get resources id modifyRouteGraph :: RouteGraphStructure -> [RouteGraphModification] -> [Resource] modifyRouteGraph structure modis = match resolveRouteGraph structure with Just (connection, nodes) -> do ra = ArrayList.fromList nodes for modis (executeAtomicModification connection ra) ArrayList.freeze ra Nothing -> fail "Couldn't resolve route graph structure." // Connection and terminal judgements importJava "org.simantics.structural2.modelingRules.CPTerminal" where makeIConnectionPoint :: Resource -> Resource -> IConnectionPoint importJava "org.simantics.structural2.modelingRules.ConnectionJudgementType" where data ConnectionJudgementType LEGAL :: ConnectionJudgementType ILLEGAL :: ConnectionJudgementType CANBEMADELEGAL :: ConnectionJudgementType importJava "org.simantics.structural2.modelingRules.ConnectionJudgement" where data ConnectionJudgement @private @JavaName "type" getConnectionJudgementType :: ConnectionJudgement -> ConnectionJudgementType importJava "org.simantics.structural2.modelingRules.IConnectionPoint" where data IConnectionPoint importJava "org.simantics.modeling.ModelingUtils" where getModelingRules :: Resource -> Maybe IModelingRules importJava "org.simantics.structural2.modelingRules.IModelingRules" where data IModelingRules judgeConnection :: IModelingRules -> [IConnectionPoint] -> ConnectionJudgement canTerminalBeConnected :: Resource -> Resource -> Resource -> Boolean canTerminalBeConnected diagram component terminal = match getModelingRules diagram with Just modelingRules -> do cpTerminal = makeIConnectionPoint component terminal connectionJudgement = judgeConnection modelingRules [cpTerminal] canBeConnected = getConnectionJudgementType connectionJudgement == LEGAL LOGGER.info $ "canBeConnected : \(canBeConnected)" canBeConnected Nothing -> do LOGGER.warn $ "No modeling rules available for diagram \(diagram) to resolve connection judgement" False // true or false when no modeling rules available ?