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.

diff --git a/input/regression/tablature-negative-fret.ly b/input/regression/tablature-negative-fret.ly
new file mode 100644 (file)
index 0000000..ccc25ed
--- /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'  {
+  <c\1>1 ^\markup { recalculate }
+  \set TabStaff.handleNegativeFrets = #'include
+  <c\1>1 ^ \markup { include }
+  \set TabStaff.handleNegativeFrets = #'ignore
+  <c\1>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 7f7297e4145df839cd5b0fb70365d326fae0f4df..ab7dafe48ee3a77b5437236494419f88cb63824b 100644 (file)
--- 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 2b1a62e7b46df8548ffeb583ce2a85aca5233c23..5853474179985733fa8675e8c309f4b5fab7847d 100644 (file)
--- 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 f6f24734e47425afbfd002276279c1d372adb5f0..5a22e72a89b1cdbba2a4e24cfe9ee9232a11c55c 100644 (file)
--- 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<? (note-pitch b)
+                 (note-pitch a)))
+
+    (define (note-finger ev)
+      (let* ((articulations (ly:event-property ev 'articulations))
+            (finger-found #f))
+
+       (map (lambda (art)
+              (let* ((num (ly:event-property art 'digit)))
+
+                (if (and (eq? 'fingering-event (ly:event-property art 'class))
+                         (number? num)
+                         (> 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<? (note-pitch b)
-               (note-pitch a)))
-
-  (define (note-finger ev)
-    (let* ((articulations (ly:event-property ev 'articulations))
-          (finger-found #f))
-
-      (map (lambda (art)
-            (let* ((num (ly:event-property art 'digit)))
-
-              (if (and (eq? 'fingering-event (ly:event-property art 'class))
-                       (number? num)
-                        (> 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