module Graphics.Vty.Widgets.Padding
( Padded
, Padding
, Paddable(..)
, (+++)
, padded
, withPadding
, padNone
, padLeft
, padRight
, padTop
, padBottom
, padLeftRight
, padTopBottom
, padAll
)
where
import Data.Monoid
import Graphics.Vty
import Graphics.Vty.Widgets.Core
import Graphics.Vty.Widgets.Util
data Padding = Padding Int Int Int Int
deriving (Show)
data Padded = forall a. (Show a) => Padded (Widget a) Padding
instance Show Padded where
show (Padded _ p) = concat [ "Padded { "
, "padding = "
, show p
, ", ... }"
]
instance Monoid Padding where
mempty = Padding 0 0 0 0
mappend (Padding a1 a2 a3 a4) (Padding b1 b2 b3 b4) =
Padding (a1 + b1) (a2 + b2) (a3 + b3) (a4 + b4)
(+++) :: (Monoid a) => a -> a -> a
(+++) = mappend
class Paddable a where
pad :: a -> Padding -> a
instance Paddable Padding where
pad p1 p2 = p1 +++ p2
leftPadding :: Padding -> Int
leftPadding (Padding _ _ _ l) = toEnum l
rightPadding :: Padding -> Int
rightPadding (Padding _ r _ _) = toEnum r
bottomPadding :: Padding -> Int
bottomPadding (Padding _ _ b _) = toEnum b
topPadding :: Padding -> Int
topPadding (Padding t _ _ _) = toEnum t
padNone :: Padding
padNone = Padding 0 0 0 0
padLeft :: Int -> Padding
padLeft v = Padding 0 0 0 v
padRight :: Int -> Padding
padRight v = Padding 0 v 0 0
padTop :: Int -> Padding
padTop v = Padding v 0 0 0
padBottom :: Int -> Padding
padBottom v = Padding 0 0 v 0
padAll :: Int -> Padding
padAll v = Padding v v v v
padTopBottom :: Int -> Padding
padTopBottom v = Padding v 0 v 0
padLeftRight :: Int -> Padding
padLeftRight v = Padding 0 v 0 v
withPadding :: (Show a) => Padding -> Widget a -> IO (Widget Padded)
withPadding = flip padded
padded :: (Show a) => Widget a -> Padding -> IO (Widget Padded)
padded ch padding = do
let initSt = Padded ch padding
wRef <- newWidget initSt $ \w ->
w { growVertical_ = const $ growVertical ch
, growHorizontal_ = const $ growHorizontal ch
, render_ =
\this sz ctx -> do
Padded child p <- getState this
if (regionWidth sz < leftPadding p + rightPadding p) ||
(regionHeight sz < bottomPadding p + topPadding p) then
return emptyImage else
do
f <- focused <~ this
let constrained = sz `withWidth` (toEnum $ max 0 newWidth)
`withHeight` (toEnum $ max 0 newHeight)
newWidth = (fromEnum $ regionWidth sz) fromEnum (leftPadding p + rightPadding p)
newHeight = (fromEnum $ regionHeight sz) fromEnum (topPadding p + bottomPadding p)
attr = mergeAttrs [ if f then focusAttr ctx else overrideAttr ctx
, normalAttr ctx
]
img <- render child constrained ctx
let leftImg = charFill attr ' ' (leftPadding p) (imageHeight img)
rightImg = charFill attr ' ' (rightPadding p) (imageHeight img)
topImg = charFill attr ' ' (imageWidth img + leftPadding p + rightPadding p)
(topPadding p)
bottomImg = charFill attr ' ' (imageWidth img + leftPadding p + rightPadding p)
(bottomPadding p)
return $ topImg <-> (leftImg <|> img <|> rightImg) <-> bottomImg
, setCurrentPosition_ =
\this pos -> do
Padded child p <- getState this
let newPos = pos
`plusWidth` (leftPadding p)
`plusHeight` (topPadding p)
setCurrentPosition child newPos
, getCursorPosition_ = \this -> do
Padded child _ <- getState this
getCursorPosition child
}
wRef `relayKeyEvents` ch
wRef `relayFocusEvents` ch
return wRef