alsa-seq-0.5.1: examples/send-note.hs

import qualified Sound.ALSA.Sequencer.Address as Addr
import qualified Sound.ALSA.Sequencer.Client as Client
import qualified Sound.ALSA.Sequencer.Port as Port
import qualified Sound.ALSA.Sequencer.Event as Event
import qualified Sound.ALSA.Sequencer as SndSeq
import qualified Sound.ALSA.Exception as AlsaExc

import qualified System.Exit as Exit
import qualified System.IO as IO
import System.Environment (getArgs, )

parseAndConnect ::
   (SndSeq.AllowOutput mode) =>
   SndSeq.T mode -> Port.T -> String -> IO Addr.T
parseAndConnect h p destStr = do
  dest <- Addr.parse h destStr
  SndSeq.connectTo h p dest
  return dest

main :: IO ()
main = (do
  putStrLn "Starting."
  SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do
  Client.setName (h :: SndSeq.T SndSeq.OutputMode) "Haskell-Send-Note"
  c <- Client.getId h
  putStrLn ("Created sequencer with id: " ++ show c)
  Port.withSimple h "out"
     (Port.caps [Port.capRead, Port.capSubsRead]) Port.typeMidiGeneric $ \ p -> do
  putStrLn "Created port."
  args <- getArgs
  dest <-
     case args of
        [] -> do
           putStrLn "Enter destination or connect to a synthesizer and hit ENTER"
           destStr <- getLine
           if null destStr
             then return Addr.subscribers
             else parseAndConnect h p destStr
        [destStr] ->
           parseAndConnect h p destStr
        _ ->
           IO.hPutStrLn IO.stderr "too many arguments"
           >>
           Exit.exitFailure

  let ev n =
         (Event.simple (Addr.Cons c p) $
            Event.NoteEv n $ Event.simpleNote 0 60 64)
         {Event.dest = dest}
  _ <- Event.outputDirect h $ ev Event.NoteOn
  putStrLn "press Enter for stopping the note"
  _ <- getChar
  _ <- Event.outputDirect h $ ev Event.NoteOff
  return ())
  `AlsaExc.catch` \e ->
     putStrLn $ "alsa_exception: " ++ AlsaExc.show e