alsa-gui-0.0: src/program.hs

{-
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