From b909762b396932bf6d768c1f4beae5bbcb50f95a Mon Sep 17 00:00:00 2001 From: jao Date: Sun, 25 Nov 2018 03:21:57 +0000 Subject: XPMFile also in Xmobar.X11 --- readme.md | 10 +++---- src/lib/Xmobar/X11/Bitmap.hs | 2 +- src/lib/Xmobar/X11/XPMFile.hsc | 60 ++++++++++++++++++++++++++++++++++++++++++ src/lib/Xmobar/XPMFile.hsc | 60 ------------------------------------------ xmobar.cabal | 2 +- 5 files changed, 67 insertions(+), 67 deletions(-) create mode 100644 src/lib/Xmobar/X11/XPMFile.hsc delete mode 100644 src/lib/Xmobar/XPMFile.hsc diff --git a/readme.md b/readme.md index fb10c3f..3c3d5c0 100644 --- a/readme.md +++ b/readme.md @@ -1587,11 +1587,11 @@ Spencer Janssen, Roman Joost, Jochen Keil, Lennart Kolmodin, Krzysztof Kosciuszkiewicz, Dmitry Kurochkin, Todd Lunter, Vanessa McHale, Robert J. Macomber, Dmitry Malikov, David McLean, Marcin Mikołajczyk, Dino Morelli, Tony Morris, Eric Mrak, Thiago Negri, Edward O'Callaghan, -Svein Ove, Martin Perner, Jens Petersen, Alexander Polakov, Petr -Rockai, Andrew Sackville-West, Markus Scherer, Daniel Schüssler, -Olivier Schneider, Alexander Shabalin, Valentin Shirokov, Peter -Simons, Alexander Solovyov, Will Song, John Soros, Travis Staton, -Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei +Svein Ove, Martin Perner, Jens Petersen, Alexander Polakov, Pavan +Rikhi, Petr Rockai, Andrew Sackville-West, Markus Scherer, Daniel +Schüssler, Olivier Schneider, Alexander Shabalin, Valentin Shirokov, +Peter Simons, Alexander Solovyov, Will Song, John Soros, Travis +Staton, Artem Tarasov, Samuli Thomasson, Edward Tjörnhammar, Sergei Trofimovich, Thomas Tuegel, Jan Vornberger, Anton Vorontsov, Daniel Wagner, Zev Weiss, Phil Xiaojun Hu, Edward Z. Yang and Norbert Zeh. diff --git a/src/lib/Xmobar/X11/Bitmap.hs b/src/lib/Xmobar/X11/Bitmap.hs index 7b7afeb..dee3966 100644 --- a/src/lib/Xmobar/X11/Bitmap.hs +++ b/src/lib/Xmobar/X11/Bitmap.hs @@ -28,7 +28,7 @@ import Xmobar.Parsers (Widget(..)) import Xmobar.Actions (Action) #ifdef XPM -import Xmobar.XPMFile(readXPMFile) +import Xmobar.X11.XPMFile(readXPMFile) import Control.Applicative((<|>)) #endif diff --git a/src/lib/Xmobar/X11/XPMFile.hsc b/src/lib/Xmobar/X11/XPMFile.hsc new file mode 100644 index 0000000..2daffac --- /dev/null +++ b/src/lib/Xmobar/X11/XPMFile.hsc @@ -0,0 +1,60 @@ +{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-} +----------------------------------------------------------------------------- +-- | +-- Module : XPMFile +-- Copyright : (C) 2014, 2018 Alexander Shabalin +-- License : BSD3 +-- +-- Maintainer : jao@gnu.org +-- Stability : unstable +-- Portability : unportable +-- +----------------------------------------------------------------------------- + +module Xmobar.X11.XPMFile(readXPMFile) where + +#if MIN_VERSION_mtl(2, 2, 1) +import Control.Monad.Except(MonadError(..)) +#else +import Control.Monad.Error(MonadError(..)) +#endif +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 + +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/src/lib/Xmobar/XPMFile.hsc b/src/lib/Xmobar/XPMFile.hsc deleted file mode 100644 index 03d534f..0000000 --- a/src/lib/Xmobar/XPMFile.hsc +++ /dev/null @@ -1,60 +0,0 @@ -{-# LANGUAGE FlexibleContexts, ForeignFunctionInterface #-} ------------------------------------------------------------------------------ --- | --- Module : XPMFile --- Copyright : (C) 2014 Alexander Shabalin --- License : BSD3 --- --- Maintainer : jao@gnu.org --- Stability : unstable --- Portability : unportable --- ------------------------------------------------------------------------------ - -module Xmobar.XPMFile(readXPMFile) where - -#if MIN_VERSION_mtl(2, 2, 1) -import Control.Monad.Except(MonadError(..)) -#else -import Control.Monad.Error(MonadError(..)) -#endif -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 - -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 dfa75a8..f250dfd 100644 --- a/xmobar.cabal +++ b/xmobar.cabal @@ -229,7 +229,7 @@ library if flag(with_xpm) || flag(all_extensions) extra-libraries: Xpm - other-modules: Xmobar.XPMFile + other-modules: Xmobar.X11.XPMFile cpp-options: -DXPM if flag(with_weather) || flag(all_extensions) -- cgit v1.2.3