-- | Decoder for audio data.
module Sound.File.Decode ( decode
                         , deinterleave ) where

import Data.Int
import qualified Data.ByteString.Lazy as B
import Sound.OpenSoundControl.Coding.Byte
import Sound.File.Encoding

setsOf :: Int -> [a] -> [[a]]
setsOf _ [] = []
setsOf n l =
    let (x, y) = splitAt n l
    in x : setsOf n y

channel :: [[a]] -> Int -> [a]
channel l n = map (!!n) l

-- | Given channel count, deinterleave list to set of channels.
--
-- > deinterleave 2 [0..9] == [[0,2,4,6,8],[1,3,5,7,9]]
deinterleave :: Int -> [a] -> [[a]]
deinterleave n l = map (channel (setsOf n l)) [0..n-1]

bSetsOf :: Int64 -> B.ByteString -> [B.ByteString]
bSetsOf _ b | B.null b = []
bSetsOf n b | otherwise =
                let (x, y) = B.splitAt n b
                in x : bSetsOf n y

decodef32 :: Int -> B.ByteString -> [[Double]]
decodef32 n = deinterleave n . map decode_f32 . bSetsOf 4

decodei16 :: Int -> B.ByteString -> [[Int]]
decodei16 n = deinterleave n . map decode_i16 . bSetsOf 2

decodei8 :: Int -> B.ByteString -> [[Int]]
decodei8 n = deinterleave n . map decode_i8 . bSetsOf 1

i8_f :: [Int] -> [Double]
i8_f = map ((/ 128.0) . fromIntegral)

i16_f :: [Int] -> [Double]
i16_f = map ((/ 32768.0) . fromIntegral)

-- | Given an 'Encoding' and the number of channels, decode
-- a 'B.ByteString' to set of 'deinterleave'd channels.
decode :: Encoding -> Int -> B.ByteString -> [[Double]]
decode enc nc b =
    case enc of
      Linear8 -> map i8_f (decodei8 nc b)
      Linear16 -> map i16_f (decodei16 nc b)
      Float -> decodef32 nc b
      _ -> undefined