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 --- src/lib/Xmobar/X11/Bitmap.hs | 2 +- src/lib/Xmobar/X11/XPMFile.hsc | 60 ++++++++++++++++++++++++++++++++++++++++++ src/lib/Xmobar/XPMFile.hsc | 60 ------------------------------------------ 3 files changed, 61 insertions(+), 61 deletions(-) create mode 100644 src/lib/Xmobar/X11/XPMFile.hsc delete mode 100644 src/lib/Xmobar/XPMFile.hsc (limited to 'src') 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 -- cgit v1.2.3