xmonad-screenshot 0.1.0.0 → 0.1.1.0

raw patch · 2 files changed

+36/−36 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• src/XMonad/Util/WorkspaceScreenshot/Internal.hs +35/−35
• xmonad-screenshot.cabal +1/−1

@@ -1,4 +1,3 @@-{-# LANGUAGE UnicodeSyntax #-} {-# OPTIONS_HADDOCK hide #-} -- | Provides an utility functions for easy and robust workspaces' screen capturing. module XMonad.Util.WorkspaceScreenshot.Internal@@ -21,6 +20,7 @@ import Control.Concurrent (threadDelay) import Control.Monad (filterM, foldM_, (>=>)) import Data.Maybe (catMaybes)+import Data.String (fromString)  import Graphics.UI.Gtk (initGUI, Rectangle(..), drawableGetSize, drawWindowGetDefaultRootWindow) import Graphics.UI.Gtk.Gdk.Pixbuf (Colorspace(ColorspaceRgb), Pixbuf, pixbufCopyArea, pixbufGetFromDrawable, pixbufGetHeight, pixbufGetWidth, pixbufNew, pixbufSave)@@ -29,98 +29,98 @@   -- | Init gtk to enable a possibility of capturing workspaces.-initCapturing ∷ IO ()+initCapturing :: IO () initCapturing = initGUI >> return () {-# WARNING initCapturing "Make sure you add `initCapturing' before `xmonad' call in xmonad.hs" #-}   -- | Capture screens from workspaces satisfying given predicate.-captureWorkspacesWhen ∷ (WindowSpace → X Bool) → (FilePath → IO ()) → CapturingLayout → X ()+captureWorkspacesWhen :: (WindowSpace -> X Bool) -> (FilePath -> IO ()) -> CapturingLayout -> X () captureWorkspacesWhen p hook = captureWorkspacesWhenId (workspaceIdToWindowSpace >=> p) hook  where-  workspaceIdToWindowSpace i = gets $ head . filter (\w → S.tag w == i) . S.workspaces . windowset+  workspaceIdToWindowSpace i = gets $ head . filter (\w -> S.tag w == i) . S.workspaces . windowset   -- | Capture screens from workspaces which id satisfies given predicate.-captureWorkspacesWhenId ∷ (WorkspaceId → X Bool) → (FilePath → IO ()) → CapturingLayout → X ()+captureWorkspacesWhenId :: (WorkspaceId -> X Bool) -> (FilePath -> IO ()) -> CapturingLayout -> X () captureWorkspacesWhenId p hook mode = do-  c ← gets $ S.currentTag . windowset-  ps ← catMaybes <$> (mapM (\t → windows (S.view t) >> captureScreen) =<< filterM p =<< asks (workspaces . config))+  c <- gets $ S.currentTag . windowset+  ps <- catMaybes <$> (mapM (\t -> windows (S.view t) >> captureScreen) =<< filterM p =<< asks (workspaces . config))   windows $ S.view c   xfork $ merge mode ps >>= hook   return ()   -- | Default predicate. Accepts every available workspace.-defaultPredicate ∷ a → X Bool+defaultPredicate :: a -> X Bool defaultPredicate = const (return True)   -- | Default hook. Does nothing.-defaultHook ∷ a → IO ()+defaultHook :: a -> IO () defaultHook = const (return ())   -- Capture screen with gtk pixbuf. -- Delay is necessary to get interfaces rendered.-captureScreen ∷ X (Maybe Pixbuf)+captureScreen :: X (Maybe Pixbuf) captureScreen = liftIO $   do threadDelay 100000-     rw ← drawWindowGetDefaultRootWindow-     (w, h) ← drawableGetSize rw+     rw <- drawWindowGetDefaultRootWindow+     (w, h) <- drawableGetSize rw      pixbufGetFromDrawable rw (Rectangle 0 0 w h)   -- | Layout for resulting capture. data CapturingLayout = CapturingLayout-  { dimensions ∷ [Pixbuf] → IO (Int, Int) -- ^ Maximum height and maximum width for capture-  , fill ∷ [Pixbuf] → Pixbuf → IO () -- ^ Filling algorithm+  { dimensions :: [Pixbuf] -> IO (Int, Int) -- ^ Maximum height and maximum width for capture+  , fill :: [Pixbuf] -> Pixbuf -> IO () -- ^ Filling algorithm   }   -- | Capture screens layout horizontally.-horizontally ∷ CapturingLayout+horizontally :: CapturingLayout horizontally = CapturingLayout-  { dimensions = \xs →-      do h ← maximum <$> mapM pixbufGetHeight xs-         w ← sum <$> mapM pixbufGetWidth xs+  { dimensions = \xs ->+      do h <- maximum <$> mapM pixbufGetHeight xs+         w <- sum <$> mapM pixbufGetWidth xs          return (h, w)-  , fill = \ps p → foldM_ (addTo p) 0 ps+  , fill = \ps p -> foldM_ (addTo p) 0 ps   }  where-  addTo ∷ Pixbuf → Int → Pixbuf → IO Int+  addTo :: Pixbuf -> Int -> Pixbuf -> IO Int   addTo p a p' =-    do w' ← pixbufGetWidth p'-       h' ← pixbufGetHeight p'+    do w' <- pixbufGetWidth p'+       h' <- pixbufGetHeight p'        pixbufCopyArea p' 0 0 w' h' p a 0        return (a + w')   -- | Capture screens layout vertically.-vertically ∷ CapturingLayout+vertically :: CapturingLayout vertically = CapturingLayout-  { dimensions = \xs →-     do h ← sum <$> mapM pixbufGetHeight xs-        w ← maximum <$> mapM pixbufGetWidth xs+  { dimensions = \xs ->+     do h <- sum <$> mapM pixbufGetHeight xs+        w <- maximum <$> mapM pixbufGetWidth xs         return (h, w)-  , fill = \ps p → foldM_ (addTo p) 0 ps+  , fill = \ps p -> foldM_ (addTo p) 0 ps   }  where-  addTo ∷ Pixbuf → Int → Pixbuf → IO Int+  addTo :: Pixbuf -> Int -> Pixbuf -> IO Int   addTo p a p' =-    do w' ← pixbufGetWidth p'-       h' ← pixbufGetHeight p'+    do w' <- pixbufGetWidth p'+       h' <- pixbufGetHeight p'        pixbufCopyArea p' 0 0 w' h' p 0 a        return (a + h')   -- Contruct final image from the list of pixbufs.-merge ∷ CapturingLayout → [Pixbuf] → IO FilePath+merge :: CapturingLayout -> [Pixbuf] -> IO FilePath merge layout ps = do-  (h, w) ← dimensions layout ps-  p ← pixbufNew ColorspaceRgb False 8 w h+  (h, w) <- dimensions layout ps+  p <- pixbufNew ColorspaceRgb False 8 w h   fill layout ps p-  dir ← getXMonadDir+  dir <- getXMonadDir   let filepath = (dir ++ "/screenshot.png")-  pixbufSave p filepath "png" []+  pixbufSave p filepath (fromString "png") ([] :: [(String,String)])   return filepath

@@ -1,5 +1,5 @@ name:                xmonad-screenshot-version:             0.1.0.0+version:             0.1.1.0 synopsis:            Workspaces screenshooting utility for XMonad. homepage:            http://github.com/supki/xmonad-screenshot license:             MIT