From 9394e86a2ea44c29035630f54d276bd9712746c9 Mon Sep 17 00:00:00 2001 From: azahi Date: Sat, 29 Jun 2019 18:16:16 +0300 Subject: Replace alsa-mixer with external shell alternative Modify fonts Remove urgency hook Remove selection notification Decrease spacing and apply it to bars Tweak colors --- src/Main.hs | 15 ---- src/XMonad/Custom/Bindings.hs | 14 +--- src/XMonad/Custom/Layout.hs | 5 +- src/XMonad/Custom/Log.hs | 2 +- src/XMonad/Custom/Theme.hs | 9 ++- src/XMonad/Util/ALSA.hs | 171 ------------------------------------------ xmobarrc/bot.hs | 14 ++-- xmobarrc/top.hs | 14 ++-- xmonad-ng.cabal | 1 - 9 files changed, 29 insertions(+), 216 deletions(-) delete mode 100644 src/XMonad/Util/ALSA.hs diff --git a/src/Main.hs b/src/Main.hs index 9afb3a1..91a3e9f 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -26,30 +26,15 @@ import qualified XMonad.Custom.Projects as C import qualified XMonad.Custom.Startup as C import qualified XMonad.Custom.Theme as C import qualified XMonad.Custom.Workspaces as C -import XMonad.Hooks.DynamicLog import XMonad.Hooks.EwmhDesktops import XMonad.Hooks.ManageDocks -import XMonad.Hooks.UrgencyHook import XMonad.Layout.Fullscreen -import qualified XMonad.StackSet as S -import XMonad.Util.NamedWindows -import XMonad.Util.Run - -data NotifyUrgencyHook = NotifyUrgencyHook - deriving (Read, Show) - -instance UrgencyHook NotifyUrgencyHook where - urgencyHook NotifyUrgencyHook w = do - n <- getName w - Just i <- S.findTag w <$> gets windowset - safeSpawn (C.notify C.applications) [show n, "workspace " ++ wrap "[" "]" i] main :: IO () main = xmonad $ ewmh $ fullscreenSupport $ docks - $ withUrgencyHook NotifyUrgencyHook $ withNavigation2DConfig C.navigation $ dynamicProjects C.projects $ def { borderWidth = C.border diff --git a/src/XMonad/Custom/Bindings.hs b/src/XMonad/Custom/Bindings.hs index 772b0ad..cbe5056 100644 --- a/src/XMonad/Custom/Bindings.hs +++ b/src/XMonad/Custom/Bindings.hs @@ -19,7 +19,6 @@ module XMonad.Custom.Bindings , mouseBindings ) where -import Control.Monad import qualified Data.Map as M import System.Exit import XMonad hiding (keys, modMask, @@ -77,9 +76,6 @@ zipKeys' m ks as f b = zipWith (\k d -> (m ++ k, f d b)) ks as tryMessageR_ :: (Message a, Message b) => a -> b -> X () tryMessageR_ x y = sequence_ [tryMessageWithNoRefreshToCurrent x y, refresh] --- xSelectionNotify :: MonadIO m => m () --- xSelectionNotify = join $ io --- $ unsafeSpawn . (\x -> C.notify C.applications ++ " Clipboard " ++ wrap "\"\\\"" "\"\\\"" x) <$> getSelection toggleCopyToAll :: X () toggleCopyToAll = wsContainingCopies >>= \case [] -> windows copyToAll @@ -132,7 +128,6 @@ keysSystem :: XConfig Layout -> [(String, X ())] keysSystem _ = [ ("M-C-g" , return ()) , ("" , spawn "~/.xmonad/scripts/screenlock.sh") - -- , ("M-S-c" , xSelectionNotify) , ("M-" , spawn "~/.xmonad/scripts/xshot-upload.sh") , ("M-S-" , spawn "~/.xmonad/scripts/xshot-select-upload.sh") , ("M-" , spawn "~/.xmonad/scripts/xcast.sh --webm") @@ -146,11 +141,10 @@ keysSystem _ = keysMedia :: XConfig Layout -> [(String, X ())] keysMedia _ = - [ - -- , ("" , void toggleMute) - -- , ("" , void $ lowerVolume 5) - -- , ("" , void $ raiseVolume 5) - ("" , spawn "~/.xmonad/scripts/mpc-play-pause.sh") + [ ("" , spawn "amixer set Master toggle") + , ("" , spawn "amixer set Master 5-") + , ("" , spawn "amixer set Master 5+") + , ("" , spawn "~/.xmonad/scripts/mpc-play-pause.sh") , ("" , spawn "mpc --no-status stop") , ("" , spawn "mpc --no-status prev") , ("" , spawn "mpc --no-status next") diff --git a/src/XMonad/Custom/Layout.hs b/src/XMonad/Custom/Layout.hs index f0a763b..652aed8 100644 --- a/src/XMonad/Custom/Layout.hs +++ b/src/XMonad/Custom/Layout.hs @@ -39,7 +39,7 @@ import XMonad.Layout.Tabbed import XMonad.Layout.WindowNavigation applySpacing :: l a -> ModifiedLayout Spacing l a -applySpacing = spacingRaw True (Border 12 12 12 12) True (Border 12 12 12 12) True +applySpacing = spacingRaw False (Border 6 6 6 6) True (Border 6 6 6 6) True data CustomTransformers = GAPS deriving (Read, Show, Eq, Typeable) @@ -51,7 +51,8 @@ layoutHook = fullscreenFloat $ lessBorders OnlyLayoutFloat $ mkToggle (single NBFULL) $ avoidStruts - $ mkToggle (single GAPS) + $ applySpacing + -- $ mkToggle (single GAPS) $ mkToggle (single REFLECTX) $ mkToggle (single REFLECTY) $ windowNavigation diff --git a/src/XMonad/Custom/Log.hs b/src/XMonad/Custom/Log.hs index e441a02..dfa60c1 100644 --- a/src/XMonad/Custom/Log.hs +++ b/src/XMonad/Custom/Log.hs @@ -39,7 +39,7 @@ topBarPP = def , ppVisible = xmobarColor white1 "" . wrap "~" "~" , ppHidden = xmobarColor white1 "" . wrap "-" "-" , ppHiddenNoWindows = xmobarColor white1 "" . wrap "_" "_" - , ppUrgent = xmobarColor red1 "" . wrap "!" "!" + , ppUrgent = xmobarColor red2 "" . wrap "!" "!" , ppSep = " / " , ppWsSep = " " , ppTitle = xmobarColor white1 "" . shorten 50 diff --git a/src/XMonad/Custom/Theme.hs b/src/XMonad/Custom/Theme.hs index d25cb55..2860b91 100644 --- a/src/XMonad/Custom/Theme.hs +++ b/src/XMonad/Custom/Theme.hs @@ -44,6 +44,7 @@ import Data.List import Graphics.X11.Xlib.Types import XMonad.Layout.Decoration import qualified XMonad.Prompt as P +import Data.Ratio font :: String font = "xft:tewi:style=Regular:size=8" -- TODO CJKのフォールバックフォントを追加する @@ -92,7 +93,7 @@ colorN = black2 colorF = white2 gapBase, gapFull :: Int -gapBase = 12 +gapBase = 6 gapFull = gapBase * 2 height, border :: Dimension @@ -123,9 +124,13 @@ promptTheme = def , P.bgHLight = black2 , P.borderColor = white2 , P.promptBorderWidth = border - , P.position = P.Bottom + , P.position = P.CenteredAt { P.xpCenterY = 3 % 10 + , P.xpWidth = 9 % 10 + } , P.height = height + , P.maxComplRows = Just 5 , P.searchPredicate = isInfixOf `on` map toLower + , P.alwaysHighlight = True } hotPromptTheme = promptTheme { P.bgColor = black2 diff --git a/src/XMonad/Util/ALSA.hs b/src/XMonad/Util/ALSA.hs deleted file mode 100644 index 0bccfd8..0000000 --- a/src/XMonad/Util/ALSA.hs +++ /dev/null @@ -1,171 +0,0 @@ -{-# LANGUAGE CPP #-} - ----------------------------------------------------------------------------- --- | --- Module : XMonad.Util.ALSA --- Copyright : (c) daniel@wagner-home.com --- License : BSD3-style (see LICENSE) --- --- Maintainer : azahi@teknik.io --- Stability : unstable --- Portability : unportable --- ----------------------------------------------------------------------------- - -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 - -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/xmobarrc/bot.hs b/xmobarrc/bot.hs index 86af565..0f92dce 100644 --- a/xmobarrc/bot.hs +++ b/xmobarrc/bot.hs @@ -1,17 +1,17 @@ -Config { font = "xft:tewi:style=Regular:pixelsize=11,Efont Biwidth:pixelsize=12,Misc Fixed Wide:size=8" +Config { font = "xft:tewi:style=Regular:pixelsize=11,Biwidth:pixelsize=12" , additionalFonts = [ "xft:Siji:style=Regular" , "xft:tewi:style=Bold:pixelsize=11" ] , bgColor = "#0b0806" , fgColor = "#a19782" , alpha = 255 - , position = Static { xpos = 0 - , ypos = 876 - , width = 1600 + , position = Static { xpos = 12 + , ypos = 864 + , width = 1576 , height = 24 } - , textOffset = 16 - , textOffsets = [16, -1] + , textOffset = 15 + , textOffsets = [15, 15] , iconOffset = -1 , lowerOnStart = True , hideOnStart = False @@ -43,7 +43,7 @@ Config { font = "xft:tewi:style=Regular:pixelsize=11,Efont Biwidth:pixelsize=12, , "--" , "-P", "\57498", "-Z", "\57499", "-S", "\57497" ] 10 - , Run Volume "default" "Master" [ "-t", " %" + , Run Volume "default" "Master" [ "-t", " %" , "--" , "--on" , "\57427" , "--off" , "\57426" diff --git a/xmobarrc/top.hs b/xmobarrc/top.hs index c502cbd..83fa5d2 100644 --- a/xmobarrc/top.hs +++ b/xmobarrc/top.hs @@ -1,17 +1,17 @@ -Config { font = "xft:tewi:style=Regular:pixelsize=11,Efont Biwidth:pixelsize=12,Misc Fixed Wide:size=8" +Config { font = "xft:tewi:style=Regular:pixelsize=11,Biwidth:pixelsize=12" , additionalFonts = [ "xft:Siji:style=Regular" , "xft:tewi:style=Bold:pixelsize=11" ] , bgColor = "#0b0806" , fgColor = "#a19782" , alpha = 255 - , position = Static { xpos = 0 - , ypos = 0 - , width = 1600 + , position = Static { xpos = 12 + , ypos = 12 + , width = 1576 , height = 24 } - , textOffset = -1 - , textOffsets = [-1, -1] + , textOffset = 15 + , textOffsets = [15, 15] , iconOffset = -1 , lowerOnStart = True , hideOnStart = False @@ -37,5 +37,5 @@ Config { font = "xft:tewi:style=Regular:pixelsize=11,Efont Biwidth:pixelsize=12, \%UUWW% %date%\ \ " } - + -- vim:filetype=haskell:expandtab:tabstop=4:shiftwidth=4 diff --git a/xmonad-ng.cabal b/xmonad-ng.cabal index 0e2292f..3c011ee 100644 --- a/xmonad-ng.cabal +++ b/xmonad-ng.cabal @@ -37,7 +37,6 @@ executable xmonad-ng hs-source-dirs: src build-depends: base >= 4.12 && < 4.13 , X11 >= 1.9 && < 1.10 - -- , alsa-mixer >= 0.3 && < 0.4 , containers >= 0.6 && < 0.7 , directory >= 1.3 && < 1.4 , filepath >= 1.4 && < 1.5 -- cgit 1.4.1