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> ()