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

-- | Note calls that transform other note calls.  They rely on track slicing
-- via 'Sub.sub_events'.
module Derive.C.Prelude.Parent (
    library
    -- testing
    , interpolate_subs
) where
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Maybe as Maybe

import qualified Util.Lists as Lists
import qualified Util.Num as Num

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.Sub as Sub
import qualified Derive.Call.SubT as SubT
import qualified Derive.Call.Tags as Tags
import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Eval as Eval
import qualified Derive.Flags as Flags
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.Lilypond.Constants as Constants
import qualified Perform.RealTime as RealTime
import qualified Perform.Signal as Signal

import qualified Ui.ScoreTime as ScoreTime

import           Global
import           Types


library :: Library.Library
library :: Library
library = forall call.
ToLibrary (Generator call) =>
[(Symbol, Generator call)] -> Library
Library.generators
    [ (Symbol
"ap", Generator Note
c_ap)
    , (Symbol
"t", Generator Note
c_tuplet)
    , (Symbol
"tup", Generator Note
c_tuplet) -- longer name in case 't' is shadowed
    , (Symbol
"`arp-up`", Arpeggio -> Generator Note
c_real_arpeggio Arpeggio
ToRight)
    , (Symbol
"`arp-down`", Arpeggio -> Generator Note
c_real_arpeggio Arpeggio
ToLeft)
    , (Symbol
"`arp-rnd`", Arpeggio -> Generator Note
c_real_arpeggio Arpeggio
Random)
    , (Symbol
"interpolate", Generator Note
c_interpolate)
    , (Symbol
"e-interpolate", Generator Note
c_event_interpolate)
    , (Symbol
"cycle", Generator Note
c_cycle)
    , (Symbol
"cycle-t", Generator Note
c_cycle_t)
    ]

c_ap :: Derive.Generator Derive.Note
c_ap :: Generator Note
c_ap = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.prelude CallName
"ap" Tags
Tags.subs
    Doc
"Derive sub events with no changes.  This is used to apply a transformer\
    \ to sub events."
    forall a b. (a -> b) -> a -> b
$ forall y d.
Taggable y =>
Generator y d -> WithArgDoc (Generator y d)
Sig.call0 forall a b. (a -> b) -> a -> b
$ [Event] -> Deriver State Error (Stream Note)
Sub.derive forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall d. PassedArgs d -> Deriver [[Event]]
Sub.sub_events

-- * tuplet

c_tuplet :: Derive.Generator Derive.Note
c_tuplet :: Generator Note
c_tuplet = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.prelude CallName
"tuplet" forall a. Monoid a => a
mempty
    Doc
"A generalized tuplet. The notes within its scope are stretched so that\
    \ their collective duration is the same as the tuplet's duration.\
    \\nThis doesn't work so well for zero duration notes. The last note\
    \ winds up at the end of the tuplet, which is not very useful. But zero\
    \ duration is common for percussion, so there's a hack to cover this case:\
    \ if there are >1 equidistant zero duration sub events, the distance\
    \ between them is considered their implicit duration.\
    \\nIf there are multiple note tracks, they get the stretch of the longest\
    \ one. This is so the timing will come out right if some of the notes are\
    \ chords."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call_sub (forall a. Typecheck a => ArgName -> Doc -> Parser [a]
Sig.many ArgName
"subtrack" Doc
"Subtrack to stretch.") forall a b. (a -> b) -> a -> b
$
        \[Track]
subtracks PassedArgs Note
args -> forall a. Deriver a -> Deriver a -> Deriver a
Ly.when_lilypond
            ((ScoreTime, ScoreTime)
-> [[Event]] -> Deriver State Error (Stream Note)
lily_tuplet (forall a. PassedArgs a -> (ScoreTime, ScoreTime)
Args.range PassedArgs Note
args) (forall a b. (a -> b) -> [a] -> [b]
map Track -> [Event]
SubT._events [Track]
subtracks))
            ((ScoreTime, ScoreTime)
-> [[Event]] -> Deriver State Error (Stream Note)
tuplet (forall a. PassedArgs a -> (ScoreTime, ScoreTime)
Args.range PassedArgs Note
args) (forall a b. (a -> b) -> [a] -> [b]
map Track -> [Event]
SubT._events [Track]
subtracks))

tuplet :: (ScoreTime, ScoreTime) -> [[SubT.Event]] -> Derive.NoteDeriver
tuplet :: (ScoreTime, ScoreTime)
-> [[Event]] -> Deriver State Error (Stream Note)
tuplet (ScoreTime
start, ScoreTime
end) [[Event]]
tracks =
    case forall a. (Ord a, Num a) => [[(a, a)]] -> Maybe a
tuplet_note_end (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. EventT a -> (ScoreTime, ScoreTime)
to_start_dur) [[Event]]
tracks) of
        Maybe ScoreTime
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Monoid a => a
mempty
        Just ScoreTime
