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