unmed2-0.0: src/MED.hs

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))