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