// --- 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> ()
"""Returns all diagrams of the given model."""
diagramsOf :: Model -> <ReadGraph> [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 -> <ReadGraph> [Resource]
+diagramsUnder folder = recurse DIA.Diagram folder
where
recurse t r = do
cs = children r
diagramResourceOf :: Diagram -> <ReadGraph> Resource
diagramResourceOf d = singleObject d MOD.CompositeToDiagram
-import "Extras/HashMap" as Map
-
"""Constructs a transformation for a diagram element."""
mapDiagramElement :: (a -> <e> b) -> (a -> <e> b) -> (a -> <e> Maybe b) -> (a -> <e> b) -> DiagramElement a -> <e> DiagramElement b
mapDiagramElement mapComponentType mapTerminal mapAttribute mapFlagType diagramElement =
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
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)
/*
createJoin :: (Dynamic -> <WriteGraph> Resource) -> Dynamic -> <Proc,WriteGraph> 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,
for (zip elementSpecs elements) setConnectionName
elements
) where
- elementMap = Map.create ()
+ elementMap = MMap.create ()
idRef = ref (0 :: Integer)
isConnectionResource r = isInstanceOf r DIA.Connection
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,
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 [
]
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
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 [
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
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
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
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
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