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

-- | Convert a 'ModT.Module' to 'Ui.State'.
module Cmd.Load.Mod where
import qualified Data.IntMap as IntMap
import qualified Data.Map as Map
import qualified Data.Maybe as Maybe
import qualified Data.Set as Set
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Util.Num as Num

import qualified Cmd.Create as Create
import qualified Cmd.Load.ModT as ModT
import qualified Cmd.Ruler.RulerUtil as RulerUtil

import qualified Derive.ParseTitle as ParseTitle
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal
import           Derive.ShowVal (show_val)

import qualified Perform.Pitch as Pitch
import qualified Ui.Event as Event
import qualified Ui.Events as Events
import qualified Ui.Id as Id
import qualified Ui.Meter.Meters as Meters
import qualified Ui.Ruler as Ruler
import qualified Ui.ScoreTime as ScoreTime
import qualified Ui.Skeleton as Skeleton
import qualified Ui.Track as Track
import qualified Ui.Ui as Ui
import qualified Ui.UiConfig as UiConfig

import           Global
import           Types


data State = State {
    State -> Tempo
_tempo :: !ModT.Tempo
    , State -> IntMap Instrument
_instruments :: IntMap ModT.Instrument
    } deriving (State -> State -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: State -> State -> Bool
$c/= :: State -> State -> Bool
== :: State -> State -> Bool
$c== :: State -> State -> Bool
Eq, Int -> State -> ShowS
[State] -> ShowS
State -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [State] -> ShowS
$cshowList :: [State] -> ShowS
show :: State -> String
$cshow :: State -> String
showsPrec :: Int -> State -> ShowS
$cshowsPrec :: Int -> State -> ShowS
Show)

-- |
-- Make IntMap Instrument
-- map convert_block
-- make @score block using _block_order
convert :: Id.Namespace -> ModT.Module -> Either Ui.Error Ui.State
convert :: Namespace -> Module -> Either Error State
convert Namespace
ns Module
mod = forall a. State -> StateId a -> Either Error State
Ui.exec State
Ui.empty forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *). M m => Namespace -> m ()
Ui.set_namespace Namespace
ns
    [BlockId]
bids <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [([Track], TrackTime, Skeleton)]
blocks forall a b. (a -> b) -> a -> b
$ \([Track]
tracks, TrackTime
block_end, Skeleton
_skel) -> do
        BlockId
bid <- forall (m :: * -> *). M m => RulerId -> m BlockId
Create.block RulerId
Ui.no_ruler
        RulerId
rid <- forall (m :: * -> *). M m => Id -> Ruler -> m RulerId
Ui.create_ruler (forall a. Ident a => a -> Id
Id.unpack_id BlockId
bid) forall a b. (a -> b) -> a -> b
$
            Meter -> Ruler
Ruler.meter_ruler forall a b. (a -> b) -> a -> b
$ AbstractMeter -> TrackTime -> Int -> TrackTime -> Meter
RulerUtil.meter_until AbstractMeter
Meters.m44 TrackTime
1 Int
4 TrackTime
block_end
        forall (m :: * -> *). M m => RulerId -> BlockId -> m ()
Create.set_block_ruler RulerId
rid BlockId
bid
        forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Track]
tracks forall a b. (a -> b) -> a -> b
$ \Track
track -> do
            TrackId
tid <- forall (m :: * -> *).
M m =>
BlockId -> RulerId -> Int -> Int -> Track -> m TrackId
Create.track_events BlockId
bid RulerId
rid Int
999 Int
40 Track
track
            forall (m :: * -> *). M m => RenderStyle -> TrackId -> m ()
Ui.set_render_style (Maybe RenderSource -> RenderStyle
Track.Line forall a. Maybe a
Nothing) TrackId
tid
        -- Now skeleton is implicit by default.
        -- Ui.set_skeleton bid skel
        forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
bid
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ forall (m :: * -> *). M m => RulerId -> m ()
Ui.destroy_ruler forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall (m :: * -> *). M m => m [RulerId]
Create.orphan_rulers

    let block_ends :: [TrackTime]
block_ends = [TrackTime
t | ([Track]
_, TrackTime
t, Skeleton
_) <- [([Track], TrackTime, Skeleton)]
blocks]
    let block_map :: IntMap (BlockId, TrackTime)
block_map = forall a. [(Int, a)] -> IntMap a
IntMap.fromList forall a b. (a -> b) -> a -> b
$ forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0..] (forall a b. [a] -> [b] -> [(a, b)]
zip [BlockId]
bids [TrackTime]
block_ends)
    [BlockId]
