content: {-# LANGUAGE BangPatterns, ExistentialQuantification, 
      ScopedTypeVariables, FlexibleContexts #-}
  
  module Euterpea.IO.Audio.IO (
      outFile,  outFileNorm, 
  --    outFileA, outFileNormA, RecordStatus, 
      maxSample) where
  
  import Control.Arrow.ArrowP
  import Control.SF.SF
  import Euterpea.IO.Audio.Types hiding (Signal)
  
  import Codec.Wav
  import Data.Audio
  import Data.Array.Unboxed
  import Data.Int
  
  --import Data.IORef
  --import Foreign.C
  --import Foreign.Marshal.Array
  --import Foreign.Marshal.Utils
  --import Foreign.Ptr
  --import Foreign.Storable
  --import Control.CCA.Types
  --import Control.Arrow
  --import Control.Concurrent.MonadIO
  --import Sound.RtAudio
  
  type Signal clk a b = ArrowP SF clk a b
  
  -- | Writes sound to a wave file (.wav)
  outFile :: forall a p. (AudioSample a, Clock p) => 
             String              -- ^ Filename to write to.
          -> Double              -- ^ Duration of the wav in seconds.
          -> Signal p () a       -- ^ Signal representing the sound.
          -> IO ()
  outFile = outFileHelp' id
  
  normList :: [Double] -> [Double]
  normList xs = map (/ mx) xs 
      where mx = max 1.0 (maximum (map abs xs))
  
  -- | Like outFile, but normalizes the output if the amplitude of 
  -- the signal goes above 1.  If the maximum sample is less than
  -- or equal to 1, the output is not normalized.
  -- Currently this requires storing the entire output stream in memory
  -- before writing to the file.
  outFileNorm :: forall a p. (AudioSample a, Clock p) => 
              String              -- ^ Filename to write to.
           -> Double              -- ^ Duration of the wav in seconds.
           -> Signal p () a       -- ^ Signal representing the sound.
           -> IO ()
  outFileNorm = outFileHelp' normList
  
  outFileHelp :: forall a p. (AudioSample a, Clock p) => 
              ([Double] -> [Double]) -- ^ Post-processing function.
           -> String              -- ^ Filename to write to.
           -> Double              -- ^ Duration of the wav in seconds.
           -> Signal p () a       -- ^ Signal representing the sound.
           -> IO ()
  outFileHelp f filepath dur sf = 
    let sr          = rate (undefined :: p)
        numChannels = numChans (undefined :: a)
        numSamples  = truncate (dur * sr) * numChannels
        dat         = map (fromSample . (*0.999)) 
                          (f (toSamples dur sf)) :: [Int32]
                      -- multiply by 0.999 to avoid wraparound at 1.0
        array       = listArray (0, numSamples-1) dat
        aud = Audio { sampleRate    = truncate sr,
                      channelNumber = numChannels,
                      sampleData    = array }
    in exportFile filepath aud
    
  {-
  Alternative definition of the above that enforces a clipping behavior when 
  the value exceeds the [-1.0, 1.0] range. The overflow behavior makes it 
  very hard to debug sound modeling problems that involve certain waveforms, 
  such as saw waves. Clipping is also a more common behavior in other audio 
  software rather than overflowing or wrap-around.
  -}
    
  outFileHelp' :: forall a p. (AudioSample a, Clock p) => 
              ([Double] -> [Double]) -- ^ Post-processing function.
           -> String              -- ^ Filename to write to.
           -> Double              -- ^ Duration of the wav in seconds.
           -> Signal p () a       -- ^ Signal representing the sound.
           -> IO ()
  outFileHelp' f filepath dur sf = 
    let sr          = rate (undefined :: p)
        numChannels = numChans (undefined :: a)
        numSamples  = truncate (dur * sr) * numChannels
        dat         = map (fromSample . (*0.999) . clipFix) 
                          (f (toSamples dur sf)) :: [Int32]
        array       = listArray (0, numSamples-1) dat
        aud = Audio { sampleRate    = truncate sr,
                      channelNumber = numChannels,
                      sampleData    = array }
    in exportFile filepath aud where
        clipFix x = if x > 1.0 then 1.0 else if x < -1.0 then -1.0 else x
  
  
  {-
  data RecordStatus = Pause | Record | Clear | Write
  
  outFileA :: forall a. AudioSample a => 
              String               -- ^ Filename to write to.
           -> Double               -- ^ Sample rate of the incoming signal.
           -> UISF (a, RecordStatus) ()
  outFileA = outFileHelpA id
  
  outFileNormA :: forall a. AudioSample a => 
                  String               -- ^ Filename to write to.
               -> Double               -- ^ Sample rate of the incoming signal.
               -> UISF (a, RecordStatus) ()
  outFileNormA = outFileHelpA normList
  
  outFileHelpA :: forall a. AudioSample a => 
               ([Double] -> [Double]) -- ^ Post-processing function.
            -> String                 -- ^ Filename to write to.
            -> Double                 -- ^ Sample rate of the incoming signal.
            -> UISF (a, RecordStatus) ()
  outFileHelpA f filepath sr = 
    let numChannels = numChans (undefined :: a)
        writeWavSink = sink (writeWav f filepath sr numChannels)
    in proc (a, rs) -> do
          rec dat <- delay [] -< dat'
              dat' <- case rs of
                          Pause  -> returnA -< dat
                          Record -> returnA -< a:dat
                          Clear  -> returnA -< []
                          Write  -> do writeWavSink -< dat
                                       returnA -< a:dat
          returnA -< ()
  -}
  {-
  writeWav :: AudioSample a => ([Double] -> [Double]) -> String -> Double -> Int -> [a] -> UI ()
  writeWav f filepath sr numChannels adat = 
    let dat         = map (fromSample . (*0.999)) 
                          (f (concatMap collapse adat)) :: [Int32]
                      -- multiply by 0.999 to avoid wraparound at 1.0
        array       = listArray (0, (length dat)-1) dat
        aud = Audio { sampleRate    = truncate sr,
                      channelNumber = numChannels,
                      sampleData    = array }
    in liftIO $ exportFile filepath aud
  -}
  
  
    
  
  toSamples :: forall a p. (AudioSample a, Clock p) =>
               Double -> Signal p () a -> [Double]
  toSamples dur sf = 
    let sr          = rate     (undefined :: p)
        numChannels = numChans (undefined :: a)
        numSamples  = truncate (dur * sr) * numChannels
    in take numSamples $ concatMap collapse $ unfold $ strip sf
  
  -- | Compute the maximum sample of an SF in the first 'dur' seconds.
  maxSample :: forall a p. (AudioSample a, Clock p) =>
               Double -> Signal p () a -> Double
  maxSample dur sf = maximum (map abs (toSamples dur sf))
  
  
  {-
  chunk !nFrames !(i, f) ref buf = nFrames `seq` i `seq` f `seq` aux nFrames i 
      where aux !n !i = x `seq` i `seq` i' `seq`
                         if n == 0 then do
                                    writeIORef ref i
                                    return ()
                         else do
                          pokeElemOff buf (fromIntegral nFrames-n) (realToFrac x)
                          aux (n-1) i'
                where (x, i') = f ((), i)
  {-# INLINE [0] chunk #-}
  
  chunkify !i !f !secs = do
    --userData <- new i
    ref <- newIORef i
    let cb :: RtAudioCallback 
        cb oBuf iBuf nFrames nSecs status userData = do
                        
                        lastState <- readIORef ref
                        -- Fill output buffer with nFrames of samples
                        chunk (fromIntegral nFrames) (lastState,f) ref oBuf
                        if secs < (realToFrac nSecs) then return 2 else return 0
                                
                                                            
    mkAudioCallback cb                                 
  
  
  
  playPure :: Show b => Double -> (b, ((), b) -> (Double, b)) -> IO ()
  playPure !secs !(i, f) = do
    rtaCloseStream
    rtaInitialize
    dev <- rtaGetDefaultOutputDevice
    callback <- chunkify i f secs
    with (StreamParameters dev 1 0) (\params -> do
           rtaOpenStream params nullPtr float64 44100 4096 callback nullPtr nullPtr)
    rtaStartStream
    return ()
    
  -}
  