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.
Related
I'm using the GHC API to parse a module. If the module contains syntax errors the GHC API writes them to stdout. This interferes with my program, which has another way to report errors. Example session:
$ prog ../stack/src/Stack/Package.hs
../stack/src/Stack/Package.hs:669:0:
error: missing binary operator before token "("
#if MIN_VERSION_Cabal(1, 22, 0)
^
../stack/src/Stack/Package.hs:783:0:
error: missing binary operator before token "("
#if MIN_VERSION_Cabal(1, 22, 0)
^
../stack/src/Stack/Package.hs
error: 1:1 argon: phase `C pre-processor' failed (exitcode = 1)
Only the last one should be outputted. How can I make sure the GHC API does not output anything? I'd like to avoid libraries like silently which solve the problem by redirecting stdout to a temporary file.
I already tried to use GHC.defaultErrorHandler, but while I can catch the exception, GHC API still writes to stdout. Relevant code:
-- | Parse a module with specific instructions for the C pre-processor.
parseModuleWithCpp :: CppOptions
-> FilePath
-> IO (Either (Span, String) LModule)
parseModuleWithCpp cppOptions file =
GHC.defaultErrorHandler GHC.defaultFatalMessager (GHC.FlushOut $ return ()) $
GHC.runGhc (Just libdir) $ do
dflags <- initDynFlags file
let useCpp = GHC.xopt GHC.Opt_Cpp dflags
fileContents <-
if useCpp
then getPreprocessedSrcDirect cppOptions file
else GHC.liftIO $ readFile file
return $
case parseFile dflags file fileContents of
GHC.PFailed ss m -> Left (srcSpanToSpan ss, GHC.showSDoc dflags m)
GHC.POk _ pmod -> Right pmod
Moreover, with this approach I cannot catch the error message (I just get ExitFailure). Removing the line with GHC.defaultErrorHandler gives me the output shown above.
Many thanks to #adamse for pointing me in the right direction! I have found the answer in Hint's code.
It suffices to override logging in the dynamic flags:
initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags
initDynFlags file = do
dflags0 <- GHC.getSessionDynFlags
src_opts <- GHC.liftIO $ GHC.getOptionsFromFile dflags0 file
(dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 src_opts
let dflags2 = dflags1 { GHC.log_action = customLogAction }
void $ GHC.setSessionDynFlags dflags2
return dflags2
customLogAction :: GHC.LogAction
customLogAction dflags severity _ _ msg =
case severity of
GHC.SevFatal -> fail $ GHC.showSDoc dflags msg
_ -> return () -- do nothing in the other cases (debug, info, etc.)
The default implementation of GHC.log_action can be found here:
http://haddock.stackage.org/lts-3.10/ghc-7.10.2/src/DynFlags.html#defaultLogAction
The code for parsing remains the same in my question, after having removed the line about GHC.defaultErrorHandler, which is no longer needed, assuming one catches exceptions himself.
I have seen this question before and then the answer was to temporarily redirect stdout and stderr.
To redirect stdout to a file as an example:
import GHC.IO.Handle
import System.IO
main = do file <- openFile "stdout" WriteMode
stdout' <- hDuplicate stdout -- you might want to keep track
-- of the original stdout
hDuplicateTo file stdout -- makes the second Handle a
-- duplicate of the first
putStrLn "hi"
hClose file
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 ()
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.
The problem i have relates to the following piece of code:
module Main(main) where
import qualified Media.Streaming.GStreamer as GS
import Data.Maybe
import System.IO
import System.Exit
import System.Glib.MainLoop as Glib
import System.Glib.Signals as Glib
import System.Glib.Properties as Glib
makeElement:: String → String → IO GS.Element
makeElement elementType elementName = do
element ← GS.elementFactoryMake elementType (Just elementName)
case element of
Just element' → return element'
Nothing → do
hPutStrLn stdout ("Cannot create element!")
hFlush stdout
exitFailure
player = do
GS.init
pipeline ← GS.pipelineNew "video-stream"
source ← makeElement "v4l2src" "video-source"
color ← makeElement "ffmpegcolorspace" "video-color"
tee ← makeElement "tee" "stream-tee"
rQ ← makeElement "queue" "record-queue"
vQ ← makeElement "queue" "video-queue"
encoder ← makeElement "y4menc" "video-encoder"
rSink ← makeElement "filesink" "record-sink"
sink ← makeElement "ximagesink" "video-sink"
let elements = [source,color,encoder,rSink,vQ,rQ,sink,tee]
Glib.objectSetPropertyString "location" rSink "rec"
mapM_ (GS.binAdd (GS.castToBin pipeline)) elements
-- Request Pads from tee
dPad ← GS.elementGetRequestPad tee "src%d"
rPad ← GS.elementGetRequestPad tee "src%d"
-- Request Static Pads from queue
sDPad ← GS.elementGetStaticPad vQ "sink"
sRPad ← GS.elementGetStaticPad rQ "sink"
-- Link tee source to queue sink
GS.padLink (fromJust dPad) (fromJust sDPad)
GS.padLink (fromJust rPad) (fromJust sRPad)
GS.elementReleaseRequestPad tee $ fromJust dPad
GS.elementReleaseRequestPad tee $ fromJust rPad
GS.elementLink source color
GS.elementLink color tee
GS.elementLink vQ sink
GS.elementLink rQ encoder
GS.elementLink encoder rSink
GS.elementSetState pipeline GS.StatePlaying
main = do
loop ← Glib.mainLoopNew Nothing False
player
Glib.mainLoopRun loop
The code compiles fine, camera LED switches ON and the file is created but then NOTHING.
Without the tee and queue elements, the separate setup for recording/displaying video works just fine.Also, the same pipeline works perfectly if i test it with gst-launch.
I'm missing something here on how gstreamer works but i can't figure out what.
Also, if it helps, i'm building on ArchLinux using:
- GHC 7.0.3 ;
- gstreamer-bindings 0.12.1 ;
- gtk2hs 0.12.2 ;
- gstreamer 0.10.35-1 ;
- glib 1.2.10-9 .
RESOLVED
I found my solution, and what follows is a lengthy post but please, bear with me. I must share my frustration with someone.
After many more buggy tries i decided to go back to testing some setups using gst-launch.
This helped me to find out that after the queue element that buffers the part which goes to the filesink i needed another ffmpegcolorspace element to setup the correct video format i think.
At this point i was not going back to trying this thing out it Haskell again, i thought i needed to get 'closer' so i decided to try it in C.
As a side note , i don't know C , i can understand the syntax but that's about it...and for goodness sake i'm just now trying to learn Haskell.
To continue, i decided to also try using 'GS.elementGetCompatiblePad' on the tee element so i can be sure that the pads will link with the queue.
The C code i stitched together is this :
#include <gst/gst.h>
#include <glib.h>
int
main (int argc,char *argv[])
{
GstElement *pipeline, *source, *color, *color2 , *color3, *tee, *rQ, *vQ, *encoder, *fSink , *sink;
GMainLoop *loop;
loop = g_main_loop_new (NULL,FALSE);
/* initialize gstreamer */
gst_init(&argc,&argv);
/* creating elements */
pipeline = gst_pipeline_new("stream-pipeline");
source = gst_element_factory_make ("v4l2src","stream-source");
color = gst_element_factory_make ("ffmpegcolorspace","video-color");
tee = gst_element_factory_make ("tee","stream-tee");
rQ = gst_element_factory_make ("queue","record-queue");
vQ = gst_element_factory_make ("queue","video-queue");
encoder = gst_element_factory_make ("theoraenc","video-encoder");
fSink = gst_element_factory_make ("filesink","record-sink");
sink = gst_element_factory_make ("ximagesink","video-sink");
color2 = gst_element_factory_make ("ffmpegcolorspace","video-color2");
color3 = gst_element_factory_make ("ffmpegcolorspace","video-color3");
/*check that the elements were created */
if (!source || !color || !tee || !rQ || !vQ || !encoder || !fSink || !sink){
g_printerr("One element could not be created!");
return -1;
}
/*set file output location */
g_object_set(G_OBJECT (fSink),"location","rec",NULL);
gst_bin_add_many (GST_BIN(pipeline),
source,color,color2,color3,tee,rQ,vQ,encoder,fSink,sink,NULL);
/* get request pads */
GstPad *dPad, *rPad, *sDPad, *sRPad;
sDPad = gst_element_get_static_pad(vQ,"sink");
sRPad = gst_element_get_static_pad(rQ,"sink");
dPad = gst_element_get_compatible_pad(tee,sDPad,GST_CAPS_ANY);
rPad = gst_element_get_compatible_pad(tee,sRPad,GST_CAPS_ANY);
/*link pads*/
gst_pad_link(dPad,sDPad);
gst_pad_link(rPad,sRPad);
/*unref pads */
gst_object_unref(GST_OBJECT(dPad));
gst_object_unref(GST_OBJECT(rPad));
gst_object_unref(GST_OBJECT(sDPad));
gst_object_unref(GST_OBJECT(sRPad));
/*link elements */
gst_element_link(source,tee);
gst_element_link_many(rQ,color2,encoder,fSink,NULL);
gst_element_link_many(vQ,color3,sink),NULL;
/*set the pipeline state to playing */
gst_element_set_state(pipeline,GST_STATE_PLAYING);
g_main_loop_run (loop);
gst_element_set_state(pipeline,GST_STATE_NULL);
gst_object_unref(GST_OBJECT(pipeline));
return 0;
}
In order to use 'gst_element_get_compatible_pad' i had to first get static pads from the queue elements so i hand to switch those four related lines.
I try it out, and Abracadabra ...oh no, wait ... camera starts, the file is created and a window with the 'video' pops, but a black window that remains black!
No problem i say , run the program with gst-debug-level=5 ( =)) ) yea, right , try reading the whole output.I give up for the moment and i thought maybe it has something to do with the elements in my pipeline not working right together so i code another pipeline in C but this time something more simple just with audio files.
I had the same result so i decided tu debug again, this time with runlevel 3 and i started reading the whole thing,line by line.
Somewhere in there i found this:
trying to link stream-tee:src0 and record-queue:sink
trying to link stream-tee:src0 and video-queue:sink
something nasty is happening here
linked stream-tee:src0 and video-queue:sink,successful
trying to link stream-tee:src0 and record-queue:sink
src stream-tee:src0 was already linked with video-queue:sink
And it gives up!
I guess i must go back using gst_element_get_request_pad, but haven't i tried that already?
So i switch back to vim and replace all occurrences of 'gst_element_get_compatible_pad with the request counterpart like so:
sDPad = gst_element_get_static_pad(vQ,"sink");
sRPad = gst_element_get_static_pad(rQ,"sink");
dPad = gst_element_get_request_pad(tee,"src%d");
rPad = gst_element_get_request_pad(tee,"src%d");
I gaze upon this code and i say to myself 'you twit', this is where it all started; take a deep breath ; after all this is what the debugger complains about so i compile , i run, and Voila. I found my solution.
Those four lines had to be reversed, i had to first get a reference to the static pads and then request a reference to a 'request' pad on the tee element.
I go back to haskell a happy man.I implement my solution, compile, fire up,camera starts, the file is created and ... just like that..nothing, not even the black screen.
Filled with anger i just comment out the lines where i release the request pads and decide to compile and run once more, my neck started to hurt a while ago.
Again, by magic it all works , i have video on the screen and in the file.
I guess Haskell just likes to hold tighter and sometimes you have to just go with something that makes no sense. The gstreamer docs state clearly release,release,release.
The final haskell code:
module Main(main) where
import qualified Media.Streaming.GStreamer as GS
import Data.Maybe
import System.Exit
import System.Glib.MainLoop as Glib
import System.Glib.Signals as Glib
import System.Glib.Properties as Glib
makeElement:: String → String → IO GS.Element
makeElement elementType elementName = do
element ← GS.elementFactoryMake elementType (Just elementName)
case element of
Just element' → return element'
Nothing → do
putStrLn "Cannot create element!"
exitFailure
linkSPadToStaticSink::(GS.ElementClass object, GS.ElementClass elementT) ⇒ object → elementT → IO (Glib.ConnectId object)
linkSPadToStaticSink elSrc elSink = do
Glib.on elSrc GS.elementPadAdded (λpad → do
sinkPad ← GS.elementGetStaticPad elSink "sink"
GS.padLink pad (fromJust sinkPad)
return ∅)
player = do
GS.init
pipeline ← GS.pipelineNew "video-stream"
source ← makeElement "v4l2src" "video-source"
color ← makeElement "ffmpegcolorspace" "video-color"
color2 ← makeElement "ffmpegcolorspace" "video-color2"
tee ← makeElement "tee" "stream-tee"
rQ ← makeElement "queue" "record-queue"
vQ ← makeElement "queue" "video-queue"
encoder ← makeElement "y4menc" "video-encoder"
rSink ← makeElement "filesink" "record-sink"
sink ← makeElement "ximagesink" "video-sink"
let elements = [source,color,color2,encoder,rSink,vQ,rQ,sink,tee]
Glib.objectSetPropertyString "location" rSink "rec"
mapM_ (GS.binAdd (GS.castToBin pipeline)) elements
-- Get static pads from queue elements
sDPad ← GS.elementGetStaticPad vQ "sink"
sRPad ← GS.elementGetStaticPad rQ "sink"
-- Request pads from tee element
dPad ← GS.elementGetRequestPad tee "src%d"
rPad ← GS.elementGetRequestPad tee "src%d"
-- Link tee source to queue sink
GS.padLink (fromJust dPad) (fromJust sDPad)
GS.padLink (fromJust rPad) (fromJust sRPad)
GS.elementLink source color
GS.elementLink color tee
GS.elementLink vQ sink
GS.elementLink rQ color2
GS.elementLink color2 encoder
GS.elementLink encoder rSink
GS.elementSetState pipeline GS.StatePlaying
main = do
loop ← Glib.mainLoopNew Nothing False
player
Glib.mainLoopRun loop
Now i ask you, should/could i have seen this ?
Was it that obvious ?
I'm glad this will make me be more careful and look in not so obvious places but...eww.
In conclusion to all this, i learned about the gstreamer debug options, i learned that it whispers to me and i MUST listen. I learned about GDB being forced to used because when i began stitching C code all i got was a 'seg fault'.I learned to love lazy-eval and pure Haskell code. A little bit of Haskell, maybe a tiny bit of C and more experience.
'Lost' about half a day, three classes and several hours of sleep but after all...So it goes...
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).