{- |
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 =
   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


-- | little endian (Intel)
{-# 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"
      [] -> []


{- |
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 ([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

{- |
Uses endianess of the machine, like Sox does.
-}
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)


{- |
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 =
   ([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)

{- |
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 =
   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))

-- 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 = 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")