alsa-gui-0.1: src/controller.hs

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, 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
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 ()) -> (Event.Value -> IO ()) -> a -> b -> IO ()
transferSelection event action src dst =
   set src [on event :=
      get src selection >>= \i -> set dst [selection := i] >> action (Event.Value $ fromIntegral i)]

getController :: WX.SpinCtrl () -> IO Event.Parameter
getController ctrlSpin =
   fmap (Event.Parameter . fromIntegral) $
   WX.get ctrlSpin WX.selection


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 <- getChannel chan
            midiCtrl <- getController ctrl
            when (midiChan == Event.ctrlChannel ctrlEv &&
                  midiCtrl == Event.ctrlParam ctrlEv) $
               let v = fromIntegral $ Event.unValue $ 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 <- getChannel chan
             midiCtrl <- getController ctrl
             sendCtrl sequ midiChan midiCtrl x
      transferSelection command send val sval
      transferSelection select send sval val
      return $ Slider val sval ctrl chan
   reactOnEvent 20 f sequ (updateSliders sliders)
   quit <- button p [text := "Quit", on command := close f]
   let makeCol (Slider val sval ctrl 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 $
             WX.column 5 [
                WX.grid 5 5 $ List.transpose $
                labels : map makeCol sliders,
                hfloatCentre (widget quit)]]


sendCtrl ::
   Sequencer SndSeq.DuplexMode ->
   Event.Channel -> Event.Parameter -> Event.Value -> IO ()
sendCtrl h chan ctrl val =
   sendEvent h $
      Event.CtrlEv Event.Controller $ Event.Ctrl {
         Event.ctrlChannel = chan,
         Event.ctrlParam = ctrl,
         Event.ctrlValue = val
      }


main :: IO ()
main =
   withSequencer "Slider bank" $ WX.start . makeGUI