packages feed

alsa-gui 0.0 → 0.0.1

raw patch · 5 files changed

+87/−50 lines, 5 files

Files

alsa-gui.cabal view
@@ -1,5 +1,5 @@ Name:          alsa-gui-Version:       0.0+Version:       0.0.1 Maintainer:    Henning Thielemann <alsa@henning-thielemann.de> Author:        Henning Thielemann <alsa@henning-thielemann.de> Category:      Sound, Music, GUI@@ -25,11 +25,6 @@   type:     darcs   location: http://code.haskell.org/alsa/gui/ -Source-Repository this-  type:     darcs-  location: http://code.haskell.org/alsa/gui/-  tag:      0.0- Executable alsa-midi-mode   Main-Is: mode.hs   Other-Modules: Common@@ -37,6 +32,7 @@   GHC-Options: -Wall -threaded   Build-Depends:     wx >=0.12.1.6 && <0.13,+    wxcore >=0.12.1.6 && <0.13,     midi-alsa >=0.1.1 && <0.2,     midi >=0.1.6 && <0.2,     alsa-seq >=0.5.1 && <0.6,
src/Common.hs view
@@ -7,8 +7,15 @@ import qualified Sound.ALSA.Sequencer as SndSeq import qualified Sound.ALSA.Exception as AlsaExc -import Control.Monad (liftM2, )+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  @@ -44,9 +51,46 @@ withSequencer name act =    flip AlsaExc.catch       (\e -> IO.hPutStrLn IO.stderr $ "alsa_exception: " ++ AlsaExc.show e) $ do-   SndSeq.with SndSeq.defaultName SndSeq.Nonblock $ \h -> 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+++-- | cf. http://snipplr.com/view/17538/+myEventId :: Int+myEventId = WXCore.wxID_HIGHEST+1 -- the custom event ID++-- | 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]
src/controller.hs view
@@ -1,7 +1,3 @@-{--ToDo:- - avoid busy wait on ALSA events--} module Main where  import Common@@ -12,12 +8,13 @@ import Graphics.UI.WX    ((.+.), Prop((:=)), set, get, selection, command, on,     button, close, container, hfloatCentre, widget, vfill,-    layout, margin, column, row, select, spinCtrl, text, )+    layout, margin, select, spinCtrl, text, label, )  import qualified Graphics.UI.WX as WX import qualified Graphics.UI.WXCore as WXCore  import Control.Monad (forM, forM_, when, )+import qualified Data.List as List   wxSL_INVERSE :: Int@@ -76,19 +73,26 @@       transferSelection command send val sval       transferSelection select send sval val       return $ Slider val sval ctrl chan-   _ <- WX.timer f [-           WX.interval := 20,-           on command  := getWaitingEvents sequ >>= mapM_ (updateSliders sliders)]+   reactOnEvent 20 f sequ (updateSliders sliders)    quit <- button p [text := "Quit", on command := close f]    let makeCol (Slider val sval ctrl chan) =-          column 5 $-             vfill (widget val) :-             widget sval :-             widget ctrl :-             widget chan :-             []+          vfill (widget val) :+          widget sval :+          widget ctrl :+          widget chan :+          []+       labels =+          map WX.valignCentre $+          WX.vglue :+          label "Value" :+          label "Controller" :+          label "Channel" :+          []    set f [layout := container p $ margin 10 $-             column 5 [row 5 (map makeCol sliders), hfloatCentre (widget quit)]]+             WX.column 5 [+                WX.grid 5 5 $ List.transpose $+                labels : map makeCol sliders,+                hfloatCentre (widget quit)]]   sendCtrl :: Sequencer SndSeq.DuplexMode -> Int -> Int -> Int -> IO ()
src/mode.hs view
@@ -10,9 +10,9 @@ import qualified Sound.ALSA.Sequencer as SndSeq  import Graphics.UI.WX-   (Prop((:=)), set, get, selection, command, on,-    button, close, container, hfloatCentre, widget,-    layout, margin, column, spinCtrl, text, )+   (Prop((:=)), set, get, text, selection, command, on,+    close, container, widget,+    layout, margin, label, row, column, )  import qualified Graphics.UI.WX as WX @@ -21,9 +21,9 @@ makeGUI sequ = do    f <- WX.frame [text := "MIDI Mode"]    p <- WX.panel f []-   allNotesOff <- button p [text := "All Notes Off"]-   allSoundOff <- button p [text := "All Sound Off"]-   chan <- spinCtrl p 0 15 []+   allNotesOff <- WX.button p [text := "All Notes Off"]+   allSoundOff <- WX.button p [text := "All Sound Off"]+   chan <- WX.spinCtrl p 0 15 []    let getChan = fmap ChannelMsg.toChannel $ get chan selection    set allNotesOff [       on command := getChan >>=@@ -33,13 +33,14 @@       on command := getChan >>=          \c -> sendMode sequ c Mode.AllSoundOff       ]-   quit <- button p [text := "Quit", on command := close f]+   quit <- WX.button p [text := "Quit", on command := close f]    set f [layout := container p $ margin 10 $-             column 5 $ map hfloatCentre [-                widget allNotesOff,-                widget allSoundOff,-                widget chan,-                widget quit]]+             column 5 $+                WX.hfill (widget allNotesOff) :+                WX.hfill (widget allSoundOff) :+                (row 5 $ WX.valignCentre (label "Channel") : widget chan : []) :+                WX.hfill (widget quit) :+                []]   sendMode :: Sequencer SndSeq.OutputMode -> ChannelMsg.Channel -> Mode.T -> IO ()
src/program.hs view
@@ -1,7 +1,3 @@-{--ToDo:- - avoid busy wait on ALSA events--} module Main where  import Common@@ -12,7 +8,7 @@ import Graphics.UI.WX    (Prop((:=)), set, get, selection, command, on,     button, close, container, hfloatCentre, widget, fill,-    layout, margin, column, select, spinCtrl, text, )+    layout, margin, label, row, column, select, spinCtrl, text, )  import qualified Graphics.UI.WX as WX @@ -88,19 +84,15 @@             sendProgram sequ c pgm     ] -   _ <--      WX.timer f [-         WX.interval := 100,-         on command  :=-            getWaitingEvents sequ >>=-            mapM_ (updateSelection chan list)-      ]+   reactOnEvent 100 f sequ (updateSelection chan list)     quit <- button p [text := "Quit", on command := close f]    set f [layout := container p $ margin 10 $-             column 5 [fill (widget list),-                       hfloatCentre (widget chan),-                       hfloatCentre (widget quit)]]+             column 5 $+                fill (widget list) :+                hfloatCentre (row 5 $ WX.valignCentre (label "Channel") : widget chan : []) :+                hfloatCentre (widget quit) :+                []]   sendProgram :: Sequencer SndSeq.DuplexMode -> Int -> Int -> IO ()