]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/translation-functions.scm
Change stringTunings from list of semitones to list of pitches
[lilypond.git] / scm / translation-functions.scm
index 683f2aaae405c6fd447cc85448894e8980d37285..a2ee8b9ddb26766184e5f639f34581ac9231ace5 100644 (file)
                                                     (ly:duration-dot-count dur)
                                                     1))
                        #f))
-         (note-markup (if (and (not hide-note) (number? count) (> count 0) )
+        (count-markup (cond ((number? count)
+                             (if (> count 0)
+                                 (make-simple-markup (number->string count))
+                                 #f))
+                            ((pair? count)
+                             (make-concat-markup
+                              (list
+                               (make-simple-markup (number->string (car count)))
+                               (make-simple-markup " ")
+                               (make-simple-markup "–")
+                               (make-simple-markup " ")
+                               (make-simple-markup (number->string (cdr count))))))
+                            (else #f)))
+         (note-markup (if (and (not hide-note) count-markup)
                          (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))))
+                           count-markup))
                          #f))
          (text-markup (if (not (null? text))
                          (make-bold-markup text)
     (set! (ly:grob-property grob 'dot-placement-list) placement-list)))
 
 (define-public
-  (determine-frets context notes defined-strings . rest)
+  (determine-frets context notes specified-info . rest)
   "Determine string numbers and frets for playing @var{notes}
-as a chord, given specified string numbers @var{defined-strings}.
+as a chord, given specified information  @var{specified-info}.
+@var{specified-info} is a list with two list elements,
+specified strings @var{defined-strings} and
+specified fingerings @var{defined-fingers}.  Only a fingering of
+0 will affect the fret selection, as it specifies an open string.
+If @var{defined-strings} is @code{'()}, the context property
+@code{defaultStrings} will be used as a list of defined strings.
 Will look for predefined fretboards if @code{predefinedFretboardTable}
 is not @code {#f}.  If @var{rest} is present, it contains the
 FretBoard grob, and a fretboard will be
@@ -232,8 +251,12 @@ dot placement entries."
                          (cdr x)
                          (list (cadr x) 0)))
          (filter (lambda (l) (or (eq? (car l) 'place-fret)
-                                 (eq? (car l) 'open))) placement-list)))
+                                 (eq? (car l) 'open)))
+                 placement-list)))
 
+  (define (entry-count art-list)
+    (length (filter (lambda (x) (not (null? x)))
+                    art-list)))
 
   (define (get-predefined-fretboard predefined-fret-table tuning pitches)
     "Search through @var{predefined-fret-table} looking for a predefined
@@ -268,6 +291,21 @@ chords.  Returns a placement-list."
          (string-count (length tunings))
          (grob (if (null? rest) '() (car rest)))
         (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes))
+         (defined-strings (map (lambda (x)
+                                 (if (null? x)
+                                     x
+                                     (ly:event-property x 'string-number)))
+                               (car specified-info)))
+         (defined-fingers (map (lambda (x)
+                                 (if (null? x)
+                                     x
+                                     (ly:event-property x 'digit)))
+                               (cadr specified-info)))
+         (default-strings (ly:context-property context 'defaultStrings '()))
+         (strings-used (if (and (zero? (entry-count defined-strings))
+                                (not (zero? (entry-count default-strings))))
+                           default-strings
+                           defined-strings))
          (predefined-fretboard
           (if predefined-fret-table
               (get-predefined-fretboard
@@ -275,12 +313,12 @@ chords.  Returns a placement-list."
                tunings
                pitches)
               '())))
-
      (if (null? predefined-fretboard)
          (let ((string-frets
                 (determine-frets-and-strings
                  notes
-                 defined-strings
+                 strings-used
+                 defined-fingers
                  (ly:context-property context 'minimumFret 0)
                  (ly:context-property context 'maximumFretStretch 4)
                  tunings)))
@@ -295,10 +333,15 @@ chords.  Returns a placement-list."
 
 
 (define (determine-frets-and-strings
-          notes defined-strings minimum-fret maximum-stretch tuning)
+          notes
+          defined-strings
+          defined-fingers
+          minimum-fret
+          maximum-stretch
+          tuning)
 
   (define (calc-fret pitch string tuning)
-    (- (ly:pitch-semitones pitch) (list-ref tuning (1- string))))
+    (- (ly:pitch-semitones pitch) (ly:pitch-semitones (list-ref tuning (1- string)))))
 
   (define (note-pitch a)
     (ly:event-property a 'pitch))
@@ -315,7 +358,8 @@ chords.  Returns a placement-list."
             (let* ((num (ly:event-property art 'digit)))
 
               (if (and (eq? 'fingering-event (ly:event-property art 'class))
-                       (number? num))
+                       (number? num)
+                        (> num 0))
                   (set! finger-found num))))
           articulations)
 
@@ -327,7 +371,6 @@ chords.  Returns a placement-list."
           num
           #f)))
 
-
   (define (delete-free-string string)
     (if (number? string)
        (set! free-strings
@@ -345,7 +388,8 @@ chords.  Returns a placement-list."
             (and x y))
           #t
           (map (lambda (specced-fret)
-                 (> maximum-stretch (abs (- fret specced-fret))))
+                 (or (eq? 0 specced-fret)
+                     (>= maximum-stretch (abs (- fret specced-fret)))))
                specified-frets))))
 
   (define (string-qualifies string pitch)
@@ -353,12 +397,19 @@ chords.  Returns a placement-list."
       (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
@@ -367,35 +418,60 @@ chords.  Returns a placement-list."
        (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
-  (while (< (length defined-strings) (length notes))
-         (set! defined-strings (append defined-strings '(()))))
+  (pad-list defined-strings notes)
+
+  ;; get defined-fingers same length as notes
+  (pad-list defined-fingers notes)
 
-  ;; handle notes with strings assigned
+  ;; handle notes with strings assigned and fingering of 0
   (for-each
-    (lambda (note string)
-      (if (null? string)
-          (set! unassigned-notes (cons note unassigned-notes))
-          (let ((this-string (string-number string)))
-            (delete-free-string this-string)
-            (set-fret note this-string))))
-    notes defined-strings)
+    (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)))
+     (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))))
+            (ly:warning (_ "No string for pitch ~a (given frets ~a)")
+                           (note-pitch note)
+                           specified-frets))))
    (sort unassigned-notes note-pitch>?))
 
    string-fret-fingering-tuples)
@@ -417,10 +493,10 @@ chords.  Returns a placement-list."
     ((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))
-       ".")))))
+     (ly:warning (_ "No label for fret ~a (on string ~a);
+only ~a fret labels provided")
+                fret-number string-number (length labels))
+     ".")))))
 
 ;; Display the fret number as a number
 (define-public (fret-number-tablature-format