]> gerrit.simantics Code Review - simantics/platform.git/blob - bundles/org.simantics.modeling/scl/Simantics/Diagram.scl
Use ListIndexRoots in migration
[simantics/platform.git] / bundles / org.simantics.modeling / scl / Simantics / Diagram.scl
1 include "Simantics/Model"
2 include "Simantics/WorkbenchSelection"
3 include "Simantics/Library"
4 include "File"
5 import "Simantics/GUID" as GUID
6
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
13
14 // --- Entity types -------------------------------------------------
15
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
24
25 // --- Position -----------------------------------------------------
26
27 data Position = Position Double Double Double Double Double Double
28
29 deriving instance Show Position
30
31 location :: Double -> Double -> Position
32 location x y = Position 1 0 0 1 x y
33
34 move :: (Double,Double) -> Position -> Position
35 move (dx,dy) (Position xx xy yx yy x y) = Position xx xy yx yy (x+dx) (y+dy)
36
37 rotate :: Integer -> Position -> Position
38 rotate angle (Position xx xy yx yy x y) =
39     Position (c*xx + s*xy) (c*xy - s*xx)
40              (c*yx + s*yy) (c*yy - s*yx)
41              x y
42   where
43     a = if angle < 0 
44         then (angle `mod` 4) + 4
45         else angle `mod` 4
46     s = match a with 1 -> 1.0 ; 3 -> -1.0 ; _ -> 0.0
47     c = match a with 0 -> 1.0 ; 2 -> -1.0 ; _ -> 0.0
48
49 scale :: Double -> Position -> Position
50 scale s (Position xx xy yx yy x y) = Position (s*xx) (s*xy) (s*yx) (s*yy) x y
51
52 flipX :: Position -> Position
53 flipX (Position xx xy yx yy x y) = Position (-xx) xy (-yx) yy x y 
54
55 flipY :: Position -> Position
56 flipY (Position xx xy yx yy x y) = Position xx (-xy) yx (-yy) x y
57
58 positionToDoubleArray (Position a b c d e f) = toDoubleArray [a,b,c,d,e,f]
59
60 // --- Diagram element data types -----------------------------------
61
62 data Property res = Property res Dynamic
63 instance (Show res) => Show (Property res) where
64     show (Property r _) = "Property " + show r 
65
66 data Edge = Edge Integer Integer
67 deriving instance Show Edge
68 data ConnectionNode res = Terminal String res
69                         | RouteLine
70                               Boolean   // is horizontal 
71                               Double    // position
72 deriving instance (Show res) => Show (ConnectionNode res)
73
74 data Font = Font String Integer Integer
75 deriving instance Show Font
76
77 data Alignment =
78     Baseline
79   | Center
80   | Leading
81   | Trailing
82 deriving instance Show Alignment
83
84 resourceToAlignment res = match (possibleNameOf res) with
85     Just "Baseline" -> Baseline
86     Just "Center" -> Center
87     Just "Leading" -> Leading
88     Just "Trailing" -> Trailing
89     _ -> fail ("Couldn't convert " + show res + " to Alignment.")
90
91 alignmentToResource Baseline = G2D.Alignment.Baseline
92 alignmentToResource Center = G2D.Alignment.Center
93 alignmentToResource Leading = G2D.Alignment.Leading
94 alignmentToResource Trailing = G2D.Alignment.Trailing
95
96 data MonitorReference = MonitorReference String String
97 deriving instance Show MonitorReference
98
99 data MonitorVisuals = MonitorVisuals (Maybe Font) Double Alignment Alignment
100 deriving instance Show MonitorVisuals
101
102 data TextVisuals = TextVisuals (Maybe Font) Alignment Alignment
103 deriving instance Show TextVisuals
104
105 data DiagramElement res = 
106     Component
107         res            // component type
108         String         // name
109         Position       // position
110         [Property res] // properties
111   | SimpleConnection String res String res (Maybe String)
112   | Connection [ConnectionNode res] [Edge] (Maybe String)
113   | Flag 
114         res 
115         String         // name 
116         String         // label
117         Boolean        // output
118         Boolean        // external
119         (Maybe String)         // IOTableBinding
120         (Maybe Integer)        // IOTableRowIndex
121         Position       // position  
122         [Dynamic]      // references to the joins
123   | SVG String Position
124   | Monitor String (Maybe MonitorReference) MonitorVisuals Position
125   | Text
126         Resource       // element type
127         String         // Text shown by the element
128         TextVisuals    // text element visual attributes
129         Position       // position on diagram
130 deriving instance (Show res) => Show (DiagramElement res)
131
132 // --- Functions ----------------------------------------------------
133
134 """Creates a random GUID L0.identifier property for the specified entity resource.""" 
135 @private
136 hasRandomIdentifier :: Resource -> <ReadGraph,WriteGraph> ()
137 hasRandomIdentifier entity = runProc (claimRelatedValue_ entity L0.identifier GUID.randomGUID GUID.guidBinding)
138
139 """Returns all diagrams of the given model."""
140 diagramsOf :: Model -> <ReadGraph> [Diagram]
141 diagramsOf model = recurse
142                    DIA.Diagram 
143                    (configurationOf model)
144   where
145     recurse t r = do
146         cs = children r 
147         dias = filter isDiagramComposite cs
148         folders = filter (not . isDiagramComposite) cs
149         dias + concatMap (recurse t) folders
150     isDiagramComposite r = existsStatement r MOD.CompositeToDiagram
151
152 """Returns a model relative path of the given diagram."""
153 pathOf :: Diagram -> <ReadGraph> [String]
154 pathOf diagram = map nameOf $ unfoldl aux diagram
155   where
156     aux r = if existsStatement r SIMU.IsConfigurationOf
157             then Nothing
158             else do
159                 parents  = r # L0.PartOf
160                 if length parents == 1
161                 then Just (r, parents!0)
162                 else Nothing
163     nameOf r = relatedValue r $ L0.HasName
164
165 pathNameOf :: Diagram -> <ReadGraph> String
166 pathNameOf diagram = do
167     path = pathOf diagram
168     foldl1 (\s s1 -> s + " / " + s1) path
169
170 // @Private?
171 diagramResourceOf :: Diagram -> <ReadGraph> Resource
172 diagramResourceOf d = singleObject d MOD.CompositeToDiagram
173
174 import "Extras/HashMap" as Map
175
176 """Constructs a transformation for a diagram element."""
177 mapDiagramElement :: (a -> <e> b) -> (a -> <e> b) -> (a -> <e> Maybe b) -> (a -> <e> b) -> DiagramElement a -> <e> DiagramElement b
178 mapDiagramElement mapComponentType mapTerminal mapAttribute mapFlagType diagramElement =
179     (match diagramElement with
180         Component componentType name position properties -> do
181             Component (mapComponentType componentType) name position
182                 (filterJust (map mapProperty properties))
183         SimpleConnection e1 r1 e2 r2 possibleName ->
184             SimpleConnection e1 (mapTerminal r1) e2 (mapTerminal r2) possibleName
185         Connection nodes edges possibleName ->
186             Connection
187                 (map mapConnectionNode nodes)
188                 edges possibleName
189         Flag t e e2 e3 e4 e5 p p2 joins -> Flag (mapFlagType t) e e2 e3 e4 e5 p p2 joins
190         SVG d p -> SVG d p
191         Monitor label ref visuals position -> Monitor label ref visuals position
192         Text elementType text visuals position -> Text elementType text visuals position
193 ) where
194     mapProperty (Property p v) = 
195       match (mapAttribute p) with
196         Just mp -> Just (Property mp v)
197         Nothing -> Nothing
198     mapConnectionNode (Terminal e r) = Terminal e (mapTerminal r)
199     mapConnectionNode (RouteLine iv p) = RouteLine iv p
200
201 importJava "org.simantics.structural2.utils.StructuralUtils" where
202     @JavaName newComponent
203     createComposite_ :: Resource -> String -> Resource -> <WriteGraph> Resource   
204
205 data DiagramSpec = NewDiagram 
206                        Model    // root 
207                        [String] // path to the diagram
208                        Resource // folder type 
209                        Resource // composite type
210                  | ExistingDiagram Diagram
211
212 compositeToDiagram' c = singleObject c MOD.CompositeToDiagram
213
214 """Creates or modifies an existing diagram to contain the given diagram elements."""        
215 createDiagramR :: DiagramSpec -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <WriteGraph> (Diagram, [Resource])
216 createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do
217     configuration = diagram'
218     diagram = compositeToDiagram' configuration
219     hasName = L0.HasName
220     componentMap = Map.fromList [ (c `relatedValue` hasName :: String, c)
221                                 | c <- children configuration
222                                 ]
223     denyByPredicate diagram L0.ConsistsOf
224     elements = setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs
225     claimRelatedValue diagram DIA.HasModCount 
226         (fromInteger (length elements) :: Long)
227     (diagram', elements)
228
229 createDiagramR (NewDiagram model path folderType compositeType) joinMap elementSpecs = (runProc do
230     configuration = createConfiguration ()    
231     diagram = compositeToDiagram' configuration
232     elements = setElements (DiagramInfo diagram configuration (Map.create ())) joinMap elementSpecs
233     claimRelatedValue diagram DIA.HasModCount 
234         (fromInteger (length elements) :: Long)
235     (configuration, elements)
236 ) where
237     createConfiguration () = do
238         lastId = length path - 1
239         parentFolder = foldl (\p id -> getOrCreateFolder p (path!id)) 
240             (configurationOf model)
241             [0..lastId-1]        
242         createComposite_ parentFolder (path!lastId) compositeType
243     getOrCreateFolder parentFolder name =
244         match possibleResourceChild parentFolder name with
245             Just child -> child
246             Nothing ->
247                 createComposite_ parentFolder name folderType
248
249 claimFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource
250 claimFolder model path folderType = do
251     lastId = length path
252     foldl (\p id -> getOrCreateFolder p folderType (path!id)) 
253         (configurationOf model) 
254         [0..lastId-1]
255
256 claimModelFolder :: Model -> [String] -> Resource -> <Proc,WriteGraph> Resource
257 claimModelFolder model path folderType = do
258     lastId = length path
259     foldl (\p id -> getOrCreateFolder p folderType (path!id)) 
260         model
261         [0..lastId-1]        
262
263 getOrCreateFolder :: Resource -> Resource -> String -> <Proc,WriteGraph> Resource
264 getOrCreateFolder parentFolder folderType name = do
265     match possibleResourceChild parentFolder name with
266         Just child -> child
267         Nothing ->
268             createComposite_ parentFolder name folderType
269
270 relatedValueWithDefault :: Serializable a => a -> Resource -> Resource -> <ReadGraph> a
271 relatedValueWithDefault def r p =
272     if existsStatement r p
273     then relatedValue r p
274     else def
275
276 applyConnectionType :: Resource -> <Proc,WriteGraph,ReadGraph> ()
277 applyConnectionType res = do
278     t = determineConnectionType res
279     match t with
280       Just t -> claim res STR.HasConnectionType t
281       Nothing -> print ("No connection type " + (show res))
282     () 
283
284 importJava "org.simantics.modeling.utils.JoinMap" where
285     @JavaName "<init>"
286     createJoinMap :: () -> <Proc> (Dynamic -> <WriteGraph> Resource)
287     
288 /*
289 createJoin :: (Dynamic -> <WriteGraph> Resource) -> Dynamic -> <Proc,WriteGraph> Resource
290 createJoin joinMap key = if Map.contains joinMap key
291                          then Map.unsafeGet joinMap key
292                          else do
293                              j = newEntity [
294                                  hasType STR.ConnectionJoin
295                                ]
296                              Map.put joinMap key j 
297                              j
298 */
299 data DiagramInfo = DiagramInfo
300                        Resource                // diagram
301                        Resource                // configuration
302                        (Map.T String Resource) // existing components
303
304 """
305 Sets the elements of the diagram. Diagram is assumed to be empty,
306 but the configuration may contain existing components that can be found
307 from the given existing components map.
308 """
309 setElements :: DiagramInfo -> (Dynamic -> <WriteGraph> Resource) -> [DiagramElement Resource] -> <Proc,WriteGraph> [Resource]
310 setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs = (do
311     /*elements = map createElement (filter (not . isConnection) elementSpecs)
312              + map createElement (filter isConnection elementSpecs)*/
313     elements = mapMaybe createElement elementSpecs
314     for elements 
315         (claim diagram L0.ConsistsOf)
316     setOrderedSet diagram elements
317     iter applyConnectionType (filter isConnectionResource elements)
318     syncActivateOnce diagram
319     for (zip elementSpecs elements) setConnectionName
320     elements
321 ) where
322     elementMap = Map.create ()
323     idRef = ref (0 :: Integer)
324
325     isConnectionResource r = isInstanceOf r DIA.Connection
326     isConnection (Connection _ _ _) = True
327     isConnection (SimpleConnection _ _ _ _ _) = True
328     isConnection _ = False
329
330     freshElementName () = do
331         id = getRef idRef
332         idRef := id + 1
333         show id
334     createElement (Component componentType name position properties) = do
335         component = if Map.contains componentMap name 
336                     then Map.unsafeGet componentMap name 
337                     else newEntity [
338                         hasName name,
339                         hasParent configuration,
340                         hasRandomIdentifier
341                     ]
342         for properties (\(Property prop value) ->
343             untypedClaimRelatedValue component prop value
344         )
345         element = newOrMappedElement name 
346         element = updateEntity element [
347             hasName (freshElementName ()),
348             hasType componentType,
349             hasTypedProperty 
350                 DIA.HasTransform
351                 (positionToDoubleArray position)
352                 G2D.Transform,
353             hasStatement 
354                 MOD.ElementToComponent
355                 component
356         ]
357         Map.put elementMap name element
358         Just element
359     newOrMappedElement eName = do
360         element = match Map.get elementMap eName with
361             Just element -> element
362             Nothing -> newEntity []
363         Map.put elementMap eName element
364         element
365     createElement (SimpleConnection aName ar bName br _) = do
366         connection = newEntity [
367             hasName (freshElementName ()),
368             hasType DIA.RouteGraphConnection
369         ]
370         a = newOrMappedElement aName
371         b = newOrMappedElement bName
372         ca = createConnector connection a ar
373         cb = createConnector connection b br
374         connectNodes ca cb
375         Just connection
376     createElement (Flag t name label output external tableBinding tableRow position joins) = do
377         flag = newOrMappedElement name 
378         flag = updateEntity flag [
379             hasName (freshElementName ()),
380             hasLabel label,
381             hasType t,
382             hasTypedProperty 
383                 DIA.HasTransform
384                 (positionToDoubleArray position)
385                 G2D.Transform,
386             hasPossibleProperty 
387                 DIA.Flag.HasIOTableBinding
388                 tableBinding,
389             hasPossibleProperty 
390                 DIA.Flag.HasIOTableRowIndex
391                 tableRow
392         ]
393         iter (\jRef -> claim
394                        (joinMap jRef)
395                        DIA.JoinsFlag
396                        flag
397              ) 
398             joins
399         if output 
400           then do
401             claim flag DIA.HasFlagType DIA.FlagType.OutputFlag
402           else ()
403         if external 
404           then do
405             claim flag DIA.ExternalFlag flag
406           else ()
407         Map.put elementMap name flag
408         Just flag
409     createElement (Connection nodeSpecs edges _) = do
410         connection = newEntity [
411             hasName (freshElementName ()),
412             hasType DIA.RouteGraphConnection
413         ]
414         
415         nodes = map (createNode connection) nodeSpecs
416         for edges (\(Edge a b) -> connectNodes (nodes!a) (nodes!b))
417         Just connection
418     createNode connection (Terminal elementName terminal) = do
419         element = newOrMappedElement elementName
420         createConnector connection element terminal        
421     createNode connection (RouteLine isHorizontal position) = do
422         newEntity [
423             hasName (freshElementName ()),
424             hasType DIA.RouteLine,
425             hasProperty DIA.HasPosition
426                         position,
427             hasProperty DIA.IsHorizontal
428                         isHorizontal,
429             hasStatement DIA.HasInteriorRouteNode.Inverse
430                         connection
431         ]
432     createConnector connection component terminal = do
433         connector = newResource ()
434         claim connector
435               L0.InstanceOf
436               DIA.Connector
437         claim component terminal connector
438         claim connection 
439               DIA.HasPlainConnector 
440               connector
441         connector
442     connectNodes a b = 
443         claim a DIA.AreConnected b
444     createElement (SVG document position) =
445         Just $ newEntity [
446             hasName (freshElementName ()),
447             hasType DIA.SVGElement,
448             hasProperty 
449                 G2D.HasSVGDocument
450                 document,
451             hasTypedProperty 
452                 DIA.HasTransform
453                 (positionToDoubleArray position)
454                 G2D.Transform
455         ]
456     createRealizedFont (Font family size style) = do
457         font = newResource ()
458         claim font
459               L0.InstanceOf
460               DIA.RealizedFont
461         claimRelatedValue font DIA.RealizedFont.HasFamily family
462         claimRelatedValue font DIA.RealizedFont.HasSize size
463         claimRelatedValue font DIA.RealizedFont.HasStyle style
464         font
465     hasFont (Just font) = hasStatement DIA.HasFont (createRealizedFont font)
466     hasFont Nothing = const ()
467     createElement (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
468         Just $ newEntity [
469             hasName (freshElementName ()),
470             hasType DIA.Monitor,
471             hasProperty 
472                 L0.HasLabel
473                 label,
474             hasTypedProperty 
475                 DIA.HasTransform
476                 (positionToDoubleArray position)
477                 G2D.Transform,
478             hasTypedProperty 
479                 G2D.HasStrokeWidth
480                 strokeWidth
481                 L0.Double,
482             hasStatement 
483                 G2D.HasHorizontalAlignment
484                 (alignmentToResource hAlign),
485             hasStatement 
486                 G2D.HasVerticalAlignment
487                 (alignmentToResource vAlign),
488             hasFont font
489         ]
490     createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
491         match (Map.get elementMap componentName) with
492           Nothing -> Nothing // Monitored component is not on the same diagram as the monitor. Not supported by this routine.
493           Just element -> do
494             component = singleObject element MOD.ElementToComponent
495             Just $ newEntity [
496             hasName (freshElementName ()),
497             hasType DIA.Monitor,
498             hasProperty 
499                 L0.HasLabel
500                 label,
501             hasProperty 
502                 DIA.HasMonitorSuffix
503                 suffix,
504             hasStatement DIA.HasMonitorComponent component,
505             hasTypedProperty 
506                 DIA.HasTransform
507                 (positionToDoubleArray position)
508                 G2D.Transform,
509             hasTypedProperty 
510                 G2D.HasStrokeWidth
511                 strokeWidth
512                 L0.Double,
513             hasStatement 
514                 G2D.HasHorizontalAlignment
515                 (alignmentToResource hAlign),
516             hasStatement 
517                 G2D.HasVerticalAlignment
518                 (alignmentToResource vAlign),
519             hasFont font
520           ]
521     createElement (Text elementType text (TextVisuals font hAlign vAlign) position) =
522         Just $ newEntity [
523             hasName (freshElementName ()),
524             hasType elementType,
525             hasProperty 
526                 DIA.HasText
527                 text,
528             hasTypedProperty 
529                 DIA.HasTransform
530                 (positionToDoubleArray position)
531                 G2D.Transform,
532             hasStatement 
533                 G2D.HasHorizontalAlignment
534                 (alignmentToResource hAlign),
535             hasStatement 
536                 G2D.HasVerticalAlignment
537                 (alignmentToResource vAlign),
538             hasFont font
539         ]
540     setConnectionName (Connection _ _ (Just name), element) = 
541         match possibleObject element MOD.ElementToComponent with
542             Just c -> claimRelatedValue c L0.HasName name
543             Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
544     setConnectionName (SimpleConnection _ _ _ _ (Just name), element) = 
545         match possibleObject element MOD.ElementToComponent with
546             Just c -> claimRelatedValue c L0.HasName name
547             Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
548     setConnectionName (Flag _ name _ _ _ _ _ _ _, element) =
549         match possibleObject element MOD.ElementToComponent with
550             Just c -> claimRelatedValue c L0.HasName name
551             Nothing -> () // This is a typical case
552     setConnectionName _ = ()
553
554 """Returns a diagram in the given model with the given model relative path.""" 
555 diagram :: Model -> [String] -> <ReadGraph> Diagram
556 diagram model path = 
557     foldl 
558         (\r name -> match possibleResourceChild r name with
559             Just c -> c
560             Nothing -> fail ("Didn't find " + name + ".") 
561         ) 
562         (configurationOf model) path
563
564 possibleDiagram :: Model -> [String] -> <ReadGraph> (Maybe Diagram)
565 possibleDiagram model path = 
566     foldl
567         (\r name -> match r with
568             Just p -> possibleResourceChild p name
569             Nothing -> Nothing 
570         ) 
571         (Just (configurationOf model)) path
572
573 /*
574 """FIXME: doesn't work anymore with the elementsOfR spec
575 elementsOf :: Diagram -> <ReadGraph> [DiagramElement String]
576 elementsOf diagram = map (mapDiagramElement nameOf mapTerminal possibleNameOf nameOf)
577                    $ elementsOfR diagram
578   where
579     nameOf r = relatedValue r L0.HasName
580     mapTerminal r = do
581         name = nameOf r
582         if name == "ConnectionPoint" &&
583            r == DIA.Flag.ConnectionPoint
584         then "FlagTerminal"
585         else name
586 */
587
588 """Returns the elements of the given diagram.""" 
589 elementsOfR :: Diagram -> <ReadGraph> [(DiagramElement Resource, Resource)]
590 elementsOfR diagram = filterJust $ map readElement' 
591               (diagramResourceOf diagram # L0.ConsistsOf)
592   where
593     readElement' element = match readElement element with
594         Just el -> Just (el, element)
595         Nothing -> Nothing
596     readElement element =
597         if element `isInstanceOf` DIA.Flag
598         then readFlag element
599         else if element `isInstanceOf` DIA.SVGElement
600         then readSVG element
601         else if element `isInstanceOf` DIA.Monitor
602         then readMonitor element
603         else if element `isInstanceOf` DIA.RouteGraphConnection
604         then readConnection element
605         else if element `isInstanceOf` DIA.TextElement
606         then readText element
607         else if element `isInstanceOf` DIA.Element
608         then readComponent element
609         else Nothing
610     readFlag flag = Just $ Flag
611         (singleTypeOf 
612                 flag 
613                 DIA.Flag)
614         (idOf flag) 
615         (labelOf flag)
616         (existsStatement3 flag DIA.HasFlagType DIA.FlagType.OutputFlag)
617         (existsStatement flag DIA.ExternalFlag)
618         ((possibleRelatedString flag DIA.Flag.HasIOTableBinding) :: (Maybe String))
619         ((possibleRelatedInteger flag DIA.Flag.HasIOTableRowIndex) :: (Maybe Integer))
620         (transformOf flag)
621         (map toDynamic $ flag # DIA.FlagIsJoinedBy)
622     readComponent element = do
623         component = singleObject 
624             element 
625             MOD.ElementToComponent
626         Just (Component 
627             (singleTypeOf 
628                 element 
629                 DIA.Element)
630             (nameOf component) 
631             (transformOf element)
632             (readAttributes component))
633     readSVG element = do
634         Just (SVG 
635             (relatedValue element G2D.HasSVGDocument) 
636             (transformOf element)
637             )
638     readMonitor element = do
639         font = readFont element (singleObject element DIA.HasFont)
640         hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
641         vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
642         label = (relatedValue2 element L0.HasLabel)
643         strokeWidth = relatedValueWithDefault (-1.0) element G2D.HasStrokeWidth 
644         transform = (transformOf element)  
645         match (existsStatement element DIA.HasMonitorSuffix) with
646           True -> do
647             suffix = (relatedValue element DIA.HasMonitorSuffix)
648             monitorComponent = (singleObject element DIA.HasMonitorComponent)
649             componentName = relatedValue monitorComponent L0.HasName
650             Just (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) transform) 
651           False -> Just (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) transform)
652     readText element = do
653         elementType = singleTypeOf element DIA.Element
654         font = readPossibleFont element 
655         hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
656         vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
657         text = relatedValueWithDefault "" element DIA.HasText 
658         transform = (transformOf element)
659         Just (Text elementType text (TextVisuals font hAlign vAlign) transform)
660     readPossibleFont element =
661         match possibleObject element DIA.HasFont with
662             Just f -> readFont element f
663             Nothing -> Nothing
664     readFont element font = do
665         if font `isInstanceOf` DIA.RealizedFont
666         then do
667             family = (relatedValue font DIA.RealizedFont.HasFamily)
668             size = (relatedValue font DIA.RealizedFont.HasSize)
669             style = (relatedValue font DIA.RealizedFont.HasStyle)
670             Just (Font family size style)
671         else Nothing
672     readAttributes component = let
673         allPredicates = map objectOf (statements (singleTypeOf component L0.Entity) L0.DomainOf)
674         is p = isSubrelationOf p L0.HasProperty
675         hasPropertyPredicates = filter is allPredicates
676         propertyStatements = map (singleStatement component) hasPropertyPredicates
677         p stm = match (untypedPossibleValueOf (objectOf stm)) with
678             Just v -> Just (Property (predicateOf stm) v)
679             _      -> Nothing
680       in mapMaybe p propertyStatements
681             
682     readConnection element = do
683         connectors = element # DIA.HasConnector
684         routeLines = element # DIA.HasInteriorRouteNode
685         nodes = map (readConnector element) connectors
686               + map readRouteLine routeLines
687         
688         nodeResources = connectors + routeLines
689         nodeResourceWithIds = zip nodeResources [0..length nodeResources-1]
690         edges = runProc do
691             rMap = Map.fromList nodeResourceWithIds
692             edgesOf (node,i) = 
693                 [ Edge i j
694                 | r <- node # DIA.AreConnected
695                 , j = Map.unsafeGet rMap r
696                 , j > i ]
697             concatMap edgesOf nodeResourceWithIds
698         
699         Just $ Connection nodes edges (readConnectionName element)
700     readConnectionName element = 
701         match possibleObject element MOD.ElementToComponent with
702             Just c -> possibleNameOf c
703             Nothing -> Nothing
704     readConnector connection r = Terminal
705         (idOf $ objectOf stat)
706         (inverseOf $ predicateOf stat)
707       where
708         stat = [ stat
709             | stat <- statements r STR.Connects
710             , objectOf stat != connection 
711             ]!0
712     readRouteLine r = RouteLine
713         (relatedValue r DIA.IsHorizontal) 
714         (relatedValue r DIA.HasPosition)
715     transformOf element = do 
716         da = fromDoubleArray $
717             relatedValue element DIA.HasTransform
718         Position (da!0) (da!1) (da!2) (da!3) (da!4) (da!5)
719     nameOf r = relatedValue r L0.HasName
720     labelOf r = relatedValue2 r L0.HasLabel
721     idOf r = match possibleObject r MOD.ElementToComponent with
722         Just c -> nameOf c
723         Nothing -> if r `isInstanceOf` DIA.Flag
724                    then "FLAG_" + nameOf r
725                    else fail ("Element " + show r + " was not mapped to a component.")
726
727 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
728     """Takes one connection element and returns possible diagram type.""" 
729     determineConnectionType :: Resource -> <ReadGraph> Maybe Resource
730     
731     rotateConnection :: Resource -> Double -> Double -> Boolean -> <WriteGraph> ()
732     flipConnection :: Resource -> Boolean -> Double -> <WriteGraph> ()   
733
734 applyDiagramMapping :: Resource -> <Proc,WriteGraph> ()
735 applyDiagramMapping diagram = do
736   syncActivateOnce diagram
737   ()
738
739 """Returns the diagram flag type resource used for all generic diagram flags."""
740 genericFlagType :: () -> <ReadGraph> Resource
741 genericFlagType _ = DIA.Flag
742
743 /* Use functions in Simantics/PageSettings
744 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
745     @JavaName setPageBordersVisible
746     setPageBordersVisible :: Diagram -> Boolean -> <WriteGraph> ()
747     
748     @JavaName setMarginsVisible
749     setMarginsVisible :: Diagram -> Boolean -> <WriteGraph> ()
750 */
751 importJava "org.simantics.modeling.typicals.TypicalUtil" where
752     @JavaName newMasterTypical
753     newTypicalDiagram :: Library -> Diagram
754
755     @JavaName syncTypicalInstance
756     syncTypicalInstance :: Resource -> <WriteGraph> ()
757     
758 syncActivateDiagram :: Diagram -> <WriteGraph, Proc> Boolean
759 syncActivateDiagram composite = do
760     diagram = compositeToDiagram' composite
761     syncActivateOnce diagram
762     True
763
764 // --- Diagrams ---------------------------------------------------
765
766 importJava "org.simantics.structural2.utils.StructuralUtils" where
767     @JavaName newComponent
768     createComposite__ :: Configuration -> String -> Resource -> <WriteGraph> Diagram
769
770 compositeToDiagram :: Resource -> <ReadGraph> Diagram
771 compositeToDiagram c = singleObject c MOD.CompositeToDiagram
772
773 createComposite :: Configuration -> String -> Resource -> <WriteGraph> Diagram
774 createComposite diagramFolder name compositeType = do
775      newName = findFreshName name diagramFolder
776      createComposite__ diagramFolder newName compositeType
777
778 elementToComponent :: Element -> <ReadGraph> Component
779 elementToComponent element = singleObject element MOD.ElementToComponent
780     
781 componentToElement :: Component -> <ReadGraph> Element
782 componentToElement component = singleObject component MOD.ComponentToElement
783
784 getConnections :: Diagram -> <ReadGraph> [Resource]
785 getConnections diagram = [object | object <- (compositeToDiagram diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection]
786
787 getConnection :: Diagram -> String -> <ReadGraph> [Resource]
788 getConnection diagram name = do
789     connections = getConnections diagram
790     filter (\x -> relatedValue2 x L0.HasName == name) connections
791
792 setTransform :: Resource -> DoubleArray -> <WriteGraph> ()
793 setTransform element transform = claimRelatedValueWithType element DIA.HasTransform G2D.Transform transform 
794     
795 importJava "org.simantics.modeling.svg.CreateSVGElement" where
796     createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> ()
797     
798     importSVGElement :: Resource -> File -> Double -> Double -> <WriteGraph> ()
799     
800 importJava "org.simantics.diagram.synchronization.graph.RemoveElement" where
801     removeElement :: Resource -> Resource -> <WriteGraph> ()
802
803 setStraightConnectionLines :: Resource -> Boolean -> <WriteGraph> ()
804 setStraightConnectionLines element v =
805     for (element # STR.IsConnectedTo) $ \connector ->
806         claimRelatedValue connector DIA.Connector.straight v
807
808 showProfileMonitors :: Resource -> Boolean -> <WriteGraph> ()
809 showProfileMonitors element v = claimRelatedValue element DIA.Element.hideProfileMonitors (not v)
810
811 setProfileMonitorsDirectionUp :: Resource -> Boolean -> <WriteGraph> ()
812 setProfileMonitorsDirectionUp element v = claimRelatedValue element DIA.Element.upProfileMonitors v
813
814 importJava "org.simantics.diagram.flag.Joiner" where
815     joinFlagsLocal :: [Resource] -> <WriteGraph> ()
816
817 importJava "org.simantics.diagram.flag.RouteGraphConnectionSplitter" where
818     splitConnection :: Resource -> Double -> Double -> <WriteGraph> ()
819
820 importJava "org.simantics.diagram.handler.CopyPasteUtil" where
821     moveConnection :: Resource -> Double -> Double -> <WriteGraph> ()
822
823 importJava "org.simantics.diagram.content.ConnectionUtil" where
824     translateRouteNodes :: Resource -> Double -> Double -> <WriteGraph> ()
825     
826 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
827     defaultSymbolDropHandler :: [WorkbenchSelectionElement] -> <WriteGraph> ()