X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ftranslation-functions.scm;h=eefa9c0806a3b18088219b88cf413e7bccf45e5f;hb=d31248d7770fb5770c2caacfb3547984bf8dcdc3;hp=667b0e267900dc0042ebfa784da767d1698ee2fe;hpb=49f9b097ce73335f8a6b3436c43df1aed8a77288;p=lilypond.git diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm index 667b0e2679..eefa9c0806 100644 --- a/scm/translation-functions.scm +++ b/scm/translation-functions.scm @@ -2,44 +2,42 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2007 Han-Wen Nienhuys +;;;; (c) 1998--2009 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen ;; metronome marks (define-public (format-metronome-markup text dur count context) - (let* ((hide_note (eq? #t (ly:context-property context 'tempoHideNote))) - (note-mark (if (and (not hide_note) (ly:duration? dur)) + (let* ((hide-note (eq? #t (ly:context-property context 'tempoHideNote)))) + (metronome-markup text dur count hide-note))) + +(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)) - (note-markup (if (and note-mark (number? count) (> count 0) ) + (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 " ") (make-simple-markup (number->string count)))) - #f)) + #f)) (text-markup (if (not (null? text)) (make-bold-markup text) #f))) (if text-markup - (if note-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)) - ) + (make-line-markup (list text-markup))) (if note-markup (make-line-markup (list note-markup)) - #f - ) - ) - ) -) + (make-null-markup))))) (define-public (format-mark-alphabet mark context) (make-bold-markup (make-markalphabet-markup (1- mark)))) @@ -134,7 +132,7 @@ ;; (if (markup? fig-markup) ;; (set! ;; fig-markup (markup #:translate (cons 1.0 0) - ;; #:hcenter fig-markup))) + ;; #:center-align fig-markup))) (if alt-markup (set! fig-markup @@ -168,26 +166,92 @@ ;; fret diagrams (define-public (determine-frets context grob notes string-numbers) + (define (ensure-number a b) (if (number? a) a b)) -(let* + + (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))) + + (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)))))))) + +;; 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))) + tunings)) + (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes))) + + (set! (ly:grob-property grob 'fret-diagram-details) - (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 'string-fret-finger-combinations) string-frets))) + (set! (ly:grob-property grob 'dot-placement-list) + (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))))) (define-public (determine-frets-mf notes string-numbers minimum-fret max-stretch @@ -199,9 +263,9 @@ (define (note-pitch a) (ly:event-property a 'pitch)) - (define (note-pitch? a b) + (ly:pitch?)) string-fret-fingering-tuples)