note_end ->
            forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map ((ScoreTime, ScoreTime)
-> (ScoreTime, ScoreTime)
-> [Event]
-> Deriver State Error (Stream Note)
Sub.fit (ScoreTime
start, ScoreTime
note_end) (ScoreTime
start, ScoreTime
end)) [[Event]]
tracks
    where to_start_dur :: EventT a -> (ScoreTime, ScoreTime)
to_start_dur EventT a
e = (forall a. EventT a -> ScoreTime
SubT._start EventT a
e, forall a. EventT a -> ScoreTime
SubT._duration EventT a
e)

-- | Get the end of the notes inside the tuplet.  If it has >1 note, and they
-- are all zero dur, and notes are equidistant, assume the last one has the
-- same dur.
tuplet_note_end :: (Ord a, Num a) => [[(a, a)]] -> Maybe a
tuplet_note_end :: forall a. (Ord a, Num a) => [[(a, a)]] -> Maybe a
tuplet_note_end = forall a. Ord a => [a] -> Maybe a
Lists.maximum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. (Num a, Ord a) => [(a, a)] -> Maybe a
last_end
    where
    last_end :: [(a, a)] -> Maybe a
last_end [(a, a)]
events = forall {a} {b}. (Num a, Num b, Eq b, Eq a) => [(a, b)] -> Maybe a
infer_duration [(a, a)]
events forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Ord a => [a] -> Maybe a
Lists.maximum (forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Num a => (a, a) -> a
end_of [(a, a)]
events)
    infer_duration :: [(a, b)] -> Maybe a
infer_duration [(a, b)]
events = case forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (-) (forall a. Int -> [a] -> [a]
drop Int
1 [a]
starts) [a]
starts of
        a
d : [a]
ds | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all ((forall a. Eq a => a -> a -> Bool
==b
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. (a, b) -> b
dur_of) [(a, b)]
events Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==a
d) [a]
ds ->
            forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall {a} {b}. (a, b) -> a
start_of (forall a. [a] -> a
last [(a, b)]
events) forall a. Num a => a -> a -> a
+ a
d
        [a]
_ -> forall a. Maybe a
Nothing
        where starts :: [a]
starts = forall a b. (a -> b) -> [a] -> [b]
map forall {a} {b}. (a, b) -> a
start_of [(a, b)]
events
    start_of :: (a, b) -> a
start_of = forall {a} {b}. (a, b) -> a
fst
    dur_of :: (a, b) -> b
dur_of = forall {a} {b}. (a, b) -> b
snd
    end_of :: (a, a) -> a
end_of (a
s, a
d) = a
s forall a. Num a => a -> a -> a
+ a
d

-- | Emit a special 'tuplet_event' and derive the sub events with no time
-- changes.
lily_tuplet :: (ScoreTime, ScoreTime) -> [[SubT.Event]] -> Derive.NoteDeriver
lily_tuplet :: (ScoreTime, ScoreTime)
-> [[Event]] -> Deriver State Error (Stream Note)
lily_tuplet (ScoreTime
start, ScoreTime
end) [[Event]]
track_notes = do
    [[Event]]
track_notes <- case forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Event]]
track_notes of
        [] -> forall a. HasCallStack => Text -> Deriver a
Derive.throw Text
"no sub events"
        [[Event]]
notes -> forall (m :: * -> *) a. Monad m => a -> m a
return [[Event]]
notes
    [Stream Note]
track_events <- forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM [Event] -> Deriver State Error (Stream Note)
Sub.derive [[Event]]
track_notes
    let notes :: [[Note]]
notes = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> Bool
Ly.is_code0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> [a]
Stream.events_of) [Stream Note]
track_events
    RealTime
notes_end <- case forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Note]]
notes of
        [] -> forall a. HasCallStack => Text -> Deriver a
Derive.throw Text
"no sub events"
        [[Note]]
tracks -> forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require Text
"can't figure out tuplet duration" forall a b. (a -> b) -> a -> b
$
            forall a. (Ord a, Num a) => [[(a, a)]] -> Maybe a
tuplet_note_end (forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (a -> b) -> [a] -> [b]
map Note -> (RealTime, RealTime)
to_start_dur) [[Note]]
tracks)
    RealTime
real_start <- forall a. Time a => a -> Deriver State Error RealTime
Derive.real ScoreTime
start
    RealTime
real_end <- forall a. Time a => a -> Deriver State Error RealTime
Derive.real ScoreTime
end
    Stream Note
tuplet <- forall a. ScoreTime -> ScoreTime -> Deriver a -> Deriver a
Derive.place ScoreTime
start (ScoreTime
endforall a. Num a => a -> a -> a
-ScoreTime
start) forall a b. (a -> b) -> a -> b
$
        RealTime -> RealTime -> Deriver State Error (Stream Note)
