X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=blobdiff_plain;f=bundles%2Forg.simantics.modeling%2Fscl%2FSimantics%2FDiagram.scl;h=8276962eac7d4aefab138355327ee3d364cd3ffe;hb=24336357712d9b1f5c633b7f0c8f059f064fd0bb;hp=2490acc5b916b52ccd6e05e8b26accfcf15abce8;hpb=0ae2b770234dfc3cbb18bd38f324125cf0faca07;p=simantics%2Fplatform.git diff --git a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl index 2490acc5b..8276962ea 100644 --- a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl +++ b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl @@ -57,6 +57,17 @@ flipY (Position xx xy yx yy x y) = Position xx (-xy) yx (-yy) x y positionToDoubleArray (Position a b c d e f) = toDoubleArray [a,b,c,d,e,f] +positionToVector :: Position -> Vector Double +positionToVector (Position a b c d e f) = runProc + (do r = createMVector 6 + setMVector r 0 a + setMVector r 1 b + setMVector r 2 c + setMVector r 3 d + setMVector r 4 e + setMVector r 5 f + freezeMVector r) + // --- Diagram element data types ----------------------------------- data Property res = Property res Dynamic @@ -138,20 +149,26 @@ hasRandomIdentifier entity = runProc (claimRelatedValue_ entity L0.identifier GU """Returns all diagrams of the given model.""" diagramsOf :: Model -> [Diagram] -diagramsOf model = recurse - DIA.Diagram - (toResource (configurationOf model)) +diagramsOf model = diagramsUnder $ configurationOf model + +""" +Returns all diagrams under the specified diagram folder. +The parameter can also be the configuration root `configurationOf` +in which case this function returns the same as `diagramsOf model`. +""" +diagramsUnder :: DiagramFolder -> [Resource] +diagramsUnder folder = recurse DIA.Diagram folder where recurse t r = do - cs = resourceChildrenOf r - dias = map fromResource $ filter isDiagramComposite cs + cs = children r + dias = filter isDiagramComposite cs folders = filter (not . isDiagramComposite) cs dias + concatMap (recurse t) folders isDiagramComposite r = existsStatement r MOD.CompositeToDiagram """Returns a model relative path of the given diagram.""" pathOf :: Diagram -> [String] -pathOf diagram = map nameOf $ unfoldl aux $ toResource diagram +pathOf diagram = map nameOf $ unfoldl aux diagram where aux r = if existsStatement r SIMU.IsConfigurationOf then Nothing @@ -169,9 +186,7 @@ pathNameOf diagram = do // @Private? diagramResourceOf :: Diagram -> Resource -diagramResourceOf d = singleObject (toResource d) MOD.CompositeToDiagram - -import "Extras/HashMap" as Map +diagramResourceOf d = singleObject d MOD.CompositeToDiagram """Constructs a transformation for a diagram element.""" mapDiagramElement :: (a -> b) -> (a -> b) -> (a -> Maybe b) -> (a -> b) -> DiagramElement a -> DiagramElement b @@ -214,12 +229,12 @@ compositeToDiagram' c = singleObject c MOD.CompositeToDiagram """Creates or modifies an existing diagram to contain the given diagram elements.""" createDiagramR :: DiagramSpec -> (Dynamic -> Resource) -> [DiagramElement Resource] -> (Diagram, [Resource]) createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do - configuration = toResource diagram' + configuration = diagram' diagram = compositeToDiagram' configuration hasName = L0.HasName - componentMap = Map.fromList [ (c `relatedValue` hasName :: String, c) - | c <- resourceChildrenOf configuration - ] + componentMap = MMap.fromEntryList [ (c `relatedValue` hasName :: String, c) + | c <- children configuration + ] denyByPredicate diagram L0.ConsistsOf elements = setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs claimRelatedValue diagram DIA.HasModCount @@ -229,15 +244,15 @@ createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do createDiagramR (NewDiagram model path folderType compositeType) joinMap elementSpecs = (runProc do configuration = createConfiguration () diagram = compositeToDiagram' configuration - elements = setElements (DiagramInfo diagram configuration (Map.create ())) joinMap elementSpecs + elements = setElements (DiagramInfo diagram configuration (MMap.create ())) joinMap elementSpecs claimRelatedValue diagram DIA.HasModCount (fromInteger (length elements) :: Long) - (fromResource configuration, elements) + (configuration, elements) ) where createConfiguration () = do lastId = length path - 1 parentFolder = foldl (\p id -> getOrCreateFolder p (path!id)) - (toResource (configurationOf model)) + (configurationOf model) [0..lastId-1] createComposite_ parentFolder (path!lastId) compositeType getOrCreateFolder parentFolder name = @@ -250,14 +265,14 @@ claimFolder :: Model -> [String] -> Resource -> Resource claimFolder model path folderType = do lastId = length path foldl (\p id -> getOrCreateFolder p folderType (path!id)) - (toResource (configurationOf model)) + (configurationOf model) [0..lastId-1] claimModelFolder :: Model -> [String] -> Resource -> Resource claimModelFolder model path folderType = do lastId = length path foldl (\p id -> getOrCreateFolder p folderType (path!id)) - (toResource model) + model [0..lastId-1] getOrCreateFolder :: Resource -> Resource -> String -> Resource @@ -287,19 +302,19 @@ importJava "org.simantics.modeling.utils.JoinMap" where /* createJoin :: (Dynamic -> Resource) -> Dynamic -> Resource -createJoin joinMap key = if Map.contains joinMap key - then Map.unsafeGet joinMap key +createJoin joinMap key = if MMap.containsKey joinMap key + then MMap.unsafeGet joinMap key else do j = newEntity [ hasType STR.ConnectionJoin ] - Map.put joinMap key j + MMap.put joinMap key j j */ data DiagramInfo = DiagramInfo Resource // diagram Resource // configuration - (Map.T String Resource) // existing components + (MMap.T String Resource) // existing components """ Sets the elements of the diagram. Diagram is assumed to be empty, @@ -319,7 +334,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec for (zip elementSpecs elements) setConnectionName elements ) where - elementMap = Map.create () + elementMap = MMap.create () idRef = ref (0 :: Integer) isConnectionResource r = isInstanceOf r DIA.Connection @@ -332,8 +347,8 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec idRef := id + 1 show id createElement (Component componentType name position properties) = do - component = if Map.contains componentMap name - then Map.unsafeGet componentMap name + component = if MMap.containsKey componentMap name + then MMap.unsafeGet componentMap name else newEntity [ hasName name, hasParent configuration, @@ -354,13 +369,13 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec MOD.ElementToComponent component ] - Map.put elementMap name element + MMap.put elementMap name element Just element newOrMappedElement eName = do - element = match Map.get elementMap eName with + element = match MMap.get elementMap eName with Just element -> element Nothing -> newEntity [] - Map.put elementMap eName element + MMap.put elementMap eName element element createElement (SimpleConnection aName ar bName br _) = do connection = newEntity [ @@ -404,7 +419,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec then do claim flag DIA.ExternalFlag flag else () - Map.put elementMap name flag + MMap.put elementMap name flag Just flag createElement (Connection nodeSpecs edges _) = do connection = newEntity [ @@ -488,7 +503,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec hasFont font ] createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do - match (Map.get elementMap componentName) with + match (MMap.get elementMap componentName) with Nothing -> Nothing // Monitored component is not on the same diagram as the monitor. Not supported by this routine. Just element -> do component = singleObject element MOD.ElementToComponent @@ -554,21 +569,21 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec """Returns a diagram in the given model with the given model relative path.""" diagram :: Model -> [String] -> Diagram diagram model path = - fromResource $ foldl + foldl (\r name -> match possibleResourceChild r name with Just c -> c Nothing -> fail ("Didn't find " + name + ".") ) - (toResource (configurationOf model)) path + (configurationOf model) path possibleDiagram :: Model -> [String] -> (Maybe Diagram) possibleDiagram model path = - map fromResource (foldl + foldl (\r name -> match r with Just p -> possibleResourceChild p name Nothing -> Nothing ) - (Just $ toResource (configurationOf model)) path) + (Just (configurationOf model)) path /* """FIXME: doesn't work anymore with the elementsOfR spec @@ -688,11 +703,11 @@ elementsOfR diagram = filterJust $ map readElement' nodeResources = connectors + routeLines nodeResourceWithIds = zip nodeResources [0..length nodeResources-1] edges = runProc do - rMap = Map.fromList nodeResourceWithIds + rMap = MMap.fromEntryList nodeResourceWithIds edgesOf (node,i) = [ Edge i j | r <- node # DIA.AreConnected - , j = Map.unsafeGet rMap r + , j = MMap.unsafeGet rMap r , j > i ] concatMap edgesOf nodeResourceWithIds @@ -757,7 +772,7 @@ importJava "org.simantics.modeling.typicals.TypicalUtil" where syncActivateDiagram :: Diagram -> Boolean syncActivateDiagram composite = do - diagram = compositeToDiagram' $ toResource composite + diagram = compositeToDiagram' composite syncActivateOnce diagram True @@ -768,25 +783,21 @@ importJava "org.simantics.structural2.utils.StructuralUtils" where createComposite__ :: Configuration -> String -> Resource -> Diagram compositeToDiagram :: Resource -> Diagram -compositeToDiagram c = fromResource (singleObject c MOD.CompositeToDiagram) +compositeToDiagram c = singleObject c MOD.CompositeToDiagram createComposite :: Configuration -> String -> Resource -> Diagram createComposite diagramFolder name compositeType = do - newName = findFreshName name (toResource diagramFolder) + newName = findFreshName name diagramFolder createComposite__ diagramFolder newName compositeType elementToComponent :: Element -> Component -elementToComponent element = do - component = singleObject (toResource element) MOD.ElementToComponent - fromResource component +elementToComponent element = singleObject element MOD.ElementToComponent componentToElement :: Component -> Element -componentToElement component = do - element = singleObject (toResource component) MOD.ComponentToElement - fromResource element +componentToElement component = singleObject component MOD.ComponentToElement getConnections :: Diagram -> [Resource] -getConnections diagram = [object | object <- (toResource $ compositeToDiagram $ toResource diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection] +getConnections diagram = [object | object <- (compositeToDiagram diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection] getConnection :: Diagram -> String -> [Resource] getConnection diagram name = do @@ -798,8 +809,10 @@ setTransform element transform = claimRelatedValueWithType element DIA.HasTransf importJava "org.simantics.modeling.svg.CreateSVGElement" where createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> () + createSVGElementR :: Resource -> String -> ByteArray -> Double -> Double -> Resource importSVGElement :: Resource -> File -> Double -> Double -> () + importSVGElementR :: Resource -> File -> Double -> Double -> Resource importJava "org.simantics.diagram.synchronization.graph.RemoveElement" where removeElement :: Resource -> Resource -> ()