// --- 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)
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
// --- 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 -> <ReadGraph,WriteGraph> ()
hasType componentType,
hasTypedProperty
DIA.HasTransform
- (positionToDoubleArray position)
+ (positionToVector position)
G2D.Transform,
hasStatement
MOD.ElementToComponent
]
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
hasType t,
hasTypedProperty
DIA.HasTransform
- (positionToDoubleArray position)
+ (positionToVector position)
G2D.Transform,
hasPossibleProperty
DIA.Flag.HasIOTableBinding
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 ()),
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 ()),
document,
hasTypedProperty
DIA.HasTransform
- (positionToDoubleArray position)
+ (positionToVector position)
G2D.Transform
]
createRealizedFont (Font family size style) = do
label,
hasTypedProperty
DIA.HasTransform
- (positionToDoubleArray position)
+ (positionToVector position)
G2D.Transform,
hasTypedProperty
G2D.HasStrokeWidth
hasStatement DIA.HasMonitorComponent component,
hasTypedProperty
DIA.HasTransform
- (positionToDoubleArray position)
+ (positionToVector position)
G2D.Transform,
hasTypedProperty
G2D.HasStrokeWidth
text,
hasTypedProperty
DIA.HasTransform
- (positionToDoubleArray position)
+ (positionToVector position)
G2D.Transform,
hasStatement
G2D.HasHorizontalAlignment
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
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
setTransform :: Resource -> DoubleArray -> <WriteGraph> ()
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 -> <WriteGraph> ()
+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] -> <WriteGraph> ()
+transformElements transformer elements = for elements $ transformElement transformer
importJava "org.simantics.modeling.svg.CreateSVGElement" where
createSVGElement :: Resource -> String -> ByteArray -> Double -> Double -> <WriteGraph> ()
Code Review / simantics / platform.git / blobdiff