From 8c28483a5e22953c7ae2d507bc5be31b78e3ef5d Mon Sep 17 00:00:00 2001 From: u_quark Date: Sun, 20 Mar 2022 16:39:52 +0000 Subject: [PATCH] Add 24 bit color demo --- demos/Demo.hs | 14 +++++++++++--- 1 file changed, 11 insertions(+), 3 deletions(-) diff --git a/demos/Demo.hs b/demos/Demo.hs index 3b0e337..866752f 100644 --- a/demos/Demo.hs +++ b/demos/Demo.hs @@ -32,6 +32,7 @@ introText = vertCat $ map (string defAttr) , "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." + , "Followed by tones of red using a 24-bit palette." , "If the 240 color box is not visible then the terminal" , "claims 240 colors are not supported." , "Try setting TERM to xterm-256color" @@ -42,12 +43,19 @@ introText = vertCat $ map (string defAttr) , "¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯ ¯\\_(ツ)_/¯" ] +splitColorImages :: [Image] -> [[Image]] +splitColorImages [] = [] +splitColorImages is = (take 20 is ++ [string defAttr " "]) : (splitColorImages (drop 20 is)) + +fullcolorbox :: Image +fullcolorbox = vertCat $ map horizCat $ splitColorImages colorImages + where + colorImages = map (\i -> string (currentAttr `withBackColor` linearColor i 0 0) " ") [0..255] + 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 @@ -70,7 +78,7 @@ updateDisplay = do "Press ESC to exit. Events for keys below." eventLog <- foldMap (string defAttr) <$> get let pic = picForImage (info <-> eventLog) - `addToBottom` (introText <-> colorbox_240 <|> colorbox_16) + `addToBottom` (introText <-> colorbox_240 <|> colorbox_16 <|> fullcolorbox) vty <- ask liftIO $ update vty pic