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