Play a wav file with Haskell - haskell

Is there a simple, direct way to play a WAV file from Haskell using some library and possibly such that I play many sounds at once?
I'm aware of OpenAL but I'm not writing some advanced audio synthesis program, I just want to play some sounds for a little play thing. Ideally the API might be something like:
readWavFile :: FilePath -> IO Wave
playWave :: Wave -> IO ()
playWaveNonBlocking :: Wave -> IO ()
I'm this close to merely launching mplayer or something. Or trying to cat the wav directly to /dev/snd/ or somesuch.

This is how to play multiple sounds on multiple channels at once with SDL. I think this answers the question criteria. WAV files, simple, Haskell, multiple channels.
import Control.Monad
import Control.Monad.Fix
import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.Mixer as Mix
main = do
SDL.init [SDL.InitAudio]
result <- openAudio audioRate audioFormat audioChannels audioBuffers
classicJungle <- Mix.loadWAV "/home/chris/Samples/ClassicJungle/A4.wav"
realTech <- Mix.loadWAV "/home/chris/Samples/RealTech/A4.wav"
ch1 <- Mix.playChannel anyChannel classicJungle 0
SDL.delay 1000
ch2 <- Mix.playChannel anyChannel realTech 0
fix $ \loop -> do
SDL.delay 50
stillPlaying <- numChannelsPlaying
when (stillPlaying /= 0) loop
Mix.closeAudio
SDL.quit
where audioRate = 22050
audioFormat = Mix.AudioS16LSB
audioChannels = 2
audioBuffers = 4096
anyChannel = (-1)

