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