使用Gloss在使用SDL播放声音时运行模拟

时间:2013-08-09 20:41:29

标签: haskell audio sdl

我的模拟与从声音文件中收集的数据相关联。我想运行模拟并同时播放声音文件以查看我的数据是否匹配。

问题是我似乎无法通过SDL.Mixer播放声音并同时运行Gloss模拟。这两个功能都可以自行完成。

创建模拟窗口,但不绘制任何内容并播放wav文件。这可能是模拟模型(onsets)的数据在计算上非常昂贵吗?它似乎根本没有得到评估。

{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import GHC.Float
import Debug.Trace
import Control.Concurrent
import Control.Monad.Fix
import Control.Monad

import Graphics.Gloss
import Graphics.Gloss.Interface.Pure.Simulate
import Graphics.Gloss.Data.Color

import qualified Sound.File.Sndfile as Snd
import qualified Sound.File.Sndfile.Buffer.Vector as B
import qualified Graphics.UI.SDL as SDL
import qualified Graphics.UI.SDL.Mixer as Mix

--My own libraries
import Sound.Analysis.Spectrum
import Sound.Analysis.SpectralFlux
import Sound.Analysis.Onset
import Sound.Data.Buffers

--(TimeElapsed, ToDraw, ToBeDrawn)
type Time = Float
type DrawableOnsets = (Time, Onset, OnsetStream)

main = do
    --bs holds our BufferS
    (info, Just (bs :: B.Buffer Double)) <- Snd.readFile "./downtheroad.wav"
    --Convert to an unboxed array
    let b = sterilize bs

    --Grab all of the sound file
    let ct = (truncate $ (fromIntegral $ Snd.frames info)/2048)
    let i = StreamInfo 1024 44100 2

    let b' = sampleRawPCM 0 ct (i, b)
    let s = pcmStream b'

    --Very expensive computations
    let freqs   = freqStream s --Get frequency bins
    let fluxes  = fluxStream freqs --Get spectral flux
    let onsets = onset fluxes --Get onsets based on spectral flux

    let onsetModel = makeModel onsets

    let dispWin = InWindow "Onset Test" (1440, 300) (0,0)

    forkIO playSound
    simulate dispWin white 45 onsetModel drawOnsets stepWorld

    print "done"

playSound = do
    SDL.init [SDL.InitAudio]
    result <- Mix.openAudio 44100 Mix.AudioS16LSB 2 4096
    toPlay <- Mix.loadWAV "./downtheroad.wav"
    ch1 <- Mix.playChannel (-1) toPlay 0
    fix $ \loop -> do
        SDL.delay 50
        stillPlaying <- Mix.numChannelsPlaying
        when (stillPlaying /= 0) loop



makeModel :: OnsetStream -> DrawableOnsets
makeModel (i, os) = (0.0, Onset 0 0.0, (i, os))

drawOnsets :: DrawableOnsets -> Picture
drawOnsets (t, o, os) = translate x 50 $ color red $ circleSolid rad
    where   rad = (double2Float $ power o)*0.01
            x   = (fromIntegral $ frame o)

stepWorld :: ViewPort -> Float -> DrawableOnsets -> DrawableOnsets
stepWorld vp t' (t, o, (i, os)) = (elapsed, o', (i, os'))
    where   o'  | elapsed > nextTime = head os
                | otherwise          = o

            os' | (elapsed > nextTime) = tail os
                | otherwise          = os

            elapsed = t+t'*1000
            interval = (fromIntegral $ sampleRate i)/(fromIntegral $ fftWindow i)
            nextTime = (fromIntegral $ frame o) * 86

我尝试了一些事情,例如在evaluate包中使用Control.Exception

makeModel :: DrawableOnsets -> IO DrawableOnsets
makeModel  (i, os) = do evaluate (0.0, Onset 0 0.0, os)

尝试强制评估昂贵的计算,但似乎没有效果。将爆炸模式添加到makeModellet中的main声明中也是如此。

...
let !freqs = freqStream s
let !fluxes = fluxStream freqs
...

makeModel (i, !os) = (0.0, Onset 0 0.0, os)

此外,如果我尝试forkIO playSoundsimulate我的程序只是终止而不播放声音或模拟。

非常感谢任何帮助!

1 个答案:

答案 0 :(得分:4)

您的代码不是自包含的,因此我将其剥离到forkIO playSound后跟Gloss.display静态图片,并遇到了同样的问题:声音正在播放,但在停止之前不会显示任何内容。

我发现SDL-mixer仅使用不可抢占的unsafe个外来函数。所以我用SDL.delay 50替换了threadDelay 50000(它在整个持续时间内阻止了当前的操作系统线程)以使调度程序有机会完成其工作,并将forkIO更改为forkOS以使确保所有对SDL的FFI调用都是从同一个OS线程发出的(处理有状态库时通常是个好主意)。现在画面立即出现,但声音在几秒钟后突然结束。

然后我发现this SO answer表示Haskell GC在播放时可以释放音频块。在touchForeignPtr toPlay之前插入threadDelay后,一切都按预期工作。

playSound = do
    SDL.init [SDL.InitAudio]
    result <- Mix.openAudio 44100 Mix.AudioS16LSB 2 4096
    toPlay <- Mix.loadWAV "./sound.wav"
    ch1 <- Mix.playChannel (-1) toPlay 0
    fix $ \loop -> do
        touchForeignPtr toPlay
        threadDelay 50000
        stillPlaying <- Mix.numChannelsPlaying
        when (stillPlaying /= 0) loop

当然,请确保使用线程RTS(-threaded GHC选项)进行编译。计算密集型模拟可能会引入其他问题,我很想知道它是如何为您解决的。