summaryrefslogtreecommitdiffhomepage
path: root/src/XPMFile.hsc
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2014-09-04 20:38:53 +0200
committerjao <jao@gnu.org>2014-09-04 20:38:53 +0200
commit8d658f93df22d69ea4170234b15fd03cdd3f7f4f (patch)
tree478344a55fc84b95475ec47d33caeada7bdf28f9 /src/XPMFile.hsc
parentce60a9fcca7c05fee01758bd49b2f9e410693769 (diff)
parent8512afbb2c3be1897101da0b23edb258715475e6 (diff)
downloadxmobar-8d658f93df22d69ea4170234b15fd03cdd3f7f4f.tar.gz
xmobar-8d658f93df22d69ea4170234b15fd03cdd3f7f4f.tar.bz2
Merge branch 'xpm' of https://github.com/projedi/xmobar
Diffstat (limited to 'src/XPMFile.hsc')
-rw-r--r--src/XPMFile.hsc56
1 files changed, 56 insertions, 0 deletions
diff --git a/src/XPMFile.hsc b/src/XPMFile.hsc
new file mode 100644
index 0000000..18c7dec
--- /dev/null
+++ b/src/XPMFile.hsc
@@ -0,0 +1,56 @@
+{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-}
+-----------------------------------------------------------------------------
+-- |
+-- Module : XPMFile
+-- Copyright : (C) 2014 Alexander Shabalin
+-- License : BSD3
+--
+-- Maintainer : jao@gnu.org
+-- Stability : unstable
+-- Portability : unportable
+--
+-----------------------------------------------------------------------------
+
+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