{-# LANGUAGE Arrows, ScopedTypeVariables, NamedFieldPuns, FlexibleContexts #-}



-- Render a Music object to a audio signal function that can be further

-- manipulated or saved to a file.  It is channel-agnostic in that it is

-- able to deal with instruments of arbitrary number of channels.



module Euterpea.IO.Audio.Render (

  Instr, InstrMap, renderSF, 

) where



import Control.Arrow

import Control.Arrow.Operations

import Control.Arrow.ArrowP

import Control.SF.SF



import Euterpea.Music

import Euterpea.IO.MIDI.MEvent

import Euterpea.IO.Audio.Basics

import Euterpea.IO.Audio.Types



import Data.List

import qualified Data.IntMap as M

import Data.Ord (comparing)



-- Every instrument is a function that takes a duration, absolute

-- pitch, volume, and a list of parameters (Doubles).  What the function 

-- actually returns is implementation independent.

type Instr a = Dur -> AbsPitch -> Volume -> [Double] -> a



type InstrMap a = [(InstrumentName, Instr a)]



lookupInstr :: InstrumentName -> InstrMap a -> Instr a

lookupInstr ins im =

    case lookup ins im of

      Just i -> i

      Nothing -> error $ "Instrument " ++ show ins ++ 

                 " does not have a matching Instr in the supplied InstrMap."



-- Each note in a Performance is tagged with a unique NoteId, which

-- helps us keep track of the signal function associated with a note.

type NoteId = Int



-- In this particular implementation, 'a' is the signal function that

-- plays the given note.

data NoteEvt a = NoteOn  NoteId a

               | NoteOff NoteId



type Evt a = (Double, NoteEvt a) -- Timestamp in seconds, and the note event





-- Turn an Event into a NoteOn and a matching NoteOff with the same NodeId.  

eventToEvtPair :: InstrMap a -> MEvent -> Int -> [Evt a]

eventToEvtPair imap (MEvent {eTime, eInst, ePitch, eDur, eVol, eParams}) nid =

    let instr = lookupInstr eInst imap

        tOn   = fromRational eTime

        tDur  = fromRational eDur :: Double

        sf    = instr eDur ePitch eVol eParams

    in [(tOn, NoteOn nid sf), (tOn + tDur, NoteOff nid)]



-- Turn a Performance into an SF of NoteOn/NoteOffs.  

-- For each note, generate a unique id to tag the NoteOn and NoteOffs.

-- The tag is used as the key to the collection of signal functions

-- for efficient insertion/removal.

toEvtSF :: Clock p => [MEvent] -> InstrMap a -> Signal p () [Evt a]

toEvtSF pf imap = 

    let evts = sortBy (comparing fst) $ concat $ 

                 zipWith (eventToEvtPair imap) pf [0..]

          -- Sort all NoteOn/NoteOff events by timestamp.

    in proc _ -> do

         rec

           t <- integral -< 1

           es <- delay evts -< next

           let (evs, next) = span ((<= t) . fst) es

             -- Trim events that are due off the list and output them,

             -- retaining the rest

         outA -< evs



-- Modify the collection upon receiving NoteEvts.  The timestamps 

-- are not used here, but they are expected to be the same.



modSF :: M.IntMap a -> [Evt a] -> M.IntMap a

modSF = foldl' mod

    where mod m (_, NoteOn nid sf)  = M.insert nid sf m

          mod m (_, NoteOff nid)    = M.delete nid m





-- Simplified version of a parallel switcher.  

-- Note that this is tied to the particular implementation of SF, as it

-- needs to use runSF to run all the signal functions in the collection.



pSwitch :: forall p col a. (Clock p, Functor col) =>

           col (Signal p () a)  -- Initial SF collection.

        -> Signal p () [Evt (Signal p () a)]    -- Input event stream.

        -> (col (Signal p () a) -> [Evt (Signal p () a)] -> col (Signal p () a))

           -- A Modifying function that modifies the collection of SF

           --   based on the event that is occuring.

        -> Signal p () (col a)  

           -- The resulting collection of output values obtained from

           --   running all SFs in the collection.



pSwitch col esig mod = 

    proc _ -> do

      evts <- esig -< ()

      rec

        -- perhaps this can be run at a lower rate using upsample

        sfcol <- delay col -< mod sfcol' evts  

        let rs = fmap (\s -> runSF (strip s) ()) sfcol :: col (a, SF () a)

            (as, sfcol' :: col (Signal p () a)) = (fmap fst rs, fmap (ArrowP . snd) rs)

      outA -< as





renderSF :: (Clock p, ToMusic1 a, AudioSample b) => 

            Music a 

         -> InstrMap (Signal p () b) 

         -> (Double, Signal p () b)

            -- ^ Duration of the music in seconds, 

            -- and a signal function that plays the music.



renderSF m im = 

    let (pf, d) = perform1Dur $ toMusic1 m -- Updated 16-Dec-2015 

        evtsf = toEvtSF pf im

        allsf = pSwitch M.empty evtsf modSF

        sf = allsf >>> arr (foldl' mix zero . M.elems)  -- add up all samples

    in (fromRational d, sf)