mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Embed lambdas as arguments. Make apply and lambda argumenet/parameter boxes transparent to make line crossings look better.
This commit is contained in:
parent
ff761f8db8
commit
2460a3f472
@ -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
|
||||||
|
@ -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.
|
||||||
|
41
app/Icons.hs
41
app/Icons.hs
@ -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
|
||||||
|
1
todo.md
1
todo.md
@ -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..
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user