scores <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM (forall k a. Map k a -> [(k, a)]
Map.toList (Module -> Map Control [Int]
ModT._block_order Module
mod)) forall a b. (a -> b) -> a -> b
$
        \(Control
name_, [Int]
indices) -> do
            let name :: Control
name = if Control
name_ forall a. Eq a => a -> a -> Bool
== Control
"" then Control
"score" else Control
name_
            -- TODO LRuler.extract_meters
            let ruler_id :: RulerId
ruler_id = RulerId
Ui.no_ruler
            BlockId
score <- forall (m :: * -> *). M m => Id -> RulerId -> m BlockId
Create.named_block (Namespace -> Control -> Id
Id.id Namespace
ns Control
name) RulerId
ruler_id
            forall (m :: * -> *).
M m =>
BlockId -> RulerId -> Int -> Int -> Track -> m TrackId
Create.track_events BlockId
score RulerId
ruler_id Int
1 Int
40 forall a b. (a -> b) -> a -> b
$
                IntMap (BlockId, TrackTime) -> [Int] -> Track
score_track IntMap (BlockId, TrackTime)
block_map [Int]
indices
            forall (m :: * -> *). M m => BlockId -> m ViewId
Create.unfitted_view BlockId
score
            forall (m :: * -> *) a. Monad m => a -> m a
return BlockId
score
    forall (m :: * -> *) a.
Applicative m =>
Maybe a -> (a -> m ()) -> m ()
whenJust (forall a. [a] -> Maybe a
Lists.head [BlockId]
scores) forall (m :: * -> *). M m => BlockId -> m ()
Ui.set_root_id
    forall (m :: * -> *). M m => (Config -> Config) -> m ()
Ui.modify_config forall a b. (a -> b) -> a -> b
$ Config :-> Control
UiConfig.ky forall f a. Lens f a -> a -> f -> f
#= Control
ky
    where
    blocks :: [([Track], TrackTime, Skeleton)]
blocks = forall a b. (a -> b) -> [a] -> [b]
map (State -> Block -> ([Track], TrackTime, Skeleton)
convert_block State
state) (Module -> [Block]
ModT._blocks Module
mod)
    state :: State
state = State
        { _tempo :: Tempo
_tempo = Module -> Tempo
ModT._default_tempo Module
mod
        , _instruments :: IntMap Instrument
_instruments = Module -> IntMap Instrument
ModT._instruments Module
mod
        }

ky :: Text
ky :: Control
ky = [Control] -> Control
Text.unlines
    [ Control
"note generator:"
    -- convert uses `i` call to set instrument.
    , Control
"i = inst = $inst |"
    ]

-- | Make a score track with calls to the blocks.
score_track :: IntMap (BlockId, TrackTime) -> [Int] -> Track.Track
score_track :: IntMap (BlockId, TrackTime) -> [Int] -> Track
score_track IntMap (BlockId, TrackTime)
blocks [Int]
indices = Control -> Events -> Track
Track.track Control
">" forall a b. (a -> b) -> a -> b
$ [Event] -> Events
Events.from_list
    [ TrackTime -> TrackTime -> Control -> Event
Event.event TrackTime
start (TrackTime
end forall a. Num a => a -> a -> a
- TrackTime
start) Control
call
    | (TrackTime
start, TrackTime
end, Control
call) <- forall a b c. [a] -> [b] -> [c] -> [(a, b, c)]
zip3 [TrackTime]
starts (forall a. Int -> [a] -> [a]
drop Int
1 [TrackTime]
starts) [Control]
calls
    ]
    where
    starts :: [TrackTime]
starts = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) TrackTime
0 [TrackTime]
durs
    ([Control]
calls, [TrackTime]
durs) = forall a b. [(a, b)] -> ([a], [b])
unzip forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Int -> (Control, TrackTime)
call_of [Int]
indices
    call_of :: Int -> (Control, TrackTime)
call_of Int
idx = case forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
idx IntMap (BlockId, TrackTime)
blocks of
        Just (BlockId
bid, TrackTime
end) -> (forall a. Ident a => a -> Control
Id.ident_name BlockId
bid, TrackTime
end)
        Maybe (BlockId, TrackTime)
Nothing -> (Control
"block" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Control
showt Int
idx, TrackTime
1) -- order number with no block

