mirror of
https://github.com/rgleichman/glance.git
synced 2024-08-17 02:40:28 +03:00
Make the args of pattern apply nodes vertical to make embedding cases nicer.
This commit is contained in:
parent
79c15e2e86
commit
d7eb3749d9
@ -36,7 +36,7 @@ syntaxNodeIsEmbeddable parentType n mParentPort = case (parentType, n) of
|
||||
(ApplyParent, LikeApplyNode _ _) -> notResultPort
|
||||
(ApplyParent, LiteralNode _) -> notResultPort
|
||||
(CaseOrGuardParent, LiteralNode _) -> notResultPort
|
||||
(CaseOrGuardParent, LikeApplyNode _ _) -> notResultPort
|
||||
(CaseOrGuardParent, LikeApplyNode _ _) -> notResultPort && notInputPort
|
||||
(CaseOrGuardParent, NestedPatternApplyNode _ _) -> notResultPort && notInputPort
|
||||
_ -> False
|
||||
where
|
||||
|
61
app/Icons.hs
61
app/Icons.hs
@ -55,7 +55,7 @@ iconToDiagram icon = case icon of
|
||||
CaseResultIcon -> identDiaFunc caseResult
|
||||
FlatLambdaIcon n -> identDiaFunc $ flatLambda n
|
||||
NestedApply flavor args -> nestedApplyDia flavor args
|
||||
NestedPApp args -> generalNestedDia apply0Triangle (repeat $ patternC colorScheme) args
|
||||
NestedPApp args -> nestedPAppDia (repeat $ patternC colorScheme) args
|
||||
NestedCaseIcon args -> nestedCaseDia args
|
||||
NestedGuardIcon args -> nestedGuardDia args
|
||||
|
||||
@ -68,6 +68,12 @@ applyPortAngles (Port x) = fmap (@@ turn) $ case x of
|
||||
1 -> [0]
|
||||
_ -> [1/4, 3/4]
|
||||
|
||||
pAppPortAngles :: Floating n => Port -> [Angle n]
|
||||
pAppPortAngles (Port x) = fmap (@@ turn) $ case x of
|
||||
0 -> [1/4]
|
||||
1 -> [0]
|
||||
_ -> [1/2]
|
||||
|
||||
guardPortAngles :: Floating n => Port -> [Angle n]
|
||||
guardPortAngles (Port port) = case port of
|
||||
0 -> [1/4 @@ turn]
|
||||
@ -91,16 +97,17 @@ findIcon name args = icon where
|
||||
Nothing -> listToMaybe $ catMaybes $ fmap findSubSubIcon filteredArgs
|
||||
Just (argNum, (_, finalIcon)) -> Just (argNum, finalIcon)
|
||||
where
|
||||
findSubSubIcon (argNum, (_, icon)) = case findNestedIcon name icon of
|
||||
findSubSubIcon (argNum, (_, subIcon)) = case findNestedIcon name subIcon of
|
||||
Nothing -> Nothing
|
||||
Just x -> Just (argNum, x)
|
||||
|
||||
nestedApplyPortAngles :: SpecialNum n => [Maybe (NodeName, Icon)] -> Port -> Maybe NodeName -> [Angle n]
|
||||
nestedApplyPortAngles args port maybeNodeName = case maybeNodeName of
|
||||
Nothing -> applyPortAngles port
|
||||
|
||||
generalNestedPortAngles :: SpecialNum n =>
|
||||
(Port -> [Angle n]) -> [Maybe (NodeName, Icon)] -> Port -> Maybe NodeName -> [Angle n]
|
||||
generalNestedPortAngles defaultAngles args port maybeNodeName = case maybeNodeName of
|
||||
Nothing -> defaultAngles port
|
||||
Just name -> case findIcon name args of
|
||||
Nothing -> []
|
||||
Just (argNum, icon) -> getPortAngles icon port Nothing
|
||||
Just (_, icon) -> getPortAngles icon port Nothing
|
||||
|
||||
reflectXAngle :: SpecialNum n => Angle n -> Angle n
|
||||
reflectXAngle x = reflectedAngle where
|
||||
@ -109,7 +116,7 @@ reflectXAngle x = reflectedAngle where
|
||||
|
||||
-- TODO reflect the angles for the right side sub-icons
|
||||
nestedGuardPortAngles :: SpecialNum n => [Maybe (NodeName, Icon)] -> Port -> Maybe NodeName -> [Angle n]
|
||||
nestedGuardPortAngles args port@(Port portInt) maybeNodeName = case maybeNodeName of
|
||||
nestedGuardPortAngles args port maybeNodeName = case maybeNodeName of
|
||||
Nothing -> guardPortAngles port
|
||||
Just name -> case findIcon name args of
|
||||
Nothing -> []
|
||||
@ -118,7 +125,7 @@ nestedGuardPortAngles args port@(Port portInt) maybeNodeName = case maybeNodeNam
|
||||
Just (argNum, icon) -> if odd argNum && argNum >= 1
|
||||
-- The icon will be reflected
|
||||
then fmap reflectXAngle subAngles
|
||||
else subAngles --fmap reflectXAngle subAngles
|
||||
else subAngles
|
||||
where
|
||||
subAngles = getPortAngles icon port Nothing
|
||||
|
||||
@ -133,8 +140,8 @@ getPortAngles icon port maybeNodeName = case icon of
|
||||
CaseIcon _ -> guardPortAngles port
|
||||
CaseResultIcon -> []
|
||||
FlatLambdaIcon _ -> applyPortAngles port
|
||||
NestedApply _ args -> nestedApplyPortAngles args port maybeNodeName
|
||||
NestedPApp args -> nestedApplyPortAngles args port maybeNodeName
|
||||
NestedApply _ args -> generalNestedPortAngles applyPortAngles args port maybeNodeName
|
||||
NestedPApp args -> generalNestedPortAngles pAppPortAngles args port maybeNodeName
|
||||
NestedCaseIcon args -> nestedGuardPortAngles args port maybeNodeName
|
||||
NestedGuardIcon args -> nestedGuardPortAngles args port maybeNodeName
|
||||
|
||||
@ -213,6 +220,38 @@ generalTextAppDia textCol borderCol numArgs str name _ reflect angle = nameDiagr
|
||||
rotateDia = transformCorrectedTextBox str textCol borderCol reflect angle |||
|
||||
coloredApplyADia borderCol numArgs
|
||||
|
||||
-- TODO Refactor with generalNestedDia
|
||||
nestedPAppDia :: SpecialBackend b n =>
|
||||
[Colour Double] -> [Maybe (NodeName, Icon)] -> TransformableDia b n
|
||||
nestedPAppDia borderCols funcNodeNameAndArgs name nestingLevel reflect angle = named name $ case funcNodeNameAndArgs of
|
||||
[] -> mempty
|
||||
(maybeFunText:args) -> centerXY $ centerY finalDia ||| transformedText ||| resultCircleAndPort
|
||||
where
|
||||
borderCol = borderCols !! nestingLevel
|
||||
|
||||
transformedText = case maybeFunText of
|
||||
Just _ -> makeInnerIcon True 0 maybeFunText
|
||||
Nothing -> mempty
|
||||
separation = circleRadius * 1.5
|
||||
verticalSeparation = circleRadius
|
||||
resultCircleAndPort = makeQualifiedPort name (Port 1) <> alignR (lc borderCol $ lwG defaultLineWidth $ fc borderCol $ circle circleRadius)
|
||||
triangleAndPorts = vsep separation $
|
||||
rotate quarterTurn (apply0Triangle borderCol) :
|
||||
zipWith (makeInnerIcon False) [2,3..] args
|
||||
|
||||
|
||||
allPorts = makeQualifiedPort name (Port 0) <> alignT triangleAndPorts -- alignL (strutX separation ||| trianglePortsCircle)
|
||||
topAndBottomLineWidth = width allPorts
|
||||
-- boxHeight = height
|
||||
argBox = alignT $ lwG defaultLineWidth $ lc borderCol $ roundedRect topAndBottomLineWidth (height allPorts + verticalSeparation) (circleRadius * 0.5)
|
||||
finalDia = argBox <> allPorts
|
||||
|
||||
makeInnerIcon _ portNum Nothing = makeQualifiedPort name (Port portNum) <> portCircle
|
||||
makeInnerIcon True _ (Just (_, TextBoxIcon t)) = transformCorrectedTextBox t (textBoxTextC colorScheme) borderCol reflect angle
|
||||
makeInnerIcon func _ (Just (iconNodeName, icon)) = iconToDiagram icon iconNodeName innerLevel reflect angle where
|
||||
innerLevel = if func then nestingLevel else nestingLevel + 1
|
||||
|
||||
|
||||
generalNestedDia :: SpecialBackend b n =>
|
||||
(Colour Double -> SpecialQDiagram b n) -> [Colour Double] -> [Maybe (NodeName, Icon)] -> TransformableDia b n
|
||||
generalNestedDia dia borderCols funcNodeNameAndArgs name nestingLevel reflect angle = named name $ case funcNodeNameAndArgs of
|
||||
|
@ -196,8 +196,8 @@ y = (((2 + 4 * 4) - (7+ 2 + baz)*8)/21)
|
||||
(Just x) = Just 3
|
||||
|
||||
{-
|
||||
Since constructors are functions, the match icon has the same shape as
|
||||
the apply icon. The match icon is magenta to help distinguish
|
||||
Since constructors are functions, the match icon has a same shape similar
|
||||
to the apply icon. The match icon is magenta to help distinguish
|
||||
it from the apply icon. In a future iteration of the Glance icons, the match and
|
||||
apply icons should be made more dissimilar so that they can not be confused with
|
||||
each other, even when displaying Glance drawings in black and white.
|
||||
|
2
todo.md
2
todo.md
@ -1,7 +1,7 @@
|
||||
# Todo
|
||||
|
||||
## Todo Now
|
||||
* 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).
|
||||
* Don't allow guards to embed patterns. This is only happening because @ values come from the PApp, not the actual source.
|
||||
|
||||
* Consider adding binding variable names to the lambda icon and match icon. Don't display the name if it is only one character.
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user