-- 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 {- | This module defines basic tracklang types. The Derive.PSignal section is re-exported from "Derive.PSignal". I'd rather move it to PSignal, but it needs to be here to avoid circular imports. Here are the names for various aspects of signals: > numbers pitches both > scalar Signal.Y PSignal.Y > name ScoreT.Control ScoreT.PControl > signal Signal.Control PSignal.PSignal > ref DeriveT.ControlRef DeriveT.PControlRef Ref -} module Derive.DeriveT ( -- * Derive.PSignal PSignal(..) , _signal , interpolate , Pitch , Transposed , RawPitch(..) , pitch , coerce , pitch_nn, pitch_note , PitchConfig(..) , Scale(..) , detailed_error , PitchError(..) , OutOfRange(..) , out_of_range, out_of_range_error , pitches_equal -- * Duration , Duration(..) , TimeType(..) , multiply_duration -- * Environ , Environ(..) , null , insert , lookup , environ_attributes -- * Val , Val(..) , vals_equal , types_equal , val_to_mini , Quoted(..) , show_call_val -- ** val utils , num , constant_val , constant , score_time, real_time , transposition , str , to_scale_id , quoted, quoted0 -- * Ref , ControlRef, PControlRef, Ref(..) -- * Expr , Expr, Call, Term , PitchCall -- ** call utils , map_str -- * type aliases , PitchMap , PitchFunction -- * ControlFunction , CFunction(..) , call_cfunction , PFunction(..) , Dynamic(..) , empty_dynamic ) where import Prelude hiding (lookup, null) import qualified Control.DeepSeq as DeepSeq import qualified Data.Coerce as Coerce import qualified Data.List.NonEmpty as NonEmpty import qualified Data.Map.Strict as Map import qualified Data.Set as Set import qualified Data.Text as Text import qualified Util.Num as Num import qualified Util.Pretty as Pretty import qualified Util.Segment as Segment import qualified Util.Lists as Lists import qualified Util.Serialize as Serialize import qualified Derive.Attrs as Attrs import qualified Derive.EnvKey as EnvKey import qualified Derive.Expr as Expr import qualified Derive.ScoreT as ScoreT import qualified Derive.ShowVal as ShowVal import qualified Derive.Warp as Warp import qualified Perform.Pitch as Pitch import qualified Perform.RealTime as RealTime import qualified Perform.Signal as Signal import qualified Ui.Ruler as Ruler import qualified Ui.ScoreTime as ScoreTime import Global import Types {- This file is pretty much unreducable, as far as dependencies go: For TrackLang: ControlFunction -> Environ -> Val <- ControlFunction For PSignal: PitchConfig -> Environ -> Val <- Pitch <- PitchConfig So 'ControlFunction', 'Pitch', and 'Val' must all be together. 'Signal' also gets dragged in, and winds up being everything in this file. The real key is Val, which has a ControlFunction, which means ControlFunction can't be in Deriver (since Deriver.Monad imports this), and PControlRef, which requires PSignal. -} -- * Derive.PSignal -- | A pitch signal is similar to a 'Signal.Control', except that its values -- are 'Pitch'es instead of plain floating point values. newtype PSignal = PSignal (Segment.Boxed Pitch) deriving (Int -> PSignal -> ShowS [PSignal] -> ShowS PSignal -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [PSignal] -> ShowS $cshowList :: [PSignal] -> ShowS show :: PSignal -> String $cshow :: PSignal -> String showsPrec :: Int -> PSignal -> ShowS $cshowsPrec :: Int -> PSignal -> ShowS Show, [PSignal] -> Doc PSignal -> Text PSignal -> Doc forall a. (a -> Text) -> (a -> Doc) -> ([a] -> Doc) -> Pretty a formatList :: [PSignal] -> Doc $cformatList :: [PSignal] -> Doc format :: PSignal -> Doc $cformat :: PSignal -> Doc pretty :: PSignal -> Text $cpretty :: PSignal -> Text Pretty) _signal :: PSignal -> Segment.Boxed Pitch _signal :: PSignal -> Boxed Pitch _signal (PSignal Boxed Pitch sig) = Boxed Pitch sig instance Semigroup PSignal where PSignal s1 <> :: PSignal -> PSignal -> PSignal <> PSignal s2 | forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> Bool Segment.null (PSignal -> Boxed Pitch _signal PSignal s1) = PSignal s2 | forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> Bool Segment.null (PSignal -> Boxed Pitch _signal PSignal s2) = PSignal s1 | Bool otherwise = forall a. Monoid a => [a] -> a mconcat [PSignal s1, PSignal s2] instance Monoid PSignal where mempty :: PSignal mempty = Boxed Pitch -> PSignal PSignal forall (v :: * -> *) a. Vector v a => Signal (v a) Segment.empty mappend :: PSignal -> PSignal -> PSignal mappend = forall a. Semigroup a => a -> a -> a (<>) mconcat :: [PSignal] -> PSignal mconcat [] = forall a. Monoid a => a mempty mconcat [PSignal] sigs = Boxed Pitch -> PSignal PSignal forall a b. (a -> b) -> a -> b $ forall (v :: * -> *) y. Vector v (Sample y) => Maybe (y -> y -> Bool) -> Interpolate y -> [SignalS v y] -> SignalS v y Segment.concat forall a. Maybe a Nothing Interpolate Pitch interpolate forall a b. (a -> b) -> a -> b $ forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> Bool Segment.null) forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map PSignal -> Boxed Pitch _signal [PSignal] sigs instance DeepSeq.NFData PSignal where rnf :: PSignal -> () rnf (PSignal Boxed Pitch vec) = Boxed Pitch vec seq :: forall a b. a -> b -> b `seq` () -- | A pitch interpolated a certain distance between two other pitches. interpolate :: Segment.Interpolate Pitch interpolate :: Interpolate Pitch interpolate (Segment.Sample RealTime x1 Pitch p1) (Segment.Sample RealTime x2 Pitch p2) RealTime x | RealTime x forall a. Ord a => a -> a -> Bool <= RealTime x1 = Pitch p1 | RealTime x forall a. Ord a => a -> a -> Bool >= RealTime x2 = Pitch p2 | Bool otherwise = Pitch { pitch_eval_nn :: PitchConfig -> Either PitchError NoteNumber pitch_eval_nn = PitchConfig -> Either PitchError NoteNumber nn , pitch_eval_note :: PitchConfig -> Either PitchError Note pitch_eval_note = PitchConfig -> Either PitchError Note note , pitch_scale :: Scale pitch_scale = forall a. RawPitch a -> Scale pitch_scale Pitch p1 , pitch_config :: PitchConfig pitch_config = forall a. Monoid a => a mempty } where nn :: PitchConfig -> Either PitchError NoteNumber nn PitchConfig config = do NoteNumber p1_nn <- Transposed -> Either PitchError NoteNumber pitch_nn forall a b. (a -> b) -> a -> b $ forall a b. RawPitch a -> RawPitch b coerce forall a b. (a -> b) -> a -> b $ forall {a} {a}. PitchConfig -> RawPitch a -> RawPitch a apply_config PitchConfig config Pitch p1 NoteNumber p2_nn <- Transposed -> Either PitchError NoteNumber pitch_nn forall a b. (a -> b) -> a -> b $ forall a b. RawPitch a -> RawPitch b coerce forall a b. (a -> b) -> a -> b $ forall {a} {a}. PitchConfig -> RawPitch a -> RawPitch a apply_config PitchConfig config Pitch p2 forall (m :: * -> *) a. Monad m => a -> m a return forall a b. (a -> b) -> a -> b $ forall a. (Eq a, Num a) => a -> a -> a -> a Num.scale NoteNumber p1_nn NoteNumber p2_nn forall a b. (a -> b) -> a -> b $ Y -> NoteNumber Pitch.NoteNumber forall a b. (a -> b) -> a -> b $ RealTime -> Y RealTime.to_seconds forall a b. (a -> b) -> a -> b $ forall a. (Eq a, Fractional a) => a -> a -> a -> a Num.normalize RealTime x1 RealTime x2 RealTime x note :: PitchConfig -> Either PitchError Note note PitchConfig config = Transposed -> Either PitchError Note pitch_note forall a b. (a -> b) -> a -> b $ forall a b. RawPitch a -> RawPitch b coerce forall a b. (a -> b) -> a -> b $ forall {a} {a}. PitchConfig -> RawPitch a -> RawPitch a apply_config PitchConfig config forall a b. (a -> b) -> a -> b $ if RealTime x forall a. Ord a => a -> a -> Bool < RealTime x1 then Pitch p1 else Pitch p2 apply_config :: PitchConfig -> RawPitch a -> RawPitch a apply_config PitchConfig c RawPitch a pitch = RawPitch a pitch { pitch_config :: PitchConfig pitch_config = PitchConfig c forall a. Semigroup a => a -> a -> a <> forall a. RawPitch a -> PitchConfig pitch_config RawPitch a pitch } {- | This is an untransposed pitch. All pitches have transposition signals from the dynamic state applied when they are converted to MIDI or whatever backend. So if I want the final concrete pitch, I have to apply the transposition signals. But if I want to emit a note with this pitch, I want the untransposed one, or the transposition will be applied twice. I use a phantom type parameter to keep them straight. -} type Pitch = RawPitch Untransposed_ -- | The transposed version of 'Pitch'. type Transposed = RawPitch Transposed_ data Transposed_ data Untransposed_ -- | A pitch is an abstract value that can generate a 'Pitch.NoteNumber' or -- symbolic 'Pitch.Note'. data RawPitch a = Pitch { forall a. RawPitch a -> PitchConfig -> Either PitchError NoteNumber pitch_eval_nn :: !(PitchConfig -> Either PitchError Pitch.NoteNumber) , forall a. RawPitch a -> PitchConfig -> Either PitchError Note pitch_eval_note :: !(PitchConfig -> Either PitchError Pitch.Note) , forall a. RawPitch a -> Scale pitch_scale :: !Scale , forall a. RawPitch a -> PitchConfig pitch_config :: !PitchConfig } -- | Make an abstract Pitch. pitch :: Scale -> (PitchConfig -> Either PitchError Pitch.NoteNumber) -> (PitchConfig -> Either PitchError Pitch.Note) -> PitchConfig -> Pitch pitch :: Scale -> (PitchConfig -> Either PitchError NoteNumber) -> (PitchConfig -> Either PitchError Note) -> PitchConfig -> Pitch pitch Scale scale PitchConfig -> Either PitchError NoteNumber nn PitchConfig -> Either PitchError Note note PitchConfig config = Pitch { pitch_eval_nn :: PitchConfig -> Either PitchError NoteNumber pitch_eval_nn = PitchConfig -> Either PitchError NoteNumber nn , pitch_eval_note :: PitchConfig -> Either PitchError Note pitch_eval_note = PitchConfig -> Either PitchError Note note , pitch_scale :: Scale pitch_scale = Scale scale , pitch_config :: PitchConfig pitch_config = PitchConfig config } coerce :: RawPitch a -> RawPitch b coerce :: forall a b. RawPitch a -> RawPitch b coerce = coerce :: forall a b. Coercible a b => a -> b Coerce.coerce -- | Usually I only want to evaluate a fully transposed pitch. Exceptions -- are documented by applying 'coerce'. pitch_nn :: Transposed -> Either PitchError Pitch.NoteNumber pitch_nn :: Transposed -> Either PitchError NoteNumber pitch_nn Transposed pitch = do NoteNumber nn <- forall a. RawPitch a -> PitchConfig -> Either PitchError NoteNumber pitch_eval_nn Transposed pitch (forall a. RawPitch a -> PitchConfig pitch_config Transposed pitch) forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first (forall a. RawPitch a -> Maybe NoteNumber -> PitchError -> PitchError annotate_out_of_range Transposed pitch (forall a. a -> Maybe a Just NoteNumber nn)) forall a b. (a -> b) -> a -> b $ if NoteNumber 0 forall a. Ord a => a -> a -> Bool <= NoteNumber nn Bool -> Bool -> Bool && NoteNumber nn forall a. Ord a => a -> a -> Bool <= NoteNumber 127 then forall (m :: * -> *) a. Monad m => a -> m a return NoteNumber nn else forall a b. a -> Either a b Left forall a b. (a -> b) -> a -> b $ OutOfRange -> PitchError OutOfRangeError OutOfRange out_of_range -- | Usually I only want to evaluate a fully transposed pitch. Exceptions -- are documented by applying 'coerce'. pitch_note :: Transposed -> Either PitchError Pitch.Note pitch_note :: Transposed -> Either PitchError Note pitch_note Transposed pitch = forall (p :: * -> * -> *) a b c. Bifunctor p => (a -> b) -> p a c -> p b c first (forall a. RawPitch a -> Maybe NoteNumber -> PitchError -> PitchError annotate_out_of_range Transposed pitch forall a. Maybe a Nothing) forall a b. (a -> b) -> a -> b $ forall a. RawPitch a -> PitchConfig -> Either PitchError Note pitch_eval_note Transposed pitch (forall a. RawPitch a -> PitchConfig pitch_config Transposed pitch) annotate_out_of_range :: RawPitch a -> Maybe Pitch.NoteNumber -> PitchError -> PitchError annotate_out_of_range :: forall a. RawPitch a -> Maybe NoteNumber -> PitchError -> PitchError annotate_out_of_range RawPitch a pitch Maybe NoteNumber maybe_nn = (OutOfRange -> OutOfRange) -> PitchError -> PitchError modify_out_of_range forall a b. (a -> b) -> a -> b $ \OutOfRange err -> OutOfRange err { oor_nn :: Maybe NoteNumber oor_nn = Maybe NoteNumber maybe_nn , oor_transposers :: ControlValMap oor_transposers = ControlValMap filtered forall a. Semigroup a => a -> a -> a <> OutOfRange -> ControlValMap oor_transposers OutOfRange err } where filtered :: ControlValMap filtered = forall k a. (k -> a -> Bool) -> Map k a -> Map k a Map.filterWithKey (\Control k Y v -> Control k forall a. Ord a => a -> Set a -> Bool `Set.member` Set Control transposers Bool -> Bool -> Bool && Y v forall a. Eq a => a -> a -> Bool /= Y 0) ControlValMap cmap PitchConfig Environ _ ControlValMap cmap = forall a. RawPitch a -> PitchConfig pitch_config RawPitch a pitch transposers :: Set Control transposers = Scale -> Set Control pscale_transposers (forall a. RawPitch a -> Scale pitch_scale RawPitch a pitch) {- | A PitchConfig is the data that can continue to influence the pitch's frequency. Pitches are configured by controls and by an environ. The controls are for values that change over time, such as transposition or tuning. They're combined additively, which is really only appropriate for transposition. Controls are mostly applied only on conversion to the performer. TODO I don't entirely remember why. However, this leads to some trickiness because if I want to compare a pitch to an absolute NoteNumber, I need the final transposed value, but if I put it in an event it must be untransposed, or transposition will be applied twice. To avoid double. To avoid this, there's a phantom type parameter to distinguish an untransposed 'Pitch' from a 'Transposed' one. The Environ is for symbolic configuration, such as key or tuning mode. Unlike controls, though, it's taken from the environ in scope when the pith is created. Otherwise, you can't evaluate a pitch with a different key by setting the environ. -} data PitchConfig = PitchConfig !Environ !ScoreT.ControlValMap deriving (Int -> PitchConfig -> ShowS [PitchConfig] -> ShowS PitchConfig -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [PitchConfig] -> ShowS $cshowList :: [PitchConfig] -> ShowS show :: PitchConfig -> String $cshow :: PitchConfig -> String showsPrec :: Int -> PitchConfig -> ShowS $cshowsPrec :: Int -> PitchConfig -> ShowS Show) instance Semigroup PitchConfig where PitchConfig Environ env1 ControlValMap c1 <> :: PitchConfig -> PitchConfig -> PitchConfig <> PitchConfig Environ env2 ControlValMap c2 = Environ -> ControlValMap -> PitchConfig PitchConfig (Environ env1 forall a. Semigroup a => a -> a -> a <> Environ env2) (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a Map.unionWith forall a. Num a => a -> a -> a (+) ControlValMap c1 ControlValMap c2) instance Monoid PitchConfig where mempty :: PitchConfig mempty = Environ -> ControlValMap -> PitchConfig PitchConfig forall a. Monoid a => a mempty forall a. Monoid a => a mempty mappend :: PitchConfig -> PitchConfig -> PitchConfig mappend = forall a. Semigroup a => a -> a -> a (<>) -- | PSignal can't take a Scale because that would be a circular import. -- Fortunately it only needs a few fields. However, because of the -- circularity, the Scale.Scale -> PSignal.Scale constructor is in -- "Derive.Derive". data Scale = Scale { -- | It can be useful to see the scale of a pitch, e.g. to create more -- pitches in the same scale as an existing pitch. Scale -> ScaleId pscale_scale_id :: !Pitch.ScaleId -- | The set of transposer signals for this scale, as documented in -- 'Derive.Scale.scale_transposers'. -- -- They are stored here because they're needed by 'to_nn'. I could -- store them separately, e.g. in the 'Score.Event' alongside the -- event_pitch, but the scale at event creation time is not guaranteed to -- be the same as the one when the pitch was created, so the safest thing -- to do is keep it with the pitch itself. , Scale -> Set Control pscale_transposers :: !(Set ScoreT.Control) } deriving (Int -> Scale -> ShowS [Scale] -> ShowS Scale -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Scale] -> ShowS $cshowList :: [Scale] -> ShowS show :: Scale -> String $cshow :: Scale -> String showsPrec :: Int -> Scale -> ShowS $cshowsPrec :: Int -> Scale -> ShowS Show) instance Pretty Scale where pretty :: Scale -> Text pretty = forall a. Pretty a => a -> Text pretty forall b c a. (b -> c) -> (a -> b) -> a -> c . Scale -> ScaleId pscale_scale_id -- | It can't be reduced since it has lambdas, but at least this way you can -- easily rnf things that contain it. instance DeepSeq.NFData (RawPitch a) where rnf :: RawPitch a -> () rnf RawPitch a _ = () instance Show (RawPitch a) where -- Show just the NN, so this is parseable by Util.PPrint. show :: RawPitch a -> String show RawPitch a p = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall a. Show a => a -> String show forall a. Pretty a => a -> String prettys (Transposed -> Either PitchError NoteNumber pitch_nn (forall a b. RawPitch a -> RawPitch b coerce RawPitch a p)) -- | Will look like: 62.95nn,4i(*wayang) instance Pretty (RawPitch a) where pretty :: RawPitch a -> Text pretty RawPitch a p = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall a. Show a => a -> Text showt forall a. Pretty a => a -> Text pretty (Transposed -> Either PitchError NoteNumber pitch_nn (forall a b. RawPitch a -> RawPitch b coerce RawPitch a p)) forall a. Semigroup a => a -> a -> a <> Text "," forall a. Semigroup a => a -> a -> a <> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall a. Show a => a -> Text showt Note -> Text Pitch.note_text (Transposed -> Either PitchError Note pitch_note (forall a b. RawPitch a -> RawPitch b coerce RawPitch a p)) forall a. Semigroup a => a -> a -> a <> Text "(" forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty (forall a. RawPitch a -> Scale pitch_scale RawPitch a p) forall a. Semigroup a => a -> a -> a <> Text ")" -- | Pitches have no literal syntax, but I have to print something. instance ShowVal.ShowVal (RawPitch a) where show_val :: RawPitch a -> Text show_val RawPitch a pitch = Text "<pitch: " forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty RawPitch a pitch forall a. Semigroup a => a -> a -> a <> Text ">" -- | Annotate a PitchError with additional info. TODO I should probably -- accumulate info all the way up to get a full "stack trace" of what happened -- to a pitch (e.g. interpolation), which maybe means abandon PitchError and -- just use Text, or go ever further with structure? Meanwhile, this seems -- to do ok practically speaking. detailed_error :: RawPitch a -> PitchError -> Text detailed_error :: forall a. RawPitch a -> PitchError -> Text detailed_error RawPitch a pitch PitchError err = forall a. Monoid a => [a] -> a mconcat [ forall a. Pretty a => a -> Text pretty (Scale -> ScaleId pscale_scale_id Scale scale) , Text ":" , forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either forall a. Pretty a => a -> Text pretty forall a. Pretty a => a -> Text pretty forall a b. (a -> b) -> a -> b $ forall a. RawPitch a -> PitchConfig -> Either PitchError Note pitch_eval_note RawPitch a pitch forall a. Monoid a => a mempty -- TODO the cmap includes non-transposing , if forall k a. Map k a -> Bool Map.null ControlValMap cmap then Text "" else Text " with transposition: " forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty ControlValMap cmap , Text ": ", forall a. Pretty a => a -> Text pretty PitchError err ] where PitchConfig Environ _env ControlValMap cmap_all = forall a. RawPitch a -> PitchConfig pitch_config RawPitch a pitch cmap :: ControlValMap cmap = forall k a b. Ord k => Map k a -> Map k b -> Map k a Map.intersection ControlValMap cmap_all (forall k a. (k -> a) -> Set k -> Map k a Map.fromSet (forall a b. a -> b -> a const ()) (Scale -> Set Control pscale_transposers Scale scale)) scale :: Scale scale = forall a. RawPitch a -> Scale pitch_scale RawPitch a pitch -- | Things that can go wrong evaluating a pitch. data PitchError = UnparseableNote !Pitch.Note | OutOfRangeError !OutOfRange -- | Input note doesn't map to a scale note. | InvalidInput -- | A required environ value was missing or had the wrong type or value. -- Nothing if the value is missing, otherwise a Text description. | EnvironError !EnvKey.Key !(Maybe Text) -- | Same as EnvironError, but for control vals. | ControlError !ScoreT.Control !Text -- | The scale doesn't implement that operation. | NotImplemented -- | Other kind of error. | PitchError !Text deriving (PitchError -> PitchError -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: PitchError -> PitchError -> Bool $c/= :: PitchError -> PitchError -> Bool == :: PitchError -> PitchError -> Bool $c== :: PitchError -> PitchError -> Bool Eq, Eq PitchError PitchError -> PitchError -> Bool PitchError -> PitchError -> Ordering PitchError -> PitchError -> PitchError forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: PitchError -> PitchError -> PitchError $cmin :: PitchError -> PitchError -> PitchError max :: PitchError -> PitchError -> PitchError $cmax :: PitchError -> PitchError -> PitchError >= :: PitchError -> PitchError -> Bool $c>= :: PitchError -> PitchError -> Bool > :: PitchError -> PitchError -> Bool $c> :: PitchError -> PitchError -> Bool <= :: PitchError -> PitchError -> Bool $c<= :: PitchError -> PitchError -> Bool < :: PitchError -> PitchError -> Bool $c< :: PitchError -> PitchError -> Bool compare :: PitchError -> PitchError -> Ordering $ccompare :: PitchError -> PitchError -> Ordering Ord, Int -> PitchError -> ShowS [PitchError] -> ShowS PitchError -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [PitchError] -> ShowS $cshowList :: [PitchError] -> ShowS show :: PitchError -> String $cshow :: PitchError -> String showsPrec :: Int -> PitchError -> ShowS $cshowsPrec :: Int -> PitchError -> ShowS Show) {- | Note out of the scale's range. The values are transpositions from the environment, in case it was out of range because of a transposition. Some scales have a restricted range, in which case they should throw 'out_of_range', which 'pitch_nn' and 'pitch_note' will annotate with the transposition signals. Other scales have unlimited range, in which case they're limited by the backend. In this case 'pitch_nn' checks 0--127, which happens to be MIDI's limitation. -} data OutOfRange = OutOfRange { OutOfRange -> Maybe NoteNumber oor_nn :: !(Maybe Pitch.NoteNumber) , OutOfRange -> Maybe Y oor_degree :: !(Maybe Pitch.FSemi) , OutOfRange -> Maybe (Int, Int) oor_valid :: !(Maybe (Int, Int)) , OutOfRange -> ControlValMap oor_transposers :: !ScoreT.ControlValMap } deriving (OutOfRange -> OutOfRange -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: OutOfRange -> OutOfRange -> Bool $c/= :: OutOfRange -> OutOfRange -> Bool == :: OutOfRange -> OutOfRange -> Bool $c== :: OutOfRange -> OutOfRange -> Bool Eq, Eq OutOfRange OutOfRange -> OutOfRange -> Bool OutOfRange -> OutOfRange -> Ordering OutOfRange -> OutOfRange -> OutOfRange forall a. Eq a -> (a -> a -> Ordering) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> Bool) -> (a -> a -> a) -> (a -> a -> a) -> Ord a min :: OutOfRange -> OutOfRange -> OutOfRange $cmin :: OutOfRange -> OutOfRange -> OutOfRange max :: OutOfRange -> OutOfRange -> OutOfRange $cmax :: OutOfRange -> OutOfRange -> OutOfRange >= :: OutOfRange -> OutOfRange -> Bool $c>= :: OutOfRange -> OutOfRange -> Bool > :: OutOfRange -> OutOfRange -> Bool $c> :: OutOfRange -> OutOfRange -> Bool <= :: OutOfRange -> OutOfRange -> Bool $c<= :: OutOfRange -> OutOfRange -> Bool < :: OutOfRange -> OutOfRange -> Bool $c< :: OutOfRange -> OutOfRange -> Bool compare :: OutOfRange -> OutOfRange -> Ordering $ccompare :: OutOfRange -> OutOfRange -> Ordering Ord, Int -> OutOfRange -> ShowS [OutOfRange] -> ShowS OutOfRange -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [OutOfRange] -> ShowS $cshowList :: [OutOfRange] -> ShowS show :: OutOfRange -> String $cshow :: OutOfRange -> String showsPrec :: Int -> OutOfRange -> ShowS $cshowsPrec :: Int -> OutOfRange -> ShowS Show) out_of_range :: OutOfRange out_of_range :: OutOfRange out_of_range = Maybe NoteNumber -> Maybe Y -> Maybe (Int, Int) -> ControlValMap -> OutOfRange OutOfRange forall a. Maybe a Nothing forall a. Maybe a Nothing forall a. Maybe a Nothing forall a. Monoid a => a mempty modify_out_of_range :: (OutOfRange -> OutOfRange) -> PitchError -> PitchError modify_out_of_range :: (OutOfRange -> OutOfRange) -> PitchError -> PitchError modify_out_of_range OutOfRange -> OutOfRange modify (OutOfRangeError OutOfRange err) = OutOfRange -> PitchError OutOfRangeError (OutOfRange -> OutOfRange modify OutOfRange err) modify_out_of_range OutOfRange -> OutOfRange _ PitchError err = PitchError err out_of_range_error :: Real a => a -> (Int, Int) -> PitchError out_of_range_error :: forall a. Real a => a -> (Int, Int) -> PitchError out_of_range_error a semi (Int, Int) valid = OutOfRange -> PitchError OutOfRangeError forall a b. (a -> b) -> a -> b $ OutOfRange { oor_nn :: Maybe NoteNumber oor_nn = forall a. Maybe a Nothing , oor_degree :: Maybe Y oor_degree = forall a. a -> Maybe a Just (forall a b. (Real a, Fractional b) => a -> b realToFrac a semi) , oor_valid :: Maybe (Int, Int) oor_valid = forall a. a -> Maybe a Just (Int, Int) valid , oor_transposers :: ControlValMap oor_transposers = forall a. Monoid a => a mempty } instance Pretty PitchError where pretty :: PitchError -> Text pretty PitchError err = case PitchError err of UnparseableNote Note note -> Text "unparseable note: " forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty Note note OutOfRangeError OutOfRange err -> forall a. Pretty a => a -> Text pretty OutOfRange err PitchError InvalidInput -> Text "invalid input" EnvironError Text key Maybe Text err -> Text "environ value for " forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty Text key forall a. Semigroup a => a -> a -> a <> Text ": " forall a. Semigroup a => a -> a -> a <> forall a. a -> Maybe a -> a fromMaybe Text "not found" Maybe Text err ControlError Control control Text err -> Text "control value for " forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty Control control forall a. Semigroup a => a -> a -> a <> Text ": " forall a. Semigroup a => a -> a -> a <> Text err PitchError NotImplemented -> Text "not implemented" PitchError Text msg -> Text msg instance Pretty OutOfRange where pretty :: OutOfRange -> Text pretty (OutOfRange Maybe NoteNumber nn Maybe Y semi Maybe (Int, Int) valid ControlValMap transposers) = [Text] -> Text Text.unwords forall a b. (a -> b) -> a -> b $ forall a. (a -> Bool) -> [a] -> [a] filter (Bool -> Bool not forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Bool Text.null) [ Text "pitch" , forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "" forall a. Pretty a => a -> Text pretty Maybe NoteNumber nn , forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "" (\Y n -> Text "scale degree " forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty Y n) Maybe Y semi , Text "out of range" , forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "" (\(Int a, Int b) -> forall a. Pretty a => a -> Text pretty Int a forall a. Semigroup a => a -> a -> a <> Text "--" forall a. Semigroup a => a -> a -> a <> forall a. Pretty a => a -> Text pretty Int b) Maybe (Int, Int) valid , if ControlValMap transposers forall a. Eq a => a -> a -> Bool == forall a. Monoid a => a mempty then Text "" else forall a. Pretty a => a -> Text pretty ControlValMap transposers ] instance Pretty PitchConfig where format :: PitchConfig -> Doc format (PitchConfig Environ env ControlValMap controls) = Doc -> [(Text, Doc)] -> Doc Pretty.record Doc "PitchConfig" [ (Text "environ", forall a. Pretty a => a -> Doc Pretty.format Environ env) , (Text "controls", forall a. Pretty a => a -> Doc Pretty.format ControlValMap controls) ] pitches_equal :: RawPitch a -> RawPitch a -> Bool pitches_equal :: forall a. RawPitch a -> RawPitch a -> Bool pitches_equal RawPitch a p1 RawPitch a p2 = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c either (forall a b. a -> b -> a const Bool False) forall a. a -> a id forall a b. (a -> b) -> a -> b $ NoteNumber -> NoteNumber -> Bool Pitch.nns_equal forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> Transposed -> Either PitchError NoteNumber pitch_nn (forall a b. RawPitch a -> RawPitch b coerce RawPitch a p1) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> Transposed -> Either PitchError NoteNumber pitch_nn (forall a b. RawPitch a -> RawPitch b coerce RawPitch a p2) -- * Duration -- | Some calls can operate in either RealTime or ScoreTime. data Duration = RealDuration RealTime | ScoreDuration ScoreTime deriving (Duration -> Duration -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: Duration -> Duration -> Bool $c/= :: Duration -> Duration -> Bool == :: Duration -> Duration -> Bool $c== :: Duration -> Duration -> Bool Eq, Int -> Duration -> ShowS [Duration] -> ShowS Duration -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Duration] -> ShowS $cshowList :: [Duration] -> ShowS show :: Duration -> String $cshow :: Duration -> String showsPrec :: Int -> Duration -> ShowS $cshowsPrec :: Int -> Duration -> ShowS Show) data TimeType = Real | Score deriving (TimeType -> TimeType -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: TimeType -> TimeType -> Bool $c/= :: TimeType -> TimeType -> Bool == :: TimeType -> TimeType -> Bool $c== :: TimeType -> TimeType -> Bool Eq, Int -> TimeType -> ShowS [TimeType] -> ShowS TimeType -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [TimeType] -> ShowS $cshowList :: [TimeType] -> ShowS show :: TimeType -> String $cshow :: TimeType -> String showsPrec :: Int -> TimeType -> ShowS $cshowsPrec :: Int -> TimeType -> ShowS Show) instance ShowVal.ShowVal Duration where show_val :: Duration -> Text show_val (RealDuration RealTime x) = forall a. ShowVal a => a -> Text ShowVal.show_val RealTime x show_val (ScoreDuration ScoreTime x) = forall a. ShowVal a => a -> Text ShowVal.show_val ScoreTime x instance Pretty Duration where pretty :: Duration -> Text pretty (RealDuration RealTime t) = forall a. Pretty a => a -> Text pretty RealTime t pretty (ScoreDuration ScoreTime t) = forall a. Pretty a => a -> Text pretty ScoreTime t -- | Duration can't be in Fractional since you can't multiple a RealDuration -- by a ScoreDuration, but scaling operations are still useful. multiply_duration :: Duration -> Double -> Duration multiply_duration :: Duration -> Y -> Duration multiply_duration (RealDuration RealTime t) Y n = RealTime -> Duration RealDuration (RealTime t forall a. Num a => a -> a -> a * Y -> RealTime RealTime.seconds Y n) multiply_duration (ScoreDuration ScoreTime t) Y n = ScoreTime -> Duration ScoreDuration (ScoreTime t forall a. Num a => a -> a -> a * Y -> ScoreTime ScoreTime.from_double Y n) -- * Environ newtype Environ = Environ (Map EnvKey.Key Val) deriving (Int -> Environ -> ShowS [Environ] -> ShowS Environ -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Environ] -> ShowS $cshowList :: [Environ] -> ShowS show :: Environ -> String $cshow :: Environ -> String showsPrec :: Int -> Environ -> ShowS $cshowsPrec :: Int -> Environ -> ShowS Show, NonEmpty Environ -> Environ Environ -> Environ -> Environ forall b. Integral b => b -> Environ -> Environ forall a. (a -> a -> a) -> (NonEmpty a -> a) -> (forall b. Integral b => b -> a -> a) -> Semigroup a stimes :: forall b. Integral b => b -> Environ -> Environ $cstimes :: forall b. Integral b => b -> Environ -> Environ sconcat :: NonEmpty Environ -> Environ $csconcat :: NonEmpty Environ -> Environ <> :: Environ -> Environ -> Environ $c<> :: Environ -> Environ -> Environ Semigroup, Semigroup Environ Environ [Environ] -> Environ Environ -> Environ -> Environ forall a. Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a mconcat :: [Environ] -> Environ $cmconcat :: [Environ] -> Environ mappend :: Environ -> Environ -> Environ $cmappend :: Environ -> Environ -> Environ mempty :: Environ $cmempty :: Environ Monoid, Environ -> () forall a. (a -> ()) -> NFData a rnf :: Environ -> () $crnf :: Environ -> () DeepSeq.NFData) -- Environ keys are always Text, and it's annoying to have quotes on them. instance Pretty Environ where format :: Environ -> Doc format (Environ Map Text Val env) = [(Doc, Doc)] -> Doc Pretty.formatMap forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map (forall (p :: * -> * -> *) a b c d. Bifunctor p => (a -> b) -> (c -> d) -> p a c -> p b d bimap Text -> Doc Pretty.text forall a. Pretty a => a -> Doc Pretty.format) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall k a. Map k a -> [(k, a)] Map.toList forall a b. (a -> b) -> a -> b $ Map Text Val env null :: Environ -> Bool null :: Environ -> Bool null (Environ Map Text Val env) = forall k a. Map k a -> Bool Map.null Map Text Val env -- | Insert a val directly, with no typechecking. insert :: EnvKey.Key -> Val -> Environ -> Environ insert :: Text -> Val -> Environ -> Environ insert Text name Val val (Environ Map Text Val env) = Map Text Val -> Environ Environ forall a b. (a -> b) -> a -> b $ forall k a. Ord k => k -> a -> Map k a -> Map k a Map.insert Text name Val val Map Text Val env lookup :: EnvKey.Key -> Environ -> Maybe Val lookup :: Text -> Environ -> Maybe Val lookup Text name (Environ Map Text Val env) = forall k a. Ord k => k -> Map k a -> Maybe a Map.lookup Text name Map Text Val env environ_attributes :: Environ -> Attrs.Attributes environ_attributes :: Environ -> Attributes environ_attributes Environ environ = case Text -> Environ -> Maybe Val lookup Text EnvKey.attributes Environ environ of Just (VAttributes Attributes attrs) -> Attributes attrs Maybe Val _ -> forall a. Monoid a => a mempty -- * Val -- | This is the type of first class values in the tracklang. It's main -- purpose is the type for arguments to tracklang calls, and val calls' return -- type. data Val = -- | A number with an optional type suffix. It also has a ratio style -- literal, though the output is still a floating point value, not a true -- ratio. -- -- Constant literal: @42.23@, @-.4@, @1c@, @-2.4d@, @3/2@, @-3/2@, @0x7f@. -- -- Signal literal: @(signal d 0 0 1 1)@. VSignal !(ScoreT.Typed Signal.Control) -- | No literal, but is returned from val calls, notably scale calls. | VPitch !Pitch | VPSignal !PSignal -- | A set of Attributes for an instrument. -- -- Literal: @+attr@, @+attr1+attr2@. | VAttributes !Attrs.Attributes -- | A control name. An optional value gives a default if the control -- isn't present. -- -- Literal: @%control@, @%control,.4@ | VControlRef !ControlRef -- | A pitch control name. The scale is taken from the environ. Unlike -- a control signal, the empty string is a valid signal name and means the -- default pitch signal. The @#@ val call is needed to make a pitch signal -- with a default. -- -- Literal: @\#@, @\#pitch@, @(# pitch (4c))@ | VPControlRef !PControlRef -- | A parsed 'Pitch.Note'. This is useful for things for which a textual -- 'Pitch.Note' is too high level and a numerical 'Pitch.NoteNumber' is too -- low level, like instrument ranges. -- -- Literal: @(pitch 4 0 1)@ -> 4c#. | VNotePitch !Pitch.Pitch -- | A string. There is an unquoted and a quoted form, parsed at -- 'Derive.Parse.p_unquoted_str' and 'Derive.Parse.p_str'. -- -- Literal: @func@, @\'hello\'@, @\'quinn\'\'s hat\'@ | VStr !Expr.Str -- | A quoted expression. Quoted calls are resolved by "Derive.Sig" when -- it typechecks arguments. This way you can set an argument default to -- an expression that will be evaluated every time the call occurs. -- Derive.Sig expects that the expression is a valid val call, which means -- no pipes. -- -- Literal: @\"(a b c)@ | VQuoted !Quoted | VCFunction !CFunction | VPFunction !PFunction -- | An explicit not-given arg for functions so you can use positional -- args with defaults. -- -- Literal: @_@ | VNotGiven -- | A token used as a separator when calls want to parse their argument -- lists via their own complicated means. TODO only used by old gamakam, -- get rid of this -- -- Literal: @;@ | VSeparator -- | List of values. -- -- Literal: @(list)@, @(list 1 2)@, @(list (x) (y))@ | VList ![Val] deriving (Int -> Val -> ShowS [Val] -> ShowS Val -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Val] -> ShowS $cshowList :: [Val] -> ShowS show :: Val -> String $cshow :: Val -> String showsPrec :: Int -> Val -> ShowS $cshowsPrec :: Int -> Val -> ShowS Show) -- | Return Nothing if the Vals can't be compared, and whether or not they're -- equal otherwise. vals_equal :: Val -> Val -> Maybe Bool vals_equal :: Val -> Val -> Maybe Bool vals_equal Val x Val y = case (Val x, Val y) of (VSignal Typed Control a, VSignal Typed Control b) -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ Typed Control a forall a. Eq a => a -> a -> Bool == Typed Control b (VPitch Pitch a, VPitch Pitch b) -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ forall a. RawPitch a -> RawPitch a -> Bool pitches_equal Pitch a Pitch b -- I'm not going to implement this right now. vals_equal is only used in -- Conditional anyway, and who is going to be comparing pitch signals? (VPSignal PSignal _, VPSignal PSignal _) -> forall a. Maybe a Nothing (VAttributes Attributes a, VAttributes Attributes b) -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ Attributes a forall a. Eq a => a -> a -> Bool == Attributes b (VControlRef ControlRef a, VControlRef ControlRef b) -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ ControlRef a forall a. Eq a => a -> a -> Bool == ControlRef b -- This could use pitches_equal, but don't bother until I have a need for -- it. (VPControlRef PControlRef _, VPControlRef PControlRef _) -> forall a. Maybe a Nothing (VNotePitch Pitch a, VNotePitch Pitch b) -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ Pitch a forall a. Eq a => a -> a -> Bool == Pitch b (VStr Str a, VStr Str b) -> forall a. a -> Maybe a Just forall a b. (a -> b) -> a -> b $ Str a forall a. Eq a => a -> a -> Bool == Str b (VQuoted (Quoted Expr a), VQuoted (Quoted Expr b)) -> forall a. (a -> a -> Maybe Bool) -> [a] -> [a] -> Maybe Bool lists_equal Call Val -> Call Val -> Maybe Bool calls_equal (forall a. NonEmpty a -> [a] NonEmpty.toList Expr a) (forall a. NonEmpty a -> [a] NonEmpty.toList Expr b) (VCFunction CFunction _, VCFunction CFunction _) -> forall a. Maybe a Nothing (Val VNotGiven, Val VNotGiven) -> forall a. a -> Maybe a Just Bool True (Val VSeparator, Val VSeparator) -> forall a. a -> Maybe a Just Bool True (VList [Val] a, VList [Val] b) -> forall a. (a -> a -> Maybe Bool) -> [a] -> [a] -> Maybe Bool lists_equal Val -> Val -> Maybe Bool vals_equal [Val] a [Val] b (Val, Val) _ -> forall a. Maybe a Nothing types_equal :: Val -> Val -> Bool types_equal :: Val -> Val -> Bool types_equal Val x Val y = case (Val x, Val y) of (VSignal {}, VSignal {}) -> Bool True (VPitch {}, VPitch {}) -> Bool True (VPSignal {}, VPSignal {}) -> Bool True (VAttributes {}, VAttributes {}) -> Bool True (VControlRef {}, VControlRef {}) -> Bool True (VPControlRef {}, VPControlRef {}) -> Bool True (VNotePitch {}, VNotePitch {}) -> Bool True (VStr {}, VStr {}) -> Bool True (VQuoted {}, VQuoted {}) -> Bool True (VCFunction {}, VCFunction {}) -> Bool True (VPFunction {}, VPFunction {}) -> Bool True (Val VNotGiven, Val VNotGiven) -> Bool True (Val VSeparator, Val VSeparator) -> Bool True (VList {}, VList {}) -> Bool True (Val, Val) _ -> Bool False lists_equal :: (a -> a -> Maybe Bool) -> [a] -> [a] -> Maybe Bool lists_equal :: forall a. (a -> a -> Maybe Bool) -> [a] -> [a] -> Maybe Bool lists_equal a -> a -> Maybe Bool eq = [a] -> [a] -> Maybe Bool go where go :: [a] -> [a] -> Maybe Bool go (a a:[a] as) (a b:[a] bs) = forall b a. b -> (a -> b) -> Maybe a -> b maybe forall a. Maybe a Nothing (\Bool t -> if Bool t then [a] -> [a] -> Maybe Bool go [a] as [a] bs else forall a. a -> Maybe a Just Bool False) (a -> a -> Maybe Bool eq a a a b) go [a] _ [a] _ = forall a. a -> Maybe a Just Bool False val_to_mini :: Val -> Maybe Expr.MiniVal val_to_mini :: Val -> Maybe MiniVal val_to_mini = \case VStr Str a -> forall a. a -> Maybe a Just (Str -> MiniVal Expr.VStr Str a) VSignal Typed Control sig -> Typed Y -> MiniVal Expr.VNum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) (f :: * -> *) a b. (Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverse forall {k} (kind :: k). Signal kind -> Maybe Y Signal.constant_val Typed Control sig Val _ -> forall a. Maybe a Nothing -- | This instance is actually invalid due to showing VPitch, which has no -- literal, and for 'Val', showing 'PControlRef', which amounts to the same -- thing. I use this to treat any Val as a Str to re-evaluate it. Being -- invalid means that a VPitch or VPControlRef with a default will cause -- a parse failure, but I'll have to see if this becomes a problem in practice. instance ShowVal.ShowVal Val where show_val :: Val -> Text show_val = \case VSignal Typed Control sig -> Typed Control -> Text show_signal Typed Control sig VPitch Pitch pitch -> forall a. ShowVal a => a -> Text ShowVal.show_val Pitch pitch VPSignal PSignal sig -> PSignal -> Text show_psignal PSignal sig VAttributes Attributes attrs -> forall a. ShowVal a => a -> Text ShowVal.show_val Attributes attrs VControlRef ControlRef ref -> forall a. ShowVal a => a -> Text ShowVal.show_val ControlRef ref VPControlRef PControlRef ref -> forall a. ShowVal a => a -> Text ShowVal.show_val PControlRef ref VNotePitch Pitch pitch -> forall a. ShowVal a => a -> Text ShowVal.show_val Pitch pitch VStr Str str -> forall a. ShowVal a => a -> Text ShowVal.show_val Str str VQuoted Quoted quoted -> forall a. ShowVal a => a -> Text ShowVal.show_val Quoted quoted VCFunction CFunction f -> forall a. ShowVal a => a -> Text ShowVal.show_val CFunction f VPFunction PFunction f -> forall a. ShowVal a => a -> Text ShowVal.show_val PFunction f Val VNotGiven -> Text "_" Val VSeparator -> Text ";" VList [Val] vals -> forall a. ShowVal a => a -> Text ShowVal.show_val [Val] vals instance ShowVal.ShowVal (ScoreT.Typed Signal.Control) where show_val :: Typed Control -> Text show_val = Typed Control -> Text show_signal -- | ShowVal for VSignal. -- -- > 1c -- constant with chromatic type -- > (signal 0 1 1 1) -- [(0, 1), (1, 1)], untyped show_signal :: ScoreT.Typed Signal.Control -> Text show_signal :: Typed Control -> Text show_signal (ScoreT.Typed Type typ Control sig) | Just Y c <- forall {k} (kind :: k). Signal kind -> Maybe Y Signal.constant_val Control sig = forall a. ShowVal a => a -> Text ShowVal.show_val (forall a. Type -> a -> Typed a ScoreT.Typed Type typ Y c) | Bool otherwise = [Text] -> Text Text.unwords forall a b. (a -> b) -> a -> b $ forall a. (a -> a) -> [a] -> [a] Lists.mapLast (forall a. Semigroup a => a -> a -> a <>Text ")") forall a b. (a -> b) -> a -> b $ Text "(signal" forall a. a -> [a] -> [a] : forall a. (a -> Bool) -> [a] -> [a] filter (forall a. Eq a => a -> a -> Bool /=Text "") [forall a. ShowVal a => a -> Text ShowVal.show_val Type typ] forall a. [a] -> [a] -> [a] ++ [ forall a. ShowVal a => a -> Text ShowVal.show_val Y v | (RealTime x, Y y) <- forall {k} (kind :: k). Signal kind -> [(RealTime, Y)] Signal.to_pairs Control sig, Y v <- [RealTime -> Y RealTime.to_seconds RealTime x, Y y] ] instance ShowVal.ShowVal PSignal where show_val :: PSignal -> Text show_val = PSignal -> Text show_psignal -- | ShowVal for VPSignal. -- -- TODO probably bogus? ShowVal (RawPitch a) just punts and uses <>s -- Which this also uses. Ideal if I can get back to symbolic, like (4c). -- Otherwise, convert to nn, since symbolic depends on what's in scope? -- The fact that I never trip on <>s implies that improper ShowVal for -- pitch is not practically a problem. show_psignal :: PSignal -> Text show_psignal :: PSignal -> Text show_psignal PSignal sig | Just Pitch c <- PSignal -> Maybe Pitch constant_val PSignal sig = forall a. ShowVal a => a -> Text ShowVal.show_val Pitch c | Bool otherwise = [Text] -> Text Text.unwords forall a b. (a -> b) -> a -> b $ forall a. (a -> a) -> [a] -> [a] Lists.mapLast (forall a. Semigroup a => a -> a -> a <>Text ")") forall a b. (a -> b) -> a -> b $ Text "(psignal" forall a. a -> [a] -> [a] : [ Text s | (RealTime x, Pitch y) <- PSignal -> [(RealTime, Pitch)] to_pairs PSignal sig , Text s <- [forall a. ShowVal a => a -> Text ShowVal.show_val RealTime x, forall a. ShowVal a => a -> Text ShowVal.show_val Pitch y] ] where -- These are in PSignal, but have to be here too to avoid a circular -- import. constant_val :: PSignal -> Maybe Pitch constant_val :: PSignal -> Maybe Pitch constant_val = forall (v :: * -> *) a. Vector v (Sample a) => SignalS v a -> Maybe a Segment.constant_val forall b c a. (b -> c) -> (a -> b) -> a -> c . PSignal -> Boxed Pitch _signal to_pairs :: PSignal -> [(RealTime, Pitch)] to_pairs = forall (v :: * -> *) y. Vector v (Sample y) => SignalS v y -> [(RealTime, y)] Segment.to_pairs forall b c a. (b -> c) -> (a -> b) -> a -> c . PSignal -> Boxed Pitch _signal instance Pretty Val where pretty :: Val -> Text pretty = forall a. ShowVal a => a -> Text ShowVal.show_val instance DeepSeq.NFData Val where rnf :: Val -> () rnf (VStr Str s) = forall a. NFData a => a -> () DeepSeq.rnf Str s rnf Val _ = () newtype Quoted = Quoted Expr deriving (Int -> Quoted -> ShowS [Quoted] -> ShowS Quoted -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Quoted] -> ShowS $cshowList :: [Quoted] -> ShowS show :: Quoted -> String $cshow :: Quoted -> String showsPrec :: Int -> Quoted -> ShowS $cshowsPrec :: Int -> Quoted -> ShowS Show) -- | Unlike Exprs in general, a Quoted Expr should be representable with -- show_val. This is because a Quoted has only been parsed, not evaluated, -- so it shouldn't have anything unshowable, like pitches. instance ShowVal.ShowVal Quoted where show_val :: Quoted -> Text show_val (Quoted Expr expr) = Text "\"(" forall a. Semigroup a => a -> a -> a <> forall a. ShowVal a => a -> Text ShowVal.show_val Expr expr forall a. Semigroup a => a -> a -> a <> Text ")" instance Pretty Quoted where pretty :: Quoted -> Text pretty = forall a. ShowVal a => a -> Text ShowVal.show_val -- | Show a str intended for call position. Call position is special in -- that it can contain any character except space and equals without quoting. show_call_val :: Val -> Text show_call_val :: Val -> Text show_call_val (VStr (Expr.Str Text sym)) = Text sym show_call_val Val val = forall a. ShowVal a => a -> Text ShowVal.show_val Val val -- ** val utils -- | Make an untyped VSignal. num :: Double -> Val num :: Y -> Val num = Type -> Y -> Val constant Type ScoreT.Untyped constant_val :: Val -> Maybe (ScoreT.Typed Signal.Y) constant_val :: Val -> Maybe (Typed Y) constant_val (VSignal (ScoreT.Typed Type typ Control sig)) = forall a. Type -> a -> Typed a ScoreT.Typed Type typ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall {k} (kind :: k). Signal kind -> Maybe Y Signal.constant_val Control sig constant_val Val _ = forall a. Maybe a Nothing constant :: ScoreT.Type -> Signal.Y -> Val constant :: Type -> Y -> Val constant Type typ = Typed Control -> Val VSignal forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Type -> a -> Typed a ScoreT.Typed Type typ forall b c a. (b -> c) -> (a -> b) -> a -> c . forall {k} (kind :: k). Y -> Signal kind Signal.constant score_time :: ScoreTime -> Val score_time :: ScoreTime -> Val score_time = Type -> Y -> Val constant Type ScoreT.Score forall b c a. (b -> c) -> (a -> b) -> a -> c . ScoreTime -> Y ScoreTime.to_double real_time :: RealTime -> Val real_time :: RealTime -> Val real_time = Type -> Y -> Val constant Type ScoreT.Real forall b c a. (b -> c) -> (a -> b) -> a -> c . RealTime -> Y RealTime.to_seconds transposition :: Pitch.Transpose -> Val transposition :: Transpose -> Val transposition Transpose t = case Transpose t of Pitch.Diatonic Y d -> Type -> Y -> Val constant Type ScoreT.Diatonic Y d Pitch.Chromatic Y d -> Type -> Y -> Val constant Type ScoreT.Chromatic Y d Pitch.Nn Y d -> Type -> Y -> Val constant Type ScoreT.Nn Y d str :: Text -> Val str :: Text -> Val str = Str -> Val VStr forall b c a. (b -> c) -> (a -> b) -> a -> c . Text -> Str Expr.Str to_scale_id :: Val -> Maybe Pitch.ScaleId to_scale_id :: Val -> Maybe ScaleId to_scale_id (VStr (Expr.Str Text a)) = forall a. a -> Maybe a Just (Text -> ScaleId Pitch.ScaleId Text a) to_scale_id Val _ = forall a. Maybe a Nothing quoted :: Expr.Symbol -> [Val] -> Quoted quoted :: Symbol -> [Val] -> Quoted quoted Symbol sym [Val] args = Expr -> Quoted Quoted forall a b. (a -> b) -> a -> b $ forall val. Call val -> Expr val Expr.generator (forall val. Symbol -> [val] -> Call val Expr.call Symbol sym [Val] args) quoted0 :: Expr.Symbol -> Quoted quoted0 :: Symbol -> Quoted quoted0 Symbol sym = Symbol -> [Val] -> Quoted quoted Symbol sym [] -- * Ref type ControlRef = Ref ScoreT.Control ScoreT.TypedSignal type PControlRef = Ref ScoreT.PControl PSignal data Ref control val = Ref control (Maybe val) deriving (Ref control val -> Ref control val -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a forall control val. (Eq control, Eq val) => Ref control val -> Ref control val -> Bool /= :: Ref control val -> Ref control val -> Bool $c/= :: forall control val. (Eq control, Eq val) => Ref control val -> Ref control val -> Bool == :: Ref control val -> Ref control val -> Bool $c== :: forall control val. (Eq control, Eq val) => Ref control val -> Ref control val -> Bool Eq, Int -> Ref control val -> ShowS forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a forall control val. (Show control, Show val) => Int -> Ref control val -> ShowS forall control val. (Show control, Show val) => [Ref control val] -> ShowS forall control val. (Show control, Show val) => Ref control val -> String showList :: [Ref control val] -> ShowS $cshowList :: forall control val. (Show control, Show val) => [Ref control val] -> ShowS show :: Ref control val -> String $cshow :: forall control val. (Show control, Show val) => Ref control val -> String showsPrec :: Int -> Ref control val -> ShowS $cshowsPrec :: forall control val. (Show control, Show val) => Int -> Ref control val -> ShowS Show) instance (Serialize.Serialize control, Serialize.Serialize val) => Serialize.Serialize (Ref control val) where put :: Putter (Ref control val) put (Ref control a Maybe val b) = Word8 -> PutM () Serialize.put_tag Word8 3 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall a. Serialize a => Putter a Serialize.put control a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall a. Serialize a => Putter a Serialize.put Maybe val b {- This has to be careful to maintain compatibility with the old Ref: data Ref control val = ControlSignal val | DefaultedControl control val | LiteralControl control get = Serialize.get_tag >>= \case 0 -> ControlSignal <$> Serialize.get 1 -> DefaultedControl <$> Serialize.get <*> Serialize.get 2 -> LiteralControl <$> Serialize.get -} get :: Get (Ref control val) get = Get Word8 Serialize.get_tag forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b >>= \case Word8 0 -> forall (m :: * -> *) a. MonadFail m => String -> m a fail String "new Ref doesn't have ControlSignal" Word8 1 -> forall control val. control -> Maybe val -> Ref control val Ref forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Serialize a => Get a Serialize.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> (forall a. a -> Maybe a Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Serialize a => Get a Serialize.get) Word8 2 -> forall control val. control -> Maybe val -> Ref control val Ref forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Serialize a => Get a Serialize.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall (f :: * -> *) a. Applicative f => a -> f a pure forall a. Maybe a Nothing Word8 3 -> forall control val. control -> Maybe val -> Ref control val Ref forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall a. Serialize a => Get a Serialize.get forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> forall a. Serialize a => Get a Serialize.get Word8 n -> forall a. String -> Word8 -> Get a Serialize.bad_tag String "DeriveT.Ref" Word8 n instance ShowVal.ShowVal ControlRef where show_val :: ControlRef -> Text show_val = forall sig control. ShowVal sig => (control -> Text) -> Ref control sig -> Text show_ref (Char -> Text -> Text Text.cons Char '%' forall b c a. (b -> c) -> (a -> b) -> a -> c . Control -> Text ScoreT.control_name) instance Pretty ControlRef where pretty :: ControlRef -> Text pretty = forall a. ShowVal a => a -> Text ShowVal.show_val -- | There's no way to convert a pitch back into the expression that produced -- it, so this is the best I can do. -- -- Similar to ShowVal 'ControlRef', there's no signal literal so I use the -- value at 0. A pitch can be turned into an expression, but not necessarily -- accurately since it doesn't take things like pitch interpolation into -- account. instance ShowVal.ShowVal PControlRef where show_val :: PControlRef -> Text show_val = forall sig control. ShowVal sig => (control -> Text) -> Ref control sig -> Text show_ref (Char -> Text -> Text Text.cons Char '#' forall b c a. (b -> c) -> (a -> b) -> a -> c . PControl -> Text ScoreT.pcontrol_name) instance Pretty PControlRef where pretty :: PControlRef -> Text pretty = forall a. ShowVal a => a -> Text ShowVal.show_val show_ref :: ShowVal.ShowVal sig => (control -> Text) -> Ref control sig -> Text show_ref :: forall sig control. ShowVal sig => (control -> Text) -> Ref control sig -> Text show_ref control -> Text ref_text (Ref control control Maybe sig deflt) = control -> Text ref_text control control forall a. Semigroup a => a -> a -> a <> forall b a. b -> (a -> b) -> Maybe a -> b maybe Text "" ((Text "," <>) forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. ShowVal a => a -> Text ShowVal.show_val) Maybe sig deflt -- * Expr type Expr = Expr.Expr Val type Call = Expr.Call Val type Term = Expr.Term Val instance ShowVal.ShowVal (Expr.Expr Val) where show_val :: Expr -> Text show_val = forall val. ShowVal (Call val) => Expr val -> Text Expr.show_val_expr instance ShowVal.ShowVal (Expr.Call Val) where show_val :: Call Val -> Text show_val = forall val. ShowVal (Term val) => (val -> Maybe Text) -> Call val -> Text Expr.show_val_call forall a b. (a -> b) -> a -> b $ \case VStr (Expr.Str Text op) -> forall a. a -> Maybe a Just Text op Val _ -> forall a. Maybe a Nothing instance ShowVal.ShowVal (Expr.Term Val) where show_val :: Term Val -> Text show_val = forall val. (ShowVal val, ShowVal (Call val)) => Term val -> Text Expr.show_val_term instance Pretty (Expr.Call Val) where pretty :: Call Val -> Text pretty = forall a. ShowVal a => a -> Text ShowVal.show_val instance Pretty (Expr.Term Val) where pretty :: Term Val -> Text pretty = forall a. ShowVal a => a -> Text ShowVal.show_val calls_equal :: Call -> Call -> Maybe Bool calls_equal :: Call Val -> Call Val -> Maybe Bool calls_equal (Expr.Call Symbol sym1 [Term Val] args1) (Expr.Call Symbol sym2 [Term Val] args2) | Symbol sym1 forall a. Eq a => a -> a -> Bool /= Symbol sym2 = forall a. a -> Maybe a Just Bool False | Bool otherwise = forall a. (a -> a -> Maybe Bool) -> [a] -> [a] -> Maybe Bool lists_equal Term Val -> Term Val -> Maybe Bool terms_equal [Term Val] args1 [Term Val] args2 terms_equal :: Term -> Term -> Maybe Bool terms_equal :: Term Val -> Term Val -> Maybe Bool terms_equal (Expr.ValCall Call Val call1) (Expr.ValCall Call Val call2) = Call Val -> Call Val -> Maybe Bool calls_equal Call Val call1 Call Val call2 terms_equal (Expr.Literal Val val1) (Expr.Literal Val val2) = Val -> Val -> Maybe Bool vals_equal Val val1 Val val2 terms_equal Term Val _ Term Val _ = forall a. a -> Maybe a Just Bool False -- | This is just a 'Call', but it's expected to return a VPitch. type PitchCall = Call -- ** call utils -- | Transform the Symbols in a Call. map_str :: (Expr.Str -> Expr.Str) -> Call -> Call map_str :: (Str -> Str) -> Call Val -> Call Val map_str Str -> Str f = Call Val -> Call Val call where call :: Call Val -> Call Val call (Expr.Call Symbol sym [Term Val] terms) = forall val. Symbol -> [Term val] -> Call val Expr.Call Symbol sym (forall a b. (a -> b) -> [a] -> [b] map Term Val -> Term Val term [Term Val] terms) term :: Term Val -> Term Val term (Expr.ValCall Call Val c) = forall val. Call val -> Term val Expr.ValCall (Call Val -> Call Val call Call Val c) term (Expr.Literal (VStr Str str)) = forall val. val -> Term val Expr.Literal (Str -> Val VStr (Str -> Str f Str str)) term (Expr.Literal Val lit) = forall val. val -> Term val Expr.Literal Val lit -- * type aliases type PitchMap = Map ScoreT.PControl PSignal type PitchFunction = RealTime -> Maybe Pitch -- * ControlFunction {- | Another representation of a signal, complementary to 'Signal.Control'. It's more powerful because it has access to a subset of the Dynamic state, as well as the 'Control' is was originally bound to. However, it's also less powerful because you can't inspect it to see if it's constant, or emit exactly the samples present without resorting to sampling, or draw it on the UI. This is the ubiquitous code vs. data tradeoff. In addition, the main motivation to add control functions was to randomize values, which means that, unlike signals, they're not actually functions at all, and thus couldn't be rendered as a continuous signal. This means that functions are only suitable for sampling at points, not for slicing over time ranges. Having both signals and functions is awkward because then some calls may ignore a control function if they require a signal, which is inconsistent and confusing. This is the case for all control generators since the signal usually is on a control track and will wind up being rendered on the UI. So the convention is that control functions are generally just modifications of an underlying signal, rather than synthesizing a signal. Another awkward thing about CFunction is that it really wants to be in Deriver, but can't, due to circular imports. The alternative is a giant hs-boot file, or lumping thousands of lines into "Derive.Deriver.Monad". Currently it's a plain function but if I want logging and exceptions I could use "Derive.Deriver.DeriveM". It still wouldn't solve the main problem, which is that I can't reuse the Deriver functions, and instead have to rewrite them. See NOTE [control-function]. -} data CFunction = CFunction { -- | Human readable name. -- -- TODO I thought of making it the expression that created this, for -- serialization, but not implemented yet. CFunction -> Text cf_name :: !Text , CFunction -> Typed Control cf_signal :: !ScoreT.TypedSignal {- | This is modifying an underlying signal. The function may be created before the signal it modifies, e.g. @dyn=(cf-rnd .2)@ will apply to whatever values the @dyn@ signal later takes. There is special hackery in Env.put_val to merge a signal into a CFunction if present. The signal should start at const 0 by convention, since many functions make sense against 0 too, and it would be annoying to plumb out an error from 'call_cfunction'. -} , CFunction -> Dynamic -> Control -> RealTime -> Y cf_function :: !(Dynamic -> Signal.Control -> RealTime -> Signal.Y) } -- | A simple pure function. data PFunction = PFunction { PFunction -> Text pf_name :: !Text , PFunction -> TypedFunction pf_function :: !ScoreT.TypedFunction } instance Show PFunction where show :: PFunction -> String show = forall a. Pretty a => a -> String prettys instance Pretty PFunction where pretty :: PFunction -> Text pretty = forall a. ShowVal a => a -> Text ShowVal.show_val instance ShowVal.ShowVal PFunction where show_val :: PFunction -> Text show_val = PFunction -> Text pf_name instance DeepSeq.NFData CFunction where rnf :: CFunction -> () rnf CFunction _ = () -- bogus instance so Derive.Dynamic can have one instance Show CFunction where show :: CFunction -> String show = Text -> String untxt forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Pretty a => a -> Text pretty instance Pretty CFunction where pretty :: CFunction -> Text pretty CFunction cf = Text "((CFunction " forall a. Semigroup a => a -> a -> a <> CFunction -> Text cf_name CFunction cf forall a. Semigroup a => a -> a -> a <> Text "))" -- | TODO this isn't a real ShowVal, I'd have to record the whole expression. instance ShowVal.ShowVal CFunction where show_val :: CFunction -> Text show_val = CFunction -> Text cf_name call_cfunction :: Dynamic -> CFunction -> ScoreT.TypedFunction call_cfunction :: Dynamic -> CFunction -> TypedFunction call_cfunction Dynamic cf_dyn CFunction cf = forall a. Type -> a -> Typed a ScoreT.Typed Type typ (CFunction -> Dynamic -> Control -> RealTime -> Y cf_function CFunction cf Dynamic cf_dyn Control signal) where ScoreT.Typed Type typ Control signal = CFunction -> Typed Control cf_signal CFunction cf -- | A stripped down "Derive.Deriver.Monad.Dynamic" for ControlFunctions -- to use. The duplication is unfortunate, see 'CFunction'. data Dynamic = Dynamic { Dynamic -> PSignal dyn_pitch :: !PSignal , Dynamic -> Environ dyn_environ :: !Environ -- | This is from 'Derive.Deriver.Monad.state_event_serial'. , Dynamic -> Int dyn_event_serial :: !Int , Dynamic -> Warp dyn_warp :: !Warp.Warp , Dynamic -> Marklists dyn_ruler :: Ruler.Marklists -- intentionally lazy } deriving (Int -> Dynamic -> ShowS [Dynamic] -> ShowS Dynamic -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [Dynamic] -> ShowS $cshowList :: [Dynamic] -> ShowS show :: Dynamic -> String $cshow :: Dynamic -> String showsPrec :: Int -> Dynamic -> ShowS $cshowsPrec :: Int -> Dynamic -> ShowS Show) empty_dynamic :: Dynamic empty_dynamic :: Dynamic empty_dynamic = Dynamic { dyn_pitch :: PSignal dyn_pitch = forall a. Monoid a => a mempty , dyn_environ :: Environ dyn_environ = forall a. Monoid a => a mempty , dyn_event_serial :: Int dyn_event_serial = Int 0 , dyn_warp :: Warp dyn_warp = Warp Warp.identity , dyn_ruler :: Marklists dyn_ruler = forall a. Monoid a => a mempty } {- NOTE [control-function] . The UI is what I want, which is that I write a start=(rnd .1 .3), so let's keep that. Then it gets serialized as an expression (rnd .1 .3). Stuff I don't like: . The UI where it's in a different namespace than signals, so dyn=(rnd) vs %dyn=.5. Maybe this comes from the signal vs env namespace though. . UI where they have an implicit signal backing. I think I don't need that, if it's a random addition it should be explicit, like dyn=%dyn + rnd .5. If they are in the same namespace then something like dyn=(+ dyn (rnd .5)), or even dyn=+(rnd .5) . Also plenty is wrong with the implementation, extra Dynamic. Problems to solve: - Unify signal and env namespaces. - Unify Val and RVal. Make Val serializable. - Make so calls can coerce to ScoreT.TypedFunction. - Unify ControlFunction with ValCall. . Why though? Can't it be its own thing? Control functions add unwanted complexity, but I couldn't think of a simpler way to randomized or synthesized control values. Here's the history: . One way would be look for a corresponding <>"-rnd" control for a range. But what about distribution? . If I pass RealTime to a Quoted value, I could write the parameter as "(rnd-signal x y). But it would have to be curried to still accept the "at" parameter, or have access to it through Context. It could look at the stack, which is how the random seed works. Seems complicated. But replacing a signal with a function seems like a good idea. . Can I replace the Signal.Control itself with something possibly wrapped in a function? That function would need (RandomSeed, RealTime). But that doesn't work for notes that take a slice of the signal. I think I only want to randomize Signal.at access. . Or a separate 'Map ScoreT.Control ValCall' and the Signal.at functions in derive first look in there. This is similar to the -rnd control idea, except more flexible. I could use it not just for different distributions, but to invert a signal, combine two signals, etc. Or have an entirely synthesized signal, with no backing Signal.Control. . dur-rnd could be replaced by randomization on sus-abs. start-rnd gets replaced by a start-offset control, which can then be randomized. start-offset could be also useful for e.g. swing time or instruments that are aggressively before the beat. . At this point I could get rid of the "normal" control map, replacing with Signal.at ValCalls. Except that I still need non-randomized signals to slice and send to MIDI perform, and to display on the UI. . Also, ValCalls can log and fail and do the other Deriver things. Of course they also have access to State, which they need, or at least the Dynamic part. But to bind in tracklang I still need some sort of currying, e.g. '%control = (rnd .1 sig)'. But the call is (rnd, Control, RealTime). So I could save the Call and append RealTime at the end. I could optimize a bit by looking up 'rnd' at the binding time. But I can't typecheck the args unless I introspect... which I actually can do, given the documentation. I would have to map each ArgDoc back to its parser, then apply each parser. But it would be hard to store the types untagged, maybe possible with an existential type but seems tricky, and I need access to the function directly. . I could also use plain haskell functions, but it would be yet another namespace, and I'd still need a way to typecheck and pass args from tracklang. Val calls already do all that, I should reuse it. . A better way might be to add a VCFunction, which is just RealTime -> Signal.Y, this would also eliminate typechecking the return value. That means I also don't have to quote, e.g. '%x = "(f)' -}