-- 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 {-# LANGUAGE DeriveFunctor #-} -- | This is the basic interface for slicing. This also includes 'inverting', -- which is a special case of slicing. module Derive.Call.Sub ( -- * inversion under_invert , inverting, inverting_args -- ** events , sub_events, sub_events_negative , sub_tracks , assert_no_subs , modify_notes , derive_subs, derive, derive_tracks, derive_pitch, fit -- ** RestEvent , RestEvent, sub_rest_events , fit_rests, strip_rests -- * reapply , reapply, reapply_call ) where import qualified Data.Map as Map import qualified Data.Tree as Tree import qualified Util.Seq as Seq import qualified Derive.Args as Args import qualified Derive.Call.BlockUtil as BlockUtil import qualified Derive.Call.SubT as SubT import qualified Derive.Derive as Derive import qualified Derive.DeriveT as DeriveT import qualified Derive.Deriver.Internal as Internal import qualified Derive.Eval as Eval import qualified Derive.Expr as Expr import qualified Derive.ParseTitle as ParseTitle import qualified Derive.Score as Score import qualified Derive.Slice as Slice import qualified Derive.Stack as Stack import qualified Derive.Stream as Stream import qualified Perform.Pitch as Pitch import qualified Ui.Event as Event import qualified Ui.Events as Events import qualified Ui.TrackTree as TrackTree import Global import Types -- * inversion {- | Cause this transformer to apply only after inversion. 'Derive.Call.Tags.under_invert' documents this, also see NOTE [under-invert]. Normally when a call is inverted, the transformers run outside the inversion, while only the generator runs underneath. However, some transformers rely on per-note controls, such as pitch and dyn, and therefore need to go under the invert. So this saves the transformer, and applies it only after all the inversion has happened. If there are no sub-tracks, then inversion won't happen, and the transform is run right here. However, if there are sub-tracks, but the generator doesn't want to run, then the transform will be lost. TODO I could probably fix it by making Eval.eval_generator apply the transform, but it would have to clear it out too to avoid evaluating more than once. Not sure which way is right. -} under_invert :: (Derive.NoteArgs -> Derive.NoteDeriver -> Derive.NoteDeriver) -> Derive.NoteArgs -> Derive.NoteDeriver -> Derive.NoteDeriver under_invert :: (NoteArgs -> NoteDeriver -> NoteDeriver) -> NoteArgs -> NoteDeriver -> NoteDeriver under_invert NoteArgs -> NoteDeriver -> NoteDeriver transformer NoteArgs args NoteDeriver deriver | [EventsNode] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null ([EventsNode] -> Bool) -> [EventsNode] -> Bool forall a b. (a -> b) -> a -> b $ Context Event -> [EventsNode] forall val. Context val -> [EventsNode] Derive.ctx_sub_tracks (Context Event -> [EventsNode]) -> Context Event -> [EventsNode] forall a b. (a -> b) -> a -> b $ NoteArgs -> Context Event forall val. PassedArgs val -> Context val Derive.passed_ctx NoteArgs args = NoteArgs -> NoteDeriver -> NoteDeriver transformer NoteArgs args NoteDeriver deriver | Bool otherwise = NoteDeriver -> NoteDeriver forall {a}. Deriver a -> Deriver a with NoteDeriver deriver where with :: Deriver a -> Deriver a with = (Dynamic -> Dynamic) -> Deriver a -> Deriver a forall a. (Dynamic -> Dynamic) -> Deriver a -> Deriver a Internal.local ((Dynamic -> Dynamic) -> Deriver a -> Deriver a) -> (Dynamic -> Dynamic) -> Deriver a -> Deriver a forall a b. (a -> b) -> a -> b $ \Dynamic state -> Dynamic state { state_under_invert :: NoteDeriver -> NoteDeriver Derive.state_under_invert = Dynamic -> NoteDeriver -> NoteDeriver Derive.state_under_invert Dynamic state (NoteDeriver -> NoteDeriver) -> (NoteDeriver -> NoteDeriver) -> NoteDeriver -> NoteDeriver forall b c a. (b -> c) -> (a -> b) -> a -> c . NoteArgs -> NoteDeriver -> NoteDeriver transformer NoteArgs args } -- | Convert a call into an inverting call. Documented in -- @doc/slicing-inverting.md@. run_invert :: Derive.PassedArgs d -> Derive.NoteDeriver -> Derive.NoteDeriver run_invert :: forall d. PassedArgs d -> NoteDeriver -> NoteDeriver run_invert PassedArgs d args NoteDeriver call = do Dynamic dyn <- (Dynamic -> Dynamic) -> Deriver Dynamic forall a. (Dynamic -> a) -> Deriver a Internal.get_dynamic Dynamic -> Dynamic forall a. a -> a id case (Dynamic -> Inversion Derive.state_inversion Dynamic dyn, Context d -> [EventsNode] forall val. Context val -> [EventsNode] Derive.ctx_sub_tracks Context d ctx) of (Derive.InversionInProgress {}, [EventsNode] _) -> Text -> NoteDeriver forall a. HasCallStack => Text -> Deriver a Derive.throw Text "tried to invert while inverting" (Inversion Derive.NotInverted, subs :: [EventsNode] subs@(EventsNode _:[EventsNode] _)) -> do [EventsNode] sliced <- [EventsNode] -> Event -> ScoreTime -> ([Event], [Event]) -> Deriver [EventsNode] invert [EventsNode] subs Event event (PassedArgs d -> ScoreTime forall a. PassedArgs a -> ScoreTime Args.next PassedArgs d args) (Context d -> [Event] forall val. Context val -> [Event] Derive.ctx_prev_events Context d ctx, Context d -> [Event] forall val. Context val -> [Event] Derive.ctx_next_events Context d ctx) NoteDeriver -> NoteDeriver forall {a}. Deriver a -> Deriver a with_inversion (NoteDeriver -> NoteDeriver) -> NoteDeriver -> NoteDeriver forall a b. (a -> b) -> a -> b $ [EventsNode] -> NoteDeriver BlockUtil.derive_tracks [EventsNode] sliced (Inversion Derive.NotInverted, []) -> NoteDeriver call where with_inversion :: Deriver a -> Deriver a with_inversion = (Dynamic -> Dynamic) -> Deriver a -> Deriver a forall a. (Dynamic -> Dynamic) -> Deriver a -> Deriver a Internal.local ((Dynamic -> Dynamic) -> Deriver a -> Deriver a) -> (Dynamic -> Dynamic) -> Deriver a -> Deriver a forall a b. (a -> b) -> a -> b $ \Dynamic dyn -> Dynamic dyn { state_inversion :: Inversion Derive.state_inversion = NoteDeriver -> Inversion Derive.InversionInProgress NoteDeriver call } event :: Event event = Context d -> Event forall val. Context val -> Event Derive.ctx_event Context d ctx ctx :: Context d ctx = PassedArgs d -> Context d forall val. PassedArgs val -> Context val Derive.passed_ctx PassedArgs d args -- | Convert a call into an inverting call. This is designed to be convenient -- to insert after the signature arg in a call definition. The args passed -- to the call have been stripped of their sub tracks to avoid another -- inversion. inverting :: (Derive.PassedArgs d -> Derive.NoteDeriver) -> Derive.PassedArgs d -> Derive.NoteDeriver inverting :: forall d. (PassedArgs d -> NoteDeriver) -> PassedArgs d -> NoteDeriver inverting PassedArgs d -> NoteDeriver call PassedArgs d args = PassedArgs d -> NoteDeriver -> NoteDeriver forall d. PassedArgs d -> NoteDeriver -> NoteDeriver run_invert PassedArgs d args (PassedArgs d -> NoteDeriver call PassedArgs d stripped) where stripped :: PassedArgs d stripped = PassedArgs d args { passed_ctx :: Context d Derive.passed_ctx = (PassedArgs d -> Context d forall val. PassedArgs val -> Context val Derive.passed_ctx PassedArgs d args) { ctx_sub_tracks :: [EventsNode] Derive.ctx_sub_tracks = [EventsNode] forall a. Monoid a => a mempty , ctx_sub_events :: Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] Derive.ctx_sub_events = Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] forall a. Maybe a Nothing } } -- | 'inverting' with its arguments flipped. This is useful for calls that -- want to do stuff with the args before inverting. Make sure to shadow the -- old 'Derive.PassedArgs' with the ones passed to the call, for the reason -- documented in 'inverting'. inverting_args :: Derive.PassedArgs d -> (Derive.PassedArgs d -> Derive.NoteDeriver) -> Derive.NoteDeriver inverting_args :: forall d. PassedArgs d -> (PassedArgs d -> NoteDeriver) -> NoteDeriver inverting_args = ((PassedArgs d -> NoteDeriver) -> PassedArgs d -> NoteDeriver) -> PassedArgs d -> (PassedArgs d -> NoteDeriver) -> NoteDeriver forall a b c. (a -> b -> c) -> b -> a -> c flip (PassedArgs d -> NoteDeriver) -> PassedArgs d -> NoteDeriver forall d. (PassedArgs d -> NoteDeriver) -> PassedArgs d -> NoteDeriver inverting -- When I invert, I call derive_tracks again, which means the inverted bottom -- is going to expect to see the current prev val. TODO but evidently I don't -- need this? Try to make a problem without it. save_prev_val :: Derive.Taggable a => Derive.PassedArgs a -> Derive.Deriver () save_prev_val :: forall a. Taggable a => PassedArgs a -> Deriver () save_prev_val PassedArgs a args = case PassedArgs a -> Maybe a forall a. PassedArgs a -> Maybe a Args.prev_val PassedArgs a args of Maybe a Nothing -> () -> Deriver () forall (m :: * -> *) a. Monad m => a -> m a return () Just a val -> Stack -> Maybe (BlockId, TrackId) Stack.block_track_of (Stack -> Maybe (BlockId, TrackId)) -> Deriver State Error Stack -> Deriver State Error (Maybe (BlockId, TrackId)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Deriver State Error Stack Internal.get_stack Deriver State Error (Maybe (BlockId, TrackId)) -> (Maybe (BlockId, TrackId) -> Deriver ()) -> Deriver () forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Maybe (BlockId, TrackId) Nothing -> () -> Deriver () forall (m :: * -> *) a. Monad m => a -> m a return () Just (BlockId, TrackId) block_track -> (Threaded -> Threaded) -> Deriver () forall {err}. (Threaded -> Threaded) -> Deriver State err () modify_threaded ((Threaded -> Threaded) -> Deriver ()) -> (Threaded -> Threaded) -> Deriver () forall a b. (a -> b) -> a -> b $ \Threaded th -> Threaded th { state_prev_val :: Map (BlockId, TrackId) Tagged Derive.state_prev_val = (BlockId, TrackId) -> Tagged -> Map (BlockId, TrackId) Tagged -> Map (BlockId, TrackId) Tagged forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert (BlockId, TrackId) block_track (a -> Tagged forall a. Taggable a => a -> Tagged Derive.to_tagged a val) (Threaded -> Map (BlockId, TrackId) Tagged Derive.state_prev_val Threaded th) } where modify_threaded :: (Threaded -> Threaded) -> Deriver State err () modify_threaded Threaded -> Threaded modify = (State -> State) -> Deriver State err () forall st err. (st -> st) -> Deriver st err () Derive.modify ((State -> State) -> Deriver State err ()) -> (State -> State) -> Deriver State err () forall a b. (a -> b) -> a -> b $ \State st -> State st { state_threaded :: Threaded Derive.state_threaded = Threaded -> Threaded modify (State -> Threaded Derive.state_threaded State st) } invert :: TrackTree.EventsTree -> Event.Event -> ScoreTime -> ([Event.Event], [Event.Event]) -> Derive.Deriver TrackTree.EventsTree invert :: [EventsNode] -> Event -> ScoreTime -> ([Event], [Event]) -> Deriver [EventsNode] invert [EventsNode] subs Event event ScoreTime next_start ([Event], [Event]) events_around = do -- Pick the current TrackId out of the stack, and give that to the track -- created by inversion. -- TODO I'm not 100% comfortable with this, I don't like putting implicit -- dependencies on the stack like this. Too many of these and someday -- I change how the stack works and all sorts of things break. It would be -- more explicit to put TrackId into Context. Maybe TrackId track_id <- Deriver (Maybe TrackId) stack_track_id let sliced :: [EventsNode] sliced = Maybe TrackId -> [EventsNode] slice Maybe TrackId track_id Maybe Track -> (Track -> Deriver ()) -> Deriver () forall (m :: * -> *) a. Applicative m => Maybe a -> (a -> m ()) -> m () whenJust ([EventsNode] -> Maybe Track non_bottom_note_track [EventsNode] sliced) ((Track -> Deriver ()) -> Deriver ()) -> (Track -> Deriver ()) -> Deriver () forall a b. (a -> b) -> a -> b $ \Track track -> Text -> Deriver () forall a. HasCallStack => Text -> Deriver a Derive.throw (Text -> Deriver ()) -> Text -> Deriver () forall a b. (a -> b) -> a -> b $ Text "inverting below a note track will lead to an endless loop: " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Maybe TrackId -> Text forall a. Pretty a => a -> Text pretty (Track -> Maybe TrackId TrackTree.track_id Track track) [EventsNode] -> Deriver [EventsNode] forall (m :: * -> *) a. Monad m => a -> m a return [EventsNode] sliced where slice :: Maybe TrackId -> [EventsNode] slice Maybe TrackId track_id = (EventsNode -> EventsNode) -> [EventsNode] -> [EventsNode] forall a b. (a -> b) -> [a] -> [b] map (Bool -> ScoreTime -> ScoreTime -> Maybe InsertEvent -> EventsNode -> EventsNode Slice.slice Bool False (Event -> ScoreTime Event.start Event event) ScoreTime next_start (InsertEvent -> Maybe InsertEvent forall a. a -> Maybe a Just (Maybe TrackId -> InsertEvent insert Maybe TrackId track_id))) [EventsNode] subs -- Use 'next_start' instead of track_end because in the absence of a next -- note, the track end becomes next note and clips controls. insert :: Maybe TrackId -> InsertEvent insert Maybe TrackId track_id = Slice.InsertEvent { event_duration :: ScoreTime event_duration = Event -> ScoreTime Event.duration Event event , event_orientation :: Orientation event_orientation = Event -> Orientation Event.orientation Event event , event_around :: ([Event], [Event]) event_around = ([Event], [Event]) events_around , event_track_id :: Maybe TrackId event_track_id = Maybe TrackId track_id } stack_track_id :: Derive.Deriver (Maybe TrackId) stack_track_id :: Deriver (Maybe TrackId) stack_track_id = [TrackId] -> Maybe TrackId forall a. [a] -> Maybe a Seq.head ([TrackId] -> Maybe TrackId) -> (Stack -> [TrackId]) -> Stack -> Maybe TrackId forall b c a. (b -> c) -> (a -> b) -> a -> c . (Frame -> Maybe TrackId) -> [Frame] -> [TrackId] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe Frame -> Maybe TrackId Stack.track_of ([Frame] -> [TrackId]) -> (Stack -> [Frame]) -> Stack -> [TrackId] forall b c a. (b -> c) -> (a -> b) -> a -> c . Stack -> [Frame] Stack.innermost (Stack -> Maybe TrackId) -> Deriver State Error Stack -> Deriver (Maybe TrackId) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Deriver State Error Stack Internal.get_stack -- | An inverting call above another note track will lead to an infinite loop -- if there are overlapping sub-events that also invert, or confusing results -- if there are non-overlapping or non-inverting sub-events. Either way, I -- don't think I want it. -- -- An exception is if the note track is empty, since I can be sure there are -- no inverting calls in that case. non_bottom_note_track :: TrackTree.EventsTree -> Maybe TrackTree.Track non_bottom_note_track :: [EventsNode] -> Maybe Track non_bottom_note_track [EventsNode] tree = [Track] -> Maybe Track forall a. [a] -> Maybe a Seq.head ((EventsNode -> [Track]) -> [EventsNode] -> [Track] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap EventsNode -> [Track] go [EventsNode] tree) where go :: EventsNode -> [Track] go (Tree.Node Track track [EventsNode] subs) | Text -> Bool ParseTitle.is_note_track (Track -> Text TrackTree.track_title Track track) Bool -> Bool -> Bool && Bool -> Bool not (Events -> Bool Events.null (Track -> Events TrackTree.track_events Track track)) Bool -> Bool -> Bool && Bool -> Bool not ([EventsNode] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [EventsNode] subs) = [Track track] | Bool otherwise = (EventsNode -> [Track]) -> [EventsNode] -> [Track] forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b] concatMap EventsNode -> [Track] go [EventsNode] subs -- * sub tracks -- | Get the Events of subtracks, if any, returning one list of events per sub -- note track. This is the top-level utility for note calls that take other -- note calls as arguments. sub_events :: Derive.PassedArgs d -> Derive.Deriver [[SubT.Event]] sub_events :: forall d. PassedArgs d -> Deriver [[Event]] sub_events = Bool -> PassedArgs d -> Deriver [[Event]] forall d. Bool -> PassedArgs d -> Deriver [[Event]] sub_events_ Bool False -- | TODO maybe this should replace 'sub_events' sub_tracks :: Derive.PassedArgs d -> Derive.Deriver [SubT.Track] sub_tracks :: forall d. PassedArgs d -> Deriver [Track] sub_tracks = Bool -> PassedArgs d -> Deriver [Track] forall d. Bool -> PassedArgs d -> Deriver [Track] sub_tracks_ Bool False -- | Like 'sub_events', but exclude events at the start time, and include -- events at the end time. Presumably suitable for 'Event.Negative' calls. sub_events_negative :: Derive.PassedArgs d -> Derive.Deriver [[SubT.Event]] sub_events_negative :: forall d. PassedArgs d -> Deriver [[Event]] sub_events_negative = Bool -> PassedArgs d -> Deriver [[Event]] forall d. Bool -> PassedArgs d -> Deriver [[Event]] sub_events_ Bool True -- | Throw an exception if there are sub-events. assert_no_subs :: Derive.PassedArgs d -> Derive.Deriver () assert_no_subs :: forall d. PassedArgs d -> Deriver () assert_no_subs PassedArgs d args = do -- Due to laziness, checking null shouldn't require any actual slicing. [[Event]] events <- PassedArgs d -> Deriver [[Event]] forall d. PassedArgs d -> Deriver [[Event]] sub_events PassedArgs d args if [[Event]] -> Bool forall (t :: * -> *) a. Foldable t => t a -> Bool null [[Event]] events then () -> Deriver () forall (m :: * -> *) a. Monad m => a -> m a return () else case Context d -> Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] forall val. Context val -> Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] Derive.ctx_sub_events Context d ctx of Just [[(ScoreTime, ScoreTime, NoteDeriver)]] subs -> Text -> Deriver () forall a. HasCallStack => Text -> Deriver a Derive.throw (Text -> Deriver ()) -> Text -> Deriver () forall a b. (a -> b) -> a -> b $ Text "expected no sub events, but got " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> [[(ScoreTime, ScoreTime)]] -> Text forall a. Pretty a => a -> Text pretty (([(ScoreTime, ScoreTime, NoteDeriver)] -> [(ScoreTime, ScoreTime)]) -> [[(ScoreTime, ScoreTime, NoteDeriver)]] -> [[(ScoreTime, ScoreTime)]] forall a b. (a -> b) -> [a] -> [b] map (((ScoreTime, ScoreTime, NoteDeriver) -> (ScoreTime, ScoreTime)) -> [(ScoreTime, ScoreTime, NoteDeriver)] -> [(ScoreTime, ScoreTime)] forall a b. (a -> b) -> [a] -> [b] map (\(ScoreTime s, ScoreTime d, NoteDeriver _) -> (ScoreTime s, ScoreTime d))) [[(ScoreTime, ScoreTime, NoteDeriver)]] subs) Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] Nothing -> Text -> Deriver () forall a. HasCallStack => Text -> Deriver a Derive.throw (Text -> Deriver ()) -> Text -> Deriver () forall a b. (a -> b) -> a -> b $ Text "expected no sub events, but got " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> [Tree (Text, Maybe TrackId)] -> Text forall a. Pretty a => a -> Text pretty ((EventsNode -> Tree (Text, Maybe TrackId)) -> [EventsNode] -> [Tree (Text, Maybe TrackId)] forall a b. (a -> b) -> [a] -> [b] map ((Track -> (Text, Maybe TrackId)) -> EventsNode -> Tree (Text, Maybe TrackId) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Track -> (Text, Maybe TrackId) extract_track) (Context d -> [EventsNode] forall val. Context val -> [EventsNode] Derive.ctx_sub_tracks Context d ctx)) where ctx :: Context d ctx = PassedArgs d -> Context d forall val. PassedArgs val -> Context val Derive.passed_ctx PassedArgs d args extract_track :: Track -> (Text, Maybe TrackId) extract_track Track t = (Track -> Text TrackTree.track_title Track t, Track -> Maybe TrackId TrackTree.track_id Track t) sub_events_ :: Bool -> Derive.PassedArgs d -> Derive.Deriver [[SubT.Event]] sub_events_ :: forall d. Bool -> PassedArgs d -> Deriver [[Event]] sub_events_ Bool include_end PassedArgs d args = (Track -> [Event]) -> [Track] -> [[Event]] forall a b. (a -> b) -> [a] -> [b] map Track -> [Event] SubT._events ([Track] -> [[Event]]) -> Deriver [Track] -> Deriver [[Event]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Bool -> PassedArgs d -> Deriver [Track] forall d. Bool -> PassedArgs d -> Deriver [Track] sub_tracks_ Bool include_end PassedArgs d args sub_tracks_ :: Bool -> Derive.PassedArgs d -> Derive.Deriver [SubT.Track] sub_tracks_ :: forall d. Bool -> PassedArgs d -> Deriver [Track] sub_tracks_ Bool include_end PassedArgs d args = case Context d -> Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] forall val. Context val -> Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] Derive.ctx_sub_events (PassedArgs d -> Context d forall val. PassedArgs val -> Context val Derive.passed_ctx PassedArgs d args) of Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] Nothing -> (Text -> Deriver [Track]) -> ([Track] -> Deriver [Track]) -> Either Text [Track] -> Deriver [Track] forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either Text -> Deriver [Track] forall a. HasCallStack => Text -> Deriver a Derive.throw ([Track] -> Deriver [Track] forall (m :: * -> *) a. Monad m => a -> m a return ([Track] -> Deriver [Track]) -> ([Track] -> [Track]) -> [Track] -> Deriver [Track] forall b c a. (b -> c) -> (a -> b) -> a -> c . (Track -> Maybe Track) -> [Track] -> [Track] forall a b. (a -> Maybe b) -> [a] -> [b] mapMaybe Track -> Maybe Track mktrack) (Either Text [Track] -> Deriver [Track]) -> Either Text [Track] -> Deriver [Track] forall a b. (a -> b) -> a -> b $ Bool -> ScoreTime -> ScoreTime -> [EventsNode] -> Either Text [Track] Slice.checked_slice_notes Bool include_end ScoreTime start ScoreTime end ([EventsNode] -> Either Text [Track]) -> [EventsNode] -> Either Text [Track] forall a b. (a -> b) -> a -> b $ Context d -> [EventsNode] forall val. Context val -> [EventsNode] Derive.ctx_sub_tracks (PassedArgs d -> Context d forall val. PassedArgs val -> Context val Derive.passed_ctx PassedArgs d args) Just [[(ScoreTime, ScoreTime, NoteDeriver)]] tracks -> [Track] -> Deriver [Track] forall (m :: * -> *) a. Monad m => a -> m a return [ Either Text TrackId -> [Event] -> Track SubT.Track (Text -> Either Text TrackId forall a b. a -> Either a b Left (Text -> Either Text TrackId) -> Text -> Either Text TrackId forall a b. (a -> b) -> a -> b $ Text "subevent:" Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Integer -> Text forall a. Show a => a -> Text showt Integer i) ([Event] -> Track) -> [Event] -> Track forall a b. (a -> b) -> a -> b $ ((ScoreTime, ScoreTime, NoteDeriver) -> Event) -> [(ScoreTime, ScoreTime, NoteDeriver)] -> [Event] forall a b. (a -> b) -> [a] -> [b] map (\(ScoreTime s, ScoreTime d, NoteDeriver n) -> ScoreTime -> ScoreTime -> NoteDeriver -> Event forall a. ScoreTime -> ScoreTime -> a -> EventT a SubT.EventT ScoreTime s ScoreTime d NoteDeriver n) [(ScoreTime, ScoreTime, NoteDeriver)] track | (Integer i, [(ScoreTime, ScoreTime, NoteDeriver)] track) <- [Integer] -> [[(ScoreTime, ScoreTime, NoteDeriver)]] -> [(Integer, [(ScoreTime, ScoreTime, NoteDeriver)])] forall a b. [a] -> [b] -> [(a, b)] zip [Integer 0..] [[(ScoreTime, ScoreTime, NoteDeriver)]] tracks ] where mktrack :: Track -> Maybe Track mktrack (Slice.Track Maybe TrackId track_id [Note] notes) = Track -> Maybe Track forall a. a -> Maybe a Just (Track -> Maybe Track) -> Track -> Maybe Track forall a b. (a -> b) -> a -> b $ -- 'TrackTree.track_id' can be Nothing. Presumably this happens for -- a constructed block. Either Text TrackId -> [Event] -> Track SubT.Track (Either Text TrackId -> (TrackId -> Either Text TrackId) -> Maybe TrackId -> Either Text TrackId forall b a. b -> (a -> b) -> Maybe a -> b maybe (Text -> Either Text TrackId forall a b. a -> Either a b Left Text "no-track-id") TrackId -> Either Text TrackId forall a b. b -> Either a b Right Maybe TrackId track_id) ((Note -> Event) -> [Note] -> [Event] forall a b. (a -> b) -> [a] -> [b] map Note -> Event mkevent [Note] notes) (ScoreTime start, ScoreTime end) = PassedArgs d -> (ScoreTime, ScoreTime) forall a. PassedArgs a -> (ScoreTime, ScoreTime) Args.range PassedArgs d args -- The events have been shifted back to 0 by 'Slice.checked_slice_notes', -- but are still their original lengths. Stretch them back to 1 so Events -- are normalized. mkevent :: Note -> Event mkevent (ScoreTime shift, ScoreTime stretch, [EventsNode] tree) = SubT.EventT { _start :: ScoreTime _start = ScoreTime shift , _duration :: ScoreTime _duration = ScoreTime stretch , _note :: NoteDeriver _note = ScoreTime -> NoteDeriver -> NoteDeriver forall a. ScoreTime -> Deriver a -> Deriver a Derive.stretch (if ScoreTime stretch ScoreTime -> ScoreTime -> Bool forall a. Eq a => a -> a -> Bool == ScoreTime 0 then ScoreTime 1 else ScoreTime -> ScoreTime forall a. Fractional a => a -> a recip ScoreTime stretch) ([EventsNode] -> NoteDeriver BlockUtil.derive_tracks [EventsNode] tree) } -- | Modify the text of sub note tracks before deriving them. This can be -- used to implement an ad-hoc new language. modify_notes :: ([SubT.EventT Text] -> Either Text [SubT.EventT Text]) -> Derive.PassedArgs a -> Either Text (Derive.PassedArgs a) modify_notes :: forall a. ([EventT Text] -> Either Text [EventT Text]) -> PassedArgs a -> Either Text (PassedArgs a) modify_notes [EventT Text] -> Either Text [EventT Text] modify = ([EventsNode] -> Either Text [EventsNode]) -> PassedArgs a -> Either Text (PassedArgs a) forall a. ([EventsNode] -> Either Text [EventsNode]) -> PassedArgs a -> Either Text (PassedArgs a) modify_sub_tracks (([EventsNode] -> Either Text [EventsNode]) -> PassedArgs a -> Either Text (PassedArgs a)) -> ([EventsNode] -> Either Text [EventsNode]) -> PassedArgs a -> Either Text (PassedArgs a) forall a b. (a -> b) -> a -> b $ (Events -> Either Text Events) -> [EventsNode] -> Either Text [EventsNode] modify_sub_notes (([EventT Text] -> Events) -> Either Text [EventT Text] -> Either Text Events forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap [EventT Text] -> Events to (Either Text [EventT Text] -> Either Text Events) -> (Events -> Either Text [EventT Text]) -> Events -> Either Text Events forall b c a. (b -> c) -> (a -> b) -> a -> c . [EventT Text] -> Either Text [EventT Text] modify ([EventT Text] -> Either Text [EventT Text]) -> (Events -> [EventT Text]) -> Events -> Either Text [EventT Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . Events -> [EventT Text] from) where from :: Events -> [EventT Text] from = (Event -> EventT Text) -> [Event] -> [EventT Text] forall a b. (a -> b) -> [a] -> [b] map Event -> EventT Text make ([Event] -> [EventT Text]) -> (Events -> [Event]) -> Events -> [EventT Text] forall b c a. (b -> c) -> (a -> b) -> a -> c . Events -> [Event] Events.ascending make :: Event -> EventT Text make Event e = SubT.EventT { _start :: ScoreTime _start = Event -> ScoreTime Event.start Event e , _duration :: ScoreTime _duration = Event -> ScoreTime Event.duration Event e , _note :: Text _note = Event -> Text Event.text Event e } to :: [EventT Text] -> Events to = [Event] -> Events Events.from_list ([Event] -> Events) -> ([EventT Text] -> [Event]) -> [EventT Text] -> Events forall b c a. (b -> c) -> (a -> b) -> a -> c . (EventT Text -> Event) -> [EventT Text] -> [Event] forall a b. (a -> b) -> [a] -> [b] map (\(SubT.EventT ScoreTime start ScoreTime dur Text text) -> ScoreTime -> ScoreTime -> Text -> Event Event.event ScoreTime start ScoreTime dur Text text) modify_sub_notes :: (Events.Events -> Either Text Events.Events) -> TrackTree.EventsTree -> Either Text TrackTree.EventsTree modify_sub_notes :: (Events -> Either Text Events) -> [EventsNode] -> Either Text [EventsNode] modify_sub_notes Events -> Either Text Events modify = (EventsNode -> Either Text EventsNode) -> [EventsNode] -> Either Text [EventsNode] forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse ((EventsNode -> Either Text EventsNode) -> [EventsNode] -> Either Text [EventsNode]) -> (EventsNode -> Either Text EventsNode) -> [EventsNode] -> Either Text [EventsNode] forall a b. (a -> b) -> a -> b $ (Track -> Either Text Track) -> EventsNode -> Either Text EventsNode forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse ((Track -> Either Text Track) -> EventsNode -> Either Text EventsNode) -> (Track -> Either Text Track) -> EventsNode -> Either Text EventsNode forall a b. (a -> b) -> a -> b $ \Track track -> if Text -> Bool ParseTitle.is_note_track (Track -> Text TrackTree.track_title Track track) then do Events events <- Events -> Either Text Events modify (Track -> Events TrackTree.track_events Track track) Track -> Either Text Track forall a b. b -> Either a b Right (Track -> Either Text Track) -> Track -> Either Text Track forall a b. (a -> b) -> a -> b $ Track track { track_events :: Events TrackTree.track_events = Events events } else Track -> Either Text Track forall a b. b -> Either a b Right Track track modify_sub_tracks :: (TrackTree.EventsTree -> Either Text TrackTree.EventsTree) -> Derive.PassedArgs a -> Either Text (Derive.PassedArgs a) modify_sub_tracks :: forall a. ([EventsNode] -> Either Text [EventsNode]) -> PassedArgs a -> Either Text (PassedArgs a) modify_sub_tracks [EventsNode] -> Either Text [EventsNode] modify PassedArgs a args = do [EventsNode] tracks <- [EventsNode] -> Either Text [EventsNode] modify ([EventsNode] -> Either Text [EventsNode]) -> [EventsNode] -> Either Text [EventsNode] forall a b. (a -> b) -> a -> b $ Context a -> [EventsNode] forall val. Context val -> [EventsNode] Derive.ctx_sub_tracks (PassedArgs a -> Context a forall val. PassedArgs val -> Context val Derive.passed_ctx PassedArgs a args) PassedArgs a -> Either Text (PassedArgs a) forall a b. b -> Either a b Right (PassedArgs a -> Either Text (PassedArgs a)) -> PassedArgs a -> Either Text (PassedArgs a) forall a b. (a -> b) -> a -> b $ PassedArgs a args { passed_ctx :: Context a Derive.passed_ctx = (PassedArgs a -> Context a forall val. PassedArgs val -> Context val Derive.passed_ctx PassedArgs a args) { ctx_sub_tracks :: [EventsNode] Derive.ctx_sub_tracks = [EventsNode] tracks } } derive_subs :: Derive.PassedArgs d -> Derive.NoteDeriver derive_subs :: forall d. PassedArgs d -> NoteDeriver derive_subs = [[Event]] -> NoteDeriver derive_tracks ([[Event]] -> NoteDeriver) -> (PassedArgs d -> Deriver [[Event]]) -> PassedArgs d -> NoteDeriver forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< PassedArgs d -> Deriver [[Event]] forall d. PassedArgs d -> Deriver [[Event]] sub_events -- | Derive and merge Events. derive :: [SubT.Event] -> Derive.NoteDeriver derive :: [Event] -> NoteDeriver derive = (Event -> NoteDeriver) -> [Event] -> NoteDeriver forall b a. Monoid b => (a -> b) -> [a] -> b mconcatMap (\(SubT.EventT ScoreTime s ScoreTime d NoteDeriver n) -> ScoreTime -> ScoreTime -> NoteDeriver -> NoteDeriver forall a. ScoreTime -> ScoreTime -> Deriver a -> Deriver a Derive.place ScoreTime s ScoreTime d NoteDeriver n) derive_tracks :: [[SubT.Event]] -> Derive.NoteDeriver derive_tracks :: [[Event]] -> NoteDeriver derive_tracks = [Event] -> NoteDeriver derive ([Event] -> NoteDeriver) -> ([[Event]] -> [Event]) -> [[Event]] -> NoteDeriver forall b c a. (b -> c) -> (a -> b) -> a -> c . (Event -> ScoreTime) -> [[Event]] -> [Event] forall k a. Ord k => (a -> k) -> [[a]] -> [a] Seq.merge_lists Event -> ScoreTime forall a. EventT a -> ScoreTime SubT._start -- | Get the pitch of an Event. Useful for debugging. derive_pitch :: SubT.Event -> Derive.Deriver (SubT.EventT (Maybe Pitch.Note)) derive_pitch :: Event -> Deriver (EventT (Maybe Note)) derive_pitch Event event = do Stream Event stream <- Event -> NoteDeriver forall a. EventT a -> a SubT._note Event event let note :: Maybe Note note = Event -> Maybe Note Score.initial_note (Event -> Maybe Note) -> Maybe Event -> Maybe Note forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< [Event] -> Maybe Event forall a. [a] -> Maybe a Seq.head (Stream Event -> [Event] forall a. Stream a -> [a] Stream.events_of Stream Event stream) EventT (Maybe Note) -> Deriver (EventT (Maybe Note)) forall (m :: * -> *) a. Monad m => a -> m a return (EventT (Maybe Note) -> Deriver (EventT (Maybe Note))) -> EventT (Maybe Note) -> Deriver (EventT (Maybe Note)) forall a b. (a -> b) -> a -> b $ Event event { _note :: Maybe Note SubT._note = Maybe Note note } -- | Re-fit the events from one range to another. fit :: (ScoreTime, ScoreTime) -- ^ fit this range -> (ScoreTime, ScoreTime) -- ^ into this range -> [SubT.Event] -> Derive.NoteDeriver fit :: (ScoreTime, ScoreTime) -> (ScoreTime, ScoreTime) -> [Event] -> NoteDeriver fit (ScoreTime from_start, ScoreTime from_end) (ScoreTime to_start, ScoreTime to_end) [Event] events = ScoreTime -> ScoreTime -> NoteDeriver -> NoteDeriver forall a. ScoreTime -> ScoreTime -> Deriver a -> Deriver a Derive.place ScoreTime to_start ScoreTime factor (NoteDeriver -> NoteDeriver) -> NoteDeriver -> NoteDeriver forall a b. (a -> b) -> a -> b $ [Event] -> NoteDeriver derive [Event e { _start :: ScoreTime SubT._start = Event -> ScoreTime forall a. EventT a -> ScoreTime SubT._start Event e ScoreTime -> ScoreTime -> ScoreTime forall a. Num a => a -> a -> a - ScoreTime from_start } | Event e <- [Event] events] -- Subtract from_start because Derive.place is going to add the start back -- on again in the form of to_start. where factor :: ScoreTime factor = (ScoreTime to_end ScoreTime -> ScoreTime -> ScoreTime forall a. Num a => a -> a -> a - ScoreTime to_start) ScoreTime -> ScoreTime -> ScoreTime forall a. Fractional a => a -> a -> a / (ScoreTime from_end ScoreTime -> ScoreTime -> ScoreTime forall a. Num a => a -> a -> a - ScoreTime from_start) -- ** RestEvent -- | A Nothing represents a rest. type RestEvent = SubT.EventT (Maybe Derive.NoteDeriver) -- | This is like 'sub_events', but gaps between the events are returned as -- explicit rests. sub_rest_events :: Bool -- ^ end bias -> Bool -- ^ if True, include the trailing gap as a rest -> Derive.PassedArgs d -> Derive.Deriver [[RestEvent]] sub_rest_events :: forall d. Bool -> Bool -> PassedArgs d -> Deriver [[RestEvent]] sub_rest_events Bool include_end Bool want_final_rest PassedArgs d args = ([Event] -> [RestEvent]) -> [[Event]] -> [[RestEvent]] forall a b. (a -> b) -> [a] -> [b] map ((ScoreTime -> ScoreTime -> [Event] -> [RestEvent]) -> (ScoreTime, ScoreTime) -> [Event] -> [RestEvent] forall a b c. (a -> b -> c) -> (a, b) -> c uncurry (Bool -> ScoreTime -> ScoreTime -> [Event] -> [RestEvent] forall a. Bool -> ScoreTime -> ScoreTime -> [EventT a] -> [EventT (Maybe a)] find_gaps Bool want_final_rest) (PassedArgs d -> (ScoreTime, ScoreTime) forall a. PassedArgs a -> (ScoreTime, ScoreTime) Args.range PassedArgs d args)) ([[Event]] -> [[RestEvent]]) -> Deriver [[Event]] -> Deriver [[RestEvent]] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Bool -> PassedArgs d -> Deriver [[Event]] forall d. Bool -> PassedArgs d -> Deriver [[Event]] sub_events_ Bool include_end PassedArgs d args find_gaps :: Bool -> ScoreTime -> ScoreTime -> [SubT.EventT a] -> [SubT.EventT (Maybe a)] find_gaps :: forall a. Bool -> ScoreTime -> ScoreTime -> [EventT a] -> [EventT (Maybe a)] find_gaps Bool want_final_rest ScoreTime start ScoreTime end (EventT a event : [EventT a] events) | ScoreTime gap ScoreTime -> ScoreTime -> Bool forall a. Ord a => a -> a -> Bool > ScoreTime 0 = ScoreTime -> ScoreTime -> Maybe a -> EventT (Maybe a) forall a. ScoreTime -> ScoreTime -> a -> EventT a SubT.EventT ScoreTime start ScoreTime gap Maybe a forall a. Maybe a Nothing EventT (Maybe a) -> [EventT (Maybe a)] -> [EventT (Maybe a)] forall a. a -> [a] -> [a] : [EventT (Maybe a)] rest | Bool otherwise = [EventT (Maybe a)] rest where gap :: ScoreTime gap = EventT a -> ScoreTime forall a. EventT a -> ScoreTime SubT._start EventT a event ScoreTime -> ScoreTime -> ScoreTime forall a. Num a => a -> a -> a - ScoreTime start rest :: [EventT (Maybe a)] rest = (a -> Maybe a forall a. a -> Maybe a Just (a -> Maybe a) -> EventT a -> EventT (Maybe a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> EventT a event) EventT (Maybe a) -> [EventT (Maybe a)] -> [EventT (Maybe a)] forall a. a -> [a] -> [a] : Bool -> ScoreTime -> ScoreTime -> [EventT a] -> [EventT (Maybe a)] forall a. Bool -> ScoreTime -> ScoreTime -> [EventT a] -> [EventT (Maybe a)] find_gaps Bool want_final_rest (EventT a -> ScoreTime forall a. EventT a -> ScoreTime SubT.end EventT a event) ScoreTime end [EventT a] events find_gaps Bool want_final_rest ScoreTime start ScoreTime end [] | Bool want_final_rest Bool -> Bool -> Bool && ScoreTime start ScoreTime -> ScoreTime -> Bool forall a. Ord a => a -> a -> Bool < ScoreTime end = [ScoreTime -> ScoreTime -> Maybe a -> EventT (Maybe a) forall a. ScoreTime -> ScoreTime -> a -> EventT a SubT.EventT ScoreTime start (ScoreTime endScoreTime -> ScoreTime -> ScoreTime forall a. Num a => a -> a -> a -ScoreTime start) Maybe a forall a. Maybe a Nothing] | Bool otherwise = [] -- | 'fit' for 'RestEvent's. fit_rests :: (ScoreTime, ScoreTime) -> (ScoreTime, ScoreTime) -> [RestEvent] -> Derive.NoteDeriver fit_rests :: (ScoreTime, ScoreTime) -> (ScoreTime, ScoreTime) -> [RestEvent] -> NoteDeriver fit_rests (ScoreTime from_start, ScoreTime from_end) (ScoreTime to_start, ScoreTime to_end) [RestEvent] events = ScoreTime -> ScoreTime -> NoteDeriver -> NoteDeriver forall a. ScoreTime -> ScoreTime -> Deriver a -> Deriver a Derive.place ScoreTime to_start ScoreTime factor (NoteDeriver -> NoteDeriver) -> NoteDeriver -> NoteDeriver forall a b. (a -> b) -> a -> b $ [Event] -> NoteDeriver derive [Event e { _start :: ScoreTime SubT._start = Event -> ScoreTime forall a. EventT a -> ScoreTime SubT._start Event e ScoreTime -> ScoreTime -> ScoreTime forall a. Num a => a -> a -> a - ScoreTime from_start } | Event e <- [RestEvent] -> [Event] strip_rests [RestEvent] events] where factor :: ScoreTime factor = (ScoreTime to_end ScoreTime -> ScoreTime -> ScoreTime forall a. Num a => a -> a -> a - ScoreTime to_start) ScoreTime -> ScoreTime -> ScoreTime forall a. Fractional a => a -> a -> a / (ScoreTime from_end ScoreTime -> ScoreTime -> ScoreTime forall a. Num a => a -> a -> a - ScoreTime from_start) strip_rests :: [RestEvent] -> [SubT.Event] strip_rests :: [RestEvent] -> [Event] strip_rests [RestEvent] events = [ScoreTime -> ScoreTime -> NoteDeriver -> Event forall a. ScoreTime -> ScoreTime -> a -> EventT a SubT.EventT ScoreTime s ScoreTime d NoteDeriver n | SubT.EventT ScoreTime s ScoreTime d (Just NoteDeriver n) <- [RestEvent] events] -- * reapply -- | Call a note parent with sub-events. While you can easily call other -- kinds of calls with 'Eval.reapply', note parents are more tricky -- because they expect a track structure in 'Derive.ctx_sub_tracks'. This -- bypasses that and directly passes 'SubT.EventT's to the note parent, -- courtesy of 'Derive.ctx_sub_events'. reapply :: Derive.Context Score.Event -> DeriveT.Expr -> [[SubT.Event]] -> Derive.NoteDeriver reapply :: Context Event -> Expr -> [[Event]] -> NoteDeriver reapply Context Event ctx Expr expr [[Event]] notes = Context Event -> Expr -> NoteDeriver forall d. CallableExpr d => Context d -> Expr -> Deriver (Stream d) Eval.reapply Context Event subs Expr expr where subs :: Context Event subs = Context Event ctx { ctx_sub_events :: Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] Derive.ctx_sub_events = [[(ScoreTime, ScoreTime, NoteDeriver)]] -> Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] forall a. a -> Maybe a Just ([[(ScoreTime, ScoreTime, NoteDeriver)]] -> Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]]) -> [[(ScoreTime, ScoreTime, NoteDeriver)]] -> Maybe [[(ScoreTime, ScoreTime, NoteDeriver)]] forall a b. (a -> b) -> a -> b $ ([Event] -> [(ScoreTime, ScoreTime, NoteDeriver)]) -> [[Event]] -> [[(ScoreTime, ScoreTime, NoteDeriver)]] forall a b. (a -> b) -> [a] -> [b] map ((Event -> (ScoreTime, ScoreTime, NoteDeriver)) -> [Event] -> [(ScoreTime, ScoreTime, NoteDeriver)] forall a b. (a -> b) -> [a] -> [b] map (\(SubT.EventT ScoreTime s ScoreTime d NoteDeriver n) -> (ScoreTime s, ScoreTime d, NoteDeriver n))) [[Event]] notes } reapply_call :: Derive.Context Score.Event -> Expr.Symbol -> [DeriveT.Term] -> [[SubT.Event]] -> Derive.NoteDeriver reapply_call :: Context Event -> Symbol -> [Term] -> [[Event]] -> NoteDeriver reapply_call Context Event ctx Symbol sym [Term] call_args = Context Event -> Expr -> [[Event]] -> NoteDeriver reapply Context Event ctx (Expr -> [[Event]] -> NoteDeriver) -> Expr -> [[Event]] -> NoteDeriver forall a b. (a -> b) -> a -> b $ Call Val -> Expr forall val. Call val -> Expr val Expr.generator (Call Val -> Expr) -> Call Val -> Expr forall a b. (a -> b) -> a -> b $ Symbol -> [Term] -> Call Val forall val. Symbol -> [Term val] -> Call val Expr.Call Symbol sym [Term] call_args {- NOTE [under-invert] . To make 'lift' to an absolute pitch work outside of inversion, I'd need an abstract way (e.g. like a transpose signal) to say "pitch midway to (4c)" . It's better to have the lift under the pitch. The only reason it isn't is that inversion assumes all transformers go above. So either make it a generator (at which point it can't compose), or have some way to put transformers under the inversion, e.g. 'delay | Drop $ lift $ gen' under inversion is 'delay' -> 'Drop' 'lift' 'gen'. . Another way would be to put that in the call itself, so 'lift' has a flag that says it likes to be under the inversion. Then the invert function has to go look all those up. But that can't work, because invert is called by a generator, and that's too late. . So call all the transformers pre and post invert. Normally they check if they're under inversion, and if so do nothing, but ones that would rather be inverted do the inverse. Cons: 1. Instead of transformers always happening before inversion, they can now vary internally, which is one more subtle thing about inversion. I'll need to expose it in documentation at least, via a tag. 2. Call stacks get even messier in the presence of inversion, since every transformer appears twice. 3. Transformers can have their order change, e.g. given 'below | above | gen', below is actually called below above, if it wants to be under inversion. . It seems like I could improve these by driving them from a tag. E.g. if the call has a under-inversion tag, Call.eval_transformers will skip or not skip, as appropriate. This solves #1 and #2, but not #3. . This is all just to get lift working under inversion. Is it that important? . Everything should work under inversion. It's a hassle to suddenly have to rearrange the pitch track, and now 'd' doesn't work. . This will come up for every note transformer that wants to know the pitch. -}