hmt-0.15: Haskell Music Theory

Safe HaskellSafe-Inferred
LanguageHaskell98

Music.Theory.Time.Bel1990.R

Contents

Description

Bel(R) is a simplified form of the Bel notation described in:

For patterns without tempo indications, the two notations should give equivalent phase diagrams, for instance (Bel 1990, §11, p.24):

> bel_ascii_pp "ab{ab,cde}cd"

Bel(R): "ab{ab,cde}cd", Dur: 7

a _ b _ a _ _ b _ _ c _ d _
        c _ d _ e _        

and:

> bel_ascii_pp "{a{bc,def},ghijk}"

Bel(R): "{a{bc,def},ghijk}", Dur: 5

a _ _ _ _ _ _ _ _ _ b _ _ _ _ _ _ _ _ _ _ _ _ _ _ c _ _ _ _ _ _ _ _ _ _ _ _ _ _
                    d _ _ _ _ _ _ _ _ _ e _ _ _ _ _ _ _ _ _ f _ _ _ _ _ _ _ _ _
g _ _ _ _ _ _ _ h _ _ _ _ _ _ _ i _ _ _ _ _ _ _ j _ _ _ _ _ _ _ k _ _ _ _ _ _ _

The Bel notation allows n-ary parallel structures, ie. {a_bcd_e,a_f_gh_,ji_a_i_} (Bel 1992, p.29), however Bel(R) allows only binary structures. The parallel interpretation rules are associative:

> bel_ascii_pp "{a_bcd_e,{a_f_gh_,ji_a_i_}}"

Bel(R): "{a_bcd_e,{a_f_gh_,ji_a_i_}}", Dur: 7

a _ b c d _ e
a _ f _ g h _
j i _ a _ i _

Bel(R) does allow unary parallel structures (see Iso), which can be used to isolate tempo changes:

> bel_ascii_pp "ab{*2cd}ef{*2/3gh}ij"

Bel(R): "ab{*2cd}ef{*2/3gh}ij", Dur: 10

a _ b _ c d e _ f _ g _ _ h _ _ i _ j _

Patterns with tempo indications have completely different meanings in Bel and Bel(R), though in both cases parallel nodes delimit the scope of tempo markings.

Bel(R) replaces the /n notation for explicit tempo marks with a *n notation to indicate a tempo multiplier, and a set of bracketing notations to specify interpretation rules for parallel (concurrent) temporal structures.

The tempo indication /1 in the expression ab{/1ab,cde}cd (Bel 1990, p.24) requires that the inner ab have the same tempo as the outer ab, which is implicitly /1. Setting the tempo of one part of a parallel structure requires assigning a tempo to the other part in order that the two parts have equal duration. Here the tempo assigned to cde is /1.5, but since fractional tempi are not allowed the expression is re-written as /2ab{/2ab,/3cde}/2cd.

Importantly the explicit tempo indications make it possible to write syntactically correct expressions in Bel that do not have a coherent interpretation, ie. {/1ab,/1cde}. Determining if a coherent set of tempos can be assigned, and assigning these tempos, is the object of the interpretation system.

In comparison, all syntactically valid Bel(R) strings have an interpretation. The expression {*1ab,*1cde} is trivially equal to {ab,cde}, and tempo marks in parallel parts do not interact:

> bel_ascii_pp "{a*2b,*3c/2d/3e}"

Bel(R): "{a*2b,*3c*1/2d*1/3e}", Dur: 3

a _ _ _ _ _ b _ _
c d _ e _ _ _ _ _

Here a is twice the duration of b, and e is three times the duration of d, which is twice the duration of c (in Bel(R) /n is equivalent to *1/n). The duration of any Bel(R) expression can be calculated directly, given an initial Tempo:

bel_dur 1 (bel_char_parse "a*2b") == 3/2
bel_dur 1 (bel_char_parse "*3c/2d/3e") == 3

Therefore in the composite expression the left part is slowed by a factor of two to align with the right part.

The Bel string ab{/1ab,cde}cd can be re-written in Bel(R) as either ab~{ab,cde}cd or ab(ab,cde)cd. The absolute tempo indication is replaced by notations giving alternate modes of interpretation for the parallel structure.

In the first case the ~ indicates the opposite of the normal rule for parallel nodes. The normal rule is the same as for Bel and is that the duration of the whole is equal to duration of the longer of the two parts. The ~ inverts this so that the whole has the duration of the shorter of the two parts, and the longer part is scaled to have equal duration.

In the second case the parentheses () replacing the braces {} indicates that the duration of the whole is equal to the duration of the left side, and that the right is to be scaled. Similarly, a ~ preceding parentheses indicates the duration of the whole should be the duration of the right side, and the left scaled.

> bel_ascii_pp "ab~{ab,cde}cd"

Bel(R): "ab~{ab,cde}cd", Dur: 6

