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