-include "Simantics/Model"\r
-include "Simantics/WorkbenchSelection"\r
-include "Simantics/Library"\r
-include "File"\r
-import "Simantics/GUID" as GUID\r
-\r
-import "http://www.simantics.org/Layer0-1.1" as L0\r
-import "http://www.simantics.org/Diagram-2.2" as DIA\r
-import "http://www.simantics.org/G2D-1.1" as G2D\r
-import "http://www.simantics.org/Modeling-1.2" as MOD\r
-import "http://www.simantics.org/Simulation-1.1" as SIMU\r
-import "http://www.simantics.org/Structural-1.2" as STR\r
-\r
-// --- Entity types -------------------------------------------------\r
-\r
-type Diagram = Resource\r
-type DiagramFolder = Resource\r
-type Component = Resource\r
-type Element = Resource\r
-type ComponentType = Resource\r
-type Terminal = Resource\r
-type Connection = Resource\r
-type ConnectionType = Resource\r
-\r
-// --- Position -----------------------------------------------------\r
-\r
-data Position = Position Double Double Double Double Double Double\r
-\r
-deriving instance Show Position\r
-\r
-location :: Double -> Double -> Position\r
-location x y = Position 1 0 0 1 x y\r
-\r
-move :: (Double,Double) -> Position -> Position\r
-move (dx,dy) (Position xx xy yx yy x y) = Position xx xy yx yy (x+dx) (y+dy)\r
-\r
-rotate :: Integer -> Position -> Position\r
-rotate angle (Position xx xy yx yy x y) =\r
- Position (c*xx + s*xy) (c*xy - s*xx)\r
- (c*yx + s*yy) (c*yy - s*yx)\r
- x y\r
- where\r
- a = if angle < 0 \r
- then (angle `mod` 4) + 4\r
- else angle `mod` 4\r
- s = match a with 1 -> 1.0 ; 3 -> -1.0 ; _ -> 0.0\r
- c = match a with 0 -> 1.0 ; 2 -> -1.0 ; _ -> 0.0\r
-\r
-scale :: Double -> Position -> Position\r
-scale s (Position xx xy yx yy x y) = Position (s*xx) (s*xy) (s*yx) (s*yy) x y\r
-\r
-flipX :: Position -> Position\r
-flipX (Position xx xy yx yy x y) = Position (-xx) xy (-yx) yy x y \r
-\r
-flipY :: Position -> Position\r
-flipY (Position xx xy yx yy x y) = Position xx (-xy) yx (-yy) x y\r
-\r
-positionToDoubleArray (Position a b c d e f) = toDoubleArray [a,b,c,d,e,f]\r
-\r
-// --- Diagram element data types -----------------------------------\r
-\r
-data Property res = Property res Dynamic\r
-instance (Show res) => Show (Property res) where\r
- show (Property r _) = "Property " + show r \r
-\r
-data Edge = Edge Integer Integer\r
-deriving instance Show Edge\r
-data ConnectionNode res = Terminal String res\r
- | RouteLine\r
- Boolean // is horizontal \r
- Double // position\r
-deriving instance (Show res) => Show (ConnectionNode res)\r
-\r
-data Font = Font String Integer Integer\r
-deriving instance Show Font\r
-\r
-data Alignment =\r
- Baseline\r
- | Center\r
- | Leading\r
- | Trailing\r
-deriving instance Show Alignment\r
-\r
-resourceToAlignment res = match (possibleNameOf res) with\r
- Just "Baseline" -> Baseline\r
- Just "Center" -> Center\r
- Just "Leading" -> Leading\r
- Just "Trailing" -> Trailing\r
- _ -> fail ("Couldn't convert " + show res + " to Alignment.")\r
-\r
-alignmentToResource Baseline = G2D.Alignment.Baseline\r
-alignmentToResource Center = G2D.Alignment.Center\r
-alignmentToResource Leading = G2D.Alignment.Leading\r
-alignmentToResource Trailing = G2D.Alignment.Trailing\r
-\r
-data MonitorReference = MonitorReference String String\r
-deriving instance Show MonitorReference\r
-\r
-data MonitorVisuals = MonitorVisuals (Maybe Font) Double Alignment Alignment\r
-deriving instance Show MonitorVisuals\r
-\r
-data TextVisuals = TextVisuals (Maybe Font) Alignment Alignment\r
-deriving instance Show TextVisuals\r
-\r
-data DiagramElement res = \r
- Component\r
- res // component type\r
- String // name\r
- Position // position\r
- [Property res] // properties\r
- | SimpleConnection String res String res (Maybe String)\r
- | Connection [ConnectionNode res] [Edge] (Maybe String)\r
- | Flag \r
- res \r
- String // name \r
- String // label\r
- Boolean // output\r
- Boolean // external\r
- (Maybe String) // IOTableBinding\r
- (Maybe Integer) // IOTableRowIndex\r
- Position // position \r
- [Dynamic] // references to the joins\r
- | SVG String Position\r
- | Monitor String (Maybe MonitorReference) MonitorVisuals Position\r
- | Text\r
- Resource // element type\r
- String // Text shown by the element\r
- TextVisuals // text element visual attributes\r
- Position // position on diagram\r
-deriving instance (Show res) => Show (DiagramElement res)\r
-\r
-// --- Functions ----------------------------------------------------\r
-\r
-"""Creates a random GUID L0.identifier property for the specified entity resource.""" \r
-@private\r
-hasRandomIdentifier :: Resource -> <ReadGraph,WriteGraph> ()\r
-hasRandomIdentifier entity = runProc (claimRelatedValue_ entity L0.identifier GUID.randomGUID GUID.guidBinding)\r
-\r
-"""Returns all diagrams of the given model."""\r
-diagramsOf :: Model -> <ReadGraph> [Diagram]\r
-diagramsOf model = recurse\r
- DIA.Diagram \r
- (toResource (configurationOf model))\r
- where\r
- recurse t r = do\r
- cs = resourceChildrenOf r \r
- dias = map fromResource $ filter isDiagramComposite cs\r
- folders = filter (not . isDiagramComposite) cs\r
- dias + concatMap (recurse t) folders\r
- isDiagramComposite r = existsStatement r MOD.CompositeToDiagram\r
-\r
-"""Returns a model relative path of the given diagram."""\r
-pathOf :: Diagram -> <ReadGraph> [String]\r
-pathOf diagram = map nameOf $ unfoldl aux $ toResource diagram\r
- where\r
- aux r = if existsStatement r SIMU.IsConfigurationOf\r
- then Nothing\r
- else do\r
- parents = r # L0.PartOf\r
- if length parents == 1\r
- then Just (r, parents!0)\r
- else Nothing\r
- nameOf r = relatedValue r $ L0.HasName\r
-\r
-pathNameOf :: Diagram -> <ReadGraph> String\r
-pathNameOf diagram = do\r
- path = pathOf diagram\r
- foldl1 (\s s1 -> s + " / " + s1) path\r
-\r
-// @Private?\r
-diagramResourceOf :: Diagram -> <ReadGraph> Resource\r
-diagramResourceOf d = singleObject (toResource d) MOD.CompositeToDiagram\r
-\r
-import "Extras/HashMap" as Map\r
-\r
-"""Constructs a transformation for a diagram element."""\r
-mapDiagramElement :: (a -> <e> b) -> (a -> <e> b) -> (a -> <e> Maybe b) -> (a -> <e> b) -> DiagramElement a -> <e> DiagramElement b\r
-mapDiagramElement mapComponentType mapTerminal mapAttribute mapFlagType diagramElement =\r
- (match diagramElement with\r
- Component componentType name position properties -> do\r
- Component (mapComponentType componentType) name position\r
- (filterJust (map mapProperty properties))\r
- SimpleConnection e1 r1 e2 r2 possibleName ->\r
- SimpleConnection e1 (mapTerminal r1) e2 (mapTerminal r2) possibleName\r
- Connection nodes edges possibleName ->\r
- Connection\r
- (map mapConnectionNode nodes)\r
- edges possibleName\r
- Flag t e e2 e3 e4 e5 p p2 joins -> Flag (mapFlagType t) e e2 e3 e4 e5 p p2 joins\r
- SVG d p -> SVG d p\r
- Monitor label ref visuals position -> Monitor label ref visuals position\r
- Text elementType text visuals position -> Text elementType text visuals position\r
-) where\r
- mapProperty (Property p v) = \r
- match (mapAttribute p) with\r
- Just mp -> Just (Property mp v)\r
- Nothing -> Nothing\r
- mapConnectionNode (Terminal e r) = Terminal e (mapTerminal r)\r
- mapConnectionNode (RouteLine iv p) = RouteLine iv p\r
-\r
-importJava "org.simantics.structural2.utils.StructuralUtils" where\r
- @JavaName newComponent\r
- createComposite_ :: Resource -> String -> Resource -> <WriteGraph> Resource \r
-\r
-data DiagramSpec = NewDiagram \r
- Model // root \r
- [String] // path to the diagram\r
- Resource // folder type \r
- Resource // composite type\r
- | ExistingDiagram Diagram\r
-\r
-compositeToDiagram' c = singleObject c MOD.CompositeToDiagram\r
-\r
-"""Creates or modifies an existing diagram to contain the given diagram elements.""" \r
-createDiagramR :: DiagramSpec -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <WriteGraph> (Diagram, [Resource])\r
-createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do\r
- configuration = toResource diagram'\r
- diagram = compositeToDiagram' configuration\r
- hasName = L0.HasName\r
- componentMap = Map.fromList [ (c `relatedValue` hasName :: String, c)\r
- | c <- resourceChildrenOf configuration\r
- ]\r
- denyByPredicate diagram L0.ConsistsOf\r
- elements = setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs\r
- claimRelatedValue diagram DIA.HasModCount \r
- (fromInteger (length elements) :: Long)\r
- (diagram', elements)\r
-\r
-createDiagramR (NewDiagram model path folderType compositeType) joinMap elementSpecs = (runProc do\r
- configuration = createConfiguration () \r
- diagram = compositeToDiagram' configuration\r
- elements = setElements (DiagramInfo diagram configuration (Map.create ())) joinMap elementSpecs\r
- claimRelatedValue diagram DIA.HasModCount \r
- (fromInteger (length elements) :: Long)\r
- (fromResource configuration, elements)\r
-) where\r
- createConfiguration () = do\r
- lastId = length path - 1\r
- parentFolder = foldl (\p id -> getOrCreateFolder p (path!id)) \r
- (toResource (configurationOf model)) \r
- [0..lastId-1] \r
- createComposite_ parentFolder (path!lastId) compositeType\r
- getOrCreateFolder parentFolder name =\r
- match possibleResourceChild parentFolder name with\r
- Just child -> child\r
- Nothing ->\r
- createComposite_ parentFolder name folderType\r
-\r
-claimFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource\r
-claimFolder model path folderType = do\r
- lastId = length path\r
- foldl (\p id -> getOrCreateFolder p folderType (path!id)) \r
- (toResource (configurationOf model)) \r
- [0..lastId-1]\r
-\r
-claimModelFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource\r
-claimModelFolder model path folderType = do\r
- lastId = length path\r
- foldl (\p id -> getOrCreateFolder p folderType (path!id)) \r
- (toResource model) \r
- [0..lastId-1] \r
-\r
-getOrCreateFolder :: Resource -> Resource -> String -> <Proc,WriteGraph> Resource\r
-getOrCreateFolder parentFolder folderType name = do\r
- match possibleResourceChild parentFolder name with\r
- Just child -> child\r
- Nothing ->\r
- createComposite_ parentFolder name folderType\r
-\r
-relatedValueWithDefault :: Serializable a => a -> Resource -> Resource -> <ReadGraph> a\r
-relatedValueWithDefault def r p =\r
- if existsStatement r p\r
- then relatedValue r p\r
- else def\r
-\r
-applyConnectionType :: Resource -> <Proc,WriteGraph,ReadGraph> ()\r
-applyConnectionType res = do\r
- t = determineConnectionType res\r
- match t with\r
- Just t -> claim res STR.HasConnectionType t\r
- Nothing -> print ("No connection type " + (show res))\r
- () \r
-\r
-importJava "org.simantics.modeling.utils.JoinMap" where\r
- @JavaName "<init>"\r
- createJoinMap :: () -> <Proc> (Dynamic -> <WriteGraph> Resource)\r
- \r
-/*\r
-createJoin :: (Dynamic -> <WriteGraph> Resource) -> Dynamic -> <Proc,WriteGraph> Resource\r
-createJoin joinMap key = if Map.contains joinMap key\r
- then Map.unsafeGet joinMap key\r
- else do\r
- j = newEntity [\r
- hasType STR.ConnectionJoin\r
- ]\r
- Map.put joinMap key j \r
- j\r
-*/\r
-data DiagramInfo = DiagramInfo\r
- Resource // diagram\r
- Resource // configuration\r
- (Map.T String Resource) // existing components\r
-\r
-"""\r
-Sets the elements of the diagram. Diagram is assumed to be empty,\r
-but the configuration may contain existing components that can be found\r
-from the given existing components map.\r
-"""\r
-setElements :: DiagramInfo -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <Proc,WriteGraph> [Resource]\r
-setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs = (do\r
- /*elements = map createElement (filter (not . isConnection) elementSpecs)\r
- + map createElement (filter isConnection elementSpecs)*/\r
- elements = mapMaybe createElement elementSpecs\r
- for elements \r
- (claim diagram L0.ConsistsOf)\r
- setOrderedSet diagram elements\r
- iter applyConnectionType (filter isConnectionResource elements)\r
- syncActivateOnce diagram\r
- for (zip elementSpecs elements) setConnectionName\r
- elements\r
-) where\r
- elementMap = Map.create ()\r
- idRef = ref (0 :: Integer)\r
-\r
- isConnectionResource r = isInstanceOf r DIA.Connection\r
- isConnection (Connection _ _ _) = True\r
- isConnection (SimpleConnection _ _ _ _ _) = True\r
- isConnection _ = False\r
-\r
- freshElementName () = do\r
- id = getRef idRef\r
- idRef := id + 1\r
- show id\r
- createElement (Component componentType name position properties) = do\r
- component = if Map.contains componentMap name \r
- then Map.unsafeGet componentMap name \r
- else newEntity [\r
- hasName name,\r
- hasParent configuration,\r
- hasRandomIdentifier\r
- ]\r
- for properties (\(Property prop value) ->\r
- untypedClaimRelatedValue component prop value\r
- )\r
- element = newOrMappedElement name \r
- element = updateEntity element [\r
- hasName (freshElementName ()),\r
- hasType componentType,\r
- hasTypedProperty \r
- DIA.HasTransform\r
- (positionToDoubleArray position)\r
- G2D.Transform,\r
- hasStatement \r
- MOD.ElementToComponent\r
- component\r
- ]\r
- Map.put elementMap name element\r
- Just element\r
- newOrMappedElement eName = do\r
- element = match Map.get elementMap eName with\r
- Just element -> element\r
- Nothing -> newEntity []\r
- Map.put elementMap eName element\r
- element\r
- createElement (SimpleConnection aName ar bName br _) = do\r
- connection = newEntity [\r
- hasName (freshElementName ()),\r
- hasType DIA.RouteGraphConnection\r
- ]\r
- a = newOrMappedElement aName\r
- b = newOrMappedElement bName\r
- ca = createConnector connection a ar\r
- cb = createConnector connection b br\r
- connectNodes ca cb\r
- Just connection\r
- createElement (Flag t name label output external tableBinding tableRow position joins) = do\r
- flag = newOrMappedElement name \r
- flag = updateEntity flag [\r
- hasName (freshElementName ()),\r
- hasLabel label,\r
- hasType t,\r
- hasTypedProperty \r
- DIA.HasTransform\r
- (positionToDoubleArray position)\r
- G2D.Transform,\r
- hasPossibleProperty \r
- DIA.Flag.HasIOTableBinding\r
- tableBinding,\r
- hasPossibleProperty \r
- DIA.Flag.HasIOTableRowIndex\r
- tableRow\r
- ]\r
- iter (\jRef -> claim\r
- (joinMap jRef)\r
- DIA.JoinsFlag\r
- flag\r
- ) \r
- joins\r
- if output \r
- then do\r
- claim flag DIA.HasFlagType DIA.FlagType.OutputFlag\r
- else ()\r
- if external \r
- then do\r
- claim flag DIA.ExternalFlag flag\r
- else ()\r
- Map.put elementMap name flag\r
- Just flag\r
- createElement (Connection nodeSpecs edges _) = do\r
- connection = newEntity [\r
- hasName (freshElementName ()),\r
- hasType DIA.RouteGraphConnection\r
- ]\r
- \r
- nodes = map (createNode connection) nodeSpecs\r
- for edges (\(Edge a b) -> connectNodes (nodes!a) (nodes!b))\r
- Just connection\r
- createNode connection (Terminal elementName terminal) = do\r
- element = newOrMappedElement elementName\r
- createConnector connection element terminal \r
- createNode connection (RouteLine isHorizontal position) = do\r
- newEntity [\r
- hasName (freshElementName ()),\r
- hasType DIA.RouteLine,\r
- hasProperty DIA.HasPosition\r
- position,\r
- hasProperty DIA.IsHorizontal\r
- isHorizontal,\r
- hasStatement DIA.HasInteriorRouteNode.Inverse\r
- connection\r
- ]\r
- createConnector connection component terminal = do\r
- connector = newResource ()\r
- claim connector\r
- L0.InstanceOf\r
- DIA.Connector\r
- claim component terminal connector\r
- claim connection \r
- DIA.HasPlainConnector \r
- connector\r
- connector\r
- connectNodes a b = \r
- claim a DIA.AreConnected b\r
- createElement (SVG document position) =\r
- Just $ newEntity [\r
- hasName (freshElementName ()),\r
- hasType DIA.SVGElement,\r
- hasProperty \r
- G2D.HasSVGDocument\r
- document,\r
- hasTypedProperty \r
- DIA.HasTransform\r
- (positionToDoubleArray position)\r
- G2D.Transform\r
- ]\r
- createRealizedFont (Font family size style) = do\r
- font = newResource ()\r
- claim font\r
- L0.InstanceOf\r
- DIA.RealizedFont\r
- claimRelatedValue font DIA.RealizedFont.HasFamily family\r
- claimRelatedValue font DIA.RealizedFont.HasSize size\r
- claimRelatedValue font DIA.RealizedFont.HasStyle style\r
- font\r
- hasFont (Just font) = hasStatement DIA.HasFont (createRealizedFont font)\r
- hasFont Nothing = const ()\r
- createElement (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) position) = do\r
- Just $ newEntity [\r
- hasName (freshElementName ()),\r
- hasType DIA.Monitor,\r
- hasProperty \r
- L0.HasLabel\r
- label,\r
- hasTypedProperty \r
- DIA.HasTransform\r
- (positionToDoubleArray position)\r
- G2D.Transform,\r
- hasTypedProperty \r
- G2D.HasStrokeWidth\r
- strokeWidth\r
- L0.Double,\r
- hasStatement \r
- G2D.HasHorizontalAlignment\r
- (alignmentToResource hAlign),\r
- hasStatement \r
- G2D.HasVerticalAlignment\r
- (alignmentToResource vAlign),\r
- hasFont font\r
- ]\r
- createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do\r
- match (Map.get elementMap componentName) with\r
- Nothing -> Nothing // Monitored component is not on the same diagram as the monitor. Not supported by this routine.\r
- Just element -> do\r
- component = singleObject element MOD.ElementToComponent\r
- Just $ newEntity [\r
- hasName (freshElementName ()),\r
- hasType DIA.Monitor,\r
- hasProperty \r
- L0.HasLabel\r
- label,\r
- hasProperty \r
- DIA.HasMonitorSuffix\r
- suffix,\r
- hasStatement DIA.HasMonitorComponent component,\r
- hasTypedProperty \r
- DIA.HasTransform\r
- (positionToDoubleArray position)\r
- G2D.Transform,\r
- hasTypedProperty \r
- G2D.HasStrokeWidth\r
- strokeWidth\r
- L0.Double,\r
- hasStatement \r
- G2D.HasHorizontalAlignment\r
- (alignmentToResource hAlign),\r
- hasStatement \r
- G2D.HasVerticalAlignment\r
- (alignmentToResource vAlign),\r
- hasFont font\r
- ]\r
- createElement (Text elementType text (TextVisuals font hAlign vAlign) position) =\r
- Just $ newEntity [\r
- hasName (freshElementName ()),\r
- hasType elementType,\r
- hasProperty \r
- DIA.HasText\r
- text,\r
- hasTypedProperty \r
- DIA.HasTransform\r
- (positionToDoubleArray position)\r
- G2D.Transform,\r
- hasStatement \r
- G2D.HasHorizontalAlignment\r
- (alignmentToResource hAlign),\r
- hasStatement \r
- G2D.HasVerticalAlignment\r
- (alignmentToResource vAlign),\r
- hasFont font\r
- ]\r
- setConnectionName (Connection _ _ (Just name), element) = \r
- match possibleObject element MOD.ElementToComponent with\r
- Just c -> claimRelatedValue c L0.HasName name\r
- Nothing -> print ("Failed to set the name of the connection '" + name + "'.")\r
- setConnectionName (SimpleConnection _ _ _ _ (Just name), element) = \r
- match possibleObject element MOD.ElementToComponent with\r
- Just c -> claimRelatedValue c L0.HasName name\r
- Nothing -> print ("Failed to set the name of the connection '" + name + "'.")\r
- setConnectionName (Flag _ name _ _ _ _ _ _ _, element) =\r
- match possibleObject element MOD.ElementToComponent with\r
- Just c -> claimRelatedValue c L0.HasName name\r
- Nothing -> () // This is a typical case\r
- setConnectionName _ = ()\r
-\r
-"""Returns a diagram in the given model with the given model relative path.""" \r
-diagram :: Model -> [String] -> <ReadGraph> Diagram\r
-diagram model path = \r
- fromResource $ foldl \r
- (\r name -> match possibleResourceChild r name with\r
- Just c -> c\r
- Nothing -> fail ("Didn't find " + name + ".") \r
- ) \r
- (toResource (configurationOf model)) path\r
-\r
-possibleDiagram :: Model -> [String] -> <ReadGraph> (Maybe Diagram)\r
-possibleDiagram model path = \r
- map fromResource (foldl\r
- (\r name -> match r with\r
- Just p -> possibleResourceChild p name\r
- Nothing -> Nothing \r
- ) \r
- (Just $ toResource (configurationOf model)) path)\r
-\r
-/*\r
-"""FIXME: doesn't work anymore with the elementsOfR spec\r
-elementsOf :: Diagram -> <ReadGraph> [DiagramElement String]\r
-elementsOf diagram = map (mapDiagramElement nameOf mapTerminal possibleNameOf nameOf)\r
- $ elementsOfR diagram\r
- where\r
- nameOf r = relatedValue r L0.HasName\r
- mapTerminal r = do\r
- name = nameOf r\r
- if name == "ConnectionPoint" &&\r
- r == DIA.Flag.ConnectionPoint\r
- then "FlagTerminal"\r
- else name\r
-*/\r
-\r
-"""Returns the elements of the given diagram.""" \r
-elementsOfR :: Diagram -> <ReadGraph> [(DiagramElement Resource, Resource)]\r
-elementsOfR diagram = filterJust $ map readElement' \r
- (diagramResourceOf diagram # L0.ConsistsOf)\r
- where\r
- readElement' element = match readElement element with\r
- Just el -> Just (el, element)\r
- Nothing -> Nothing\r
- readElement element =\r
- if element `isInstanceOf` DIA.Flag\r
- then readFlag element\r
- else if element `isInstanceOf` DIA.SVGElement\r
- then readSVG element\r
- else if element `isInstanceOf` DIA.Monitor\r
- then readMonitor element\r
- else if element `isInstanceOf` DIA.RouteGraphConnection\r
- then readConnection element\r
- else if element `isInstanceOf` DIA.TextElement\r
- then readText element\r
- else if element `isInstanceOf` DIA.Element\r
- then readComponent element\r
- else Nothing\r
- readFlag flag = Just $ Flag\r
- (singleTypeOf \r
- flag \r
- DIA.Flag)\r
- (idOf flag) \r
- (labelOf flag)\r
- (existsStatement3 flag DIA.HasFlagType DIA.FlagType.OutputFlag)\r
- (existsStatement flag DIA.ExternalFlag)\r
- ((possibleRelatedString flag DIA.Flag.HasIOTableBinding) :: (Maybe String))\r
- ((possibleRelatedInteger flag DIA.Flag.HasIOTableRowIndex) :: (Maybe Integer))\r
- (transformOf flag)\r
- (map toDynamic $ flag # DIA.FlagIsJoinedBy)\r
- readComponent element = do\r
- component = singleObject \r
- element \r
- MOD.ElementToComponent\r
- Just (Component \r
- (singleTypeOf \r
- element \r
- DIA.Element)\r
- (nameOf component) \r
- (transformOf element)\r
- (readAttributes component))\r
- readSVG element = do\r
- Just (SVG \r
- (relatedValue element G2D.HasSVGDocument) \r
- (transformOf element)\r
- )\r
- readMonitor element = do\r
- font = readFont element (singleObject element DIA.HasFont)\r
- hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)\r
- vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)\r
- label = (relatedValue2 element L0.HasLabel)\r
- strokeWidth = relatedValueWithDefault (-1.0) element G2D.HasStrokeWidth \r
- transform = (transformOf element) \r
- match (existsStatement element DIA.HasMonitorSuffix) with\r
- True -> do\r
- suffix = (relatedValue element DIA.HasMonitorSuffix)\r
- monitorComponent = (singleObject element DIA.HasMonitorComponent)\r
- componentName = relatedValue monitorComponent L0.HasName\r
- Just (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) transform) \r
- False -> Just (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) transform)\r
- readText element = do\r
- elementType = singleTypeOf element DIA.Element\r
- font = readPossibleFont element \r
- hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)\r
- vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)\r
- text = relatedValueWithDefault "" element DIA.HasText \r
- transform = (transformOf element)\r
- Just (Text elementType text (TextVisuals font hAlign vAlign) transform)\r
- readPossibleFont element =\r
- match possibleObject element DIA.HasFont with\r
- Just f -> readFont element f\r
- Nothing -> Nothing\r
- readFont element font = do\r
- if font `isInstanceOf` DIA.RealizedFont\r
- then do\r
- family = (relatedValue font DIA.RealizedFont.HasFamily)\r
- size = (relatedValue font DIA.RealizedFont.HasSize)\r
- style = (relatedValue font DIA.RealizedFont.HasStyle)\r
- Just (Font family size style)\r
- else Nothing\r
- readAttributes component = let\r
- allPredicates = map objectOf (statements (singleTypeOf component L0.Entity) L0.DomainOf)\r
- is p = isSubrelationOf p L0.HasProperty\r
- hasPropertyPredicates = filter is allPredicates\r
- propertyStatements = map (singleStatement component) hasPropertyPredicates\r
- p stm = match (untypedPossibleValueOf (objectOf stm)) with\r
- Just v -> Just (Property (predicateOf stm) v)\r
- _ -> Nothing\r
- in mapMaybe p propertyStatements\r
- \r
- readConnection element = do\r
- connectors = element # DIA.HasConnector\r
- routeLines = element # DIA.HasInteriorRouteNode\r
- nodes = map (readConnector element) connectors\r
- + map readRouteLine routeLines\r
- \r
- nodeResources = connectors + routeLines\r
- nodeResourceWithIds = zip nodeResources [0..length nodeResources-1]\r
- edges = runProc do\r
- rMap = Map.fromList nodeResourceWithIds\r
- edgesOf (node,i) = \r
- [ Edge i j\r
- | r <- node # DIA.AreConnected\r
- , j = Map.unsafeGet rMap r\r
- , j > i ]\r
- concatMap edgesOf nodeResourceWithIds\r
- \r
- Just $ Connection nodes edges (readConnectionName element)\r
- readConnectionName element = \r
- match possibleObject element MOD.ElementToComponent with\r
- Just c -> possibleNameOf c\r
- Nothing -> Nothing\r
- readConnector connection r = Terminal\r
- (idOf $ objectOf stat)\r
- (inverseOf $ predicateOf stat)\r
- where\r
- stat = [ stat\r
- | stat <- statements r STR.Connects\r
- , objectOf stat != connection \r
- ]!0\r
- readRouteLine r = RouteLine\r
- (relatedValue r DIA.IsHorizontal) \r
- (relatedValue r DIA.HasPosition)\r
- transformOf element = do \r
- da = fromDoubleArray $\r
- relatedValue element DIA.HasTransform\r
- Position (da!0) (da!1) (da!2) (da!3) (da!4) (da!5)\r
- nameOf r = relatedValue r L0.HasName\r
- labelOf r = relatedValue2 r L0.HasLabel\r
- idOf r = match possibleObject r MOD.ElementToComponent with\r
- Just c -> nameOf c\r
- Nothing -> if r `isInstanceOf` DIA.Flag\r
- then "FLAG_" + nameOf r\r
- else fail ("Element " + show r + " was not mapped to a component.")\r
-\r
-importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where\r
- """Takes one connection element and returns possible diagram type.""" \r
- determineConnectionType :: Resource -> <ReadGraph> Maybe Resource\r
- \r
- rotateConnection :: Resource -> Double -> Double -> Boolean -> <WriteGraph> ()\r
- flipConnection :: Resource -> Boolean -> Double -> <WriteGraph> () \r
-\r
-applyDiagramMapping :: Resource -> <Proc,WriteGraph> ()\r
-applyDiagramMapping diagram = do\r
- syncActivateOnce diagram\r
- ()\r
-\r
-"""Returns the diagram flag type resource used for all generic diagram flags."""\r
-genericFlagType :: () -> <ReadGraph> Resource\r
-genericFlagType _ = DIA.Flag\r
-\r
-/* Use functions in Simantics/PageSettings\r
-importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where\r
- @JavaName setPageBordersVisible\r
- setPageBordersVisible :: Diagram -> Boolean -> <WriteGraph> ()\r
- \r
- @JavaName setMarginsVisible\r
- setMarginsVisible :: Diagram -> Boolean -> <WriteGraph> ()\r
-*/\r
-importJava "org.simantics.modeling.typicals.TypicalUtil" where\r
- @JavaName newMasterTypical\r
- newTypicalDiagram :: Library -> Diagram\r
-\r
- @JavaName syncTypicalInstance\r
- syncTypicalInstance :: Resource -> <WriteGraph> ()\r
- \r
-syncActivateDiagram :: Diagram -> <WriteGraph, Proc> Boolean\r
-syncActivateDiagram composite = do\r
- diagram = compositeToDiagram' $ toResource composite\r
- syncActivateOnce diagram\r
- True\r
-\r
-// --- Diagrams ---------------------------------------------------\r
-\r
-importJava "org.simantics.structural2.utils.StructuralUtils" where\r
- @JavaName newComponent\r
- createComposite__ :: Configuration -> String -> Resource -> <WriteGraph> Diagram\r
-\r
-compositeToDiagram :: Resource -> <ReadGraph> Diagram\r
-compositeToDiagram c = fromResource (singleObject c MOD.CompositeToDiagram) \r
-\r
-createComposite :: Configuration -> String -> Resource -> <WriteGraph> Diagram\r
-createComposite diagramFolder name compositeType = do\r
- newName = findFreshName name (toResource diagramFolder)\r
- createComposite__ diagramFolder newName compositeType\r
-\r
-elementToComponent :: Element -> <ReadGraph> Component\r
-elementToComponent element = do\r
- component = singleObject (toResource element) MOD.ElementToComponent\r
- fromResource component\r
- \r
-componentToElement :: Component -> <ReadGraph> Element\r
-componentToElement component = do\r
- element = singleObject (toResource component) MOD.ComponentToElement\r
- fromResource element\r
-\r
-getConnections :: Diagram -> <ReadGraph> [Resource]\r
-getConnections diagram = [object | object <- (toResource $ compositeToDiagram $ toResource diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection]\r
-\r
-getConnection :: Diagram -> String -> <ReadGraph> [Resource]\r
-getConnection diagram name = do\r
- connections = getConnections diagram\r
- filter (\x -> relatedValue2 x L0.HasName == name) connections\r
-\r
-setTransform :: Resource -> DoubleArray -> <WriteGraph> ()\r
-setTransform element transform = claimRelatedValueWithType element DIA.HasTransform G2D.Transform transform \r
- \r
-importJava "org.simantics.modeling.svg.CreateSVGElement" where\r
- createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> ()\r
- \r
- importSVGElement :: Resource -> File -> Double -> Double -> <WriteGraph> ()\r
- \r
-importJava "org.simantics.diagram.synchronization.graph.RemoveElement" where\r
- removeElement :: Resource -> Resource -> <WriteGraph> ()\r
-\r
-setStraightConnectionLines :: Resource -> Boolean -> <WriteGraph> ()\r
-setStraightConnectionLines element v =\r
- for (element # STR.IsConnectedTo) $ \connector ->\r
- claimRelatedValue connector DIA.Connector.straight v\r
-\r
-showProfileMonitors :: Resource -> Boolean -> <WriteGraph> ()\r
-showProfileMonitors element v = claimRelatedValue element DIA.Element.hideProfileMonitors (not v)\r
-\r
-setProfileMonitorsDirectionUp :: Resource -> Boolean -> <WriteGraph> ()\r
-setProfileMonitorsDirectionUp element v = claimRelatedValue element DIA.Element.upProfileMonitors v\r
-\r
-importJava "org.simantics.diagram.flag.Joiner" where\r
- joinFlagsLocal :: [Resource] -> <WriteGraph> ()\r
-\r
-importJava "org.simantics.diagram.flag.RouteGraphConnectionSplitter" where\r
- splitConnection :: Resource -> Double -> Double -> <WriteGraph> ()\r
-\r
-importJava "org.simantics.diagram.handler.CopyPasteUtil" where\r
- moveConnection :: Resource -> Double -> Double -> <WriteGraph> ()\r
-\r
-importJava "org.simantics.diagram.content.ConnectionUtil" where\r
- translateRouteNodes :: Resource -> Double -> Double -> <WriteGraph> ()\r
- \r
-importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where\r
+include "Simantics/Model"
+include "Simantics/WorkbenchSelection"
+include "Simantics/Library"
+include "File"
+import "Simantics/GUID" as GUID
+
+import "http://www.simantics.org/Layer0-1.1" as L0
+import "http://www.simantics.org/Diagram-2.2" as DIA
+import "http://www.simantics.org/G2D-1.1" as G2D
+import "http://www.simantics.org/Modeling-1.2" as MOD
+import "http://www.simantics.org/Simulation-1.1" as SIMU
+import "http://www.simantics.org/Structural-1.2" as STR
+
+// --- Entity types -------------------------------------------------
+
+type Diagram = Resource
+type DiagramFolder = Resource
+type Component = Resource
+type Element = Resource
+type ComponentType = Resource
+type Terminal = Resource
+type Connection = Resource
+type ConnectionType = Resource
+
+// --- Position -----------------------------------------------------
+
+"""
+ Position xx xy yx yy tx ty
+
+is a 2D affine transform with a rotation/scale/shear part,
+i.e. `xx xy yx yy` and a translation part `tx ty` which
+represents the matrix
+
+ [xx yx | tx]
+ [xy yy | ty]
+"""
+data Position = Position Double Double Double Double Double Double
+
+deriving instance Show Position
+
+"""
+ translation x y
+
+Returns an affine transform with identity rotation and `x y` for translation.
+"""
+location :: Double -> Double -> Position
+location x y = Position 1 0 0 1 x y
+
+"""
+ move (dx,dy)
+
+Returns a function that adds `(dx, dy)` to the translation of a specified affine transform.
+"""
+move :: (Double,Double) -> Position -> Position
+move (dx,dy) (Position xx xy yx yy x y) = Position xx xy yx yy (x+dx) (y+dy)
+
+"""
+ rotate n
+
+Returns a function that rotates the specified affine transform by `n*90` degrees
+"""
+rotate :: Integer -> Position -> Position
+rotate angle (Position xx xy yx yy x y) =
+ Position (c*xx + s*xy) (c*xy - s*xx)
+ (c*yx + s*yy) (c*yy - s*yx)
+ x y
+ where
+ a = if angle < 0
+ then (angle `mod` 4) + 4
+ else angle `mod` 4
+ s = match a with 1 -> 1.0 ; 3 -> -1.0 ; _ -> 0.0
+ c = match a with 0 -> 1.0 ; 2 -> -1.0 ; _ -> 0.0
+
+"""
+ scale s transform
+
+Multiplies the rotation part of the specified affine `transform` by `s`
+
+```
+[xx yx tx] => [s*xx s*yx tx]
+[xy yy ty] [s*xy s*yy ty]
+```
+"""
+scale :: Double -> Position -> Position
+scale s (Position xx xy yx yy x y) = Position (s*xx) (s*xy) (s*yx) (s*yy) x y
+
+"""
+ withScale scale transform
+
+Sets the rotation part so that the base vectors defined by `u=[xx xy]` and `v=[yx yy]`
+are of length `scale`. This effectively sets the scaling of the elements without
+touching their rotation/shear.
+
+```
+su = scale / |u|
+sv = scale / |v|
+
+[xx yx tx] => [su*xx sv*yx tx]
+[xy yy ty] [su*xy sv*yy ty]
+```
+"""
+withScale :: Double -> Position -> Position
+withScale scale (Position xx xy yx yy tx ty) = Position xx' xy' yx' yy' tx ty
+ where
+ su = scale / (sqrt (xx*xx + xy*xy))
+ sv = scale / (sqrt (yx*yx + yy*yy))
+ xx' = xx * su
+ xy' = xy * su
+ yx' = yx * sv
+ yy' = yy * sv
+
+"""
+ flipX transform
+
+Performs a mirror operation for the specified `transform` about the Y-axis.
+"""
+flipX :: Position -> Position
+flipX (Position xx xy yx yy x y) = Position (-xx) xy (-yx) yy x y
+
+"""
+ flipY transform
+
+Performs a mirror operation for the specified `transform` about the X-axis.
+"""
+flipY :: Position -> Position
+flipY (Position xx xy yx yy x y) = Position xx (-xy) yx (-yy) x y
+
+"""
+Converts a [Position](#Position) into a `Vector Double`.
+"""
+positionToDoubleArray (Position a b c d e f) = toDoubleArray [a,b,c,d,e,f]
+
+"""
+Converts a [Position](#Position) into a `Vector Double`.
+"""
+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
+instance (Show res) => Show (Property res) where
+ show (Property r _) = "Property " + show r
+
+data Edge = Edge Integer Integer
+deriving instance Show Edge
+data ConnectionNode res = Terminal String res
+ | RouteLine
+ Boolean // is horizontal
+ Double // position
+deriving instance (Show res) => Show (ConnectionNode res)
+
+data Font = Font String Integer Integer
+deriving instance Show Font
+
+data Alignment =
+ Baseline
+ | Center
+ | Leading
+ | Trailing
+deriving instance Show Alignment
+
+resourceToAlignment res = match (possibleNameOf res) with
+ Just "Baseline" -> Baseline
+ Just "Center" -> Center
+ Just "Leading" -> Leading
+ Just "Trailing" -> Trailing
+ _ -> fail ("Couldn't convert " + show res + " to Alignment.")
+
+alignmentToResource Baseline = G2D.Alignment.Baseline
+alignmentToResource Center = G2D.Alignment.Center
+alignmentToResource Leading = G2D.Alignment.Leading
+alignmentToResource Trailing = G2D.Alignment.Trailing
+
+data MonitorReference = MonitorReference String String
+deriving instance Show MonitorReference
+
+data MonitorVisuals = MonitorVisuals (Maybe Font) Double Alignment Alignment
+deriving instance Show MonitorVisuals
+
+data TextVisuals = TextVisuals (Maybe Font) Alignment Alignment
+deriving instance Show TextVisuals
+
+data DiagramElement res =
+ Component
+ res // component type
+ String // name
+ Position // position
+ [Property res] // properties
+ | SimpleConnection String res String res (Maybe String)
+ | Connection [ConnectionNode res] [Edge] (Maybe String)
+ | Flag
+ res
+ String // name
+ String // label
+ Boolean // output
+ Boolean // external
+ (Maybe String) // IOTableBinding
+ (Maybe Integer) // IOTableRowIndex
+ Position // position
+ [Dynamic] // references to the joins
+ | SVG String Position
+ | Monitor String (Maybe MonitorReference) MonitorVisuals Position
+ | Text
+ Resource // element type
+ String // Text shown by the element
+ TextVisuals // text element visual attributes
+ Position // position on diagram
+deriving instance (Show res) => Show (DiagramElement res)
+
+// --- Functions ----------------------------------------------------
+
+@private
+transformOf element = Position (da!0) (da!1) (da!2) (da!3) (da!4) (da!5)
+ where da = relatedValue element DIA.HasTransform :: Vector Double
+
+"""Creates a random GUID L0.identifier property for the specified entity resource."""
+@private
+hasRandomIdentifier :: Resource -> <ReadGraph,WriteGraph> ()
+hasRandomIdentifier entity = runProc (claimRelatedValue_ entity L0.identifier GUID.randomGUID GUID.guidBinding)
+
+"""Returns all diagrams of the given model."""
+diagramsOf :: Model -> <ReadGraph> [Diagram]
+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 -> <ReadGraph> [Resource]
+diagramsUnder folder = recurse DIA.Diagram folder
+ where
+ recurse t r = do
+ 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 -> <ReadGraph> [String]
+pathOf diagram = map nameOf $ unfoldl aux diagram
+ where
+ aux r = if existsStatement r SIMU.IsConfigurationOf
+ then Nothing
+ else do
+ parents = r # L0.PartOf
+ if length parents == 1
+ then Just (r, parents!0)
+ else Nothing
+ nameOf r = relatedValue r $ L0.HasName
+
+pathNameOf :: Diagram -> <ReadGraph> String
+pathNameOf diagram = do
+ path = pathOf diagram
+ foldl1 (\s s1 -> s + " / " + s1) path
+
+// @Private?
+diagramResourceOf :: Diagram -> <ReadGraph> Resource
+diagramResourceOf d = singleObject d MOD.CompositeToDiagram
+
+"""Constructs a transformation for a diagram element."""
+mapDiagramElement :: (a -> <e> b) -> (a -> <e> b) -> (a -> <e> Maybe b) -> (a -> <e> b) -> DiagramElement a -> <e> DiagramElement b
+mapDiagramElement mapComponentType mapTerminal mapAttribute mapFlagType diagramElement =
+ (match diagramElement with
+ Component componentType name position properties -> do
+ Component (mapComponentType componentType) name position
+ (filterJust (map mapProperty properties))
+ SimpleConnection e1 r1 e2 r2 possibleName ->
+ SimpleConnection e1 (mapTerminal r1) e2 (mapTerminal r2) possibleName
+ Connection nodes edges possibleName ->
+ Connection
+ (map mapConnectionNode nodes)
+ edges possibleName
+ Flag t e e2 e3 e4 e5 p p2 joins -> Flag (mapFlagType t) e e2 e3 e4 e5 p p2 joins
+ SVG d p -> SVG d p
+ Monitor label ref visuals position -> Monitor label ref visuals position
+ Text elementType text visuals position -> Text elementType text visuals position
+) where
+ mapProperty (Property p v) =
+ match (mapAttribute p) with
+ Just mp -> Just (Property mp v)
+ Nothing -> Nothing
+ mapConnectionNode (Terminal e r) = Terminal e (mapTerminal r)
+ mapConnectionNode (RouteLine iv p) = RouteLine iv p
+
+importJava "org.simantics.structural2.utils.StructuralUtils" where
+ @JavaName newComponent
+ createComposite_ :: Resource -> String -> Resource -> <WriteGraph> Resource
+
+data DiagramSpec = NewDiagram
+ Model // root
+ [String] // path to the diagram
+ Resource // folder type
+ Resource // composite type
+ | ExistingDiagram Diagram
+
+compositeToDiagram' c = singleObject c MOD.CompositeToDiagram
+
+"""Creates or modifies an existing diagram to contain the given diagram elements."""
+createDiagramR :: DiagramSpec -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <WriteGraph> (Diagram, [Resource])
+createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do
+ configuration = diagram'
+ diagram = compositeToDiagram' configuration
+ hasName = L0.HasName
+ 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
+ (fromInteger (length elements) :: Long)
+ (diagram', elements)
+
+createDiagramR (NewDiagram model path folderType compositeType) joinMap elementSpecs = (runProc do
+ configuration = createConfiguration ()
+ diagram = compositeToDiagram' configuration
+ elements = setElements (DiagramInfo diagram configuration (MMap.create ())) joinMap elementSpecs
+ claimRelatedValue diagram DIA.HasModCount
+ (fromInteger (length elements) :: Long)
+ (configuration, elements)
+) where
+ createConfiguration () = do
+ lastId = length path - 1
+ parentFolder = foldl (\p id -> getOrCreateFolder p (path!id))
+ (configurationOf model)
+ [0..lastId-1]
+ createComposite_ parentFolder (path!lastId) compositeType
+ getOrCreateFolder parentFolder name =
+ match possibleResourceChild parentFolder name with
+ Just child -> child
+ Nothing ->
+ createComposite_ parentFolder name folderType
+
+claimFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource
+claimFolder model path folderType = do
+ lastId = length path
+ foldl (\p id -> getOrCreateFolder p folderType (path!id))
+ (configurationOf model)
+ [0..lastId-1]
+
+claimModelFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource
+claimModelFolder model path folderType = do
+ lastId = length path
+ foldl (\p id -> getOrCreateFolder p folderType (path!id))
+ model
+ [0..lastId-1]
+
+getOrCreateFolder :: Resource -> Resource -> String -> <Proc,WriteGraph> Resource
+getOrCreateFolder parentFolder folderType name = do
+ match possibleResourceChild parentFolder name with
+ Just child -> child
+ Nothing ->
+ createComposite_ parentFolder name folderType
+
+relatedValueWithDefault :: Serializable a => a -> Resource -> Resource -> <ReadGraph> a
+relatedValueWithDefault def r p =
+ if existsStatement r p
+ then relatedValue r p
+ else def
+
+applyConnectionType :: Resource -> <Proc,WriteGraph,ReadGraph> ()
+applyConnectionType res = do
+ t = determineConnectionType res
+ match t with
+ Just t -> claim res STR.HasConnectionType t
+ Nothing -> print ("No connection type " + (show res))
+ ()
+
+importJava "org.simantics.modeling.utils.JoinMap" where
+ @JavaName "<init>"
+ createJoinMap :: () -> <Proc> (Dynamic -> <WriteGraph> Resource)
+
+/*
+createJoin :: (Dynamic -> <WriteGraph> Resource) -> Dynamic -> <Proc,WriteGraph> Resource
+createJoin joinMap key = if MMap.containsKey joinMap key
+ then MMap.unsafeGet joinMap key
+ else do
+ j = newEntity [
+ hasType STR.ConnectionJoin
+ ]
+ MMap.put joinMap key j
+ j
+*/
+data DiagramInfo = DiagramInfo
+ Resource // diagram
+ Resource // configuration
+ (MMap.T String Resource) // existing components
+
+"""
+Sets the elements of the diagram. Diagram is assumed to be empty,
+but the configuration may contain existing components that can be found
+from the given existing components map.
+"""
+setElements :: DiagramInfo -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <Proc,WriteGraph> [Resource]
+setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs = (do
+ /*elements = map createElement (filter (not . isConnection) elementSpecs)
+ + map createElement (filter isConnection elementSpecs)*/
+ elements = mapMaybe createElement elementSpecs
+ for elements
+ (claim diagram L0.ConsistsOf)
+ setOrderedSet diagram elements
+ iter applyConnectionType (filter isConnectionResource elements)
+ syncActivateOnce diagram
+ for (zip elementSpecs elements) setConnectionName
+ elements
+) where
+ elementMap = MMap.create ()
+ idRef = ref (0 :: Integer)
+
+ isConnectionResource r = isInstanceOf r DIA.Connection
+ isConnection (Connection _ _ _) = True
+ isConnection (SimpleConnection _ _ _ _ _) = True
+ isConnection _ = False
+
+ freshElementName () = do
+ id = getRef idRef
+ idRef := id + 1
+ show id
+ createElement (Component componentType name position properties) = do
+ component = if MMap.containsKey componentMap name
+ then MMap.unsafeGet componentMap name
+ else newEntity [
+ hasName name,
+ hasParent configuration,
+ hasRandomIdentifier
+ ]
+ for properties (\(Property prop value) ->
+ untypedClaimRelatedValue component prop value
+ )
+ element = newOrMappedElement name
+ element = updateEntity element [
+ hasName (freshElementName ()),
+ hasType componentType,
+ hasTypedProperty
+ DIA.HasTransform
+ (positionToVector position)
+ G2D.Transform,
+ hasStatement
+ MOD.ElementToComponent
+ component
+ ]
+ MMap.put elementMap name element
+ Just element
+ newOrMappedElement eName = do
+ element = match MMap.get elementMap eName with
+ Just element -> element
+ Nothing -> newEntity []
+ MMap.put elementMap eName element
+ element
+ createElement (SimpleConnection aName ar bName br _) = do
+ connection = newEntity [
+ hasName (freshElementName ()),
+ hasType DIA.RouteGraphConnection
+ ]
+ a = newOrMappedElement aName
+ b = newOrMappedElement bName
+ ca = createConnector connection a ar DIA.HasPlainConnector
+ cb = createConnector connection b br DIA.HasArrowConnector
+ connectNodes ca cb
+ Just connection
+ createElement (Flag t name label output external tableBinding tableRow position joins) = do
+ flag = newOrMappedElement name
+ flag = updateEntity flag [
+ hasName (freshElementName ()),
+ hasLabel label,
+ hasType t,
+ hasTypedProperty
+ DIA.HasTransform
+ (positionToVector position)
+ G2D.Transform,
+ hasPossibleProperty
+ DIA.Flag.HasIOTableBinding
+ tableBinding,
+ hasPossibleProperty
+ DIA.Flag.HasIOTableRowIndex
+ tableRow
+ ]
+ iter (\jRef -> claim
+ (joinMap jRef)
+ DIA.JoinsFlag
+ flag
+ )
+ joins
+ if output
+ then do
+ claim flag DIA.HasFlagType DIA.FlagType.OutputFlag
+ else ()
+ if external
+ then do
+ claim flag DIA.ExternalFlag flag
+ else ()
+ MMap.put elementMap name flag
+ Just flag
+ createElement (Connection nodeSpecs edges _) = do
+ connection = newEntity [
+ hasName (freshElementName ()),
+ hasType DIA.RouteGraphConnection
+ ]
+
+ nodes = map (createNode connection) nodeSpecs
+ for edges (\(Edge a b) -> connectNodes (nodes!a) (nodes!b))
+ Just connection
+ createNode connection (Terminal elementName terminal) = do
+ element = newOrMappedElement elementName
+ if terminal == DIA.Flag.ConnectionPoint then
+ createConnector connection element terminal DIA.HasPlainConnector
+ else
+ createConnector connection element terminal DIA.HasPlainConnector
+ createNode connection (RouteLine isHorizontal position) = do
+ newEntity [
+ hasName (freshElementName ()),
+ hasType DIA.RouteLine,
+ hasProperty DIA.HasPosition
+ position,
+ hasProperty DIA.IsHorizontal
+ isHorizontal,
+ hasStatement DIA.HasInteriorRouteNode.Inverse
+ connection
+ ]
+ createConnector connection component terminal defaultHasConnector = do
+ connector = newResource ()
+ claim connector
+ L0.InstanceOf
+ DIA.Connector
+ claim component terminal connector
+
+ (connectionRelation, attachmentRelation) = resolveAttachmentRelation component terminal defaultHasConnector
+
+ claim connection attachmentRelation connector
+
+ execJust connectionRelation (\cr -> do
+ if existsStatement cr MOD.NeedsConnectionMappingSpecification then do
+ connectionType = singleObject cr STR.AllowsConnectionType
+ spec = singleObject connectionType MOD.ConnectionTypeToConnectionMappingSpecification
+ claim connector
+ MOD.HasConnectionMappingSpecification
+ spec
+ else ())
+
+ connector
+ connectNodes a b =
+ claim a DIA.AreConnected b
+ // Returns (connectionRelation :: Maybe Resource, connector attachment relation :: Resource)
+ resolveAttachmentRelation element terminal defaultAttachmentRelation =
+ if terminal == DIA.Flag.ConnectionPoint then
+ (Nothing, flagTypeToAttachmentRelation element)
+ else
+ match possibleObject terminal MOD.DiagramConnectionRelationToConnectionRelation with
+ Just connectionRelation -> (Just connectionRelation, orElse (possibleObject connectionRelation STR.HasAttachmentRelation) defaultAttachmentRelation)
+ Nothing -> (Nothing, defaultAttachmentRelation)
+ createElement (SVG document position) =
+ Just $ newEntity [
+ hasName (freshElementName ()),
+ hasType DIA.SVGElement,
+ hasProperty
+ G2D.HasSVGDocument
+ document,
+ hasTypedProperty
+ DIA.HasTransform
+ (positionToVector position)
+ G2D.Transform
+ ]
+ createRealizedFont (Font family size style) = do
+ font = newResource ()
+ claim font
+ L0.InstanceOf
+ DIA.RealizedFont
+ claimRelatedValue font DIA.RealizedFont.HasFamily family
+ claimRelatedValue font DIA.RealizedFont.HasSize size
+ claimRelatedValue font DIA.RealizedFont.HasStyle style
+ font
+ hasFont (Just font) = hasStatement DIA.HasFont (createRealizedFont font)
+ hasFont Nothing = const ()
+ createElement (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
+ Just $ newEntity [
+ hasName (freshElementName ()),
+ hasType DIA.Monitor,
+ hasProperty
+ L0.HasLabel
+ label,
+ hasTypedProperty
+ DIA.HasTransform
+ (positionToVector position)
+ G2D.Transform,
+ hasTypedProperty
+ G2D.HasStrokeWidth
+ strokeWidth
+ L0.Double,
+ hasStatement
+ G2D.HasHorizontalAlignment
+ (alignmentToResource hAlign),
+ hasStatement
+ G2D.HasVerticalAlignment
+ (alignmentToResource vAlign),
+ hasFont font
+ ]
+ createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
+ 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
+ Just $ newEntity [
+ hasName (freshElementName ()),
+ hasType DIA.Monitor,
+ hasProperty
+ L0.HasLabel
+ label,
+ hasProperty
+ DIA.HasMonitorSuffix
+ suffix,
+ hasStatement DIA.HasMonitorComponent component,
+ hasTypedProperty
+ DIA.HasTransform
+ (positionToVector position)
+ G2D.Transform,
+ hasTypedProperty
+ G2D.HasStrokeWidth
+ strokeWidth
+ L0.Double,
+ hasStatement
+ G2D.HasHorizontalAlignment
+ (alignmentToResource hAlign),
+ hasStatement
+ G2D.HasVerticalAlignment
+ (alignmentToResource vAlign),
+ hasFont font
+ ]
+ createElement (Text elementType text (TextVisuals font hAlign vAlign) position) =
+ Just $ newEntity [
+ hasName (freshElementName ()),
+ hasType elementType,
+ hasProperty
+ DIA.HasText
+ text,
+ hasTypedProperty
+ DIA.HasTransform
+ (positionToVector position)
+ G2D.Transform,
+ hasStatement
+ G2D.HasHorizontalAlignment
+ (alignmentToResource hAlign),
+ hasStatement
+ G2D.HasVerticalAlignment
+ (alignmentToResource vAlign),
+ hasFont font
+ ]
+ setConnectionName (Connection _ _ (Just name), element) =
+ match possibleObject element MOD.ElementToComponent with
+ Just c -> claimRelatedValue c L0.HasName name
+ Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
+ setConnectionName (SimpleConnection _ _ _ _ (Just name), element) =
+ match possibleObject element MOD.ElementToComponent with
+ Just c -> claimRelatedValue c L0.HasName name
+ Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
+ setConnectionName (Flag _ name _ _ _ _ _ _ _, element) =
+ match possibleObject element MOD.ElementToComponent with
+ Just c -> claimRelatedValue c L0.HasName name
+ Nothing -> () // This is a typical case
+ setConnectionName _ = ()
+ flagTypeToAttachmentRelation flag = match possibleObject flag DIA.HasFlagType with
+ Just DIA.FlagType.OutputFlag -> DIA.HasArrowConnector
+ otherwise -> DIA.HasPlainConnector
+
+"""Returns a diagram in the given model with the given model relative path."""
+diagram :: Model -> [String] -> <ReadGraph> Diagram
+diagram model path =
+ foldl
+ (\r name -> match possibleResourceChild r name with
+ Just c -> c
+ Nothing -> fail ("Didn't find " + name + ".")
+ )
+ (configurationOf model) path
+
+possibleDiagram :: Model -> [String] -> <ReadGraph> (Maybe Diagram)
+possibleDiagram model path =
+ foldl
+ (\r name -> match r with
+ Just p -> possibleResourceChild p name
+ Nothing -> Nothing
+ )
+ (Just (configurationOf model)) path
+
+/*
+"""FIXME: doesn't work anymore with the elementsOfR spec
+elementsOf :: Diagram -> <ReadGraph> [DiagramElement String]
+elementsOf diagram = map (mapDiagramElement nameOf mapTerminal possibleNameOf nameOf)
+ $ elementsOfR diagram
+ where
+ nameOf r = relatedValue r L0.HasName
+ mapTerminal r = do
+ name = nameOf r
+ if name == "ConnectionPoint" &&
+ r == DIA.Flag.ConnectionPoint
+ then "FlagTerminal"
+ else name
+*/
+
+"""Returns the elements of the given diagram."""
+elementsOfR :: Diagram -> <ReadGraph> [(DiagramElement Resource, Resource)]
+elementsOfR diagram = filterJust $ map readElement'
+ (diagramResourceOf diagram # L0.ConsistsOf)
+ where
+ readElement' element = match readElement element with
+ Just el -> Just (el, element)
+ Nothing -> Nothing
+ readElement element =
+ if element `isInstanceOf` DIA.Flag
+ then readFlag element
+ else if element `isInstanceOf` DIA.SVGElement
+ then readSVG element
+ else if element `isInstanceOf` DIA.Monitor
+ then readMonitor element
+ else if element `isInstanceOf` DIA.RouteGraphConnection
+ then readConnection element
+ else if element `isInstanceOf` DIA.TextElement
+ then readText element
+ else if element `isInstanceOf` DIA.Element
+ then readComponent element
+ else Nothing
+ readFlag flag = Just $ Flag
+ (singleTypeOf
+ flag
+ DIA.Flag)
+ (idOf flag)
+ (labelOf flag)
+ (existsStatement3 flag DIA.HasFlagType DIA.FlagType.OutputFlag)
+ (existsStatement flag DIA.ExternalFlag)
+ ((possibleRelatedString flag DIA.Flag.HasIOTableBinding) :: (Maybe String))
+ ((possibleRelatedInteger flag DIA.Flag.HasIOTableRowIndex) :: (Maybe Integer))
+ (transformOf flag)
+ (map toDynamic $ flag # DIA.FlagIsJoinedBy)
+ readComponent element = do
+ component = singleObject
+ element
+ MOD.ElementToComponent
+ Just (Component
+ (singleTypeOf
+ element
+ DIA.Element)
+ (nameOf component)
+ (transformOf element)
+ (readAttributes component))
+ readSVG element = do
+ Just (SVG
+ (relatedValue element G2D.HasSVGDocument)
+ (transformOf element)
+ )
+ readMonitor element = do
+ font = readFont element (singleObject element DIA.HasFont)
+ hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
+ vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
+ label = (relatedValue2 element L0.HasLabel)
+ strokeWidth = relatedValueWithDefault (-1.0) element G2D.HasStrokeWidth
+ transform = (transformOf element)
+ match (existsStatement element DIA.HasMonitorSuffix) with
+ True -> do
+ suffix = (relatedValue element DIA.HasMonitorSuffix)
+ monitorComponent = (singleObject element DIA.HasMonitorComponent)
+ componentName = relatedValue monitorComponent L0.HasName
+ Just (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) transform)
+ False -> Just (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) transform)
+ readText element = do
+ elementType = singleTypeOf element DIA.Element
+ font = readPossibleFont element
+ hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
+ vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
+ text = relatedValueWithDefault "" element DIA.HasText
+ transform = (transformOf element)
+ Just (Text elementType text (TextVisuals font hAlign vAlign) transform)
+ readPossibleFont element =
+ match possibleObject element DIA.HasFont with
+ Just f -> readFont element f
+ Nothing -> Nothing
+ readFont element font = do
+ if font `isInstanceOf` DIA.RealizedFont
+ then do
+ family = (relatedValue font DIA.RealizedFont.HasFamily)
+ size = (relatedValue font DIA.RealizedFont.HasSize)
+ style = (relatedValue font DIA.RealizedFont.HasStyle)
+ Just (Font family size style)
+ else Nothing
+ readAttributes component = let
+ allPredicates = map objectOf (statements (singleTypeOf component L0.Entity) L0.DomainOf)
+ is p = isSubrelationOf p L0.HasProperty
+ hasPropertyPredicates = filter is allPredicates
+ propertyStatements = map (singleStatement component) hasPropertyPredicates
+ p stm = match (untypedPossibleValueOf (objectOf stm)) with
+ Just v -> Just (Property (predicateOf stm) v)
+ _ -> Nothing
+ in mapMaybe p propertyStatements
+
+ readConnection element = do
+ connectors = element # DIA.HasConnector
+ routeLines = element # DIA.HasInteriorRouteNode
+ nodes = map (readConnector element) connectors
+ + map readRouteLine routeLines
+
+ nodeResources = connectors + routeLines
+ nodeResourceWithIds = zip nodeResources [0..length nodeResources-1]
+ edges = runProc do
+ rMap = MMap.fromEntryList nodeResourceWithIds
+ edgesOf (node,i) =
+ [ Edge i j
+ | r <- node # DIA.AreConnected
+ , j = MMap.unsafeGet rMap r
+ , j > i ]
+ concatMap edgesOf nodeResourceWithIds
+
+ Just $ Connection nodes edges (readConnectionName element)
+ readConnectionName element =
+ match possibleObject element MOD.ElementToComponent with
+ Just c -> possibleNameOf c
+ Nothing -> Nothing
+ readConnector connection r = Terminal
+ (idOf $ objectOf stat)
+ (inverseOf $ predicateOf stat)
+ where
+ stat = [ stat
+ | stat <- statements r STR.Connects
+ , objectOf stat != connection
+ ]!0
+ readRouteLine r = RouteLine
+ (relatedValue r DIA.IsHorizontal)
+ (relatedValue r DIA.HasPosition)
+ nameOf r = relatedValue r L0.HasName
+ labelOf r = relatedValue2 r L0.HasLabel
+ idOf r = match possibleObject r MOD.ElementToComponent with
+ Just c -> nameOf c
+ Nothing -> if r `isInstanceOf` DIA.Flag
+ then "FLAG_" + nameOf r
+ else fail ("Element " + show r + " was not mapped to a component.")
+
+importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
+ """Takes one connection element and returns possible diagram type."""
+ determineConnectionType :: Resource -> <ReadGraph> Maybe Resource
+
+ rotateConnection :: Resource -> Double -> Double -> Boolean -> <WriteGraph> ()
+ flipConnection :: Resource -> Boolean -> Double -> <WriteGraph> ()
+
+applyDiagramMapping :: Resource -> <Proc,WriteGraph> ()
+applyDiagramMapping diagram = do
+ syncActivateOnce diagram
+ ()
+
+"""Returns the diagram flag type resource used for all generic diagram flags."""
+genericFlagType :: () -> <ReadGraph> Resource
+genericFlagType _ = DIA.Flag
+
+/* Use functions in Simantics/PageSettings
+importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
+ @JavaName setPageBordersVisible
+ setPageBordersVisible :: Diagram -> Boolean -> <WriteGraph> ()
+
+ @JavaName setMarginsVisible
+ setMarginsVisible :: Diagram -> Boolean -> <WriteGraph> ()
+*/
+importJava "org.simantics.modeling.typicals.TypicalUtil" where
+ @JavaName newMasterTypical
+ newTypicalDiagram :: Library -> Diagram
+
+ @JavaName syncTypicalInstance
+ syncTypicalInstance :: Resource -> <WriteGraph> ()
+
+syncActivateDiagram :: Diagram -> <WriteGraph, Proc> Boolean
+syncActivateDiagram composite = do
+ diagram = compositeToDiagram' composite
+ syncActivateOnce diagram
+ True
+
+// --- Diagrams ---------------------------------------------------
+
+importJava "org.simantics.structural2.utils.StructuralUtils" where
+ @JavaName newComponent
+ createComposite__ :: Configuration -> String -> Resource -> <WriteGraph> Diagram
+
+compositeToDiagram :: Resource -> <ReadGraph> Diagram
+compositeToDiagram c = singleObject c MOD.CompositeToDiagram
+
+createComposite :: Configuration -> String -> Resource -> <WriteGraph> Diagram
+createComposite diagramFolder name compositeType = do
+ newName = findFreshName name diagramFolder
+ createComposite__ diagramFolder newName compositeType
+
+elementToComponent :: Element -> <ReadGraph> Component
+elementToComponent element = singleObject element MOD.ElementToComponent
+
+componentToElement :: Component -> <ReadGraph> Element
+componentToElement component = singleObject component MOD.ComponentToElement
+
+getConnections :: Diagram -> <ReadGraph> [Resource]
+getConnections diagram = [object | object <- (compositeToDiagram diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection]
+
+getConnection :: Diagram -> String -> <ReadGraph> [Resource]
+getConnection diagram name = do
+ connections = getConnections diagram
+ filter (\x -> relatedValue2 x L0.HasName == name) connections
+
+setTransform :: Resource -> DoubleArray -> <WriteGraph> ()
+setTransform element transform = claimRelatedValueWithType element DIA.HasTransform G2D.Transform transform
+
+"""
+ transformElement transformer element
+
+Performs the affine transformation encapsulated by `transformer` for the specified
+diagram `element`.
+
+For examples of possible transformer functions, see [scaleTransform](#scaleTransform)
+and [transformWithScale](#transformWithScale).
+"""
+transformElement :: (Position -> Position) -> Resource -> <WriteGraph> ()
+transformElement transformer element =
+ claimRelatedValue element DIA.HasTransform (positionToVector (transformer (transformOf element)))
+
+"""
+ transformElements transformer elements
+
+Runs [transformElement](#transformElement) using the specified transformer for
+all the specified `elements`.
+
+Use this function together with e.g. [scaleTransform](#scaleTransform) and
+[transformWithScale](#transformWithScale) or similar functions.
+
+Examples:
+
+ import "Simantics/Diagram"
+
+ // Scale some elements by 1.5:
+ transformElements (scale 1.5) someElements
+ // Set scale of some elements to 10
+ transformElements (withScale 10) someElements
+"""
+transformElements :: (Position -> Position) -> [Resource] -> <WriteGraph> ()
+transformElements transformer elements = for elements $ transformElement transformer
+
+importJava "org.simantics.modeling.svg.CreateSVGElement" where
+ createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> ()
+ createSVGElementR :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> Resource
+
+ importSVGElement :: Resource -> File -> Double -> Double -> <WriteGraph> ()
+ importSVGElementR :: Resource -> File -> Double -> Double -> <WriteGraph> Resource
+
+importJava "org.simantics.diagram.synchronization.graph.RemoveElement" where
+ removeElement :: Resource -> Resource -> <WriteGraph> ()
+
+setStraightConnectionLines :: Resource -> Boolean -> <WriteGraph> ()
+setStraightConnectionLines element v =
+ for (element # STR.IsConnectedTo) $ \connector ->
+ claimRelatedValue connector DIA.Connector.straight v
+
+showProfileMonitors :: Resource -> Boolean -> <WriteGraph> ()
+showProfileMonitors element v = claimRelatedValue element DIA.Element.hideProfileMonitors (not v)
+
+setProfileMonitorsDirectionUp :: Resource -> Boolean -> <WriteGraph> ()
+setProfileMonitorsDirectionUp element v = claimRelatedValue element DIA.Element.upProfileMonitors v
+
+importJava "org.simantics.diagram.flag.Joiner" where
+ joinFlagsLocal :: [Resource] -> <WriteGraph> ()
+
+importJava "org.simantics.diagram.flag.RouteGraphConnectionSplitter" where
+ splitConnection :: Resource -> Double -> Double -> <WriteGraph> ()
+
+importJava "org.simantics.diagram.handler.CopyPasteUtil" where
+ moveConnection :: Resource -> Double -> Double -> <WriteGraph> ()
+
+importJava "org.simantics.diagram.content.ConnectionUtil" where
+ translateRouteNodes :: Resource -> Double -> Double -> <WriteGraph> ()
+
+importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
defaultSymbolDropHandler :: [WorkbenchSelectionElement] -> <WriteGraph> ()
\ No newline at end of file
Code Review / simantics / platform.git / blobdiff