mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-16 18:30:36 +03:00
Remove context dependent coloring for text boxes in apply icons.
This commit is contained in:
parent
6f18d5f96d
commit
bc5ac3fa80
28
app/Icons.hs
28
app/Icons.hs
@ -349,7 +349,8 @@ nestedPAppDia
|
||||
case funcNodeNameAndArgs of
|
||||
[] -> mempty
|
||||
(maybeFunText:args) ->
|
||||
centerXY $ centerY finalDia ||| transformedText ||| resultCircleAndPort
|
||||
centerXY
|
||||
$ centerY finalDia ||| beside' unitX transformedText resultCircleAndPort
|
||||
where
|
||||
borderCol = borderCols !! nestingLevel
|
||||
|
||||
@ -367,7 +368,6 @@ nestedPAppDia
|
||||
rotate quarterTurn (apply0Triangle borderCol) :
|
||||
zipWith (makeInnerIcon False) argPortsConst args
|
||||
|
||||
|
||||
allPorts
|
||||
= makeQualifiedPort name inputPortConst <> alignT triangleAndPorts
|
||||
-- alignL (strutX separation ||| trianglePortsCircle)
|
||||
@ -383,13 +383,6 @@ nestedPAppDia
|
||||
|
||||
makeInnerIcon _ portNum (Nothing, str)
|
||||
= centerX $ makeLabelledPort name reflect angle str portNum
|
||||
makeInnerIcon True _ (Just (NamedIcon _ (TextBoxIcon t)), _)
|
||||
= transformCorrectedTextBox
|
||||
t
|
||||
(textBoxTextC colorScheme)
|
||||
borderCol
|
||||
reflect
|
||||
angle
|
||||
makeInnerIcon func _ (Just (NamedIcon iconNodeName icon), _)
|
||||
= iconToDiagram
|
||||
icon
|
||||
@ -397,6 +390,10 @@ nestedPAppDia
|
||||
where
|
||||
innerLevel = if func then nestingLevel else nestingLevel + 1
|
||||
|
||||
-- | Like beside, but it puts the second dia atop the first dia
|
||||
beside' :: (Semigroup a, Juxtaposable a) => V a (N a) -> a -> a -> a
|
||||
beside' dir dia1 dia2 = juxtapose dir dia1 dia2 <> dia1
|
||||
|
||||
generalNestedDia :: SpecialBackend b n
|
||||
=> (Colour Double -> SpecialQDiagram b n)
|
||||
-> [Colour Double]
|
||||
@ -407,11 +404,9 @@ generalNestedDia
|
||||
dia
|
||||
borderCols
|
||||
maybeFunText
|
||||
funcNodeNameAndArgs
|
||||
args
|
||||
(TransformParams name nestingLevel reflect angle)
|
||||
= named name $ case funcNodeNameAndArgs of
|
||||
[] -> mempty
|
||||
args -> centerXY $ transformedText ||| centerY finalDia
|
||||
= named name $ centerXY $ beside' unitX transformedText finalDia
|
||||
where
|
||||
borderCol = borderCols !! nestingLevel
|
||||
|
||||
@ -442,13 +437,6 @@ generalNestedDia
|
||||
|
||||
makeInnerIcon _ portNum Nothing
|
||||
= makeQualifiedPort name portNum <> portCircle
|
||||
makeInnerIcon True _ (Just (NamedIcon _ (TextBoxIcon t)))
|
||||
= transformCorrectedTextBox
|
||||
t
|
||||
(textBoxTextC colorScheme)
|
||||
borderCol
|
||||
reflect
|
||||
angle
|
||||
makeInnerIcon func _ (Just (NamedIcon iconNodeName icon))
|
||||
= iconToDiagram
|
||||
icon
|
||||
|
@ -205,7 +205,7 @@ makeEdge graph dia rotationMap (node0, node1, edge@(Edge _ _ (namePort0, namePor
|
||||
getPortPoint n = head $ fromMaybeError
|
||||
("makeEdge: port not found. Port: " ++ show n ++ ". Valid ports: " ++ show diaNodeNamePointMap)
|
||||
(lookup n diaNodeNamePointMap)
|
||||
|
||||
|
||||
portAngles = (icon0PortAngle, icon1PortAngle)
|
||||
|
||||
-- | addEdges draws the edges underneath the nodes.
|
||||
@ -246,10 +246,10 @@ bestAngleForIcon positionMap graph key@(NamedIcon (NodeName nodeId) _) reflected
|
||||
-- possibleAngles = [0, 1/2] -- (uncomment this line and comment out the line above to disable rotation)
|
||||
iconPosition = positionMap Map.! key
|
||||
edges = getPositionAndAngles <$> fmap getSucEdge (ING.lsuc graph nodeId) <> fmap getPreEdge (ING.lpre graph nodeId)
|
||||
|
||||
|
||||
getPositionAndAngles (node, nameAndPort) = (positionMap Map.! nodeLabel, portAngles) where
|
||||
nodeLabel = fromMaybeError "getPositionAndAngles: node not found" $ ING.lab graph node
|
||||
portAngles = findPortAngles key nameAndPort
|
||||
portAngles = findPortAngles key nameAndPort
|
||||
|
||||
-- Edge points from id to otherNode
|
||||
getSucEdge (otherNode, edge) = (otherNode, nameAndPort) where
|
||||
@ -347,7 +347,10 @@ doGraphLayout graph = do
|
||||
diaWidth = drawingToGraphvizScaleFactor * width dia
|
||||
diaHeight = drawingToGraphvizScaleFactor * height dia
|
||||
circleDiameter' = max diaWidth diaHeight
|
||||
circleDiameter = if circleDiameter' <= 0.01 then error ("circleDiameter too small: " ++ show circleDiameter') else circleDiameter'
|
||||
circleDiameter
|
||||
= if circleDiameter' <= 0.01
|
||||
then error ("circleDiameter too small: " ++ show circleDiameter')
|
||||
else circleDiameter'
|
||||
|
||||
-- | Given a Drawing, produce a Diagram complete with rotated/flipped icons and
|
||||
-- lines connecting ports and icons. IO is needed for the GraphViz layout.
|
||||
|
@ -126,6 +126,38 @@ flatGuardDrawing = Drawing icons edges where
|
||||
]
|
||||
edges = []
|
||||
|
||||
nestedPAppDia :: Drawing
|
||||
nestedPAppDia = Drawing icons []
|
||||
where
|
||||
icons = [
|
||||
NamedIcon (NodeName 1) (NestedPApp [(Nothing, "baz")])
|
||||
, NamedIcon
|
||||
(NodeName 2)
|
||||
(NestedPApp
|
||||
[ (Nothing, "")
|
||||
, (Just (NamedIcon (NodeName 1) (TextBoxIcon "foo")), "bar")
|
||||
, (Nothing, "bar")])
|
||||
, NamedIcon
|
||||
(NodeName 3)
|
||||
(NestedPApp
|
||||
[
|
||||
(Just (NamedIcon (NodeName 4) (TextBoxIcon "foo")), "bar")
|
||||
, (Nothing, "bar")])
|
||||
]
|
||||
|
||||
nestedApplyDia :: Drawing
|
||||
nestedApplyDia = Drawing icons []
|
||||
where
|
||||
icons = [
|
||||
NamedIcon
|
||||
(NodeName 1)
|
||||
(NestedApply
|
||||
ApplyNodeFlavor
|
||||
(Just $ NamedIcon (NodeName 1) (TextBoxIcon "foo"))
|
||||
[])
|
||||
--[Just $ NamedIcon (NodeName 1) (TextBoxIcon "bar")])
|
||||
]
|
||||
|
||||
--renderTests :: IO (Diagram B)
|
||||
renderTests :: SpecialBackend b Double => IO (SpecialQDiagram b Double)
|
||||
renderTests = do
|
||||
@ -139,6 +171,7 @@ renderTests = do
|
||||
nestedCaseDrawing,
|
||||
nestedGuardDrawing,
|
||||
flatCaseDrawing,
|
||||
flatGuardDrawing
|
||||
-- TODO Add a nested test where the function expression is nested.
|
||||
flatGuardDrawing,
|
||||
nestedPAppDia,
|
||||
nestedApplyDia
|
||||
]
|
||||
|
Loading…
Reference in New Issue
Block a user