tuplet_event (RealTime
notes_end forall a. Num a => a -> a -> a
- RealTime
real_start) (RealTime
real_end forall a. Num a => a -> a -> a
- RealTime
real_start)
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. Monoid a => [a] -> a
mconcat (Stream Note
tuplet forall a. a -> [a] -> [a]
: [Stream Note]
track_events)
    where to_start_dur :: Note -> (RealTime, RealTime)
to_start_dur Note
e = (Note -> RealTime
Score.event_start Note
e, Note -> RealTime
Score.event_duration Note
e)

-- | Emit the special event that tells lilypond to gather the following events
-- into a tuplet.
tuplet_event :: RealTime -> RealTime -> Derive.NoteDeriver
tuplet_event :: RealTime -> RealTime -> Deriver State Error (Stream Note)
tuplet_event RealTime
score_dur RealTime
real_dur =
    Flags
-> Deriver State Error (Stream Note)
-> Deriver State Error (Stream Note)
Call.add_flags Flags
Flags.ly_code forall a b. (a -> b) -> a -> b
$
        forall a. Environ -> Deriver a -> Deriver a
Derive.with_environ (RealTime -> RealTime -> Environ
Constants.set_tuplet RealTime
score_dur RealTime
real_dur) forall a b. (a -> b) -> a -> b
$
        Deriver State Error (Stream Note)
Call.note

-- * arpeggio

-- | Direction in which to arpeggiate.  This is a general arpeggiation that
-- just makes each track slightly delayed with regard to its neighbor.
--
-- Since I can't know the pitch of things (and a 'SubT.Event' may not have
-- a single pitch), the arpeggiation is by track position, not pitch.
data Arpeggio = ToRight | ToLeft | Random deriving (Int -> Arpeggio -> ShowS
[Arpeggio] -> ShowS
Arpeggio -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Arpeggio] -> ShowS
$cshowList :: [Arpeggio] -> ShowS
show :: Arpeggio -> String
$cshow :: Arpeggio -> String
showsPrec :: Int -> Arpeggio -> ShowS
$cshowsPrec :: Int -> Arpeggio -> ShowS
Show)

c_real_arpeggio :: Arpeggio -> Derive.Generator Derive.Note
c_real_arpeggio :: Arpeggio -> Generator Note
c_real_arpeggio Arpeggio
arp = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.prelude CallName
"arp" Tags
Tags.subs
    (Doc
"Arpeggiate the transformed notes. This shifts each note's start time\
    \ by a different amount, increasing to the right for `arp-up`,\
    \ to the left for `arp-down`, and randomly for `arp-rnd`.\
    \ Since it transforms score and not events, it doesn't know the\
    \ pitches of the sub notes (they may not have a single pitch) so\
    \ it's not actually \"up\" or \"down\"."
    ) forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call ((,)
    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
"time" (Double
0.1 :: Double)
        Doc
"This much RealTime between each note."
    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
"random" (Double
0.5 :: Double)
        Doc
"Each note can vary randomly by `+- time/2 * random`."
    ) forall a b. (a -> b) -> a -> b
$ \(Double
time, Double
random) PassedArgs Note
args -> forall {d}.
PassedArgs d
-> Deriver State Error (Stream Note)
-> Deriver State Error (Stream Note)
lily_code PassedArgs Note
args forall a b. (a -> b) -> a -> b
$
        Arpeggio
-> RealTime
-> Double
-> [[Event]]
-> Deriver State Error (Stream Note)
arpeggio Arpeggio
arp (Double -> RealTime
RealTime.seconds Double
time) Double
random forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall d. PassedArgs d -> Deriver [[Event]]
Sub.sub_events PassedArgs Note
args
    where
    lily_code :: PassedArgs d
-> Deriver State Error (Stream Note)
-> Deriver State Error (Stream Note)
lily_code = forall d.
(Deriver State Error (Stream Note)
 -> Deriver State Error (Stream Note))
-> PassedArgs d
-> Deriver State Error (Stream Note)
-> Deriver State Error (Stream Note)
Ly.notes_with forall a b. (a -> b) -> a -> b
$ Code
-> Deriver State Error (Stream Note)
-> Deriver State Error (Stream Note)
Ly.add_first (Position CodePosition
Ly.prepend, Text
prefix)
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. Code
-> Deriver State Error (Stream Note)
-> Deriver State Error (Stream Note)
Ly.add_first (Distribution -> Position CodePosition
Ly.append Distribution
Constants.First, Text
suffix)
    prefix :: Text
prefix = case Arpeggio
arp of
        Arpeggio
ToRight -> Text
"\\arpeggioArrowUp"
        Arpeggio
ToLeft -> Text
"\\arpeggioArrowDown"
        Arpeggio
Random -> Text
"\\arpeggioNormal"
    suffix :: Text
