1 ;;;; translation-functions.scm --
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 1998--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
6 ;;;; Jan Nieuwenhuizen <janneke@gnu.org>
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
12 (define-public (format-metronome-markup text dur count context)
13 (let* ((hide-note (eq? #t (ly:context-property context 'tempoHideNote))))
14 (metronome-markup text dur count hide-note)))
16 (define-public (metronome-markup text dur count hide-note)
17 (let* ((note-mark (if (and (not hide-note) (ly:duration? dur))
19 (make-note-by-number-markup (ly:duration-log dur)
20 (ly:duration-dot-count dur)
23 (note-markup (if (and (not hide-note) (number? count) (> count 0) )
24 (make-concat-markup (list
25 (make-general-align-markup Y DOWN note-mark)
26 (make-simple-markup " ")
27 (make-simple-markup "=")
28 (make-simple-markup " ")
29 (make-simple-markup (number->string count))))
31 (text-markup (if (not (null? text))
32 (make-bold-markup text)
35 (if (and note-markup (not hide-note))
36 (make-line-markup (list text-markup
37 (make-concat-markup (list (make-simple-markup "(")
39 (make-simple-markup ")")))))
40 (make-line-markup (list text-markup)))
42 (make-line-markup (list note-markup))
43 (make-null-markup)))))
45 (define-public (format-mark-alphabet mark context)
46 (make-bold-markup (make-markalphabet-markup (1- mark))))
48 (define-public (format-mark-box-alphabet mark context)
49 (make-bold-markup (make-box-markup (make-markalphabet-markup (1- mark)))))
51 (define-public (format-mark-circle-alphabet mark context)
52 (make-bold-markup (make-circle-markup (make-markalphabet-markup (1- mark)))))
54 (define-public (format-mark-letters mark context)
55 (make-bold-markup (make-markletter-markup (1- mark))))
57 (define-public (format-mark-numbers mark context)
58 (make-bold-markup (number->string mark)))
60 (define-public (format-mark-barnumbers mark context)
61 (make-bold-markup (number->string (ly:context-property context 'currentBarNumber))))
63 (define-public (format-mark-box-letters mark context)
64 (make-bold-markup (make-box-markup (make-markletter-markup (1- mark)))))
66 (define-public (format-mark-circle-letters mark context)
67 (make-bold-markup (make-circle-markup (make-markletter-markup (1- mark)))))
69 (define-public (format-mark-box-numbers mark context)
70 (make-bold-markup (make-box-markup (number->string mark))))
72 (define-public (format-mark-circle-numbers mark context)
73 (make-bold-markup (make-circle-markup (number->string mark))))
75 (define-public (format-mark-box-barnumbers mark context)
76 (make-bold-markup (make-box-markup
77 (number->string (ly:context-property context 'currentBarNumber)))))
79 (define-public (format-mark-circle-barnumbers mark context)
80 (make-bold-markup (make-circle-markup
81 (number->string (ly:context-property context 'currentBarNumber)))))
84 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
87 (define-public (format-bass-figure figure event context)
88 (let* ((fig (ly:event-property event 'figure))
89 (fig-markup (if (number? figure)
91 ;; this is not very elegant, but center-aligning all digits
92 ;; is problematic with other markups, and shows problems
93 ;; in the (lack of) overshoot of feta alphabet glyphs.
96 (lambda (y) (make-translate-scaled-markup (cons -0.7 0) y))
100 ((eq? #t (ly:event-property event 'diminished))
101 (markup #:slashed-digit figure))
102 ((eq? #t (ly:event-property event 'augmented-slash))
103 (markup #:backslashed-digit figure))
104 (else (markup #:number (number->string figure 10)))))
107 (alt (ly:event-property event 'alteration))
111 #:general-align Y DOWN #:fontsize
112 (if (not (= alt DOUBLE-SHARP))
114 (alteration->text-accidental-markup alt))
117 (plus-markup (if (eq? #t (ly:event-property event 'augmented))
118 (markup #:number "+")
121 (alt-dir (ly:context-property context 'figuredBassAlterationDirection))
122 (plus-dir (ly:context-property context 'figuredBassPlusDirection))
125 (if (and (not fig-markup) alt-markup)
127 (set! fig-markup (markup #:left-align #:pad-around 0.3 alt-markup))
128 (set! alt-markup #f)))
131 ;; hmm, how to get figures centered between note, and
132 ;; lone accidentals too?
134 ;; (if (markup? fig-markup)
136 ;; fig-markup (markup #:translate (cons 1.0 0)
137 ;; #:center-align fig-markup)))
141 (markup #:put-adjacent
142 X (if (number? alt-dir)
146 #:pad-x 0.2 alt-markup
153 (markup #:put-adjacent
154 X (if (number? plus-dir)
158 #:pad-x 0.2 plus-markup)
161 (if (markup? fig-markup)
162 (markup #:fontsize -2 fig-markup)
168 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
171 (define-public (determine-frets context grob notes string-numbers)
173 (define (ensure-number a b)
178 (define (string-frets->dot-placement string-frets string-count)
181 (map (lambda (x) (list 'mute (1+ x)))
182 (iota string-count)))))
184 (for-each (lambda (sf)
195 (list 'place-fret string fret finger)
196 (list 'place-fret string fret))
200 (vector->list desc)))
202 (define (get-predefined-fretboard predefined-fret-table tuning pitches)
203 ; (_i "Search through @var{predefined-fret-table} looking for a predefined
204 ;fretboard with a key of @var{(tuning . pitches)}. The search will check
205 ;both up and down an octave in order to accomodate transposition of the
207 (define (get-fretboard key)
209 (hash-get-handle predefined-fret-table key)))
211 (cdr hash-handle) ; return table entry
214 (let ((test-fretboard (get-fretboard (cons tuning pitches))))
215 (if (not (null? test-fretboard))
217 (let ((test-fretboard
219 (cons tuning (map (lambda (x) (shift-octave x 1)) pitches)))))
220 (if (not (null? test-fretboard))
223 (cons tuning (map (lambda (x) (shift-octave x -1)) pitches))))))))
227 ((tunings (ly:context-property context 'stringTunings))
228 (my-string-count (length tunings))
229 (details (ly:grob-property grob 'fret-diagram-details))
231 (ly:context-property context 'predefinedDiagramTable))
232 (minimum-fret (ensure-number
233 (ly:context-property context 'minimumFret) 0))
234 (max-stretch (ensure-number
235 (ly:context-property context 'maximumFretStretch) 4))
236 (string-frets (determine-frets-mf notes string-numbers
237 minimum-fret max-stretch
239 (pitches (map (lambda (x) (ly:event-property x 'pitch)) notes)))
241 (set! (ly:grob-property grob 'fret-diagram-details)
244 (acons 'string-count (length tunings) '())
245 (acons 'string-count (length tunings) details)))
246 (set! (ly:grob-property grob 'dot-placement-list)
248 (let ((predefined-fretboard
249 (get-predefined-fretboard
253 (if (null? predefined-fretboard)
254 (string-frets->dot-placement
255 string-frets my-string-count) ;no predefined diagram
256 predefined-fretboard)) ;found default diagram
257 (string-frets->dot-placement string-frets my-string-count)))))
259 (define-public (determine-frets-mf notes string-numbers
260 minimum-fret max-stretch
263 (define (calc-fret pitch string tuning)
264 (- (ly:pitch-semitones pitch) (list-ref tuning (1- string))))
266 (define (note-pitch a)
267 (ly:event-property a 'pitch))
269 (define (note-pitch>? a b)
270 (ly:pitch<? (note-pitch b)
273 (define (note-finger ev)
274 (let* ((articulations (ly:event-property ev 'articulations))
279 ((num (ly:event-property art 'digit)))
281 (if (and (eq? 'fingering-event (ly:event-property art 'class))
283 (set! finger-found num))))
288 (define (note-string ev)
289 (let* ((articulations (ly:event-property ev 'articulations))
294 ((num (ly:event-property art 'string-number)))
297 (set! string-found num))))
302 (define (del-string string)
305 (delete string free-strings))))
306 (define specified-frets '())
307 (define free-strings '())
309 (define (close-enough fret)
314 (map (lambda (specced-fret)
315 (> max-stretch (abs (- fret specced-fret))))
319 (define (string-qualifies string pitch)
321 ((fret (calc-fret pitch string tunings)))
323 (and (>= fret minimum-fret)
328 (define string-fret-fingering-tuples '())
329 (define (set-fret note string)
330 (set! string-fret-fingering-tuples
332 (calc-fret (ly:event-property note 'pitch)
335 string-fret-fingering-tuples))
340 (set! specified-frets
341 (filter identity (map
343 (if (note-string note)
344 (calc-fret (note-pitch note)
345 (note-string note) tunings)
350 (set! free-strings (map 1+ (iota (length tunings))))
352 (for-each (lambda (note)
353 (del-string (note-string note)))
359 (if (note-string note)
360 (set-fret note (note-string note))
362 ((fit-string (find (lambda (string)
363 (string-qualifies string (note-pitch note)))
366 (set-fret note fit-string)
367 (ly:warning "No string for pitch ~a (given frets ~a)"
372 (sort notes note-pitch>?))
374 string-fret-fingering-tuples)
377 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
380 ;; The TabNoteHead tablatureFormat callback.
381 ;; Compute the text grob-property
382 (define-public (fret-number-tablature-format string context event)
383 (let* ((tuning (ly:context-property context 'stringTunings))
384 (pitch (ly:event-property event 'pitch))
389 (eq? 'harmonic-event (ly:event-property ev 'class)))
390 (ly:event-property event 'articulations)))))
392 (make-whiteout-markup
396 (- (ly:pitch-semitones pitch)
398 ;; remove 1 because list index starts at 0
399 ;;and guitar string at 1.
402 ;; The 5-string banjo has got a extra string, the fifth (duh), which
403 ;; starts at the fifth fret on the neck. Frets on the fifth string
404 ;; are referred to relative to the other frets:
405 ;; the "first fret" on the fifth string is really the sixth fret
406 ;; on the banjo neck.
407 ;; We solve this by defining a new fret-number-tablature function:
408 (define-public (fret-number-tablature-format-banjo string context event)
409 (let* ((tuning (ly:context-property context 'stringTunings))
410 (pitch (ly:event-property event 'pitch)))
412 (make-whiteout-markup
414 (let ((fret (- (ly:pitch-semitones pitch) (list-ref tuning (1- string)))))
415 (number->string (cond
416 ((and (> fret 0) (= string 5))
421 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
424 (define-public ((every-nth-bar-number-visible n) barnum)
425 (= 0 (modulo barnum n)))
427 (define-public ((modulo-bar-number-visible n m) barnum)
428 (and (> barnum 1) (= m (modulo barnum n))))
430 (define-public ((set-bar-number-visibility n) tr)
431 (let ((bn (ly:context-property tr 'currentBarNumber)))
432 (ly:context-set-property! tr 'barNumberVisibility
433 (modulo-bar-number-visible n (modulo bn n)))))
435 (define-public (first-bar-number-invisible barnum) (> barnum 1))
437 (define-public (all-bar-numbers-visible barnum) #t)
440 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
441 ;; percent repeat counters
443 (define-public ((every-nth-repeat-count-visible n) count context)
444 (= 0 (modulo count n)))
446 (define-public (all-repeat-counts-visible count context) #t)