-- | Figure out block length from min (max lines) (first cut_block)
-- map convert_track, merge Notes
convert_block :: State -> ModT.Block
    -> ([Track.Track], TrackTime, Skeleton.Skeleton)
convert_block :: State -> Block -> ([Track], TrackTime, Skeleton)
convert_block State
state Block
block =
    ( forall a b. (a -> b) -> [a] -> [b]
map (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Control -> Events -> Track
Track.track) (forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[(Control, Events)]]
ctracks)
    , Int -> TrackTime
line_start Int
block_len
    , forall track. [[track]] -> Skeleton
make_skeleton [[(Control, Events)]]
ctracks
    )
    where
    ctracks :: [[(Control, Events)]]
ctracks = forall a b. (a -> b) -> [a] -> [b]
map ([Note] -> [(Control, Events)]
merge_notes forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> Int -> IntMap Line -> [Note]
convert_track State
state Int
block_len)
        (Block -> [IntMap Line]
ModT._tracks Block
block)
    block_len :: Int
block_len = forall a. a -> Maybe a -> a
fromMaybe (Block -> Int
ModT._block_length Block
block) forall a b. (a -> b) -> a -> b
$
        forall a. Ord a => [a] -> Maybe a
Lists.minimum forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe IntMap Line -> Maybe Int
track_len (Block -> [IntMap Line]
ModT._tracks Block
block)
    track_len :: IntMap Line -> Maybe Int
track_len = forall a. [a] -> Maybe a
Lists.head forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. Num a => (a, Line) -> Maybe a
cut_block forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IntMap.toAscList
    cut_block :: (a, Line) -> Maybe a
cut_block (a
linenum, Line
line)
        | Command
ModT.CutBlock forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Line -> [Command]
ModT._commands Line
line = forall a. a -> Maybe a
Just (a
linenumforall a. Num a => a -> a -> a
+a
1)
        | Bool
otherwise = forall a. Maybe a
Nothing

make_skeleton :: [[track]] -> Skeleton.Skeleton
make_skeleton :: forall track. [[track]] -> Skeleton
make_skeleton [[track]]
track_groups =
    [Edge] -> Skeleton
Skeleton.make forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {b}. (Num b, Ord b) => b -> b -> [(b, b)]
make [Int]
tracknums (forall a. Int -> [a] -> [a]
drop Int
1 [Int]
tracknums)
    where
    tracknums :: [Int]
tracknums = forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) Int
1 (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[track]]
track_groups)
    make :: b -> b -> [(b, b)]
make b
start b
end = forall a b. [a] -> [b] -> [(a, b)]
zip [b]
ts (forall a. Int -> [a] -> [a]
drop Int
1 [b]
ts)
        where ts :: [b]
ts = forall a. (Num a, Ord a) => a -> a -> a -> [a]
Lists.range' b
start b
end b
1

merge_notes :: [Note] -> [(Text, Events.Events)]
merge_notes :: [Note] -> [(Control, Events)]
merge_notes [Note]
notes =
    forall a b. (a -> b) -> [a] -> [b]
map (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [Event] -> Events
Events.from_list) forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Control, [Event]) -> Maybe (Control, [Event])
clean_track forall a b. (a -> b) -> a -> b
$
        (Control, [Event])
note_track forall a. a -> [a] -> [a]
: (Control, [Event])
pitch_track forall a. a -> [a] -> [a]
: [(Control, [Event])]
control_tracks
    where
    note_track :: (Control, [Event])
note_track = case [Instrument]
instruments of
        [Instrument
inst] ->
            (Instrument -> Control
ParseTitle.instrument_to_title Instrument
inst, forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Note -> Event
note_event Bool
False) [Note]
notes)
        [Instrument]
_ -> (Control
">", forall a b. (a -> b) -> [a] -> [b]
map (Bool -> Note -> Event
note_event Bool
True) [Note]
notes)
    pitch_track :: (Control, [Event])
pitch_track = (Control
"*", forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Note -> [Event]
note_pitches [Note]
notes)
    control_tracks :: [(Control, [Event])]
control_tracks =
        [ (Control
c, forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Control
c forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Map Control [Event]
_controls) [Note]
notes)
        | Control
c <- [Control]
controls
        ]
    controls :: [Control]
controls = forall a. Set a -> [a]
Set.toList forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> Set a -> Set a
Set.delete Control
"*" forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions forall a b. (a -> b) -> a -> b
$
        forall a b. (a -> b) -> [a] -> [b]