suffix = Text
"\\arpeggio"

-- | Shift each track of notes by a successive amount.
arpeggio :: Arpeggio -> RealTime -> Double -> [[SubT.Event]]
    -> Derive.NoteDeriver
arpeggio :: Arpeggio
-> RealTime
-> Double
-> [[Event]]
-> Deriver State Error (Stream Note)
arpeggio Arpeggio
arp RealTime
time Double
random [[Event]]
tracks = do
    [(RealTime, [Event])]
delay_tracks <- forall {b}. [(RealTime, b)] -> Deriver State Error [(RealTime, b)]
jitter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. Num a => a -> a -> [a]
Lists.range_ RealTime
0 RealTime
time) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {a}. [a] -> Deriver State Error [a]
sort [[Event]]
tracks
    [Event]
events <- forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(RealTime, [Event])]
delay_tracks forall a b. (a -> b) -> a -> b
$ \(RealTime
delay, [Event]
track) ->
        forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Event]
track forall a b. (a -> b) -> a -> b
$ \(SubT.EventT ScoreTime
start ScoreTime
dur Deriver State Error (Stream Note)
d) -> do
            ScoreTime
delay <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver ScoreTime
Call.score_duration ScoreTime
start RealTime
delay
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. ScoreTime -> ScoreTime -> a -> EventT a
SubT.EventT (ScoreTime
startforall a. Num a => a -> a -> a
+ScoreTime
delay) (ScoreTime
durforall a. Num a => a -> a -> a
-ScoreTime
delay) Deriver State Error (Stream Note)
d
    [Event] -> Deriver State Error (Stream Note)
Sub.derive [Event]
events
    where
    jitter :: [(RealTime, b)] -> Deriver State Error [(RealTime, b)]
jitter [(RealTime, b)]
tracks
        | Double
random forall a. Eq a => a -> a -> Bool
== Double
0 = forall (m :: * -> *) a. Monad m => a -> m a
return [(RealTime, b)]
tracks
        | Bool
otherwise = do
            [Double]
rs <- forall a. Random a => a -> a -> Deriver [a]
Call.randoms_in (-Double
random) Double
random
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {b}. Double -> (RealTime, b) -> (RealTime, b)
nudge [Double]
rs [(RealTime, b)]
tracks
    nudge :: Double -> (RealTime, b) -> (RealTime, b)
nudge Double
r (RealTime
delay, b
notes)
        | RealTime
delay forall a. Eq a => a -> a -> Bool
== RealTime
0 = (RealTime
delay, b
notes)
        | Bool
otherwise = (RealTime
delay forall a. Num a => a -> a -> a
+ RealTime
timeforall a. Fractional a => a -> a -> a
/RealTime
2 forall a. Num a => a -> a -> a
* Double -> RealTime
RealTime.seconds Double
r, b
notes)
    sort :: [a] -> Deriver State Error [a]
sort = case Arpeggio
arp of
        Arpeggio
ToRight -> forall (m :: * -> *) a. Monad m => a -> m a
return
        Arpeggio
ToLeft -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse
        Arpeggio
Random -> forall {a}. [a] -> Deriver State Error [a]
Call.shuffle

-- | This is the old version that shifts each note as a postproc.  This means
-- it can arpeggiate by pitch since it knows the pitches at that point, but
-- also means it won't place events that consist of multiple notes correctly.
--
-- It's also buggy for events after the start since it will make their
-- duration negative.
arpeggio_by_note :: Arpeggio -> RealTime -> Derive.NoteDeriver
    -> Derive.NoteDeriver
arpeggio_by_note :: Arpeggio
-> RealTime
-> Deriver State Error (Stream Note)
-> Deriver State Error (Stream Note)
arpeggio_by_note Arpeggio
arp RealTime
time Deriver State Error (Stream Note)
deriver = do
    ([Note]
events, [Msg]
logs) <- forall a. Stream a -> ([a], [Msg])
Stream.partition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver State Error (Stream Note)
deriver
    let sort :: [Note] -> Deriver State Error [Note]
sort = case Arpeggio
arp of
            Arpeggio
ToRight -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
Lists.reverseSortOn Note -> Maybe NoteNumber
Score.initial_nn
            Arpeggio
ToLeft -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. Ord b => (a -> b) -> [a] -> [a]
Lists.sortOn Note -> Maybe NoteNumber
Score.initial_nn
            Arpeggio
Random -> forall {a}. [a] -> Deriver State Error [a]
Call.shuffle
    [Note]
arpeggiated <- forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (RealTime -> RealTime -> Note -> Note
Score.move_start RealTime
0) (forall a. Num a => a -> a -> [a]
Lists.range_ RealTime
0 RealTime
time)
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Note] -> Deriver State Error [Note]
sort [Note]
events
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall e. [Msg] -> Stream e -> Stream e
Stream.merge_logs [Msg]
logs forall a b. (a -> b) -> a -> b
$ forall a. [a] -> Stream a
Stream.from_sorted_events [Note]
arpeggiated

