xbattbar 0.1 → 0.2
raw patch · 5 files changed
+99/−100 lines, 5 filesdep ~select
Dependency ranges changed: select
Files
- src/XBattBar/Backend.hs +0/−1
- src/XBattBar/Core.hs +29/−31
- src/XBattBar/Types.hs +3/−22
- src/XBattBar/Widgets.hs +65/−43
- xbattbar.cabal +2/−3
src/XBattBar/Backend.hs view
@@ -1,5 +1,4 @@ module XBattBar.Backend (getCharge, getPower, Power(..)) where-import System.Environment data Power = AC | Battery deriving (Show)
src/XBattBar/Core.hs view
@@ -1,18 +1,15 @@ module XBattBar.Core (start) where import Prelude hiding (Left, Right)-import Data.Word-import Data.Bits-import Control.Monad+import Data.Bits ((.|.))+import Control.Monad (forever) import Graphics.X11.Types import Graphics.X11.Xlib.Types hiding (Position) import Graphics.X11.Xlib.Display-import Graphics.X11.Xlib.Window+import Graphics.X11.Xlib.Window (raiseWindow) import Graphics.X11.Xlib.Event-import Graphics.X11.Xlib.Misc-import Graphics.X11.Xlib.Context-import Graphics.X11.Xlib.Color-import Graphics.X11.Xlib.Extras (unmapWindow)+import Graphics.X11.Xlib.Color hiding (allocColor) import System.Posix.IO.Select+import System.Posix.IO.Select.Types import System.Posix.Types import System.Time (getClockTime, ClockTime) @@ -64,28 +61,28 @@ start :: Options -> IO () start opts = do- dpy <- openDisplay ""- let screen = defaultScreen dpy- root <- rootWindow dpy screen- let ctx = XContext dpy screen root- let geom = getBarRect (position opts) (fromIntegral $ thickness opts) (getScreenRect ctx)- let fg = whitePixel dpy screen- let bg = blackPixel dpy screen+ dpy' <- openDisplay ""+ let screen' = defaultScreen dpy'+ root <- rootWindow dpy' screen'+ let ctx = XContext dpy' screen' root+ let geom' = getBarRect (position opts) (fromIntegral $ thickness opts) (getScreenRect ctx)+ let fg = whitePixel dpy' screen'+ let bg = blackPixel dpy' screen' let orientation' x | x == Top || x == Bottom = Horizontal | otherwise = Vertical- bar' <- mkProgressBar ctx geom fg bg (orientation' $ position opts) (exposureMask .|. enterWindowMask .|. leaveWindowMask)+ bar' <- mkProgressBar ctx geom' fg bg (orientation' $ position opts) (exposureMask .|. enterWindowMask .|. leaveWindowMask) let popupGeom = getPopupRect $ getScreenRect ctx popup' <- mkLabel ctx popupGeom bg fg "fixed" [] noEventMask (ac, bat) <- getColors ctx opts run $ XBattBar opts bar' popup' ac bat return () -handleTimeout :: XBattBar -> Double -> Power -> IO ()-handleTimeout xbb charge state = drawWidget (bar xbb)+handleTimeout :: XBattBar -> IO ()+handleTimeout xbb = drawWidget (bar xbb) -- | dispatch X11 events to widgets-handleEvents :: XBattBar -> Double -> Power -> IO ()-handleEvents xbb charge state = do+handleEvents :: XBattBar -> IO ()+handleEvents xbb = do let bar' = bar xbb popup' = popup xbb dpy' = dpy $ xContext bar'@@ -94,20 +91,22 @@ n <- pending dpy' case n of 0 -> return ()- _ -> allocaXEvent $ \e -> do- nextEvent dpy' e- t <- get_EventType e- w <- get_Window e- let dispatch w e t | t == enterNotify = displayWidget popup' >> drawWidget popup'+ _ -> allocaXEvent $ \ev -> do+ nextEvent dpy' ev+ ty <- get_EventType ev+ win <- get_Window ev+ let dispatch w e t | t == enterNotify = displayWidget popup' >>+ drawWidget popup' >>+ raiseWindow dpy' popupWin | t == leaveNotify = hideWidget popup' | w == barWin = handleWidgetEvent bar' e t | w == popupWin = handleWidgetEvent popup' e t | otherwise = return ()- dispatch w e t- handleEvents xbb charge state+ dispatch win ev ty+ handleEvents xbb selectWrapper fd int eventH timeoutH = do- n <- select [fd] [] [] (Time int 0)+ n <- select'' [fd] [] [] (Time $ CTimeval int 0) case n of -1 -> error "select() error" 0 -> return timeoutH@@ -139,9 +138,8 @@ run :: XBattBar -> IO () run xbb = do let bar' = bar xbb- popup' = popup xbb dpy' = dpy $ xContext bar'- int = interval $ options xbb+ int = fromIntegral $ interval $ options xbb displayWidget bar' sync dpy' False let fd = Fd $ connectionNumber dpy'@@ -151,4 +149,4 @@ t <- getClockTime let xbb' = applyState xbb c s t drawWidget $ bar xbb'- selectWrapper fd int handleEvents handleTimeout >>= (\h -> h xbb' c s)+ selectWrapper fd int handleEvents handleTimeout >>= (\h -> h xbb')
src/XBattBar/Types.hs view
@@ -1,7 +1,7 @@-module XBattBar.Types (Options(..), Position(..), Orientation(..), XContext(..), ExtContext(..), ProgressBar(..), Label(..), XWidget(..)) where+module XBattBar.Types (Options(..), Position(..), Orientation(..), XContext(..), ExtContext(..), XWidget(..)) where -import Graphics.X11.Types-import Graphics.X11.Xlib.Event+import Graphics.X11.Types (expose, Window, EventType)+import Graphics.X11.Xlib.Event (XEventPtr) import Graphics.X11.Xlib.Font (FontStruct) import Graphics.X11.Xlib.Window (mapWindow) import Graphics.X11.Xlib.Extras (unmapWindow)@@ -63,22 +63,3 @@ handleWidgetEvent a ev et | et == expose = drawWidget a | otherwise = return ()---- | progress bar-like widget-data ProgressBar = ProgressBar {- pbXContext :: XContext,- pbExContext :: ExtContext,- colorBack :: Pixel,- colorBar :: Pixel,- progress :: Double,- orientation :: Orientation- }--- | multiline non-editable text widget with centered text-data Label = Label {- lXContext :: XContext,- lExContext :: ExtContext,- colorBG :: Pixel,- colorFont :: Pixel,- font :: FontStruct,- text :: [String]- }
src/XBattBar/Widgets.hs view
@@ -1,52 +1,33 @@-module XBattBar.Widgets (mkWidget, mkProgressBar, mkLabel) where+module XBattBar.Widgets (ProgressBar(colorBack, colorBar, progress), mkProgressBar,+ Label(text), mkLabel) where -import Data.Word-import Data.Bits-import Control.Monad-import Graphics.X11.Types+import Graphics.X11.Types (EventMask, cWOverrideRedirect) import Graphics.X11.Xlib.Types hiding (Position)-import Graphics.X11.Xlib.Display-import Graphics.X11.Xlib.Window-import Graphics.X11.Xlib.Event-import Graphics.X11.Xlib.Misc-import Graphics.X11.Xlib.Context-import Graphics.X11.Xlib.Color-import Graphics.X11.Xlib.Font+import Graphics.X11.Xlib.Display (blackPixel, whitePixel)+import Graphics.X11.Xlib.Window (createSimpleWindow)+import Graphics.X11.Xlib.Event (flush, selectInput)+import Graphics.X11.Xlib.Misc (fillRectangles,+ drawString,+ allocaSetWindowAttributes,+ set_override_redirect)+import Graphics.X11.Xlib.Context (setForeground, createGC)+import Graphics.X11.Xlib.Font (FontStruct,+ ascentFromFontStruct,+ descentFromFontStruct,+ textWidth, loadQueryFont) import Graphics.X11.Xlib.Extras (unmapWindow, changeWindowAttributes) import XBattBar.Types --- | wraps X11 window creation process-mkWidget :: XContext -> Rectangle -> EventMask -> Int -> (XContext -> ExtContext -> b) -> IO b-mkWidget ctx geom mask bw which = do- let attrmask = cWOverrideRedirect- borderWidth = fromIntegral bw - dpy' = dpy ctx- screen' = screen ctx- parent' = parent ctx- window <- createSimpleWindow dpy' parent'- (rect_x geom)- (rect_y geom)- (rect_width geom)- (rect_height geom)- borderWidth- (blackPixel dpy' screen')- (whitePixel dpy' screen')- allocaSetWindowAttributes $ \attrs -> do - set_override_redirect attrs True- changeWindowAttributes dpy' window cWOverrideRedirect attrs- gc <- createGC dpy' window- selectInput dpy' window mask- let ectx = ExtContext window geom gc- return $ which ctx ectx--getIndicatorRect :: Orientation -> Double -> Rectangle -> Rectangle-getIndicatorRect pos perc rect = case pos of- Horizontal ->- rect { rect_x = p (rect_width rect) - fromIntegral (rect_width rect), rect_y = 0 }- Vertical ->- rect { rect_y = fromIntegral (rect_height rect) - p (rect_height rect), rect_x = 0 }- where p x = floor $ perc * fromIntegral x+-- | progress bar-like widget+data ProgressBar = ProgressBar {+ pbXContext :: XContext,+ pbExContext :: ExtContext,+ colorBack :: Pixel,+ colorBar :: Pixel,+ progress :: Double,+ orientation :: Orientation+ } instance XWidget ProgressBar where xContext = pbXContext@@ -67,6 +48,14 @@ fillRectangles dpy' window' gc' [getIndicatorRect (orientation bar) (progress bar) geom'] flush dpy' +getIndicatorRect :: Orientation -> Double -> Rectangle -> Rectangle+getIndicatorRect pos perc rect = case pos of+ Horizontal ->+ rect { rect_x = p (rect_width rect) - fromIntegral (rect_width rect), rect_y = 0 }+ Vertical ->+ rect { rect_y = fromIntegral (rect_height rect) - p (rect_height rect), rect_x = 0 }+ where p x = floor $ perc * fromIntegral x+ -- | creates a progress bar-like widget mkProgressBar :: XContext -> Rectangle -> Pixel -> Pixel -> Orientation -> EventMask -> IO ProgressBar mkProgressBar xctx geom fg bg orientation mask = do@@ -75,6 +64,16 @@ f <- mkWidget xctx geom mask 0 ProgressBar return $ f fg bg 0.0 orientation +-- | multiline non-editable text widget with centered text+data Label = Label {+ lXContext :: XContext,+ lExContext :: ExtContext,+ colorBG :: Pixel,+ colorFont :: Pixel,+ font :: FontStruct,+ text :: [String]+ }+ instance XWidget Label where xContext = lXContext widgetContext = lExContext@@ -109,3 +108,26 @@ font <- loadQueryFont dpy' fontName f <- mkWidget xctx geom mask 2 Label return $ f bg fg font text++-- | wraps X11 window creation process+mkWidget :: XContext -> Rectangle -> EventMask -> Int -> (XContext -> ExtContext -> b) -> IO b+mkWidget ctx geom mask bw which = do+ let borderWidth = fromIntegral bw + dpy' = dpy ctx+ screen' = screen ctx+ parent' = parent ctx+ window <- createSimpleWindow dpy' parent'+ (rect_x geom)+ (rect_y geom)+ (rect_width geom)+ (rect_height geom)+ borderWidth+ (blackPixel dpy' screen')+ (whitePixel dpy' screen')+ allocaSetWindowAttributes $ \attrs -> do + set_override_redirect attrs True+ changeWindowAttributes dpy' window cWOverrideRedirect attrs+ gc <- createGC dpy' window+ selectInput dpy' window mask+ let ectx = ExtContext window geom gc+ return $ which ctx ectx
xbattbar.cabal view
@@ -1,5 +1,5 @@ name: xbattbar-version: 0.1+version: 0.2 synopsis: Simple battery indicator homepage: https://github.com/polachok/xbattbar license: MIT@@ -20,6 +20,5 @@ executable xbattbar main-is: Main.hs other-modules: XBattBar.Types, XBattBar.Core, XBattBar.Backend, XBattBar.Widgets- GHC-Options: -with-rtsopts=-V0- build-depends: base < 5, X11, select, old-time+ build-depends: base < 5, X11, select >= 0.4, old-time hs-source-dirs: src