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, label, row, 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 <- getChannel chan when (midiChan == Event.ctrlChannel ctrlEv) $ set list [selection := fromIntegral (Event.unValue (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 <- getChannel chan pgm <- get list selection when (0<=pgm && pgm<128) $ sendProgram sequ c (Event.Value $ fromIntegral pgm) ] 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 (row 5 $ WX.valignCentre (label "Channel") : widget chan : []) : hfloatCentre (widget quit) : []] sendProgram :: Sequencer SndSeq.DuplexMode -> Event.Channel -> Event.Value -> IO () sendProgram h chan pgm = sendEvent h $ Event.CtrlEv Event.PgmChange $ Event.Ctrl { Event.ctrlChannel = chan, Event.ctrlParam = Event.Parameter 0, Event.ctrlValue = pgm } main :: IO () main = withSequencer "Program change" $ WX.start . makeGUI