Fixes

Fix snapping only using half of specified gap number
Add ALSA support for media buttons

5 files changed, 354 insertions, 7 deletions

diff --git a/src/XMonad/Actions/Alsa.hs b/src/XMonad/Actions/Alsa.hs
new file mode 100644
index 0000000..362f73b
--- /dev/null
+++ b/src/XMonad/Actions/Alsa.hs
@@ -0,0 +1,179 @@
+{-# LANGUAGE CPP #-}
+
+----------------------------------------------------------------------------
+-- |
+-- Module       : XMonad.Util.ALSA
+-- Copyright    : (c) daniel@wagner-home.com
+-- License      : BSD3-style (see LICENSE)
+--
+-- Maintainer   : daniel@wagner-home.com
+-- Stability    : unstable
+-- Portability  : unportable
+--
+----------------------------------------------------------------------------
+
+module XMonad.Util.ALSA
+    ( defaultChannels
+
+    , toggleMute
+    , raiseVolume
+    , lowerVolume
+
+    , getVolume
+    , getMute
+    , getVolumeMute
+
+    , setVolume
+    , setMute
+    , setVolumeMute
+
+    , modifyVolume
+    , modifyMute
+    , modifyVolumeMute
+
+
+    , toggleMuteChannels
+    , raiseVolumeChannels
+    , lowerVolumeChannels
+
+    , getVolumeChannels
+    , getMuteChannels
+    , getVolumeMuteChannels
+
+    , setVolumeChannels
+    , setMuteChannels
+    , setVolumeMuteChannels
+
+    , modifyVolumeChannels
+    , modifyMuteChannels
+    , modifyVolumeMuteChannels
+    ) where
+
+import           Control.Monad
+import           Control.Monad.Trans
+import           Data.Maybe
+import           Sound.ALSA.Mixer
+
+defaultChannels :: [String]
+defaultChannels = ["Master", "Headphone", "Speaker", "PCM"]
+
+toggleMute  :: MonadIO m => m Bool
+raiseVolume :: MonadIO m => Double -> m Double
+lowerVolume :: MonadIO m => Double -> m Double
+toggleMute  = toggleMuteChannels  defaultChannels
+raiseVolume = raiseVolumeChannels defaultChannels
+lowerVolume = lowerVolumeChannels defaultChannels
+
+getVolume     :: MonadIO m => m Double
+getMute       :: MonadIO m => m Bool
+getVolumeMute :: MonadIO m => m (Double, Bool)
+getVolume     = getVolumeChannels     defaultChannels
+getMute       = getMuteChannels       defaultChannels
+getVolumeMute = getVolumeMuteChannels defaultChannels
+
+setVolume     :: MonadIO m => Double         -> m ()
+setMute       :: MonadIO m => Bool           -> m ()
+setVolumeMute :: MonadIO m => Double -> Bool -> m ()
+setVolume     = setVolumeChannels     defaultChannels
+setMute       = setMuteChannels       defaultChannels
+setVolumeMute = setVolumeMuteChannels defaultChannels
+
+modifyVolume     :: MonadIO m => (Double         -> Double)         -> m Double
+modifyMute       :: MonadIO m => (Bool           -> Bool)           -> m Bool
+modifyVolumeMute :: MonadIO m => (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
+modifyVolume     = modifyVolumeChannels     defaultChannels
+modifyMute       = modifyMuteChannels       defaultChannels
+modifyVolumeMute = modifyVolumeMuteChannels defaultChannels
+
+toggleMuteChannels  :: MonadIO m => [String] -> m Bool
+raiseVolumeChannels :: MonadIO m => [String] -> Double -> m Double
+lowerVolumeChannels :: MonadIO m => [String] -> Double -> m Double
+toggleMuteChannels  cs = modifyMuteChannels   cs not
+raiseVolumeChannels cs = modifyVolumeChannels cs . (+)
+lowerVolumeChannels cs = modifyVolumeChannels cs . (subtract)
+
+getVolumeChannels     :: MonadIO m => [String] -> m Double
+getMuteChannels       :: MonadIO m => [String] -> m Bool
+getVolumeMuteChannels :: MonadIO m => [String] -> m (Double, Bool)
+getVolumeChannels     = liftIO . fmap fst . alsaGetAll
+getMuteChannels       = liftIO . fmap snd . alsaGetAll
+getVolumeMuteChannels = liftIO            . alsaGetAll
+
+setVolumeChannels     :: MonadIO m => [String] -> Double         -> m ()
+setMuteChannels       :: MonadIO m => [String] -> Bool           -> m ()
+setVolumeMuteChannels :: MonadIO m => [String] -> Double -> Bool -> m ()
+setVolumeChannels     cs v   = liftIO (alsaSetVolumeAll v   cs)
+setMuteChannels       cs   m = liftIO (alsaSetMuteAll     m cs)
+setVolumeMuteChannels cs v m = liftIO (alsaSetAll       v m cs)
+
+modifyVolumeChannels     :: MonadIO m => [String] -> (Double         -> Double)         -> m Double
+modifyMuteChannels       :: MonadIO m => [String] -> (Bool           -> Bool)           -> m Bool
+modifyVolumeMuteChannels :: MonadIO m => [String] -> (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
+modifyVolumeChannels        = modify getVolumeChannels setVolumeChannels
+modifyMuteChannels          = modify getMuteChannels   setMuteChannels
+modifyVolumeMuteChannels cs = modify getVolumeMuteChannels (\cs' -> uncurry (setVolumeMuteChannels cs')) cs . uncurry
+
+geomMean :: Floating a => [a] -> a
+geomMean xs = product xs ** (recip . fromIntegral . length $ xs)
+
+clip :: (Num t, Ord t) => t -> t
+clip = min 100 . max 0
+
+toRange :: (Integer, Integer) -> Double -> Integer
+toRange (x, y) d = floor (d * (y' - x') / 100 + x')
+    where x' = fromIntegral x
+          y' = fromIntegral y
+
+fromRange :: (Integer, Integer) -> Integer -> Double
+fromRange (x, y) z = fromIntegral (z - x) / fromIntegral (y - x) * 100
+
+modify :: Monad m => (arg -> m value) -> (arg -> value -> m ()) -> arg -> (value -> value) -> m value
+modify get set cs f = do
+    v <- liftM f $ get cs
+    set cs v
+    return v
+
+withControl :: (Control -> IO a) -> [String] -> IO a
+withControl f cs = withMixer "default" $ \mixer -> do
+    (control:_) <- catMaybes <$> mapM (getControlByName mixer) cs
+    f control
+
+alsaGetAll :: [String] -> IO (Double, Bool)
+alsaGetAll = withControl $ \control -> (,) <$> alsaGetVolume control <*> alsaGetMute control
+
+alsaGetVolume :: Control -> IO Double
+alsaGetVolume control = do
+    let Just playbackVolume = playback $ volume control
+        volChans = value playbackVolume
+    range <- getRange playbackVolume
+    vals <- mapM (\chan -> getChannel chan volChans) (channels volChans)
+    return $ geomMean $ map (fromRange range . fromJust) vals
+
+alsaGetMute :: Control -> IO Bool
+alsaGetMute control = do
+    let Just muteChans = playback $ switch control
+    all id . map fromJust <$> mapM (\chan -> getChannel chan muteChans) (channels muteChans)
+
+alsaSetVolumeAll :: Double -> [String] -> IO ()
+alsaSetVolumeAll v = withControl (alsaSetVolume v)
+
+alsaSetVolume :: Double -> Control -> IO ()
+alsaSetVolume v control = do
+    let Just playbackVolume = playback $ volume control
+        volChans = value playbackVolume
+    range <- getRange playbackVolume
+    forM_ (channels volChans) $ \chan -> do
+        setChannel chan volChans (toRange range (clip v))
+
+alsaSetMuteAll :: Bool -> [String] -> IO ()
+alsaSetMuteAll m = withControl (alsaSetMute m)
+
+alsaSetMute :: Bool -> Control -> IO ()
+alsaSetMute m control = do
+    let Just muteChans = playback $ switch control
+    forM_ (channels muteChans) $ \chan -> setChannel chan muteChans m
+
+alsaSetAll :: Double -> Bool -> [String] -> IO ()
+alsaSetAll v m = withControl $ \control -> do
+    alsaSetVolume v control
+    alsaSetMute m control
diff --git a/src/XMonad/Custom/Bindings.hs b/src/XMonad/Custom/Bindings.hs
index 414e89a..e744c69 100644
--- a/src/XMonad/Custom/Bindings.hs
+++ b/src/XMonad/Custom/Bindings.hs
@@ -36,7 +36,6 @@ import           XMonad.Actions.MessageFeedback
 import           XMonad.Actions.Navigation2D
 import           XMonad.Actions.PerConditionKeys
 import           XMonad.Actions.Promote
---import           XMonad.Actions.Volume
 import           XMonad.Actions.WithAll
 import           XMonad.Custom.Layout
 import qualified XMonad.Custom.Misc                  as CM
@@ -57,6 +56,7 @@ import           XMonad.Prompt.Shell
 import           XMonad.Prompt.Window
 import           XMonad.Prompt.Workspace
 import qualified XMonad.StackSet                     as S
+import           XMonad.Util.ALSA
 import           XMonad.Util.EZConfig
 import           XMonad.Util.NamedActions
 import           XMonad.Util.NamedScratchpad
@@ -147,10 +147,10 @@ keyBindings c = let subKeys s ks = subtitle s:mkNamedKeymap c ks in
     ]
     ^++^
     subKeys "Volume & Music"
- -- [ ("<XF86AudioMute>"        , addName "ALSA: Mute"         $ void   toggleMute)
- -- , ("<XF86AudioLowerVolume>" , addName "ALSA: Lower volume" $ void $ lowerVolume 5)
- -- , ("<XF86AudioRaiseVolume>" , addName "ALSA: Raise volume" $ void $ raiseVolume 5)
-    [ ("<XF86AudioPlay>"        , addName "MPD: Play/pause"    $ spawn "~/.xmonad/bin/mpc-play-pause.sh")
+    [ ("<XF86AudioMute>"        , addName "ALSA: Mute"         $ void   toggleMute)
+    , ("<XF86AudioLowerVolume>" , addName "ALSA: Lower volume" $ void $ lowerVolume 5)
+    , ("<XF86AudioRaiseVolume>" , addName "ALSA: Raise volume" $ void $ raiseVolume 5)
+    , ("<XF86AudioPlay>"        , addName "MPD: Play/pause"    $ spawn "~/.xmonad/bin/mpc-play-pause.sh")
     , ("<XF86AudioStop>"        , addName "MPD: Stop"          $ spawn "mpc --no-status stop")
     , ("<XF86AudioPrev>"        , addName "MPD: Previos track" $ spawn "mpc --no-status prev")
     , ("<XF86AudioNext>"        , addName "MPD: Next track"    $ spawn "mpc --no-status next")
@@ -238,7 +238,7 @@ mouseBindings' :: XConfig Layout -> M.Map (KeyMask, Button) (Window -> X ())
 mouseBindings' XConfig {XMonad.modMask = m} = M.fromList
     [ ((m,               button1), \w -> focus w
                                          >> F.mouseWindow F.position w
-                                         >> ifClick (snapSpacedMagicMove gapBase  (Just 50) (Just 50) w)
+                                         >> ifClick (snapSpacedMagicMove gapFull  (Just 50) (Just 50) w)
                                          >> windows S.shiftMaster
       )
     , ((m .|. shiftMask, button1), \w -> focus w
diff --git a/src/XMonad/Util/ALSA.hs b/src/XMonad/Util/ALSA.hs
new file mode 100644
index 0000000..27037cb
--- /dev/null
+++ b/src/XMonad/Util/ALSA.hs
@@ -0,0 +1,160 @@
+{-# LANGUAGE CPP #-}
+
+module XMonad.Util.ALSA
+    ( toggleMute
+    , raiseVolume
+    , lowerVolume
+    , getVolume
+    , getMute
+    , getVolumeMute
+    , setVolume
+    , setMute
+    , setVolumeMute
+    , modifyVolume
+    , modifyMute
+    , modifyVolumeMute
+    , defaultChannels
+    , toggleMuteChannels
+    , raiseVolumeChannels
+    , lowerVolumeChannels
+    , getVolumeChannels
+    , getMuteChannels
+    , getVolumeMuteChannels
+    , setVolumeChannels
+    , setMuteChannels
+    , setVolumeMuteChannels
+    , modifyVolumeChannels
+    , modifyMuteChannels
+    , modifyVolumeMuteChannels
+    ) where
+
+import           Control.Monad
+import           Control.Monad.Trans
+import           Data.Maybe
+import           Sound.ALSA.Mixer
+import           XMonad.Core
+
+toggleMute          :: MonadIO m => m Bool
+raiseVolume         :: MonadIO m => Double -> m Double
+lowerVolume         :: MonadIO m => Double -> m Double
+getVolume           :: MonadIO m => m Double
+getMute             :: MonadIO m => m Bool
+getVolumeMute       :: MonadIO m => m (Double, Bool)
+setVolume           :: MonadIO m => Double         -> m ()
+setMute             :: MonadIO m => Bool           -> m ()
+setVolumeMute       :: MonadIO m => Double -> Bool -> m ()
+modifyVolume        :: MonadIO m => (Double         -> Double)         -> m Double
+modifyMute          :: MonadIO m => (Bool           -> Bool)           -> m Bool
+modifyVolumeMute    :: MonadIO m => (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
+
+toggleMute          = toggleMuteChannels       defaultChannels
+raiseVolume         = raiseVolumeChannels      defaultChannels
+lowerVolume         = lowerVolumeChannels      defaultChannels
+getVolume           = getVolumeChannels        defaultChannels
+getMute             = getMuteChannels          defaultChannels
+getVolumeMute       = getVolumeMuteChannels    defaultChannels
+setVolume           = setVolumeChannels        defaultChannels
+setMute             = setMuteChannels          defaultChannels
+setVolumeMute       = setVolumeMuteChannels    defaultChannels
+modifyVolume        = modifyVolumeChannels     defaultChannels
+modifyMute          = modifyMuteChannels       defaultChannels
+modifyVolumeMute    = modifyVolumeMuteChannels defaultChannels
+
+defaultChannels :: [String]
+defaultChannels = ["Master", "Wave", "PCM"]
+
+toggleMuteChannels          :: MonadIO m => [String] -> m Bool
+raiseVolumeChannels         :: MonadIO m => [String] -> Double -> m Double
+lowerVolumeChannels         :: MonadIO m => [String] -> Double -> m Double
+getVolumeChannels           :: MonadIO m => [String] -> m Double
+getMuteChannels             :: MonadIO m => [String] -> m Bool
+getVolumeMuteChannels       :: MonadIO m => [String] -> m (Double, Bool)
+setVolumeChannels           :: MonadIO m => [String] -> Double         -> m ()
+setMuteChannels             :: MonadIO m => [String] -> Bool           -> m ()
+setVolumeMuteChannels       :: MonadIO m => [String] -> Double -> Bool -> m ()
+modifyVolumeChannels        :: MonadIO m => [String] -> (Double         -> Double )        -> m Double
+modifyMuteChannels          :: MonadIO m => [String] -> (Bool           -> Bool )          -> m Bool
+modifyVolumeMuteChannels    :: MonadIO m => [String] -> (Double -> Bool -> (Double, Bool)) -> m (Double, Bool)
+
+toggleMuteChannels  cs = modifyMuteChannels   cs not
+raiseVolumeChannels cs = modifyVolumeChannels cs . (+)
+lowerVolumeChannels cs = modifyVolumeChannels cs . (subtract)
+
+getVolumeChannels     = liftIO . fmap fst . alsaGetAll
+getMuteChannels       = liftIO . fmap snd . alsaGetAll
+getVolumeMuteChannels = liftIO            . alsaGetAll
+
+setVolumeChannels     cs v   = liftIO (alsaSetVolumeAll v   cs)
+setMuteChannels       cs   m = liftIO (alsaSetMuteAll     m cs)
+setVolumeMuteChannels cs v m = liftIO (alsaSetAll       v m cs)
+
+modifyVolumeChannels = modify getVolumeChannels setVolumeChannels
+modifyMuteChannels   = modify getMuteChannels   setMuteChannels
+modifyVolumeMuteChannels cs = modify getVolumeMuteChannels (\cs' -> uncurry (setVolumeMuteChannels cs')) cs . uncurry
+
+geomMean :: Floating a => [a] -> a
+geomMean xs = product xs ** (recip . fromIntegral . length $ xs)
+
+clip :: (Num t, Ord t) => t -> t
+clip = min 100 . max 0
+
+toRange :: (Integer, Integer) -> Double -> Integer
+toRange (x, y) d = floor (d * (y' - x') / 100 + x')
+    where x' = fromIntegral x
+          y' = fromIntegral y
+
+fromRange :: (Integer, Integer) -> Integer -> Double
+fromRange (x, y) z = fromIntegral (z - x) / fromIntegral (y - x) * 100
+
+modify :: Monad m => (arg -> m value) -> (arg -> value -> m ()) -> arg -> (value -> value) -> m value
+modify get set cs f = do
+    v <- liftM f $ get cs
+    set cs v
+    return v
+
+withControl :: (Control -> IO a) -> [String] -> IO a
+withControl f cs = withMixer "default" $ \mixer -> do
+    (control:_) <- catMaybes <$> mapM (getControlByName mixer) cs
+    f control
+
+alsaGetAll :: [String] -> IO (Double, Bool)
+alsaGetAll = withControl $ \control -> (,)
+    <$> alsaGetVolume control
+    <*> alsaGetMute control
+
+alsaGetVolume :: Control -> IO Double
+alsaGetVolume control = do
+    let Just playbackVolume = playback $ volume control
+        volChans = value playbackVolume
+    range <- getRange playbackVolume
+    vals <- mapM (\chan -> getChannel chan volChans) (channels volChans)
+    return $ geomMean $ map (fromRange range . fromJust) vals
+
+alsaGetMute :: Control -> IO Bool
+alsaGetMute control = do
+    let Just muteChans = playback $ switch control
+    all id . map fromJust <$> mapM (\chan -> getChannel chan muteChans) (channels muteChans)
+
+alsaSetVolumeAll :: Double -> [String] -> IO ()
+alsaSetVolumeAll v = withControl (alsaSetVolume v)
+
+alsaSetVolume :: Double -> Control -> IO ()
+alsaSetVolume v control = do
+    let Just playbackVolume = playback $ volume control
+        volChans = value playbackVolume
+    range <- getRange playbackVolume
+    forM_ (channels volChans) $ \chan -> do
+        setChannel chan volChans (toRange range (clip v))
+
+alsaSetMuteAll :: Bool -> [String] -> IO ()
+alsaSetMuteAll m = withControl (alsaSetMute m)
+
+alsaSetMute :: Bool -> Control -> IO ()
+alsaSetMute m control = do
+    let Just muteChans = playback $ switch control
+    forM_ (channels muteChans) $ \chan -> setChannel chan muteChans m
+
+alsaSetAll :: Double -> Bool -> [String] -> IO ()
+alsaSetAll v m = withControl $ \control -> do
+    alsaSetVolume v control
+    alsaSetMute m control
diff --git a/stack.yaml b/stack.yaml
index 98ff64a..ab9f566 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -3,3 +3,5 @@ packages:
     - .
     - ./vendor/xmonad
     - ./vendor/xmonad-contrib
+extra-deps:
+    - alsa-mixer-0.2.0.3
diff --git a/xmonad-ng.cabal b/xmonad-ng.cabal
index 87374fb..0f22f2a 100644
--- a/xmonad-ng.cabal
+++ b/xmonad-ng.cabal
@@ -24,9 +24,12 @@ library
 
     exposed-modules: XMonad.Actions.FloatSnapSpaced
                    , XMonad.Actions.PerConditionKeys
+                   , XMonad.Util.ALSA
 
-    build-depends: base           >= 4.11 && < 4.12
+    build-depends: alsa-mixer     >= 0.2  && < 0.3
+                 , base           >= 4.11 && < 4.12
                  , containers     >= 0.5  && < 0.6
+                 , mtl            >= 2.2  && < 2.3
                  , xmonad         >= 0.15 && < 0.16
                  , xmonad-contrib >= 0.15 && < 0.16
 
@@ -55,12 +58,15 @@ executable xmonad-ng
                  , XMonad.Custom.Startup
                  , XMonad.Custom.Theme
                  , XMonad.Custom.Workspaces
+                 , XMonad.Util.ALSA
 
     build-depends: X11            >= 1.9  && < 1.10
+                 , alsa-mixer     >= 0.2  && < 0.3
                  , base           >= 4.11 && < 4.12
                  , containers     >= 0.5  && < 0.6
                  , directory      >= 1.3  && < 1.4
                  , filepath       >= 1.4  && < 1.5
+                 , mtl            >= 2.2  && < 2.3
                  , text           >= 1.2  && < 1.3
                  , time           >= 1.8  && < 1.9
                  , xmonad         >= 0.15 && < 0.16