Tertio Idus Apriles MMXVIII scripsit Jérôme Plût : > So before I waste too much time on this: given the number of geniuses > on this mailing-list, certainly one of you already did write the > relevant Scheme code, am I right?
Given the lack of answer, I did write some Scheme code, which you will find attached. This defines a function \transposeFigures, used in the following way: #(load "transpose-figures.scm") oldfigures = \figures { ... } % put something in here oldbass = \relative { ... } % here too \new FiguredBass { \transposeFigures c d \oldfigures \oldbass } -- Jérôme
(define (moment-max a b) (if (ly:moment<? a b) b a)) (define (duration-rat d) (ly:moment-main (ly:duration-length d))) ; raw-notes;{{{ ; returns a pair (list of all music events) . (end position) ; where each (music event) is a list of (time, pitch, duration) (define (raw-notes music) (car (raw-note-rec music (ly:make-moment 0 1 0 0)))) (define (raw-note-rec music start) (let* ( (name (ly:music-property music 'name)) (proc (primitive-eval (assoc-ref raw-note-proc name))) ) (if proc (proc music start) (cons '() start)) )) (define raw-note-proc '( (RelativeOctaveMusic . raw-note-descend-element) (SequentialMusic . raw-note-sequential) (EventChord . raw-note-simultaneous) (SimultaneousMusic . raw-note-simultaneous) (NoteEvent . raw-note-duration) (RestEvent . raw-note-duration) (SkipEvent . raw-note-duration) )) (define (raw-note-descend-element music start) (raw-note-rec (ly:music-property music 'element) start)) ; (define (raw-note-ignore music start) (cons '() start)) (define (raw-note-sequential music start) (let* ( (F (lambda (m ret) (let ( (R (raw-note-rec m (cdr ret)))) (cons (append (car R) (car ret)) (cdr R))))) ) (fold F (cons '() start) (ly:music-property music 'elements)) )) (define (raw-note-simultaneous music start) (let* ( (F (lambda (ret m) (let R (raw-note-rec m start) (cons (append (car R) (car ret)) (moment-max (cdr R) (cdr ret)))))) ) (fold F (cons '() start) (ly:music-property music 'elements)) )) (define (raw-note-duration music start) (let* ( (prop (lambda (x) (ly:music-property music x))) (duration (prop 'duration)) ) (cons (list (list start (prop 'pitch) duration)) (ly:moment-add start (ly:duration-length duration))) )) ;}}} ; bass-line;{{{ ; 0. get raw notes (cf. supra) ; 1. sort them by (increasing time position, increasing pitch, ; decreasing duration) ; 1.5 initialize B = '() ; 2. for each note X in this list: ; if (null? B) ; or (X starts after the end of (car B)) ; or (X is lower in pitch than (car B)) ; then B ← X::B ; 3. return (reverse B) ; ; then we modify step 3 by computing the duration of each note as the ; difference between its position and the next one ; (this allows rests in the bass to be interpreted as a prolongation ; of the previous note) (define (bass-line music) (car (fold (lambda (x r) (cons (cons (list (list-ref x 0) (list-ref x 1) (- (cdr r) (list-ref x 0))) (car r)) (list-ref x 0))) (cons '() 10000) (fold bass-line-rec '() (sort (raw-notes music) (lambda (x y) (or (ly:moment<? (list-ref x 0) (list-ref y 0)) (ly:pitch<? (list-ref x 1) (list-ref y 1)) (ly:duration<? (list-ref y 2) (list-ref x 2))))))))) ; (define (bass-note-end x) (ly:moment-add (list-ref x 0) (list-ref x 2))) (define (bass-line-rec x b) (let* ( (m (ly:moment-main (list-ref x 0))) (p (list-ref x 1)) (d (duration-rat (list-ref x 2))) ; (_ (print "m p d = " m " " p " " d ", " b)) ) (if (null? b) (list (list m p d)) (if (or (>= m (+ (list-ref (car b) 0) (list-ref (car b) 2))) (ly:pitch<? p (list-ref (car b) 1)) ) (cons (list m p d) b) b)) )) ;}}} ; transpose-figures-event;{{{ ; transposes a single BassFigureEvent object. ; figure (as a BassFigureEvent) ; delta (as a Pitch) ; bass (as a Pitch) (define (transpose-figures-event delta figure bass) (let* ( (prop (lambda (x) (ly:music-property figure x))) (f1 (prop 'figure)) (f (if (null? f1) 3 f1)) ; 3 is the default (unnamed) interval (p (ly:make-pitch 0 (+ (ly:pitch-notename bass) f -1))) (q (ly:pitch-transpose p delta)) (l1 (list 'duration (prop 'duration))) (l (if (null? f1) l1 (append l1 (list 'figure f)))) ; (_ (print "f1 = " f1 ", f = " f ", q = " q "l = " l)) (a (prop 'alteration)) ) ; (print "a:" (rational? a) a (if (rational? a) (+ a (ly:pitch-alteration q)) a)) (if (not (null? a)) (set! l (cons 'alteration (cons (if (rational? a) (+ a (ly:pitch-alteration q)) a) l)))) ; (print "now l = " l) (apply make-music (cons 'BassFigureEvent l)) )) ;}}} ; transpose-figures-chord;{{{ (define (transpose-figures-chord delta chord bass) (if (and (not (null? bass)) (equal? (ly:music-property chord 'name) 'EventChord)) (make-music 'EventChord 'elements (map (lambda (e) (transpose-figures-event delta e bass)) (ly:music-property chord 'elements))) chord)) ; delta: pitch of transposition ; figures: list of BassFigureEvent ; bass: list of bass notes (as produced by bass-line) ; current: current bass note ; ttl: (rational) duration remaining on current bass note (define (chord-duration chord) (if (equal? (ly:music-property chord 'name) 'EventChord) (fold max 0 (map (lambda(x) (duration-rat (ly:music-property x 'duration))) (ly:music-property chord 'elements))) 0)) (define (transpose-figures-rec delta figures bass current ttl) ; (print "#figures = " (length figures)) ; (print "figures0 = ") (display-scheme-music (list-ref figures 0)) (print "--") (if (null? figures) '() (if (<= ttl 0) (transpose-figures-rec delta figures (cdr bass) (list-ref (car bass) 1) (+ ttl (list-ref (car bass) 2))) (cons (transpose-figures-chord delta (car figures) current) (transpose-figures-rec delta (cdr figures) bass current (- ttl (chord-duration (car figures))))) )) ) ;}}} ; (define (transpose-figures delta figures bass) (let* ( (bass1 (bass-line bass)) (fig1 (ly:music-property (ly:music-property figures 'element) 'elements)) ) (transpose-figures-rec delta fig1 bass1 (list-ref (car bass1) 1) 0) )) (define transposeFigures (define-music-function (parser location p1 p2 figures bass) (ly:pitch? ly:pitch? ly:music? ly:music?) (make-music 'ContextSpeccedMusic 'create-new #t 'property-operations '() 'context-type 'FiguredBass 'element (make-music 'SequentialMusic 'elements (transpose-figures (ly:pitch-diff p2 p1) figures bass)))) )
_______________________________________________ lilypond-user mailing list lilypond-user@gnu.org https://lists.gnu.org/mailman/listinfo/lilypond-user