module Graphics.Vty.Widgets.Util
( on
, fgColor
, bgColor
, style
, mergeAttr
, mergeAttrs
, withWidth
, withHeight
, plusWidth
, plusHeight
, remove
, inject
, repl
, takeMaxText
, takeMaxChars
, chWidth
, strWidth
, textWidth
, regionWidth
, regionHeight
, Phys(..)
)
where
import Control.Applicative
import qualified Data.Text as T
import Graphics.Vty
newtype Phys = Phys Int
deriving (Num, Eq, Show, Ord, Integral, Enum, Real)
chWidth :: Char -> Phys
chWidth = Phys . fromEnum . safeWcwidth
textWidth :: T.Text -> Phys
textWidth = strWidth . T.unpack
strWidth :: String -> Phys
strWidth = sum . (chWidth <$>)
takeMaxChars :: Phys -> [Char] -> [Char]
takeMaxChars mx xs = f' (Phys 0) xs
where
f' _ [] = []
f' acc (c:cs) = let w = chWidth c
in if acc + w <= mx
then c : f' (acc + w) cs
else []
takeMaxText :: Phys -> T.Text -> T.Text
takeMaxText mx xs = T.pack $ takeMaxChars mx $ T.unpack xs
on :: Color -> Color -> Attr
on a b = defAttr `withBackColor` b `withForeColor` a
fgColor :: Color -> Attr
fgColor = (defAttr `withForeColor`)
bgColor :: Color -> Attr
bgColor = (defAttr `withBackColor`)
style :: Style -> Attr
style = (defAttr `withStyle`)
mergeAttr :: Attr -> Attr -> Attr
mergeAttr a b =
let b1 = case attrStyle a of
SetTo v -> b { attrStyle = SetTo v }
_ -> b
b2 = case attrForeColor a of
SetTo v -> b1 `withForeColor` v
_ -> b1
b3 = case attrBackColor a of
SetTo v -> b2 `withBackColor` v
_ -> b2
in b3
mergeAttrs :: [Attr] -> Attr
mergeAttrs attrs = foldr mergeAttr defAttr attrs
withWidth :: DisplayRegion -> Int -> DisplayRegion
withWidth (_, h) w = (w, h)
withHeight :: DisplayRegion -> Int -> DisplayRegion
withHeight (w, _) h = (w, h)
plusWidth :: DisplayRegion -> Int -> DisplayRegion
plusWidth (w', h) w =
if (w' + w < 0)
then error $ "plusWidth: would overflow on " ++ (show w') ++ " + " ++ (show w)
else ((w + w'), h)
plusHeight :: DisplayRegion -> Int -> DisplayRegion
plusHeight (w, h') h =
if (h' + h < 0)
then error $ "plusHeight: would overflow on " ++ (show h') ++ " + " ++ (show h)
else (w, (h + h'))
remove :: Int -> [a] -> [a]
remove pos as = (take pos as) ++ (drop (pos + 1) as)
inject :: Int -> a -> [a] -> [a]
inject !pos !a !as = let (h, t) = (take pos as, drop pos as)
in h ++ (a:t)
repl :: Int -> a -> [a] -> [a]
repl !pos !a !as = inject pos a (remove pos as)
regionWidth :: DisplayRegion -> Int
regionWidth = fst
regionHeight :: DisplayRegion -> Int
regionHeight = snd