mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-17 10:50:24 +03:00
Allow case icon to embed apply and pattern apply icons.
This commit is contained in:
parent
d2bfde4c51
commit
4ca53c58c4
@ -36,8 +36,13 @@ syntaxNodeIsEmbeddable parentType n mParentPort = case (parentType, n) of
|
||||
(ApplyParent, LikeApplyNode _ _) -> notResultPort
|
||||
(ApplyParent, LiteralNode _) -> notResultPort
|
||||
(CaseOrGuardParent, LiteralNode _) -> notResultPort
|
||||
(CaseOrGuardParent, LikeApplyNode _ _) -> notResultPort
|
||||
(CaseOrGuardParent, NestedPatternApplyNode _ _) -> notResultPort && notInputPort
|
||||
_ -> False
|
||||
where
|
||||
notInputPort = case mParentPort of
|
||||
Just (Port 0) -> False
|
||||
_ -> True
|
||||
notResultPort = case mParentPort of
|
||||
-- TODO Don't use hardcoded port number
|
||||
Just (Port 1) -> False
|
||||
|
34
app/Icons.hs
34
app/Icons.hs
@ -98,6 +98,14 @@ nestedApplyPortAngles args port maybeNodeName = case maybeNodeName of
|
||||
Nothing -> []
|
||||
Just icon -> getPortAngles icon port Nothing
|
||||
|
||||
-- TODO reflect the angles for the right side sub-icons
|
||||
nestedGuardPortAngles :: Floating n => [Maybe (NodeName, Icon)] -> Port -> Maybe NodeName -> [Angle n]
|
||||
nestedGuardPortAngles args port maybeNodeName = case maybeNodeName of
|
||||
Nothing -> guardPortAngles port
|
||||
Just name -> case findIcon name args of
|
||||
Nothing -> []
|
||||
Just icon -> getPortAngles icon port Nothing
|
||||
|
||||
getPortAngles :: (Floating n) => Icon -> Port -> Maybe NodeName -> [Angle n]
|
||||
getPortAngles icon port maybeNodeName = case icon of
|
||||
ApplyAIcon _ -> applyPortAngles port
|
||||
@ -111,8 +119,8 @@ getPortAngles icon port maybeNodeName = case icon of
|
||||
FlatLambdaIcon _ -> applyPortAngles port
|
||||
NestedApply _ args -> nestedApplyPortAngles args port maybeNodeName
|
||||
NestedPApp args -> nestedApplyPortAngles args port maybeNodeName
|
||||
NestedCaseIcon _ -> guardPortAngles port
|
||||
NestedGuardIcon _ -> guardPortAngles port
|
||||
NestedCaseIcon args -> nestedGuardPortAngles args port maybeNodeName
|
||||
NestedGuardIcon args -> nestedGuardPortAngles args port maybeNodeName
|
||||
|
||||
-- END getPortAngles --
|
||||
|
||||
@ -273,7 +281,7 @@ coloredTextBox :: SpecialBackend b n =>
|
||||
-> AlphaColour Double -> String -> SpecialQDiagram b n
|
||||
coloredTextBox textColor boxColor t =
|
||||
fontSize (local textBoxFontSize) (bold $ font "freemono" $ fc textColor $ text t)
|
||||
<> lwG (0.6 * defaultLineWidth) (lcA boxColor $ rectForText (length t))
|
||||
<> lwG (0.6 * defaultLineWidth) (lcA boxColor $ fcA (withOpacity (backgroundC colorScheme) 0.5) $ rectForText (length t))
|
||||
|
||||
bindTextBox :: SpecialBackend b n =>
|
||||
String -> SpecialQDiagram b n
|
||||
@ -320,16 +328,14 @@ generalNestedGuard triangleColor lBracket bottomDia inputAndArgs name nestingLev
|
||||
finalDia = alignT (bottomDia <> makeQualifiedPort name (Port 1)) <> alignB (inputIcon === (bigVerticalLine <> guardDia <> makeQualifiedPort name (Port 0)))
|
||||
|
||||
argPortNums = [2..]
|
||||
innerIcons = fmap makeInnerIcon args
|
||||
|
||||
iconMapper portNum innerIcon
|
||||
| even portNum = Right $ guardTriangle port ||| innerIcon
|
||||
| otherwise = Left $ innerIcon ||| lBracket port
|
||||
iconMapper portNum arg
|
||||
| even portNum = Right $ guardTriangle port ||| makeInnerIcon True arg
|
||||
| otherwise = Left $ makeInnerIcon False arg ||| lBracket port
|
||||
where
|
||||
port = makeQualifiedPort name (Port portNum)
|
||||
|
||||
-- TODO argPortNums is duplicated
|
||||
(lBrackets, trianglesWithPorts) = partitionEithers $ zipWith iconMapper argPortNums innerIcons
|
||||
(lBrackets, trianglesWithPorts) = partitionEithers $ zipWith iconMapper argPortNums args
|
||||
|
||||
trianglesAndBrackets =
|
||||
zipWith zipper trianglesWithPorts lBrackets
|
||||
@ -338,14 +344,18 @@ generalNestedGuard triangleColor lBracket bottomDia inputAndArgs name nestingLev
|
||||
where
|
||||
verticalLine = strutY 0.4
|
||||
|
||||
inputIcon = makeInnerIcon input
|
||||
inputIcon = makeInnerIcon False input
|
||||
|
||||
guardDia = vcat (alignT trianglesAndBrackets)
|
||||
bigVerticalLine = alignT $ lwG defaultLineWidth $ lc triangleColor $ vrule (height guardDia)
|
||||
|
||||
makeInnerIcon mNameAndIcon = case mNameAndIcon of
|
||||
makeInnerIcon innerReflected mNameAndIcon = case mNameAndIcon of
|
||||
Nothing -> mempty
|
||||
Just (iconNodeName, icon) -> iconToDiagram icon iconNodeName nestingLevel reflect angle
|
||||
Just (iconNodeName, icon) -> if innerReflected
|
||||
then reflectX dia
|
||||
else dia
|
||||
where
|
||||
dia = iconToDiagram icon iconNodeName nestingLevel (innerReflected /= reflect) angle
|
||||
|
||||
guardLBracket :: SpecialBackend b n =>
|
||||
SpecialQDiagram b n -> SpecialQDiagram b n
|
||||
|
@ -63,7 +63,9 @@ nestedTests = [
|
||||
"Foo (Bar x) (Baz y) = 1",
|
||||
"Foo (Bar x) = f 2",
|
||||
"Foo (Bar x) = f x",
|
||||
"y x = case x of {Just w -> (let (z,_) = w in z)}"
|
||||
"y x = case x of {Just w -> (let (z,_) = w in z)}",
|
||||
"y = case x of 1 -> f 0",
|
||||
"y (Port x) = case x of 0 -> 1"
|
||||
]
|
||||
|
||||
specialTests :: [String]
|
||||
|
4
todo.md
4
todo.md
@ -1,6 +1,10 @@
|
||||
# Todo
|
||||
|
||||
## Todo Now
|
||||
* Reflect the angles of the inner icons for nestedGuardPortAngles
|
||||
|
||||
* Change the PApp icon so that from left to right it looks like: list of args, constructor name, result. If there is only one arg, then the arg port can have an additional angle of (1/2 turn).
|
||||
|
||||
* Consider adding binding variable names to the lambda icon and match icon. Don't display the name if it is only one character.
|
||||
|
||||
## Todo Later
|
||||
|
Loading…
Reference in New Issue
Block a user