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