diff --git a/compat/brick_015plus/TextUI/ItemField/BrickHelper.hs b/compat/brick_015plus/TextUI/ItemField/BrickHelper.hs --- a/compat/brick_015plus/TextUI/ItemField/BrickHelper.hs +++ b/compat/brick_015plus/TextUI/ItemField/BrickHelper.hs @@ -1,5 +1,10 @@ +{-# LANGUAGE RankNTypes #-} + module TextUI.ItemField.BrickHelper - (getEventWidgetLocation) + ( getEventWidgetLocation + , BChan, newBChan, writeBChan, readBChan + , defaultConfig + ) where import Brick.Main (lookupViewport, lookupExtent, clickedExtent) @@ -9,16 +14,26 @@ import Data.Monoid ((<>)) import Lens.Micro ((^.)) import Control.Concurrent +import Data.Default +import Graphics.Vty +-- Vty 5.15 introduces defaultConfig instead of using Data.Default.def + +defaultConfig :: Graphics.Vty.Config +defaultConfig = def + -- Brick 0.16 introduces the BChan to abstract over the underlying -- Chan implementation. -type BChan = Chan +type BChan a = Chan a -newBChan :: Int -> IO BChan -newBChan = const . newChan +newBChan :: forall a. Int -> IO (BChan a) +newBChan _ = newChan +writeBChan :: forall a. Chan a -> a -> IO () writeBChan = writeChan + +readBChan :: forall a. Chan a -> IO a readBChan = readChan @@ -52,7 +67,7 @@ do mExtent <- Brick.Main.lookupExtent (getName widget) case mExtent of Nothing -> return Nothing - Just e@(Extent _ upperLeft _) -> + Just e@(Extent _ upperLeft _ _) -> if Brick.Main.clickedExtent (screenCol, screenRow) e then let widgetRow = screenRow - upperLeft^.locationRowL widgetCol = screenCol - upperLeft^.locationColumnL diff --git a/compat/brick_016/TextUI/ItemField/BrickHelper.hs b/compat/brick_016/TextUI/ItemField/BrickHelper.hs --- a/compat/brick_016/TextUI/ItemField/BrickHelper.hs +++ b/compat/brick_016/TextUI/ItemField/BrickHelper.hs @@ -1,6 +1,7 @@ module TextUI.ItemField.BrickHelper ( getEventWidgetLocation , BChan, newBChan, writeBChan, readBChan + , defaultConfig ) where @@ -11,6 +12,14 @@ import Data.Monoid ((<>)) import Lens.Micro ((^.)) import Brick.BChan (BChan, newBChan, writeBChan, readBChan) +import Data.Default +import Graphics.Vty + + +-- Vty 5.15 introduces defaultConfig instead of using Data.Default.def + +defaultConfig :: Graphics.Vty.Config +defaultConfig = def -- | When processing a global EvMouseDown VtyEvent, the coordinates of diff --git a/compat/brick_017/TextUI/ItemField/BrickHelper.hs b/compat/brick_017/TextUI/ItemField/BrickHelper.hs new file mode 100644 --- /dev/null +++ b/compat/brick_017/TextUI/ItemField/BrickHelper.hs @@ -0,0 +1,63 @@ +module TextUI.ItemField.BrickHelper + ( getEventWidgetLocation + , BChan, newBChan, writeBChan, readBChan + , defaultConfig + ) + where + +import Brick.Main (lookupViewport, lookupExtent, clickedExtent) +import Brick.Types (EventM, Location(..), locationRowL, locationColumnL, + Extent(..), Viewport(..)) +import Brick.Widgets.Core (Named(..)) +import Data.Monoid ((<>)) +import Lens.Micro ((^.)) +import Brick.BChan (BChan, newBChan, writeBChan, readBChan) +import Graphics.Vty (defaultConfig) + + +-- | When processing a global EvMouseDown VtyEvent, the coordinates of +-- the mouse event on the screen must be mapped to a specific location +-- in a Widget. The `lookupExtent` function will return the "extent" +-- of the Widget (i.e. where it was drawn and how big it is) but this +-- only indicates that the widget was clicked and does not identify +-- the actual location within the widget where the click occurred. +-- +-- The `getEventWidgetLocation` function translates the mouse event +-- coordinates to a specific location within the widget in the +-- widget's local reference frame, taking into account any scrolling +-- that has occurred within a viewport that wraps that widget. +-- +-- drawUI st = reportExtent (getName st) $ +-- viewport (getName st) Vertical $ +-- Widget Fixed Fixed $ ... +-- +-- handleEvent event st = +-- case event of +-- EvMouseDown col row button _mods -> +-- do wcoords <- getEventWidgetLocation fieldw col row +-- case wcoords of +-- Nothing -> return fieldw +-- Just l -> ... +-- +getEventWidgetLocation :: (Named a n, Ord n) + => a -> Int -> Int -> EventM n (Maybe Location) +getEventWidgetLocation widget screenCol screenRow = + do mExtent <- Brick.Main.lookupExtent (getName widget) + case mExtent of + Nothing -> return Nothing + Just e@(Extent _ upperLeft _ _) -> + if Brick.Main.clickedExtent (screenCol, screenRow) e + then let widgetRow = screenRow - upperLeft^.locationRowL + widgetCol = screenCol - upperLeft^.locationColumnL + widgetLoc = Location (widgetCol, widgetRow) + in do mView <- Brick.Main.lookupViewport (getName widget) + case mView of + Nothing -> return $ Just widgetLoc + Just (VP left top _) -> + return $ Just $ widgetLoc <> Location (left, top) + else return Nothing + + +-- brick now uses bounded channels (Brick.BChan.BChan for event communications instead of Control.Concurrent.Chan unbounded channels +-- Brick.List now has listModify for modifying the selected element +-- hBox and vBox use more efficient DList data struct diff --git a/compat/brick_pre015/TextUI/ItemField/BrickHelper.hs b/compat/brick_pre015/TextUI/ItemField/BrickHelper.hs --- a/compat/brick_pre015/TextUI/ItemField/BrickHelper.hs +++ b/compat/brick_pre015/TextUI/ItemField/BrickHelper.hs @@ -1,6 +1,9 @@ +{-# LANGUAGE RankNTypes #-} + module TextUI.ItemField.BrickHelper ( getEventWidgetLocation , BChan, newBChan, writeBChan, readBChan + , defaultConfig ) where @@ -11,16 +14,27 @@ import Data.Monoid ((<>)) import Lens.Micro ((^.)) import Control.Concurrent +import Data.Default +import Graphics.Vty + +-- Vty 5.15 introduces defaultConfig instead of using Data.Default.def + +defaultConfig :: Graphics.Vty.Config +defaultConfig = def + -- Brick 0.16 introduces the BChan to abstract over the underlying -- Chan implementation. -type BChan = Chan +type BChan a = Chan a -newBChan :: Int -> IO BChan -newBChan = const . newChan +newBChan :: forall a. Int -> IO (BChan a) +newBChan _ = newChan +writeBChan :: forall a. Chan a -> a -> IO () writeBChan = writeChan + +readBChan :: forall a. Chan a -> IO a readBChan = readChan diff --git a/examples/bookcase.hs b/examples/bookcase.hs --- a/examples/bookcase.hs +++ b/examples/bookcase.hs @@ -10,12 +10,12 @@ import Data.List (intercalate) import Data.Monoid -import Data.Default import Data.String (IsString) import qualified Data.Text as T import Brick import Brick.Widgets.Border import Graphics.Vty (Event(..), Key(..)) +import Graphics.Vty.Attributes (defAttr) import TextUI.ItemField import Lens.Micro ((^.)) import Lens.Micro.TH (makeLenses) @@ -128,6 +128,6 @@ where app = App { appDraw = showBookcase , appHandleEvent = bookEvent , appStartEvent = return - , appAttrMap = const $ applyAttrMappings itemDefaultAttrs def + , appAttrMap = const $ applyAttrMappings itemDefaultAttrs $ attrMap defAttr [] , appChooseCursor = showFirstCursor } diff --git a/examples/workreport.hs b/examples/workreport.hs --- a/examples/workreport.hs +++ b/examples/workreport.hs @@ -13,17 +13,17 @@ import Compat import Data.List (intercalate) import Data.Monoid -import Data.Default import Data.String (IsString) import Brick import Brick.Widgets.Center (hCenter) -import Graphics.Vty (Event(..), Key(..), mkVty, outputIface, supportsMode, Mode(..), setMode, Vty) +import Graphics.Vty ( Event(..), Key(..), mkVty + , outputIface, supportsMode, Mode(..), setMode, Vty) import Graphics.Vty.Attributes import TextUI.ItemField import Brick.Widgets.Border import Lens.Micro ((^.), Lens', (.~), (&)) import Lens.Micro.TH (makeLenses) -import TextUI.ItemField.BrickHelper (BChan, newBChan, writeBChan) +import TextUI.ItemField.BrickHelper (BChan, newBChan, writeBChan, defaultConfig) import Control.Concurrent import Control.Monad import Control.Monad.IO.Class @@ -156,7 +156,7 @@ , (itemHeaderAttr, bg blue `withStyle` underline) ] $ applyAttrMappings itemDefaultAttrs $ - setDefault (white `on` black) def + setDefault (white `on` black) $ attrMap defAttr [] enableMouse :: Graphics.Vty.Vty -> IO () @@ -173,7 +173,7 @@ , appAttrMap = const workAttrs , appChooseCursor = showFirstCursor } - vty = do v <- mkVty def + vty = do v <- mkVty defaultConfig enableMouse v return v mapM_ (forkIO . doWork chan) [8 .. 12] -- initial sample work diff --git a/itemfield.cabal b/itemfield.cabal --- a/itemfield.cabal +++ b/itemfield.cabal @@ -1,5 +1,5 @@ name: itemfield -version: 1.2.3.0 +version: 1.2.4.0 synopsis: A brick Widget for selectable summary of many elements on a terminal description: @@ -62,22 +62,27 @@ build-depends: vty , text < 1.3 , microlens < 0.5 + , data-default if flag(base48) build-depends: base >= 4.8 && < 5.0 hs-source-dirs: compat/base48 else build-depends: base < 4.8 hs-source-dirs: compat/base_pre48 - if flag(brick016) - build-depends: brick >= 0.16 - hs-source-dirs: compat/brick_016 + if flag(brick017) + build-depends: brick >= 0.17 + hs-source-dirs: compat/brick_017 else - if flag(brick015) - build-depends: brick >= 0.15 && < 0.16 - hs-source-dirs: compat/brick_015plus + if flag(brick016) + build-depends: brick == 0.16 + hs-source-dirs: compat/brick_016 else - build-depends: brick >= 0.13 && < 0.15 - hs-source-dirs: compat/brick_pre015 + if flag(brick015) + build-depends: brick >= 0.15 && < 0.16 + hs-source-dirs: compat/brick_015plus + else + build-depends: brick >= 0.13 && < 0.15 + hs-source-dirs: compat/brick_pre015 ghc-options: -Wall -fno-warn-unused-do-bind -O3 @@ -85,6 +90,10 @@ Description: Build example programs Default: True +Flag brick017 + Description: true for Brick version 0.17 or later + Default: True + Flag brick016 Description: true for Brick version 0.16 or later Default: True @@ -112,16 +121,20 @@ else build-depends: base < 4.8 hs-source-dirs: compat/base_pre48 - if flag(brick016) - build-depends: brick >= 0.16 - hs-source-dirs: compat/brick_016 + if flag(brick017) + build-depends: brick >= 0.17 + hs-source-dirs: compat/brick_017 else - if flag(brick015) - build-depends: brick >= 0.15 && < 0.16 - hs-source-dirs: compat/brick_015plus + if flag(brick016) + build-depends: brick == 0.16 + hs-source-dirs: compat/brick_016 else - build-depends: brick >= 0.13 && < 0.15 - hs-source-dirs: compat/brick_pre015 + if flag(brick015) + build-depends: brick >= 0.15 && < 0.16 + hs-source-dirs: compat/brick_015plus + else + build-depends: brick >= 0.13 && < 0.15 + hs-source-dirs: compat/brick_pre015 ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 -- default-language: Haskell2010 main-is: bookcase.hs @@ -143,16 +156,20 @@ else build-depends: base < 4.8, transformers hs-source-dirs: compat/base_pre48 - if flag(brick016) - build-depends: brick >= 0.16 - hs-source-dirs: compat/brick_016 + if flag(brick017) + build-depends: brick >= 0.17 + hs-source-dirs: compat/brick_017 else - if flag(brick015) - build-depends: brick >= 0.15 && < 0.16 - hs-source-dirs: compat/brick_015plus + if flag(brick016) + build-depends: brick == 0.16 + hs-source-dirs: compat/brick_016 else - build-depends: brick >= 0.13 && < 0.15 - hs-source-dirs: compat/brick_pre015 + if flag(brick015) + build-depends: brick >= 0.15 && < 0.16 + hs-source-dirs: compat/brick_015plus + else + build-depends: brick >= 0.13 && < 0.15 + hs-source-dirs: compat/brick_pre015 ghc-options: -threaded -Wall -fno-warn-unused-do-bind -O3 -- default-language: Haskell2010 main-is: workreport.hs @@ -172,16 +189,20 @@ else build-depends: base < 4.8 hs-source-dirs: compat/base_pre48 - if flag(brick016) - build-depends: brick >= 0.16 - hs-source-dirs: compat/brick_016 + if flag(brick017) + build-depends: brick >= 0.17 + hs-source-dirs: compat/brick_017 else - if flag(brick015) - build-depends: brick >= 0.15 && < 0.16 - hs-source-dirs: compat/brick_015plus + if flag(brick016) + build-depends: brick == 0.16 + hs-source-dirs: compat/brick_016 else - build-depends: brick >= 0.13 && < 0.15 - hs-source-dirs: compat/brick_pre015 + if flag(brick015) + build-depends: brick >= 0.15 && < 0.16 + hs-source-dirs: compat/brick_015plus + else + build-depends: brick >= 0.13 && < 0.15 + hs-source-dirs: compat/brick_pre015 ghc-options: -threaded -O0 other-modules: TextUI.ItemField.Types , TextUI.ItemField.Attrs @@ -196,6 +217,7 @@ , test-framework-quickcheck2 , brick >= 0.13 && < 1.0 , vty, text, microlens, microlens-th + , data-default test-suite test_layout type: exitcode-stdio-1.0 @@ -207,16 +229,20 @@ else build-depends: base < 4.8 hs-source-dirs: compat/base_pre48 - if flag(brick016) - build-depends: brick >= 0.16 - hs-source-dirs: compat/brick_016 + if flag(brick017) + build-depends: brick >= 0.17 + hs-source-dirs: compat/brick_017 else - if flag(brick015) - build-depends: brick >= 0.15 && < 0.16 - hs-source-dirs: compat/brick_015plus + if flag(brick016) + build-depends: brick == 0.16 + hs-source-dirs: compat/brick_016 else - build-depends: brick >= 0.13 && < 0.15 - hs-source-dirs: compat/brick_pre015 + if flag(brick015) + build-depends: brick >= 0.15 && < 0.16 + hs-source-dirs: compat/brick_015plus + else + build-depends: brick >= 0.13 && < 0.15 + hs-source-dirs: compat/brick_pre015 ghc-options: -threaded -O0 other-modules: TextUI.ItemField.Types , TextUI.ItemField.Attrs diff --git a/test/test_layout.hs b/test/test_layout.hs --- a/test/test_layout.hs +++ b/test/test_layout.hs @@ -12,10 +12,11 @@ import Data.Default import Data.Monoid import Control.Monad -import Brick.AttrMap (AttrName) +import Brick.AttrMap (AttrName, attrMap) import TextUI.ItemField import TextUI.ItemField.Layout import Graphics.Vty.Image +import Graphics.Vty.Attributes (defAttr) import TestDataGen @@ -44,6 +45,7 @@ where linesize (ItemGroup g r) = T.length g + 1 + linesize r linesize (Items n) = n +defattrs = attrMap defAttr [] tests = [ testGroup "RenderData" @@ -52,7 +54,7 @@ , testProperty "rendered width calculation" $ \f lpr1 lpr2 -> - let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w h + let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) defattrs w h w = lineWidth lpr1 h = lineWidth lpr2 expected_width = if maxItemGroupLine f >= w @@ -66,18 +68,18 @@ -- newItemField [Items 0] Nothing) def w h) , testCase "rendered width no items show centered empty message" $ - let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w 100 + let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) defattrs w 100 f = newItemField [] Nothing w = 100 in assertEqual "" w (imageWidth img) , testCase "rendered width zero items" $ - let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def 100 100 + let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) defattrs 100 100 f = newItemField [Items 0] $ Just $ \a b -> "hi" in assertEqual "" 100 (imageWidth img) -- shows none message , testCase "rendered width too many items" $ - let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w 3 + let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) defattrs w 3 f = newItemField [Items 100] $ Just $ \a b -> "hi" w = 5 in assertEqual "" w (imageWidth img) @@ -85,7 +87,7 @@ , testProperty "rendered width" $ prop_render_width , testCase "single group, one item per line, width" $ - let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w h + let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) defattrs w h w = 11 h = 500 expected_width = 11 @@ -128,7 +130,7 @@ prop_render_width f w = - let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) def w h + let (rdata,img) = itemFieldRender (ItemFieldWidget "hi" f) defattrs w h h = 500 expected_width = if maxItemGroupLine f >= w then maxLongGroupLine w f