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