You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
77 lines
2.4 KiB
77 lines
2.4 KiB
9 years ago
|
-- Создан: Ср 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]"
|
||
|
|
|