]> gitweb @ CieloNegro.org - EsounD.git/blob - Sound/EsounD/Internals.hs
Recorder
[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     , deinterleave
15
16     , toLSV
17
18     , wrapSocket
19     , closeSocket
20     , withCStrOrNull
21     )
22     where
23 import Bindings.EsounD
24 import Data.Int
25 import Data.StorableVector      as S
26 import Data.StorableVector.Lazy as L
27 import Foreign.C.String
28 import Foreign.C.Types
29 import Foreign.Ptr
30 import Foreign.Storable
31 import System.IO
32 import System.Posix.IO
33 import System.Posix.Types
34
35 class Storable fr ⇒ Frame fr where
36     frameFmt ∷ fr → C'esd_format_t
37
38 instance Frame Int8 where
39     frameFmt _ = c'ESD_BITS8
40
41 instance Frame Int16 where
42     frameFmt _ = c'ESD_BITS16
43
44 class Channels ch where
45     channelFmt ∷ ch → C'esd_format_t
46
47 -- Mono
48 data Mono
49
50 instance Channels Mono where
51     channelFmt _ = c'ESD_MONO
52
53 -- Stereo
54 data Stereo
55
56 instance Channels Stereo where
57     channelFmt _ = c'ESD_STEREO
58
59 {-# INLINE interleave #-}
60 interleave ∷ Storable α ⇒ L.Vector α → L.Vector α → L.Vector α
61 interleave l r
62     -- THINKME: consider using storablevector-streamfusion
63     = let Just (lFr, l') = L.viewL l
64           Just (rFr, r') = L.viewL r
65           lr' = interleave l' r'
66       in
67         L.cons lFr (L.cons rFr lr')
68
69 {-# INLINE deinterleave #-}
70 deinterleave ∷ Storable α ⇒ L.Vector α → (L.Vector α, L.Vector α)
71 deinterleave v
72     -- THINKME: consider using storablevector-streamfusion
73     = let (lr, v') = L.splitAt 2 v
74       in
75         if L.null lr then
76             (L.empty, L.empty)
77         else
78             let Just (lFr, r) = L.viewL lr
79                 Just (rFr, _) = L.viewL r
80                 (l', r') = deinterleave v'
81             in
82               (L.cons lFr l', L.cons rFr r')
83
84 -- Utility functions
85 toLSV ∷ Storable α ⇒ S.Vector α → L.Vector α
86 toLSV v = L.fromChunks [v]
87
88 wrapSocket ∷ String → CInt → IO Handle
89 wrapSocket e (-1) = fail e
90 wrapSocket _ fd   = fdToHandle (Fd fd)
91
92 closeSocket ∷ Handle → IO ()
93 closeSocket h = do (Fd fd) ← handleToFd h
94                    _       ← c'esd_close (fromIntegral fd)
95                    return ()
96
97 withCStrOrNull ∷ Maybe String → (CString → IO a) → IO a
98 withCStrOrNull Nothing  f = f nullPtr
99 withCStrOrNull (Just s) f = withCString s f