diff --git a/cbits/ima4.c b/cbits/ima4.c new file mode 100644 --- /dev/null +++ b/cbits/ima4.c @@ -0,0 +1,115 @@ +static int index_table[16] = { + -1, -1, -1, -1, 2, 4, 6, 8, + -1, -1, -1, -1, 2, 4, 6, 8, +}; + +static int step_table[89] = { + 7, 8, 9, 10, 11, 12, 13, 14, 16, 17, + 19, 21, 23, 25, 28, 31, 34, 37, 41, 45, + 50, 55, 60, 66, 73, 80, 88, 97, 107, 118, + 130, 143, 157, 173, 190, 209, 230, 253, 279, 307, + 337, 371, 408, 449, 494, 544, 598, 658, 724, 796, + 876, 963, 1060, 1166, 1282, 1411, 1552, 1707, 1878, 2066, + 2272, 2499, 2749, 3024, 3327, 3660, 4026, 4428, 4871, 5358, + 5894, 6484, 7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899, + 15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794, 32767 +}; + +/* parse a chunk - waits a 34 bytes buffer, returns a little endian buffer */ +short decode_chunk(unsigned char *input, unsigned char *output, short predictor) +{ + char d; + int i; + short step_index; + int hnb, lnb; + int diff; + int sign, delta; + short step; + + d = *input++; + // predictor=d << 8; + d = *input++; + step_index = d & 127; + // predictor |= d&128; + + /* is this necessary ? */ + if (step_index < 0) step_index = 0; + if (step_index > 88) step_index = 88; + + step = step_table[step_index]; + + for (i=0; i<32; i++, input++) { + d = *input; + hnb = (d>>4) & 15; + lnb = d & 15; + + /* decode lnb */ + step_index += index_table[lnb]; + /* necessary ? */ + if (step_index<0) step_index = 0; + if (step_index>88) step_index = 88; + + sign = lnb & 8; + delta = lnb & 7; + diff = step >> 3; + if (delta & 4) diff += step; + if (delta & 2) diff += step >> 1; + if (delta & 1) diff += step >> 2; + /* take care of clamping (Adam Sampson ) */ + if (sign) { + int p = ((int) predictor) - diff; + if (p < -32768) + predictor = -32768; + else + predictor = p; + } else { + int p = ((int) predictor) + diff; + if (p > 32767) + predictor = 32767; + else + predictor = p; + } + + *output = predictor&255; + output++; + *output = (predictor>>8)&255; + output++; + + step = step_table[step_index]; + + /* decode hnb */ + step_index += index_table[hnb]; + if (step_index<0) step_index = 0; + if (step_index>88) step_index = 88; + + sign = hnb & 8; + delta = hnb & 7; + diff = step >> 3; + if (delta & 4) diff += step; + if (delta & 2) diff += step >> 1; + if (delta & 1) diff += step >> 2; + /* take care of clamping (Adam Sampson ) */ + if (sign) { + int p = ((int) predictor) - diff; + if (p < -32768) + predictor = -32768; + else + predictor = p; + } else { + int p = ((int) predictor) + diff; + if (p > 32767) + predictor = 32767; + else + predictor = p; + } + + *output = predictor&255; + output++; + *output = (predictor>>8)&255; + output++; + + step = step_table[step_index]; + } + + return predictor; +} diff --git a/jammittools.cabal b/jammittools.cabal --- a/jammittools.cabal +++ b/jammittools.cabal @@ -1,5 +1,5 @@ Name: jammittools -Version: 0.5.0.1 +Version: 0.5.0.2 Synopsis: Export sheet music and audio from Windows/Mac app Jammit Description: @@ -43,14 +43,15 @@ , temporary >= 1.1.2.5 && < 1.3 , transformers >= 0.3.0.0 && < 0.5 , JuicyPixels >= 3.2.2 && < 3.3 - , HPDF >= 1.4.6 && < 1.5 + , HPDF >= 1.4.7 && < 1.5 , bytestring >= 0.10.4.0 && < 0.11 , conduit >= 1.2.3.1 && < 1.3 , vector >= 0.10.12.2 && < 0.11 - , conduit-audio >= 0.1 && < 0.2 + , conduit-audio >= 0.1 && < 0.3 , resourcet ghc-options: -Wall -O2 + c-sources: cbits/ima4.c executable jammittools main-is: Main.hs @@ -61,7 +62,7 @@ , directory >= 1.2.0.1 && < 1.3 , filepath >= 1.3.0.1 && < 1.5 , boxes >= 0.1.3 && < 0.2 - , jammittools == 0.5.0.1 + , jammittools == 0.5.0.2 ghc-options: -Wall -O2 source-repository head diff --git a/src/Sound/Jammit/Internal/Audio.hs b/src/Sound/Jammit/Internal/Audio.hs --- a/src/Sound/Jammit/Internal/Audio.hs +++ b/src/Sound/Jammit/Internal/Audio.hs @@ -2,30 +2,32 @@ AIFC\/IMA audio decoding functions in this module are ported from http://sed.free.fr/aifc2wav.html -} -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ForeignFunctionInterface #-} +{-# LANGUAGE OverloadedStrings #-} module Sound.Jammit.Internal.Audio ( readIMA , writeWAV , clamp ) where -import qualified Data.Conduit as C -import qualified Data.Conduit.List as CL -import qualified Data.Vector.Storable as V -import Data.Int (Int16, Int32) -import Data.Word (Word16, Word32) -import Control.Monad.IO.Class (liftIO) -import qualified Data.ByteString as B -import Data.ByteString.Char8 () -- for IsString instance -import qualified System.IO as IO -import GHC.IO.Handle (HandlePosn(..)) -import Data.Bits (shiftL, shiftR, (.&.)) -import Control.Monad (unless, forM, liftM2) -import Control.Monad.ST (runST) -import Data.STRef (newSTRef, readSTRef, modifySTRef) +import Control.Monad (liftM2, unless) +import Control.Monad.IO.Class (liftIO) +import qualified Data.ByteString as B +import Data.ByteString.Char8 () -- for IsString instance +import qualified Data.ByteString.Unsafe as B +import qualified Data.Conduit as C +import qualified Data.Conduit.List as CL +import qualified Data.Vector.Storable as V +import Foreign (Int16, Int32, Ptr, Word16, + Word32, Word8, castPtr, + finalizerFree, mallocBytes, + newForeignPtr, shiftL, shiftR) +import GHC.IO.Handle (HandlePosn (..)) +import qualified System.IO as IO +import System.IO.Unsafe (unsafePerformIO) -import qualified Data.Conduit.Audio as A -import Control.Monad.Trans.Resource (MonadResource) +import Control.Monad.Trans.Resource (MonadResource) +import qualified Data.Conduit.Audio as A parseChunk :: IO.Handle -> IO (B.ByteString, (HandlePosn, HandlePosn)) parseChunk h = do @@ -97,57 +99,22 @@ go 0 0 frames return $ A.AudioSource src 44100 2 $ fromIntegral frames +foreign import ccall unsafe "decode_chunk" + c_decodeChunk :: Ptr Word8 -> Ptr Word8 -> Int16 -> IO Int16 + decodeChunk :: (Int16, B.ByteString) -> (Int16, V.Vector Int16) -decodeChunk (initPredictor, chunk) = runST $ do - predictor <- newSTRef initPredictor - stepIndex <- newSTRef (fromIntegral (B.index chunk 1) .&. 127 :: Int16) - let step = fmap (\si -> stepTable V.! fromIntegral si) $ readSTRef stepIndex - v <- fmap (V.fromList . concat) $ forM (B.unpack $ B.drop 2 chunk) $ \d -> do - let hnb = fromIntegral $ d `shiftR` 4 :: Int32 - lnb = fromIntegral $ d .&. 15 :: Int32 - forM [lnb, hnb] $ \nb -> do - thisStep <- step - let sign = nb .&. 8 - diff = sum - [ thisStep `shiftR` 3 - , if nb .&. 4 /= 0 then thisStep else 0 - , if nb .&. 2 /= 0 then thisStep `shiftR` 1 else 0 - , if nb .&. 1 /= 0 then thisStep `shiftR` 2 else 0 - ] - modifySTRef predictor $ \old -> let - op = if sign /= 0 then (-) else (+) - new = fromIntegral old `op` fromIntegral diff :: Int32 - in fromIntegral $ clamp (-32768, 32767) new - modifySTRef stepIndex $ \old -> - clamp (0, 88) $ old + (indexTable V.! fromIntegral nb) - readSTRef predictor - finalPredictor <- readSTRef predictor - return (finalPredictor, v) +decodeChunk (initPredictor, chunk) = unsafePerformIO $ do + B.unsafeUseAsCString chunk $ \cstr -> do + p <- mallocBytes 128 + lastPredictor <- c_decodeChunk (castPtr cstr) p initPredictor + fp <- newForeignPtr finalizerFree $ castPtr p + return (lastPredictor, V.unsafeFromForeignPtr0 fp 64) clamp :: (Ord a) => (a, a) -> a -> a clamp (vmin, vmax) v | v < vmin = vmin | v > vmax = vmax | otherwise = v - -indexTable :: V.Vector Int16 -indexTable = V.fromList - [ -1, -1, -1, -1, 2, 4, 6, 8 - , -1, -1, -1, -1, 2, 4, 6, 8 - ] - -stepTable :: V.Vector Int16 -stepTable = V.fromList - [ 7, 8, 9, 10, 11, 12, 13, 14, 16, 17 - , 19, 21, 23, 25, 28, 31, 34, 37, 41, 45 - , 50, 55, 60, 66, 73, 80, 88, 97, 107, 118 - , 130, 143, 157, 173, 190, 209, 230, 253, 279, 307 - , 337, 371, 408, 449, 494, 544, 598, 658, 724, 796 - , 876, 963, 1060, 1166, 1282, 1411, 1552, 1707, 1878, 2066 - , 2272, 2499, 2749, 3024, 3327, 3660, 4026, 4428, 4871, 5358 - , 5894, 6484, 7132, 7845, 8630, 9493, 10442, 11487, 12635, 13899 - , 15289, 16818, 18500, 20350, 22385, 24623, 27086, 29794, 32767 - ] writeWAV :: (MonadResource m) => FilePath -> A.AudioSource m Int16 -> m () writeWAV fp (A.AudioSource s r c _) = s C.$$ C.bracketP