-- * interpolate

c_interpolate :: Derive.Generator Derive.Note
c_interpolate :: Generator Note
c_interpolate = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.prelude CallName
"interpolate" Tags
Tags.subs
    Doc
"Interpolate between multiple sub-tracks, each of which must have the\
    \ same number of events. This interpolates rhythm only. To interpolate\
    \ pitch and controls, it would need to work at the score event level,\
    \ rather than ui events."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call (
        forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> EnvironDefault -> deflt -> Doc -> Parser a
Sig.defaulted_env ArgName
"at" EnvironDefault
Sig.Both (Double -> Normalized
Typecheck.Normalized Double
0)
            Doc
"interpolate position"
    ) forall a b. (a -> b) -> a -> b
$ \RealTime -> Double
at PassedArgs Note
args -> do
        [[Event]]
tracks <- forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall d. PassedArgs d -> Deriver [[Event]]
Sub.sub_events PassedArgs Note
args
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall a. Eq a => [a] -> Bool
all_equal (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Event]]
tracks)) forall a b. (a -> b) -> a -> b
$
            forall a. HasCallStack => Text -> Deriver a
Derive.throw forall a b. (a -> b) -> a -> b
$ Text
"sub tracks should have the same number of events: "
                forall a. Semigroup a => a -> a -> a
<> forall a. Pretty a => a -> Text
pretty (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Event]]
tracks)
        ScoreTime -> RealTime
to_real <- Deriver (ScoreTime -> RealTime)
Derive.real_function
        [Event] -> Deriver State Error (Stream Note)
Sub.derive forall a b. (a -> b) -> a -> b
$ (ScoreTime -> Double) -> [[Event]] -> [Event]
interpolate_tracks (RealTime -> Double
at forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScoreTime -> RealTime
to_real) (forall a. [[a]] -> [[a]]
Lists.rotate [[Event]]
tracks)

interpolate_tracks :: (ScoreTime -> Signal.Y) -> [[SubT.Event]] -> [SubT.Event]
interpolate_tracks :: (ScoreTime -> Double) -> [[Event]] -> [Event]
interpolate_tracks ScoreTime -> Double
at = forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a}. [EventT a] -> Maybe (EventT a)
interpolate1
    where
    interpolate1 :: [EventT a] -> Maybe (EventT a)
interpolate1 [EventT a]
events = forall a. Double -> [EventT a] -> Maybe (EventT a)
interpolate_subs (ScoreTime -> Double
at ScoreTime
start) [EventT a]
events
        where
        start :: ScoreTime
start = forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum (forall a b. (a -> b) -> [a] -> [b]
map forall a. EventT a -> ScoreTime
SubT._start [EventT a]
events) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventT a]
events)

interpolate_subs :: Double -> [SubT.EventT a] -> Maybe (SubT.EventT a)
interpolate_subs :: forall a. Double -> [EventT a] -> Maybe (EventT a)
interpolate_subs Double
at [EventT a]
events = case forall a. Int -> [a] -> [a]
drop Int
i [EventT a]
events of
    [] -> forall a. [a] -> Maybe a
Lists.last [EventT a]
events
    [EventT a
event] -> forall a. a -> Maybe a
Just EventT a
event
    EventT a
e1 : EventT a
e2 : [EventT a]
_ -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ SubT.EventT
        { _start :: ScoreTime
_start = ScoreTime -> ScoreTime -> ScoreTime
interpolate (forall a. EventT a -> ScoreTime
SubT._start EventT a
e1) (forall a. EventT a -> ScoreTime
SubT._start EventT a
e2)
        , _duration :: ScoreTime
_duration = ScoreTime -> ScoreTime -> ScoreTime
interpolate (forall a. EventT a -> ScoreTime
SubT._duration EventT a
e1) (forall a. EventT a -> ScoreTime
SubT._duration EventT a
e2)
        , _note :: a
_note = forall a. EventT a -> a
SubT._note EventT a
e1
        }
    where
    (Int
i, Double
frac) = forall a b. (RealFrac a, Integral b) => a -> (b, a)
properFraction (Double
at forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [EventT a]
events forall a. Num a => a -> a -> a
- Int
1))
    interpolate :: ScoreTime -> ScoreTime -> ScoreTime
interpolate ScoreTime
x ScoreTime
y = forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale ScoreTime
x ScoreTime
y (Double -> ScoreTime
ScoreTime.from_double Double
frac)

all_equal :: Eq a => [a] -> Bool
all_equal :: forall a. Eq a => [a] -> Bool
all_equal [] = Bool
True
all_equal (a
x:[a]
xs) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
==a
x) [a]
xs

