packages feed

YampaSynth-0.0.2: src/Main/OpenAL.hs

module Main where

import MidiSynth
import qualified Codec.SoundFont as SF
import qualified Codec.Midi as Midi
import Player.OpenAL
import SynthParams

import FRP.Yampa

import Numeric
import System.IO
import System.Environment
import System.Console.GetOpt

data Flag =
    SampleRate String
  | SoundFontFile FilePath
  | MidiFile FilePath
  | Output FilePath
  deriving Show

options :: [OptDescr Flag]
options =
 [ Option ['r'] ["samplerate"] (ReqArg SampleRate "SAMPLERATE")
   "synthesizer sampling rate"
 , Option ['s'] ["soundfont"]  (ReqArg SoundFontFile "FILE")
   "SoundFont FILE"
 , Option ['m'] ["midi"]       (ReqArg MidiFile "FILE")
   "midi FILE to synthesize"
 ]

main :: IO ()
main = do
  argv <- getArgs
  (sampleRate', soundFontFile, midiFile) <-
    case getOpt Permute options argv of
      ([SampleRate srs, SoundFontFile sf, MidiFile mf], _,_) -> do
        sr <- case (readDec srs) of
          [] -> fail "SAMPLERATE must be a decimal integer number"
          (i,_) : _ -> return i
        return (sr, sf, mf)
      _ -> fail $ usageInfo "all options are mandatory\n" options

  hPutStrLn stderr "Importing MIDI File ..."
  eMidi <- Midi.importFile midiFile
  midi <- case  eMidi of
    Left err -> fail err
    Right midi -> return midi
  hPutStrLn stderr "Done."
  
  hPutStrLn stderr "Importing SoundFontFile ... This may take a while ..."
  eSoundFont <- SF.importFile soundFontFile
  soundFont <- case  eSoundFont of
    Left err -> fail err
    Right sf -> return sf
  hPutStrLn stderr "Done."
  
  hPutStrLn stderr "Now you should hear something ..."
  hPutStrLn stderr "If you are getting interruptions decrase sampling rate."
  let paramsGen = soundFontToSynthParams soundFont
      signalFunction = midiToEventSource midi >>> midiSynth paramsGen
  Player.OpenAL.play sampleRate' (256 * 1024) signalFunction
  hPutStrLn stderr "Done."