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