]> gitweb @ CieloNegro.org - EsounD.git/blob - Sound/EsounD/Player.hs
code cleanup
[EsounD.git] / Sound / EsounD / Player.hs
1 {-# LANGUAGE
2     FlexibleContexts
3   , FlexibleInstances
4   , KindSignatures
5   , MultiParamTypeClasses
6   , UnicodeSyntax
7   , ScopedTypeVariables
8   #-}
9 -- | EsounD player streams.
10 module Sound.EsounD.Player
11     ( Player
12     , openPlayer
13     )
14     where
15 import Bindings.EsounD
16 import Control.Exception.Peel
17 import Control.Monad.IO.Class
18 import Control.Monad.IO.Peel
19 import Control.Monad.Trans.Region
20 import Control.Monad.Trans.Region.OnExit
21 import Control.Monad.Unicode
22 import Data.Bits
23 import Data.StorableVector.Lazy as L
24 import Network
25 import Prelude.Unicode
26 import Sound.EsounD.Streams
27 import Sound.EsounD.Internals
28 import System.IO
29 import System.IO.SaferFileHandles.Unsafe
30
31
32 -- ^ An opaque ESD handle for playing a stream.
33 data Player fr ch (r ∷ ★ → ★)
34     = Player {
35         plRate   ∷ !Int
36       -- THINKME: We really want to use RegionalFileHandle but we
37       -- can't, because safer-file-handles currently provides no ways
38       -- to wrap ordinary handles into safer handles.
39       , plHandle ∷ !Handle
40       , plCloseH ∷ !(FinalizerHandle r)
41       }
42
43 instance Dup (Player fr ch) where
44     dup pl = do ch' ← dup (plCloseH pl)
45                 return pl { plCloseH = ch' }
46
47 instance Frame fr ⇒ Writable (Player fr Mono) (L.Vector fr) where 
48     write pl v
49         = liftIO $ sanitizeIOError $ L.hPut (plHandle pl) v
50
51 instance Frame fr ⇒ Writable (Player fr Stereo) (L.Vector fr, L.Vector fr) where
52     write pl (l, r)
53         = liftIO $ sanitizeIOError $ L.hPut (plHandle pl) (interleave l r)
54
55 -- | Open an ESD handle for playing a stream.
56 openPlayer ∷ ∀fr ch s pr.
57                ( Frame fr
58                , Channels ch
59                , MonadPeelIO pr
60                )
61            ⇒ Int            -- ^ sample rate for the stream.
62            → Maybe HostName -- ^ host to connect to.
63            → Maybe String   -- ^ name used to identify this stream to
64                              --   ESD (if any).
65            → RegionT s pr (Player fr ch (RegionT s pr))
66 openPlayer rate host name
67     = block $
68       do h  ← liftIO openSocket
69          ch ← onExit $ sanitizeIOError $ closeSocket h
70          return Player {
71                       plRate   = rate
72                     , plHandle = h
73                     , plCloseH = ch
74                     }
75     where
76       fmt :: C'esd_format_t
77       fmt = frameFmt   ((⊥) ∷ fr) .|.
78             channelFmt ((⊥) ∷ ch) .|.
79             c'ESD_STREAM            .|.
80             c'ESD_PLAY
81
82       openSocket :: IO Handle
83       openSocket = withCStrOrNull host $ \hostPtr →
84                    withCStrOrNull name $ \namePtr →
85                        c'esd_play_stream
86                        fmt
87                        (fromIntegral rate)
88                        hostPtr
89                        namePtr
90                        ≫= wrapSocket
91                                ( "esd_play_stream("
92                                  ⧺ show fmt
93                                  ⧺ ", "
94                                  ⧺ show rate
95                                  ⧺ ", "
96                                  ⧺ show host
97                                  ⧺ ", "
98                                  ⧺ show name
99                                  ⧺ ") returned an error"
100                                )