packages feed

med-module 0.0 → 0.1

raw patch · 39 files changed

+674/−447 lines, 39 filesdep +bytestringPVP ok

version bump matches the API change (PVP)

Dependencies added: bytestring

API changes (from Hackage documentation)

- Sound.MED.Basic.Amiga: ($?) :: (PTR -> IO a) -> PTR -> IO (Maybe a)
- Sound.MED.Basic.Amiga: chunk :: (Integral i) => i -> [a] -> [[a]]
- Sound.MED.Basic.Amiga: infixr 0 $?
- Sound.MED.Basic.Amiga: peekBig :: (Storable a, HasBigEndian a) => Peek a
- Sound.MED.Basic.Amiga: peekOffset :: (Storable a) => Peek a
- Sound.MED.Basic.Amiga: pointerRange :: PTR -> ULONG -> Int -> [PTR]
- Sound.MED.Basic.Amiga: pointerRangeGen :: (Integral i) => PTR -> ULONG -> i -> [PTR]
- Sound.MED.Basic.Amiga: pointerRangeGen2 :: (Integral i, Integral j) => PTR -> ULONG -> i -> j -> [PTR]
- Sound.MED.Basic.Amiga: pointerRangeGenCheck :: (Integral i) => PTR -> ULONG -> i -> [PTR]
- Sound.MED.Basic.Amiga: skipIf :: Bool -> IO a -> IO (Maybe a)
- Sound.MED.Basic.Amiga: stringFromBytes :: [UBYTE] -> String
- Sound.MED.Basic.Amiga: type MEM = Ptr ()
+ Sound.MED.Basic.Amiga: class (Monad m) => Reader m
+ Sound.MED.Basic.Amiga: data ByteStringReader a
+ Sound.MED.Basic.Amiga: data StorableReader a
+ Sound.MED.Basic.Amiga: instance GHC.Base.Applicative Sound.MED.Basic.Amiga.ByteStringReader
+ Sound.MED.Basic.Amiga: instance GHC.Base.Applicative Sound.MED.Basic.Amiga.StorableReader
+ Sound.MED.Basic.Amiga: instance GHC.Base.Functor Sound.MED.Basic.Amiga.ByteStringReader
+ Sound.MED.Basic.Amiga: instance GHC.Base.Functor Sound.MED.Basic.Amiga.StorableReader
+ Sound.MED.Basic.Amiga: instance GHC.Base.Monad Sound.MED.Basic.Amiga.ByteStringReader
+ Sound.MED.Basic.Amiga: instance GHC.Base.Monad Sound.MED.Basic.Amiga.StorableReader
+ Sound.MED.Basic.Amiga: instance Sound.MED.Basic.Amiga.Reader Sound.MED.Basic.Amiga.ByteStringReader
+ Sound.MED.Basic.Amiga: instance Sound.MED.Basic.Amiga.Reader Sound.MED.Basic.Amiga.StorableReader
+ Sound.MED.Basic.Amiga: runByteString :: ByteStringReader a -> ByteString -> Either String a
+ Sound.MED.Basic.Amiga: runStorable :: StorableReader a -> MEM -> IO a
- Sound.MED.Basic.Amiga: peekBYTE :: Peek BYTE
+ Sound.MED.Basic.Amiga: peekBYTE :: Reader m => Peek m BYTE
- Sound.MED.Basic.Amiga: peekLONG :: Peek LONG
+ Sound.MED.Basic.Amiga: peekLONG :: Reader m => Peek m LONG
- Sound.MED.Basic.Amiga: peekPTR :: Peek PTR
+ Sound.MED.Basic.Amiga: peekPTR :: (Reader m) => Peek m PTR
- Sound.MED.Basic.Amiga: peekUBYTE :: Peek UBYTE
+ Sound.MED.Basic.Amiga: peekUBYTE :: Reader m => Peek m UBYTE
- Sound.MED.Basic.Amiga: peekULONG :: Peek ULONG
+ Sound.MED.Basic.Amiga: peekULONG :: Reader m => Peek m ULONG
- Sound.MED.Basic.Amiga: peekUWORD :: Peek UWORD
+ Sound.MED.Basic.Amiga: peekUWORD :: Reader m => Peek m UWORD
- Sound.MED.Basic.Amiga: peekWORD :: Peek WORD
+ Sound.MED.Basic.Amiga: peekWORD :: Reader m => Peek m WORD
- Sound.MED.Basic.Amiga: type Peek a = MEM -> PTR -> IO a
+ Sound.MED.Basic.Amiga: type Peek m a = PTR -> m a
- Sound.MED.Generic: peek :: MEM -> IO MED
+ Sound.MED.Generic: peek :: (Reader m) => m MED
- Sound.MED.Raw.BlockCmdPageTable: peek :: UWORD -> UWORD -> MEM -> PTR -> IO BlockCmdPageTable
+ Sound.MED.Raw.BlockCmdPageTable: peek :: (Reader m) => UWORD -> UWORD -> PTR -> m BlockCmdPageTable
- Sound.MED.Raw.BlockCmdPageTable: peekPage :: UWORD -> UWORD -> MEM -> PTR -> IO (Maybe [[CmdPageData]])
+ Sound.MED.Raw.BlockCmdPageTable: peekPage :: (Reader m) => UWORD -> UWORD -> PTR -> m (Maybe [[CmdPageData]])
- Sound.MED.Raw.BlockInfo: peek :: UWORD -> UWORD -> MEM -> PTR -> IO BlockInfo
+ Sound.MED.Raw.BlockInfo: peek :: (Reader m) => UWORD -> UWORD -> PTR -> m BlockInfo
- Sound.MED.Raw.CmdPageData: peek :: MEM -> PTR -> IO CmdPageData
+ Sound.MED.Raw.CmdPageData: peek :: (Reader m) => PTR -> m CmdPageData
- Sound.MED.Raw.HybridInstr: peek :: MEM -> PTR -> IO HybridInstr
+ Sound.MED.Raw.HybridInstr: peek :: (Reader m) => PTR -> m HybridInstr
- Sound.MED.Raw.InstrExt: peek :: UWORD -> MEM -> PTR -> IO InstrExt
+ Sound.MED.Raw.InstrExt: peek :: (Reader m) => UWORD -> PTR -> m InstrExt
- Sound.MED.Raw.InstrHdr: peek :: MEM -> PTR -> IO InstrHdr
+ Sound.MED.Raw.InstrHdr: peek :: (Reader m) => PTR -> m InstrHdr
- Sound.MED.Raw.MMD0: peek :: MEM -> PTR -> IO MMD0
+ Sound.MED.Raw.MMD0: peek :: (Reader m) => PTR -> m MMD0
- Sound.MED.Raw.MMD0Block: peek :: MEM -> PTR -> IO MMD0Block
+ Sound.MED.Raw.MMD0Block: peek :: (Reader m) => PTR -> m MMD0Block
- Sound.MED.Raw.MMD0NoteData: peek :: MEM -> PTR -> IO MMD0NoteData
+ Sound.MED.Raw.MMD0NoteData: peek :: (Reader m) => PTR -> m MMD0NoteData
- Sound.MED.Raw.MMD0Sample: peek :: MEM -> PTR -> IO MMD0Sample
+ Sound.MED.Raw.MMD0Sample: peek :: (Reader m) => PTR -> m MMD0Sample
- Sound.MED.Raw.MMD0Song: peek :: MEM -> PTR -> IO MMD0Song
+ Sound.MED.Raw.MMD0Song: peek :: (Reader m) => PTR -> m MMD0Song
- Sound.MED.Raw.MMD0exp: peek :: MEM -> PTR -> IO MMD0exp
+ Sound.MED.Raw.MMD0exp: peek :: (Reader m) => PTR -> m MMD0exp
- Sound.MED.Raw.MMD1: peek :: MEM -> PTR -> IO MMD1
+ Sound.MED.Raw.MMD1: peek :: (Reader m) => PTR -> m MMD1
- Sound.MED.Raw.MMD1Block: peek :: MEM -> PTR -> IO MMD1Block
+ Sound.MED.Raw.MMD1Block: peek :: (Reader m) => PTR -> m MMD1Block
- Sound.MED.Raw.MMD1NoteData: peek :: MEM -> PTR -> IO MMD1NoteData
+ Sound.MED.Raw.MMD1NoteData: peek :: (Reader m) => PTR -> m MMD1NoteData
- Sound.MED.Raw.MMD2: peek :: MEM -> PTR -> IO MMD2
+ Sound.MED.Raw.MMD2: peek :: (Reader m) => PTR -> m MMD2
- Sound.MED.Raw.MMD2Song: peek :: MEM -> PTR -> IO MMD2Song
+ Sound.MED.Raw.MMD2Song: peek :: (Reader m) => PTR -> m MMD2Song
- Sound.MED.Raw.MMD3: peek :: MEM -> PTR -> IO MMD3
+ Sound.MED.Raw.MMD3: peek :: (Reader m) => PTR -> m MMD3
- Sound.MED.Raw.MMDARexx: peek :: MEM -> PTR -> IO MMDARexx
+ Sound.MED.Raw.MMDARexx: peek :: (Reader m) => PTR -> m MMDARexx
- Sound.MED.Raw.MMDARexxTrigCmd: peek :: MEM -> PTR -> IO MMDARexxTrigCmd
+ Sound.MED.Raw.MMDARexxTrigCmd: peek :: (Reader m) => PTR -> m MMDARexxTrigCmd
- Sound.MED.Raw.MMDDump: peek :: MEM -> PTR -> IO MMDDump
+ Sound.MED.Raw.MMDDump: peek :: (Reader m) => PTR -> m MMDDump
- Sound.MED.Raw.MMDDumpData: peek :: MEM -> PTR -> IO MMDDumpData
+ Sound.MED.Raw.MMDDumpData: peek :: (Reader m) => PTR -> m MMDDumpData
- Sound.MED.Raw.MMDInfo: peek :: MEM -> PTR -> IO MMDInfo
+ Sound.MED.Raw.MMDInfo: peek :: (Reader m) => PTR -> m MMDInfo
- Sound.MED.Raw.MMDInstrInfo: peek :: UWORD -> MEM -> PTR -> IO MMDInstrInfo
+ Sound.MED.Raw.MMDInstrInfo: peek :: (Reader m) => UWORD -> PTR -> m MMDInstrInfo
- Sound.MED.Raw.MMDMIDICmd3x: peek :: MEM -> PTR -> IO MMDMIDICmd3x
+ Sound.MED.Raw.MMDMIDICmd3x: peek :: (Reader m) => PTR -> m MMDMIDICmd3x
- Sound.MED.Raw.NotationInfo: peek :: MEM -> PTR -> IO NotationInfo
+ Sound.MED.Raw.NotationInfo: peek :: (Reader m) => PTR -> m NotationInfo
- Sound.MED.Raw.PlaySeq: peek :: MEM -> PTR -> IO PlaySeq
+ Sound.MED.Raw.PlaySeq: peek :: (Reader m) => PTR -> m PlaySeq
- Sound.MED.Raw.SampleInstr: peek :: ULONG -> WORD -> Bool -> Bool -> MEM -> PTR -> IO SampleInstr
+ Sound.MED.Raw.SampleInstr: peek :: (Reader m) => ULONG -> WORD -> Bool -> Bool -> PTR -> m SampleInstr
- Sound.MED.Raw.SynthInstr: peek :: MEM -> PTR -> IO SynthInstr
+ Sound.MED.Raw.SynthInstr: peek :: (Reader m) => PTR -> m SynthInstr
- Sound.MED.Raw.SynthWF: peek :: MEM -> PTR -> IO SynthWF
+ Sound.MED.Raw.SynthWF: peek :: (Reader m) => PTR -> m SynthWF

