1 include "Simantics/Model"
\r
2 include "Simantics/WorkbenchSelection"
\r
3 include "Simantics/Library"
\r
5 import "Simantics/GUID" as GUID
\r
7 import "http://www.simantics.org/Layer0-1.1" as L0
\r
8 import "http://www.simantics.org/Diagram-2.2" as DIA
\r
9 import "http://www.simantics.org/G2D-1.1" as G2D
\r
10 import "http://www.simantics.org/Modeling-1.2" as MOD
\r
11 import "http://www.simantics.org/Simulation-1.1" as SIMU
\r
12 import "http://www.simantics.org/Structural-1.2" as STR
\r
14 // --- Entity types -------------------------------------------------
\r
16 type Diagram = Resource
\r
17 type DiagramFolder = Resource
\r
18 type Component = Resource
\r
19 type Element = Resource
\r
20 type ComponentType = Resource
\r
21 type Terminal = Resource
\r
22 type Connection = Resource
\r
23 type ConnectionType = Resource
\r
25 // --- Position -----------------------------------------------------
\r
27 data Position = Position Double Double Double Double Double Double
\r
29 deriving instance Show Position
\r
31 location :: Double -> Double -> Position
\r
32 location x y = Position 1 0 0 1 x y
\r
34 move :: (Double,Double) -> Position -> Position
\r
35 move (dx,dy) (Position xx xy yx yy x y) = Position xx xy yx yy (x+dx) (y+dy)
\r
37 rotate :: Integer -> Position -> Position
\r
38 rotate angle (Position xx xy yx yy x y) =
\r
39 Position (c*xx + s*xy) (c*xy - s*xx)
\r
40 (c*yx + s*yy) (c*yy - s*yx)
\r
44 then (angle `mod` 4) + 4
\r
46 s = match a with 1 -> 1.0 ; 3 -> -1.0 ; _ -> 0.0
\r
47 c = match a with 0 -> 1.0 ; 2 -> -1.0 ; _ -> 0.0
\r
49 scale :: Double -> Position -> Position
\r
50 scale s (Position xx xy yx yy x y) = Position (s*xx) (s*xy) (s*yx) (s*yy) x y
\r
52 flipX :: Position -> Position
\r
53 flipX (Position xx xy yx yy x y) = Position (-xx) xy (-yx) yy x y
\r
55 flipY :: Position -> Position
\r
56 flipY (Position xx xy yx yy x y) = Position xx (-xy) yx (-yy) x y
\r
58 positionToDoubleArray (Position a b c d e f) = toDoubleArray [a,b,c,d,e,f]
\r
60 // --- Diagram element data types -----------------------------------
\r
62 data Property res = Property res Dynamic
\r
63 instance (Show res) => Show (Property res) where
\r
64 show (Property r _) = "Property " + show r
\r
66 data Edge = Edge Integer Integer
\r
67 deriving instance Show Edge
\r
68 data ConnectionNode res = Terminal String res
\r
70 Boolean // is horizontal
\r
72 deriving instance (Show res) => Show (ConnectionNode res)
\r
74 data Font = Font String Integer Integer
\r
75 deriving instance Show Font
\r
82 deriving instance Show Alignment
\r
84 resourceToAlignment res = match (possibleNameOf res) with
\r
85 Just "Baseline" -> Baseline
\r
86 Just "Center" -> Center
\r
87 Just "Leading" -> Leading
\r
88 Just "Trailing" -> Trailing
\r
89 _ -> fail ("Couldn't convert " + show res + " to Alignment.")
\r
91 alignmentToResource Baseline = G2D.Alignment.Baseline
\r
92 alignmentToResource Center = G2D.Alignment.Center
\r
93 alignmentToResource Leading = G2D.Alignment.Leading
\r
94 alignmentToResource Trailing = G2D.Alignment.Trailing
\r
96 data MonitorReference = MonitorReference String String
\r
97 deriving instance Show MonitorReference
\r
99 data MonitorVisuals = MonitorVisuals (Maybe Font) Double Alignment Alignment
\r
100 deriving instance Show MonitorVisuals
\r
102 data TextVisuals = TextVisuals (Maybe Font) Alignment Alignment
\r
103 deriving instance Show TextVisuals
\r
105 data DiagramElement res =
\r
107 res // component type
\r
109 Position // position
\r
110 [Property res] // properties
\r
111 | SimpleConnection String res String res (Maybe String)
\r
112 | Connection [ConnectionNode res] [Edge] (Maybe String)
\r
118 Boolean // external
\r
119 (Maybe String) // IOTableBinding
\r
120 (Maybe Integer) // IOTableRowIndex
\r
121 Position // position
\r
122 [Dynamic] // references to the joins
\r
123 | SVG String Position
\r
124 | Monitor String (Maybe MonitorReference) MonitorVisuals Position
\r
126 Resource // element type
\r
127 String // Text shown by the element
\r
128 TextVisuals // text element visual attributes
\r
129 Position // position on diagram
\r
130 deriving instance (Show res) => Show (DiagramElement res)
\r
132 // --- Functions ----------------------------------------------------
\r
134 """Creates a random GUID L0.identifier property for the specified entity resource."""
\r
136 hasRandomIdentifier :: Resource -> <ReadGraph,WriteGraph> ()
\r
137 hasRandomIdentifier entity = runProc (claimRelatedValue_ entity L0.identifier GUID.randomGUID GUID.guidBinding)
\r
139 """Returns all diagrams of the given model."""
\r
140 diagramsOf :: Model -> <ReadGraph> [Diagram]
\r
141 diagramsOf model = recurse
\r
143 (toResource (configurationOf model))
\r
146 cs = resourceChildrenOf r
\r
147 dias = map fromResource $ filter isDiagramComposite cs
\r
148 folders = filter (not . isDiagramComposite) cs
\r
149 dias + concatMap (recurse t) folders
\r
150 isDiagramComposite r = existsStatement r MOD.CompositeToDiagram
\r
152 """Returns a model relative path of the given diagram."""
\r
153 pathOf :: Diagram -> <ReadGraph> [String]
\r
154 pathOf diagram = map nameOf $ unfoldl aux $ toResource diagram
\r
156 aux r = if existsStatement r SIMU.IsConfigurationOf
\r
159 parents = r # L0.PartOf
\r
160 if length parents == 1
\r
161 then Just (r, parents!0)
\r
163 nameOf r = relatedValue r $ L0.HasName
\r
165 pathNameOf :: Diagram -> <ReadGraph> String
\r
166 pathNameOf diagram = do
\r
167 path = pathOf diagram
\r
168 foldl1 (\s s1 -> s + " / " + s1) path
\r
171 diagramResourceOf :: Diagram -> <ReadGraph> Resource
\r
172 diagramResourceOf d = singleObject (toResource d) MOD.CompositeToDiagram
\r
174 import "Extras/HashMap" as Map
\r
176 """Constructs a transformation for a diagram element."""
\r
177 mapDiagramElement :: (a -> <e> b) -> (a -> <e> b) -> (a -> <e> Maybe b) -> (a -> <e> b) -> DiagramElement a -> <e> DiagramElement b
\r
178 mapDiagramElement mapComponentType mapTerminal mapAttribute mapFlagType diagramElement =
\r
179 (match diagramElement with
\r
180 Component componentType name position properties -> do
\r
181 Component (mapComponentType componentType) name position
\r
182 (filterJust (map mapProperty properties))
\r
183 SimpleConnection e1 r1 e2 r2 possibleName ->
\r
184 SimpleConnection e1 (mapTerminal r1) e2 (mapTerminal r2) possibleName
\r
185 Connection nodes edges possibleName ->
\r
187 (map mapConnectionNode nodes)
\r
189 Flag t e e2 e3 e4 e5 p p2 joins -> Flag (mapFlagType t) e e2 e3 e4 e5 p p2 joins
\r
191 Monitor label ref visuals position -> Monitor label ref visuals position
\r
192 Text elementType text visuals position -> Text elementType text visuals position
\r
194 mapProperty (Property p v) =
\r
195 match (mapAttribute p) with
\r
196 Just mp -> Just (Property mp v)
\r
198 mapConnectionNode (Terminal e r) = Terminal e (mapTerminal r)
\r
199 mapConnectionNode (RouteLine iv p) = RouteLine iv p
\r
201 importJava "org.simantics.structural2.utils.StructuralUtils" where
\r
202 @JavaName newComponent
\r
203 createComposite_ :: Resource -> String -> Resource -> <WriteGraph> Resource
\r
205 data DiagramSpec = NewDiagram
\r
207 [String] // path to the diagram
\r
208 Resource // folder type
\r
209 Resource // composite type
\r
210 | ExistingDiagram Diagram
\r
212 compositeToDiagram' c = singleObject c MOD.CompositeToDiagram
\r
214 """Creates or modifies an existing diagram to contain the given diagram elements."""
\r
215 createDiagramR :: DiagramSpec -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <WriteGraph> (Diagram, [Resource])
\r
216 createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do
\r
217 configuration = toResource diagram'
\r
218 diagram = compositeToDiagram' configuration
\r
219 hasName = L0.HasName
\r
220 componentMap = Map.fromList [ (c `relatedValue` hasName :: String, c)
\r
221 | c <- resourceChildrenOf configuration
\r
223 denyByPredicate diagram L0.ConsistsOf
\r
224 elements = setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs
\r
225 claimRelatedValue diagram DIA.HasModCount
\r
226 (fromInteger (length elements) :: Long)
\r
227 (diagram', elements)
\r
229 createDiagramR (NewDiagram model path folderType compositeType) joinMap elementSpecs = (runProc do
\r
230 configuration = createConfiguration ()
\r
231 diagram = compositeToDiagram' configuration
\r
232 elements = setElements (DiagramInfo diagram configuration (Map.create ())) joinMap elementSpecs
\r
233 claimRelatedValue diagram DIA.HasModCount
\r
234 (fromInteger (length elements) :: Long)
\r
235 (fromResource configuration, elements)
\r
237 createConfiguration () = do
\r
238 lastId = length path - 1
\r
239 parentFolder = foldl (\p id -> getOrCreateFolder p (path!id))
\r
240 (toResource (configurationOf model))
\r
242 createComposite_ parentFolder (path!lastId) compositeType
\r
243 getOrCreateFolder parentFolder name =
\r
244 match possibleResourceChild parentFolder name with
\r
245 Just child -> child
\r
247 createComposite_ parentFolder name folderType
\r
249 claimFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource
\r
250 claimFolder model path folderType = do
\r
251 lastId = length path
\r
252 foldl (\p id -> getOrCreateFolder p folderType (path!id))
\r
253 (toResource (configurationOf model))
\r
256 claimModelFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource
\r
257 claimModelFolder model path folderType = do
\r
258 lastId = length path
\r
259 foldl (\p id -> getOrCreateFolder p folderType (path!id))
\r
260 (toResource model)
\r
263 getOrCreateFolder :: Resource -> Resource -> String -> <Proc,WriteGraph> Resource
\r
264 getOrCreateFolder parentFolder folderType name = do
\r
265 match possibleResourceChild parentFolder name with
\r
266 Just child -> child
\r
268 createComposite_ parentFolder name folderType
\r
270 relatedValueWithDefault :: Serializable a => a -> Resource -> Resource -> <ReadGraph> a
\r
271 relatedValueWithDefault def r p =
\r
272 if existsStatement r p
\r
273 then relatedValue r p
\r
276 applyConnectionType :: Resource -> <Proc,WriteGraph,ReadGraph> ()
\r
277 applyConnectionType res = do
\r
278 t = determineConnectionType res
\r
280 Just t -> claim res STR.HasConnectionType t
\r
281 Nothing -> print ("No connection type " + (show res))
\r
284 importJava "org.simantics.modeling.utils.JoinMap" where
\r
286 createJoinMap :: () -> <Proc> (Dynamic -> <WriteGraph> Resource)
\r
289 createJoin :: (Dynamic -> <WriteGraph> Resource) -> Dynamic -> <Proc,WriteGraph> Resource
\r
290 createJoin joinMap key = if Map.contains joinMap key
\r
291 then Map.unsafeGet joinMap key
\r
294 hasType STR.ConnectionJoin
\r
296 Map.put joinMap key j
\r
299 data DiagramInfo = DiagramInfo
\r
300 Resource // diagram
\r
301 Resource // configuration
\r
302 (Map.T String Resource) // existing components
\r
305 Sets the elements of the diagram. Diagram is assumed to be empty,
\r
306 but the configuration may contain existing components that can be found
\r
307 from the given existing components map.
\r
309 setElements :: DiagramInfo -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <Proc,WriteGraph> [Resource]
\r
310 setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs = (do
\r
311 /*elements = map createElement (filter (not . isConnection) elementSpecs)
\r
312 + map createElement (filter isConnection elementSpecs)*/
\r
313 elements = mapMaybe createElement elementSpecs
\r
315 (claim diagram L0.ConsistsOf)
\r
316 setOrderedSet diagram elements
\r
317 iter applyConnectionType (filter isConnectionResource elements)
\r
318 syncActivateOnce diagram
\r
319 for (zip elementSpecs elements) setConnectionName
\r
322 elementMap = Map.create ()
\r
323 idRef = ref (0 :: Integer)
\r
325 isConnectionResource r = isInstanceOf r DIA.Connection
\r
326 isConnection (Connection _ _ _) = True
\r
327 isConnection (SimpleConnection _ _ _ _ _) = True
\r
328 isConnection _ = False
\r
330 freshElementName () = do
\r
334 createElement (Component componentType name position properties) = do
\r
335 component = if Map.contains componentMap name
\r
336 then Map.unsafeGet componentMap name
\r
339 hasParent configuration,
\r
340 hasRandomIdentifier
\r
342 for properties (\(Property prop value) ->
\r
343 untypedClaimRelatedValue component prop value
\r
345 element = newOrMappedElement name
\r
346 element = updateEntity element [
\r
347 hasName (freshElementName ()),
\r
348 hasType componentType,
\r
351 (positionToDoubleArray position)
\r
354 MOD.ElementToComponent
\r
357 Map.put elementMap name element
\r
359 newOrMappedElement eName = do
\r
360 element = match Map.get elementMap eName with
\r
361 Just element -> element
\r
362 Nothing -> newEntity []
\r
363 Map.put elementMap eName element
\r
365 createElement (SimpleConnection aName ar bName br _) = do
\r
366 connection = newEntity [
\r
367 hasName (freshElementName ()),
\r
368 hasType DIA.RouteGraphConnection
\r
370 a = newOrMappedElement aName
\r
371 b = newOrMappedElement bName
\r
372 ca = createConnector connection a ar
\r
373 cb = createConnector connection b br
\r
376 createElement (Flag t name label output external tableBinding tableRow position joins) = do
\r
377 flag = newOrMappedElement name
\r
378 flag = updateEntity flag [
\r
379 hasName (freshElementName ()),
\r
384 (positionToDoubleArray position)
\r
386 hasPossibleProperty
\r
387 DIA.Flag.HasIOTableBinding
\r
389 hasPossibleProperty
\r
390 DIA.Flag.HasIOTableRowIndex
\r
393 iter (\jRef -> claim
\r
401 claim flag DIA.HasFlagType DIA.FlagType.OutputFlag
\r
405 claim flag DIA.ExternalFlag flag
\r
407 Map.put elementMap name flag
\r
409 createElement (Connection nodeSpecs edges _) = do
\r
410 connection = newEntity [
\r
411 hasName (freshElementName ()),
\r
412 hasType DIA.RouteGraphConnection
\r
415 nodes = map (createNode connection) nodeSpecs
\r
416 for edges (\(Edge a b) -> connectNodes (nodes!a) (nodes!b))
\r
418 createNode connection (Terminal elementName terminal) = do
\r
419 element = newOrMappedElement elementName
\r
420 createConnector connection element terminal
\r
421 createNode connection (RouteLine isHorizontal position) = do
\r
423 hasName (freshElementName ()),
\r
424 hasType DIA.RouteLine,
\r
425 hasProperty DIA.HasPosition
\r
427 hasProperty DIA.IsHorizontal
\r
429 hasStatement DIA.HasInteriorRouteNode.Inverse
\r
432 createConnector connection component terminal = do
\r
433 connector = newResource ()
\r
437 claim component terminal connector
\r
439 DIA.HasPlainConnector
\r
442 connectNodes a b =
\r
443 claim a DIA.AreConnected b
\r
444 createElement (SVG document position) =
\r
446 hasName (freshElementName ()),
\r
447 hasType DIA.SVGElement,
\r
453 (positionToDoubleArray position)
\r
456 createRealizedFont (Font family size style) = do
\r
457 font = newResource ()
\r
461 claimRelatedValue font DIA.RealizedFont.HasFamily family
\r
462 claimRelatedValue font DIA.RealizedFont.HasSize size
\r
463 claimRelatedValue font DIA.RealizedFont.HasStyle style
\r
465 hasFont (Just font) = hasStatement DIA.HasFont (createRealizedFont font)
\r
466 hasFont Nothing = const ()
\r
467 createElement (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
\r
469 hasName (freshElementName ()),
\r
470 hasType DIA.Monitor,
\r
476 (positionToDoubleArray position)
\r
483 G2D.HasHorizontalAlignment
\r
484 (alignmentToResource hAlign),
\r
486 G2D.HasVerticalAlignment
\r
487 (alignmentToResource vAlign),
\r
490 createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
\r
491 match (Map.get elementMap componentName) with
\r
492 Nothing -> Nothing // Monitored component is not on the same diagram as the monitor. Not supported by this routine.
\r
494 component = singleObject element MOD.ElementToComponent
\r
496 hasName (freshElementName ()),
\r
497 hasType DIA.Monitor,
\r
502 DIA.HasMonitorSuffix
\r
504 hasStatement DIA.HasMonitorComponent component,
\r
507 (positionToDoubleArray position)
\r
514 G2D.HasHorizontalAlignment
\r
515 (alignmentToResource hAlign),
\r
517 G2D.HasVerticalAlignment
\r
518 (alignmentToResource vAlign),
\r
521 createElement (Text elementType text (TextVisuals font hAlign vAlign) position) =
\r
523 hasName (freshElementName ()),
\r
524 hasType elementType,
\r
530 (positionToDoubleArray position)
\r
533 G2D.HasHorizontalAlignment
\r
534 (alignmentToResource hAlign),
\r
536 G2D.HasVerticalAlignment
\r
537 (alignmentToResource vAlign),
\r
540 setConnectionName (Connection _ _ (Just name), element) =
\r
541 match possibleObject element MOD.ElementToComponent with
\r
542 Just c -> claimRelatedValue c L0.HasName name
\r
543 Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
\r
544 setConnectionName (SimpleConnection _ _ _ _ (Just name), element) =
\r
545 match possibleObject element MOD.ElementToComponent with
\r
546 Just c -> claimRelatedValue c L0.HasName name
\r
547 Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
\r
548 setConnectionName (Flag _ name _ _ _ _ _ _ _, element) =
\r
549 match possibleObject element MOD.ElementToComponent with
\r
550 Just c -> claimRelatedValue c L0.HasName name
\r
551 Nothing -> () // This is a typical case
\r
552 setConnectionName _ = ()
\r
554 """Returns a diagram in the given model with the given model relative path."""
\r
555 diagram :: Model -> [String] -> <ReadGraph> Diagram
\r
556 diagram model path =
\r
557 fromResource $ foldl
\r
558 (\r name -> match possibleResourceChild r name with
\r
560 Nothing -> fail ("Didn't find " + name + ".")
\r
562 (toResource (configurationOf model)) path
\r
564 possibleDiagram :: Model -> [String] -> <ReadGraph> (Maybe Diagram)
\r
565 possibleDiagram model path =
\r
566 map fromResource (foldl
\r
567 (\r name -> match r with
\r
568 Just p -> possibleResourceChild p name
\r
569 Nothing -> Nothing
\r
571 (Just $ toResource (configurationOf model)) path)
\r
574 """FIXME: doesn't work anymore with the elementsOfR spec
\r
575 elementsOf :: Diagram -> <ReadGraph> [DiagramElement String]
\r
576 elementsOf diagram = map (mapDiagramElement nameOf mapTerminal possibleNameOf nameOf)
\r
577 $ elementsOfR diagram
\r
579 nameOf r = relatedValue r L0.HasName
\r
582 if name == "ConnectionPoint" &&
\r
583 r == DIA.Flag.ConnectionPoint
\r
584 then "FlagTerminal"
\r
588 """Returns the elements of the given diagram."""
\r
589 elementsOfR :: Diagram -> <ReadGraph> [(DiagramElement Resource, Resource)]
\r
590 elementsOfR diagram = filterJust $ map readElement'
\r
591 (diagramResourceOf diagram # L0.ConsistsOf)
\r
593 readElement' element = match readElement element with
\r
594 Just el -> Just (el, element)
\r
596 readElement element =
\r
597 if element `isInstanceOf` DIA.Flag
\r
598 then readFlag element
\r
599 else if element `isInstanceOf` DIA.SVGElement
\r
600 then readSVG element
\r
601 else if element `isInstanceOf` DIA.Monitor
\r
602 then readMonitor element
\r
603 else if element `isInstanceOf` DIA.RouteGraphConnection
\r
604 then readConnection element
\r
605 else if element `isInstanceOf` DIA.TextElement
\r
606 then readText element
\r
607 else if element `isInstanceOf` DIA.Element
\r
608 then readComponent element
\r
610 readFlag flag = Just $ Flag
\r
616 (existsStatement3 flag DIA.HasFlagType DIA.FlagType.OutputFlag)
\r
617 (existsStatement flag DIA.ExternalFlag)
\r
618 ((possibleRelatedString flag DIA.Flag.HasIOTableBinding) :: (Maybe String))
\r
619 ((possibleRelatedInteger flag DIA.Flag.HasIOTableRowIndex) :: (Maybe Integer))
\r
621 (map toDynamic $ flag # DIA.FlagIsJoinedBy)
\r
622 readComponent element = do
\r
623 component = singleObject
\r
625 MOD.ElementToComponent
\r
630 (nameOf component)
\r
631 (transformOf element)
\r
632 (readAttributes component))
\r
633 readSVG element = do
\r
635 (relatedValue element G2D.HasSVGDocument)
\r
636 (transformOf element)
\r
638 readMonitor element = do
\r
639 font = readFont element (singleObject element DIA.HasFont)
\r
640 hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
\r
641 vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
\r
642 label = (relatedValue2 element L0.HasLabel)
\r
643 strokeWidth = relatedValueWithDefault (-1.0) element G2D.HasStrokeWidth
\r
644 transform = (transformOf element)
\r
645 match (existsStatement element DIA.HasMonitorSuffix) with
\r
647 suffix = (relatedValue element DIA.HasMonitorSuffix)
\r
648 monitorComponent = (singleObject element DIA.HasMonitorComponent)
\r
649 componentName = relatedValue monitorComponent L0.HasName
\r
650 Just (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) transform)
\r
651 False -> Just (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) transform)
\r
652 readText element = do
\r
653 elementType = singleTypeOf element DIA.Element
\r
654 font = readPossibleFont element
\r
655 hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
\r
656 vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
\r
657 text = relatedValueWithDefault "" element DIA.HasText
\r
658 transform = (transformOf element)
\r
659 Just (Text elementType text (TextVisuals font hAlign vAlign) transform)
\r
660 readPossibleFont element =
\r
661 match possibleObject element DIA.HasFont with
\r
662 Just f -> readFont element f
\r
664 readFont element font = do
\r
665 if font `isInstanceOf` DIA.RealizedFont
\r
667 family = (relatedValue font DIA.RealizedFont.HasFamily)
\r
668 size = (relatedValue font DIA.RealizedFont.HasSize)
\r
669 style = (relatedValue font DIA.RealizedFont.HasStyle)
\r
670 Just (Font family size style)
\r
672 readAttributes component = let
\r
673 allPredicates = map objectOf (statements (singleTypeOf component L0.Entity) L0.DomainOf)
\r
674 is p = isSubrelationOf p L0.HasProperty
\r
675 hasPropertyPredicates = filter is allPredicates
\r
676 propertyStatements = map (singleStatement component) hasPropertyPredicates
\r
677 p stm = match (untypedPossibleValueOf (objectOf stm)) with
\r
678 Just v -> Just (Property (predicateOf stm) v)
\r
680 in mapMaybe p propertyStatements
\r
682 readConnection element = do
\r
683 connectors = element # DIA.HasConnector
\r
684 routeLines = element # DIA.HasInteriorRouteNode
\r
685 nodes = map (readConnector element) connectors
\r
686 + map readRouteLine routeLines
\r
688 nodeResources = connectors + routeLines
\r
689 nodeResourceWithIds = zip nodeResources [0..length nodeResources-1]
\r
691 rMap = Map.fromList nodeResourceWithIds
\r
692 edgesOf (node,i) =
\r
694 | r <- node # DIA.AreConnected
\r
695 , j = Map.unsafeGet rMap r
\r
697 concatMap edgesOf nodeResourceWithIds
\r
699 Just $ Connection nodes edges (readConnectionName element)
\r
700 readConnectionName element =
\r
701 match possibleObject element MOD.ElementToComponent with
\r
702 Just c -> possibleNameOf c
\r
704 readConnector connection r = Terminal
\r
705 (idOf $ objectOf stat)
\r
706 (inverseOf $ predicateOf stat)
\r
709 | stat <- statements r STR.Connects
\r
710 , objectOf stat != connection
\r
712 readRouteLine r = RouteLine
\r
713 (relatedValue r DIA.IsHorizontal)
\r
714 (relatedValue r DIA.HasPosition)
\r
715 transformOf element = do
\r
716 da = fromDoubleArray $
\r
717 relatedValue element DIA.HasTransform
\r
718 Position (da!0) (da!1) (da!2) (da!3) (da!4) (da!5)
\r
719 nameOf r = relatedValue r L0.HasName
\r
720 labelOf r = relatedValue2 r L0.HasLabel
\r
721 idOf r = match possibleObject r MOD.ElementToComponent with
\r
723 Nothing -> if r `isInstanceOf` DIA.Flag
\r
724 then "FLAG_" + nameOf r
\r
725 else fail ("Element " + show r + " was not mapped to a component.")
\r
727 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
\r
728 """Takes one connection element and returns possible diagram type."""
\r
729 determineConnectionType :: Resource -> <ReadGraph> Maybe Resource
\r
731 rotateConnection :: Resource -> Double -> Double -> Boolean -> <WriteGraph> ()
\r
732 flipConnection :: Resource -> Boolean -> Double -> <WriteGraph> ()
\r
734 applyDiagramMapping :: Resource -> <Proc,WriteGraph> ()
\r
735 applyDiagramMapping diagram = do
\r
736 syncActivateOnce diagram
\r
739 """Returns the diagram flag type resource used for all generic diagram flags."""
\r
740 genericFlagType :: () -> <ReadGraph> Resource
\r
741 genericFlagType _ = DIA.Flag
\r
743 /* Use functions in Simantics/PageSettings
\r
744 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
\r
745 @JavaName setPageBordersVisible
\r
746 setPageBordersVisible :: Diagram -> Boolean -> <WriteGraph> ()
\r
748 @JavaName setMarginsVisible
\r
749 setMarginsVisible :: Diagram -> Boolean -> <WriteGraph> ()
\r
751 importJava "org.simantics.modeling.typicals.TypicalUtil" where
\r
752 @JavaName newMasterTypical
\r
753 newTypicalDiagram :: Library -> Diagram
\r
755 @JavaName syncTypicalInstance
\r
756 syncTypicalInstance :: Resource -> <WriteGraph> ()
\r
758 syncActivateDiagram :: Diagram -> <WriteGraph, Proc> Boolean
\r
759 syncActivateDiagram composite = do
\r
760 diagram = compositeToDiagram' $ toResource composite
\r
761 syncActivateOnce diagram
\r
764 // --- Diagrams ---------------------------------------------------
\r
766 importJava "org.simantics.structural2.utils.StructuralUtils" where
\r
767 @JavaName newComponent
\r
768 createComposite__ :: Configuration -> String -> Resource -> <WriteGraph> Diagram
\r
770 compositeToDiagram :: Resource -> <ReadGraph> Diagram
\r
771 compositeToDiagram c = fromResource (singleObject c MOD.CompositeToDiagram)
\r
773 createComposite :: Configuration -> String -> Resource -> <WriteGraph> Diagram
\r
774 createComposite diagramFolder name compositeType = do
\r
775 newName = findFreshName name (toResource diagramFolder)
\r
776 createComposite__ diagramFolder newName compositeType
\r
778 elementToComponent :: Element -> <ReadGraph> Component
\r
779 elementToComponent element = do
\r
780 component = singleObject (toResource element) MOD.ElementToComponent
\r
781 fromResource component
\r
783 componentToElement :: Component -> <ReadGraph> Element
\r
784 componentToElement component = do
\r
785 element = singleObject (toResource component) MOD.ComponentToElement
\r
786 fromResource element
\r
788 getConnections :: Diagram -> <ReadGraph> [Resource]
\r
789 getConnections diagram = [object | object <- (toResource $ compositeToDiagram $ toResource diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection]
\r
791 getConnection :: Diagram -> String -> <ReadGraph> [Resource]
\r
792 getConnection diagram name = do
\r
793 connections = getConnections diagram
\r
794 filter (\x -> relatedValue2 x L0.HasName == name) connections
\r
796 setTransform :: Resource -> DoubleArray -> <WriteGraph> ()
\r
797 setTransform element transform = claimRelatedValueWithType element DIA.HasTransform G2D.Transform transform
\r
799 importJava "org.simantics.modeling.svg.CreateSVGElement" where
\r
800 createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> ()
\r
802 importSVGElement :: Resource -> File -> Double -> Double -> <WriteGraph> ()
\r
804 importJava "org.simantics.diagram.synchronization.graph.RemoveElement" where
\r
805 removeElement :: Resource -> Resource -> <WriteGraph> ()
\r
807 setStraightConnectionLines :: Resource -> Boolean -> <WriteGraph> ()
\r
808 setStraightConnectionLines element v =
\r
809 for (element # STR.IsConnectedTo) $ \connector ->
\r
810 claimRelatedValue connector DIA.Connector.straight v
\r
812 showProfileMonitors :: Resource -> Boolean -> <WriteGraph> ()
\r
813 showProfileMonitors element v = claimRelatedValue element DIA.Element.hideProfileMonitors (not v)
\r
815 setProfileMonitorsDirectionUp :: Resource -> Boolean -> <WriteGraph> ()
\r
816 setProfileMonitorsDirectionUp element v = claimRelatedValue element DIA.Element.upProfileMonitors v
\r
818 importJava "org.simantics.diagram.flag.Joiner" where
\r
819 joinFlagsLocal :: [Resource] -> <WriteGraph> ()
\r
821 importJava "org.simantics.diagram.flag.RouteGraphConnectionSplitter" where
\r
822 splitConnection :: Resource -> Double -> Double -> <WriteGraph> ()
\r
824 importJava "org.simantics.diagram.handler.CopyPasteUtil" where
\r
825 moveConnection :: Resource -> Double -> Double -> <WriteGraph> ()
\r
827 importJava "org.simantics.diagram.content.ConnectionUtil" where
\r
828 translateRouteNodes :: Resource -> Double -> Double -> <WriteGraph> ()
\r
830 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
\r
831 defaultSymbolDropHandler :: [WorkbenchSelectionElement] -> <WriteGraph> ()