{-# 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 :: forall a p.
(AudioSample a, Clock p) =>
String -> Double -> Signal p () a -> IO ()
outFile = ([Double] -> [Double])
-> String -> Double -> Signal p () a -> IO ()
forall a p.
(AudioSample a, Clock p) =>
([Double] -> [Double])
-> String -> Double -> Signal p () a -> IO ()
outFileHelp' [Double] -> [Double]
forall a. a -> a
id

normList :: [Double] -> [Double]
normList :: [Double] -> [Double]
normList [Double]
xs = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
mx) [Double]
xs 
    where mx :: Double
mx = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
1.0 ([Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. Num a => a -> a
abs [Double]
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 :: forall a p.
(AudioSample a, Clock p) =>
String -> Double -> Signal p () a -> IO ()
outFileNorm = ([Double] -> [Double])
-> String -> Double -> Signal p () a -> IO ()
forall a p.
(AudioSample a, Clock p) =>
([Double] -> [Double])
-> String -> Double -> Signal p () a -> IO ()
outFileHelp' [Double] -> [Double]
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 :: forall a p.
(AudioSample a, Clock p) =>
([Double] -> [Double])
-> String -> Double -> Signal p () a -> IO ()
outFileHelp [Double] -> [Double]
f String
filepath Double
dur Signal p () a
sf = 
  let sr :: Double
sr          = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
      numChannels :: Int
numChannels = a -> Int
forall a. AudioSample a => a -> Int
numChans (a
forall a. HasCallStack => a
undefined :: a)
      numSamples :: Int
numSamples  = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
dur Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sr) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numChannels
      dat :: [Int32]
dat         = (Double -> Int32) -> [Double] -> [Int32]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Int32
forall a. Audible a => Double -> a
fromSample (Double -> Int32) -> (Double -> Double) -> Double -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
0.999)) 
                        ([Double] -> [Double]
f (Double -> Signal p () a -> [Double]
forall a p.
(AudioSample a, Clock p) =>
Double -> Signal p () a -> [Double]
toSamples Double
dur Signal p () a
sf)) :: [Int32]
                    -- multiply by 0.999 to avoid wraparound at 1.0

      array :: UArray Int Int32
array       = (Int, Int) -> [Int32] -> UArray Int Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
numSamplesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Int32]
dat
      aud :: Audio Int32
aud = Audio { sampleRate :: Int
sampleRate    = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
sr,
                    channelNumber :: Int
channelNumber = Int
numChannels,
                    sampleData :: UArray Int Int32
sampleData    = UArray Int Int32
array }
  in String -> Audio Int32 -> IO ()
forall a.
(IArray UArray a, Audible a, AudibleInWav a) =>
String -> Audio a -> IO ()
exportFile String
filepath Audio Int32
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' :: forall a p.
(AudioSample a, Clock p) =>
([Double] -> [Double])
-> String -> Double -> Signal p () a -> IO ()
outFileHelp' [Double] -> [Double]
f String
filepath Double
dur Signal p () a
sf = 
  let sr :: Double
sr          = p -> Double
forall p. Clock p => p -> Double
rate (p
forall a. HasCallStack => a
undefined :: p)
      numChannels :: Int
numChannels = a -> Int
forall a. AudioSample a => a -> Int
numChans (a
forall a. HasCallStack => a
undefined :: a)
      numSamples :: Int
numSamples  = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
dur Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sr) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numChannels
      dat :: [Int32]
dat         = (Double -> Int32) -> [Double] -> [Int32]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Int32
forall a. Audible a => Double -> a
fromSample (Double -> Int32) -> (Double -> Double) -> Double -> Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Double -> Double -> Double
forall a. Num a => a -> a -> a
*Double
0.999) (Double -> Double) -> (Double -> Double) -> Double -> Double
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Double
forall {a}. (Ord a, Fractional a) => a -> a
clipFix) 
                        ([Double] -> [Double]
f (Double -> Signal p () a -> [Double]
forall a p.
(AudioSample a, Clock p) =>
Double -> Signal p () a -> [Double]
toSamples Double
dur Signal p () a
sf)) :: [Int32]
      array :: UArray Int Int32
array       = (Int, Int) -> [Int32] -> UArray Int Int32
forall (a :: * -> * -> *) e i.
(IArray a e, Ix i) =>
(i, i) -> [e] -> a i e
listArray (Int
0, Int
numSamplesInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [Int32]
dat
      aud :: Audio Int32
aud = Audio { sampleRate :: Int
sampleRate    = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate Double
sr,
                    channelNumber :: Int
channelNumber = Int
numChannels,
                    sampleData :: UArray Int Int32
sampleData    = UArray Int Int32
array }
  in String -> Audio Int32 -> IO ()
forall a.
(IArray UArray a, Audible a, AudibleInWav a) =>
String -> Audio a -> IO ()
exportFile String
filepath Audio Int32
aud where
      clipFix :: a -> a
clipFix a
x = if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
1.0 then a
1.0 else if a
x a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< -a
1.0 then -a
1.0 else a
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 :: forall a p.
(AudioSample a, Clock p) =>
Double -> Signal p () a -> [Double]
toSamples Double
dur Signal p () a
sf = 
  let sr :: Double
sr          = p -> Double
forall p. Clock p => p -> Double
rate     (p
forall a. HasCallStack => a
undefined :: p)
      numChannels :: Int
numChannels = a -> Int
forall a. AudioSample a => a -> Int
numChans (a
forall a. HasCallStack => a
undefined :: a)
      numSamples :: Int
numSamples  = Double -> Int
forall b. Integral b => Double -> b
forall a b. (RealFrac a, Integral b) => a -> b
truncate (Double
dur Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
sr) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
numChannels
  in Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
numSamples ([Double] -> [Double]) -> [Double] -> [Double]
forall a b. (a -> b) -> a -> b
$ (a -> [Double]) -> [a] -> [Double]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap a -> [Double]
forall a. AudioSample a => a -> [Double]
collapse ([a] -> [Double]) -> [a] -> [Double]
forall a b. (a -> b) -> a -> b
$ SF () a -> [a]
forall a. SF () a -> [a]
unfold (SF () a -> [a]) -> SF () a -> [a]
forall a b. (a -> b) -> a -> b
$ Signal p () a -> SF () a
forall (a :: * -> * -> *) p b c. ArrowP a p b c -> a b c
strip Signal p () a
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 :: forall a p.
(AudioSample a, Clock p) =>
Double -> Signal p () a -> Double
maxSample Double
dur Signal p () a
sf = [Double] -> Double
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ((Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map Double -> Double
forall a. Num a => a -> a
abs (Double -> Signal p () a -> [Double]
forall a p.
(AudioSample a, Clock p) =>
Double -> Signal p () a -> [Double]
toSamples Double
dur Signal p () a
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 ()
  
-}