map (forall k a. Map k a -> Set k
Map.keysSet forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Map Control [Event]
_controls) [Note]
notes
    instruments :: [Instrument]
instruments = forall a. Ord a => [a] -> [a]
Lists.unique forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Instrument -> Instrument
ModT._instrument_name forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Instrument
_instrument) [Note]
notes

clean_track :: (Text, [Event.Event]) -> Maybe (Text, [Event.Event])
clean_track :: (Control, [Event]) -> Maybe (Control, [Event])
clean_track (Control
_, []) = forall a. Maybe a
Nothing
clean_track (Control
title, [Event]
events)
    | Control -> Bool
ParseTitle.is_note_track Control
title Bool -> Bool -> Bool
|| Control -> Bool
ParseTitle.is_pitch_track Control
title =
        forall a. a -> Maybe a
Just (Control
title, [Event]
events)
    -- Remove control tracks that are just 1.
    | Control -> Bool
ParseTitle.is_control_track Control
title Bool -> Bool -> Bool
&& forall a b. (a -> b) -> [a] -> [b]
map Event -> Control
Event.text [Event]
clean forall a. Eq a => a -> a -> Bool
== [Control
"`0x`ff"] =
        forall a. Maybe a
Nothing
    | Bool
otherwise = forall a. a -> Maybe a
Just (Control
title, [Event]
clean)
    where
    clean :: [Event]
clean = forall a. (a -> a -> Bool) -> [a] -> [a]
Lists.dropWith Event -> Event -> Bool
idempotent [Event]
events
    idempotent :: Event -> Event -> Bool
idempotent Event
e1 Event
e2 = Control
"`0x`" Control -> Control -> Bool
`Text.isPrefixOf` Control
a Bool -> Bool -> Bool
&& Control
a forall a. Eq a => a -> a -> Bool
== Control
b
        where (Control
a, Control
b) = (Event -> Control
Event.text Event
e1, Event -> Control
Event.text Event
e2)

note_event :: Bool -> Note -> Event.Event
note_event :: Bool -> Note -> Event
note_event Bool
set_instrument Note
n = TrackTime -> TrackTime -> Control -> Event
Event.event (Note -> TrackTime
_start Note
n) (Note -> TrackTime
_duration Note
n) Control
call
    where
    call :: Control
call = (if Bool
set_instrument then Control
set_inst else Control
"") forall a. Semigroup a => a -> a -> a
<> Note -> Control
_call Note
n
    set_inst :: Control
set_inst = Control
"i " forall a. Semigroup a => a -> a -> a
<> forall a. ShowVal a => a -> Control
show_val (Instrument -> Instrument
ModT._instrument_name (Note -> Instrument
_instrument Note
n))

note_pitches :: Note -> [Event.Event]
note_pitches :: Note -> [Event]
note_pitches Note
n = TrackTime -> TrackTime -> Control -> Event
Event.event (Note -> TrackTime
_start Note
n) TrackTime
0 (NoteNumber -> Control
nn_to_call (Note -> NoteNumber
_pitch Note
n))
    forall a. a -> [a] -> [a]
: forall k a. Ord k => a -> k -> Map k a -> a
Map.findWithDefault [] Control
"*" (Note -> Map Control [Event]
_controls Note
n)

-- | TODO surely this exists elsewhere?
nn_to_call :: Pitch.NoteNumber -> Text
nn_to_call :: NoteNumber -> Control
nn_to_call NoteNumber
nn = forall a. Show a => a -> Control
showt (Int
octforall a. Num a => a -> a -> a
-Int
1) forall a. Semigroup a => a -> a -> a
<> [Control]
steps forall a. [a] -> Int -> a
!! Int
step
    where
    (Int
oct, Int
step) = forall a b. (RealFrac a, Integral b) => a -> b
floor NoteNumber
nn forall a. Integral a => a -> a -> (a, a)
`divMod` Int
12
    steps :: [Control]
steps = [Control
"c", Control
"c#", Control
"d", Control
"d#", Control
"e", Control
"f", Control
"f#", Control
"g", Control
"g#", Control
"a", Control
"a#", Control
"b"]

-- * convert

