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=554a25edad081a50f4388688d19820b359440942;hb=77d7e2176bf9b031dbe216339568d316066bcfc1;hpb=fe1a2f532761669e67da4db4ae15096ced8a04db diff --git a/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl b/bundles/org.simantics.modeling/scl/Simantics/Diagram.scl index 554a25eda..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 -> () @@ -149,9 +229,15 @@ hasRandomIdentifier entity = runProc (claimRelatedValue_ entity L0.identifier GU """Returns all diagrams of the given model.""" diagramsOf :: Model -> [Diagram] -diagramsOf model = recurse - DIA.Diagram - (configurationOf model) +diagramsOf model = diagramsUnder $ configurationOf model + +""" +Returns all diagrams under the specified diagram folder. +The parameter can also be the configuration root `configurationOf` +in which case this function returns the same as `diagramsOf model`. +""" +diagramsUnder :: DiagramFolder -> [Resource] +diagramsUnder folder = recurse DIA.Diagram folder where recurse t r = do cs = children r @@ -182,8 +268,6 @@ pathNameOf diagram = do diagramResourceOf :: Diagram -> Resource diagramResourceOf d = singleObject d MOD.CompositeToDiagram -import "Extras/HashMap" as Map - """Constructs a transformation for a diagram element.""" mapDiagramElement :: (a -> b) -> (a -> b) -> (a -> Maybe b) -> (a -> b) -> DiagramElement a -> DiagramElement b mapDiagramElement mapComponentType mapTerminal mapAttribute mapFlagType diagramElement = @@ -228,9 +312,9 @@ createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do configuration = diagram' diagram = compositeToDiagram' configuration hasName = L0.HasName - componentMap = Map.fromList [ (c `relatedValue` hasName :: String, c) - | c <- children configuration - ] + componentMap = MMap.fromEntryList [ (c `relatedValue` hasName :: String, c) + | c <- children configuration + ] denyByPredicate diagram L0.ConsistsOf elements = setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpecs claimRelatedValue diagram DIA.HasModCount @@ -240,7 +324,7 @@ createDiagramR (ExistingDiagram diagram') joinMap elementSpecs = runProc do createDiagramR (NewDiagram model path folderType compositeType) joinMap elementSpecs = (runProc do configuration = createConfiguration () diagram = compositeToDiagram' configuration - elements = setElements (DiagramInfo diagram configuration (Map.create ())) joinMap elementSpecs + elements = setElements (DiagramInfo diagram configuration (MMap.create ())) joinMap elementSpecs claimRelatedValue diagram DIA.HasModCount (fromInteger (length elements) :: Long) (configuration, elements) @@ -298,19 +382,19 @@ importJava "org.simantics.modeling.utils.JoinMap" where /* createJoin :: (Dynamic -> Resource) -> Dynamic -> Resource -createJoin joinMap key = if Map.contains joinMap key - then Map.unsafeGet joinMap key +createJoin joinMap key = if MMap.containsKey joinMap key + then MMap.unsafeGet joinMap key else do j = newEntity [ hasType STR.ConnectionJoin ] - Map.put joinMap key j + MMap.put joinMap key j j */ data DiagramInfo = DiagramInfo Resource // diagram Resource // configuration - (Map.T String Resource) // existing components + (MMap.T String Resource) // existing components """ Sets the elements of the diagram. Diagram is assumed to be empty, @@ -330,7 +414,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec for (zip elementSpecs elements) setConnectionName elements ) where - elementMap = Map.create () + elementMap = MMap.create () idRef = ref (0 :: Integer) isConnectionResource r = isInstanceOf r DIA.Connection @@ -343,8 +427,8 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec idRef := id + 1 show id createElement (Component componentType name position properties) = do - component = if Map.contains componentMap name - then Map.unsafeGet componentMap name + component = if MMap.containsKey componentMap name + then MMap.unsafeGet componentMap name else newEntity [ hasName name, hasParent configuration, @@ -359,19 +443,19 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec hasType componentType, hasTypedProperty DIA.HasTransform - (positionToDoubleArray position) + (positionToVector position) G2D.Transform, hasStatement MOD.ElementToComponent component ] - Map.put elementMap name element + MMap.put elementMap name element Just element newOrMappedElement eName = do - element = match Map.get elementMap eName with + element = match MMap.get elementMap eName with Just element -> element Nothing -> newEntity [] - Map.put elementMap eName element + MMap.put elementMap eName element element createElement (SimpleConnection aName ar bName br _) = do connection = newEntity [ @@ -380,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 @@ -392,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 @@ -415,7 +499,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec then do claim flag DIA.ExternalFlag flag else () - Map.put elementMap name flag + MMap.put elementMap name flag Just flag createElement (Connection nodeSpecs edges _) = do connection = newEntity [ @@ -428,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 ()), @@ -440,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 ()), @@ -461,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 @@ -484,7 +590,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec label, hasTypedProperty DIA.HasTransform - (positionToDoubleArray position) + (positionToVector position) G2D.Transform, hasTypedProperty G2D.HasStrokeWidth @@ -499,7 +605,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec hasFont font ] createElement (Monitor label (Just (MonitorReference componentName suffix)) (MonitorVisuals font strokeWidth hAlign vAlign) position) = do - match (Map.get elementMap componentName) with + match (MMap.get elementMap componentName) with Nothing -> Nothing // Monitored component is not on the same diagram as the monitor. Not supported by this routine. Just element -> do component = singleObject element MOD.ElementToComponent @@ -515,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 @@ -538,7 +644,7 @@ setElements (DiagramInfo diagram configuration componentMap) joinMap elementSpec text, hasTypedProperty DIA.HasTransform - (positionToDoubleArray position) + (positionToVector position) G2D.Transform, hasStatement G2D.HasHorizontalAlignment @@ -561,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 @@ -699,11 +808,11 @@ elementsOfR diagram = filterJust $ map readElement' nodeResources = connectors + routeLines nodeResourceWithIds = zip nodeResources [0..length nodeResources-1] edges = runProc do - rMap = Map.fromList nodeResourceWithIds + rMap = MMap.fromEntryList nodeResourceWithIds edgesOf (node,i) = [ Edge i j | r <- node # DIA.AreConnected - , j = Map.unsafeGet rMap r + , j = MMap.unsafeGet rMap r , j > i ] concatMap edgesOf nodeResourceWithIds @@ -723,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 @@ -802,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 -> ()