Safe Haskell | Safe-Inferred |
---|---|
Language | Haskell2010 |
Gamelan instruments and pitch structures.
Synopsis
- fromJust_err :: String -> Maybe a -> a
- near_rat :: Double -> Rational
- data Instrument_Family
- instrument_family_set :: [Instrument_Family]
- data Instrument_Name
- instrument_family :: Instrument_Name -> Instrument_Family
- instrument_name_pp :: Instrument_Name -> String
- instrument_name_clef :: Integral i => Instrument_Name -> Clef i
- instrument_name_clef_plain :: Integral i => Instrument_Name -> Clef i
- data Scale
- type Octave = Integer
- type Degree = Integer
- type Frequency = Double
- type Annotation = String
- data Pitch = Pitch {}
- pitch_pp_ascii :: Pitch -> String
- pitch_pp_duple :: Pitch -> String
- data Note = Note {
- note_scale :: Scale
- note_pitch :: Pitch
- note_degree :: Note -> Degree
- note_compare :: Note -> Note -> Ordering
- note_range_elem :: Scale -> Pitch -> Pitch -> [Note]
- note_gamut_elem :: Note -> Note -> [Note]
- data Tone t = Tone {}
- tone_frequency_err :: Tone t -> Frequency
- plain_tone :: Instrument_Name -> Scale -> Octave -> Degree -> Tone t
- tone_equivalent :: Tone t -> Tone t -> Bool
- tone_24et_pitch :: Tone t -> Maybe Pitch
- tone_24et_pitch' :: Tone t -> Pitch
- tone_24et_pitch_detune :: Tone t -> Maybe Pitch_Detune
- tone_24et_pitch_detune' :: Tone t -> Pitch_Detune
- tone_fmidi :: Tone t -> Double
- tone_24et_fmidi :: Tone t -> Rational
- tone_12et_pitch :: Tone t -> Maybe Pitch
- tone_12et_pitch' :: Tone t -> Pitch
- tone_12et_pitch_detune :: Tone t -> Maybe Pitch_Detune
- tone_12et_pitch_detune' :: Tone t -> Pitch_Detune
- tone_12et_fmidi :: Tone t -> Rational
- tone_family :: Tone t -> Instrument_Family
- tone_in_family :: Instrument_Family -> Tone t -> Bool
- select_tones :: Instrument_Family -> [Tone t] -> [Maybe (Tone t)]
- type Tone_Subset = ([Instrument_Family], [Scale])
- tone_subset :: Tone_Subset -> Tone_Set t -> Tone_Set t
- data Instrument = Instrument {}
- type Tone_Set t = [Tone t]
- type Tone_Group t = [Tone_Set t]
- type Gamelan = [Instrument]
- tone_scale :: Tone t -> Maybe Scale
- tone_pitch :: Tone t -> Maybe Pitch
- tone_degree :: Tone t -> Maybe Degree
- tone_degree' :: Tone t -> Degree
- tone_octave :: Tone t -> Maybe Octave
- tone_class :: Tone t -> (Instrument_Name, Maybe Scale)
- instrument_class :: Instrument -> (Instrument_Name, Maybe Scale)
- tone_class_p :: (Instrument_Name, Scale) -> Tone t -> Bool
- tone_family_class_p :: (Instrument_Family, Scale) -> Tone t -> Bool
- tone_set_near_frequency :: Tone_Set t -> Cents -> Frequency -> Tone_Set t
- tone_compare_frequency :: Tone t -> Tone t -> Ordering
- map_maybe_uniform :: (a -> Maybe b) -> [a] -> Maybe [b]
- instrument :: Tone_Set t -> Instrument
- instruments :: Tone_Set t -> [Instrument]
- instrument_gamut :: Instrument -> Maybe (Pitch, Pitch)
- scale_degrees :: Scale -> [Degree]
- degree_index :: Scale -> Degree -> Maybe Int
- tone_set_gamut :: Tone_Set t -> Maybe (Pitch, Pitch)
- tone_set_instrument :: Tone_Set t -> (Instrument_Name, Maybe Scale) -> Tone_Set t
Documentation
Gamelan
data Instrument_Family Source #
Enumeration of gamelan instrument families.
Instances
instrument_family_set :: [Instrument_Family] Source #
Universe
data Instrument_Name Source #
Enumeration of Gamelan instruments.
Bonang_Barung | Bonang Barung (horizontal gong, middle) |
Bonang_Panerus | Bonang Panerus (horizontal gong, high) |
Gambang_Kayu | Gambang Kayu (wooden key&resonator) |
Gender_Barung | Gender Barung (key&resonator, middle) |
Gender_Panerus | Gender Panembung (key&resonator, high) |
Gender_Panembung | Gender Panembung, Slenthem (key&resonator, low) |
Gong_Ageng | Gong Ageng (hanging gong, low) |
Gong_Suwukan | Gong Suwukan (hanging gong, middle) |
Kempul | Kempul (hanging gong, middle) |
Kempyang | Kempyang (horizontal gong, high) |
Kenong | Kenong (horizontal gong, low) |
Ketuk | Ketuk, Kethuk (horizontal gong, middle) |
Saron_Barung | Saron Barung, Saron (key, middle) |
Saron_Demung | Saron Demung, Demung (key, low) |
Saron_Panerus | Saron Panerus, Peking (key, high) |
Instances
instrument_name_clef :: Integral i => Instrument_Name -> Clef i Source #
Clef
appropriate for Instrument_Name
.
instrument_name_clef_plain :: Integral i => Instrument_Name -> Clef i Source #
Enumeration of Gamelan scales.
type Annotation = String Source #
A text annotation.
pitch_pp_ascii :: Pitch -> String Source #
Octaves are written as repeated -
or +
, degrees are printed ordinarily.
map pitch_pp_ascii (zipWith Pitch [-2 .. 2] [1 .. 5]) == ["--1","-2","3","+4","++5"]
pitch_pp_duple :: Pitch -> String Source #
Note | |
|
note_degree :: Note -> Degree Source #
note_compare :: Note -> Note -> Ordering Source #
It is an error to compare notes from different scales.
note_gamut_elem :: Note -> Note -> [Note] Source #
Ascending sequence of Note
from n1 to n2 inclusive.
note_gamut_elem (Note Slendro (Pitch 0 5)) (Note Slendro (Pitch 1 2))
tone_frequency_err :: Tone t -> Frequency Source #
plain_tone :: Instrument_Name -> Scale -> Octave -> Degree -> Tone t Source #
Constructor for Tone
without frequency or annotation.
tone_equivalent :: Tone t -> Tone t -> Bool Source #
Tones are considered equivalent if they have the same
Instrument_Name
and Note
.
tone_24et_pitch' :: Tone t -> Pitch Source #
tone_24et_pitch_detune :: Tone t -> Maybe Pitch_Detune Source #
tone_24et_pitch_detune' :: Tone t -> Pitch_Detune Source #
tone_fmidi :: Tone t -> Double Source #
tone_12et_pitch' :: Tone t -> Pitch Source #
tone_12et_pitch_detune :: Tone t -> Maybe Pitch_Detune Source #
tone_12et_pitch_detune' :: Tone t -> Pitch_Detune Source #
tone_family :: Tone t -> Instrument_Family Source #
tone_in_family :: Instrument_Family -> Tone t -> Bool Source #
select_tones :: Instrument_Family -> [Tone t] -> [Maybe (Tone t)] Source #
type Tone_Subset = ([Instrument_Family], [Scale]) Source #
Specify subset as list of families and scales.
tone_subset :: Tone_Subset -> Tone_Set t -> Tone_Set t Source #
Extract subset of Tone_Set
.
data Instrument Source #
Instances
Show Instrument Source # | |
Defined in Music.Theory.Gamelan showsPrec :: Int -> Instrument -> ShowS # show :: Instrument -> String # showList :: [Instrument] -> ShowS # | |
Eq Instrument Source # | |
Defined in Music.Theory.Gamelan (==) :: Instrument -> Instrument -> Bool # (/=) :: Instrument -> Instrument -> Bool # |
type Tone_Group t = [Tone_Set t] Source #
type Gamelan = [Instrument] Source #
tone_degree' :: Tone t -> Degree Source #
tone_class :: Tone t -> (Instrument_Name, Maybe Scale) Source #
instrument_class :: Instrument -> (Instrument_Name, Maybe Scale) Source #
tone_class_p :: (Instrument_Name, Scale) -> Tone t -> Bool Source #
tone_family_class_p :: (Instrument_Family, Scale) -> Tone t -> Bool Source #
map_maybe_uniform :: (a -> Maybe b) -> [a] -> Maybe [b] Source #
instrument :: Tone_Set t -> Instrument Source #
instruments :: Tone_Set t -> [Instrument] Source #
instrument_gamut :: Instrument -> Maybe (Pitch, Pitch) Source #
scale_degrees :: Scale -> [Degree] Source #
Pelog has seven degrees, numbered one to seven. Slendro has five degrees, numbered one to six excluding four.
map scale_degrees [Pelog,Slendro] == [[1,2,3,4,5,6,7],[1,2,3,5,6]]
degree_index :: Scale -> Degree -> Maybe Int Source #
Zero based index of scale degree, or Nothing.
degree_index Slendro 4 == Nothing degree_index Pelog 4 == Just 3
Tone set
tone_set_instrument :: Tone_Set t -> (Instrument_Name, Maybe Scale) -> Tone_Set t Source #