From 2460a3f47210adc0ee332dc50356cc14b600b301 Mon Sep 17 00:00:00 2001 From: Robbie Gleichman Date: Tue, 6 Aug 2019 02:33:01 -0700 Subject: [PATCH] Embed lambdas as arguments. Make apply and lambda argumenet/parameter boxes transparent to make line crossings look better. --- app/DrawingColors.hs | 2 +- app/GraphAlgorithms.hs | 2 +- app/Icons.hs | 41 +++++++++++++++++++++++++++++++---------- todo.md | 1 + 4 files changed, 34 insertions(+), 12 deletions(-) diff --git a/app/DrawingColors.hs b/app/DrawingColors.hs index eed670e..8974006 100644 --- a/app/DrawingColors.hs +++ b/app/DrawingColors.hs @@ -56,7 +56,7 @@ colorOnBlackScheme = ColorStyle { where slightlyGreenYellow = sRGB24 212 255 0 lightMagenta = sRGB24 255 94 255 - lightSlightlyPurpleBlue = sRGB24 67 38 255 + lightSlightlyPurpleBlue = sRGB24 109 87 255 reddishOrange = sRGB24 255 119 0 --lightBlue = sRGB24 126 127 255 lightBlue = sRGB24 35 156 255 diff --git a/app/GraphAlgorithms.hs b/app/GraphAlgorithms.hs index 6ee569b..b065110 100644 --- a/app/GraphAlgorithms.hs +++ b/app/GraphAlgorithms.hs @@ -53,7 +53,7 @@ syntaxNodeIsEmbeddable parentType syntaxNode mParentPort mChildPort (ApplyParent, ApplyNode _ _) -> parentPortNotResult (ApplyParent, LiteralNode _) -> parentPortNotResult (ApplyParent, FunctionDefNode _ _) - -> isInput mParentPort && isResult mChildPort + -> parentPortNotResult && isResult mChildPort -- The match below works, but can make messy drawings with the current -- icon for lambdas. diff --git a/app/Icons.hs b/app/Icons.hs index 634f4b9..638e380 100644 --- a/app/Icons.hs +++ b/app/Icons.hs @@ -68,6 +68,9 @@ defaultLineWidth = 0.15 circleRadius :: (Fractional a) => a circleRadius = 0.5 +defaultOpacity :: (Fractional a) => a +defaultOpacity = 0.4 + -- COLORS -- lineCol :: Colour Double lineCol = lineC colorScheme @@ -121,6 +124,17 @@ applyPortAngles (Port x) = fmap (@@ turn) $ case x of 1 -> [0] _ -> [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 (Port x) = fmap (@@ turn) $ case x of 0 -> [1/4] @@ -172,7 +186,7 @@ generalNestedPortAngles iconInfo defaultAngles headIcon args port maybeNodeName Nothing -> defaultAngles port Just name -> case findIcon iconInfo name (headIcon : args) of Nothing -> [] - Just (_, icon) -> getPortAngles iconInfo icon port Nothing + Just (_, icon) -> getPortAnglesHelper True iconInfo icon port Nothing reflectXAngle :: SpecialNum n => Angle n -> Angle n reflectXAngle x = reflectedAngle where @@ -197,16 +211,21 @@ nestedMultiIfPortAngles iconInfo args port maybeNodeName = case maybeNodeName of then fmap reflectXAngle subAngles else subAngles 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 iconInfo icon port maybeNodeName = case icon of +getPortAngles :: SpecialNum n + => 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 _ -> [] BindTextBoxIcon _ -> [] MultiIfIcon _ -> multiIfPortAngles port CaseIcon _ -> multiIfPortAngles port CaseResultIcon -> [] - LambdaIcon _ _ _ -> applyPortAngles port + LambdaIcon _ _ _ -> lambdaPortAngles embedded port NestedApply _ headIcon args -> generalNestedPortAngles iconInfo @@ -376,7 +395,7 @@ appArgBox :: (HasStyle a, Typeable (N a) , TrailLike a, RealFloat (N a), V a ~ V2) => Colour Double -> N a -> N a -> a appArgBox borderCol topAndBottomLineWidth portHeight - = lwG defaultLineWidth $ lc borderCol + = lwG defaultLineWidth $ lcA (withOpacity borderCol defaultOpacity) $ roundedRect topAndBottomLineWidth (portHeight + verticalSeparation) @@ -540,7 +559,8 @@ coloredTextBox textColor boxColor t = <> lwG (0.6 * defaultLineWidth) (lcA boxColor - $ fcA (withOpacity (backgroundC colorScheme) 0.5) $ rectForText (length t)) + $ fcA (withOpacity (backgroundC colorScheme) 0.5) + $ rectForText (length t)) transformCorrectedTextBox :: SpecialBackend b n => String @@ -725,7 +745,7 @@ nestedLambda iconInfo paramNames mBodyExp (TransformParams name level reflect an lambdaCircle = lwG defaultLineWidth $ lc (regionPerimC colorScheme) - $ fc (regionPerimC colorScheme) $ circle (1.5 * circleRadius) + $ fc (regionPerimC colorScheme) $ circle (1.85 * circleRadius) lambdaParts = (makeQualifiedPort name InputPortConst <> resultIcon) : @@ -746,8 +766,9 @@ nestedLambda iconInfo paramNames mBodyExp (TransformParams name level reflect an topAndBottomLine = alignL $ lwG defaultLineWidth - $ lc (regionPerimC colorScheme) $ hrule topAndBottomLineWidth - finalDia = topAndBottomLine <> alignB (topAndBottomLine <> alignT middle) + $ lcA (withOpacity (regionPerimC colorScheme) defaultOpacity) + $ hrule topAndBottomLineWidth + finalDia = vcat [topAndBottomLine, middle, topAndBottomLine] -- END Main icons -- END Icons diff --git a/todo.md b/todo.md index 9b501de..5f7ecb7 100644 --- a/todo.md +++ b/todo.md @@ -2,6 +2,7 @@ ## Todo Now * 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 wiki pages discussing: Why a visual language?, History of Glance, How to contribute, Code guide [code style, ...], etc..