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

module Derive.C.Post.Reverse (library) where
import qualified Util.Lists as Lists
import qualified Derive.Args as Args
import qualified Derive.Call.Module as Module
import qualified Derive.Call.Tags as Tags
import qualified Derive.Derive as Derive
import qualified Derive.Library as Library
import qualified Derive.Score as Score
import qualified Derive.Sig as Sig
import qualified Derive.Stack as Stack
import qualified Derive.Stream as Stream

import           Global
import           Types


library :: Library.Library
library :: Library
library = forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
Library.transformers
    [ (Symbol
"reverse", Transformer Note
c_reverse)
    ]

-- * reverse

c_reverse :: Derive.Transformer Derive.Note
c_reverse :: Transformer Note
c_reverse = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
Module.prelude CallName
"reverse" Tags
Tags.postproc
    Doc
"Reverse the events." forall a b. (a -> b) -> a -> b
$
    forall y d.
Taggable y =>
Transformer y d -> WithArgDoc (Transformer y d)
Sig.call0t forall a b. (a -> b) -> a -> b
$ \PassedArgs Note
args Deriver (Stream Note)
deriver -> do
        RealTime
start <- forall a. PassedArgs a -> Deriver RealTime
Args.real_start PassedArgs Note
args
        ([Note]
events, [Msg]
logs) <- forall a. Stream a -> ([a], [Msg])
Stream.partition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver (Stream Note)
deriver
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e. [Msg] -> Stream e -> Stream e
Stream.merge_logs [Msg]
logs forall a b. (a -> b) -> a -> b
$
            forall a. [a] -> Stream a
Stream.from_sorted_events (RealTime -> [Note] -> [Note]
reverse_tracks RealTime
start [Note]
events)

reverse_tracks :: RealTime -> [Score.Event] -> [Score.Event]
reverse_tracks :: RealTime -> [Note] -> [Note]
reverse_tracks RealTime
start [Note]
events = forall k a. Ord k => (a -> k) -> [[a]] -> [a]
Lists.mergeLists Note -> RealTime
Score.event_start
    [ RealTime -> [Note] -> [Note]
reverse_events (RealTime
start forall a. Num a => a -> a -> a
+ (RealTime
end forall a. Num a => a -> a -> a
- Note -> RealTime
Score.event_end Note
last)) [Note]
events
    | events :: [Note]
events@(Note
last : [Note]
_) <- [[Note]]
by_track
    ]
    where
    by_track :: [[Note]]
by_track = forall a b. (a -> b) -> [a] -> [b]
map (forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) forall a b. (a -> b) -> a -> b
$ [Note] -> [(TrackId, [Note])]
partition_tracks [Note]
events
    -- This will be the new 0.
    end :: RealTime
end = forall a. a -> Maybe a -> a
fromMaybe RealTime
0 forall a b. (a -> b) -> a -> b
$ forall a. Ord a => [a] -> Maybe a
Lists.maximum
        [Note -> RealTime
Score.event_end Note
last | Note
last : [Note]
_ <- [[Note]]
by_track]

-- | Partition up events by the track they're in.
partition_tracks :: [Score.Event] -> [(TrackId, [Score.Event])]
partition_tracks :: [Note] -> [(TrackId, [Note])]
partition_tracks = forall {a} {b}. [(Maybe a, b)] -> [(a, b)]
strip forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall key a. Ord key => (a -> key) -> [a] -> [(key, [a])]
Lists.keyedGroupSort Note -> Maybe TrackId
track_of
    where strip :: [(Maybe a, b)] -> [(a, b)]
strip [(Maybe a, b)]
xs = [(a
track_id, b
events) | (Just a
track_id, b
events) <- [(Maybe a, b)]
xs]

track_of :: Score.Event -> Maybe TrackId
track_of :: Note -> Maybe TrackId
track_of = 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 Frame -> Maybe TrackId
Stack.track_of forall b c a. (b -> c) -> (a -> b) -> a -> c
. Stack -> [Frame]
Stack.innermost
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Stack
Score.event_stack

reverse_events :: RealTime -> [Score.Event] -> [Score.Event]
reverse_events :: RealTime -> [Note] -> [Note]
reverse_events RealTime
at [Note]
events = case [Note]
events of
    [] -> []
    [Note
cur] -> [RealTime -> Note -> Note
move RealTime
at Note
cur]
    Note
cur : rest :: [Note]
rest@(Note
next : [Note]
_) -> RealTime -> Note -> Note
move RealTime
at Note
cur
        forall a. a -> [a] -> [a]
: RealTime -> [Note] -> [Note]
reverse_events (RealTime
at forall a. Num a => a -> a -> a
+ Note -> RealTime
Score.event_duration Note
cur
            forall a. Num a => a -> a -> a
+ (Note -> RealTime
Score.event_start Note
cur forall a. Num a => a -> a -> a
- Note -> RealTime
Score.event_end Note
next)) [Note]
rest
    where
    move :: RealTime -> Note -> Note
move RealTime
at = (RealTime -> RealTime) -> Note -> Note
Score.move (forall a b. a -> b -> a
const RealTime
at)