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