Добавлено определение уровня сигнала

level.hs

@@ -0,0 +1,76 @@
+-- Создан:  Ср 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]"
+