Web-fr: updates intro and community

[lilypond.git] / scm / translation-functions.scm

diff --git a/scm/translation-functions.scm b/scm/translation-functions.scm
index 2a3701ea16e8fb4773c52818201dd4d6f06a6253..f9f532b0d0bcbc9265ee359e13a130c2ce1b037c 100644 (file)
--- a/scm/translation-functions.scm
+++ b/scm/translation-functions.scm
@@ -247,7 +247,9 @@ Will look for predefined fretboards if @code{predefinedFretboardTable}
 is not @code {#f}.  If @var{rest} is present, it contains the
 @code{FretBoard} grob, and a fretboard will be
 created.  Otherwise, a list of @code{(string fret finger)} lists will
-be returned."
+be returned.
+If the context-property @code{supportNonIntegerFret} is set @code{#t},
+micro-tones are supported for TabStaff, but not not for FretBoards."
 
   ;;  helper functions
 
@@ -356,7 +358,11 @@ notes?"
         (and (or (and (not restrain-open-strings)
                       (zero? fret))
                  (>= fret minimum-fret))
-             (integer? fret)
+             (if (and
+                   (ly:context-property context 'supportNonIntegerFret #f)
+                   (null? rest))
+                 (integer? (truncate fret))
+                 (integer? fret))
              (close-enough fret))))
 
     (define (open-string string pitch)
@@ -372,7 +378,9 @@ the current tuning?"
         (if (< this-fret 0)
             (ly:warning (_ "Negative fret for pitch ~a on string ~a")
                         (car pitch-entry) string)
-            (if (not (integer? this-fret))
+            (if (and
+                  (not (integer? this-fret))
+                  (not (ly:context-property context 'supportNonIntegerFret #f)))
                 (ly:warning (_ "Missing fret for pitch ~a on string ~a")
                             (car pitch-entry) string)))
         (delete-free-string string)
@@ -569,7 +577,7 @@ chords.  Returns a placement-list."
 (define-public (fret-letter-tablature-format
                 context string-number fret-number)
   (let ((labels (ly:context-property context 'fretLabels)))
-    (make-vcenter-markup
+    (make-translate-scaled-markup '(0 . -0.5)
      (cond
       ((= 0 (length labels))
        (string (integer->char (+ fret-number (char->integer #\a)))))
@@ -584,8 +592,25 @@ only ~a fret labels provided")
 ;; Display the fret number as a number
 (define-public (fret-number-tablature-format
                 context string-number fret-number)
-  (make-vcenter-markup
-   (format #f "~a" fret-number)))
+  (if (integer? fret-number)
+      (make-vcenter-markup
+        (format #f "~a" fret-number))
+      ;; for non-integer fret-number print p.e. "2½"
+      (let* ((whole-part (truncate fret-number))
+             (remaining (- fret-number whole-part))
+             (fret
+               (if (and (zero? whole-part) (not (zero? remaining)))
+                   ""
+                   (format #f "~a" whole-part)))
+             (frac
+               (if (zero? remaining)
+                   ""
+                   (format #f "~a" remaining))))
+        (make-concat-markup
+          (list (make-vcenter-markup fret)
+                (make-vcenter-markup
+                  ;; the value `-2.5' is my choice
+                  (make-fontsize-markup -2.5 frac)))))))
 
 ;; The 5-string banjo has got an extra string, the fifth (duh), which
 ;; starts at the fifth fret on the neck.  Frets on the fifth string
@@ -681,3 +706,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)