-- UI should be: call with two args, like 'interp b1 b2'

c_event_interpolate :: Derive.Generator Derive.Note
c_event_interpolate :: Generator Note
c_event_interpolate = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.prelude CallName
"e-interpolate" Tags
Tags.subs
    Doc
"Interpolate rhythms of the transformed sequence."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call ((,,)
    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
"notes" (forall a. Maybe a
Nothing :: Maybe Sig.Dummy) Doc
"source deriver"
    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
"model" (forall a. Maybe a
Nothing :: Maybe Sig.Dummy) Doc
"rhythm model"
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a deflt.
(Typecheck a, ToVal deflt) =>
ArgName -> EnvironDefault -> deflt -> Doc -> Parser a
Sig.defaulted_env ArgName
"at" EnvironDefault
Sig.Both (Double -> Normalized
Typecheck.Normalized Double
0)
        Doc
"interpolate position"
    ) forall a b. (a -> b) -> a -> b
$ \(Maybe Quoted
mb_notes, Maybe Quoted
mb_model, RealTime -> Double
at) PassedArgs Note
args -> do
        (Deriver State Error (Stream Note)
model, Deriver State Error (Stream Note)
notes) <- PassedArgs Note
-> (Text, Maybe Quoted)
-> (Text, Maybe Quoted)
-> Deriver
     (Deriver State Error (Stream Note),
      Deriver State Error (Stream Note))
resolve_derivers2 PassedArgs Note
args
            (Text
"model", Maybe Quoted
mb_model) (Text
"notes", Maybe Quoted
mb_notes)
        let start_dur :: Note -> (RealTime, RealTime)
start_dur Note
e = (Note -> RealTime
Score.event_start Note
e, Note -> RealTime
Score.event_duration Note
e)
        ([(RealTime, RealTime)]
model_starts, [Msg]
model_logs) <-
            forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (forall a b. (a -> b) -> [a] -> [b]
map Note -> (RealTime, RealTime)
start_dur) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> ([a], [Msg])
Stream.partition forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver State Error (Stream Note)
model
        forall e. [Msg] -> Stream e -> Stream e
Stream.merge_logs [Msg]
model_logs
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. ([a] -> [b]) -> Stream a -> Stream b
Post.apply ((RealTime -> Double) -> [(RealTime, RealTime)] -> [Note] -> [Note]
interpolate_events RealTime -> Double
at [(RealTime, RealTime)]
model_starts) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver State Error (Stream Note)
notes

interpolate_events :: (RealTime -> Signal.Y) -> [(RealTime, RealTime)]
    -> [Score.Event] -> [Score.Event]
interpolate_events :: (RealTime -> Double) -> [(RealTime, RealTime)] -> [Note] -> [Note]
interpolate_events RealTime -> Double
at [(RealTime, RealTime)]
ms = forall a b. (a -> b) -> [a] -> [b]
map (Maybe (RealTime, RealTime), Note) -> Note
interpolate forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [a] -> [b] -> [(Maybe a, b)]
Lists.zipPaddedFst [(RealTime, RealTime)]
ms
    where
    interpolate :: (Maybe (RealTime, RealTime), Note) -> Note
interpolate (Just (RealTime
to_start, RealTime
to_dur), Note
event) =
        RealTime -> RealTime -> Note -> Note
Score.place
            (forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale (Note -> RealTime
Score.event_start Note
event) RealTime
to_start RealTime
frac)
            (forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale (Note -> RealTime
Score.event_duration Note
event) RealTime
to_dur RealTime
frac)
            Note
event
        where
        frac :: RealTime
frac = Double -> RealTime
RealTime.seconds forall a b. (a -> b) -> a -> b
$ RealTime -> Double
at (Note -> RealTime
Score.event_start Note
event)
    interpolate (Maybe (RealTime, RealTime)
Nothing, Note
event) = Note
event

resolve_derivers2 :: Derive.NoteArgs
    -> (Text, Maybe DeriveT.Quoted) -> (Text, Maybe DeriveT.Quoted)
    -> Derive.Deriver (Derive.NoteDeriver, Derive.NoteDeriver)
resolve_derivers2 :: PassedArgs Note
-> (Text, Maybe Quoted)
-> (Text, Maybe Quoted)
-> Deriver
     (Deriver State Error (Stream Note),
      Deriver State Error (Stream Note))
resolve_derivers2 PassedArgs Note
args (Text, Maybe Quoted)
sym1 (Text, Maybe Quoted)
sym2 = PassedArgs Note
-> [(Text, Maybe Quoted)]
-> Deriver [Deriver State Error (Stream Note)]
resolve_derivers PassedArgs Note
args [(Text, Maybe Quoted)
sym1, (Text, Maybe Quoted)
sym2] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    [Deriver State Error (Stream Note)
d1, Deriver State Error (Stream Note)
d2] -> forall (m :: * -> *) a. Monad m => a -> m a
return (Deriver State Error (Stream Note)
d1, Deriver State Error (Stream Note)
d2)
    [Deriver State Error (Stream Note)]