data Note = Note {
    Note -> TrackTime
_start :: !TrackTime
    , Note -> TrackTime
_duration :: !TrackTime
    , Note -> Instrument
_instrument :: !ModT.Instrument
    -- | Note call text.
    , Note -> Control
_call :: !Text
    , Note -> NoteNumber
_pitch :: !Pitch.NoteNumber
    , Note -> Map Control [Event]
_controls :: !(Map Control [Event.Event])
    } deriving (Note -> Note -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Note -> Note -> Bool
$c/= :: Note -> Note -> Bool
== :: Note -> Note -> Bool
$c== :: Note -> Note -> Bool
Eq, Int -> Note -> ShowS
[Note] -> ShowS
Note -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Note] -> ShowS
$cshowList :: [Note] -> ShowS
show :: Note -> String
$cshow :: Note -> String
showsPrec :: Int -> Note -> ShowS
$cshowsPrec :: Int -> Note -> ShowS
Show)

type LineNum = Int

-- |
-- - Lookup instrument.
convert_track :: State -> LineNum -> IntMap ModT.Line -> [Note]
convert_track :: State -> Int -> IntMap Line -> [Note]
convert_track State
state Int
block_len =
    [(Int, Line)] -> [Note]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Ord a => a -> a -> Bool
<Int
block_len) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IntMap a -> [(Int, a)]
IntMap.toAscList
    where
    go :: [(Int, Line)] -> [Note]
go ((Int
_, ModT.Line Maybe NoteNumber
Nothing Int
_ [Command]
_) : [(Int, Line)]
lines) = [(Int, Line)] -> [Note]
go [(Int, Line)]
lines
    go ((Int
linenum, ModT.Line (Just NoteNumber
pitch) Int
instnum [Command]
cmds) : [(Int, Line)]
lines) =
        Int
-> Tempo
-> Instrument
-> Int
-> NoteNumber
-> [Command]
-> [(Int, Line)]
-> Note
convert_note Int
block_len (State -> Tempo
_tempo State
state) Instrument
instrument Int
linenum NoteNumber
pitch
            [Command]
cmds [(Int, Line)]
lines
        forall a. a -> [a] -> [a]
: [(Int, Line)] -> [Note]
go [(Int, Line)]
lines
        where
        instrument :: Instrument
instrument = forall a. a -> Maybe a -> a
fromMaybe Instrument
no_instrument forall a b. (a -> b) -> a -> b
$
            forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
instnum (State -> IntMap Instrument
_instruments State
state)
        no_instrument :: Instrument
no_instrument = Instrument -> Maybe Double -> Instrument
ModT.Instrument (Control -> Instrument
ScoreT.Instrument (forall a. Show a => a -> Control
showt Int
instnum))
            forall a. Maybe a
Nothing
    go [] = []

-- |
-- Figure out note duration: min of time until next line with Pitch>0, or 0fff,
-- or...?  Convert Pitch. Collect cmds and convert to Command.
--
-- Convert 0d to linear, 01 02 to pitch 'u' or 'd', 03 to pitch linear.
--
-- - Interpret timing cmds like 1f.
convert_note :: LineNum -> ModT.Tempo -> ModT.Instrument -> LineNum
    -> Pitch.NoteNumber -> [ModT.Command] -> [(LineNum, ModT.Line)] -> Note
convert_note :: Int
-> Tempo
-> Instrument
-> Int
-> NoteNumber
-> [Command]
-> [(Int, Line)]
-> Note
convert_note Int
block_len Tempo
tempo Instrument
instrument Int
linenum NoteNumber
pitch [Command]
cmds [(Int, Line)]
future_lines = Note
    { _start :: TrackTime
_start = TrackTime
start
    , _duration :: TrackTime
_duration = TrackTime
end forall a. Num a => a -> a -> a
- TrackTime
start
    , _instrument :: Instrument
_instrument = Instrument
instrument
    , _call :: Control
_call = Int -> [Command] -> Control
note_call (Tempo -> Int
ModT._frames Tempo
tempo) [Command]
cmds
    , _pitch :: NoteNumber
_pitch = NoteNumber
pitch
    , _controls :: Map Control [Event]
_controls = forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith (forall k a. Ord k => (a -> k) -> [a] -> [a] -> [a]
Lists.mergeOn Event -> TrackTime
Event.start) forall a b. (a -> b) -> a -> b
$
        Instrument
-> TrackTime -> [Command] -> [(Int, Line)] -> [(Control, [Event])]
convert_commands Instrument
instrument TrackTime
start [Command]
cmds forall a b. (a -> b) -> a -> b
$
        forall a. (a -> Bool) -> [a] -> [a]
takeWhile ((forall a. Eq a => a -> a -> Bool
==forall a. Maybe a
Nothing) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, Line) -> Maybe TrackTime
cut_note) [(Int, Line)]
future_lines
    }
    where
    start :: TrackTime
