-- Создан:  Ср 28 сен 2016 10:18:53
-- Изменен: Чт 29 сен 2016 13:39:54

import System.Environment
import Data.WAVE
import Data.List

nth :: [Double] -> Int -> Double
nth (x:xs) n
    | k == n     = x
    | k > n     = nth ys n
    | otherwise = nth zs $ n - k - 1
    where (ys, zs) = partition (< x) xs
          k = length ys

-- Вычисление среднего значения массива
median :: [Double] -> Double
median [] = 0
median xs | even n = (nth xs (div n 2) + nth xs (div n 2 - 1)) / 2.0
          | otherwise = nth xs (div n 2)
	where
	n = length xs

-- Деление списка на несколько по указанному разделителю
takeTo :: Ord a => a -> [a] -> [[a]]
takeTo x [] = []
takeTo x list = flat $ span (> x) list where
	flat (x, y) = [x, y]

splitBy :: Ord a => a -> [a] -> [[a]]
splitBy x xs = splitAll (takeTo x xs) where
	splitAll [] = []
	splitAll (g:list) = g : splitAll (takeTo x (rest list))
	rest ([]:_) = []
	rest ([xs]) = tail xs

-- Вычисление уровня сигнала
calcLevel :: Int -> [Double] -> Int
calcLevel fs samples = case dd of
		[] -> -52 -- Неслышимый звук
		_  -> round (median dd)
	where
		dd = [x | x <- map float2db slices, x /= 0]
		float2db []   = 0
		float2db list = 20 * logBase 10 (maximum list)
		slices = splitBy 0 $ take fs samples;

--Выбор канала из пары
channel :: [Char] -> [[Double]] -> [Double]
channel ch (xs) = map selectChannel xs where
	selectChannel (l:r:[])  | ch == "R" = r
				| ch == "L" = l
				| otherwise  = l

audioread :: Int -> WAVE -> [[Double]]
audioread samples file = do
	map (\(l:r:[]) -> [sampleToDouble l, sampleToDouble r]) (take samples $ waveSamples file)

main :: IO ()
main = do
	cmd <- getArgs
	case cmd of
	  -- Вывод сэмплов аудиофайла
	  ["-samples", samples, file, ch] -> do
			w <- getWAVEFile file
			let s = read samples :: Int
			mapM_ print $ channel ch (audioread (read samples :: Int) w)
	  -- Вывод уровня сигнала для левого и правого каналов
	  ["-level",  samples, file] -> do
			w <- getWAVEFile file
			let s = read samples :: Int
			print $ calcLevel s (channel "L" (audioread s w))
			print $ calcLevel s (channel "R" (audioread s w))
	  -- Неправильный запуск программы
	  _                   -> putStrLn "Usage: audioread [samples] [file.wav] [L/R]"