Safe Haskell | Safe-Inferred |
---|
Calls for gangsa techniques. Gangsa come in polos and sangsih pairs, and play either kotekan patterns or play unison or parallel parts.
Kotekan patterns have a number of features in common. They are all transpositions from a base pitch. Rhythmically, they consist of notes with a constant duration, that line up at the end of an event's range, and the last duration is negative (i.e. implicit, depending on the next note). They use polos and sangsih and may switch patterns when the a kotekan speed threshold is passed. Notes are also possibly muted.
There are a number of ways this can be extended:
- Use any attribute instead of just mute.
- More instruments than just polos and sangsih.
- Multiple kotekan thresholds.
The first two are supported at the KotekanNote
level of abstraction. For
the others, I have to either directly use Note
s or create a new
abstraction:
- Variable durations.
Synopsis
- library :: Library.Library
- module_ :: Module.Module
- c_derive_with :: CallName -> Bool -> Bool -> Library.Calls Note
- mute_postproc :: Attrs.Attributes -> Score.Event -> (Score.Event, [Log.Msg])
- c_ngoret :: Sig.Parser (Maybe.Maybe Pitch.Transpose) -> Generator Note
- data KotekanPattern = KotekanPattern {}
- data Pasang a = Pasang {}
- data Realization a = Realization {
- interlocking :: a
- non_interlocking :: a
- data IrregularPattern = IrregularPattern {
- ir_polos :: [Char]
- ir_sangsih4 :: [Char]
- ir_polos_ngotek :: [Char]
- ir_sangsih_ngotek3 :: [Char]
- ir_sangsih_ngotek4 :: [Char]
- irregular_pattern :: CallStack.Stack => IrregularPattern -> KotekanPattern
- parse_pattern :: CallStack.Stack => Pitch.Step -> [Char] -> [Maybe.Maybe Pitch.Step]
- kotekan_pattern :: KotekanPattern -> KotekanStyle -> Pasang ScoreT.Instrument -> Cycle
- pattern_steps :: KotekanStyle -> Pasang ScoreT.Instrument -> KotekanPattern -> Realization [[(Maybe.Maybe ScoreT.Instrument, Pitch.Step)]]
- c_norot :: Bool -> Maybe.Maybe Bool -> Generator Note
- norot :: Bool -> (DeriveT.Transposed -> Cycle) -> (DeriveT.Transposed -> Cycle) -> (ScoreTime -> Bool) -> Maybe.Maybe DeriveT.Pitch -> Maybe.Maybe DeriveT.Pitch -> ScoreTime -> (Bool, Bool) -> (ScoreTime, ScoreTime) -> NoteDeriver
- apply_initial_final :: ScoreTime -> ScoreTime -> (Bool, Bool) -> [[Note a]] -> [[Note a]]
- realize_norot :: (ScoreTime -> Bool) -> ScoreTime -> ScoreTime -> ScoreTime -> (Maybe.Maybe PitchedCycle, Maybe.Maybe PitchedCycle, Maybe.Maybe PitchedCycle) -> [[Note NoteDeriver]]
- norot_sequence :: Bool -> (DeriveT.Transposed -> Cycle) -> (DeriveT.Transposed -> Cycle) -> Maybe.Maybe DeriveT.Pitch -> Maybe.Maybe DeriveT.Pitch -> RealTime.RealTime -> Deriver (Maybe.Maybe PitchedCycle, Maybe.Maybe PitchedCycle, Maybe.Maybe PitchedCycle)
- data PitchedCycle = PitchedCycle !DeriveT.Pitch !Cycle
- prepare_sustain :: Bool -> ScoreTime -> (Maybe.Maybe Bool, Bool) -> Types.Orientation -> (ScoreTime, ScoreTime) -> (Maybe.Maybe ((Bool, Bool), (ScoreTime, ScoreTime)), Maybe.Maybe ((Bool, Bool), (ScoreTime, ScoreTime)))
- infer_prepare :: PassedArgs a -> Maybe.Maybe Bool -> Deriver (Maybe.Maybe DeriveT.Pitch)
- gangsa_norot :: NorotStyle -> Pasang ScoreT.Instrument -> Pasang (Pitch.Step, Pitch.Step) -> Cycle
- gangsa_norot_prepare :: NorotStyle -> Pasang ScoreT.Instrument -> Pasang (Pitch.Step, Pitch.Step) -> Cycle
- norot_steps :: Scale -> Maybe.Maybe Pitch.Pitch -> NorotStyle -> DeriveT.Transposed -> Pasang (Pitch.Step, Pitch.Step)
- c_gender_norot :: Generator Note
- gender_norot :: Pasang ScoreT.Instrument -> Cycle
- kotekan_doc :: Doc.Doc
- c_kotekan_irregular :: KotekanStyle -> KotekanPattern -> Generator Note
- c_kotekan_kernel :: Generator Note
- c_kotekan_regular :: Bool -> Maybe.Maybe Text -> KotekanStyle -> Generator Note
- c_kotekan_explicit :: Generator Note
- realize_explicit :: (ScoreTime, ScoreTime) -> ScoreTime -> DeriveT.Pitch -> [Maybe.Maybe Pitch.Step] -> ScoreT.Instrument -> NoteDeriver
- kernel_doc :: Doc.Doc
- realize_kernel :: Call.UpDown -> KotekanStyle -> Pasang ScoreT.Instrument -> Kernel -> Cycle
- realize_kotekan_pattern_args :: PassedArgs a -> (Maybe.Maybe Bool, Bool) -> ScoreTime -> DeriveT.Pitch -> (ScoreTime -> Bool) -> Repeat -> Cycle -> NoteDeriver
- realize_kotekan_pattern :: (Bool, Bool) -> (ScoreTime, ScoreTime) -> Types.Orientation -> ScoreTime -> DeriveT.Pitch -> (ScoreTime -> Bool) -> Repeat -> Cycle -> NoteDeriver
- type Kernel = [Atom]
- data Atom
- make_kernel :: [Char] -> Either Text Kernel
- from_char :: Char -> Either Text Atom
- to_char :: Atom -> Char
- end_on_zero :: Cycle -> Cycle
- kernel_to_pattern :: Kernel -> Call.UpDown -> KotekanStyle -> Pasang ScoreT.Instrument -> Cycle
- rotate :: Int -> [a] -> [a]
- rotations :: [a] -> [[a]]
- invert :: Kernel -> Kernel
- find_kernel :: Kernel -> Maybe.Maybe (Kernel, Bool, Int)
- data Repeat
- type Cycle = Realization [[KotekanNote]]
- data Note a = Note {
- note_start :: !ScoreTime
- note_duration :: !ScoreTime
- note_flags :: !Flags.Flags
- note_data :: !a
- add_flag :: Flags.Flags -> Note a -> Note a
- data KotekanNote = KotekanNote {}
- kotekan_note :: Maybe.Maybe ScoreT.Instrument -> Pitch.Step -> KotekanNote
- muted_note :: KotekanNote -> KotekanNote
- under_threshold_function :: (RealTime.RealTime -> RealTime.RealTime) -> ScoreTime -> Deriver (ScoreTime -> Bool)
- realize_pattern :: Repeat -> Types.Orientation -> (Bool, Bool) -> ScoreTime -> ScoreTime -> ScoreTime -> (ScoreTime -> [[a]]) -> [Note a]
- cycles :: (t -> [a]) -> [t] -> [(t, a)]
- cycles_end :: (t -> [a]) -> [t] -> [(t, a)]
- zip_end :: [a] -> [b] -> [(a, b)]
- realize_notes :: (a -> NoteDeriver) -> [Note a] -> NoteDeriver
- data NorotStyle
- data KotekanStyle
- c_unison :: Transformer Note
- c_kempyung :: Library.Calls Note
- c_nyogcag :: Library.Calls Note
- nyogcag :: ScoreT.Instrument -> Pasang (ScoreT.Instrument, Instrument) -> Bool -> Score.Event -> (Bool, [Score.Event])
- c_realize_gangsa :: Transformer Note
- type NoltolArg = (RealTime.RealTime, RealTime.RealTime, Signal.Y)
- noltol_arg :: Text
- c_noltol :: Transformer Note
- c_realize_noltol :: Transformer Score.Event
- realize_noltol_call :: Stream.Stream Score.Event -> NoteDeriver
- realize_noltol :: NoltolArg -> Score.Event -> Maybe.Maybe Score.Event -> NoteDeriver
- c_cancel_pasang :: Transformer Note
- cancel_strong_final :: [Score.Event] -> Either Text [Score.Event]
- pasang_key :: Postproc.Key (Either ScoreT.Instrument (ScoreT.Instrument, ScoreT.Instrument), Maybe.Maybe Text)
- get_pitch :: PassedArgs a -> Deriver DeriveT.Pitch
- style_arg :: KotekanStyle -> Sig.Parser KotekanStyle
- dur_env :: Sig.Parser ScoreTime
- kotekan_env :: Sig.Parser (RealTime.RealTime -> RealTime.RealTime)
- infer_initial_final_env :: Sig.Parser (Maybe.Maybe Bool, Bool)
- infer_initial :: PassedArgs a -> (Maybe.Maybe Bool, Bool) -> (Bool, Bool)
- initial_final_env :: Sig.Parser (Bool, Bool)
- instrument_top_env :: Sig.Parser (Maybe.Maybe Pitch.Pitch)
- note_too_high :: Scale -> Maybe.Maybe Pitch.Pitch -> DeriveT.Transposed -> Bool
- pitch_too_high :: Scale -> Maybe.Maybe Pitch.Pitch -> Score.Event -> Bool
- pasang_env :: Sig.Parser (Pasang ScoreT.Instrument)
- inst_polos :: EnvKey.Key
- inst_sangsih :: EnvKey.Key
- final_flag :: Flags.Flags
Documentation
c_derive_with :: CallName -> Bool -> Bool -> Library.Calls Note Source #
instrument postproc
mute_postproc :: Attrs.Attributes -> Score.Event -> (Score.Event, [Log.Msg]) Source #
Variable mute for gangsa. Intended for the inst_postproc
field.
This interprets Controls.mute
and turns it into either a %mod
control or
mute_attr
.
ngoret
patterns
data KotekanPattern Source #
There are 4 ways to realize a kotekan:
- Undivided. Since it's undivided it could be unison or kempyung.
- Slow but divided. Play all the notes, but sangsih and polos are kempyung on the outer notes. 3, 4. Ngotek, in telu and pat versions.
Instances
Show KotekanPattern Source # | |
Defined in Derive.C.Bali.Gangsa showsPrec :: Int -> KotekanPattern -> ShowS # show :: KotekanPattern -> String # showList :: [KotekanPattern] -> ShowS # | |
Eq KotekanPattern Source # | |
Defined in Derive.C.Bali.Gangsa (==) :: KotekanPattern -> KotekanPattern -> Bool # (/=) :: KotekanPattern -> KotekanPattern -> Bool # | |
Pretty.Pretty KotekanPattern Source # | |
Defined in Derive.C.Bali.Gangsa pretty :: KotekanPattern -> Text Source # format :: KotekanPattern -> Doc Source # formatList :: [KotekanPattern] -> Doc Source # |
data Realization a Source #
Realization | |
|
Instances
Show a => Show (Realization a) Source # | |
Defined in Derive.C.Bali.Gangsa showsPrec :: Int -> Realization a -> ShowS # show :: Realization a -> String # showList :: [Realization a] -> ShowS # | |
Eq a => Eq (Realization a) Source # | |
Defined in Derive.C.Bali.Gangsa (==) :: Realization a -> Realization a -> Bool # (/=) :: Realization a -> Realization a -> Bool # | |
Pretty.Pretty a => Pretty.Pretty (Realization a) Source # | |
Defined in Derive.C.Bali.Gangsa pretty :: Realization a -> Text Source # format :: Realization a -> Doc Source # formatList :: [Realization a] -> Doc Source # |
data IrregularPattern Source #
IrregularPattern | |
|
Instances
Show IrregularPattern Source # | |
Defined in Derive.C.Bali.Gangsa showsPrec :: Int -> IrregularPattern -> ShowS # show :: IrregularPattern -> String # showList :: [IrregularPattern] -> ShowS # |
parse_pattern :: CallStack.Stack => Pitch.Step -> [Char] -> [Maybe.Maybe Pitch.Step] Source #
kotekan_pattern :: KotekanPattern -> KotekanStyle -> Pasang ScoreT.Instrument -> Cycle Source #
pattern_steps :: KotekanStyle -> Pasang ScoreT.Instrument -> KotekanPattern -> Realization [[(Maybe.Maybe ScoreT.Instrument, Pitch.Step)]] Source #
norot
c_norot :: Bool -> Maybe.Maybe Bool -> Generator Note Source #
Initially I implemented this as a postproc, but it now seems to me that it would be more convenient as a generator. In any case, as a postproc it gets really complicated.
norot :: Bool -> (DeriveT.Transposed -> Cycle) -> (DeriveT.Transposed -> Cycle) -> (ScoreTime -> Bool) -> Maybe.Maybe DeriveT.Pitch -> Maybe.Maybe DeriveT.Pitch -> ScoreTime -> (Bool, Bool) -> (ScoreTime, ScoreTime) -> NoteDeriver Source #
realize_norot :: (ScoreTime -> Bool) -> ScoreTime -> ScoreTime -> ScoreTime -> (Maybe.Maybe PitchedCycle, Maybe.Maybe PitchedCycle, Maybe.Maybe PitchedCycle) -> [[Note NoteDeriver]] Source #
Realize the output of norot_sequence
.
norot_sequence :: Bool -> (DeriveT.Transposed -> Cycle) -> (DeriveT.Transposed -> Cycle) -> Maybe.Maybe DeriveT.Pitch -> Maybe.Maybe DeriveT.Pitch -> RealTime.RealTime -> Deriver (Maybe.Maybe PitchedCycle, Maybe.Maybe PitchedCycle, Maybe.Maybe PitchedCycle) Source #
Figure out the appropriate cycles for each norot phase. There are 3 phases: an optional preparation for the current pitch, a variable length sustain, and an optional preparation for the next pitch.
prepare_sustain :: Bool -> ScoreTime -> (Maybe.Maybe Bool, Bool) -> Types.Orientation -> (ScoreTime, ScoreTime) -> (Maybe.Maybe ((Bool, Bool), (ScoreTime, ScoreTime)), Maybe.Maybe ((Bool, Bool), (ScoreTime, ScoreTime))) Source #
Figure out parameters for the sustain and prepare phases. Why is this SO COMPLICATED.
TODO this is still used by Reyong. If I can simplify reyong norot too then I can get rid of it.
:: PassedArgs a | |
-> Maybe.Maybe Bool | True to prepare, False to not, Nothing to prepare if this note touches the next one. |
-> Deriver (Maybe.Maybe DeriveT.Pitch) |
gangsa_norot :: NorotStyle -> Pasang ScoreT.Instrument -> Pasang (Pitch.Step, Pitch.Step) -> Cycle Source #
gangsa_norot_prepare :: NorotStyle -> Pasang ScoreT.Instrument -> Pasang (Pitch.Step, Pitch.Step) -> Cycle Source #
:: Scale | |
-> Maybe.Maybe Pitch.Pitch | |
-> NorotStyle | |
-> DeriveT.Transposed | this is to figure out if the sangsih part will be in range |
-> Pasang (Pitch.Step, Pitch.Step) |
kotekan
regular
c_kotekan_regular :: Bool -> Maybe.Maybe Text -> KotekanStyle -> Generator Note Source #
For regular kotekan, the sangsih can be automatically derived from the polos.
realize_explicit :: (ScoreTime, ScoreTime) -> ScoreTime -> DeriveT.Pitch -> [Maybe.Maybe Pitch.Step] -> ScoreT.Instrument -> NoteDeriver Source #
kernel_doc :: Doc.Doc Source #
realize_kernel :: Call.UpDown -> KotekanStyle -> Pasang ScoreT.Instrument -> Kernel -> Cycle Source #
implementation
realize_kotekan_pattern_args :: PassedArgs a -> (Maybe.Maybe Bool, Bool) -> ScoreTime -> DeriveT.Pitch -> (ScoreTime -> Bool) -> Repeat -> Cycle -> NoteDeriver Source #
realize_kotekan_pattern Source #
:: (Bool, Bool) | include (initial, final) |
-> (ScoreTime, ScoreTime) | |
-> Types.Orientation | |
-> ScoreTime | |
-> DeriveT.Pitch | |
-> (ScoreTime -> Bool) | |
-> Repeat | |
-> Cycle | |
-> NoteDeriver |
Take a Cycle, which is an abstract description of a pattern via
KotekanNote
s, to real notes in a NoteDeriver.
end_on_zero :: Cycle -> Cycle Source #
Make both parts end on zero by subtracting the pitch of the final non-interlocking note.
kernel_to_pattern :: Kernel -> Call.UpDown -> KotekanStyle -> Pasang ScoreT.Instrument -> Cycle Source #
all kernels
find_kernel :: Kernel -> Maybe.Maybe (Kernel, Bool, Int) Source #
Find a kernel as a rotation or inversion of one of the standard ones.
implementation
type Cycle = Realization [[KotekanNote]] Source #
(interlocking pattern, non-interlocking pattern)
Each list represents coincident notes. [] is a rest.
Note | |
|
data KotekanNote Source #
High level description of a note. This goes into Note before it becomes a Derive.NoteDeriver.
KotekanNote | |
|
Instances
Show KotekanNote Source # | |
Defined in Derive.C.Bali.Gangsa showsPrec :: Int -> KotekanNote -> ShowS # show :: KotekanNote -> String # showList :: [KotekanNote] -> ShowS # | |
Pretty.Pretty KotekanNote Source # | |
Defined in Derive.C.Bali.Gangsa pretty :: KotekanNote -> Text Source # format :: KotekanNote -> Doc Source # formatList :: [KotekanNote] -> Doc Source # |
muted_note :: KotekanNote -> KotekanNote Source #
under_threshold_function Source #
:: (RealTime.RealTime -> RealTime.RealTime) | |
-> ScoreTime | |
-> Deriver (ScoreTime -> Bool) | say if a note at this time with the given duration would be under the kotekan threshold |
:: Repeat | Once will just call get_cycle at the start time. Repeat will start the cycle at t+1 because t is the initial, so it's the end of the cycle. |
-> Types.Orientation | align to start or end |
-> (Bool, Bool) | |
-> ScoreTime | |
-> ScoreTime | |
-> ScoreTime | |
-> (ScoreTime -> [[a]]) | Get one cycle of notes, starting at the time. |
-> [Note a] |
Repeatedly call a cycle generating function to create notes. The result
will presumably be passed to realize_notes
to convert the notes into
NoteDerivers.
cycles :: (t -> [a]) -> [t] -> [(t, a)] Source #
Pair each t
with an a
, asking the function for more a
s as needed.
cycles_end :: (t -> [a]) -> [t] -> [(t, a)] Source #
This is like cycles
, but the last cycle is aligned to the end of the
t
s, chopping off the front of the cycle if necessary.
zip_end :: [a] -> [b] -> [(a, b)] Source #
Like zip
, but two sequences are aligned at at their ends, instead of
their starts.
realize_notes :: (a -> NoteDeriver) -> [Note a] -> NoteDeriver Source #
Turn Notes into a NoteDeriver.
data NorotStyle Source #
Style for non-interlocking norot. Interlocking norot is always the upper neighbor (or lower on the top key).
Default | Norot is emitted as the current instrument, which should be converted into kempyung or unison by a postproc. |
Diamond | Norot in the diamond pattern, where sangsih goes down. |
Instances
data KotekanStyle Source #
Instances
postproc
c_kempyung :: Library.Calls Note Source #
I could do this in two different ways: Eval normally, then eval with +kempyung, and make instrument note call understand it. Or, postproc, transpose, and check if the nn is above a limit. The first one would let the instrument choose how it wants to interpret +kempyung while letting this call remain generic, but let's face it, it only really means one thing. The second seems a little simpler since it doesn't need a cooperating note call.
So postproc it is.
nyogcag :: ScoreT.Instrument -> Pasang (ScoreT.Instrument, Instrument) -> Bool -> Score.Event -> (Bool, [Score.Event]) Source #
realize calls
type NoltolArg = (RealTime.RealTime, RealTime.RealTime, Signal.Y) Source #
(noltol-time, kotekan-dur, damp-dyn)
noltol_arg :: Text Source #
realize_noltol :: NoltolArg -> Score.Event -> Maybe.Maybe Score.Event -> NoteDeriver Source #
If the next note of the same instrument is below a threshold, the note's off time is replaced with a +mute.
cancel-pasang
cancel_strong_final :: [Score.Event] -> Either Text [Score.Event] Source #
Kotekan ends with a final, which cancels normal, but loses to strong.
This is like Postproc.cancel_strong_weak
, except it adds final_flag
,
so I can have the end of a kotekan override, but still be overidden
with an explicit strong note.
pasang_key :: Postproc.Key (Either ScoreT.Instrument (ScoreT.Instrument, ScoreT.Instrument), Maybe.Maybe Text) Source #
Match any of polos, sangsih, and pasang to each other. Since polos and sangsih together are considered one voice, a sangsih start is note end for a polos note.
implementation
get_pitch :: PassedArgs a -> Deriver DeriveT.Pitch Source #
Get pitch for a kotekan call.
infer_initial :: PassedArgs a -> (Maybe.Maybe Bool, Bool) -> (Bool, Bool) Source #
initial_final_env :: Sig.Parser (Bool, Bool) Source #
note_too_high :: Scale -> Maybe.Maybe Pitch.Pitch -> DeriveT.Transposed -> Bool Source #
pitch_too_high :: Scale -> Maybe.Maybe Pitch.Pitch -> Score.Event -> Bool Source #