Re #149 Add underlining colours and styles

ansi-terminal-types/CHANGELOG.md

@@ -1,6 +1,13 @@
 Changes
 =======
 
+Version 1.1
+--------------
+
+* Add `Underlining` constructor to type `ConsoleLayer`.
+* Add `CurlyUnderline`, `DottedUnderline`, and `DashedUnderline` constructors to
+  type `Underlining`.
+
 Version 0.11.5
 --------------
 

ansi-terminal-types/ansi-terminal-types.cabal

@@ -1,6 +1,6 @@
 Cabal-Version:       1.22
 Name:                ansi-terminal-types
-Version:             0.11.5
+Version:             1.1
 Category:            User Interfaces
 Synopsis:            Types and functions used to represent SGR aspects
 Description:         The \'ANSI\' standards refer to the visual style of

ansi-terminal-types/src/System/Console/ANSI/Types.hs

@@ -58,6 +58,8 @@ data ColorIntensity
 data ConsoleLayer
   = Foreground
   | Background
+  | Underlining
+    -- ^ Not widely supported.
   deriving (Bounded, Eq, Enum, Ix, Ord, Read, Show)
 
 -- | ANSI blink speeds: values other than 'NoBlink' are not widely supported
@@ -70,8 +72,14 @@ data BlinkSpeed
 -- | ANSI text underlining
 data Underlining
   = SingleUnderline
-  -- | Not widely supported. Not supported natively on Windows 10
   | DoubleUnderline
+    -- ^ Not widely supported.
+  | CurlyUnderline
+    -- ^ Not widely supported.
+  | DottedUnderline
+    -- ^ Not widely supported.
+  | DashedUnderline
+    -- ^ Not widely supported.
   | NoUnderline
   deriving (Bounded, Eq, Enum, Ix, Ord, Read, Show)
 

ansi-terminal/CHANGELOG.md

@@ -1,6 +1,12 @@
 Changes
 =======
 
+Version 1.1
+-----------
+
+* Add support for console layer `Underlining` and underlining styles
+  `CurlyUnderline`, `DottedUnderline` and `DashedUnderline`.
+
 Version 1.0.3
 -------------
 

ansi-terminal/ansi-terminal.cabal

@@ -1,6 +1,6 @@
 Cabal-Version:       1.22
 Name:                ansi-terminal
-Version:             1.0.3
+Version:             1.1
 Category:            User Interfaces
 Synopsis:            Simple ANSI terminal support
 Description:         ANSI terminal support for Haskell: allows cursor movement,
@@ -39,7 +39,7 @@ Library
         Other-Modules:          System.Console.ANSI.Internal
 
         Build-Depends:          base >= 4.8.0.0 && < 5
-                              , ansi-terminal-types == 0.11.5
+                              , ansi-terminal-types == 1.1
                               , colour >= 2.1.0
         if os(windows)
             Hs-Source-Dirs:     win

ansi-terminal/app/Example.hs

@@ -243,15 +243,16 @@ screenBuffersExample = do
 sgrColorExample :: IO ()
 sgrColorExample = do
   let colors = enumFromTo minBound maxBound :: [Color]
-  forM_ [Foreground, Background] $ \layer ->  do
+  forM_ [Foreground, Background, Underlining] $ \layer ->  do
     forM_ [Dull, Vivid] $ \intensity -> do
       resetScreen
       forM_ colors $ \color -> do
         setSGR [Reset]
         setSGR [SetColor layer intensity color]
+        setSGR [SetUnderlining SingleUnderline]
         print color
       pause