start = Int -> TrackTime
line_start Int
linenum
    end :: TrackTime
end = forall a. a -> Maybe a -> a
fromMaybe (Int -> TrackTime
line_start Int
block_len) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, MonadPlus m) =>
t (m a) -> m a
msum (forall a b. (a -> b) -> [a] -> [b]
map (Int, Line) -> Maybe TrackTime
cut_note [(Int, Line)]
future_lines)

note_call :: Int -> [ModT.Command] -> Text
note_call :: Int -> [Command] -> Control
note_call Int
frames [Command]
cmds =
    Control -> Control
Text.strip forall a b. (a -> b) -> a -> b
$ Control -> [Control] -> Control
Text.intercalate Control
" | " forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
Maybe.catMaybes [Maybe Control
d, forall a. Maybe a
r, forall a. a -> Maybe a
Just Control
""]
    where
    d :: Maybe Control
d = if Int
delay forall a. Eq a => a -> a -> Bool
== Int
0 then forall a. Maybe a
Nothing else
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Control
"d " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Control
showt Int
delay forall a. Semigroup a => a -> a -> a
<> Control
"/" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Control
showt (Int
frames forall a. Num a => a -> a -> a
* Int
lines_per_t) forall a. Semigroup a => a -> a -> a
<> Control
"t"
    r :: Maybe a
r = forall a. Maybe a
Nothing -- TODO?
    (Int
delay, Int
_repeat) = forall a. a -> Maybe a -> a
fromMaybe (Int
0, Int
0) forall a b. (a -> b) -> a -> b
$
        forall a. [a] -> Maybe a
Lists.head [(Int
delay, Int
repeat) | ModT.DelayRepeat Int
delay Int
repeat <- [Command]
cmds]

convert_commands :: ModT.Instrument -> TrackTime -> [ModT.Command]
    -> [(LineNum, ModT.Line)] -> [(Control, [Event.Event])]
convert_commands :: Instrument
-> TrackTime -> [Command] -> [(Int, Line)] -> [(Control, [Event])]
convert_commands Instrument
instrument TrackTime
start [Command]
cmds [(Int, Line)]
lines = [(TrackTime, (CommandType, Control, Control))]
-> [(Control, [Event])]
group_controls [(TrackTime, (CommandType, Control, Control))]
controls
    where
    inst_vol :: Double
inst_vol = forall a. a -> Maybe a -> a
fromMaybe Double
1 forall a b. (a -> b) -> a -> b
$ Instrument -> Maybe Double
ModT._volume Instrument
instrument
    volume :: [Command]
volume = if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [() | ModT.Volume Double
_ <- [Command]
cmds]
        then [Double -> Command
ModT.Volume Double
inst_vol] else []
    controls :: [(TrackTime, (CommandType, Control, Control))]
controls = forall a b. (a -> b) -> [a] -> [b]
map (TrackTime
start,) ([Command] -> [(CommandType, Control, Control)]
commands_to_controls ([Command]
volume forall a. [a] -> [a] -> [a]
++ [Command]
cmds))
        forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Int, Line) -> [(TrackTime, (CommandType, Control, Control))]
line_controls [(Int, Line)]
lines
    line_controls :: (Int, Line) -> [(TrackTime, (CommandType, Control, Control))]
line_controls (Int
linenum, Line
line) = forall a b. (a -> b) -> [a] -> [b]
map (Int -> TrackTime
line_start Int
linenum,) forall a b. (a -> b) -> a -> b
$
        [Command] -> [(CommandType, Control, Control)]
commands_to_controls (Line -> [Command]
ModT._commands Line
line)

group_controls :: [(TrackTime, (CommandType, Control, Text))]
    -> [(Control, [Event.Event])]
group_controls :: [(TrackTime, (CommandType, Control, Control))]
-> [(Control, [Event])]
group_controls [(TrackTime, (CommandType, Control, Control))]
controls =
    forall a b. (a -> b) -> [a] -> [b]
map forall {a} {a} {a} {b}.
(Either a (a, a), [(TrackTime, (a, b, Control))]) -> (a, [Event])
make_control forall a b. (a -> b) -> a -> b
$ forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
Lists.keyedGroupSort (forall {b} {c}. (CommandType, b, c) -> Either b (Control, b)
key forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(TrackTime, (CommandType, Control, Control))]
controls
    where
    make_control :: (Either a (a, a), [(TrackTime, (a, b, Control))]) -> (a, [Event])
