Fix comment text alignment.

app/Icons.hs

@@ -7,7 +7,7 @@ module Icons
     iconToDiagram,
     nameDiagram,
     textBox,
-    multilineText,
+    multilineComment,
     enclosure,
     lambdaRegion,
     resultIcon,
@@ -184,15 +184,23 @@ bindTextBox :: SpecialBackend b =>
 bindTextBox = coloredTextBox (bindTextBoxTextC colorScheme) $ opaque (bindTextBoxC colorScheme)
 
 
-multilineText :: SpecialBackend b =>
+multilineComment :: SpecialBackend b =>
   Colour Double
   -> AlphaColour Double -> String -> SpecialQDiagram b
-multilineText textColor boxColor t = lwG (0.6 * defaultLineWidth) $ textDia
+multilineComment textColor boxColor t = lwG (0.6 * defaultLineWidth) textDia
   where
     textLines = lines t
-    textAreas = map (singleLineTextArea textColor) textLines
+    textAreas = map (commentTextArea textColor) textLines
     textDia = vcat textAreas
 
+-- | Given the number of letters in a textbox string, make a rectangle that will
+-- enclose the text box.
+rectForText :: (InSpace V2 n t, TrailLike t, OrderedField n) => Int -> t
+rectForText n = rect rectangleWidth (textBoxFontSize * textBoxHeightFactor)
+  where
+    rectangleWidth = fromIntegral n * textBoxFontSize * monoLetterWidthToHeightFraction
+      + (textBoxFontSize * 0.2)
+
 -- Since the normal SVG text has no size, some hackery is needed to determine
 -- the size of the text's bounding box.
 coloredTextBox :: SpecialBackend b =>
@@ -200,21 +208,13 @@ coloredTextBox :: SpecialBackend b =>
   -> AlphaColour Double -> String -> SpecialQDiagram b
 coloredTextBox textColor boxColor t =
   fontSize (local textBoxFontSize) (bold $ font "freemono" $ fc textColor $ text t)
-  <>  lwG (0.6 * defaultLineWidth) (lcA boxColor $ rect rectangleWidth (textBoxFontSize * textBoxHeightFactor))
+  <>  lwG (0.6 * defaultLineWidth) (lcA boxColor $ rectForText (length t))
-  where
-    rectangleWidth = textBoxFontSize * monoLetterWidthToHeightFraction
-      * fromIntegral (length t)
-      + (textBoxFontSize * 0.2)
 
-singleLineTextArea :: SpecialBackend b =>
+commentTextArea :: SpecialBackend b =>
   Colour Double -> String -> SpecialQDiagram b
-singleLineTextArea textColor t =
+commentTextArea textColor t =
-  alignL $ fontSize (local textBoxFontSize) (font "freemono" $ fc textColor $ text t)
+  alignL $ fontSize (local textBoxFontSize) (font "freemono" $ fc textColor $ topLeftText t)
-  <>  rect rectangleWidth (textBoxFontSize * textBoxHeightFactor)
+  <>  alignTL (lw none $ rectForText (length t))
-  where
-    rectangleWidth = textBoxFontSize * monoLetterWidthToHeightFraction
-      * fromIntegral (length t)
-      + (textBoxFontSize * 0.2)
 
 -- ENCLOSING REGION --
 enclosure :: SpecialBackend b =>

app/Main.hs

@@ -8,7 +8,7 @@ import Diagrams.Prelude hiding ((#), (&))
 import Diagrams.Backend.SVG.CmdLine
 import qualified Language.Haskell.Exts as Exts
 
-import Icons(ColorStyle(..), colorScheme, multilineText)
+import Icons(ColorStyle(..), colorScheme, multilineComment)
 import Rendering(renderDrawing)
 import Translate(drawingsFromModule)
 
@@ -69,7 +69,7 @@ renderFile inputFilename includeComments = do
 
   diagrams <- traverse renderDrawing drawings
   let
-    commentsInBoxes = fmap (\(Exts.Comment _ _ c) -> alignL $ multilineText white (opaque white) c) comments
+    commentsInBoxes = fmap (\(Exts.Comment _ _ c) -> alignL $ multilineComment white (opaque white) c) comments
     diagramsAndComments = vsep 2 $ zipWith (\x y -> x === strutY 0.4 === y) commentsInBoxes (fmap alignL diagrams)
     justDiagrams = vsep 1 $ fmap alignL diagrams
     diagramsAndMaybeComments = if includeComments == "c" then diagramsAndComments else justDiagrams

examples/tutorial.hs

@@ -201,9 +201,9 @@ apply icons should be made more dissimilar so that they can not be confused with
 each other, even when displaying Glance drawings in black and white.
 
 Now that you are fammiliar with matches, here's a simple case expression.
-y = case maybeInt of
+--y = case maybeInt of
-  Just x -> x + 1
+--  Just x -> x + 1
-  Nothing -> 0
+--  Nothing -> 0
 -}
 y = case maybeInt of
   Just x -> x + 1
@@ -225,8 +225,8 @@ as opposed to the case icon which would create many cycles if remote result circ
 were not allowed.
 
 Guards and if expressions look like this:
-y | x == 0 = 1
+--y | x == 0 = 1
-  | otherwise = x + 1
+---  | otherwise = x + 1
 -}
 y | x == 0 = 1
   | otherwise = x + 1
@@ -242,10 +242,10 @@ in better icon versions.
 
 If expressions are rendered the same as a guard with only one boolean.
 
-factorial x =
+--factorial x =
-  if x == 0
+--  if x == 0
-    then 1
+--    then 1
-    else x * factorial (x - 1)
+--    else x * factorial (x - 1)
 -}
 factorial x =
   if x == 0