supercollider-midi-0.2: src/Sound/SC3/MIDI/Wind.hs

module Main where
-- module Sound.SC3.MIDI.Wind where

import Sound.SC3.MIDI.Utility (withEvents, startMessage, )

import Sound.SC3 as SC3
import Sound.SC3.UGen.Noise.ID as Noise

import qualified Sound.MIDI.ALSA as MALSA
import qualified Sound.MIDI.Message.Channel.Voice as VoiceMsg

import qualified Sound.ALSA.Sequencer.Event as Event

import Data.Accessor.Basic ((^.), )

import Data.Maybe (fromMaybe, )


sound :: UGen
sound =
   let noise =
          delayN (0.1 * rlpf
             (Noise.whiteNoise (0::Int) AR * control KR "Volume" 1)
             (control KR "Frequency" 400)
             (control KR "Resonance" 0.005))
                 0 (MCE [0, control KR "Phase" 0])
   in  out 0 (noise + 0.5 * combN noise 0.5 0.5 2)

controlChange :: String -> (Double -> Double) -> Int -> IO ()
controlChange ctrlName f value =
   let cValue = f (fromIntegral value / 127)
   in  print (ctrlName, cValue) >>
       withSC3 (\fd -> send fd (n_set (-1)
           [(ctrlName, cValue)]))


main :: IO ()
main = do
   withSC3 reset
   audition sound

   putStrLn "turn the wheels ..."
   withEvents "Haskell-Wind" "in-0" $ \ evs -> do
      putStr startMessage
      flip mapM_ (map Event.body evs) $ \ev -> case ev of
         Event.CtrlEv Event.Controller param ->
            case param ^. MALSA.ctrlControllerMode of
               MALSA.Controller ctrl value ->
                  fromMaybe (return ()) $
                  lookup ctrl $
                  (VoiceMsg.mainVolume,
                      controlChange "Volume" id value) :
                  (VoiceMsg.footControl,
                      controlChange "Frequency" (\x -> 200 * 4 ** x) value) :
                  (VoiceMsg.breathControl,
                      controlChange "Resonance" (\x -> 1 / 1000 ** x) value) :
                  (VoiceMsg.modulation,
                      controlChange "Phase" (0.002*) value) :
                  []
               _ -> return ()
         Event.CtrlEv Event.PitchBend param ->
            controlChange "Frequency"
               (\x -> 400 * 2 ** (x / 64)) (param ^. MALSA.ctrlValue)
         _ -> return ()