2

我有一个与从声音文件中收集的数据相关的模拟。我想同时运行模拟并播放声音文件,看看我的数据匹配得如何。

问题是我似乎无法通过 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

我已经尝试了一些东西,例如evaluateControl.Exception包中使用。

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

尝试强制评估昂贵的计算,但这似乎没有效果。将 bang 模式添加makeModel到.letmain

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

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

此外,如果我尝试同时 forkIOplaySound并且simulate我的程序只是终止而不播放声音或模拟。

任何帮助是极大的赞赏!

4

1 回答 1

4

您的代码不是独立的,因此我将其剥离为静态图片,forkIO playSoundGloss.display遇到了同样的问题:声音正在播放,但在停止之前什么都没有显示。

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

然后我发现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(-threadedGHC 选项)进行编译。计算密集型模拟可能会带来额外的问题,我很想知道它是如何为您服务的。

于 2013-08-10T10:24:58.887 回答