Render.hs

module Main (main) where
-- module Synthesizer.LLVM.Server.Render where

import qualified Synthesizer.LLVM.Server.CausalPacked.Arrange as Arrange
import Synthesizer.LLVM.Server.CommonPacked
          (vectorSize, vectorRate, )

import qualified Synthesizer.LLVM.Server.Option as Option
import qualified Synthesizer.LLVM.Frame.Stereo as Stereo
import Synthesizer.LLVM.Server.Common

import qualified Synthesizer.CausalIO.Process as PIO
import qualified Synthesizer.PiecewiseConstant.Signal as PC

import qualified Data.StorableVector.Lazy as SVL

import qualified Data.EventList.Relative.TimeBody  as EventList
import qualified Data.EventList.Relative.TimeMixed as EventListTM

import qualified Sound.MIDI.File as MidiFile
import qualified Sound.MIDI.File.Event as FileEvent
import qualified Sound.MIDI.File.Load as Load

import qualified Sound.Sox.Write as SoxWrite
import qualified Sound.Sox.Play  as SoxPlay

import Control.Applicative ((<*>), )

import Data.Monoid (mempty, )

{-
import qualified Numeric.NonNegative.Chunky  as NonNegChunky
import qualified Numeric.NonNegative.Class   as NonNeg
-}
import qualified Numeric.NonNegative.Wrapper as NonNegW

import qualified System.Exit as Exit
import qualified System.IO as IO

import Prelude hiding (Real, id, )



strictTimeFromChunkSize :: SVL.ChunkSize -> PC.StrictTime
strictTimeFromChunkSize (SVL.ChunkSize n) =
   NonNegW.fromNumberMsg "strictTimeFromNFrames" $ fromIntegral n


{-
This is the duration of rendering after the last MIDI event.

Optimally we would stop rendering after the last sound ends.
Unfortunately with causal processes we have no way
to make the output audio stream longer than the input MIDI stream.
We might make the stream infinitely long
and add an End-Of-Stream marker in the MIDI input
that tells the 'arrange' process to stop after the last sound.
-}
padTime :: Integer
padTime = 2

render ::
   Option.T ->
   IO (MidiFile.T -> SVL.Vector (Stereo.T Real))
render opt = do
   proc <-
      case 0::Int of
         0 -> Arrange.keyboardMultiChannel $ Option.sampleDirectory opt
         _ -> Arrange.voderMaskMulti $ Option.sampleDirectory opt
   run <- PIO.runCont $ proc $ fmap fromIntegral $ Option.sampleRate opt
   return $
      SVL.fromChunks .
      run (const []) .
      chopEvents (strictTimeFromChunkSize $ Option.chunkSize opt) .
      flip EventListTM.snocTime
         (NonNegW.fromNumberMsg "render end pad" $
          case Option.sampleRate opt of
             SampleRate rate -> padTime * (fromIntegral $ div rate vectorSize)) .
--      flip EventListTM.snocTime (NonNegW.fromNumber 1) .
--      flip EventListTM.snocTime mempty .
      EventList.collectCoincident .
      EventList.mapMaybe (\ev ->
         case ev of
            FileEvent.MIDIEvent mev -> Just mev
            _ -> Nothing) .
      EventList.resample
         (vectorRate $ fmap fromIntegral $ Option.sampleRate opt) .
      (\(MidiFile.Cons typ division tracks) ->
         MidiFile.mergeTracks typ $
         map (MidiFile.secondsFromTicks division) tracks)

handleSoxExit :: IO Exit.ExitCode -> IO ()
handleSoxExit sox = do
   soxResult <- sox
   case soxResult of
      Exit.ExitSuccess -> return ()
      Exit.ExitFailure n -> do
         IO.hPutStrLn IO.stderr $
            "'sox' aborted with exit code " ++ show n
         Exit.exitFailure

main :: IO ()
main = do
   (opt, midiPath, mWavePath) <- Option.get
   case Option.sampleRate opt of
      SampleRate rate ->
         case mWavePath of
            Nothing ->
               handleSoxExit $
                  SoxPlay.simple SVL.hPut mempty rate =<<
                  (render opt <*> Load.fromFile midiPath)
            -- Rendering to SoX ends with an error code 13, but why?
            Just wavePath ->
               handleSoxExit $
                  SoxWrite.simple SVL.hPut mempty wavePath rate =<<
                  (render opt <*> Load.fromFile midiPath)
{-
            Just wavePath ->
               SVL.writeFile wavePath =<<
                  (render opt <*> Load.fromFile midiPath)
-}