module Derive.C.Post.Rearticulate (library) where
import qualified Util.Lists as Lists
import qualified Util.Maps as Maps
import qualified Derive.Args as Args
import qualified Derive.Call as Call
import qualified Derive.Call.Module as Module
import qualified Derive.Call.Tags as Tags
import qualified Derive.Derive as Derive
import qualified Derive.Env as Env
import qualified Derive.LEvent as LEvent
import qualified Derive.Library as Library
import qualified Derive.PSignal as PSignal
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
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 qualified Perform.Signal as Signal
import Global
import Types
library :: Library.Library
library :: Library
library = forall call.
ToLibrary (Transformer call) =>
[(Symbol, Transformer call)] -> Library
Library.transformers
[ (Symbol
"slur-n", Transformer Note
c_slur_n)
, (Symbol
"slur-dur", Transformer Note
c_slur_dur)
]
c_slur_n :: Derive.Transformer Derive.Note
c_slur_n :: Transformer Note
c_slur_n = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
Module.prelude CallName
"slur-n" Tags
Tags.postproc
Doc
"Merge groups of notes into one note, where the pitch is taken from each\
\ merged note. The groups are of a fixed size."
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. Typecheck a => ArgName -> Doc -> Parser a
Sig.required ArgName
"group" Doc
"How many notes in a group.")
forall a b. (a -> b) -> a -> b
$ \Int
group PassedArgs Note
_args Deriver (Stream Note)
deriver -> Int -> Stream Note -> Stream Note
slur_n Int
group forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver (Stream Note)
deriver
slur_n :: Int -> Stream.Stream Score.Event -> Stream.Stream Score.Event
slur_n :: Int -> Stream Note -> Stream Note
slur_n Int
group = forall a. [LEvent a] -> Stream a
Stream.from_sorted_list forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LEvent Note] -> [LEvent Note]
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Stream a -> [LEvent a]
Stream.to_list
where
go :: [LEvent Note] -> [LEvent Note]
go [LEvent Note]
events = case forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first forall d. [LEvent d] -> ([d], [Msg])
LEvent.partition forall a b. (a -> b) -> a -> b
$ forall a. Int -> [LEvent a] -> ([LEvent a], [LEvent a])
split_events Int
group [LEvent Note]
events of
(([], [Msg]
logs), [LEvent Note]
_) -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Msg -> LEvent a
LEvent.Log [Msg]
logs
((Note
e : [Note]
es, [Msg]
logs), [LEvent Note]
post) -> forall a b. (a -> b) -> [a] -> [b]
map forall a. Msg -> LEvent a
LEvent.Log [Msg]
logs
forall a. [a] -> [a] -> [a]
++ forall a. a -> LEvent a
LEvent.Event (Note -> [Note] -> Note
slur Note
e [Note]
es) forall a. a -> [a] -> [a]
: [LEvent Note] -> [LEvent Note]
go [LEvent Note]
post
slur :: Score.Event -> [Score.Event] -> Score.Event
slur :: Note -> [Note] -> Note
slur Note
event [Note]
events = Note
event
{ event_duration :: RealTime
Score.event_duration = RealTime
dur
, event_pitch :: PSignal
Score.event_pitch = PSignal -> [(RealTime, PSignal)] -> PSignal
merge_pitch (Note -> PSignal
Score.event_pitch Note
event)
[(Note -> RealTime
Score.event_start Note
e, Note -> PSignal
Score.event_pitch Note
e) | Note
e <- [Note]
events]
, event_environ :: Environ
Score.event_environ = ControlMap -> Environ
Env.from_controls (Note -> [Note] -> ControlMap
merge_controls Note
event [Note]
events)
forall a. Semigroup a => a -> a -> a
<> Note -> Environ
Score.event_environ Note
event
}
where
dur :: RealTime
dur = Note -> RealTime
Score.event_end (forall a. a -> Maybe a -> a
fromMaybe Note
event (forall a. [a] -> Maybe a
Lists.last [Note]
events))
forall a. Num a => a -> a -> a
- Note -> RealTime
Score.event_start Note
event
merge_pitch :: PSignal.PSignal -> [(RealTime, PSignal.PSignal)]
-> PSignal.PSignal
merge_pitch :: PSignal -> [(RealTime, PSignal)] -> PSignal
merge_pitch PSignal
sig [(RealTime, PSignal)]
sigs =
forall a. Monoid a => [a] -> a
mconcat forall a b. (a -> b) -> a -> b
$ PSignal
sig forall a. a -> [a] -> [a]
: [RealTime -> PSignal -> PSignal
PSignal.clip_before RealTime
start PSignal
sig | (RealTime
start, PSignal
sig) <- [(RealTime, PSignal)]
sigs]
merge_controls :: Score.Event -> [Score.Event] -> ScoreT.ControlMap
merge_controls :: Note -> [Note] -> ControlMap
merge_controls Note
event [Note]
events = forall k a. (Ord k, Monoid a) => [Map k a] -> Map k a
Maps.mconcat forall a b. (a -> b) -> a -> b
$ Note -> ControlMap
clip Note
event forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map Note -> ControlMap
clip [Note]
events
where
clip :: Note -> ControlMap
clip Note
event = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall {k} (kind :: k). RealTime -> Signal kind -> Signal kind
Signal.clip_before (Note -> RealTime
Score.event_start Note
event)) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Note -> ControlMap
Score.event_controls Note
event
split_events :: Int -> [LEvent.LEvent a]
-> ([LEvent.LEvent a], [LEvent.LEvent a])
split_events :: forall a. Int -> [LEvent a] -> ([LEvent a], [LEvent a])
split_events Int
_ [] = ([], [])
split_events Int
n (LEvent a
e:[LEvent a]
es)
| Int
n forall a. Ord a => a -> a -> Bool
<= Int
0 = ([], LEvent a
e forall a. a -> [a] -> [a]
: [LEvent a]
es)
| Bool
otherwise = (LEvent a
e forall a. a -> [a] -> [a]
: [LEvent a]
pre, [LEvent a]
post)
where ([LEvent a]
pre, [LEvent a]
post) = forall a. Int -> [LEvent a] -> ([LEvent a], [LEvent a])
split_events (if forall a. LEvent a -> Bool
LEvent.is_event LEvent a
e then Int
n forall a. Num a => a -> a -> a
- Int
1 else Int
n) [LEvent a]
es
c_slur_dur :: Derive.Transformer Derive.Note
c_slur_dur :: Transformer Note
c_slur_dur = forall d.
Module
-> CallName
-> Tags
-> Doc
-> WithArgDoc (TransformerF d)
-> Transformer d
Derive.transformer Module
Module.prelude CallName
"slur-dur" Tags
Tags.postproc
Doc
"Merge groups of notes into one note, where the pitch is taken from each\
\ merged note. The groups are by duration."
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
<$> (DefaultScore -> Duration
Typecheck._score forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Typecheck a => ArgName -> Doc -> Parser a
Sig.required ArgName
"dur" Doc
"How long each group is.")
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (DefaultScore -> Duration
Typecheck._score 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
"offset" (ScoreTime -> DefaultScore
Typecheck.score ScoreTime
0)
Doc
"Groups start at this time.")
) forall a b. (a -> b) -> a -> b
$ \(Duration
dur, Duration
offset) PassedArgs Note
args Deriver (Stream Note)
deriver -> do
RealTime
start <- forall a. PassedArgs a -> Deriver RealTime
Args.real_start PassedArgs Note
args
RealTime
dur <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
Call.real_duration RealTime
start Duration
dur
RealTime
offset <- forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
Call.real_duration RealTime
start Duration
offset
RealTime -> RealTime -> Stream Note -> Stream Note
slur_dur RealTime
dur RealTime
offset forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver (Stream Note)
deriver
slur_dur :: RealTime -> RealTime -> Stream.Stream Score.Event
-> Stream.Stream Score.Event
slur_dur :: RealTime -> RealTime -> Stream Note -> Stream Note
slur_dur RealTime
dur RealTime
offset Stream Note
stream =
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 forall a b. (a -> b) -> a -> b
$
forall a b. (a -> b) -> [a] -> [b]
map NonEmpty Note -> Note
apply (RealTime -> RealTime -> [Note] -> [NonEmpty Note]
group_dur RealTime
dur RealTime
offset [Note]
events)
where
apply :: NonEmpty Note -> Note
apply (Note
e :| [Note]
es) = Note -> [Note] -> Note
slur Note
e [Note]
es
([Note]
events, [Msg]
logs) = forall a. Stream a -> ([a], [Msg])
Stream.partition Stream Note
stream
group_dur :: RealTime -> RealTime -> [Score.Event] -> [NonEmpty Score.Event]
group_dur :: RealTime -> RealTime -> [Note] -> [NonEmpty Note]
group_dur RealTime
dur RealTime
offset = forall key a. Eq key => (a -> key) -> [a] -> [NonEmpty a]
Lists.groupStable Note -> Integer
group_of
where
group_of :: Note -> Integer
group_of = forall a b. (RealFrac a, Integral b) => a -> b
floor forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Double
RealTime.to_seconds forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Fractional a => a -> a -> a
/RealTime
dur) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract RealTime
offset
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Note -> RealTime
Score.event_start