module Synthesizer.Plain.IO
{-# DEPRECATED "Use Sound.Sox.Signal.List instead." #-}
(
writeInt16Stream, readInt16StreamStrict,
writeLEInt16Stream, readLEInt16Stream,
putInt16Stream, putInt16StreamChunky,
intToTwoLEChars, twoLECharsToInt,
) where
import Foreign (Int16, Ptr, alloca, sizeOf, poke, peek)
import System.IO
(openBinaryFile, IOMode(WriteMode,ReadMode), hClose,
Handle, hPutBuf, hGetBuf)
import Control.Exception (bracket, )
import Control.Monad (liftM, )
import qualified Data.ByteString.Lazy as B
import qualified Data.Binary.Builder as Builder
import Data.Monoid (mconcat, )
import Data.Char (ord, )
import NumericPrelude.Numeric
import NumericPrelude.Base
import qualified Prelude as P98
{-# INLINE leCharsToInt16 #-}
leCharsToInt16 :: Char -> Char -> Int16
leCharsToInt16 :: Char -> Char -> Int16
leCharsToInt16 Char
hi Char
lo =
Int -> Int16
forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral (Int -> Int16) -> Int -> Int16
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
lo Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
256 Int -> Int -> Int
forall a. C a => a -> a -> a
* Char -> Int
ord Char
hi
twoLECharsToInt :: Char -> Char -> Int
twoLECharsToInt :: Char -> Char -> Int
twoLECharsToInt Char
hi Char
lo =
let unsigned :: Int
unsigned = Char -> Int
ord Char
lo Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
256 Int -> Int -> Int
forall a. C a => a -> a -> a
* Char -> Int
ord Char
hi
in Int -> Int -> Int
forall a. C a => a -> a -> a
mod (Int
unsigned Int -> Int -> Int
forall a. C a => a -> a -> a
+ Int
32768) Int
65536 Int -> Int -> Int
forall a. C a => a -> a -> a
- Int
32768
{-# INLINE int16ToLEChars #-}
int16ToLEChars :: Int16 -> [Char]
int16ToLEChars :: Int16 -> [Char]
int16ToLEChars Int16
x =
let (Int
hi,Int
lo) = Int -> Int -> (Int, Int)
forall a. C a => a -> a -> (a, a)
divMod (Int16 -> Int
forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral Int16
x) Int
256
in [Int -> Char
forall a. Enum a => Int -> a
toEnum Int
lo, Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Int -> Int
forall a. C a => a -> a -> a
mod Int
hi Int
256)]
intToTwoLEChars :: Int -> [Char]
intToTwoLEChars :: Int -> [Char]
intToTwoLEChars Int
x =
let (Int
hi,Int
lo) = Int -> Int -> (Int, Int)
forall a. C a => a -> a -> (a, a)
divMod Int
x Int
256
in [Int -> Char
forall a. Enum a => Int -> a
toEnum Int
lo, Int -> Char
forall a. Enum a => Int -> a
toEnum (Int -> Int -> Int
forall a. C a => a -> a -> a
mod Int
hi Int
256)]
{-# INLINE binaryToIntsMono16 #-}
binaryToIntsMono16 :: [Char] -> [Int16]
binaryToIntsMono16 :: [Char] -> [Int16]
binaryToIntsMono16 [Char]
sig =
case [Char]
sig of
(Char
lo:Char
hi:[Char]
xs) ->
Char -> Char -> Int16
leCharsToInt16 Char
hi Char
lo Int16 -> [Int16] -> [Int16]
forall a. a -> [a] -> [a]
: [Char] -> [Int16]
binaryToIntsMono16 [Char]
xs
(Char
_:[]) ->
[Char] -> [Int16]
forall a. HasCallStack => [Char] -> a
error [Char]
"binaryToIntsMono16: 16 bit sample files must have even length"
[] -> []
writeLEInt16Stream :: FilePath -> [Int16] -> IO ()
writeLEInt16Stream :: [Char] -> [Int16] -> IO ()
writeLEInt16Stream [Char]
fileName =
[Char] -> [Char] -> IO ()
writeFile [Char]
fileName ([Char] -> IO ()) -> ([Int16] -> [Char]) -> [Int16] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int16 -> [Char]) -> [Int16] -> [Char]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int16 -> [Char]
int16ToLEChars
writeInt16Stream :: FilePath -> [Int16] -> IO ()
writeInt16Stream :: [Char] -> [Int16] -> IO ()
writeInt16Stream [Char]
fileName [Int16]
stream =
IO Handle -> (Handle -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([Char] -> IOMode -> IO Handle
openBinaryFile [Char]
fileName IOMode
WriteMode) Handle -> IO ()
hClose
((Handle -> [Int16] -> IO ()) -> [Int16] -> Handle -> IO ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Handle -> [Int16] -> IO ()
putInt16Stream [Int16]
stream)
putInt16StreamChunky :: Handle -> [Int16] -> IO ()
putInt16StreamChunky :: Handle -> [Int16] -> IO ()
putInt16StreamChunky Handle
h =
Handle -> ByteString -> IO ()
B.hPut Handle
h (ByteString -> IO ())
-> ([Int16] -> ByteString) -> [Int16] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> ByteString)
-> ([Int16] -> Builder) -> [Int16] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> ([Int16] -> [Builder]) -> [Int16] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int16 -> Builder) -> [Int16] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Word16 -> Builder
Builder.putWord16host (Word16 -> Builder) -> (Int16 -> Word16) -> Int16 -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int16 -> Word16
forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral)
putInt16Stream :: Handle -> [Int16] -> IO ()
putInt16Stream :: Handle -> [Int16] -> IO ()
putInt16Stream Handle
h [Int16]
stream =
(Ptr Int16 -> IO ()) -> IO ()
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int16 -> IO ()) -> IO ()) -> (Ptr Int16 -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Ptr Int16
p -> (Int16 -> IO ()) -> [Int16] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> Ptr Int16 -> Int16 -> IO ()
putInt16 Handle
h Ptr Int16
p) [Int16]
stream
putInt16 :: Handle -> Ptr Int16 -> Int16 -> IO ()
putInt16 :: Handle -> Ptr Int16 -> Int16 -> IO ()
putInt16 Handle
h Ptr Int16
p Int16
n =
Ptr Int16 -> Int16 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int16
p Int16
n IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> Ptr Int16 -> Int -> IO ()
forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr Int16
p (Int16 -> Int
forall a. Storable a => a -> Int
sizeOf Int16
n)
readLEInt16Stream :: FilePath -> IO [Int16]
readLEInt16Stream :: [Char] -> IO [Int16]
readLEInt16Stream [Char]
fileName =
([Char] -> [Int16]) -> IO [Char] -> IO [Int16]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> [Int16]
binaryToIntsMono16 ([Char] -> IO [Char]
readFile [Char]
fileName)
readInt16StreamStrict :: FilePath -> IO [Int16]
readInt16StreamStrict :: [Char] -> IO [Int16]
readInt16StreamStrict [Char]
fileName =
IO Handle
-> (Handle -> IO ()) -> (Handle -> IO [Int16]) -> IO [Int16]
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket ([Char] -> IOMode -> IO Handle
openBinaryFile [Char]
fileName IOMode
ReadMode) Handle -> IO ()
hClose
Handle -> IO [Int16]
getInt16StreamStrict
getInt16StreamStrict :: Handle -> IO [Int16]
getInt16StreamStrict :: Handle -> IO [Int16]
getInt16StreamStrict Handle
h =
(Ptr Int16 -> IO [Int16]) -> IO [Int16]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr Int16 -> IO [Int16]) -> IO [Int16])
-> (Ptr Int16 -> IO [Int16]) -> IO [Int16]
forall a b. (a -> b) -> a -> b
$
\Ptr Int16
p -> ([Int16] -> [Int16]) -> IO [Int16] -> IO [Int16]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Int16 -> Int16) -> [Int16] -> [Int16]
forall a b. (a -> b) -> [a] -> [b]
map Int16 -> Int16
forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral)
(IO (Maybe Int16) -> IO [Int16]
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
unfoldM (Handle -> Ptr Int16 -> IO (Maybe Int16)
getInt16 Handle
h Ptr Int16
p))
unfoldM :: Monad m => m (Maybe a) -> m [a]
unfoldM :: forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
unfoldM m (Maybe a)
act =
let listM :: m [a]
listM = m [a] -> (a -> m [a]) -> Maybe a -> m [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([a] -> m [a]
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return []) (\a
x -> ([a] -> [a]) -> m [a] -> m [a]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:) m [a]
listM) (Maybe a -> m [a]) -> m (Maybe a) -> m [a]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe a)
act
in m [a]
listM
getInt16 :: Handle -> Ptr Int16 -> IO (Maybe Int16)
getInt16 :: Handle -> Ptr Int16 -> IO (Maybe Int16)
getInt16 Handle
h Ptr Int16
p =
do Int
cnt <- Handle -> Ptr Int16 -> Int -> IO Int
forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Int16
p (Int16 -> Int
forall a. Storable a => a -> Int
sizeOf (Int16
forall a. HasCallStack => a
undefined::Int16))
case Int
cnt of
Int
0 -> Maybe Int16 -> IO (Maybe Int16)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int16
forall a. Maybe a
Nothing
Int
2 -> (Int16 -> Maybe Int16) -> IO Int16 -> IO (Maybe Int16)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int16 -> Maybe Int16
forall a. a -> Maybe a
Just (Ptr Int16 -> IO Int16
forall a. Storable a => Ptr a -> IO a
peek Ptr Int16
p)
Int
_ -> Maybe Int16 -> IO (Maybe Int16)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Maybe Int16
forall a. HasCallStack => [Char] -> a
error [Char]
"getInt16: only one byte found")