Browse Source

Алгоритм расчёта уровня сигнала Db: финальный вариант

master
Maxim Lihachev 9 years ago
parent
commit
dd70ce725a
  1. 17
      level.hs

17
level.hs

@ -1,7 +1,7 @@
{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} {-# LANGUAGE DeriveDataTypeable, RecordWildCards #-}
-- Создан: Ср 28 сен 2016 10:18:53 -- Создан: Ср 28 сен 2016 10:18:53
-- Изменен: Пт 14 окт 2016 11:45:06 -- Изменен: Пт 14 окт 2016 12:07:33
import System.Console.CmdArgs import System.Console.CmdArgs
import System.Environment import System.Environment
@ -47,8 +47,13 @@ getChannel ch (xs) = map selectChannel xs where
-- k десятичных логарифмов -- k десятичных логарифмов
float2db :: (RealFloat a, Integral b) => b -> a -> a float2db :: (RealFloat a, Integral b) => b -> a -> a
float2db k x float2db k x
| not (isNaN x) = fromIntegral k * (logBase 10 x) | isNaN x = 0
| otherwise = 0 | otherwise = fromIntegral k * (logBase 10 x)
-- Пиковое значение уровня сигнала на отрезке
peak :: (Ord a, Floating a) => [a] -> a
peak [] = acos(2) -- NaN
peak xs = maximum xs
-- Вычисление уровня сигнала -- Вычисление уровня сигнала
calcLevel :: [Char] -> Int -> [Double] -> Int calcLevel :: [Char] -> Int -> [Double] -> Int
@ -62,9 +67,8 @@ calcLevelDb fs samples = case dd of
[] -> -52 -- Неслышимый звук [] -> -52 -- Неслышимый звук
_ -> round (median dd) _ -> round (median dd)
where where
dd = [x | x <- map (float2db 20 . maximum) slices, not (isNaN x), x /= 0] dd = [x | x <- map (float2db 20 . peak) slices, not (isNaN x), x /= 0]
slices = chunksOf ms $ take fs samples slices = splitWhen (== 0) $ take fs samples;
ms = fs `div` 2
-- Вычисление уровня сигнала / LUFS -- Вычисление уровня сигнала / LUFS
calcLevelLUFS :: Int -> [Double] -> Int calcLevelLUFS :: Int -> [Double] -> Int
@ -113,6 +117,7 @@ defaultOptions = cmdArgs $ Audioread {
vu = "db" &= typ "db/lufs" &= help "Type of vu scale" vu = "db" &= typ "db/lufs" &= help "Type of vu scale"
} &= summary "audioread v0.2: information about audiofiles" } &= summary "audioread v0.2: information about audiofiles"
-- Вывод строки с префиксом и суффиксом
describe :: (Show s) => Int -> String -> s -> String -> IO () describe :: (Show s) => Int -> String -> s -> String -> IO ()
describe o p ms s = let message = show ms in do describe o p ms s = let message = show ms in do
when (o == 1) $ putStr $ p when (o == 1) $ putStr $ p

Loading…
Cancel
Save