(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)
(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))
;; 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
(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)))
(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)
projects / lilypond.git / blobdiff