add to the demo program

Demo.hs

@@ -2,7 +2,7 @@ module Main where
 
 import Graphics.Vty
 
-import Control.Applicative
+import Control.Applicative hiding ((<|>))
 import Control.Arrow
 import Control.Monad.RWS
 
@@ -25,11 +25,50 @@ vtyInteract shouldExit = do
     updateDisplay
     unless shouldExit $ handleNextEvent >>= vtyInteract
 
+introText = vertCat $ map (string defAttr)
+    [ "this line is hidden by the top layer"
+    , "The vty demo program will echo the events generated by the pressed keys."
+    , "Below there is a 240 color box."
+    , "Followed by a description of the 16 color pallete."
+    , "If the 240 color box is not visible then the terminal"
+    , "claims 240 colors are not supported."
+    , "Try setting TERM to xterm-256color"
+    , "This text is on a lower layer than the event list."
+    , "Which means it'll be hidden soon."
+    , "Bye!"
+    , "Great Faith in the ¯\\_(ツ)_/¯"
+    , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯"
+    ]
+
+colorbox_240 :: Image
+colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages
+    where
+        colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239]
+        splitColorImages [] = []
+        splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is))
+
+colorbox_16 :: Image
+colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border
+    where
+        column0 = vertCat $ map lineWithColor normal
+        column1 = vertCat $ map lineWithColor bright
+        border = vertCat $ replicate (length normal) $ string defAttr " | "
+        column2 = vertCat $ map (string defAttr . snd) normal
+        lineWithColor (c, cName) = string (defAttr `withForeColor` c) cName
+        normal = zip [ black, red, green, yellow, blue, magenta, cyan, white ]
+                     [ "black", "red", "green", "yellow", "blue", "magenta", "cyan", "white" ]
+        bright = zip [ brightBlack, brightRed, brightGreen, brightYellow, brightBlue
+                     , brightMagenta, brightCyan, brightWhite ]
+                     [ "bright black", "bright red", "bright green", "bright yellow"
+                     , "bright blue", "bright magenta", "bright cyan", "bright white" ]
+
 updateDisplay :: App ()
 updateDisplay = do
-    let info = string defAttr "Press ESC to exit."
+    let info = string (defAttr `withForeColor` black `withBackColor` green)
+                      "Press ESC to exit. Events for keys below."
     eventLog <- foldMap (string defAttr) <$> get
-    let pic = picForImage $ info <-> eventLog
+    let pic = picForImage (info <-> eventLog)
+              `addToBottom` (introText <-> colorbox_240 <|> colorbox_16)
     vty <- ask
     liftIO $ update vty pic