alsa-gui (empty) → 0.0
raw patch · 7 files changed
+412/−0 lines, 7 filesdep +alsa-coredep +alsa-seqdep +basesetup-changed
Dependencies added: alsa-core, alsa-seq, base, midi, midi-alsa, wx, wxcore
Files
- LICENSE +7/−0
- Setup.lhs +8/−0
- alsa-gui.cabal +68/−0
- src/Common.hs +52/−0
- src/controller.hs +106/−0
- src/mode.hs +53/−0
- src/program.hs +118/−0
+ LICENSE view
@@ -0,0 +1,7 @@+Copyright (c) 2011 Henning Thielemann++Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Setup.lhs view
@@ -0,0 +1,8 @@+#!/usr/bin/env runghc++> module Main where++> import Distribution.Simple++> main :: IO ()+> main = defaultMain
+ alsa-gui.cabal view
@@ -0,0 +1,68 @@+Name: alsa-gui+Version: 0.0+Maintainer: Henning Thielemann <alsa@henning-thielemann.de>+Author: Henning Thielemann <alsa@henning-thielemann.de>+Category: Sound, Music, GUI+License: BSD3+License-file: LICENSE+Homepage: http://www.haskell.org/haskellwiki/ALSA+Stability: Experimental+Build-Type: Simple+Cabal-Version: >= 1.8+Synopsis: Some simple interactive programs for sending MIDI control messages via ALSA+Description:+ Some simple interactive programs for sending MIDI control messages via ALSA.+ The GUI uses wxHaskell.+ Currently we provide these programs:+ .+ * Send @All Notes Off@ and @All Sounds Off@ events.+ .+ * Show several sliders, that trigger sending MIDI controller messages.+ .+ * Show a list widget, that triggers MIDI program changes.++Source-Repository head+ 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+ Hs-Source-Dirs: src+ GHC-Options: -Wall -threaded+ Build-Depends:+ wx >=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,+ alsa-core >=0.5 && <0.6,+ base >=3 && <5++Executable alsa-midi-program+ Main-Is: program.hs+ Other-Modules: Common+ Hs-Source-Dirs: src+ GHC-Options: -Wall -threaded+ Build-Depends:+ wx >=0.12.1.6 && <0.13,+ wxcore >=0.12.1.6 && <0.13,+ alsa-seq >=0.5.1 && <0.6,+ alsa-core >=0.5 && <0.6,+ base >=3 && <5++Executable alsa-midi-controller+ Main-Is: controller.hs+ Other-Modules: Common+ Hs-Source-Dirs: src+ GHC-Options: -Wall -threaded+ Build-Depends:+ wx >=0.12.1.6 && <0.13,+ wxcore >=0.12.1.6 && <0.13,+ alsa-seq >=0.5.1 && <0.6,+ alsa-core >=0.5 && <0.6,+ base >=3 && <5
+ src/Common.hs view
@@ -0,0 +1,52 @@+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 Control.Monad (liftM2, )++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.Nonblock $ \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
+ src/controller.hs view
@@ -0,0 +1,106 @@+{-+ToDo:+ - avoid busy wait on ALSA events+-}+module Main where++import Common++import qualified Sound.ALSA.Sequencer.Event as Event+import qualified Sound.ALSA.Sequencer as SndSeq++import Graphics.UI.WX+ ((.+.), Prop((:=)), set, get, selection, command, on,+ button, close, container, hfloatCentre, widget, vfill,+ layout, margin, column, row, select, spinCtrl, text, )++import qualified Graphics.UI.WX as WX+import qualified Graphics.UI.WXCore as WXCore++import Control.Monad (forM, forM_, when, )+++wxSL_INVERSE :: Int+wxSL_INVERSE = 0x1000++vslider ::+ WX.Window a -> Bool -> Int -> Int ->+ [WX.Prop (WX.Slider ())] -> IO (WX.Slider ())+vslider parentW showLabels top bottom props =+ let (minV, maxV, dirFlags) =+ if top<bottom+ then (top, bottom, 0)+ else (bottom, top, wxSL_INVERSE)+ in WX.sliderEx parentW minV maxV+ (WXCore.wxVERTICAL .+. dirFlags -- .+. wxSL_LEFT .+. wxSL_AUTOTICKS+ .+. (if showLabels then WXCore.wxSL_LABELS else 0))+ props++transferSelection ::+ (WX.Selection a, WX.Selection b) =>+ WX.Event a (IO ()) -> (Int -> IO ()) -> a -> b -> IO ()+transferSelection event action src dst =+ set src [on event :=+ get src selection >>= \i -> set dst [selection := i] >> action i]++data Slider =+ Slider (WX.Slider ()) (WX.SpinCtrl ()) (WX.SpinCtrl ()) (WX.SpinCtrl ())++updateSliders :: [Slider] -> Event.T -> IO ()+updateSliders sliders ev =+ case Event.body ev of+ Event.CtrlEv Event.Controller ctrlEv ->+ forM_ sliders $ \(Slider val sval ctrl chan) -> do+ midiChan <- get chan selection+ midiCtrl <- get ctrl selection+ when (midiChan == fromIntegral (Event.ctrlChannel ctrlEv) &&+ midiCtrl == fromIntegral (Event.ctrlParam ctrlEv)) $+ let v = fromIntegral $ Event.ctrlValue ctrlEv+ in set val [selection := v] >>+ set sval [selection := v]+ _ -> return ()++makeGUI :: Sequencer SndSeq.DuplexMode -> IO ()+makeGUI sequ = do+ f <- WX.frame [text := "MIDI Controllers"]+ p <- WX.panel f []+ sliders <- forM [7, 1, 73, 70, 71, 93, 94, 95] $ \n -> do+ val <- vslider p False 127 0 []+ sval <- spinCtrl p 0 127 []+ ctrl <- spinCtrl p 0 119 [selection := n]+ chan <- spinCtrl p 0 15 []+ let send x = do+ midiChan <- get chan selection+ midiCtrl <- get ctrl selection+ sendCtrl sequ midiChan midiCtrl x+ 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)]+ 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 :+ []+ set f [layout := container p $ margin 10 $+ column 5 [row 5 (map makeCol sliders), hfloatCentre (widget quit)]]+++sendCtrl :: Sequencer SndSeq.DuplexMode -> Int -> Int -> Int -> IO ()+sendCtrl h chan ctrl val =+ sendEvent h $+ Event.CtrlEv Event.Controller $ Event.Ctrl {+ Event.ctrlChannel = fromIntegral chan,+ Event.ctrlParam = fromIntegral ctrl,+ Event.ctrlValue = fromIntegral val+ }+++main :: IO ()+main =+ withSequencer "Slider bank" $ WX.start . makeGUI
+ src/mode.hs view
@@ -0,0 +1,53 @@+module Main where++import Common++import qualified Sound.MIDI.Message.Channel.Mode as Mode+import qualified Sound.MIDI.Message.Channel as ChannelMsg+import qualified Sound.MIDI.ALSA as MidiAlsa++import qualified Sound.ALSA.Sequencer.Event as Event+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, )++import qualified Graphics.UI.WX as WX+++makeGUI :: Sequencer SndSeq.OutputMode -> IO ()+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 []+ let getChan = fmap ChannelMsg.toChannel $ get chan selection+ set allNotesOff [+ on command := getChan >>=+ \c -> sendMode sequ c Mode.AllNotesOff+ ]+ set allSoundOff [+ on command := getChan >>=+ \c -> sendMode sequ c Mode.AllSoundOff+ ]+ quit <- 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]]+++sendMode :: Sequencer SndSeq.OutputMode -> ChannelMsg.Channel -> Mode.T -> IO ()+sendMode h chan mode = do+ sendEvent h $+ Event.CtrlEv Event.Controller $ MidiAlsa.modeEvent chan mode+++main :: IO ()+main =+ withSequencer "Mode" $ WX.start . makeGUI
+ src/program.hs view
@@ -0,0 +1,118 @@+{-+ToDo:+ - avoid busy wait on ALSA events+-}+module Main where++import Common++import qualified Sound.ALSA.Sequencer.Event as Event+import qualified Sound.ALSA.Sequencer as SndSeq++import Graphics.UI.WX+ (Prop((:=)), set, get, selection, command, on,+ button, close, container, hfloatCentre, widget, fill,+ layout, margin, column, select, spinCtrl, text, )++import qualified Graphics.UI.WX as WX++import Control.Monad (when, )+++programs :: [String]+programs =+ "FM tine" :+ "FM Fender piano" :+ "Percussive saw" :+ "Filtered saw" :+ "Bell" :+ "Noisy bell" :+ "Square" :+ "Brass" :+ "Soft string" :+ "FM string" :+ "Cosine string" :+ "Arc sine string" :+ "Arc triangle string" :+ "Arc square string" :+ "Arc saw string" :+ "Wind" :+ "Syllable to" :+ "Syllable ma" :+ "Syllable ten" :+ "Syllable sa" :+ "Syllable lat" :+ "Syllable has" :+ "Syllable kell" :+ "Syllable in" :+ "Syllable leip" :+ "Syllable zig" :+ "Syllable gra" :+ "Syllable phen" :+ "Syllable the" :+ "Syllable o" :+ "Syllable rie" :+ []+++updateSelection :: WX.SpinCtrl () -> WX.SingleListBox () -> Event.T -> IO ()+updateSelection chan list ev =+ case Event.body ev of+ Event.CtrlEv Event.PgmChange ctrlEv -> do+ midiChan <- get chan selection+ when (midiChan == fromIntegral (Event.ctrlChannel ctrlEv)) $+ set list [selection := fromIntegral (Event.ctrlValue ctrlEv)]+ _ -> return ()+++makeGUI :: Sequencer SndSeq.DuplexMode -> IO ()+makeGUI sequ = do+ f <- WX.frame [text := "MIDI Program Change"]+ p <- WX.panel f []++ {-+ order of creation matters for TAB-cycling+ if 'chan' and 'list' are swapped, then the program crashes on Quit+ It seems, that closing the application triggers a selection.+ This may access an invalidated 'chan'.+ -}+ list <- WX.singleListBox p [+ WX.items := programs+ ]+ chan <- spinCtrl p 0 15 []+ set list [+ on select := do+ c <- get chan selection+ pgm <- get list selection+ when (0<=pgm && pgm<128) $+ sendProgram sequ c pgm+ ]++ _ <-+ WX.timer f [+ WX.interval := 100,+ on command :=+ getWaitingEvents sequ >>=+ mapM_ (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)]]+++sendProgram :: Sequencer SndSeq.DuplexMode -> Int -> Int -> IO ()+sendProgram h chan pgm =+ sendEvent h $+ Event.CtrlEv Event.PgmChange $ Event.Ctrl {+ Event.ctrlChannel = fromIntegral chan,+ Event.ctrlParam = 0,+ Event.ctrlValue = fromIntegral pgm+ }+++main :: IO ()+main =+ withSequencer "Program change" $ WX.start . makeGUI