xmonad-screenshot (empty) → 0.1.0.0

raw patch · 5 files changed

+171/−0 lines, 5 filesdep +basedep +gtkdep +xmonadsetup-changed

Dependencies added: base, gtk, xmonad

Files

• LICENSE +19/−0
• Setup.hs +2/−0
• src/XMonad/Util/WorkspaceScreenshot.hs +7/−0
• src/XMonad/Util/WorkspaceScreenshot/Internal.hs +126/−0
• xmonad-screenshot.cabal +17/−0

@@ -0,0 +1,19 @@+Copyright (C) 2012 Matvey Aksenov++Permission is hereby granted, free of charge, to any person obtaining a copy of+this software and associated documentation files (the "Software"), to deal in+the Software without restriction, including without limitation the rights to+use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies+of the Software, and to permit persons to whom the Software is furnished to do+so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,7 @@+{-# OPTIONS_HADDOCK not-home #-}+-- | Provides an utility functions for easy and robust workspaces' screen capturing.+module XMonad.Util.WorkspaceScreenshot+  ( module XMonad.Util.WorkspaceScreenshot.Internal+  ) where++import XMonad.Util.WorkspaceScreenshot.Internal

@@ -0,0 +1,126 @@+{-# LANGUAGE UnicodeSyntax #-}+{-# OPTIONS_HADDOCK hide #-}+-- | Provides an utility functions for easy and robust workspaces' screen capturing.+module XMonad.Util.WorkspaceScreenshot.Internal+{-# WARNING "Make sure you add `initCapturing' before `xmonad' call in xmonad.hs" #-}+  ( -- * Initialization+    initCapturing+    -- * Screenshoting routines+  , captureWorkspacesWhen+  , captureWorkspacesWhenId+    -- * Defaulting+  , defaultPredicate+  , defaultHook+    -- * Screenshoting layout+  , CapturingLayout(..)+  , horizontally+  , vertically+  ) where++import Control.Applicative ((<$>))+import Control.Concurrent (threadDelay)+import Control.Monad (filterM, foldM_, (>=>))+import Data.Maybe (catMaybes)++import Graphics.UI.Gtk (initGUI, Rectangle(..), drawableGetSize, drawWindowGetDefaultRootWindow)+import Graphics.UI.Gtk.Gdk.Pixbuf (Colorspace(ColorspaceRgb), Pixbuf, pixbufCopyArea, pixbufGetFromDrawable, pixbufGetHeight, pixbufGetWidth, pixbufNew, pixbufSave)+import XMonad hiding (Image, Rectangle)+import qualified XMonad.StackSet as S+++-- | Init gtk to enable a possibility of capturing workspaces.+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 p hook = captureWorkspacesWhenId (workspaceIdToWindowSpace >=> p) hook+ where+  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 p hook mode = do+  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 = const (return True)+++-- | Default hook. Does nothing.+defaultHook ∷ a → IO ()+defaultHook = const (return ())+++-- Capture screen with gtk pixbuf.+-- Delay is necessary to get interfaces rendered.+captureScreen ∷ X (Maybe Pixbuf)+captureScreen = liftIO $+  do threadDelay 100000+     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+  }+++-- | Capture screens layout horizontally.+horizontally ∷ CapturingLayout+horizontally = CapturingLayout+  { dimensions = \xs →+      do h ← maximum <$> mapM pixbufGetHeight xs+         w ← sum <$> mapM pixbufGetWidth xs+         return (h, w)+  , fill = \ps p → foldM_ (addTo p) 0 ps+  }+ where+  addTo ∷ Pixbuf → Int → Pixbuf → IO Int+  addTo p a 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+  { dimensions = \xs →+     do h ← sum <$> mapM pixbufGetHeight xs+        w ← maximum <$> mapM pixbufGetWidth xs+        return (h, w)+  , fill = \ps p → foldM_ (addTo p) 0 ps+  }+ where+  addTo ∷ Pixbuf → Int → Pixbuf → IO Int+  addTo p a 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 layout ps = do+  (h, w) ← dimensions layout ps+  p ← pixbufNew ColorspaceRgb False 8 w h+  fill layout ps p+  dir ← getXMonadDir+  let filepath = (dir ++ "/screenshot.png")+  pixbufSave p filepath "png" []+  return filepath

@@ -0,0 +1,17 @@+name:                xmonad-screenshot+version:             0.1.0.0+synopsis:            Workspaces screenshooting utility for XMonad.+homepage:            http://github.com/supki/xmonad-screenshot+license:             MIT+license-file:        LICENSE+author:              Matvey Aksenov+maintainer:          Dmitry Malikov, malikov.d.y@gmail.com+category:            XMonad+build-type:          Simple+cabal-version:       >=1.8++library+  build-depends:       base >= 3 && < 5, xmonad >= 0.9, gtk >= 0.12.3+  exposed-modules:     XMonad.Util.WorkspaceScreenshot+  other-modules:       XMonad.Util.WorkspaceScreenshot.Internal+  hs-source-dirs:      src