module Sound.MED.Generic.Instrument where

import qualified Sound.MED.Raw.MMD0Sample as MMD0Sample
import qualified Sound.MED.Raw.InstrHdr as InstrHdr
import qualified Sound.MED.Raw.MMDInstrInfo as MMDInstrInfo
import qualified Sound.MED.Raw.InstrExt as InstrExt

import Sound.MED.Basic.Human(Human(human))
import Sound.MED.Basic.Utility(stringFromBytes)

import qualified Data.List as List

data MEDInstrument = MEDInstrument
  { MEDInstrument -> Maybe Int
rep                :: Maybe Int
  , MEDInstrument -> Maybe Int
replen             :: Maybe Int
  , MEDInstrument -> Maybe Int
midich             :: Maybe Int
  , MEDInstrument -> Maybe Int
midipreset         :: Maybe Int
  , MEDInstrument -> Maybe Int
svol               :: Maybe Int
  , MEDInstrument -> Maybe Int
strans             :: Maybe Int
  , MEDInstrument -> Maybe Int
hold               :: Maybe Int
  , MEDInstrument -> Maybe Int
decay              :: Maybe Int
  , MEDInstrument -> Maybe Int
suppress_midi_off  :: Maybe Int
  , MEDInstrument -> Maybe Int
finetune           :: Maybe Int
  , MEDInstrument -> Maybe Int
default_pitch      :: Maybe Int
  , MEDInstrument -> Maybe Int
instr_flags        :: Maybe Int
  , MEDInstrument -> Maybe Int
long_midi_preset   :: Maybe Int
  , MEDInstrument -> Maybe Int
output_device      :: Maybe Int
  , MEDInstrument -> Maybe Int
long_repeat        :: Maybe Int
  , MEDInstrument -> Maybe Int
long_replen        :: Maybe Int
  , MEDInstrument -> Maybe String
name               :: Maybe String
  }
  deriving (Int -> MEDInstrument -> ShowS
[MEDInstrument] -> ShowS
MEDInstrument -> String
(Int -> MEDInstrument -> ShowS)
-> (MEDInstrument -> String)
-> ([MEDInstrument] -> ShowS)
-> Show MEDInstrument
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MEDInstrument] -> ShowS
$cshowList :: [MEDInstrument] -> ShowS
show :: MEDInstrument -> String
$cshow :: MEDInstrument -> String
showsPrec :: Int -> MEDInstrument -> ShowS
$cshowsPrec :: Int -> MEDInstrument -> ShowS
Show)

medinstruments ::
  [Maybe InstrHdr.InstrHdr] -> [MMD0Sample.MMD0Sample] ->
  [MMDInstrInfo.MMDInstrInfo] -> [InstrExt.InstrExt] ->
  [MEDInstrument]
medinstruments :: [Maybe InstrHdr]
-> [MMD0Sample] -> [MMDInstrInfo] -> [InstrExt] -> [MEDInstrument]
medinstruments [Maybe InstrHdr]
hdrs [MMD0Sample]
samples [MMDInstrInfo]
infos [InstrExt]
exts =
  let pad :: [a] -> [Maybe a]
pad [a]
xs = (a -> Maybe a) -> [a] -> [Maybe a]
forall a b. (a -> b) -> [a] -> [b]
map a -> Maybe a
forall a. a -> Maybe a
Just [a]
xs [Maybe a] -> [Maybe a] -> [Maybe a]
forall a. [a] -> [a] -> [a]
++ Maybe a -> [Maybe a]
forall a. a -> [a]
repeat Maybe a
forall a. Maybe a
Nothing
  in  Int -> [MEDInstrument] -> [MEDInstrument]
