packages feed

sample-frame (empty) → 0.0.1

raw patch · 6 files changed

+304/−0 lines, 6 filesdep +QuickCheckdep +basedep +special-functorssetup-changed

Dependencies added: QuickCheck, base, special-functors, storable-record

Files

+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2009, Henning Thielemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * The names of contributors may not be used to endorse or promote+      products derived from this software without specific prior+      written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#! /usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ sample-frame.cabal view
@@ -0,0 +1,50 @@+Name:             sample-frame+Version:          0.0.1+License:          BSD3+License-File:     LICENSE+Author:           Henning Thielemann <haskell@henning-thielemann.de>+Maintainer:       Henning Thielemann <haskell@henning-thielemann.de>+Homepage:         http://www.haskell.org/haskellwiki/Synthesizer+Package-URL:      http://code.haskell.org/~thielema/sample-frame/core/+Category:         Sound+Synopsis:         Handling of samples in an (audio) signal+Description:+   This package provides a type class+   to handle signed and unsigned samples+   of various size and number of channels in a uniform way.+   .+   We expect that you use the types Int8, Word8 and so on+   for monophonic samples and thus provide instances of the class for them.+   Further we define Stereo record and mu-law sample type.+   Quadrophony can be achieved by nested Stereo value,+   but I'm uncertain, whether this is a good way to go.+   Maybe we add 5+1 channels or so in future.+   .+   This is used by packages sox, alsa, synthesizer.+Tested-With:       GHC==6.10.4+Cabal-Version:     >=1.2+Build-Type:        Simple++Flag splitBase+  description: Choose the new smaller, split-up base package.++Library+  Build-Depends:+    storable-record >=0.0.1 && <0.1,+    QuickCheck >= 1.0 && <2.0+  If flag(splitBase)+    Build-Depends:+      base >= 2 && <5+  Else+    Build-Depends:+      special-functors >= 1.0 && <1.1,+      base >= 1.0 && < 2++  Hs-Source-Dirs: src++  GHC-Options: -Wall++  Exposed-Modules:+    Sound.Frame+    Sound.Frame.Stereo+    Sound.Frame.MuLaw
+ src/Sound/Frame.hs view
@@ -0,0 +1,52 @@+module Sound.Frame where++import Data.Word (Word8, Word16, Word32, )+import Data.Int (Int8, Int16, Int32, )+import Foreign.Storable (sizeOf, )+++class C y where+   {- | The argument is not touched and can be undefined -}+   numberOfChannels :: y -> Int+   {- |+   Size of elements.+   In a nested record type, like @Stereo (Stereo a)@,+   it is the size of the atomic element, in our example @a@.+   -}+   sizeOfElement :: y -> Int++instance C Word8 where+   numberOfChannels _ = 1+   sizeOfElement = sizeOf++instance C Int8 where+   numberOfChannels _ = 1+   sizeOfElement = sizeOf++instance C Word16 where+   numberOfChannels _ = 1+   sizeOfElement = sizeOf++instance C Int16 where+   numberOfChannels _ = 1+   sizeOfElement = sizeOf++instance C Word32 where+   numberOfChannels _ = 1+   sizeOfElement = sizeOf++instance C Int32 where+   numberOfChannels _ = 1+   sizeOfElement = sizeOf++instance C Float where+   numberOfChannels _ = 1+   sizeOfElement = sizeOf++instance C Double where+   numberOfChannels _ = 1+   sizeOfElement = sizeOf+++withSignal :: (y -> a) -> (sig y -> a)+withSignal f _ = f undefined
+ src/Sound/Frame/MuLaw.hs view
@@ -0,0 +1,98 @@+{-+This data type can be used as sample type for stereo signals.+-}+module Sound.Frame.MuLaw (T, cons, decons, fromLinear16, toLinear16, ) where++import qualified Sound.Frame as Frame++import Foreign.Storable.Newtype as Store+import Foreign.Storable (Storable (..), )++import Data.Word (Word8, )+import Data.Int (Int16, )++import Test.QuickCheck (Arbitrary(arbitrary, coarbitrary), )++import Prelude hiding (map, )+++newtype T = Cons Word8+   deriving (Eq)+++instance Show T where+   showsPrec p x =+      showParen (p >= 10)+         (showString "MuLaw.cons " . shows (decons x))++instance Arbitrary T where+   arbitrary = fmap (cons . fromIntegral :: Int -> T) arbitrary+   coarbitrary = error "MuLaw.coarbitrary not implemented"+++{-# INLINE cons #-}+cons :: Word8 -> T+cons = Cons++{-# INLINE decons #-}+decons :: T -> Word8+decons (Cons a) = a+++{-# INLINE fromLinear16 #-}+fromLinear16 :: Int16 -> T+fromLinear16 x16 =+   let x = fromIntegral x16 :: Int+       logi e y =+          if y < 16+            then e*16 + y+            else logi (e+1) (div (y - 16) 2)+       loga = min 127 . logi 0 . flip div 8+   in  cons . fromIntegral $+       if x >= -2+         then 255 - loga (x+6)+         else 127 - loga (5-x)++{-# INLINE toLinear16 #-}+toLinear16 :: T -> Int16+toLinear16 ymu =+   let y = fromIntegral (decons ymu) :: Int+       (e,m) = divMod y 16+   in  fromIntegral $+       if e>=8+         then (2^(15-e) * ((15-m)*2 + 33) - 33) * 4+         else (2^ (7-e) * ((m-15)*2 - 33) + 33) * 4+{-+         then ((15-m) * 2^(16-e) + (2^(15-e) - 1) * 33) * 4+         else ((m-15) * 2^(8-e) - (2^(7-e) - 1) * 33) * 4+-}+++{-+propZero :: Bool+propZero =+   fromLinear16 0 == cons 255 &&+   toLinear16 (cons 255) == 0++propLinear :: T -> Bool+propLinear x =+   fromLinear16 (toLinear16 x) == x+-}+++instance Storable T where+   {-# INLINE sizeOf #-}+   sizeOf = Store.sizeOf decons+   {-# INLINE alignment #-}+   alignment = Store.alignment decons+   {-# INLINE peek #-}+   peek = Store.peek cons+   {-# INLINE poke #-}+   poke = Store.poke decons+++instance Frame.C T where+   {-# INLINE numberOfChannels #-}+   numberOfChannels _ = 1+   {-# INLINE sizeOfElement #-}+   sizeOfElement = Store.sizeOf decons
+ src/Sound/Frame/Stereo.hs view
@@ -0,0 +1,70 @@+{-+This data type can be used as sample type for stereo signals.+-}+module Sound.Frame.Stereo (T, left, right, cons, map, ) where++import qualified Sound.Frame as Frame++import Control.Applicative (liftA2, )+import Control.Monad (liftM2, )++import Foreign.Storable.Record as Store+import Foreign.Storable (Storable (..), )++import Test.QuickCheck (Arbitrary(arbitrary, coarbitrary), )++import Prelude hiding (map, )+++data T a = Cons {left, right :: !a}+   deriving (Eq)+++instance Show a => Show (T a) where+   showsPrec p x =+      showParen (p >= 10)+         (showString "Stereo.cons " . showsPrec 11 (left x) .+          showString " " . showsPrec 11 (right x))++instance (Arbitrary a) => Arbitrary (T a) where+   arbitrary = liftM2 cons arbitrary arbitrary+   coarbitrary = error "Stereo.coarbitrary not implemented"+++{-# INLINE cons #-}+cons :: a -> a -> T a+cons = Cons++{-# INLINE map #-}+map :: (a -> b) -> T a -> T b+map f (Cons l r) = Cons (f l) (f r)++instance Functor T where+   {-# INLINE fmap #-}+   fmap = map+++{-# INLINE store #-}+store :: Storable a => Store.Dictionary (T a)+store =+   Store.run $+   liftA2 Cons+      (Store.element left)+      (Store.element right)++instance (Storable a) => Storable (T a) where+   {-# INLINE sizeOf #-}+   sizeOf = Store.sizeOf store+   {-# INLINE alignment #-}+   alignment = Store.alignment store+   {-# INLINE peek #-}+   peek = Store.peek store+   {-# INLINE poke #-}+   poke = Store.poke store+++instance Frame.C a => Frame.C (T a) where+   {-# INLINE numberOfChannels #-}+   numberOfChannels y = 2 * Frame.numberOfChannels (left y)+   {-# INLINE sizeOfElement #-}+   sizeOfElement = Frame.sizeOfElement . left