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