diff --git a/level.hs b/level.hs index cca792e..ddb7d77 100644 --- a/level.hs +++ b/level.hs @@ -1,16 +1,17 @@ {-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} -- Создан: Ср 28 сен 2016 10:18:53 --- Изменен: Пт 14 окт 2016 12:07:33 +-- Изменен: Пт 14 окт 2016 17:53:23 import System.Console.CmdArgs import System.Environment import System.Directory -import Control.Monad +import System.Exit import Data.WAVE import Data.Char import Data.List import Data.List.Split +import Control.Monad -- ============================================================================= @@ -20,7 +21,7 @@ median l = let (t,n) = foldl' (\(b,c) a -> (a+b,c+1)) (0,0) l in t/n -- everyN :: Int -> [Double] -> [[Double]] -everyN n list = [take (n + n) $ drop (x-1) list | x <- [1, n..length list]] +everyN n list = [(n+n) ## drop (x-1) list | x <- [1, n..length list]] -- Перевод между типами convert :: (Show a, Read c) => a -> c @@ -30,16 +31,26 @@ convert = read . show notEmpty :: String -> Bool notEmpty = (/=) (show "") +-- Проверка на действительное ненулевое значение +notZero :: RealFloat a => a -> Bool +notZero x = (not $ isNaN x) && (x /= 0) + +-- Синтаксический сахар +(<@) = map -- a <@ b = map a b +(<#) = filter -- a <# b = filter a b +(##) = take -- n##b = take n b +(//) = drop -- n//b = drop n b + -- ============================================================================= -- Чтение данных аудиофайла audioread :: WAVE -> [[Double]] -audioread file = map samplesToDouble (waveSamples file) +audioread = map samplesToDouble . waveSamples where samplesToDouble (l:r:[]) = [sampleToDouble l, sampleToDouble r] --Выбор канала из пары getChannel :: [Char] -> [[Double]] -> [Double] -getChannel ch (xs) = map selectChannel xs where +getChannel ch = map selectChannel where selectChannel (l:r:[]) | ch == "R" = r | ch == "L" = l | otherwise = l @@ -47,17 +58,17 @@ getChannel ch (xs) = map selectChannel xs where -- k десятичных логарифмов float2db :: (RealFloat a, Integral b) => b -> a -> a float2db k x - | isNaN x = 0 - | otherwise = fromIntegral k * (logBase 10 x) + | notZero x = fromIntegral k * (logBase 10 x) + | otherwise = 0 -- Пиковое значение уровня сигнала на отрезке peak :: (Ord a, Floating a) => [a] -> a -peak [] = acos(2) -- NaN +peak [] = acos(1) -- NaN peak xs = maximum xs -- Вычисление уровня сигнала calcLevel :: [Char] -> Int -> [Double] -> Int -calcLevel vu = case (map toLower vu) of +calcLevel vu = case (toLower <@ vu) of "lufs" -> calcLevelLUFS "db" -> calcLevelDb @@ -67,14 +78,14 @@ calcLevelDb fs samples = case dd of [] -> -52 -- Неслышимый звук _ -> round (median dd) where - dd = [x | x <- map (float2db 20 . peak) slices, not (isNaN x), x /= 0] - slices = splitWhen (== 0) $ take fs samples; + dd = notZero <# map (float2db 20 . peak) slices + slices = splitWhen (== 0) $ take fs samples -- Вычисление уровня сигнала / LUFS calcLevelLUFS :: Int -> [Double] -> Int -calcLevelLUFS fs samples = round (median values) +calcLevelLUFS fs samples = round (median $ getlufs <@ chunks) where - values = map (\l -> float2db 10 (1 / fd' * (sum $ map (^2) l))) chunks + getlufs l = float2db 10 (1 / fd' * (sum $ map (^2) l)) chunks = everyN fd $ take fs samples fd = fs `div` 10 fd' = convert fd :: Double @@ -83,7 +94,7 @@ calcLevelLUFS fs samples = round (median values) calcPhase :: (Ord a, Fractional a) => [[a]] -> a calcPhase samples | sum [ abs l + abs r | [l,r] <- samples] < 0.01 = 0 - | otherwise = median (map ph (zip3 samples (drop 1 samples) (drop 2 samples))) where + | otherwise = median (map ph (zip3 samples (1//samples) (2//samples))) where ph ([0,0], [l2,r2], [l3,r3]) | (signum l2 /= signum r2) && (signum l3 /= signum r3) = 0 | otherwise = 1 @@ -130,23 +141,24 @@ main = do args <- getArgs cmd <- (if null args then withArgs ["--help"] else id) defaultOptions - if (isInfixOf ".wav" $ file cmd) then do - d <- getWAVEFile $ file cmd - let w = take (samples cmd) (audioread d) - - let exec fx = do - describe (title cmd) ("\n---[ " ++ fx) "" (" ]:") - case fx of - "samples" -> mapM_ print $ getChannel (map toUpper $ channel cmd) w - "phase" -> print $ calcPhase w - "level" -> do - describe (title cmd) "L: " - (calcLevel (vu cmd) (samples cmd) (getChannel "L" w)) (vu cmd) - describe (title cmd) "R: " - (calcLevel (vu cmd) (samples cmd) (getChannel "R" w)) (vu cmd) - _ -> putStrLn $ "WARNING: Unknown type of information: " ++ fx ++ "\n" - - mapM_ exec (splitOn "," $ info cmd) - else do + unless (isInfixOf ".wav" $ file cmd) $ do putStrLn "ERROR: You must specify a correct filename." + exitFailure + + d <- getWAVEFile $ file cmd + let w = samples cmd ## audioread d + + let exec fx = do + describe (title cmd) ("\n---[ " ++ fx) "" (" ]:") + case fx of + "samples" -> mapM_ print $ getChannel (toUpper <@ channel cmd) w + "phase" -> print $ calcPhase w + "level" -> do + describe (title cmd) "L: " + (calcLevel (vu cmd) (samples cmd) (getChannel "L" w)) (vu cmd) + describe (title cmd) "R: " + (calcLevel (vu cmd) (samples cmd) (getChannel "R" w)) (vu cmd) + _ -> putStrLn $ "WARNING: Unknown type of information: " ++ fx ++ "\n" + + mapM_ exec (splitOn "," $ info cmd)