alsa-midi-0.4: examples/SimpleSynth.hs

module Main where

import qualified Sound.JACK as Jack
import qualified Sound.ALSA.Sequencer as Alsa
import Sound.ALSA.Sequencer (MIDIEvent)

import qualified Sound.MIDI.File  as MIDIFile
import qualified Sound.MIDI.Event as MIDIEvent

import Foreign.C.Types (CFloat)

import Data.IORef (IORef, newIORef, writeIORef, readIORef, modifyIORef)
import Control.Concurrent


main :: IO ()
main = do
    n <- newIORef Nothing
    (_client, incoming) <- Alsa.receiveMIDIEvents "SimpleSynth" "inport"
    forkIO $ writeNotes n incoming
    performNotes n

writeNotes ::
     IORef (Maybe MIDIEvent)
  -> [MIDIEvent]
  -> IO ()
writeNotes ref =
    mapM_ (\ a -> writeIORef ref $ toMaybe (Alsa.isNoteOn a) a)

-- is this important enough for inclusion in midi package?
isNoteOn :: MIDIFile.Event -> Bool
isNoteOn  = maybe False (MIDIEvent.isNoteOn  . snd) . MIDIFile.maybeMIDIEvent

isNoteOff :: MIDIFile.Event -> Bool
isNoteOff = maybe False (MIDIEvent.isNoteOff . snd) . MIDIFile.maybeMIDIEvent

toMaybe :: Bool -> a -> Maybe a
toMaybe c x = if c then Just x else Nothing

performNotes ::
  IORef (Maybe MIDIEvent) -> IO ()
performNotes ref = do
    putStrLn "performNotes..."
    phase <- newIORef 0
    Jack.mainStereo (const (synth ref phase))

synth ::
  IORef (Maybe MIDIEvent)
  -> IORef CFloat
  -> IO (CFloat, CFloat)
synth ref phase =
    readIORef ref >>=
    liftM split
       (maybe
          (return 0)
          (\n -> do
            p <- readIORef phase
            modifyIORef phase (incPhase (midi2Hz (Alsa.note n)) 44100)
            return $ sin (p * 2 * pi)))

split :: t -> (t, t)
split a = (a, a)

incPhase :: (RealFrac a) => a -> a -> a -> a
incPhase frq samplerate phase =
   snd (properFraction (phase + frq / samplerate) `asTypeOf`
            (undefined::Int,phase))

midi2Hz :: Int -> CFloat
midi2Hz mn = midiBaseFrq * semitoneFactor ^ mn

semitoneFactor :: CFloat
semitoneFactor = 2 ** (1 / 12)

midiBaseFrq :: CFloat
midiBaseFrq = 440 / semitoneFactor ^ (69::Int)