mirror of
https://github.com/rgleichman/glance.git
synced 2024-09-11 15:05:41 +03:00
Give top level bind text boxes special colors.
This commit is contained in:
parent
cede5c645c
commit
299886c450
25
app/Icons.hs
25
app/Icons.hs
@ -41,7 +41,9 @@ data ColorStyle a = ColorStyle {
|
||||
regionPerimC :: Colour a,
|
||||
caseRhsC :: Colour a,
|
||||
patternC :: Colour a,
|
||||
patternTextC :: Colour a
|
||||
patternTextC :: Colour a,
|
||||
bindTextBoxC :: Colour a,
|
||||
bindTextBoxTextC :: Colour a
|
||||
}
|
||||
|
||||
colorOnBlackScheme :: (Floating a, Ord a) => ColorStyle a
|
||||
@ -57,12 +59,16 @@ colorOnBlackScheme = ColorStyle {
|
||||
regionPerimC = lime,
|
||||
caseRhsC = slightlyGreenYellow,
|
||||
patternC = lightMagenta,
|
||||
patternTextC = cyan
|
||||
patternTextC = cyan,
|
||||
bindTextBoxC = reddishOrange,
|
||||
bindTextBoxTextC = blueishLightCyan
|
||||
}
|
||||
where
|
||||
slightlyGreenYellow = sRGB24 212 255 0
|
||||
lightMagenta = sRGB24 255 94 255
|
||||
lightSlightlyPurpleBlue = sRGB24 67 38 255
|
||||
reddishOrange = sRGB24 255 119 0
|
||||
blueishLightCyan = sRGB24 66 198 255
|
||||
|
||||
whiteOnBlackScheme :: (Floating a, Ord a) => ColorStyle a
|
||||
whiteOnBlackScheme = ColorStyle {
|
||||
@ -77,7 +83,9 @@ whiteOnBlackScheme = ColorStyle {
|
||||
regionPerimC = white,
|
||||
caseRhsC = white,
|
||||
patternC = white,
|
||||
patternTextC = white
|
||||
patternTextC = white,
|
||||
bindTextBoxC = white,
|
||||
bindTextBoxTextC = white
|
||||
}
|
||||
|
||||
-- Use this to test that all of the colors use the colorScheme
|
||||
@ -94,7 +102,9 @@ randomColorScheme = ColorStyle {
|
||||
regionPerimC = cyan,
|
||||
caseRhsC = red,
|
||||
patternC = olive,
|
||||
patternTextC = coral
|
||||
patternTextC = coral,
|
||||
bindTextBoxC = maroon,
|
||||
bindTextBoxTextC = lime
|
||||
}
|
||||
|
||||
lineCol :: (Floating a, Ord a) => Colour a
|
||||
@ -116,6 +126,7 @@ iconToDiagram (TextApplyAIcon n str) _ = makeRotateSymmetricTransDia $ textApply
|
||||
iconToDiagram ResultIcon _ = makeSymmetricTransDia resultIcon
|
||||
iconToDiagram BranchIcon _ = makeSymmetricTransDia branchIcon
|
||||
iconToDiagram (TextBoxIcon s) _ = makeSymmetricTransDia $ textBox s
|
||||
iconToDiagram (BindTextBoxIcon s) _ = makeSymmetricTransDia $ bindTextBox s
|
||||
iconToDiagram (GuardIcon n) _ = makeTransformableDia $ guardIcon n
|
||||
iconToDiagram (CaseIcon n) _ = makeTransformableDia $ caseIcon n
|
||||
iconToDiagram CaseResultIcon _ = makeSymmetricTransDia caseResult
|
||||
@ -258,6 +269,12 @@ textBox ::
|
||||
String -> QDiagram b V2 n Any
|
||||
textBox = coloredTextBox (textBoxTextC colorScheme) $ opaque (textBoxC colorScheme)
|
||||
|
||||
bindTextBox ::
|
||||
(RealFloat n, Typeable n, Renderable (Path V2 n) b,
|
||||
Renderable (Text n) b) =>
|
||||
String -> QDiagram b V2 n Any
|
||||
bindTextBox = coloredTextBox (bindTextBoxTextC colorScheme) $ opaque (bindTextBoxC colorScheme)
|
||||
|
||||
-- Since the normal SVG text has no size, some hackery is needed to determine
|
||||
-- the size of the text's bounding box.
|
||||
coloredTextBox ::
|
||||
|
@ -27,14 +27,16 @@ import Translate(translateString, drawingsFromModule)
|
||||
-- Move tests out of main.
|
||||
|
||||
-- TODO Later --
|
||||
-- Highlight the names of top level declarations.
|
||||
-- Visual todos
|
||||
-- Give lines a black border to make line crossings easier to see.
|
||||
-- Give lines that cross the border of a lambda function a special color.
|
||||
|
||||
-- Use clustered graphs. Make a test project.
|
||||
-- Consider making lines between patterns Pattern Color when the line is a reference.
|
||||
-- Consider using seperate parameter icons in functions.
|
||||
-- Add function name and type to LambdaIcons.
|
||||
-- Add proper RecConstr, and RecUpdate support.
|
||||
-- Let each bool, value pair in Guard icon be flipped to reduce line crossings. Do the same for case.
|
||||
-- Add text field to Apply. Also redraw text and icon when it is rotated so that the characters stay oriented.
|
||||
-- Eliminate BranchIcon in Alts.
|
||||
-- Eliminate BranchIcon for the identity funciton "y x = x"
|
||||
-- otherwise Guard special case
|
||||
|
@ -494,7 +494,7 @@ drawingFromDecl d = iconGraphToDrawing $ evalState evaluatedDecl initialIdState
|
||||
addBind (patName, Right port) = do
|
||||
uniquePatName <- getUniqueName patName
|
||||
let
|
||||
icons = toNames [(uniquePatName, TextBoxIcon patName)]
|
||||
icons = toNames [(uniquePatName, BindTextBoxIcon patName)]
|
||||
edges = [makeSimpleEdge (justName uniquePatName, port)]
|
||||
edgeGraph = iconGraphFromIconsEdges icons edges
|
||||
pure edgeGraph
|
||||
|
@ -25,6 +25,7 @@ import Control.Monad.State(State, state)
|
||||
data Icon = ResultIcon | BranchIcon | TextBoxIcon String | GuardIcon Int
|
||||
| LambdaRegionIcon Int Name | FlatLambdaIcon Int | ApplyAIcon Int
|
||||
| TextApplyAIcon Int String | PAppIcon Int String | CaseIcon Int | CaseResultIcon
|
||||
| BindTextBoxIcon String
|
||||
deriving (Show)
|
||||
|
||||
data NameAndPort = NameAndPort Name (Maybe Int) deriving (Show)
|
||||
|
Loading…
Reference in New Issue
Block a user