mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +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, LikeApplyNode _ _) -> notResultPort
|
||||||
(ApplyParent, LiteralNode _) -> notResultPort
|
(ApplyParent, LiteralNode _) -> notResultPort
|
||||||
(CaseOrGuardParent, LiteralNode _) -> notResultPort
|
(CaseOrGuardParent, LiteralNode _) -> notResultPort
|
||||||
|
(CaseOrGuardParent, LikeApplyNode _ _) -> notResultPort
|
||||||
|
(CaseOrGuardParent, NestedPatternApplyNode _ _) -> notResultPort && notInputPort
|
||||||
_ -> False
|
_ -> False
|
||||||
where
|
where
|
||||||
|
notInputPort = case mParentPort of
|
||||||
|
Just (Port 0) -> False
|
||||||
|
_ -> True
|
||||||
notResultPort = case mParentPort of
|
notResultPort = case mParentPort of
|
||||||
-- TODO Don't use hardcoded port number
|
-- TODO Don't use hardcoded port number
|
||||||
Just (Port 1) -> False
|
Just (Port 1) -> False
|
||||||
|
34
app/Icons.hs
34
app/Icons.hs
@ -98,6 +98,14 @@ nestedApplyPortAngles args port maybeNodeName = case maybeNodeName of
|
|||||||
Nothing -> []
|
Nothing -> []
|
||||||
Just icon -> getPortAngles icon port 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 :: (Floating n) => Icon -> Port -> Maybe NodeName -> [Angle n]
|
||||||
getPortAngles icon port maybeNodeName = case icon of
|
getPortAngles icon port maybeNodeName = case icon of
|
||||||
ApplyAIcon _ -> applyPortAngles port
|
ApplyAIcon _ -> applyPortAngles port
|
||||||
@ -111,8 +119,8 @@ getPortAngles icon port maybeNodeName = case icon of
|
|||||||
FlatLambdaIcon _ -> applyPortAngles port
|
FlatLambdaIcon _ -> applyPortAngles port
|
||||||
NestedApply _ args -> nestedApplyPortAngles args port maybeNodeName
|
NestedApply _ args -> nestedApplyPortAngles args port maybeNodeName
|
||||||
NestedPApp args -> nestedApplyPortAngles args port maybeNodeName
|
NestedPApp args -> nestedApplyPortAngles args port maybeNodeName
|
||||||
NestedCaseIcon _ -> guardPortAngles port
|
NestedCaseIcon args -> nestedGuardPortAngles args port maybeNodeName
|
||||||
NestedGuardIcon _ -> guardPortAngles port
|
NestedGuardIcon args -> nestedGuardPortAngles args port maybeNodeName
|
||||||
|
|
||||||
-- END getPortAngles --
|
-- END getPortAngles --
|
||||||
|
|
||||||
@ -273,7 +281,7 @@ coloredTextBox :: SpecialBackend b n =>
|
|||||||
-> AlphaColour Double -> String -> SpecialQDiagram b n
|
-> AlphaColour Double -> String -> SpecialQDiagram b n
|
||||||
coloredTextBox textColor boxColor t =
|
coloredTextBox textColor boxColor t =
|
||||||
fontSize (local textBoxFontSize) (bold $ font "freemono" $ fc textColor $ text 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 =>
|
bindTextBox :: SpecialBackend b n =>
|
||||||
String -> SpecialQDiagram 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)))
|
finalDia = alignT (bottomDia <> makeQualifiedPort name (Port 1)) <> alignB (inputIcon === (bigVerticalLine <> guardDia <> makeQualifiedPort name (Port 0)))
|
||||||
|
|
||||||
argPortNums = [2..]
|
argPortNums = [2..]
|
||||||
innerIcons = fmap makeInnerIcon args
|
|
||||||
|
|
||||||
iconMapper portNum innerIcon
|
iconMapper portNum arg
|
||||||
| even portNum = Right $ guardTriangle port ||| innerIcon
|
| even portNum = Right $ guardTriangle port ||| makeInnerIcon True arg
|
||||||
| otherwise = Left $ innerIcon ||| lBracket port
|
| otherwise = Left $ makeInnerIcon False arg ||| lBracket port
|
||||||
where
|
where
|
||||||
port = makeQualifiedPort name (Port portNum)
|
port = makeQualifiedPort name (Port portNum)
|
||||||
|
|
||||||
-- TODO argPortNums is duplicated
|
(lBrackets, trianglesWithPorts) = partitionEithers $ zipWith iconMapper argPortNums args
|
||||||
(lBrackets, trianglesWithPorts) = partitionEithers $ zipWith iconMapper argPortNums innerIcons
|
|
||||||
|
|
||||||
trianglesAndBrackets =
|
trianglesAndBrackets =
|
||||||
zipWith zipper trianglesWithPorts lBrackets
|
zipWith zipper trianglesWithPorts lBrackets
|
||||||
@ -338,14 +344,18 @@ generalNestedGuard triangleColor lBracket bottomDia inputAndArgs name nestingLev
|
|||||||
where
|
where
|
||||||
verticalLine = strutY 0.4
|
verticalLine = strutY 0.4
|
||||||
|
|
||||||
inputIcon = makeInnerIcon input
|
inputIcon = makeInnerIcon False input
|
||||||
|
|
||||||
guardDia = vcat (alignT trianglesAndBrackets)
|
guardDia = vcat (alignT trianglesAndBrackets)
|
||||||
bigVerticalLine = alignT $ lwG defaultLineWidth $ lc triangleColor $ vrule (height guardDia)
|
bigVerticalLine = alignT $ lwG defaultLineWidth $ lc triangleColor $ vrule (height guardDia)
|
||||||
|
|
||||||
makeInnerIcon mNameAndIcon = case mNameAndIcon of
|
makeInnerIcon innerReflected mNameAndIcon = case mNameAndIcon of
|
||||||
Nothing -> mempty
|
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 =>
|
guardLBracket :: SpecialBackend b n =>
|
||||||
SpecialQDiagram b n -> SpecialQDiagram b n
|
SpecialQDiagram b n -> SpecialQDiagram b n
|
||||||
|
@ -63,7 +63,9 @@ nestedTests = [
|
|||||||
"Foo (Bar x) (Baz y) = 1",
|
"Foo (Bar x) (Baz y) = 1",
|
||||||
"Foo (Bar x) = f 2",
|
"Foo (Bar x) = f 2",
|
||||||
"Foo (Bar x) = f x",
|
"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]
|
specialTests :: [String]
|
||||||
|
4
todo.md
4
todo.md
@ -1,6 +1,10 @@
|
|||||||
# Todo
|
# Todo
|
||||||
|
|
||||||
## Todo Now
|
## 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.
|
* 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
|
## Todo Later
|
||||||
|
Loading…
Reference in New Issue
Block a user