alsa-gui-0.1: src/Common.hs

module Common where

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 Graphics.UI.WX (Prop((:=)), command, on, )
import qualified Graphics.UI.WX as WX
import qualified Graphics.UI.WXCore as WXCore

import qualified Control.Concurrent.MVar as MVar
import Control.Concurrent (forkIO, )

import Control.Monad (liftM2, forever, )

import qualified System.IO as IO


data Sequencer mode =
   Sequencer (SndSeq.T mode) Port.T


sendEvent ::
   (SndSeq.AllowOutput mode) =>
   Sequencer mode -> Event.Data -> IO ()
sendEvent (Sequencer h p) ev = do
   c <- Client.getId h
   _ <-
      Event.outputDirect h $
      Event.simple (Addr.Cons c p) $ ev
   return ()


getWaitingEvents ::
   (SndSeq.AllowInput mode) =>
   Sequencer mode -> IO [Event.T]
getWaitingEvents (Sequencer h _) =
   let loop =
          AlsaExc.catch
             (liftM2 (:) (Event.input h) loop)
             (const $ return [])
   in  loop


withSequencer ::
   (SndSeq.OpenMode mode) =>
   String -> (Sequencer mode -> IO ()) -> IO ()
withSequencer name act =
   flip AlsaExc.catch
      (\e -> IO.hPutStrLn IO.stderr $ "alsa_exception: " ++ AlsaExc.show e) $ do
   SndSeq.with SndSeq.defaultName SndSeq.Block $ \h -> do
   Client.setName h name
   Port.withSimple h "inout"
      (Port.caps [Port.capRead, Port.capSubsRead,
                  Port.capWrite, Port.capSubsWrite]) Port.typeApplication $ \ port -> do
   act $ Sequencer h port



getChannel :: WX.SpinCtrl () -> IO Event.Channel
getChannel chanSpin =
   fmap (Event.Channel . fromIntegral) $
   WX.get chanSpin WX.selection


-- | cf. http://snipplr.com/view/17538/
myEventId :: Int
myEventId = WXCore.wxID_HIGHEST+100
    -- the custom event ID, avoid clash with Graphics.UI.WXCore.Types.varTopId

-- | the custom event is registered as a menu event
createMyEvent :: IO (WXCore.CommandEvent ())
createMyEvent =
   WXCore.commandEventCreate WXCore.wxEVT_COMMAND_MENU_SELECTED myEventId

registerMyEvent :: WXCore.EvtHandler a -> IO () -> IO ()
registerMyEvent win io =
   WXCore.evtHandlerOnMenuCommand win myEventId io


reactOnEvent, reactOnEventTimer ::
   SndSeq.AllowInput mode =>
   Int -> WX.Window a -> Sequencer mode ->
   (Event.T -> IO ()) ->
   IO ()
reactOnEvent _interval frame (Sequencer h _) action = do
   mvar <- MVar.newEmptyMVar

   _ <- forkIO $ forever $ do
      MVar.putMVar mvar =<< Event.input h
      WXCore.evtHandlerAddPendingEvent frame =<< createMyEvent

   registerMyEvent frame $
      MVar.takeMVar mvar >>= action

-- naive implementation using a timer, requires Non-Blocking sequencer mode
reactOnEventTimer interval frame sequ action =
   fmap (const ()) $
   WX.timer frame [
      WX.interval := interval,
      on command  := getWaitingEvents sequ >>= mapM_ action]