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 = relatedValue element DIA.HasTransform :: Vector Double
 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                 (positionToVector 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 DIA.HasPlainConnector
 468         cb = createConnector connection b br DIA.HasArrowConnector
 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                 (positionToVector 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         if terminal == DIA.Flag.ConnectionPoint then
 516             createConnector connection element terminal DIA.HasPlainConnector
 517         else
 518             createConnector connection element terminal DIA.HasPlainConnector
 519     createNode connection (RouteLine isHorizontal position) = do
 520         newEntity [
 521             hasName (freshElementName ()),
 522             hasType DIA.RouteLine,
 523             hasProperty DIA.HasPosition
 524                         position,
 525             hasProperty DIA.IsHorizontal
 526                         isHorizontal,
 527             hasStatement DIA.HasInteriorRouteNode.Inverse
 528                         connection
 529         ]
 530     createConnector connection component terminal defaultHasConnector = do
 531         connector = newResource ()
 532         claim connector
 533               L0.InstanceOf
 534               DIA.Connector
 535         claim component terminal connector
 536
 537         (connectionRelation, attachmentRelation) = resolveAttachmentRelation component terminal defaultHasConnector
 538
 539         claim connection attachmentRelation connector
 540
 541         execJust connectionRelation (\cr -> do
 542             if existsStatement cr MOD.NeedsConnectionMappingSpecification then do
 543                 connectionType = singleObject cr STR.AllowsConnectionType
 544                 spec = singleObject connectionType MOD.ConnectionTypeToConnectionMappingSpecification
 545                 claim connector
 546                       MOD.HasConnectionMappingSpecification
 547                       spec
 548             else ())
 549
 550         connector
 551     connectNodes a b =
 552         claim a DIA.AreConnected b
 553     // Returns (connectionRelation :: Maybe Resource, connector attachment relation :: Resource)
 554     resolveAttachmentRelation element terminal defaultAttachmentRelation =
 555         if terminal == DIA.Flag.ConnectionPoint then
 556             (Nothing, flagTypeToAttachmentRelation element)
 557         else
 558             match possibleObject terminal MOD.DiagramConnectionRelationToConnectionRelation with
 559                 Just connectionRelation -> (Just connectionRelation, orElse (possibleObject connectionRelation STR.HasAttachmentRelation) defaultAttachmentRelation)
 560                 Nothing                 -> (Nothing, defaultAttachmentRelation)
 561     createElement (SVG document position) =
 562         Just $ newEntity [
 563             hasName (freshElementName ()),
 564             hasType DIA.SVGElement,
 565             hasProperty
 566                 G2D.HasSVGDocument
 567                 document,
 568             hasTypedProperty
 569                 DIA.HasTransform
 570                 (positionToVector position)
 571                 G2D.Transform
 572         ]
 573     createRealizedFont (Font family size style) = do
 574         font = newResource ()
 575         claim font
 576               L0.InstanceOf
 577               DIA.RealizedFont
 578         claimRelatedValue font DIA.RealizedFont.HasFamily family
 579         claimRelatedValue font DIA.RealizedFont.HasSize size
 580         claimRelatedValue font DIA.RealizedFont.HasStyle style
 581         font
 582     hasFont (Just font) = hasStatement DIA.HasFont (createRealizedFont font)
 583     hasFont Nothing = const ()
 584     createElement (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
 585         Just $ newEntity [
 586             hasName (freshElementName ()),
 587             hasType DIA.Monitor,
 588             hasProperty
 589                 L0.HasLabel
 590                 label,
 591             hasTypedProperty
 592                 DIA.HasTransform
 593                 (positionToVector position)
 594                 G2D.Transform,
 595             hasTypedProperty
 596                 G2D.HasStrokeWidth
 597                 strokeWidth
 598                 L0.Double,
 599             hasStatement
 600                 G2D.HasHorizontalAlignment
 601                 (alignmentToResource hAlign),
 602             hasStatement
 603                 G2D.HasVerticalAlignment
 604                 (alignmentToResource vAlign),
 605             hasFont font
 606         ]
 607     createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do
 608         match (MMap.get elementMap componentName) with
 609           Nothing -> Nothing // Monitored component is not on the same diagram as the monitor. Not supported by this routine.
 610           Just element -> do
 611             component = singleObject element MOD.ElementToComponent
 612             Just $ newEntity [
 613             hasName (freshElementName ()),
 614             hasType DIA.Monitor,
 615             hasProperty
 616                 L0.HasLabel
 617                 label,
 618             hasProperty
 619                 DIA.HasMonitorSuffix
 620                 suffix,
 621             hasStatement DIA.HasMonitorComponent component,
 622             hasTypedProperty
 623                 DIA.HasTransform
 624                 (positionToVector position)
 625                 G2D.Transform,
 626             hasTypedProperty
 627                 G2D.HasStrokeWidth
 628                 strokeWidth
 629                 L0.Double,
 630             hasStatement
 631                 G2D.HasHorizontalAlignment
 632                 (alignmentToResource hAlign),
 633             hasStatement
 634                 G2D.HasVerticalAlignment
 635                 (alignmentToResource vAlign),
 636             hasFont font
 637           ]
 638     createElement (Text elementType text (TextVisuals font hAlign vAlign) position) =
 639         Just $ newEntity [
 640             hasName (freshElementName ()),
 641             hasType elementType,
 642             hasProperty
 643                 DIA.HasText
 644                 text,
 645             hasTypedProperty
 646                 DIA.HasTransform
 647                 (positionToVector position)
 648                 G2D.Transform,
 649             hasStatement
 650                 G2D.HasHorizontalAlignment
 651                 (alignmentToResource hAlign),
 652             hasStatement
 653                 G2D.HasVerticalAlignment
 654                 (alignmentToResource vAlign),
 655             hasFont font
 656         ]
 657     setConnectionName (Connection _ _ (Just name), element) =
 658         match possibleObject element MOD.ElementToComponent with
 659             Just c -> claimRelatedValue c L0.HasName name
 660             Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
 661     setConnectionName (SimpleConnection _ _ _ _ (Just name), element) =
 662         match possibleObject element MOD.ElementToComponent with
 663             Just c -> claimRelatedValue c L0.HasName name
 664             Nothing -> print ("Failed to set the name of the connection '" + name + "'.")
 665     setConnectionName (Flag _ name _ _ _ _ _ _ _, element) =
 666         match possibleObject element MOD.ElementToComponent with
 667             Just c -> claimRelatedValue c L0.HasName name
 668             Nothing -> () // This is a typical case
 669     setConnectionName _ = ()
 670     flagTypeToAttachmentRelation flag = match possibleObject flag DIA.HasFlagType with
 671         Just DIA.FlagType.OutputFlag -> DIA.HasArrowConnector
 672         otherwise                    -> DIA.HasPlainConnector
 673
 674 """Returns a diagram in the given model with the given model relative path."""
 675 diagram :: Model -> [String] -> <ReadGraph> Diagram
 676 diagram model path =
 677     foldl
 678         (\r name -> match possibleResourceChild r name with
 679             Just c -> c
 680             Nothing -> fail ("Didn't find " + name + ".")
 681         )
 682         (configurationOf model) path
 683
 684 possibleDiagram :: Model -> [String] -> <ReadGraph> (Maybe Diagram)
 685 possibleDiagram model path =
 686     foldl
 687         (\r name -> match r with
 688             Just p -> possibleResourceChild p name
 689             Nothing -> Nothing
 690         )
 691         (Just (configurationOf model)) path
 692
 693 /*
 694 """FIXME: doesn't work anymore with the elementsOfR spec
 695 elementsOf :: Diagram -> <ReadGraph> [DiagramElement String]
 696 elementsOf diagram = map (mapDiagramElement nameOf mapTerminal possibleNameOf nameOf)
 697                    $ elementsOfR diagram
 698   where
 699     nameOf r = relatedValue r L0.HasName
 700     mapTerminal r = do
 701         name = nameOf r
 702         if name == "ConnectionPoint" &&
 703            r == DIA.Flag.ConnectionPoint
 704         then "FlagTerminal"
 705         else name
 706 */
 707
 708 """Returns the elements of the given diagram."""
 709 elementsOfR :: Diagram -> <ReadGraph> [(DiagramElement Resource, Resource)]
 710 elementsOfR diagram = filterJust $ map readElement'
 711               (diagramResourceOf diagram # L0.ConsistsOf)
 712   where
 713     readElement' element = match readElement element with
 714         Just el -> Just (el, element)
 715         Nothing -> Nothing
 716     readElement element =
 717         if element `isInstanceOf` DIA.Flag
 718         then readFlag element
 719         else if element `isInstanceOf` DIA.SVGElement
 720         then readSVG element
 721         else if element `isInstanceOf` DIA.Monitor
 722         then readMonitor element
 723         else if element `isInstanceOf` DIA.RouteGraphConnection
 724         then readConnection element
 725         else if element `isInstanceOf` DIA.TextElement
 726         then readText element
 727         else if element `isInstanceOf` DIA.Element
 728         then readComponent element
 729         else Nothing
 730     readFlag flag = Just $ Flag
 731         (singleTypeOf
 732                 flag
 733                 DIA.Flag)
 734         (idOf flag)
 735         (labelOf flag)
 736         (existsStatement3 flag DIA.HasFlagType DIA.FlagType.OutputFlag)
 737         (existsStatement flag DIA.ExternalFlag)
 738         ((possibleRelatedString flag DIA.Flag.HasIOTableBinding) :: (Maybe String))
 739         ((possibleRelatedInteger flag DIA.Flag.HasIOTableRowIndex) :: (Maybe Integer))
 740         (transformOf flag)
 741         (map toDynamic $ flag # DIA.FlagIsJoinedBy)
 742     readComponent element = do
 743         component = singleObject
 744             element
 745             MOD.ElementToComponent
 746         Just (Component
 747             (singleTypeOf
 748                 element
 749                 DIA.Element)
 750             (nameOf component)
 751             (transformOf element)
 752             (readAttributes component))
 753     readSVG element = do
 754         Just (SVG
 755             (relatedValue element G2D.HasSVGDocument)
 756             (transformOf element)
 757             )
 758     readMonitor element = do
 759         font = readFont element (singleObject element DIA.HasFont)
 760         hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
 761         vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
 762         label = (relatedValue2 element L0.HasLabel)
 763         strokeWidth = relatedValueWithDefault (-1.0) element G2D.HasStrokeWidth
 764         transform = (transformOf element)
 765         match (existsStatement element DIA.HasMonitorSuffix) with
 766           True -> do
 767             suffix = (relatedValue element DIA.HasMonitorSuffix)
 768             monitorComponent = (singleObject element DIA.HasMonitorComponent)
 769             componentName = relatedValue monitorComponent L0.HasName
 770             Just (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) transform)
 771           False -> Just (Monitor label Nothing (MonitorVisuals font strokeWidth hAlign vAlign) transform)
 772     readText element = do
 773         elementType = singleTypeOf element DIA.Element
 774         font = readPossibleFont element
 775         hAlign = resourceToAlignment (singleObject element G2D.HasHorizontalAlignment)
 776         vAlign = resourceToAlignment (singleObject element G2D.HasVerticalAlignment)
 777         text = relatedValueWithDefault "" element DIA.HasText
 778         transform = (transformOf element)
 779         Just (Text elementType text (TextVisuals font hAlign vAlign) transform)
 780     readPossibleFont element =
 781         match possibleObject element DIA.HasFont with
 782             Just f -> readFont element f
 783             Nothing -> Nothing
 784     readFont element font = do
 785         if font `isInstanceOf` DIA.RealizedFont
 786         then do
 787             family = (relatedValue font DIA.RealizedFont.HasFamily)
 788             size = (relatedValue font DIA.RealizedFont.HasSize)
 789             style = (relatedValue font DIA.RealizedFont.HasStyle)
 790             Just (Font family size style)
 791         else Nothing
 792     readAttributes component = let
 793         allPredicates = map objectOf (statements (singleTypeOf component L0.Entity) L0.DomainOf)
 794         is p = isSubrelationOf p L0.HasProperty
 795         hasPropertyPredicates = filter is allPredicates
 796         propertyStatements = map (singleStatement component) hasPropertyPredicates
 797         p stm = match (untypedPossibleValueOf (objectOf stm)) with
 798             Just v -> Just (Property (predicateOf stm) v)
 799             _      -> Nothing
 800       in mapMaybe p propertyStatements
 801
 802     readConnection element = do
 803         connectors = element # DIA.HasConnector
 804         routeLines = element # DIA.HasInteriorRouteNode
 805         nodes = map (readConnector element) connectors
 806               + map readRouteLine routeLines
 807
 808         nodeResources = connectors + routeLines
 809         nodeResourceWithIds = zip nodeResources [0..length nodeResources-1]
 810         edges = runProc do
 811             rMap = MMap.fromEntryList nodeResourceWithIds
 812             edgesOf (node,i) =
 813                 [ Edge i j
 814                 | r <- node # DIA.AreConnected
 815                 , j = MMap.unsafeGet rMap r
 816                 , j > i ]
 817             concatMap edgesOf nodeResourceWithIds
 818
 819         Just $ Connection nodes edges (readConnectionName element)
 820     readConnectionName element =
 821         match possibleObject element MOD.ElementToComponent with
 822             Just c -> possibleNameOf c
 823             Nothing -> Nothing
 824     readConnector connection r = Terminal
 825         (idOf $ objectOf stat)
 826         (inverseOf $ predicateOf stat)
 827       where
 828         stat = [ stat
 829             | stat <- statements r STR.Connects
 830             , objectOf stat != connection
 831             ]!0
 832     readRouteLine r = RouteLine
 833         (relatedValue r DIA.IsHorizontal)
 834         (relatedValue r DIA.HasPosition)
 835     nameOf r = relatedValue r L0.HasName
 836     labelOf r = relatedValue2 r L0.HasLabel
 837     idOf r = match possibleObject r MOD.ElementToComponent with
 838         Just c -> nameOf c
 839         Nothing -> if r `isInstanceOf` DIA.Flag
 840                    then "FLAG_" + nameOf r
 841                    else fail ("Element " + show r + " was not mapped to a component.")
 842
 843 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
 844     """Takes one connection element and returns possible diagram type."""
 845     determineConnectionType :: Resource -> <ReadGraph> Maybe Resource
 846
 847     rotateConnection :: Resource -> Double -> Double -> Boolean -> <WriteGraph> ()
 848     flipConnection :: Resource -> Boolean -> Double -> <WriteGraph> ()
 849
 850 applyDiagramMapping :: Resource -> <Proc,WriteGraph> ()
 851 applyDiagramMapping diagram = do
 852   syncActivateOnce diagram
 853   ()
 854
 855 """Returns the diagram flag type resource used for all generic diagram flags."""
 856 genericFlagType :: () -> <ReadGraph> Resource
 857 genericFlagType _ = DIA.Flag
 858
 859 /* Use functions in Simantics/PageSettings
 860 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
 861     @JavaName setPageBordersVisible
 862     setPageBordersVisible :: Diagram -> Boolean -> <WriteGraph> ()
 863
 864     @JavaName setMarginsVisible
 865     setMarginsVisible :: Diagram -> Boolean -> <WriteGraph> ()
 866 */
 867 importJava "org.simantics.modeling.typicals.TypicalUtil" where
 868     @JavaName newMasterTypical
 869     newTypicalDiagram :: Library -> Diagram
 870
 871     @JavaName syncTypicalInstance
 872     syncTypicalInstance :: Resource -> <WriteGraph> ()
 873
 874 syncActivateDiagram :: Diagram -> <WriteGraph, Proc> Boolean
 875 syncActivateDiagram composite = do
 876     diagram = compositeToDiagram' composite
 877     syncActivateOnce diagram
 878     True
 879
 880 // --- Diagrams ---------------------------------------------------
 881
 882 importJava "org.simantics.structural2.utils.StructuralUtils" where
 883     @JavaName newComponent
 884     createComposite__ :: Configuration -> String -> Resource -> <WriteGraph> Diagram
 885
 886 compositeToDiagram :: Resource -> <ReadGraph> Diagram
 887 compositeToDiagram c = singleObject c MOD.CompositeToDiagram
 888
 889 createComposite :: Configuration -> String -> Resource -> <WriteGraph> Diagram
 890 createComposite diagramFolder name compositeType = do
 891      newName = findFreshName name diagramFolder
 892      createComposite__ diagramFolder newName compositeType
 893
 894 elementToComponent :: Element -> <ReadGraph> Component
 895 elementToComponent element = singleObject element MOD.ElementToComponent
 896
 897 componentToElement :: Component -> <ReadGraph> Element
 898 componentToElement component = singleObject component MOD.ComponentToElement
 899
 900 getConnections :: Diagram -> <ReadGraph> [Resource]
 901 getConnections diagram = [object | object <- (compositeToDiagram diagram) # L0.ConsistsOf, isInstanceOf object DIA.RouteGraphConnection]
 902
 903 getConnection :: Diagram -> String -> <ReadGraph> [Resource]
 904 getConnection diagram name = do
 905     connections = getConnections diagram
 906     filter (\x -> relatedValue2 x L0.HasName == name) connections
 907
 908 setTransform :: Resource -> DoubleArray -> <WriteGraph> ()
 909 setTransform element transform = claimRelatedValueWithType element DIA.HasTransform G2D.Transform transform
 910
 911 """
 912     transformElement transformer element
 913
 914 Performs the affine transformation encapsulated by `transformer` for the specified
 915 diagram `element`.
 916
 917 For examples of possible transformer functions, see [scaleTransform](#scaleTransform)
 918 and [transformWithScale](#transformWithScale).
 919 """
 920 transformElement :: (Position -> Position) -> Resource -> <WriteGraph> ()
 921 transformElement transformer element =
 922     claimRelatedValue element DIA.HasTransform (positionToVector (transformer (transformOf element)))
 923
 924 """
 925     transformElements transformer elements
 926
 927 Runs [transformElement](#transformElement) using the specified transformer for
 928 all the specified `elements`.
 929
 930 Use this function together with e.g. [scaleTransform](#scaleTransform) and
 931 [transformWithScale](#transformWithScale) or similar functions.
 932
 933 Examples:
 934
 935     import "Simantics/Diagram"
 936
 937     // Scale some elements by 1.5:
 938     transformElements (scale 1.5) someElements
 939     // Set scale of some elements to 10
 940     transformElements (withScale 10) someElements
 941 """
 942 transformElements :: (Position -> Position) -> [Resource] -> <WriteGraph> ()
 943 transformElements transformer elements = for elements $ transformElement transformer
 944
 945 importJava "org.simantics.modeling.svg.CreateSVGElement" where
 946     createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> ()
 947     createSVGElementR :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> Resource
 948
 949     importSVGElement :: Resource -> File -> Double -> Double -> <WriteGraph> ()
 950     importSVGElementR :: Resource -> File -> Double -> Double -> <WriteGraph> Resource
 951
 952 importJava "org.simantics.diagram.synchronization.graph.RemoveElement" where
 953     removeElement :: Resource -> Resource -> <WriteGraph> ()
 954
 955 setStraightConnectionLines :: Resource -> Boolean -> <WriteGraph> ()
 956 setStraightConnectionLines element v =
 957     for (element # STR.IsConnectedTo) $ \connector ->
 958         claimRelatedValue connector DIA.Connector.straight v
 959
 960 showProfileMonitors :: Resource -> Boolean -> <WriteGraph> ()
 961 showProfileMonitors element v = claimRelatedValue element DIA.Element.hideProfileMonitors (not v)
 962
 963 setProfileMonitorsDirectionUp :: Resource -> Boolean -> <WriteGraph> ()
 964 setProfileMonitorsDirectionUp element v = claimRelatedValue element DIA.Element.upProfileMonitors v
 965
 966 importJava "org.simantics.diagram.flag.Joiner" where
 967     joinFlagsLocal :: [Resource] -> <WriteGraph> ()
 968
 969 importJava "org.simantics.diagram.flag.RouteGraphConnectionSplitter" where
 970     splitConnection :: Resource -> Double -> Double -> <WriteGraph> ()
 971
 972 importJava "org.simantics.diagram.handler.CopyPasteUtil" where
 973     moveConnection :: Resource -> Double -> Double -> <WriteGraph> ()
 974
 975 importJava "org.simantics.diagram.content.ConnectionUtil" where
 976     translateRouteNodes :: Resource -> Double -> Double -> <WriteGraph> ()
 977
 978 importJava "org.simantics.diagram.synchronization.graph.DiagramGraphUtil" where
 979     defaultSymbolDropHandler :: [WorkbenchSelectionElement] -> <WriteGraph> ()