ilyakooo0/vty
1
0
Fork 0
mirror of https://github.com/ilyakooo0/vty.git synced 2024-11-29 08:49:40 +03:00
Code Issues Projects Releases Wiki Activity

Add 24 bit color demo

Browse Source
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
1 changed files with 11 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
demos/Demo.hs
View File

@ -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