Files

med-module.cabal view
@@ -1,5 +1,5 @@ Name:                med-module-Version:             0.0+Version:             0.1 Synopsis:            Parse song module files from Amiga MED and OctaMED Description:   MED (Music EDitor) and its successor OctaMED@@ -29,7 +29,7 @@ Cabal-Version:       >=1.10  Source-Repository this-  Tag:         0.0+  Tag:         0.1   Type:        darcs   Location:    http://hub.darcs.net/thielema/med-module @@ -82,9 +82,14 @@     Sound.MED.Generic.Tempo   Other-Modules:     Sound.MED.Basic.Pretty+    Sound.MED.Basic.Storable+    Sound.MED.Basic.ByteString+    Sound.MED.Basic.Utility    Build-Depends:+    transformers >=0.3 && <0.6,     storable-endian >=0.2.6 && <0.3,+    bytestring >=0.9.2 && <0.11,     utility-ht >=0.0.12 && <0.1,     base >=4.5 && <5   Hs-Source-Dirs:      src
src/Sound/MED/Basic/Amiga.hs view
@@ -1,56 +1,106 @@-module Sound.MED.Basic.Amiga where+module Sound.MED.Basic.Amiga (+  Peek, Reader(..), peekPTR,+  StorableReader, runStorable,+  ByteStringReader, runByteString,+  PTR, LONG, ULONG, WORD, UWORD, BYTE, UBYTE,+  loadMEM, freeMEM,+  ) where +import qualified Sound.MED.Basic.Storable as MedStore+import qualified Sound.MED.Basic.ByteString as MedBytes+import Sound.MED.Basic.Storable (MEM)+import Data.ByteString (ByteString)+import Sound.MED.Basic.Utility (PTR, LONG, ULONG, WORD, UWORD, BYTE, UBYTE)+ import qualified System.IO as IO  import qualified Foreign.Marshal.Alloc as Alloc-import Foreign.Storable (Storable, peekByteOff)-import Foreign.Ptr (Ptr) +import qualified Control.Monad.Trans.Class as MT+import qualified Control.Monad.Trans.Reader as MR import Control.Monad (when)-import Control.Applicative ((<$>))+import Control.Applicative (Applicative(pure, (<*>)), (<$>)) -import qualified Data.List.Reverse.StrictSpine as ListRev-import Data.List.HT (sliceVertical)-import Data.Storable.Endian (HasBigEndian, getBigEndian)-import Data.Word (Word8, Word16, Word32)-import Data.Int (Int8, Int16, Int32)+type Peek m a = PTR -> m a -type MEM   = Ptr ()-type PTR   = Word32-type LONG  = Int32-type ULONG = Word32-type WORD  = Int16-type UWORD = Word16-type BYTE  = Int8-type UBYTE = Word8+class (Monad m) => Reader m where+  peekLONG  :: Peek m LONG+  peekULONG :: Peek m ULONG+  peekWORD  :: Peek m WORD+  peekUWORD :: Peek m UWORD+  peekBYTE  :: Peek m BYTE+  peekUBYTE :: Peek m UBYTE -type Peek a = MEM -> PTR -> IO a+{-# INLINE peekPTR #-}+peekPTR :: (Reader m) => Peek m PTR+peekPTR = peekULONG -peekOffset :: (Storable a) => Peek a-peekOffset mem ptr = peekByteOff mem (fromIntegral ptr) -peekBig :: (Storable a, HasBigEndian a) => Peek a-peekBig mem ptr = getBigEndian <$> peekOffset mem ptr+newtype StorableReader a = StorableReader (MR.ReaderT MEM IO a) -peekPTR   :: Peek PTR   ; peekPTR   = peekBig-peekLONG  :: Peek LONG  ; peekLONG  = peekBig-peekULONG :: Peek ULONG ; peekULONG = peekBig-peekWORD  :: Peek WORD  ; peekWORD  = peekBig-peekUWORD :: Peek UWORD ; peekUWORD = peekBig-peekBYTE  :: Peek BYTE  ; peekBYTE  = peekOffset-peekUBYTE :: Peek UBYTE ; peekUBYTE = peekOffset+instance Functor StorableReader where+  fmap f (StorableReader act) = StorableReader $ fmap f act -infixr 0 $?+instance Applicative StorableReader where+  pure = StorableReader . pure+  StorableReader f <*> StorableReader m = StorableReader (f <*> m) -($?) :: (PTR -> IO a) -> PTR -> IO (Maybe a)-f $? ptr = skipIf (ptr == 0) (f ptr)+instance Monad StorableReader where+  return = pure+  StorableReader x >>= f  =+    StorableReader  $  x >>= \a -> case f a of StorableReader y -> y+  fail = StorableReader . MT.lift . fail -skipIf :: Bool -> IO a -> IO (Maybe a)-skipIf cond act =-  if cond-    then return Nothing-    else Just <$> act+runStorable :: StorableReader a -> MEM -> IO a+runStorable (StorableReader rd) = MR.runReaderT rd +{-# INLINE liftStorable #-}+liftStorable :: MedStore.Peek a -> PTR -> StorableReader a+liftStorable peek ptr = StorableReader (MR.ReaderT $ \mem -> peek mem ptr)++instance Reader StorableReader where+  peekLONG  = liftStorable MedStore.peekBig+  peekULONG = liftStorable MedStore.peekBig+  peekWORD  = liftStorable MedStore.peekBig+  peekUWORD = liftStorable MedStore.peekBig+  peekBYTE  = liftStorable MedStore.peekOffset+  peekUBYTE = liftStorable MedStore.peekOffset+++newtype+  ByteStringReader a =+    ByteStringReader (MR.ReaderT ByteString (Either String) a)++instance Functor ByteStringReader where+  fmap f (ByteStringReader act) = ByteStringReader $ fmap f act++instance Applicative ByteStringReader where+  pure = ByteStringReader . pure+  ByteStringReader f <*> ByteStringReader m = ByteStringReader (f <*> m)++instance Monad ByteStringReader where+  return = pure+  ByteStringReader x >>= f  =+    ByteStringReader  $  x >>= \a -> case f a of ByteStringReader y -> y+  fail = ByteStringReader . MT.lift . Left++runByteString :: ByteStringReader a -> ByteString -> Either String a+runByteString (ByteStringReader rd) = MR.runReaderT rd++{-# INLINE liftByteString #-}+liftByteString :: MedBytes.Peek a -> PTR -> ByteStringReader a+liftByteString peek ptr =+  ByteStringReader (MR.ReaderT $ \mem -> Right $ peek mem ptr)++instance Reader ByteStringReader where+  peekLONG  = liftByteString MedBytes.peekInt32+  peekULONG = liftByteString MedBytes.peekWord32+  peekWORD  = liftByteString MedBytes.peekInt16+  peekUWORD = liftByteString MedBytes.peekWord16+  peekBYTE  = liftByteString MedBytes.peekInt8+  peekUBYTE = liftByteString MedBytes.peekWord8++ loadMEM :: String -> IO MEM loadMEM s =   IO.withBinaryFile s IO.ReadMode $ \h -> do@@ -63,30 +113,3 @@  freeMEM :: MEM -> IO () freeMEM = Alloc.free---pointerRange :: PTR -> ULONG -> Int -> [PTR]-pointerRange start step len =-  take len $ iterate (fromIntegral step +) start--pointerRangeGen :: (Integral i) => PTR -> ULONG -> i -> [PTR]-pointerRangeGen start step len = pointerRange start step (fromIntegral len)--{- |-Return empty list if start pointer is zero.--}-pointerRangeGenCheck :: (Integral i) => PTR -> ULONG -> i -> [PTR]-pointerRangeGenCheck start step len =-  if start == 0 then [] else pointerRangeGen start step len--pointerRangeGen2 :: (Integral i, Integral j) => PTR -> ULONG -> i -> j -> [PTR]-pointerRangeGen2 start step len0 len1 =-  pointerRange start step (fromIntegral len0 * fromIntegral len1)---chunk :: (Integral i) => i -> [a] -> [[a]]-chunk k = sliceVertical (fromIntegral k)---- | Strings tend to be fixed width fields with trailing zeros.-stringFromBytes :: [UBYTE] -> String-stringFromBytes = map (toEnum . fromEnum) . ListRev.dropWhile (==0)
+ src/Sound/MED/Basic/ByteString.hs view
@@ -0,0 +1,37 @@+module Sound.MED.Basic.ByteString where++import qualified Data.ByteString as B++import Data.Bits (Bits, shiftL, (.|.))+import Data.Word (Word8, Word16, Word32)+import Data.Int (Int8, Int16, Int32)+++type PTR = Word32+type Peek a = B.ByteString -> PTR -> a+++peekInt32 :: Peek Int32; peekInt32 xs = fromIntegral . peekWord32 xs+peekInt16 :: Peek Int16; peekInt16 xs = fromIntegral . peekWord16 xs+peekInt8  :: Peek Int8;  peekInt8  xs = fromIntegral . peekWord8  xs++peekWord32 :: Peek Word32+peekWord32 xs ptr =+  let k = fromIntegral ptr+  in  peekOffset xs k 0 <+ peekOffset xs k 1 <++      peekOffset xs k 2 <+ peekOffset xs k 3++peekWord16 :: Peek Word16+peekWord16 xs ptr =+  let k = fromIntegral ptr+  in  peekOffset xs k 0 <+ peekOffset xs k 1++infixl 6 <++(<+) :: (Bits a) => a -> a -> a+x <+ y = shiftL x 8 .|. y++peekOffset :: (Bits a, Num a) => B.ByteString -> Int -> Int -> a+peekOffset xs k d = fromIntegral $ B.index xs $ k+d++peekWord8 :: Peek Word8+peekWord8 xs k = B.index xs $ fromIntegral k
+ src/Sound/MED/Basic/Storable.hs view
@@ -0,0 +1,20 @@+module Sound.MED.Basic.Storable where++import Foreign.Storable (Storable, peekByteOff)+import Foreign.Ptr (Ptr)++import Control.Applicative ((<$>))++import Data.Storable.Endian (HasBigEndian, getBigEndian)+import Data.Word (Word32)+++type MEM = Ptr ()+type PTR = Word32+type Peek a = MEM -> PTR -> IO a++peekOffset :: (Storable a) => Peek a+peekOffset mem ptr = peekByteOff mem (fromIntegral ptr)++peekBig :: (Storable a, HasBigEndian a) => Peek a+peekBig mem ptr = getBigEndian <$> peekOffset mem ptr
+ src/Sound/MED/Basic/Utility.hs view
@@ -0,0 +1,53 @@+module Sound.MED.Basic.Utility where++import qualified Data.List.Reverse.StrictSpine as ListRev+import qualified Data.Traversable as Trav+import Data.List.HT (sliceVertical)+import Data.Maybe.HT (toMaybe)++import Data.Word (Word8, Word16, Word32)+import Data.Int (Int8, Int16, Int32)+++type PTR   = Word32+type LONG  = Int32+type ULONG = Word32+type WORD  = Int16+type UWORD = Word16+type BYTE  = Int8+type UBYTE = Word8++infixr 0 $?++($?) :: (Monad m) => (PTR -> m a) -> PTR -> m (Maybe a)+f $? ptr = skipIf (ptr == 0) (f ptr)++skipIf :: (Monad m) => Bool -> m a -> m (Maybe a)+skipIf cond act = Trav.sequence $ toMaybe (not cond) act+++pointerRange :: PTR -> ULONG -> Int -> [PTR]+pointerRange start step len =+  take len $ iterate (fromIntegral step +) start++pointerRangeGen :: (Integral i) => PTR -> ULONG -> i -> [PTR]+pointerRangeGen start step len = pointerRange start step (fromIntegral len)++{- |+Return empty list if start pointer is zero.+-}+pointerRangeGenCheck :: (Integral i) => PTR -> ULONG -> i -> [PTR]+pointerRangeGenCheck start step len =+  if start == 0 then [] else pointerRangeGen start step len++pointerRangeGen2 :: (Integral i, Integral j) => PTR -> ULONG -> i -> j -> [PTR]+pointerRangeGen2 start step len0 len1 =+  pointerRange start step (fromIntegral len0 * fromIntegral len1)+++chunk :: (Integral i) => i -> [a] -> [[a]]+chunk k = sliceVertical (fromIntegral k)++-- | Strings tend to be fixed width fields with trailing zeros.+stringFromBytes :: [UBYTE] -> String+stringFromBytes = map (toEnum . fromEnum) . ListRev.dropWhile (==0)
src/Sound/MED/Generic.hs view
@@ -30,9 +30,9 @@   , tempo :: MEDTempo.MEDTempo   } -peek :: MEM -> IO MED-peek m = do-  ident <- peekULONG m 0+peek :: (Reader m) => m MED+peek = do+  ident <- peekULONG 0   let samples0 song =         take (fromIntegral (MMD0Song.numsamples song)) $ MMD0Song.sample song   let samples2 song =@@ -45,7 +45,7 @@   let mmd2PlaySeqs = map MEDPlaySeq.playSeq2 . MMD2Song.playseqtable   case ident of     0x4D4D4430 -> do-      med <- MMD0.peek m 0+      med <- MMD0.peek 0       return $ MED         { instrs = instrs_ MMD0.smplarr (samples0 . MMD0.song) MMD0.expdata med         , blocks = map MEDBlock.medblock0 $ MMD0.blockarr med@@ -53,7 +53,7 @@         , tempo = MEDTempo.song0Tempo $ MMD0.song med         }     0x4D4D4431 -> do-      med <- MMD1.peek m 0+      med <- MMD1.peek 0       return $ MED         { instrs = instrs_ MMD1.smplarr (samples0 . MMD1.song) MMD1.expdata med         , blocks = map MEDBlock.medblock1 $ MMD1.blockarr med@@ -61,7 +61,7 @@         , tempo = MEDTempo.song0Tempo $ MMD1.song med         }     0x4D4D4432 -> do-      med <- MMD2.peek m 0+      med <- MMD2.peek 0       return $ MED         { instrs = instrs_ MMD2.smplarr (samples2 . MMD2.song) MMD2.expdata med         , blocks = map MEDBlock.medblock1 $ MMD2.blockarr med@@ -69,14 +69,14 @@         , tempo = MEDTempo.song2Tempo $ MMD2.song med         }     0x4D4D4433 -> do-      med <- MMD3.peek m 0+      med <- MMD3.peek 0       return $ MED         { instrs = instrs_ MMD3.smplarr (samples2 . MMD3.song) MMD3.expdata med         , blocks = map MEDBlock.medblock1 $ MMD3.blockarr med         , playseqs = mmd2PlaySeqs $ MMD3.song med         , tempo = MEDTempo.song2Tempo $ MMD3.song med         }-    _ -> ioError $ userError $ printf "unknown format: %08x" $ toInteger ident+    _ -> fail $ printf "unknown format: %08x" $ toInteger ident  instance Human MED where   human m =@@ -86,4 +86,4 @@   load :: FilePath -> IO MED-load path = bracket (loadMEM path) freeMEM peek+load path = bracket (loadMEM path) freeMEM (runStorable peek)
src/Sound/MED/Generic/Block.hs view
@@ -9,7 +9,7 @@ import qualified Sound.MED.Raw.CmdPageData as CmdPageData  import Sound.MED.Basic.Human(Human(human),bold)-import Sound.MED.Basic.Amiga(stringFromBytes)+import Sound.MED.Basic.Utility(stringFromBytes)  import Text.Printf(printf) import Control.Monad(liftM2)
src/Sound/MED/Generic/Instrument.hs view
@@ -6,7 +6,7 @@ import qualified Sound.MED.Raw.InstrExt as InstrExt  import Sound.MED.Basic.Human(Human(human))-import Sound.MED.Basic.Amiga(stringFromBytes)+import Sound.MED.Basic.Utility(stringFromBytes)  import qualified Data.List as List 
src/Sound/MED/Generic/PlaySeq.hs view
@@ -7,7 +7,7 @@ import Sound.MED.Raw.PlaySeq(PlaySeq)  import Sound.MED.Basic.Human(Human(human))-import Sound.MED.Basic.Amiga(stringFromBytes)+import Sound.MED.Basic.Utility(stringFromBytes)  import qualified Data.List as List 
src/Sound/MED/Raw/BlockCmdPageTable.hs view
@@ -4,7 +4,10 @@ import Sound.MED.Raw.CmdPageData(CmdPageData)  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility +import Control.Monad (liftM)+ data BlockCmdPageTable = BlockCmdPageTable   { num_pages :: UWORD   , reserved  :: UWORD@@ -12,16 +15,19 @@   }   deriving (Show) -peek :: UWORD -> UWORD -> MEM -> PTR -> IO BlockCmdPageTable-peek tracks numlines m p = do-  num_pages' <- peekUWORD m p-  reserved'  <- peekUWORD m (p+2)-  pages''    <- mapM (peekPTR m) $ pointerRangeGen (p+4) 4 num_pages'-  pages'     <- mapM (peekPage tracks numlines m) pages''+{-# SPECIALISE peek :: UWORD -> UWORD -> PTR -> StorableReader BlockCmdPageTable #-}+{-# SPECIALISE peek :: UWORD -> UWORD -> PTR -> ByteStringReader BlockCmdPageTable #-}+peek :: (Reader m) => UWORD -> UWORD -> PTR -> m BlockCmdPageTable+peek tracks numlines p = do+  num_pages' <- peekUWORD p+  reserved'  <- peekUWORD (p+2)+  pages''    <- mapM peekPTR $ pointerRangeGen (p+4) 4 num_pages'+  pages'     <- mapM (peekPage tracks numlines) pages''   return $ BlockCmdPageTable     num_pages' reserved' pages' -peekPage :: UWORD -> UWORD -> MEM -> PTR -> IO (Maybe [ [ CmdPageData ] ])-peekPage tracks numlines m p =-  skipIf (p == 0) $ fmap (chunk tracks) $-    mapM (CmdPageData.peek m) $ pointerRangeGen2 p 2 tracks numlines+peekPage ::+  (Reader m) => UWORD -> UWORD -> PTR -> m (Maybe [ [ CmdPageData ] ])+peekPage tracks numlines p =+  skipIf (p == 0) $ liftM (chunk tracks) $+    mapM CmdPageData.peek $ pointerRangeGen2 p 2 tracks numlines
src/Sound/MED/Raw/BlockInfo.hs view
@@ -4,6 +4,7 @@ import Sound.MED.Raw.BlockCmdPageTable(BlockCmdPageTable)  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data BlockInfo = BlockInfo   { hlmask       :: Maybe [ ULONG ]@@ -14,20 +15,22 @@   }   deriving (Show) -peek :: UWORD -> UWORD -> MEM -> PTR -> IO BlockInfo-peek tracks numlines m p = do+{-# SPECIALISE peek :: UWORD -> UWORD -> PTR -> StorableReader BlockInfo #-}+{-# SPECIALISE peek :: UWORD -> UWORD -> PTR -> ByteStringReader BlockInfo #-}+peek :: (Reader m) => UWORD -> UWORD -> PTR -> m BlockInfo+peek tracks numlines p = do   let hlmasklen = (numlines + 31) `div` 32-  hlmask'''     <- peekPTR m p+  hlmask'''     <- peekPTR p   hlmask'       <-     skipIf (hlmask''' == 0) $-    mapM (peekULONG m) $ pointerRangeGen hlmask''' 4 hlmasklen-  blocknamelen' <- peekULONG m (p+8)-  blockname'''  <- peekPTR m (p+4)+    mapM peekULONG $ pointerRangeGen hlmask''' 4 hlmasklen+  blocknamelen' <- peekULONG (p+8)+  blockname'''  <- peekPTR (p+4)   blockname'    <-     skipIf (blockname''' == 0) $-    mapM (peekUBYTE m) $ pointerRangeGen blockname''' 1 blocknamelen'-  pagetable'''  <- peekPTR m (p+12)-  pagetable'    <- BlockCmdPageTable.peek tracks numlines m $? pagetable'''-  reserved'     <- mapM (peekULONG m) $ pointerRange (p+16) 4 5+    mapM peekUBYTE $ pointerRangeGen blockname''' 1 blocknamelen'+  pagetable'''  <- peekPTR (p+12)+  pagetable'    <- BlockCmdPageTable.peek tracks numlines $? pagetable'''+  reserved'     <- mapM peekULONG $ pointerRange (p+16) 4 5   return $ BlockInfo     hlmask' blockname' blocknamelen' pagetable' reserved'
src/Sound/MED/Raw/CmdPageData.hs view
@@ -8,9 +8,11 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO CmdPageData-peek m p = do-  command'  <- peekUBYTE m (p + 0)-  databyte' <- peekUBYTE m (p + 1)+{-# SPECIALISE peek :: PTR -> StorableReader CmdPageData #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader CmdPageData #-}+peek :: (Reader m) => PTR -> m CmdPageData+peek p = do+  command'  <- peekUBYTE (p + 0)+  databyte' <- peekUBYTE (p + 1)   return $ CmdPageData     command' databyte'
src/Sound/MED/Raw/HybridInstr.hs view
@@ -4,6 +4,7 @@ import Sound.MED.Raw.SynthWF(SynthWF)  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data HybridInstr = HybridInstr   { defaultdecay :: UBYTE@@ -22,21 +23,23 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO HybridInstr-peek m p = do-  defaultdecay' <- peekUBYTE m (p+6)-  reserved'     <- mapM (peekUBYTE m) $ pointerRange (p+7) 1 3-  rep'          <- peekUWORD m (p+10)-  replen'       <- peekUWORD m (p+12)-  voltbllen'    <- peekUWORD m (p+14)-  wftbllen'     <- peekUWORD m (p+16)-  volspeed'     <- peekUBYTE m (p+18)-  wfspeed'      <- peekUBYTE m (p+19)-  wforms'       <- peekUWORD m (p+20)-  voltbl'       <- mapM (peekUBYTE m) $ pointerRange (p+22) 1 128-  wftbl'        <- mapM (peekUBYTE m) $ pointerRange (p+150) 150 128-  wf0':wf''     <- mapM (peekPTR m)   $ pointerRange (p+278) 4 64-  wf'           <- mapM (SynthWF.peek m . (p+) $?) wf''+{-# SPECIALISE peek :: PTR -> StorableReader HybridInstr #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader HybridInstr #-}+peek :: (Reader m) => PTR -> m HybridInstr+peek p = do+  defaultdecay' <- peekUBYTE (p+6)+  reserved'     <- mapM peekUBYTE $ pointerRange (p+7) 1 3+  rep'          <- peekUWORD (p+10)+  replen'       <- peekUWORD (p+12)+  voltbllen'    <- peekUWORD (p+14)+  wftbllen'     <- peekUWORD (p+16)+  volspeed'     <- peekUBYTE (p+18)+  wfspeed'      <- peekUBYTE (p+19)+  wforms'       <- peekUWORD (p+20)+  voltbl'       <- mapM peekUBYTE $ pointerRange (p+22) 1 128+  wftbl'        <- mapM peekUBYTE $ pointerRange (p+150) 150 128+  wf0':wf''     <- mapM peekPTR   $ pointerRange (p+278) 4 64+  wf'           <- mapM (SynthWF.peek . (p+) $?) wf''   return $ HybridInstr     defaultdecay' reserved' rep' replen' voltbllen' wftbllen'     volspeed' wfspeed' wforms' voltbl' wftbl' wf0' wf'
src/Sound/MED/Raw/InstrExt.hs view
@@ -1,6 +1,7 @@ module Sound.MED.Raw.InstrExt where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  import Foreign.Storable (Storable, sizeOf) @@ -19,12 +20,15 @@   }   deriving (Show) -peek :: UWORD -> MEM -> PTR -> IO InstrExt-peek size m p = do-  let peekHelp :: (Storable a) => a -> Peek a -> UWORD -> IO (Maybe a)+{-# SPECIALISE peek :: UWORD -> PTR -> StorableReader InstrExt #-}+{-# SPECIALISE peek :: UWORD -> PTR -> ByteStringReader InstrExt #-}+peek :: (Reader m) => UWORD -> PTR -> m InstrExt+peek size p = do+  let peekHelp ::+        (Reader m, Storable a) => a -> Peek m a -> UWORD -> m (Maybe a)       peekHelp elm peeker offset =         skipIf (offset + fromIntegral (sizeOf elm) > size) $-        peeker m (p + fromIntegral offset)+        peeker (p + fromIntegral offset)       peeker $?? offset = peekHelp undefined peeker offset   hold' <- peekUBYTE $?? 0   decay' <- peekUBYTE $?? 1
src/Sound/MED/Raw/InstrHdr.hs view
@@ -28,23 +28,25 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO InstrHdr-peek m p = do-  len'   <- peekULONG m  p-  itype' <- peekWORD  m (p+4)+{-# SPECIALISE peek :: PTR -> StorableReader InstrHdr #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader InstrHdr #-}+peek :: (Reader m) => PTR -> m InstrHdr+peek p = do+  len'   <- peekULONG  p+  itype' <- peekWORD  (p+4)   let s16'    = (itype' .&. 0x10) == 0x10   let stereo' = (itype' .&. 0x20) == 0x20   let md16'   = itype'            == 0x18   let stype'  = if itype' < 0 then itype' else itype' .&. 0x7   dat' <- case stype' of     (-2) -> do-      hybridinstr' <- HybridInstr.peek m p+      hybridinstr' <- HybridInstr.peek p       return $ Hybrid hybridinstr'     (-1) -> do-      synthinstr' <- SynthInstr.peek m p+      synthinstr' <- SynthInstr.peek p       return $ Synthetic synthinstr'     _ -> if stype' < 0 || 7 < stype' then return Unknown else do-      sampleinstr' <- SampleInstr.peek len' stype' s16' stereo' m p+      sampleinstr' <- SampleInstr.peek len' stype' s16' stereo' p       return $ Sample sampleinstr'   return $ InstrHdr     len' stype' s16' stereo' md16' dat'
src/Sound/MED/Raw/MMD0.hs view
@@ -9,6 +9,7 @@ import qualified Sound.MED.Raw.MMD0exp as MMD0exp import Sound.MED.Raw.MMD0exp(MMD0exp) import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMD0 = MMD0   { id          :: ULONG@@ -35,35 +36,37 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD0-peek m p = do-  id'          <- peekULONG m (p + 0)-  modlen'      <- peekULONG m (p + 4)-  song''       <- peekPTR   m (p + 8)-  song'        <- MMD0Song.peek m song''-  psecnum'     <- peekUWORD m (p + 12)-  pseq'        <- peekUWORD m (p + 14)-  blockarr'''  <- peekPTR   m (p + 16)-  blockarr''   <- mapM (peekPTR m) $ pointerRangeGen blockarr''' 4 (MMD0Song.numblocks song')-  blockarr'    <- mapM (MMD0Block.peek m) blockarr''-  mmdflags'    <- peekUBYTE m (p + 20)-  reserved1'   <- peekUBYTE m (p + 21)-  reserved2'   <- peekUBYTE m (p + 22)-  reserved3'   <- peekUBYTE m (p + 23)-  smplarr'''   <- peekPTR   m (p + 24)-  smplarr''    <- mapM (peekPTR m) $ pointerRangeGenCheck smplarr''' 4 (MMD0Song.numsamples song')-  smplarr'     <- mapM (InstrHdr.peek m $?) smplarr''-  reserved4'   <- peekULONG m (p + 28)-  expdata'''   <- peekPTR   m (p + 32)-  expdata'     <- MMD0exp.peek m $? expdata'''-  reserved5'   <- peekULONG m (p + 36)-  pstate'      <- peekUWORD m (p + 40)-  pblock'      <- peekUWORD m (p + 42)-  pline'       <- peekUWORD m (p + 44)-  pseqnum'     <- peekUWORD m (p + 46)-  actplayline' <- peekWORD  m (p + 48)-  counter'     <- peekUBYTE m (p + 50)-  extra_songs' <- peekUBYTE m (p + 51)+{-# SPECIALISE peek :: PTR -> StorableReader MMD0 #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD0 #-}+peek :: (Reader m) => PTR -> m MMD0+peek p = do+  id'          <- peekULONG (p + 0)+  modlen'      <- peekULONG (p + 4)+  song''       <- peekPTR   (p + 8)+  song'        <- MMD0Song.peek song''+  psecnum'     <- peekUWORD (p + 12)+  pseq'        <- peekUWORD (p + 14)+  blockarr'''  <- peekPTR   (p + 16)+  blockarr''   <- mapM peekPTR $ pointerRangeGen blockarr''' 4 (MMD0Song.numblocks song')+  blockarr'    <- mapM MMD0Block.peek blockarr''+  mmdflags'    <- peekUBYTE (p + 20)+  reserved1'   <- peekUBYTE (p + 21)+  reserved2'   <- peekUBYTE (p + 22)+  reserved3'   <- peekUBYTE (p + 23)+  smplarr'''   <- peekPTR   (p + 24)+  smplarr''    <- mapM peekPTR $ pointerRangeGenCheck smplarr''' 4 (MMD0Song.numsamples song')+  smplarr'     <- mapM (InstrHdr.peek $?) smplarr''+  reserved4'   <- peekULONG (p + 28)+  expdata'''   <- peekPTR   (p + 32)+  expdata'     <- MMD0exp.peek $? expdata'''+  reserved5'   <- peekULONG (p + 36)+  pstate'      <- peekUWORD (p + 40)+  pblock'      <- peekUWORD (p + 42)+  pline'       <- peekUWORD (p + 44)+  pseqnum'     <- peekUWORD (p + 46)+  actplayline' <- peekWORD  (p + 48)+  counter'     <- peekUBYTE (p + 50)+  extra_songs' <- peekUBYTE (p + 51)   return $ MMD0     id' modlen' song' psecnum' pseq' blockarr' mmdflags'     reserved1' reserved2' reserved3' smplarr' reserved4'
src/Sound/MED/Raw/MMD0Block.hs view
@@ -4,6 +4,7 @@ import Sound.MED.Raw.MMD0NoteData(MMD0NoteData)  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMD0Block = MMD0Block   { numtracks :: UBYTE@@ -12,11 +13,13 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD0Block-peek m p = do-  numtracks'    <- peekUBYTE m (p + 0)-  lines'        <- peekUBYTE m (p + 1)-  notedata''    <- mapM (MMD0NoteData.peek m) $ pointerRangeGen2 (p+2) 3 numtracks' (lines'+1)+{-# SPECIALISE peek :: PTR -> StorableReader MMD0Block #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD0Block #-}+peek :: (Reader m) => PTR -> m MMD0Block+peek p = do+  numtracks'    <- peekUBYTE (p + 0)+  lines'        <- peekUBYTE (p + 1)+  notedata''    <- mapM MMD0NoteData.peek $ pointerRangeGen2 (p+2) 3 numtracks' (lines'+1)   let notedata' =  chunk numtracks' notedata''   return $ MMD0Block     numtracks' lines' notedata'
src/Sound/MED/Raw/MMD0NoteData.hs view
@@ -12,11 +12,13 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD0NoteData-peek m p = do-  byte1 <- peekUBYTE m (p + 0)-  byte2 <- peekUBYTE m (p + 1)-  byte3 <- peekUBYTE m (p + 2)+{-# SPECIALISE peek :: PTR -> StorableReader MMD0NoteData #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD0NoteData #-}+peek :: (Reader m) => PTR -> m MMD0NoteData+peek p = do+  byte1 <- peekUBYTE (p + 0)+  byte2 <- peekUBYTE (p + 1)+  byte3 <- peekUBYTE (p + 2)   let x           = (byte1 .&. 0x80) `shiftR` 7   let y           = (byte1 .&. 0x40) `shiftR` 6   let nnnnnn      = (byte1 .&. 0x3F)
src/Sound/MED/Raw/MMD0Sample.hs view
@@ -12,13 +12,15 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD0Sample-peek m p = do-  rep'        <- peekUWORD m (p+0)-  replen'     <- peekUWORD m (p+2)-  midich'     <- peekUBYTE m (p+4)-  midipreset' <- peekUBYTE m (p+5)-  svol'       <- peekUBYTE m (p+6)-  strans'     <- peekBYTE  m (p+7)+{-# SPECIALISE peek :: PTR -> StorableReader MMD0Sample #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD0Sample #-}+peek :: (Reader m) => PTR -> m MMD0Sample+peek p = do+  rep'        <- peekUWORD (p+0)+  replen'     <- peekUWORD (p+2)+  midich'     <- peekUBYTE (p+4)+  midipreset' <- peekUBYTE (p+5)+  svol'       <- peekUBYTE (p+6)+  strans'     <- peekBYTE  (p+7)   return $ MMD0Sample     rep' replen' midich' midipreset' svol' strans'
src/Sound/MED/Raw/MMD0Song.hs view
@@ -3,6 +3,7 @@ import qualified Sound.MED.Raw.MMD0Sample as MMD0Sample import Sound.MED.Raw.MMD0Sample(MMD0Sample) import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMD0Song = MMD0Song   { sample     :: [ MMD0Sample ]@@ -20,20 +21,22 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD0Song-peek m p = do-  sample'      <- mapM (MMD0Sample.peek m) $ pointerRange p 8 63-  numblocks'   <- peekUWORD m (p+504)-  songlen'     <- peekUWORD m (p+506)-  playseq'     <- mapM (peekUBYTE m) $ pointerRange (p+508) 1 256-  deftempo'    <- peekUWORD m (p+764)-  playtransp'  <- peekBYTE  m (p+766)-  flags'       <- peekUBYTE m (p+767)-  flags2'      <- peekUBYTE m (p+768)-  tempo2'      <- peekUBYTE m (p+769)-  trkvol'      <- mapM (peekUBYTE m) $ pointerRange (p+770) 1 16-  mastervol'   <- peekUBYTE m (p+786)-  numsamples'  <- peekUBYTE m (p+787)+{-# SPECIALISE peek :: PTR -> StorableReader MMD0Song #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD0Song #-}+peek :: (Reader m) => PTR -> m MMD0Song+peek p = do+  sample'      <- mapM MMD0Sample.peek $ pointerRange p 8 63+  numblocks'   <- peekUWORD (p+504)+  songlen'     <- peekUWORD (p+506)+  playseq'     <- mapM peekUBYTE $ pointerRange (p+508) 1 256+  deftempo'    <- peekUWORD (p+764)+  playtransp'  <- peekBYTE  (p+766)+  flags'       <- peekUBYTE (p+767)+  flags2'      <- peekUBYTE (p+768)+  tempo2'      <- peekUBYTE (p+769)+  trkvol'      <- mapM peekUBYTE $ pointerRange (p+770) 1 16+  mastervol'   <- peekUBYTE (p+786)+  numsamples'  <- peekUBYTE (p+787)   return $ MMD0Song     sample' numblocks' songlen' playseq' deftempo' playtransp' flags'     flags2' tempo2' trkvol' mastervol' numsamples'
src/Sound/MED/Raw/MMD0exp.hs view
@@ -16,6 +16,7 @@ import Sound.MED.Raw.MMDMIDICmd3x(MMDMIDICmd3x)  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMD0exp = MMD0exp   { nextmod       :: PTR -- FIXME@@ -42,39 +43,41 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD0exp-peek m p = do-  nextmod'       <- peekPTR   m (p+0)-  exp_smp''      <- peekPTR   m (p+4)-  s_ext_entries' <- peekUWORD m (p+8)-  s_ext_entrsz'  <- peekUWORD m (p+10)-  exp_smp'       <- mapM (InstrExt.peek s_ext_entrsz' m) $ pointerRangeGenCheck exp_smp'' (fromIntegral s_ext_entrsz') s_ext_entries'-  annotxt''      <- peekPTR   m (p+12)-  annolen'       <- peekULONG m (p+16)-  annotxt'       <- mapM (peekUBYTE m) $ pointerRangeGenCheck annotxt'' 1 annolen'-  iinfo''        <- peekPTR   m (p+20)-  i_ext_entries' <- peekUWORD m (p+24)-  i_ext_entrsz'  <- peekUWORD m (p+26)-  iinfo'         <- mapM (MMDInstrInfo.peek i_ext_entrsz' m) $ pointerRangeGenCheck iinfo'' (fromIntegral i_ext_entrsz') i_ext_entries'-  jumpmask'      <- peekULONG m (p+28)-  rgbtable''     <- peekPTR   m (p+32)-  rgbtable'      <- mapM (peekUWORD m) $ pointerRangeGenCheck rgbtable'' 2 (8::Int)-  channelsplit'  <- mapM (peekUBYTE m) $ pointerRange (p+36) 1 4-  n_info'''      <- peekPTR   m (p+40)-  n_info'        <- NotationInfo.peek m $? n_info'''-  songname''     <- peekPTR   m (p+44)-  songnamelen'   <- peekULONG m (p+48)-  songname'      <- mapM (peekUBYTE m) $ pointerRangeGenCheck songname'' 1 songnamelen'-  dumps'''       <- peekPTR   m (p+52)-  dumps'         <- MMDDumpData.peek m $? dumps'''-  mmdinfo'''     <- peekPTR   m (p+56)-  mmdinfo'       <- MMDInfo.peek m $? mmdinfo'''-  mmdrexx'''     <- peekPTR   m (p+60)-  mmdrexx'       <- MMDARexx.peek m $? mmdrexx'''-  mmdcmd3x'''    <- peekPTR   m (p+64)-  mmdcmd3x'      <- MMDMIDICmd3x.peek m $? mmdcmd3x'''-  reserved2'     <- mapM (peekULONG m) $ pointerRange (p+68) 4 3-  tag_end'       <- peekULONG m (p+80)+{-# SPECIALISE peek :: PTR -> StorableReader MMD0exp #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD0exp #-}+peek :: (Reader m) => PTR -> m MMD0exp+peek p = do+  nextmod'       <- peekPTR   (p+0)+  exp_smp''      <- peekPTR   (p+4)+  s_ext_entries' <- peekUWORD (p+8)+  s_ext_entrsz'  <- peekUWORD (p+10)+  exp_smp'       <- mapM (InstrExt.peek s_ext_entrsz') $ pointerRangeGenCheck exp_smp'' (fromIntegral s_ext_entrsz') s_ext_entries'+  annotxt''      <- peekPTR   (p+12)+  annolen'       <- peekULONG (p+16)+  annotxt'       <- mapM peekUBYTE $ pointerRangeGenCheck annotxt'' 1 annolen'+  iinfo''        <- peekPTR   (p+20)+  i_ext_entries' <- peekUWORD (p+24)+  i_ext_entrsz'  <- peekUWORD (p+26)+  iinfo'         <- mapM (MMDInstrInfo.peek i_ext_entrsz') $ pointerRangeGenCheck iinfo'' (fromIntegral i_ext_entrsz') i_ext_entries'+  jumpmask'      <- peekULONG (p+28)+  rgbtable''     <- peekPTR   (p+32)+  rgbtable'      <- mapM peekUWORD $ pointerRangeGenCheck rgbtable'' 2 (8::Int)+  channelsplit'  <- mapM peekUBYTE $ pointerRange (p+36) 1 4+  n_info'''      <- peekPTR   (p+40)+  n_info'        <- NotationInfo.peek $? n_info'''+  songname''     <- peekPTR   (p+44)+  songnamelen'   <- peekULONG (p+48)+  songname'      <- mapM peekUBYTE $ pointerRangeGenCheck songname'' 1 songnamelen'+  dumps'''       <- peekPTR   (p+52)+  dumps'         <- MMDDumpData.peek $? dumps'''+  mmdinfo'''     <- peekPTR   (p+56)+  mmdinfo'       <- MMDInfo.peek $? mmdinfo'''+  mmdrexx'''     <- peekPTR   (p+60)+  mmdrexx'       <- MMDARexx.peek $? mmdrexx'''+  mmdcmd3x'''    <- peekPTR   (p+64)+  mmdcmd3x'      <- MMDMIDICmd3x.peek $? mmdcmd3x'''+  reserved2'     <- mapM peekULONG $ pointerRange (p+68) 4 3+  tag_end'       <- peekULONG (p+80)   return $ MMD0exp     nextmod' exp_smp' i_ext_entries' s_ext_entrsz' annotxt' annolen'     iinfo' i_ext_entries' i_ext_entrsz' jumpmask' rgbtable'
src/Sound/MED/Raw/MMD1.hs view
@@ -9,6 +9,7 @@ import qualified Sound.MED.Raw.MMD0exp as MMD0exp import Sound.MED.Raw.MMD0exp(MMD0exp) import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMD1 = MMD1   { id          :: ULONG@@ -35,35 +36,37 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD1-peek m p = do-  id'          <- peekULONG m (p + 0)-  modlen'      <- peekULONG m (p + 4)-  song''       <- peekPTR   m (p + 8)-  song'        <- MMD0Song.peek m song''-  psecnum'     <- peekUWORD m (p + 12)-  pseq'        <- peekUWORD m (p + 14)-  blockarr'''  <- peekPTR   m (p + 16)-  blockarr''   <- mapM (peekPTR m) $ pointerRangeGen blockarr''' 4 (MMD0Song.numblocks song')-  blockarr'    <- mapM (MMD1Block.peek m) blockarr''-  mmdflags'    <- peekUBYTE m (p + 20)-  reserved1'   <- peekUBYTE m (p + 21)-  reserved2'   <- peekUBYTE m (p + 22)-  reserved3'   <- peekUBYTE m (p + 23)-  smplarr'''   <- peekPTR   m (p + 24)-  smplarr''    <- mapM (peekPTR m) $ pointerRangeGenCheck smplarr''' 4 (MMD0Song.numsamples song')-  smplarr'     <- mapM (InstrHdr.peek m $?) smplarr''-  reserved4'   <- peekULONG m (p + 28)-  expdata'''   <- peekPTR   m (p + 32)-  expdata'     <- MMD0exp.peek m $? expdata'''-  reserved5'   <- peekULONG m (p + 36)-  pstate'      <- peekUWORD m (p + 40)-  pblock'      <- peekUWORD m (p + 42)-  pline'       <- peekUWORD m (p + 44)-  pseqnum'     <- peekUWORD m (p + 46)-  actplayline' <- peekWORD  m (p + 48)-  counter'     <- peekUBYTE m (p + 50)-  extra_songs' <- peekUBYTE m (p + 51)+{-# SPECIALISE peek :: PTR -> StorableReader MMD1 #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD1 #-}+peek :: (Reader m) => PTR -> m MMD1+peek p = do+  id'          <- peekULONG (p + 0)+  modlen'      <- peekULONG (p + 4)+  song''       <- peekPTR   (p + 8)+  song'        <- MMD0Song.peek song''+  psecnum'     <- peekUWORD (p + 12)+  pseq'        <- peekUWORD (p + 14)+  blockarr'''  <- peekPTR   (p + 16)+  blockarr''   <- mapM peekPTR $ pointerRangeGen blockarr''' 4 (MMD0Song.numblocks song')+  blockarr'    <- mapM MMD1Block.peek blockarr''+  mmdflags'    <- peekUBYTE (p + 20)+  reserved1'   <- peekUBYTE (p + 21)+  reserved2'   <- peekUBYTE (p + 22)+  reserved3'   <- peekUBYTE (p + 23)+  smplarr'''   <- peekPTR   (p + 24)+  smplarr''    <- mapM peekPTR $ pointerRangeGenCheck smplarr''' 4 (MMD0Song.numsamples song')+  smplarr'     <- mapM (InstrHdr.peek $?) smplarr''+  reserved4'   <- peekULONG (p + 28)+  expdata'''   <- peekPTR   (p + 32)+  expdata'     <- MMD0exp.peek $? expdata'''+  reserved5'   <- peekULONG (p + 36)+  pstate'      <- peekUWORD (p + 40)+  pblock'      <- peekUWORD (p + 42)+  pline'       <- peekUWORD (p + 44)+  pseqnum'     <- peekUWORD (p + 46)+  actplayline' <- peekWORD  (p + 48)+  counter'     <- peekUBYTE (p + 50)+  extra_songs' <- peekUBYTE (p + 51)   return $ MMD1     id' modlen' song' psecnum' pseq' blockarr' mmdflags'     reserved1' reserved2' reserved3' smplarr' reserved4'
src/Sound/MED/Raw/MMD1Block.hs view
@@ -6,6 +6,7 @@ import Sound.MED.Raw.MMD1NoteData(MMD1NoteData)  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMD1Block = MMD1Block   { numtracks :: UWORD@@ -15,13 +16,15 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD1Block-peek m p = do-  numtracks'    <- peekUWORD m (p + 0)-  lines'        <- peekUWORD m (p + 2)-  info'''       <- peekPTR   m (p + 4)-  info'         <- BlockInfo.peek numtracks' (lines'+1) m $? info'''-  notedata''    <- mapM (MMD1NoteData.peek m) $ pointerRangeGen2 (p+8) 4 numtracks' (lines'+1)+{-# SPECIALISE peek :: PTR -> StorableReader MMD1Block #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD1Block #-}+peek :: (Reader m) => PTR -> m MMD1Block+peek p = do+  numtracks'    <- peekUWORD (p + 0)+  lines'        <- peekUWORD (p + 2)+  info'''       <- peekPTR   (p + 4)+  info'         <- BlockInfo.peek numtracks' (lines'+1) $? info'''+  notedata''    <- mapM MMD1NoteData.peek $ pointerRangeGen2 (p+8) 4 numtracks' (lines'+1)   let notedata' =  chunk numtracks' notedata''   return $ MMD1Block     numtracks' lines' info' notedata'
src/Sound/MED/Raw/MMD1NoteData.hs view
@@ -12,12 +12,14 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD1NoteData-peek m p = do-  byte1 <- peekUBYTE m (p + 0)-  byte2 <- peekUBYTE m (p + 1)-  byte3 <- peekUBYTE m (p + 2)-  byte4 <- peekUBYTE m (p + 3)+{-# SPECIALISE peek :: PTR -> StorableReader MMD1NoteData #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD1NoteData #-}+peek :: (Reader m) => PTR -> m MMD1NoteData+peek p = do+  byte1 <- peekUBYTE (p + 0)+  byte2 <- peekUBYTE (p + 1)+  byte3 <- peekUBYTE (p + 2)+  byte4 <- peekUBYTE (p + 3)   let nnnnnnn     = byte1 .&. 0x7F   let iiiiii      = byte2 .&. 0x3F   let cccccccc    = byte3 .&. 0xFF
src/Sound/MED/Raw/MMD2.hs view
@@ -9,6 +9,7 @@ import qualified Sound.MED.Raw.MMD0exp as MMD0exp import Sound.MED.Raw.MMD0exp(MMD0exp) import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMD2 = MMD2   { id          :: ULONG@@ -35,35 +36,37 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD2-peek m p = do-  id'          <- peekULONG m (p + 0)-  modlen'      <- peekULONG m (p + 4)-  song''       <- peekPTR   m (p + 8)-  song'        <- MMD2Song.peek m song''-  psecnum'     <- peekUWORD m (p + 12)-  pseq'        <- peekUWORD m (p + 14)-  blockarr'''  <- peekPTR   m (p + 16)-  blockarr''   <- mapM (peekPTR m) $ pointerRangeGen blockarr''' 4 (MMD2Song.numblocks song')-  blockarr'    <- mapM (MMD1Block.peek m) blockarr''-  mmdflags'    <- peekUBYTE m (p + 20)-  reserved1'   <- peekUBYTE m (p + 21)-  reserved2'   <- peekUBYTE m (p + 22)-  reserved3'   <- peekUBYTE m (p + 23)-  smplarr'''   <- peekPTR   m (p + 24)-  smplarr''    <- mapM (peekPTR m) $ pointerRangeGenCheck smplarr''' 4 (MMD2Song.numsamples song')-  smplarr'     <- mapM (InstrHdr.peek m $?) smplarr''-  reserved4'   <- peekULONG m (p + 28)-  expdata'''   <- peekPTR   m (p + 32)-  expdata'     <- MMD0exp.peek m $? expdata'''-  reserved5'   <- peekULONG m (p + 36)-  pstate'      <- peekUWORD m (p + 40)-  pblock'      <- peekUWORD m (p + 42)-  pline'       <- peekUWORD m (p + 44)-  pseqnum'     <- peekUWORD m (p + 46)-  actplayline' <- peekWORD  m (p + 48)-  counter'     <- peekUBYTE m (p + 50)-  extra_songs' <- peekUBYTE m (p + 51)+{-# SPECIALISE peek :: PTR -> StorableReader MMD2 #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD2 #-}+peek :: (Reader m) => PTR -> m MMD2+peek p = do+  id'          <- peekULONG (p + 0)+  modlen'      <- peekULONG (p + 4)+  song''       <- peekPTR   (p + 8)+  song'        <- MMD2Song.peek song''+  psecnum'     <- peekUWORD (p + 12)+  pseq'        <- peekUWORD (p + 14)+  blockarr'''  <- peekPTR   (p + 16)+  blockarr''   <- mapM peekPTR $ pointerRangeGen blockarr''' 4 (MMD2Song.numblocks song')+  blockarr'    <- mapM MMD1Block.peek blockarr''+  mmdflags'    <- peekUBYTE (p + 20)+  reserved1'   <- peekUBYTE (p + 21)+  reserved2'   <- peekUBYTE (p + 22)+  reserved3'   <- peekUBYTE (p + 23)+  smplarr'''   <- peekPTR   (p + 24)+  smplarr''    <- mapM peekPTR $ pointerRangeGenCheck smplarr''' 4 (MMD2Song.numsamples song')+  smplarr'     <- mapM (InstrHdr.peek $?) smplarr''+  reserved4'   <- peekULONG (p + 28)+  expdata'''   <- peekPTR   (p + 32)+  expdata'     <- MMD0exp.peek $? expdata'''+  reserved5'   <- peekULONG (p + 36)+  pstate'      <- peekUWORD (p + 40)+  pblock'      <- peekUWORD (p + 42)+  pline'       <- peekUWORD (p + 44)+  pseqnum'     <- peekUWORD (p + 46)+  actplayline' <- peekWORD  (p + 48)+  counter'     <- peekUBYTE (p + 50)+  extra_songs' <- peekUBYTE (p + 51)   return $ MMD2     id' modlen' song' psecnum' pseq' blockarr' mmdflags'     reserved1' reserved2' reserved3' smplarr' reserved4'
src/Sound/MED/Raw/MMD2Song.hs view
@@ -5,6 +5,7 @@ import qualified Sound.MED.Raw.PlaySeq as PlaySeq import Sound.MED.Raw.PlaySeq(PlaySeq) import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMD2Song = MMD2Song   { sample        :: [ MMD0Sample ]@@ -35,38 +36,40 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD2Song-peek m p = do-  sample'         <- mapM (MMD0Sample.peek m) $ pointerRange p 8 63-  numblocks'      <- peekUWORD m (p+504)-  songlen'        <- peekUWORD m (p+506)-  numpseqs'       <- peekUWORD m (p+522)-  playseqtable''' <- peekPTR   m (p+508)-  playseqtable''  <- mapM (peekPTR m) $ pointerRangeGen playseqtable''' 4 numpseqs'-  playseqtable'   <- mapM (PlaySeq.peek m) playseqtable''-  sectiontable''  <- peekPTR   m (p+512)-  sectiontable'   <- mapM (peekUWORD m) $ pointerRangeGen sectiontable'' 2 songlen'-  numtracks'      <- peekUWORD m (p+520)-  trackvols''     <- peekPTR   m (p+516)-  trackvols'      <- mapM (peekUBYTE m) $ pointerRangeGen trackvols'' 1 numtracks'-  trackpans''     <- peekPTR   m (p+524)-  trackpans'      <- if trackpans'' == 0 then return $ replicate (fromIntegral numtracks') 0 else mapM (peekBYTE m) $ pointerRangeGen trackpans'' 1 numtracks'-  flags3'         <- peekULONG m (p+528)-  voladj'         <- peekUWORD m (p+532)-  channels'       <- peekUWORD m (p+534)-  mix_echotype'   <- peekUBYTE m (p+536)-  mix_echodepth'  <- peekUBYTE m (p+537)-  mix_echolen'    <- peekUWORD m (p+538)-  mix_stereosep'  <- peekBYTE  m (p+540)-  pad0'           <- mapM (peekUBYTE m) $ pointerRange (p+541) 1 223-  deftempo'       <- peekUWORD m (p+764)-  playtransp'     <- peekBYTE  m (p+766)-  flags'          <- peekUBYTE m (p+767)-  flags2'         <- peekUBYTE m (p+768)-  tempo2'         <- peekUBYTE m (p+769)-  pad1'           <- mapM (peekUBYTE m) $ pointerRange (p+770) 1 16-  mastervol'      <- peekUBYTE m (p+786)-  numsamples'     <- peekUBYTE m (p+787)+{-# SPECIALISE peek :: PTR -> StorableReader MMD2Song #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD2Song #-}+peek :: (Reader m) => PTR -> m MMD2Song+peek p = do+  sample'         <- mapM MMD0Sample.peek $ pointerRange p 8 63+  numblocks'      <- peekUWORD (p+504)+  songlen'        <- peekUWORD (p+506)+  numpseqs'       <- peekUWORD (p+522)+  playseqtable''' <- peekPTR   (p+508)+  playseqtable''  <- mapM peekPTR $ pointerRangeGen playseqtable''' 4 numpseqs'+  playseqtable'   <- mapM PlaySeq.peek playseqtable''+  sectiontable''  <- peekPTR   (p+512)+  sectiontable'   <- mapM peekUWORD $ pointerRangeGen sectiontable'' 2 songlen'+  numtracks'      <- peekUWORD (p+520)+  trackvols''     <- peekPTR   (p+516)+  trackvols'      <- mapM peekUBYTE $ pointerRangeGen trackvols'' 1 numtracks'+  trackpans''     <- peekPTR   (p+524)+  trackpans'      <- if trackpans'' == 0 then return $ replicate (fromIntegral numtracks') 0 else mapM peekBYTE $ pointerRangeGen trackpans'' 1 numtracks'+  flags3'         <- peekULONG (p+528)+  voladj'         <- peekUWORD (p+532)+  channels'       <- peekUWORD (p+534)+  mix_echotype'   <- peekUBYTE (p+536)+  mix_echodepth'  <- peekUBYTE (p+537)+  mix_echolen'    <- peekUWORD (p+538)+  mix_stereosep'  <- peekBYTE  (p+540)+  pad0'           <- mapM peekUBYTE $ pointerRange (p+541) 1 223+  deftempo'       <- peekUWORD (p+764)+  playtransp'     <- peekBYTE  (p+766)+  flags'          <- peekUBYTE (p+767)+  flags2'         <- peekUBYTE (p+768)+  tempo2'         <- peekUBYTE (p+769)+  pad1'           <- mapM peekUBYTE $ pointerRange (p+770) 1 16+  mastervol'      <- peekUBYTE (p+786)+  numsamples'     <- peekUBYTE (p+787)   return $ MMD2Song     sample' numblocks' songlen' playseqtable' sectiontable' trackvols'     numtracks' numpseqs' trackpans' flags3' voladj' channels'
src/Sound/MED/Raw/MMD3.hs view
@@ -9,6 +9,7 @@ import qualified Sound.MED.Raw.MMD0exp as MMD0exp import Sound.MED.Raw.MMD0exp(MMD0exp) import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMD3 = MMD3   { id          :: ULONG@@ -35,35 +36,37 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMD3-peek m p = do-  id'          <- peekULONG m (p + 0)-  modlen'      <- peekULONG m (p + 4)-  song''       <- peekPTR   m (p + 8)-  song'        <- MMD2Song.peek m song''-  psecnum'     <- peekUWORD m (p + 12)-  pseq'        <- peekUWORD m (p + 14)-  blockarr'''  <- peekPTR   m (p + 16)-  blockarr''   <- mapM (peekPTR m) $ pointerRangeGen blockarr''' 4 (MMD2Song.numblocks song')-  blockarr'    <- mapM (MMD1Block.peek m) blockarr''-  mmdflags'    <- peekUBYTE m (p + 20)-  reserved1'   <- peekUBYTE m (p + 21)-  reserved2'   <- peekUBYTE m (p + 22)-  reserved3'   <- peekUBYTE m (p + 23)-  smplarr'''   <- peekPTR   m (p + 24)-  smplarr''    <- mapM (peekPTR m) $ pointerRangeGenCheck smplarr''' 4 (MMD2Song.numsamples song')-  smplarr'     <- mapM (InstrHdr.peek m $?) smplarr''-  reserved4'   <- peekULONG m (p + 28)-  expdata'''   <- peekPTR   m (p + 32)-  expdata'     <- MMD0exp.peek m $? expdata'''-  reserved5'   <- peekULONG m (p + 36)-  pstate'      <- peekUWORD m (p + 40)-  pblock'      <- peekUWORD m (p + 42)-  pline'       <- peekUWORD m (p + 44)-  pseqnum'     <- peekUWORD m (p + 46)-  actplayline' <- peekWORD  m (p + 48)-  counter'     <- peekUBYTE m (p + 50)-  extra_songs' <- peekUBYTE m (p + 51)+{-# SPECIALISE peek :: PTR -> StorableReader MMD3 #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMD3 #-}+peek :: (Reader m) => PTR -> m MMD3+peek p = do+  id'          <- peekULONG (p + 0)+  modlen'      <- peekULONG (p + 4)+  song''       <- peekPTR   (p + 8)+  song'        <- MMD2Song.peek song''+  psecnum'     <- peekUWORD (p + 12)+  pseq'        <- peekUWORD (p + 14)+  blockarr'''  <- peekPTR   (p + 16)+  blockarr''   <- mapM peekPTR $ pointerRangeGen blockarr''' 4 (MMD2Song.numblocks song')+  blockarr'    <- mapM MMD1Block.peek blockarr''+  mmdflags'    <- peekUBYTE (p + 20)+  reserved1'   <- peekUBYTE (p + 21)+  reserved2'   <- peekUBYTE (p + 22)+  reserved3'   <- peekUBYTE (p + 23)+  smplarr'''   <- peekPTR   (p + 24)+  smplarr''    <- mapM peekPTR $ pointerRangeGenCheck smplarr''' 4 (MMD2Song.numsamples song')+  smplarr'     <- mapM (InstrHdr.peek $?) smplarr''+  reserved4'   <- peekULONG (p + 28)+  expdata'''   <- peekPTR   (p + 32)+  expdata'     <- MMD0exp.peek $? expdata'''+  reserved5'   <- peekULONG (p + 36)+  pstate'      <- peekUWORD (p + 40)+  pblock'      <- peekUWORD (p + 42)+  pline'       <- peekUWORD (p + 44)+  pseqnum'     <- peekUWORD (p + 46)+  actplayline' <- peekWORD  (p + 48)+  counter'     <- peekUBYTE (p + 50)+  extra_songs' <- peekUBYTE (p + 51)   return $ MMD3     id' modlen' song' psecnum' pseq' blockarr' mmdflags'     reserved1' reserved2' reserved3' smplarr' reserved4'
src/Sound/MED/Raw/MMDARexx.hs view
@@ -4,6 +4,7 @@ import Sound.MED.Raw.MMDARexxTrigCmd(MMDARexxTrigCmd)  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMDARexx = MMDARexx   { reserved   :: UWORD@@ -12,11 +13,13 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMDARexx-peek m p = do-  reserved'   <- peekUWORD m (p+0)-  trigcmdlen' <- peekUWORD m (p+2)-  trigcmd'''  <- peekPTR   m (p+4)-  trigcmd'    <- MMDARexxTrigCmd.peek m $? trigcmd'''+{-# SPECIALISE peek :: PTR -> StorableReader MMDARexx #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMDARexx #-}+peek :: (Reader m) => PTR -> m MMDARexx+peek p = do+  reserved'   <- peekUWORD (p+0)+  trigcmdlen' <- peekUWORD (p+2)+  trigcmd'''  <- peekPTR   (p+4)+  trigcmd'    <- MMDARexxTrigCmd.peek $? trigcmd'''   return $ MMDARexx     reserved' trigcmdlen' trigcmd'
src/Sound/MED/Raw/MMDARexxTrigCmd.hs view
@@ -1,6 +1,7 @@ module Sound.MED.Raw.MMDARexxTrigCmd where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMDARexxTrigCmd = MMDARexxTrigCmd   { next     :: Maybe MMDARexxTrigCmd@@ -14,18 +15,20 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMDARexxTrigCmd-peek m p = do-  next'''    <- peekPTR m p-  next'      <- peek m $? next'''-  cmdnum'    <- peekUBYTE m (p+4)-  pad'       <- peekUBYTE m (p+5)-  cmdtype'   <- peekWORD  m (p+6)-  cmd''      <- peekPTR   m (p+8)-  port''     <- peekPTR   m (p+12)-  cmd_len'   <- peekUWORD m (p+16)-  port_len'  <- peekUWORD m (p+18)-  cmd'       <- mapM (peekUBYTE m) $ pointerRangeGenCheck cmd'' 1 (cmd_len'+1)-  port'      <- mapM (peekUBYTE m) $ pointerRangeGenCheck port'' 1 (port_len'+1)+{-# SPECIALISE peek :: PTR -> StorableReader MMDARexxTrigCmd #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMDARexxTrigCmd #-}+peek :: (Reader m) => PTR -> m MMDARexxTrigCmd+peek p = do+  next'''    <- peekPTR p+  next'      <- peek $? next'''+  cmdnum'    <- peekUBYTE (p+4)+  pad'       <- peekUBYTE (p+5)+  cmdtype'   <- peekWORD  (p+6)+  cmd''      <- peekPTR   (p+8)+  port''     <- peekPTR   (p+12)+  cmd_len'   <- peekUWORD (p+16)+  port_len'  <- peekUWORD (p+18)+  cmd'       <- mapM peekUBYTE $ pointerRangeGenCheck cmd'' 1 (cmd_len'+1)+  port'      <- mapM peekUBYTE $ pointerRangeGenCheck port'' 1 (port_len'+1)   return $ MMDARexxTrigCmd     next' cmdnum' pad' cmdtype' cmd' port' cmd_len' port_len'
src/Sound/MED/Raw/MMDDump.hs view
@@ -1,6 +1,7 @@ module Sound.MED.Raw.MMDDump where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMDDump = MMDDump   { len     :: ULONG@@ -10,13 +11,15 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMDDump-peek m p = do-  len'     <- peekULONG m (p+0)-  dat''    <- peekPTR   m (p+4)-  dat'     <- mapM (peekUBYTE m) $ pointerRangeGenCheck dat'' 1 len'-  ext_len' <- peekUWORD m (p+8)+{-# SPECIALISE peek :: PTR -> StorableReader MMDDump #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMDDump #-}+peek :: (Reader m) => PTR -> m MMDDump+peek p = do+  len'     <- peekULONG (p+0)+  dat''    <- peekPTR   (p+4)+  dat'     <- mapM peekUBYTE $ pointerRangeGenCheck dat'' 1 len'+  ext_len' <- peekUWORD (p+8)   name'    <--    skipIf (ext_len' < 20) $ mapM (peekUBYTE m) $ pointerRange (p+10) 1 20+    skipIf (ext_len' < 20) $ mapM peekUBYTE $ pointerRange (p+10) 1 20   return $ MMDDump     len' dat' ext_len' name'
src/Sound/MED/Raw/MMDDumpData.hs view
@@ -4,6 +4,7 @@ import Sound.MED.Raw.MMDDump(MMDDump)  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMDDumpData = MMDDumpData   { numdumps :: UWORD@@ -12,11 +13,13 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMDDumpData-peek m p = do-  numdumps' <- peekUWORD m p-  reserved' <- mapM (peekUWORD m) $ pointerRange (p+2) 2 3-  dumps''   <- mapM (peekPTR m) $ pointerRangeGen (p+8) 4 numdumps'-  dumps'    <- mapM (MMDDump.peek m) dumps''+{-# SPECIALISE peek :: PTR -> StorableReader MMDDumpData #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMDDumpData #-}+peek :: (Reader m) => PTR -> m MMDDumpData+peek p = do+  numdumps' <- peekUWORD p+  reserved' <- mapM peekUWORD $ pointerRange (p+2) 2 3+  dumps''   <- mapM peekPTR $ pointerRangeGen (p+8) 4 numdumps'+  dumps'    <- mapM MMDDump.peek dumps''   return $ MMDDumpData     numdumps' reserved' dumps'
src/Sound/MED/Raw/MMDInfo.hs view
@@ -1,6 +1,7 @@ module Sound.MED.Raw.MMDInfo where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMDInfo = MMDInfo   { next     :: Maybe MMDInfo@@ -11,13 +12,15 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMDInfo-peek m p = do-  next'''   <- peekPTR m p-  next'     <- peek m $? next'''-  reserved' <- peekUWORD m (p+4)-  typ'      <- peekUWORD m (p+6)-  len'      <- peekULONG m (p+8)-  dat'      <- mapM (peekUBYTE m) $ pointerRangeGen (p+12) 1 len'+{-# SPECIALISE peek :: PTR -> StorableReader MMDInfo #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMDInfo #-}+peek :: (Reader m) => PTR -> m MMDInfo+peek p = do+  next'''   <- peekPTR p+  next'     <- peek $? next'''+  reserved' <- peekUWORD (p+4)+  typ'      <- peekUWORD (p+6)+  len'      <- peekULONG (p+8)+  dat'      <- mapM peekUBYTE $ pointerRangeGen (p+12) 1 len'   return $ MMDInfo     next' reserved' typ' len' dat'
src/Sound/MED/Raw/MMDInstrInfo.hs view
@@ -1,14 +1,17 @@ module Sound.MED.Raw.MMDInstrInfo where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMDInstrInfo = MMDInstrInfo   { name :: Maybe [ UBYTE ]   }   deriving (Show) -peek :: UWORD -> MEM -> PTR -> IO MMDInstrInfo-peek size m p = do-  name' <- skipIf (size < 40) $ mapM (peekUBYTE m) $ pointerRange p 1 40+{-# SPECIALISE peek :: UWORD -> PTR -> StorableReader MMDInstrInfo #-}+{-# SPECIALISE peek :: UWORD -> PTR -> ByteStringReader MMDInstrInfo #-}+peek :: (Reader m) => UWORD -> PTR -> m MMDInstrInfo+peek size p = do+  name' <- skipIf (size < 40) $ mapM peekUBYTE $ pointerRange p 1 40   return $ MMDInstrInfo     name'
src/Sound/MED/Raw/MMDMIDICmd3x.hs view
@@ -1,6 +1,7 @@ module Sound.MED.Raw.MMDMIDICmd3x where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data MMDMIDICmd3x = MMDMIDICmd3x   { struct_ver      :: UBYTE@@ -11,14 +12,16 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO MMDMIDICmd3x-peek m p = do-  struct_ver'      <- peekUBYTE m (p+0)-  pad'             <- peekUBYTE m (p+1)-  num_of_settings' <- peekUWORD m (p+2)-  ctrlr_types''    <- peekPTR   m (p+4)-  ctrlr_types'     <- mapM (peekUBYTE m) $ pointerRangeGen ctrlr_types'' 1 num_of_settings'-  ctrlr_numbers''  <- peekPTR   m (p+8)-  ctrlr_numbers'   <- mapM (peekUWORD m) $ pointerRangeGen ctrlr_numbers'' 2 num_of_settings'+{-# SPECIALISE peek :: PTR -> StorableReader MMDMIDICmd3x #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader MMDMIDICmd3x #-}+peek :: (Reader m) => PTR -> m MMDMIDICmd3x+peek p = do+  struct_ver'      <- peekUBYTE (p+0)+  pad'             <- peekUBYTE (p+1)+  num_of_settings' <- peekUWORD (p+2)+  ctrlr_types''    <- peekPTR   (p+4)+  ctrlr_types'     <- mapM peekUBYTE $ pointerRangeGen ctrlr_types'' 1 num_of_settings'+  ctrlr_numbers''  <- peekPTR   (p+8)+  ctrlr_numbers'   <- mapM peekUWORD $ pointerRangeGen ctrlr_numbers'' 2 num_of_settings'   return $ MMDMIDICmd3x     struct_ver' pad' num_of_settings' ctrlr_types' ctrlr_numbers'
src/Sound/MED/Raw/NotationInfo.hs view
@@ -1,6 +1,7 @@ module Sound.MED.Raw.NotationInfo where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data NotationInfo = NotationInfo   { n_of_sharps :: UBYTE@@ -13,14 +14,16 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO NotationInfo-peek m p = do-  n_of_sharps' <- peekUBYTE m (p+0)-  flags'       <- peekUBYTE m (p+1)-  trksel'      <- mapM (peekWORD  m) $ pointerRange (p+ 2) 2 5-  trkshow'     <- mapM (peekUBYTE m) $ pointerRange (p+22) 1 16-  trkghost'    <- mapM (peekUBYTE m) $ pointerRange (p+38) 1 16-  notetr'      <- mapM (peekBYTE  m) $ pointerRange (p+54) 1 63-  pad'         <- peekUBYTE m (p+117)+{-# SPECIALISE peek :: PTR -> StorableReader NotationInfo #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader NotationInfo #-}+peek :: (Reader m) => PTR -> m NotationInfo+peek p = do+  n_of_sharps' <- peekUBYTE (p+0)+  flags'       <- peekUBYTE (p+1)+  trksel'      <- mapM peekWORD  $ pointerRange (p+ 2) 2 5+  trkshow'     <- mapM peekUBYTE $ pointerRange (p+22) 1 16+  trkghost'    <- mapM peekUBYTE $ pointerRange (p+38) 1 16+  notetr'      <- mapM peekBYTE  $ pointerRange (p+54) 1 63+  pad'         <- peekUBYTE (p+117)   return $ NotationInfo     n_of_sharps' flags' trksel' trkshow' trkghost' notetr' pad'
src/Sound/MED/Raw/PlaySeq.hs view
@@ -1,6 +1,7 @@ module Sound.MED.Raw.PlaySeq where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data PlaySeq = PlaySeq   { name       :: [ UBYTE ]@@ -11,12 +12,14 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO PlaySeq-peek m p = do-  name'      <- mapM (peekUBYTE m) $ pointerRange p 1 32-  reserved0' <- peekULONG m (p+32)-  reserved1' <- peekULONG m (p+36)-  len'       <- peekUWORD m (p+40)-  seq'       <- mapM (peekUWORD m) $ pointerRangeGen (p+42) 2 len'+{-# SPECIALISE peek :: PTR -> StorableReader PlaySeq #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader PlaySeq #-}+peek :: (Reader m) => PTR -> m PlaySeq+peek p = do+  name'      <- mapM peekUBYTE $ pointerRange p 1 32+  reserved0' <- peekULONG (p+32)+  reserved1' <- peekULONG (p+36)+  len'       <- peekUWORD (p+40)+  seq'       <- mapM peekUWORD $ pointerRangeGen (p+42) 2 len'   return $ PlaySeq     name' reserved0' reserved1' len' seq'
src/Sound/MED/Raw/SampleInstr.hs view
@@ -1,6 +1,7 @@ module Sound.MED.Raw.SampleInstr where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data SampleInstr = SampleInstr   { octaves :: WORD@@ -8,11 +9,13 @@   }   deriving Show -peek :: ULONG -> WORD -> Bool -> Bool -> MEM -> PTR -> IO SampleInstr-peek len' stype' s16' stereo' m p = do+{-# SPECIALISE peek :: ULONG -> WORD -> Bool -> Bool -> PTR -> StorableReader SampleInstr #-}+{-# SPECIALISE peek :: ULONG -> WORD -> Bool -> Bool -> PTR -> ByteStringReader SampleInstr #-}+peek :: (Reader m) => ULONG -> WORD -> Bool -> Bool -> PTR -> m SampleInstr+peek len' stype' s16' stereo' p = do   let octaves' = [1,5,3,2,4,6,7,9]!!fromIntegral stype'   case (s16',stereo') of-    (False, False) -> do { dat'' <- mapM (peekBYTE m) $ pointerRangeGen (p+6) 1 len'             ; return $ SampleInstr octaves' $ Left [dat''] }-    (True,  False) -> do { dat'' <- mapM (peekWORD m) $ pointerRangeGen (p+6) 2 (len'`div`2)     ; return $ SampleInstr octaves' $ Right [dat''] }-    (False, True ) -> do { dat'' <- mapM (peekBYTE m) $ pointerRangeGen (p+6) 1 (2*len')         ; return $ SampleInstr octaves' $ Left (chunk len' dat'') }-    (True,  True ) -> do { dat'' <- mapM (peekWORD m) $ pointerRangeGen (p+6) 2 (2*(len'`div`2)) ; return $ SampleInstr octaves' $ Right (chunk (len'`div`2) dat'') }+    (False, False) -> do { dat'' <- mapM peekBYTE $ pointerRangeGen (p+6) 1 len'             ; return $ SampleInstr octaves' $ Left [dat''] }+    (True,  False) -> do { dat'' <- mapM peekWORD $ pointerRangeGen (p+6) 2 (len'`div`2)     ; return $ SampleInstr octaves' $ Right [dat''] }+    (False, True ) -> do { dat'' <- mapM peekBYTE $ pointerRangeGen (p+6) 1 (2*len')         ; return $ SampleInstr octaves' $ Left (chunk len' dat'') }+    (True,  True ) -> do { dat'' <- mapM peekWORD $ pointerRangeGen (p+6) 2 (2*(len'`div`2)) ; return $ SampleInstr octaves' $ Right (chunk (len'`div`2) dat'') }
src/Sound/MED/Raw/SynthInstr.hs view
@@ -4,6 +4,7 @@ import Sound.MED.Raw.SynthWF(SynthWF)  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data SynthInstr = SynthInstr   { defaultdecay :: UBYTE@@ -21,21 +22,23 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO SynthInstr-peek m p = do-  defaultdecay' <- peekUBYTE m (p+6)-  reserved'     <- mapM (peekUBYTE m) $ pointerRange (p+7) 1 3-  rep'          <- peekUWORD m (p+10)-  replen'       <- peekUWORD m (p+12)-  voltbllen'    <- peekUWORD m (p+14)-  wftbllen'     <- peekUWORD m (p+16)-  volspeed'     <- peekUBYTE m (p+18)-  wfspeed'      <- peekUBYTE m (p+19)-  wforms'       <- peekUWORD m (p+20)-  voltbl'       <- mapM (peekUBYTE m) $ pointerRange (p+22) 1 128-  wftbl'        <- mapM (peekUBYTE m) $ pointerRange (p+150) 150 128-  wf''          <- mapM (peekPTR m)   $ pointerRange (p+278) 4 64-  wf'           <- mapM (SynthWF.peek m . (p+) $?) wf''+{-# SPECIALISE peek :: PTR -> StorableReader SynthInstr #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader SynthInstr #-}+peek :: (Reader m) => PTR -> m SynthInstr+peek p = do+  defaultdecay' <- peekUBYTE (p+6)+  reserved'     <- mapM peekUBYTE $ pointerRange (p+7) 1 3+  rep'          <- peekUWORD (p+10)+  replen'       <- peekUWORD (p+12)+  voltbllen'    <- peekUWORD (p+14)+  wftbllen'     <- peekUWORD (p+16)+  volspeed'     <- peekUBYTE (p+18)+  wfspeed'      <- peekUBYTE (p+19)+  wforms'       <- peekUWORD (p+20)+  voltbl'       <- mapM peekUBYTE $ pointerRange (p+22) 1 128+  wftbl'        <- mapM peekUBYTE $ pointerRange (p+150) 150 128+  wf''          <- mapM peekPTR   $ pointerRange (p+278) 4 64+  wf'           <- mapM (SynthWF.peek . (p+) $?) wf''   return $ SynthInstr     defaultdecay' reserved' rep' replen' voltbllen' wftbllen'     volspeed' wfspeed' wforms' voltbl' wftbl' wf'
src/Sound/MED/Raw/SynthWF.hs view
@@ -1,6 +1,7 @@ module Sound.MED.Raw.SynthWF where  import Sound.MED.Basic.Amiga+import Sound.MED.Basic.Utility  data SynthWF = SynthWF   { len2   :: UWORD@@ -8,9 +9,11 @@   }   deriving (Show) -peek :: MEM -> PTR -> IO SynthWF-peek m p = do-  len2'   <- peekUWORD m (p+0)-  wfdata' <- mapM (peekBYTE m) $ pointerRangeGen (p+2) 1 (len2'*2)+{-# SPECIALISE peek :: PTR -> StorableReader SynthWF #-}+{-# SPECIALISE peek :: PTR -> ByteStringReader SynthWF #-}+peek :: (Reader m) => PTR -> m SynthWF+peek p = do+  len2'   <- peekUWORD (p+0)+  wfdata' <- mapM peekBYTE $ pointerRangeGen (p+2) 1 (len2'*2)   return $ SynthWF     len2' wfdata'