module System.MIDI.Utility
( selectMidiDevice
, selectInputDevice
, selectOutputDevice
)
where
import Data.List
import Control.Monad
import Control.Concurrent
import System.IO
import System.MIDI
import System.MIDI.Base
maybeRead :: Read a => String -> Maybe a
maybeRead s = case reads s of
[(x,"")] -> Just x
_ -> Nothing
selectMidiDevice
:: MIDIHasName a
=> String
-> Maybe String
-> [a]
-> IO a
selectMidiDevice prompt mbdefault srclist = do
names <- mapM getName srclist
let nsrc = length srclist
putStrLn prompt
src <- case srclist of
[] -> do
putStrLn "no midi devices found"
fail "no midi devices found"
[x] -> do
putStrLn $ "device #1 (" ++ head names ++ ") selected."
return x
_ -> do
k <- case findIndex (==mbdefault) (map Just names) of
Just i -> return (i+1)
Nothing -> do
forM_ (zip [1..] names) $ \(i,name) -> putStrLn $ show i ++ ": " ++ name
putStr "please select a midi device: "
hFlush stdout
l <- getLine
putStrLn ""
let k = case maybeRead l of
Nothing -> nsrc
Just m -> if m<1 || m>nsrc then nsrc else m
return k
putStrLn $ "device #" ++ show k ++ " (" ++ names!!(k1) ++ ") selected."
return $ srclist!!(k1)
return src
selectInputDevice :: String -> Maybe String -> IO Source
selectInputDevice prompt mbdefault = do
srclist <- enumerateSources
src <- selectMidiDevice prompt mbdefault srclist
return src
selectOutputDevice :: String -> Maybe String -> IO Destination
selectOutputDevice prompt mbdefault = do
dstlist <- enumerateDestinations
dst <- selectMidiDevice prompt mbdefault dstlist
return dst