-  -- The ANSI eight standard colors, 4 times in sequence (two layers and two
+  -- The ANSI eight standard colors, 6 times in sequence (three layers and two
   -- intensities)
 
   resetScreen
@@ -333,6 +334,25 @@ sgrColorExample = do
         putStr " "
   replicateM_ 5 pause
 
+  resetScreen
+  setSGR [Reset]
+  setSGR [SetUnderlining SingleUnderline]
+  forM_
+    (zip "Underlining: True color (24 bit color depth)" (cycle [0, 10 .. 255])) $
+    \(c, i) -> do
+      setSGR [SetRGBColor Underlining $ sRGB24 i 0 0]
+      putChar c
+  putChar '\n'
+  putChar '\n'
+  setSGR [Reset]
+  setSGR [SetUnderlining SingleUnderline]
+  forM_ (zip "Underlining: A 256-color palette" (cycle [0 .. 5])) $
+    \(c, i) -> do
+      setSGR [SetPaletteColor Underlining $ xterm6LevelRGB i 0 0]
+      putChar c
+  putChar '\n'
+  replicateM_ 5 pause
+
 sgrOtherExample :: IO ()
 sgrOtherExample = do
   let named_styles = [ (SetConsoleIntensity BoldIntensity, "Bold")
@@ -342,6 +362,9 @@ sgrOtherExample = do
                      , (SetItalicized False, "No Italics")
                      , (SetUnderlining SingleUnderline, "Single Underline")
                      , (SetUnderlining DoubleUnderline, "Double Underline")
+                     , (SetUnderlining CurlyUnderline, "Curly Underline")
+                     , (SetUnderlining DottedUnderline, "Dotted Underline")
+                     , (SetUnderlining DashedUnderline, "Dashed Underline")
                      , (SetUnderlining NoUnderline, "No Underline")
                      , (SetBlinkSpeed SlowBlink, "Slow Blink")
                      , (SetBlinkSpeed RapidBlink, "Rapid Blink")

ansi-terminal/src/System/Console/ANSI.hs

@@ -897,6 +897,7 @@ layerColor layer = do
   void $ string $ case layer of
     Foreground -> "10"
     Background -> "11"
+    Underlining -> fail "reportLayerColor does not support underlining"
   void $ string ";rgb:"
   redHex <- hexadecimal -- A non-negative whole hexadecimal number
   void $ char '/'

ansi-terminal/src/System/Console/ANSI/Codes.hs

@@ -189,6 +189,9 @@ sgrToCode' sgr = case sgr of
   SetUnderlining underlining -> case underlining of
     SingleUnderline -> Right [4]
     DoubleUnderline -> Right [21]
+    CurlyUnderline -> Left (4, [Just 3])
+    DottedUnderline -> Left (4, [Just 4])
+    DashedUnderline -> Left (4, [Just 5])
     NoUnderline     -> Right [24]
   SetBlinkSpeed blink_speed -> case blink_speed of
     SlowBlink   -> Right [5]
@@ -202,15 +205,21 @@ sgrToCode' sgr = case sgr of
   SetColor Foreground Vivid color -> Right [90 + colorToCode color]
   SetColor Background Dull color  -> Right [40 + colorToCode color]
   SetColor Background Vivid color -> Right [100 + colorToCode color]
+  SetColor Underlining Dull color  -> Left (58, [Just 5, Just $ colorToCode color])
+  SetColor Underlining Vivid color -> Left (58, [Just 5, Just $ 8 + colorToCode color])
   SetPaletteColor Foreground index -> Right [38, 5, fromIntegral index]
   SetPaletteColor Background index -> Right [48, 5, fromIntegral index]
+  SetPaletteColor Underlining index -> Left (58, [Just 5, Just $ fromIntegral index])
   SetRGBColor Foreground color -> Right $ [38, 2] ++ toRGB color
   SetRGBColor Background color -> Right $ [48, 2] ++ toRGB color
+  SetRGBColor Underlining color -> Left (58, [Just 2, Nothing] ++ toRGB' color)
   SetDefaultColor Foreground -> Right [39]
   SetDefaultColor Background -> Right [49]
+  SetDefaultColor Underlining -> Right [59]
  where
   toRGB color = let RGB r g b = toSRGB24 color
                 in  map fromIntegral [r, g, b]
+  toRGB' = map Just . toRGB
 
 cursorUpCode, cursorDownCode, cursorForwardCode, cursorBackwardCode ::
      Int -- ^ Number of lines or characters to move
@@ -262,9 +271,11 @@ restoreCursorCode = "\ESC8"
 reportCursorPositionCode :: String
 reportCursorPositionCode = csi [] "6n"
 
--- | Code to emit the layer color into the console input stream, immediately
--- after being recognised on the output stream, as:
+-- | Code to emit the foreground or backgrond layer color into the console input
+-- stream, immediately after being recognised on the output stream, as:
+--
 -- @ESC ] \<Ps> ; rgb: \<red> ; \<green> ; \<blue> \<ST>@
+--
 -- where @\<Ps>@ is @10@ for 'Foreground' and @11@ for 'Background'; @\<red>@,
 -- @\<green>@ and @\<blue>@ are the color channel values in hexadecimal (4, 8,
 -- 12 and 16 bit values are possible, although 16 bit values are most common);
@@ -280,6 +291,7 @@ reportCursorPositionCode = csi [] "6n"
 reportLayerColorCode :: ConsoleLayer -> String
 reportLayerColorCode Foreground = osc "10" "?"
 reportLayerColorCode Background = osc "11" "?"
+reportLayerColorCode Underlining = [] -- Not supported.
 
 clearFromCursorToScreenEndCode, clearFromCursorToScreenBeginningCode,
   clearScreenCode :: String