Wav.hs

module Main where

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

import FRP.Yampa

import Data.Char
import Numeric
import Control.Monad
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"
 , Option ['o'] ["output"]     (ReqArg Output "FILE")
   "output FILE (.wav file), if FILE argument ommited audio will be sent to sound card in real-time"
 ]

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

  putStrLn "Importing MIDI File ..."
  eMidi <- Midi.importFile midiFile
  midi <- case  eMidi of
    Left err -> fail err
    Right midi -> return midi
  putStrLn "Done."
  
  putStrLn "Importing SoundFontFile ... This may take a while ..."
  eSoundFont <- SF.importFile soundFontFile
  soundFont <- case  eSoundFont of
    Left err -> fail err
    Right sf -> return sf
  putStrLn "Done."
  
  putStrLn $ "Writing WAV audio data to '" ++ wavFile  ++ "' ..."
  let paramsGen = soundFontToSynthParams soundFont
      sf = midiToEventSource midi >>> midiSynth paramsGen
  Player.Wav.play wavFile sampleRate' sf
  putStrLn "Done."