]> gitweb @ CieloNegro.org - EsounD.git/blob - Sound/EsounD/Internals.hs
Give up using type families for stream muxing
[EsounD.git] / Sound / EsounD / Internals.hs
1 {-# LANGUAGE
2     EmptyDataDecls
3   , FlexibleInstances
4   , MultiParamTypeClasses
5   , UnicodeSyntax
6   #-}
7 module Sound.EsounD.Internals
8     ( Frame(..)
9
10     , Channels(..)
11     , Mono
12     , Stereo
13     , interleave
14
15     , wrapSocket
16     , closeSocket
17     , withCStrOrNull
18     )
19     where
20 import Bindings.EsounD
21 import Data.Int
22 import Data.StorableVector.Lazy as L
23 import Foreign.C.String
24 import Foreign.C.Types
25 import Foreign.Ptr
26 import Foreign.Storable
27 import System.IO
28 import System.Posix.IO
29 import System.Posix.Types
30
31 class Storable fr ⇒ Frame fr where
32     frameFmt ∷ fr → C'esd_format_t
33
34 instance Frame Int8 where
35     frameFmt _ = c'ESD_BITS8
36
37 instance Frame Int16 where
38     frameFmt _ = c'ESD_BITS16
39
40 class Channels ch where
41     channelFmt ∷ ch → C'esd_format_t
42
43 -- Mono
44 data Mono
45
46 instance Channels Mono where
47     channelFmt _ = c'ESD_MONO
48
49 -- Stereo
50 data Stereo
51
52 instance Channels Stereo where
53     channelFmt _ = c'ESD_STEREO
54
55 interleave ∷ Frame fr ⇒ L.Vector fr → L.Vector fr → L.Vector fr
56 interleave l r
57     -- THINKME: consider using storablevector-streamfusion
58     = let Just (lFr, l') = L.viewL l
59           Just (rFr, r') = L.viewL r
60           lr' = interleave l' r'
61       in
62         L.cons lFr (L.cons rFr lr')
63
64 -- Utility functions
65 wrapSocket ∷ String → CInt → IO Handle
66 wrapSocket e (-1) = fail e
67 wrapSocket _ fd   = fdToHandle (Fd fd)
68
69 closeSocket ∷ Handle → IO ()
70 closeSocket h = do (Fd fd) ← handleToFd h
71                    _       ← c'esd_close (fromIntegral fd)
72                    return ()
73
74 withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a
75 withCStrOrNull Nothing  f = f nullPtr
76 withCStrOrNull (Just s) f = withCString s f