module System.Dzen.Bars
(
dbar
,cdbar
,gdbar
,cgdbar
,bar
,cbar
,BarType(..)
,BarTextType(..)
,BarText(..)
,dbar_style
,gdbar_style
) where
import Control.Arrow
import Data.Monoid
import System.Dzen.Base
import System.Dzen.Colour
import System.Dzen.Graphics
import System.Dzen.Padding
maybeLeft :: Bool -> BarText
maybeLeft False = None
maybeLeft True = AtLeft Percentage
dbar :: (Num a, Enum a, Ord a)
=> Bool
-> Width
-> (a,a)
-> a
-> DString
dbar p = bar (maybeLeft p) . dbar_style '='
cdbar :: (Num a, Enum a, Ord a) => Bool -> Width -> (a,a) -> Printer a
cdbar p = cbar (maybeLeft p) . dbar_style '='
dbar_style :: Char -> Width -> BarType
dbar_style c w = Text {txtOpen = "["
,txtFilled = str [c]
,txtMiddle = Nothing
,txtBackground = " "
,txtClose = "]"
,txtWidth = w}
gdbar :: (Num a, Enum a, Ord a)
=> Bool
-> (Width, Height)
-> Maybe DColour
-> Maybe DColour
-> Bool
-> (a,a)
-> a
-> DString
gdbar p = (((bar (maybeLeft p) .) . ) .) . gdbar_style
cgdbar :: (Num a, Enum a, Ord a) => Bool -> (Width, Height)
-> Maybe DColour -> Maybe DColour -> Bool -> (a,a) -> Printer a
cgdbar p = (((cbar (maybeLeft p) .) . ) .) . gdbar_style
gdbar_style :: (Width, Height) -> Maybe DColour
-> Maybe DColour -> Bool -> BarType
gdbar_style size_ fore back False =
Filled {grpFilled = fore
,grpBackground = back
,grpSize = size_}
gdbar_style size_ fore back True =
Hollow {grpFilled = fore
,grpBackground = Nothing
,grpBorder = back
,grpSize = size_}
data BarType =
Text {
txtOpen :: !DString
,txtFilled :: !DString
,txtMiddle :: !(Maybe DString)
,txtBackground :: !DString
,txtClose :: !DString
,txtWidth :: !Width}
| Filled {
grpFilled :: !(Maybe DColour)
,grpBackground :: !(Maybe DColour)
,grpSize :: !(Width, Height)}
| Hollow {
grpFilled :: !(Maybe DColour)
,grpBackground :: !(Maybe DColour)
,grpBorder :: !(Maybe DColour)
,grpSize :: !(Width, Height)}
deriving (Show)
data BarTextType = Percentage | Absolute
deriving (Eq, Ord, Show, Enum)
data BarText = AtLeft !BarTextType
| AtRight !BarTextType
| None
deriving (Eq, Ord, Show)
bar :: (Num a, Enum a, Ord a) => BarText ->
BarType -> (a,a) -> a -> DString
bar txt bar_ r v =
case txt of
None -> drawnBar
AtLeft t -> mconcat [padL 4 (barText t r v), " ", drawnBar]
AtRight t -> mconcat [drawnBar, " ", padR 4 (barText t r v)]
where drawnBar = barDraw bar_ r v
cbar :: (Num a, Enum a, Ord a) => BarText ->
BarType -> (a,a) -> Printer a
cbar = ((simple .) .) . bar
barText :: (Num a, Enum a, Ord a) => BarTextType -> (a,a) -> a -> DString
barText Absolute _ val = str $ show val
barText Percentage range val
= str $ (show . fst . fst $ barRound 100 range val) ++ "%"
barDraw :: (Num a, Enum a, Ord a) => BarType -> (a,a) -> a -> DString
barDraw (Text {txtOpen = to
,txtFilled = tf
,txtMiddle = Just tm
,txtBackground = tb
,txtClose = tc
,txtWidth = tw}) range val
= let ((f, b), more) = barRound tw range val
r | f >= tw = to : replicate tw tf
| f > 0 = to : replicate f' tf ++ tm : replicate b' tb
| more = to : tm : replicate (tw1) tb
| True = to : replicate tw tb
where (f',b') | more = (f, b1)
| otherwise = (f1, b)
in mconcat r `mappend` tc
barDraw (Text {txtOpen = to
,txtFilled = tf
,txtMiddle = Nothing
,txtBackground = tb
,txtClose = tc
,txtWidth = tw}) range val
= let (f, b) = fst $ barRound tw range val
r = to : replicate f tf ++ replicate b tb
in mconcat r `mappend` tc
barDraw (Filled {grpFilled = gf
,grpBackground = gb
,grpSize = (gw,gh)}) range val
= let (f, b) = fst $ barRound gw range val
in mconcat $ [changeFg gf $ rect f gh
,transpRect gb b gh]
barDraw (Hollow {grpFilled = gf
,grpBackground = gb
,grpBorder = gbd
,grpSize = (gw_orig, gh_orig)}) range val
= let gw = gw_orig 4
gh = gh_orig 4
(f, b) = fst $ barRound gw range val
in mconcat $ [pos 2
,changeFg gf $ rect f gh
,transpRect gb b gh
,pos $ negate (gw + 2)
,changeFg gbd $
ignoreBg True $
rectO gw_orig gh_orig]
transpRect :: Maybe DColour -> Width -> Height -> DString
transpRect Nothing w _ = pos w
transpRect (Just c) w h = fg c $ rect w h
barRound :: (Num a, Enum a, Ord a) =>
Width -> (a,a) -> a -> ((Int, Int), Bool)
barRound w r n = let (f, b) = barRound' w r n in ((f, w f), b)
barRound' :: (Num a, Enum a, Ord a) =>
Width -> (a,a) -> a -> (Int, Bool)
barRound' w (mini,maxi) n
| maxi < mini = error "System.Dzen.Bars.bar: max value is less than min."
| n <= mini = (0, False)
| n >= maxi = (w, False)
| otherwise = let r = fromEnum (2 * fromIntegral w * (nmini))
`div` fromEnum (maximini)
in second (== 1) (r `divMod` 2)