1 %%% markup.ily -- generic markup commands
3 %%% Author: Nicolas Sceaux <nicolas.sceaux@free.fr>
8 %%% like \hspace, but for vertical space
10 %%% \smallCaps <string>
11 %%% like built-in \smallCaps, but dealing with accented letters
13 %%% \when-property <symbol> <markup>
14 %%% if symbol is find in properties, interpret the markup
15 %%% otherwise, return an empty stencil
17 %%% \line-width-ratio <ratio> <markup>
18 %%% interpret markup with a line-width set to current line-width * ratio
21 %%% build a copyight line, using the maintainer and copyrightYear
24 %%% \wordwrap-center <markup-list>
25 %%% like wordwrap, but center align the lines
27 %%% Markup lines commands
28 %%% =====================
29 %%% \wordwrap-center-lines <markup-list>
30 %%% make a markup list composed centered lines of text.
32 %%% Redefinition of \column, \justify and \wordwrap
33 %%% to fix spacing around blocks
34 #(define-markup-command (column layout props args) (markup-list?)
35 #:properties ((baseline-skip))
36 (let ((arg-stencils (interpret-markup-list layout props args)))
37 (stack-lines DOWN 0.0 0
38 (space-lines baseline-skip
39 (remove ly:stencil-empty? arg-stencils)))))
41 #(define-markup-command (justify layout props args)
43 #:properties ((baseline-skip)
44 wordwrap-internal-markup-list)
47 (space-lines baseline-skip
48 (wordwrap-internal-markup-list layout props #t args))))
50 #(define-markup-command (wordwrap layout props args)
52 #:properties ((baseline-skip)
53 wordwrap-internal-markup-list)
56 (space-lines baseline-skip
57 (wordwrap-internal-markup-list layout props #f args))))
62 #(define-markup-command (vspace layout props amount) (number?)
63 "This produces a invisible object taking vertical space."
64 (let ((amount (* amount 3.0)))
66 (ly:make-stencil "" (cons -1 1) (cons 0 amount))
67 (ly:make-stencil "" (cons -1 1) (cons amount amount)))))
69 #(define-markup-command (copyright layout props) ()
70 (let* ((maintainer (chain-assoc-get 'header:maintainer props))
71 (this-year (+ 1900 (tm:year (gmtime (current-time)))))
72 (year (string->number (or (chain-assoc-get 'header:copyrightYear props)
73 (number->string this-year)))))
74 (interpret-markup layout props
76 (if (= year this-year)
77 (format #f "~a" this-year)
78 (format #f "~a-~a" year this-year))
81 #(define-markup-command (today layout props) ()
82 (let ((today (gmtime (current-time))))
83 (interpret-markup layout props
85 (+ 1900 (tm:year today))
89 #(define-markup-command (today-french layout props) ()
90 (let* ((date (gmtime (current-time)))
91 (months '#("janvier" "février" "mars" "avril"
92 "mai" "juin" "juillet" "août"
93 "septembre" "octobre" "novembre"
95 (day (if (= (tm:mday date) 1)
96 (markup (#:concat ("1" #:super "er")))
97 (number->string (tm:mday date))))
98 (month (vector-ref months (tm:mon date)))
99 (year (number->string (+ 1900 (tm:year date)))))
101 layout props (markup day month year))))
103 #(define-markup-command (when-property layout props symbol markp) (symbol? markup?)
104 (if (chain-assoc-get symbol props)
105 (interpret-markup layout props markp)
106 (ly:make-stencil '() '(1 . -1) '(1 . -1))))
108 #(define-markup-command (apply-fromproperty layout props fn symbol)
110 (let ((m (chain-assoc-get symbol props)))
112 (interpret-markup layout props (fn m))
115 #(define-markup-command (line-width-ratio layout props width-ratio arg)
120 #`(line-width . ,(* width-ratio
121 (or (chain-assoc-get 'line-width props)
122 (ly:output-def-lookup layout 'line-width))))
125 #(define-markup-list-command (line-width-ratio-lines layout props width-ratio args)
126 (number? markup-list?)
127 (interpret-markup-list layout props
128 (make-override-lines-markup-list
129 (cons 'line-width (* width-ratio
130 (chain-assoc-get 'line-width props)))
133 #(define-markup-list-command (with-line-width-ratio layout props width-ratio args)
134 (number? markup-list?)
135 (let* ((line-width (chain-assoc-get 'line-width props))
136 (new-line-width (* width-ratio line-width))
137 (indent (* 0.5 (- line-width new-line-width)))
138 (stencils (interpret-markup-list layout
139 (cons `((line-width . ,new-line-width)) props)
141 (interpret-markup-list layout props
142 (map (lambda (stencil)
143 (markup #:hspace indent #:stencil stencil))
146 #(define-markup-command (force-line-width-ratio layout props ratio arg)
148 (let* ((new-line-width (* ratio (chain-assoc-get 'line-width props)))
149 (line-stencil (interpret-markup layout props
150 (markup #:override (cons 'line-width new-line-width)
154 (interval-length (ly:stencil-extent line-stencil X))))))
155 (interpret-markup layout props (markup #:concat (#:stencil line-stencil #:hspace gap)))))
157 #(define-markup-list-command (two-column-lines layout props col1 col2)
158 (markup-list? markup-list?)
159 (interpret-markup-list layout props
160 (make-column-lines-markup-list
162 (let map-on-lists ((col1 col1)
164 (if (and (null? col1) (null? col2))
166 (let ((line-col1 (if (null? col1) "" (car col1)))
167 (line-col2 (if (null? col2) "" (car col2)))
168 (rest-col1 (if (null? col1) '() (cdr col1)))
169 (rest-col2 (if (null? col2) '() (cdr col2))))
173 #:force-line-width-ratio 0.45 line-col1
175 #:force-line-width-ratio 0.45 line-col2
178 (map-on-lists rest-col1 rest-col2))))))))
180 #(define-markup-command (tacet-lyrics layout props score text)
181 (markup? markup-list?)
182 #:properties ((column-number 2))
186 \fontsize #-2 \override #`(column-number . ,column-number)
187 \column\page-columns {
188 \fontsize #2 \line { \hspace #10 Tacet $score }
194 #(define-markup-command (tacet layout props num) (number?)
195 (let ((score (ly:make-score
198 'elements (list (make-music
199 'MultiMeasureRestMusic
200 'duration (ly:make-duration 0 0 num))
203 'context-type 'Timing
207 'symbol 'whichBar)))))))
208 (ly:score-add-output-def! score #{ \layout {
211 \context { \Score skipBars = ##t }
214 \remove "Time_signature_engraver"
215 \remove "Clef_engraver"
216 \override StaffSymbol.line-count = #1
217 \override StaffSymbol.transparent = ##t
218 \override MultiMeasureRest #'expand-limit = #2
223 #{ \markup { \hspace #10 Tacet $(make-score-markup score) } #})))
225 #(define-markup-command (lyrics layout props text)
227 #:properties ((column-number 2))
231 \fontsize #-2 \override #`(column-number . ,column-number)
232 \column\page-columns { $text } } #}))
234 #(define-markup-list-command (indented-lines layout props indent args)
235 (number? markup-list?)
236 (let* ((new-line-width (- (chain-assoc-get 'line-width props) indent))
237 (lines (interpret-markup-list layout
238 (cons `((line-width . ,new-line-width)) props)
240 (interpret-markup-list layout props
242 (markup #:hspace indent #:stencil line))
245 #(define-markup-list-command (wordwrap-center-lines layout props args)
247 (map (lambda (stencil)
248 (interpret-markup layout props (markup #:fill-line (#:stencil stencil))))
249 (interpret-markup-list layout props (make-wordwrap-lines-markup-list args))))
251 #(define-markup-list-command (centered-lines layout props args)
253 (let ((baseline-skip (chain-assoc-get 'baseline-skip props)))
254 (space-lines baseline-skip
255 (interpret-markup-list layout props
256 (map (lambda (arg) (markup #:fill-line (arg)))
259 #(define-markup-list-command (fontsize-lines layout props increment args)
260 (number? markup-list?)
261 #:properties ((font-size 0)
264 (interpret-markup-list layout
265 (cons `((baseline-skip . ,(* baseline-skip (magstep increment)))
266 (word-space . ,(* word-space (magstep increment)))
267 (font-size . ,(+ font-size increment)))
271 #(define-markup-list-command (abs-fontsize-lines layout props size args)
272 (number? markup-list?)
273 (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
274 (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
275 (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
276 (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
277 (magnification (/ size ref-size)))
278 (interpret-markup-list layout
279 (cons `((baseline-skip . ,(* magnification ref-baseline))
280 (word-space . ,(* magnification ref-word-space))
281 (font-size . ,(magnification->font-size magnification)))
285 #(define-markup-command (wordwrap-center layout props args) (markup-list?)
286 (interpret-markup layout props
288 (make-wordwrap-center-lines-markup-list args))))
290 #(define (page-ref-aux layout props label gauge next)
291 (let* ((gauge-stencil
292 (interpret-markup layout props
293 (make-concat-markup (list gauge next))))
294 (x-ext (ly:stencil-extent gauge-stencil X))
295 (y-ext (ly:stencil-extent gauge-stencil Y)))
297 `(delay-stencil-evaluation
298 ,(delay (ly:stencil-expr
299 (let* ((table (ly:output-def-lookup layout 'label-page-table))
300 (label-page (and (list? table) (assoc label table)))
301 (page-number (and label-page (cdr label-page)))
302 (page-markup (if page-number
303 (markup #:page-link page-number
304 #:concat ((format "~a" page-number)
306 (markup #:concat ("?" next))))
307 (page-stencil (interpret-markup layout props page-markup))
308 (gap (- (interval-length x-ext)
309 (interval-length (ly:stencil-extent page-stencil X)))))
310 (interpret-markup layout props
311 (markup #:concat (page-markup #:hspace gap)))))))
315 #(define-markup-command (page-refI layout props label next)
317 (page-ref-aux layout props label "0" next))
319 #(define-markup-command (page-refII layout props label next)
321 (page-ref-aux layout props label "00" next))
323 #(define-markup-command (page-refIII layout props label next)
325 (page-ref-aux layout props label "000" next))
327 #(define-markup-command (super layout props arg) (markup?)
328 (ly:stencil-translate-axis
331 (cons `((font-size . ,(- (chain-assoc-get 'font-size props 0) 3))) props)
333 (* 0.25 (chain-assoc-get 'baseline-skip props))
336 #(define-markup-list-command (paragraph layout props text) (markup-list?)
337 (let ((indentation (markup #:pad-to-box (cons 0 3) (cons 0 0) #:null)))
338 (interpret-markup-list layout props
339 (make-justified-lines-markup-list (cons indentation text)))))
341 #(define-markup-list-command (columns paper props text) (markup-list?)
342 (interpret-markup-list paper props
343 (make-column-lines-markup-list text)))
345 #(define-markup-command (separation-line layout props width) (number?)
346 (interpret-markup layout props
347 (markup #:fill-line (#:draw-line (cons (/ (* 20 width) (*staff-size*)) 0)))))
349 #(define-markup-command (sep layout props) ()
350 (interpret-markup layout props
351 (markup #:pad-around 1 #:fill-line (#:draw-line '(50 . 0)))))
353 #(define-markup-command (boxed-justify layout props text) (markup-list?)
354 (interpret-markup layout props
355 (make-override-markup '(box-padding . 1)
358 (make-justified-lines-markup-list text))))))
360 #(define-markup-command (after-system layout props arg) (markup?)
361 (let ((stencil (interpret-markup layout props arg)))
362 (ly:make-stencil (ly:stencil-expr (ly:stencil-aligned-to stencil Y DOWN))
363 (ly:stencil-extent stencil X)
366 %%% Guile does not deal with accented letters
367 #(use-modules (ice-9 regex))
368 %%;; actually defined below, in a closure
369 #(define-public string-upper-case #f)
370 #(define accented-char-upper-case? #f)
371 #(define accented-char-lower-case? #f)
373 %%;; an accented character is seen as two characters by guile
374 #(let ((lower-case-accented-string "éèêëáàâäíìîïóòôöúùûüçœæ")
375 (upper-case-accented-string "ÉÈÊËÁÀÂÄÍÌÎÏÓÒÔÖÚÙÛÜÇŒÆ"))
376 (define (group-by-2 chars result)
377 (if (or (null? chars) (null? (cdr chars)))
379 (group-by-2 (cddr chars)
380 (cons (string (car chars) (cadr chars))
382 (let ((lower-case-accented-chars
383 (group-by-2 (string->list lower-case-accented-string) (list)))
384 (upper-case-accented-chars
385 (group-by-2 (string->list upper-case-accented-string) (list))))
386 (set! string-upper-case
388 (define (replace-chars str froms tos)
391 (replace-chars (regexp-substitute/global #f (car froms) str
392 'pre (car tos) 'post)
395 (string-upcase (replace-chars str
396 lower-case-accented-chars
397 upper-case-accented-chars))))
398 (set! accented-char-upper-case?
399 (lambda (char1 char2)
400 (member (string char1 char2) upper-case-accented-chars string=?)))
401 (set! accented-char-lower-case?
402 (lambda (char1 char2)
403 (member (string char1 char2) lower-case-accented-chars string=?)))))
405 #(define-markup-command (smallCaps layout props text) (markup?)
406 "Turn @code{text}, which should be a string, to small caps.
408 \\markup \\small-caps \"Text between double quotes\"
410 (define (string-list->markup strings lower)
411 (let ((final-string (string-upper-case
412 (apply string-append (reverse strings)))))
414 (markup #:fontsize -2 final-string)
416 (define (make-small-caps rest-chars currents current-is-lower prev-result)
417 (if (null? rest-chars)
418 (make-concat-markup (reverse! (cons (string-list->markup
419 currents current-is-lower)
421 (let* ((ch1 (car rest-chars))
422 (ch2 (and (not (null? (cdr rest-chars))) (cadr rest-chars)))
423 (this-char-string (string ch1))
424 (is-lower (char-lower-case? ch1))
425 (next-rest-chars (cdr rest-chars)))
426 (cond ((and ch2 (accented-char-lower-case? ch1 ch2))
427 (set! this-char-string (string ch1 ch2))
429 (set! next-rest-chars (cddr rest-chars)))
430 ((and ch2 (accented-char-upper-case? ch1 ch2))
431 (set! this-char-string (string ch1 ch2))
433 (set! next-rest-chars (cddr rest-chars))))
434 (if (or (and current-is-lower is-lower)
435 (and (not current-is-lower) (not is-lower)))
436 (make-small-caps next-rest-chars
437 (cons this-char-string currents)
440 (make-small-caps next-rest-chars
441 (list this-char-string)
445 (cons (string-list->markup
446 currents current-is-lower)
448 (interpret-markup layout props
450 (make-small-caps (string->list text) (list) #f (list))
453 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
454 %%% Character lists, inline quoted scores, etc.
457 #(define-music-function (parser location bar-num) (number?)
458 #{ \override Score.BarNumber #'break-visibility = #'#(#f #f #t)
460 \set Score.currentBarNumber = #bar-num #})
463 \override Score.StaffSymbol #'staff-space = #(magstep -3)
464 \set Score . fontSize = #-3
467 quoteLayout = \layout {
470 \context { \Staff \remove "Time_signature_engraver" }
471 \context { \Voice \override Script #'avoid-slur = #'outside }
474 \override StaffGrouper.staff-staff-spacing.basic-distance = #1
475 \override BarNumber.break-visibility = #'#(#f #f #t)
479 tinyLayout = \layout {
482 \override StaffSymbol #'staff-space = #(magstep -2)
485 \context { \FiguredBass \override BassFigure.font-size = #-2 }
488 tinyQuoteLayout = \layout {
492 \override StaffSymbol #'staff-space = #(magstep -3)
495 \context { \FiguredBass \override BassFigure.font-size = #-3 }
498 quoteEmptyLayout = \layout {
501 \context { \Score skipBars = ##t }
504 \remove "Time_signature_engraver"
505 \remove "Clef_engraver"
506 \remove "Staff_symbol_engraver"
507 \override MultiMeasureRest #'expand-limit = #2
511 smallLayout = \layout {
513 \Staff fontSize = #-1
514 \override StaffSymbol.staff-space = #(magstep -1)
516 \context { \Lyrics fontSize = #-1 }
517 \context { \FiguredBass \override BassFigure.font-size = #-1 }
518 \context { \Voice \override Script.avoid-slur = #'outside }
519 \context { \CueVoice \override Script.avoid-slur = #'outside }
522 \override NonMusicalPaperColumn.line-break-permission = #'allow
523 \override NonMusicalPaperColumn.page-break-permission = #'allow
527 onlyNotesLayout = \layout {
531 \remove "Time_signature_engraver"
532 \remove "Clef_engraver"
533 \remove "Staff_symbol_engraver"
535 \context { \Score \remove "Bar_number_engraver" }
538 characterLayout = \layout {
540 line-width = #(if (eqv? #t (ly:get-option 'ancient-style))
546 \override Clef #'full-size-change = ##t
547 \remove "Bar_engraver"
551 \remove "Stem_engraver"
556 #(define-music-function (parser location clef1 clef2 low-note high-note)
557 (string? string? ly:music? ly:music?)
558 (let* ((low-pitch (ly:music-property low-note 'pitch))
559 (high-pitch (ly:music-property high-note 'pitch))
562 'elements (list (make-music
564 'duration (ly:make-duration 2 0 1 1)
568 'duration (ly:make-duration 2 0 1 1)
569 'pitch high-pitch)))))
570 (if (eqv? #t (ly:get-option 'ancient-style))
571 #{ \new Staff { \clef $clef1 $chord } #}
574 \set Staff.forceClef = ##t
575 \clef $clef2 s8. $chord s2
579 #(define-markup-command (character-ambitus layout props name ambitus)
581 #:properties ((character-width-ratio 16/20)
582 (ambitus-width-ratio 3/20))
586 (interpret-markup layout props
588 #:force-line-width-ratio ambitus-width-ratio
589 #:vcenter #:fill-line (#:null #:left-align ambitus)
591 #:force-line-width-ratio character-width-ratio
592 #:vcenter #:smallCaps name)))))
594 #(define-markup-command (character-two-columns layout props col1 col2)
596 #:properties ((word-space 0.6)
597 (character-width-ratio 10/30)
598 (ambitus-width-ratio 4/30))
602 \override #`(character-width-ratio . ,character-width-ratio)
603 \override #`(ambitus-width-ratio . ,ambitus-width-ratio)
606 \override #`(word-space . ,word-space) $col1
608 \override #`(word-space . ,word-space) $col2
612 #(define-markup-command (character-three-columns layout props col1 col2 col3)
613 (markup? markup? markup?)
614 #:properties ((word-space 0.6))
617 (markup (#:concat (#:override `(word-space . ,word-space) col1
619 #:override `(word-space . ,word-space) col2
621 #:override `(word-space . ,word-space) col3)))))
623 #(define-markup-command (sline layout props args) (markup-list?)
624 (interpret-markup layout props
625 (make-line-markup (cons (make-hspace-markup 4) args))))
628 #(define-markup-command (verse layout props syllab-count words)
629 (number? markup-list?)
632 (if (< syllab-count 12)
633 (make-line-markup (cons (make-hspace-markup (* 1.5 (- 12 syllab-count)))
635 (make-line-markup words))))
640 footnote-auto-numbering = ##t
641 footnote-numbering-function =
643 (markup #:small #:box (number->string (+ 1 num))))
644 footnote-separator-markup = \markup\override #'(span-factor . 1/4) \draw-hline
645 footnote-padding = 2\mm
646 footnote-footer-padding = 1\mm
649 #(define (make-footnote-here-music offset note)
650 (make-music 'FootnoteEvent
651 'X-offset (car offset)
652 'Y-offset (cdr offset)
653 'automatically-numbered #t
654 'text (make-null-markup)
655 'footnote-text note))
657 #(define-music-function (parser this-location offset note)
658 (number-pair? markup?)
660 #{ <>-\tweak footnote-music #(make-footnote-here-music offset note)
661 ^\markup\transparent\box "1" #})
664 #(define-music-function (parser this-location offset note)
665 (number-pair? markup?)
667 (if (symbol? (ly:get-option 'part))
668 (make-music 'Music 'void #t)
669 #{ <>-\tweak footnote-music #(make-footnote-here-music offset note)
670 ^\markup\transparent\box "1" #}))
672 footnoteHereNoSpace =
673 #(define-music-function (parser this-location offset note)
674 (number-pair? markup?)
676 #{ <>-\tweak footnote-music #(make-footnote-here-music offset note)
681 #(define-music-function (parser this-location text)
684 \once\override TextSpanner.bound-details.left.stencil-align-dir-y = #CENTER
685 \once\override TextSpanner.bound-details.left.text =
686 \markup\whiteout { $text \hspace #1 }
687 \once\override TextSpanner.bound-details.left-broken.text = \markup\transparent t %##f