module Derive.Call where
import qualified Data.List as List
import qualified System.Random.Mersenne.Pure64 as Pure64
import qualified Util.Num as Num
import qualified Util.Random as Random
import qualified Cmd.TimeStep as TimeStep
import qualified Derive.Args as Args
import qualified Derive.Attrs as Attrs
import qualified Derive.Controls as Controls
import qualified Derive.Derive as Derive
import qualified Derive.DeriveT as DeriveT
import qualified Derive.Deriver.Internal as Internal
import qualified Derive.EnvKey as EnvKey
import qualified Derive.Eval as Eval
import qualified Derive.Expr as Expr
import qualified Derive.Flags as Flags
import qualified Derive.PSignal as PSignal
import qualified Derive.Pitches as Pitches
import qualified Derive.Scale as Scale
import qualified Derive.Score as Score
import qualified Derive.ScoreT as ScoreT
import qualified Derive.ShowVal as ShowVal
import qualified Derive.Symbols as Symbols
import qualified Derive.Typecheck as Typecheck
import qualified Perform.Pitch as Pitch
import qualified Perform.RealTime as RealTime
import qualified Perform.Signal as Signal
import qualified Ui.Meter.Meter as Meter
import qualified Ui.ScoreTime as ScoreTime
import Global
import Types
control_at :: DeriveT.ControlRef -> RealTime -> Derive.Deriver Signal.Y
control_at :: ControlRef -> RealTime -> Deriver Double
control_at ControlRef
control RealTime
pos = Typed Double -> Double
forall a. Typed a -> a
ScoreT.typed_val (Typed Double -> Double)
-> Deriver State Error (Typed Double) -> Deriver Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ControlRef -> RealTime -> Deriver State Error (Typed Double)
typed_control_at ControlRef
control RealTime
pos
typed_control_at :: DeriveT.ControlRef -> RealTime
-> Derive.Deriver (ScoreT.Typed Signal.Y)
typed_control_at :: ControlRef -> RealTime -> Deriver State Error (Typed Double)
typed_control_at ControlRef
control RealTime
pos = case ControlRef
control of
DeriveT.ControlSignal Typed Control
sig -> Typed Double -> Deriver State Error (Typed Double)
forall (m :: * -> *) a. Monad m => a -> m a
return (Typed Double -> Deriver State Error (Typed Double))
-> Typed Double -> Deriver State Error (Typed Double)
forall a b. (a -> b) -> a -> b
$ RealTime -> Control -> Double
forall {k} (kind :: k). RealTime -> Signal kind -> Double
Signal.at RealTime
pos (Control -> Double) -> Typed Control -> Typed Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Typed Control
sig
DeriveT.DefaultedControl Control
cont Typed Control
deflt ->
Typed Double -> Maybe (Typed Double) -> Typed Double
forall a. a -> Maybe a -> a
fromMaybe (RealTime -> Control -> Double
forall {k} (kind :: k). RealTime -> Signal kind -> Double
Signal.at RealTime
pos (Control -> Double) -> Typed Control -> Typed Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Typed Control
deflt) (Maybe (Typed Double) -> Typed Double)
-> Deriver State Error (Maybe (Typed Double))
-> Deriver State Error (Typed Double)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Control -> RealTime -> Deriver State Error (Maybe (Typed Double))
Derive.control_at Control
cont RealTime
pos
DeriveT.LiteralControl Control
cont ->
Text -> Maybe (Typed Double) -> Deriver State Error (Typed Double)
forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"not found and no default: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Control -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val Control
cont)
(Maybe (Typed Double) -> Deriver State Error (Typed Double))
-> Deriver State Error (Maybe (Typed Double))
-> Deriver State Error (Typed Double)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Control -> RealTime -> Deriver State Error (Maybe (Typed Double))
Derive.control_at Control
cont RealTime
pos
time_control_at :: Typecheck.TimeType -> DeriveT.ControlRef -> RealTime
-> Derive.Deriver DeriveT.Duration
time_control_at :: TimeType -> ControlRef -> RealTime -> Deriver Duration
time_control_at TimeType
default_type ControlRef
control RealTime
pos = do
ScoreT.Typed Type
typ Double
val <- ControlRef -> RealTime -> Deriver State Error (Typed Double)
typed_control_at ControlRef
control RealTime
pos
TimeType
time_type <- case Type
typ of
Type
ScoreT.Untyped -> TimeType -> Deriver State Error TimeType
forall (m :: * -> *) a. Monad m => a -> m a
return TimeType
default_type
Type
ScoreT.Score -> TimeType -> Deriver State Error TimeType
forall (m :: * -> *) a. Monad m => a -> m a
return TimeType
Typecheck.Score
Type
ScoreT.Real -> TimeType -> Deriver State Error TimeType
forall (m :: * -> *) a. Monad m => a -> m a
return TimeType
Typecheck.Real
Type
_ -> Text -> Deriver State Error TimeType
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver State Error TimeType)
-> Text -> Deriver State Error TimeType
forall a b. (a -> b) -> a -> b
$ Text
"expected time type for "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControlRef -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val ControlRef
control Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Pretty a => a -> Text
pretty Type
typ
Duration -> Deriver Duration
forall (m :: * -> *) a. Monad m => a -> m a
return (Duration -> Deriver Duration) -> Duration -> Deriver Duration
forall a b. (a -> b) -> a -> b
$ case TimeType
time_type of
TimeType
Typecheck.Real -> RealTime -> Duration
DeriveT.RealDuration (Double -> RealTime
RealTime.seconds Double
val)
TimeType
Typecheck.Score -> ScoreTime -> Duration
DeriveT.ScoreDuration (Double -> ScoreTime
ScoreTime.from_double Double
val)
real_time_at :: DeriveT.ControlRef -> RealTime -> Derive.Deriver RealTime
real_time_at :: ControlRef -> RealTime -> Deriver RealTime
real_time_at ControlRef
control RealTime
pos = do
Duration
val <- TimeType -> ControlRef -> RealTime -> Deriver Duration
time_control_at TimeType
Typecheck.Real ControlRef
control RealTime
pos
case Duration
val of
DeriveT.RealDuration RealTime
t -> RealTime -> Deriver RealTime
forall (m :: * -> *) a. Monad m => a -> m a
return RealTime
t
DeriveT.ScoreDuration ScoreTime
t -> Text -> Deriver RealTime
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver RealTime) -> Text -> Deriver RealTime
forall a b. (a -> b) -> a -> b
$ Text
"expected RealTime for "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControlRef -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val ControlRef
control Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScoreTime -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val ScoreTime
t
transpose_control_at :: Typecheck.TransposeType -> DeriveT.ControlRef
-> RealTime -> Derive.Deriver (Signal.Y, Typecheck.TransposeType)
transpose_control_at :: TransposeType
-> ControlRef -> RealTime -> Deriver (Double, TransposeType)
transpose_control_at TransposeType
default_type ControlRef
control RealTime
pos = do
ScoreT.Typed Type
typ Double
val <- ControlRef -> RealTime -> Deriver State Error (Typed Double)
typed_control_at ControlRef
control RealTime
pos
TransposeType
transpose_type <- case Type
typ of
Type
ScoreT.Untyped -> TransposeType -> Deriver State Error TransposeType
forall (m :: * -> *) a. Monad m => a -> m a
return TransposeType
default_type
Type
ScoreT.Chromatic -> TransposeType -> Deriver State Error TransposeType
forall (m :: * -> *) a. Monad m => a -> m a
return TransposeType
Typecheck.Chromatic
Type
ScoreT.Diatonic -> TransposeType -> Deriver State Error TransposeType
forall (m :: * -> *) a. Monad m => a -> m a
return TransposeType
Typecheck.Diatonic
Type
_ -> Text -> Deriver State Error TransposeType
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver State Error TransposeType)
-> Text -> Deriver State Error TransposeType
forall a b. (a -> b) -> a -> b
$ Text
"expected transpose type for "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControlRef -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val ControlRef
control Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Pretty a => a -> Text
pretty Type
typ
(Double, TransposeType) -> Deriver (Double, TransposeType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Double
val, TransposeType
transpose_type)
to_function :: DeriveT.ControlRef -> Derive.Deriver Typecheck.Function
to_function :: ControlRef -> Deriver Function
to_function = ((RealTime -> Typed Double) -> Function)
-> Deriver State Error (RealTime -> Typed Double)
-> Deriver Function
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Typed Double -> Double
forall a. Typed a -> a
ScoreT.typed_val .) (Deriver State Error (RealTime -> Typed Double)
-> Deriver Function)
-> (ControlRef -> Deriver State Error (RealTime -> Typed Double))
-> ControlRef
-> Deriver Function
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlRef -> Deriver State Error (RealTime -> Typed Double)
Typecheck.to_typed_function
to_typed_signal :: DeriveT.ControlRef
-> Derive.Deriver (ScoreT.Typed Signal.Control)
to_typed_signal :: ControlRef -> Deriver (Typed Control)
to_typed_signal ControlRef
control =
(Typed Control -> Deriver (Typed Control))
-> (ControlFunction -> Deriver (Typed Control))
-> Either (Typed Control) ControlFunction
-> Deriver (Typed Control)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Typed Control -> Deriver (Typed Control)
forall (m :: * -> *) a. Monad m => a -> m a
return (Deriver (Typed Control)
-> ControlFunction -> Deriver (Typed Control)
forall a b. a -> b -> a
const (Deriver (Typed Control)
-> ControlFunction -> Deriver (Typed Control))
-> Deriver (Typed Control)
-> ControlFunction
-> Deriver (Typed Control)
forall a b. (a -> b) -> a -> b
$ Text -> Deriver (Typed Control)
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver (Typed Control))
-> Text -> Deriver (Typed Control)
forall a b. (a -> b) -> a -> b
$ Text
"not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControlRef -> Text
forall a. Pretty a => a -> Text
pretty ControlRef
control)
(Either (Typed Control) ControlFunction -> Deriver (Typed Control))
-> Deriver State Error (Either (Typed Control) ControlFunction)
-> Deriver (Typed Control)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ControlRef
-> Deriver State Error (Either (Typed Control) ControlFunction)
Typecheck.to_signal_or_function ControlRef
control
to_signal :: DeriveT.ControlRef -> Derive.Deriver Signal.Control
to_signal :: ControlRef -> Deriver Control
to_signal = (Typed Control -> Control)
-> Deriver (Typed Control) -> Deriver Control
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Typed Control -> Control
forall a. Typed a -> a
ScoreT.typed_val (Deriver (Typed Control) -> Deriver Control)
-> (ControlRef -> Deriver (Typed Control))
-> ControlRef
-> Deriver Control
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ControlRef -> Deriver (Typed Control)
to_typed_signal
to_transpose_function :: Typecheck.TransposeType -> DeriveT.ControlRef
-> Derive.Deriver (Typecheck.Function, ScoreT.Control)
to_transpose_function :: TransposeType -> ControlRef -> Deriver (Function, Control)
to_transpose_function TransposeType
default_type ControlRef
control = do
RealTime -> Typed Double
sig <- ControlRef -> Deriver State Error (RealTime -> Typed Double)
Typecheck.to_typed_function ControlRef
control
let typ :: Type
typ = Typed Double -> Type
forall a. Typed a -> Type
ScoreT.type_of (RealTime -> Typed Double
sig RealTime
0)
untyped :: Function
untyped = Typed Double -> Double
forall a. Typed a -> a
ScoreT.typed_val (Typed Double -> Double) -> (RealTime -> Typed Double) -> Function
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Typed Double
sig
case Type
typ of
Type
ScoreT.Untyped ->
(Function, Control) -> Deriver (Function, Control)
forall (m :: * -> *) a. Monad m => a -> m a
return (Function
untyped, TransposeType -> Control
Typecheck.transpose_control TransposeType
default_type)
Type
_ -> case Type -> Maybe Control
Controls.transpose_type Type
typ of
Just Control
control -> (Function, Control) -> Deriver (Function, Control)
forall (m :: * -> *) a. Monad m => a -> m a
return (Function
untyped, Control
control)
Maybe Control
_ -> Text -> Deriver (Function, Control)
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver (Function, Control))
-> Text -> Deriver (Function, Control)
forall a b. (a -> b) -> a -> b
$ Text
"expected transpose type for "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControlRef -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val ControlRef
control Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Pretty a => a -> Text
pretty Type
typ
to_time_function :: Typecheck.TimeType -> DeriveT.ControlRef
-> Derive.Deriver (Typecheck.Function, Typecheck.TimeType)
to_time_function :: TimeType -> ControlRef -> Deriver (Function, TimeType)
to_time_function TimeType
default_type ControlRef
control = do
RealTime -> Typed Double
sig <- ControlRef -> Deriver State Error (RealTime -> Typed Double)
Typecheck.to_typed_function ControlRef
control
let typ :: Type
typ = Typed Double -> Type
forall a. Typed a -> Type
ScoreT.type_of (RealTime -> Typed Double
sig RealTime
0)
untyped :: Function
untyped = Typed Double -> Double
forall a. Typed a -> a
ScoreT.typed_val (Typed Double -> Double) -> (RealTime -> Typed Double) -> Function
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Typed Double
sig
case Type
typ of
Type
ScoreT.Untyped -> (Function, TimeType) -> Deriver (Function, TimeType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Function
untyped, TimeType
default_type)
Type
ScoreT.Score -> (Function, TimeType) -> Deriver (Function, TimeType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Function
untyped, TimeType
Typecheck.Score)
Type
ScoreT.Real -> (Function, TimeType) -> Deriver (Function, TimeType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Function
untyped, TimeType
Typecheck.Real)
Type
_ -> Text -> Deriver (Function, TimeType)
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver (Function, TimeType))
-> Text -> Deriver (Function, TimeType)
forall a b. (a -> b) -> a -> b
$ Text
"expected time type for "
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ControlRef -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val ControlRef
control Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" but got " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Type -> Text
forall a. Pretty a => a -> Text
pretty Type
typ
pitch_at :: RealTime -> DeriveT.PControlRef -> Derive.Deriver PSignal.Pitch
pitch_at :: RealTime -> PControlRef -> Deriver Pitch
pitch_at = RealTime -> PControlRef -> Deriver Pitch
Typecheck.pitch_at
to_psignal :: DeriveT.PControlRef -> Derive.Deriver PSignal.PSignal
to_psignal :: PControlRef -> Deriver PSignal
to_psignal PControlRef
control = case PControlRef
control of
DeriveT.ControlSignal PSignal
sig -> PSignal -> Deriver PSignal
forall (m :: * -> *) a. Monad m => a -> m a
return PSignal
sig
DeriveT.DefaultedControl PControl
cont PSignal
deflt ->
Deriver PSignal
-> (PSignal -> Deriver PSignal) -> Maybe PSignal -> Deriver PSignal
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (PSignal -> Deriver PSignal
forall (m :: * -> *) a. Monad m => a -> m a
return PSignal
deflt) PSignal -> Deriver PSignal
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe PSignal -> Deriver PSignal)
-> Deriver State Error (Maybe PSignal) -> Deriver PSignal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PControl -> Deriver State Error (Maybe PSignal)
Derive.get_named_pitch PControl
cont
DeriveT.LiteralControl PControl
cont ->
Text -> Maybe PSignal -> Deriver PSignal
forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"not found: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> PControl -> Text
forall a. Show a => a -> Text
showt PControl
cont)
(Maybe PSignal -> Deriver PSignal)
-> Deriver State Error (Maybe PSignal) -> Deriver PSignal
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< PControl -> Deriver State Error (Maybe PSignal)
Derive.get_named_pitch PControl
cont
nn_at :: RealTime -> DeriveT.PControlRef
-> Derive.Deriver (Maybe Pitch.NoteNumber)
nn_at :: RealTime -> PControlRef -> Deriver (Maybe NoteNumber)
nn_at RealTime
pos PControlRef
control =
Text -> Transposed -> Deriver (Maybe NoteNumber)
Derive.logged_pitch_nn (Text
"Util.nn_at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (RealTime, PControlRef) -> Text
forall a. Pretty a => a -> Text
pretty (RealTime
pos, PControlRef
control))
(Transposed -> Deriver (Maybe NoteNumber))
-> Deriver State Error Transposed -> Deriver (Maybe NoteNumber)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RealTime -> Pitch -> Deriver State Error Transposed
Derive.resolve_pitch RealTime
pos
(Pitch -> Deriver State Error Transposed)
-> Deriver Pitch -> Deriver State Error Transposed
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RealTime -> PControlRef -> Deriver Pitch
pitch_at RealTime
pos PControlRef
control
real_duration_at :: Typecheck.TypedFunction -> RealTime
-> Derive.Deriver RealTime
real_duration_at :: (RealTime -> Typed Double) -> RealTime -> Deriver RealTime
real_duration_at RealTime -> Typed Double
f RealTime
t = TimeType -> RealTime -> Typed Double -> Deriver RealTime
forall t.
Time t =>
TimeType -> t -> Typed Double -> Deriver RealTime
typed_real_duration TimeType
Typecheck.Real RealTime
t (RealTime -> Typed Double
f RealTime
t)
transposed :: RealTime -> Derive.Deriver (Maybe PSignal.Transposed)
transposed :: RealTime -> Deriver (Maybe Transposed)
transposed RealTime
pos =
Deriver State Error (Maybe Pitch)
-> (Pitch -> Deriver (Maybe Transposed))
-> Deriver (Maybe Transposed)
forall (m :: * -> *) a b.
Monad m =>
m (Maybe a) -> (a -> m (Maybe b)) -> m (Maybe b)
justm (RealTime -> Deriver State Error (Maybe Pitch)
Derive.pitch_at RealTime
pos) ((Pitch -> Deriver (Maybe Transposed))
-> Deriver (Maybe Transposed))
-> (Pitch -> Deriver (Maybe Transposed))
-> Deriver (Maybe Transposed)
forall a b. (a -> b) -> a -> b
$ (Transposed -> Maybe Transposed)
-> Deriver State Error Transposed -> Deriver (Maybe Transposed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transposed -> Maybe Transposed
forall a. a -> Maybe a
Just (Deriver State Error Transposed -> Deriver (Maybe Transposed))
-> (Pitch -> Deriver State Error Transposed)
-> Pitch
-> Deriver (Maybe Transposed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RealTime -> Pitch -> Deriver State Error Transposed
Derive.resolve_pitch RealTime
pos
get_transposed :: RealTime -> Derive.Deriver PSignal.Transposed
get_transposed :: RealTime -> Deriver State Error Transposed
get_transposed RealTime
pos = Text -> Maybe Transposed -> Deriver State Error Transposed
forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"no pitch at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealTime -> Text
forall a. Pretty a => a -> Text
pretty RealTime
pos)
(Maybe Transposed -> Deriver State Error Transposed)
-> Deriver (Maybe Transposed) -> Deriver State Error Transposed
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RealTime -> Deriver (Maybe Transposed)
transposed RealTime
pos
get_pitch :: RealTime -> Derive.Deriver PSignal.Pitch
get_pitch :: RealTime -> Deriver Pitch
get_pitch RealTime
pos = Text -> Maybe Pitch -> Deriver Pitch
forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"no pitch at " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> RealTime -> Text
forall a. Pretty a => a -> Text
pretty RealTime
pos)
(Maybe Pitch -> Deriver Pitch)
-> Deriver State Error (Maybe Pitch) -> Deriver Pitch
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< RealTime -> Deriver State Error (Maybe Pitch)
Derive.pitch_at RealTime
pos
get_pitch_here :: Derive.PassedArgs a -> Derive.Deriver PSignal.Pitch
get_pitch_here :: forall a. PassedArgs a -> Deriver Pitch
get_pitch_here = RealTime -> Deriver Pitch
get_pitch (RealTime -> Deriver Pitch)
-> (PassedArgs a -> Deriver RealTime)
-> PassedArgs a
-> Deriver Pitch
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< PassedArgs a -> Deriver RealTime
forall a. PassedArgs a -> Deriver RealTime
Args.real_start
get_parsed_pitch :: (Pitch.Note -> Maybe Pitch.Pitch)
-> RealTime -> Derive.Deriver Pitch.Pitch
get_parsed_pitch :: (Note -> Maybe Pitch) -> RealTime -> Deriver Pitch
get_parsed_pitch Note -> Maybe Pitch
parse = (Note -> Maybe Pitch) -> Transposed -> Deriver Pitch
forall a. (Note -> Maybe a) -> Transposed -> Deriver a
parse_pitch Note -> Maybe Pitch
parse (Transposed -> Deriver Pitch)
-> (RealTime -> Deriver State Error Transposed)
-> RealTime
-> Deriver Pitch
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< RealTime -> Deriver State Error Transposed
get_transposed
get_symbolic_pitch :: RealTime -> Derive.Deriver Pitch.Note
get_symbolic_pitch :: RealTime -> Deriver Note
get_symbolic_pitch = Transposed -> Deriver Note
Pitches.pitch_note (Transposed -> Deriver Note)
-> (RealTime -> Deriver State Error Transposed)
-> RealTime
-> Deriver Note
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< RealTime -> Deriver State Error Transposed
get_transposed
dynamic :: RealTime -> Derive.Deriver Signal.Y
dynamic :: RealTime -> Deriver Double
dynamic RealTime
pos = Double
-> (Typed Double -> Double) -> Maybe (Typed Double) -> Double
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Double
Derive.default_dynamic Typed Double -> Double
forall a. Typed a -> a
ScoreT.typed_val (Maybe (Typed Double) -> Double)
-> Deriver State Error (Maybe (Typed Double)) -> Deriver Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Control -> RealTime -> Deriver State Error (Maybe (Typed Double))
Derive.control_at Control
Controls.dynamic RealTime
pos
with_pitch :: PSignal.Pitch -> Derive.Deriver a -> Derive.Deriver a
with_pitch :: forall a. Pitch -> Deriver a -> Deriver a
with_pitch = Pitch -> Deriver a -> Deriver a
forall a. Pitch -> Deriver a -> Deriver a
Derive.with_constant_pitch
with_transposed_pitch :: PSignal.Transposed -> Derive.Deriver a
-> Derive.Deriver a
with_transposed_pitch :: forall a. Transposed -> Deriver a -> Deriver a
with_transposed_pitch Transposed
pitch =
Deriver a -> Deriver a
forall a. Deriver a -> Deriver a
without_transpose (Deriver a -> Deriver a)
-> (Deriver a -> Deriver a) -> Deriver a -> Deriver a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Pitch -> Deriver a -> Deriver a
forall a. Pitch -> Deriver a -> Deriver a
with_pitch (Transposed -> Pitch
forall a b. RawPitch a -> RawPitch b
PSignal.coerce Transposed
pitch)
without_transpose :: Derive.Deriver a -> Derive.Deriver a
without_transpose :: forall a. Deriver a -> Deriver a
without_transpose = [Control] -> Deriver a -> Deriver a
forall a. [Control] -> Deriver a -> Deriver a
Derive.remove_controls [Control]
Controls.transposers
with_symbolic_pitch :: DeriveT.PitchCall -> ScoreTime -> Derive.Deriver a
-> Derive.Deriver a
with_symbolic_pitch :: forall a. PitchCall -> ScoreTime -> Deriver a -> Deriver a
with_symbolic_pitch PitchCall
call ScoreTime
pos Deriver a
deriver = do
Pitch
pitch <- ScoreTime -> PitchCall -> Deriver Pitch
forall a. ScoreTime -> PitchCall -> Deriver (RawPitch a)
Eval.eval_pitch ScoreTime
pos PitchCall
call
Pitch -> Deriver a -> Deriver a
forall a. Pitch -> Deriver a -> Deriver a
with_pitch Pitch
pitch Deriver a
deriver
with_dynamic :: Signal.Y -> Derive.Deriver a -> Derive.Deriver a
with_dynamic :: forall a. Double -> Deriver a -> Deriver a
with_dynamic = Control -> Double -> Deriver a -> Deriver a
forall a. Control -> Double -> Deriver a -> Deriver a
with_constant Control
Controls.dynamic
multiply_dynamic :: Signal.Y -> Derive.Deriver a -> Derive.Deriver a
multiply_dynamic :: forall a. Double -> Deriver a -> Deriver a
multiply_dynamic = Control -> Double -> Deriver a -> Deriver a
forall a. Control -> Double -> Deriver a -> Deriver a
multiply_constant Control
Controls.dynamic
with_constant :: ScoreT.Control -> Signal.Y -> Derive.Deriver a
-> Derive.Deriver a
with_constant :: forall a. Control -> Double -> Deriver a -> Deriver a
with_constant Control
control = Control -> Typed Control -> Deriver a -> Deriver a
forall a. Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_control Control
control (Typed Control -> Deriver a -> Deriver a)
-> (Double -> Typed Control) -> Double -> Deriver a -> Deriver a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Control -> Typed Control
forall a. a -> Typed a
ScoreT.untyped
(Control -> Typed Control)
-> (Double -> Control) -> Double -> Typed Control
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Control
forall {k} (kind :: k). Double -> Signal kind
Signal.constant
add_control, multiply_control :: ScoreT.Control -> ScoreT.Typed Signal.Control
-> Derive.Deriver a -> Derive.Deriver a
add_control :: forall a. Control -> Typed Control -> Deriver a -> Deriver a
add_control = Merger -> Control -> Typed Control -> Deriver a -> Deriver a
forall a.
Merger -> Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_merged_control Merger
Derive.merge_add
multiply_control :: forall a. Control -> Typed Control -> Deriver a -> Deriver a
multiply_control = Merger -> Control -> Typed Control -> Deriver a -> Deriver a
forall a.
Merger -> Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_merged_control Merger
Derive.merge_mul
add_constant, multiply_constant :: ScoreT.Control -> Signal.Y
-> Derive.Deriver a -> Derive.Deriver a
multiply_constant :: forall a. Control -> Double -> Deriver a -> Deriver a
multiply_constant Control
control Double
val
| Double
val Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
1 = Deriver a -> Deriver a
forall a. a -> a
id
| Bool
otherwise = Merger -> Control -> Typed Control -> Deriver a -> Deriver a
forall a.
Merger -> Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_merged_control Merger
Derive.merge_mul Control
control
(Control -> Typed Control
forall a. a -> Typed a
ScoreT.untyped (Double -> Control
forall {k} (kind :: k). Double -> Signal kind
Signal.constant Double
val))
add_constant :: forall a. Control -> Double -> Deriver a -> Deriver a
add_constant Control
control Double
val
| Double
val Double -> Double -> Bool
forall a. Eq a => a -> a -> Bool
== Double
0 = Deriver a -> Deriver a
forall a. a -> a
id
| Bool
otherwise = Merger -> Control -> Typed Control -> Deriver a -> Deriver a
forall a.
Merger -> Control -> Typed Control -> Deriver a -> Deriver a
Derive.with_merged_control Merger
Derive.merge_add Control
control
(Control -> Typed Control
forall a. a -> Typed a
ScoreT.untyped (Double -> Control
forall {k} (kind :: k). Double -> Signal kind
Signal.constant Double
val))
get_srate :: Derive.Deriver RealTime
get_srate :: Deriver RealTime
get_srate = Double -> RealTime
RealTime.seconds (Double -> RealTime) -> Deriver Double -> Deriver RealTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Deriver Double
forall a. Typecheck a => Text -> Deriver a
Derive.get_val Text
EnvKey.srate
get_scale :: Derive.Deriver Scale.Scale
get_scale :: Deriver Scale
get_scale = ScaleId -> Deriver Scale
Derive.get_scale (ScaleId -> Deriver Scale)
-> Deriver State Error ScaleId -> Deriver Scale
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Deriver State Error ScaleId
get_scale_id
lookup_scale :: Derive.Deriver (Maybe Scale.Scale)
lookup_scale :: Deriver (Maybe Scale)
lookup_scale = ScaleId -> Deriver (Maybe Scale)
Derive.lookup_scale (ScaleId -> Deriver (Maybe Scale))
-> Deriver State Error ScaleId -> Deriver (Maybe Scale)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Deriver State Error ScaleId
get_scale_id
get_scale_id :: Derive.Deriver Pitch.ScaleId
get_scale_id :: Deriver State Error ScaleId
get_scale_id = Str -> ScaleId
Expr.str_to_scale_id (Str -> ScaleId)
-> Deriver State Error Str -> Deriver State Error ScaleId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Deriver State Error Str
forall a. Typecheck a => Text -> Deriver a
Derive.get_val Text
EnvKey.scale
lookup_key :: Derive.Deriver (Maybe Pitch.Key)
lookup_key :: Deriver (Maybe Key)
lookup_key = (Text -> Key) -> Maybe Text -> Maybe Key
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Key
Pitch.Key (Maybe Text -> Maybe Key)
-> Deriver State Error (Maybe Text) -> Deriver (Maybe Key)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Deriver State Error (Maybe Text)
forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.key
get_instrument :: Derive.Deriver ScoreT.Instrument
get_instrument :: Deriver Instrument
get_instrument = Text -> Deriver Instrument
forall a. Typecheck a => Text -> Deriver a
Derive.get_val Text
EnvKey.instrument
lookup_instrument :: Derive.Deriver (Maybe ScoreT.Instrument)
lookup_instrument :: Deriver (Maybe Instrument)
lookup_instrument = Text -> Deriver (Maybe Instrument)
forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.instrument
get_attributes :: Derive.Deriver Attrs.Attributes
get_attributes :: Deriver Attributes
get_attributes = Attributes -> Maybe Attributes -> Attributes
forall a. a -> Maybe a -> a
fromMaybe Attributes
forall a. Monoid a => a
mempty (Maybe Attributes -> Attributes)
-> Deriver State Error (Maybe Attributes) -> Deriver Attributes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Deriver State Error (Maybe Attributes)
forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.attributes
get_pitch_functions :: Derive.Deriver
( Pitch.Note -> Maybe Pitch.Pitch
, Pitch.Pitch -> Maybe Pitch.Note
, Scale.Transposition -> Pitch.Step -> Pitch.Pitch -> Maybe Pitch.Pitch
)
get_pitch_functions :: Deriver
(Note -> Maybe Pitch, Pitch -> Maybe Note,
Transposition -> Int -> Pitch -> Maybe Pitch)
get_pitch_functions = do
Scale
scale <- Deriver Scale
get_scale
Environ
env <- Deriver Environ
Derive.get_environ
let transpose :: Transposition -> Int -> Pitch -> Maybe Pitch
transpose Transposition
transposition Int
steps =
Either PitchError Pitch -> Maybe Pitch
forall {a} {a}. Either a a -> Maybe a
to_maybe (Either PitchError Pitch -> Maybe Pitch)
-> (Pitch -> Either PitchError Pitch) -> Pitch -> Maybe Pitch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scale -> Transpose
Scale.scale_transpose Scale
scale Transposition
transposition Environ
env Int
steps
(Note -> Maybe Pitch, Pitch -> Maybe Note,
Transposition -> Int -> Pitch -> Maybe Pitch)
-> Deriver
(Note -> Maybe Pitch, Pitch -> Maybe Note,
Transposition -> Int -> Pitch -> Maybe Pitch)
forall (m :: * -> *) a. Monad m => a -> m a
return
( Either PitchError Pitch -> Maybe Pitch
forall {a} {a}. Either a a -> Maybe a
to_maybe (Either PitchError Pitch -> Maybe Pitch)
-> (Note -> Either PitchError Pitch) -> Note -> Maybe Pitch
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scale -> Environ -> Note -> Either PitchError Pitch
Scale.scale_read Scale
scale Environ
env
, Either PitchError Note -> Maybe Note
forall {a} {a}. Either a a -> Maybe a
to_maybe (Either PitchError Note -> Maybe Note)
-> (Pitch -> Either PitchError Note) -> Pitch -> Maybe Note
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scale -> Environ -> Pitch -> Either PitchError Note
Scale.scale_show Scale
scale Environ
env
, Transposition -> Int -> Pitch -> Maybe Pitch
transpose
)
where to_maybe :: Either a a -> Maybe a
to_maybe = (a -> Maybe a) -> (a -> Maybe a) -> Either a a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> a -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just
parse_pitch :: (Pitch.Note -> Maybe a) -> PSignal.Transposed
-> Derive.Deriver a
parse_pitch :: forall a. (Note -> Maybe a) -> Transposed -> Deriver a
parse_pitch Note -> Maybe a
parse Transposed
pitch = do
Note
note <- Transposed -> Deriver Note
Pitches.pitch_note Transposed
pitch
Text -> Maybe a -> Deriver a
forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require Text
"unparseable pitch" (Maybe a -> Deriver a) -> Maybe a -> Deriver a
forall a b. (a -> b) -> a -> b
$ Note -> Maybe a
parse Note
note
chromatic_difference :: PSignal.Transposed -> PSignal.Transposed
-> Derive.Deriver Pitch.Semi
chromatic_difference :: Transposed -> Transposed -> Deriver Int
chromatic_difference = (Layout -> Pitch -> Pitch -> Int)
-> Transposed -> Transposed -> Deriver Int
forall a.
(Layout -> Pitch -> Pitch -> a)
-> Transposed -> Transposed -> Deriver a
pitch_difference Layout -> Pitch -> Pitch -> Int
Scale.chromatic_difference
diatonic_difference :: PSignal.Transposed -> PSignal.Transposed
-> Derive.Deriver Pitch.PitchClass
diatonic_difference :: Transposed -> Transposed -> Deriver Int
diatonic_difference = (Layout -> Pitch -> Pitch -> Int)
-> Transposed -> Transposed -> Deriver Int
forall a.
(Layout -> Pitch -> Pitch -> a)
-> Transposed -> Transposed -> Deriver a
pitch_difference Layout -> Pitch -> Pitch -> Int
Scale.diatonic_difference
pitch_difference :: (Scale.Layout -> Pitch.Pitch -> Pitch.Pitch -> a)
-> PSignal.Transposed -> PSignal.Transposed -> Derive.Deriver a
pitch_difference :: forall a.
(Layout -> Pitch -> Pitch -> a)
-> Transposed -> Transposed -> Deriver a
pitch_difference Layout -> Pitch -> Pitch -> a
difference Transposed
p1 Transposed
p2 = do
Scale
scale <- Deriver Scale
get_scale
Environ
env <- Deriver Environ
Derive.get_environ
let parse :: Scale -> Environ -> Transposed -> Either PitchError Pitch
parse Scale
scale Environ
env = Scale -> Environ -> Note -> Either PitchError Pitch
Scale.scale_read Scale
scale Environ
env (Note -> Either PitchError Pitch)
-> (Transposed -> Either PitchError Note)
-> Transposed
-> Either PitchError Pitch
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Transposed -> Either PitchError Note
PSignal.pitch_note
let msg :: Text
msg = Transposed -> Text
forall a. Pretty a => a -> Text
pretty Transposed
p1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" - " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Transposed -> Text
forall a. Pretty a => a -> Text
pretty Transposed
p2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": "
(PitchError -> Text) -> Either PitchError a -> Deriver a
forall err a.
HasCallStack =>
(err -> Text) -> Either err a -> Deriver a
Derive.require_right ((Text
msg<>) (Text -> Text) -> (PitchError -> Text) -> PitchError -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PitchError -> Text
forall a. Pretty a => a -> Text
pretty) (Either PitchError a -> Deriver a)
-> Either PitchError a -> Deriver a
forall a b. (a -> b) -> a -> b
$
Layout -> Pitch -> Pitch -> a
difference (Scale -> Layout
Scale.scale_layout Scale
scale) (Pitch -> Pitch -> a)
-> Either PitchError Pitch -> Either PitchError (Pitch -> a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Scale -> Environ -> Transposed -> Either PitchError Pitch
parse Scale
scale Environ
env Transposed
p1 Either PitchError (Pitch -> a)
-> Either PitchError Pitch -> Either PitchError a
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Scale -> Environ -> Transposed -> Either PitchError Pitch
parse Scale
scale Environ
env Transposed
p2
nn_difference :: RealTime -> PSignal.Pitch -> PSignal.Pitch
-> Derive.Deriver Pitch.NoteNumber
nn_difference :: RealTime -> Pitch -> Pitch -> Deriver NoteNumber
nn_difference RealTime
pos Pitch
pitch1 Pitch
pitch2 = do
Transposed
pitch1 <- RealTime -> Pitch -> Deriver State Error Transposed
Derive.resolve_pitch RealTime
pos Pitch
pitch1
Transposed
pitch2 <- RealTime -> Pitch -> Deriver State Error Transposed
Derive.resolve_pitch RealTime
pos Pitch
pitch2
(-) (NoteNumber -> NoteNumber -> NoteNumber)
-> Deriver NoteNumber
-> Deriver State Error (NoteNumber -> NoteNumber)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Transposed -> Deriver NoteNumber
Pitches.pitch_nn Transposed
pitch1 Deriver State Error (NoteNumber -> NoteNumber)
-> Deriver NoteNumber -> Deriver NoteNumber
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Transposed -> Deriver NoteNumber
Pitches.pitch_nn Transposed
pitch2
eval_pitch_ :: ScoreTime -> Pitch.Pitch -> Derive.Deriver PSignal.Transposed
eval_pitch_ :: ScoreTime -> Pitch -> Deriver State Error Transposed
eval_pitch_ ScoreTime
start Pitch
pitch = do
(Note -> Maybe Pitch
_, Pitch -> Maybe Note
show_pitch, Transposition -> Int -> Pitch -> Maybe Pitch
_) <- Deriver
(Note -> Maybe Pitch, Pitch -> Maybe Note,
Transposition -> Int -> Pitch -> Maybe Pitch)
get_pitch_functions
(Pitch -> Maybe Note)
-> ScoreTime -> Pitch -> Deriver State Error Transposed
eval_pitch Pitch -> Maybe Note
show_pitch ScoreTime
start Pitch
pitch
eval_pitch :: (Pitch.Pitch -> Maybe Pitch.Note) -> ScoreTime -> Pitch.Pitch
-> Derive.Deriver PSignal.Transposed
eval_pitch :: (Pitch -> Maybe Note)
-> ScoreTime -> Pitch -> Deriver State Error Transposed
eval_pitch Pitch -> Maybe Note
show_pitch ScoreTime
start Pitch
pitch = do
Note
note <- Text -> Maybe Note -> Deriver Note
forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"scale doesn't have pitch: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Pitch -> Text
forall a. Pretty a => a -> Text
pretty Pitch
pitch)
(Pitch -> Maybe Note
show_pitch Pitch
pitch)
ScoreTime -> Note -> Deriver State Error Transposed
eval_note ScoreTime
start Note
note
eval_note :: ScoreTime -> Pitch.Note -> Derive.Deriver PSignal.Transposed
eval_note :: ScoreTime -> Note -> Deriver State Error Transposed
eval_note ScoreTime
pos Note
note = ScoreTime -> PitchCall -> Deriver State Error Transposed
forall a. ScoreTime -> PitchCall -> Deriver (RawPitch a)
Eval.eval_pitch ScoreTime
pos (PitchCall -> Deriver State Error Transposed)
-> PitchCall -> Deriver State Error Transposed
forall a b. (a -> b) -> a -> b
$
Symbol -> PitchCall
forall val. Symbol -> Call val
Expr.call0 (Text -> Symbol
Expr.Symbol (Note -> Text
Pitch.note_text Note
note))
note :: Derive.NoteDeriver
note :: NoteDeriver
note = Bool -> PitchCall -> NoteDeriver
forall d. CallableExpr d => Bool -> PitchCall -> Deriver (Stream d)
Eval.eval_one_call Bool
True (PitchCall -> NoteDeriver) -> PitchCall -> NoteDeriver
forall a b. (a -> b) -> a -> b
$ Symbol -> PitchCall
forall val. Symbol -> Call val
Expr.call0 Symbol
Symbols.null_note
reapply_note :: Derive.NoteArgs -> Derive.NoteDeriver
reapply_note :: NoteArgs -> NoteDeriver
reapply_note NoteArgs
args = Context Event -> Symbol -> [Term] -> NoteDeriver
forall d.
CallableExpr d =>
Context d -> Symbol -> [Term] -> Deriver (Stream d)
Eval.reapply_call (NoteArgs -> Context Event
forall a. PassedArgs a -> Context a
Args.context NoteArgs
args) Symbol
Symbols.null_note []
pitched_note :: PSignal.Pitch -> Derive.NoteDeriver
pitched_note :: Pitch -> NoteDeriver
pitched_note Pitch
pitch = Pitch -> NoteDeriver -> NoteDeriver
forall a. Pitch -> Deriver a -> Deriver a
with_pitch Pitch
pitch NoteDeriver
note
transposed_pitched_note :: PSignal.Transposed -> Derive.NoteDeriver
transposed_pitched_note :: Transposed -> NoteDeriver
transposed_pitched_note Transposed
pitch = Transposed -> NoteDeriver -> NoteDeriver
forall a. Transposed -> Deriver a -> Deriver a
with_transposed_pitch Transposed
pitch NoteDeriver
note
attribute_note :: Attrs.Attributes -> Derive.NoteDeriver
attribute_note :: Attributes -> NoteDeriver
attribute_note Attributes
attrs = Attributes -> NoteDeriver -> NoteDeriver
forall d. Attributes -> Deriver d -> Deriver d
add_attributes Attributes
attrs NoteDeriver
note
triggered_note :: Derive.NoteDeriver
triggered_note :: NoteDeriver
triggered_note =
Bool -> ScoreTime -> ScoreTime -> Expr -> NoteDeriver
forall d.
CallableExpr d =>
Bool -> ScoreTime -> ScoreTime -> Expr -> Deriver (Stream d)
Eval.eval_one_at Bool
True ScoreTime
0 ScoreTime
0 (Expr -> NoteDeriver) -> Expr -> NoteDeriver
forall a b. (a -> b) -> a -> b
$ Symbol -> Expr
forall val. Symbol -> Expr val
Expr.generator0 Symbol
Symbols.null_note
place :: Derive.PassedArgs d -> Derive.Deriver a -> Derive.Deriver a
place :: forall d a. PassedArgs d -> Deriver a -> Deriver a
place = (ScoreTime -> ScoreTime -> Deriver a -> Deriver a)
-> (ScoreTime, ScoreTime) -> Deriver a -> Deriver a
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry ScoreTime -> ScoreTime -> Deriver a -> Deriver a
forall a. ScoreTime -> ScoreTime -> Deriver a -> Deriver a
Derive.place ((ScoreTime, ScoreTime) -> Deriver a -> Deriver a)
-> (PassedArgs d -> (ScoreTime, ScoreTime))
-> PassedArgs d
-> Deriver a
-> Deriver a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PassedArgs d -> (ScoreTime, ScoreTime)
forall a. PassedArgs a -> (ScoreTime, ScoreTime)
Args.extent
placed_note :: Derive.PassedArgs d -> Derive.NoteDeriver
placed_note :: forall d. PassedArgs d -> NoteDeriver
placed_note PassedArgs d
args = PassedArgs d -> NoteDeriver -> NoteDeriver
forall d a. PassedArgs d -> Deriver a -> Deriver a
place PassedArgs d
args NoteDeriver
note
with_attributes :: (Attrs.Attributes -> Attrs.Attributes) -> Derive.Deriver d
-> Derive.Deriver d
with_attributes :: forall d. (Attributes -> Attributes) -> Deriver d -> Deriver d
with_attributes Attributes -> Attributes
f Deriver d
deriver = do
Attributes
attrs <- Deriver Attributes
get_attributes
Text -> Attributes -> Deriver d -> Deriver d
forall val a. ToVal val => Text -> val -> Deriver a -> Deriver a
Derive.with_val Text
EnvKey.attributes (Attributes -> Attributes
f Attributes
attrs) Deriver d
deriver
add_attributes :: Attrs.Attributes -> Derive.Deriver d -> Derive.Deriver d
add_attributes :: forall d. Attributes -> Deriver d -> Deriver d
add_attributes Attributes
attrs
| Attributes
attrs Attributes -> Attributes -> Bool
forall a. Eq a => a -> a -> Bool
== Attributes
forall a. Monoid a => a
mempty = Deriver d -> Deriver d
forall a. a -> a
id
| Bool
otherwise = (Attributes -> Attributes) -> Deriver d -> Deriver d
forall d. (Attributes -> Attributes) -> Deriver d -> Deriver d
with_attributes (Attributes -> Attributes -> Attributes
forall a. Semigroup a => a -> a -> a
<> Attributes
attrs)
add_flags :: Flags.Flags -> Derive.NoteDeriver -> Derive.NoteDeriver
add_flags :: Flags -> NoteDeriver -> NoteDeriver
add_flags Flags
flags
| Flags
flags Flags -> Flags -> Bool
forall a. Eq a => a -> a -> Bool
== Flags
forall a. Monoid a => a
mempty = NoteDeriver -> NoteDeriver
forall a. a -> a
id
| Bool
otherwise = (Stream Event -> Stream Event) -> NoteDeriver -> NoteDeriver
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Event -> Event) -> Stream Event -> Stream Event
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Flags -> Event -> Event
Score.add_flags Flags
flags))
class Random a where
randoms :: Derive.Deriver [a]
randoms_in :: a -> a -> Derive.Deriver [a]
instance Random Double where
randoms :: Deriver [Double]
randoms = (PureMT -> (Double, PureMT)) -> Deriver [Double]
forall a. (PureMT -> (a, PureMT)) -> Deriver [a]
_make_randoms PureMT -> (Double, PureMT)
Pure64.randomDouble
randoms_in :: Double -> Double -> Deriver [Double]
randoms_in Double
low Double
high = (Double -> Double) -> [Double] -> [Double]
forall a b. (a -> b) -> [a] -> [b]
map (Double -> Double -> Double -> Double
forall a. (Eq a, Num a) => a -> a -> a -> a
Num.scale Double
low Double
high) ([Double] -> [Double]) -> Deriver [Double] -> Deriver [Double]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver [Double]
forall a. Random a => Deriver [a]
randoms
instance Random Int where
randoms :: Deriver [Int]
randoms = (PureMT -> (Int, PureMT)) -> Deriver [Int]
forall a. (PureMT -> (a, PureMT)) -> Deriver [a]
_make_randoms PureMT -> (Int, PureMT)
Pure64.randomInt
randoms_in :: Int -> Int -> Deriver [Int]
randoms_in Int
low Int
high = (Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int -> Int
forall a. Real a => a -> a -> a -> a
Num.restrict Int
low Int
high) ([Int] -> [Int]) -> Deriver [Int] -> Deriver [Int]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver [Int]
forall a. Random a => Deriver [a]
randoms
random :: Random a => Derive.Deriver a
random :: forall a. Random a => Deriver a
random = [a] -> a
forall a. [a] -> a
head ([a] -> a) -> Deriver State Error [a] -> Deriver State Error a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver State Error [a]
forall a. Random a => Deriver [a]
randoms
random_in :: (Random a, Real a) => a -> a -> Derive.Deriver a
random_in :: forall a. (Random a, Real a) => a -> a -> Deriver a
random_in a
low a
high
| a
low a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
high = a -> Deriver State Error a
forall (m :: * -> *) a. Monad m => a -> m a
return a
low
| Bool
otherwise = [a] -> a
forall a. [a] -> a
head ([a] -> a) -> Deriver State Error [a] -> Deriver State Error a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> a -> Deriver State Error [a]
forall a. Random a => a -> a -> Deriver [a]
randoms_in a
low a
high
chance :: Double -> Derive.Deriver Bool
chance :: Double -> Deriver Bool
chance Double
v
| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
1 = Bool -> Deriver Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
| Double
v Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0 = Bool -> Deriver Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
| Bool
otherwise = do
Double
r <- Double -> Double -> Deriver Double
forall a. (Random a, Real a) => a -> a -> Deriver a
random_in Double
0 Double
1
Bool -> Deriver Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> Deriver Bool) -> Bool -> Deriver Bool
forall a b. (a -> b) -> a -> b
$ Double
r Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
v
shuffle :: [a] -> Derive.Deriver [a]
shuffle :: forall a. [a] -> Deriver [a]
shuffle [a]
xs = [a] -> [Int] -> [a]
forall a. [a] -> [Int] -> [a]
Random.shuffle [a]
xs ([Int] -> [a]) -> Deriver [Int] -> Deriver State Error [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver [Int]
forall a. Random a => Deriver [a]
randoms
_make_randoms :: (Pure64.PureMT -> (a, Pure64.PureMT)) -> Derive.Deriver [a]
_make_randoms :: forall a. (PureMT -> (a, PureMT)) -> Deriver [a]
_make_randoms PureMT -> (a, PureMT)
f = (PureMT -> Maybe (a, PureMT)) -> PureMT -> [a]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
List.unfoldr ((a, PureMT) -> Maybe (a, PureMT)
forall a. a -> Maybe a
Just ((a, PureMT) -> Maybe (a, PureMT))
-> (PureMT -> (a, PureMT)) -> PureMT -> Maybe (a, PureMT)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PureMT -> (a, PureMT)
f) (PureMT -> [a])
-> Deriver State Error PureMT -> Deriver State Error [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver State Error PureMT
_random_generator
_random_generator :: Derive.Deriver Pure64.PureMT
_random_generator :: Deriver State Error PureMT
_random_generator = do
Double
seed <- Double -> Maybe Double -> Double
forall a. a -> Maybe a -> a
fromMaybe Double
0 (Maybe Double -> Double)
-> Deriver State Error (Maybe Double) -> Deriver Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Deriver State Error (Maybe Double)
forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
EnvKey.seed
PureMT -> Deriver State Error PureMT
forall (m :: * -> *) a. Monad m => a -> m a
return (PureMT -> Deriver State Error PureMT)
-> PureMT -> Deriver State Error PureMT
forall a b. (a -> b) -> a -> b
$ Word64 -> PureMT
Pure64.pureMT (Double -> Word64
forall a b. (RealFrac a, Integral b) => a -> b
floor (Double
seed :: Double))
pick_weighted :: NonEmpty (Double, a) -> Double -> a
pick_weighted :: forall a. NonEmpty (Double, a) -> Double -> a
pick_weighted NonEmpty (Double, a)
weights Double
rnd_ = Double -> NonEmpty (Double, a) -> a
forall {b}. Double -> NonEmpty (Double, b) -> b
go Double
0 NonEmpty (Double, a)
weights
where
rnd :: Double
rnd = Double
rnd_ Double -> Double -> Double
forall a. Num a => a -> a -> a
* NonEmpty Double -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum (((Double, a) -> Double) -> NonEmpty (Double, a) -> NonEmpty Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Double, a) -> Double
forall a b. (a, b) -> a
fst NonEmpty (Double, a)
weights)
go :: Double -> NonEmpty (Double, b) -> b
go Double
collect ((Double
weight, b
a) :| [(Double, b)]
weights) = case [(Double, b)]
weights of
[] -> b
a
(Double, b)
w : [(Double, b)]
ws
| Double
collect Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
weight Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> Double
rnd -> b
a
| Bool
otherwise -> Double -> NonEmpty (Double, b) -> b
go (Double
collect Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
weight) ((Double, b)
w (Double, b) -> [(Double, b)] -> NonEmpty (Double, b)
forall a. a -> [a] -> NonEmpty a
:| [(Double, b)]
ws)
pick :: NonEmpty a -> Double -> a
pick :: forall a. NonEmpty a -> Double -> a
pick (a
x :| [a]
xs) Double
rnd = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
xs) [a] -> Int -> a
forall a. [a] -> Int -> a
!! Int
i
where i :: Int
i = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
rnd Double -> Double -> Double
forall a. Num a => a -> a -> a
* Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
xs))
normal :: Double -> Derive.Deriver Double
normal :: Double -> Deriver Double
normal Double
stddev = Double -> [Double] -> Double
make_normal Double
stddev ([Double] -> Double) -> Deriver [Double] -> Deriver Double
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Deriver [Double]
forall a. Random a => Deriver [a]
randoms
make_normal :: Double -> [Double] -> Double
make_normal :: Double -> [Double] -> Double
make_normal Double
stddev [Double]
rnds = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
Num.sum (Int -> [Double] -> [Double]
forall a. Int -> [a] -> [a]
take Int
samples [Double]
rnds) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
samples
where
samples :: Int
samples = Int
12
if_env :: (Eq val, Typecheck.Typecheck val) => EnvKey.Key -> Maybe val
-> Derive.Deriver a -> Derive.Deriver a -> Derive.Deriver a
if_env :: forall val a.
(Eq val, Typecheck val) =>
Text -> Maybe val -> Deriver a -> Deriver a -> Deriver a
if_env Text
key Maybe val
val Deriver a
is_set Deriver a
not_set =
Deriver Bool -> Deriver a -> Deriver a -> Deriver a
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM ((Maybe val -> Maybe val -> Bool
forall a. Eq a => a -> a -> Bool
==Maybe val
val) (Maybe val -> Bool)
-> Deriver State Error (Maybe val) -> Deriver Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Deriver State Error (Maybe val)
forall a. Typecheck a => Text -> Deriver (Maybe a)
Derive.lookup_val Text
key) Deriver a
is_set Deriver a
not_set
when_env :: (Eq val, Typecheck.Typecheck val) => EnvKey.Key -> Maybe val
-> (Derive.Deriver a -> Derive.Deriver a)
-> Derive.Deriver a -> Derive.Deriver a
when_env :: forall val a.
(Eq val, Typecheck val) =>
Text
-> Maybe val -> (Deriver a -> Deriver a) -> Deriver a -> Deriver a
when_env Text
key Maybe val
val Deriver a -> Deriver a
transformer Deriver a
deriver =
Text -> Maybe val -> Deriver a -> Deriver a -> Deriver a
forall val a.
(Eq val, Typecheck val) =>
Text -> Maybe val -> Deriver a -> Deriver a -> Deriver a
if_env Text
key Maybe val
val (Deriver a -> Deriver a
transformer Deriver a
deriver) Deriver a
deriver
real_duration :: (Derive.Time t1, Derive.Time t2) => t1 -> t2
-> Derive.Deriver RealTime
real_duration :: forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
real_duration t1
start t2
dur = case t2 -> Duration
forall a. Time a => a -> Duration
Derive.to_duration t2
dur of
DeriveT.RealDuration RealTime
t -> RealTime -> Deriver RealTime
forall (m :: * -> *) a. Monad m => a -> m a
return RealTime
t
DeriveT.ScoreDuration ScoreTime
t
| ScoreTime
t ScoreTime -> ScoreTime -> Bool
forall a. Eq a => a -> a -> Bool
== ScoreTime
0 -> RealTime -> Deriver RealTime
forall (m :: * -> *) a. Monad m => a -> m a
return RealTime
0
| Bool
otherwise -> do
ScoreTime
score_start <- t1 -> Deriver ScoreTime
forall a. Time a => a -> Deriver ScoreTime
Derive.score t1
start
RealTime
real_start <- t1 -> Deriver RealTime
forall a. Time a => a -> Deriver RealTime
Derive.real t1
start
RealTime
end <- ScoreTime -> Deriver RealTime
forall a. Time a => a -> Deriver RealTime
Derive.real (ScoreTime -> Deriver RealTime) -> ScoreTime -> Deriver RealTime
forall a b. (a -> b) -> a -> b
$ ScoreTime
score_start ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
+ ScoreTime
t
RealTime -> Deriver RealTime
forall (m :: * -> *) a. Monad m => a -> m a
return (RealTime -> Deriver RealTime) -> RealTime -> Deriver RealTime
forall a b. (a -> b) -> a -> b
$ RealTime
end RealTime -> RealTime -> RealTime
forall a. Num a => a -> a -> a
- RealTime
real_start
score_duration :: (Derive.Time t1, Derive.Time t2) => t1 -> t2
-> Derive.Deriver ScoreTime
score_duration :: forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver ScoreTime
score_duration t1
start t2
dur = case t2 -> Duration
forall a. Time a => a -> Duration
Derive.to_duration t2
dur of
DeriveT.ScoreDuration ScoreTime
t -> ScoreTime -> Deriver ScoreTime
forall (m :: * -> *) a. Monad m => a -> m a
return ScoreTime
t
DeriveT.RealDuration RealTime
t
| RealTime
t RealTime -> RealTime -> Bool
forall a. Eq a => a -> a -> Bool
== RealTime
0 -> ScoreTime -> Deriver ScoreTime
forall (m :: * -> *) a. Monad m => a -> m a
return ScoreTime
0
| Bool
otherwise -> do
ScoreTime
score_start <- t1 -> Deriver ScoreTime
forall a. Time a => a -> Deriver ScoreTime
Derive.score t1
start
RealTime
real_start <- t1 -> Deriver RealTime
forall a. Time a => a -> Deriver RealTime
Derive.real t1
start
ScoreTime
end <- RealTime -> Deriver ScoreTime
forall a. Time a => a -> Deriver ScoreTime
Derive.score (RealTime -> Deriver ScoreTime) -> RealTime -> Deriver ScoreTime
forall a b. (a -> b) -> a -> b
$ RealTime
real_start RealTime -> RealTime -> RealTime
forall a. Num a => a -> a -> a
+ RealTime
t
ScoreTime -> Deriver ScoreTime
forall (m :: * -> *) a. Monad m => a -> m a
return (ScoreTime -> Deriver ScoreTime) -> ScoreTime -> Deriver ScoreTime
forall a b. (a -> b) -> a -> b
$ ScoreTime
end ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
- ScoreTime
score_start
duration_from_start :: Derive.Time t => Derive.PassedArgs d -> t
-> Derive.Deriver (RealTime, RealTime)
duration_from_start :: forall t d.
Time t =>
PassedArgs d -> t -> Deriver (RealTime, RealTime)
duration_from_start PassedArgs d
args t
t = do
RealTime
start <- PassedArgs d -> Deriver RealTime
forall a. PassedArgs a -> Deriver RealTime
Args.real_start PassedArgs d
args
RealTime
dur <- RealTime -> t -> Deriver RealTime
forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
real_duration RealTime
start t
t
(RealTime, RealTime) -> Deriver (RealTime, RealTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (RealTime
start, RealTime
start RealTime -> RealTime -> RealTime
forall a. Num a => a -> a -> a
+ RealTime
dur)
duration_from_end :: Derive.Time t => Derive.PassedArgs d -> t
-> Derive.Deriver (RealTime, RealTime)
duration_from_end :: forall t d.
Time t =>
PassedArgs d -> t -> Deriver (RealTime, RealTime)
duration_from_end PassedArgs d
args t
t = do
RealTime
end <- PassedArgs d -> Deriver RealTime
forall a. PassedArgs a -> Deriver RealTime
Args.real_end PassedArgs d
args
RealTime
dur <- RealTime -> t -> Deriver RealTime
forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
real_duration RealTime
end t
t
(RealTime, RealTime) -> Deriver (RealTime, RealTime)
forall (m :: * -> *) a. Monad m => a -> m a
return (RealTime
end RealTime -> RealTime -> RealTime
forall a. Num a => a -> a -> a
- RealTime
dur, RealTime
end)
typed_real_duration :: Derive.Time t => Typecheck.TimeType -> t
-> ScoreT.Typed Signal.Y -> Derive.Deriver RealTime
typed_real_duration :: forall t.
Time t =>
TimeType -> t -> Typed Double -> Deriver RealTime
typed_real_duration TimeType
default_type t
from (ScoreT.Typed Type
typ Double
val)
| Type
typ Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
ScoreT.Real
Bool -> Bool -> Bool
|| Type
typ Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
ScoreT.Untyped Bool -> Bool -> Bool
&& TimeType
default_type TimeType -> TimeType -> Bool
forall a. Eq a => a -> a -> Bool
== TimeType
Typecheck.Real =
RealTime -> Deriver RealTime
forall (m :: * -> *) a. Monad m => a -> m a
return (Double -> RealTime
RealTime.seconds Double
val)
| Type
typ Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
ScoreT.Score
Bool -> Bool -> Bool
|| Type
typ Type -> Type -> Bool
forall a. Eq a => a -> a -> Bool
== Type
ScoreT.Untyped Bool -> Bool -> Bool
&& TimeType
default_type TimeType -> TimeType -> Bool
forall a. Eq a => a -> a -> Bool
== TimeType
Typecheck.Score =
t -> ScoreTime -> Deriver RealTime
forall t1 t2. (Time t1, Time t2) => t1 -> t2 -> Deriver RealTime
real_duration t
from (Double -> ScoreTime
ScoreTime.from_double Double
val)
| Bool
otherwise = Text -> Deriver RealTime
forall a. HasCallStack => Text -> Deriver a
Derive.throw (Text -> Deriver RealTime) -> Text -> Deriver RealTime
forall a b. (a -> b) -> a -> b
$
Text
"expected time type for " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Typed Double -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val (Type -> Double -> Typed Double
forall a. Type -> a -> Typed a
ScoreT.Typed Type
typ Double
val)
timestep :: ScoreTime -> TimeStep.TimeStep
-> [Int]
-> Derive.Deriver ScoreTime
timestep :: ScoreTime -> TimeStep -> [Int] -> Deriver ScoreTime
timestep ScoreTime
start TimeStep
ts [Int]
steps = do
(BlockId
block_id, Int
tracknum) <- Deriver (BlockId, Int)
Internal.get_current_tracknum
Text -> Maybe ScoreTime -> Deriver ScoreTime
forall a. HasCallStack => Text -> Maybe a -> Deriver a
Derive.require (Text
"no valid timestep from " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ScoreTime -> Text
forall a. ShowVal a => a -> Text
ShowVal.show_val ScoreTime
start)
(Maybe ScoreTime -> Deriver ScoreTime)
-> Deriver State Error (Maybe ScoreTime) -> Deriver ScoreTime
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< StateId (Maybe ScoreTime) -> Deriver State Error (Maybe ScoreTime)
forall a. HasCallStack => StateId a -> Deriver a
Derive.eval_ui
([StateId (Maybe ScoreTime)] -> StateId (Maybe ScoreTime)
forall (m :: * -> *) a. Monad m => [m (Maybe a)] -> m (Maybe a)
firstJusts [Int
-> TimeStep
-> BlockId
-> Int
-> ScoreTime
-> StateId (Maybe ScoreTime)
forall (m :: * -> *).
M m =>
Int
-> TimeStep -> BlockId -> Int -> ScoreTime -> m (Maybe ScoreTime)
TimeStep.step_from Int
step TimeStep
ts BlockId
block_id Int
tracknum ScoreTime
start |
Int
step <- [Int]
steps])
meter_duration :: ScoreTime -> Meter.Rank -> Int
-> Derive.Deriver ScoreTime
meter_duration :: ScoreTime -> Rank -> Int -> Deriver ScoreTime
meter_duration ScoreTime
start Rank
rank Int
steps = do
ScoreTime
end <- ScoreTime -> TimeStep -> [Int] -> Deriver ScoreTime
timestep ScoreTime
start TimeStep
ts ((Int -> Int) -> [Int] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
steps) [Int
1, -Int
1])
ScoreTime -> Deriver ScoreTime
forall (m :: * -> *) a. Monad m => a -> m a
return (ScoreTime -> Deriver ScoreTime) -> ScoreTime -> Deriver ScoreTime
forall a b. (a -> b) -> a -> b
$ ScoreTime -> ScoreTime
forall a. Num a => a -> a
abs (ScoreTime
end ScoreTime -> ScoreTime -> ScoreTime
forall a. Num a => a -> a -> a
- ScoreTime
start)
where
ts :: TimeStep
ts = Step -> TimeStep
TimeStep.time_step (Step -> TimeStep) -> Step -> TimeStep
forall a b. (a -> b) -> a -> b
$ MarklistMatch -> Rank -> Step
TimeStep.RelativeMark MarklistMatch
TimeStep.match_meter Rank
rank
timestep_duration :: Derive.PassedArgs a -> Meter.Rank
-> Derive.Deriver ScoreTime
timestep_duration :: forall a. PassedArgs a -> Rank -> Deriver ScoreTime
timestep_duration PassedArgs a
args Rank
step = ScoreTime -> Rank -> Int -> Deriver ScoreTime
meter_duration (PassedArgs a -> ScoreTime
forall a. PassedArgs a -> ScoreTime
Args.start PassedArgs a
args) Rank
step Int
1
data UpDown = Up | Down deriving (Int -> UpDown -> ShowS
[UpDown] -> ShowS
UpDown -> String
(Int -> UpDown -> ShowS)
-> (UpDown -> String) -> ([UpDown] -> ShowS) -> Show UpDown
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpDown] -> ShowS
$cshowList :: [UpDown] -> ShowS
show :: UpDown -> String
$cshow :: UpDown -> String
showsPrec :: Int -> UpDown -> ShowS
$cshowsPrec :: Int -> UpDown -> ShowS
Show, Int -> UpDown
UpDown -> Int
UpDown -> [UpDown]
UpDown -> UpDown
UpDown -> UpDown -> [UpDown]
UpDown -> UpDown -> UpDown -> [UpDown]
(UpDown -> UpDown)
-> (UpDown -> UpDown)
-> (Int -> UpDown)
-> (UpDown -> Int)
-> (UpDown -> [UpDown])
-> (UpDown -> UpDown -> [UpDown])
-> (UpDown -> UpDown -> [UpDown])
-> (UpDown -> UpDown -> UpDown -> [UpDown])
-> Enum UpDown
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: UpDown -> UpDown -> UpDown -> [UpDown]
$cenumFromThenTo :: UpDown -> UpDown -> UpDown -> [UpDown]
enumFromTo :: UpDown -> UpDown -> [UpDown]
$cenumFromTo :: UpDown -> UpDown -> [UpDown]
enumFromThen :: UpDown -> UpDown -> [UpDown]
$cenumFromThen :: UpDown -> UpDown -> [UpDown]
enumFrom :: UpDown -> [UpDown]
$cenumFrom :: UpDown -> [UpDown]
fromEnum :: UpDown -> Int
$cfromEnum :: UpDown -> Int
toEnum :: Int -> UpDown
$ctoEnum :: Int -> UpDown
pred :: UpDown -> UpDown
$cpred :: UpDown -> UpDown
succ :: UpDown -> UpDown
$csucc :: UpDown -> UpDown
Enum, UpDown
UpDown -> UpDown -> Bounded UpDown
forall a. a -> a -> Bounded a
maxBound :: UpDown
$cmaxBound :: UpDown
minBound :: UpDown
$cminBound :: UpDown
Bounded, UpDown -> UpDown -> Bool
(UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> Bool) -> Eq UpDown
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpDown -> UpDown -> Bool
$c/= :: UpDown -> UpDown -> Bool
== :: UpDown -> UpDown -> Bool
$c== :: UpDown -> UpDown -> Bool
Eq, Eq UpDown
Eq UpDown
-> (UpDown -> UpDown -> Ordering)
-> (UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> Bool)
-> (UpDown -> UpDown -> UpDown)
-> (UpDown -> UpDown -> UpDown)
-> Ord UpDown
UpDown -> UpDown -> Bool
UpDown -> UpDown -> Ordering
UpDown -> UpDown -> UpDown
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 :: UpDown -> UpDown -> UpDown
$cmin :: UpDown -> UpDown -> UpDown
max :: UpDown -> UpDown -> UpDown
$cmax :: UpDown -> UpDown -> UpDown
>= :: UpDown -> UpDown -> Bool
$c>= :: UpDown -> UpDown -> Bool
> :: UpDown -> UpDown -> Bool
$c> :: UpDown -> UpDown -> Bool
<= :: UpDown -> UpDown -> Bool
$c<= :: UpDown -> UpDown -> Bool
< :: UpDown -> UpDown -> Bool
$c< :: UpDown -> UpDown -> Bool
compare :: UpDown -> UpDown -> Ordering
$ccompare :: UpDown -> UpDown -> Ordering
Ord)
instance Pretty UpDown where pretty :: UpDown -> Text
pretty = UpDown -> Text
forall a. Show a => a -> Text
showt
instance Typecheck.Typecheck UpDown
instance ShowVal.ShowVal UpDown where
show_val :: UpDown -> Text
show_val UpDown
Up = Text
"u"
show_val UpDown
Down = Text
"d"