forall a. Int -> [a] -> [a]
take ([Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [[Maybe InstrHdr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Maybe InstrHdr]
hdrs, [MMD0Sample] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MMD0Sample]
samples, [MMDInstrInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [MMDInstrInfo]
infos, [InstrExt] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [InstrExt]
exts]) ([MEDInstrument] -> [MEDInstrument])
-> [MEDInstrument] -> [MEDInstrument]
forall a b. (a -> b) -> a -> b
$
      (Maybe InstrHdr
 -> Maybe MMD0Sample
 -> Maybe MMDInstrInfo
 -> Maybe InstrExt
 -> MEDInstrument)
-> [Maybe InstrHdr]
-> [Maybe MMD0Sample]
-> [Maybe MMDInstrInfo]
-> [Maybe InstrExt]
-> [MEDInstrument]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
List.zipWith4 Maybe InstrHdr
-> Maybe MMD0Sample
-> Maybe MMDInstrInfo
-> Maybe InstrExt
-> MEDInstrument
medinstrument
        ([Maybe InstrHdr]
hdrs [Maybe InstrHdr] -> [Maybe InstrHdr] -> [Maybe InstrHdr]
forall a. [a] -> [a] -> [a]
++ Maybe InstrHdr -> [Maybe InstrHdr]
forall a. a -> [a]
repeat Maybe InstrHdr
forall a. Maybe a
Nothing) ([MMD0Sample] -> [Maybe MMD0Sample]
forall a. [a] -> [Maybe a]
pad [MMD0Sample]
samples) ([MMDInstrInfo] -> [Maybe MMDInstrInfo]
forall a. [a] -> [Maybe a]
pad [MMDInstrInfo]
infos) ([InstrExt] -> [Maybe InstrExt]
forall a. [a] -> [Maybe a]
pad [InstrExt]
exts)

medinstrument ::
  Maybe InstrHdr.InstrHdr -> Maybe MMD0Sample.MMD0Sample ->
  Maybe MMDInstrInfo.MMDInstrInfo -> Maybe InstrExt.InstrExt -> MEDInstrument
medinstrument :: Maybe InstrHdr
-> Maybe MMD0Sample
-> Maybe MMDInstrInfo
-> Maybe InstrExt
-> MEDInstrument
medinstrument Maybe InstrHdr
_h Maybe MMD0Sample
s Maybe MMDInstrInfo
i Maybe InstrExt
e =
  let rep' :: Maybe Int
rep' = (MMD0Sample -> Int) -> Maybe MMD0Sample -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UWORD -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UWORD -> Int) -> (MMD0Sample -> UWORD) -> MMD0Sample -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMD0Sample -> UWORD
MMD0Sample.rep) Maybe MMD0Sample
s
      replen' :: Maybe Int
replen' = (MMD0Sample -> Int) -> Maybe MMD0Sample -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UWORD -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UWORD -> Int) -> (MMD0Sample -> UWORD) -> MMD0Sample -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMD0Sample -> UWORD
MMD0Sample.replen) Maybe MMD0Sample
s
      midich' :: Maybe Int
midich' = (MMD0Sample -> Int) -> Maybe MMD0Sample -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UBYTE -> Int) -> (MMD0Sample -> UBYTE) -> MMD0Sample -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMD0Sample -> UBYTE
MMD0Sample.midich) Maybe MMD0Sample
s
      midipreset' :: Maybe Int
midipreset' = (MMD0Sample -> Int) -> Maybe MMD0Sample -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UBYTE -> Int) -> (MMD0Sample -> UBYTE) -> MMD0Sample -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMD0Sample -> UBYTE
MMD0Sample.midipreset) Maybe MMD0Sample
s
      svol' :: Maybe Int
svol' = (MMD0Sample -> Int) -> Maybe MMD0Sample -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (UBYTE -> Int) -> (MMD0Sample -> UBYTE) -> MMD0Sample -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMD0Sample -> UBYTE
MMD0Sample.svol) Maybe MMD0Sample
s
      strans' :: Maybe Int
strans' = (MMD0Sample -> Int) -> Maybe MMD0Sample -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (BYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BYTE -> Int) -> (MMD0Sample -> BYTE) -> MMD0Sample -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMD0Sample -> BYTE
MMD0Sample.strans) Maybe MMD0Sample
s
      hold' :: Maybe Int
