-- Copyright 2014 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 -- | Post-process notes to add artifacts characteristic of wind instruments. module Derive.C.Idiom.Wind (library, find_harmonic) where import qualified Util.Lists as Lists import qualified Derive.Args as Args 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.PSignal as PSignal import qualified Derive.Pitches as Pitches import qualified Derive.Score as Score import qualified Derive.Sig as Sig import qualified Derive.Stream as Stream import qualified Perform.Pitch as Pitch import Global import Types library :: Library.Library library :: Library library = forall call. ToLibrary (Transformer call) => [(Symbol, Transformer call)] -> Library Library.transformers [ (Symbol "wind-idiom", Transformer Note c_wind_idiom) ] module_ :: Module.Module module_ :: Module module_ = Module "idiom" forall a. Semigroup a => a -> a -> a <> Module "wind" c_wind_idiom :: Derive.Transformer Derive.Note c_wind_idiom :: Transformer Note c_wind_idiom = forall d. Module -> CallName -> Tags -> Doc -> WithArgDoc (TransformerF d) -> Transformer d Derive.transformer Module module_ CallName "wind-idiom" (Tags Tags.postproc forall a. Semigroup a => a -> a -> a <> Tags Tags.inst) Doc "Post-process events to play in a monophonic wind-like idiom.\ \\nThis tweaks the ends of the pitch signals of notes depending on the\ \ following note. When a note is played, a (fundamental, harmonic) pair\ \ is chosen that best fits it. When a subsequent note is played, a new\ \ pair is chosen for it.\ \\nThe decay of the note will be shifted to the corresponding harmonic\ \ of the the fundamental of the subsequent note. If the fundamentals are\ \ the same then the pitch will remain constant, of course." 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 Parser [Either NoteNumber Pitch] fundamentals_env forall a b. (a -> b) -> a -> b $ \[Either NoteNumber Pitch] fundamentals PassedArgs Note args Deriver (Stream Note) deriver -> do RealTime start <- forall a. PassedArgs a -> Deriver RealTime Args.real_start PassedArgs Note args [NoteNumber] fundamentals <- forall (t :: * -> *) (m :: * -> *) a b. (Traversable t, Monad m) => (a -> m b) -> t a -> m (t b) mapM (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall (m :: * -> *) a. Monad m => a -> m a return (Transposed -> Deriver State Error NoteNumber Pitches.pitch_nn forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< RealTime -> Pitch -> Deriver Transposed Derive.resolve_pitch RealTime start)) [Either NoteNumber Pitch] fundamentals Fundamentals -> Stream Note -> Deriver (Stream Note) wind_idiom (forall a b. (a -> b) -> [a] -> [b] map NoteNumber -> Hz Pitch.nn_to_hz [NoteNumber] fundamentals) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b =<< Deriver (Stream Note) deriver type Fundamentals = [Pitch.Hz] wind_idiom :: Fundamentals -> Stream.Stream Score.Event -> Derive.NoteDeriver wind_idiom :: Fundamentals -> Stream Note -> Deriver (Stream Note) wind_idiom Fundamentals fundamentals = forall (m :: * -> *) a. Monad m => a -> m a return forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> Stream a -> Stream b Post.emap1_ (Fundamentals -> (Maybe Note, Note) -> Note process Fundamentals fundamentals) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. ([a] -> [b]) -> Stream a -> Stream (b, a) Stream.zip_on (forall a b. (a -> b) -> [a] -> [b] map forall a. [a] -> Maybe a Lists.head forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. [a] -> [[a]] Post.nexts) fundamentals_env :: Sig.Parser [Either Pitch.NoteNumber PSignal.Pitch] fundamentals_env :: Parser [Either NoteNumber Pitch] fundamentals_env = forall a. (a -> Maybe Text) -> Parser a -> Parser a Sig.check forall {t :: * -> *} {a} {a}. (Foldable t, IsString a) => t a -> Maybe a non_empty forall a b. (a -> b) -> a -> b $ forall a deflt. (Typecheck a, ToVal deflt) => ArgName -> EnvironDefault -> deflt -> Doc -> Parser a Sig.environ ArgName "fundamentals" EnvironDefault Sig.Unprefixed ([] :: [Pitch.NoteNumber]) Doc "Fundamentals for this instrument." where non_empty :: t a -> Maybe a non_empty t a xs | forall (t :: * -> *) a. Foldable t => t a -> Bool null t a xs = forall a. a -> Maybe a Just a "fundamentals required" | Bool otherwise = forall a. Maybe a Nothing -- | On each event, find the closest (fundamental, harmonic) for this pitch and -- the next event's pitch. On the next note's start time, shift the pitch to -- same harmonic on the next note's fundamental. process :: Fundamentals -> (Maybe Score.Event, Score.Event) -> Score.Event process :: Fundamentals -> (Maybe Note, Note) -> Note process Fundamentals fundamentals (Maybe Note maybe_next, Note event) = forall a. a -> Maybe a -> a fromMaybe Note event forall a b. (a -> b) -> a -> b $ do Note next <- Maybe Note maybe_next (Hz next_fundamental, Int _) <- Fundamentals -> Note -> Maybe (Hz, Int) harmonic_of Fundamentals fundamentals Note next (Hz _, Int this_harmonic) <- Fundamentals -> Note -> Maybe (Hz, Int) harmonic_of Fundamentals fundamentals Note event forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ RealTime -> Hz -> Note -> Note tweak_pitch (Note -> RealTime Score.event_start Note next) (Hz next_fundamental Hz -> Int -> Hz *# Int this_harmonic) Note event harmonic_of :: Fundamentals -> Score.Event -> Maybe (Pitch.Hz, Int) harmonic_of :: Fundamentals -> Note -> Maybe (Hz, Int) harmonic_of Fundamentals fundamentals = Fundamentals -> Hz -> Maybe (Hz, Int) find_harmonic Fundamentals fundamentals forall b c a. (b -> c) -> (a -> b) -> a -> c . NoteNumber -> Hz Pitch.nn_to_hz forall (m :: * -> *) b c a. Monad m => (b -> m c) -> (a -> m b) -> a -> m c <=< Note -> Maybe NoteNumber Score.initial_nn find_harmonic :: Fundamentals -> Pitch.Hz -> Maybe (Pitch.Hz, Int) find_harmonic :: Fundamentals -> Hz -> Maybe (Hz, Int) find_harmonic Fundamentals fundamentals Hz hz = forall {b}. [(Hz, b)] -> Maybe b closest forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map Hz -> (Hz, (Hz, Int)) find Fundamentals fundamentals where -- I always pick the closest match, but I also want a lower harmonic. -- Hopefully this doesn't matter in practice, since fundamentals generally -- aren't multiples of each other. closest :: [(Hz, b)] -> Maybe b closest = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b fmap forall a b. (a, b) -> b snd forall b c a. (b -> c) -> (a -> b) -> a -> c . forall k a. Ord k => (a -> k) -> [a] -> Maybe a Lists.minimumOn (forall a. Num a => a -> a abs forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a, b) -> a fst) find :: Hz -> (Hz, (Hz, Int)) find Hz f = Int -> (Hz, (Hz, Int)) go Int 1 where go :: Int -> (Hz, (Hz, Int)) go Int harm | Hz f Hz -> Int -> Hz *# (Int harmforall a. Num a => a -> a -> a +Int 1) forall a. Num a => a -> a -> a - Hz eta forall a. Num a => a -> a -> a * (forall a b. (Integral a, Num b) => a -> b fromIntegral Int harm forall a. Num a => a -> a -> a + Hz 1) forall a. Ord a => a -> a -> Bool > Hz hz = (Hz hz forall a. Num a => a -> a -> a - Hz f Hz -> Int -> Hz *# Int harm, (Hz f, Int harm)) | Bool otherwise = Int -> (Hz, (Hz, Int)) go (Int harmforall a. Num a => a -> a -> a +Int 1) -- Hz is a little imprecise, so while I want to pick the closest harmonic -- below 'hz', I can pick one above if it's only a little above. Also, any -- imprecision in the original fundamental will be multiplied with the -- harmonic, so I can multiply the eta too. eta :: Hz eta = Hz 0.25 -- | Hz raised to the nth harmonic. (*#) :: Pitch.Hz -> Int -> Pitch.Hz Hz fundamental *# :: Hz -> Int -> Hz *# Int harmonic = Hz fundamental forall a. Num a => a -> a -> a * forall a b. (Integral a, Num b) => a -> b fromIntegral Int harmonic tweak_pitch :: RealTime -> Pitch.Hz -> Score.Event -> Score.Event tweak_pitch :: RealTime -> Hz -> Note -> Note tweak_pitch RealTime pos Hz hz Note event = PSignal -> Note -> Note Score.set_pitch (Note -> PSignal Score.event_pitch Note event forall a. Semigroup a => a -> a -> a <> PSignal tweak) Note event where tweak :: PSignal tweak = RealTime -> Pitch -> PSignal PSignal.from_sample RealTime pos (NoteNumber -> Pitch PSignal.nn_pitch (Hz -> NoteNumber Pitch.hz_to_nn Hz hz))