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)