在Haskell中生成.wav声音数据

时间:2011-04-14 04:03:34

标签: haskell wav wave

我正在尝试使用Data.WAVE库在Haskell中使用格式“Note Octave Note Octave”(例如A 4 F#1)以编程方式生成.wav文件,我遇到了问题:我无法弄清楚如何准确地计算出作为笔记存储的内容。截至目前,我正在尝试将它们存储为根据八度音符的音符频率计算的正弦波,但是我从扬声器中取出的所有内容都是点击。我做错了,这不会产生音调?

import Data.WAVE
import Graphics.UI.SDL.Mixer.Samples

import Control.Applicative
import Data.List.Split (splitOn)
import Data.Char
import Data.Int (Int32)
import Data.List (group)
import System.IO (hGetContents, Handle, openFile, IOMode(..))

a4 = 440.0

frameRate = 16000

noteToFreq :: (String, Int) -> Double
noteToFreq (note, octave) =
    if octave >= -1 && octave < 10
    then if n /= 15.0
         then (2 ** (n + (12.0 * ((fromIntegral octave ::Double) - 4.0)))) * a4
         else error $ "Bad note: " ++ note
    else error $ "Bad octave: " ++ show octave
    where n = case note of
                "B#" -> -9.0
                "C"  -> -9.0
                "C#" -> -8.0
                "Db" -> -8.0
                "D"  -> -7.0
                "D#" -> -6.0
                "Eb" -> -6.0
                "E"  -> -5.0
                "Fb" -> -5.0
                "E#" -> -4.0
                "F"  -> -4.0
                "F#" -> -3.0
                "Gb" -> -3.0
                "G"  -> -2.0
                "G#" -> -1.0
                "Ab" -> -1.0
                "A"  -> 0.0
                "A#" -> 1.0
                "Bb" -> 1.0
                "B"  -> 2.0
                "Cb" -> 2.0
                _    -> 15.0

notesToSamples :: [(String, Int)] -> [WAVESample]
notesToSamples ns =
    map doubleToSample [sin $ pi * i * (f/fr) | i <- [0,0.1..len], f <- freqs]
    where freqs = map noteToFreq ns
          fr = fromIntegral frameRate :: Double
          len = fromIntegral (length ns) :: Double

getFileName :: IO FilePath
getFileName = putStr "Enter the name of the file: " >> getLine

openMFile :: IO Handle
openMFile = getFileName >>= \path -> 
            openFile path ReadMode

getNotesAndOctaves :: IO String
getNotesAndOctaves = openMFile >>= hGetContents

noteValuePairs :: String -> [(String, Int)]
noteValuePairs = pair . splitOn " "
    where pair (x:y:ys) = (x, read y) : pair ys
          pair []       = []

getWavSamples :: IO [WAVESample]
getWavSamples = (notesToSamples . noteValuePairs) <$> getNotesAndOctaves 

constructWAVE :: IO WAVE
constructWAVE = do
  samples <- map (:[]) . concatMap (replicate 1000) <$> getWavSamples
  let channels      = 1
      bitsPerSample = 32
      frames        = Just (length samples)
      header        =
          WAVEHeader channels frameRate bitsPerSample frames
  return $ WAVE header samples

makeWavFile :: IO ()
makeWavFile = constructWAVE >>= \wav -> putWAVEFile "temp.wav" wav

1 个答案:

答案 0 :(得分:3)

以下是使用该库生成音调的一些代码,您应该能够将代码用于您自己的问题。首先检查它是否为给定的输入产生正确的频率 - 我从未测试过。我实际上没有检查你的代码,因为大多数与声音生成无关。有了这种问题,我通常会尝试编写最简单的代码来使外部库工作,然后再编写自己的抽象:

module Sound where
import Data.WAVE
import Data.Int (Int32)
import Data.List.Split (splitOn)

samplesPS = 16000
bitrate = 32

header = WAVEHeader 1 samplesPS bitrate Nothing

sound :: Double  -- | Frequency
      -> Int -- | Samples per second
      -> Double -- | Lenght of sound in seconds
      -> Int32 -- | Volume, (maxBound :: Int32) for highest, 0 for lowest
      -> [Int32]
sound freq samples len volume = take (round $ len * (fromIntegral samples)) $ 
                         map (round . (* fromIntegral volume)) $
                         map sin [0.0, (freq * 2 * pi / (fromIntegral samples))..]

samples :: [[Int32]]
samples = map (:[]) $ sound 600 samplesPS 3 (maxBound `div` 2)

samples2 :: [[Int32]] -- play two tones at once
samples2 = map (:[]) $ zipWith (+) (sound 600 samplesPS 3 (maxBound `div` 2)) (sound 1000 samplesPS 3 (maxBound `div` 2))

waveData = WAVE header samples


makeWavFile :: WAVE -> IO ()
makeWavFile wav = putWAVEFile "temp.wav" wav

main = makeWavFile waveData

一旦你开始工作,你就可以围绕它写一个更好的抽象。您应该能够为此库获得一个很好的纯抽象,因为使用IO的唯一函数是将其写入文件的函数。