-- Copyright 2017 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

-- | Parse MED output to ModT.Mod.
module Cmd.Load.Med where
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import qualified Sound.MED.Generic as MED
import qualified Sound.MED.Generic.Block as Block
import qualified Sound.MED.Generic.Instrument as Instrument
import qualified Sound.MED.Generic.PlaySeq as PlaySeq

import qualified Util.Lists as Lists
import qualified Cmd.Load.ModT as ModT
import qualified Derive.ScoreT as ScoreT

import           Global


load :: FilePath -> IO ModT.Module
load :: FilePath -> IO Module
load FilePath
fn = MED -> Module
convert forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO MED
MED.load FilePath
fn

convert :: MED.MED -> ModT.Module
convert :: MED -> Module
convert MED
med = ModT.Module
    { _instruments :: IntMap Instrument
_instruments = forall a. [(Int, a)] -> IntMap a
IntMap.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
1..] forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map MEDInstrument -> Instrument
instrument (MED -> [MEDInstrument]
MED.instrs MED
med)
        -- TODO I guess MED instruments start at 1?
    , _default_tempo :: Tempo
_default_tempo = Int -> Int -> Tempo
ModT.Tempo Int
33 Int
6 -- TODO
    , _blocks :: [Block]
_blocks = forall a b. (a -> b) -> [a] -> [b]
map MEDBlock -> Block
block (MED -> [MEDBlock]
MED.blocks MED
med)
    , _block_order :: Map Text [Int]
_block_order = forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
        [ (FilePath -> Text
txt FilePath
name, [Int]
indices)
        | PlaySeq.MEDPlaySeq FilePath
name [Int]
indices <- MED -> [MEDPlaySeq]
MED.playseqs MED
med
        ]
    }

instrument :: Instrument.MEDInstrument -> ModT.Instrument
instrument :: MEDInstrument -> Instrument
instrument MEDInstrument
inst = ModT.Instrument
    { _instrument_name :: Instrument
_instrument_name = forall b a. b -> (a -> b) -> Maybe a -> b
maybe Instrument
"none" (Text -> Instrument
ScoreT.Instrument forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> Text
txt) forall a b. (a -> b) -> a -> b
$
        MEDInstrument -> Maybe FilePath
Instrument.name MEDInstrument
inst
    , _volume :: Maybe Double
_volume = forall a. Integral a => a -> Double
ModT.volume forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MEDInstrument -> Maybe Int
Instrument.svol MEDInstrument
inst
    }

block :: Block.MEDBlock -> ModT.Block
block :: MEDBlock -> Block
block MEDBlock
b = ModT.Block
    { _tracks :: [Track]
_tracks = forall a b. (a -> b) -> [a] -> [b]
map [Maybe (Int, Int, [(Int, Int)])] -> Track
track forall a b. (a -> b) -> a -> b
$ forall a. [[a]] -> [[Maybe a]]
Lists.rotate2 forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ MEDBlock -> [Line]
Block.seqdata MEDBlock
b
    , _block_length :: Int
_block_length = MEDBlock -> Int
Block.lines MEDBlock
b
    }

track :: [Maybe (Block.Note, Block.Inst, [(Block.Cmd, Block.Val)])]
    -> ModT.Track
track :: [Maybe (Int, Int, [(Int, Int)])] -> Track
track = [(Int, Line)] -> Track
ModT.make_track forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Line
empty (Int, Int, [(Int, Int)]) -> Line
note)
    where empty :: Line
empty = Maybe NoteNumber -> Int -> [Command] -> Line
ModT.Line forall a. Maybe a
Nothing Int
0 []

note :: (Block.Note, Block.Inst, [(Block.Cmd, Block.Val)]) -> ModT.Line
note :: (Int, Int, [(Int, Int)]) -> Line
note (Int
pitch, Int
inst, [(Int, Int)]
cmds) = ModT.Line
    { _pitch :: Maybe NoteNumber
_pitch = Int -> Maybe NoteNumber
ModT.pitch Int
pitch
    , _instrument :: Int
_instrument = Int
inst
    , _commands :: [Command]
_commands = [(Int, Int)] -> [Command]
ModT.commands [(Int, Int)]
cmds
    }