ds -> forall a. HasCallStack => Text -> Deriver a
Derive.throw forall a b. (a -> b) -> a -> b
$ Text
"expected 2, got " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Deriver State Error (Stream Note)]
ds)

-- TODO this is awkward... maybe it should be built into Derive.Sig.
resolve_derivers :: Derive.NoteArgs -> [(Text, Maybe DeriveT.Quoted)]
    -> Derive.Deriver [Derive.NoteDeriver]
resolve_derivers :: PassedArgs Note
-> [(Text, Maybe Quoted)]
-> Deriver [Deriver State Error (Stream Note)]
resolve_derivers PassedArgs Note
args [(Text, Maybe Quoted)]
syms
    | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Maybe a -> Bool
Maybe.isJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a} {b}. (a, b) -> b
snd) [(Text, Maybe Quoted)]
syms = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Quoted -> Deriver State Error (Stream Note)
eval forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe forall {a} {b}. (a, b) -> b
snd [(Text, Maybe Quoted)]
syms
    | Bool
otherwise = do
        [[Event]]
tracks <- forall d. PassedArgs d -> Deriver [[Event]]
Sub.sub_events PassedArgs Note
args
        [(Text, Maybe Quoted)]
-> [[Event]] -> Deriver [Deriver State Error (Stream Note)]
go [(Text, Maybe Quoted)]
syms [[Event]]
tracks
    where
    eval :: Quoted -> Deriver State Error (Stream Note)
eval = forall d.
CallableExpr d =>
Context d -> Quoted -> Deriver (Stream d)
Eval.eval_quoted (forall a. PassedArgs a -> Context a
Args.context PassedArgs Note
args)
    go :: [(Text, Maybe Quoted)]
-> [[Event]] -> Deriver [Deriver State Error (Stream Note)]
go ((Text
_, Just Quoted
sym) : [(Text, Maybe Quoted)]
syms) [[Event]]
tracks = (Quoted -> Deriver State Error (Stream Note)
eval Quoted
sym :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe Quoted)]
-> [[Event]] -> Deriver [Deriver State Error (Stream Note)]
go [(Text, Maybe Quoted)]
syms [[Event]]
tracks
    go ((Text
_, Maybe Quoted
Nothing) : [(Text, Maybe Quoted)]
syms) ([Event]
track : [[Event]]
tracks) =
        ([Event] -> Deriver State Error (Stream Note)
Sub.derive [Event]
track :) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Maybe Quoted)]
-> [[Event]] -> Deriver [Deriver State Error (Stream Note)]
go [(Text, Maybe Quoted)]
syms [[Event]]
tracks
    go [] [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
    go ((Text
arg_name, Maybe Quoted
Nothing) : [(Text, Maybe Quoted)]
_) [] =
        forall a. HasCallStack => Text -> Deriver a
Derive.throw forall a b. (a -> b) -> a -> b
$ Text
"arg not given, expected a track: " forall a. Semigroup a => a -> a -> a
<> Text
arg_name
    go [] [[Event]]
tracks
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null) [[Event]]
tracks) = forall (m :: * -> *) a. Monad m => a -> m a
return []
        | Bool
otherwise = forall a. HasCallStack => Text -> Deriver a
Derive.throw forall a b. (a -> b) -> a -> b
$ Text
"extra tracks: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> Text
showt (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Event]]
tracks)

-- * cycle

c_cycle :: Derive.Generator Derive.Note
c_cycle :: Generator Note
c_cycle = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.prelude CallName
"cycle" Tags
Tags.subs
    Doc
"Apply transformers in a cycle to the sub events."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call (
        forall a. Typecheck a => ArgName -> Doc -> Parser (NonEmpty a)
Sig.many1 ArgName
"transformer" Doc
"Transformers to apply."
    ) forall a b. (a -> b) -> a -> b
$ \NonEmpty Quoted
transformers PassedArgs Note
args -> do
        [[Event]]
tracks <- forall d. PassedArgs d -> Deriver [[Event]]
Sub.sub_events PassedArgs Note
args
        forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap ([Event] -> Deriver State Error (Stream Note)
Sub.derive forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context Note -> NonEmpty Quoted -> [Event] -> [Event]
cycle_call (forall a. PassedArgs a -> Context a
Args.context PassedArgs Note
args) NonEmpty Quoted
transformers)
            [[Event]]
tracks

cycle_call :: Derive.Context Score.Event -> NonEmpty DeriveT.Quoted
    -> [SubT.Event] -> [SubT.Event]