I realize this is not actually a convenient way to do it, but I had the test code lying around, so...
{-# LANGUAGE NoImplicitPrelude #-}
module Wav (main) where
import Fay.W3C.Events
import Fay.W3C.Html5
import Language.Fay.FFI
import Language.Fay.Prelude
main :: Fay ()
main = addWindowEventListener "load" run
run :: Event -> Fay Bool
run _ = do
aud <- mkAudio
setSrc aud "test.wav"
play aud
return False
mkAudio :: Fay HTMLAudioElement
mkAudio = ffi "new Audio()"
addWindowEventListener :: String -> (Event -> Fay Bool) -> Fay ()
addWindowEventListener = ffi "window['addEventListener'](%1,%2,false)"
There you go--playing a WAV file in Haskell thanks to the power of HTML5! All you have to do is launch a web browser instead of mplayer. :D

using OpenAL through ALUT:
import Control.Monad
import Sound.ALUT
playSound :: IO ()
playSound =
withProgNameAndArgs runALUTUsingCurrentContext $ \_ _ ->
do
(Just device) <- openDevice Nothing
(Just context) <- createContext device []
currentContext $= Just context
buffer1 <- createBuffer $ Sine 440 0 1
buffer2 <- createBuffer HelloWorld
[source] <- genObjectNames 1
queueBuffers source [buffer1,buffer2]
play [source]
sleep 4
closeDevice device
return ()
main = playSound
to load a wav file:
buffer3 <- createBuffer $ File "/path/to/file.wav"
credit goes to Chris Double: http://bluishcoder.co.nz/articles/haskell/openal.html

module Main (main) where
import qualified SDL
import SDL.Mixer
main :: IO ()
main = do
SDL.initialize [SDL.InitAudio]
withAudio defaultAudio 4096 $ do
load "test.wav" >>= play
SDL.delay 1000
SDL.quit
I was trying to play sound with Haskell and I found this board when I searched how to do this. Actually, I want to know some kind of solution in Japanese sites because I am Japanese, but I couldn't find such sites.
I tried the OpenAl one above and with a little revision I succeeded, but I want to have a result with a simpler way.
I use 'sdl2' and 'sdl2-mixer' library. To do this, I had to install sdl2 and sdl2-mixer library into my OS.
I am using DebianOS and I installed 'libsdl2-dev' and 'libsdl2-mixer-dev' with apt command.
sudo apt instll libsdl2-dev libsdl2-mixer-dev
(Because I installed these files many months ago, so my memory is ambiguous.)
I use 'stack' to launch a Haskell project.
stack new myproject
(myproject is the project name)
In the myproject folder I edited the package.yaml file:
dependencies:
- base >= 4.7 && < 5
- sdl2
- sdl2-mixer
and I also edited then Main.hs file in the app folder. That is the above code.
I put the test.wav file in the myproject folder and with the command:
stack run
I could play the test sound.

Related

Haskell SDL2 accessing GLContext Ptr

I am trying to access the Ptr value in a GLContext provided by SDL2 library. Here is the function to get a GLContext: http://hackage.haskell.org/package/sdl2-2.5.0.0/docs/SDL-Video-OpenGL.html#v:glCreateContext
How do I get access to the Ptr inside?
import qualified SDL as SDL
import qualified SDL.Internal.Types as SDL
main :: IO ()
main = do
SDL.initializeAll
window # (SDL.Window wp) <- SDL.createWindow "My SDL Application" SDL.defaultWindow
context # (SDL.GLContext gl) <- SDL.glCreateContext window
putStrLn $ show wp
But the error I get is:
Not in scope: data constructor ‘SDL.GLContext’
Neither ‘SDL’ nor ‘SDL.Internal.Types’ exports ‘
|
15 | context # (SDL.GLContext gl) <- SDL.glCreateContext window
The constructor appears to be exported. What am I doing wrong?
I ended up figuring it out. I can use the Raw.Video module which has a glCreateContext function that returns the type I need.

No sound with Haskell OpenAl

I am currently attempting to play audio files in Haskell using OpenAl. In order to do so, I am trying to get the example code at the ALUT git repository (https://github.com/haskell-openal/ALUT/blob/master/examples/Basic/PlayFile.hs) to work. However, it refuses to produce any sound. What am I missing here?
{-
PlayFile.hs (adapted from playfile.c in freealut)
Copyright (c) Sven Panne 2005-2016
This file is part of the ALUT package & distributed under a BSD-style license.
See the file LICENSE.
-}
import Control.Monad ( when, unless )
import Data.List ( intersperse )
import Sound.ALUT
import System.Exit ( exitFailure )
import System.IO ( hPutStrLn, stderr )
-- This program loads and plays a variety of files.
playFile :: FilePath -> IO ()
playFile fileName = do
-- Create an AL buffer from the given sound file.
buf <- createBuffer (File fileName)
-- Generate a single source, attach the buffer to it and start playing.
source <- genObjectName
buffer source $= Just buf
play [source]
-- Normally nothing should go wrong above, but one never knows...
errs <- get alErrors
unless (null errs) $ do
hPutStrLn stderr (concat (intersperse "," [ d | ALError _ d <- errs ]))
exitFailure
-- Check every 0.1 seconds if the sound is still playing.
let waitWhilePlaying = do
sleep 0.1
state <- get (sourceState source)
when (state == Playing) $
waitWhilePlaying
waitWhilePlaying
main :: IO ()
main = do
-- Initialise ALUT and eat any ALUT-specific commandline flags.
withProgNameAndArgs runALUT $ \progName args -> do
-- Check for correct usage.
unless (length args == 1) $ do
hPutStrLn stderr ("usage: " ++ progName ++ " <fileName>")
exitFailure
-- If everything is OK, play the sound file and exit when finished.
playFile (head args)
Unfortunately, while I don't get any errors, I also can\t hear any sound. Pavucontrol also does not seem to detect anything (no extra streams appear under the Playback tab).
Their HelloWorld example on the same git repository also gave neither errors nor sound.
I also tried the OpenALInfo function on the same git repository (https://github.com/haskell-openal/ALUT/blob/master/examples/Basic/OpenALInfo.hs), which further proves that I'm actually connecting to OpenAL, and gives some information about the versions which may or may not be useful:
ALC version: 1.1
ALC extensions:
ALC_ENUMERATE_ALL_EXT, ALC_ENUMERATION_EXT, ALC_EXT_CAPTURE,
ALC_EXT_DEDICATED, ALC_EXT_disconnect, ALC_EXT_EFX,
ALC_EXT_thread_local_context, ALC_SOFTX_device_clock,
ALC_SOFT_HRTF, ALC_SOFT_loopback, ALC_SOFT_pause_device
AL version: 1.1 ALSOFT 1.17.2
AL renderer: OpenAL Soft
AL vendor: OpenAL Community
AL extensions:
AL_EXT_ALAW, AL_EXT_BFORMAT, AL_EXT_DOUBLE,
AL_EXT_EXPONENT_DISTANCE, AL_EXT_FLOAT32, AL_EXT_IMA4,
AL_EXT_LINEAR_DISTANCE, AL_EXT_MCFORMATS, AL_EXT_MULAW,
AL_EXT_MULAW_BFORMAT, AL_EXT_MULAW_MCFORMATS, AL_EXT_OFFSET,
AL_EXT_source_distance_model, AL_LOKI_quadriphonic,
AL_SOFT_block_alignment, AL_SOFT_buffer_samples,
AL_SOFT_buffer_sub_data, AL_SOFT_deferred_updates,
AL_SOFT_direct_channels, AL_SOFT_loop_points, AL_SOFT_MSADPCM,
AL_SOFT_source_latency, AL_SOFT_source_length
Well, it turns out I posted here a bit too quickly. There was no problem with my code, but rather with my OpenAl settings. By adding
drivers=pulse,alsa
to /etc/openal/alsoft.conf OpenAl works. This is described in https://wiki.archlinux.org/index.php/PulseAudio#OpenAL.

Stream stdin to a Wai.EventSource

I would like to stream stdin over an HTTP connection using text/event-stream. The Network.Wai.EventSource thing looks like a good candidate.
I tried using this code:
import Network.Wai
import Network.Wai.EventSource
import Network.Wai.Middleware.AddHeaders
import Network.Wai.Handler.Warp (run)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
import Blaze.ByteString.Builder.ByteString
toEvent :: [L.ByteString] -> ServerEvent
toEvent s = ServerEvent {
eventName = Nothing,
eventId = Nothing,
eventData = map fromLazyByteString s
}
createWaiApp :: IO L.ByteString -> Application
createWaiApp input = eventSourceAppIO $ fmap (toEvent . C.lines) input
main :: IO ()
main = run 1337 $ createWaiApp L.getContents
Which (I think) does:
Reads stdin as a Lazy ByteStream
Splits the ByteStream into lines
Produces one ServerEvent for all the lines (this feels wrong - there should presumably be multiple events?)
Builds a WAI Application from the IO ServerEvent
Binds the Application to port 1337
When I run this (e.g. using ping -c 5 example.com | stack exec test-exe) it doesn't respond until the whole of stdin has been read.
How do I build a Wai application that flushes out the HTTP connection every time it reads a line from stdin?
L.getContents is a single IO action, so only one event will be created.
Here is an example of eventSourcEventAppIO where multiple events are created:
import Blaze.ByteString.Builder.Char8 (fromString)
...same imports as above...
nextEvent :: IO ServerEvent
nextEvent = do
s <- getLine
let event = if s == ""
then CloseEvent
else ServerEvent
{ eventName = Nothing
, eventId = Nothing
, eventData = [ fromString s ]
}
case event of
CloseEvent -> putStrLn "<close event>"
ServerEvent _ _ _ -> putStrLn "<server event>"
return event
main :: IO ()
main = run 1337 $ eventSourceAppIO nextEvent
To test, in one window start up the server and in another run the command curl -v http://localhost:1337. For each line you enter in the server window you will get a data frame from curl. Entering a blank line will close the HTTP connection but the server will remain running allowing you to connect to it again.

Importing 'C' Delay function into Haskell using FFI

There is a function in the wiringPi 'C' library called delay with type
void delay(unsigned int howLong);
This function delays execution of code for howLong milliseconds. I wrote the binding code in haskell to be able to call this function. The haskell code is as follows,
foreign import ccall "wiringPi.h delay" c_delay :: CUInt -> IO ()
hdelay :: Int -> IO ()
hdelay howlong = c_delay (fromIntegral howlong)
After this, I wrote a simple haskell program to call this function. The simply haskell code is as follows..
--After importing relavent libraries I did
main = wiringPiSetup
>> delay 5000
But the delay does not happen or rather the executable generated by the ghc compiler exits right away.
Could someone tell me what could possibly go wrong here? A small nudge in the right direction would help.
Cheers and Regards.
Please ignore the part in block quote, and see update below - I am preserving the original non-solution because of comments associated with it.
You should mark the import as unsafe since you want the main
thread to block while the function is executing (see comment below by
#carl). By default, import is safe, not unsafe. So, changing
the function signature to this should make the main thread block:
foreign import ccall unsafe "wiring.h delay" c_delay :: CUInt -> IO ()
Also, if you plan to write multi-threaded code, GHC docs for multi-threaded FFI is >very useful. This also seems a good starter.
Update
The behavior seems to be due to signal interrupt handling (if I recall correctly, this was added in GHC 7.4+ to fix some bugs). More details here:
http://hackage.haskell.org/trac/ghc/wiki/Commentary/Rts/Signals
Please note the comment on the above page: Signal handling differs between the threaded version of the runtime and the non-threaded version.
Approach 1 - Handle signal interrupt in FFI code:
A toy code is below which handles the interrupt in sleep. I tested it on Linux 2.6.18 with ghc 7.6.1.
C code:
/** ctest.c **/
#include <unistd.h>
#include <stdio.h>
#include <time.h>
unsigned delay(unsigned sec)
{
struct timespec req={0};
req.tv_sec = sec;
req.tv_nsec = 0;
while (nanosleep(&req, &req) == -1) {
printf("Got interrupt, continuing\n");
continue;
}
return 1;
}
Haskell code:
{-# LANGUAGE ForeignFunctionInterface #-}
-- Filename Test.hs
module Main (main) where
import Foreign.C.Types
foreign import ccall safe "delay" delay :: CUInt -> IO CUInt
main = do
putStrLn "Sleeping"
n <- delay 2000
putStrLn $ "Got return code from sleep: " ++ show n
Now, after compiling with ghc 7.6.1 (command: ghc Test.hs ctest.c), it waits until sleep finishes, and prints a message every time it gets an interrupt signal during sleep:
./Test
Sleeping
Got interrupt, continuing
Got interrupt, continuing
Got interrupt, continuing
Got interrupt, continuing
....
....
Got return code from sleep: 1
Approach 2 - Disable SIGVTALRM before calling FFI code, and re-enable:
I am not sure what the implications are for disabling SIGVTALRM. This is alternative approach which disables SIGVTALRM during FFI call, if you can't alter FFI code. So, FFI code is not interrupted during sleep (assuming it is SIGVTALRM that is causing the interrupt).
{-# LANGUAGE ForeignFunctionInterface #-}
-- Test.hs
module Main (main) where
import Foreign.C.Types
import System.Posix.Signals
foreign import ccall safe "delay" delay :: CUInt -> IO CUInt
main = do
putStrLn "Sleeping"
-- Block SIGVTALRM temporarily to avoid interrupts while sleeping
blockSignals $ addSignal sigVTALRM emptySignalSet
n <- delay 2
putStrLn $ "Got return code from sleep: " ++ show n
-- Unblock SIGVTALRM
unblockSignals $ addSignal sigVTALRM emptySignalSet
return ()

ThreadDelay Problem in Haskell (GHC) on Ubuntu

I noticed odd behavior with the threadDelay function in GHC.Conc on some of my machines. The following program:
main = do print "start"
threadDelay (1000 * 1000)
print "done"
takes 1 second to run, as expected. On the other hand, this program:
{-# LANGUAGE BangPatterns #-}
import Control.Concurrent
main = do print "start"
loop 1000
print "done"
where loop :: Int -> IO ()
loop !n =
if n == 0
then return ()
else do threadDelay 1000
loop (n-1)
takes about 10 seconds to run on two of my machines, though on other machines it takes about 1 second, as expected. (I compiled both of the above programs with the '-threaded' flag.) Here is a screen shot from Threadscope showing that there is activity only once every 10 milliseconds:
On the other hand, here is a screenshot from ThreadScope from one of my machines on which the program takes 1 second total:
A similar C program:
#include <unistd.h>
#include <stdio.h>
int main() {
int i;
for (i=1; i < 1000; i++) {
printf("%i\n",i);
usleep(1000);
}
return 0;
}
does the right thing, i.e. running 'time ./a.out' gives output like:
1
2
...
999
real 0m1.080s
user 0m0.000s
sys 0m0.020s
Has anyone encountered this problem before, and if so, how can this be fixed? I am running ghc 7.2.1 for Linux(x86_64) on all of my machines and am running various versions of Ubuntu. It works badly on Ubuntu 10.04.2, but fine on 11.04.
threadDelay is not an accurate timer. It promises that your thread will sleep for at least as long as its argument says it should, but it doesn't promise anything more than that. If you want something to happen periodically, you will have to use something else. (I'm not sure what, but possibly Unix' realtime alarm signal would work for you.)
I suspect you forgot to compile with the '-threaded' option. (I did that once for 6.12.3, and consistently had 30 millisecond thread delays.)
As noted above, threadDelay only makes one guarantee, which is that you'll wait at least as long as you request. Haskell's runtime does not obtain special cooperation from the OS
Other than that, it's best effort from the OS.
It might be worth benchmarking your results for threadDelays. For example:
module Main where
import Control.Concurrent
import Data.Time
time op =
getCurrentTime >>= \ t0 ->
op >>
getCurrentTime >>= \ tf ->
return $! (diffUTCTime tf t0)
main :: IO ()
main =
let action tm = time (threadDelay tm) >>= putStrLn . show in
mapM action [2000,5000,10000,20000,30000,40000,50000] >>
return ()
On my windows box, this gives me:
0.0156098s
0.0156098s
0.0156098s
0.0312196s
0.0312196s
0.0468294s
0.0624392s
This suggests the combo of delay and getCurrentTime has a resolution of 15.6 milliseconds. When I loop 1000 times delay 1000, I end up waiting 15.6 seconds, so this is just the minimum wait for a thread.
On my Ubuntu box (11.04, with kernel 2.6.38-11), I get much greater precision (~100us).
It might be you can avoid the timing problem by keeping the program busier, so we don't context switch away. Either way, I would suggest you do not use threadDelay for timing, or at least check the time and perform any operations up to the given instant.
Your high-precision sleep via C might work for you, if you are willing to muck with FFI, but the cost is you'll need to use bound threads (at least for your timer).

Resources