diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,6 +2,21 @@ Brick changelog --------------- +1.4 +--- + +API changes: +* `Brick.Widgets.Border` got `hBorderAttr` and `vBorderAttr` for use by + `hBorder` and `vBorder` respectively. The new attributes inherit from + `borderAttr`, so applications that just specify `borderAttr` will not + see any change in behavior for those specific border elements. + +Performance improvements: +* `Brick.Widgets.Core.txt` had its performance improved. (thanks Fraser + Tweedale) +* `Brick.Widgets.Core.hBox` and `vBox` had their performance improved. + (thanks Fraser Tweedale) + 1.3 --- @@ -47,7 +62,7 @@ you to update your programs. This section details the list of API changes in 1.0 that are likely to introduce breakage and how to deal with each one. You can also consult the demonstration -programs to see orking examples of the new API. For those +programs to see working examples of the new API. For those interested in a bit of discussion on the changes, see [this ticket](https://github.com/jtdaugherty/brick/issues/379). diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -86,12 +86,14 @@ | [`kpxhs`](https://github.com/akazukin5151/kpxhs) | An interactive [Keepass](https://github.com/keepassxreboot/keepassxc/) database viewer | | [`htyper`](https://github.com/Simon-Hostettler/htyper) | A typing speed test program | | [`ullekha`](https://github.com/ajithnn/ullekha) | An interactive terminal notes/todo app with file/redis persistence | +| [`mywork`](https://github.com/kquick/mywork) [[Hackage]](https://hackage.haskell.org/package/mywork) | A tool to keep track of the projects you are working on | These third-party packages also extend `brick`: | Project | Description | | ------- | ----------- | | [`brick-filetree`](https://github.com/ChrisPenner/brick-filetree) [[Hackage]](http://hackage.haskell.org/package/brick-filetree) | A widget for exploring a directory tree and selecting or flagging files and directories | +| [`brick-panes`](https://github.com/kquick/brick-panes) [[Hackage]](https://hackage.haskell.org/package/brick-panes) | A Brick overlay library providing composition and isolation of screen areas for TUI apps. | Release Announcements / News ---------------------------- diff --git a/brick.cabal b/brick.cabal --- a/brick.cabal +++ b/brick.cabal @@ -1,5 +1,5 @@ name: brick -version: 1.3 +version: 1.4 synopsis: A declarative terminal user interface library description: Write terminal user interfaces (TUIs) painlessly with 'brick'! You diff --git a/programs/BorderDemo.hs b/programs/BorderDemo.hs --- a/programs/BorderDemo.hs +++ b/programs/BorderDemo.hs @@ -73,6 +73,8 @@ borderMappings :: [(A.AttrName, V.Attr)] borderMappings = [ (B.borderAttr, V.yellow `on` V.black) + , (B.vBorderAttr, fg V.cyan) + , (B.hBorderAttr, fg V.magenta) , (titleAttr, fg V.cyan) ] diff --git a/src/Brick/Widgets/Border.hs b/src/Brick/Widgets/Border.hs --- a/src/Brick/Widgets/Border.hs +++ b/src/Brick/Widgets/Border.hs @@ -20,12 +20,17 @@ -- * Attribute names , borderAttr + , hBorderAttr + , vBorderAttr -- * Utility , joinableBorder ) where +#if !(MIN_VERSION_base(4,11,0)) +import Data.Monoid ((<>)) +#endif import Lens.Micro ((^.), (&), (.~), to) import Graphics.Vty (imageHeight, imageWidth) @@ -41,6 +46,14 @@ borderAttr :: AttrName borderAttr = attrName "border" +-- | The horizontal border attribute name. Inherits from 'borderAttr'. +hBorderAttr :: AttrName +hBorderAttr = borderAttr <> attrName "horizontal" + +-- | The vertical border attribute name. Inherits from 'borderAttr'. +vBorderAttr :: AttrName +vBorderAttr = borderAttr <> attrName "vertical" + -- | Draw the specified border element using the active border style -- using 'borderAttr'. -- @@ -95,7 +108,8 @@ $ vLimit (middleResult^.imageL.to imageHeight + 2) $ total --- | A horizontal border. Fills all horizontal space. +-- | A horizontal border. Fills all horizontal space. Draws using +-- 'hBorderAttr'. hBorder :: Widget n hBorder = withAttr borderAttr $ Widget Greedy Fixed $ do @@ -105,7 +119,8 @@ db <- dynBorderFromDirections (Edges False False True True) let dynBorders = BM.insertH mempty (Run w db) $ BM.emptyCoordinates (Edges 0 0 0 (w-1)) - setDynBorders dynBorders $ render $ vLimit 1 $ fill (bsHorizontal bs) + setDynBorders dynBorders $ render $ withAttr hBorderAttr + $ vLimit 1 $ fill (bsHorizontal bs) -- | A horizontal border with a label placed in the center of the -- border. Fills all horizontal space. @@ -117,7 +132,8 @@ res <- render $ vLimit 1 label render $ hBox [hBorder, Widget Fixed Fixed (return res), hBorder] --- | A vertical border. Fills all vertical space. +-- | A vertical border. Fills all vertical space. Draws using +-- 'vBorderAttr'. vBorder :: Widget n vBorder = withAttr borderAttr $ Widget Fixed Greedy $ do @@ -127,7 +143,8 @@ db <- dynBorderFromDirections (Edges True True False False) let dynBorders = BM.insertV mempty (Run h db) $ BM.emptyCoordinates (Edges 0 (h-1) 0 0) - setDynBorders dynBorders $ render $ hLimit 1 $ fill (bsVertical bs) + setDynBorders dynBorders $ render $ withAttr vBorderAttr + $ hLimit 1 $ fill (bsVertical bs) -- | Initialize a 'DynBorder'. It will be 'bsDraw'n and 'bsOffer'ing -- in the given directions to begin with, and accept join offers from diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -268,17 +268,6 @@ unrestricted :: Int unrestricted = 100000 --- | Take a substring capable of fitting into the number of specified --- columns. This function takes character column widths into --- consideration. -takeColumns :: Int -> String -> String -takeColumns _ "" = "" -takeColumns numCols (c:cs) = - let w = V.safeWcwidth c - in if w > numCols - then [] - else c : takeColumns (numCols - w) cs - -- | Make a widget from a string, but wrap the words in the input's -- lines at the available width using the default wrapping settings. The -- input string should not contain escape sequences or carriage returns. @@ -296,9 +285,6 @@ strWrapWith :: WrapSettings -> String -> Widget n strWrapWith settings t = txtWrapWith settings $ T.pack t -safeTextWidth :: T.Text -> Int -safeTextWidth = V.safeWcswidth . T.unpack - -- | Make a widget from text, but wrap the words in the input's lines at -- the available width using the default wrapping settings. The input -- text should not contain escape sequences or carriage returns. @@ -322,15 +308,15 @@ case force theLines of [] -> return emptyResult multiple -> - let maxLength = maximum $ safeTextWidth <$> multiple + let maxLength = maximum $ textWidth <$> multiple padding = V.charFill (c^.attrL) ' ' (c^.availWidthL - maxLength) (length lineImgs) lineImgs = lineImg <$> multiple lineImg lStr = V.text' (c^.attrL) - (lStr <> T.replicate (maxLength - safeTextWidth lStr) " ") + (lStr <> T.replicate (maxLength - textWidth lStr) " ") in return $ emptyResult & imageL .~ (V.horizCat [V.vertCat lineImgs, padding]) --- | Build a widget from a 'String'. Breaks newlines up and space-pads --- short lines out to the length of the longest line. +-- | Build a widget from a 'String'. Behaves the same as 'txt' when the +-- input contains multiple lines. -- -- The input string must not contain tab characters. If it does, -- interface corruption will result since the terminal will likely @@ -338,25 +324,10 @@ -- replace tabs with the appropriate number of spaces as desired. The -- input string should not contain escape sequences or carriage returns. str :: String -> Widget n -str s = - Widget Fixed Fixed $ do - c <- getContext - let theLines = fixEmpty <$> (dropUnused . lines) s - fixEmpty :: String -> String - fixEmpty [] = " " - fixEmpty l = l - dropUnused l = takeColumns (availWidth c) <$> take (availHeight c) l - case force theLines of - [] -> return emptyResult - [one] -> return $ emptyResult & imageL .~ (V.string (c^.attrL) one) - multiple -> - let maxLength = maximum $ V.safeWcswidth <$> multiple - lineImgs = lineImg <$> multiple - lineImg lStr = V.string (c^.attrL) (lStr ++ replicate (maxLength - V.safeWcswidth lStr) ' ') - in return $ emptyResult & imageL .~ (V.vertCat lineImgs) +str = txt . T.pack --- | Build a widget from a 'T.Text' value. Behaves the same as 'str' --- when the input contains multiple lines. +-- | Build a widget from a 'T.Text' value. Breaks newlines up and +-- space-pads short lines out to the length of the longest line. -- -- The input string must not contain tab characters. If it does, -- interface corruption will result since the terminal will likely @@ -364,8 +335,45 @@ -- replace tabs with the appropriate number of spaces as desired. The -- input text should not contain escape sequences or carriage returns. txt :: T.Text -> Widget n -txt = str . T.unpack +txt s = + -- Althoguh vty Image uses lazy Text internally, using lazy text at this + -- level may not be an improvement. Indeed it can be much worse, due + -- the overhead of lazy Text being significant compared to the typically + -- short string content used to compose UIs. + Widget Fixed Fixed $ do + c <- getContext + let theLines = fixEmpty <$> (dropUnused . T.lines) s + fixEmpty l = if T.null l then T.singleton ' ' else l + dropUnused l = takeColumnsT (availWidth c) <$> take (availHeight c) l + pure $ case theLines of + [] -> emptyResult + [one] -> emptyResult & imageL .~ (V.text' (c^.attrL) one) + multiple -> + let maxLength = maximum $ V.safeWctwidth <$> multiple + lineImgs = lineImg <$> multiple + lineImg lStr = V.text' (c^.attrL) + (lStr <> T.replicate (maxLength - V.safeWctwidth lStr) (T.singleton ' ')) + in emptyResult & imageL .~ (V.vertCat lineImgs) +-- | Take up to the given width, having regard to character width. +takeColumnsT :: Int -> T.Text -> T.Text +takeColumnsT w s = T.take (fst $ T.foldl' f (0,0) s) s + where + -- The accumulator value is (index in Text value, width of Text so far) + f (i,z) c + -- Width was previously exceeded; continue with same values. + | z < 0 = (i, z) + -- Width exceeded. Signal this with z = -1. Index will no longer be + -- incremented. + -- + -- Why not short circuit (e.g. using foldlM construction)? + -- Because in the typical case, the Either allocation costs exceed + -- any benefits. The pathological case, string length >> width, is + -- probably rare. + | z + V.safeWcwidth c > w = (i, -1) + -- Width not yet exceeded. Increment index and add character width. + | otherwise = (i + 1, z + V.safeWcwidth c) + -- | Hyperlink the given widget to the specified URL. Not all terminal -- emulators support this. In those that don't, this should have no -- discernible effect. @@ -508,7 +516,6 @@ , imagePrimary :: V.Image -> Int , imageSecondary :: V.Image -> Int , limitPrimary :: Int -> Widget n -> Widget n - , limitSecondary :: Int -> Widget n -> Widget n , primaryWidgetSize :: Widget n -> Size , concatenatePrimary :: [V.Image] -> V.Image , concatenateSecondary :: [V.Image] -> V.Image @@ -534,7 +541,6 @@ , imagePrimary = V.imageHeight , imageSecondary = V.imageWidth , limitPrimary = vLimit - , limitSecondary = hLimit , primaryWidgetSize = vSize , concatenatePrimary = V.vertCat , concatenateSecondary = V.horizCat @@ -562,7 +568,6 @@ , imagePrimary = V.imageWidth , imageSecondary = V.imageHeight , limitPrimary = hLimit - , limitSecondary = vLimit , primaryWidgetSize = hSize , concatenatePrimary = V.horizCat , concatenateSecondary = V.vertCat @@ -639,18 +644,13 @@ (his, lows) = partition (\p -> (primaryWidgetSize br $ snd p) == Fixed) pairsIndexed - let availPrimary = c^.(contextPrimary br) - availSecondary = c^.(contextSecondary br) - renderHi prim = do remainingPrimary <- get - result <- lift $ render $ limitPrimary br remainingPrimary - $ limitSecondary br availSecondary - $ cropToContext prim + result <- lift $ render $ limitPrimary br remainingPrimary prim result <$ (put $! remainingPrimary - (result^.imageL.(to $ imagePrimary br))) (renderedHis, remainingPrimary) <- - runStateT (traverse (traverse renderHi) his) availPrimary + runStateT (traverse (traverse renderHi) his) (c ^. contextPrimary br) renderedLows <- case lows of [] -> return [] @@ -660,10 +660,7 @@ primaries = replicate rest (primaryPerLow + 1) <> replicate (length ls - rest) primaryPerLow - let renderLow ((i, prim), pri) = - (i,) <$> (render $ limitPrimary br pri - $ limitSecondary br availSecondary - $ cropToContext prim) + let renderLow ((i, prim), pri) = (i,) <$> render (limitPrimary br pri prim) if remainingPrimary > 0 then mapM renderLow (zip ls primaries) else return [] @@ -886,7 +883,7 @@ -- , withAttr "highlight" (str b) -- ] -- --- render1 = renderA ("Brick", "fun") +-- render1 = renderA (\"Brick\", "fun") -- render2 = withAttr "warning" render1 -- @ -- @@ -930,7 +927,7 @@ -- , str " is " -- , withAttr "highlight" (str b) ] -- --- render1 = renderA ("Brick", "fun") +-- render1 = renderA (\"Brick\", "fun") -- render2 = withDefAttr "warning" render1 -- @ --