From: Neil Puttock Date: Mon, 16 Nov 2009 00:27:06 +0000 (+0000) Subject: translation-functions.scm: Tidy formatting. X-Git-Tag: release/2.13.8-1~33 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=f903aa1415bac953e1b3f700a17c1e7ffc7f93ad;p=lilypond.git translation-functions.scm: Tidy formatting. --- diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm index fb8ccac3c5..365f6883d1 100644 --- a/scm/translation-functions.scm +++ b/scm/translation-functions.scm @@ -15,32 +15,34 @@ (define-public (metronome-markup text dur count hide-note) (let* ((note-mark (if (and (not hide-note) (ly:duration? dur)) - (make-smaller-markup - (make-note-by-number-markup (ly:duration-log dur) - (ly:duration-dot-count dur) - 1)) - #f)) + (make-smaller-markup + (make-note-by-number-markup (ly:duration-log dur) + (ly:duration-dot-count dur) + 1)) + #f)) (note-markup (if (and (not hide-note) (number? count) (> count 0) ) - (make-concat-markup (list - (make-general-align-markup Y DOWN note-mark) - (make-simple-markup " ") - (make-simple-markup "=") - (make-simple-markup " ") - (make-simple-markup (number->string count)))) - #f)) + (make-concat-markup + (list + (make-general-align-markup Y DOWN note-mark) + (make-simple-markup " ") + (make-simple-markup "=") + (make-simple-markup " ") + (make-simple-markup (number->string count)))) + #f)) (text-markup (if (not (null? text)) - (make-bold-markup text) - #f))) + (make-bold-markup text) + #f))) (if text-markup - (if (and note-markup (not hide-note)) - (make-line-markup (list text-markup - (make-concat-markup (list (make-simple-markup "(") - note-markup - (make-simple-markup ")"))))) - (make-line-markup (list text-markup))) - (if note-markup - (make-line-markup (list note-markup)) - (make-null-markup))))) + (if (and note-markup (not hide-note)) + (make-line-markup (list text-markup + (make-concat-markup + (list (make-simple-markup "(") + note-markup + (make-simple-markup ")"))))) + (make-line-markup (list text-markup))) + (if note-markup + (make-line-markup (list note-markup)) + (make-null-markup))))) (define-public (format-mark-alphabet mark context) (make-bold-markup (make-markalphabet-markup (1- mark)))) @@ -58,7 +60,8 @@ (make-bold-markup (number->string mark))) (define-public (format-mark-barnumbers mark context) - (make-bold-markup (number->string (ly:context-property context 'currentBarNumber)))) + (make-bold-markup (number->string (ly:context-property context + 'currentBarNumber)))) (define-public (format-mark-box-letters mark context) (make-bold-markup (make-box-markup (make-markletter-markup (1- mark))))) @@ -74,11 +77,13 @@ (define-public (format-mark-box-barnumbers mark context) (make-bold-markup (make-box-markup - (number->string (ly:context-property context 'currentBarNumber))))) + (number->string (ly:context-property context + 'currentBarNumber))))) (define-public (format-mark-circle-barnumbers mark context) (make-bold-markup (make-circle-markup - (number->string (ly:context-property context 'currentBarNumber))))) + (number->string (ly:context-property context + 'currentBarNumber))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -88,22 +93,23 @@ (let* ((fig (ly:event-property event 'figure)) (fig-markup (if (number? figure) - ;; this is not very elegant, but center-aligning all digits - ;; is problematic with other markups, and shows problems - ;; in the (lack of) overshoot of feta alphabet glyphs. - + ;; this is not very elegant, but center-aligning + ;; all digits is problematic with other markups, + ;; and shows problems in the (lack of) overshoot + ;; of feta-alphabet glyphs. ((if (<= 10 figure) - (lambda (y) (make-translate-scaled-markup (cons -0.7 0) y)) + (lambda (y) (make-translate-scaled-markup + (cons -0.7 0) y)) identity) (cond - ((eq? #t (ly:event-property event 'diminished)) - (markup #:slashed-digit figure)) - ((eq? #t (ly:event-property event 'augmented-slash)) - (markup #:backslashed-digit figure)) - (else (markup #:number (number->string figure 10))))) - #f - )) + ((eq? #t (ly:event-property event 'diminished)) + (markup #:slashed-digit figure)) + ((eq? #t (ly:event-property event 'augmented-slash)) + (markup #:backslashed-digit figure)) + (else (markup #:number (number->string figure 10))))) + #f)) + (alt (ly:event-property event 'alteration)) (alt-markup (if (number? alt) @@ -112,15 +118,14 @@ (if (not (= alt DOUBLE-SHARP)) -2 2) (alteration->text-accidental-markup alt)) - #f)) + (plus-markup (if (eq? #t (ly:event-property event 'augmented)) (markup #:number "+") #f)) (alt-dir (ly:context-property context 'figuredBassAlterationDirection)) - (plus-dir (ly:context-property context 'figuredBassPlusDirection)) - ) + (plus-dir (ly:context-property context 'figuredBassPlusDirection))) (if (and (not fig-markup) alt-markup) (begin @@ -130,7 +135,7 @@ ;; hmm, how to get figures centered between note, and ;; lone accidentals too? - + ;; (if (markup? fig-markup) ;; (set! ;; fig-markup (markup #:translate (cons 1.0 0) @@ -143,10 +148,8 @@ alt-dir LEFT) fig-markup - #:pad-x 0.2 alt-markup - ))) + #:pad-x 0.2 alt-markup))) - (if plus-markup (set! fig-markup (if fig-markup @@ -157,12 +160,10 @@ fig-markup #:pad-x 0.2 plus-markup) plus-markup))) - + (if (markup? fig-markup) (markup #:fontsize -2 fig-markup) - empty-markup) - - )) + empty-markup))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -176,85 +177,83 @@ b)) (define (string-frets->dot-placement string-frets string-count) - (let* - ((desc (list->vector - (map (lambda (x) (list 'mute (1+ x))) - (iota string-count))))) - - (for-each (lambda (sf) - (let* - ((string (car sf)) - (fret (cadr sf)) - (finger (caddr sf))) - - (vector-set! - desc (1- string) - (if (= 0 fret) - (list 'open string) - (if finger - (list 'place-fret string fret finger) - (list 'place-fret string fret)) - )) - )) - string-frets) - (vector->list desc))) + (let* ((desc (list->vector + (map (lambda (x) (list 'mute (1+ x))) + (iota string-count))))) + + (for-each (lambda (sf) + (let* ((string (car sf)) + (fret (cadr sf)) + (finger (caddr sf))) + + (vector-set! + desc (1- string) + (if (= 0 fret) + (list 'open string) + (if finger + (list 'place-fret string fret finger) + (list 'place-fret string fret)))))) + string-frets) + + (vector->list desc))) (define (get-predefined-fretboard predefined-fret-table tuning pitches) ; (_i "Search through @var{predefined-fret-table} looking for a predefined ;fretboard with a key of @var{(tuning . pitches)}. The search will check ;both up and down an octave in order to accomodate transposition of the ;chords.") - (define (get-fretboard key) - (let ((hash-handle - (hash-get-handle predefined-fret-table key))) - (if hash-handle - (cdr hash-handle) ; return table entry - '()))) - - (let ((test-fretboard (get-fretboard (cons tuning pitches)))) - (if (not (null? test-fretboard)) - test-fretboard - (let ((test-fretboard - (get-fretboard - (cons tuning (map (lambda (x) (shift-octave x 1)) pitches))))) - (if (not (null? test-fretboard)) - test-fretboard - (get-fretboard - (cons tuning (map (lambda (x) (shift-octave x -1)) pitches)))))))) + (define (get-fretboard key) + (let ((hash-handle + (hash-get-handle predefined-fret-table key))) + (if hash-handle + (cdr hash-handle) ; return table entry + '()))) + + (let ((test-fretboard (get-fretboard (cons tuning pitches)))) + (if (not (null? test-fretboard)) + test-fretboard + (let ((test-fretboard + (get-fretboard + (cons tuning (map (lambda (x) (shift-octave x 1)) pitches))))) + (if (not (null? test-fretboard)) + test-fretboard + (get-fretboard + (cons tuning (map (lambda (x) (shift-octave x -1)) + pitches)))))))) ;; body. - (let* - ((tunings (ly:context-property context 'stringTunings)) - (my-string-count (length tunings)) - (details (ly:grob-property grob 'fret-diagram-details)) - (predefined-frets - (ly:context-property context 'predefinedDiagramTable)) - (minimum-fret (ensure-number - (ly:context-property context 'minimumFret) 0)) - (max-stretch (ensure-number - (ly:context-property context 'maximumFretStretch) 4)) - (string-frets (determine-frets-mf notes string-numbers - minimum-fret max-stretch - tunings)) - (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes))) + (let* ((tunings (ly:context-property context 'stringTunings)) + (my-string-count (length tunings)) + (details (ly:grob-property grob 'fret-diagram-details)) + (predefined-frets + (ly:context-property context 'predefinedDiagramTable)) + (minimum-fret (ensure-number + (ly:context-property context 'minimumFret) 0)) + (max-stretch (ensure-number + (ly:context-property context 'maximumFretStretch) 4)) + (string-frets (determine-frets-mf notes string-numbers + minimum-fret max-stretch + tunings)) + (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes))) (set! (ly:grob-property grob 'fret-diagram-details) (if (null? details) (acons 'string-count (length tunings) '()) (acons 'string-count (length tunings) details))) + (set! (ly:grob-property grob 'dot-placement-list) - (if predefined-frets - (let ((predefined-fretboard - (get-predefined-fretboard + (if predefined-frets + (let ((predefined-fretboard + (get-predefined-fretboard predefined-frets tunings pitches))) - (if (null? predefined-fretboard) - (string-frets->dot-placement - string-frets my-string-count) ;no predefined diagram - predefined-fretboard)) ;found default diagram - (string-frets->dot-placement string-frets my-string-count))))) + (if (null? predefined-fretboard) + (string-frets->dot-placement + string-frets my-string-count) ;no predefined diagram + predefined-fretboard)) ;found default diagram + (string-frets->dot-placement string-frets my-string-count))))) (define-public (determine-frets-mf notes string-numbers minimum-fret max-stretch @@ -275,8 +274,7 @@ (finger-found #f)) (map (lambda (art) - (let* - ((num (ly:event-property art 'digit))) + (let* ((num (ly:event-property art 'digit))) (if (and (eq? 'fingering-event (ly:event-property art 'class)) (number? num)) @@ -284,14 +282,13 @@ articulations) finger-found)) - + (define (note-string ev) (let* ((articulations (ly:event-property ev 'articulations)) (string-found #f)) (map (lambda (art) - (let* - ((num (ly:event-property art 'string-number))) + (let* ((num (ly:event-property art 'string-number))) (if (number? num) (set! string-found num)))) @@ -300,75 +297,67 @@ string-found)) (define (del-string string) - (if (number? string) - (set! free-strings - (delete string free-strings)))) + (if (number? string) + (set! free-strings + (delete string free-strings)))) + (define specified-frets '()) (define free-strings '()) (define (close-enough fret) - (reduce - (lambda (x y) - (and x y)) - #t - (map (lambda (specced-fret) - (> max-stretch (abs (- fret specced-fret)))) - specified-frets) - )) - + (reduce + (lambda (x y) + (and x y)) + #t + (map (lambda (specced-fret) + (> max-stretch (abs (- fret specced-fret)))) + specified-frets))) + (define (string-qualifies string pitch) - (let* - ((fret (calc-fret pitch string tunings))) - - (and (>= fret minimum-fret) - (close-enough fret)) - - )) - + (let* ((fret (calc-fret pitch string tunings))) + (and (>= fret minimum-fret) + (close-enough fret)))) + (define string-fret-fingering-tuples '()) (define (set-fret note string) - (set! string-fret-fingering-tuples - (cons (list string - (calc-fret (ly:event-property note 'pitch) - string tunings) - (note-finger note)) - string-fret-fingering-tuples)) - (del-string string)) - + (set! string-fret-fingering-tuples + (cons (list string + (calc-fret (ly:event-property note 'pitch) + string tunings) + (note-finger note)) + string-fret-fingering-tuples)) + (del-string string)) + ;;; body. (set! specified-frets (filter identity (map - (lambda (note) - (if (note-string note) - (calc-fret (note-pitch note) - (note-string note) tunings) - #f)) - notes))) - + (lambda (note) + (if (note-string note) + (calc-fret (note-pitch note) + (note-string note) tunings) + #f)) + notes))) (set! free-strings (map 1+ (iota (length tunings)))) - + (for-each (lambda (note) (del-string (note-string note))) notes) - - + + (for-each (lambda (note) (if (note-string note) (set-fret note (note-string note)) - (let* - ((fit-string (find (lambda (string) - (string-qualifies string (note-pitch note))) - free-strings))) + (let* ((fit-string (find (lambda (string) + (string-qualifies string (note-pitch note))) + free-strings))) (if fit-string (set-fret note fit-string) (ly:warning "No string for pitch ~a (given frets ~a)" (note-pitch note) - specified-frets)) - - ))) + specified-frets))))) (sort notes note-pitch>?)) string-fret-fingering-tuples)