diff --git a/brick.cabal b/brick.cabal index 73961ac..38660bd 100644 --- a/brick.cabal +++ b/brick.cabal @@ -62,6 +62,7 @@ library Brick Brick.AttrMap Brick.BChan + Brick.BorderMap Brick.Focus Brick.Forms Brick.Main @@ -77,10 +78,10 @@ library Brick.Widgets.Edit Brick.Widgets.List Brick.Widgets.ProgressBar - Data.BorderMap Data.IMap Data.Text.Markup other-modules: + Brick.Types.Common Brick.Types.TH Brick.Types.Internal Brick.Widgets.Internal diff --git a/src/Data/BorderMap.hs b/src/Brick/BorderMap.hs similarity index 86% rename from src/Data/BorderMap.hs rename to src/Brick/BorderMap.hs index 11c2c25..0e1e1ac 100644 --- a/src/Data/BorderMap.hs +++ b/src/Brick/BorderMap.hs @@ -1,9 +1,8 @@ {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE TemplateHaskell #-} -module Data.BorderMap +module Brick.BorderMap ( BorderMap - , Location(..), origin, locL , Edges(..) , eTopL, eBottomL, eRightL, eLeftL , empty, emptyCoordinates, singleton @@ -16,57 +15,12 @@ module Data.BorderMap , translate ) where -import Brick.Types.TH (suffixLenses) +import Brick.Types.Common (Edges(..), Location(..), eTopL, eBottomL, eRightL, eLeftL, origin) import Control.Applicative (liftA2) -import qualified Data.Semigroup as Sem import Data.IMap (IMap, Run(Run)) -import Lens.Micro (_1, _2) -import Lens.Micro.Internal (Field1, Field2) import Prelude hiding (lookup) import qualified Data.IMap as IM --- | A terminal screen location. -data Location = Location { loc :: (Int, Int) - -- ^ (Column, Row) - } - deriving (Show, Eq, Ord) - -suffixLenses ''Location - -instance Field1 Location Location Int Int where - _1 = locL._1 - -instance Field2 Location Location Int Int where - _2 = locL._2 - --- | The origin (upper-left corner). -origin :: Location -origin = Location (0, 0) - -instance Sem.Semigroup Location where - (Location (w1, h1)) <> (Location (w2, h2)) = Location (w1+w2, h1+h2) - -instance Monoid Location where - mempty = origin - mappend = (Sem.<>) - -data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a } - deriving (Eq, Ord, Read, Show, Functor) - -suffixLenses ''Edges - -instance Applicative Edges where - pure a = Edges a a a a - Edges ft fb fl fr <*> Edges vt vb vl vr = - Edges (ft vt) (fb vb) (fl vl) (fr vr) - -instance Monad Edges where - Edges vt vb vl vr >>= f = Edges - (eTop (f vt)) - (eBottom (f vb)) - (eLeft (f vl)) - (eRight (f vr)) - -- | Internal use only. neighbors :: Edges a -> Edges (a, a) neighbors (Edges vt vb vl vr) = Edges horiz horiz vert vert where diff --git a/src/Brick/Types/Common.hs b/src/Brick/Types/Common.hs new file mode 100644 index 0000000..8b32318 --- /dev/null +++ b/src/Brick/Types/Common.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE TemplateHaskell #-} + +module Brick.Types.Common + ( Location(..) + , locL + , origin + , Edges(..) + , eTopL, eBottomL, eRightL, eLeftL + ) where + +import Brick.Types.TH (suffixLenses) +import qualified Data.Semigroup as Sem +import Lens.Micro (_1, _2) +import Lens.Micro.Internal (Field1, Field2) + +-- | A terminal screen location. +data Location = Location { loc :: (Int, Int) + -- ^ (Column, Row) + } + deriving (Show, Eq, Ord) + +suffixLenses ''Location + +instance Field1 Location Location Int Int where + _1 = locL._1 + +instance Field2 Location Location Int Int where + _2 = locL._2 + +-- | The origin (upper-left corner). +origin :: Location +origin = Location (0, 0) + +instance Sem.Semigroup Location where + (Location (w1, h1)) <> (Location (w2, h2)) = Location (w1+w2, h1+h2) + +instance Monoid Location where + mempty = origin + mappend = (Sem.<>) + +data Edges a = Edges { eTop, eBottom, eLeft, eRight :: a } + deriving (Eq, Ord, Read, Show, Functor) + +suffixLenses ''Edges + +instance Applicative Edges where + pure a = Edges a a a a + Edges ft fb fl fr <*> Edges vt vb vl vr = + Edges (ft vt) (fb vb) (fl vl) (fr vr) + +instance Monad Edges where + Edges vt vb vl vr >>= f = Edges + (eTop (f vt)) + (eBottom (f vb)) + (eLeft (f vl)) + (eRight (f vr)) diff --git a/src/Brick/Types/Internal.hs b/src/Brick/Types/Internal.hs index e8da32e..b72c638 100644 --- a/src/Brick/Types/Internal.hs +++ b/src/Brick/Types/Internal.hs @@ -53,14 +53,15 @@ where import Data.Monoid #endif -import Data.BorderMap (BorderMap, Edges(..), Location(..), locL, origin, eTopL, eBottomL, eLeftL, eRightL) -import qualified Data.BorderMap as BM import Lens.Micro (_1, _2, Lens') import Lens.Micro.TH (makeLenses) import qualified Data.Set as S import qualified Data.Map as M import Graphics.Vty (Vty, Event, Button, Modifier, DisplayRegion, Image, Attr, emptyImage) +import Brick.BorderMap (BorderMap) +import qualified Brick.BorderMap as BM +import Brick.Types.Common import Brick.Types.TH import Brick.AttrMap (AttrName, AttrMap) import Brick.Widgets.Border.Style (BorderStyle) diff --git a/src/Brick/Widgets/Border.hs b/src/Brick/Widgets/Border.hs index 053d515..888a60d 100644 --- a/src/Brick/Widgets/Border.hs +++ b/src/Brick/Widgets/Border.hs @@ -39,7 +39,7 @@ import Brick.Widgets.Core import Brick.Widgets.Border.Style (BorderStyle(..)) import Brick.Widgets.Internal (renderDynBorder) import Data.IMap (Run(..)) -import qualified Data.BorderMap as BM +import qualified Brick.BorderMap as BM -- | The top-level border attribute name. borderAttr :: AttrName @@ -107,7 +107,7 @@ hBorder = let bs = ctxBorderStyle ctx w = availWidth ctx db <- dynBorderFromDirections (Edges False False True True) - let dynBorders = BM.insertH BM.origin (Run w db) + let dynBorders = BM.insertH mempty (Run w db) $ BM.emptyCoordinates (Edges 0 0 0 (w-1)) setDynBorders dynBorders $ render $ vLimit 1 $ fill (bsHorizontal bs) @@ -129,7 +129,7 @@ vBorder = let bs = ctxBorderStyle ctx h = availHeight ctx db <- dynBorderFromDirections (Edges True True False False) - let dynBorders = BM.insertV BM.origin (Run h db) + let dynBorders = BM.insertV mempty (Run h db) $ BM.emptyCoordinates (Edges 0 (h-1) 0 0) setDynBorders dynBorders $ render $ hLimit 1 $ fill (bsVertical bs) @@ -165,5 +165,5 @@ joinableBorder :: Edges Bool -> Widget n joinableBorder dirs = withAttr borderAttr . Widget Fixed Fixed $ do db <- dynBorderFromDirections dirs setDynBorders - (BM.singleton BM.origin db) + (BM.singleton mempty db) (render (raw (renderDynBorder db))) diff --git a/src/Brick/Widgets/Core.hs b/src/Brick/Widgets/Core.hs index 42ff16d..b392e78 100644 --- a/src/Brick/Widgets/Core.hs +++ b/src/Brick/Widgets/Core.hs @@ -108,7 +108,6 @@ import qualified Data.DList as DL import qualified Data.Map as M import qualified Data.Set as S import qualified Data.IMap as I -import qualified Data.BorderMap as BM import qualified Data.Function as DF import Data.List (sortBy, partition) import qualified Graphics.Vty as V @@ -122,6 +121,7 @@ import Brick.Widgets.Border.Style import Brick.Util (clOffset, clamp) import Brick.AttrMap import Brick.Widgets.Internal +import qualified Brick.BorderMap as BM -- | The class of text types that have widths measured in terminal -- columns. NEVER use 'length' etc. to measure the length of a string if diff --git a/src/Brick/Widgets/Internal.hs b/src/Brick/Widgets/Internal.hs index e0f0b25..e755a56 100644 --- a/src/Brick/Widgets/Internal.hs +++ b/src/Brick/Widgets/Internal.hs @@ -21,8 +21,8 @@ import Brick.Types import Brick.Types.Internal import Brick.AttrMap import Brick.Widgets.Border.Style -import Data.BorderMap (BorderMap, Edges(..)) -import qualified Data.BorderMap as BM +import Brick.BorderMap (BorderMap, Edges(..)) +import qualified Brick.BorderMap as BM renderFinal :: AttrMap -> [Widget n]