{- |
This is old code, handling Int16 using two characters.
-}
module Synthesizer.Plain.IO
   {-# DEPRECATED "Use Sound.Sox.Signal.List instead." #-}
   (
    writeInt16Stream, readInt16StreamStrict,
    writeLEInt16Stream, readLEInt16Stream,
    putInt16Stream, putInt16StreamChunky,
    -- historical functions
    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



-- | little endian (Intel)
{-# INLINE leCharsToInt16 #-}
leCharsToInt16 :: Char -> Char -> Int16
leCharsToInt16 :: Char -> Char -> Int16
leCharsToInt16 Char
hi Char
lo =
   forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
lo forall a. C a => a -> a -> a
+ Int
256 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 forall a. C a => a -> a -> a
+ Int
256 forall a. C a => a -> a -> a
* Char -> Int
ord Char
hi
   in  forall a. C a => a -> a -> a
mod (Int
unsigned forall a. C a => a -> a -> a
+ Int
32768) Int
65536 forall a. C a => a -> a -> a
- Int
32768


-- | little endian (Intel)
{-# INLINE int16ToLEChars #-}
int16ToLEChars :: Int16 -> [Char]
int16ToLEChars :: Int16 -> [Char]
int16ToLEChars Int16
x =
   let (Int
hi,Int
lo) = forall a. C a => a -> a -> (a, a)
divMod (forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral Int16
x) Int
256
   in  [forall a. Enum a => Int -> a
toEnum Int
lo, forall a. Enum a => Int -> a
toEnum (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) = forall a. C a => a -> a -> (a, a)
divMod Int
x Int
256
   in  [forall a. Enum a => Int -> a
toEnum Int
lo, forall a. Enum a => Int -> a
toEnum (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 forall a. a -> [a] -> [a]
: [Char] -> [Int16]
binaryToIntsMono16 [Char]
xs
      (Char
_:[]) ->
         forall a. HasCallStack => [Char] -> a
error [Char]
"binaryToIntsMono16: 16 bit sample files must have even length"
      [] -> []


{- |
Write a little endian 16 bit integer stream
via String data and 'writeFile'.
-}
writeLEInt16Stream :: FilePath -> [Int16] -> IO ()
writeLEInt16Stream :: [Char] -> [Int16] -> IO ()
writeLEInt16Stream [Char]
fileName =
   [Char] -> [Char] -> IO ()
writeFile [Char]
fileName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Int16 -> [Char]
int16ToLEChars

{- |
Uses endianess of the machine, like Sox does.
-}
writeInt16Stream :: FilePath -> [Int16] -> IO ()
writeInt16Stream :: [Char] -> [Int16] -> IO ()
writeInt16Stream [Char]
fileName [Int16]
stream =
   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
      (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   forall a. Monoid a => [a] -> a
mconcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (Word16 -> Builder
Builder.putWord16host forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral)

putInt16Stream :: Handle -> [Int16] -> IO ()
putInt16Stream :: Handle -> [Int16] -> IO ()
putInt16Stream Handle
h [Int16]
stream =
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$
      \Ptr Int16
p -> 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 =
   forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr Int16
p Int16
n forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. Handle -> Ptr a -> Int -> IO ()
hPutBuf Handle
h Ptr Int16
p (forall a. Storable a => a -> Int
sizeOf Int16
n)


{- |
The end of the list is undefined,
if the file has odd length.
It would be better if it throws an exception.
-}
readLEInt16Stream :: FilePath -> IO [Int16]
readLEInt16Stream :: [Char] -> IO [Int16]
readLEInt16Stream [Char]
fileName =
   forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Char] -> [Int16]
binaryToIntsMono16 ([Char] -> IO [Char]
readFile [Char]
fileName)

{- |
The end of the list is undefined,
if the file has odd length.
It would be better if it throws an exception.
-}
readInt16StreamStrict :: FilePath -> IO [Int16]
readInt16StreamStrict :: [Char] -> IO [Int16]
readInt16StreamStrict [Char]
fileName =
   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 =
   forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca forall a b. (a -> b) -> a -> b
$
      \Ptr Int16
p -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (Integral a, Num b) => a -> b
P98.fromIntegral)
                 (forall (m :: * -> *) a. Monad m => m (Maybe a) -> m [a]
unfoldM (Handle -> Ptr Int16 -> IO (Maybe Int16)
getInt16 Handle
h Ptr Int16
p))

-- candidate for Utility
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 = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return []) (\a
x -> forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM (a
xforall a. a -> [a] -> [a]
:) m [a]
listM) 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 <- forall a. Handle -> Ptr a -> Int -> IO Int
hGetBuf Handle
h Ptr Int16
p (forall a. Storable a => a -> Int
sizeOf (forall a. HasCallStack => a
undefined::Int16))
      case Int
cnt of
        Int
0 -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
        Int
2 -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. a -> Maybe a
Just (forall a. Storable a => Ptr a -> IO a
peek Ptr Int16
p)
        Int
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. HasCallStack => [Char] -> a
error [Char]
"getInt16: only one byte found")