cycle_call :: Context Note -> NonEmpty Quoted -> [Event] -> [Event]
cycle_call Context Note
ctx NonEmpty Quoted
transformers =
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall {f :: * -> *}.
Functor f =>
Quoted
-> f (Deriver State Error (Stream Note))
-> f (Deriver State Error (Stream Note))
apply (forall a. [a] -> [a]
cycle (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty Quoted
transformers))
    where apply :: Quoted
-> f (Deriver State Error (Stream Note))
-> f (Deriver State Error (Stream Note))
apply Quoted
quoted = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a -> b) -> a -> b
$ forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> Quoted -> Deriver (Stream d) -> Deriver (Stream d)
Eval.eval_quoted_transformers Context Note
ctx Quoted
quoted

c_cycle_t :: Derive.Generator Derive.Note
c_cycle_t :: Generator Note
c_cycle_t = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (GeneratorF d)
-> Generator d
Derive.generator Module
Module.prelude CallName
"cycle-t" Tags
Tags.subs
    Doc
"Apply transformers in a cycle to the sub events. This is like 'cycle',\
    \ except that it also gets a duration for each transformer, and cycles in\
    \ the given rhythm, rather than for each event."
    forall a b. (a -> b) -> a -> b
$ forall y a d.
Taggable y =>
Parser a -> (a -> Generator y d) -> WithArgDoc (Generator y d)
Sig.call (
        forall a b.
(Typecheck a, Typecheck b) =>
ArgName -> Doc -> Parser (NonEmpty (a, b))
Sig.many1_pairs ArgName
"transformer" Doc
"Transformers to apply, and the ScoreTime\
            \ duration for each transformer."
    ) forall a b. (a -> b) -> a -> b
$ \NonEmpty (Quoted, Double)
transformers PassedArgs Note
args -> do
        [[Event]]
tracks <- forall d. PassedArgs d -> Deriver [[Event]]
Sub.sub_events PassedArgs Note
args
        let ctx :: Context Note
ctx = forall a. PassedArgs a -> Context a
Args.context PassedArgs Note
args
        forall b a. Monoid b => (a -> b) -> [a] -> b
mconcatMap ([Event] -> Deriver State Error (Stream Note)
Sub.derive forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context Note
-> ScoreTime -> NonEmpty (Quoted, Double) -> [Event] -> [Event]
cycle_t Context Note
ctx (forall a. PassedArgs a -> ScoreTime
Args.start PassedArgs Note
args) NonEmpty (Quoted, Double)
transformers)
            [[Event]]
tracks

cycle_t :: Derive.Context Score.Event -> ScoreTime
    -> NonEmpty (DeriveT.Quoted, Double) -> [SubT.Event] -> [SubT.Event]
cycle_t :: Context Note
-> ScoreTime -> NonEmpty (Quoted, Double) -> [Event] -> [Event]
cycle_t Context Note
ctx ScoreTime
start NonEmpty (Quoted, Double)
transformers =
    [(Quoted, ScoreTime)] -> [Event] -> [Event]
go (forall a b. [a] -> [b] -> [(a, b)]
zip (forall a. [a] -> [a]
cycle [Quoted]
ts) (forall a. [a] -> [a]
tail (forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl forall a. Num a => a -> a -> a
(+) ScoreTime
start (forall a. [a] -> [a]
cycle [ScoreTime]
durs))))
    where
    go :: [(Quoted, ScoreTime)] -> [Event] -> [Event]
go [] [Event]
_ = []
    go [(Quoted, ScoreTime)]
_ [] = []
    go ts :: [(Quoted, ScoreTime)]
ts@((Quoted
quoted, ScoreTime
until) : [(Quoted, ScoreTime)]
rest_ts) (Event
event : [Event]
events)
        | forall a. EventT a -> ScoreTime
SubT._start Event
event forall a. Ord a => a -> a -> Bool
>= ScoreTime
until = [(Quoted, ScoreTime)] -> [Event] -> [Event]
go [(Quoted, ScoreTime)]
rest_ts (Event
event forall a. a -> [a] -> [a]
: [Event]
events)
        | Bool
otherwise = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall d.
(Callable (Transformer d), Taggable d) =>
Context d -> Quoted -> Deriver (Stream d) -> Deriver (Stream d)
Eval.eval_quoted_transformers Context Note
ctx Quoted
quoted) Event
event
            forall a. a -> [a] -> [a]
: [(Quoted, ScoreTime)] -> [Event] -> [Event]
go [(Quoted, ScoreTime)]
ts [Event]
events
    ([Quoted]
ts, [ScoreTime]
durs) = forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (forall a b. (a -> b) -> [a] -> [b]
map Double -> ScoreTime
ScoreTime.from_double)
        (forall a b. [(a, b)] -> ([a], [b])
unzip (forall a. NonEmpty a -> [a]
NonEmpty.toList NonEmpty (Quoted, Double)
transformers))