Allow case icon to embed apply and pattern apply icons.

This commit is contained in:
Robbie Gleichman 2016-12-24 14:46:53 -08:00
parent d2bfde4c51
commit 4ca53c58c4
4 changed files with 34 additions and 13 deletions

View File

@ -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

View File

@ -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

View File

@ -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]

View File

@ -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