;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; clefs
+
+(define-public (clef-transposition-markup oct style)
+ "The transposition sign formatting function. @var{oct} is supposed to be
+a string holding the transposition number, @var{style} determines the
+way the transposition number is displayed."
+ (let* ((delim (if (symbol? style)
+ (case style
+ ((parenthesized) (cons "(" ")"))
+ ((bracketed) (cons "[" "]"))
+ (else (cons "" "")))
+ (cons "" "")))
+ (text (string-concatenate (list (car delim) oct (cdr delim)))))
+
+ (make-vcenter-markup text)))
+
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; metronome marks
(length (filter (lambda (x) (not (null? x)))
art-list)))
+ (define (string-number event)
+ "Get the string-number from @var{event}. Return @var{#f}
+if no string-number is present."
+ (let ((num (ly:event-property event 'string-number)))
+ (and (integer? num) (positive? num) num)))
+
(define (determine-frets-and-strings
notes
defined-strings
(define (calc-fret pitch string tuning)
"Calculate the fret to play @var{pitch} on @var{string} with
@var{tuning}."
- (- (ly:pitch-semitones pitch) (ly:pitch-semitones (list-ref tuning (1- string)))))
+ (* 2 (- (ly:pitch-tones pitch) (ly:pitch-tones (list-ref tuning (1- string))))))
(define (note-pitch note)
"Get the pitch (in semitones) from @var{note}."
(map (lambda (art)
(let* ((num (ly:event-property art 'digit)))
- (if (and (eq? 'fingering-event (ly:event-property art 'class))
+ (if (and (ly:in-event-class? art 'fingering-event)
(number? num)
(> num 0))
(set! finger-found num))))
articulations)
finger-found))
- (define (string-number event)
- "Get the string-number from @var{event}. Return @var{#f}
-if no string-number is present."
- (let ((num (ly:event-property event 'string-number)))
- (if (number? num)
- num
- #f)))
-
(define (delete-free-string string)
(if (number? string)
(set! free-strings
(define (close-enough fret)
"Decide if @var{fret} is acceptable, given the already used frets."
- (if (null? specified-frets)
- #t
- (reduce
- (lambda (x y)
- (and x y))
- #t
- (map (lambda (specced-fret)
- (or (eq? 0 specced-fret)
- (and (not restrain-open-strings)
- (eq? 0 fret))
- (>= maximum-stretch (abs (- fret specced-fret)))))
- specified-frets))))
+ (every (lambda (specced-fret)
+ (or (zero? specced-fret)
+ (zero? fret)
+ (>= maximum-stretch (abs (- fret specced-fret)))))
+ specified-frets))
(define (string-qualifies string pitch)
"Can @var{pitch} be played on @var{string}, given already placed
notes?"
(let* ((fret (calc-fret pitch string tuning)))
(and (or (and (not restrain-open-strings)
- (eq? fret 0))
+ (zero? fret))
(>= fret minimum-fret))
+ (integer? fret)
(close-enough fret))))
(define (open-string string pitch)
"Is @var{pitch} and open-string note on @var{string}, given
the current tuning?"
(let* ((fret (calc-fret pitch string tuning)))
- (eq? fret 0)))
+ (zero? fret)))
(define (set-fret! pitch-entry string finger)
(let ((this-fret (calc-fret (car pitch-entry)
tuning)))
(if (< this-fret 0)
(ly:warning (_ "Negative fret for pitch ~a on string ~a")
- (car pitch-entry) string))
+ (car pitch-entry) string)
+ (if (not (integer? this-fret))
+ (ly:warning (_ "Missing fret for pitch ~a on string ~a")
+ (car pitch-entry) string)))
(delete-free-string string)
(set! specified-frets (cons this-fret specified-frets))
(list-set! string-fret-fingers
defined-strings defined-fingers))
;;; body of determine-frets-and-strings
- (let* ((pitch-alist (apply (lambda (mylist)
- (let ((index -1))
- (map (lambda (note)
- (begin
- (set! index (1+ index))
- (cons (note-pitch note)
- index)))
- mylist)))
- notes '()))
- (pitches (map note-pitch notes)))
+ (let* ((pitches (map note-pitch notes))
+ (pitch-alist (map cons pitches (iota (length pitches)))))
;; handle notes with strings assigned and fingering of 0
(for-each
(lambda (pitch-entry string-fret-finger)
(let* ((string (list-ref string-fret-finger 0))
- (finger (if (eq? (length string-fret-finger) 3)
+ (finger (if (= (length string-fret-finger) 3)
(list-ref string-fret-finger 2)
'()))
(pitch (car pitch-entry))
#f
finger)))
(if (or (not (null? string))
- (eq? digit 0))
- (if (eq? digit 0)
+ (eqv? digit 0))
+ (if (eqv? digit 0)
;; here we handle fingers of 0 -- open strings
(let ((fit-string
(find (lambda (string)
(ly:context-property context
'handleNegativeFrets
'recalculate)))
- (cond ((or (>= this-fret 0)
+ (cond ((or (and (>= this-fret 0) (integer? this-fret))
(eq? handle-negative 'include))
(set-fret! pitch-entry string finger))
((eq? handle-negative 'recalculate)
(let* ((string-fret-finger (list-ref string-fret-fingers
(cdr pitch-entry)))
(string (list-ref string-fret-finger 0))
- (finger (if (eq? (length string-fret-finger) 3)
+ (finger (if (= (length string-fret-finger) 3)
(list-ref string-fret-finger 2)
'()))
(pitch (car pitch-entry))
(defined-strings (map (lambda (x)
(if (null? x)
x
- (ly:event-property x 'string-number)))
+ (or (string-number x) '())))
(car specified-info)))
(defined-fingers (map (lambda (x)
(if (null? x)