summaryrefslogtreecommitdiffhomepage
diff options
context:
space:
mode:
authorAlexander Shabalin <shabalyn.a@gmail.com>2014-09-02 21:15:00 +0400
committerAlexander Shabalin <shabalyn.a@gmail.com>2014-09-03 23:55:38 +0400
commit1d8a1955dd719846e51596b573ee5a6e2bcbcf5a (patch)
tree6c839290278baf7078c515fda2c7665cd94f2d68
parent557f5dbf2863f85c9e39c90d38a28d4870110afe (diff)
downloadxmobar-1d8a1955dd719846e51596b573ee5a6e2bcbcf5a.tar.gz
xmobar-1d8a1955dd719846e51596b573ee5a6e2bcbcf5a.tar.bz2
Add .xpm support for <icon> via libXpm.
* Adds a new flag with_xpm to enable compilation with xpm support * Adds a module XPMFile only exporting readXPMFile which almost mirrors Graphics.X11.Xlib.Misc.readBitmapFile * During loadBitmap a file is first tried with readBitmapFile and if it fails with readXPMFile
-rw-r--r--readme.md5
-rw-r--r--src/Bitmap.hs58
-rw-r--r--src/XPMFile.hsc44
-rw-r--r--xmobar.cabal9
4 files changed, 110 insertions, 6 deletions
diff --git a/readme.md b/readme.md
index 5814d0c..f8ad0db 100644
--- a/readme.md
+++ b/readme.md
@@ -152,6 +152,10 @@ Otherwise, you'll need to install them yourself.
: Support for other timezones. Enables the DateZone plugin.
Requires [timezone-olson] and [timezone-series] package.
+`with_xpm`
+: Support for xpm image file format. This will allow loading .xpm files in `<icon>`.
+ Requires the [libXpm] C library.
+
`all_extensions`
: Enables all the extensions above.
@@ -1495,3 +1499,4 @@ Copyright &copy; 2007-2010 Andrea Rossato
[alsa-mixer]: http://hackage.haskell.org/package/alsa-mixer
[timezone-olson]: http://hackage.haskell.org/package/timezone-olson
[timezone-series]: http://hackage.haskell.org/package/timezone-series
+[libXpm]: http://cgit.freedesktop.org/xorg/lib/libXpm
diff --git a/src/Bitmap.hs b/src/Bitmap.hs
index 3673b7a..ff79262 100644
--- a/src/Bitmap.hs
+++ b/src/Bitmap.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP, FlexibleContexts #-}
-----------------------------------------------------------------------------
-- |
-- Module : Bitmap
@@ -15,7 +16,10 @@ module Bitmap
, drawBitmap
, Bitmap(..)) where
+import Control.Applicative((<|>))
import Control.Monad
+import Control.Monad.Except(MonadError(..), runExceptT)
+import Control.Monad.Trans(MonadIO(..))
import Data.Map hiding (foldr, map, filter)
import Graphics.X11.Xlib
import System.Directory (doesFileExist)
@@ -24,9 +28,17 @@ import ColorCache
import Parsers (Widget(..))
import Actions (Action)
+#ifdef XPM
+import XPMFile(readXPMFile)
+#endif
+
+data BitmapType = Mono Pixel | Poly
+
data Bitmap = Bitmap { width :: Dimension
, height :: Dimension
, pixmap :: Pixmap
+ , shapePixmap :: Maybe Pixmap
+ , bitmapType :: BitmapType
}
updateCache :: Display -> Window -> Map FilePath Bitmap ->
@@ -41,21 +53,48 @@ updateCache dpy win cache ps = do
return $ maybe m (\b -> insert path b m) bitmap
foldM go cache paths
+readBitmapFile'
+ :: (MonadError String m, MonadIO m)
+ => Display
+ -> Drawable
+ -> String
+ -> m (Dimension, Dimension, Pixmap)
+readBitmapFile' d w p = do
+ res <- liftIO $ readBitmapFile d w p
+ case res of
+ Left err -> throwError err
+ Right (bw, bh, bp, _, _) -> return (bw, bh, bp)
+
loadBitmap :: Display -> Drawable -> FilePath -> IO (Maybe Bitmap)
loadBitmap d w p = do
exist <- doesFileExist p
if exist
then do
- bmap <- readBitmapFile d w p
- case bmap of
- Right (bw, bh, bp, _, _) -> do
- addFinalizer bp (freePixmap d bp)
- return $ Just $ Bitmap bw bh bp
+ res <- runExceptT $
+ tryXBM
+#ifdef XPM
+ <|> tryXPM
+#endif
+ case res of
+ Right b -> return $ Just b
Left err -> do
putStrLn err
return Nothing
else
return Nothing
+ where tryXBM = do
+ (bw, bh, bp) <- readBitmapFile' d w p
+ liftIO $ addFinalizer bp (freePixmap d bp)
+ return $ Bitmap bw bh bp Nothing (Mono 1)
+#ifdef XPM
+ tryXPM = do
+ (bw, bh, bp, mbpm) <- readXPMFile d w p
+ liftIO $ addFinalizer bp (freePixmap d bp)
+ case mbpm of
+ Nothing -> return ()
+ Just bpm -> liftIO $ addFinalizer bpm (freePixmap d bpm)
+ return $ Bitmap bw bh bp mbpm Poly
+#endif
drawBitmap :: Display -> Drawable -> GC -> String -> String
-> Position -> Position -> Bitmap -> IO ()
@@ -63,6 +102,13 @@ drawBitmap d p gc fc bc x y i =
withColors d [fc, bc] $ \[fc', bc'] -> do
let w = width i
h = height i
+ y' = 1 + y - fromIntegral h `div` 2
setForeground d gc fc'
setBackground d gc bc'
- copyPlane d (pixmap i) p gc 0 0 w h x (1 + y - fromIntegral h `div` 2) 1
+ case (shapePixmap i) of
+ Nothing -> return ()
+ Just mask -> setClipOrigin d gc x y' >> setClipMask d gc mask
+ case bitmapType i of
+ Poly -> copyArea d (pixmap i) p gc 0 0 w h x y'
+ Mono pl -> copyPlane d (pixmap i) p gc 0 0 w h x y' pl
+ setClipMask d gc 0
diff --git a/src/XPMFile.hsc b/src/XPMFile.hsc
new file mode 100644
index 0000000..2284e4a
--- /dev/null
+++ b/src/XPMFile.hsc
@@ -0,0 +1,44 @@
+{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-}
+module XPMFile(readXPMFile) where
+
+import Control.Monad.Except(MonadError(..))
+import Control.Monad.Trans(MonadIO(..))
+import Graphics.X11.Xlib(Dimension, Display(..), Drawable, Pixmap)
+import Foreign.C.String(CString, withCString)
+import Foreign.C.Types(CInt(..), CLong)
+import Foreign.Ptr(Ptr)
+import Foreign.Marshal.Alloc(alloca, allocaBytes)
+import Foreign.Storable(peek, peekByteOff, pokeByteOff)
+
+#include <X11/xpm.h>
+
+foreign import ccall "XpmReadFileToPixmap"
+ xpmReadFileToPixmap :: Display -> Drawable -> CString -> Ptr Pixmap -> Ptr Pixmap -> Ptr () -> IO CInt
+
+readXPMFile
+ :: (MonadError String m, MonadIO m)
+ => Display
+ -> Drawable
+ -> String
+ -> m (Dimension, Dimension, Pixmap, Maybe Pixmap)
+readXPMFile display d filename =
+ toError $ withCString filename $ \c_filename ->
+ alloca $ \pixmap_return ->
+ alloca $ \shapemask_return ->
+ allocaBytes (#size XpmAttributes) $ \attributes -> do
+ (#poke XpmAttributes, valuemask) attributes ((#const XpmReturnAllocPixels) :: CLong)
+ res <- xpmReadFileToPixmap display d c_filename pixmap_return shapemask_return attributes
+ case res of
+ 0 -> do
+ width <- (#peek XpmAttributes, width) attributes
+ height <- (#peek XpmAttributes, height) attributes
+ pixmap <- peek pixmap_return
+ shapemask <- peek shapemask_return
+ return $ Right (width, height, pixmap, if shapemask == 0 then Nothing else Just shapemask)
+ 1 -> return $ Left "readXPMFile: XpmColorError"
+ -1 -> return $ Left "readXPMFile: XpmOpenFailed"
+ -2 -> return $ Left "readXPMFile: XpmFileInvalid"
+ -3 -> return $ Left "readXPMFile: XpmNoMemory"
+ -4 -> return $ Left "readXPMFile: XpmColorFailed"
+ _ -> return $ Left "readXPMFile: Unknown error"
+ where toError m = either throwError return =<< liftIO m
diff --git a/xmobar.cabal b/xmobar.cabal
index 9e0e509..716366e 100644
--- a/xmobar.cabal
+++ b/xmobar.cabal
@@ -66,6 +66,10 @@ flag with_dbus
description: Publish a service on the session bus for controlling xmobar.
default: False
+flag with_xpm
+ description: Enable usage of xpm for icons
+ default: False
+
flag with_threaded
description: Use threaded runtime.
default: False
@@ -166,3 +170,8 @@ executable xmobar
build-depends: dbus >= 0.10
other-modules: IPC.DBus
cpp-options: -DDBUS
+
+ if flag(with_xpm) || flag(all_extensions)
+ extra-libraries: Xpm
+ other-modules: XPMFile
+ cpp-options: -DXPM