1{-# LANGUAGE OverloadedStrings #-} 2module Main where 3 4#if !MIN_VERSION_base(4,8,0) 5import Control.Applicative ((<$>)) 6#endif 7#if !(MIN_VERSION_base(4,11,0)) 8import Data.Monoid ((<>)) 9#endif 10import qualified Data.Text as T 11import Control.Monad (void) 12import Control.Concurrent 13import System.Random 14 15import Brick 16import Brick.BChan 17import Brick.Widgets.Border 18import qualified Graphics.Vty as V 19 20draw :: AppState -> Widget n 21draw st = 22 header st <=> box st 23 24header :: AppState -> Widget n 25header st = 26 padBottom (Pad 1) $ 27 hBox [ padRight (Pad 7) $ 28 (str $ "Max width: " <> show (textAreaWidth st)) <=> 29 (str "Left(-)/Right(+)") 30 , (str $ "Max height: " <> show (textAreaHeight st)) <=> 31 (str "Down(-)/Up(+)") 32 ] 33 34box :: AppState -> Widget n 35box st = 36 border $ 37 hLimit (textAreaWidth st) $ 38 vLimit (textAreaHeight st) $ 39 (renderBottomUp (txtWrap <$> textAreaContents st)) 40 41-- | Given a list of widgets, draw them bottom-up in a vertical 42-- arrangement, i.e., the first widget in this list will appear at the 43-- bottom of the rendering area. Rendering stops when the rendering area 44-- is full, i.e., items that cannot be rendered are never evaluated or 45-- drawn. 46renderBottomUp :: [Widget n] -> Widget n 47renderBottomUp ws = 48 Widget Greedy Greedy $ do 49 let go _ [] = return V.emptyImage 50 go remainingHeight (c:cs) = do 51 cResult <- render c 52 let img = image cResult 53 newRemainingHeight = remainingHeight - V.imageHeight img 54 if newRemainingHeight == 0 55 then return img 56 else if newRemainingHeight < 0 57 then return $ V.cropTop remainingHeight img 58 else do 59 rest <- go newRemainingHeight cs 60 return $ V.vertCat [rest, img] 61 62 ctx <- getContext 63 img <- go (availHeight ctx) ws 64 render $ fill ' ' <=> raw img 65 66textLines :: [T.Text] 67textLines = 68 [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut" 69 , "labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco" 70 , "laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit" 71 , "in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat" 72 , "cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum." 73 ] 74 75handleEvent :: AppState -> BrickEvent n CustomEvent -> EventM n (Next AppState) 76handleEvent s (AppEvent (NewLine l)) = 77 continue $ s { textAreaContents = l : textAreaContents s } 78handleEvent s (VtyEvent (V.EvKey V.KUp [])) = 79 continue $ s { textAreaHeight = textAreaHeight s + 1 } 80handleEvent s (VtyEvent (V.EvKey V.KDown [])) = 81 continue $ s { textAreaHeight = max 0 $ textAreaHeight s - 1 } 82handleEvent s (VtyEvent (V.EvKey V.KRight [])) = 83 continue $ s { textAreaWidth = textAreaWidth s + 1 } 84handleEvent s (VtyEvent (V.EvKey V.KLeft [])) = 85 continue $ s { textAreaWidth = max 0 $ textAreaWidth s - 1 } 86handleEvent s (VtyEvent (V.EvKey V.KEsc [])) = 87 halt s 88handleEvent s _ = 89 continue s 90 91data CustomEvent = 92 NewLine T.Text 93 94data AppState = 95 AppState { textAreaHeight :: Int 96 , textAreaWidth :: Int 97 , textAreaContents :: [T.Text] 98 } 99 100app :: App AppState CustomEvent () 101app = 102 App { appDraw = (:[]) . draw 103 , appChooseCursor = neverShowCursor 104 , appHandleEvent = handleEvent 105 , appAttrMap = const $ attrMap V.defAttr [] 106 , appStartEvent = return 107 } 108 109initialState :: AppState 110initialState = 111 AppState { textAreaHeight = 20 112 , textAreaWidth = 40 113 , textAreaContents = [] 114 } 115 116-- | Run forever, generating new lines of text for the application 117-- window, prefixed with a line number. This function simulates the kind 118-- of behavior that you'd get from running 'tail -f' on a file. 119generateLines :: BChan CustomEvent -> IO () 120generateLines chan = go (1::Integer) 121 where 122 go lineNum = do 123 -- Wait a random amount of time (in milliseconds) 124 let delayOptions = [500, 1000, 2000] 125 delay <- randomVal delayOptions 126 threadDelay $ delay * 1000 127 128 -- Choose a random line of text from our collection 129 l <- randomVal textLines 130 131 -- Send it to the application to be added to the UI 132 writeBChan chan $ NewLine $ (T.pack $ "Line " <> show lineNum <> " - ") <> l 133 134 go $ lineNum + 1 135 136randomVal :: [a] -> IO a 137randomVal as = do 138 idx <- randomRIO (0, length as - 1) 139 return $ as !! idx 140 141main :: IO () 142main = do 143 cfg <- V.standardIOConfig 144 vty <- V.mkVty cfg 145 chan <- newBChan 10 146 147 -- Run thread to simulate incoming data 148 void $ forkIO $ generateLines chan 149 150 void $ customMain vty (V.mkVty cfg) (Just chan) app initialState 151