X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ftranslation-functions.scm;h=0ed0deff0a24817edc4f53b42fb902313f0e75bc;hb=79c17e0eaedca79e5f7605f5b9f92db27c68e679;hp=2e0d02371b19c3e74ae718f99cbda8be7e1df0dd;hpb=84ac019c437ea40b7b18ab46da1772f6db344a83;p=lilypond.git diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm index 2e0d02371b..0ed0deff0a 100644 --- a/scm/translation-functions.scm +++ b/scm/translation-functions.scm @@ -427,13 +427,21 @@ the current tuning?" (ly:warning (_ "No open string for pitch ~a") pitch))) ;; here we handle assigned strings - (let ((this-fret - (calc-fret pitch string tuning)) - (handle-negative - (ly:context-property context - 'handleNegativeFrets - 'recalculate))) - (cond ((or (and (>= this-fret 0) (integer? this-fret)) + (let* ((this-fret + (calc-fret pitch string tuning)) + (possible-fret? + (and (>= this-fret 0) + (if (and + (ly:context-property + context 'supportNonIntegerFret #f) + (null? rest)) + (integer? (truncate this-fret)) + (integer? this-fret)))) + (handle-negative + (ly:context-property context + 'handleNegativeFrets + 'recalculate))) + (cond ((or possible-fret? (eq? handle-negative 'include)) (set-fret! pitch-entry string finger)) ((eq? handle-negative 'recalculate) @@ -515,10 +523,18 @@ chords. Returns a placement-list." (cons tuning (map (lambda (x) (shift-octave x -1)) pitches)))))))) + ;; TODO: Does it make sense to have additional bass strings in a fret-diagram? + (if (and (not (null? rest)) + (not (null? (ly:context-property context 'additionalBassStrings)))) + (ly:warning "additional bass strings are not supported by FretBoards")) + ;; body of determine-frets (let* ((predefined-fret-table (ly:context-property context 'predefinedDiagramTable)) - (tunings (ly:context-property context 'stringTunings)) + (tunings + (append + (ly:context-property context 'stringTunings) + (ly:context-property context 'additionalBassStrings '()))) (string-count (length tunings)) (grob (if (null? rest) '() (car rest))) (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes)) @@ -576,18 +592,33 @@ chords. Returns a placement-list." ;; The fret letter is taken from 'fretLabels if present (define-public (fret-letter-tablature-format context string-number fret-number) - (let ((labels (ly:context-property context 'fretLabels))) - (make-translate-scaled-markup '(0 . -0.5) - (cond - ((= 0 (length labels)) - (string (integer->char (+ fret-number (char->integer #\a))))) - ((and (<= 0 fret-number) (< fret-number (length labels))) - (list-ref labels fret-number)) - (else - (ly:warning (_ "No label for fret ~a (on string ~a); + (let* ((labels (ly:context-property context 'fretLabels)) + (string-tunings (ly:context-property context 'stringTunings)) + (string-count (length string-tunings)) + (letter + (cond + ((= 0 (length labels)) + (string (integer->char (+ fret-number (char->integer #\a))))) + ((and (<= 0 fret-number) (< fret-number (length labels))) + (list-ref labels fret-number)) + (else + (ly:warning + (_ "No label for fret ~a (on string ~a); only ~a fret labels provided") - fret-number string-number (length labels)) - "."))))) + fret-number string-number (length labels)) + "."))) + (add-bass-string-nr ;; starting at zero + (- string-number string-count 1))) + (make-translate-scaled-markup '(0 . -0.5) + ;; For additional bass strings, we add zero up to three "/"-signs before + ;; the letter, even more bass strings will get numbers, starting with "4". + ;; In the rare case such a string isn't played open, we put out, eg."4b" + (make-concat-markup + (if (> string-number (+ string-count 4)) + (list (number->string add-bass-string-nr) + (if (zero? fret-number) "" letter)) + (list (make-string (max 0 add-bass-string-nr) #\/) + letter)))))) ;; Display the fret number as a number (define-public (fret-number-tablature-format @@ -635,8 +666,12 @@ only ~a fret labels provided") (define-public (tablature-position-on-lines context string-number) (let* ((string-tunings (ly:context-property context 'stringTunings)) (string-count (length string-tunings)) + (string-nr + (if (> string-number (length string-tunings)) + (1+ (length string-tunings)) + string-number)) (string-one-topmost (ly:context-property context 'stringOneTopmost)) - (staff-line (- (* 2 string-number) string-count 1))) + (staff-line (- (* 2 string-nr) string-count 1))) (if string-one-topmost (- staff-line) staff-line))) @@ -706,3 +741,66 @@ only ~a fret labels provided") (export every-nth-repeat-count-visible) (define-public (all-repeat-counts-visible count context) #t) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; pitch recognition + +(define-public (make-semitone->pitch pitches) + "Convert @var{pitches}, an unordered list of note values +covering (after disregarding octaves) all absolute pitches in need of +conversion, into a function converting semitone numbers (absolute +pitch missing enharmonic information) back into note values. + +For a key signature without accidentals +@example +c cis d es e f fis g gis a bes b +@end example +might be a good choice, covering Bb major to A major and their +parallel keys, and melodic/harmonic C minor to A minor." + ;; TODO: short-circuit lcm calculation once we know it will be large + (let* ((size (apply lcm (map (lambda (pitch) + (denominator (/ (ly:pitch-tones pitch) 6))) + pitches))) + ;; Normal tunings need 12 steps per octave, quartertone + ;; tunings 24, Makam needs 108. But microtunings might cause + ;; trouble. + (lookup (if (> size 400) + (make-hash-table) + (make-vector size #f)))) + (for-each + (lambda (pitch) + (let* ((rawoct (/ (ly:pitch-tones pitch) 6)) + (oct (floor rawoct)) + (ref (- rawoct oct)) + (val (ly:pitch-transpose pitch + (ly:make-pitch (- oct) 0)))) + (if (hash-table? lookup) + (hashv-set! lookup ref val) + (vector-set! lookup (* size ref) val)))) + pitches) + (lambda (semitone) + "Convert @var{semitone} numbers into note values. If the +originally specified list of pitches does not contain a note +corresponding to @var{semitone} (disregarding octaves), @code{#f} is +returned." + (let* ((rawoct (/ semitone 12)) + (oct (floor rawoct)) + (ref (- rawoct oct)) + (val (if (hash-table? lookup) + (hashv-ref lookup ref) + (let ((ref (* (vector-length lookup) ref))) + (and (integer? ref) + (vector-ref lookup ref)))))) + (and val + (ly:pitch-transpose val (ly:make-pitch oct 0))))))) + +(define ((shift-semitone->pitch key semitone->pitch) semitone) + "Given a function @var{semitone->pitch} converting a semitone number +into a note value for a lookup table created in relation to@tie{}C, +returns a corresponding function in relation to @var{key}. The note +values returned by this function differ only enharmonically from the +original @var{semitone->pitch} function." + (ly:pitch-transpose (semitone->pitch (- semitone (* 2 (ly:pitch-tones key)))) + key)) + +(export shift-semitone->pitch)