-- | -- Module : System.Dzen.Bars -- Copyright : (c) 2009 Felipe A. Lessa -- License : GPL 3 (see the LICENSE file in the distribution) -- -- Maintainer : felipe.lessa@gmail.com -- Stability : experimental -- Portability : semi-portable (uses MPTC and type families) -- -- Drawing of progress bars (sometimes called progress gauges), -- like @dbar@ and @gdbar@ utilities work but a little more -- powerful (in fact, we can simulate both utilities, see 'dbar' -- and 'gdbar'). -- -- An example of text progress bar that can be drawn: -- -- > 96% [==================> ] module System.Dzen.Bars (-- * Simple interface -- ** Mimicking @dbar@ dbar ,cdbar -- ** Mimicking @gdbar@ ,gdbar ,cgdbar -- * Generic interface ,bar ,cbar ,BarType(..) ,BarTextType(..) ,BarText(..) -- * Styles of the simple interfaces -- You may want to use some of these as the -- base for your own style. Look at the sources! ,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 -- | Helper function used below. maybeLeft :: Bool -> BarText maybeLeft False = None maybeLeft True = AtLeft Percentage -- | Mimics the dbar utility. Uses the 'dbar_style'. dbar :: (Num a, Enum a, Ord a) => Bool -- ^ If @True@, write the percentage on the left. -> Width -- ^ Width of the bar interior. -> (a,a) -- ^ Minimum and maximum values. -> a -- ^ Actual value. -> DString dbar p = bar (maybeLeft p) . dbar_style '=' -- | Mimics the dbar utility while getting the input dinamically. cdbar :: (Num a, Enum a, Ord a) => Bool -> Width -> (a,a) -> Printer a cdbar p = cbar (maybeLeft p) . dbar_style '=' -- | The style produced by the dbar utility. dbar_style :: Char -> Width -> BarType dbar_style c w = Text {txtOpen = "[" ,txtFilled = str [c] ,txtMiddle = Nothing ,txtBackground = " " ,txtClose = "]" ,txtWidth = w} -- | Mimics the gdbar utility. Uses the 'gdbar_style'. gdbar :: (Num a, Enum a, Ord a) => Bool -- ^ If @True@, write the percentage on the left. -> (Width, Height) -- ^ Size of the whole bar (excluding text). -> Maybe DColour -- ^ Filled colour (see 'grpFilled'). -> Maybe DColour -- ^ Background/border colour -- (see 'grpBackground' and 'grpBorder'). -> Bool -- ^ @True@ to mimic @-o@ option (outline). -> (a,a) -- ^ Minimum and maximum values. -> a -- ^ Actual value. -> DString gdbar p = (((bar (maybeLeft p) .) . ) .) . gdbar_style -- | Mimics the gdbar utility while getting the input dinamically. 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 -- | The style of gdbar (or something very close). 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 -- That's what gdbar does! ,grpBorder = back ,grpSize = size_} -- | The type of the bar to be drawn. data BarType = -- | Draws a text bar. Note, however, that the -- @DString@s below can be anything, not just -- text. For example, they may have colours ('fg'), -- shapes ('rect's and 'circ's) or 'icon's, you may -- even simulate both 'Filled' and 'Hollow' using just -- 'Text' (although performance would be suboptimal). Text { -- | Text written at the start. txtOpen :: !DString -- | Text written for each filled square. ,txtFilled :: !DString -- | Text written for the last filled square. -- If @Nothing@, the same as the filled square -- is used, but more fairly than if you used -- the same value for filled and middle chars. ,txtMiddle :: !(Maybe DString) -- | Text written for the unfilled squares. ,txtBackground :: !DString -- | Text written at the end. ,txtClose :: !DString -- | How many squares there should be -- (i.e. does not count the open and close parts). ,txtWidth :: !Width} -- | Draws a filled graphical bar, like @gdbar@ would. | Filled { -- | Colour used for filled squares, or @Nothing@ -- to use the default /foreground/ colour. grpFilled :: !(Maybe DColour) -- | Colour used for the unfilled squares, or -- @Nothing@ to use the default /background/ -- colour. ,grpBackground :: !(Maybe DColour) -- | Size of the whole bar. ,grpSize :: !(Width, Height)} -- | Draws a filled graphical bar with a surrounding -- border. | Hollow { -- | Same as @grpFilled@ above. grpFilled :: !(Maybe DColour) -- | Same as @grpBackground@ above. ,grpBackground :: !(Maybe DColour) -- | Colour of the border, or @Nothing@ to use -- the default /foreground/ colour. ,grpBorder :: !(Maybe DColour) -- | Size of the whole bar (including border). ,grpSize :: !(Width, Height)} deriving (Show) -- | The type of text to be written. data BarTextType = Percentage | Absolute deriving (Eq, Ord, Show, Enum) -- | How to draw the bar text. @AtLeft@ and @AtRight@ are used to -- specify if the text is at the left or the right of the bar, -- and @None@ means that no text will be written. data BarText = AtLeft !BarTextType | AtRight !BarTextType | None deriving (Eq, Ord, Show) -- | Draws a bar and optionally some text describing some quantity -- in relation to some range. For example, -- -- > bar (AtLeft Percentage) (Text "[" "=" (Just ">") " " "]" 20) (-10,10) i -- -- produces the bars -- -- > " 2% [ ]" where i = -9.6 -- > " 2% [> ]" where i = -9.5 -- > " 50% [=========> ]" where i = 0 -- > " 96% [==================> ]" where i = 9.4 -- > " 99% [===================>]" where i = 9.99 -- > "100% [====================]" where i = 10 -- -- Note that the text is always padded to four characters. If the -- first bar above had @AtRight Percentage@ the result would be -- -- > "[ ] 2% " -- -- so the padding always inserts the spaces on the outside. 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 -- | 'bar' wrapped with 'simple' so that the value is -- taken from an input. cbar :: (Num a, Enum a, Ord a) => BarText -> BarType -> (a,a) -> Printer a cbar = ((simple .) .) . bar -- | Draws the text part of the 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) ++ "%" {-# INLINE barText #-} -- | Draws the bar itself. 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 (tw-1) tb | True = to : replicate tw tb where (f',b') | more = (f, b-1) | otherwise = (f-1, 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 -- Account for the border 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] {-# INLINE barDraw #-} -- | Simulates transparency by not drawing at all. transpRect :: Maybe DColour -> Width -> Height -> DString transpRect Nothing w _ = pos w transpRect (Just c) w h = fg c $ rect w h -- | Function used for rounding. It always rounds towards minus -- infinity, so only the maximum value gives a full bar. -- Values outside the range are clamped. The boolean returned -- is @True@ iff the value would be one more if we rounded -- half-up. 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 * (n-mini)) `div` fromEnum (maxi-mini) in second (== 1) (r `divMod` 2)