{-# 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)