haskell - 在使用SDL播放声音的同时使用Gloss运行模拟

Question

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

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

试图强制对昂贵的计算进行评估，但这似乎没有效果。在 makeModel和 let的 main声明中添加爆炸模式也是如此。

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

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

此外，如果我尝试对 playSound和 simulate都进行forkIO，则我的程序将终止，而不会播放声音或模拟。

任何帮助是极大的赞赏!

Answer 1

您的代码不是独立的，因此我将其简化为forkIO playSound，然后是静态图片的Gloss.display，并遇到了相同的问题:声音正在播放，但直到停止为止，什么都不会显示。

我发现SDL-mixer仅使用了不可抢占的unsafe外部函数。因此，我用SDL.delay 50替换了threadDelay 50000(在整个持续时间内阻止当前OS线程)，以使调度程序有机会进行工作，然后将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选项)进行编译。计算密集型仿真可能会带来其他问题，我很想知道它如何为您解决问题。