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 +7/−2
- src/Sound/MED/Basic/Amiga.hs +87/−64
- src/Sound/MED/Basic/ByteString.hs +37/−0
- src/Sound/MED/Basic/Storable.hs +20/−0
- src/Sound/MED/Basic/Utility.hs +53/−0
- src/Sound/MED/Generic.hs +9/−9
- src/Sound/MED/Generic/Block.hs +1/−1
- src/Sound/MED/Generic/Instrument.hs +1/−1
- src/Sound/MED/Generic/PlaySeq.hs +1/−1
- src/Sound/MED/Raw/BlockCmdPageTable.hs +16/−10
- src/Sound/MED/Raw/BlockInfo.hs +13/−10
- src/Sound/MED/Raw/CmdPageData.hs +6/−4
- src/Sound/MED/Raw/HybridInstr.hs +18/−15
- src/Sound/MED/Raw/InstrExt.hs +8/−4
- src/Sound/MED/Raw/InstrHdr.hs +9/−7
- src/Sound/MED/Raw/MMD0.hs +32/−29
- src/Sound/MED/Raw/MMD0Block.hs +8/−5
- src/Sound/MED/Raw/MMD0NoteData.hs +7/−5
- src/Sound/MED/Raw/MMD0Sample.hs +10/−8
- src/Sound/MED/Raw/MMD0Song.hs +17/−14
- src/Sound/MED/Raw/MMD0exp.hs +36/−33
- src/Sound/MED/Raw/MMD1.hs +32/−29
- src/Sound/MED/Raw/MMD1Block.hs +10/−7
- src/Sound/MED/Raw/MMD1NoteData.hs +8/−6
- src/Sound/MED/Raw/MMD2.hs +32/−29
- src/Sound/MED/Raw/MMD2Song.hs +35/−32
- src/Sound/MED/Raw/MMD3.hs +32/−29
- src/Sound/MED/Raw/MMDARexx.hs +9/−6
- src/Sound/MED/Raw/MMDARexxTrigCmd.hs +16/−13
- src/Sound/MED/Raw/MMDDump.hs +10/−7
- src/Sound/MED/Raw/MMDDumpData.hs +9/−6
- src/Sound/MED/Raw/MMDInfo.hs +11/−8
- src/Sound/MED/Raw/MMDInstrInfo.hs +6/−3
- src/Sound/MED/Raw/MMDMIDICmd3x.hs +12/−9
- src/Sound/MED/Raw/NotationInfo.hs +12/−9
- src/Sound/MED/Raw/PlaySeq.hs +10/−7
- src/Sound/MED/Raw/SampleInstr.hs +9/−6
- src/Sound/MED/Raw/SynthInstr.hs +18/−15
- src/Sound/MED/Raw/SynthWF.hs +7/−4
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'