make_control (Left a
control, [(TrackTime, (a, b, Control))]
vals) =
        (a
control, [TrackTime -> TrackTime -> Control -> Event
Event.event TrackTime
start TrackTime
0 Control
call | (TrackTime
start, (a
_, b
_, Control
call)) <- [(TrackTime, (a, b, Control))]
vals])
    make_control (Right (a
_k, a
control), [(TrackTime, (a, b, Control))]
vals) =
        ( a
control
        , [TrackTime -> TrackTime -> Control -> Event
Event.event TrackTime
t (forall a. [a] -> a
last [TrackTime]
run forall a. Num a => a -> a -> a
+ TrackTime
one_line forall a. Num a => a -> a -> a
- TrackTime
t) Control
call | run :: [TrackTime]
run@(TrackTime
t:[TrackTime]
_) <- [[TrackTime]]
runs]
        )
        where
        (a
_, b
_, Control
call) = forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [(TrackTime, (a, b, Control))]
vals
        runs :: [[TrackTime]]
runs = forall a. (a -> a -> Bool) -> [a] -> [[a]]
Lists.splitBetween (\TrackTime
t1 TrackTime
t2 -> TrackTime
t2 forall a. Ord a => a -> a -> Bool
> TrackTime
t1 forall a. Num a => a -> a -> a
+ TrackTime
one_line) (forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(TrackTime, (a, b, Control))]
vals)
        one_line :: TrackTime
one_line = TrackTime
1 forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lines_per_t
    -- All Singles are in one group so they each get a 0 dur event.
    key :: (CommandType, b, c) -> Either b (Control, b)
key (CommandType
Single, b
control, c
_) = forall a b. a -> Either a b
Left b
control
    key (Grouped Control
k, b
control, c
_call) = forall a b. b -> Either a b
Right (Control
k, b
control)

type Control = Text
data Call = Call !Text !Double
    deriving (Call -> Call -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Call -> Call -> Bool
$c/= :: Call -> Call -> Bool
== :: Call -> Call -> Bool
$c== :: Call -> Call -> Bool
Eq, Eq Call
Call -> Call -> Bool
Call -> Call -> Ordering
Call -> Call -> Call
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Call -> Call -> Call
$cmin :: Call -> Call -> Call
max :: Call -> Call -> Call
$cmax :: Call -> Call -> Call
>= :: Call -> Call -> Bool
$c>= :: Call -> Call -> Bool
> :: Call -> Call -> Bool
$c> :: Call -> Call -> Bool
<= :: Call -> Call -> Bool
$c<= :: Call -> Call -> Bool
< :: Call -> Call -> Bool
$c< :: Call -> Call -> Bool
compare :: Call -> Call -> Ordering
$ccompare :: Call -> Call -> Ordering
Ord, Int -> Call -> ShowS
[Call] -> ShowS
Call -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Call] -> ShowS
$cshowList :: [Call] -> ShowS
show :: Call -> String
$cshow :: Call -> String
showsPrec :: Int -> Call -> ShowS
$cshowsPrec :: Int -> Call -> ShowS
Show)

-- | Single cmds emit a single 0 dur event.  Grouped cmds emit an event with
-- the given duration as long as they stay the same.
data CommandType = Single
    -- | Take a group key since VolumeSlide can group df with d.
    | Grouped !Text
    deriving (CommandType -> CommandType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommandType -> CommandType -> Bool
$c/= :: CommandType -> CommandType -> Bool
== :: CommandType -> CommandType -> Bool
$c== :: CommandType -> CommandType -> Bool
Eq, Eq CommandType
CommandType -> CommandType -> Bool
CommandType -> CommandType -> Ordering
CommandType -> CommandType -> CommandType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CommandType -> CommandType -> CommandType
$cmin :: CommandType -> CommandType -> CommandType
max :: CommandType -> CommandType -> CommandType
$cmax :: CommandType -> CommandType -> CommandType
>= :: CommandType -> CommandType -> Bool
$c>= :: CommandType -> CommandType -> Bool
> :: CommandType -> CommandType -> Bool
$c> :: CommandType -> CommandType -> Bool
<= :: CommandType -> CommandType -> Bool
$c<= :: CommandType -> CommandType -> Bool
< :: CommandType -> CommandType -> Bool
$c< :: CommandType -> CommandType -> Bool
compare :: CommandType -> CommandType -> Ordering
$ccompare :: CommandType -> CommandType -> Ordering
Ord, Int -> CommandType -> ShowS
[CommandType] -> ShowS
CommandType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CommandType] -> ShowS
$cshowList :: [CommandType] -> ShowS
show :: CommandType -> String
$cshow :: CommandType -> String
showsPrec :: Int -> CommandType -> ShowS
$cshowsPrec :: Int -> CommandType -> ShowS
Show)

