module MED where import Amiga import qualified MMD0 import qualified MMD1 import qualified MMD2 import qualified MMD3 import qualified MMD0exp import qualified MMD0Song import qualified MMD2Song import qualified MEDBlock import qualified MEDInstrument import qualified MEDPlaySeq import qualified MEDTempo import MEDInstrument(medinstruments) import Human import Data.Foldable (foldMap) import Text.Printf (printf) data MED = MED { instrs :: [MEDInstrument.MEDInstrument] , blocks :: [MEDBlock.MEDBlock] , playseqs :: [MEDPlaySeq.MEDPlaySeq] , tempo :: MEDTempo.MEDTempo } peek :: MEM -> IO MED peek m = do ident <- peekULONG m 0 let samples0 song = take (fromIntegral (MMD0Song.numsamples song)) $ MMD0Song.sample song let samples2 song = take (fromIntegral (MMD2Song.numsamples song)) $ MMD2Song.sample song let instrs_ smplarr samples expdata med = medinstruments (smplarr med) (samples med) (foldMap MMD0exp.iinfo $ expdata med) (foldMap MMD0exp.exp_smp $ expdata med) let mmd0PlaySeq song = [MEDPlaySeq.playSeq0 song] let mmd2PlaySeqs = map MEDPlaySeq.playSeq2 . MMD2Song.playseqtable case ident of 0x4D4D4430 -> do med <- MMD0.peek m 0 return $ MED { instrs = instrs_ MMD0.smplarr (samples0 . MMD0.song) MMD0.expdata med , blocks = map MEDBlock.medblock0 $ MMD0.blockarr med , playseqs = mmd0PlaySeq $ MMD0.song med , tempo = MEDTempo.song0Tempo $ MMD0.song med } 0x4D4D4431 -> do med <- MMD1.peek m 0 return $ MED { instrs = instrs_ MMD1.smplarr (samples0 . MMD1.song) MMD1.expdata med , blocks = map MEDBlock.medblock1 $ MMD1.blockarr med , playseqs = mmd0PlaySeq $ MMD1.song med , tempo = MEDTempo.song0Tempo $ MMD1.song med } 0x4D4D4432 -> do med <- MMD2.peek m 0 return $ MED { instrs = instrs_ MMD2.smplarr (samples2 . MMD2.song) MMD2.expdata med , blocks = map MEDBlock.medblock1 $ MMD2.blockarr med , playseqs = mmd2PlaySeqs $ MMD2.song med , tempo = MEDTempo.song2Tempo $ MMD2.song med } 0x4D4D4433 -> do med <- MMD3.peek m 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 instance Human MED where human m = concatMap human (instrs m) ++ concatMap human (blocks m) ++ unlines (map human (playseqs m))