hold' = (UBYTE -> Int) -> Maybe UBYTE -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe UBYTE -> Maybe Int)
-> (InstrExt -> Maybe UBYTE) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe UBYTE
InstrExt.hold (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      decay' :: Maybe Int
decay' = (UBYTE -> Int) -> Maybe UBYTE -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe UBYTE -> Maybe Int)
-> (InstrExt -> Maybe UBYTE) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe UBYTE
InstrExt.decay (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      suppress_midi_off' :: Maybe Int
suppress_midi_off' = (UBYTE -> Int) -> Maybe UBYTE -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe UBYTE -> Maybe Int)
-> (InstrExt -> Maybe UBYTE) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe UBYTE
InstrExt.suppress_midi_off (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      finetune' :: Maybe Int
finetune' = (BYTE -> Int) -> Maybe BYTE -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe BYTE -> Maybe Int)
-> (InstrExt -> Maybe BYTE) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe BYTE
InstrExt.finetune (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      default_pitch' :: Maybe Int
default_pitch' = (UBYTE -> Int) -> Maybe UBYTE -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe UBYTE -> Maybe Int)
-> (InstrExt -> Maybe UBYTE) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe UBYTE
InstrExt.default_pitch (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      instr_flags' :: Maybe Int
instr_flags' = (UBYTE -> Int) -> Maybe UBYTE -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe UBYTE -> Maybe Int)
-> (InstrExt -> Maybe UBYTE) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe UBYTE
InstrExt.instr_flags (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      long_midi_preset' :: Maybe Int
long_midi_preset' = (UWORD -> Int) -> Maybe UWORD -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UWORD -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe UWORD -> Maybe Int)
-> (InstrExt -> Maybe UWORD) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe UWORD
InstrExt.long_midi_preset (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      output_device' :: Maybe Int
output_device' = (UBYTE -> Int) -> Maybe UBYTE -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap UBYTE -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe UBYTE -> Maybe Int)
-> (InstrExt -> Maybe UBYTE) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe UBYTE
InstrExt.output_device (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      long_repeat' :: Maybe Int
long_repeat' = (ULONG -> Int) -> Maybe ULONG -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ULONG -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe ULONG -> Maybe Int)
-> (InstrExt -> Maybe ULONG) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe ULONG
InstrExt.long_repeat (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      long_replen' :: Maybe Int
long_replen' = (ULONG -> Int) -> Maybe ULONG -> Maybe Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ULONG -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Maybe ULONG -> Maybe Int)
-> (InstrExt -> Maybe ULONG) -> InstrExt -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstrExt -> Maybe ULONG
InstrExt.long_replen (InstrExt -> Maybe Int) -> Maybe InstrExt -> Maybe Int
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe InstrExt
e
      name' :: Maybe String
name' = ([UBYTE] -> String) -> Maybe [UBYTE] -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [UBYTE] -> String
stringFromBytes (Maybe [UBYTE] -> Maybe String)
-> (MMDInstrInfo -> Maybe [UBYTE]) -> MMDInstrInfo -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MMDInstrInfo -> Maybe [UBYTE]
MMDInstrInfo.name (MMDInstrInfo -> Maybe String)
-> Maybe MMDInstrInfo -> Maybe String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe MMDInstrInfo
i
  in Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe Int
-> Maybe String
-> MEDInstrument
MEDInstrument
    Maybe Int
rep' Maybe Int
replen' Maybe Int
midich' Maybe Int
midipreset' Maybe Int
svol' Maybe Int
strans' Maybe Int
hold' Maybe Int
decay'
    Maybe Int
suppress_midi_off' Maybe Int
finetune' Maybe Int
default_pitch' Maybe Int
instr_flags'
    Maybe Int
long_midi_preset' Maybe Int
output_device' Maybe Int
long_repeat' Maybe Int
long_replen' Maybe String
name'

instance Human MEDInstrument where
  human :: MEDInstrument -> String
human MEDInstrument
i = MEDInstrument -> String
forall a. Show a => a -> String
show MEDInstrument
i String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\n"