File: PlayFile.hs

package info (click to toggle)
haskell-alut 2.2.0.0-3
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 484 kB
  • ctags: 19
  • sloc: sh: 2,811; haskell: 535; makefile: 2
file content (51 lines) | stat: -rw-r--r-- 1,623 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
{-
   PlayFile.hs (adapted from playfile.c in freealut)
   Copyright (c) Sven Panne 2005-2009 <sven.panne@aedion.de>
   This file is part of the ALUT package & distributed under a BSD-style license
   See the file libraries/ALUT/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] <- genObjectNames 1
   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)