commands_to_controls :: [ModT.Command] -> [(CommandType, Control, Text)]
commands_to_controls :: [Command] -> [(CommandType, Control, Control)]
commands_to_controls = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe ([Command], Command) -> Maybe (CommandType, Control, Control)
convert forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\[Command]
xs -> forall a b. (a -> b) -> [a] -> [b]
map ([Command]
xs,) [Command]
xs)
    where
    convert :: ([Command], Command) -> Maybe (CommandType, Control, Control)
convert ([Command]
cmds, Command
c) = case Command
c of
        -- The slope is not accurate, and I'd need a ScoreTime slope for 'u'
        -- and 'd' to make it accurate.  Too much bother.
        ModT.VolumeSlide Double
val -> forall a. a -> Maybe a
Just
            ( Control -> CommandType
Grouped (forall a. ShowVal a => a -> Control
show_val Double
val)
            , Control
c_dyn
            , [Control] -> Control
Text.unwords forall a b. (a -> b) -> a -> b
$ case [Double
vol | ModT.Volume Double
vol <- [Command]
cmds] of
                Double
vol : [Double]
_ ->
                    [ Control
c forall a. Semigroup a => a -> a -> a
<> Control
"f"
                    , Double -> Control
ShowVal.show_hex_val Double
vol
                    , forall a. ShowVal a => a -> Control
show_val (forall a. Num a => a -> a
abs Double
val)
                    ]
                [] -> [Control
c, forall a. ShowVal a => a -> Control
show_val (forall a. Num a => a -> a
abs Double
val)]
            )
            where c :: Control
c = if Double
val forall a. Ord a => a -> a -> Bool
>= Double
0 then Control
"u" else Control
"d"
        ModT.Volume Double
val
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [() | ModT.VolumeSlide Double
_ <- [Command]
cmds] ->
                forall a. a -> Maybe a
Just (CommandType
Single, Control
c_dyn, Double -> Control
ShowVal.show_hex_val Double
val)
            | Bool
otherwise -> forall a. Maybe a
Nothing
        ModT.Command Control
name Word8
val -> forall a. a -> Maybe a
Just
            ( CommandType
Single
            , Control
"cmd"
            , Control
"--| " forall a. Semigroup a => a -> a -> a
<> Control
name forall a. Semigroup a => a -> a -> a
<> if Word8
val forall a. Eq a => a -> a -> Bool
== Word8
0 then Control
"" else Control
" " forall a. Semigroup a => a -> a -> a
<> forall a. (Integral a, Show a) => Int -> a -> Control
Num.hex Int
2 Word8
val
            )
        Command
_ -> forall a. Maybe a
Nothing

c_dyn, c_pitch :: Control
c_dyn :: Control
c_dyn = Control
"dyn"
c_pitch :: Control
c_pitch = Control
"*"

cut_note :: (LineNum, ModT.Line) -> Maybe TrackTime
cut_note :: (Int, Line) -> Maybe TrackTime
cut_note (Int
linenum, Line
line)
    | Just NoteNumber
_ <- Line -> Maybe NoteNumber
ModT._pitch Line
line = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> TrackTime
line_start Int
linenum
    | Command
ModT.CutNote forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Line -> [Command]
ModT._commands Line
line = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> TrackTime
line_start Int
linenum
    | Command
ModT.CutBlock forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` Line -> [Command]
ModT._commands Line
line = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Int -> TrackTime
line_start (Int
linenumforall a. Num a => a -> a -> a
+Int
1)
    | Bool
otherwise = forall a. Maybe a
Nothing

line_start :: LineNum -> TrackTime
line_start :: Int -> TrackTime
line_start = (forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
lines_per_t) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> TrackTime
ScoreTime.from_double forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | Lines per 1 TrackTime.
lines_per_t :: Int
lines_per_t :: Int
lines_per_t = Int
8