-- 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 -- | Echo and delay oriented calls. -- -- TODO event delay module Derive.C.Prelude.Delay (library) where import qualified Util.Control as Control import qualified Derive.Args as Args import qualified Derive.Call as Call import qualified Derive.Call.Ly as Ly import qualified Derive.Call.Module as Module import qualified Derive.Call.Post as Post 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.Stream as Stream import qualified Derive.Typecheck as Typecheck import qualified Perform.RealTime as RealTime import Types library :: Library.Library library :: Library library = forall call. ToLibrary (Transformer call) => [(Symbol, Transformer call)] -> Library Library.transformers [ (Symbol "d", Transformer Note c_delay) , (Symbol "echo", Transformer Note c_echo) , (Symbol "e-echo", Transformer Note c_event_echo) ] forall a. Semigroup a => a -> a -> a <> forall call. ToLibrary (Transformer call) => [(Symbol, Transformer call)] -> Library Library.transformers [ (Symbol "d", forall a. Taggable a => Transformer a c_delay_c :: Derive.Transformer Derive.Control) ] forall a. Semigroup a => a -> a -> a <> forall call. ToLibrary (Transformer call) => [(Symbol, Transformer call)] -> Library Library.transformers [ (Symbol "d", forall a. Taggable a => Transformer a c_delay_c :: Derive.Transformer Derive.Pitch) ] -- * note calls c_delay :: Derive.Transformer Derive.Note c_delay :: Transformer Note c_delay = forall d. Module -> CallName -> Tags -> Doc -> WithArgDoc (TransformerF d) -> Transformer d Derive.transformer Module Module.prelude CallName "delay" Tags Tags.ly (Doc "Simple abstract delay. As with `echo`, abstract means it happens in the\ \ score, so events may not be delayed evenly if the tempo is changing." ) forall a b. (a -> b) -> a -> b $ forall y a d. Taggable y => Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d) Sig.callt ( forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> deflt -> Doc -> Parser a Sig.defaulted ArgName "time" (RealTime 0.1 :: RealTime) Doc "Delay time." ) forall a b. (a -> b) -> a -> b $ \(Typecheck.RealTimeFunction RealTime -> Duration time) PassedArgs Note args NoteDeriver deriver -> forall a. Deriver a -> Deriver a -> Deriver a Ly.when_lilypond NoteDeriver deriver forall a b. (a -> b) -> a -> b $ do RealTime start <- forall a. PassedArgs a -> Deriver RealTime Args.real_start PassedArgs Note args ScoreTime delay <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver ScoreTime Call.score_duration RealTime start (RealTime -> Duration time RealTime start) forall a. ScoreTime -> Deriver a -> Deriver a Derive.at ScoreTime delay NoteDeriver deriver c_delay_c :: Derive.Taggable a => Derive.Transformer a c_delay_c :: forall a. Taggable a => Transformer a c_delay_c = forall d. Module -> CallName -> Tags -> Doc -> WithArgDoc (TransformerF d) -> Transformer d Derive.transformer Module Module.prelude CallName "delay" forall a. Monoid a => a mempty Doc "Simple delay for control and pitch tracks." forall a b. (a -> b) -> a -> b $ forall y a d. Taggable y => Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d) Sig.callt ( forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> deflt -> Doc -> Parser a Sig.defaulted ArgName "time" (RealTime -> DefaultReal Typecheck.real RealTime 0.1) Doc "Delay time." ) forall a b. (a -> b) -> a -> b $ \(Typecheck.DefaultReal Duration time) PassedArgs a args Deriver (Stream a) deriver -> do RealTime start <- forall a. PassedArgs a -> Deriver RealTime Args.real_start PassedArgs a args ScoreTime delay <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver ScoreTime Call.score_duration RealTime start Duration time forall a. ScoreTime -> Deriver a -> Deriver a Derive.at ScoreTime delay Deriver (Stream a) deriver -- TODO typed delay time c_echo :: Derive.Transformer Derive.Note c_echo :: Transformer Note c_echo = forall d. Module -> CallName -> Tags -> Doc -> WithArgDoc (TransformerF d) -> Transformer d Derive.transformer Module Module.prelude CallName "echo" forall a. Monoid a => a mempty (Doc "Abstract echo. This means the echoes happen in score time, so they will\ \ change tempo with the rest of the score, and their derivation may\ \ change due to different dynamics.\ \\nThe controls are only sampled at the beginning of the echo,\ \ so you can't vary them over the scope of the echo like you can\ \ with `e-echo`." ) forall a b. (a -> b) -> a -> b $ forall y a d. Taggable y => Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d) Sig.callt ((,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> deflt -> Doc -> Parser a Sig.defaulted ArgName "delay" (ScoreTime 1 :: ScoreTime) Doc "Delay time." forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> deflt -> Doc -> Parser a Sig.defaulted ArgName "feedback" (Double 0.4 :: Double) Doc "The %dyn of each echo is multiplied by this amount." forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> deflt -> Doc -> Parser a Sig.defaulted ArgName "times" (Int 1 :: Int) Doc "Number of echoes, not counting the original." ) forall a b. (a -> b) -> a -> b $ \(ScoreTime delay, Double feedback, Int times) PassedArgs Note _args -> ScoreTime -> Double -> Int -> NoteDeriver -> NoteDeriver echo ScoreTime delay Double feedback Int times echo :: ScoreTime -> Double -> Int -> Derive.NoteDeriver -> Derive.NoteDeriver echo :: ScoreTime -> Double -> Int -> NoteDeriver -> NoteDeriver echo ScoreTime delay Double feedback Int times NoteDeriver deriver | Int times forall a. Ord a => a -> a -> Bool <= Int 0 = NoteDeriver deriver | Bool otherwise = NoteDeriver deriver forall a. Semigroup a => a -> a -> a <> forall a. ScoreTime -> Deriver a -> Deriver a Derive.shift_controls ScoreTime delay (forall a. ScoreTime -> Deriver a -> Deriver a Derive.at ScoreTime delay (forall a. Double -> Deriver a -> Deriver a Call.multiply_dynamic Double feedback forall a b. (a -> b) -> a -> b $ ScoreTime -> Double -> Int -> NoteDeriver -> NoteDeriver echo ScoreTime delay Double feedback (Int times forall a. Num a => a -> a -> a - Int 1) NoteDeriver deriver)) -- | This echo works directly on Events. -- -- Args are the same as 'c_echo', except that their signals are sampled at -- every event, so parameters can vary over the course of the effect. c_event_echo :: Derive.Transformer Derive.Note c_event_echo :: Transformer Note c_event_echo = forall d. Module -> CallName -> Tags -> Doc -> WithArgDoc (TransformerF d) -> Transformer d Derive.transformer Module Module.prelude CallName "e-echo" Tags Tags.postproc (Doc "Concrete echo. All events are delayed by the same amount. Also, the\ \ parameter signals are sampled at every event, so they can vary\ \ over the course of the echo." ) forall a b. (a -> b) -> a -> b $ forall y a d. Taggable y => Parser a -> (a -> Transformer y d) -> WithArgDoc (Transformer y d) Sig.callt ((,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> deflt -> Doc -> Parser a Sig.defaulted ArgName "delay" (RealTime 1 :: RealTime) Doc "Delay time." forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> deflt -> Doc -> Parser a Sig.defaulted ArgName "feedback" (Double 0.4 :: Double) Doc "The dyn of each echo is multiplied by this amount." forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> deflt -> Doc -> Parser a Sig.defaulted ArgName "times" (Int 1 :: Int) Doc "Number of echoes, not counting the original." ) forall a b. (a -> b) -> a -> b $ \(Function delay, Function feedback, Function times) PassedArgs Note _args NoteDeriver deriver -> do Stream Note events <- NoteDeriver deriver [RealTime] delay <- forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Function -> Stream Note -> [RealTime] Post.real_time_control Function delay Stream Note events [Double] feedback <- forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ Function -> Stream Note -> [Double] Post.control Function feedback Stream Note events [Int] times <- forall (f :: * -> *) a. Applicative f => a -> f a pure forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map forall a b. (RealFrac a, Integral b) => a -> b floor forall a b. (a -> b) -> a -> b $ Function -> Stream Note -> [Double] Post.control Function times Stream Note events forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. (a -> [Note]) -> Stream a -> Stream Note Post.emap_asc_ (forall a b c d e. (a -> b -> c -> d -> e) -> (a, b, c, d) -> e Control.uncurry4 RealTime -> Double -> Int -> Note -> [Note] echo_event) (forall a b c x. [a] -> [b] -> [c] -> Stream x -> Stream (a, b, c, x) Stream.zip4 [RealTime] delay [Double] feedback [Int] times Stream Note events) -- TODO this modifies the signals to shift by the given amount of time, which -- is inefficient if there is a lot of signal data. I could store a shift -- with the event or the signals, but I'm not sure that would actually be -- more efficient unless the signals are shifted more than once. echo_event :: RealTime -> Double -> Int -> Score.Event -> [Score.Event] echo_event :: RealTime -> Double -> Int -> Note -> [Note] echo_event RealTime delay Double feedback Int times Note event = Note event forall a. a -> [a] -> [a] : forall a b. (a -> b) -> [a] -> [b] map (forall {b}. Integral b => Note -> b -> Note echo Note event) [Int 1..Int times] where echo :: Note -> b -> Note echo Note event b n = (Double -> Double) -> Note -> Note Score.modify_dynamic (forall a. Num a => a -> a -> a *Double feedbackforall a b. (Num a, Integral b) => a -> b -> a ^b n) forall a b. (a -> b) -> a -> b $ (RealTime -> RealTime) -> Note -> Note Score.move (forall a. Num a => a -> a -> a +RealTime d) Note event where d :: RealTime d = RealTime delay forall a. Num a => a -> a -> a * Double -> RealTime RealTime.seconds (forall a b. (Integral a, Num b) => a -> b fromIntegral b n)