a _ _ b _ _ a _ _ b _ _ c _ _ d _ _
            c _ d _ e _            

There is one other parallel mode that has no equivalent in Bel notation. It is a mode that does not scale either part, leaving a hole at the end of the shorter part, and is indicated by square brackets:

> bel_ascii_pp "ab[ab,cde]cd"

Bel(R): "ab[ab,cde]cd", Dur: 7

a b a b   c d
    c d e    

The Bel string /2abc/3de (Bel 1992, p.53) can be written as *2abc*1/2*3de, or equivalently as *2abc*3/2de:

> bel_ascii_pp "*2abc*3/2de"

Bel(R): "*2abc*3/2de", Dur: 13/6

a _ _ b _ _ c _ _ d _ e _

It can also be written using the shorthand notation for rest sequences, where an integer n indicates a sequence of n rests, as:

> bel_ascii_pp "(9,abc)(4,de)"

Bel(R): "(---------,abc)(----,de)", Dur: 13

- - - - - - - - - - - - -
a _ _ b _ _ c _ _ d _ e _

In the Bel string {ab{/3abc,de},fghijk} (Bel 1992, p.20) the tempo indication does not change the inter-relation of the parts but rather scales the parallel node altogether, and can be re-written in Bel(R) notation as:

> bel_ascii_pp "{ab*3{abc,de},fghijk}"

Bel(R): "{ab*3{abc,de},fghijk}", Dur: 6

a _ _ _ _ _ b _ _ _ _ _ a _ b _ c _
                        d _ _ e _ _
f _ _ g _ _ h _ _ i _ _ j _ _ k _ _

Curiously the following example (Bel 1990, p. 24) does not correspond to the phase diagram given:

> bel_ascii_pp "{i{ab,cde},jk}"

Bel(R): "{i{ab,cde},jk}", Dur: 4

i _ a _ _ b _ _
    c _ d _ e _
j _ _ _ k _ _ _

The paper assigns tempi of /6 to both i and ab, which in Bel(R) could be written:

> bel_ascii_pp "{i~{ab,cde},jk}"

Bel(R): "{i~{ab,cde},jk}", Dur: 3

i _ _ _ _ _ a _ _ _ _ _ b _ _ _ _ _
            c _ _ _ d _ _ _ e _ _ _
j _ _ _ _ _ _ _ _ k _ _ _ _ _ _ _ _

Synopsis

Bel

data Par_Mode Source

Types of Par nodes.

Instances

par_mode_brackets :: Par_Mode -> (String, String) Source

The different Par modes are indicated by bracket types.

type Tempo = Rational Source

Tempo is rational. The duration of a Term is the reciprocal of the Tempo that is in place at the Term.

data Term a Source

Terms are the leaf nodes of the temporal structure.

Constructors

Value a 
Rest 
Continue 

Instances

Eq a => Eq (Term a) 
Show a => Show (Term a) 

data Bel a Source

Recursive temporal structure.

Constructors

Node (Term a)

Leaf node

Iso (Bel a)

Isolate

Seq (Bel a) (Bel a)

Sequence

Par Par_Mode (Bel a) (Bel a)

Parallel

Mul Tempo

Tempo multiplier

Instances

Eq a => Eq (Bel a) 
Show a => Show (Bel a) 

bel_pp :: (a -> String) -> Bel a -> String Source

Pretty printer for Bel, given pretty printer for the term type.

par_analyse :: Tempo -> Par_Mode -> Bel a -> Bel a -> (Rational, Rational, Rational) Source

Analyse a Par node giving (duration,LHS-tempo-*,RHS-tempo-*).

par_analyse 1 Par_Left (nseq "cd") (nseq "efg") == (2,1,3/2)
par_analyse 1 Par_Right (nseq "cd") (nseq "efg") == (3,2/3,1)
par_analyse 1 Par_Min (nseq "cd") (nseq "efg") == (2,1,3/2)
par_analyse 1 Par_Max (nseq "cd") (nseq "efg") == (3,2/3,1)
par_analyse 1 Par_None (nseq "cd") (nseq "efg") == (3,1,1)

par_dur :: Tempo -> Par_Mode -> Bel a -> Bel a -> Rational Source

Duration element of par_analyse.

bel_tdur :: Tempo -> Bel a -> (Tempo, Rational) Source

Calculate final tempo and duration of Bel.

Linearisation

type Time = Rational Source

Time point.

type Voice = [Char] Source

Voices are named as a sequence of left and right directions within nested Par structures.

type L_St = (Time, Tempo, Voice) Source

Linear state. Time is the start time of the term, Tempo is the active tempo & therefore the reciprocal of the duration, Voice is the part label.

type L_Term a = (L_St, Term a) Source

Linear term.

lterm_time :: L_Term a -> Time Source

Start time of L_Term.

