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=8276962eac7d4aefab138355327ee3d364cd3ffe;hb=77d7e2176bf9b031dbe216339568d316066bcfc1;hpb=2318f67fbf458ee97fd438678be1bc5a636c9fa7 diff --git a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl index 8276962ea..14a558bec 100644 --- a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl +++ b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl @@ -24,16 +24,41 @@ type ConnectionType = Resource // --- Position ----------------------------------------------------- +""" + Position xx xy yx yy tx ty + +is a 2D affine transform with a rotation/scale/shear part, +i.e. `xx xy yx yy` and a translation part `tx ty` which +represents the matrix + + [xx yx | tx] + [xy yy | ty] +""" data Position = Position Double Double Double Double Double Double deriving instance Show Position +""" + translation x y + +Returns an affine transform with identity rotation and `x y` for translation. +""" location :: Double -> Double -> Position location x y = Position 1 0 0 1 x y +""" + move (dx,dy) + +Returns a function that adds `(dx, dy)` to the translation of a specified affine transform. +""" move :: (Double,Double) -> Position -> Position move (dx,dy) (Position xx xy yx yy x y) = Position xx xy yx yy (x+dx) (y+dy) +""" + rotate n + +Returns a function that rotates the specified affine transform by `n*90` degrees +""" rotate :: Integer -> Position -> Position rotate angle (Position xx xy yx yy x y) = Position (c*xx + s*xy) (c*xy - s*xx) @@ -46,17 +71,68 @@ rotate angle (Position xx xy yx yy x y) = s = match a with 1 -> 1.0 ; 3 -> -1.0 ; _ -> 0.0 c = match a with 0 -> 1.0 ; 2 -> -1.0 ; _ -> 0.0 +""" + scale s transform + +Multiplies the rotation part of the specified affine `transform` by `s` + +``` +[xx yx tx] => [s*xx s*yx tx] +[xy yy ty] [s*xy s*yy ty] +``` +""" scale :: Double -> Position -> Position scale s (Position xx xy yx yy x y) = Position (s*xx) (s*xy) (s*yx) (s*yy) x y +""" + withScale scale transform + +Sets the rotation part so that the base vectors defined by `u=[xx xy]` and `v=[yx yy]` +are of length `scale`. This effectively sets the scaling of the elements without +touching their rotation/shear. + +``` +su = scale / |u| +sv = scale / |v| + +[xx yx tx] => [su*xx sv*yx tx] +[xy yy ty] [su*xy sv*yy ty] +``` +""" +withScale :: Double -> Position -> Position +withScale scale (Position xx xy yx yy tx ty) = Position xx' xy' yx' yy' tx ty + where + su = scale / (sqrt (xx*xx + xy*xy)) + sv = scale / (sqrt (yx*yx + yy*yy)) + xx' = xx * su + xy' = xy * su + yx' = yx * sv + yy' = yy * sv + +""" + flipX transform + +Performs a mirror operation for the specified `transform` about the Y-axis. +""" flipX :: Position -> Position flipX (Position xx xy yx yy x y) = Position (-xx) xy (-yx) yy x y +""" + flipY transform + +Performs a mirror operation for the specified `transform` about the X-axis. +""" flipY :: Position -> Position flipY (Position xx xy yx yy x y) = Position xx (-xy) yx (-yy) x y +""" +Converts a [Position](#Position) into a `Vector Double`. +""" positionToDoubleArray (Position a b c d e f) = toDoubleArray [a,b,c,d,e,f] +""" +Converts a [Position](#Position) into a `Vector Double`. +""" positionToVector :: Position -> Vector Double positionToVector (Position a b c d e f) = runProc (do r = createMVector 6 @@ -142,6 +218,10 @@ deriving instance (Show res) => Show (DiagramElement res) // --- Functions ---------------------------------------------------- +@private +transformOf element = Position (da!0) (da!1) (da!2) (da!3) (da!4) (da!5) + where da = relatedValue element DIA.HasTransform :: Vector Double + """Creates a random GUID L0.identifier property for the specified entity resource.""" @private hasRandomIdentifier :: Resource -> () @@ -363,7 +443,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec hasType componentType, hasTypedProperty DIA.HasTransform - (positionToDoubleArray position) + (positionToVector position) G2D.Transform, hasStatement MOD.ElementToComponent @@ -384,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 @@ -396,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 @@ -432,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 ()), @@ -444,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 ()), @@ -465,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 @@ -488,7 +590,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec label, hasTypedProperty DIA.HasTransform - (positionToDoubleArray position) + (positionToVector position) G2D.Transform, hasTypedProperty G2D.HasStrokeWidth @@ -519,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 @@ -542,7 +644,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec text, hasTypedProperty DIA.HasTransform - (positionToDoubleArray position) + (positionToVector position) G2D.Transform, hasStatement G2D.HasHorizontalAlignment @@ -565,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 @@ -727,10 +832,6 @@ elementsOfR diagram = filterJust $ map readElement' readRouteLine r = RouteLine (relatedValue r DIA.IsHorizontal) (relatedValue r DIA.HasPosition) - transformOf element = do - da = fromDoubleArray $ - relatedValue element DIA.HasTransform - Position (da!0) (da!1) (da!2) (da!3) (da!4) (da!5) nameOf r = relatedValue r L0.HasName labelOf r = relatedValue2 r L0.HasLabel idOf r = match possibleObject r MOD.ElementToComponent with @@ -806,6 +907,40 @@ getConnection diagram name = do setTransform :: Resource -> DoubleArray -> () setTransform element transform = claimRelatedValueWithType element DIA.HasTransform G2D.Transform transform + +""" + transformElement transformer element + +Performs the affine transformation encapsulated by `transformer` for the specified +diagram `element`. + +For examples of possible transformer functions, see [scaleTransform](#scaleTransform) +and [transformWithScale](#transformWithScale). +""" +transformElement :: (Position -> Position) -> Resource -> () +transformElement transformer element = + claimRelatedValue element DIA.HasTransform (positionToVector (transformer (transformOf element))) + +""" + transformElements transformer elements + +Runs [transformElement](#transformElement) using the specified transformer for +all the specified `elements`. + +Use this function together with e.g. [scaleTransform](#scaleTransform) and +[transformWithScale](#transformWithScale) or similar functions. + +Examples: + + import "Simantics/Diagram" + + // Scale some elements by 1.5: + transformElements (scale 1.5) someElements + // Set scale of some elements to 10 + transformElements (withScale 10) someElements +""" +transformElements :: (Position -> Position) -> [Resource] -> () +transformElements transformer elements = for elements $ transformElement transformer importJava "org.simantics.modeling.svg.CreateSVGElement" where createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> ()