--------------------- rootPos = proc(b: note) returns(chord) % EFFECT: return tenorAltoSwap = proc(c: chord) % MODIFIES: c % EFFECT: change c so that the tenor and alto exchange their roles in % the chord. For example <1,3,5,8> becomes <1,5,10,15>. % In detail, if c had value , it's value becomes % , where t' = t + k*7, where k>=1 is the minimum % number such that t' > a and where s' = s + m*7, where m>=0 % is the minimum number such that s' > t'. tenorSopranoSwap = proc(c: chord) % MODIFIES: c % EFFECT: change c so that the tenor and soprano exchange their roles in % the chord. For example <1,3,5,8> becomes <1,8,12,17>. altoSopranoSwap = proc(c: chord) % MODIFIES: c % EFFECT: change c so that the alto and soprano exchange their roles in % the chord. For example <1,3,5,8> becomes <1,5,10,15>. sopranoUp = proc(c:chord) % MODIFIES: c % EFFECT: if the value of c is , then change c so its value is % . % For example <1,3,5,8> becomes <1,3,5,15>. altoUp = proc(c:chord) % MODIFIES: c % EFFECT: if the value of c is , then change c so its value is % , where s' = s+m*7 % and m is the minimal m>=0 such that s' > a+7. % For example <1,3,5,8> becomes <1,3,12,15>. tenorUp = proc(c:chord) % MODIFIES: c % EFFECT: if the value of c is , then change c so its value is % , where a' = a+k*7 and s' = s+m*7 % and the k and m are minimal natural numbers as in altoUp. % For example <1,3,5,8> becomes <1,10,12,15>. soprano = proc(c: chord) returns(note) % EFFECT: return the soprano note of c alto = proc(c: chord) returns(note) % EFFECT: return the alto note of c tenor = proc(c: chord) returns(note) % EFFECT: return the tenor note of c bass = proc(c: chord) returns(note) % EFFECT: return the bass note of c equal = proc(c1, c2: cvt) returns(bool) % EFFECT: return true if c1 has the same notes as c2 ------------- ------------- (cluster Chord ; Export: rootPos, tenorAltoSwap, tenorSopranoSwap, altoSopranoSwap, ; sopranoUp, altoUp, tenorUp, soprano, alto, tenor, bass, equal (rep b t a s) (define rootPos (b) (Chord b (Note$thirdAbove b) (Note$fifthAbove b) (Note$octaveAbove b))) (define tenorAltoSwap (c) (begin (set temp (t c)) (set-t c (a c)) (set-a c temp) (establishInvariant c))) (define tenorSopranoSwap (c) (begin (set temp (t c)) (set-t c (s c)) (set-s c temp) (establishInvariant c))) (define altoSoprano (c) (begin (set temp (a c)) (set-a c (s c)) (set-s c temp) (establishInvariant c))) (define sopranoUp (c) (begin (set-s c (Note$octaveAbove (s c))))) (define altoUp (c) (begin (set-a c (Note$octaveAbove (a c))) (establishInvariant c))) (define tenorUp (c) (begin (set-t c (Note$octaveAbove (t c))) (establishInvariant c))) (define soprano (c) (s c)) (define alto (c) (a c)) (define tenor (c) (t c)) (define bass (c) (b c)) (define equal (c1 c2) (and (= (soprano c1) (soprano c2)) (= (alto c1) (alto c2)) (= (tenor c1) (tenor c2)) (= (tenor c1) (tenor c2)))) ; internal operations (define makeHigher (x y) ; EFFECT: return smallest note y' such that y' is 0 or more octaves ; above y and such that y' > x (if (< x y) y (makeGreater x (Note$octaveAbove y)))) (define establishInvariant (c) ; MODIFIES: c ; EFFECT: change the state of c from where it may not be ; true that t < a < s to so that t',a',s' are ; moved by the smallest number of octaves up. (begin (set-a (makeHigher (t c) (a c))) (set-s (makeHigher (a c) (t c))))) ) ------------