1 ;;;; output-lib.scm -- implement Scheme output helper functions
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 1998--2006 Jan Nieuwenhuizen <janneke@gnu.org>
6 ;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
9 ;;; Tablature functions, by Jiba (jiba@tuxfamily.org)
11 ;; The TabNoteHead stem attachment function.
12 (define (note-head::calc-tablature-stem-attachment grob)
15 ;; The TabNoteHead tablatureFormat callback.
16 ;; Compute the text grob-property
17 (define-public (fret-number-tablature-format string tuning pitch)
21 (- (ly:pitch-semitones pitch)
23 ;; remove 1 because list index starts at 0 and guitar string at 1.
26 ;; The 5-string banjo has got a extra string, the fifth (duh), wich
27 ;; starts at the fifth fret on the neck. Frets on the fifth string
28 ;; are referred to relative to the other frets:
29 ;; the "first fret" on the fifth string is really the sixth fret
31 ;; We solve this by defining a new fret-number-tablature function:
32 (define-public (fret-number-tablature-format-banjo string tuning pitch)
35 (let ((fret (- (ly:pitch-semitones pitch) (list-ref tuning (- string 1)))))
37 ((and (> fret 0) (= string 5))
42 ; default tunings for common string instruments
43 (define-public guitar-tuning '(4 -1 -5 -10 -15 -20))
44 (define-public guitar-open-g-tuning '(2 -1 -5 -10 -17 -22))
45 (define-public bass-tuning '(-17 -22 -27 -32))
46 (define-public mandolin-tuning '(16 9 2 -5))
48 ;; tunings for 5-string banjo
49 (define-public banjo-open-g-tuning '(2 -1 -5 -10 7))
50 (define-public banjo-c-tuning '(2 -1 -5 -12 7))
51 (define-public banjo-modal-tuning '(2 0 -5 -10 7))
52 (define-public banjo-open-d-tuning '(2 -3 -6 -10 9))
53 (define-public banjo-open-dm-tuning '(2 -3 -6 -10 9))
54 ;; convert 5-string banjo tuning to 4-string by removing the 5th string
55 (define-public (four-string-banjo tuning)
56 (reverse (cdr (reverse tuning))))
58 ;;; end of tablature functions
60 (define-public (make-stencil-boxer thickness padding callback)
62 "Return function that adds a box around the grob passed as argument."
65 (box-stencil (callback grob) thickness padding)))
67 (define-public (make-stencil-circler thickness padding callback)
68 "Return function that adds a circle around the grob passed as argument."
69 (lambda (grob) (circle-stencil (callback grob) thickness padding)))
71 (define-public (arg->string arg)
72 (cond ((number? arg) (ly:inexact->string arg 10))
73 ((string? arg) (string-append "\"" arg "\""))
74 ((symbol? arg) (string-append "\"" (symbol->string arg) "\""))))
76 (define-public (print-circled-text-callback grob)
77 (let* ((text (ly:grob-property grob 'text))
79 (layout (ly:grob-layout grob))
80 (defs (ly:output-def-lookup layout 'text-font-defaults))
81 (props (ly:grob-alist-chain grob defs))
82 (circle (ly:text-interface::interpret-markup
83 layout props (make-circle-markup text))))
87 ;;(define (mm-to-pt x)
88 ;; (* (/ 72.27 25.40) x))
90 ;; do nothing in .scm output
92 (define-public (ly:numbers->string lst)
93 (string-join (map ly:number->string lst) " "))
95 (define (number->octal-string x)
96 (let* ((n (inexact->exact x))
98 (n8 (quotient (- n (* n64 64)) 8)))
102 (number->string (remainder (- n (+ (* n64 64) (* n8 8))) 8)))))
104 (define-public (ly:inexact->string x radix)
105 (let ((n (inexact->exact x)))
106 (number->string n radix)))
108 (define-public (ly:number-pair->string c)
109 (string-append (ly:number->string (car c)) " "
110 (ly:number->string (cdr c))))
114 (define-public (note-head::calc-glyph-name grob)
116 ((style (ly:grob-property grob 'style))
117 (log (min 2 (ly:grob-property grob 'duration-log))))
120 ((xcircle) "2xcircle")
121 ((harmonic) "0harmonic")
123 ;; Oops, I actually would not call this "baroque", but, for
124 ;; backwards compatibility to 1.4, this is supposed to take
125 ;; brevis, longa and maxima from the neo-mensural font and all
126 ;; other note heads from the default font. -- jr
128 (string-append (number->string log) "neomensural")
129 (number->string log)))
131 (string-append (number->string log) (symbol->string style)))
134 (string-append (number->string log) "mensural")
135 (string-append (number->string log) (symbol->string style))))
137 (string-append (number->string log) (symbol->string style)))
139 ;; The default font in mf/feta-bolletjes.mf defines a brevis, but
140 ;; neither a longa nor a maxima. Hence let us, for the moment,
141 ;; take these from the neo-mensural font. TODO: mf/feta-bolletjes
142 ;; should define at least a longa for the default font. The longa
143 ;; should look exactly like the brevis of the default font, but
144 ;; with a stem exactly like that of the quarter note. -- jr
146 (string-append (number->string log) "neomensural")
147 (number->string log)))
149 (if (string-match "vaticana*|hufnagel*|medicaea*" (symbol->string style))
150 (symbol->string style)
151 (string-append (number->string (max 0 log))
152 (symbol->string style)))))))
154 ;; TODO junk completely?
155 (define (note-head-style->attachment-coordinates grob axis)
156 "Return pair (X . Y), containing multipliers for the note head
157 bounding box, where to attach the stem. e.g.: X==0 means horizontally
158 centered, X==1 is at the right, X == -1 is at the left."
162 (define-public (string-encode-integer i)
165 ((< i 0) (string-append "n" (string-encode-integer (- i))))
167 (make-string 1 (integer->char (+ 65 (modulo i 26))))
168 (string-encode-integer (quotient i 26))))))
170 (define-public ((every-nth-bar-number-visible n) barnum) (= 0 (modulo barnum n)))
172 (define-public ((modulo-bar-number-visible n m) barnum) (and (> barnum 1) (= m (modulo barnum n))))
174 (define-public ((set-bar-number-visibility n) tr)
175 (let* ((bn (ly:context-property tr 'currentBarNumber)))
176 (ly:context-set-property! tr 'barNumberVisibility (modulo-bar-number-visible n (modulo bn n)))))
178 (define-public (first-bar-number-invisible barnum) (> barnum 1))
180 ;; See documentation of ly:item::visibility-lambda-
181 (define-public begin-of-line-visible
183 (define-public end-of-line-visible
185 (define-public end-of-line-invisible
187 (define-public spanbar-begin-of-line-invisible
189 (define-public all-visible #(#t #t #t))
190 (define-public all-invisible #(#f #f #f))
191 (define-public begin-of-line-invisible
193 (define-public center-invisible #(#t #f #t))
195 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
199 ;; How should a bar line behave at a break?
201 ;; Why prepend `default-' to every scm identifier?
202 (define-public (bar-line::calc-glyph-name grob)
204 (glyph (ly:grob-property grob 'glyph))
205 (dir (ly:item-break-dir grob))
207 '((":|:" . (":|" . "|:"))
208 ("||:" . ("||" . "|:"))
210 ("||:" . ("||" . "|:"))
212 ("|:" . ("|" . "|:"))
215 ;; hmm... should we end with a bar line here?
216 (".|" . ("|" . ".|"))
219 (".|." . (".|." . ()))
223 ("empty" . (() . ()))
224 ("brace" . (() . "brace"))
225 ("bracket" . (() . "bracket")) )))
226 (glyph-name (if (= dir CENTER)
228 (if (and result (string? (index-cell (cdr result) dir)))
229 (index-cell (cdr result) dir)
234 (ly:grob-suicide! grob))
239 (define-public (shift-right-at-line-begin g)
240 "Shift an item to the right, but only at the start of the line."
241 (if (and (ly:item? g)
242 (equal? (ly:item-break-dir g) RIGHT))
243 (ly:grob-translate-axis! g 3.5 X)))
246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
249 (define-public (tuplet-number::calc-denominator-text grob)
251 ((mus (ly:grob-property grob 'cause)))
253 (number->string (ly:music-property mus 'denominator))))
256 (define-public (tuplet-number::calc-fraction-text grob)
258 ((mus (ly:grob-property grob 'cause)))
260 (ly:music-property mus 'denominator)
261 (ly:music-property mus 'numerator))))
263 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
266 (define-public color? list?)
269 (define-public black '(0.0 0.0 0.0))
270 (define-public white '(1.0 1.0 1.0))
271 (define-public red '(1.0 0.0 0.0))
272 (define-public green '(0.0 1.0 0.0))
273 (define-public blue '(0.0 0.0 1.0))
274 (define-public cyan '(0.0 1.0 1.0))
275 (define-public magenta '(1.0 0.0 1.0))
276 (define-public yellow '(1.0 1.0 0.0))
278 (define-public grey '(0.5 0.5 0.5))
279 (define-public darkred '(0.5 0.0 0.0))
280 (define-public darkgreen '(0.0 0.5 0.0))
281 (define-public darkblue '(0.0 0.0 0.5))
282 (define-public darkcyan '(0.0 0.5 0.5))
283 (define-public darkmagenta '(0.5 0.0 0.5))
284 (define-public darkyellow '(0.5 0.5 0.0))
286 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
287 ;; * Pitch Trill Heads
290 (define (parenthesize-elements grob . rest)
293 (refp (if (null? rest)
296 (elts (ly:grob-object grob 'elements))
297 (x-ext (ly:relative-group-extent elts refp X))
299 (font (ly:grob-default-font grob))
300 (lp (ly:font-get-glyph font "accidentals.leftparen"))
301 (rp (ly:font-get-glyph font "accidentals.rightparen"))
302 (padding (ly:grob-property grob 'padding 0.1)))
305 (ly:stencil-translate-axis lp (- (car x-ext) padding) X)
306 (ly:stencil-translate-axis rp (+ (cdr x-ext) padding) X))
310 (define (parentheses-item::print me)
312 ((elts (ly:grob-object me 'elements))
313 (y-ref (ly:grob-common-refpoint-of-array me elts Y))
314 (x-ref (ly:grob-common-refpoint-of-array me elts X))
315 (stencil (parenthesize-elements me x-ref))
316 (elt-y-ext (ly:relative-group-extent elts y-ref Y))
317 (y-center (interval-center elt-y-ext)))
319 (ly:stencil-translate
323 (ly:grob-relative-coordinate me x-ref X))
326 (ly:grob-relative-coordinate me y-ref Y))))
332 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
335 (define-public (chain-grob-member-functions grob value . funcs)
338 (set! value (func grob value)))
343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
346 (define-public (fall::print spanner)
348 ((delta (ly:grob-property spanner 'delta-position))
349 (left-span (ly:spanner-bound spanner LEFT))
350 (right-span (ly:spanner-bound spanner RIGHT))
351 (thickness (* (ly:grob-property spanner 'thickness)
352 (ly:output-def-lookup (ly:grob-layout spanner) 'line-thickness)))
353 (padding (ly:grob-property spanner 'padding 0.5))
354 (common (ly:grob-common-refpoint right-span
355 (ly:grob-common-refpoint spanner
358 (left-x (+ padding (interval-end (ly:grob-robust-relative-extent left-span common X))))
359 (right-x (- (interval-start (ly:grob-robust-relative-extent right-span common X)) padding))
360 (self-x (ly:grob-relative-coordinate spanner common X))
361 (dx (- right-x left-x))
362 (exp (list 'path thickness