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 if terminal == DIA.Flag.ConnectionPoint then
516 createConnector connection element terminal DIA.HasPlainConnector
518 createConnector connection element terminal DIA.HasPlainConnector
519 createNode connection (RouteLine isHorizontal position) = do
521 hasName (freshElementName ()),
522 hasType DIA.RouteLine,
523 hasProperty DIA.HasPosition
525 hasProperty DIA.IsHorizontal
527 hasStatement DIA.HasInteriorRouteNode.Inverse
530 createConnector connection component terminal defaultHasConnector = do
531 connector = newResource ()
535 claim component terminal connector
537 (connectionRelation, attachmentRelation) = resolveAttachmentRelation component terminal defaultHasConnector
539 claim connection attachmentRelation connector
541 execJust connectionRelation (\cr -> do
542 if existsStatement cr MOD.NeedsConnectionMappingSpecification then do
543 connectionType = singleObject cr STR.AllowsConnectionType
544 spec = singleObject connectionType MOD.ConnectionTypeToConnectionMappingSpecification
546 MOD.HasConnectionMappingSpecification
552 claim a DIA.AreConnected b
553 // Returns (connectionRelation :: Maybe Resource, connector attachment relation :: Resource)
554 resolveAttachmentRelation element terminal defaultAttachmentRelation =
555 if terminal == DIA.Flag.ConnectionPoint then
556 (Nothing, flagTypeToAttachmentRelation element)
558 match possibleObject terminal MOD.DiagramConnectionRelationToConnectionRelation with
559 Just connectionRelation -> (Just connectionRelation, orElse (possibleObject connectionRelation STR.HasAttachmentRelation) defaultAttachmentRelation)
560 Nothing -> (Nothing, defaultAttachmentRelation)
561 createElement (SVG document position) =
563 hasName (freshElementName ()),
564 hasType DIA.SVGElement,
570 (positionToVector position)
573 createRealizedFont (Font family size style) = do
574 font = newResource ()
578 claimRelatedValue font DIA.RealizedFont.HasFamily family
579 claimRelatedValue font DIA.RealizedFont.HasSize size
580 claimRelatedValue font DIA.RealizedFont.HasStyle style
582 hasFont (Just font) = hasStatement DIA.HasFont (createRealizedFont font)
583 hasFont Nothing = const ()
584 createElement (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
586 hasName (freshElementName ()),
593 (positionToVector position)
600 G2D.HasHorizontalAlignment
601 (alignmentToResource hAlign),
603 G2D.HasVerticalAlignment
604 (alignmentToResource vAlign),
607 createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
608 match (MMap.get elementMap componentName) with
609 Nothing -> Nothing // Monitored component is not on the same diagram as the monitor. Not supported by this routine.
611 component = singleObject element MOD.ElementToComponent
613 hasName (freshElementName ()),
621 hasStatement DIA.HasMonitorComponent component,
624 (positionToVector position)
631 G2D.HasHorizontalAlignment
632 (alignmentToResource hAlign),
634 G2D.HasVerticalAlignment
635 (alignmentToResource vAlign),
638 createElement (Text elementType text (TextVisuals font hAlign vAlign) position) =
640 hasName (freshElementName ()),
647 (positionToVector position)
650 G2D.HasHorizontalAlignment
651 (alignmentToResource hAlign),
653 G2D.HasVerticalAlignment
654 (alignmentToResource vAlign),
657 setConnectionName (Connection _ _ (Just name), element) =
658 match possibleObject element MOD.ElementToComponent with
659 Just c -> claimRelatedValue c L0.HasName name
660 Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
661 setConnectionName (SimpleConnection _ _ _ _ (Just name), element) =
662 match possibleObject element MOD.ElementToComponent with
663 Just c -> claimRelatedValue c L0.HasName name
664 Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
665 setConnectionName (Flag _ name _ _ _ _ _ _ _, element) =
666 match possibleObject element MOD.ElementToComponent with
667 Just c -> claimRelatedValue c L0.HasName name
668 Nothing -> () // This is a typical case
669 setConnectionName _ = ()
670 flagTypeToAttachmentRelation flag = match possibleObject flag DIA.HasFlagType with
671 Just DIA.FlagType.OutputFlag -> DIA.HasArrowConnector
672 otherwise -> DIA.HasPlainConnector
674 """Returns a diagram in the given model with the given model relative path."""
675 diagram :: Model -> [String] -> <ReadGraph> Diagram
678 (\r name -> match possibleResourceChild r name with
680 Nothing -> fail ("Didn't find " + name + ".")
682 (configurationOf model) path
684 possibleDiagram :: Model -> [String] -> <ReadGraph> (Maybe Diagram)
685 possibleDiagram model path =
687 (\r name -> match r with
688 Just p -> possibleResourceChild p name
691 (Just (configurationOf model)) path
694 """FIXME: doesn't work anymore with the elementsOfR spec
695 elementsOf :: Diagram -> <ReadGraph> [DiagramElement String]
696 elementsOf diagram = map (mapDiagramElement nameOf mapTerminal possibleNameOf nameOf)
697 $ elementsOfR diagram
699 nameOf r = relatedValue r L0.HasName
702 if name == "ConnectionPoint" &&
703 r == DIA.Flag.ConnectionPoint
708 """Returns the elements of the given diagram."""
709 elementsOfR :: Diagram -> <ReadGraph> [(DiagramElement Resource, Resource)]
710 elementsOfR diagram = filterJust $ map readElement'
711 (diagramResourceOf diagram # L0.ConsistsOf)
713 readElement' element = match readElement element with
714 Just el -> Just (el, element)
716 readElement element =
717 if element `isInstanceOf` DIA.Flag
718 then readFlag element
719 else if element `isInstanceOf` DIA.SVGElement
721 else if element `isInstanceOf` DIA.Monitor
722 then readMonitor element
723 else if element `isInstanceOf` DIA.RouteGraphConnection
724 then readConnection element
725 else if element `isInstanceOf` DIA.TextElement
726 then readText element
727 else if element `isInstanceOf` DIA.Element
728 then readComponent element
730 readFlag flag = Just $ Flag
736 (existsStatement3 flag DIA.HasFlagType DIA.FlagType.OutputFlag)
737 (existsStatement flag DIA.ExternalFlag)
738 ((possibleRelatedString flag DIA.Flag.HasIOTableBinding) :: (Maybe String))
739 ((possibleRelatedInteger flag DIA.Flag.HasIOTableRowIndex) :: (Maybe Integer))
741 (map toDynamic $ flag # DIA.FlagIsJoinedBy)
742 readComponent element = do
743 component = singleObject
745 MOD.ElementToComponent
751 (transformOf element)
752 (readAttributes component))
755 (relatedValue element G2D.HasSVGDocument)
756 (transformOf element)
758 readMonitor element = do
759 font = readFont element (singleObject element DIA.HasFont)
760 hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
761 vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
762 label = (relatedValue2 element L0.HasLabel)
763 strokeWidth = relatedValueWithDefault (-1.0) element G2D.HasStrokeWidth
764 transform = (transformOf element)
765 match (existsStatement element DIA.HasMonitorSuffix) with
767 suffix = (relatedValue element DIA.HasMonitorSuffix)
768 monitorComponent = (singleObject element DIA.HasMonitorComponent)
769 componentName = relatedValue monitorComponent L0.HasName
770 Just (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) transform)
771 False -> Just (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) transform)
772 readText element = do
773 elementType = singleTypeOf element DIA.Element
774 font = readPossibleFont element
775 hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
776 vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
777 text = relatedValueWithDefault "" element DIA.HasText
778 transform = (transformOf element)
779 Just (Text elementType text (TextVisuals font hAlign vAlign) transform)
780 readPossibleFont element =
781 match possibleObject element DIA.HasFont with
782 Just f -> readFont element f
784 readFont element font = do
785 if font `isInstanceOf` DIA.RealizedFont
787 family = (relatedValue font DIA.RealizedFont.HasFamily)
788 size = (relatedValue font DIA.RealizedFont.HasSize)
789 style = (relatedValue font DIA.RealizedFont.HasStyle)
790 Just (Font family size style)
792 readAttributes component = let
793 allPredicates = map objectOf (statements (singleTypeOf component L0.Entity) L0.DomainOf)
794 is p = isSubrelationOf p L0.HasProperty
795 hasPropertyPredicates = filter is allPredicates
796 propertyStatements = map (singleStatement component) hasPropertyPredicates
797 p stm = match (untypedPossibleValueOf (objectOf stm)) with
798 Just v -> Just (Property (predicateOf stm) v)
800 in mapMaybe p propertyStatements
802 readConnection element = do
803 connectors = element # DIA.HasConnector
804 routeLines = element # DIA.HasInteriorRouteNode
805 nodes = map (readConnector element) connectors
806 + map readRouteLine routeLines
808 nodeResources = connectors + routeLines
809 nodeResourceWithIds = zip nodeResources [0..length nodeResources-1]
811 rMap = MMap.fromEntryList nodeResourceWithIds
814 | r <- node # DIA.AreConnected
815 , j = MMap.unsafeGet rMap r
817 concatMap edgesOf nodeResourceWithIds
819 Just $ Connection nodes edges (readConnectionName element)
820 readConnectionName element =
821 match possibleObject element MOD.ElementToComponent with
822 Just c -> possibleNameOf c
824 readConnector connection r = Terminal
825 (idOf $ objectOf stat)
826 (inverseOf $ predicateOf stat)
829 | stat <- statements r STR.Connects
830 , objectOf stat != connection
832 readRouteLine r = RouteLine
833 (relatedValue r DIA.IsHorizontal)
834 (relatedValue r DIA.HasPosition)
835 nameOf r = relatedValue r L0.HasName
836 labelOf r = relatedValue2 r L0.HasLabel
837 idOf r = match possibleObject r MOD.ElementToComponent with
839 Nothing -> if r `isInstanceOf` DIA.Flag
840 then "FLAG_" + nameOf r
841 else fail ("Element " + show r + " was not mapped to a component.")
843 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
844 """Takes one connection element and returns possible diagram type."""
845 determineConnectionType :: Resource -> <ReadGraph> Maybe Resource
847 rotateConnection :: Resource -> Double -> Double -> Boolean -> <WriteGraph> ()
848 flipConnection :: Resource -> Boolean -> Double -> <WriteGraph> ()
850 applyDiagramMapping :: Resource -> <Proc,WriteGraph> ()
851 applyDiagramMapping diagram = do
852 syncActivateOnce diagram
855 """Returns the diagram flag type resource used for all generic diagram flags."""
856 genericFlagType :: () -> <ReadGraph> Resource
857 genericFlagType _ = DIA.Flag
859 /* Use functions in Simantics/PageSettings
860 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
861 @JavaName setPageBordersVisible
862 setPageBordersVisible :: Diagram -> Boolean -> <WriteGraph> ()
864 @JavaName setMarginsVisible
865 setMarginsVisible :: Diagram -> Boolean -> <WriteGraph> ()
867 importJava "org.simantics.modeling.typicals.TypicalUtil" where
868 @JavaName newMasterTypical
869 newTypicalDiagram :: Library -> Diagram
871 @JavaName syncTypicalInstance
872 syncTypicalInstance :: Resource -> <WriteGraph> ()
874 syncActivateDiagram :: Diagram -> <WriteGraph, Proc> Boolean
875 syncActivateDiagram composite = do
876 diagram = compositeToDiagram' composite
877 syncActivateOnce diagram
880 // --- Diagrams ---------------------------------------------------
882 importJava "org.simantics.structural2.utils.StructuralUtils" where
883 @JavaName newComponent
884 createComposite__ :: Configuration -> String -> Resource -> <WriteGraph> Diagram
886 compositeToDiagram :: Resource -> <ReadGraph> Diagram
887 compositeToDiagram c = singleObject c MOD.CompositeToDiagram
889 createComposite :: Configuration -> String -> Resource -> <WriteGraph> Diagram
890 createComposite diagramFolder name compositeType = do
891 newName = findFreshName name diagramFolder
892 createComposite__ diagramFolder newName compositeType
894 elementToComponent :: Element -> <ReadGraph> Component
895 elementToComponent element = singleObject element MOD.ElementToComponent
897 componentToElement :: Component -> <ReadGraph> Element
898 componentToElement component = singleObject component MOD.ComponentToElement
900 getConnections :: Diagram -> <ReadGraph> [Resource]
901 getConnections diagram = [object | object <- (compositeToDiagram diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection]
903 getConnection :: Diagram -> String -> <ReadGraph> [Resource]
904 getConnection diagram name = do
905 connections = getConnections diagram
906 filter (\x -> relatedValue2 x L0.HasName == name) connections
908 setTransform :: Resource -> DoubleArray -> <WriteGraph> ()
909 setTransform element transform = claimRelatedValueWithType element DIA.HasTransform G2D.Transform transform
912 transformElement transformer element
914 Performs the affine transformation encapsulated by `transformer` for the specified
917 For examples of possible transformer functions, see [scaleTransform](#scaleTransform)
918 and [transformWithScale](#transformWithScale).
920 transformElement :: (Position -> Position) -> Resource -> <WriteGraph> ()
921 transformElement transformer element =
922 claimRelatedValue element DIA.HasTransform (positionToVector (transformer (transformOf element)))
925 transformElements transformer elements
927 Runs [transformElement](#transformElement) using the specified transformer for
928 all the specified `elements`.
930 Use this function together with e.g. [scaleTransform](#scaleTransform) and
931 [transformWithScale](#transformWithScale) or similar functions.
935 import "Simantics/Diagram"
937 // Scale some elements by 1.5:
938 transformElements (scale 1.5) someElements
939 // Set scale of some elements to 10
940 transformElements (withScale 10) someElements
942 transformElements :: (Position -> Position) -> [Resource] -> <WriteGraph> ()
943 transformElements transformer elements = for elements $ transformElement transformer
945 importJava "org.simantics.modeling.svg.CreateSVGElement" where
946 createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> ()
947 createSVGElementR :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> Resource
949 importSVGElement :: Resource -> File -> Double -> Double -> <WriteGraph> ()
950 importSVGElementR :: Resource -> File -> Double -> Double -> <WriteGraph> Resource
952 importJava "org.simantics.diagram.synchronization.graph.RemoveElement" where
953 removeElement :: Resource -> Resource -> <WriteGraph> ()
955 setStraightConnectionLines :: Resource -> Boolean -> <WriteGraph> ()
956 setStraightConnectionLines element v =
957 for (element # STR.IsConnectedTo) $ \connector ->
958 claimRelatedValue connector DIA.Connector.straight v
960 showProfileMonitors :: Resource -> Boolean -> <WriteGraph> ()
961 showProfileMonitors element v = claimRelatedValue element DIA.Element.hideProfileMonitors (not v)
963 setProfileMonitorsDirectionUp :: Resource -> Boolean -> <WriteGraph> ()
964 setProfileMonitorsDirectionUp element v = claimRelatedValue element DIA.Element.upProfileMonitors v
966 importJava "org.simantics.diagram.flag.Joiner" where
967 joinFlagsLocal :: [Resource] -> <WriteGraph> ()
969 importJava "org.simantics.diagram.flag.RouteGraphConnectionSplitter" where
970 splitConnection :: Resource -> Double -> Double -> <WriteGraph> ()
972 importJava "org.simantics.diagram.handler.CopyPasteUtil" where
973 moveConnection :: Resource -> Double -> Double -> <WriteGraph> ()
975 importJava "org.simantics.diagram.content.ConnectionUtil" where
976 translateRouteNodes :: Resource -> Double -> Double -> <WriteGraph> ()
978 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
979 defaultSymbolDropHandler :: [WorkbenchSelectionElement] -> <WriteGraph> ()