X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=blobdiff_plain;f=bundles%2Forg.simantics.modeling%2Fscl%2FSimantics%2FDiagram.scl;h=14a558bec05c0b549ddd5600e4c3ebec224e6cab;hp=8dd1644e8d0737087eef7f67dc47c3751fd5c9a5;hb=77d7e2176bf9b031dbe216339568d316066bcfc1;hpb=c00d1429bda8dc27461e1576f4be028b43149758;ds=sidebyside diff --git a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl index 8dd1644e8..14a558bec 100644 --- 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] -> Diagram @@ -894,7 +919,7 @@ and [transformWithScale](#transformWithScale). """ transformElement :: (Position -> Position) -> Resource -> () transformElement transformer element = - claimRelatedValue element DIA.HasTransform (positionToDoubleArray (transformer (transformOf element))) + claimRelatedValue element DIA.HasTransform (positionToVector (transformer (transformOf element))) """ transformElements transformer elements