lterm_duration :: L_Term a -> Time Source

Duration of L_Term (reciprocal of tempo).

lterm_end_time :: L_Term a -> Time Source

End time of L_Term.

type L_Bel a = [L_Term a] Source

Linear form of Bel, an ascending sequence of L_Term.

bel_linearise :: L_St -> Bel a -> (L_Bel a, L_St) Source

Linearise Bel given initial L_St, ascending by construction.

lbel_merge :: L_Bel a -> L_Bel a -> L_Bel a Source

Merge two ascending L_Bel.

lbel_tempi :: L_Bel a -> [Tempo] Source

Set of unique Tempo at L_Bel.

lbel_tempo_mul :: Rational -> L_Bel a -> L_Bel a Source

Multiply Tempo by n, and divide Time by n.

lbel_normalise :: L_Bel a -> L_Bel a Source

After normalisation all start times and durations are integral.

voice_normalise :: Voice -> Voice Source

All leftmost voices are re-written to the last non-left turning point.

map voice_normalise ["","l","ll","lll"] == replicate 4 ""
voice_normalise "lllrlrl" == "rlrl"

lbel_voices :: L_Bel a -> [Voice] Source

Unique Voices at L_Bel.

lbel_duration :: L_Bel a -> Time Source

The duration of L_Bel.

lbel_lookup :: (Time, Voice) -> L_Bel a -> Maybe (L_Term a) Source

Locate an L_Term that is active at the indicated Time and in the indicated Voice.

lbel_grid :: L_Bel a -> [[Maybe (Term a)]] Source

Calculate grid (phase diagram) for L_Bel.

bel_ascii :: Bool -> Bel Char -> String Source

Bel type phase diagram for Bel of Char. Optionally print whitespace between columns.

Combinators

(~>) :: Bel a -> Bel a -> Bel a Source

Infix form for Seq.

lseq :: [Bel a] -> Bel a Source

foldl1 of Seq.

lseq [Node Rest] == Node Rest
lseq [Node Rest,Node Continue] == Seq (Node Rest) (Node Continue)

node :: a -> Bel a Source

nseq :: [a] -> Bel a Source

cseq :: String -> Bel Char Source

Variant of nseq where _ is read as Continue and - as Rest.

par :: Bel a -> Bel a -> Bel a Source

Par of Par_Max, this is the default Par_Mode.

nrests :: Integral n => n -> Bel a Source

bel_ascii_pp :: String -> IO () Source

Run bel_char_parse, and print both bel_char_pp and bel_ascii.

bel_ascii_pp "{i{ab,{c[d,oh]e,sr{p,qr}}},{jk,ghjkj}}"

Parsing

type P a = GenParser Char () a Source

A Char parser.

p_rest :: P (Term a) Source

Parse Rest Term.

P.parse p_rest "" "-"

p_nrests :: P (Bel a) Source

Parse Rest Term.

P.parse p_nrests "" "3"

p_continue :: P (Term a) Source

Parse Continue Term.

P.parse p_continue "" "_"

p_char_value :: P (Term Char) Source

Parse Char Value Term.

P.parse p_char_value "" "a"

p_char_term :: P (Term Char) Source

Parse Char Term.

P.parse (P.many1 p_char_term) "" "-_a"

p_char_node :: P (Bel Char) Source

Parse Char Node.

P.parse (P.many1 p_char_node) "" "-_a"

p_integer :: P Integer Source

Parse positive Integer.

P.parse p_integer "" "3"

p_rational :: P Rational Source

Parse positive Rational.

P.parse (p_rational `P.sepBy` (P.char ',')) "" "3%5,2/3"

p_double :: P Double Source

Parse positive Double.

P.parse p_double "" "3.5"
P.parse (p_double `P.sepBy` (P.char ',')) "" "3.5,7.2,1.0"

p_number :: P Rational Source

Parse positive number as Rational.

P.parse (p_number `P.sepBy` (P.char ',')) "" "7%2,3.5,3"

p_mul :: P (Bel a) Source

Parse Mul.

P.parse (P.many1 p_mul) "" "/3*3/2"

p_iso :: P (Bel a) -> P (Bel a) Source

Given parser for Bel a, generate Iso parser.

p_char_iso :: P (Bel Char) Source

p_iso of p_char_bel.

P.parse p_char_iso "" "{abcde}"

p_par :: P (Bel a) -> P (Bel a) Source

Given parser for Bel a, generate Par parser.

p_char_par :: P (Bel Char) Source

p_par of p_char_bel.

P.parse p_char_par "" "{ab,{c,de}}"
P.parse p_char_par "" "{ab,~(c,de)}"

p_char_bel :: P (Bel Char) Source

Parse Bel Char.

P.parse (P.many1 p_char_bel) "" "-_a*3"

bel_char_parse :: String -> Bel Char Source

Run parser for Bel of Char.