Embed lambdas as arguments. Make apply and lambda argumenet/parameter boxes transparent to make line crossings look better.

This commit is contained in:
Robbie Gleichman 2019-08-06 02:33:01 -07:00
parent ff761f8db8
commit 2460a3f472
4 changed files with 34 additions and 12 deletions

View File

@ -56,7 +56,7 @@ colorOnBlackScheme = ColorStyle {
where where
slightlyGreenYellow = sRGB24 212 255 0 slightlyGreenYellow = sRGB24 212 255 0
lightMagenta = sRGB24 255 94 255 lightMagenta = sRGB24 255 94 255
lightSlightlyPurpleBlue = sRGB24 67 38 255 lightSlightlyPurpleBlue = sRGB24 109 87 255
reddishOrange = sRGB24 255 119 0 reddishOrange = sRGB24 255 119 0
--lightBlue = sRGB24 126 127 255 --lightBlue = sRGB24 126 127 255
lightBlue = sRGB24 35 156 255 lightBlue = sRGB24 35 156 255

View File

@ -53,7 +53,7 @@ syntaxNodeIsEmbeddable parentType syntaxNode mParentPort mChildPort
(ApplyParent, ApplyNode _ _) -> parentPortNotResult (ApplyParent, ApplyNode _ _) -> parentPortNotResult
(ApplyParent, LiteralNode _) -> parentPortNotResult (ApplyParent, LiteralNode _) -> parentPortNotResult
(ApplyParent, FunctionDefNode _ _) (ApplyParent, FunctionDefNode _ _)
-> isInput mParentPort && isResult mChildPort -> parentPortNotResult && isResult mChildPort
-- The match below works, but can make messy drawings with the current -- The match below works, but can make messy drawings with the current
-- icon for lambdas. -- icon for lambdas.

View File

@ -68,6 +68,9 @@ defaultLineWidth = 0.15
circleRadius :: (Fractional a) => a circleRadius :: (Fractional a) => a
circleRadius = 0.5 circleRadius = 0.5
defaultOpacity :: (Fractional a) => a
defaultOpacity = 0.4
-- COLORS -- -- COLORS --
lineCol :: Colour Double lineCol :: Colour Double
lineCol = lineC colorScheme lineCol = lineC colorScheme
@ -121,6 +124,17 @@ applyPortAngles (Port x) = fmap (@@ turn) $ case x of
1 -> [0] 1 -> [0]
_ -> [1/4, 3/4] _ -> [1/4, 3/4]
lambdaPortAngles :: Floating n => Bool -> Port -> [Angle n]
lambdaPortAngles embedded (Port x) = fmap (@@ turn) $ case x of
-- 0 == lambda return value Icon
0 -> if embedded
then [1/4, 3/4]
else [3/8, 1/2, 5/8]
-- 1 == value port
--1 -> [1/8, 7/8, 0]
1 -> [0]
_ -> [1/4, 3/4]
pAppPortAngles :: Floating n => Port -> [Angle n] pAppPortAngles :: Floating n => Port -> [Angle n]
pAppPortAngles (Port x) = fmap (@@ turn) $ case x of pAppPortAngles (Port x) = fmap (@@ turn) $ case x of
0 -> [1/4] 0 -> [1/4]
@ -172,7 +186,7 @@ generalNestedPortAngles iconInfo defaultAngles headIcon args port maybeNodeName
Nothing -> defaultAngles port Nothing -> defaultAngles port
Just name -> case findIcon iconInfo name (headIcon : args) of Just name -> case findIcon iconInfo name (headIcon : args) of
Nothing -> [] Nothing -> []
Just (_, icon) -> getPortAngles iconInfo icon port Nothing Just (_, icon) -> getPortAnglesHelper True iconInfo icon port Nothing
reflectXAngle :: SpecialNum n => Angle n -> Angle n reflectXAngle :: SpecialNum n => Angle n -> Angle n
reflectXAngle x = reflectedAngle where reflectXAngle x = reflectedAngle where
@ -197,16 +211,21 @@ nestedMultiIfPortAngles iconInfo args port maybeNodeName = case maybeNodeName of
then fmap reflectXAngle subAngles then fmap reflectXAngle subAngles
else subAngles else subAngles
where where
subAngles = getPortAngles iconInfo icon port Nothing subAngles = getPortAnglesHelper True iconInfo icon port Nothing
getPortAngles :: SpecialNum n => IconInfo -> Icon -> Port -> Maybe NodeName -> [Angle n] getPortAngles :: SpecialNum n
getPortAngles iconInfo icon port maybeNodeName = case icon of => IconInfo -> Icon -> Port -> Maybe NodeName -> [Angle n]
getPortAngles = getPortAnglesHelper False
getPortAnglesHelper :: SpecialNum n
=> Bool -> IconInfo -> Icon -> Port -> Maybe NodeName -> [Angle n]
getPortAnglesHelper embedded iconInfo icon port maybeNodeName = case icon of
TextBoxIcon _ -> [] TextBoxIcon _ -> []
BindTextBoxIcon _ -> [] BindTextBoxIcon _ -> []
MultiIfIcon _ -> multiIfPortAngles port MultiIfIcon _ -> multiIfPortAngles port
CaseIcon _ -> multiIfPortAngles port CaseIcon _ -> multiIfPortAngles port
CaseResultIcon -> [] CaseResultIcon -> []
LambdaIcon _ _ _ -> applyPortAngles port LambdaIcon _ _ _ -> lambdaPortAngles embedded port
NestedApply _ headIcon args NestedApply _ headIcon args
-> generalNestedPortAngles -> generalNestedPortAngles
iconInfo iconInfo
@ -376,7 +395,7 @@ appArgBox :: (HasStyle a, Typeable (N a)
, TrailLike a, RealFloat (N a), V a ~ V2) , TrailLike a, RealFloat (N a), V a ~ V2)
=> Colour Double -> N a -> N a -> a => Colour Double -> N a -> N a -> a
appArgBox borderCol topAndBottomLineWidth portHeight appArgBox borderCol topAndBottomLineWidth portHeight
= lwG defaultLineWidth $ lc borderCol = lwG defaultLineWidth $ lcA (withOpacity borderCol defaultOpacity)
$ roundedRect $ roundedRect
topAndBottomLineWidth topAndBottomLineWidth
(portHeight + verticalSeparation) (portHeight + verticalSeparation)
@ -540,7 +559,8 @@ coloredTextBox textColor boxColor t =
<> lwG <> lwG
(0.6 * defaultLineWidth) (0.6 * defaultLineWidth)
(lcA boxColor (lcA boxColor
$ fcA (withOpacity (backgroundC colorScheme) 0.5) $ rectForText (length t)) $ fcA (withOpacity (backgroundC colorScheme) 0.5)
$ rectForText (length t))
transformCorrectedTextBox :: SpecialBackend b n => transformCorrectedTextBox :: SpecialBackend b n =>
String String
@ -725,7 +745,7 @@ nestedLambda iconInfo paramNames mBodyExp (TransformParams name level reflect an
lambdaCircle lambdaCircle
= lwG defaultLineWidth = lwG defaultLineWidth
$ lc (regionPerimC colorScheme) $ lc (regionPerimC colorScheme)
$ fc (regionPerimC colorScheme) $ circle (1.5 * circleRadius) $ fc (regionPerimC colorScheme) $ circle (1.85 * circleRadius)
lambdaParts lambdaParts
= (makeQualifiedPort name InputPortConst <> resultIcon) = (makeQualifiedPort name InputPortConst <> resultIcon)
: :
@ -746,8 +766,9 @@ nestedLambda iconInfo paramNames mBodyExp (TransformParams name level reflect an
topAndBottomLine topAndBottomLine
= alignL = alignL
$ lwG defaultLineWidth $ lwG defaultLineWidth
$ lc (regionPerimC colorScheme) $ hrule topAndBottomLineWidth $ lcA (withOpacity (regionPerimC colorScheme) defaultOpacity)
finalDia = topAndBottomLine <> alignB (topAndBottomLine <> alignT middle) $ hrule topAndBottomLineWidth
finalDia = vcat [topAndBottomLine, middle, topAndBottomLine]
-- END Main icons -- END Main icons
-- END Icons -- END Icons

View File

@ -2,6 +2,7 @@
## Todo Now ## Todo Now
* Redesign case icon to avoid non-locality. * Redesign case icon to avoid non-locality.
* Move @ pattern circles so that they are on the same side as the variables.
* Add command line flags for color style, embedding, and whether to draw arrowheads. * Add command line flags for color style, embedding, and whether to draw arrowheads.
* Add wiki pages discussing: Why a visual language?, History of Glance, How to contribute, Code guide [code style, ...], etc.. * Add wiki pages discussing: Why a visual language?, History of Glance, How to contribute, Code guide [code style, ...], etc..