bundles/org.simantics.modeling/scl/Simantics/Diagram.scl

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