Give top level bind text boxes special colors.

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 ::

app/Main.hs

@@ -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

app/Translate.hs

@@ -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

app/Types.hs

@@ -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)