-- 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 TypeSynonymInstances #-} -- | Extract things from the PassedArgs data structure. module Derive.Args where import qualified Data.Map as Map import qualified Util.Log as Log import qualified Util.Seq as Seq import qualified Derive.Derive as Derive import Derive.Derive (Context, PassedArgs) import qualified Derive.Deriver.Internal as Internal import qualified Derive.EnvKey as EnvKey import qualified Derive.Eval as Eval import qualified Derive.PSignal as PSignal import qualified Derive.Parse as Parse import qualified Derive.Pitches as Pitches import qualified Derive.Score as Score import qualified Derive.Stream as Stream import qualified Perform.Pitch as Pitch import qualified Perform.RealTime as RealTime import qualified Perform.Signal as Signal import qualified Ui.Event as Event import qualified Ui.Events as Events import qualified Ui.Track as Track import qualified Ui.Types as Types import Global import Types context :: PassedArgs a -> Context a context :: forall a. PassedArgs a -> Context a context = PassedArgs a -> Context a forall a. PassedArgs a -> Context a Derive.passed_ctx event :: PassedArgs a -> Event.Event event :: forall a. PassedArgs a -> Event event = Context a -> Event forall val. Context val -> Event Derive.ctx_event (Context a -> Event) -> (PassedArgs a -> Context a) -> PassedArgs a -> Event forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Context a forall a. PassedArgs a -> Context a context orientation :: PassedArgs a -> Types.Orientation orientation :: forall a. PassedArgs a -> Orientation orientation = Event -> Orientation Event.orientation (Event -> Orientation) -> (PassedArgs a -> Event) -> PassedArgs a -> Orientation forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Event forall a. PassedArgs a -> Event event negative :: PassedArgs a -> Bool negative :: forall a. PassedArgs a -> Bool negative = (Orientation -> Orientation -> Bool forall a. Eq a => a -> a -> Bool ==Orientation Types.Negative) (Orientation -> Bool) -> (PassedArgs a -> Orientation) -> PassedArgs a -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Orientation forall a. PassedArgs a -> Orientation orientation -- * prev and next {- NOTE [previous-pitch] There are many ways to get the previous pitch: 'prev_pitch' - The simplest, it uses 'Derive.ctx_prev_val', so it only works when you are in a pitch track, and only gets the immediately previous pitch. A special hack should make it work even if the pitch track is inverted and the previous pitch is in a different slice. 'prev_event_pitch' - This is like 'prev_pitch', except that it works at the note track level. It gets the entire previous event and picks out the last pitch it played. 'lookup_prev_pitch' - This uses 'Derive.state_note_track', which means that it should work even in an inversion under a note track. 'lookup_prev_logical_pitch' - This is actually an entirely different mechanism than the others. Documented in 'Derive.NotePitchQuery'. Clearly this is too many. Probably I can come up with a way to combine the first three. -} -- ** from 'Derive.ctx_prev_val' prev_control :: Derive.ControlArgs -> Maybe (RealTime, Signal.Y) prev_control :: ControlArgs -> Maybe (RealTime, Y) prev_control = Signal ControlSig -> Maybe (RealTime, Y) forall {k} (kind :: k). Signal kind -> Maybe (RealTime, Y) Signal.last (Signal ControlSig -> Maybe (RealTime, Y)) -> (ControlArgs -> Maybe (Signal ControlSig)) -> ControlArgs -> Maybe (RealTime, Y) forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< ControlArgs -> Maybe (Signal ControlSig) forall a. PassedArgs a -> Maybe a prev_val prev_pitch :: Derive.PitchArgs -> Maybe (RealTime, PSignal.Pitch) prev_pitch :: PitchArgs -> Maybe (RealTime, Pitch) prev_pitch = PSignal -> Maybe (RealTime, Pitch) PSignal.last (PSignal -> Maybe (RealTime, Pitch)) -> (PitchArgs -> Maybe PSignal) -> PitchArgs -> Maybe (RealTime, Pitch) forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< PitchArgs -> Maybe PSignal forall a. PassedArgs a -> Maybe a prev_val prev_event :: Derive.NoteArgs -> Maybe Score.Event prev_event :: NoteArgs -> Maybe Event prev_event = NoteArgs -> Maybe Event forall a. PassedArgs a -> Maybe a prev_val prev_event_pitch :: PassedArgs Score.Event -> Maybe PSignal.Pitch prev_event_pitch :: NoteArgs -> Maybe Pitch prev_event_pitch NoteArgs args = ((RealTime, Pitch) -> Pitch) -> Maybe (RealTime, Pitch) -> Maybe Pitch forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap (RealTime, Pitch) -> Pitch forall a b. (a, b) -> b snd (Maybe (RealTime, Pitch) -> Maybe Pitch) -> (Event -> Maybe (RealTime, Pitch)) -> Event -> Maybe Pitch forall b c a. (b -> c) -> (a -> b) -> a -> c . PSignal -> Maybe (RealTime, Pitch) PSignal.last (PSignal -> Maybe (RealTime, Pitch)) -> (Event -> PSignal) -> Event -> Maybe (RealTime, Pitch) forall b c a. (b -> c) -> (a -> b) -> a -> c . Event -> PSignal Score.event_pitch (Event -> Maybe Pitch) -> Maybe Event -> Maybe Pitch forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< NoteArgs -> Maybe Event forall a. PassedArgs a -> Maybe a prev_val NoteArgs args -- | Polymorphic version of 'prev_control' or 'prev_pitch'. prev_val_end :: Derive.Taggable a => PassedArgs a -> Maybe RealTime prev_val_end :: forall a. Taggable a => PassedArgs a -> Maybe RealTime prev_val_end = a -> Maybe RealTime forall {a}. Taggable a => a -> Maybe RealTime extract (a -> Maybe RealTime) -> (PassedArgs a -> Maybe a) -> PassedArgs a -> Maybe RealTime forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< PassedArgs a -> Maybe a forall a. PassedArgs a -> Maybe a prev_val where extract :: a -> Maybe RealTime extract a val = case a -> Tagged forall a. Taggable a => a -> Tagged Derive.to_tagged a val of Derive.TagEvent Event event -> RealTime -> Maybe RealTime forall a. a -> Maybe a Just (RealTime -> Maybe RealTime) -> RealTime -> Maybe RealTime forall a b. (a -> b) -> a -> b $ Event -> RealTime Score.event_end Event event Derive.TagControl Signal ControlSig sig -> (RealTime, Y) -> RealTime forall a b. (a, b) -> a fst ((RealTime, Y) -> RealTime) -> Maybe (RealTime, Y) -> Maybe RealTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Signal ControlSig -> Maybe (RealTime, Y) forall {k} (kind :: k). Signal kind -> Maybe (RealTime, Y) Signal.last Signal ControlSig sig Derive.TagPitch PSignal sig -> (RealTime, Pitch) -> RealTime forall a b. (a, b) -> a fst ((RealTime, Pitch) -> RealTime) -> Maybe (RealTime, Pitch) -> Maybe RealTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> PSignal -> Maybe (RealTime, Pitch) PSignal.last PSignal sig -- | Get the previous val. See NOTE [prev-val]. prev_val :: PassedArgs a -> Maybe a prev_val :: forall a. PassedArgs a -> Maybe a prev_val = Context a -> Maybe a forall val. Context val -> Maybe val Derive.ctx_prev_val (Context a -> Maybe a) -> (PassedArgs a -> Context a) -> PassedArgs a -> Maybe a forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Context a forall a. PassedArgs a -> Context a context -- ** from 'Derive.state_prev_val' -- TODO do I really need so many ways to get the previous pitch? -- prev_note_pitch :: Derive.Deriver (Maybe (RealTime, PSignal.Pitch)) -- prev_note_pitch = do -- prev <- prev_note -- return $ PSignal.last . Score.event_pitch =<< prev prev_note_pitch :: RealTime -> Derive.Deriver (Maybe PSignal.Pitch) prev_note_pitch :: RealTime -> Deriver (Maybe Pitch) prev_note_pitch RealTime start = Deriver State Error (Maybe Event) -> (Event -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall (m :: * -> *) a b. Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b) justm Deriver State Error (Maybe Event) prev_note ((Event -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch)) -> (Event -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall a b. (a -> b) -> a -> b $ Maybe Pitch -> Deriver (Maybe Pitch) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Pitch -> Deriver (Maybe Pitch)) -> (Event -> Maybe Pitch) -> Event -> Deriver (Maybe Pitch) forall b c a. (b -> c) -> (a -> b) -> a -> c . RealTime -> PSignal -> Maybe Pitch PSignal.at_negative RealTime start (PSignal -> Maybe Pitch) -> (Event -> PSignal) -> Event -> Maybe Pitch forall b c a. (b -> c) -> (a -> b) -> a -> c . Event -> PSignal Score.event_pitch -- | Get the previous note. Unlike 'prev_val', this always gets the previous -- Score.Event, even if you're evaluating a control track under the note track. -- -- TODO it doesn't really belong here since it doesn't use PassedArgs, but -- this is where I would look for a function for the previous value. prev_note :: Derive.Deriver (Maybe Score.Event) prev_note :: Deriver State Error (Maybe Event) prev_note = do -- TODO this happens if you're not inverting, but that should be ok, right? (BlockId, TrackId) addr <- Text -> Maybe (BlockId, TrackId) -> Deriver (BlockId, TrackId) forall a. HasCallStack => Text -> Maybe a -> Deriver a Derive.require Text "lookup_prev_note: no state_note_track" (Maybe (BlockId, TrackId) -> Deriver (BlockId, TrackId)) -> Deriver State Error (Maybe (BlockId, TrackId)) -> Deriver (BlockId, TrackId) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< (State -> Maybe (BlockId, TrackId)) -> Deriver State Error (Maybe (BlockId, TrackId)) forall st a err. (st -> a) -> Deriver st err a Derive.gets (Dynamic -> Maybe (BlockId, TrackId) Derive.state_note_track (Dynamic -> Maybe (BlockId, TrackId)) -> (State -> Dynamic) -> State -> Maybe (BlockId, TrackId) forall b c a. (b -> c) -> (a -> b) -> a -> c . State -> Dynamic Derive.state_dynamic) (State -> Maybe Event) -> Deriver State Error (Maybe Event) forall st a err. (st -> a) -> Deriver st err a Derive.gets ((State -> Maybe Event) -> Deriver State Error (Maybe Event)) -> (State -> Maybe Event) -> Deriver State Error (Maybe Event) forall a b. (a -> b) -> a -> b $ Tagged -> Maybe Event forall a. Taggable a => Tagged -> Maybe a Derive.from_tagged (Tagged -> Maybe Event) -> (State -> Maybe Tagged) -> State -> Maybe Event forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< (BlockId, TrackId) -> Map (BlockId, TrackId) Tagged -> Maybe Tagged forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup (BlockId, TrackId) addr (Map (BlockId, TrackId) Tagged -> Maybe Tagged) -> (State -> Map (BlockId, TrackId) Tagged) -> State -> Maybe Tagged forall b c a. (b -> c) -> (a -> b) -> a -> c . Threaded -> Map (BlockId, TrackId) Tagged Derive.state_prev_val (Threaded -> Map (BlockId, TrackId) Tagged) -> (State -> Threaded) -> State -> Map (BlockId, TrackId) Tagged forall b c a. (b -> c) -> (a -> b) -> a -> c . State -> Threaded Derive.state_threaded -- ** 'Derive.state_pitch_map' -- | Pitch at the time of the next event in this track. lookup_next_pitch :: PassedArgs a -> Derive.Deriver (Maybe PSignal.Pitch) lookup_next_pitch :: forall a. PassedArgs a -> Deriver (Maybe Pitch) lookup_next_pitch = Deriver (Maybe Pitch) -> (TrackTime -> Deriver (Maybe Pitch)) -> Maybe TrackTime -> Deriver (Maybe Pitch) forall b a. b -> (a -> b) -> Maybe a -> b maybe (Maybe Pitch -> Deriver (Maybe Pitch) forall (m :: * -> *) a. Monad m => a -> m a return Maybe Pitch forall a. Maybe a Nothing) TrackTime -> Deriver (Maybe Pitch) lookup_pitch_at (Maybe TrackTime -> Deriver (Maybe Pitch)) -> (PassedArgs a -> Maybe TrackTime) -> PassedArgs a -> Deriver (Maybe Pitch) forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Maybe TrackTime forall a. PassedArgs a -> Maybe TrackTime next_start lookup_prev_pitch :: PassedArgs a -> Derive.Deriver (Maybe PSignal.Pitch) lookup_prev_pitch :: forall a. PassedArgs a -> Deriver (Maybe Pitch) lookup_prev_pitch = Deriver (Maybe Pitch) -> (TrackTime -> Deriver (Maybe Pitch)) -> Maybe TrackTime -> Deriver (Maybe Pitch) forall b a. b -> (a -> b) -> Maybe a -> b maybe (Maybe Pitch -> Deriver (Maybe Pitch) forall (m :: * -> *) a. Monad m => a -> m a return Maybe Pitch forall a. Maybe a Nothing) TrackTime -> Deriver (Maybe Pitch) lookup_pitch_at (Maybe TrackTime -> Deriver (Maybe Pitch)) -> (PassedArgs a -> Maybe TrackTime) -> PassedArgs a -> Deriver (Maybe Pitch) forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Maybe TrackTime forall a. PassedArgs a -> Maybe TrackTime prev_start -- | Pitch at the time of the next note event of this track's -- 'Derive.state_note_track'. lookup_next_note_pitch :: ScoreTime -> Derive.Deriver (Maybe PSignal.Pitch) lookup_next_note_pitch :: TrackTime -> Deriver (Maybe Pitch) lookup_next_note_pitch TrackTime start = Deriver State Error (Maybe Event) -> (Event -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall (m :: * -> *) a b. Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b) justm (TrackTime -> Events -> Maybe Event note_after TrackTime start (Events -> Maybe Event) -> Deriver State Error Events -> Deriver State Error (Maybe Event) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Deriver State Error Events get_note_events) ((Event -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch)) -> (Event -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall a b. (a -> b) -> a -> b $ TrackTime -> Deriver (Maybe Pitch) lookup_pitch_at (TrackTime -> Deriver (Maybe Pitch)) -> (Event -> TrackTime) -> Event -> Deriver (Maybe Pitch) forall b c a. (b -> c) -> (a -> b) -> a -> c . Event -> TrackTime Event.start lookup_prev_note_pitch :: ScoreTime -> Derive.Deriver (Maybe PSignal.Pitch) lookup_prev_note_pitch :: TrackTime -> Deriver (Maybe Pitch) lookup_prev_note_pitch TrackTime start = Deriver State Error (Maybe Event) -> (Event -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall (m :: * -> *) a b. Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b) justm (TrackTime -> Events -> Maybe Event note_before TrackTime start (Events -> Maybe Event) -> Deriver State Error Events -> Deriver State Error (Maybe Event) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Deriver State Error Events get_note_events) ((Event -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch)) -> (Event -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall a b. (a -> b) -> a -> b $ TrackTime -> Deriver (Maybe Pitch) lookup_pitch_at (TrackTime -> Deriver (Maybe Pitch)) -> (Event -> TrackTime) -> Event -> Deriver (Maybe Pitch) forall b c a. (b -> c) -> (a -> b) -> a -> c . Event -> TrackTime Event.start note_before :: TrackTime -> Events.Events -> Maybe Event.Event note_before :: TrackTime -> Events -> Maybe Event note_before TrackTime p = Events -> Maybe Event Events.last (Events -> Maybe Event) -> (Events -> Events) -> Events -> Maybe Event forall b c a. (b -> c) -> (a -> b) -> a -> c . (Events, Events) -> Events forall a b. (a, b) -> a fst ((Events, Events) -> Events) -> (Events -> (Events, Events)) -> Events -> Events forall b c a. (b -> c) -> (a -> b) -> a -> c . TrackTime -> Events -> (Events, Events) Events.split_exclude TrackTime p note_after :: TrackTime -> Events.Events -> Maybe Event.Event note_after :: TrackTime -> Events -> Maybe Event note_after TrackTime p = Events -> Maybe Event Events.head (Events -> Maybe Event) -> (Events -> Events) -> Events -> Maybe Event forall b c a. (b -> c) -> (a -> b) -> a -> c . (Events, Events) -> Events forall a b. (a, b) -> b snd ((Events, Events) -> Events) -> (Events -> (Events, Events)) -> Events -> Events forall b c a. (b -> c) -> (a -> b) -> a -> c . TrackTime -> Events -> (Events, Events) Events.split_exclude TrackTime p get_note_events :: Derive.Deriver Events.Events get_note_events :: Deriver State Error Events get_note_events = do -- TODO this happens if you're not inverting, is that ok? (BlockId _, TrackId track_id) <- Text -> Maybe (BlockId, TrackId) -> Deriver (BlockId, TrackId) forall a. HasCallStack => Text -> Maybe a -> Deriver a Derive.require Text "no state_note_track" (Maybe (BlockId, TrackId) -> Deriver (BlockId, TrackId)) -> Deriver State Error (Maybe (BlockId, TrackId)) -> Deriver (BlockId, TrackId) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< (State -> Maybe (BlockId, TrackId)) -> Deriver State Error (Maybe (BlockId, TrackId)) forall st a err. (st -> a) -> Deriver st err a Derive.gets (Dynamic -> Maybe (BlockId, TrackId) Derive.state_note_track (Dynamic -> Maybe (BlockId, TrackId)) -> (State -> Dynamic) -> State -> Maybe (BlockId, TrackId) forall b c a. (b -> c) -> (a -> b) -> a -> c . State -> Dynamic Derive.state_dynamic) Track -> Events Track.track_events (Track -> Events) -> Deriver State Error Track -> Deriver State Error Events forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TrackId -> Deriver State Error Track Derive.get_track TrackId track_id -- | Get a logical pitch at the given time, via 'Derive.state_pitch_map'. -- As documented by 'Derive.state_pitch_map', the pitch map is unset while -- evaluating the pitch map, so pitch calls that use this shouldn't be -- surprised if it's Nothing. lookup_pitch_at :: TrackTime -> Derive.Deriver (Maybe PSignal.Pitch) lookup_pitch_at :: TrackTime -> Deriver (Maybe Pitch) lookup_pitch_at TrackTime pos = Deriver State Error (Maybe (Maybe PSignal, [Msg])) -> ((Maybe PSignal, [Msg]) -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall (m :: * -> *) a b. Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b) justm ((Dynamic -> Maybe (Maybe PSignal, [Msg])) -> Deriver State Error (Maybe (Maybe PSignal, [Msg])) forall a. (Dynamic -> a) -> Deriver a Internal.get_dynamic Dynamic -> Maybe (Maybe PSignal, [Msg]) Derive.state_pitch_map) (((Maybe PSignal, [Msg]) -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch)) -> ((Maybe PSignal, [Msg]) -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall a b. (a -> b) -> a -> b $ \(Maybe PSignal maybe_sig, [Msg] logs) -> do (Msg -> Deriver State Error ()) -> [Msg] -> Deriver State Error () forall (t :: * -> *) (m :: * -> *) a b. (Foldable t, Monad m) => (a -> m b) -> t a -> m () mapM_ (Msg -> Deriver State Error () forall (m :: * -> *). LogMonad m => Msg -> m () Log.write (Msg -> Deriver State Error ()) -> (Msg -> Msg) -> Msg -> Deriver State Error () forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Msg -> Msg Log.add_prefix (Text "lookup_pitch_at " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> TrackTime -> Text forall a. Pretty a => a -> Text pretty TrackTime pos)) ([Msg] -> Deriver State Error ()) -> [Msg] -> Deriver State Error () forall a b. (a -> b) -> a -> b $ (Msg -> Bool) -> [Msg] -> [Msg] forall a. (a -> Bool) -> [a] -> [a] filter ((Priority -> Priority -> Bool forall a. Ord a => a -> a -> Bool >=Priority Log.Warn) (Priority -> Bool) -> (Msg -> Priority) -> Msg -> Bool forall b c a. (b -> c) -> (a -> b) -> a -> c . Msg -> Priority Log.msg_priority) [Msg] logs -- PSignal is actually in TrackTime, see 'Derive.state_pitch_map'. Maybe Pitch -> Deriver (Maybe Pitch) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Pitch -> Deriver (Maybe Pitch)) -> Maybe Pitch -> Deriver (Maybe Pitch) forall a b. (a -> b) -> a -> b $ RealTime -> PSignal -> Maybe Pitch PSignal.at (TrackTime -> RealTime RealTime.from_score TrackTime pos) (PSignal -> Maybe Pitch) -> Maybe PSignal -> Maybe Pitch forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Maybe PSignal maybe_sig -- | Like 'lookup_pitch_at', except for parsed pitches. Normally you'd pass -- 'Derive.Call.get_pitch_functions' to make a 'Pitch.Pitch'. lookup_parsed_pitch_at :: (Pitch.Note -> Maybe a) -> TrackTime -> Derive.Deriver (Maybe a) lookup_parsed_pitch_at :: forall a. (Note -> Maybe a) -> TrackTime -> Deriver (Maybe a) lookup_parsed_pitch_at Note -> Maybe a parse_pitch TrackTime pos = Deriver (Maybe Pitch) -> (Pitch -> Deriver State Error (Maybe a)) -> Deriver State Error (Maybe a) forall (m :: * -> *) a b. Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b) justm (TrackTime -> Deriver (Maybe Pitch) lookup_pitch_at TrackTime pos) ((Pitch -> Deriver State Error (Maybe a)) -> Deriver State Error (Maybe a)) -> (Pitch -> Deriver State Error (Maybe a)) -> Deriver State Error (Maybe a) forall a b. (a -> b) -> a -> b $ \Pitch pitch -> do RealTime rpos <- TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real TrackTime pos -- TODO transposes may be out of sync because state_pitch_map is in -- TrackTime. Note note <- Transposed -> Deriver Note Pitches.pitch_note (Transposed -> Deriver Note) -> Deriver State Error Transposed -> Deriver Note forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< RealTime -> Pitch -> Deriver State Error Transposed Derive.resolve_pitch RealTime rpos Pitch pitch a -> Maybe a forall a. a -> Maybe a Just (a -> Maybe a) -> Deriver State Error a -> Deriver State Error (Maybe a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Text -> Maybe a -> Deriver State Error a forall a. HasCallStack => Text -> Maybe a -> Deriver a Derive.require Text "unparseable pitch" (Note -> Maybe a parse_pitch Note note) -- ** eval -- | Unused, but might be used again if I need to evaluate the next event. eval :: Derive.CallableExpr d => Context x -> Event.Event -> [Event.Event] -> Derive.Deriver (Stream.Stream d) eval :: forall d x. CallableExpr d => Context x -> Event -> [Event] -> Deriver (Stream d) eval Context x ctx Event event [Event] prev = case Text -> Either Text Expr Parse.parse_expr (Event -> Text Event.text Event event) of Left Text err -> Text -> Deriver (Stream d) forall a. HasCallStack => Text -> Deriver a Derive.throw (Text -> Deriver (Stream d)) -> Text -> Deriver (Stream d) forall a b. (a -> b) -> a -> b $ Text "parse error: " Text -> Text -> Text forall a. Semigroup a => a -> a -> a <> Text err Right Expr expr -> Bool -> Context d -> Expr -> Deriver (Stream d) forall d. CallableExpr d => Bool -> Context d -> Expr -> Deriver (Stream d) Eval.eval_expr Bool False Context d forall {val}. Context val prev_ctx Expr expr where prev_ctx :: Context val prev_ctx = Context x ctx { ctx_prev_val :: Maybe val Derive.ctx_prev_val = Maybe val forall a. Maybe a Nothing , ctx_event :: Event Derive.ctx_event = Event event , ctx_prev_events :: [Event] Derive.ctx_prev_events = [Event] prev , ctx_next_events :: [Event] Derive.ctx_next_events = Context x -> Event forall val. Context val -> Event Derive.ctx_event Context x ctx Event -> [Event] -> [Event] forall a. a -> [a] -> [a] : Context x -> [Event] forall val. Context val -> [Event] Derive.ctx_next_events Context x ctx , ctx_event_end :: TrackTime Derive.ctx_event_end = Event -> TrackTime Event.start (Event -> TrackTime) -> Event -> TrackTime forall a b. (a -> b) -> a -> b $ Context x -> Event forall val. Context val -> Event Derive.ctx_event Context x ctx } -- | Get the pitch at the time of the next event, when evaluating a pitch -- track. Since the pitch hasn't been evaluated yet, it has to be evaluated -- here. So if it depends on the previous pitch, you won't get a pitch back. -- -- Actually, the pitch likely *has* been evaluated, I just can't get at it -- here. If it's uninverted then I have the whole pitch track, and if it's -- inverted then the event at or after the end of the event will be included. -- But 'Derive.Control.trim_signal' will clip that sample off to avoid -- a spurious pitch change at the end of the note. eval_next_pitch :: Derive.PitchArgs -> Derive.Deriver (Maybe PSignal.Pitch) eval_next_pitch :: PitchArgs -> Deriver (Maybe Pitch) eval_next_pitch = Deriver (Maybe Pitch) -> (Event -> Deriver (Maybe Pitch)) -> Maybe Event -> Deriver (Maybe Pitch) forall b a. b -> (a -> b) -> Maybe a -> b maybe (Maybe Pitch -> Deriver (Maybe Pitch) forall (m :: * -> *) a. Monad m => a -> m a return Maybe Pitch forall a. Maybe a Nothing) Event -> Deriver (Maybe Pitch) eval_pitch (Maybe Event -> Deriver (Maybe Pitch)) -> (PitchArgs -> Maybe Event) -> PitchArgs -> Deriver (Maybe Pitch) forall b c a. (b -> c) -> (a -> b) -> a -> c . [Event] -> Maybe Event forall a. [a] -> Maybe a Seq.head ([Event] -> Maybe Event) -> (PitchArgs -> [Event]) -> PitchArgs -> Maybe Event forall b c a. (b -> c) -> (a -> b) -> a -> c . PitchArgs -> [Event] forall a. PassedArgs a -> [Event] next_events eval_pitch :: Event.Event -> Derive.Deriver (Maybe PSignal.Pitch) eval_pitch :: Event -> Deriver (Maybe Pitch) eval_pitch Event event = Deriver State Error (Maybe (Stream PSignal)) -> (Stream PSignal -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall (m :: * -> *) a b. Monad m => m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b) justm (Either Text (Stream PSignal) -> Maybe (Stream PSignal) forall {a} {a}. Either a a -> Maybe a to_maybe (Either Text (Stream PSignal) -> Maybe (Stream PSignal)) -> Deriver State Error (Either Text (Stream PSignal)) -> Deriver State Error (Maybe (Stream PSignal)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Event -> Deriver State Error (Either Text (Stream PSignal)) forall d. CallableExpr d => Event -> Deriver (Either Text (Stream d)) Eval.eval_event Event event) ((Stream PSignal -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch)) -> (Stream PSignal -> Deriver (Maybe Pitch)) -> Deriver (Maybe Pitch) forall a b. (a -> b) -> a -> b $ \Stream PSignal stream -> do RealTime start <- TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real (Event -> TrackTime Event.start Event event) Maybe Pitch -> Deriver (Maybe Pitch) forall (m :: * -> *) a. Monad m => a -> m a return (Maybe Pitch -> Deriver (Maybe Pitch)) -> Maybe Pitch -> Deriver (Maybe Pitch) forall a b. (a -> b) -> a -> b $ RealTime -> PSignal -> Maybe Pitch PSignal.at RealTime start (PSignal -> Maybe Pitch) -> PSignal -> Maybe Pitch forall a b. (a -> b) -> a -> b $ [PSignal] -> PSignal forall a. Monoid a => [a] -> a mconcat ([PSignal] -> PSignal) -> [PSignal] -> PSignal forall a b. (a -> b) -> a -> b $ Stream PSignal -> [PSignal] forall a. Stream a -> [a] Stream.events_of Stream PSignal stream where to_maybe :: Either a a -> Maybe a to_maybe = (a -> Maybe a) -> (a -> Maybe a) -> Either a a -> Maybe a forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (Maybe a -> a -> Maybe a forall a b. a -> b -> a const Maybe a forall a. Maybe a Nothing) a -> Maybe a forall a. a -> Maybe a Just -- * event timing start :: PassedArgs a -> TrackTime start :: forall a. PassedArgs a -> TrackTime start = Event -> TrackTime Event.start (Event -> TrackTime) -> (PassedArgs a -> Event) -> PassedArgs a -> TrackTime forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Event forall a. PassedArgs a -> Event event duration :: PassedArgs a -> TrackTime duration :: forall a. PassedArgs a -> TrackTime duration = Event -> TrackTime Event.duration (Event -> TrackTime) -> (PassedArgs a -> Event) -> PassedArgs a -> TrackTime forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Event forall a. PassedArgs a -> Event event real_duration :: PassedArgs a -> Derive.Deriver RealTime real_duration :: forall a. PassedArgs a -> Deriver RealTime real_duration PassedArgs a args = (-) (RealTime -> RealTime -> RealTime) -> Deriver RealTime -> Deriver State Error (RealTime -> RealTime) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> PassedArgs a -> Deriver RealTime forall a. PassedArgs a -> Deriver RealTime real_end PassedArgs a args Deriver State Error (RealTime -> RealTime) -> Deriver RealTime -> Deriver RealTime forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> PassedArgs a -> Deriver RealTime forall a. PassedArgs a -> Deriver RealTime real_start PassedArgs a args real_start :: PassedArgs a -> Derive.Deriver RealTime real_start :: forall a. PassedArgs a -> Deriver RealTime real_start = TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real (TrackTime -> Deriver RealTime) -> (PassedArgs a -> TrackTime) -> PassedArgs a -> Deriver RealTime forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> TrackTime forall a. PassedArgs a -> TrackTime start end :: PassedArgs a -> TrackTime end :: forall a. PassedArgs a -> TrackTime end = Event -> TrackTime Event.end (Event -> TrackTime) -> (PassedArgs a -> Event) -> PassedArgs a -> TrackTime forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Event forall a. PassedArgs a -> Event event real_end :: PassedArgs a -> Derive.Deriver RealTime real_end :: forall a. PassedArgs a -> Deriver RealTime real_end = TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real (TrackTime -> Deriver RealTime) -> (PassedArgs a -> TrackTime) -> PassedArgs a -> Deriver RealTime forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> TrackTime forall a. PassedArgs a -> TrackTime end -- | The start of the next event, or the end of the block if there is no next -- event. -- -- Used by calls to determine their extent, especially control calls, which -- have no explicit duration. next :: PassedArgs a -> TrackTime next :: forall a. PassedArgs a -> TrackTime next = Context a -> TrackTime forall val. Context val -> TrackTime Derive.ctx_event_end (Context a -> TrackTime) -> (PassedArgs a -> Context a) -> PassedArgs a -> TrackTime forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Context a forall a. PassedArgs a -> Context a context -- | End of the next event, or the end of the block if there is no next event. next_end :: PassedArgs a -> TrackTime next_end :: forall a. PassedArgs a -> TrackTime next_end PassedArgs a args = TrackTime -> (Event -> TrackTime) -> Maybe Event -> TrackTime forall b a. b -> (a -> b) -> Maybe a -> b maybe (PassedArgs a -> TrackTime forall a. PassedArgs a -> TrackTime next PassedArgs a args) Event -> TrackTime Event.end ([Event] -> Maybe Event forall a. [a] -> Maybe a Seq.head (PassedArgs a -> [Event] forall a. PassedArgs a -> [Event] next_events PassedArgs a args)) -- | Get the start of the next event, if there is one. -- -- This is similar to 'next', except that it will be Nothing at the end of -- the block. next_start :: PassedArgs a -> Maybe TrackTime next_start :: forall a. PassedArgs a -> Maybe TrackTime next_start = (Event -> TrackTime) -> Maybe Event -> Maybe TrackTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Event -> TrackTime Event.start (Maybe Event -> Maybe TrackTime) -> (PassedArgs a -> Maybe Event) -> PassedArgs a -> Maybe TrackTime forall b c a. (b -> c) -> (a -> b) -> a -> c . [Event] -> Maybe Event forall a. [a] -> Maybe a Seq.head ([Event] -> Maybe Event) -> (PassedArgs a -> [Event]) -> PassedArgs a -> Maybe Event forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> [Event] forall a. PassedArgs a -> [Event] next_events -- | Start time of the previous event. prev_start :: PassedArgs a -> Maybe TrackTime prev_start :: forall a. PassedArgs a -> Maybe TrackTime prev_start = (Event -> TrackTime) -> Maybe Event -> Maybe TrackTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Event -> TrackTime Event.start (Maybe Event -> Maybe TrackTime) -> (PassedArgs a -> Maybe Event) -> PassedArgs a -> Maybe TrackTime forall b c a. (b -> c) -> (a -> b) -> a -> c . [Event] -> Maybe Event forall a. [a] -> Maybe a Seq.head ([Event] -> Maybe Event) -> (PassedArgs a -> [Event]) -> PassedArgs a -> Maybe Event forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> [Event] forall a. PassedArgs a -> [Event] prev_events -- | End time of the previous event. prev_end :: PassedArgs a -> Maybe TrackTime prev_end :: forall a. PassedArgs a -> Maybe TrackTime prev_end = (Event -> TrackTime) -> Maybe Event -> Maybe TrackTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap Event -> TrackTime Event.end (Maybe Event -> Maybe TrackTime) -> (PassedArgs a -> Maybe Event) -> PassedArgs a -> Maybe TrackTime forall b c a. (b -> c) -> (a -> b) -> a -> c . [Event] -> Maybe Event forall a. [a] -> Maybe a Seq.head ([Event] -> Maybe Event) -> (PassedArgs a -> [Event]) -> PassedArgs a -> Maybe Event forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> [Event] forall a. PassedArgs a -> [Event] prev_events prev_events, next_events :: PassedArgs a -> [Event.Event] next_events :: forall a. PassedArgs a -> [Event] next_events = Context a -> [Event] forall val. Context val -> [Event] Derive.ctx_next_events (Context a -> [Event]) -> (PassedArgs a -> Context a) -> PassedArgs a -> [Event] forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Context a forall a. PassedArgs a -> Context a context prev_events :: forall a. PassedArgs a -> [Event] prev_events = Context a -> [Event] forall val. Context val -> [Event] Derive.ctx_prev_events (Context a -> [Event]) -> (PassedArgs a -> Context a) -> PassedArgs a -> [Event] forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Context a forall a. PassedArgs a -> Context a context -- ** modify -- | Modify the duration of the ctx_event. This is a hack, because calls run -- in TrackTime, instead of using Derive.place. set_duration :: TrackTime -> PassedArgs a -> PassedArgs a set_duration :: forall a. TrackTime -> PassedArgs a -> PassedArgs a set_duration TrackTime dur PassedArgs a args = PassedArgs a args { passed_ctx :: Context a Derive.passed_ctx = Context a ctx { ctx_event :: Event Derive.ctx_event = Lens Event TrackTime Event.duration_ Lens Event TrackTime -> TrackTime -> Event -> Event forall f a. Lens f a -> a -> f -> f #= TrackTime dur (Event -> Event) -> Event -> Event forall a b. (a -> b) -> a -> b $ Context a -> Event forall val. Context val -> Event Derive.ctx_event Context a ctx } } where ctx :: Context a ctx = PassedArgs a -> Context a forall a. PassedArgs a -> Context a Derive.passed_ctx PassedArgs a args -- ** range -- | Range of the called event, i.e. (min, max). Note that range is the -- minimum to maximum, which is not the same as the start and end if the event -- has negative duration. range :: PassedArgs a -> (TrackTime, TrackTime) range :: forall a. PassedArgs a -> (TrackTime, TrackTime) range = Event -> (TrackTime, TrackTime) Event.range (Event -> (TrackTime, TrackTime)) -> (PassedArgs a -> Event) -> PassedArgs a -> (TrackTime, TrackTime) forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Event forall a. PassedArgs a -> Event event real_range :: PassedArgs a -> Derive.Deriver (RealTime, RealTime) real_range :: forall a. PassedArgs a -> Deriver (RealTime, RealTime) real_range PassedArgs a args = (,) (RealTime -> RealTime -> (RealTime, RealTime)) -> Deriver RealTime -> Deriver State Error (RealTime -> (RealTime, RealTime)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real TrackTime start Deriver State Error (RealTime -> (RealTime, RealTime)) -> Deriver RealTime -> Deriver (RealTime, RealTime) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real TrackTime end where (TrackTime start, TrackTime end) = PassedArgs a -> (TrackTime, TrackTime) forall a. PassedArgs a -> (TrackTime, TrackTime) range PassedArgs a args -- | Like 'range', but if the duration is 0, then the end is 'next' event. range_or_next :: PassedArgs a -> (TrackTime, TrackTime) range_or_next :: forall a. PassedArgs a -> (TrackTime, TrackTime) range_or_next PassedArgs a args | TrackTime start TrackTime -> TrackTime -> Bool forall a. Eq a => a -> a -> Bool == TrackTime end = (TrackTime start, PassedArgs a -> TrackTime forall a. PassedArgs a -> TrackTime next PassedArgs a args) | Bool otherwise = (TrackTime start, TrackTime end) where (TrackTime start, TrackTime end) = PassedArgs a -> (TrackTime, TrackTime) forall a. PassedArgs a -> (TrackTime, TrackTime) range PassedArgs a args real_range_or_next :: PassedArgs a -> Derive.Deriver (RealTime, RealTime) real_range_or_next :: forall a. PassedArgs a -> Deriver (RealTime, RealTime) real_range_or_next PassedArgs a args = (,) (RealTime -> RealTime -> (RealTime, RealTime)) -> Deriver RealTime -> Deriver State Error (RealTime -> (RealTime, RealTime)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real TrackTime start Deriver State Error (RealTime -> (RealTime, RealTime)) -> Deriver RealTime -> Deriver (RealTime, RealTime) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real TrackTime end where (TrackTime start, TrackTime end) = PassedArgs a -> (TrackTime, TrackTime) forall a. PassedArgs a -> (TrackTime, TrackTime) range_or_next PassedArgs a args -- | The current event's start and end times. -- -- If the event has a duration, then use that. Otherwise, if there is -- a 'EnvKey.note_end', return that. Otherwise, return 'next'. However, if -- there's an 'EnvKey.note_start' and it's past the event start, then this -- event isn't contained within the range of its parent note, which means that -- its expected note end has also passed. In that case, it returns -- (note_start, note_start), which should cause the call to just emit its final -- sample at the note-start, which will both get the correct value for the -- event and not destroy the earlier track signal fragment. range_or_note_end :: PassedArgs a -> Derive.Deriver (TrackTime, TrackTime) range_or_note_end :: forall a. PassedArgs a -> Deriver (TrackTime, TrackTime) range_or_note_end PassedArgs a args | TrackTime start TrackTime -> TrackTime -> Bool forall a. Eq a => a -> a -> Bool == TrackTime end = do Maybe TrackTime note_start <- Text -> Deriver (Maybe TrackTime) forall a. Typecheck a => Text -> Deriver (Maybe a) Derive.lookup_val Text EnvKey.note_start Maybe TrackTime note_end <- Text -> Deriver (Maybe TrackTime) forall a. Typecheck a => Text -> Deriver (Maybe a) Derive.lookup_val Text EnvKey.note_end case (Maybe TrackTime note_start, Maybe TrackTime note_end) of (Just TrackTime note_start, Just TrackTime note_end) | TrackTime start TrackTime -> TrackTime -> Bool forall a. Ord a => a -> a -> Bool < TrackTime note_start -> (TrackTime, TrackTime) -> Deriver (TrackTime, TrackTime) forall (m :: * -> *) a. Monad m => a -> m a return (TrackTime note_start, TrackTime note_start) | Bool otherwise -> (TrackTime, TrackTime) -> Deriver (TrackTime, TrackTime) forall (m :: * -> *) a. Monad m => a -> m a return (TrackTime start, TrackTime -> TrackTime -> TrackTime forall a. Ord a => a -> a -> a min (PassedArgs a -> TrackTime forall a. PassedArgs a -> TrackTime next PassedArgs a args) (TrackTime -> TrackTime -> TrackTime forall a. Ord a => a -> a -> a max TrackTime end TrackTime note_end)) (Maybe TrackTime, Maybe TrackTime) _ -> (TrackTime, TrackTime) -> Deriver (TrackTime, TrackTime) forall (m :: * -> *) a. Monad m => a -> m a return (TrackTime start, PassedArgs a -> TrackTime forall a. PassedArgs a -> TrackTime next PassedArgs a args) | Bool otherwise = (TrackTime, TrackTime) -> Deriver (TrackTime, TrackTime) forall (m :: * -> *) a. Monad m => a -> m a return (TrackTime start, TrackTime end) where (TrackTime start, TrackTime end) = PassedArgs a -> (TrackTime, TrackTime) forall a. PassedArgs a -> (TrackTime, TrackTime) range PassedArgs a args -- | Start and duration of the event. This is probably the right thing for -- calls that generate a note since it will give a negative duration when -- appropriate. extent :: PassedArgs a -> (TrackTime, TrackTime) extent :: forall a. PassedArgs a -> (TrackTime, TrackTime) extent = (\Event e -> (Event -> TrackTime Event.start Event e, Event -> TrackTime Event.duration Event e)) (Event -> (TrackTime, TrackTime)) -> (PassedArgs a -> Event) -> PassedArgs a -> (TrackTime, TrackTime) forall b c a. (b -> c) -> (a -> b) -> a -> c . PassedArgs a -> Event forall a. PassedArgs a -> Event event real_extent :: PassedArgs a -> Derive.Deriver (RealTime, RealTime) real_extent :: forall a. PassedArgs a -> Deriver (RealTime, RealTime) real_extent PassedArgs a args = do let e :: Event e = PassedArgs a -> Event forall a. PassedArgs a -> Event event PassedArgs a args RealTime start <- TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real (Event -> TrackTime Event.start Event e) RealTime end <- TrackTime -> Deriver RealTime forall a. Time a => a -> Deriver RealTime Derive.real (Event -> TrackTime Event.end Event e) (RealTime, RealTime) -> Deriver (RealTime, RealTime) forall (m :: * -> *) a. Monad m => a -> m a return (RealTime start, RealTime end RealTime -> RealTime -> RealTime forall a. Num a => a -> a -> a - RealTime start) -- | Event range as it appears on the track, regardless of slicing. range_on_track :: PassedArgs a -> (TrackTime, TrackTime) range_on_track :: forall a. PassedArgs a -> (TrackTime, TrackTime) range_on_track PassedArgs a args = (TrackTime shifted TrackTime -> TrackTime -> TrackTime forall a. Num a => a -> a -> a + TrackTime start, TrackTime shifted TrackTime -> TrackTime -> TrackTime forall a. Num a => a -> a -> a + TrackTime end) where (TrackTime start, TrackTime end) = PassedArgs a -> (TrackTime, TrackTime) forall a. PassedArgs a -> (TrackTime, TrackTime) range PassedArgs a args shifted :: TrackTime shifted = Context a -> TrackTime forall val. Context val -> TrackTime Derive.ctx_track_shifted (PassedArgs a -> Context a forall a. PassedArgs a -> Context a context PassedArgs a args) -- | This normalizes a deriver to start at 0 and have a duration of 1, provided -- that the deriver is placed at the start and dur of the given args. This is -- the case if the deriver is a transformer arg, so this is useful for -- a transformer to manipulate its argument. normalized :: PassedArgs a -> Derive.Deriver b -> Derive.Deriver b normalized :: forall a b. PassedArgs a -> Deriver b -> Deriver b normalized PassedArgs a args = TrackTime -> TrackTime -> Deriver b -> Deriver b forall a. TrackTime -> TrackTime -> Deriver a -> Deriver a Derive.place (- (TrackTime start TrackTime -> TrackTime -> TrackTime forall a. Fractional a => a -> a -> a / TrackTime dur)) (TrackTime 1 TrackTime -> TrackTime -> TrackTime forall a. Fractional a => a -> a -> a / TrackTime dur) where (TrackTime start, TrackTime dur_) = PassedArgs a -> (TrackTime, TrackTime) forall a. PassedArgs a -> (TrackTime, TrackTime) extent PassedArgs a args dur :: TrackTime dur = if TrackTime dur_ TrackTime -> TrackTime -> Bool forall a. Eq a => a -> a -> Bool == TrackTime 0 then TrackTime 1 else TrackTime dur_ -- | Like 'normalized', but only shifts start to 0. normalized_start :: PassedArgs a -> Derive.Deriver b -> Derive.Deriver b normalized_start :: forall a b. PassedArgs a -> Deriver b -> Deriver b normalized_start PassedArgs a args = TrackTime -> Deriver b -> Deriver b forall a. TrackTime -> Deriver a -> Deriver a Derive.at (- PassedArgs a -> TrackTime forall a. PassedArgs a -> TrackTime start PassedArgs a args) {- NOTE [prev-val] Many control calls rely on the last value emitted by the previous call. I can't think of a way around that, because it's really fundamental to how the notation works, and it would be a real pain (and redundant) to have to write where interpolation comes from all the time. So conceptually each call takes the last val of the previous one as an argument. This is problematic because it means you never know how far back in the track a given call's dependence extends. Since track slicing divides control tracks into lots of little chunks it's not so simple to get the previous value. Initially I relied entirely on 'Derive.ctx_prev_val' and a hack where certain calls were marked as requiring the previous value, which 'slice' would then use. The problem with that is that slice is working purely syntactically, and it doesn't know what's really in scope, nor does it understand val calls. This is #2 below. After that, I tried #3, but ran into trouble wanting to get the previous Score.Event. Actually, I could have supported Score.Event with the evaluating technique, but I forgot that I had already done all these work before, implemented most of #2 before stumbling on #1 again, when its earlier problems seemed less severe than before. So the current solution is #1. 1. Extend the 'Derive.ctx_prev_val' mechanism to work even across sliced tracks. Since they are no longer evaluated in sequence, I have to save them in a `Map (BlockId, TrackId) (RealTime, Either Signal.Y PSignal.Pitch))`. However, this is problematic in its own way because it's actually threaded state, which is new. This isn't actually so bad, because I would add it in a new Threaded state, and it's only making explicit the already threaded nature of track derivation, due to prev_val. An additional problem is that, once again due to slicing, control events are evaluated twice, which means that the second evaluation gets the first evaluation's value as it's \"previous\" value. An extra hack in "Derive.EvalTrack" avoids recording a previous value when the event is past the end of a slice. 2. Make 'slice' figure out which calls will need the previous val. This is like the old syntactic mechanism only more robust. Calls already include a `prev` tag that indicates they rely on the previous value. This is complicated because what is in scope can change dynamically, so the slicing has to be done under the track's transform at least. That means slicing is split into two halves, where the first part just marks slice boundaries, and the actual slice is done in the track deriver. 3. If a call doesn't have a prev val already, it can go evaluate the prev event itself, which must be able to continue recursively until there really isn't a prev event. This can do more work, but is appealing because it removes the serialization requirement of 'Derive.ctx_prev_val'. - This means if multiple calls want the prev val, it'll be evaluated multiple times, unless I cache it somehow. - I should clear out the next events so it doesn't get in a loop if it wants the next event. Actually it's fine if it wants to look at it, it just can't want to evaluate it. -}