hXmixer 0.1.0.0 → 0.1.1.0
raw patch · 3 files changed
+173/−2 lines, 3 files
Files
- hXmixer.cabal +4/−2
- src/MixerForm.hs +122/−0
- src/MixerQuery.hs +47/−0
hXmixer.cabal view
@@ -1,5 +1,5 @@ name: hXmixer -version: 0.1.0.0 +version: 0.1.1.0 synopsis: A Gtk mixer application for FreeBSD description: A Gtk mixer application for FreeBSD homepage: http://colinrmitchell.endoftheinternet.org/ @@ -15,7 +15,9 @@ executable hxmixer main-is: Main.hs - -- other-modules: + other-modules: + MixerForm, + MixerQuery -- other-extensions: build-depends: base >= 4 && < 5,
+ src/MixerForm.hs view
@@ -0,0 +1,122 @@+module MixerForm where + +import Graphics.UI.Gtk +import qualified Data.Text as T + +import MixerQuery + +-- | Creates the mixer form. +createForm mixers = do + window <- windowNew + mainBox <- vBoxNew False 10 + + deviceBox <- hBoxNew True 10 + deviceDropDown <- comboBoxNewText + + windowCloseBtn <- buttonNewWithLabel "Close" + on windowCloseBtn buttonActivated $ do + mainQuit + + on deviceDropDown changed $ do + maybeMixer <- comboBoxGetActiveText deviceDropDown + case maybeMixer of + Nothing -> return () + Just mixer -> do + containerGetChildren mainBox >>= dropKnobs mainBox + channelBox <- hBoxNew False 10 + knobs <- (mixerChannels $ T.unpack mixer) >>= mapM (createKnob mixer) + mapM (\x -> boxPackStart channelBox x PackRepel 0) knobs + boxPackStart mainBox channelBox PackGrow 0 + widgetShowAll window + + mapM (comboBoxAppendText deviceDropDown . T.pack) mixers + comboBoxSetActive deviceDropDown 0 + + boxPackStart deviceBox deviceDropDown PackGrow 0 + boxPackStart deviceBox windowCloseBtn PackRepel 0 + + boxPackEnd mainBox deviceBox PackNatural 0 + + set window + [containerBorderWidth := 10, + containerChild := mainBox, + windowTitle := "hXmixer"] + + on window objectDestroy mainQuit + widgetShowAll window + +dropKnobs _ [] = return () +dropKnobs b (x:_) = containerRemove b x + +-- | Creates an individual mixer section. +createKnob mixer (name, (left, right)) = do + vbox <- vBoxNew False 5 + label <- labelNew $ Just name + + hbox <- hBoxNew True 5 + leftAdj <- adjustmentNew (fromIntegral left) 0.00 100.00 1.0 5.0 0.0 + rightAdj <- adjustmentNew (fromIntegral right) 0.00 100.00 1.0 5.0 0.0 + + leftKnob <- vScaleNew leftAdj + rightKnob <- vScaleNew rightAdj + + rangeSetInverted leftKnob True + rangeSetInverted rightKnob True + + scaleSetDigits leftKnob 0 + scaleSetDigits rightKnob 0 + + lLabel <- labelNew $ Just "L" + rLabel <- labelNew $ Just "R" + + lbox <- vBoxNew False 5 + rbox <- vBoxNew False 5 + + boxPackStart lbox lLabel PackNatural 0 + boxPackStart rbox rLabel PackNatural 0 + boxPackStart lbox leftKnob PackGrow 0 + boxPackStart rbox rightKnob PackGrow 0 + + lockCB <- checkButtonNewWithLabel "Lock" + toggleButtonSetActive lockCB $ left == right + on lockCB toggled $ do + locked <- toggleButtonGetActive lockCB + case locked of + True -> do + leftVal <- rangeGetValue leftKnob + rangeSetValue rightKnob leftVal + False -> return () + + boxPackStart hbox lbox PackGrow 0 + boxPackStart hbox rbox PackGrow 0 + + boxPackStart vbox label PackNatural 0 + boxPackStart vbox hbox PackGrow 0 + boxPackStart vbox lockCB PackNatural 0 + + on leftKnob valueChanged $ do + locked <- toggleButtonGetActive lockCB + case locked of + True -> do + leftVal <- rangeGetValue leftKnob + rangeSetValue rightKnob leftVal + setVol (T.unpack mixer) name (floor leftVal) (floor leftVal) + False -> do + leftVal <- rangeGetValue leftKnob + rightVal <- rangeGetValue rightKnob + setVol (T.unpack mixer) name (floor leftVal) (floor rightVal) + + on rightKnob valueChanged $ do + locked <- toggleButtonGetActive lockCB + case locked of + True -> do + rightVal <- rangeGetValue rightKnob + rangeSetValue leftKnob rightVal + setVol (T.unpack mixer) name (floor rightVal) (floor rightVal) + False -> do + leftVal <- rangeGetValue leftKnob + rightVal <- rangeGetValue rightKnob + setVol (T.unpack mixer) name (floor leftVal) (floor rightVal) + + return vbox +
+ src/MixerQuery.hs view
@@ -0,0 +1,47 @@+module MixerQuery +( + mixerDevices, + mixerChannels, + setVol +) where + +import Data.List (isInfixOf, sort) +import Data.List.Split (splitOn) +import System.IO (FilePath) +import System.Directory (getDirectoryContents) +import System.Process (runInteractiveCommand) +import GHC.IO.Handle (hGetContents) + +-- | Gets all available mixer devices on this system. +mixerDevices :: IO [FilePath] +mixerDevices = + getDirectoryContents "/dev" >>= return . ("Default" : ) . map ((++) "/dev/") . sort . filter (isInfixOf "mixer") + +-- | Gets the channels from a mixer device. +mixerChannels :: FilePath -> IO [(String, (Int, Int))] +mixerChannels mixer = do + (_, stdout, _, _) <- runInteractiveCommand $ command mixer + hGetContents stdout >>= return . parseMixerLines . lines + where + command "Default" = "mixer" + command mixer' = "mixer -f " ++ mixer' + +-- | Parses out the channel names and volumes from the output +-- of the mixer command. +parseMixerLines :: [String] -> [(String, (Int, Int))] +parseMixerLines lines = + [(line !! 1, parseLevels $ last line) | line <- map words $ filter (isInfixOf "Mixer ") lines] + where + parseLevels str = (\(x:y:_) -> (read x, read y)) $ splitOn ":" str + +-- | Sets the volume of a channel. +setVol :: String -> String -> Int -> Int -> IO () +setVol mixer channel left right + | mixer == "Default" + = (runInteractiveCommand + (unwords ["mixer", channel, (show left) ++ ":" ++ (show right)])) + >>= \_ -> return () + | otherwise + = (runInteractiveCommand + (unwords ["mixer", "-f", mixer, channel, (show left) ++ ":" ++ (show right)])) + >>= \_ -> return ()