wav-info/level.hs

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

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

-- =============================================================================

-- Чтение данных аудиофайла
audioread :: WAVE -> [[Double]]
audioread file = map samplesToDouble (waveSamples file)
	where samplesToDouble (l:r:[]) = [sampleToDouble l, sampleToDouble r]

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

-- Вычисление уровня сигнала
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;

-- Вычисление значения фазы
calcPhase samples = median (map ph (zip3 samples (drop 1 samples) (drop 2 samples))) where
	ph ([0,0], [l2,r2], [l3,r3])    | (signum l2 /= signum r2) && (signum l3 /= signum r3) = 0
					| otherwise = 1

	ph ([l1,r1], _, _)              | (l1 == 0 && r1 /= 0) || ((r1 == 0) && (l1 /= 0)) = -1
					| otherwise =
						if (abs l1) >= (abs r1) then
							2 * (l1 + r1) / (2 * l1) - 1
						else
							2 * (l1 + r1) / (2 * r1) - 1

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 (take s (audioread w))
	  -- Вывод уровня сигнала для левого и правого каналов
	  ["-level",  samples, file] -> do
			w <- getWAVEFile file
			let s = read samples :: Int
			print $ calcLevel s (channel "L" (take s (audioread w)))
			print $ calcLevel s (channel "R" (take s (audioread w)))
	  -- Вывод сэмплов аудиофайла
	  ["-phase", samples, file] -> do
			w <- getWAVEFile file
			let s = read samples :: Int
			print $ calcPhase (take s (audioread w))
	  -- Неправильный запуск программы
	  _                   -> putStrLn "Usage: audioread [samples] [file.wav] [L/R]"