module Sound.MED.Generic where import qualified Sound.MED.Raw.MMD0 as MMD0 import qualified Sound.MED.Raw.MMD1 as MMD1 import qualified Sound.MED.Raw.MMD2 as MMD2 import qualified Sound.MED.Raw.MMD3 as MMD3 import qualified Sound.MED.Raw.MMD0exp as MMD0exp import qualified Sound.MED.Raw.MMD0Song as MMD0Song import qualified Sound.MED.Raw.MMD2Song as MMD2Song import qualified Sound.MED.Generic.Block as MEDBlock import qualified Sound.MED.Generic.Instrument as MEDInstrument import qualified Sound.MED.Generic.PlaySeq as MEDPlaySeq import qualified Sound.MED.Generic.Tempo as MEDTempo import Sound.MED.Generic.Instrument(medinstruments) import Sound.MED.Basic.Human(Human(human)) import Sound.MED.Basic.Amiga import Control.Exception (bracket) import Data.Foldable (foldMap) import Text.Printf (printf) data MED = MED { MED -> [MEDInstrument] instrs :: [MEDInstrument.MEDInstrument] , MED -> [MEDBlock] blocks :: [MEDBlock.MEDBlock] , MED -> [MEDPlaySeq] playseqs :: [MEDPlaySeq.MEDPlaySeq] , MED -> MEDTempo tempo :: MEDTempo.MEDTempo } peek :: (Reader m) => m MED peek :: m MED peek = do ULONG ident <- Peek m ULONG forall (m :: * -> *). Reader m => Peek m ULONG peekULONG ULONG 0 let samples0 :: MMD0Song -> [MMD0Sample] samples0 MMD0Song song = Int -> [MMD0Sample] -> [MMD0Sample] forall a. Int -> [a] -> [a] take (UBYTE -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral (MMD0Song -> UBYTE MMD0Song.numsamples MMD0Song song)) ([MMD0Sample] -> [MMD0Sample]) -> [MMD0Sample] -> [MMD0Sample] forall a b. (a -> b) -> a -> b $ MMD0Song -> [MMD0Sample] MMD0Song.sample MMD0Song song let samples2 :: MMD2Song -> [MMD0Sample] samples2 MMD2Song song = Int -> [MMD0Sample] -> [MMD0Sample] forall a. Int -> [a] -> [a] take (UBYTE -> Int forall a b. (Integral a, Num b) => a -> b fromIntegral (MMD2Song -> UBYTE MMD2Song.numsamples MMD2Song song)) ([MMD0Sample] -> [MMD0Sample]) -> [MMD0Sample] -> [MMD0Sample] forall a b. (a -> b) -> a -> b $ MMD2Song -> [MMD0Sample] MMD2Song.sample MMD2Song song let instrs_ :: (t -> [Maybe InstrHdr]) -> (t -> [MMD0Sample]) -> (t -> t MMD0exp) -> t -> [MEDInstrument] instrs_ t -> [Maybe InstrHdr] smplarr t -> [MMD0Sample] samples t -> t MMD0exp expdata t med = [Maybe InstrHdr] -> [MMD0Sample] -> [MMDInstrInfo] -> [InstrExt] -> [MEDInstrument] medinstruments (t -> [Maybe InstrHdr] smplarr t med) (t -> [MMD0Sample] samples t med) ((MMD0exp -> [MMDInstrInfo]) -> t MMD0exp -> [MMDInstrInfo] forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap MMD0exp -> [MMDInstrInfo] MMD0exp.iinfo (t MMD0exp -> [MMDInstrInfo]) -> t MMD0exp -> [MMDInstrInfo] forall a b. (a -> b) -> a -> b $ t -> t MMD0exp expdata t med) ((MMD0exp -> [InstrExt]) -> t MMD0exp -> [InstrExt] forall (t :: * -> *) m a. (Foldable t, Monoid m) => (a -> m) -> t a -> m foldMap MMD0exp -> [InstrExt] MMD0exp.exp_smp (t MMD0exp -> [InstrExt]) -> t MMD0exp -> [InstrExt] forall a b. (a -> b) -> a -> b $ t -> t MMD0exp expdata t med) let mmd0PlaySeq :: MMD0Song -> [MEDPlaySeq] mmd0PlaySeq MMD0Song song = [MMD0Song -> MEDPlaySeq MEDPlaySeq.playSeq0 MMD0Song song] let mmd2PlaySeqs :: MMD2Song -> [MEDPlaySeq] mmd2PlaySeqs = (PlaySeq -> MEDPlaySeq) -> [PlaySeq] -> [MEDPlaySeq] forall a b. (a -> b) -> [a] -> [b] map PlaySeq -> MEDPlaySeq MEDPlaySeq.playSeq2 ([PlaySeq] -> [MEDPlaySeq]) -> (MMD2Song -> [PlaySeq]) -> MMD2Song -> [MEDPlaySeq] forall b c a. (b -> c) -> (a -> b) -> a -> c . MMD2Song -> [PlaySeq] MMD2Song.playseqtable case ULONG ident of ULONG 0x4D4D4430 -> do MMD0 med <- ULONG -> m MMD0 forall (m :: * -> *). Reader m => ULONG -> m MMD0 MMD0.peek ULONG 0 MED -> m MED forall (m :: * -> *) a. Monad m => a -> m a return (MED -> m MED) -> MED -> m MED forall a b. (a -> b) -> a -> b $ MED :: [MEDInstrument] -> [MEDBlock] -> [MEDPlaySeq] -> MEDTempo -> MED MED { instrs :: [MEDInstrument] instrs = (MMD0 -> [Maybe InstrHdr]) -> (MMD0 -> [MMD0Sample]) -> (MMD0 -> Maybe MMD0exp) -> MMD0 -> [MEDInstrument] forall (t :: * -> *) t. Foldable t => (t -> [Maybe InstrHdr]) -> (t -> [MMD0Sample]) -> (t -> t MMD0exp) -> t -> [MEDInstrument] instrs_ MMD0 -> [Maybe InstrHdr] MMD0.smplarr (MMD0Song -> [MMD0Sample] samples0 (MMD0Song -> [MMD0Sample]) -> (MMD0 -> MMD0Song) -> MMD0 -> [MMD0Sample] forall b c a. (b -> c) -> (a -> b) -> a -> c . MMD0 -> MMD0Song MMD0.song) MMD0 -> Maybe MMD0exp MMD0.expdata MMD0 med , blocks :: [MEDBlock] blocks = (MMD0Block -> MEDBlock) -> [MMD0Block] -> [MEDBlock] forall a b. (a -> b) -> [a] -> [b] map MMD0Block -> MEDBlock MEDBlock.medblock0 ([MMD0Block] -> [MEDBlock]) -> [MMD0Block] -> [MEDBlock] forall a b. (a -> b) -> a -> b $ MMD0 -> [MMD0Block] MMD0.blockarr MMD0 med , playseqs :: [MEDPlaySeq] playseqs = MMD0Song -> [MEDPlaySeq] mmd0PlaySeq (MMD0Song -> [MEDPlaySeq]) -> MMD0Song -> [MEDPlaySeq] forall a b. (a -> b) -> a -> b $ MMD0 -> MMD0Song MMD0.song MMD0 med , tempo :: MEDTempo tempo = MMD0Song -> MEDTempo MEDTempo.song0Tempo (MMD0Song -> MEDTempo) -> MMD0Song -> MEDTempo forall a b. (a -> b) -> a -> b $ MMD0 -> MMD0Song MMD0.song MMD0 med } ULONG 0x4D4D4431 -> do MMD1 med <- ULONG -> m MMD1 forall (m :: * -> *). Reader m => ULONG -> m MMD1 MMD1.peek ULONG 0 MED -> m MED forall (m :: * -> *) a. Monad m => a -> m a return (MED -> m MED) -> MED -> m MED forall a b. (a -> b) -> a -> b $ MED :: [MEDInstrument] -> [MEDBlock] -> [MEDPlaySeq] -> MEDTempo -> MED MED { instrs :: [MEDInstrument] instrs = (MMD1 -> [Maybe InstrHdr]) -> (MMD1 -> [MMD0Sample]) -> (MMD1 -> Maybe MMD0exp) -> MMD1 -> [MEDInstrument] forall (t :: * -> *) t. Foldable t => (t -> [Maybe InstrHdr]) -> (t -> [MMD0Sample]) -> (t -> t MMD0exp) -> t -> [MEDInstrument] instrs_ MMD1 -> [Maybe InstrHdr] MMD1.smplarr (MMD0Song -> [MMD0Sample] samples0 (MMD0Song -> [MMD0Sample]) -> (MMD1 -> MMD0Song) -> MMD1 -> [MMD0Sample] forall b c a. (b -> c) -> (a -> b) -> a -> c . MMD1 -> MMD0Song MMD1.song) MMD1 -> Maybe MMD0exp MMD1.expdata MMD1 med , blocks :: [MEDBlock] blocks = (MMD1Block -> MEDBlock) -> [MMD1Block] -> [MEDBlock] forall a b. (a -> b) -> [a] -> [b] map MMD1Block -> MEDBlock MEDBlock.medblock1 ([MMD1Block] -> [MEDBlock]) -> [MMD1Block] -> [MEDBlock] forall a b. (a -> b) -> a -> b $ MMD1 -> [MMD1Block] MMD1.blockarr MMD1 med , playseqs :: [MEDPlaySeq] playseqs = MMD0Song -> [MEDPlaySeq] mmd0PlaySeq (MMD0Song -> [MEDPlaySeq]) -> MMD0Song -> [MEDPlaySeq] forall a b. (a -> b) -> a -> b $ MMD1 -> MMD0Song MMD1.song MMD1 med , tempo :: MEDTempo tempo = MMD0Song -> MEDTempo MEDTempo.song0Tempo (MMD0Song -> MEDTempo) -> MMD0Song -> MEDTempo forall a b. (a -> b) -> a -> b $ MMD1 -> MMD0Song MMD1.song MMD1 med } ULONG 0x4D4D4432 -> do MMD2 med <- ULONG -> m MMD2 forall (m :: * -> *). Reader m => ULONG -> m MMD2 MMD2.peek ULONG 0 MED -> m MED forall (m :: * -> *) a. Monad m => a -> m a return (MED -> m MED) -> MED -> m MED forall a b. (a -> b) -> a -> b $ MED :: [MEDInstrument] -> [MEDBlock] -> [MEDPlaySeq] -> MEDTempo -> MED MED { instrs :: [MEDInstrument] instrs = (MMD2 -> [Maybe InstrHdr]) -> (MMD2 -> [MMD0Sample]) -> (MMD2 -> Maybe MMD0exp) -> MMD2 -> [MEDInstrument] forall (t :: * -> *) t. Foldable t => (t -> [Maybe InstrHdr]) -> (t -> [MMD0Sample]) -> (t -> t MMD0exp) -> t -> [MEDInstrument] instrs_ MMD2 -> [Maybe InstrHdr] MMD2.smplarr (MMD2Song -> [MMD0Sample] samples2 (MMD2Song -> [MMD0Sample]) -> (MMD2 -> MMD2Song) -> MMD2 -> [MMD0Sample] forall b c a. (b -> c) -> (a -> b) -> a -> c . MMD2 -> MMD2Song MMD2.song) MMD2 -> Maybe MMD0exp MMD2.expdata MMD2 med , blocks :: [MEDBlock] blocks = (MMD1Block -> MEDBlock) -> [MMD1Block] -> [MEDBlock] forall a b. (a -> b) -> [a] -> [b] map MMD1Block -> MEDBlock MEDBlock.medblock1 ([MMD1Block] -> [MEDBlock]) -> [MMD1Block] -> [MEDBlock] forall a b. (a -> b) -> a -> b $ MMD2 -> [MMD1Block] MMD2.blockarr MMD2 med , playseqs :: [MEDPlaySeq] playseqs = MMD2Song -> [MEDPlaySeq] mmd2PlaySeqs (MMD2Song -> [MEDPlaySeq]) -> MMD2Song -> [MEDPlaySeq] forall a b. (a -> b) -> a -> b $ MMD2 -> MMD2Song MMD2.song MMD2 med , tempo :: MEDTempo tempo = MMD2Song -> MEDTempo MEDTempo.song2Tempo (MMD2Song -> MEDTempo) -> MMD2Song -> MEDTempo forall a b. (a -> b) -> a -> b $ MMD2 -> MMD2Song MMD2.song MMD2 med } ULONG 0x4D4D4433 -> do MMD3 med <- ULONG -> m MMD3 forall (m :: * -> *). Reader m => ULONG -> m MMD3 MMD3.peek ULONG 0 MED -> m MED forall (m :: * -> *) a. Monad m => a -> m a return (MED -> m MED) -> MED -> m MED forall a b. (a -> b) -> a -> b $ MED :: [MEDInstrument] -> [MEDBlock] -> [MEDPlaySeq] -> MEDTempo -> MED MED { instrs :: [MEDInstrument] instrs = (MMD3 -> [Maybe InstrHdr]) -> (MMD3 -> [MMD0Sample]) -> (MMD3 -> Maybe MMD0exp) -> MMD3 -> [MEDInstrument] forall (t :: * -> *) t. Foldable t => (t -> [Maybe InstrHdr]) -> (t -> [MMD0Sample]) -> (t -> t MMD0exp) -> t -> [MEDInstrument] instrs_ MMD3 -> [Maybe InstrHdr] MMD3.smplarr (MMD2Song -> [MMD0Sample] samples2 (MMD2Song -> [MMD0Sample]) -> (MMD3 -> MMD2Song) -> MMD3 -> [MMD0Sample] forall b c a. (b -> c) -> (a -> b) -> a -> c . MMD3 -> MMD2Song MMD3.song) MMD3 -> Maybe MMD0exp MMD3.expdata MMD3 med , blocks :: [MEDBlock] blocks = (MMD1Block -> MEDBlock) -> [MMD1Block] -> [MEDBlock] forall a b. (a -> b) -> [a] -> [b] map MMD1Block -> MEDBlock MEDBlock.medblock1 ([MMD1Block] -> [MEDBlock]) -> [MMD1Block] -> [MEDBlock] forall a b. (a -> b) -> a -> b $ MMD3 -> [MMD1Block] MMD3.blockarr MMD3 med , playseqs :: [MEDPlaySeq] playseqs = MMD2Song -> [MEDPlaySeq] mmd2PlaySeqs (MMD2Song -> [MEDPlaySeq]) -> MMD2Song -> [MEDPlaySeq] forall a b. (a -> b) -> a -> b $ MMD3 -> MMD2Song MMD3.song MMD3 med , tempo :: MEDTempo tempo = MMD2Song -> MEDTempo MEDTempo.song2Tempo (MMD2Song -> MEDTempo) -> MMD2Song -> MEDTempo forall a b. (a -> b) -> a -> b $ MMD3 -> MMD2Song MMD3.song MMD3 med } ULONG _ -> String -> m MED forall (m :: * -> *) a. MonadFail m => String -> m a fail (String -> m MED) -> String -> m MED forall a b. (a -> b) -> a -> b $ String -> Integer -> String forall r. PrintfType r => String -> r printf String "unknown format: %08x" (Integer -> String) -> Integer -> String forall a b. (a -> b) -> a -> b $ ULONG -> Integer forall a. Integral a => a -> Integer toInteger ULONG ident instance Human MED where human :: MED -> String human MED m = (MEDInstrument -> String) -> [MEDInstrument] -> String forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap MEDInstrument -> String forall a. Human a => a -> String human (MED -> [MEDInstrument] instrs MED m) String -> String -> String forall a. [a] -> [a] -> [a] ++ (MEDBlock -> String) -> [MEDBlock] -> String forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap MEDBlock -> String forall a. Human a => a -> String human (MED -> [MEDBlock] blocks MED m) String -> String -> String forall a. [a] -> [a] -> [a] ++ [String] -> String unlines ((MEDPlaySeq -> String) -> [MEDPlaySeq] -> [String] forall a b. (a -> b) -> [a] -> [b] map MEDPlaySeq -> String forall a. Human a => a -> String human (MED -> [MEDPlaySeq] playseqs MED m)) load :: FilePath -> IO MED load :: String -> IO MED load String path = IO MEM -> (MEM -> IO ()) -> (MEM -> IO MED) -> IO MED forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c bracket (String -> IO MEM loadMEM String path) MEM -> IO () freeMEM (StorableReader MED -> MEM -> IO MED forall a. StorableReader a -> MEM -> IO a runStorable StorableReader MED forall (m :: * -> *). Reader m => m MED peek)