From 06460107b47dc0c30192eba4400a19acf14a2a3d Mon Sep 17 00:00:00 2001 From: Maxim Likhachev Date: Fri, 20 Sep 2019 14:44:39 +0500 Subject: [PATCH] Renamed to wav-info --- README.md | 4 +- wav-info.hs | 178 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ wave-info.hs | 178 ----------------------------------------------------------- 3 files changed, 180 insertions(+), 180 deletions(-) create mode 100644 wav-info.hs delete mode 100644 wave-info.hs diff --git a/README.md b/README.md index de107f2..d345622 100644 --- a/README.md +++ b/README.md @@ -1,4 +1,4 @@ -**wave-info** - информация о wav-файлах +**wav-info** - информация о wav-файлах ##Лицензия Copyright (C) 2011-2019, Maxim Lihachev, @@ -21,7 +21,7 @@ значения отсчётов, уровень сигнала в формате dB и LUFS, значение фазы ##Использование - wave-info [OPTIONS] + wav-info [OPTIONS] Common flags: -i --info=samples,phase,db,lufs Type of information diff --git a/wav-info.hs b/wav-info.hs new file mode 100644 index 0000000..19fd724 --- /dev/null +++ b/wav-info.hs @@ -0,0 +1,178 @@ +{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} + +-- Copyright (C) 2011-2019, Maxim Lihachev, + +-- This program is free software: you can redistribute it and/or modify +-- it under the terms of the GNU General Public License as published by +-- the Free Software Foundation, either version 3 of the License, or +-- (at your option) any later version. + +-- This program is distributed in the hope that it will be useful, +-- but WITHOUT ANY WARRANTY; without even the implied warranty of +-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +-- GNU General Public License for more details. + +-- You should have received a copy of the GNU General Public License +-- along with this program. If not, see . + +-- ============================================================================= + +-- Программа предназначена для отображения информации о wav-файлах, включая +-- значения отсчётов, уровень сигнала в формате dB и LUFS, значение фазы + +-- ============================================================================= + +import System.Console.CmdArgs +import System.Environment +import System.Directory +import System.Exit +import Data.WAVE +import Data.Char +import Data.List +import Data.List.Split +import Control.Monad + +-- ============================================================================= + +-- Среднее значение списка +median :: Fractional a => [a] -> a +median l = let (t,n) = foldl' (\(b,c) a -> (a+b,c+1)) (0,0) l in t/n + +-- Перевод между типами +convert :: (Show a, Read c) => a -> c +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 + +-- ============================================================================= + +-- Чтение данных аудиофайла +wavinfo :: WAVE -> [[Double]] +wavinfo = map samplesToDouble . wavSamples + where samplesToDouble (l:r:[]) = [sampleToDouble l, sampleToDouble r] + +--Выбор канала из пары +getChannel :: [Char] -> [[Double]] -> [Double] +getChannel ch = map selectChannel where + selectChannel (l:r:[]) | ch == "R" = r + | ch == "L" = l + | otherwise = l + +-- k десятичных логарифмов +float2db :: (RealFloat a, Integral b) => b -> a -> a +float2db k x + | notZero x = fromIntegral k * (logBase 10 x) + | otherwise = 0 + +-- Пиковое значение уровня сигнала на отрезке +peak :: (Ord a, Floating a) => [a] -> a +peak [] = acos(1) -- NaN +peak xs = maximum $ abs <@ xs + +-- Вычисление уровня сигнала +calcLevel :: [Char] -> Int -> [Double] -> Double +calcLevel vu = case (toLower <@ vu) of + "lufs" -> calcLevelLUFS + "db" -> calcLevelDb + +-- Вычисление уровня сигнала / Db +calcLevelDb :: Int -> [Double] -> Double +calcLevelDb fs samples = case dd of + [] -> -52 -- Неслышимый звук + _ -> median dd + where + dd = notZero <# map (float2db 20 . peak) slices + slices = splitWhen (== 0) $ take fs samples + +-- Вычисление уровня сигнала / LUFS +calcLevelLUFS :: Int -> [Double] -> Double +calcLevelLUFS fs samples = lufs + where + lufs = float2db 10 (1 / fs' * s) + 3 + s = sum [x*x | x <- samples] + fs' = convert fs :: Double + + +-- Вычисление значения фазы +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 (1//samples) (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)) = 0 + | otherwise = + if (abs l1) >= (abs r1) then + 2 * (l1 + r1) / (2 * l1) - 1 + else + 2 * (l1 + r1) / (2 * r1) - 1 + +-- ============================================================================= + +-- Параметры +data WavInfo = WavInfo { + info :: String, + samples :: Int, + channel :: String, + file :: String, + vu :: String, + title :: Int + } deriving (Show, Data,Typeable) + +-- Стандартные значения и описания параметров +defaultOptions :: IO WavInfo +defaultOptions = cmdArgs $ WavInfo { + file = "none" &= typ "FILE.WAV" &= help "File for analysis", + info = "none" &= typ "samples,phase,db,lufs" &= help "Type of information", + samples = 1200 &= typ "12000" &= help "Number of samples for analysis", + channel = "L" &= typ "L/R" &= help "Channel from stereo stream", + title = 0 &= typ "1/0" &= help "File for analysis", + vu = "db" &= typ "db/lufs" &= help "Type of vu scale" + } &= summary "wav-info v0.3: information about audiofiles" + +-- Вывод строки с префиксом и суффиксом +describe :: (Show s) => Int -> String -> s -> String -> IO () +describe o p m s = putStrLn message where + str = if notEmpty (show m) then show m else "" + message | o == 1 = p ++ str ++ s + | otherwise = str + +main :: IO () +main = do + args <- getArgs + cmd <- (if null args then withArgs ["--help"] else id) defaultOptions + + unless (".wav" `isInfixOf` file cmd) $ do + putStrLn "ERROR: You must specify a correct filename." + exitFailure + + d <- getWAVEFile $ file cmd + let w = samples cmd ## wavinfo 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) + diff --git a/wave-info.hs b/wave-info.hs deleted file mode 100644 index 7a1121b..0000000 --- a/wave-info.hs +++ /dev/null @@ -1,178 +0,0 @@ -{-# LANGUAGE DeriveDataTypeable, RecordWildCards #-} - --- Copyright (C) 2011-2019, Maxim Lihachev, - --- This program is free software: you can redistribute it and/or modify --- it under the terms of the GNU General Public License as published by --- the Free Software Foundation, either version 3 of the License, or --- (at your option) any later version. - --- This program is distributed in the hope that it will be useful, --- but WITHOUT ANY WARRANTY; without even the implied warranty of --- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the --- GNU General Public License for more details. - --- You should have received a copy of the GNU General Public License --- along with this program. If not, see . - --- ============================================================================= - --- Программа предназначена для отображения информации о wav-файлах, включая --- значения отсчётов, уровень сигнала в формате dB и LUFS, значение фазы - --- ============================================================================= - -import System.Console.CmdArgs -import System.Environment -import System.Directory -import System.Exit -import Data.WAVE -import Data.Char -import Data.List -import Data.List.Split -import Control.Monad - --- ============================================================================= - --- Среднее значение списка -median :: Fractional a => [a] -> a -median l = let (t,n) = foldl' (\(b,c) a -> (a+b,c+1)) (0,0) l in t/n - --- Перевод между типами -convert :: (Show a, Read c) => a -> c -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 - --- ============================================================================= - --- Чтение данных аудиофайла -waveinfo :: WAVE -> [[Double]] -waveinfo = map samplesToDouble . waveSamples - where samplesToDouble (l:r:[]) = [sampleToDouble l, sampleToDouble r] - ---Выбор канала из пары -getChannel :: [Char] -> [[Double]] -> [Double] -getChannel ch = map selectChannel where - selectChannel (l:r:[]) | ch == "R" = r - | ch == "L" = l - | otherwise = l - --- k десятичных логарифмов -float2db :: (RealFloat a, Integral b) => b -> a -> a -float2db k x - | notZero x = fromIntegral k * (logBase 10 x) - | otherwise = 0 - --- Пиковое значение уровня сигнала на отрезке -peak :: (Ord a, Floating a) => [a] -> a -peak [] = acos(1) -- NaN -peak xs = maximum $ abs <@ xs - --- Вычисление уровня сигнала -calcLevel :: [Char] -> Int -> [Double] -> Double -calcLevel vu = case (toLower <@ vu) of - "lufs" -> calcLevelLUFS - "db" -> calcLevelDb - --- Вычисление уровня сигнала / Db -calcLevelDb :: Int -> [Double] -> Double -calcLevelDb fs samples = case dd of - [] -> -52 -- Неслышимый звук - _ -> median dd - where - dd = notZero <# map (float2db 20 . peak) slices - slices = splitWhen (== 0) $ take fs samples - --- Вычисление уровня сигнала / LUFS -calcLevelLUFS :: Int -> [Double] -> Double -calcLevelLUFS fs samples = lufs - where - lufs = float2db 10 (1 / fs' * s) + 3 - s = sum [x*x | x <- samples] - fs' = convert fs :: Double - - --- Вычисление значения фазы -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 (1//samples) (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)) = 0 - | otherwise = - if (abs l1) >= (abs r1) then - 2 * (l1 + r1) / (2 * l1) - 1 - else - 2 * (l1 + r1) / (2 * r1) - 1 - --- ============================================================================= - --- Параметры -data WaveInfo = WaveInfo { - info :: String, - samples :: Int, - channel :: String, - file :: String, - vu :: String, - title :: Int - } deriving (Show, Data,Typeable) - --- Стандартные значения и описания параметров -defaultOptions :: IO WaveInfo -defaultOptions = cmdArgs $ WaveInfo { - file = "none" &= typ "FILE.WAV" &= help "File for analysis", - info = "none" &= typ "samples,phase,db,lufs" &= help "Type of information", - samples = 1200 &= typ "12000" &= help "Number of samples for analysis", - channel = "L" &= typ "L/R" &= help "Channel from stereo stream", - title = 0 &= typ "1/0" &= help "File for analysis", - vu = "db" &= typ "db/lufs" &= help "Type of vu scale" - } &= summary "wave-info v0.3: information about audiofiles" - --- Вывод строки с префиксом и суффиксом -describe :: (Show s) => Int -> String -> s -> String -> IO () -describe o p m s = putStrLn message where - str = if notEmpty (show m) then show m else "" - message | o == 1 = p ++ str ++ s - | otherwise = str - -main :: IO () -main = do - args <- getArgs - cmd <- (if null args then withArgs ["--help"] else id) defaultOptions - - unless (".wav" `isInfixOf` file cmd) $ do - putStrLn "ERROR: You must specify a correct filename." - exitFailure - - d <- getWAVEFile $ file cmd - let w = samples cmd ## waveinfo 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) -