1 include "Simantics/Model"
2 include "Simantics/WorkbenchSelection"
3 include "Simantics/Library"
5 import "Simantics/GUID" as GUID
7 import "http://www.simantics.org/Layer0-1.1" as L0
8 import "http://www.simantics.org/Diagram-2.2" as DIA
9 import "http://www.simantics.org/G2D-1.1" as G2D
10 import "http://www.simantics.org/Modeling-1.2" as MOD
11 import "http://www.simantics.org/Simulation-1.1" as SIMU
12 import "http://www.simantics.org/Structural-1.2" as STR
14 // --- Entity types -------------------------------------------------
16 type Diagram = Resource
17 type DiagramFolder = Resource
18 type Component = Resource
19 type Element = Resource
20 type ComponentType = Resource
21 type Terminal = Resource
22 type Connection = Resource
23 type ConnectionType = Resource
25 // --- Position -----------------------------------------------------
28 Position xx xy yx yy tx ty
30 is a 2D affine transform with a rotation/scale/shear part,
31 i.e. `xx xy yx yy` and a translation part `tx ty` which
37 data Position = Position Double Double Double Double Double Double
39 deriving instance Show Position
44 Returns an affine transform with identity rotation and `x y` for translation.
46 location :: Double -> Double -> Position
47 location x y = Position 1 0 0 1 x y
52 Returns a function that adds `(dx, dy)` to the translation of a specified affine transform.
54 move :: (Double,Double) -> Position -> Position
55 move (dx,dy) (Position xx xy yx yy x y) = Position xx xy yx yy (x+dx) (y+dy)
60 Returns a function that rotates the specified affine transform by `n*90` degrees
62 rotate :: Integer -> Position -> Position
63 rotate angle (Position xx xy yx yy x y) =
64 Position (c*xx + s*xy) (c*xy - s*xx)
65 (c*yx + s*yy) (c*yy - s*yx)
69 then (angle `mod` 4) + 4
71 s = match a with 1 -> 1.0 ; 3 -> -1.0 ; _ -> 0.0
72 c = match a with 0 -> 1.0 ; 2 -> -1.0 ; _ -> 0.0
77 Multiplies the rotation part of the specified affine `transform` by `s`
80 [xx yx tx] => [s*xx s*yx tx]
81 [xy yy ty] [s*xy s*yy ty]
84 scale :: Double -> Position -> Position
85 scale s (Position xx xy yx yy x y) = Position (s*xx) (s*xy) (s*yx) (s*yy) x y
88 withScale scale transform
90 Sets the rotation part so that the base vectors defined by `u=[xx xy]` and `v=[yx yy]`
91 are of length `scale`. This effectively sets the scaling of the elements without
92 touching their rotation/shear.
98 [xx yx tx] => [su*xx sv*yx tx]
99 [xy yy ty] [su*xy sv*yy ty]
102 withScale :: Double -> Position -> Position
103 withScale scale (Position xx xy yx yy tx ty) = Position xx' xy' yx' yy' tx ty
105 su = scale / (sqrt (xx*xx + xy*xy))
106 sv = scale / (sqrt (yx*yx + yy*yy))
115 Performs a mirror operation for the specified `transform` about the Y-axis.
117 flipX :: Position -> Position
118 flipX (Position xx xy yx yy x y) = Position (-xx) xy (-yx) yy x y
123 Performs a mirror operation for the specified `transform` about the X-axis.
125 flipY :: Position -> Position
126 flipY (Position xx xy yx yy x y) = Position xx (-xy) yx (-yy) x y
129 Converts a [Position](#Position) into a `Vector Double`.
131 positionToDoubleArray (Position a b c d e f) = toDoubleArray [a,b,c,d,e,f]
134 Converts a [Position](#Position) into a `Vector Double`.
136 positionToVector :: Position -> Vector Double
137 positionToVector (Position a b c d e f) = runProc
138 (do r = createMVector 6
147 // --- Diagram element data types -----------------------------------
149 data Property res = Property res Dynamic
150 instance (Show res) => Show (Property res) where
151 show (Property r _) = "Property " + show r
153 data Edge = Edge Integer Integer
154 deriving instance Show Edge
155 data ConnectionNode res = Terminal String res
157 Boolean // is horizontal
159 deriving instance (Show res) => Show (ConnectionNode res)
161 data Font = Font String Integer Integer
162 deriving instance Show Font
169 deriving instance Show Alignment
171 resourceToAlignment res = match (possibleNameOf res) with
172 Just "Baseline" -> Baseline
173 Just "Center" -> Center
174 Just "Leading" -> Leading
175 Just "Trailing" -> Trailing
176 _ -> fail ("Couldn't convert " + show res + " to Alignment.")
178 alignmentToResource Baseline = G2D.Alignment.Baseline
179 alignmentToResource Center = G2D.Alignment.Center
180 alignmentToResource Leading = G2D.Alignment.Leading
181 alignmentToResource Trailing = G2D.Alignment.Trailing
183 data MonitorReference = MonitorReference String String
184 deriving instance Show MonitorReference
186 data MonitorVisuals = MonitorVisuals (Maybe Font) Double Alignment Alignment
187 deriving instance Show MonitorVisuals
189 data TextVisuals = TextVisuals (Maybe Font) Alignment Alignment
190 deriving instance Show TextVisuals
192 data DiagramElement res =
194 res // component type
197 [Property res] // properties
198 | SimpleConnection String res String res (Maybe String)
199 | Connection [ConnectionNode res] [Edge] (Maybe String)
206 (Maybe String) // IOTableBinding
207 (Maybe Integer) // IOTableRowIndex
209 [Dynamic] // references to the joins
210 | SVG String Position
211 | Monitor String (Maybe MonitorReference) MonitorVisuals Position
213 Resource // element type
214 String // Text shown by the element
215 TextVisuals // text element visual attributes
216 Position // position on diagram
217 deriving instance (Show res) => Show (DiagramElement res)
219 // --- Functions ----------------------------------------------------
222 transformOf element = Position (da!0) (da!1) (da!2) (da!3) (da!4) (da!5)
223 where da = relatedValue element DIA.HasTransform :: Vector Double
225 """Creates a random GUID L0.identifier property for the specified entity resource."""
227 hasRandomIdentifier :: Resource -> <ReadGraph,WriteGraph> ()
228 hasRandomIdentifier entity = runProc (claimRelatedValue_ entity L0.identifier GUID.randomGUID GUID.guidBinding)
230 """Returns all diagrams of the given model."""
231 diagramsOf :: Model -> <ReadGraph> [Diagram]
232 diagramsOf model = diagramsUnder $ configurationOf model
235 Returns all diagrams under the specified diagram folder.
236 The parameter can also be the configuration root `configurationOf`
237 in which case this function returns the same as `diagramsOf model`.
239 diagramsUnder :: DiagramFolder -> <ReadGraph> [Resource]
240 diagramsUnder folder = recurse DIA.Diagram folder
244 dias = filter isDiagramComposite cs
245 folders = filter (not . isDiagramComposite) cs
246 dias + concatMap (recurse t) folders
247 isDiagramComposite r = existsStatement r MOD.CompositeToDiagram
249 """Returns a model relative path of the given diagram."""
250 pathOf :: Diagram -> <ReadGraph> [String]
251 pathOf diagram = map nameOf $ unfoldl aux diagram
253 aux r = if existsStatement r SIMU.IsConfigurationOf
256 parents = r # L0.PartOf
257 if length parents == 1
258 then Just (r, parents!0)
260 nameOf r = relatedValue r $ L0.HasName
262 pathNameOf :: Diagram -> <ReadGraph> String
263 pathNameOf diagram = do
264 path = pathOf diagram
265 foldl1 (\s s1 -> s + " / " + s1) path
268 diagramResourceOf :: Diagram -> <ReadGraph> Resource
269 diagramResourceOf d = singleObject d MOD.CompositeToDiagram
271 """Constructs a transformation for a diagram element."""
272 mapDiagramElement :: (a -> <e> b) -> (a -> <e> b) -> (a -> <e> Maybe b) -> (a -> <e> b) -> DiagramElement a -> <e> DiagramElement b
273 mapDiagramElement mapComponentType mapTerminal mapAttribute mapFlagType diagramElement =
274 (match diagramElement with
275 Component componentType name position properties -> do
276 Component (mapComponentType componentType) name position
277 (filterJust (map mapProperty properties))
278 SimpleConnection e1 r1 e2 r2 possibleName ->
279 SimpleConnection e1 (mapTerminal r1) e2 (mapTerminal r2) possibleName
280 Connection nodes edges possibleName ->
282 (map mapConnectionNode nodes)
284 Flag t e e2 e3 e4 e5 p p2 joins -> Flag (mapFlagType t) e e2 e3 e4 e5 p p2 joins
286 Monitor label ref visuals position -> Monitor label ref visuals position
287 Text elementType text visuals position -> Text elementType text visuals position
289 mapProperty (Property p v) =
290 match (mapAttribute p) with
291 Just mp -> Just (Property mp v)
293 mapConnectionNode (Terminal e r) = Terminal e (mapTerminal r)
294 mapConnectionNode (RouteLine iv p) = RouteLine iv p
296 importJava "org.simantics.structural2.utils.StructuralUtils" where
297 @JavaName newComponent
298 createComposite_ :: Resource -> String -> Resource -> <WriteGraph> Resource
300 data DiagramSpec = NewDiagram
302 [String] // path to the diagram
303 Resource // folder type
304 Resource // composite type
305 | ExistingDiagram Diagram
307 compositeToDiagram' c = singleObject c MOD.CompositeToDiagram
309 """Creates or modifies an existing diagram to contain the given diagram elements."""
310 createDiagramR :: DiagramSpec -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <WriteGraph> (Diagram, [Resource])
311 createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do
312 configuration = diagram'
313 diagram = compositeToDiagram' configuration
315 componentMap = MMap.fromEntryList [ (c `relatedValue` hasName :: String, c)
316 | c <- children configuration
318 denyByPredicate diagram L0.ConsistsOf
319 elements = setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs
320 claimRelatedValue diagram DIA.HasModCount
321 (fromInteger (length elements) :: Long)
324 createDiagramR (NewDiagram model path folderType compositeType) joinMap elementSpecs = (runProc do
325 configuration = createConfiguration ()
326 diagram = compositeToDiagram' configuration
327 elements = setElements (DiagramInfo diagram configuration (MMap.create ())) joinMap elementSpecs
328 claimRelatedValue diagram DIA.HasModCount
329 (fromInteger (length elements) :: Long)
330 (configuration, elements)
332 createConfiguration () = do
333 lastId = length path - 1
334 parentFolder = foldl (\p id -> getOrCreateFolder p (path!id))
335 (configurationOf model)
337 createComposite_ parentFolder (path!lastId) compositeType
338 getOrCreateFolder parentFolder name =
339 match possibleResourceChild parentFolder name with
342 createComposite_ parentFolder name folderType
344 claimFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource
345 claimFolder model path folderType = do
347 foldl (\p id -> getOrCreateFolder p folderType (path!id))
348 (configurationOf model)
351 claimModelFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource
352 claimModelFolder model path folderType = do
354 foldl (\p id -> getOrCreateFolder p folderType (path!id))
358 getOrCreateFolder :: Resource -> Resource -> String -> <Proc,WriteGraph> Resource
359 getOrCreateFolder parentFolder folderType name = do
360 match possibleResourceChild parentFolder name with
363 createComposite_ parentFolder name folderType
365 relatedValueWithDefault :: Serializable a => a -> Resource -> Resource -> <ReadGraph> a
366 relatedValueWithDefault def r p =
367 if existsStatement r p
368 then relatedValue r p
371 applyConnectionType :: Resource -> <Proc,WriteGraph,ReadGraph> ()
372 applyConnectionType res = do
373 t = determineConnectionType res
375 Just t -> claim res STR.HasConnectionType t
376 Nothing -> print ("No connection type " + (show res))
379 importJava "org.simantics.modeling.utils.JoinMap" where
381 createJoinMap :: () -> <Proc> (Dynamic -> <WriteGraph> Resource)
384 createJoin :: (Dynamic -> <WriteGraph> Resource) -> Dynamic -> <Proc,WriteGraph> Resource
385 createJoin joinMap key = if MMap.containsKey joinMap key
386 then MMap.unsafeGet joinMap key
389 hasType STR.ConnectionJoin
391 MMap.put joinMap key j
394 data DiagramInfo = DiagramInfo
396 Resource // configuration
397 (MMap.T String Resource) // existing components
400 Sets the elements of the diagram. Diagram is assumed to be empty,
401 but the configuration may contain existing components that can be found
402 from the given existing components map.
404 setElements :: DiagramInfo -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <Proc,WriteGraph> [Resource]
405 setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs = (do
406 /*elements = map createElement (filter (not . isConnection) elementSpecs)
407 + map createElement (filter isConnection elementSpecs)*/
408 elements = mapMaybe createElement elementSpecs
410 (claim diagram L0.ConsistsOf)
411 setOrderedSet diagram elements
412 iter applyConnectionType (filter isConnectionResource elements)
413 syncActivateOnce diagram
414 for (zip elementSpecs elements) setConnectionName
417 elementMap = MMap.create ()
418 idRef = ref (0 :: Integer)
420 isConnectionResource r = isInstanceOf r DIA.Connection
421 isConnection (Connection _ _ _) = True
422 isConnection (SimpleConnection _ _ _ _ _) = True
423 isConnection _ = False
425 freshElementName () = do
429 createElement (Component componentType name position properties) = do
430 component = if MMap.containsKey componentMap name
431 then MMap.unsafeGet componentMap name
434 hasParent configuration,
437 for properties (\(Property prop value) ->
438 untypedClaimRelatedValue component prop value
440 element = newOrMappedElement name
441 element = updateEntity element [
442 hasName (freshElementName ()),
443 hasType componentType,
446 (positionToVector position)
449 MOD.ElementToComponent
452 MMap.put elementMap name element
454 newOrMappedElement eName = do
455 element = match MMap.get elementMap eName with
456 Just element -> element
457 Nothing -> newEntity []
458 MMap.put elementMap eName element
460 createElement (SimpleConnection aName ar bName br _) = do
461 connection = newEntity [
462 hasName (freshElementName ()),
463 hasType DIA.RouteGraphConnection
465 a = newOrMappedElement aName
466 b = newOrMappedElement bName
467 ca = createConnector connection a ar DIA.HasPlainConnector
468 cb = createConnector connection b br DIA.HasArrowConnector
471 createElement (Flag t name label output external tableBinding tableRow position joins) = do
472 flag = newOrMappedElement name
473 flag = updateEntity flag [
474 hasName (freshElementName ()),
479 (positionToVector position)
482 DIA.Flag.HasIOTableBinding
485 DIA.Flag.HasIOTableRowIndex
496 claim flag DIA.HasFlagType DIA.FlagType.OutputFlag
500 claim flag DIA.ExternalFlag flag
502 MMap.put elementMap name flag
504 createElement (Connection nodeSpecs edges _) = do
505 connection = newEntity [
506 hasName (freshElementName ()),
507 hasType DIA.RouteGraphConnection
510 nodes = map (createNode connection) nodeSpecs
511 for edges (\(Edge a b) -> connectNodes (nodes!a) (nodes!b))
513 createNode connection (Terminal elementName terminal) = do
514 element = newOrMappedElement elementName
515 createConnector connection element terminal DIA.HasPlainConnector
516 createNode connection (RouteLine isHorizontal position) = do
518 hasName (freshElementName ()),
519 hasType DIA.RouteLine,
520 hasProperty DIA.HasPosition
522 hasProperty DIA.IsHorizontal
524 hasStatement DIA.HasInteriorRouteNode.Inverse
527 createConnector connection component terminal defaultHasConnector = do
528 connector = newResource ()
532 claim component terminal connector
534 (connectionRelation, attachmentRelation) = resolveAttachmentRelation component terminal defaultHasConnector
536 claim connection attachmentRelation connector
538 execJust connectionRelation (\cr -> do
539 if existsStatement cr MOD.NeedsConnectionMappingSpecification then do
540 connectionType = singleObject cr STR.AllowsConnectionType
541 spec = singleObject connectionType MOD.ConnectionTypeToConnectionMappingSpecification
543 MOD.HasConnectionMappingSpecification
549 claim a DIA.AreConnected b
550 // Returns (connectionRelation :: Maybe Resource, connector attachment relation :: Resource)
551 resolveAttachmentRelation element terminal defaultAttachmentRelation =
552 if isSubrelationOf terminal DIA.Flag.ConnectionPoint then
553 (Nothing, flagTypeToAttachmentRelation element)
555 match possibleObject terminal MOD.DiagramConnectionRelationToConnectionRelation with
556 Just connectionRelation -> (Just connectionRelation, orElse (possibleObject connectionRelation STR.HasAttachmentRelation) defaultAttachmentRelation)
557 Nothing -> (Nothing, defaultAttachmentRelation)
558 createElement (SVG document position) =
560 hasName (freshElementName ()),
561 hasType DIA.SVGElement,
567 (positionToVector position)
570 createRealizedFont (Font family size style) = do
571 font = newResource ()
575 claimRelatedValue font DIA.RealizedFont.HasFamily family
576 claimRelatedValue font DIA.RealizedFont.HasSize size
577 claimRelatedValue font DIA.RealizedFont.HasStyle style
579 hasFont (Just font) = hasStatement DIA.HasFont (createRealizedFont font)
580 hasFont Nothing = const ()
581 createElement (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
583 hasName (freshElementName ()),
590 (positionToVector position)
597 G2D.HasHorizontalAlignment
598 (alignmentToResource hAlign),
600 G2D.HasVerticalAlignment
601 (alignmentToResource vAlign),
604 createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
605 match (MMap.get elementMap componentName) with
606 Nothing -> Nothing // Monitored component is not on the same diagram as the monitor. Not supported by this routine.
608 component = singleObject element MOD.ElementToComponent
610 hasName (freshElementName ()),
618 hasStatement DIA.HasMonitorComponent component,
621 (positionToVector position)
628 G2D.HasHorizontalAlignment
629 (alignmentToResource hAlign),
631 G2D.HasVerticalAlignment
632 (alignmentToResource vAlign),
635 createElement (Text elementType text (TextVisuals font hAlign vAlign) position) =
637 hasName (freshElementName ()),
644 (positionToVector position)
647 G2D.HasHorizontalAlignment
648 (alignmentToResource hAlign),
650 G2D.HasVerticalAlignment
651 (alignmentToResource vAlign),
654 setConnectionName (Connection _ _ (Just name), element) =
655 match possibleObject element MOD.ElementToComponent with
656 Just c -> claimRelatedValue c L0.HasName name
657 Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
658 setConnectionName (SimpleConnection _ _ _ _ (Just name), element) =
659 match possibleObject element MOD.ElementToComponent with
660 Just c -> claimRelatedValue c L0.HasName name
661 Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
662 setConnectionName (Flag _ name _ _ _ _ _ _ _, element) =
663 match possibleObject element MOD.ElementToComponent with
664 Just c -> claimRelatedValue c L0.HasName name
665 Nothing -> () // This is a typical case
666 setConnectionName _ = ()
667 flagTypeToAttachmentRelation flag = match possibleObject flag DIA.HasFlagType with
668 Just DIA.FlagType.OutputFlag -> DIA.HasArrowConnector
669 otherwise -> DIA.HasPlainConnector
671 """Returns a diagram in the given model with the given model relative path."""
672 diagram :: Model -> [String] -> <ReadGraph> Diagram
675 (\r name -> match possibleResourceChild r name with
677 Nothing -> fail ("Didn't find " + name + ".")
679 (configurationOf model) path
681 possibleDiagram :: Model -> [String] -> <ReadGraph> (Maybe Diagram)
682 possibleDiagram model path =
684 (\r name -> match r with
685 Just p -> possibleResourceChild p name
688 (Just (configurationOf model)) path
691 """FIXME: doesn't work anymore with the elementsOfR spec
692 elementsOf :: Diagram -> <ReadGraph> [DiagramElement String]
693 elementsOf diagram = map (mapDiagramElement nameOf mapTerminal possibleNameOf nameOf)
694 $ elementsOfR diagram
696 nameOf r = relatedValue r L0.HasName
699 if name == "ConnectionPoint" &&
700 r == DIA.Flag.ConnectionPoint
705 """Returns the elements of the given diagram."""
706 elementsOfR :: Diagram -> <ReadGraph> [(DiagramElement Resource, Resource)]
707 elementsOfR diagram = filterJust $ map readElement'
708 (diagramResourceOf diagram # L0.ConsistsOf)
710 readElement' element = match readElement element with
711 Just el -> Just (el, element)
713 readElement element =
714 if element `isInstanceOf` DIA.Flag
715 then readFlag element
716 else if element `isInstanceOf` DIA.SVGElement
718 else if element `isInstanceOf` DIA.Monitor
719 then readMonitor element
720 else if element `isInstanceOf` DIA.RouteGraphConnection
721 then readConnection element
722 else if element `isInstanceOf` DIA.TextElement
723 then readText element
724 else if element `isInstanceOf` DIA.Element
725 then readComponent element
727 readFlag flag = Just $ Flag
733 (existsStatement3 flag DIA.HasFlagType DIA.FlagType.OutputFlag)
734 (existsStatement flag DIA.ExternalFlag)
735 ((possibleRelatedString flag DIA.Flag.HasIOTableBinding) :: (Maybe String))
736 ((possibleRelatedInteger flag DIA.Flag.HasIOTableRowIndex) :: (Maybe Integer))
738 (map toDynamic $ flag # DIA.FlagIsJoinedBy)
739 readComponent element = do
740 component = singleObject
742 MOD.ElementToComponent
748 (transformOf element)
749 (readAttributes component))
752 (relatedValue element G2D.HasSVGDocument)
753 (transformOf element)
755 readMonitor element = do
756 font = readFont element (singleObject element DIA.HasFont)
757 hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
758 vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
759 label = (relatedValue2 element L0.HasLabel)
760 strokeWidth = relatedValueWithDefault (-1.0) element G2D.HasStrokeWidth
761 transform = (transformOf element)
762 match (existsStatement element DIA.HasMonitorSuffix) with
764 suffix = (relatedValue element DIA.HasMonitorSuffix)
765 monitorComponent = (singleObject element DIA.HasMonitorComponent)
766 componentName = relatedValue monitorComponent L0.HasName
767 Just (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) transform)
768 False -> Just (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) transform)
769 readText element = do
770 elementType = singleTypeOf element DIA.Element
771 font = readPossibleFont element
772 hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
773 vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
774 text = relatedValueWithDefault "" element DIA.HasText
775 transform = (transformOf element)
776 Just (Text elementType text (TextVisuals font hAlign vAlign) transform)
777 readPossibleFont element =
778 match possibleObject element DIA.HasFont with
779 Just f -> readFont element f
781 readFont element font = do
782 if font `isInstanceOf` DIA.RealizedFont
784 family = (relatedValue font DIA.RealizedFont.HasFamily)
785 size = (relatedValue font DIA.RealizedFont.HasSize)
786 style = (relatedValue font DIA.RealizedFont.HasStyle)
787 Just (Font family size style)
789 readAttributes component = let
790 allPredicates = map objectOf (statements (singleTypeOf component L0.Entity) L0.DomainOf)
791 is p = isSubrelationOf p L0.HasProperty
792 hasPropertyPredicates = filter is allPredicates
793 propertyStatements = map (singleStatement component) hasPropertyPredicates
794 p stm = match (untypedPossibleValueOf (objectOf stm)) with
795 Just v -> Just (Property (predicateOf stm) v)
797 in mapMaybe p propertyStatements
799 readConnection element = do
800 connectors = element # DIA.HasConnector
801 routeLines = element # DIA.HasInteriorRouteNode
802 nodes = map (readConnector element) connectors
803 + map readRouteLine routeLines
805 nodeResources = connectors + routeLines
806 nodeResourceWithIds = zip nodeResources [0..length nodeResources-1]
808 rMap = MMap.fromEntryList nodeResourceWithIds
811 | r <- node # DIA.AreConnected
812 , j = MMap.unsafeGet rMap r
814 concatMap edgesOf nodeResourceWithIds
816 Just $ Connection nodes edges (readConnectionName element)
817 readConnectionName element =
818 match possibleObject element MOD.ElementToComponent with
819 Just c -> possibleNameOf c
821 readConnector connection r = Terminal
822 (idOf $ objectOf stat)
823 (inverseOf $ predicateOf stat)
826 | stat <- statements r STR.Connects
827 , objectOf stat != connection
829 readRouteLine r = RouteLine
830 (relatedValue r DIA.IsHorizontal)
831 (relatedValue r DIA.HasPosition)
832 nameOf r = relatedValue r L0.HasName
833 labelOf r = relatedValue2 r L0.HasLabel
834 idOf r = match possibleObject r MOD.ElementToComponent with
836 Nothing -> if r `isInstanceOf` DIA.Flag
837 then "FLAG_" + nameOf r
838 else fail ("Element " + show r + " was not mapped to a component.")
840 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
841 """Takes one connection element and returns possible diagram type."""
842 determineConnectionType :: Resource -> <ReadGraph> Maybe Resource
844 rotateConnection :: Resource -> Double -> Double -> Boolean -> <WriteGraph> ()
845 flipConnection :: Resource -> Boolean -> Double -> <WriteGraph> ()
847 applyDiagramMapping :: Resource -> <Proc,WriteGraph> ()
848 applyDiagramMapping diagram = do
849 syncActivateOnce diagram
852 """Returns the diagram flag type resource used for all generic diagram flags."""
853 genericFlagType :: () -> <ReadGraph> Resource
854 genericFlagType _ = DIA.Flag
856 /* Use functions in Simantics/PageSettings
857 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
858 @JavaName setPageBordersVisible
859 setPageBordersVisible :: Diagram -> Boolean -> <WriteGraph> ()
861 @JavaName setMarginsVisible
862 setMarginsVisible :: Diagram -> Boolean -> <WriteGraph> ()
864 importJava "org.simantics.modeling.typicals.TypicalUtil" where
865 @JavaName newMasterTypical
866 newTypicalDiagram :: Library -> Diagram
868 @JavaName syncTypicalInstance
869 syncTypicalInstance :: Resource -> <WriteGraph> ()
871 syncActivateDiagram :: Diagram -> <WriteGraph, Proc> Boolean
872 syncActivateDiagram composite = do
873 diagram = compositeToDiagram' composite
874 syncActivateOnce diagram
877 // --- Diagrams ---------------------------------------------------
879 importJava "org.simantics.structural2.utils.StructuralUtils" where
880 @JavaName newComponent
881 createComposite__ :: Configuration -> String -> Resource -> <WriteGraph> Diagram
883 compositeToDiagram :: Resource -> <ReadGraph> Diagram
884 compositeToDiagram c = singleObject c MOD.CompositeToDiagram
886 createComposite :: Configuration -> String -> Resource -> <WriteGraph> Diagram
887 createComposite diagramFolder name compositeType = do
888 newName = findFreshName name diagramFolder
889 createComposite__ diagramFolder newName compositeType
891 elementToComponent :: Element -> <ReadGraph> Component
892 elementToComponent element = singleObject element MOD.ElementToComponent
894 componentToElement :: Component -> <ReadGraph> Element
895 componentToElement component = singleObject component MOD.ComponentToElement
897 getConnections :: Diagram -> <ReadGraph> [Resource]
898 getConnections diagram = [object | object <- (compositeToDiagram diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection]
900 getConnection :: Diagram -> String -> <ReadGraph> [Resource]
901 getConnection diagram name = do
902 connections = getConnections diagram
903 filter (\x -> relatedValue2 x L0.HasName == name) connections
905 setTransform :: Resource -> DoubleArray -> <WriteGraph> ()
906 setTransform element transform = claimRelatedValueWithType element DIA.HasTransform G2D.Transform transform
909 transformElement transformer element
911 Performs the affine transformation encapsulated by `transformer` for the specified
914 For examples of possible transformer functions, see [scaleTransform](#scaleTransform)
915 and [transformWithScale](#transformWithScale).
917 transformElement :: (Position -> Position) -> Resource -> <WriteGraph> ()
918 transformElement transformer element =
919 claimRelatedValue element DIA.HasTransform (positionToVector (transformer (transformOf element)))
922 transformElements transformer elements
924 Runs [transformElement](#transformElement) using the specified transformer for
925 all the specified `elements`.
927 Use this function together with e.g. [scaleTransform](#scaleTransform) and
928 [transformWithScale](#transformWithScale) or similar functions.
932 import "Simantics/Diagram"
934 // Scale some elements by 1.5:
935 transformElements (scale 1.5) someElements
936 // Set scale of some elements to 10
937 transformElements (withScale 10) someElements
939 transformElements :: (Position -> Position) -> [Resource] -> <WriteGraph> ()
940 transformElements transformer elements = for elements $ transformElement transformer
942 importJava "org.simantics.modeling.svg.CreateSVGElement" where
943 createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> ()
944 createSVGElementR :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> Resource
946 importSVGElement :: Resource -> File -> Double -> Double -> <WriteGraph> ()
947 importSVGElementR :: Resource -> File -> Double -> Double -> <WriteGraph> Resource
949 importJava "org.simantics.diagram.synchronization.graph.RemoveElement" where
950 removeElement :: Resource -> Resource -> <WriteGraph> ()
952 setStraightConnectionLines :: Resource -> Boolean -> <WriteGraph> ()
953 setStraightConnectionLines element v =
954 for (element # STR.IsConnectedTo) $ \connector ->
955 claimRelatedValue connector DIA.Connector.straight v
957 showProfileMonitors :: Resource -> Boolean -> <WriteGraph> ()
958 showProfileMonitors element v = claimRelatedValue element DIA.Element.hideProfileMonitors (not v)
960 setProfileMonitorsDirectionUp :: Resource -> Boolean -> <WriteGraph> ()
961 setProfileMonitorsDirectionUp element v = claimRelatedValue element DIA.Element.upProfileMonitors v
963 importJava "org.simantics.diagram.flag.Joiner" where
964 joinFlagsLocal :: [Resource] -> <WriteGraph> ()
966 importJava "org.simantics.diagram.flag.RouteGraphConnectionSplitter" where
967 splitConnection :: Resource -> Double -> Double -> <WriteGraph> ()
969 importJava "org.simantics.diagram.handler.CopyPasteUtil" where
970 moveConnection :: Resource -> Double -> Double -> <WriteGraph> ()
972 importJava "org.simantics.diagram.content.ConnectionUtil" where
973 translateRouteNodes :: Resource -> Double -> Double -> <WriteGraph> ()
975 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
976 defaultSymbolDropHandler :: [WorkbenchSelectionElement] -> <WriteGraph> ()