v0.1

level.hs

@@ -1,40 +1,17 @@
 -- Создан:  Ср 28 сен 2016 10:18:53
--- Изменен: Чт 29 сен 2016 15:28:50
+-- Изменен: Чт 29 сен 2016 18:50:35
 
+import System.Console.CmdArgs.Explicit
 import System.Environment
+import System.Directory
 import Data.WAVE
 import Data.List
+import Data.List.Split
 
 -- =============================================================================
 
-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
+-- Среднее значение списка
+median l = let (t,n) = foldl' (\(b,c) a -> (a+b,c+1)) (0,0) l in t/n
 
 -- =============================================================================
 
@@ -51,48 +28,59 @@ channel ch (xs) = map selectChannel xs where
 				| otherwise  = l
 
 -- Вычисление уровня сигнала
-calcLevel :: Int -> [Double] -> Int
+-- calcLevel :: Int -> [Double] -> Int
 calcLevel fs samples = case dd of
 		[] -> -52 -- Неслышимый звук
 		_  -> round (median dd)
 	where
-		dd = [x | x <- map float2db slices, x /= 0]
+		dd = [x | x <- map float2db slices, not (isNaN x), x /= 0]
 		float2db []   = 0
 		float2db list = 20 * logBase 10 (maximum list)
-		slices = splitBy 0 $ take fs samples;
+		slices = splitWhen (== 0) $ take fs samples;
 
 -- Вычисление значения фазы
-calcPhase samples = median (map ph (zip3 samples (drop 1 samples) (drop 2 samples))) where
+calcPhase samples = 2 * median (map ph (zip3 samples (drop 1 samples) (drop 2 samples))) - 1 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
+	ph ([l1,r1], _, _)              | (l1 == 0 && r1 /= 0) || ((r1 == 0) && (l1 /= 0)) = 0
 					| otherwise =
 						if (abs l1) >= (abs r1) then
 							2 * (l1 + r1) / (2 * l1) - 1
 						else
 							2 * (l1 + r1) / (2 * r1) - 1
 
+-- =============================================================================
+
+-- Справка по использованию
+usage bin = mapM_ putStrLn [
+	"Использование: " ++ bin ++ " [функция] file.wav [параметры]"
+	"Функции:",
+	"          -samples N file.wav CH     - вывод Ν сэмплов канала CH (L или R)",
+	"          -level   N file.wav        - расчёт уровня сигнала по N сэмплам",
+	"          -phase   N file.wav        - расчёт значения фазы по N сэмплам"]
+
 main :: IO ()
 main = do
+	bin <- getProgName
 	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]"
+	if (cmd /= [] && isInfixOf ".wav" (cmd!!2)) then do
+		w <- getWAVEFile (cmd!!2)
+		let s = read (cmd!!1) :: Int
+		case cmd of
+			-- Вывод сэмплов аудиофайла
+			["-samples", samples, file, ch] ->
+				mapM_ print $ channel ch (take s (audioread w))
+			-- Вывод уровня сигнала для левого и правого каналов
+			["-level",  samples, file] -> do
+				print $ calcLevel s (channel "L" (take s (audioread w)))
+				print $ calcLevel s (channel "R" (take s (audioread w)))
+			-- Вывод значения фазы
+			["-phase", samples, file] -> 
+				print $ calcPhase (take s (audioread w))
+			-- Справка по использованию
+			_ ->
+				usage bin
+	else
+		usage bin