]> git.donarmstrong.com Git - lilypond.git/blob - scm/define-markup-commands.scm
7a96dfa869592b9ec9f3434c6cae5d58fbe4829c
[lilypond.git] / scm / define-markup-commands.scm
1 ;;;; This file is part of LilyPond, the GNU music typesetter.
2 ;;;;
3 ;;;; Copyright (C) 2000--2011  Han-Wen Nienhuys <hanwen@xs4all.nl>
4 ;;;;                  Jan Nieuwenhuizen <janneke@gnu.org>
5 ;;;;
6 ;;;; LilyPond is free software: you can redistribute it and/or modify
7 ;;;; it under the terms of the GNU General Public License as published by
8 ;;;; the Free Software Foundation, either version 3 of the License, or
9 ;;;; (at your option) any later version.
10 ;;;;
11 ;;;; LilyPond is distributed in the hope that it will be useful,
12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 ;;;; GNU General Public License for more details.
15 ;;;;
16 ;;;; You should have received a copy of the GNU General Public License
17 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
18
19 ;;;
20 ;;; Markup commands and markup-list commands definitions.
21 ;;;
22 ;;; Markup commands which are part of LilyPond, are defined
23 ;;; in the (lily) module, which is the current module in this file,
24 ;;; using the `define-markup-command' macro.
25 ;;;
26 ;;; Usage:
27 ;;;
28 ;;; (define-markup-command (command-name layout props args...)
29 ;;;   args-signature
30 ;;;   [ #:category category ]
31 ;;;   [ #:properties property-bindings ]
32 ;;;   documentation-string
33 ;;;   ..body..)
34 ;;;
35 ;;; with:
36 ;;;   command-name
37 ;;;     the name of the markup command
38 ;;;
39 ;;;   layout and props
40 ;;;     arguments that are automatically passed to the command when it
41 ;;;     is interpreted.
42 ;;;     `layout' is an output def, which properties can be accessed
43 ;;;     using `ly:output-def-lookup'.
44 ;;;     `props' is a list of property settings which can be accessed
45 ;;;     using `chain-assoc-get' (more on that below)
46 ;;;
47 ;;;   args...
48 ;;;     the command arguments.
49 ;;;     There is no limitation on the order of command arguments.
50 ;;;     However, markup functions taking a markup as their last
51 ;;;     argument are somewhat special as you can apply them to a
52 ;;;     markup list, and the result is a markup list where the
53 ;;;     markup function (with the specified leading arguments) has
54 ;;;     been applied to every element of the original markup list.
55 ;;;
56 ;;;     Since replicating the leading arguments for applying a
57 ;;;     markup function to a markup list is cheap mostly for
58 ;;;     Scheme arguments, you avoid performance pitfalls by just
59 ;;;     using Scheme arguments for the leading arguments of markup
60 ;;;     functions that take a markup as their last argument.
61 ;;;
62 ;;;   args-signature
63 ;;;     the arguments signature, i.e. a list of type predicates which
64 ;;;     are used to type check the arguments, and also to define the general
65 ;;;     argument types (markup, markup-list, scheme) that the command is
66 ;;;     expecting.
67 ;;;     For instance, if a command expects a number, then a markup, the
68 ;;;     signature would be: (number? markup?)
69 ;;;
70 ;;;   category
71 ;;;     for documentation purpose, builtin markup commands are grouped by
72 ;;;     category. This can be any symbol. When documentation is generated,
73 ;;;     the symbol is converted to a capitalized string, where hyphens are
74 ;;;     replaced by spaces.
75 ;;;
76 ;;;   property-bindings
77 ;;;     this is used both for documentation generation, and to ease
78 ;;;     programming the command itself. It is list of
79 ;;;        (property-name default-value)
80 ;;;     or (property-name)
81 ;;;     elements. Each property is looked-up in the `props' argument, and
82 ;;;     the symbol naming the property is bound to its value.
83 ;;;     When the property is not found in `props', then the symbol is bound
84 ;;;     to the given default value. When no default value is given, #f is
85 ;;;     used instead.
86 ;;;     Thus, using the following property bindings:
87 ;;;       ((thickness 0.1)
88 ;;;        (font-size 0))
89 ;;;     is equivalent to writing:
90 ;;;       (let ((thickness (chain-assoc-get 'thickness props 0.1))
91 ;;;             (font-size (chain-assoc-get 'font-size props 0)))
92 ;;;         ..body..)
93 ;;;     When a command `B' internally calls an other command `A', it may
94 ;;;     desirable to see in `B' documentation all the properties and
95 ;;;     default values used by `A'. In that case, add `A-markup' to the
96 ;;;     property-bindings of B. (This is used when generating
97 ;;;     documentation, but won't create bindings.)
98 ;;;
99 ;;;   documentation-string
100 ;;;     the command documentation string (used to generate manuals)
101 ;;;
102 ;;;   body
103 ;;;     the command body. The function is supposed to return a stencil.
104 ;;;
105 ;;; Each markup command definition shall have a documentation string
106 ;;; with description, syntax and example.
107
108 (use-modules (ice-9 regex))
109
110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
111 ;; utility functions
112 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
113
114 (define-public empty-stencil (ly:make-stencil '() '(1 . -1) '(1 . -1)))
115 (define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0)))
116
117 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
118 ;; geometric shapes
119 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
120
121 (define-markup-command (draw-line layout props dest)
122   (number-pair?)
123   #:category graphic
124   #:properties ((thickness 1))
125   "
126 @cindex drawing lines within text
127
128 A simple line.
129 @lilypond[verbatim,quote]
130 \\markup {
131   \\draw-line #'(4 . 4)
132   \\override #'(thickness . 5)
133   \\draw-line #'(-3 . 0)
134 }
135 @end lilypond"
136   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
137                thickness))
138         (x (car dest))
139         (y (cdr dest)))
140     (make-line-stencil th 0 0 x y)))
141
142 (define-markup-command (draw-circle layout props radius thickness filled)
143   (number? number? boolean?)
144   #:category graphic
145   "
146 @cindex drawing circles within text
147
148 A circle of radius @var{radius} and thickness @var{thickness},
149 optionally filled.
150
151 @lilypond[verbatim,quote]
152 \\markup {
153   \\draw-circle #2 #0.5 ##f
154   \\hspace #2
155   \\draw-circle #2 #0 ##t
156 }
157 @end lilypond"
158   (make-circle-stencil radius thickness filled))
159
160 (define-markup-command (triangle layout props filled)
161   (boolean?)
162   #:category graphic
163   #:properties ((thickness 0.1)
164                 (font-size 0)
165                 (baseline-skip 2))
166   "
167 @cindex drawing triangles within text
168
169 A triangle, either filled or empty.
170
171 @lilypond[verbatim,quote]
172 \\markup {
173   \\triangle ##t
174   \\hspace #2
175   \\triangle ##f
176 }
177 @end lilypond"
178   (let ((ex (* (magstep font-size) 0.8 baseline-skip)))
179     (ly:make-stencil
180      `(polygon '(0.0 0.0
181                      ,ex 0.0
182                      ,(* 0.5 ex)
183                      ,(* 0.86 ex))
184            ,thickness
185            ,filled)
186      (cons 0 ex)
187      (cons 0 (* .86 ex)))))
188
189 (define-markup-command (circle layout props arg)
190   (markup?)
191   #:category graphic
192   #:properties ((thickness 1)
193                 (font-size 0)
194                 (circle-padding 0.2))
195   "
196 @cindex circling text
197
198 Draw a circle around @var{arg}.  Use @code{thickness},
199 @code{circle-padding} and @code{font-size} properties to determine line
200 thickness and padding around the markup.
201
202 @lilypond[verbatim,quote]
203 \\markup {
204   \\circle {
205     Hi
206   }
207 }
208 @end lilypond"
209   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
210                thickness))
211          (pad (* (magstep font-size) circle-padding))
212          (m (interpret-markup layout props arg)))
213     (circle-stencil m th pad)))
214
215 (define-markup-command (with-url layout props url arg)
216   (string? markup?)
217   #:category graphic
218   "
219 @cindex inserting URL links into text
220
221 Add a link to URL @var{url} around @var{arg}.  This only works in
222 the PDF backend.
223
224 @lilypond[verbatim,quote]
225 \\markup {
226   \\with-url #\"http://lilypond.org/web/\" {
227     LilyPond ... \\italic {
228       music notation for everyone
229     }
230   }
231 }
232 @end lilypond"
233   (let* ((stil (interpret-markup layout props arg))
234          (xextent (ly:stencil-extent stil X))
235          (yextent (ly:stencil-extent stil Y))
236          (old-expr (ly:stencil-expr stil))
237          (url-expr (list 'url-link url `(quote ,xextent) `(quote ,yextent))))
238
239     (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
240
241 (define-markup-command (beam layout props width slope thickness)
242   (number? number? number?)
243   #:category graphic
244   "
245 @cindex drawing beams within text
246
247 Create a beam with the specified parameters.
248 @lilypond[verbatim,quote]
249 \\markup {
250   \\beam #5 #1 #2
251 }
252 @end lilypond"
253   (let* ((y (* slope width))
254          (yext (cons (min 0 y) (max 0 y)))
255          (half (/ thickness 2)))
256
257     (ly:make-stencil
258      `(polygon ',(list
259                   0 (/ thickness -2)
260                     width (+ (* width slope)  (/ thickness -2))
261                     width (+ (* width slope)  (/ thickness 2))
262                     0 (/ thickness 2))
263                ,(ly:output-def-lookup layout 'blot-diameter)
264                #t)
265      (cons 0 width)
266      (cons (+ (- half) (car yext))
267            (+ half (cdr yext))))))
268
269 (define-markup-command (underline layout props arg)
270   (markup?)
271   #:category font
272   #:properties ((thickness 1) (offset 2))
273   "
274 @cindex underlining text
275
276 Underline @var{arg}.  Looks at @code{thickness} to determine line
277 thickness, and @code{offset} to determine line y-offset.
278
279 @lilypond[verbatim,quote]
280 \\markup \\fill-line {
281   \\underline \"underlined\"
282   \\override #'(offset . 5)
283   \\override #'(thickness . 1)
284   \\underline \"underlined\"
285   \\override #'(offset . 1)
286   \\override #'(thickness . 5)
287   \\underline \"underlined\"
288 }
289 @end lilypond"
290   (let* ((thick (ly:output-def-lookup layout 'line-thickness))
291          (underline-thick (* thickness thick))
292          (markup (interpret-markup layout props arg))
293          (x1 (car (ly:stencil-extent markup X)))
294          (x2 (cdr (ly:stencil-extent markup X)))
295          (y (* thick (- offset)))
296          (line (make-line-stencil underline-thick x1 y x2 y)))
297     (ly:stencil-add markup line)))
298
299 (define-markup-command (box layout props arg)
300   (markup?)
301   #:category font
302   #:properties ((thickness 1)
303                 (font-size 0)
304                 (box-padding 0.2))
305   "
306 @cindex enclosing text within a box
307
308 Draw a box round @var{arg}.  Looks at @code{thickness},
309 @code{box-padding} and @code{font-size} properties to determine line
310 thickness and padding around the markup.
311
312 @lilypond[verbatim,quote]
313 \\markup {
314   \\override #'(box-padding . 0.5)
315   \\box
316   \\line { V. S. }
317 }
318 @end lilypond"
319   (let* ((th (* (ly:output-def-lookup layout 'line-thickness)
320                 thickness))
321          (pad (* (magstep font-size) box-padding))
322          (m (interpret-markup layout props arg)))
323     (box-stencil m th pad)))
324
325 (define-markup-command (filled-box layout props xext yext blot)
326   (number-pair? number-pair? number?)
327   #:category graphic
328   "
329 @cindex drawing solid boxes within text
330 @cindex drawing boxes with rounded corners
331
332 Draw a box with rounded corners of dimensions @var{xext} and
333 @var{yext}.  For example,
334 @verbatim
335 \\filled-box #'(-.3 . 1.8) #'(-.3 . 1.8) #0
336 @end verbatim
337 creates a box extending horizontally from -0.3 to 1.8 and
338 vertically from -0.3 up to 1.8, with corners formed from a
339 circle of diameter@tie{}0 (i.e., sharp corners).
340
341 @lilypond[verbatim,quote]
342 \\markup {
343   \\filled-box #'(0 . 4) #'(0 . 4) #0
344   \\filled-box #'(0 . 2) #'(-4 . 2) #0.4
345   \\filled-box #'(1 . 8) #'(0 . 7) #0.2
346   \\with-color #white
347   \\filled-box #'(-4.5 . -2.5) #'(3.5 . 5.5) #0.7
348 }
349 @end lilypond"
350   (ly:round-filled-box
351    xext yext blot))
352
353 (define-markup-command (rounded-box layout props arg)
354   (markup?)
355   #:category graphic
356   #:properties ((thickness 1)
357                 (corner-radius 1)
358                 (font-size 0)
359                 (box-padding 0.5))
360   "@cindex enclosing text in a box with rounded corners
361    @cindex drawing boxes with rounded corners around text
362 Draw a box with rounded corners around @var{arg}.  Looks at @code{thickness},
363 @code{box-padding} and @code{font-size} properties to determine line
364 thickness and padding around the markup; the @code{corner-radius} property
365 makes it possible to define another shape for the corners (default is 1).
366
367 @lilypond[quote,verbatim,relative=2]
368 c4^\\markup {
369   \\rounded-box {
370     Overtura
371   }
372 }
373 c,8. c16 c4 r
374 @end lilypond"
375   (let ((th (* (ly:output-def-lookup layout 'line-thickness)
376                thickness))
377         (pad (* (magstep font-size) box-padding))
378         (m (interpret-markup layout props arg)))
379     (ly:stencil-add (rounded-box-stencil m th pad corner-radius)
380                     m)))
381
382 (define-markup-command (rotate layout props ang arg)
383   (number? markup?)
384   #:category align
385   "
386 @cindex rotating text
387
388 Rotate object with @var{ang} degrees around its center.
389
390 @lilypond[verbatim,quote]
391 \\markup {
392   default
393   \\hspace #2
394   \\rotate #45
395   \\line {
396     rotated 45°
397   }
398 }
399 @end lilypond"
400   (let* ((stil (interpret-markup layout props arg)))
401     (ly:stencil-rotate stil ang 0 0)))
402
403 (define-markup-command (whiteout layout props arg)
404   (markup?)
405   #:category other
406   "
407 @cindex adding a white background to text
408
409 Provide a white background for @var{arg}.
410
411 @lilypond[verbatim,quote]
412 \\markup {
413   \\combine
414     \\filled-box #'(-1 . 10) #'(-3 . 4) #1
415     \\whiteout whiteout
416 }
417 @end lilypond"
418   (stencil-whiteout (interpret-markup layout props arg)))
419
420 (define-markup-command (pad-markup layout props amount arg)
421   (number? markup?)
422   #:category align
423   "
424 @cindex padding text
425 @cindex putting space around text
426
427 Add space around a markup object.
428
429 @lilypond[verbatim,quote]
430 \\markup {
431   \\box {
432     default
433   }
434   \\hspace #2
435   \\box {
436     \\pad-markup #1 {
437       padded
438     }
439   }
440 }
441 @end lilypond"
442   (let*
443       ((stil (interpret-markup layout props arg))
444        (xext (ly:stencil-extent stil X))
445        (yext (ly:stencil-extent stil Y)))
446
447     (ly:make-stencil
448      (ly:stencil-expr stil)
449      (interval-widen xext amount)
450      (interval-widen yext amount))))
451
452 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
453 ;; space
454 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
455
456 (define-markup-command (strut layout props)
457   ()
458   #:category other
459   "
460 @cindex creating vertical spaces in text
461
462 Create a box of the same height as the space in the current font."
463   (let ((m (ly:text-interface::interpret-markup layout props " ")))
464     (ly:make-stencil (ly:stencil-expr m)
465                      '(0 . 0)
466                      (ly:stencil-extent m X)
467                      )))
468
469 ;; todo: fix negative space
470 (define-markup-command (hspace layout props amount)
471   (number?)
472   #:category align
473   #:properties ((word-space))
474   "
475 @cindex creating horizontal spaces in text
476
477 Create an invisible object taking up horizontal space @var{amount}.
478
479 @lilypond[verbatim,quote]
480 \\markup {
481   one
482   \\hspace #2
483   two
484   \\hspace #8
485   three
486 }
487 @end lilypond"
488   (let ((corrected-space (- amount word-space)))
489     (if (> corrected-space 0)
490         (ly:make-stencil "" (cons 0 corrected-space) '(0 . 0))
491         (ly:make-stencil "" (cons corrected-space corrected-space) '(0 . 0)))))
492
493 ;; todo: fix negative space
494 (define-markup-command (vspace layout props amount)
495  (number?)
496  #:category align
497  "
498 @cindex creating vertical spaces in text
499
500 Create an invisible object taking up vertical space
501 of @var{amount} multiplied by 3.
502
503 @lilypond[verbatim,quote]
504 \\markup {
505     \\center-column {
506     one
507     \\vspace #2
508     two
509     \\vspace #5
510     three
511   }
512 }
513 @end lilypond"
514   (let ((amount (* amount 3.0)))
515     (if (> amount 0)
516         (ly:make-stencil "" (cons 0 0) (cons 0 amount))
517         (ly:make-stencil "" (cons 0 0) (cons amount amount)))))
518
519
520 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
521 ;; importing graphics.
522 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
523
524 (define-markup-command (stencil layout props stil)
525   (ly:stencil?)
526   #:category other
527   "
528 @cindex importing stencils into text
529
530 Use a stencil as markup.
531
532 @lilypond[verbatim,quote]
533 \\markup {
534   \\stencil #(make-circle-stencil 2 0 #t)
535 }
536 @end lilypond"
537   stil)
538
539 (define bbox-regexp
540   (make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)"))
541
542 (define (get-postscript-bbox string)
543   "Extract the bbox from STRING, or return #f if not present."
544   (let*
545       ((match (regexp-exec bbox-regexp string)))
546
547     (if match
548         (map (lambda (x)
549                (string->number (match:substring match x)))
550              (cdr (iota 5)))
551
552         #f)))
553
554 (define-markup-command (epsfile layout props axis size file-name)
555   (number? number? string?)
556   #:category graphic
557   "
558 @cindex inlining an Encapsulated PostScript image
559
560 Inline an EPS image.  The image is scaled along @var{axis} to
561 @var{size}.
562
563 @lilypond[verbatim,quote]
564 \\markup {
565   \\general-align #Y #DOWN {
566     \\epsfile #X #20 #\"context-example.eps\"
567     \\epsfile #Y #20 #\"context-example.eps\"
568   }
569 }
570 @end lilypond"
571   (if (ly:get-option 'safe)
572       (interpret-markup layout props "not allowed in safe")
573       (eps-file->stencil axis size file-name)
574       ))
575
576 (define-markup-command (postscript layout props str)
577   (string?)
578   #:category graphic
579   "
580 @cindex inserting PostScript directly into text
581 This inserts @var{str} directly into the output as a PostScript
582 command string.
583
584 @lilypond[verbatim,quote]
585 ringsps = #\"
586   0.15 setlinewidth
587   0.9 0.6 moveto
588   0.4 0.6 0.5 0 361 arc
589   stroke
590   1.0 0.6 0.5 0 361 arc
591   stroke
592   \"
593
594 rings = \\markup {
595   \\with-dimensions #'(-0.2 . 1.6) #'(0 . 1.2)
596   \\postscript #ringsps
597 }
598
599 \\relative c'' {
600   c2^\\rings
601   a2_\\rings
602 }
603 @end lilypond"
604   ;; FIXME
605   (ly:make-stencil
606    (list 'embedded-ps
607          (format "
608 gsave currentpoint translate
609 0.1 setlinewidth
610  ~a
611 grestore
612 "
613                  str))
614    '(0 . 0) '(0 . 0)))
615
616 (define-markup-command (path layout props thickness commands) (number? list?)
617   #:category graphic
618   #:properties ((line-cap-style 'round)
619                 (line-join-style 'round)
620                 (filled #f))
621   "
622 @cindex paths, drawing
623 @cindex drawing paths
624 Draws a path with line thickness @var{thickness} according to the
625 directions given in @var{commands}.  @var{commands} is a list of
626 lists where the @code{car} of each sublist is a drawing command and
627 the @code{cdr} comprises the associated arguments for each command.
628
629 Line-cap styles and line-join styles may be customized by
630 overriding the @code{line-cap-style} and @code{line-join-style}
631 properties, respectively.  Available line-cap styles are
632 @code{'butt}, @code{'round}, and @code{'square}.  Available
633 line-join styles are @code{'miter}, @code{'round}, and
634 @code{'bevel}.
635
636 The property @code{filled} specifies whether or not the path is
637 filled with color.
638
639 There are seven commands available to use in the list
640 @code{commands}: @code{moveto}, @code{rmoveto}, @code{lineto},
641 @code{rlineto}, @code{curveto}, @code{rcurveto}, and
642 @code{closepath}.  Note that the commands that begin with @emph{r}
643 are the relative variants of the other three commands.
644
645 The commands @code{moveto}, @code{rmoveto}, @code{lineto}, and
646 @code{rlineto} take 2 arguments; they are the X and Y coordinates
647 for the destination point.
648
649 The commands @code{curveto} and @code{rcurveto} create cubic
650 Bézier curves, and take 6 arguments; the first two are the X and Y
651 coordinates for the first control point, the second two are the X
652 and Y coordinates for the second control point, and the last two
653 are the X and Y coordinates for the destination point.
654
655 The @code{closepath} command takes zero arguments and closes the
656 current subpath in the active path.
657
658 Note that a sequence of commands @emph{must} begin with a
659 @code{moveto} or @code{rmoveto} to work with the SVG output.
660
661 @lilypond[verbatim,quote]
662 samplePath =
663   #'((moveto 0 0)
664      (lineto -1 1)
665      (lineto 1 1)
666      (lineto 1 -1)
667      (curveto -5 -5 -5 5 -1 0)
668      (closepath))
669
670 \\markup {
671   \\path #0.25 #samplePath
672 }
673 @end lilypond"
674   (let* ((half-thickness (/ thickness 2))
675          (current-point '(0 . 0))
676          (set-point (lambda (lst) (set! current-point lst)))
677          (relative? (lambda (x)
678                       (string-prefix? "r" (symbol->string (car x)))))
679          ;; For calculating extents, we want to modify the command
680          ;; list so that all coordinates are absolute.
681          (new-commands (map (lambda (x)
682                               (cond
683                                 ;; for rmoveto, rlineto
684                                 ((and (relative? x) (eq? 3 (length x)))
685                                  (let ((cp (cons
686                                              (+ (car current-point)
687                                                 (second x))
688                                              (+ (cdr current-point)
689                                                 (third x)))))
690                                    (set-point cp)
691                                    (list (car cp)
692                                          (cdr cp))))
693                                 ;; for rcurveto
694                                 ((and (relative? x) (eq? 7 (length x)))
695                                  (let* ((old-cp current-point)
696                                         (cp (cons
697                                               (+ (car old-cp)
698                                                  (sixth x))
699                                               (+ (cdr old-cp)
700                                                  (seventh x)))))
701                                    (set-point cp)
702                                    (list (+ (car old-cp) (second x))
703                                          (+ (cdr old-cp) (third x))
704                                          (+ (car old-cp) (fourth x))
705                                          (+ (cdr old-cp) (fifth x))
706                                          (car cp)
707                                          (cdr cp))))
708                                 ;; for moveto, lineto
709                                 ((eq? 3 (length x))
710                                  (set-point (cons (second x)
711                                                   (third x)))
712                                  (drop x 1))
713                                 ;; for curveto
714                                 ((eq? 7 (length x))
715                                  (set-point (cons (sixth x)
716                                                   (seventh x)))
717                                  (drop x 1))
718                                 ;; keep closepath for filtering;
719                                 ;; see `without-closepath'.
720                                 (else x)))
721                             commands))
722          ;; path-min-max does not accept 0-arg lists,
723          ;; and since closepath does not affect extents, filter
724          ;; out those commands here.
725          (without-closepath (filter (lambda (x)
726                                       (not (equal? 'closepath (car x))))
727                                     new-commands))
728          (extents (path-min-max
729                     ;; set the origin to the first moveto
730                     (list (list-ref (car without-closepath) 0)
731                           (list-ref (car without-closepath) 1))
732                     without-closepath))
733          (X-extent (cons (list-ref extents 0) (list-ref extents 1)))
734          (Y-extent (cons (list-ref extents 2) (list-ref extents 3)))
735          (command-list (fold-right append '() commands)))
736
737     ;; account for line thickness
738     (set! X-extent (interval-widen X-extent half-thickness))
739     (set! Y-extent (interval-widen Y-extent half-thickness))
740
741     (ly:make-stencil
742       `(path ,thickness `(,@',command-list)
743              ',line-cap-style ',line-join-style ,filled)
744       X-extent
745       Y-extent)))
746
747 (define-markup-command (score layout props score)
748   (ly:score?)
749   #:category music
750   #:properties ((baseline-skip))
751   "
752 @cindex inserting music into text
753
754 Inline an image of music.
755
756 @lilypond[verbatim,quote]
757 \\markup {
758   \\score {
759     \\new PianoStaff <<
760       \\new Staff \\relative c' {
761         \\key f \\major
762         \\time 3/4
763         \\mark \\markup { Allegro }
764         f2\\p( a4)
765         c2( a4)
766         bes2( g'4)
767         f8( e) e4 r
768       }
769       \\new Staff \\relative c {
770         \\clef bass
771         \\key f \\major
772         \\time 3/4
773         f8( a c a c a
774         f c' es c es c)
775         f,( bes d bes d bes)
776         f( g bes g bes g)
777       }
778     >>
779     \\layout {
780       indent = 0.0\\cm
781       \\context {
782         \\Score
783         \\override RehearsalMark #'break-align-symbols =
784           #'(time-signature key-signature)
785         \\override RehearsalMark #'self-alignment-X = #LEFT
786       }
787       \\context {
788         \\Staff
789         \\override TimeSignature #'break-align-anchor-alignment = #LEFT
790       }
791     }
792   }
793 }
794 @end lilypond"
795   (let ((output (ly:score-embedded-format score layout)))
796
797     (if (ly:music-output? output)
798         (stack-stencils Y DOWN baseline-skip
799                         (map paper-system-stencil
800                              (vector->list
801                               (ly:paper-score-paper-systems output))))
802         (begin
803           (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
804           empty-stencil))))
805
806 (define-markup-command (null layout props)
807   ()
808   #:category other
809   "
810 @cindex creating empty text objects
811
812 An empty markup with extents of a single point.
813
814 @lilypond[verbatim,quote]
815 \\markup {
816   \\null
817 }
818 @end lilypond"
819   point-stencil)
820
821 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
822 ;; basic formatting.
823 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
824
825 (define-markup-command (simple layout props str)
826   (string?)
827   #:category font
828   "
829 @cindex simple text strings
830
831 A simple text string; @code{\\markup @{ foo @}} is equivalent with
832 @code{\\markup @{ \\simple #\"foo\" @}}.
833
834 Note: for creating standard text markup or defining new markup commands,
835 the use of @code{\\simple} is unnecessary.
836
837 @lilypond[verbatim,quote]
838 \\markup {
839   \\simple #\"simple\"
840   \\simple #\"text\"
841   \\simple #\"strings\"
842 }
843 @end lilypond"
844   (interpret-markup layout props str))
845
846 (define-markup-command (tied-lyric layout props str)
847   (string?)
848   #:category music
849   "
850 @cindex simple text strings with tie characters
851
852 Like simple-markup, but use tie characters for @q{~} tilde symbols.
853
854 @lilypond[verbatim,quote]
855 \\markup {
856   \\tied-lyric #\"Lasciate~i monti\"
857 }
858 @end lilypond"
859   (if (string-contains str "~")
860       (let*
861           ((parts (string-split str #\~))
862            (tie-str (ly:wide-char->utf-8 #x203f))
863            (joined  (list-join parts tie-str))
864            (join-stencil (interpret-markup layout props tie-str))
865            )
866
867         (interpret-markup layout
868                           (prepend-alist-chain
869                            'word-space
870                            (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5)
871                            props)
872                           (make-line-markup joined)))
873                            ;(map (lambda (s) (interpret-markup layout props s)) parts))
874       (interpret-markup layout props str)))
875
876 (define-public empty-markup
877   (make-simple-markup ""))
878
879 ;; helper for justifying lines.
880 (define (get-fill-space word-count line-width word-space text-widths)
881   "Calculate the necessary paddings between each two adjacent texts.
882   The lengths of all texts are stored in @var{text-widths}.
883   The normal formula for the padding between texts a and b is:
884   padding = line-width/(word-count - 1) - (length(a) + length(b))/2
885   The first and last padding have to be calculated specially using the
886   whole length of the first or last text.
887   All paddings are checked to be at least word-space, to ensure that
888   no texts collide.
889   Return a list of paddings."
890   (cond
891    ((null? text-widths) '())
892
893    ;; special case first padding
894    ((= (length text-widths) word-count)
895     (cons
896      (- (- (/ line-width (1- word-count)) (car text-widths))
897         (/ (car (cdr text-widths)) 2))
898      (get-fill-space word-count line-width word-space (cdr text-widths))))
899    ;; special case last padding
900    ((= (length text-widths) 2)
901     (list (- (/ line-width (1- word-count))
902              (+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
903    (else
904     (let ((default-padding
905             (- (/ line-width (1- word-count))
906                (/ (+ (car text-widths) (car (cdr text-widths))) 2))))
907       (cons
908        (if (> word-space default-padding)
909            word-space
910            default-padding)
911        (get-fill-space word-count line-width word-space (cdr text-widths)))))))
912
913 (define-markup-command (fill-line layout props args)
914   (markup-list?)
915   #:category align
916   #:properties ((text-direction RIGHT)
917                 (word-space 0.6)
918                 (line-width #f))
919   "Put @var{markups} in a horizontal line of width @var{line-width}.
920 The markups are spaced or flushed to fill the entire line.
921 If there are no arguments, return an empty stencil.
922
923 @lilypond[verbatim,quote]
924 \\markup {
925   \\column {
926     \\fill-line {
927       Words evenly spaced across the page
928     }
929     \\null
930     \\fill-line {
931       \\line { Text markups }
932       \\line {
933         \\italic { evenly spaced }
934       }
935       \\line { across the page }
936     }
937   }
938 }
939 @end lilypond"
940   (let* ((orig-stencils (interpret-markup-list layout props args))
941          (stencils
942           (map (lambda (stc)
943                  (if (ly:stencil-empty? stc)
944                      point-stencil
945                      stc)) orig-stencils))
946          (text-widths
947           (map (lambda (stc)
948                  (if (ly:stencil-empty? stc)
949                      0.0
950                      (interval-length (ly:stencil-extent stc X))))
951                stencils))
952          (text-width (apply + text-widths))
953          (word-count (length stencils))
954          (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
955          (fill-space
956           (cond
957            ((= word-count 1)
958             (list
959              (/ (- line-width text-width) 2)
960              (/ (- line-width text-width) 2)))
961            ((= word-count 2)
962             (list
963              (- line-width text-width)))
964            (else
965             (get-fill-space word-count line-width word-space text-widths))))
966
967          (line-contents (if (= word-count 1)
968                             (list
969                              point-stencil
970                              (car stencils)
971                              point-stencil)
972                             stencils)))
973
974     (if (null? (remove ly:stencil-empty? orig-stencils))
975         empty-stencil
976         (begin
977           (if (= text-direction LEFT)
978               (set! line-contents (reverse line-contents)))
979           (set! line-contents
980                 (stack-stencils-padding-list
981                  X RIGHT fill-space line-contents))
982           (if (> word-count 1)
983               ;; shift s.t. stencils align on the left edge, even if
984               ;; first stencil had negative X-extent (e.g. center-column)
985               ;; (if word-count = 1, X-extents are already normalized in
986               ;; the definition of line-contents)
987               (set! line-contents
988                     (ly:stencil-translate-axis
989                      line-contents
990                      (- (car (ly:stencil-extent (car stencils) X)))
991                      X)))
992           line-contents))))
993
994 (define-markup-command (line layout props args)
995   (markup-list?)
996   #:category align
997   #:properties ((word-space)
998                 (text-direction RIGHT))
999   "Put @var{args} in a horizontal line.  The property @code{word-space}
1000 determines the space between markups in @var{args}.
1001
1002 @lilypond[verbatim,quote]
1003 \\markup {
1004   \\line {
1005     one two three
1006   }
1007 }
1008 @end lilypond"
1009   (let ((stencils (interpret-markup-list layout props args)))
1010     (if (= text-direction LEFT)
1011         (set! stencils (reverse stencils)))
1012     (stack-stencil-line
1013      word-space
1014      (remove ly:stencil-empty? stencils))))
1015
1016 (define-markup-command (concat layout props args)
1017   (markup-list?)
1018   #:category align
1019   "
1020 @cindex concatenating text
1021 @cindex ligatures in text
1022
1023 Concatenate @var{args} in a horizontal line, without spaces in between.
1024 Strings and simple markups are concatenated on the input level, allowing
1025 ligatures.  For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is
1026 equivalent to @code{\"fi\"}.
1027
1028 @lilypond[verbatim,quote]
1029 \\markup {
1030   \\concat {
1031     one
1032     two
1033     three
1034   }
1035 }
1036 @end lilypond"
1037   (define (concat-string-args arg-list)
1038     (fold-right (lambda (arg result-list)
1039                   (let ((result (if (pair? result-list)
1040                                     (car result-list)
1041                                   '())))
1042                     (if (and (pair? arg) (eqv? (car arg) simple-markup))
1043                       (set! arg (cadr arg)))
1044                     (if (and (string? result) (string? arg))
1045                         (cons (string-append arg result) (cdr result-list))
1046                       (cons arg result-list))))
1047                 '()
1048                 arg-list))
1049
1050   (interpret-markup layout
1051                     (prepend-alist-chain 'word-space 0 props)
1052                     (make-line-markup (if (markup-command-list? args)
1053                                           args
1054                                           (concat-string-args args)))))
1055
1056 (define (wordwrap-stencils stencils
1057                            justify base-space line-width text-dir)
1058   "Perform simple wordwrap, return stencil of each line."
1059   (define space (if justify
1060                     ;; justify only stretches lines.
1061                     (* 0.7 base-space)
1062                     base-space))
1063   (define (take-list width space stencils
1064                      accumulator accumulated-width)
1065     "Return (head-list . tail) pair, with head-list fitting into width"
1066     (if (null? stencils)
1067         (cons accumulator stencils)
1068         (let* ((first (car stencils))
1069                (first-wid (cdr (ly:stencil-extent (car stencils) X)))
1070                (newwid (+ space first-wid accumulated-width)))
1071           (if (or (null? accumulator)
1072                   (< newwid width))
1073               (take-list width space
1074                          (cdr stencils)
1075                          (cons first accumulator)
1076                          newwid)
1077               (cons accumulator stencils)))))
1078   (let loop ((lines '())
1079              (todo stencils))
1080     (let* ((line-break (take-list line-width space todo
1081                                   '() 0.0))
1082            (line-stencils (car line-break))
1083            (space-left (- line-width
1084                           (apply + (map (lambda (x) (cdr (ly:stencil-extent x X)))
1085                                         line-stencils))))
1086            (line-word-space (cond ((not justify) space)
1087                                   ;; don't stretch last line of paragraph.
1088                                   ;; hmmm . bug - will overstretch the last line in some case.
1089                                   ((null? (cdr line-break))
1090                                    base-space)
1091                                   ((null? line-stencils) 0.0)
1092                                   ((null? (cdr line-stencils)) 0.0)
1093                                   (else (/ space-left (1- (length line-stencils))))))
1094            (line (stack-stencil-line line-word-space
1095                                      (if (= text-dir RIGHT)
1096                                          (reverse line-stencils)
1097                                          line-stencils))))
1098       (if (pair? (cdr line-break))
1099           (loop (cons line lines)
1100                 (cdr line-break))
1101           (begin
1102             (if (= text-dir LEFT)
1103                 (set! line
1104                       (ly:stencil-translate-axis
1105                        line
1106                        (- line-width (interval-end (ly:stencil-extent line X)))
1107                        X)))
1108             (reverse (cons line lines)))))))
1109
1110 (define-markup-list-command (wordwrap-internal layout props justify args)
1111   (boolean? markup-list?)
1112   #:properties ((line-width #f)
1113                 (word-space)
1114                 (text-direction RIGHT))
1115   "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}."
1116   (wordwrap-stencils (remove ly:stencil-empty?
1117                              (interpret-markup-list layout props args))
1118                      justify
1119                      word-space
1120                      (or line-width
1121                          (ly:output-def-lookup layout 'line-width))
1122                      text-direction))
1123
1124 (define-markup-command (justify layout props args)
1125   (markup-list?)
1126   #:category align
1127   #:properties ((baseline-skip)
1128                 wordwrap-internal-markup-list)
1129   "
1130 @cindex justifying text
1131
1132 Like @code{\\wordwrap}, but with lines stretched to justify the margins.
1133 Use @code{\\override #'(line-width . @var{X})} to set the line width;
1134 @var{X}@tie{}is the number of staff spaces.
1135
1136 @lilypond[verbatim,quote]
1137 \\markup {
1138   \\justify {
1139     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
1140     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1141     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1142     laboris nisi ut aliquip ex ea commodo consequat.
1143   }
1144 }
1145 @end lilypond"
1146   (stack-lines DOWN 0.0 baseline-skip
1147                (wordwrap-internal-markup-list layout props #t args)))
1148
1149 (define-markup-command (wordwrap layout props args)
1150   (markup-list?)
1151   #:category align
1152   #:properties ((baseline-skip)
1153                 wordwrap-internal-markup-list)
1154   "Simple wordwrap.  Use @code{\\override #'(line-width . @var{X})} to set
1155 the line width, where @var{X} is the number of staff spaces.
1156
1157 @lilypond[verbatim,quote]
1158 \\markup {
1159   \\wordwrap {
1160     Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed
1161     do eiusmod tempor incididunt ut labore et dolore magna aliqua.
1162     Ut enim ad minim veniam, quis nostrud exercitation ullamco
1163     laboris nisi ut aliquip ex ea commodo consequat.
1164   }
1165 }
1166 @end lilypond"
1167   (stack-lines DOWN 0.0 baseline-skip
1168                (wordwrap-internal-markup-list layout props #f args)))
1169
1170 (define-markup-list-command (wordwrap-string-internal layout props justify arg)
1171   (boolean? string?)
1172   #:properties ((line-width)
1173                 (word-space)
1174                 (text-direction RIGHT))
1175   "Internal markup list command used to define @code{\\justify-string} and
1176 @code{\\wordwrap-string}."
1177   (let* ((para-strings (regexp-split
1178                         (string-regexp-substitute
1179                          "\r" "\n"
1180                          (string-regexp-substitute "\r\n" "\n" arg))
1181                         "\n[ \t\n]*\n[ \t\n]*"))
1182          (list-para-words (map (lambda (str)
1183                                  (regexp-split str "[ \t\n]+"))
1184                                para-strings))
1185          (para-lines (map (lambda (words)
1186                             (let* ((stencils
1187                                     (remove ly:stencil-empty?
1188                                             (map (lambda (x)
1189                                                    (interpret-markup layout props x))
1190                                                  words))))
1191                               (wordwrap-stencils stencils
1192                                                  justify word-space
1193                                                  line-width text-direction)))
1194                           list-para-words)))
1195     (apply append para-lines)))
1196
1197 (define-markup-command (wordwrap-string layout props arg)
1198   (string?)
1199   #:category align
1200   #:properties ((baseline-skip)
1201                 wordwrap-string-internal-markup-list)
1202   "Wordwrap a string.  Paragraphs may be separated with double newlines.
1203
1204 @lilypond[verbatim,quote]
1205 \\markup {
1206   \\override #'(line-width . 40)
1207   \\wordwrap-string #\"Lorem ipsum dolor sit amet, consectetur
1208       adipisicing elit, sed do eiusmod tempor incididunt ut labore
1209       et dolore magna aliqua.
1210
1211
1212       Ut enim ad minim veniam, quis nostrud exercitation ullamco
1213       laboris nisi ut aliquip ex ea commodo consequat.
1214
1215
1216       Excepteur sint occaecat cupidatat non proident, sunt in culpa
1217       qui officia deserunt mollit anim id est laborum\"
1218 }
1219 @end lilypond"
1220   (stack-lines DOWN 0.0 baseline-skip
1221                (wordwrap-string-internal-markup-list layout props #f arg)))
1222
1223 (define-markup-command (justify-string layout props arg)
1224   (string?)
1225   #:category align
1226   #:properties ((baseline-skip)
1227                 wordwrap-string-internal-markup-list)
1228   "Justify a string.  Paragraphs may be separated with double newlines
1229
1230 @lilypond[verbatim,quote]
1231 \\markup {
1232   \\override #'(line-width . 40)
1233   \\justify-string #\"Lorem ipsum dolor sit amet, consectetur
1234       adipisicing elit, sed do eiusmod tempor incididunt ut labore
1235       et dolore magna aliqua.
1236
1237
1238       Ut enim ad minim veniam, quis nostrud exercitation ullamco
1239       laboris nisi ut aliquip ex ea commodo consequat.
1240
1241
1242       Excepteur sint occaecat cupidatat non proident, sunt in culpa
1243       qui officia deserunt mollit anim id est laborum\"
1244 }
1245 @end lilypond"
1246   (stack-lines DOWN 0.0 baseline-skip
1247                (wordwrap-string-internal-markup-list layout props #t arg)))
1248
1249 (define-markup-command (wordwrap-field layout props symbol)
1250   (symbol?)
1251   #:category align
1252   "Wordwrap the data which has been assigned to @var{symbol}.
1253
1254 @lilypond[verbatim,quote]
1255 \\header {
1256   title = \"My title\"
1257   myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
1258     elit, sed do eiusmod tempor incididunt ut labore et dolore magna
1259     aliqua.  Ut enim ad minim veniam, quis nostrud exercitation ullamco
1260     laboris nisi ut aliquip ex ea commodo consequat.\"
1261 }
1262
1263 \\paper {
1264   bookTitleMarkup = \\markup {
1265     \\column {
1266       \\fill-line { \\fromproperty #'header:title }
1267       \\null
1268       \\wordwrap-field #'header:myText
1269     }
1270   }
1271 }
1272
1273 \\markup {
1274   \\null
1275 }
1276 @end lilypond"
1277   (let* ((m (chain-assoc-get symbol props)))
1278     (if (string? m)
1279         (wordwrap-string-markup layout props m)
1280         empty-stencil)))
1281
1282 (define-markup-command (justify-field layout props symbol)
1283   (symbol?)
1284   #:category align
1285   "Justify the data which has been assigned to @var{symbol}.
1286
1287 @lilypond[verbatim,quote]
1288 \\header {
1289   title = \"My title\"
1290   myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
1291     elit, sed do eiusmod tempor incididunt ut labore et dolore magna
1292     aliqua.  Ut enim ad minim veniam, quis nostrud exercitation ullamco
1293     laboris nisi ut aliquip ex ea commodo consequat.\"
1294 }
1295
1296 \\paper {
1297   bookTitleMarkup = \\markup {
1298     \\column {
1299       \\fill-line { \\fromproperty #'header:title }
1300       \\null
1301       \\justify-field #'header:myText
1302     }
1303   }
1304 }
1305
1306 \\markup {
1307   \\null
1308 }
1309 @end lilypond"
1310   (let* ((m (chain-assoc-get symbol props)))
1311     (if (string? m)
1312         (justify-string-markup layout props m)
1313         empty-stencil)))
1314
1315 (define-markup-command (combine layout props arg1 arg2)
1316   (markup? markup?)
1317   #:category align
1318   "
1319 @cindex merging text
1320
1321 Print two markups on top of each other.
1322
1323 Note: @code{\\combine} cannot take a list of markups enclosed in
1324 curly braces as an argument; the follow example will not compile:
1325
1326 @example
1327 \\combine @{ a list @}
1328 @end example
1329
1330 @lilypond[verbatim,quote]
1331 \\markup {
1332   \\fontsize #5
1333   \\override #'(thickness . 2)
1334   \\combine
1335     \\draw-line #'(0 . 4)
1336     \\arrow-head #Y #DOWN ##f
1337 }
1338 @end lilypond"
1339   (let* ((s1 (interpret-markup layout props arg1))
1340          (s2 (interpret-markup layout props arg2)))
1341     (ly:stencil-add s1 s2)))
1342
1343 ;;
1344 ;; TODO: should extract baseline-skip from each argument somehow..
1345 ;;
1346 (define-markup-command (column layout props args)
1347   (markup-list?)
1348   #:category align
1349   #:properties ((baseline-skip))
1350   "
1351 @cindex stacking text in a column
1352
1353 Stack the markups in @var{args} vertically.  The property
1354 @code{baseline-skip} determines the space between markups
1355 in @var{args}.
1356
1357 @lilypond[verbatim,quote]
1358 \\markup {
1359   \\column {
1360     one
1361     two
1362     three
1363   }
1364 }
1365 @end lilypond"
1366   (let ((arg-stencils (interpret-markup-list layout props args)))
1367     (stack-lines -1 0.0 baseline-skip
1368                  (remove ly:stencil-empty? arg-stencils))))
1369
1370 (define-markup-command (dir-column layout props args)
1371   (markup-list?)
1372   #:category align
1373   #:properties ((direction)
1374                 (baseline-skip))
1375   "
1376 @cindex changing direction of text columns
1377
1378 Make a column of @var{args}, going up or down, depending on the
1379 setting of the @code{direction} layout property.
1380
1381 @lilypond[verbatim,quote]
1382 \\markup {
1383   \\override #`(direction . ,UP) {
1384     \\dir-column {
1385       going up
1386     }
1387   }
1388   \\hspace #1
1389   \\dir-column {
1390     going down
1391   }
1392   \\hspace #1
1393   \\override #'(direction . 1) {
1394     \\dir-column {
1395       going up
1396     }
1397   }
1398 }
1399 @end lilypond"
1400   (stack-lines (if (number? direction) direction -1)
1401                0.0
1402                baseline-skip
1403                (interpret-markup-list layout props args)))
1404
1405 (define (general-column align-dir baseline mols)
1406   "Stack @var{mols} vertically, aligned to  @var{align-dir} horizontally."
1407
1408   (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols)))
1409     (stack-lines -1 0.0 baseline aligned-mols)))
1410
1411 (define-markup-command (center-column layout props args)
1412   (markup-list?)
1413   #:category align
1414   #:properties ((baseline-skip))
1415   "
1416 @cindex centering a column of text
1417
1418 Put @code{args} in a centered column.
1419
1420 @lilypond[verbatim,quote]
1421 \\markup {
1422   \\center-column {
1423     one
1424     two
1425     three
1426   }
1427 }
1428 @end lilypond"
1429   (general-column CENTER baseline-skip (interpret-markup-list layout props args)))
1430
1431 (define-markup-command (left-column layout props args)
1432   (markup-list?)
1433   #:category align
1434   #:properties ((baseline-skip))
1435  "
1436 @cindex text columns, left-aligned
1437
1438 Put @code{args} in a left-aligned column.
1439
1440 @lilypond[verbatim,quote]
1441 \\markup {
1442   \\left-column {
1443     one
1444     two
1445     three
1446   }
1447 }
1448 @end lilypond"
1449   (general-column LEFT baseline-skip (interpret-markup-list layout props args)))
1450
1451 (define-markup-command (right-column layout props args)
1452   (markup-list?)
1453   #:category align
1454   #:properties ((baseline-skip))
1455  "
1456 @cindex text columns, right-aligned
1457
1458 Put @code{args} in a right-aligned column.
1459
1460 @lilypond[verbatim,quote]
1461 \\markup {
1462   \\right-column {
1463     one
1464     two
1465     three
1466   }
1467 }
1468 @end lilypond"
1469   (general-column RIGHT baseline-skip (interpret-markup-list layout props args)))
1470
1471 (define-markup-command (vcenter layout props arg)
1472   (markup?)
1473   #:category align
1474   "
1475 @cindex vertically centering text
1476
1477 Align @code{arg} to its Y@tie{}center.
1478
1479 @lilypond[verbatim,quote]
1480 \\markup {
1481   one
1482   \\vcenter
1483   two
1484   three
1485 }
1486 @end lilypond"
1487   (let* ((mol (interpret-markup layout props arg)))
1488     (ly:stencil-aligned-to mol Y CENTER)))
1489
1490 (define-markup-command (center-align layout props arg)
1491   (markup?)
1492   #:category align
1493   "
1494 @cindex horizontally centering text
1495
1496 Align @code{arg} to its X@tie{}center.
1497
1498 @lilypond[verbatim,quote]
1499 \\markup {
1500   \\column {
1501     one
1502     \\center-align
1503     two
1504     three
1505   }
1506 }
1507 @end lilypond"
1508   (let* ((mol (interpret-markup layout props arg)))
1509     (ly:stencil-aligned-to mol X CENTER)))
1510
1511 (define-markup-command (right-align layout props arg)
1512   (markup?)
1513   #:category align
1514   "
1515 @cindex right aligning text
1516
1517 Align @var{arg} on its right edge.
1518
1519 @lilypond[verbatim,quote]
1520 \\markup {
1521   \\column {
1522     one
1523     \\right-align
1524     two
1525     three
1526   }
1527 }
1528 @end lilypond"
1529   (let* ((m (interpret-markup layout props arg)))
1530     (ly:stencil-aligned-to m X RIGHT)))
1531
1532 (define-markup-command (left-align layout props arg)
1533   (markup?)
1534   #:category align
1535   "
1536 @cindex left aligning text
1537
1538 Align @var{arg} on its left edge.
1539
1540 @lilypond[verbatim,quote]
1541 \\markup {
1542   \\column {
1543     one
1544     \\left-align
1545     two
1546     three
1547   }
1548 }
1549 @end lilypond"
1550   (let* ((m (interpret-markup layout props arg)))
1551     (ly:stencil-aligned-to m X LEFT)))
1552
1553 (define-markup-command (general-align layout props axis dir arg)
1554   (integer? number? markup?)
1555   #:category align
1556   "
1557 @cindex controlling general text alignment
1558
1559 Align @var{arg} in @var{axis} direction to the @var{dir} side.
1560
1561 @lilypond[verbatim,quote]
1562 \\markup {
1563   \\column {
1564     one
1565     \\general-align #X #LEFT
1566     two
1567     three
1568     \\null
1569     one
1570     \\general-align #X #CENTER
1571     two
1572     three
1573     \\null
1574     \\line {
1575       one
1576       \\general-align #Y #UP
1577       two
1578       three
1579     }
1580     \\null
1581     \\line {
1582       one
1583       \\general-align #Y #3.2
1584       two
1585       three
1586     }
1587   }
1588 }
1589 @end lilypond"
1590   (let* ((m (interpret-markup layout props arg)))
1591     (ly:stencil-aligned-to m axis dir)))
1592
1593 (define-markup-command (halign layout props dir arg)
1594   (number? markup?)
1595   #:category align
1596   "
1597 @cindex setting horizontal text alignment
1598
1599 Set horizontal alignment.  If @var{dir} is @code{-1}, then it is
1600 left-aligned, while @code{+1} is right.  Values in between interpolate
1601 alignment accordingly.
1602
1603 @lilypond[verbatim,quote]
1604 \\markup {
1605   \\column {
1606     one
1607     \\halign #LEFT
1608     two
1609     three
1610     \\null
1611     one
1612     \\halign #CENTER
1613     two
1614     three
1615     \\null
1616     one
1617     \\halign #RIGHT
1618     two
1619     three
1620     \\null
1621     one
1622     \\halign #-5
1623     two
1624     three
1625   }
1626 }
1627 @end lilypond"
1628   (let* ((m (interpret-markup layout props arg)))
1629     (ly:stencil-aligned-to m X dir)))
1630
1631 (define-markup-command (with-dimensions layout props x y arg)
1632   (number-pair? number-pair? markup?)
1633   #:category other
1634   "
1635 @cindex setting extent of text objects
1636
1637 Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
1638   (let* ((m (interpret-markup layout props arg)))
1639     (ly:make-stencil (ly:stencil-expr m) x y)))
1640
1641 (define-markup-command (pad-around layout props amount arg)
1642   (number? markup?)
1643   #:category align
1644   "Add padding @var{amount} all around @var{arg}.
1645
1646 @lilypond[verbatim,quote]
1647 \\markup {
1648   \\box {
1649     default
1650   }
1651   \\hspace #2
1652   \\box {
1653     \\pad-around #0.5 {
1654       padded
1655     }
1656   }
1657 }
1658 @end lilypond"
1659   (let* ((m (interpret-markup layout props arg))
1660          (x (ly:stencil-extent m X))
1661          (y (ly:stencil-extent m Y)))
1662     (ly:make-stencil (ly:stencil-expr m)
1663                      (interval-widen x amount)
1664                      (interval-widen y amount))))
1665
1666 (define-markup-command (pad-x layout props amount arg)
1667   (number? markup?)
1668   #:category align
1669   "
1670 @cindex padding text horizontally
1671
1672 Add padding @var{amount} around @var{arg} in the X@tie{}direction.
1673
1674 @lilypond[verbatim,quote]
1675 \\markup {
1676   \\box {
1677     default
1678   }
1679   \\hspace #4
1680   \\box {
1681     \\pad-x #2 {
1682       padded
1683     }
1684   }
1685 }
1686 @end lilypond"
1687   (let* ((m (interpret-markup layout props arg))
1688          (x (ly:stencil-extent m X))
1689          (y (ly:stencil-extent m Y)))
1690     (ly:make-stencil (ly:stencil-expr m)
1691                      (interval-widen x amount)
1692                      y)))
1693
1694 (define-markup-command (put-adjacent layout props axis dir arg1 arg2)
1695   (integer? ly:dir? markup? markup?)
1696   #:category align
1697   "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}."
1698   (let ((m1 (interpret-markup layout props arg1))
1699         (m2 (interpret-markup layout props arg2)))
1700     (ly:stencil-combine-at-edge m1 axis dir m2 0.0)))
1701
1702 (define-markup-command (transparent layout props arg)
1703   (markup?)
1704   #:category other
1705   "Make @var{arg} transparent.
1706
1707 @lilypond[verbatim,quote]
1708 \\markup {
1709   \\transparent {
1710     invisible text
1711   }
1712 }
1713 @end lilypond"
1714   (let* ((m (interpret-markup layout props arg))
1715          (x (ly:stencil-extent m X))
1716          (y (ly:stencil-extent m Y)))
1717     (ly:make-stencil "" x y)))
1718
1719 (define-markup-command (pad-to-box layout props x-ext y-ext arg)
1720   (number-pair? number-pair? markup?)
1721   #:category align
1722   "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space.
1723
1724 @lilypond[verbatim,quote]
1725 \\markup {
1726   \\box {
1727     default
1728   }
1729   \\hspace #4
1730   \\box {
1731     \\pad-to-box #'(0 . 10) #'(0 . 3) {
1732       padded
1733     }
1734   }
1735 }
1736 @end lilypond"
1737   (let* ((m (interpret-markup layout props arg))
1738          (x (ly:stencil-extent m X))
1739          (y (ly:stencil-extent m Y)))
1740     (ly:make-stencil (ly:stencil-expr m)
1741                      (interval-union x-ext x)
1742                      (interval-union y-ext y))))
1743
1744 (define-markup-command (hcenter-in layout props length arg)
1745   (number? markup?)
1746   #:category align
1747   "Center @var{arg} horizontally within a box of extending
1748 @var{length}/2 to the left and right.
1749
1750 @lilypond[quote,verbatim]
1751 \\new StaffGroup <<
1752   \\new Staff {
1753     \\set Staff.instrumentName = \\markup {
1754       \\hcenter-in #12
1755       Oboe
1756     }
1757     c''1
1758   }
1759   \\new Staff {
1760     \\set Staff.instrumentName = \\markup {
1761       \\hcenter-in #12
1762       Bassoon
1763     }
1764     \\clef tenor
1765     c'1
1766   }
1767 >>
1768 @end lilypond"
1769   (interpret-markup layout props
1770                     (make-pad-to-box-markup
1771                      (cons (/ length -2) (/ length 2))
1772                      '(0 . 0)
1773                      (make-center-align-markup arg))))
1774
1775 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1776 ;; property
1777 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1778
1779 (define-markup-command (fromproperty layout props symbol)
1780   (symbol?)
1781   #:category other
1782   "Read the @var{symbol} from property settings, and produce a stencil
1783 from the markup contained within.  If @var{symbol} is not defined, it
1784 returns an empty markup.
1785
1786 @lilypond[verbatim,quote]
1787 \\header {
1788   myTitle = \"myTitle\"
1789   title = \\markup {
1790     from
1791     \\italic
1792     \\fromproperty #'header:myTitle
1793   }
1794 }
1795 \\markup {
1796   \\null
1797 }
1798 @end lilypond"
1799   (let ((m (chain-assoc-get symbol props)))
1800     (if (markup? m)
1801         (interpret-markup layout props m)
1802         empty-stencil)))
1803
1804 (define-markup-command (on-the-fly layout props procedure arg)
1805   (symbol? markup?)
1806   #:category other
1807   "Apply the @var{procedure} markup command to @var{arg}.
1808 @var{procedure} should take a single argument."
1809   (let ((anonymous-with-signature (lambda (layout props arg) (procedure layout props arg))))
1810     (set-object-property! anonymous-with-signature
1811                           'markup-signature
1812                           (list markup?))
1813     (interpret-markup layout props (list anonymous-with-signature arg))))
1814
1815 (define-markup-command (override layout props new-prop arg)
1816   (pair? markup?)
1817   #:category other
1818   "
1819 @cindex overriding properties within text markup
1820
1821 Add the argument @var{new-prop} to the property list.  Properties
1822 may be any property supported by @rinternals{font-interface},
1823 @rinternals{text-interface} and
1824 @rinternals{instrument-specific-markup-interface}.
1825
1826 @lilypond[verbatim,quote]
1827 \\markup {
1828   \\line {
1829     \\column {
1830       default
1831       baseline-skip
1832     }
1833     \\hspace #2
1834     \\override #'(baseline-skip . 4) {
1835       \\column {
1836         increased
1837         baseline-skip
1838       }
1839     }
1840   }
1841 }
1842 @end lilypond"
1843   (interpret-markup layout (cons (list new-prop) props) arg))
1844
1845 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1846 ;; files
1847 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1848
1849 (define-markup-command (verbatim-file layout props name)
1850   (string?)
1851   #:category other
1852   "Read the contents of file @var{name}, and include it verbatim.
1853
1854 @lilypond[verbatim,quote]
1855 \\markup {
1856   \\verbatim-file #\"simple.ly\"
1857 }
1858 @end lilypond"
1859   (interpret-markup layout props
1860                     (if  (ly:get-option 'safe)
1861                          "verbatim-file disabled in safe mode"
1862                          (let* ((str (ly:gulp-file name))
1863                                 (lines (string-split str #\nl)))
1864                            (make-typewriter-markup
1865                             (make-column-markup lines))))))
1866
1867 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1868 ;; fonts.
1869 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1870
1871
1872 (define-markup-command (smaller layout props arg)
1873   (markup?)
1874   #:category font
1875   "Decrease the font size relative to the current setting.
1876
1877 @lilypond[verbatim,quote]
1878 \\markup {
1879   \\fontsize #3.5 {
1880     some large text
1881     \\hspace #2
1882     \\smaller {
1883       a bit smaller
1884     }
1885     \\hspace #2
1886     more large text
1887   }
1888 }
1889 @end lilypond"
1890   (interpret-markup layout props
1891    `(,fontsize-markup -1 ,arg)))
1892
1893 (define-markup-command (larger layout props arg)
1894   (markup?)
1895   #:category font
1896   "Increase the font size relative to the current setting.
1897
1898 @lilypond[verbatim,quote]
1899 \\markup {
1900   default
1901   \\hspace #2
1902   \\larger
1903   larger
1904 }
1905 @end lilypond"
1906   (interpret-markup layout props
1907    `(,fontsize-markup 1 ,arg)))
1908
1909 (define-markup-command (finger layout props arg)
1910   (markup?)
1911   #:category font
1912   "Set @var{arg} as small numbers.
1913
1914 @lilypond[verbatim,quote]
1915 \\markup {
1916   \\finger {
1917     1 2 3 4 5
1918   }
1919 }
1920 @end lilypond"
1921   (interpret-markup layout
1922                     (cons '((font-size . -5) (font-encoding . fetaText)) props)
1923                     arg))
1924
1925 (define-markup-command (abs-fontsize layout props size arg)
1926   (number? markup?)
1927   #:category font
1928   "Use @var{size} as the absolute font size to display @var{arg}.
1929 Adjusts @code{baseline-skip} and @code{word-space} accordingly.
1930
1931 @lilypond[verbatim,quote]
1932 \\markup {
1933   default text font size
1934   \\hspace #2
1935   \\abs-fontsize #16 { text font size 16 }
1936   \\hspace #2
1937   \\abs-fontsize #12 { text font size 12 }
1938 }
1939 @end lilypond"
1940   (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12))
1941          (text-props (list (ly:output-def-lookup layout 'text-font-defaults)))
1942          (ref-word-space (chain-assoc-get 'word-space text-props 0.6))
1943          (ref-baseline (chain-assoc-get 'baseline-skip text-props 3))
1944          (magnification (/ size ref-size)))
1945     (interpret-markup layout
1946                       (cons `((baseline-skip . ,(* magnification ref-baseline))
1947                               (word-space . ,(* magnification ref-word-space))
1948                               (font-size . ,(magnification->font-size magnification)))
1949                             props)
1950                       arg)))
1951
1952 (define-markup-command (fontsize layout props increment arg)
1953   (number? markup?)
1954   #:category font
1955   #:properties ((font-size 0)
1956                 (word-space 1)
1957                 (baseline-skip 2))
1958   "Add @var{increment} to the font-size.  Adjusts @code{baseline-skip}
1959 accordingly.
1960
1961 @lilypond[verbatim,quote]
1962 \\markup {
1963   default
1964   \\hspace #2
1965   \\fontsize #-1.5
1966   smaller
1967 }
1968 @end lilypond"
1969   (let ((entries (list
1970                   (cons 'baseline-skip (* baseline-skip (magstep increment)))
1971                   (cons 'word-space (* word-space (magstep increment)))
1972                   (cons 'font-size (+ font-size increment)))))
1973     (interpret-markup layout (cons entries props) arg)))
1974
1975 (define-markup-command (magnify layout props sz arg)
1976   (number? markup?)
1977   #:category font
1978   "
1979 @cindex magnifying text
1980
1981 Set the font magnification for its argument.  In the following
1982 example, the middle@tie{}A is 10% larger:
1983
1984 @example
1985 A \\magnify #1.1 @{ A @} A
1986 @end example
1987
1988 Note: Magnification only works if a font name is explicitly selected.
1989 Use @code{\\fontsize} otherwise.
1990
1991 @lilypond[verbatim,quote]
1992 \\markup {
1993   default
1994   \\hspace #2
1995   \\magnify #1.5 {
1996     50% larger
1997   }
1998 }
1999 @end lilypond"
2000   (interpret-markup
2001    layout
2002    (prepend-alist-chain 'font-size (magnification->font-size sz) props)
2003    arg))
2004
2005 (define-markup-command (bold layout props arg)
2006   (markup?)
2007   #:category font
2008   "Switch to bold font-series.
2009
2010 @lilypond[verbatim,quote]
2011 \\markup {
2012   default
2013   \\hspace #2
2014   \\bold
2015   bold
2016 }
2017 @end lilypond"
2018   (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg))
2019
2020 (define-markup-command (sans layout props arg)
2021   (markup?)
2022   #:category font
2023   "Switch to the sans serif font family.
2024
2025 @lilypond[verbatim,quote]
2026 \\markup {
2027   default
2028   \\hspace #2
2029   \\sans {
2030     sans serif
2031   }
2032 }
2033 @end lilypond"
2034   (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg))
2035
2036 (define-markup-command (number layout props arg)
2037   (markup?)
2038   #:category font
2039   "Set font family to @code{number}, which yields the font used for
2040 time signatures and fingerings.  This font contains numbers and
2041 some punctuation; it has no letters.
2042
2043 @lilypond[verbatim,quote]
2044 \\markup {
2045   \\number {
2046     0 1 2 3 4 5 6 7 8 9 . ,
2047   }
2048 }
2049 @end lilypond"
2050   (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2051
2052 (define-markup-command (roman layout props arg)
2053   (markup?)
2054   #:category font
2055   "Set font family to @code{roman}.
2056
2057 @lilypond[verbatim,quote]
2058 \\markup {
2059   \\sans \\bold {
2060     sans serif, bold
2061     \\hspace #2
2062     \\roman {
2063       text in roman font family
2064     }
2065     \\hspace #2
2066     return to sans
2067   }
2068 }
2069 @end lilypond"
2070   (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg))
2071
2072 (define-markup-command (huge layout props arg)
2073   (markup?)
2074   #:category font
2075   "Set font size to +2.
2076
2077 @lilypond[verbatim,quote]
2078 \\markup {
2079   default
2080   \\hspace #2
2081   \\huge
2082   huge
2083 }
2084 @end lilypond"
2085   (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg))
2086
2087 (define-markup-command (large layout props arg)
2088   (markup?)
2089   #:category font
2090   "Set font size to +1.
2091
2092 @lilypond[verbatim,quote]
2093 \\markup {
2094   default
2095   \\hspace #2
2096   \\large
2097   large
2098 }
2099 @end lilypond"
2100   (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg))
2101
2102 (define-markup-command (normalsize layout props arg)
2103   (markup?)
2104   #:category font
2105   "Set font size to default.
2106
2107 @lilypond[verbatim,quote]
2108 \\markup {
2109   \\teeny {
2110     this is very small
2111     \\hspace #2
2112     \\normalsize {
2113       normal size
2114     }
2115     \\hspace #2
2116     teeny again
2117   }
2118 }
2119 @end lilypond"
2120   (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg))
2121
2122 (define-markup-command (small layout props arg)
2123   (markup?)
2124   #:category font
2125   "Set font size to -1.
2126
2127 @lilypond[verbatim,quote]
2128 \\markup {
2129   default
2130   \\hspace #2
2131   \\small
2132   small
2133 }
2134 @end lilypond"
2135   (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg))
2136
2137 (define-markup-command (tiny layout props arg)
2138   (markup?)
2139   #:category font
2140   "Set font size to -2.
2141
2142 @lilypond[verbatim,quote]
2143 \\markup {
2144   default
2145   \\hspace #2
2146   \\tiny
2147   tiny
2148 }
2149 @end lilypond"
2150   (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg))
2151
2152 (define-markup-command (teeny layout props arg)
2153   (markup?)
2154   #:category font
2155   "Set font size to -3.
2156
2157 @lilypond[verbatim,quote]
2158 \\markup {
2159   default
2160   \\hspace #2
2161   \\teeny
2162   teeny
2163 }
2164 @end lilypond"
2165   (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg))
2166
2167 (define-markup-command (fontCaps layout props arg)
2168   (markup?)
2169   #:category font
2170   "Set @code{font-shape} to @code{caps}
2171
2172 Note: @code{\\fontCaps} requires the installation and selection of
2173 fonts which support the @code{caps} font shape."
2174   (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
2175
2176 ;; Poor man's caps
2177 (define-markup-command (smallCaps layout props arg)
2178   (markup?)
2179   #:category font
2180   "Emit @var{arg} as small caps.
2181
2182 Note: @code{\\smallCaps} does not support accented characters.
2183
2184 @lilypond[verbatim,quote]
2185 \\markup {
2186   default
2187   \\hspace #2
2188   \\smallCaps {
2189     Text in small caps
2190   }
2191 }
2192 @end lilypond"
2193   (define (char-list->markup chars lower)
2194     (let ((final-string (string-upcase (reverse-list->string chars))))
2195       (if lower
2196           (markup #:fontsize -2 final-string)
2197           final-string)))
2198   (define (make-small-caps rest-chars currents current-is-lower prev-result)
2199     (if (null? rest-chars)
2200         (make-concat-markup
2201           (reverse! (cons (char-list->markup currents current-is-lower)
2202                           prev-result)))
2203         (let* ((ch (car rest-chars))
2204                (is-lower (char-lower-case? ch)))
2205           (if (or (and current-is-lower is-lower)
2206                   (and (not current-is-lower) (not is-lower)))
2207               (make-small-caps (cdr rest-chars)
2208                                (cons ch currents)
2209                                is-lower
2210                                prev-result)
2211               (make-small-caps (cdr rest-chars)
2212                                (list ch)
2213                                is-lower
2214                                (if (null? currents)
2215                                    prev-result
2216                                    (cons (char-list->markup
2217                                             currents current-is-lower)
2218                                          prev-result)))))))
2219   (interpret-markup layout props
2220     (if (string? arg)
2221         (make-small-caps (string->list arg) (list) #f (list))
2222         arg)))
2223
2224 (define-markup-command (caps layout props arg)
2225   (markup?)
2226   #:category font
2227   "Copy of the @code{\\smallCaps} command.
2228
2229 @lilypond[verbatim,quote]
2230 \\markup {
2231   default
2232   \\hspace #2
2233   \\caps {
2234     Text in small caps
2235   }
2236 }
2237 @end lilypond"
2238   (interpret-markup layout props (make-smallCaps-markup arg)))
2239
2240 (define-markup-command (dynamic layout props arg)
2241   (markup?)
2242   #:category font
2243   "Use the dynamic font.  This font only contains @b{s}, @b{f}, @b{m},
2244 @b{z}, @b{p}, and @b{r}.  When producing phrases, like
2245 @q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be
2246 done in a different font.  The recommended font for this is bold and italic.
2247 @lilypond[verbatim,quote]
2248 \\markup {
2249   \\dynamic {
2250     sfzp
2251   }
2252 }
2253 @end lilypond"
2254   (interpret-markup
2255    layout (prepend-alist-chain 'font-encoding 'fetaText props) arg))
2256
2257 (define-markup-command (text layout props arg)
2258   (markup?)
2259   #:category font
2260   "Use a text font instead of music symbol or music alphabet font.
2261
2262 @lilypond[verbatim,quote]
2263 \\markup {
2264   \\number {
2265     1, 2,
2266     \\text {
2267       three, four,
2268     }
2269     5
2270   }
2271 }
2272 @end lilypond"
2273
2274   ;; ugh - latin1
2275   (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props)
2276                     arg))
2277
2278 (define-markup-command (italic layout props arg)
2279   (markup?)
2280   #:category font
2281   "Use italic @code{font-shape} for @var{arg}.
2282
2283 @lilypond[verbatim,quote]
2284 \\markup {
2285   default
2286   \\hspace #2
2287   \\italic
2288   italic
2289 }
2290 @end lilypond"
2291   (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg))
2292
2293 (define-markup-command (typewriter layout props arg)
2294   (markup?)
2295   #:category font
2296   "Use @code{font-family} typewriter for @var{arg}.
2297
2298 @lilypond[verbatim,quote]
2299 \\markup {
2300   default
2301   \\hspace #2
2302   \\typewriter
2303   typewriter
2304 }
2305 @end lilypond"
2306   (interpret-markup
2307    layout (prepend-alist-chain 'font-family 'typewriter props) arg))
2308
2309 (define-markup-command (upright layout props arg)
2310   (markup?)
2311   #:category font
2312   "Set @code{font-shape} to @code{upright}.  This is the opposite
2313 of @code{italic}.
2314
2315 @lilypond[verbatim,quote]
2316 \\markup {
2317   \\italic {
2318     italic text
2319     \\hspace #2
2320     \\upright {
2321       upright text
2322     }
2323     \\hspace #2
2324     italic again
2325   }
2326 }
2327 @end lilypond"
2328   (interpret-markup
2329    layout (prepend-alist-chain 'font-shape 'upright props) arg))
2330
2331 (define-markup-command (medium layout props arg)
2332   (markup?)
2333   #:category font
2334   "Switch to medium font-series (in contrast to bold).
2335
2336 @lilypond[verbatim,quote]
2337 \\markup {
2338   \\bold {
2339     some bold text
2340     \\hspace #2
2341     \\medium {
2342       medium font series
2343     }
2344     \\hspace #2
2345     bold again
2346   }
2347 }
2348 @end lilypond"
2349   (interpret-markup layout (prepend-alist-chain 'font-series 'medium props)
2350                     arg))
2351
2352 (define-markup-command (normal-text layout props arg)
2353   (markup?)
2354   #:category font
2355   "Set all font related properties (except the size) to get the default
2356 normal text font, no matter what font was used earlier.
2357
2358 @lilypond[verbatim,quote]
2359 \\markup {
2360   \\huge \\bold \\sans \\caps {
2361     Some text with font overrides
2362     \\hspace #2
2363     \\normal-text {
2364       Default text, same font-size
2365     }
2366     \\hspace #2
2367     More text as before
2368   }
2369 }
2370 @end lilypond"
2371   ;; ugh - latin1
2372   (interpret-markup layout
2373                     (cons '((font-family . roman) (font-shape . upright)
2374                             (font-series . medium) (font-encoding . latin1))
2375                           props)
2376                     arg))
2377
2378 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2379 ;; symbols.
2380 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2381
2382 (define-markup-command (doublesharp layout props)
2383   ()
2384   #:category music
2385   "Draw a double sharp symbol.
2386
2387 @lilypond[verbatim,quote]
2388 \\markup {
2389   \\doublesharp
2390 }
2391 @end lilypond"
2392   (interpret-markup layout props (markup #:musicglyph (assoc-get 1 standard-alteration-glyph-name-alist ""))))
2393
2394 (define-markup-command (sesquisharp layout props)
2395   ()
2396   #:category music
2397   "Draw a 3/2 sharp symbol.
2398
2399 @lilypond[verbatim,quote]
2400 \\markup {
2401   \\sesquisharp
2402 }
2403 @end lilypond"
2404   (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
2405
2406 (define-markup-command (sharp layout props)
2407   ()
2408   #:category music
2409   "Draw a sharp symbol.
2410
2411 @lilypond[verbatim,quote]
2412 \\markup {
2413   \\sharp
2414 }
2415 @end lilypond"
2416   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/2 standard-alteration-glyph-name-alist ""))))
2417
2418 (define-markup-command (semisharp layout props)
2419   ()
2420   #:category music
2421   "Draw a semisharp symbol.
2422
2423 @lilypond[verbatim,quote]
2424 \\markup {
2425   \\semisharp
2426 }
2427 @end lilypond"
2428   (interpret-markup layout props (markup #:musicglyph (assoc-get 1/4 standard-alteration-glyph-name-alist ""))))
2429
2430 (define-markup-command (natural layout props)
2431   ()
2432   #:category music
2433   "Draw a natural symbol.
2434
2435 @lilypond[verbatim,quote]
2436 \\markup {
2437   \\natural
2438 }
2439 @end lilypond"
2440   (interpret-markup layout props (markup #:musicglyph (assoc-get 0 standard-alteration-glyph-name-alist ""))))
2441
2442 (define-markup-command (semiflat layout props)
2443   ()
2444   #:category music
2445   "Draw a semiflat symbol.
2446
2447 @lilypond[verbatim,quote]
2448 \\markup {
2449   \\semiflat
2450 }
2451 @end lilypond"
2452   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/4 standard-alteration-glyph-name-alist ""))))
2453
2454 (define-markup-command (flat layout props)
2455   ()
2456   #:category music
2457   "Draw a flat symbol.
2458
2459 @lilypond[verbatim,quote]
2460 \\markup {
2461   \\flat
2462 }
2463 @end lilypond"
2464   (interpret-markup layout props (markup #:musicglyph (assoc-get -1/2 standard-alteration-glyph-name-alist ""))))
2465
2466 (define-markup-command (sesquiflat layout props)
2467   ()
2468   #:category music
2469   "Draw a 3/2 flat symbol.
2470
2471 @lilypond[verbatim,quote]
2472 \\markup {
2473   \\sesquiflat
2474 }
2475 @end lilypond"
2476   (interpret-markup layout props (markup #:musicglyph (assoc-get -3/4 standard-alteration-glyph-name-alist ""))))
2477
2478 (define-markup-command (doubleflat layout props)
2479   ()
2480   #:category music
2481   "Draw a double flat symbol.
2482
2483 @lilypond[verbatim,quote]
2484 \\markup {
2485   \\doubleflat
2486 }
2487 @end lilypond"
2488   (interpret-markup layout props (markup #:musicglyph (assoc-get -1 standard-alteration-glyph-name-alist ""))))
2489
2490 (define-markup-command (with-color layout props color arg)
2491   (color? markup?)
2492   #:category other
2493   "
2494 @cindex coloring text
2495
2496 Draw @var{arg} in color specified by @var{color}.
2497
2498 @lilypond[verbatim,quote]
2499 \\markup {
2500   \\with-color #red
2501   red
2502   \\hspace #2
2503   \\with-color #green
2504   green
2505   \\hspace #2
2506   \\with-color #blue
2507   blue
2508 }
2509 @end lilypond"
2510   (let ((stil (interpret-markup layout props arg)))
2511     (ly:make-stencil (list 'color color (ly:stencil-expr stil))
2512                      (ly:stencil-extent stil X)
2513                      (ly:stencil-extent stil Y))))
2514
2515 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2516 ;; glyphs
2517 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2518
2519 (define-markup-command (arrow-head layout props axis dir filled)
2520   (integer? ly:dir? boolean?)
2521   #:category graphic
2522   "Produce an arrow head in specified direction and axis.
2523 Use the filled head if @var{filled} is specified.
2524 @lilypond[verbatim,quote]
2525 \\markup {
2526   \\fontsize #5 {
2527     \\general-align #Y #DOWN {
2528       \\arrow-head #Y #UP ##t
2529       \\arrow-head #Y #DOWN ##f
2530       \\hspace #2
2531       \\arrow-head #X #RIGHT ##f
2532       \\arrow-head #X #LEFT ##f
2533     }
2534   }
2535 }
2536 @end lilypond"
2537   (let*
2538       ((name (format "arrowheads.~a.~a~a"
2539                      (if filled
2540                          "close"
2541                          "open")
2542                      axis
2543                      dir)))
2544     (ly:font-get-glyph
2545      (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2546                                      props))
2547      name)))
2548
2549 (define-markup-command (musicglyph layout props glyph-name)
2550   (string?)
2551   #:category music
2552   "@var{glyph-name} is converted to a musical symbol; for example,
2553 @code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
2554 the music font.  See @ruser{The Feta font} for a complete listing of
2555 the possible glyphs.
2556
2557 @lilypond[verbatim,quote]
2558 \\markup {
2559   \\musicglyph #\"f\"
2560   \\musicglyph #\"rests.2\"
2561   \\musicglyph #\"clefs.G_change\"
2562 }
2563 @end lilypond"
2564   (let* ((font (ly:paper-get-font layout
2565                                   (cons '((font-encoding . fetaMusic)
2566                                           (font-name . #f))
2567
2568                                                  props)))
2569          (glyph (ly:font-get-glyph font glyph-name)))
2570     (if (null? (ly:stencil-expr glyph))
2571         (ly:warning (_ "Cannot find glyph ~a") glyph-name))
2572
2573     glyph))
2574
2575
2576 (define-markup-command (lookup layout props glyph-name)
2577   (string?)
2578   #:category other
2579   "Lookup a glyph by name.
2580
2581 @lilypond[verbatim,quote]
2582 \\markup {
2583   \\override #'(font-encoding . fetaBraces) {
2584     \\lookup #\"brace200\"
2585     \\hspace #2
2586     \\rotate #180
2587     \\lookup #\"brace180\"
2588   }
2589 }
2590 @end lilypond"
2591   (ly:font-get-glyph (ly:paper-get-font layout props)
2592                      glyph-name))
2593
2594 (define-markup-command (char layout props num)
2595   (integer?)
2596   #:category other
2597   "Produce a single character.  Characters encoded in hexadecimal
2598 format require the prefix @code{#x}.
2599
2600 @lilypond[verbatim,quote]
2601 \\markup {
2602   \\char #65 \\char ##x00a9
2603 }
2604 @end lilypond"
2605   (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num)))
2606
2607 (define number->mark-letter-vector (make-vector 25 #\A))
2608
2609 (do ((i 0 (1+ i))
2610      (j 0 (1+ j)))
2611     ((>= i 26))
2612   (if (= i (- (char->integer #\I) (char->integer #\A)))
2613       (set! i (1+ i)))
2614   (vector-set! number->mark-letter-vector j
2615                (integer->char (+ i (char->integer #\A)))))
2616
2617 (define number->mark-alphabet-vector (list->vector
2618   (map (lambda (i) (integer->char (+ i (char->integer #\A)))) (iota 26))))
2619
2620 (define (number->markletter-string vec n)
2621   "Double letters for big marks."
2622   (let* ((lst (vector-length vec)))
2623
2624     (if (>= n lst)
2625         (string-append (number->markletter-string vec (1- (quotient n lst)))
2626                        (number->markletter-string vec (remainder n lst)))
2627         (make-string 1 (vector-ref vec n)))))
2628
2629 (define-markup-command (markletter layout props num)
2630   (integer?)
2631   #:category other
2632   "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2633 (skipping letter@tie{}I), and continue with double letters.
2634
2635 @lilypond[verbatim,quote]
2636 \\markup {
2637   \\markletter #8
2638   \\hspace #2
2639   \\markletter #26
2640 }
2641 @end lilypond"
2642   (ly:text-interface::interpret-markup layout props
2643     (number->markletter-string number->mark-letter-vector num)))
2644
2645 (define-markup-command (markalphabet layout props num)
2646   (integer?)
2647   #:category other
2648    "Make a markup letter for @var{num}.  The letters start with A to@tie{}Z
2649 and continue with double letters.
2650
2651 @lilypond[verbatim,quote]
2652 \\markup {
2653   \\markalphabet #8
2654   \\hspace #2
2655   \\markalphabet #26
2656 }
2657 @end lilypond"
2658    (ly:text-interface::interpret-markup layout props
2659      (number->markletter-string number->mark-alphabet-vector num)))
2660
2661 (define-public (horizontal-slash-interval num forward number-interval mag)
2662   (if forward
2663     (cond ;((= num 6) (interval-widen number-interval (* mag 0.5)))
2664           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2665           (else (interval-widen number-interval (* mag 0.25))))
2666     (cond ((= num 6) (interval-widen number-interval (* mag 0.5)))
2667           ;((= num 5) (interval-widen number-interval (* mag 0.5)))
2668           (else (interval-widen number-interval (* mag 0.25))))
2669   ))
2670
2671 (define-public (adjust-slash-stencil num forward stencil mag)
2672   (if forward
2673     (cond ((= num 2)
2674               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2675           ((= num 3)
2676               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2))))
2677           ;((= num 5)
2678               ;(ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07))))
2679           ;((= num 7)
2680           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2681           (else stencil))
2682     (cond ((= num 6)
2683               (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15))))
2684           ;((= num 8)
2685           ;    (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15))))
2686           (else stencil))
2687   )
2688 )
2689
2690 (define (slashed-digit-internal layout props num forward font-size thickness)
2691   (let* ((mag (magstep font-size))
2692          (thickness (* mag
2693                        (ly:output-def-lookup layout 'line-thickness)
2694                        thickness))
2695          ; backward slashes might use slope and point in the other direction!
2696          (dy (* mag (if forward 0.4 -0.4)))
2697          (number-stencil (interpret-markup layout
2698                                            (prepend-alist-chain 'font-encoding 'fetaText props)
2699                                            (number->string num)))
2700          (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag))
2701          (center (interval-center (ly:stencil-extent number-stencil Y)))
2702          ; Use the real extents of the slash, not the whole number, because we
2703          ; might translate the slash later on!
2704          (num-y (interval-widen (cons center center) (abs dy)))
2705          (is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
2706          (slash-stencil (if is-sane
2707                             (make-line-stencil thickness
2708                                          (car num-x) (- (interval-center num-y) dy)
2709                                          (cdr num-x) (+ (interval-center num-y) dy))
2710                             #f)))
2711     (if (ly:stencil? slash-stencil)
2712       (begin
2713         ; for some numbers we need to shift the slash/backslash up or down to make
2714         ; the slashed digit look better
2715         (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag))
2716         (set! number-stencil
2717           (ly:stencil-add number-stencil slash-stencil)))
2718       (ly:warning "Unable to create slashed digit ~a" num))
2719     number-stencil))
2720
2721
2722 (define-markup-command (slashed-digit layout props num)
2723   (integer?)
2724   #:category other
2725   #:properties ((font-size 0)
2726                 (thickness 1.6))
2727   "
2728 @cindex slashed digits
2729
2730 A feta number, with slash.  This is for use in the context of
2731 figured bass notation.
2732 @lilypond[verbatim,quote]
2733 \\markup {
2734   \\slashed-digit #5
2735   \\hspace #2
2736   \\override #'(thickness . 3)
2737   \\slashed-digit #7
2738 }
2739 @end lilypond"
2740   (slashed-digit-internal layout props num #t font-size thickness))
2741
2742 (define-markup-command (backslashed-digit layout props num)
2743   (integer?)
2744   #:category other
2745   #:properties ((font-size 0)
2746                 (thickness 1.6))
2747   "
2748 @cindex backslashed digits
2749
2750 A feta number, with backslash.  This is for use in the context of
2751 figured bass notation.
2752 @lilypond[verbatim,quote]
2753 \\markup {
2754   \\backslashed-digit #5
2755   \\hspace #2
2756   \\override #'(thickness . 3)
2757   \\backslashed-digit #7
2758 }
2759 @end lilypond"
2760   (slashed-digit-internal layout props num #f font-size thickness))
2761
2762 ;; eyeglasses
2763 (define eyeglassespath
2764   '((moveto 0.42 0.77)
2765     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
2766     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
2767     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
2768     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
2769     (closepath)
2770     (moveto 2.07 0.77)
2771     (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
2772     (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
2773     (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
2774     (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
2775     (closepath)
2776     (moveto 1.025 0.935)
2777     (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33)
2778     (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33)
2779     (moveto -0.68 0.77)
2780     (rlineto 0.66 1.43)
2781     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)
2782     (moveto 2.07 0.77)
2783     (rlineto 0.66 1.43)
2784     (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)))
2785
2786 (define-markup-command (eyeglasses layout props)
2787   ()
2788   #:category other
2789   "Prints out eyeglasses, indicating strongly to look at the conductor.
2790 @lilypond[verbatim,quote]
2791 \\markup { \\eyeglasses }
2792 @end lilypond"
2793   (interpret-markup layout props
2794     (make-override-markup '(line-cap-style . butt)
2795       (make-path-markup 0.15 eyeglassespath))))
2796
2797 (define-markup-command (left-brace layout props size)
2798   (number?)
2799   #:category other
2800   "
2801 A feta brace in point size @var{size}.
2802
2803 @lilypond[verbatim,quote]
2804 \\markup {
2805   \\left-brace #35
2806   \\hspace #2
2807   \\left-brace #45
2808 }
2809 @end lilypond"
2810   (let* ((font (ly:paper-get-font layout
2811                                   (cons '((font-encoding . fetaBraces)
2812                                           (font-name . #f))
2813                                         props)))
2814          (glyph-count (1- (ly:otf-glyph-count font)))
2815          (scale (ly:output-def-lookup layout 'output-scale))
2816          (scaled-size (/ (ly:pt size) scale))
2817          (glyph (lambda (n)
2818                   (ly:font-get-glyph font (string-append "brace"
2819                                                          (number->string n)))))
2820          (get-y-from-brace (lambda (brace)
2821                              (interval-length
2822                               (ly:stencil-extent (glyph brace) Y))))
2823          (find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size))
2824          (glyph-found (glyph find-brace)))
2825
2826     (if (or (null? (ly:stencil-expr glyph-found))
2827             (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y)))
2828             (> scaled-size (interval-length
2829                             (ly:stencil-extent (glyph glyph-count) Y))))
2830         (begin
2831           (ly:warning (_ "no brace found for point size ~S ") size)
2832           (ly:warning (_ "defaulting to ~S pt")
2833                       (/ (* scale (interval-length
2834                                    (ly:stencil-extent glyph-found Y)))
2835                          (ly:pt 1)))))
2836     glyph-found))
2837
2838 (define-markup-command (right-brace layout props size)
2839   (number?)
2840   #:category other
2841   "
2842 A feta brace in point size @var{size}, rotated 180 degrees.
2843
2844 @lilypond[verbatim,quote]
2845 \\markup {
2846   \\right-brace #45
2847   \\hspace #2
2848   \\right-brace #35
2849 }
2850 @end lilypond"
2851   (interpret-markup layout props (markup #:rotate 180 #:left-brace size)))
2852
2853 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2854 ;; the note command.
2855 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2856
2857 ;; TODO: better syntax.
2858
2859 (define-markup-command (note-by-number layout props log dot-count dir)
2860   (number? number? number?)
2861   #:category music
2862   #:properties ((font-size 0)
2863                 (style '()))
2864   "
2865 @cindex notes within text by log and dot-count
2866
2867 Construct a note symbol, with stem.  By using fractional values for
2868 @var{dir}, longer or shorter stems can be obtained.
2869
2870 @lilypond[verbatim,quote]
2871 \\markup {
2872   \\note-by-number #3 #0 #DOWN
2873   \\hspace #2
2874   \\note-by-number #1 #2 #0.8
2875 }
2876 @end lilypond"
2877   (define (get-glyph-name-candidates dir log style)
2878     (map (lambda (dir-name)
2879            (format "noteheads.~a~a" dir-name
2880                    (if (and (symbol? style)
2881                             (not (equal? 'default style)))
2882                        (select-head-glyph style (min log 2))
2883                        (min log 2))))
2884          (list (if (= dir UP) "u" "d")
2885                "s")))
2886
2887   (define (get-glyph-name font cands)
2888     (if (null? cands)
2889         ""
2890         (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
2891             (get-glyph-name font (cdr cands))
2892             (car cands))))
2893
2894   (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
2895                                                props)))
2896          (size-factor (magstep font-size))
2897          (stem-length (* size-factor (max 3 (- log 1))))
2898          (head-glyph-name
2899           (let ((result (get-glyph-name font (get-glyph-name-candidates
2900                                               (sign dir) log style))))
2901             (if (string-null? result)
2902                 ;; If no glyph name can be found, select default heads.  Though
2903                 ;; this usually means an unsupported style has been chosen, it
2904                 ;; also prevents unrelated 'style settings from other grobs
2905                 ;; (e.g., TextSpanner and TimeSignature) leaking into markup.
2906                 (get-glyph-name font (get-glyph-name-candidates
2907                                       (sign dir) log 'default))
2908                 result)))
2909          (head-glyph (ly:font-get-glyph font head-glyph-name))
2910          (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
2911          (stem-thickness (* size-factor 0.13))
2912          (stemy (* dir stem-length))
2913          (attach-off (cons (interval-index
2914                             (ly:stencil-extent head-glyph X)
2915                             (* (sign dir) (car attach-indices)))
2916                            (* (sign dir) ; fixme, this is inconsistent between X & Y.
2917                               (interval-index
2918                                (ly:stencil-extent head-glyph Y)
2919                                (cdr attach-indices)))))
2920          (stem-glyph (and (> log 0)
2921                           (ly:round-filled-box
2922                            (ordered-cons (car attach-off)
2923                                          (+ (car attach-off)
2924                                             (* (- (sign dir)) stem-thickness)))
2925                            (cons (min stemy (cdr attach-off))
2926                                  (max stemy (cdr attach-off)))
2927                            (/ stem-thickness 3))))
2928
2929          (dot (ly:font-get-glyph font "dots.dot"))
2930          (dotwid (interval-length (ly:stencil-extent dot X)))
2931          (dots (and (> dot-count 0)
2932                     (apply ly:stencil-add
2933                            (map (lambda (x)
2934                                   (ly:stencil-translate-axis
2935                                    dot (* 2 x dotwid) X))
2936                                 (iota dot-count)))))
2937          (flaggl (and (> log 2)
2938                       (ly:stencil-translate
2939                        (ly:font-get-glyph font
2940                                           (string-append "flags."
2941                                                          (if (> dir 0) "u" "d")
2942                                                          (number->string log)))
2943                        (cons (+ (car attach-off) (if (< dir 0)
2944                                                      stem-thickness 0))
2945                              stemy)))))
2946
2947     ;; If there is a flag on an upstem and the stem is short, move the dots
2948     ;; to avoid the flag.  16th notes get a special case because their flags
2949     ;; hang lower than any other flags.
2950     (if (and dots (> dir 0) (> log 2)
2951              (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
2952         (set! dots (ly:stencil-translate-axis dots 0.5 X)))
2953     (if flaggl
2954         (set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
2955     (if (ly:stencil? stem-glyph)
2956         (set! stem-glyph (ly:stencil-add stem-glyph head-glyph))
2957         (set! stem-glyph head-glyph))
2958     (if (ly:stencil? dots)
2959         (set! stem-glyph
2960               (ly:stencil-add
2961                (ly:stencil-translate-axis
2962                 dots
2963                 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
2964                 X)
2965                stem-glyph)))
2966     stem-glyph))
2967
2968 (define-public log2
2969   (let ((divisor (log 2)))
2970     (lambda (z) (inexact->exact (/ (log z) divisor)))))
2971
2972 (define (parse-simple-duration duration-string)
2973   "Parse the `duration-string', e.g. ''4..'' or ''breve.'',
2974 and return a (log dots) list."
2975   (let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)")
2976                             duration-string)))
2977     (if (and match (string=? duration-string (match:substring match 0)))
2978         (let ((len (match:substring match 1))
2979               (dots (match:substring match 2)))
2980           (list (cond ((string=? len "breve") -1)
2981                       ((string=? len "longa") -2)
2982                       ((string=? len "maxima") -3)
2983                       (else (log2 (string->number len))))
2984                 (if dots (string-length dots) 0)))
2985         (ly:error (_ "not a valid duration string: ~a") duration-string))))
2986
2987 (define-markup-command (note layout props duration dir)
2988   (string? number?)
2989   #:category music
2990   #:properties (note-by-number-markup)
2991   "
2992 @cindex notes within text by string
2993
2994 This produces a note with a stem pointing in @var{dir} direction, with
2995 the @var{duration} for the note head type and augmentation dots.  For
2996 example, @code{\\note #\"4.\" #-0.75} creates a dotted quarter note, with
2997 a shortened down stem.
2998
2999 @lilypond[verbatim,quote]
3000 \\markup {
3001   \\override #'(style . cross) {
3002     \\note #\"4..\" #UP
3003   }
3004   \\hspace #2
3005   \\note #\"breve\" #0
3006 }
3007 @end lilypond"
3008   (let ((parsed (parse-simple-duration duration)))
3009     (note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
3010
3011 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3012 ;; translating.
3013 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3014
3015 (define-markup-command (lower layout props amount arg)
3016   (number? markup?)
3017   #:category align
3018   "
3019 @cindex lowering text
3020
3021 Lower @var{arg} by the distance @var{amount}.
3022 A negative @var{amount} indicates raising; see also @code{\\raise}.
3023
3024 @lilypond[verbatim,quote]
3025 \\markup {
3026   one
3027   \\lower #3
3028   two
3029   three
3030 }
3031 @end lilypond"
3032   (ly:stencil-translate-axis (interpret-markup layout props arg)
3033                              (- amount) Y))
3034
3035 (define-markup-command (translate-scaled layout props offset arg)
3036   (number-pair? markup?)
3037   #:category align
3038   #:properties ((font-size 0))
3039   "
3040 @cindex translating text
3041 @cindex scaling text
3042
3043 Translate @var{arg} by @var{offset}, scaling the offset by the
3044 @code{font-size}.
3045
3046 @lilypond[verbatim,quote]
3047 \\markup {
3048   \\fontsize #5 {
3049     * \\translate #'(2 . 3) translate
3050     \\hspace #2
3051     * \\translate-scaled #'(2 . 3) translate-scaled
3052   }
3053 }
3054 @end lilypond"
3055   (let* ((factor (magstep font-size))
3056          (scaled (cons (* factor (car offset))
3057                        (* factor (cdr offset)))))
3058     (ly:stencil-translate (interpret-markup layout props arg)
3059                           scaled)))
3060
3061 (define-markup-command (raise layout props amount arg)
3062   (number? markup?)
3063   #:category align
3064   "
3065 @cindex raising text
3066
3067 Raise @var{arg} by the distance @var{amount}.
3068 A negative @var{amount} indicates lowering, see also @code{\\lower}.
3069
3070 The argument to @code{\\raise} is the vertical displacement amount,
3071 measured in (global) staff spaces.  @code{\\raise} and @code{\\super}
3072 raise objects in relation to their surrounding markups.
3073
3074 If the text object itself is positioned above or below the staff, then
3075 @code{\\raise} cannot be used to move it, since the mechanism that
3076 positions it next to the staff cancels any shift made with
3077 @code{\\raise}.  For vertical positioning, use the @code{padding}
3078 and/or @code{extra-offset} properties.
3079
3080 @lilypond[verbatim,quote]
3081 \\markup {
3082   C
3083   \\small
3084   \\bold
3085   \\raise #1.0
3086   9/7+
3087 }
3088 @end lilypond"
3089   (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y))
3090
3091 (define-markup-command (fraction layout props arg1 arg2)
3092   (markup? markup?)
3093   #:category other
3094   #:properties ((font-size 0))
3095   "
3096 @cindex creating text fractions
3097
3098 Make a fraction of two markups.
3099 @lilypond[verbatim,quote]
3100 \\markup {
3101   Ï€ â‰ˆ
3102   \\fraction 355 113
3103 }
3104 @end lilypond"
3105   (let* ((m1 (interpret-markup layout props arg1))
3106          (m2 (interpret-markup layout props arg2))
3107          (factor (magstep font-size))
3108          (boxdimen (cons (* factor -0.05) (* factor 0.05)))
3109          (padding (* factor 0.2))
3110          (baseline (* factor 0.6))
3111          (offset (* factor 0.75)))
3112     (set! m1 (ly:stencil-aligned-to m1 X CENTER))
3113     (set! m2 (ly:stencil-aligned-to m2 X CENTER))
3114     (let* ((x1 (ly:stencil-extent m1 X))
3115            (x2 (ly:stencil-extent m2 X))
3116            (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0))
3117            ;; should stack mols separately, to maintain LINE on baseline
3118            (stack (stack-lines DOWN padding baseline (list m1 line m2))))
3119       (set! stack
3120             (ly:stencil-aligned-to stack Y CENTER))
3121       (set! stack
3122             (ly:stencil-aligned-to stack X LEFT))
3123       ;; should have EX dimension
3124       ;; empirical anyway
3125       (ly:stencil-translate-axis stack offset Y))))
3126
3127 (define-markup-command (normal-size-super layout props arg)
3128   (markup?)
3129   #:category font
3130   #:properties ((baseline-skip))
3131   "
3132 @cindex setting superscript in standard font size
3133
3134 Set @var{arg} in superscript with a normal font size.
3135
3136 @lilypond[verbatim,quote]
3137 \\markup {
3138   default
3139   \\normal-size-super {
3140     superscript in standard size
3141   }
3142 }
3143 @end lilypond"
3144   (ly:stencil-translate-axis
3145    (interpret-markup layout props arg)
3146    (* 0.5 baseline-skip) Y))
3147
3148 (define-markup-command (super layout props arg)
3149   (markup?)
3150   #:category font
3151   #:properties ((font-size 0)
3152                 (baseline-skip))
3153   "
3154 @cindex superscript text
3155
3156 Set @var{arg} in superscript.
3157
3158 @lilypond[verbatim,quote]
3159 \\markup {
3160   E =
3161   \\concat {
3162     mc
3163     \\super
3164     2
3165   }
3166 }
3167 @end lilypond"
3168   (ly:stencil-translate-axis
3169    (interpret-markup
3170     layout
3171     (cons `((font-size . ,(- font-size 3))) props)
3172     arg)
3173    (* 0.5 baseline-skip)
3174    Y))
3175
3176 (define-markup-command (translate layout props offset arg)
3177   (number-pair? markup?)
3178   #:category align
3179   "
3180 @cindex translating text
3181
3182 Translate @var{arg} relative to its surroundings.  @var{offset}
3183 is a pair of numbers representing the displacement in the X and Y axis.
3184
3185 @lilypond[verbatim,quote]
3186 \\markup {
3187   *
3188   \\translate #'(2 . 3)
3189   \\line { translated two spaces right, three up }
3190 }
3191 @end lilypond"
3192   (ly:stencil-translate (interpret-markup layout props arg)
3193                         offset))
3194
3195 (define-markup-command (sub layout props arg)
3196   (markup?)
3197   #:category font
3198   #:properties ((font-size 0)
3199                 (baseline-skip))
3200   "
3201 @cindex subscript text
3202
3203 Set @var{arg} in subscript.
3204
3205 @lilypond[verbatim,quote]
3206 \\markup {
3207   \\concat {
3208     H
3209     \\sub {
3210       2
3211     }
3212     O
3213   }
3214 }
3215 @end lilypond"
3216   (ly:stencil-translate-axis
3217    (interpret-markup
3218     layout
3219     (cons `((font-size . ,(- font-size 3))) props)
3220     arg)
3221    (* -0.5 baseline-skip)
3222    Y))
3223
3224 (define-markup-command (normal-size-sub layout props arg)
3225   (markup?)
3226   #:category font
3227   #:properties ((baseline-skip))
3228   "
3229 @cindex setting subscript in standard font size
3230
3231 Set @var{arg} in subscript with a normal font size.
3232
3233 @lilypond[verbatim,quote]
3234 \\markup {
3235   default
3236   \\normal-size-sub {
3237     subscript in standard size
3238   }
3239 }
3240 @end lilypond"
3241   (ly:stencil-translate-axis
3242    (interpret-markup layout props arg)
3243    (* -0.5 baseline-skip)
3244    Y))
3245
3246 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3247 ;; brackets.
3248 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3249
3250 (define-markup-command (hbracket layout props arg)
3251   (markup?)
3252   #:category graphic
3253   "
3254 @cindex placing horizontal brackets around text
3255
3256 Draw horizontal brackets around @var{arg}.
3257
3258 @lilypond[verbatim,quote]
3259 \\markup {
3260   \\hbracket {
3261     \\line {
3262       one two three
3263     }
3264   }
3265 }
3266 @end lilypond"
3267   (let ((th 0.1) ;; todo: take from GROB.
3268         (m (interpret-markup layout props arg)))
3269     (bracketify-stencil m X th (* 2.5 th) th)))
3270
3271 (define-markup-command (bracket layout props arg)
3272   (markup?)
3273   #:category graphic
3274   "
3275 @cindex placing vertical brackets around text
3276
3277 Draw vertical brackets around @var{arg}.
3278
3279 @lilypond[verbatim,quote]
3280 \\markup {
3281   \\bracket {
3282     \\note #\"2.\" #UP
3283   }
3284 }
3285 @end lilypond"
3286   (let ((th 0.1) ;; todo: take from GROB.
3287         (m (interpret-markup layout props arg)))
3288     (bracketify-stencil m Y th (* 2.5 th) th)))
3289
3290 (define-markup-command (parenthesize layout props arg)
3291   (markup?)
3292   #:category graphic
3293   #:properties ((angularity 0)
3294                 (padding)
3295                 (size 1)
3296                 (thickness 1)
3297                 (width 0.25))
3298   "
3299 @cindex placing parentheses around text
3300
3301 Draw parentheses around @var{arg}.  This is useful for parenthesizing
3302 a column containing several lines of text.
3303
3304 @lilypond[verbatim,quote]
3305 \\markup {
3306   \\line {
3307     \\parenthesize {
3308       \\column {
3309         foo
3310         bar
3311       }
3312     }
3313     \\override #'(angularity . 2) {
3314       \\parenthesize {
3315         \\column {
3316           bah
3317           baz
3318         }
3319       }
3320     }
3321   }
3322 }
3323 @end lilypond"
3324   (let* ((markup (interpret-markup layout props arg))
3325          (scaled-width (* size width))
3326          (scaled-thickness
3327           (* (chain-assoc-get 'line-thickness props 0.1)
3328              thickness))
3329          (half-thickness
3330           (min (* size 0.5 scaled-thickness)
3331                (* (/ 4 3.0) scaled-width)))
3332          (padding (chain-assoc-get 'padding props half-thickness)))
3333     (parenthesize-stencil
3334      markup half-thickness scaled-width angularity padding)))
3335
3336 \f
3337 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3338 ;; Delayed markup evaluation
3339 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3340
3341 (define-markup-command (page-ref layout props label gauge default)
3342   (symbol? markup? markup?)
3343   #:category other
3344   "
3345 @cindex referencing page numbers in text
3346
3347 Reference to a page number. @var{label} is the label set on the referenced
3348 page (using the @code{\\label} command), @var{gauge} a markup used to estimate
3349 the maximum width of the page number, and @var{default} the value to display
3350 when @var{label} is not found."
3351   (let* ((gauge-stencil (interpret-markup layout props gauge))
3352          (x-ext (ly:stencil-extent gauge-stencil X))
3353          (y-ext (ly:stencil-extent gauge-stencil Y)))
3354     (ly:make-stencil
3355      `(delay-stencil-evaluation
3356        ,(delay (ly:stencil-expr
3357                 (let* ((table (ly:output-def-lookup layout 'label-page-table))
3358                        (page-number (if (list? table)
3359                                         (assoc-get label table)
3360                                         #f))
3361                        (page-markup (if page-number (format "~a" page-number) default))
3362                        (page-stencil (interpret-markup layout props page-markup))
3363                        (gap (- (interval-length x-ext)
3364                                (interval-length (ly:stencil-extent page-stencil X)))))
3365                   (interpret-markup layout props
3366                                     (markup #:concat (#:hspace gap page-markup)))))))
3367      x-ext
3368      y-ext)))
3369
3370 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3371 ;; scaling
3372 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3373
3374 (define-markup-command (scale layout props factor-pair arg)
3375   (number-pair? markup?)
3376   #:category graphic
3377   "
3378 @cindex scaling markup
3379 @cindex mirroring markup
3380
3381 Scale @var{arg}.  @var{factor-pair} is a pair of numbers
3382 representing the scaling-factor in the X and Y axes.
3383 Negative values may be used to produce mirror images.
3384
3385 @lilypond[verbatim,quote]
3386 \\markup {
3387   \\line {
3388     \\scale #'(2 . 1)
3389     stretched
3390     \\scale #'(1 . -1)
3391     mirrored
3392   }
3393 }
3394 @end lilypond"
3395   (let ((stil (interpret-markup layout props arg))
3396         (sx (car factor-pair))
3397         (sy (cdr factor-pair)))
3398     (ly:stencil-scale stil sx sy)))
3399
3400 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3401 ;; Markup list commands
3402 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3403
3404 (define-public (space-lines baseline stils)
3405   (let space-stil ((stils stils)
3406                    (result (list)))
3407     (if (null? stils)
3408         (reverse! result)
3409         (let* ((stil (car stils))
3410                (dy-top (max (- (/ baseline 1.5)
3411                                (interval-bound (ly:stencil-extent stil Y) UP))
3412                             0.0))
3413                (dy-bottom (max (+ (/ baseline 3.0)
3414                                   (interval-bound (ly:stencil-extent stil Y) DOWN))
3415                                0.0))
3416                (new-stil (ly:make-stencil
3417                           (ly:stencil-expr stil)
3418                           (ly:stencil-extent stil X)
3419                           (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN)
3420                                    dy-bottom)
3421                                 (+ (interval-bound (ly:stencil-extent stil Y) UP)
3422                                    dy-top)))))
3423           (space-stil (cdr stils) (cons new-stil result))))))
3424
3425 (define-markup-list-command (justified-lines layout props args)
3426   (markup-list?)
3427   #:properties ((baseline-skip)
3428                 wordwrap-internal-markup-list)
3429   "
3430 @cindex justifying lines of text
3431
3432 Like @code{\\justify}, but return a list of lines instead of a single markup.
3433 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
3434 @var{X}@tie{}is the number of staff spaces."
3435   (space-lines baseline-skip
3436                (interpret-markup-list layout props
3437                                       (make-wordwrap-internal-markup-list #t args))))
3438
3439 (define-markup-list-command (wordwrap-lines layout props args)
3440   (markup-list?)
3441   #:properties ((baseline-skip)
3442                 wordwrap-internal-markup-list)
3443   "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
3444 Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
3445 where @var{X} is the number of staff spaces."
3446   (space-lines baseline-skip
3447                (interpret-markup-list layout props
3448                                       (make-wordwrap-internal-markup-list #f args))))
3449
3450 (define-markup-list-command (column-lines layout props args)
3451   (markup-list?)
3452   #:properties ((baseline-skip))
3453   "Like @code{\\column}, but return a list of lines instead of a single markup.
3454 @code{baseline-skip} determines the space between each markup in @var{args}."
3455   (space-lines baseline-skip
3456                (interpret-markup-list layout props args)))
3457
3458 (define-markup-list-command (override-lines layout props new-prop args)
3459   (pair? markup-list?)
3460   "Like @code{\\override}, for markup lists."
3461   (interpret-markup-list layout (cons (list new-prop) props) args))