From 8e4928b9fefc6e68ecef9b0bb3316b2b4203f9cb Mon Sep 17 00:00:00 2001 From: Carl Sorensen Date: Mon, 17 Jan 2011 16:03:44 -0700 Subject: [PATCH] Fix Issue 1035 -- Add context property for negative frets Add handleNegativeFrets, with possibilities of 'ignore, 'recalculate, 'include Reorder functions in scm/translation-functions.scm to put context in scope of calculate-frets-and-strings Set handleNegativeFrets to 'recalculate for TabStaff and FretBoards Add regression test. --- input/regression/tablature-negative-fret.ly | 32 +++ ly/engraver-init.ly | 3 + scm/define-context-properties.scm | 5 + scm/translation-functions.scm | 301 ++++++++++---------- 4 files changed, 198 insertions(+), 143 deletions(-) create mode 100644 input/regression/tablature-negative-fret.ly diff --git a/input/regression/tablature-negative-fret.ly b/input/regression/tablature-negative-fret.ly new file mode 100644 index 0000000000..ccc25ede5b --- /dev/null +++ b/input/regression/tablature-negative-fret.ly @@ -0,0 +1,32 @@ +\version "2.13.46" + +\header { + + texidoc = " +Negative fret numbers calculated due to assigning a string number +can be displayed, ignored, or recalculated. Here we should have +all three cases demonstrated. +" + +} + +myMusic = \relative c' { + 1 ^\markup { recalculate } + \set TabStaff.handleNegativeFrets = #'include + 1 ^ \markup { include } + \set TabStaff.handleNegativeFrets = #'ignore + 1 ^ \markup { ignore } +} + +\score { + << + \new Staff { + \clef "treble_8" + \textLengthOn + \myMusic + } + \new TabStaff { + \myMusic + } + >> +} diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index 7f7297e414..ab7dafe48e 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -45,6 +45,7 @@ shortInstrumentName = #'() predefinedDiagramTable = #default-fret-table + handleNegativeFrets = #'recalculate } \context { @@ -864,6 +865,8 @@ contexts and handles the line spacing, the tablature clef etc. properly." %% Special "TAB" clef clefGlyph = #"clefs.tab" clefPosition = #0 + %% Change string if note results in negative fret number + handleNegativeFrets = #'recalculate } \context { diff --git a/scm/define-context-properties.scm b/scm/define-context-properties.scm index 2b1a62e7b4..5853474179 100644 --- a/scm/define-context-properties.scm +++ b/scm/define-context-properties.scm @@ -261,6 +261,11 @@ frets in tablature.") @code{GridPoint}s.") + (handleNegativeFrets ,symbol? "How the automatic fret calculator +should handle calculated negative frets. Values include @code{'ignore}, +to leave them out of the diagram completely, @code{'include}, to include +them as calculated, and @code{'recalculate}, to ignore the specified +string and find a string where they will fit with a positive fret number.") (harmonicAccidentals ,boolean? "If set, harmonic notes in chords get accidentals.") (harmonicDots ,boolean? "If set, harmonic notes in dotted chords get diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm index f6f24734e4..5a22e72a89 100644 --- a/scm/translation-functions.scm +++ b/scm/translation-functions.scm @@ -258,6 +258,162 @@ dot placement entries." (length (filter (lambda (x) (not (null? x))) art-list))) + (define (determine-frets-and-strings + notes + defined-strings + defined-fingers + minimum-fret + maximum-stretch + tuning) + + (define (calc-fret pitch string tuning) + (- (ly:pitch-semitones pitch) (ly:pitch-semitones (list-ref tuning (1- string))))) + + (define (note-pitch a) + (ly:event-property a 'pitch)) + + (define (note-pitch>? a b) + (ly:pitch num 0)) + (set! finger-found num)))) + articulations) + + finger-found)) + + (define (string-number event) + (let ((num (ly:event-property event 'string-number))) + (if (number? num) + num + #f))) + + (define (delete-free-string string) + (if (number? string) + (set! free-strings + (delete string free-strings)))) + + (define free-strings '()) + (define unassigned-notes '()) + (define specified-frets '()) + + (define (close-enough fret) + (if (null? specified-frets) + #t + (reduce + (lambda (x y) + (and x y)) + #t + (map (lambda (specced-fret) + (or (eq? 0 specced-fret) + (>= maximum-stretch (abs (- fret specced-fret))))) + specified-frets)))) + + (define (string-qualifies string pitch) + (let* ((fret (calc-fret pitch string tuning))) + (and (>= fret minimum-fret) + (close-enough fret)))) + + (define (open-string string pitch) + (let* ((fret (calc-fret pitch string tuning))) + (eq? fret 0))) + + (define string-fret-fingering-tuples '()) + + (define (set-fret note string) + (let ((this-fret (calc-fret (ly:event-property note 'pitch) + string + tuning))) + (if (< this-fret 0) + (ly:warning (_ "Negative fret for pitch ~a on string ~a") + (note-pitch note) string)) + (set! string-fret-fingering-tuples + (cons (list string + this-fret + (note-finger note)) + string-fret-fingering-tuples)) + (delete-free-string string) + (set! specified-frets (cons this-fret specified-frets)))) + + (define (pad-list target template) + (while (< (length target) (length template)) + (set! target (if (null? target) + '(()) + (append target '(())))))) + + ;;; body of determine-frets-and-strings + (set! free-strings (map 1+ (iota (length tuning)))) + + ;; get defined-strings same length as notes + (pad-list defined-strings notes) + + ;; get defined-fingers same length as notes + (pad-list defined-fingers notes) + + ;; handle notes with strings assigned and fingering of 0 + (for-each + (lambda (note string finger) + (let ((digit (if (null? finger) + #f + finger))) + (if (and (null? string) + (not (eq? digit 0))) + (set! unassigned-notes (cons note unassigned-notes)) + (if (eq? digit 0) + (let ((fit-string + (find (lambda (string) + (open-string string (note-pitch note))) + free-strings))) + (if fit-string + (begin + (delete-free-string fit-string) + (set-fret note fit-string)) + (begin + (ly:warning (_ "No open string for pitch ~a") + (note-pitch note)) + (set! unassigned-notes (cons note unassigned-notes))))) + (let ((this-fret (calc-fret (note-pitch note) string tuning)) + (handle-negative + (ly:context-property context + 'handleNegativeFrets + 'recalculate))) + (cond ((or (>= this-fret 0) + (eq? handle-negative 'include)) + (begin + (delete-free-string string) + (set-fret note string))) + ((eq? handle-negative 'recalculate) + (begin + (ly:warning (_ "Requested string for pitch requires negative fret: string ~a pitch ~a") string (note-pitch note)) + (ly:warning (_ "Ignoring string request.")) + (set! unassigned-notes (cons note unassigned-notes)))))))))) + notes defined-strings defined-fingers) + + ;; handle notes without strings assigned + (for-each + (lambda (note) + (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)))) + (sort unassigned-notes note-pitch>?)) + + string-fret-fingering-tuples) ;; end of determine-frets-and-strings + (define (get-predefined-fretboard predefined-fret-table tuning pitches) "Search through @var{predefined-fret-table} looking for a predefined fretboard with a key of @var{(tuning . pitches)}. The search will check @@ -271,6 +427,8 @@ chords. Returns a placement-list." (cdr hash-handle) ; return table entry '()))) + + ;; body of get-predefined-fretboard (let ((test-fretboard (get-fretboard (cons tuning pitches)))) (if (not (null? test-fretboard)) @@ -332,149 +490,6 @@ chords. Returns a placement-list." (create-fretboard context grob predefined-fretboard))))) -(define (determine-frets-and-strings - notes - defined-strings - defined-fingers - minimum-fret - maximum-stretch - tuning) - - (define (calc-fret pitch string tuning) - (- (ly:pitch-semitones pitch) (ly:pitch-semitones (list-ref tuning (1- string))))) - - (define (note-pitch a) - (ly:event-property a 'pitch)) - - (define (note-pitch>? a b) - (ly:pitch num 0)) - (set! finger-found num)))) - articulations) - - finger-found)) - - (define (string-number event) - (let ((num (ly:event-property event 'string-number))) - (if (number? num) - num - #f))) - - (define (delete-free-string string) - (if (number? string) - (set! free-strings - (delete string free-strings)))) - - (define free-strings '()) - (define unassigned-notes '()) - (define specified-frets '()) - - (define (close-enough fret) - (if (null? specified-frets) - #t - (reduce - (lambda (x y) - (and x y)) - #t - (map (lambda (specced-fret) - (or (eq? 0 specced-fret) - (>= maximum-stretch (abs (- fret specced-fret))))) - specified-frets)))) - - (define (string-qualifies string pitch) - (let* ((fret (calc-fret pitch string tuning))) - (and (>= fret minimum-fret) - (close-enough fret)))) - - (define (open-string string pitch) - (let* ((fret (calc-fret pitch string tuning))) - (eq? fret 0))) - - (define string-fret-fingering-tuples '()) - - (define (set-fret note string) - (let ((this-fret (calc-fret (ly:event-property note 'pitch) - string - tuning))) - (if (< this-fret 0) - (ly:warning (_ "Negative fret for pitch ~a on string ~a") - (note-pitch note) string)) - (set! string-fret-fingering-tuples - (cons (list string - this-fret - (note-finger note)) - string-fret-fingering-tuples)) - (delete-free-string string) - (set! specified-frets (cons this-fret specified-frets)))) - - (define (pad-list target template) - (while (< (length target) (length template)) - (set! target (if (null? target) - '(()) - (append target '(())))))) - - ;;; body of determine-frets-and-strings - (set! free-strings (map 1+ (iota (length tuning)))) - - ;; get defined-strings same length as notes - (pad-list defined-strings notes) - - ;; get defined-fingers same length as notes - (pad-list defined-fingers notes) - - ;; handle notes with strings assigned and fingering of 0 - (for-each - (lambda (note string finger) - (let ((digit (if (null? finger) - #f - finger))) - (if (and (null? string) - (not (eq? digit 0))) - (set! unassigned-notes (cons note unassigned-notes)) - (if (eq? digit 0) - (let ((fit-string - (find (lambda (string) - (open-string string (note-pitch note))) - free-strings))) - (if fit-string - (begin - (delete-free-string fit-string) - (set-fret note fit-string)) - (begin - (ly:warning (_ "No open string for pitch ~a") - (note-pitch note)) - (set! unassigned-notes (cons note unassigned-notes))))) - (begin - (delete-free-string string) - (set-fret note string)))))) - notes defined-strings defined-fingers) - - ;; handle notes without strings assigned - (for-each - (lambda (note) - (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)))) - (sort unassigned-notes note-pitch>?)) - - string-fret-fingering-tuples) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; tablature -- 2.39.2