packages feed

HCodecs 0.0.1 → 0.0.2

raw patch · 6 files changed

+44/−76 lines, 6 files

Files

HCodecs.cabal view
@@ -1,5 +1,5 @@ name: HCodecs-version: 0.0.1+version: 0.0.2 cabal-Version: >= 1.2 license: BSD3 license-file: LICENSE
src/Codec/Midi.hs view
@@ -715,39 +715,3 @@           , putVarLenBe $ fromIntegral $ L.length bs           , fromLazyByteString bs] buildSysexMessage _ = mempty----str2key :: String -> Key---str2key s = case s of---  "p" -> 64---  "0" -> 63---  "o" -> 62---  "9" -> 61---  "i" -> 60---  "u" -> 59---  "7" -> 58---  "y" -> 57---  "6" -> 56---  "t" -> 55---  "5" -> 54---  "r" -> 53---  "e" -> 52---  "3" -> 51---  "w" -> 50---  "2" -> 49---  "q" -> 48---  ---  "m" -> 59 - 12---  "j" -> 58 - 12---  "n" -> 57 - 12---  "h" -> 56 - 12---  "b" -> 55 - 12---  "g" -> 54 - 12---  "v" -> 53 - 12---  "c" -> 52 - 12---  "d" -> 51 - 12---  "x" -> 50 - 12---  "s" -> 49 - 12---  "z" -> 48 - 12---  ---  ---  _   -> 0
src/Codec/SoundFont.hs view
@@ -21,6 +21,8 @@   , Bag (..)   , Mod (..)   , Generator (..)+  , isSampleIndex+  , isInstIndex   , Inst (..)   , Shdr (..)   , importFile@@ -230,8 +232,10 @@   ModLfoToFc Int | -- 10 filter modulation: lfo1 -> filter cutoff   ModEnvToFc Int | -- 11 filter env: modEnv(aux)-> filter cutoff +  +  EndAddressCoarseOffset Int | -- 12 initial volume+     -- Amplifier-  InstVol Int | -- 12 initial volume   ModLfoToVol Int | -- 13 tremolo: lfo1-> volume   -- 14 unused @@ -286,7 +290,7 @@   CoarseTune Int | -- 51   FineTune Int | -- 52   SampleIndex Word | -- 53-  SampleMode SampleMode | -- 54+  SampleMode Audio.SampleMode | -- 54   --  55 unused   ScaleTuning Int | -- 56   ExclusiveClass Int | -- 57@@ -319,7 +323,7 @@       , ModLfoToFc i       , ModEnvToFc i     -      , InstVol i+      , EndAddressCoarseOffset i       , ModLfoToVol i            , Chorus i@@ -373,13 +377,15 @@       , ReservedGen i' i]   coarbitrary = undefined +isSampleIndex :: Generator -> Bool+isSampleIndex g = case g of+  SampleIndex _ -> True+  _ -> False  -data SampleMode = NoLoop | ContLoop | PressLoop-  deriving (Eq, Show)-  -instance Arbitrary SampleMode where-  arbitrary = oneof [return NoLoop, return ContLoop, return PressLoop]-  coarbitrary = undefined+isInstIndex :: Generator -> Bool+isInstIndex g = case g of+  InstIndex _ -> True+  _ -> False  data Inst = Inst {     instName :: String@@ -735,7 +741,7 @@   , int16le 10 >> getInt16le  >>= return . ModLfoToFc . fromIntegral   , int16le 11 >> getInt16le  >>= return . ModEnvToFc . fromIntegral     -  , int16le 12 >> getInt16le  >>= return . InstVol . fromIntegral+  , int16le 12 >> getInt16le  >>= return . EndAddressCoarseOffset . fromIntegral   , int16le 13 >> getInt16le  >>= return . ModLfoToVol . fromIntegral        , int16le 15 >> getInt16le  >>= return . Chorus . fromIntegral@@ -783,9 +789,9 @@   , int16le 53 >> getWord16le >>= return . SampleIndex . fromIntegral   , do int16le  54;  a <- getInt16le;        case a of-         1 -> return $ SampleMode ContLoop-         3 -> return $ SampleMode PressLoop-         _ -> return $ SampleMode NoLoop+         1 -> return $ SampleMode Audio.ContLoop+         3 -> return $ SampleMode Audio.PressLoop+         _ -> return $ SampleMode Audio.NoLoop   , int16le 56 >> getInt16le  >>= return . ScaleTuning . fromIntegral   , int16le 57 >> getInt16le  >>= return . ExclusiveClass . fromIntegral     @@ -810,7 +816,7 @@   ModLfoToFc i -> [putInt16le 10, putInt16le $ fromIntegral i]   ModEnvToFc i -> [putInt16le 11, putInt16le $ fromIntegral i]     -  InstVol i     -> [putInt16le 12, putInt16le $ fromIntegral i]+  EndAddressCoarseOffset i     -> [putInt16le 12, putInt16le $ fromIntegral i]   ModLfoToVol i -> [putInt16le 13, putInt16le $ fromIntegral i]       Chorus i -> [putInt16le 15, putInt16le $ fromIntegral i]@@ -855,9 +861,9 @@   FineTune i    -> [putInt16le 52, putInt16le $ fromIntegral i]   SampleIndex i -> [putInt16le 53, putWord16le $ fromIntegral i]   -  SampleMode ContLoop  -> [putInt16le 54, putInt16le 1]-  SampleMode PressLoop -> [putInt16le 54, putInt16le 3]-  SampleMode NoLoop    -> [putInt16le 54, putInt16le 2]+  SampleMode Audio.ContLoop  -> [putInt16le 54, putInt16le 1]+  SampleMode Audio.PressLoop -> [putInt16le 54, putInt16le 3]+  SampleMode Audio.NoLoop    -> [putInt16le 54, putInt16le 2]   --56   ScaleTuning i -> [putInt16le 56, putInt16le $ fromIntegral i]   ExclusiveClass i -> [putInt16le 57, putInt16le $ fromIntegral i]
src/Codec/Wav.hs view
@@ -37,9 +37,6 @@ import Control.Monad import Control.Applicative -type BitsPerSample = Int-type BytesPerSample = Int- class AudibleInWav a where   parseSample :: Parser a   buildSample :: a -> Builder@@ -65,14 +62,14 @@   buildSample = putInt64le   bitsPerSample _ = 64 -parserSelector :: (Audible a, AudibleInWav a) => BitsPerSample -> Parser a+parserSelector :: (Audible a, AudibleInWav a) => Int -> Parser a parserSelector 8  = (parseSample :: Parser Word8) >>= return . fromSample . toSample parserSelector 16 = (parseSample :: Parser Int16) >>= return . fromSample . toSample parserSelector 32 = (parseSample :: Parser Int32) >>= return . fromSample . toSample parserSelector 64 = (parseSample :: Parser Int64) >>= return . fromSample . toSample parserSelector n = fail $ show n ++ " bitsPerSample is not supported" -bytesPerSample :: (AudibleInWav a) => a -> BytesPerSample+bytesPerSample :: (AudibleInWav a) => a -> Int bytesPerSample a = div (bitsPerSample a) 8   importFile :: (IArray DiffUArray a, Audible a, AudibleInWav a) => FilePath -> IO (Either String (Audio a))@@ -114,7 +111,7 @@     + (fromIntegral $ sampleNumber sd) * (bytesPerSample $ sampleType sd)        -- sample data -parseFmt :: Parser (SampleRate,ChannelNumber,BitsPerSample)+parseFmt :: Parser (Int,Int,Int) parseFmt = do   string "fmt "   chunkSize <- getWord32le >>= return . fromIntegral@@ -150,7 +147,7 @@   avgBytesPerSec = sampleRate a * bytesPerSampleSlice    parseData :: (IArray DiffUArray a, Audible a, AudibleInWav a)-  => ChannelNumber -> BitsPerSample -> Parser (SampleData a)+  => Int -> Int -> Parser (SampleData a) parseData cn bitsPS = do   string "data"   let bytesPS = div bitsPS 8
src/Data/Audio.hs view
@@ -18,10 +18,8 @@ module Data.Audio (    Sample  , Audio (..)- , SampleRate- , ChannelNumber- , SampleNumber  , SampleData+ , SampleMode(..)  , sampleType  , sampleNumber  , convert@@ -51,8 +49,8 @@    -- It is required that sampleNummer `mod` channelNumber == 0 data Audio a = Audio {-    sampleRate :: SampleRate-  , channelNumber :: ChannelNumber+    sampleRate :: Int+  , channelNumber :: Int   , sampleData :: SampleData a   } @@ -65,11 +63,7 @@ instance (Eq e, Ix i, IArray (IOToDiffArray a) e) => Eq (IOToDiffArray a i e) where   a1 == a2 = assocs a1 == assocs a2 -type SampleRate = Int-type ChannelNumber = Int-type SampleNumber = Word64-type SampleData a = DiffUArray SampleNumber a --UArray SampleNumber a-+type SampleData a = DiffUArray Int a  instance (Show a, IArray DiffUArray a) => Show (Audio a) where   show a = "Sample Rate: " ++ (show $ sampleRate a) ++ "\n" ++@@ -88,7 +82,7 @@     return $! Audio sr cn sd   coarbitrary = undefined -sampleNumber :: (IArray DiffUArray a) => SampleData a -> SampleNumber+sampleNumber :: (IArray DiffUArray a) => SampleData a -> Int sampleNumber sd = (snd $ bounds sd) + 1  sampleType :: (IArray DiffUArray a) => SampleData a -> a@@ -107,7 +101,7 @@ -- Updating an array every time when sample is parsed -- results in a poor preformance that is why currently I am using -- list buffer and apdating array with 64 samples at once.-parseSampleData :: (IArray DiffUArray a) => SampleNumber -> Parser a -> Parser (SampleData a)+parseSampleData :: (IArray DiffUArray a) => Int -> Parser a -> Parser (SampleData a) parseSampleData sn p = pAux 0 (array (0, sn - 1) []) []   where   pAux i acc buf | (i == sn) = return $! acc // buf@@ -153,3 +147,10 @@ instance Audible Double where   toSample = id   fromSample = id+  +data SampleMode = NoLoop | ContLoop | PressLoop+  deriving (Eq, Show)+  +instance Arbitrary SampleMode where+  arbitrary = oneof [return NoLoop, return ContLoop, return PressLoop]+  coarbitrary = undefined
src/Tests/Main.hs view
@@ -62,7 +62,7 @@    c <- readFile "midiFiles.txt"   let midiFiles = lines c -  sequence_ $ map f midiFiles+  -- sequence_ $ map f midiFiles   return ()   where   f n = do@@ -87,7 +87,7 @@    c <- readFile "wavFiles.txt"   let wavFiles = lines c -  sequence_ $ map f wavFiles+  -- sequence_ $ map f wavFiles   return ()   where   f n = do@@ -114,7 +114,7 @@     c <- readFile "soundFontFiles.txt"   let soundFontFiles = lines c -  sequence_ $ map f soundFontFiles+  -- sequence_ $ map f soundFontFiles   return ()   where   f n = do