Add 24 bit color demo

This commit is contained in:
u_quark 2022-03-20 16:39:52 +00:00
parent a4002d63b7
commit 8c28483a5e
No known key found for this signature in database
GPG Key ID: F0DAB925FFBA5DAD

View File

@ -32,6 +32,7 @@ introText = vertCat $ map (string defAttr)
, "The vty demo program will echo the events generated by the pressed keys." , "The vty demo program will echo the events generated by the pressed keys."
, "Below there is a 240 color box." , "Below there is a 240 color box."
, "Followed by a description of the 16 color pallete." , "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" , "If the 240 color box is not visible then the terminal"
, "claims 240 colors are not supported." , "claims 240 colors are not supported."
, "Try setting TERM to xterm-256color" , "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 :: Image
colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages colorbox_240 = vertCat $ map horizCat $ splitColorImages colorImages
where where
colorImages = map (\i -> string (currentAttr `withBackColor` Color240 i) " ") [0..239] 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 :: Image
colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border colorbox_16 = border <|> column0 <|> border <|> column1 <|> border <|> column2 <|> border
@ -70,7 +78,7 @@ updateDisplay = do
"Press ESC to exit. Events for keys below." "Press ESC to exit. Events for keys below."
eventLog <- foldMap (string defAttr) <$> get eventLog <- foldMap (string defAttr) <$> get
let pic = picForImage (info <-> eventLog) let pic = picForImage (info <-> eventLog)
`addToBottom` (introText <-> colorbox_240 <|> colorbox_16) `addToBottom` (introText <-> colorbox_240 <|> colorbox_16 <|> fullcolorbox)
vty <- ask vty <- ask
liftIO $ update vty pic liftIO $ update vty pic