Fixed Simantics/Diagram/setElements to resolve attachment relations

[simantics/platform.git] / bundles / org.simantics.modeling / scl / Simantics / Diagram.scl

diff --git a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl
index 8dd1644e8d0737087eef7f67dc47c3751fd5c9a5..14a558bec05c0b549ddd5600e4c3ebec224e6cab 100644 (file)
--- a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl
+++ b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl
@@ -220,7 +220,7 @@ deriving instance (Show res) => Show (DiagramElement res)
 
 @private
 transformOf element = Position (da!0) (da!1) (da!2) (da!3) (da!4) (da!5)
-    where da = fromDoubleArray $ relatedValue element DIA.HasTransform
+    where da = relatedValue element DIA.HasTransform :: Vector Double
 
 """Creates a random GUID L0.identifier property for the specified entity resource.""" 
 @private
@@ -443,7 +443,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
             hasType componentType,
             hasTypedProperty 
                 DIA.HasTransform
-                (positionToDoubleArray position)
+                (positionToVector position)
                 G2D.Transform,
             hasStatement 
                 MOD.ElementToComponent
@@ -464,8 +464,8 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
         ]
         a = newOrMappedElement aName
         b = newOrMappedElement bName
-        ca = createConnector connection a ar
-        cb = createConnector connection b br
+        ca = createConnector connection a ar DIA.HasPlainConnector
+        cb = createConnector connection b br DIA.HasArrowConnector
         connectNodes ca cb
         Just connection
     createElement (Flag t name label output external tableBinding tableRow position joins) = do
@@ -476,7 +476,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
             hasType t,
             hasTypedProperty 
                 DIA.HasTransform
-                (positionToDoubleArray position)
+                (positionToVector position)
                 G2D.Transform,
             hasPossibleProperty 
                 DIA.Flag.HasIOTableBinding
@@ -512,7 +512,10 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
         Just connection
     createNode connection (Terminal elementName terminal) = do
         element = newOrMappedElement elementName
-        createConnector connection element terminal        
+        if terminal == DIA.Flag.ConnectionPoint then
+            createConnector connection element terminal DIA.HasPlainConnector
+        else        
+            createConnector connection element terminal DIA.HasPlainConnector
     createNode connection (RouteLine isHorizontal position) = do
         newEntity [
             hasName (freshElementName ()),
@@ -524,18 +527,37 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
             hasStatement DIA.HasInteriorRouteNode.Inverse
                         connection
         ]
-    createConnector connection component terminal = do
+    createConnector connection component terminal defaultHasConnector = do
         connector = newResource ()
         claim connector
               L0.InstanceOf
               DIA.Connector
         claim component terminal connector
-        claim connection 
-              DIA.HasPlainConnector 
-              connector
+        
+        (connectionRelation, attachmentRelation) = resolveAttachmentRelation component terminal defaultHasConnector
+        
+        claim connection attachmentRelation connector
+                
+        execJust connectionRelation (\cr -> do 
+            if existsStatement cr MOD.NeedsConnectionMappingSpecification then do
+                connectionType = singleObject cr STR.AllowsConnectionType
+                spec = singleObject connectionType MOD.ConnectionTypeToConnectionMappingSpecification
+                claim connector
+                      MOD.HasConnectionMappingSpecification
+                      spec
+            else ())
+        
         connector
     connectNodes a b = 
         claim a DIA.AreConnected b
+    // Returns (connectionRelation :: Maybe Resource, connector attachment relation :: Resource)  
+    resolveAttachmentRelation element terminal defaultAttachmentRelation =
+        if terminal == DIA.Flag.ConnectionPoint then
+            (Nothing, flagTypeToAttachmentRelation element)
+        else
+            match possibleObject terminal MOD.DiagramConnectionRelationToConnectionRelation with
+                Just connectionRelation -> (Just connectionRelation, orElse (possibleObject connectionRelation STR.HasAttachmentRelation) defaultAttachmentRelation)
+                Nothing                 -> (Nothing, defaultAttachmentRelation)
     createElement (SVG document position) =
         Just $ newEntity [
             hasName (freshElementName ()),
@@ -545,7 +567,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
                 document,
             hasTypedProperty 
                 DIA.HasTransform
-                (positionToDoubleArray position)
+                (positionToVector position)
                 G2D.Transform
         ]
     createRealizedFont (Font family size style) = do
@@ -568,7 +590,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
                 label,
             hasTypedProperty 
                 DIA.HasTransform
-                (positionToDoubleArray position)
+                (positionToVector position)
                 G2D.Transform,
             hasTypedProperty 
                 G2D.HasStrokeWidth
@@ -599,7 +621,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
             hasStatement DIA.HasMonitorComponent component,
             hasTypedProperty 
                 DIA.HasTransform
-                (positionToDoubleArray position)
+                (positionToVector position)
                 G2D.Transform,
             hasTypedProperty 
                 G2D.HasStrokeWidth
@@ -622,7 +644,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
                 text,
             hasTypedProperty 
                 DIA.HasTransform
-                (positionToDoubleArray position)
+                (positionToVector position)
                 G2D.Transform,
             hasStatement 
                 G2D.HasHorizontalAlignment
@@ -645,6 +667,9 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec
             Just c -> claimRelatedValue c L0.HasName name
             Nothing -> () // This is a typical case
     setConnectionName _ = ()
+    flagTypeToAttachmentRelation flag = match possibleObject flag DIA.HasFlagType with
+        Just DIA.FlagType.OutputFlag -> DIA.HasArrowConnector
+        otherwise                    -> DIA.HasPlainConnector
 
 """Returns a diagram in the given model with the given model relative path.""" 
 diagram :: Model -> [String] -> <ReadGraph> Diagram
@@ -894,7 +919,7 @@ and [transformWithScale](#transformWithScale).
 """
 transformElement :: (Position -> Position) -> Resource -> <WriteGraph> ()
 transformElement transformer element =
-    claimRelatedValue element DIA.HasTransform (positionToDoubleArray (transformer (transformOf element)))
+    claimRelatedValue element DIA.HasTransform (positionToVector (transformer (transformOf element)))
     
 """
     transformElements transformer elements