Add demo program for tail-style UI

brick.cabal

@@ -139,6 +139,18 @@ library
   if impl(ghc < 8.0)
     build-depends:     semigroups
 
+executable brick-tail-demo
+  hs-source-dirs:      programs
+  ghc-options:         -threaded -Wall -Wcompat -O2
+  default-language:    Haskell2010
+  default-extensions:  CPP
+  main-is:             TailDemo.hs
+  build-depends:       base,
+                       brick,
+                       text,
+                       vty,
+                       random
+
 executable brick-readme-demo
   if !flag(demos)
     Buildable: False

programs/TailDemo.hs

@@ -0,0 +1,147 @@
+{-# LANGUAGE OverloadedStrings #-}
+module Main where
+
+import qualified Data.Text as T
+import Control.Monad (void, forever)
+import Control.Concurrent
+import Data.IORef
+import System.Random
+
+import Brick
+import Brick.BChan
+import Brick.Widgets.Border
+import qualified Graphics.Vty as V
+
+draw :: AppState -> Widget n
+draw st =
+    header st <=> box st
+
+header :: AppState -> Widget n
+header st =
+    padBottom (Pad 1) $
+    hBox [ padRight (Pad 7) $
+           (str $ "Max width: " <> show (textAreaWidth st)) <=>
+           (str "Left(-)/Right(+)")
+         , (str $ "Max height: " <> show (textAreaHeight st)) <=>
+           (str "Down(-)/Up(+)")
+         ]
+
+box :: AppState -> Widget n
+box st =
+    border $
+    hLimit (textAreaWidth st) $
+    vLimit (textAreaHeight st) $
+    (renderBottomUp (txtWrap <$> textAreaContents st))
+
+-- | Given a list of widgets, draw them bottom-up in a vertical
+-- arrangement, i.e., the first widget in this list will appear at the
+-- bottom of the rendering area. Rendering stops when the rendering area
+-- is full, i.e., items that cannot be rendered are never evaluated or
+-- drawn.
+renderBottomUp :: [Widget n] -> Widget n
+renderBottomUp ws =
+    Widget Greedy Greedy $ do
+        let go _ [] = return V.emptyImage
+            go remainingHeight (c:cs) = do
+                cResult <- render c
+                let img = image cResult
+                    newRemainingHeight = remainingHeight - V.imageHeight img
+                if newRemainingHeight == 0
+                   then return img
+                   else if newRemainingHeight < 0
+                        then return $ V.cropTop remainingHeight img
+                        else do
+                            rest <- go newRemainingHeight cs
+                            return $ V.vertCat [rest, img]
+
+        ctx <- getContext
+        img <- go (availHeight ctx) ws
+        render $ fill ' ' <=> raw img
+
+textLines :: [T.Text]
+textLines =
+    [ "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut"
+    , "labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco"
+    , "laboris nisi ut aliquip ex ea commodo consequat. Duis aute irure dolor in reprehenderit"
+    , "in voluptate velit esse cillum dolore eu fugiat nulla pariatur. Excepteur sint occaecat"
+    , "cupidatat non proident, sunt in culpa qui officia deserunt mollit anim id est laborum."
+    ]
+
+handleEvent :: AppState -> BrickEvent n CustomEvent -> EventM n (Next AppState)
+handleEvent s (AppEvent (NewLine l)) =
+    continue $ s { textAreaContents = l : textAreaContents s }
+handleEvent s (VtyEvent (V.EvKey V.KUp [])) =
+    continue $ s { textAreaHeight = textAreaHeight s + 1 }
+handleEvent s (VtyEvent (V.EvKey V.KDown [])) =
+    continue $ s { textAreaHeight = max 0 $ textAreaHeight s - 1 }
+handleEvent s (VtyEvent (V.EvKey V.KRight [])) =
+    continue $ s { textAreaWidth = textAreaWidth s + 1 }
+handleEvent s (VtyEvent (V.EvKey V.KLeft [])) =
+    continue $ s { textAreaWidth = max 0 $ textAreaWidth s - 1 }
+handleEvent s (VtyEvent (V.EvKey V.KEsc [])) =
+    halt s
+handleEvent s _ =
+    continue s
+
+data CustomEvent =
+    NewLine T.Text
+
+data AppState =
+    AppState { textAreaHeight :: Int
+             , textAreaWidth :: Int
+             , textAreaContents :: [T.Text]
+             }
+
+app :: App AppState CustomEvent ()
+app =
+    App { appDraw = (:[]) . draw
+        , appChooseCursor = neverShowCursor
+        , appHandleEvent = handleEvent
+        , appAttrMap = const $ attrMap V.defAttr []
+        , appStartEvent = return
+        }
+
+initialState :: AppState
+initialState =
+    AppState { textAreaHeight = 20
+             , textAreaWidth = 40
+             , textAreaContents = []
+             }
+
+-- | Run forever, generating new lines of text for the application
+-- window, prefixed with a line number. This function simulates the kind
+-- of behavior that you'd get from running 'tail -f' on a file.
+generateLines :: BChan CustomEvent -> IO ()
+generateLines chan = do
+    lineNumRef <- newIORef (1::Integer)
+
+    forever $ do
+        lineNum <- readIORef lineNumRef
+        writeIORef lineNumRef (lineNum + 1)
+
+        -- Wait a random amount of time (in milliseconds)
+        let delayOptions = [500, 1000, 2000]
+        delay <- randomVal delayOptions
+        threadDelay $ delay * 1000
+
+        -- Choose a random line of text from our collection
+        l <- randomVal textLines
+
+        -- Send it to the application to be added to the UI
+        writeBChan chan $ NewLine $ (T.pack $ "Line " <> show lineNum <> " - ") <> l
+
+randomVal :: [a] -> IO a
+randomVal as = do
+    idx <- randomRIO (0, length as - 1)
+    return $ as !! idx
+
+main :: IO ()
+main = do
+    cfg <- V.standardIOConfig
+    vty <- V.mkVty cfg
+    chan <- newBChan 10
+
+    -- Run thread to simulate incoming data
+    void $ forkIO $ generateLines chan
+
+    void $ customMain vty (V.mkVty cfg) (Just chan) app initialState