1;;;; This file is part of LilyPond, the GNU music typesetter. 2;;;; 3;;;; Copyright (C) 2000--2021 Han-Wen Nienhuys <hanwen@xs4all.nl> 4;;;; Jan Nieuwenhuizen <janneke@gnu.org> 5;;;; 6;;;; LilyPond is free software: you can redistribute it and/or modify 7;;;; it under the terms of the GNU General Public License as published by 8;;;; the Free Software Foundation, either version 3 of the License, or 9;;;; (at your option) any later version. 10;;;; 11;;;; LilyPond is distributed in the hope that it will be useful, 12;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of 13;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14;;;; GNU General Public License for more details. 15;;;; 16;;;; You should have received a copy of the GNU General Public License 17;;;; along with LilyPond. If not, see <http://www.gnu.org/licenses/>. 18 19;;; 20;;; Markup commands and markup-list commands definitions. 21;;; 22;;; Markup commands which are part of LilyPond, are defined 23;;; in the (lily) module, which is the current module in this file, 24;;; using the `define-markup-command' macro. 25;;; 26;;; Usage: 27;;; 28;;; (define-markup-command (command-name layout props args...) 29;;; args-signature 30;;; [ #:category category ] 31;;; [ #:properties property-bindings ] 32;;; documentation-string 33;;; ..body..) 34;;; 35;;; with: 36;;; command-name 37;;; the name of the markup command 38;;; 39;;; layout and props 40;;; arguments that are automatically passed to the command when it 41;;; is interpreted. 42;;; `layout' is an output def, which properties can be accessed 43;;; using `ly:output-def-lookup'. 44;;; `props' is a list of property settings which can be accessed 45;;; using `chain-assoc-get' (more on that below) 46;;; 47;;; args... 48;;; the command arguments. 49;;; There is no limitation on the order of command arguments. 50;;; However, markup functions taking a markup as their last 51;;; argument are somewhat special as you can apply them to a 52;;; markup list, and the result is a markup list where the 53;;; markup function (with the specified leading arguments) has 54;;; been applied to every element of the original markup list. 55;;; 56;;; Since replicating the leading arguments for applying a 57;;; markup function to a markup list is cheap mostly for 58;;; Scheme arguments, you avoid performance pitfalls by just 59;;; using Scheme arguments for the leading arguments of markup 60;;; functions that take a markup as their last argument. 61;;; 62;;; args-signature 63;;; the arguments signature, i.e., a list of type predicates which 64;;; are used to type check the arguments, and also to define the general 65;;; argument types (markup, markup-list, scheme) that the command is 66;;; expecting. 67;;; For instance, if a command expects a number, then a markup, the 68;;; signature would be: (number? markup?) 69;;; 70;;; category 71;;; for documentation purpose, builtin markup commands are grouped by 72;;; category. This can be any symbol. When documentation is generated, 73;;; the symbol is converted to a capitalized string, where hyphens are 74;;; replaced by spaces. 75;;; 76;;; property-bindings 77;;; this is used both for documentation generation, and to ease 78;;; programming the command itself. It is list of 79;;; (property-name default-value) 80;;; or (property-name) 81;;; elements. Each property is looked-up in the `props' argument, and 82;;; the symbol naming the property is bound to its value. 83;;; When the property is not found in `props', then the symbol is bound 84;;; to the given default value. When no default value is given, #f is 85;;; used instead. 86;;; Thus, using the following property bindings: 87;;; ((thickness 0.1) 88;;; (font-size 0)) 89;;; is equivalent to writing: 90;;; (let ((thickness (chain-assoc-get 'thickness props 0.1)) 91;;; (font-size (chain-assoc-get 'font-size props 0))) 92;;; ..body..) 93;;; When a command `B' internally calls an other command `A', it may 94;;; desirable to see in `B' documentation all the properties and 95;;; default values used by `A'. In that case, add `A-markup' to the 96;;; property-bindings of B. (This is used when generating 97;;; documentation, but won't create bindings.) 98;;; 99;;; documentation-string 100;;; the command documentation string (used to generate manuals) 101;;; 102;;; body 103;;; the command body. The function must return a stencil. 104;;; 105;;; Each markup command definition shall have a documentation string 106;;; with description, syntax and example. 107 108(use-modules (ice-9 regex)) 109 110;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 111;; utility functions 112;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 113 114(define-public empty-stencil (ly:make-stencil '() 115 empty-interval empty-interval)) 116(define-public point-stencil (ly:make-stencil "" '(0 . 0) '(0 . 0))) 117 118;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 119;; line has to come early since it is often used implicitly from the 120;; markup macro since \markup { a b c } -> \markup \line { a b c } 121;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 122 123(eval-early 124 (define-markup-command (line layout props args) 125 (markup-list?) 126 #:category align 127 #:properties ((word-space) 128 (text-direction RIGHT)) 129 "Put @var{args} in a horizontal line. The property @code{word-space} 130determines the space between markups in @var{args}. 131 132@lilypond[verbatim,quote] 133\\markup { 134 \\line { 135 one two three 136 } 137} 138@end lilypond" 139 (let ((stencils (interpret-markup-list layout props args))) 140 (if (= text-direction LEFT) 141 (set! stencils (reverse stencils))) 142 (stack-stencil-line word-space stencils)))) 143 144;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 145;; geometric shapes 146;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 147 148;; TODO: clean this up a bit. User interfaces are not consistent. 149;; - filled is sometimes a parameter, sometimes a property. blot 150;; likewise (called corner-radius for \rounded-box). 151;; - Not all \xxx commands that draw something around an argument 152;; have a \draw-xxx counterpart drawing the shape in a standalone 153;; fashion. 154 155(define-markup-command (draw-line layout props dest) 156 (number-pair?) 157 #:category graphic 158 #:properties ((thickness 1)) 159 " 160@cindex drawing line, within text 161 162A simple line. 163@lilypond[verbatim,quote] 164\\markup { 165 \\draw-line #'(4 . 4) 166 \\override #'(thickness . 5) 167 \\draw-line #'(-3 . 0) 168} 169@end lilypond" 170 (let ((th (* (ly:output-def-lookup layout 'line-thickness) 171 thickness)) 172 (x (car dest)) 173 (y (cdr dest))) 174 (make-line-stencil th 0 0 x y))) 175 176(define-markup-command (draw-dashed-line layout props dest) 177 (number-pair?) 178 #:category graphic 179 #:properties ((thickness 1) 180 (on 1) 181 (off 1) 182 (phase 0) 183 (full-length #t)) 184 " 185@cindex drawing dashed line, within text 186 187A dashed line. 188 189If @code{full-length} is set to #t (default) the dashed-line extends to the 190whole length given by @var{dest}, without white space at beginning or end. 191@code{off} will then be altered to fit. 192To insist on the given (or default) values of @code{on}, @code{off} use 193@code{\\override #'(full-length . #f)} 194Manual settings for @code{on},@code{off} and @code{phase} are possible. 195@lilypond[verbatim,quote] 196\\markup { 197 \\draw-dashed-line #'(5.1 . 2.3) 198 \\override #'((on . 0.3) (off . 0.5)) 199 \\draw-dashed-line #'(5.1 . 2.3) 200} 201@end lilypond" 202 (let* ((line-thickness (ly:output-def-lookup layout 'line-thickness)) 203 ;; Calculate the thickness to be used. 204 (th (* line-thickness thickness)) 205 (half-thick (/ th 2)) 206 ;; Get the extensions in x- and y-direction. 207 (x (car dest)) 208 (y (cdr dest)) 209 ;; Calculate the length of the dashed line. 210 (line-length (sqrt (+ (expt x 2) (expt y 2))))) 211 212 (if (and full-length (not (= (+ on off) 0))) 213 (begin 214 ;; Add double-thickness to avoid overlapping. 215 (set! off (+ (* 2 th) off)) 216 (let* (;; Make a guess how often the off/on-pair should be printed 217 ;; after the initial `on´. 218 ;; Assume a minimum of 1 to avoid division by zero. 219 (guess (max 1 (round (/ (- line-length on) (+ off on))))) 220 ;; Not sure about the value or why corr is necessary at all, 221 ;; but it seems to be necessary. 222 (corr (if (= on 0) 223 (/ line-thickness 10) 224 0)) 225 ;; Calculate a new value for off to fit the 226 ;; line-length. 227 (new-off (/ (- line-length corr (* (1+ guess) on)) guess)) 228 ) 229 (cond 230 231 ;; Settings for (= on 0). Resulting in a dotted line. 232 233 ;; If line-length isn't shorter than `th´, change the given 234 ;; value for `off´ to fit the line-length. 235 ((and (= on 0) (< th line-length)) 236 (set! off new-off)) 237 238 ;; If the line-length is shorter than `th´, it makes no 239 ;; sense to adjust `off´. The rounded edges of the lines 240 ;; would prevent any nice output. 241 ;; Do nothing. 242 ;; This will result in a single dot for very short lines. 243 ((and (= on 0) (>= th line-length)) 244 #f) 245 246 ;; Settings for (not (= on 0)). Resulting in a dashed line. 247 248 ;; If line-length isn't shorter than one go of on-off-on, 249 ;; change the given value for `off´ to fit the line-length. 250 ((< (+ (* 2 on) off) line-length) 251 (set! off new-off)) 252 ;; If the line-length is too short, but greater than 253 ;; (* 4 th) set on/off to (/ line-length 3) 254 ((< (* 4 th) line-length) 255 (set! on (/ line-length 3)) 256 (set! off (/ line-length 3))) 257 ;; If the line-length is shorter than (* 4 th), it makes 258 ;; no sense trying to adjust on/off. The rounded edges of 259 ;; the lines would prevent any nice output. 260 ;; Simply set `on´ to line-length. 261 (else 262 (set! on line-length)))))) 263 264 ;; If `on´ or `off´ is negative, or the sum of `on' and `off' equals zero a 265 ;; ghostscript-error occurs while calling 266 ;; (ly:make-stencil (list 'dashed-line th on off x y phase) x-ext y-ext) 267 ;; Better be paranoid. 268 (if (or (= (+ on off) 0) 269 (negative? on) 270 (negative? off)) 271 (begin 272 (ly:warning (_ "Can't print a line - setting on/off to default")) 273 (set! on 1) 274 (set! off 1))) 275 276 ;; To give the lines produced by \draw-line and \draw-dashed-line the same 277 ;; length, half-thick has to be added to the stencil-extensions. 278 (ly:make-stencil 279 (list 'dashed-line th on off x y phase) 280 (interval-widen (ordered-cons 0 x) half-thick) 281 (interval-widen (ordered-cons 0 y) half-thick)))) 282 283(define-markup-command (draw-dotted-line layout props dest) 284 (number-pair?) 285 #:category graphic 286 #:properties ((thickness 1) 287 (off 1) 288 (phase 0)) 289 " 290@cindex drawing dotted line, within text 291 292A dotted line. 293 294The dotted-line always extends to the whole length given by @var{dest}, without 295white space at beginning or end. 296Manual settings for @code{off} are possible to get larger or smaller space 297between the dots. 298The given (or default) value of @code{off} will be altered to fit the 299line-length. 300@lilypond[verbatim,quote] 301\\markup { 302 \\draw-dotted-line #'(5.1 . 2.3) 303 \\override #'((thickness . 2) (off . 0.2)) 304 \\draw-dotted-line #'(5.1 . 2.3) 305} 306@end lilypond" 307 308 (let ((new-props (prepend-alist-chain 'on 0 309 (prepend-alist-chain 'full-length #t props)))) 310 311 (interpret-markup layout 312 new-props 313 (make-draw-dashed-line-markup dest)))) 314 315(define-markup-command (draw-squiggle-line layout props sq-length dest eq-end?) 316 (number? number-pair? boolean?) 317 #:category graphic 318 #:properties ((thickness 0.5) 319 (angularity 0) 320 (height 0.5) 321 (orientation 1)) 322 " 323@cindex drawing squiggled line, within text 324 325A squiggled line. 326 327If @code{eq-end?} is set to @code{#t}, it is ensured the squiggled line ends 328with a bow in same direction as the starting one. @code{sq-length} is the 329length of the first bow. @code{dest} is the end point of the squiggled line. 330To match @code{dest} the squiggled line is scaled accordingly. 331Its appearance may be customized by overrides for @code{thickness}, 332@code{angularity}, @code{height} and @code{orientation}. 333@lilypond[verbatim,quote] 334\\markup 335 \\column { 336 \\draw-squiggle-line #0.5 #'(6 . 0) ##t 337 \\override #'(orientation . -1) 338 \\draw-squiggle-line #0.5 #'(6 . 0) ##t 339 \\draw-squiggle-line #0.5 #'(6 . 0) ##f 340 \\override #'(height . 1) 341 \\draw-squiggle-line #0.5 #'(6 . 0) ##t 342 \\override #'(thickness . 5) 343 \\draw-squiggle-line #0.5 #'(6 . 0) ##t 344 \\override #'(angularity . 2) 345 \\draw-squiggle-line #0.5 #'(6 . 0) ##t 346 } 347@end lilypond" 348 (let* ((line-thickness (ly:output-def-lookup layout 'line-thickness)) 349 (thick (* thickness line-thickness)) 350 (x (car dest)) 351 (y (cdr dest)) 352 (length-to-print (magnitude (make-rectangular x y))) 353 ;; Make a guess how many bows may be needed 354 (guess (max 1 (truncate (/ length-to-print sq-length)))) 355 ;; If `eq-end?' is set #t, make sure squiggle-line starts and ends 356 ;; with a bow in same direction 357 (amount (if (and (even? guess) eq-end?) (1+ guess) guess)) 358 ;; The lined-up bows needs to fit `length-to-print' 359 ;; Thus scale the length of first bow accordingly 360 ;; Other bows are copies 361 (guessed-squiggle-line-length (* amount sq-length)) 362 (line-length-diff (- length-to-print guessed-squiggle-line-length)) 363 (line-length-diff-for-each-squiggle 364 (/ line-length-diff amount)) 365 (first-bow-length (+ sq-length line-length-diff-for-each-squiggle)) 366 ;; Get first bows 367 ;; TODO two bows are created via `make-bow-stencil' 368 ;; cheaper to use `ly:stencil-scale'? 369 (first-bow-end-coord 370 (cons 371 (/ (* first-bow-length x) length-to-print) 372 (/ (* first-bow-length y) length-to-print))) 373 (init-bow 374 (lambda (o) 375 (make-bow-stencil 376 '(0 . 0) 377 first-bow-end-coord 378 thick angularity height o))) 379 (init-bow-up (init-bow orientation)) 380 (init-bow-down (init-bow (- orientation))) 381 ;; Get a list of starting-points for the bows 382 (list-of-starts 383 (map 384 (lambda (n) 385 (cons 386 (* n (car first-bow-end-coord)) 387 (* n (cdr first-bow-end-coord)))) 388 (iota amount)))) 389 ;; The final stencil: lined-up bows 390 (apply ly:stencil-add 391 (map 392 ly:stencil-translate 393 (circular-list init-bow-up init-bow-down) 394 list-of-starts)))) 395 396(define-markup-command (draw-hline layout props) 397 () 398 #:category graphic 399 #:properties ((draw-line-markup) 400 (line-width) 401 (span-factor 1)) 402 " 403@cindex drawing line, across a page 404 405Draws a line across a page, where the property @code{span-factor} 406controls what fraction of the page is taken up. 407@lilypond[verbatim,quote,line-width=14\\cm] 408\\markup { 409 \\column { 410 \\draw-hline 411 \\override #'(span-factor . 1/3) 412 \\draw-hline 413 } 414} 415@end lilypond" 416 (interpret-markup layout 417 props 418 (make-draw-line-markup (cons (* line-width 419 span-factor) 420 0)))) 421 422;; FIXME: when thickness is exactly 0, the border doesn't look 423;; smooth at least in Frescobaldi's PDF viewer. Not sure on 424;; which side the problem is. --Jean AS 425(define-markup-command (draw-circle layout props radius thickness filled) 426 (number? number? boolean?) 427 #:category graphic 428 " 429@cindex drawing circle, within text 430 431A circle of radius @var{radius} and thickness @var{thickness}, 432optionally filled. 433 434@lilypond[verbatim,quote] 435\\markup { 436 \\draw-circle #2 #0.5 ##f 437 \\hspace #2 438 \\draw-circle #2 #0 ##t 439} 440@end lilypond" 441 (make-circle-stencil radius thickness filled)) 442 443(define-markup-command (polygon layout props points) 444 (number-pair-list?) 445 #:category graphic 446 #:properties ((extroversion 0) ; Same default as ly:round-polygon. 447 (filled #t) 448 (thickness 1)) 449 " 450@cindex drawing polygon 451 452A polygon delimited by the list of @var{points}. @var{extroversion} 453defines how the shape of the polygon is adapted to its thickness. 454If it is@tie{}0, the polygon is traced as-is. If@tie{}-1, the outer side 455of the line is just on the given points. If@tie{}1, the line has its 456inner side on the points. The @var{thickness} property controls the 457thickness of the line; for filled polygons, this means the diameter 458of the blot. 459 460@lilypond[verbatim,quote] 461regularPentagon = 462 #'((1 . 0) (0.31 . 0.95) (-0.81 . 0.59) 463 (-0.81 . -0.59) (0.31 . -0.95)) 464 465\\markup { 466 \\polygon #'((-1 . -1) (0 . -3) (2 . 2) (1 . 2)) 467 \\override #'(filled . #f) 468 \\override #'(thickness . 2) 469 \\combine 470 \\with-color \"blue\" 471 \\polygon #regularPentagon 472 \\with-color \"red\" 473 \\override #'(extroversion . 1) 474 \\polygon #regularPentagon 475} 476@end lilypond" 477 (ly:round-polygon 478 points 479 (* thickness (ly:output-def-lookup layout 'line-thickness)) 480 extroversion 481 filled)) 482 483(define-markup-command (triangle layout props filled) 484 (boolean?) 485 #:category graphic 486 #:properties ((extroversion 0) 487 (font-size 0) 488 (thickness 1)) 489 " 490@cindex drawing triangle, within text 491 492A triangle, either filled or empty. 493 494@lilypond[verbatim,quote] 495\\markup { 496 \\triangle ##t 497 \\hspace #2 498 \\triangle ##f 499} 500@end lilypond" 501 ;; The value 1.8 was found by trial and error (previously, it was 0.8 * 502 ;; baseline-skip, which was only effective if the values for baseline-skip 503 ;; and font-size were both close to their default values) 504 (let ((ex (* (magstep font-size) 1.8))) 505 (interpret-markup 506 layout 507 ; TODO: make 'filled' a property rather than a parameter? 508 (cons `((filled . ,filled)) 509 props) 510 (make-polygon-markup 511 (list 512 (cons 0.0 0.0) 513 (cons ex 0.0) 514 (cons (* 0.5 ex) (* 0.86 ex))))))) 515 516(define-markup-command (circle layout props arg) 517 (markup?) 518 #:category graphic 519 #:properties ((thickness 1) 520 (font-size 0) 521 (circle-padding 0.2)) 522 " 523@cindex circling text 524 525Draw a circle around @var{arg}. Use @code{thickness}, 526@code{circle-padding} and @code{font-size} properties to determine line 527thickness and padding around the markup. 528 529@lilypond[verbatim,quote] 530\\markup { 531 \\circle { 532 Hi 533 } 534} 535@end lilypond" 536 (let ((th (* (ly:output-def-lookup layout 'line-thickness) 537 thickness)) 538 (pad (* (magstep font-size) circle-padding)) 539 (m (interpret-markup layout props arg))) 540 (circle-stencil m th pad))) 541 542(define-markup-command (ellipse layout props arg) 543 (markup?) 544 #:category graphic 545 #:properties ((thickness 1) 546 (font-size 0) 547 (x-padding 0.2) 548 (y-padding 0.2)) 549 " 550@cindex drawing ellipse, around text 551 552Draw an ellipse around @var{arg}. Use @code{thickness}, 553@code{x-padding}, @code{y-padding} and @code{font-size} properties to determine 554line thickness and padding around the markup. 555 556@lilypond[verbatim,quote] 557\\markup { 558 \\ellipse { 559 Hi 560 } 561} 562@end lilypond" 563 (let ((th (* (ly:output-def-lookup layout 'line-thickness) 564 thickness)) 565 (pad-x (* (magstep font-size) x-padding)) 566 (pad-y (* (magstep font-size) y-padding)) 567 (m (interpret-markup layout props arg))) 568 (ellipse-stencil m th pad-x pad-y))) 569 570(define-markup-command (oval layout props arg) 571 (markup?) 572 #:category graphic 573 #:properties ((thickness 1) 574 (font-size 0) 575 (x-padding 0.75) 576 (y-padding 0.75)) 577 " 578@cindex drawing oval, around text 579 580Draw an oval around @var{arg}. Use @code{thickness}, 581@code{x-padding}, @code{y-padding} and @code{font-size} properties to determine 582line thickness and padding around the markup. 583 584@lilypond[verbatim,quote] 585\\markup { 586 \\oval { 587 Hi 588 } 589} 590@end lilypond" 591 (let ((th (* (ly:output-def-lookup layout 'line-thickness) 592 thickness)) 593 (pad-x (* (magstep font-size) x-padding)) 594 (pad-y (* (magstep font-size) y-padding)) 595 (m (interpret-markup layout props arg))) 596 (oval-stencil m th pad-x pad-y))) 597 598(define-markup-command (with-url layout props url arg) 599 (string? markup?) 600 #:category graphic 601 " 602@cindex inserting URL link, into text 603 604Add a link to URL @var{url} around @var{arg}. This only works in 605the PDF backend. 606 607@lilypond[verbatim,quote] 608\\markup { 609 \\with-url #\"https://lilypond.org/\" { 610 LilyPond ... \\italic { 611 music notation for everyone 612 } 613 } 614} 615@end lilypond" 616 (let* ((stil (interpret-markup layout props arg)) 617 (xextent (ly:stencil-extent stil X)) 618 (yextent (ly:stencil-extent stil Y)) 619 (old-expr (ly:stencil-expr stil)) 620 (url-expr `(url-link ,url ,xextent ,yextent))) 621 622 (ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil))) 623 624(define-markup-command (page-link layout props page-number arg) 625 (number? markup?) 626 #:category other 627 " 628@cindex referencing page number, in text 629 630Add a link to the page @var{page-number} around @var{arg}. This only works 631in the PDF backend. 632 633@lilypond[verbatim,quote] 634\\markup { 635 \\page-link #2 { \\italic { This links to page 2... } } 636} 637@end lilypond" 638 (let* ((stil (interpret-markup layout props arg)) 639 (xextent (ly:stencil-extent stil X)) 640 (yextent (ly:stencil-extent stil Y)) 641 (old-expr (ly:stencil-expr stil)) 642 (link-expr `(page-link ,page-number ,xextent ,yextent))) 643 644 (ly:stencil-add (ly:make-stencil link-expr xextent yextent) stil))) 645 646(define-public (book-first-page layout props) 647 "Return the @code{'first-page-number} of the entire book." 648 (define (ancestor layout) 649 "Return the topmost layout ancestor" 650 (let ((parent (ly:output-def-parent layout))) 651 (if (not (ly:output-def? parent)) 652 layout 653 (ancestor parent)))) 654 (ly:output-def-lookup (ancestor layout) 'first-page-number)) 655 656(define-markup-command (with-link layout props label arg) 657 (symbol? markup?) 658 #:category other 659 " 660@cindex referencing page label, in text 661 662Add a link to the page holding label @var{label} around @var{arg}. This 663only works in the PDF backend. 664 665@verbatim 666\\markup { 667 \\with-link #'label { 668 \\italic { This links to the page 669 containing the label... } 670 } 671} 672@end verbatim" 673 (let* ((arg-stencil (interpret-markup layout props arg)) 674 (x-ext (ly:stencil-extent arg-stencil X)) 675 (y-ext (ly:stencil-extent arg-stencil Y))) 676 (ly:stencil-add 677 (ly:make-stencil 678 `(delay-stencil-evaluation 679 ,(delay (let* ((table (ly:output-def-lookup layout 'label-page-table)) 680 (table-page-number 681 (if (list? table) 682 (assoc-get label table) 683 #f)) 684 (first-page-number (book-first-page layout props)) 685 (current-page-number 686 (if table-page-number 687 (1+ (- table-page-number first-page-number)) 688 #f))) 689 `(page-link ,current-page-number 690 ,x-ext ,y-ext)))) 691 x-ext 692 y-ext) 693 arg-stencil))) 694 695(define-markup-command (beam layout props width slope thickness) 696 (number? number? number?) 697 #:category graphic 698 " 699@cindex drawing beam, within text 700 701Create a beam with the specified parameters. 702@lilypond[verbatim,quote] 703\\markup { 704 \\beam #5 #1 #2 705} 706@end lilypond" 707 (let* ((y (* slope width)) 708 (yext (cons (min 0 y) (max 0 y))) 709 (half (/ thickness 2))) 710 711 (ly:make-stencil 712 `(polygon ,(list 713 0 (/ thickness -2) 714 width (+ (* width slope) (/ thickness -2)) 715 width (+ (* width slope) (/ thickness 2)) 716 0 (/ thickness 2)) 717 ,(ly:output-def-lookup layout 'blot-diameter) 718 #t) 719 (cons 0 width) 720 (cons (+ (- half) (car yext)) 721 (+ half (cdr yext)))))) 722 723(define-markup-command (underline layout props arg) 724 (markup?) 725 #:category font 726 #:properties ((thickness 1) (offset 2) (underline-shift 0) (underline-skip 2)) 727 " 728@cindex underlining text 729 730Underline @var{arg}. Looks at @code{thickness} to determine line 731thickness, @code{offset} to determine line y-offset from @var{arg} and 732@code{underline-skip} to determine the distance of additional lines from the 733others. 734@code{underline-shift} is used to get subsequent calls correct. Overriding it 735makes little sense, it would end up adding the provided value to the one of 736@code{offset}. 737 738@lilypond[verbatim,quote,line-width=14\\cm] 739\\markup \\justify-line { 740 \\underline \"underlined\" 741 \\override #'(offset . 5) 742 \\override #'(thickness . 1) 743 \\underline \"underlined\" 744 \\override #'(offset . 1) 745 \\override #'(thickness . 5) 746 \\underline \"underlined\" 747 \\override #'(offset . 5) 748 \\override #'(underline-skip . 4) 749 \\underline \\underline \\underline \"multiple underlined\" 750} 751@end lilypond" 752 (let* ((thick (ly:output-def-lookup layout 'line-thickness)) 753 (underline-thick (* thickness thick)) 754 (m (interpret-markup 755 layout 756 ;; For multiple calls of underline-markup, this will result in 757 ;; the innermost underline ending up lowest. 758 (prepend-alist-chain 759 'underline-shift 760 (+ underline-skip underline-shift) 761 props) 762 arg)) 763 (arg-x-ext (ly:stencil-extent m X)) 764 (x1 (car arg-x-ext)) 765 (x2 (cdr arg-x-ext)) 766 (y (* thick (- (+ offset underline-shift)))) 767 (raw-line-stil (make-line-stencil underline-thick x1 y x2 y)) 768 (line 769 (ly:make-stencil 770 (ly:stencil-expr raw-line-stil) 771 ;; We use x-extent of the arg-stencil instead of the line-stencil 772 ;; to avoid increasing lines with multiple calls of underline. 773 ;; As a consequence the line sticks out a bit into the space 774 ;; between elements of continuing text, without affecting it. 775 ;; For huge values of thickness this may cause undesired output, 776 ;; we regard this a very rare case, though. 777 ;; Alternatively we could have shortened the underline by its 778 ;; thickness, i.e. raw-line-stil would have been: 779 ;; (make-line-stencil 780 ;; underline-thick 781 ;; (+ x1 (/ underline-thick 2)) 782 ;; y 783 ;; (- x2 (/ underline-thick 2)) 784 ;; y)) 785 ;; without need to reset x-extent, this causes a different ugliness 786 ;; for huge thickness, though. 787 arg-x-ext 788 (ly:stencil-extent raw-line-stil Y)))) 789 (ly:stencil-add m line))) 790 791(define-markup-command (tie layout props arg) 792 (markup?) 793 #:category font 794 #:properties ((thickness 1) 795 (offset 2) 796 (direction UP) 797 (height-limit 0.7) 798 (shorten-pair '(0 . 0))) 799 " 800@cindex tie-ing text 801 802Adds a horizontal bow created with @code{make-tie-stencil} at bottom or top 803of @var{arg}. Looks at @code{thickness} to determine line thickness, and 804@code{offset} to determine y-offset. The added bow fits the extent of 805@var{arg}, @code{shorten-pair} may be used to modify this. 806@var{direction} may be set using an @code{override} or direction-modifiers or 807@code{voiceOne}, etc. 808 809@lilypond[verbatim,quote] 810\\markup { 811 \\override #'(direction . 1) 812 \\tie \"above\" 813 \\override #'(direction . -1) 814 \\tie \"below\" 815} 816@end lilypond" 817 (let* ((line-thickness (ly:output-def-lookup layout 'line-thickness)) 818 (thick (* thickness line-thickness)) 819 (stil (interpret-markup layout props arg)) 820 (x1 (car (ly:stencil-extent stil X))) 821 (x2 (cdr (ly:stencil-extent stil X))) 822 (y-ext (ly:stencil-extent stil Y)) 823 (y (+ (* line-thickness offset direction) 824 ;; we put out zero for positive text-direction, to make it 825 ;; consistent with `underline-markup' 826 ;; TODO: this will be problematic for args like "Eng" 827 ;; fix it here _and_ in `underline-markup' 828 (if (negative? direction) 0 (cdr y-ext)))) 829 (tie 830 (make-tie-stencil 831 (cons (+ x1 (car shorten-pair) line-thickness) y) 832 (cons (- x2 (cdr shorten-pair) line-thickness) y) 833 thick 834 direction 835 ;; For usage in text we choose a little less `height-limit' 836 ;; than the default for `Tie', i.e 0.7 (see properties above) 837 ;; TODO add the other optional arguments of `make-tie-stencil' 838 ;; i.e. `ratio' and `angularity' ? 839 height-limit))) 840 (ly:stencil-add stil tie))) 841 842(define-markup-command (undertie layout props arg) 843 (markup?) 844 #:category font 845 #:properties (tie-markup) 846 " 847@cindex undertie-ing text 848 849@lilypond[verbatim,quote] 850\\markup \\line { 851 \\undertie \"undertied\" 852 \\override #'((offset . 5) (thickness . 1)) 853 \\undertie \"undertied\" 854 \\override #'((offset . 1) (thickness . 5)) 855 \\undertie \"undertied\" 856} 857@end lilypond" 858 (interpret-markup layout (prepend-alist-chain 'direction DOWN props) 859 (make-tie-markup arg))) 860 861(define-markup-command (overtie layout props arg) 862 (markup?) 863 #:category font 864 #:properties (tie-markup) 865 " 866@cindex overtie-ing text 867 868Overtie @var{arg}. 869 870@lilypond[verbatim,quote] 871\\markup \\line { 872 \\overtie \"overtied\" 873 \\override #'((offset . 5) (thickness . 1)) 874 \\overtie \"overtied\" 875 \\override #'((offset . 1) (thickness . 5)) 876 \\overtie \"overtied\" 877} 878@end lilypond" 879 (interpret-markup layout (prepend-alist-chain 'direction UP props) 880 (make-tie-markup arg))) 881 882(define-markup-command (box layout props arg) 883 (markup?) 884 #:category font 885 #:properties ((thickness 1) 886 (font-size 0) 887 (box-padding 0.2)) 888 " 889@cindex enclosing text within a box 890 891Draw a box round @var{arg}. Looks at @code{thickness}, 892@code{box-padding} and @code{font-size} properties to determine line 893thickness and padding around the markup. 894 895@lilypond[verbatim,quote] 896\\markup { 897 \\override #'(box-padding . 0.5) 898 \\box 899 \\line { V. S. } 900} 901@end lilypond" 902 (let* ((th (* (ly:output-def-lookup layout 'line-thickness) 903 thickness)) 904 (pad (* (magstep font-size) box-padding)) 905 (m (interpret-markup layout props arg))) 906 (box-stencil m th pad))) 907 908(define-markup-command (filled-box layout props xext yext blot) 909 (number-pair? number-pair? number?) 910 #:category graphic 911 " 912@cindex drawing solid box, within text 913@cindex drawing box, with rounded corners 914 915Draw a box with rounded corners of dimensions @var{xext} and 916@var{yext}. For example, 917@verbatim 918\\filled-box #'(-.3 . 1.8) #'(-.3 . 1.8) #0 919@end verbatim 920creates a box extending horizontally from -0.3 to 1.8 and 921vertically from -0.3 up to 1.8, with corners formed from a 922circle of diameter@tie{}0 (i.e., sharp corners). 923 924@lilypond[verbatim,quote] 925\\markup { 926 \\filled-box #'(0 . 4) #'(0 . 4) #0 927 \\filled-box #'(0 . 2) #'(-4 . 2) #0.4 928 \\combine 929 \\filled-box #'(1 . 8) #'(0 . 7) #0.2 930 \\with-color #white 931 \\filled-box #'(3.6 . 5.6) #'(3.5 . 5.5) #0.7 932} 933@end lilypond" 934 (ly:round-filled-box 935 xext yext blot)) 936 937(define-markup-command (rounded-box layout props arg) 938 (markup?) 939 #:category graphic 940 #:properties ((thickness 1) 941 (corner-radius 1) 942 (font-size 0) 943 (box-padding 0.5)) 944 "@cindex enclosing text in box, with rounded corners 945 @cindex drawing box, with rounded corners, around text 946Draw a box with rounded corners around @var{arg}. Looks at @code{thickness}, 947@code{box-padding} and @code{font-size} properties to determine line 948thickness and padding around the markup; the @code{corner-radius} property 949makes it possible to define another shape for the corners (default is 1). 950 951@lilypond[verbatim,quote,relative=2] 952c4^\\markup { 953 \\rounded-box { 954 Overtura 955 } 956} 957c,8. c16 c4 r 958@end lilypond" 959 (let ((th (* (ly:output-def-lookup layout 'line-thickness) 960 thickness)) 961 (pad (* (magstep font-size) box-padding)) 962 (m (interpret-markup layout props arg))) 963 (rounded-box-stencil m th pad corner-radius))) 964 965(define-markup-command (rotate layout props ang arg) 966 (number? markup?) 967 #:category align 968 " 969@cindex rotating text 970 971Rotate object with @var{ang} degrees around its center. 972 973@lilypond[verbatim,quote] 974\\markup { 975 default 976 \\hspace #2 977 \\rotate #45 978 \\line { 979 rotated 45° 980 } 981} 982@end lilypond" 983 (let* ((stil (interpret-markup layout props arg))) 984 (ly:stencil-rotate stil ang 0 0))) 985 986(define-markup-command (whiteout layout props arg) 987 (markup?) 988 #:category other 989 #:properties ((style 'box) 990 (thickness '())) 991 " 992@cindex adding white background, to text 993 994Provide a white background for @var{arg}. The shape of the white 995background is determined by @code{style}. The default 996is @code{box} which produces a rectangle. @code{rounded-box} 997produces a rounded rectangle. @code{outline} approximates the 998outline of the markup. 999 1000@lilypond[verbatim,quote] 1001\\markup { 1002 \\combine 1003 \\filled-box #'(-1 . 15) #'(-3 . 4) #1 1004 \\override #'(thickness . 1.5) 1005 \\whiteout whiteout-box 1006} 1007\\markup { 1008 \\combine 1009 \\filled-box #'(-1 . 24) #'(-3 . 4) #1 1010 \\override #'((style . rounded-box) (thickness . 3)) 1011 \\whiteout whiteout-rounded-box 1012} 1013\\markup { 1014 \\combine 1015 \\filled-box #'(-1 . 18) #'(-3 . 4) #1 1016 \\override #'((style . outline) (thickness . 3)) 1017 \\whiteout whiteout-outline 1018} 1019@end lilypond" 1020 (stencil-whiteout 1021 (interpret-markup layout props arg) 1022 style 1023 thickness 1024 (ly:output-def-lookup layout 'line-thickness))) 1025 1026(define-markup-command (pad-markup layout props amount arg) 1027 (number? markup?) 1028 #:category align 1029 " 1030@cindex padding text 1031@cindex putting space around text 1032 1033Add space around a markup object. 1034Identical to @code{pad-around}. 1035 1036@lilypond[verbatim,quote] 1037\\markup { 1038 \\box { 1039 default 1040 } 1041 \\hspace #2 1042 \\box { 1043 \\pad-markup #1 { 1044 padded 1045 } 1046 } 1047} 1048@end lilypond" 1049 (let* ((m (interpret-markup layout props arg)) 1050 (x (interval-widen (ly:stencil-extent m X) amount)) 1051 (y (interval-widen (ly:stencil-extent m Y) amount))) 1052 (ly:stencil-add (make-transparent-box-stencil x y) 1053 m))) 1054 1055;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1056;; space 1057;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1058 1059(define-markup-command (strut layout props) 1060 () 1061 #:category other 1062 " 1063@cindex creating vertical space, in text 1064 1065Create a box of the same height as the space in the current font." 1066 (let ((m (ly:text-interface::interpret-markup layout props " "))) 1067 (ly:make-stencil (ly:stencil-expr m) 1068 '(0 . 0) 1069 (ly:stencil-extent m X) 1070 ))) 1071 1072(define-markup-command (hspace layout props amount) 1073 (number?) 1074 #:category align 1075 " 1076@cindex creating horizontal space, in text 1077 1078Create an invisible object taking up horizontal space @var{amount}. 1079 1080@lilypond[verbatim,quote] 1081\\markup { 1082 one 1083 \\hspace #2 1084 two 1085 \\hspace #8 1086 three 1087} 1088@end lilypond" 1089 (ly:make-stencil "" (cons 0 amount) empty-interval)) 1090 1091(define-markup-command (vspace layout props amount) 1092 (number?) 1093 #:category align 1094 " 1095@cindex creating vertical space, in text 1096 1097Create an invisible object taking up vertical space 1098of @var{amount} multiplied by 3. 1099 1100@lilypond[verbatim,quote] 1101\\markup { 1102 \\center-column { 1103 one 1104 \\vspace #2 1105 two 1106 \\vspace #5 1107 three 1108 } 1109} 1110@end lilypond" 1111 (let ((amount (* amount 3.0))) 1112 (ly:make-stencil "" empty-interval (cons 0 amount)))) 1113 1114 1115;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1116;; importing graphics. 1117;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1118 1119(define-markup-command (stencil layout props stil) 1120 (ly:stencil?) 1121 #:category other 1122 " 1123@cindex importing stencil, into text 1124 1125Use a stencil as markup. 1126 1127@lilypond[verbatim,quote] 1128\\markup { 1129 \\stencil #(make-circle-stencil 2 0 #t) 1130} 1131@end lilypond" 1132 stil) 1133 1134(define bbox-regexp 1135 (make-regexp "%%BoundingBox:[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)[ \t]+([0-9-]+)")) 1136 1137(define-public (get-postscript-bbox string) 1138 "Extract the bounding box from @var{string}, or return @code{#f} if not 1139present." 1140 (let* 1141 ((match (regexp-exec bbox-regexp string))) 1142 1143 (if match 1144 (map (lambda (x) 1145 (string->number (match:substring match x))) 1146 (cdr (iota 5))) 1147 1148 #f))) 1149 1150(define-markup-command (epsfile layout props axis size file-name) 1151 (number? number? string?) 1152 #:category graphic 1153 " 1154@cindex inlining an Encapsulated PostScript image 1155 1156Inline an EPS image. The image is scaled along @var{axis} to 1157@var{size}. 1158 1159@lilypond[verbatim,quote] 1160\\markup { 1161 \\general-align #Y #DOWN { 1162 \\epsfile #X #20 #\"context-example.eps\" 1163 \\epsfile #Y #20 #\"context-example.eps\" 1164 } 1165} 1166@end lilypond" 1167 (if (ly:get-option 'safe) 1168 (interpret-markup layout props "not allowed in safe") 1169 (eps-file->stencil axis size file-name) 1170 )) 1171 1172(define-markup-command (postscript layout props str) 1173 (string?) 1174 #:category graphic 1175 " 1176@cindex inserting PostScript directly, into text 1177This inserts @var{str} directly into the output as a PostScript 1178command string. 1179 1180@lilypond[verbatim,quote] 1181ringsps = #\" 1182 0.15 setlinewidth 1183 0.9 0.6 moveto 1184 0.4 0.6 0.5 0 361 arc 1185 stroke 1186 1.0 0.6 0.5 0 361 arc 1187 stroke 1188 \" 1189 1190rings = \\markup { 1191 \\with-dimensions #'(-0.2 . 1.6) #'(0 . 1.2) 1192 \\postscript #ringsps 1193} 1194 1195\\relative c'' { 1196 c2^\\rings 1197 a2_\\rings 1198} 1199@end lilypond" 1200 ;; FIXME 1201 (ly:make-stencil 1202 (list 'embedded-ps 1203 (format #f " 1204gsave currentpoint translate 12050.1 setlinewidth 1206 ~a 1207grestore 1208" 1209 str)) 1210 '(0 . 0) '(0 . 0))) 1211 1212(define-markup-command (path layout props thickness commands) (number? list?) 1213 #:category graphic 1214 #:properties ((line-cap-style 'round) 1215 (line-join-style 'round) 1216 (filled #f)) 1217 " 1218@cindex path, drawing 1219@cindex drawing path 1220Draws a path with line @var{thickness} according to the 1221directions given in @var{commands}. @var{commands} is a list of 1222lists where the @code{car} of each sublist is a drawing command and 1223the @code{cdr} comprises the associated arguments for each command. 1224 1225There are seven commands available to use in the list 1226@code{commands}: @code{moveto}, @code{rmoveto}, @code{lineto}, 1227@code{rlineto}, @code{curveto}, @code{rcurveto}, and 1228@code{closepath}. Note that the commands that begin with @emph{r} 1229are the relative variants of the other three commands. 1230 1231The commands @code{moveto}, @code{rmoveto}, @code{lineto}, and 1232@code{rlineto} take 2 arguments; they are the X and Y coordinates 1233for the destination point. 1234 1235The commands @code{curveto} and @code{rcurveto} create cubic 1236Bézier curves, and take 6 arguments; the first two are the X and Y 1237coordinates for the first control point, the second two are the X 1238and Y coordinates for the second control point, and the last two 1239are the X and Y coordinates for the destination point. 1240 1241The @code{closepath} command takes zero arguments and closes the 1242current subpath in the active path. 1243 1244Note that a sequence of commands @emph{must} begin with a 1245@code{moveto} or @code{rmoveto} to work with the SVG output. 1246 1247Line-cap styles and line-join styles may be customized by 1248overriding the @code{line-cap-style} and @code{line-join-style} 1249properties, respectively. Available line-cap styles are 1250@code{'butt}, @code{'round}, and @code{'square}. Available 1251line-join styles are @code{'miter}, @code{'round}, and 1252@code{'bevel}. 1253 1254The property @code{filled} specifies whether or not the path is 1255filled with color. 1256 1257@lilypond[verbatim,quote] 1258samplePath = 1259 #'((moveto 0 0) 1260 (lineto -1 1) 1261 (lineto 1 1) 1262 (lineto 1 -1) 1263 (curveto -5 -5 -5 5 -1 0) 1264 (closepath)) 1265 1266\\markup { 1267 \\path #0.25 #samplePath 1268 1269 \\override #'(line-join-style . miter) 1270 \\path #0.25 #samplePath 1271 1272 \\override #'(filled . #t) 1273 \\path #0.25 #samplePath 1274} 1275@end lilypond" 1276 (let* ((half-thickness (/ thickness 2)) 1277 (current-point '(0 . 0)) 1278 (set-point (lambda (lst) (set! current-point lst))) 1279 (relative? (lambda (x) 1280 (string-prefix? "r" (symbol->string (car x))))) 1281 ;; For calculating extents, we want to modify the command 1282 ;; list so that all coordinates are absolute. 1283 (new-commands (map (lambda (x) 1284 (cond 1285 ;; for rmoveto, rlineto 1286 ((and (relative? x) (= 3 (length x))) 1287 (let ((cp (cons 1288 (+ (car current-point) 1289 (second x)) 1290 (+ (cdr current-point) 1291 (third x))))) 1292 (set-point cp) 1293 (list (car cp) 1294 (cdr cp)))) 1295 ;; for rcurveto 1296 ((and (relative? x) (= 7 (length x))) 1297 (let* ((old-cp current-point) 1298 (cp (cons 1299 (+ (car old-cp) 1300 (sixth x)) 1301 (+ (cdr old-cp) 1302 (seventh x))))) 1303 (set-point cp) 1304 (list (+ (car old-cp) (second x)) 1305 (+ (cdr old-cp) (third x)) 1306 (+ (car old-cp) (fourth x)) 1307 (+ (cdr old-cp) (fifth x)) 1308 (car cp) 1309 (cdr cp)))) 1310 ;; for moveto, lineto 1311 ((= 3 (length x)) 1312 (set-point (cons (second x) 1313 (third x))) 1314 (drop x 1)) 1315 ;; for curveto 1316 ((= 7 (length x)) 1317 (set-point (cons (sixth x) 1318 (seventh x))) 1319 (drop x 1)) 1320 ;; keep closepath for filtering; 1321 ;; see `without-closepath'. 1322 (else x))) 1323 commands)) 1324 ;; path-min-max does not accept 0-arg lists, 1325 ;; and since closepath does not affect extents, filter 1326 ;; out those commands here. 1327 (without-closepath (filter (lambda (x) 1328 (not (equal? 'closepath (car x)))) 1329 new-commands)) 1330 (extents (path-min-max 1331 ;; set the origin to the first moveto 1332 (list (list-ref (car without-closepath) 0) 1333 (list-ref (car without-closepath) 1)) 1334 without-closepath)) 1335 (X-extent (cons (list-ref extents 0) (list-ref extents 1))) 1336 (Y-extent (cons (list-ref extents 2) (list-ref extents 3))) 1337 (command-list (fold-right append '() commands))) 1338 1339 ;; account for line thickness 1340 (set! X-extent (interval-widen X-extent half-thickness)) 1341 (set! Y-extent (interval-widen Y-extent half-thickness)) 1342 1343 (ly:make-stencil 1344 `(path ,thickness ,command-list 1345 ,line-cap-style ,line-join-style ,filled) 1346 X-extent 1347 Y-extent))) 1348 1349(define-markup-list-command (score-lines layout props score) 1350 (ly:score?) 1351 "This is the same as the @code{\\score} markup but delivers its 1352systems as a list of lines. Its @var{score} argument is entered in 1353braces like it would be for @code{\\score}." 1354 (let ((output (ly:score-embedded-format score layout))) 1355 1356 (if (ly:music-output? output) 1357 (map 1358 (lambda (paper-system) 1359 ;; shift such that the refpoint of the bottom staff of 1360 ;; the first system is the baseline of the score 1361 (ly:stencil-translate-axis 1362 (paper-system-stencil paper-system) 1363 (- (car (paper-system-staff-extents paper-system))) 1364 Y)) 1365 (vector->list (ly:paper-score-paper-systems output))) 1366 (begin 1367 (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?")) 1368 '())))) 1369 1370(define-markup-command (score layout props score) 1371 (ly:score?) 1372 #:category music 1373 #:properties ((baseline-skip)) 1374 " 1375@cindex inserting music, into text 1376 1377Inline an image of music. The reference point (usually the middle 1378staff line) of the lowest staff in the top system is placed on the 1379baseline. 1380 1381@lilypond[verbatim,quote,line-width=14\\cm,staffsize=16] 1382\\markup { 1383 \\score { 1384 \\new PianoStaff << 1385 \\new Staff \\relative c' { 1386 \\key f \\major 1387 \\time 3/4 1388 \\mark \\markup { Allegro } 1389 f2\\p( a4) 1390 c2( a4) 1391 bes2( g'4) 1392 f8( e) e4 r 1393 } 1394 \\new Staff \\relative c { 1395 \\clef bass 1396 \\key f \\major 1397 \\time 3/4 1398 f8( a c a c a 1399 f c' es c es c) 1400 f,( bes d bes d bes) 1401 f( g bes g bes g) 1402 } 1403 >> 1404 \\layout { 1405 indent = 0.0\\cm 1406 \\context { 1407 \\Score 1408 \\override RehearsalMark.break-align-symbols = 1409 #'(time-signature key-signature) 1410 \\override RehearsalMark.self-alignment-X = #LEFT 1411 } 1412 \\context { 1413 \\Staff 1414 \\override TimeSignature 1415 .break-align-anchor-alignment = #LEFT 1416 } 1417 } 1418 } 1419} 1420@end lilypond" 1421 (stack-stencils Y DOWN baseline-skip 1422 (score-lines-markup-list layout props score))) 1423 1424(define-markup-command (null layout props) 1425 () 1426 #:category other 1427 " 1428@cindex creating empty text object 1429 1430An empty markup with extents of a single point. 1431 1432@lilypond[verbatim,quote] 1433\\markup { 1434 \\null 1435} 1436@end lilypond" 1437 point-stencil) 1438 1439;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1440;; basic formatting. 1441;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 1442 1443(define-markup-command (simple layout props str) 1444 (string?) 1445 #:category font 1446 " 1447@cindex simple text string 1448 1449A simple text string; @code{\\markup @{ foo @}} is equivalent with 1450@code{\\markup @{ \\simple #\"foo\" @}}. 1451 1452Note: for creating standard text markup or defining new markup commands, 1453the use of @code{\\simple} is unnecessary. 1454 1455@lilypond[verbatim,quote] 1456\\markup { 1457 \\simple #\"simple\" 1458 \\simple #\"text\" 1459 \\simple #\"strings\" 1460} 1461@end lilypond" 1462 (interpret-markup layout props str)) 1463 1464(define-markup-command (first-visible layout props args) 1465 (markup-list?) 1466 #:category other 1467 "Use the first markup in @var{args} that yields a non-empty stencil 1468and ignore the rest. 1469 1470@lilypond[verbatim,quote] 1471\\markup { 1472 \\first-visible { 1473 \\fromproperty #'header:composer 1474 \\italic Unknown 1475 } 1476} 1477@end lilypond" 1478 (define (false-if-empty stencil) 1479 (if (ly:stencil-empty? stencil) #f stencil)) 1480 (or 1481 (any 1482 (lambda (m) 1483 (if (markup? m) 1484 (false-if-empty (interpret-markup layout props m)) 1485 (any false-if-empty (interpret-markup-list layout props (list m))))) 1486 args) 1487 empty-stencil)) 1488 1489(define-public empty-markup 1490 (make-simple-markup "")) 1491 1492;; helper for justifying lines. 1493(define (get-fill-space 1494 word-count line-width word-space text-widths constant-space?) 1495 "Calculate the necessary paddings between adjacent texts in a 1496single justified line. The lengths of all texts are stored in 1497@var{text-widths}. 1498When @var{constant-space?} is @code{#t}, the formula for the padding 1499between texts is: 1500padding = (line-width - total-text-width)/(word-count - 1) 1501When @var{constant-space?} is @code{#f}, the formula for the 1502padding between interior texts a and b is: 1503padding = line-width/(word-count - 1) - (length(a) + length(b))/2 1504In this case, the first and last padding have to be calculated 1505specially using the whole length of the first or last text. 1506All paddings are checked to be at least word-space, to ensure that 1507no texts collide. 1508Return a list of paddings." 1509 (cond 1510 ((null? text-widths) '()) 1511 (constant-space? 1512 (make-list 1513 (1- word-count) 1514 ;; Ensure that space between words cannot be 1515 ;; less than word-space. 1516 (max 1517 word-space 1518 (/ (- line-width (apply + text-widths)) 1519 (1- word-count))))) 1520 1521 ;; special case first padding 1522 ((= (length text-widths) word-count) 1523 (cons 1524 (- (- (/ line-width (1- word-count)) (car text-widths)) 1525 (/ (cadr text-widths) 2)) 1526 (get-fill-space 1527 word-count line-width word-space (cdr text-widths) 1528 constant-space?))) 1529 ;; special case last padding 1530 ((= (length text-widths) 2) 1531 (list (- (/ line-width (1- word-count)) 1532 (+ (/ (car text-widths) 2) (cadr text-widths))) 1533 0)) 1534 (else 1535 (let ((default-padding 1536 (- (/ line-width (1- word-count)) 1537 (/ (+ (car text-widths) (cadr text-widths)) 2)))) 1538 (cons 1539 (if (> word-space default-padding) 1540 word-space 1541 default-padding) 1542 (get-fill-space 1543 word-count line-width word-space (cdr text-widths) 1544 constant-space?)))))) 1545 1546(define (justify-line-helper 1547 layout props args text-direction word-space line-width constant-space?) 1548 "Return a stencil which spreads @var{args} along a line of width 1549@var{line-width}. If @var{constant-space?} is set to @code{#t}, the 1550space between words is constant. If @code{#f}, the distance between 1551words varies according to their relative lengths." 1552 (let* ((orig-stencils (interpret-markup-list layout props args)) 1553 (stencils 1554 (map (lambda (stc) 1555 (if (ly:stencil-empty? stc X) 1556 (ly:make-stencil (ly:stencil-expr stc) 1557 '(0 . 0) (ly:stencil-extent stc Y)) 1558 stc)) 1559 orig-stencils)) 1560 (text-widths 1561 (map (lambda (stc) 1562 (interval-length (ly:stencil-extent stc X))) 1563 stencils)) 1564 (text-width (apply + text-widths)) 1565 (word-count (length stencils)) 1566 (line-width (or line-width (ly:output-def-lookup layout 'line-width))) 1567 (fill-space 1568 (cond 1569 ((= word-count 1) 1570 (list 1571 (/ (- line-width text-width) 2) 1572 (/ (- line-width text-width) 2))) 1573 ((= word-count 2) 1574 (list 1575 (- line-width text-width))) 1576 (else 1577 (get-fill-space 1578 word-count line-width word-space text-widths 1579 constant-space?)))) 1580 (line-contents (if (= word-count 1) 1581 (list 1582 point-stencil 1583 (car stencils) 1584 point-stencil) 1585 stencils))) 1586 1587 (if (null? (remove ly:stencil-empty? orig-stencils)) 1588 empty-stencil 1589 (begin 1590 (if (= text-direction LEFT) 1591 (set! line-contents (reverse line-contents))) 1592 (set! line-contents 1593 (stack-stencils-padding-list 1594 X RIGHT fill-space line-contents)) 1595 (if (> word-count 1) 1596 ;; shift s.t. stencils align on the left edge, even if 1597 ;; first stencil had negative X-extent (e.g. center-column) 1598 ;; (if word-count = 1, X-extents are already normalized in 1599 ;; the definition of line-contents) 1600 (set! line-contents 1601 (ly:stencil-translate-axis 1602 line-contents 1603 (- (car (ly:stencil-extent (car stencils) X))) 1604 X))) 1605 line-contents)))) 1606 1607(define-markup-command (fill-line layout props args) 1608 (markup-list?) 1609 #:category align 1610 #:properties ((text-direction RIGHT) 1611 (word-space 0.6) 1612 (line-width #f)) 1613 "Put @var{markups} in a horizontal line of width @var{line-width}. 1614The markups are spaced or flushed to fill the entire line. 1615If there are no arguments, return an empty stencil. 1616 1617@lilypond[verbatim,quote,line-width=14\\cm] 1618\\markup { 1619 \\column { 1620 \\fill-line { 1621 Words evenly spaced across the page 1622 } 1623 \\null 1624 \\fill-line { 1625 \\line { Text markups } 1626 \\line { 1627 \\italic { evenly spaced } 1628 } 1629 \\line { across the page } 1630 } 1631 \\null 1632 \\override #'(line-width . 50) 1633 \\fill-line { 1634 Width explicitly specified 1635 } 1636 } 1637} 1638@end lilypond" 1639 (justify-line-helper 1640 layout props args text-direction word-space line-width #f)) 1641 1642(define-markup-command (justify-line layout props args) 1643 (markup-list?) 1644 #:category align 1645 #:properties ((text-direction RIGHT) 1646 (word-space 0.6) 1647 (line-width #f)) 1648 "Put @var{markups} in a horizontal line of width @var{line-width}. 1649The markups are spread to fill the entire line and separated by equal 1650space. If there are no arguments, return an empty stencil. 1651 1652@lilypond[verbatim,quote,line-width=14\\cm] 1653\\markup { 1654 \\justify-line { 1655 Constant space between neighboring words 1656 } 1657} 1658@end lilypond" 1659 (justify-line-helper 1660 layout props args text-direction word-space line-width #t)) 1661 1662(define-markup-command (concat layout props args) 1663 (markup-list?) 1664 #:category align 1665 " 1666@cindex concatenating text 1667@cindex ligature, in text 1668 1669Concatenate @var{args} in a horizontal line, without spaces in between. 1670Strings and simple markups are concatenated on the input level, allowing 1671ligatures. For example, @code{\\concat @{ \"f\" \\simple #\"i\" @}} is 1672equivalent to @code{\"fi\"}. 1673 1674@lilypond[verbatim,quote] 1675\\markup { 1676 \\concat { 1677 one 1678 two 1679 three 1680 } 1681} 1682@end lilypond" 1683 (define (concat-string-args arg-list) 1684 (fold-right (lambda (arg result-list) 1685 (let ((result (and (pair? result-list) 1686 (car result-list)))) 1687 (cond ((not (pair? arg))) 1688 ((eq? (car arg) simple-markup) 1689 (set! arg (cadr arg))) 1690 ((eq? (car arg) char-markup) 1691 (set! arg (ly:wide-char->utf-8 (cadr arg))))) 1692 (if (and (string? result) (string? arg)) 1693 (cons (string-append arg result) (cdr result-list)) 1694 (cons arg result-list)))) 1695 '() 1696 arg-list)) 1697 (stack-stencil-line 0 1698 (interpret-markup-list layout props 1699 (if (markup-command-list? args) 1700 args 1701 (concat-string-args args))))) 1702 1703(define (wordwrap-stencils stencils 1704 justify base-space line-width text-dir) 1705 "Perform simple wordwrap, return stencil of each line." 1706 (define space (if justify 1707 ;; justify only stretches lines. 1708 (* 0.7 base-space) 1709 base-space)) 1710 (define (stencil-len s) 1711 (interval-end (ly:stencil-extent s X))) 1712 (define (maybe-shift line) 1713 (if (= text-dir LEFT) 1714 (ly:stencil-translate-axis 1715 line 1716 (- line-width (stencil-len line)) 1717 X) 1718 line)) 1719 (if (null? stencils) 1720 '() 1721 (let loop ((lines '()) 1722 (todo stencils)) 1723 (let word-loop 1724 ((line (first todo)) 1725 (todo (cdr todo)) 1726 (word-list (list (first todo)))) 1727 (cond 1728 ((pair? todo) 1729 (let ((new (if (= text-dir LEFT) 1730 (ly:stencil-stack (car todo) X RIGHT line space) 1731 (ly:stencil-stack line X RIGHT (car todo) space)))) 1732 (cond 1733 ((<= (stencil-len new) line-width) 1734 (word-loop new (cdr todo) 1735 (cons (car todo) word-list))) 1736 (justify 1737 (let* ((word-list 1738 ;; This depends on stencil stacking being 1739 ;; associative so that stacking 1740 ;; left-to-right and right-to-left leads to 1741 ;; the same result 1742 (if (= text-dir LEFT) 1743 word-list 1744 (reverse! word-list))) 1745 (len (stencil-len line)) 1746 (stretch (- line-width len)) 1747 (spaces 1748 (- (stencil-len 1749 (stack-stencils X RIGHT (1+ space) word-list)) 1750 len))) 1751 (if (zero? spaces) 1752 ;; Uh oh, nothing to fill. 1753 (loop (cons (maybe-shift line) lines) todo) 1754 (loop (cons 1755 (stack-stencils X RIGHT 1756 (+ space (/ stretch spaces)) 1757 word-list) 1758 lines) 1759 todo)))) 1760 (else ;; not justify 1761 (loop (cons (maybe-shift line) lines) todo))))) 1762 ;; todo is null 1763 (justify 1764 ;; Now we have the last line assembled with space 1765 ;; which is compressed. We want to use the 1766 ;; uncompressed version instead if it fits, and the 1767 ;; justified version if it doesn't. 1768 (let* ((word-list 1769 ;; This depends on stencil stacking being 1770 ;; associative so that stacking 1771 ;; left-to-right and right-to-left leads to 1772 ;; the same result 1773 (if (= text-dir LEFT) 1774 word-list 1775 (reverse! word-list))) 1776 (big-line (stack-stencils X RIGHT base-space word-list)) 1777 (big-len (stencil-len big-line)) 1778 (len (stencil-len line))) 1779 (reverse! lines 1780 (list 1781 (if (> big-len line-width) 1782 (stack-stencils X RIGHT 1783 (/ 1784 (+ 1785 (* (- big-len line-width) 1786 space) 1787 (* (- line-width len) 1788 base-space)) 1789 (- big-len len)) 1790 word-list) 1791 (maybe-shift big-line)))))) 1792 (else ;; not justify 1793 (reverse! lines (list (maybe-shift line))))))))) 1794 1795 1796(define-markup-list-command (wordwrap-internal layout props justify args) 1797 (boolean? markup-list?) 1798 #:properties ((line-width #f) 1799 (word-space) 1800 (text-direction RIGHT)) 1801 "Internal markup list command used to define @code{\\justify} and @code{\\wordwrap}." 1802 (wordwrap-stencils (interpret-markup-list layout props args) 1803 justify 1804 word-space 1805 (or line-width 1806 (ly:output-def-lookup layout 'line-width)) 1807 text-direction)) 1808 1809(define-markup-command (justify layout props args) 1810 (markup-list?) 1811 #:category align 1812 #:properties ((baseline-skip) 1813 wordwrap-internal-markup-list) 1814 " 1815@cindex justifying text 1816 1817Like @code{\\wordwrap}, but with lines stretched to justify the margins. 1818Use @code{\\override #'(line-width . @var{X})} to set the line width; 1819@var{X}@tie{}is the number of staff spaces. 1820 1821@lilypond[verbatim,quote,line-width=14\\cm] 1822\\markup { 1823 \\justify { 1824 Lorem ipsum dolor sit amet, consectetur adipisicing elit, 1825 sed do eiusmod tempor incididunt ut labore et dolore 1826 magna aliqua. Ut enim ad minim veniam, quis nostrud 1827 exercitation ullamco laboris nisi ut aliquip ex ea 1828 commodo consequat. 1829 } 1830} 1831@end lilypond" 1832 (stack-lines DOWN 0.0 baseline-skip 1833 (wordwrap-internal-markup-list layout props #t args))) 1834 1835(define-markup-command (wordwrap layout props args) 1836 (markup-list?) 1837 #:category align 1838 #:properties ((baseline-skip) 1839 wordwrap-internal-markup-list) 1840 "Simple wordwrap. Use @code{\\override #'(line-width . @var{X})} to set 1841the line width, where @var{X} is the number of staff spaces. 1842 1843@lilypond[verbatim,quote,line-width=14\\cm] 1844\\markup { 1845 \\wordwrap { 1846 Lorem ipsum dolor sit amet, consectetur adipisicing elit, 1847 sed do eiusmod tempor incididunt ut labore et dolore 1848 magna aliqua. Ut enim ad minim veniam, quis nostrud 1849 exercitation ullamco laboris nisi ut aliquip ex ea 1850 commodo consequat. 1851 } 1852} 1853@end lilypond" 1854 (stack-lines DOWN 0.0 baseline-skip 1855 (wordwrap-internal-markup-list layout props #f args))) 1856 1857(define-markup-list-command (wordwrap-string-internal layout props justify arg) 1858 (boolean? string?) 1859 #:properties ((line-width) 1860 (word-space) 1861 (text-direction RIGHT)) 1862 "Internal markup list command that is used to define @code{\\justify-string} 1863and @code{\\wordwrap-string}." 1864 (let* ((para-strings (regexp-split 1865 (string-regexp-substitute 1866 "\r" "\n" 1867 (string-regexp-substitute "\r\n" "\n" arg)) 1868 "\n[ \t\n]*\n[ \t\n]*")) 1869 (list-para-words (map (lambda (str) 1870 (regexp-split str "[ \t\n]+")) 1871 para-strings)) 1872 (para-lines (map (lambda (words) 1873 (let* ((stencils 1874 (map (lambda (x) 1875 (interpret-markup layout props x)) 1876 words))) 1877 (wordwrap-stencils stencils 1878 justify word-space 1879 line-width text-direction))) 1880 list-para-words))) 1881 (concatenate para-lines))) 1882 1883(define-markup-command (wordwrap-string layout props arg) 1884 (string?) 1885 #:category align 1886 #:properties ((baseline-skip) 1887 wordwrap-string-internal-markup-list) 1888 "Wordwrap a string. Paragraphs may be separated with double newlines. 1889 1890@lilypond[verbatim,quote] 1891\\markup { 1892 \\override #'(line-width . 40) 1893 \\wordwrap-string #\"Lorem ipsum dolor sit amet, 1894 consectetur adipisicing elit, sed do eiusmod tempor 1895 incididunt ut labore et dolore magna aliqua. 1896 1897 1898 Ut enim ad minim veniam, quis nostrud exercitation 1899 ullamco laboris nisi ut aliquip ex ea commodo 1900 consequat. 1901 1902 1903 Excepteur sint occaecat cupidatat non proident, 1904 sunt in culpa qui officia deserunt mollit anim id 1905 est laborum\" 1906} 1907@end lilypond" 1908 (stack-lines DOWN 0.0 baseline-skip 1909 (wordwrap-string-internal-markup-list layout props #f arg))) 1910 1911(define-markup-command (justify-string layout props arg) 1912 (string?) 1913 #:category align 1914 #:properties ((baseline-skip) 1915 wordwrap-string-internal-markup-list) 1916 "Justify a string. Paragraphs may be separated with double newlines 1917 1918@lilypond[verbatim,quote] 1919\\markup { 1920 \\override #'(line-width . 40) 1921 \\justify-string #\"Lorem ipsum dolor sit amet, consectetur 1922 adipisicing elit, sed do eiusmod tempor incididunt ut 1923 labore et dolore magna aliqua. 1924 1925 1926 Ut enim ad minim veniam, quis nostrud exercitation 1927 ullamco laboris nisi ut aliquip ex ea commodo 1928 consequat. 1929 1930 1931 Excepteur sint occaecat cupidatat non proident, sunt 1932 in culpa qui officia deserunt mollit anim id est 1933 laborum\" 1934} 1935@end lilypond" 1936 (stack-lines DOWN 0.0 baseline-skip 1937 (wordwrap-string-internal-markup-list layout props #t arg))) 1938 1939(define-markup-command (wordwrap-field layout props symbol) 1940 (symbol?) 1941 #:category align 1942 "Wordwrap the data which has been assigned to @var{symbol}. 1943 1944@lilypond[verbatim,quote,line-width=14\\cm] 1945\\header { 1946 title = \"My title\" 1947 myText = \"Lorem ipsum dolor sit amet, consectetur 1948 adipisicing elit, sed do eiusmod tempor incididunt ut 1949 labore et dolore magna aliqua. Ut enim ad minim 1950 veniam, quis nostrud exercitation ullamco laboris nisi 1951 ut aliquip ex ea commodo consequat.\" 1952} 1953 1954\\paper { 1955 bookTitleMarkup = \\markup { 1956 \\column { 1957 \\fill-line { \\fromproperty #'header:title } 1958 \\null 1959 \\wordwrap-field #'header:myText 1960 } 1961 } 1962} 1963 1964\\markup { 1965 \\null 1966} 1967@end lilypond" 1968 (let* ((m (chain-assoc-get symbol props))) 1969 (if (string? m) 1970 (wordwrap-string-markup layout props m) 1971 empty-stencil))) 1972 1973(define-markup-command (justify-field layout props symbol) 1974 (symbol?) 1975 #:category align 1976 "Justify the data which has been assigned to @var{symbol}. 1977 1978@lilypond[verbatim,quote,line-width=14\\cm] 1979\\header { 1980 title = \"My title\" 1981 myText = \"Lorem ipsum dolor sit amet, consectetur 1982 adipisicing elit, sed do eiusmod tempor incididunt 1983 ut labore et dolore magna aliqua. Ut enim ad minim 1984 veniam, quis nostrud exercitation ullamco laboris 1985 nisi ut aliquip ex ea commodo consequat.\" 1986} 1987 1988\\paper { 1989 bookTitleMarkup = \\markup { 1990 \\column { 1991 \\fill-line { \\fromproperty #'header:title } 1992 \\null 1993 \\justify-field #'header:myText 1994 } 1995 } 1996} 1997 1998\\markup { 1999 \\null 2000} 2001@end lilypond" 2002 (let* ((m (chain-assoc-get symbol props))) 2003 (if (string? m) 2004 (justify-string-markup layout props m) 2005 empty-stencil))) 2006 2007(define-markup-command (combine layout props arg1 arg2) 2008 (markup? markup?) 2009 #:category align 2010 " 2011@cindex merging text 2012 2013Print two markups on top of each other. 2014 2015Note: @code{\\combine} cannot take a list of markups enclosed in 2016curly braces as an argument; for this purpose use @code{\\overlay} instead. 2017 2018@lilypond[verbatim,quote] 2019\\markup { 2020 \\fontsize #5 2021 \\override #'(thickness . 2) 2022 \\combine 2023 \\draw-line #'(0 . 4) 2024 \\arrow-head #Y #DOWN ##f 2025} 2026@end lilypond" 2027 (let* ((s1 (interpret-markup layout props arg1)) 2028 (s2 (interpret-markup layout props arg2))) 2029 (ly:stencil-add s1 s2))) 2030 2031(define-markup-command (overlay layout props args) 2032 (markup-list?) 2033 #:category align 2034 " 2035@cindex merging text 2036 2037Takes a list of markups combining them. 2038 2039@lilypond[verbatim,quote] 2040\\markup { 2041 \\fontsize #5 2042 \\override #'(thickness . 2) 2043 \\overlay { 2044 \\draw-line #'(0 . 4) 2045 \\arrow-head #Y #DOWN ##f 2046 \\translate #'(0 . 4)\\arrow-head #Y #UP ##f 2047 } 2048} 2049@end lilypond" 2050 (apply ly:stencil-add (interpret-markup-list layout props args))) 2051 2052;; 2053;; TODO: should extract baseline-skip from each argument somehow.. 2054;; 2055(define-markup-command (column layout props args) 2056 (markup-list?) 2057 #:category align 2058 #:properties ((baseline-skip)) 2059 " 2060@cindex stacking text in a column 2061 2062Stack the markups in @var{args} vertically. The property 2063@code{baseline-skip} determines the space between markups 2064in @var{args}. 2065 2066@lilypond[verbatim,quote] 2067\\markup { 2068 \\column { 2069 one 2070 two 2071 three 2072 } 2073} 2074@end lilypond" 2075 (let ((arg-stencils (interpret-markup-list layout props args))) 2076 (stack-lines -1 0.0 baseline-skip arg-stencils))) 2077 2078(define-markup-command (dir-column layout props args) 2079 (markup-list?) 2080 #:category align 2081 #:properties ((direction) 2082 (baseline-skip)) 2083 " 2084@cindex changing direction of text column 2085 2086Make a column of @var{args}, going up or down, depending on the 2087setting of the @code{direction} layout property. 2088 2089@lilypond[verbatim,quote] 2090\\markup { 2091 \\override #`(direction . ,UP) 2092 \\dir-column { 2093 going up 2094 } 2095 \\hspace #1 2096 \\dir-column { 2097 going down 2098 } 2099 \\hspace #1 2100 \\override #'(direction . 1) 2101 \\dir-column { 2102 going up 2103 } 2104} 2105@end lilypond" 2106 (stack-lines (if (number? direction) direction -1) 2107 0.0 2108 baseline-skip 2109 (interpret-markup-list layout props args))) 2110 2111(define (general-column align-dir baseline mols) 2112 "Stack @var{mols} vertically, aligned to @var{align-dir} horizontally." 2113 (let* ((aligned-mols 2114 (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols)) 2115 (stacked-stencil (stack-lines -1 0.0 baseline aligned-mols)) 2116 (stacked-extent (ly:stencil-extent stacked-stencil X))) 2117 ;; empty stencils are not moved 2118 (if (interval-sane? stacked-extent) 2119 (ly:stencil-translate-axis 2120 stacked-stencil 2121 (- (car stacked-extent)) 2122 X) 2123 stacked-stencil))) 2124 2125(define-markup-command (center-column layout props args) 2126 (markup-list?) 2127 #:category align 2128 #:properties ((baseline-skip)) 2129 " 2130@cindex centering column of text 2131 2132Put @code{args} in a centered column. 2133 2134@lilypond[verbatim,quote] 2135\\markup { 2136 \\center-column { 2137 one 2138 two 2139 three 2140 } 2141} 2142@end lilypond" 2143 (general-column CENTER baseline-skip (interpret-markup-list layout props args))) 2144 2145(define-markup-command (left-column layout props args) 2146 (markup-list?) 2147 #:category align 2148 #:properties ((baseline-skip)) 2149 " 2150@cindex text column, left-aligned 2151 2152Put @code{args} in a left-aligned column. 2153 2154@lilypond[verbatim,quote] 2155\\markup { 2156 \\left-column { 2157 one 2158 two 2159 three 2160 } 2161} 2162@end lilypond" 2163 (general-column LEFT baseline-skip (interpret-markup-list layout props args))) 2164 2165(define-markup-command (right-column layout props args) 2166 (markup-list?) 2167 #:category align 2168 #:properties ((baseline-skip)) 2169 " 2170@cindex text column, right-aligned 2171 2172Put @code{args} in a right-aligned column. 2173 2174@lilypond[verbatim,quote] 2175\\markup { 2176 \\right-column { 2177 one 2178 two 2179 three 2180 } 2181} 2182@end lilypond" 2183 (general-column RIGHT baseline-skip (interpret-markup-list layout props args))) 2184 2185(define-markup-command (vcenter layout props arg) 2186 (markup?) 2187 #:category align 2188 " 2189@cindex vertically centering text 2190 2191Align @code{arg} to its Y@tie{}center. 2192 2193@lilypond[verbatim,quote] 2194\\markup { 2195 one 2196 \\vcenter 2197 two 2198 three 2199} 2200@end lilypond" 2201 (let* ((mol (interpret-markup layout props arg))) 2202 (ly:stencil-aligned-to mol Y CENTER))) 2203 2204(define-markup-command (center-align layout props arg) 2205 (markup?) 2206 #:category align 2207 " 2208@cindex horizontally centering text 2209 2210Align @code{arg} to its X@tie{}center. 2211 2212@lilypond[verbatim,quote] 2213\\markup { 2214 \\column { 2215 one 2216 \\center-align 2217 two 2218 three 2219 } 2220} 2221@end lilypond" 2222 (let* ((mol (interpret-markup layout props arg))) 2223 (ly:stencil-aligned-to mol X CENTER))) 2224 2225(define-markup-command (right-align layout props arg) 2226 (markup?) 2227 #:category align 2228 " 2229@cindex right-aligning text 2230 2231Align @var{arg} on its right edge. 2232 2233@lilypond[verbatim,quote] 2234\\markup { 2235 \\column { 2236 one 2237 \\right-align 2238 two 2239 three 2240 } 2241} 2242@end lilypond" 2243 (let* ((m (interpret-markup layout props arg))) 2244 (ly:stencil-aligned-to m X RIGHT))) 2245 2246(define-markup-command (left-align layout props arg) 2247 (markup?) 2248 #:category align 2249 " 2250@cindex left-aligning text 2251 2252Align @var{arg} on its left edge. 2253 2254@lilypond[verbatim,quote] 2255\\markup { 2256 \\column { 2257 one 2258 \\left-align 2259 two 2260 three 2261 } 2262} 2263@end lilypond" 2264 (let* ((m (interpret-markup layout props arg))) 2265 (ly:stencil-aligned-to m X LEFT))) 2266 2267(define-markup-command (general-align layout props axis dir arg) 2268 (integer? number? markup?) 2269 #:category align 2270 " 2271@cindex controlling general text alignment 2272 2273Align @var{arg} in @var{axis} direction to the @var{dir} side. 2274 2275@lilypond[verbatim,quote] 2276\\markup { 2277 \\column { 2278 one 2279 \\general-align #X #LEFT 2280 two 2281 three 2282 \\null 2283 one 2284 \\general-align #X #CENTER 2285 two 2286 three 2287 \\null 2288 \\line { 2289 one 2290 \\general-align #Y #UP 2291 two 2292 three 2293 } 2294 \\null 2295 \\line { 2296 one 2297 \\general-align #Y #3.2 2298 two 2299 three 2300 } 2301 } 2302} 2303@end lilypond" 2304 (let* ((m (interpret-markup layout props arg))) 2305 (ly:stencil-aligned-to m axis dir))) 2306 2307(define-markup-command (halign layout props dir arg) 2308 (number? markup?) 2309 #:category align 2310 " 2311@cindex setting horizontal text alignment 2312 2313Set horizontal alignment. If @var{dir} is @w{@code{-1}}, then it is 2314left-aligned, while @code{+1} is right. Values in between interpolate 2315alignment accordingly. 2316 2317@lilypond[verbatim,quote] 2318\\markup { 2319 \\column { 2320 one 2321 \\halign #LEFT 2322 two 2323 three 2324 \\null 2325 one 2326 \\halign #CENTER 2327 two 2328 three 2329 \\null 2330 one 2331 \\halign #RIGHT 2332 two 2333 three 2334 \\null 2335 one 2336 \\halign #-5 2337 two 2338 three 2339 } 2340} 2341@end lilypond" 2342 (let* ((m (interpret-markup layout props arg))) 2343 (ly:stencil-aligned-to m X dir))) 2344 2345(define-markup-command (with-dimensions layout props x y arg) 2346 (number-pair? number-pair? markup?) 2347 #:category other 2348 " 2349@cindex setting extent of text object 2350 2351Set the horizontal and vertical dimensions of @var{arg} to @var{x} 2352and@tie{}@var{y}." 2353 (ly:stencil-outline 2354 (interpret-markup layout props arg) 2355 (make-filled-box-stencil x y))) 2356 2357 2358(define-markup-command (with-outline layout props outline arg) 2359 (markup? markup?) 2360 #:category other 2361 " 2362Print @var{arg} with the outline and dimensions of @var{outline}. The outline 2363is used by skylines to resolve collisions (not for whiteout)." 2364 (ly:stencil-outline (interpret-markup layout props arg) 2365 (interpret-markup layout props outline))) 2366 2367(define-markup-command (with-dimensions-from layout props arg1 arg2) 2368 (markup? markup?) 2369 #:category other 2370 " 2371Print @var{arg2} with the horizontal and vertical dimensions of @var{arg1}." 2372 (let* ((stil1 (interpret-markup layout props arg1)) 2373 (x (ly:stencil-extent stil1 0)) 2374 (y (ly:stencil-extent stil1 1))) 2375 (interpret-markup layout props (make-with-dimensions-markup x y arg2)))) 2376 2377(define-markup-command (pad-around layout props amount arg) 2378 (number? markup?) 2379 #:category align 2380 "Add padding @var{amount} all around @var{arg}. 2381 2382@lilypond[verbatim,quote] 2383\\markup { 2384 \\box { 2385 default 2386 } 2387 \\hspace #2 2388 \\box { 2389 \\pad-around #0.5 { 2390 padded 2391 } 2392 } 2393} 2394@end lilypond" 2395 (let* ((m (interpret-markup layout props arg)) 2396 (x (interval-widen (ly:stencil-extent m X) amount)) 2397 (y (interval-widen (ly:stencil-extent m Y) amount))) 2398 (ly:stencil-add (make-transparent-box-stencil x y) 2399 m))) 2400 2401(define-markup-command (pad-x layout props amount arg) 2402 (number? markup?) 2403 #:category align 2404 " 2405@cindex padding text horizontally 2406 2407Add padding @var{amount} around @var{arg} in the X@tie{}direction. 2408 2409@lilypond[verbatim,quote] 2410\\markup { 2411 \\box { 2412 default 2413 } 2414 \\hspace #4 2415 \\box { 2416 \\pad-x #2 { 2417 padded 2418 } 2419 } 2420} 2421@end lilypond" 2422 (let* ((m (interpret-markup layout props arg)) 2423 (x (ly:stencil-extent m X)) 2424 (y (ly:stencil-extent m Y))) 2425 (ly:make-stencil (ly:stencil-expr m) 2426 (interval-widen x amount) 2427 y))) 2428 2429(define-markup-command (put-adjacent layout props axis dir arg1 arg2) 2430 (integer? ly:dir? markup? markup?) 2431 #:category align 2432 "Put @var{arg2} next to @var{arg1}, without moving @var{arg1}." 2433 (let ((m1 (interpret-markup layout props arg1)) 2434 (m2 (interpret-markup layout props arg2))) 2435 (ly:stencil-combine-at-edge m1 axis dir m2 0.0))) 2436 2437(define-markup-command (transparent layout props arg) 2438 (markup?) 2439 #:category other 2440 "Make @var{arg} transparent. 2441 2442@lilypond[verbatim,quote] 2443\\markup { 2444 \\transparent { 2445 invisible text 2446 } 2447} 2448@end lilypond" 2449 (ly:stencil-outline empty-stencil (interpret-markup layout props arg))) 2450 2451(define-markup-command (pad-to-box layout props x-ext y-ext arg) 2452 (number-pair? number-pair? markup?) 2453 #:category align 2454 "Make @var{arg} take at least @var{x-ext}, @var{y-ext} space. 2455 2456@lilypond[verbatim,quote] 2457\\markup { 2458 \\box { 2459 default 2460 } 2461 \\hspace #4 2462 \\box { 2463 \\pad-to-box #'(0 . 10) #'(0 . 3) { 2464 padded 2465 } 2466 } 2467} 2468@end lilypond" 2469 (ly:stencil-add (make-transparent-box-stencil x-ext y-ext) 2470 (interpret-markup layout props arg))) 2471 2472(define-markup-command (hcenter-in layout props length arg) 2473 (number? markup?) 2474 #:category align 2475 "Center @var{arg} horizontally within a box of extending 2476@var{length}/2 to the left and right. 2477 2478@lilypond[verbatim,quote] 2479\\new StaffGroup << 2480 \\new Staff { 2481 \\set Staff.instrumentName = \\markup { 2482 \\hcenter-in #12 2483 Oboe 2484 } 2485 c''1 2486 } 2487 \\new Staff { 2488 \\set Staff.instrumentName = \\markup { 2489 \\hcenter-in #12 2490 Bassoon 2491 } 2492 \\clef tenor 2493 c'1 2494 } 2495>> 2496@end lilypond" 2497 (interpret-markup layout props 2498 (make-pad-to-box-markup 2499 (cons (/ length -2) (/ length 2)) 2500 '(0 . 0) 2501 (make-center-align-markup arg)))) 2502 2503;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2504;; property 2505;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2506 2507(define-markup-command (property-recursive layout props symbol) 2508 (symbol?) 2509 #:category other 2510 "Print out a warning when a header field markup contains some recursive 2511markup definition." 2512 (ly:warning (_ "Recursive definition of property ~a detected!") symbol) 2513 empty-stencil) 2514 2515(define-markup-command (fromproperty layout props symbol) 2516 (symbol?) 2517 #:category other 2518 "Read the @var{symbol} from property settings, and produce a stencil 2519from the markup contained within. If @var{symbol} is not defined, it 2520returns an empty markup. 2521 2522@lilypond[verbatim,quote,line-width=14\\cm] 2523\\header { 2524 myTitle = \"myTitle\" 2525 title = \\markup { 2526 from 2527 \\italic 2528 \\fromproperty #'header:myTitle 2529 } 2530} 2531\\markup { 2532 \\null 2533} 2534@end lilypond" 2535 (let ((m (chain-assoc-get symbol props))) 2536 (if (markup? m) 2537 ;; prevent infinite loops by clearing the interpreted property: 2538 (interpret-markup layout (cons (list (cons symbol `(,property-recursive-markup ,symbol))) props) m) 2539 empty-stencil))) 2540 2541(define-markup-command (on-the-fly layout props procedure arg) 2542 (procedure? markup?) 2543 #:category other 2544 "Apply the @var{procedure} markup command to @var{arg}. 2545@var{procedure} takes the same arguments as @code{interpret-markup} 2546and returns a stencil." 2547 (procedure layout props arg)) 2548 2549(define-markup-command (footnote layout props mkup note) 2550 (markup? markup?) 2551 #:category other 2552 "Have footnote @var{note} act as an annotation to the markup @var{mkup}. 2553 2554@lilypond[verbatim,quote] 2555\\markup { 2556 \\auto-footnote a b 2557 \\override #'(padding . 0.2) 2558 \\auto-footnote c d 2559} 2560@end lilypond 2561The footnote will not be annotated automatically." 2562 (ly:stencil-combine-at-edge 2563 (interpret-markup layout props mkup) 2564 X 2565 RIGHT 2566 (ly:make-stencil 2567 `(footnote (gensym "footnote") #f ,(interpret-markup layout props note)) 2568 '(0 . 0) 2569 '(0 . 0)) 2570 0.0)) 2571 2572(define-markup-command (auto-footnote layout props mkup note) 2573 (markup? markup?) 2574 #:category other 2575 #:properties ((raise 0.5) 2576 (padding 0.0)) 2577 "Have footnote @var{note} act as an annotation to the markup @var{mkup}. 2578 2579@lilypond[verbatim,quote] 2580\\markup { 2581 \\auto-footnote a b 2582 \\override #'(padding . 0.2) 2583 \\auto-footnote c d 2584} 2585@end lilypond 2586The footnote will be annotated automatically." 2587 (let* ((markup-stencil (interpret-markup layout props mkup)) 2588 (footnote-hash (gensym "footnote")) 2589 (stencil-seed 0) 2590 (gauge-stencil (interpret-markup 2591 layout 2592 props 2593 ((ly:output-def-lookup 2594 layout 2595 'footnote-numbering-function) 2596 stencil-seed))) 2597 (x-ext (ly:stencil-extent gauge-stencil X)) 2598 (y-ext (ly:stencil-extent gauge-stencil Y)) 2599 (footnote-number 2600 `(delay-stencil-evaluation 2601 ,(delay 2602 (ly:stencil-expr 2603 (let* ((table 2604 (ly:output-def-lookup layout 2605 'number-footnote-table)) 2606 (footnote-stencil (if (list? table) 2607 (assoc-get footnote-hash 2608 table) 2609 empty-stencil)) 2610 (footnote-stencil (if (ly:stencil? footnote-stencil) 2611 footnote-stencil 2612 (begin 2613 (ly:programming-error 2614 "Cannot find correct footnote for a markup object.") 2615 empty-stencil))) 2616 (gap (- (interval-length x-ext) 2617 (interval-length 2618 (ly:stencil-extent footnote-stencil X)))) 2619 (y-trans (- (+ (cdr y-ext) 2620 raise) 2621 (cdr (ly:stencil-extent footnote-stencil 2622 Y))))) 2623 (ly:stencil-translate footnote-stencil 2624 (cons gap y-trans))))))) 2625 (main-stencil (ly:stencil-combine-at-edge 2626 markup-stencil 2627 X 2628 RIGHT 2629 (ly:make-stencil footnote-number x-ext y-ext) 2630 padding))) 2631 (ly:stencil-add 2632 main-stencil 2633 (ly:make-stencil 2634 `(footnote ,footnote-hash #t ,(interpret-markup layout props note)) 2635 '(0 . 0) 2636 '(0 . 0))))) 2637 2638(define-markup-command (override layout props new-prop arg) 2639 (pair? markup?) 2640 #:category other 2641 " 2642@cindex overriding property within text markup 2643 2644Add the argument @var{new-prop} to the property list. Properties 2645may be any property supported by @rinternals{font-interface}, 2646@rinternals{text-interface} and 2647@rinternals{instrument-specific-markup-interface}. 2648 2649@var{new-prop} may be either a single alist pair, or non-empty alist 2650of its own. 2651 2652@lilypond[verbatim,quote] 2653\\markup { 2654 \\undertie \"undertied\" 2655 \\override #'(offset . 15) 2656 \\undertie \"offset undertied\" 2657 \\override #'((offset . 15)(thickness . 3)) 2658 \\undertie \"offset thick undertied\" 2659} 2660@end lilypond" 2661 (interpret-markup layout 2662 (cons (if (pair? (car new-prop)) new-prop (list new-prop)) 2663 props) 2664 arg)) 2665 2666;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2667;; files 2668;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2669 2670(define-markup-command (verbatim-file layout props name) 2671 (string?) 2672 #:category other 2673 "Read the contents of file @var{name}, and include it verbatim. 2674 2675@lilypond[verbatim,quote] 2676\\markup { 2677 \\verbatim-file #\"en/included/simple.ly\" 2678} 2679@end lilypond" 2680 (interpret-markup layout props 2681 (if (ly:get-option 'safe) 2682 "verbatim-file disabled in safe mode" 2683 (let* ((str (ly:gulp-file name)) 2684 (lines (string-split str #\nl))) 2685 (make-typewriter-markup 2686 (make-column-markup lines)))))) 2687 2688;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2689;; fonts. 2690;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 2691 2692 2693(define-markup-command (smaller layout props arg) 2694 (markup?) 2695 #:category font 2696 "Decrease the font size relative to the current setting. 2697 2698@lilypond[verbatim,quote] 2699\\markup { 2700 \\fontsize #3.5 { 2701 large text 2702 \\hspace #2 2703 \\smaller { smaller text } 2704 \\hspace #2 2705 large text 2706 } 2707} 2708@end lilypond" 2709 (interpret-markup layout props 2710 `(,fontsize-markup -1 ,arg))) 2711 2712(define-markup-command (larger layout props arg) 2713 (markup?) 2714 #:category font 2715 "Increase the font size relative to the current setting. 2716 2717@lilypond[verbatim,quote] 2718\\markup { 2719 default 2720 \\hspace #2 2721 \\larger 2722 larger 2723} 2724@end lilypond" 2725 (interpret-markup layout props 2726 `(,fontsize-markup 1 ,arg))) 2727 2728(define-markup-command (finger layout props arg) 2729 (markup?) 2730 #:category font 2731 "Set @var{arg} as small numbers. 2732 2733@lilypond[verbatim,quote] 2734\\markup { 2735 \\finger { 2736 1 2 3 4 5 2737 } 2738} 2739@end lilypond" 2740 (interpret-markup layout 2741 (cons '((font-size . -5) (font-encoding . fetaText)) props) 2742 arg)) 2743 2744(define-markup-command (abs-fontsize layout props size arg) 2745 (number? markup?) 2746 #:properties ((word-space 0.6) (baseline-skip 3)) 2747 #:category font 2748 "Use @var{size} as the absolute font size (in points) to display @var{arg}. 2749Adjusts @code{baseline-skip} and @code{word-space} accordingly. 2750 2751@lilypond[verbatim,quote] 2752\\markup { 2753 default text font size 2754 \\hspace #2 2755 \\abs-fontsize #16 { text font size 16 } 2756 \\hspace #2 2757 \\abs-fontsize #12 { text font size 12 } 2758} 2759@end lilypond" 2760 (let* ((ref-size (ly:output-def-lookup layout 'text-font-size 12)) 2761 (text-props (list (ly:output-def-lookup layout 'text-font-defaults))) 2762 (magnification (/ size ref-size))) 2763 (interpret-markup 2764 layout 2765 (cons 2766 `((baseline-skip . ,(* magnification baseline-skip)) 2767 (word-space . ,(* magnification word-space)) 2768 (font-size . ,(magnification->font-size magnification))) 2769 props) 2770 arg))) 2771 2772(define-markup-command (fontsize layout props increment arg) 2773 (number? markup?) 2774 #:category font 2775 #:properties ((font-size 0) 2776 (word-space 1) 2777 (baseline-skip 2)) 2778 "Add @var{increment} to the font-size. Adjusts @code{baseline-skip} 2779accordingly. 2780 2781@lilypond[verbatim,quote] 2782\\markup { 2783 default 2784 \\hspace #2 2785 \\fontsize #-1.5 2786 smaller 2787} 2788@end lilypond" 2789 (interpret-markup 2790 layout 2791 (cons 2792 `((baseline-skip . ,(* baseline-skip (magstep increment))) 2793 (word-space . ,(* word-space (magstep increment))) 2794 (font-size . ,(+ font-size increment))) 2795 props) 2796 arg)) 2797 2798(define-markup-command (magnify layout props sz arg) 2799 (number? markup?) 2800 #:category font 2801 " 2802@cindex magnifying text 2803 2804Set the font magnification for its argument. In the following 2805example, the middle@tie{}A is 10% larger: 2806 2807@example 2808A \\magnify #1.1 @{ A @} A 2809@end example 2810 2811Note: Magnification only works if a font name is explicitly selected. 2812Use @code{\\fontsize} otherwise. 2813 2814@lilypond[verbatim,quote] 2815\\markup { 2816 default 2817 \\hspace #2 2818 \\magnify #1.5 { 2819 50% larger 2820 } 2821} 2822@end lilypond" 2823 (interpret-markup 2824 layout 2825 (prepend-alist-chain 'font-size (magnification->font-size sz) props) 2826 arg)) 2827 2828(define-markup-command (bold layout props arg) 2829 (markup?) 2830 #:category font 2831 "Switch to bold font-series. 2832 2833@lilypond[verbatim,quote] 2834\\markup { 2835 default 2836 \\hspace #2 2837 \\bold 2838 bold 2839} 2840@end lilypond" 2841 (interpret-markup layout (prepend-alist-chain 'font-series 'bold props) arg)) 2842 2843(define-markup-command (sans layout props arg) 2844 (markup?) 2845 #:category font 2846 "Switch to the sans serif font family. 2847 2848@lilypond[verbatim,quote] 2849\\markup { 2850 default 2851 \\hspace #2 2852 \\sans { 2853 sans serif 2854 } 2855} 2856@end lilypond" 2857 (interpret-markup layout (prepend-alist-chain 'font-family 'sans props) arg)) 2858 2859(define-markup-command (number layout props arg) 2860 (markup?) 2861 #:category font 2862 "Set font family to @code{number}, which yields the font used for 2863time signatures and fingerings. This font contains numbers and 2864some punctuation; it has no letters. 2865 2866@lilypond[verbatim,quote] 2867\\markup { 2868 \\number { 2869 0 1 2 3 4 5 6 7 8 9 . , 2870 } 2871} 2872@end lilypond" 2873 (interpret-markup layout (prepend-alist-chain 'font-encoding 'fetaText props) arg)) 2874 2875(define-markup-command (roman layout props arg) 2876 (markup?) 2877 #:category font 2878 "Set font family to @code{roman}. 2879 2880@lilypond[verbatim,quote] 2881\\markup { 2882 \\sans \\bold { 2883 sans serif, bold 2884 \\hspace #2 2885 \\roman { 2886 text in roman font family 2887 } 2888 \\hspace #2 2889 return to sans 2890 } 2891} 2892@end lilypond" 2893 (interpret-markup layout (prepend-alist-chain 'font-family 'roman props) arg)) 2894 2895(define-markup-command (huge layout props arg) 2896 (markup?) 2897 #:category font 2898 "Set font size to +2. 2899 2900@lilypond[verbatim,quote] 2901\\markup { 2902 default 2903 \\hspace #2 2904 \\huge 2905 huge 2906} 2907@end lilypond" 2908 (interpret-markup layout (prepend-alist-chain 'font-size 2 props) arg)) 2909 2910(define-markup-command (large layout props arg) 2911 (markup?) 2912 #:category font 2913 "Set font size to +1. 2914 2915@lilypond[verbatim,quote] 2916\\markup { 2917 default 2918 \\hspace #2 2919 \\large 2920 large 2921} 2922@end lilypond" 2923 (interpret-markup layout (prepend-alist-chain 'font-size 1 props) arg)) 2924 2925(define-markup-command (normalsize layout props arg) 2926 (markup?) 2927 #:category font 2928 "Set font size to default. 2929 2930@lilypond[verbatim,quote] 2931\\markup { 2932 \\teeny { 2933 this is very small 2934 \\hspace #2 2935 \\normalsize { 2936 normal size 2937 } 2938 \\hspace #2 2939 teeny again 2940 } 2941} 2942@end lilypond" 2943 (interpret-markup layout (prepend-alist-chain 'font-size 0 props) arg)) 2944 2945(define-markup-command (small layout props arg) 2946 (markup?) 2947 #:category font 2948 "Set font size to -1. 2949 2950@lilypond[verbatim,quote] 2951\\markup { 2952 default 2953 \\hspace #2 2954 \\small 2955 small 2956} 2957@end lilypond" 2958 (interpret-markup layout (prepend-alist-chain 'font-size -1 props) arg)) 2959 2960(define-markup-command (tiny layout props arg) 2961 (markup?) 2962 #:category font 2963 "Set font size to -2. 2964 2965@lilypond[verbatim,quote] 2966\\markup { 2967 default 2968 \\hspace #2 2969 \\tiny 2970 tiny 2971} 2972@end lilypond" 2973 (interpret-markup layout (prepend-alist-chain 'font-size -2 props) arg)) 2974 2975(define-markup-command (teeny layout props arg) 2976 (markup?) 2977 #:category font 2978 "Set font size to -3. 2979 2980@lilypond[verbatim,quote] 2981\\markup { 2982 default 2983 \\hspace #2 2984 \\teeny 2985 teeny 2986} 2987@end lilypond" 2988 (interpret-markup layout (prepend-alist-chain 'font-size -3 props) arg)) 2989 2990(define-markup-command (fontCaps layout props arg) 2991 (markup?) 2992 #:category font 2993 "Set @code{font-shape} to @code{caps} 2994 2995Note: @code{\\fontCaps} requires the installation and selection of 2996fonts which support the @code{caps} font shape." 2997 (interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg)) 2998 2999;; Poor man's caps 3000(define-markup-command (smallCaps layout props arg) 3001 (markup?) 3002 #:category font 3003 "Emit @var{arg} as small caps. 3004 3005Note: @code{\\smallCaps} does not support accented characters. 3006 3007@lilypond[verbatim,quote] 3008\\markup { 3009 default 3010 \\hspace #2 3011 \\smallCaps { 3012 Text in small caps 3013 } 3014} 3015@end lilypond" 3016 (define (char-list->markup chars lower) 3017 (let ((final-string (string-upcase (reverse-list->string chars)))) 3018 (if lower 3019 (make-fontsize-markup -2 final-string) 3020 final-string))) 3021 (define (make-small-caps rest-chars currents current-is-lower prev-result) 3022 (if (null? rest-chars) 3023 (make-concat-markup 3024 (reverse! (cons (char-list->markup currents current-is-lower) 3025 prev-result))) 3026 (let* ((ch (car rest-chars)) 3027 (is-lower (char-lower-case? ch))) 3028 (if (or (and current-is-lower is-lower) 3029 (and (not current-is-lower) (not is-lower))) 3030 (make-small-caps (cdr rest-chars) 3031 (cons ch currents) 3032 is-lower 3033 prev-result) 3034 (make-small-caps (cdr rest-chars) 3035 (list ch) 3036 is-lower 3037 (if (null? currents) 3038 prev-result 3039 (cons (char-list->markup 3040 currents current-is-lower) 3041 prev-result))))))) 3042 (interpret-markup layout props 3043 (if (string? arg) 3044 (make-small-caps (string->list arg) (list) #f (list)) 3045 arg))) 3046 3047(define-markup-command (caps layout props arg) 3048 (markup?) 3049 #:category font 3050 "Copy of the @code{\\smallCaps} command. 3051 3052@lilypond[verbatim,quote] 3053\\markup { 3054 default 3055 \\hspace #2 3056 \\caps { 3057 Text in small caps 3058 } 3059} 3060@end lilypond" 3061 (interpret-markup layout props (make-smallCaps-markup arg))) 3062 3063(define-markup-command (dynamic layout props arg) 3064 (markup?) 3065 #:category font 3066 "Use the dynamic font. This font only contains @b{s}, @b{f}, @b{m}, 3067@b{z}, @b{p}, and @b{r}. When producing phrases, like 3068@q{pi@`{u}@tie{}@b{f}}, the normal words (like @q{pi@`{u}}) should be 3069done in a different font. The recommended font for this is bold and italic. 3070@lilypond[verbatim,quote] 3071\\markup { 3072 \\dynamic { 3073 sfzp 3074 } 3075} 3076@end lilypond" 3077 (interpret-markup 3078 layout (prepend-alist-chain 'font-encoding 'fetaText props) arg)) 3079 3080(define-markup-command (text layout props arg) 3081 (markup?) 3082 #:category font 3083 "Use a text font instead of music symbol or music alphabet font. 3084 3085@lilypond[verbatim,quote] 3086\\markup { 3087 \\number { 3088 1, 2, 3089 \\text { 3090 three, four, 3091 } 3092 5 3093 } 3094} 3095@end lilypond" 3096 3097 ;; ugh - latin1 3098 (interpret-markup layout (prepend-alist-chain 'font-encoding 'latin1 props) 3099 arg)) 3100 3101(define-markup-command (italic layout props arg) 3102 (markup?) 3103 #:category font 3104 "Use italic @code{font-shape} for @var{arg}. 3105 3106@lilypond[verbatim,quote] 3107\\markup { 3108 default 3109 \\hspace #2 3110 \\italic 3111 italic 3112} 3113@end lilypond" 3114 (interpret-markup layout (prepend-alist-chain 'font-shape 'italic props) arg)) 3115 3116(define-markup-command (typewriter layout props arg) 3117 (markup?) 3118 #:category font 3119 "Use @code{font-family} typewriter for @var{arg}. 3120 3121@lilypond[verbatim,quote] 3122\\markup { 3123 default 3124 \\hspace #2 3125 \\typewriter 3126 typewriter 3127} 3128@end lilypond" 3129 (interpret-markup 3130 layout (prepend-alist-chain 'font-family 'typewriter props) arg)) 3131 3132(define-markup-command (upright layout props arg) 3133 (markup?) 3134 #:category font 3135 "Set @code{font-shape} to @code{upright}. This is the opposite 3136of @code{italic}. 3137 3138@lilypond[verbatim,quote] 3139\\markup { 3140 \\italic { 3141 italic text 3142 \\hspace #2 3143 \\upright { 3144 upright text 3145 } 3146 \\hspace #2 3147 italic again 3148 } 3149} 3150@end lilypond" 3151 (interpret-markup 3152 layout (prepend-alist-chain 'font-shape 'upright props) arg)) 3153 3154(define-markup-command (medium layout props arg) 3155 (markup?) 3156 #:category font 3157 "Switch to medium font-series (in contrast to bold). 3158 3159@lilypond[verbatim,quote] 3160\\markup { 3161 \\bold { 3162 some bold text 3163 \\hspace #2 3164 \\medium { 3165 medium font series 3166 } 3167 \\hspace #2 3168 bold again 3169 } 3170} 3171@end lilypond" 3172 (interpret-markup layout (prepend-alist-chain 'font-series 'medium props) 3173 arg)) 3174 3175(define-markup-command (normal-text layout props arg) 3176 (markup?) 3177 #:category font 3178 "Set all font related properties (except the size) to get the default 3179normal text font, no matter what font was used earlier. 3180 3181@lilypond[verbatim,quote] 3182\\markup { 3183 \\huge \\bold \\sans \\caps { 3184 huge bold sans caps 3185 \\hspace #2 3186 \\normal-text { 3187 huge normal 3188 } 3189 \\hspace #2 3190 as before 3191 } 3192} 3193@end lilypond" 3194 ;; ugh - latin1 3195 (interpret-markup layout 3196 (cons '((font-family . roman) (font-shape . upright) 3197 (font-series . medium) (font-encoding . latin1)) 3198 props) 3199 arg)) 3200 3201;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3202;; symbols. 3203;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3204 3205(define-markup-command (musicglyph layout props glyph-name) 3206 (string?) 3207 #:category music 3208 "@var{glyph-name} is converted to a musical symbol; for example, 3209@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from 3210the music font. See @ruser{The Emmentaler font} for a complete listing of 3211the possible glyphs. 3212 3213@lilypond[verbatim,quote] 3214\\markup { 3215 \\musicglyph #\"f\" 3216 \\musicglyph #\"rests.2\" 3217 \\musicglyph #\"clefs.G_change\" 3218} 3219@end lilypond" 3220 (let* ((font (ly:paper-get-font layout 3221 (cons '((font-encoding . fetaMusic) 3222 (font-name . #f)) 3223 3224 props))) 3225 (glyph (ly:font-get-glyph font glyph-name))) 3226 (if (null? (ly:stencil-expr glyph)) 3227 (ly:warning (_ "Cannot find glyph ~a") glyph-name)) 3228 3229 glyph)) 3230 3231(define-markup-command (accidental layout props alteration) 3232 (exact-rational?) 3233 #:category music 3234 #:properties ((alteration-glyph-name-alist)) 3235 "Select an accidental glyph from an alteration, given as 3236rational number. 3237 3238@lilypond[verbatim,quote] 3239\\markup \\accidental #1/2 3240@end lilypond" 3241 (let* ((defs (ly:output-def-lookup layout 'font-defaults)) 3242 (glyph-alist (or alteration-glyph-name-alist 3243 (assq-ref defs 'alteration-glyph-name-alist)))) 3244 (interpret-markup layout props 3245 (make-musicglyph-markup 3246 (or 3247 (assv-ref glyph-alist alteration) 3248 (begin 3249 (ly:warning (_ "no accidental glyph found for alteration ~a") 3250 alteration) 3251 "noteheads.s1cross")))))) 3252 3253(define-markup-command (doublesharp layout props) 3254 () 3255 #:category music 3256 "Draw a double sharp symbol. 3257 3258@lilypond[verbatim,quote] 3259\\markup { 3260 \\doublesharp 3261} 3262@end lilypond" 3263 (interpret-markup layout props 3264 (make-accidental-markup 1))) 3265 3266(define-markup-command (sesquisharp layout props) 3267 () 3268 #:category music 3269 "Draw a 3/2 sharp symbol. 3270 3271@lilypond[verbatim,quote] 3272\\markup { 3273 \\sesquisharp 3274} 3275@end lilypond" 3276 (interpret-markup layout props 3277 (make-accidental-markup 3/4))) 3278 3279(define-markup-command (sharp layout props) 3280 () 3281 #:category music 3282 "Draw a sharp symbol. 3283 3284@lilypond[verbatim,quote] 3285\\markup { 3286 \\sharp 3287} 3288@end lilypond" 3289 (interpret-markup layout props 3290 (make-accidental-markup 1/2))) 3291 3292(define-markup-command (semisharp layout props) 3293 () 3294 #:category music 3295 "Draw a semisharp symbol. 3296 3297@lilypond[verbatim,quote] 3298\\markup { 3299 \\semisharp 3300} 3301@end lilypond" 3302 (interpret-markup layout props 3303 (make-accidental-markup 1/4))) 3304 3305(define-markup-command (natural layout props) 3306 () 3307 #:category music 3308 "Draw a natural symbol. 3309 3310@lilypond[verbatim,quote] 3311\\markup { 3312 \\natural 3313} 3314@end lilypond" 3315 (interpret-markup layout props 3316 (make-accidental-markup 0))) 3317 3318(define-markup-command (semiflat layout props) 3319 () 3320 #:category music 3321 "Draw a semiflat symbol. 3322 3323@lilypond[verbatim,quote] 3324\\markup { 3325 \\semiflat 3326} 3327@end lilypond" 3328 (interpret-markup layout props 3329 (make-accidental-markup -1/4))) 3330 3331(define-markup-command (flat layout props) 3332 () 3333 #:category music 3334 "Draw a flat symbol. 3335 3336@lilypond[verbatim,quote] 3337\\markup { 3338 \\flat 3339} 3340@end lilypond" 3341 (interpret-markup layout props 3342 (make-accidental-markup -1/2))) 3343 3344(define-markup-command (sesquiflat layout props) 3345 () 3346 #:category music 3347 "Draw a 3/2 flat symbol. 3348 3349@lilypond[verbatim,quote] 3350\\markup { 3351 \\sesquiflat 3352} 3353@end lilypond" 3354 (interpret-markup layout props 3355 (make-accidental-markup -3/4))) 3356 3357(define-markup-command (doubleflat layout props) 3358 () 3359 #:category music 3360 "Draw a double flat symbol. 3361 3362@lilypond[verbatim,quote] 3363\\markup { 3364 \\doubleflat 3365} 3366@end lilypond" 3367 (interpret-markup layout props 3368 (make-accidental-markup -1))) 3369 3370(define-markup-command (with-color layout props color arg) 3371 (color? markup?) 3372 #:category other 3373 " 3374@cindex coloring text 3375 3376Draw @var{arg} in color specified by @var{color}. 3377 3378@lilypond[verbatim,quote] 3379\\markup { 3380 \\with-color #red 3381 red 3382 \\hspace #2 3383 \\with-color #green 3384 green 3385 \\hspace #2 3386 \\with-color \"#0000ff\" 3387 blue 3388} 3389@end lilypond" 3390 (stencil-with-color (interpret-markup layout props arg) color)) 3391 3392(define-markup-command (tied-lyric layout props str) 3393 (string?) 3394 #:category music 3395 #:properties ((word-space)) 3396 " 3397@cindex simple text string, with tie characters 3398 3399Like simple-markup, but use tie characters for @q{~} tilde symbols. 3400 3401@lilypond[verbatim,quote] 3402\\markup \\column { 3403 \\tied-lyric 3404 #\"Siam navi~all'onde~algenti Lasciate~in abbandono\" 3405 \\tied-lyric 3406 #\"Impetuosi venti I nostri~affetti sono\" 3407 \\tied-lyric 3408 #\"Ogni diletto~e scoglio Tutta la vita~e~un mar.\" 3409} 3410@end lilypond" 3411 (define (replace-ties tie str) 3412 (if (string-contains str "~") 3413 (let* 3414 ((half-space (/ word-space 2)) 3415 (parts (string-split str #\~)) 3416 (tie-str (make-line-markup 3417 (list 3418 (make-hspace-markup half-space) 3419 (make-musicglyph-markup tie) 3420 (make-hspace-markup half-space)))) 3421 (joined (list-join parts tie-str))) 3422 (make-concat-markup joined)) 3423 str)) 3424 3425 (define short-tie-regexp (make-regexp "~[^.]~")) 3426 (define (match-short str) (regexp-exec short-tie-regexp str)) 3427 3428 (define (replace-short str mkp) 3429 (let ((match (match-short str))) 3430 (if (not match) 3431 (make-concat-markup (list 3432 mkp 3433 (replace-ties "ties.lyric.default" str))) 3434 (let ((new-str (match:suffix match)) 3435 (new-mkp (make-concat-markup (list 3436 mkp 3437 (replace-ties "ties.lyric.default" 3438 (match:prefix match)) 3439 (replace-ties "ties.lyric.short" 3440 (match:substring match)))))) 3441 (replace-short new-str new-mkp))))) 3442 3443 (interpret-markup layout 3444 props 3445 (replace-short str (markup)))) 3446 3447;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3448;; glyphs 3449;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3450 3451(define-markup-command (arrow-head layout props axis dir filled) 3452 (integer? ly:dir? boolean?) 3453 #:category graphic 3454 "Produce an arrow head in specified direction and axis. 3455Use the filled head if @var{filled} is specified. 3456@lilypond[verbatim,quote] 3457\\markup { 3458 \\fontsize #5 { 3459 \\general-align #Y #DOWN { 3460 \\arrow-head #Y #UP ##t 3461 \\arrow-head #Y #DOWN ##f 3462 \\hspace #2 3463 \\arrow-head #X #RIGHT ##f 3464 \\arrow-head #X #LEFT ##f 3465 } 3466 } 3467} 3468@end lilypond" 3469 (let* 3470 ((name (format #f "arrowheads.~a.~a~a" 3471 (if filled 3472 "close" 3473 "open") 3474 axis 3475 dir))) 3476 (ly:font-get-glyph 3477 (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) 3478 props)) 3479 name))) 3480 3481(define-markup-command (lookup layout props glyph-name) 3482 (string?) 3483 #:category other 3484 "Lookup a glyph by name. 3485 3486@lilypond[verbatim,quote] 3487\\markup { 3488 \\override #'(font-encoding . fetaBraces) { 3489 \\lookup #\"brace200\" 3490 \\hspace #2 3491 \\rotate #180 3492 \\lookup #\"brace180\" 3493 } 3494} 3495@end lilypond" 3496 (ly:font-get-glyph (ly:paper-get-font layout props) 3497 glyph-name)) 3498 3499(define-markup-command (char layout props num) 3500 (integer?) 3501 #:category other 3502 "Produce a single character. Characters encoded in hexadecimal 3503format require the prefix @code{#x}. 3504 3505@lilypond[verbatim,quote] 3506\\markup { 3507 \\char #65 \\char ##x00a9 3508} 3509@end lilypond" 3510 (ly:text-interface::interpret-markup layout props (ly:wide-char->utf-8 num))) 3511 3512(define mark-alphabets 3513 `((alphabet . ,(list->vector (string->list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))) 3514 (alphabet-omit-i . ,(list->vector (string->list "ABCDEFGHJKLMNOPQRSTUVWXYZ"))) 3515 (alphabet-omit-j . ,(list->vector (string->list "ABCDEFGHIKLMNOPQRSTUVWXYZ"))))) 3516 3517(define (markgeneric-string number alphabet double-letters) 3518 (let* ((the-alphabet (assq-ref mark-alphabets alphabet)) 3519 (the-alphabet-length (vector-length the-alphabet))) 3520 (case double-letters 3521 ((repeat) (let ((the-length (1+ (quotient (1- number) the-alphabet-length))) 3522 (the-index (remainder (1- number) the-alphabet-length))) 3523 (make-string the-length (vector-ref the-alphabet the-index)))) 3524 ((combine) (let loop ((num (1- number))) 3525 (if (< num the-alphabet-length) 3526 (string (vector-ref the-alphabet num)) 3527 (string-append 3528 (loop (1- (quotient num the-alphabet-length))) 3529 (loop (remainder num the-alphabet-length))))))))) 3530 3531(define-markup-command (markletter layout props num) 3532 (integer?) 3533 #:category other 3534 "Make a markup letter for @var{num}. The letters start with A 3535to@tie{}Z (skipping letter@tie{}I), and continue with double letters. 3536 3537@lilypond[verbatim,quote] 3538\\markup { 3539 \\markletter #8 3540 \\hspace #2 3541 \\markletter #26 3542} 3543@end lilypond" 3544 (ly:text-interface::interpret-markup layout props 3545 (markgeneric-string num 'alphabet-omit-i 'combine))) 3546 3547(define-markup-command (markalphabet layout props num) 3548 (integer?) 3549 #:category other 3550 "Make a markup letter for @var{num}. The letters start with A to@tie{}Z 3551and continue with double letters. 3552 3553@lilypond[verbatim,quote] 3554\\markup { 3555 \\markalphabet #8 3556 \\hspace #2 3557 \\markalphabet #26 3558} 3559@end lilypond" 3560 (ly:text-interface::interpret-markup layout props 3561 (markgeneric-string num 'alphabet 'combine))) 3562 3563(define-public (horizontal-slash-interval num forward number-interval mag) 3564 (if forward 3565 (cond ;; ((= num 6) (interval-widen number-interval (* mag 0.5))) 3566 ;; ((= num 5) (interval-widen number-interval (* mag 0.5))) 3567 (else (interval-widen number-interval (* mag 0.25)))) 3568 (cond ((= num 6) (interval-widen number-interval (* mag 0.5))) 3569 ;; ((= num 5) (interval-widen number-interval (* mag 0.5))) 3570 (else (interval-widen number-interval (* mag 0.25)))) 3571 )) 3572 3573(define-public (adjust-slash-stencil num forward stencil mag) 3574 (if forward 3575 (cond ((= num 2) 3576 (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2)))) 3577 ((= num 3) 3578 (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.2)))) 3579 ;; ((= num 5) 3580 ;; (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.07)))) 3581 ;; ((= num 7) 3582 ;; (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15)))) 3583 (else stencil)) 3584 (cond ((= num 6) 3585 (ly:stencil-translate stencil (cons (* mag -0.00) (* mag 0.15)))) 3586 ;; ((= num 8) 3587 ;; (ly:stencil-translate stencil (cons (* mag -0.00) (* mag -0.15)))) 3588 (else stencil)) 3589 ) 3590 ) 3591 3592(define (slashed-digit-internal layout props num forward font-size thickness) 3593 (let* ((mag (magstep font-size)) 3594 (thickness (* mag 3595 (ly:output-def-lookup layout 'line-thickness) 3596 thickness)) 3597 ;; backward slashes might use slope and point in the other direction! 3598 (dy (* mag (if forward 0.4 -0.4))) 3599 (number-stencil (interpret-markup layout 3600 (prepend-alist-chain 'font-encoding 'fetaText props) 3601 (number->string num))) 3602 (num-x (horizontal-slash-interval num forward (ly:stencil-extent number-stencil X) mag)) 3603 (center (interval-center (ly:stencil-extent number-stencil Y))) 3604 ;; Use the real extents of the slash, not the whole number, 3605 ;; because we might translate the slash later on! 3606 (num-y (interval-widen (cons center center) (abs dy))) 3607 (is-sane (and (interval-sane? num-x) (interval-sane? num-y))) 3608 (slash-stencil (if is-sane 3609 (make-line-stencil thickness 3610 (car num-x) (- (interval-center num-y) dy) 3611 (cdr num-x) (+ (interval-center num-y) dy)) 3612 #f))) 3613 (if (ly:stencil? slash-stencil) 3614 (begin 3615 ;; for some numbers we need to shift the slash/backslash up or 3616 ;; down to make the slashed digit look better 3617 (set! slash-stencil (adjust-slash-stencil num forward slash-stencil mag)) 3618 (set! number-stencil 3619 (ly:stencil-add number-stencil slash-stencil))) 3620 (ly:warning (_ "Unable to create slashed digit ~a") num)) 3621 number-stencil)) 3622 3623 3624(define-markup-command (slashed-digit layout props num) 3625 (integer?) 3626 #:category other 3627 #:properties ((font-size 0) 3628 (thickness 1.6)) 3629 " 3630@cindex slashed digit 3631 3632A feta number, with slash. This is for use in the context of 3633figured bass notation. 3634@lilypond[verbatim,quote] 3635\\markup { 3636 \\slashed-digit #5 3637 \\hspace #2 3638 \\override #'(thickness . 3) 3639 \\slashed-digit #7 3640} 3641@end lilypond" 3642 (slashed-digit-internal layout props num #t font-size thickness)) 3643 3644(define-markup-command (backslashed-digit layout props num) 3645 (integer?) 3646 #:category other 3647 #:properties ((font-size 0) 3648 (thickness 1.6)) 3649 " 3650@cindex backslashed digit 3651 3652A feta number, with backslash. This is for use in the context of 3653figured bass notation. 3654@lilypond[verbatim,quote] 3655\\markup { 3656 \\backslashed-digit #5 3657 \\hspace #2 3658 \\override #'(thickness . 3) 3659 \\backslashed-digit #7 3660} 3661@end lilypond" 3662 (slashed-digit-internal layout props num #f font-size thickness)) 3663 3664;; eyeglasses 3665(define eyeglassespath 3666 '((moveto 0.42 0.77) 3667 (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55) 3668 (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55) 3669 (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55) 3670 (rcurveto 0.304 0 0.55 0.246 0.55 0.55) 3671 (closepath) 3672 (moveto 2.07 0.77) 3673 (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55) 3674 (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55) 3675 (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55) 3676 (rcurveto 0.304 0 0.55 0.246 0.55 0.55) 3677 (closepath) 3678 (moveto 1.025 0.935) 3679 (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33) 3680 (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33) 3681 (moveto -0.68 0.77) 3682 (rlineto 0.66 1.43) 3683 (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33) 3684 (moveto 2.07 0.77) 3685 (rlineto 0.66 1.43) 3686 (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33))) 3687 3688(define-markup-command (eyeglasses layout props) 3689 () 3690 #:category other 3691 "Prints out eyeglasses, indicating strongly to look at the conductor. 3692@lilypond[verbatim,quote] 3693\\markup { \\eyeglasses } 3694@end lilypond" 3695 (interpret-markup layout props 3696 (make-override-markup '(line-cap-style . butt) 3697 (make-path-markup 0.15 eyeglassespath)))) 3698 3699(define-markup-command (left-brace layout props size) 3700 (number?) 3701 #:category other 3702 " 3703A feta brace in point size @var{size}. 3704 3705@lilypond[verbatim,quote] 3706\\markup { 3707 \\left-brace #35 3708 \\hspace #2 3709 \\left-brace #45 3710} 3711@end lilypond" 3712 (let* ((font (ly:paper-get-font layout 3713 (cons '((font-encoding . fetaBraces) 3714 (font-name . #f)) 3715 props))) 3716 (glyph-count (1- (ly:otf-glyph-count font))) 3717 (scale (ly:output-def-lookup layout 'output-scale)) 3718 (scaled-size (/ (ly:pt size) scale)) 3719 (glyph (lambda (n) 3720 (ly:font-get-glyph font (string-append "brace" 3721 (number->string n))))) 3722 (get-y-from-brace (lambda (brace) 3723 (interval-length 3724 (ly:stencil-extent (glyph brace) Y)))) 3725 (find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size)) 3726 (glyph-found (glyph find-brace))) 3727 3728 (if (or (null? (ly:stencil-expr glyph-found)) 3729 (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y))) 3730 (> scaled-size (interval-length 3731 (ly:stencil-extent (glyph glyph-count) Y)))) 3732 (begin 3733 (ly:warning (ice9-format #f (_ "no brace found for point size ~,1f ") size)) 3734 (ly:warning (ice9-format #f 3735 (_ "defaulting to ~,1f pt") 3736 (/ (* scale (interval-length 3737 (ly:stencil-extent glyph-found Y))) 3738 (ly:pt 1)))))) 3739 glyph-found)) 3740 3741(define-markup-command (right-brace layout props size) 3742 (number?) 3743 #:category other 3744 " 3745A feta brace in point size @var{size}, rotated 180 degrees. 3746 3747@lilypond[verbatim,quote] 3748\\markup { 3749 \\right-brace #45 3750 \\hspace #2 3751 \\right-brace #35 3752} 3753@end lilypond" 3754 (interpret-markup layout props 3755 (make-rotate-markup 3756 180 (make-left-brace-markup size)))) 3757 3758;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3759;; the note command. 3760;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3761 3762;; TODO: better syntax. 3763 3764(define-markup-command (note-by-number layout props log dot-count dir) 3765 (number? number? number?) 3766 #:category music 3767 #:properties ((font-size 0) 3768 (flag-style '()) 3769 (style '())) 3770 " 3771@cindex note, within text, by @code{log} and @code{dot-count} 3772 3773Construct a note symbol, with stem and flag. By using fractional values for 3774@var{dir}, longer or shorter stems can be obtained. 3775Supports all note-head-styles. Ancient note-head-styles will get 3776mensural-style-flags. @code{flag-style} may be overridden independently. 3777Supported flag-styles are @code{default}, @code{old-straight-flag}, 3778@code{modern-straight-flag}, @code{flat-flag}, @code{mensural} and 3779@code{neomensural}. The latter two flag-styles will both result in 3780mensural-flags. Both are supplied for convenience. 3781 3782@lilypond[verbatim,quote] 3783\\markup { 3784 \\note-by-number #3 #0 #DOWN 3785 \\hspace #2 3786 \\note-by-number #1 #2 #0.8 3787} 3788@end lilypond" 3789 (define (get-glyph-name-candidates dir log style) 3790 (map (lambda (dir-name) 3791 (format #f "noteheads.~a~a" 3792 dir-name 3793 (if (and (symbol? style) 3794 (not (equal? 'default style))) 3795 (select-head-glyph style (min log 2)) 3796 (min log 2)))) 3797 (list (if (= dir UP) "u" "d") 3798 "s"))) 3799 3800 (define (get-glyph-name font cands) 3801 (if (null? cands) 3802 "" 3803 (if (ly:stencil-empty? (ly:font-get-glyph font (car cands))) 3804 (get-glyph-name font (cdr cands)) 3805 (car cands)))) 3806 3807 (define (buildflags flag-stencil remain curr-stencil spacing) 3808 ;; Function to recursively create a stencil with @code{remain} flags 3809 ;; from the single-flag stencil @code{curr-stencil}, which is already 3810 ;; translated to the position of the previous flag position. 3811 ;; 3812 ;; Copy and paste from /scm/flag-styles.scm 3813 (if (> remain 0) 3814 (let* ((translated-stencil 3815 (ly:stencil-translate-axis curr-stencil spacing Y)) 3816 (new-stencil (ly:stencil-add flag-stencil translated-stencil))) 3817 (buildflags new-stencil (- remain 1) translated-stencil spacing)) 3818 flag-stencil)) 3819 3820 (define (straight-flag-mrkp flag-thickness flag-spacing 3821 upflag-angle upflag-length 3822 downflag-angle downflag-length 3823 dir) 3824 ;; Create a stencil for a straight flag. @var{flag-thickness} and 3825 ;; @var{flag-spacing} are given in staff spaces, @var{upflag-angle} and 3826 ;; @var{downflag-angle} are given in degrees, and @var{upflag-length} and 3827 ;; @var{downflag-length} are given in staff spaces. 3828 ;; 3829 ;; All lengths are scaled according to the font size of the note. 3830 ;; 3831 ;; From /scm/flag-styles.scm, modified to fit here. 3832 3833 (let* ((stem-up (> dir 0)) 3834 ;; scale with the note size 3835 (factor (magstep font-size)) 3836 (stem-thickness (* factor 0.1)) 3837 (line-thickness (ly:output-def-lookup layout 'line-thickness)) 3838 (half-stem-thickness (/ (* stem-thickness line-thickness) 2)) 3839 (raw-length (if stem-up upflag-length downflag-length)) 3840 (angle (if stem-up upflag-angle downflag-angle)) 3841 (flag-length (+ (* raw-length factor) half-stem-thickness)) 3842 (flag-end (polar->rectangular flag-length angle)) 3843 (thickness (* flag-thickness factor)) 3844 (thickness-offset (cons 0 (* -1 thickness dir))) 3845 (spacing (* -1 flag-spacing factor dir)) 3846 (start (cons (- half-stem-thickness) (* half-stem-thickness dir))) 3847 (raw-points 3848 (list 3849 '(0 . 0) 3850 flag-end 3851 (offset-add flag-end thickness-offset) 3852 thickness-offset)) 3853 (points (map (lambda (coord) (offset-add coord start)) raw-points)) 3854 (stencil (ly:round-polygon points half-stem-thickness -1.0)) 3855 ;; Log for 1/8 is 3, so we need to subtract 3 3856 (flag-stencil (buildflags stencil (- log 3) stencil spacing))) 3857 flag-stencil)) 3858 3859 (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic) 3860 (font-name . #f)) 3861 props))) 3862 ;; To make the stem scale properly with changes in 3863 ;; set-global-staff-size and/or set-layout-staff-size, we need to catch 3864 ;; text-font-size from current layout and $defaultpaper and scale 3865 ;; stem-thickness and -length with the division 3866 ;; (/ layout-text-font-size paper-text-font-size) later. 3867 ;; Default for text-font-size is 11. 3868 (layout-text-font-size 3869 (ly:output-def-lookup layout 'text-font-size 11)) 3870 (paper-text-font-size 3871 (ly:output-def-lookup 3872 (ly:parser-lookup '$defaultpaper) 3873 'text-font-size 11)) 3874 (blot (ly:output-def-lookup layout 'blot-diameter)) 3875 (layout-output-scale (ly:output-def-lookup layout 'output-scale)) 3876 (paper-output-scale 3877 (ly:output-def-lookup 3878 (ly:parser-lookup '$defaultpaper) 3879 'output-scale)) 3880 (staff-space (ly:output-def-lookup layout 'staff-space)) 3881 ;; While `layout-set-staff-size', applied in a score-layout, changes 3882 ;; staff-space, it does not change staff-space while applied in \paper 3883 ;; of an explicit book. 3884 ;; Thus we compare the actual staff-space with the values of 3885 ;; output-scale from current layout and $defaultpaper 3886 (size-factor 3887 (if (eqv? (/ layout-output-scale paper-output-scale) staff-space) 3888 (magstep font-size) 3889 (/ (* paper-output-scale staff-space (magstep font-size)) 3890 layout-output-scale))) 3891 (head-glyph-name 3892 (let ((result (get-glyph-name font 3893 (get-glyph-name-candidates 3894 (sign dir) log style)))) 3895 (if (string-null? result) 3896 ;; If no glyph name can be found, select default heads. 3897 ;; Though this usually means an unsupported style has been 3898 ;; chosen, it also prevents unrelated 'style settings from 3899 ;; other grobs (e.g., TextSpanner and TimeSignature) leaking 3900 ;; into markup. 3901 (get-glyph-name font 3902 (get-glyph-name-candidates 3903 (sign dir) log 'default)) 3904 result))) 3905 (head-glyph (ly:font-get-glyph font head-glyph-name)) 3906 (ancient-flags? 3907 (member style 3908 '(mensural neomensural petrucci semipetrucci blackpetrucci))) 3909 (attach-indices (ly:note-head::stem-attachment font head-glyph-name)) 3910 (stem-length 3911 (* size-factor 3912 (/ layout-text-font-size paper-text-font-size) 3913 (max 3 (- log 1)))) 3914 ;; With ancient-flags we want a tighter stem 3915 (stem-thickness 3916 (* size-factor 3917 (/ layout-text-font-size paper-text-font-size) 3918 (if ancient-flags? 0.1 0.13))) 3919 (stemy (* dir stem-length)) 3920 (attach-off (cons (interval-index 3921 (ly:stencil-extent head-glyph X) 3922 (* (sign dir) (car attach-indices))) 3923 ;; fixme, this is inconsistent between X & Y. 3924 (* (sign dir) 3925 (interval-index 3926 (ly:stencil-extent head-glyph Y) 3927 (cdr attach-indices))))) 3928 ;; For a tighter stem (with ancient-flags) the stem-width has to be 3929 ;; adjusted. 3930 (stem-X-corr 3931 (if (or ancient-flags? 3932 (member flag-style '(mensural neomensural))) 3933 (* 0.5 dir stem-thickness) 0)) 3934 (stem-glyph (and (> log 0) 3935 (ly:round-filled-box 3936 (ordered-cons (+ stem-X-corr (car attach-off)) 3937 (+ stem-X-corr (car attach-off) 3938 (* (- (sign dir)) stem-thickness))) 3939 (cons (min stemy (cdr attach-off)) 3940 (max stemy (cdr attach-off))) 3941 (/ stem-thickness 3)))) 3942 (dot (ly:font-get-glyph font "dots.dot")) 3943 (dotwid (interval-length (ly:stencil-extent dot X))) 3944 (dots (and (> dot-count 0) 3945 (apply ly:stencil-add 3946 (map (lambda (x) 3947 (ly:stencil-translate-axis 3948 dot (* 2 x dotwid) X)) 3949 (iota dot-count))))) 3950 ;; Straight-flags. Values taken from /scm/flag-style.scm 3951 (modern-straight-flag (straight-flag-mrkp 0.55 1 -18 1.1 22 1.2 dir)) 3952 (old-straight-flag (straight-flag-mrkp 0.55 1 -45 1.2 45 1.4 dir)) 3953 (flat-flag (straight-flag-mrkp 0.55 1.0 0 1.0 0 1.0 dir)) 3954 ;; Calculate a corrective to avoid a gap between 3955 ;; straight-flags and the stem. 3956 (flag-style-Y-corr (if (or (eq? flag-style 'modern-straight-flag) 3957 (eq? flag-style 'old-straight-flag) 3958 (eq? flag-style 'flat-flag)) 3959 (/ blot 10 (* -1 dir)) 3960 0)) 3961 (flaggl (and (> log 2) 3962 (ly:stencil-translate 3963 (cond ((eq? flag-style 'modern-straight-flag) 3964 modern-straight-flag) 3965 ((eq? flag-style 'old-straight-flag) 3966 old-straight-flag) 3967 ((eq? flag-style 'flat-flag) 3968 flat-flag) 3969 (else 3970 (ly:font-get-glyph font 3971 (format #f 3972 (if (or (member flag-style 3973 '(mensural neomensural)) 3974 (and ancient-flags? 3975 (null? flag-style))) 3976 "flags.mensural~a2~a" 3977 "flags.~a~a") 3978 (if (> dir 0) "u" "d") 3979 log)))) 3980 (cons (+ (car attach-off) 3981 ;; For tighter stems (with ancient-flags) the 3982 ;; flag has to be adjusted different. 3983 (if (and (not ancient-flags?) (< dir 0)) 3984 stem-thickness 3985 0)) 3986 (+ stemy flag-style-Y-corr)))))) 3987 ;; If there is a flag on an upstem and the stem is short, move the dots 3988 ;; to avoid the flag. 16th notes get a special case because their flags 3989 ;; hang lower than any other flags. 3990 ;; Not with ancient flags or straight-flags. 3991 (if (and dots (> dir 0) (> log 2) 3992 (or (eq? flag-style 'default) (null? flag-style)) 3993 (not ancient-flags?) 3994 (or (< dir 1.15) (and (= log 4) (< dir 1.3)))) 3995 (set! dots (ly:stencil-translate-axis dots 0.5 X))) 3996 (if flaggl 3997 (set! stem-glyph (ly:stencil-add flaggl stem-glyph))) 3998 (if (ly:stencil? stem-glyph) 3999 (set! stem-glyph (ly:stencil-add stem-glyph head-glyph)) 4000 (set! stem-glyph head-glyph)) 4001 (if (ly:stencil? dots) 4002 (set! stem-glyph 4003 (ly:stencil-add 4004 (ly:stencil-translate-axis 4005 dots 4006 (+ (cdr (ly:stencil-extent head-glyph X)) dotwid) 4007 X) 4008 stem-glyph))) 4009 stem-glyph)) 4010 4011(define-markup-command (note layout props duration dir) 4012 (ly:duration? number?) 4013 #:category music 4014 #:properties (note-by-number-markup) 4015 " 4016@cindex note, within text, by duration 4017 4018This produces a note with a stem pointing in @var{dir} direction, with 4019the @var{duration} for the note head type and augmentation dots. For 4020example, @code{\\note @{4.@} #-0.75} creates a dotted quarter note, with 4021a shortened down stem. 4022 4023@lilypond[verbatim,quote] 4024\\markup { 4025 \\override #'(style . cross) 4026 \\note {4..} #UP 4027 \\hspace #2 4028 \\note {\\breve} #0 4029} 4030@end lilypond" 4031 (note-by-number-markup layout props 4032 (ly:duration-log duration) 4033 (ly:duration-dot-count duration) 4034 dir)) 4035 4036;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4037;; the rest command. 4038;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4039 4040(define-markup-command (rest-by-number layout props log dot-count) 4041 (integer? integer?) 4042 #:category music 4043 #:properties ((font-size 0) 4044 (ledgers '(-1 0 1)) 4045 (style '())) 4046 " 4047@cindex rest, within text, by @code{log} and @code{dot-count} 4048 4049A rest symbol. 4050 4051For duration logs specified with property @code{ledgers}, rest symbols with 4052ledger lines are selected. 4053 4054@lilypond[verbatim,quote] 4055\\markup { 4056 \\rest-by-number #3 #2 4057 \\hspace #2 4058 \\rest-by-number #0 #1 4059} 4060@end lilypond" 4061 4062 (define (get-glyph-name-candidates log style) 4063 (let* (;; Choose the style-string to be added. 4064 ;; If no glyph exists, select others for the specified styles 4065 ;; otherwise defaulting. 4066 (style-strg 4067 (cond ( 4068 ;; 'baroque needs to be special-cased, otherwise 4069 ;; `select-head-glyph´ would catch neomensural-glyphs for 4070 ;; this style, if (< log 0). 4071 (eq? style 'baroque) 4072 (string-append (number->string log) "")) 4073 ((eq? style 'petrucci) 4074 (string-append (number->string log) "mensural")) 4075 ;; In other cases `select-head-glyph´ from output-lib.scm 4076 ;; works for rest-glyphs, too. 4077 ((and (symbol? style) (not (eq? style 'default))) 4078 (select-head-glyph style log)) 4079 (else log))) 4080 ;; Choose ledgered glyphs for whole and half rest. 4081 ;; Except for the specified styles and logs. 4082 (ledger-style-rests 4083 (if (and (or (list? style) 4084 (not (member style 4085 '(neomensural mensural petrucci)))) 4086 ;(or (= log -1) (= log 0) (= log 1)) 4087 (member log ledgers) 4088 ) 4089 "o" 4090 ""))) 4091 (format #f "rests.~a~a" style-strg ledger-style-rests))) 4092 4093 (define (get-glyph-name font cands) 4094 (if (ly:stencil-empty? (ly:font-get-glyph font cands)) 4095 "" 4096 cands)) 4097 4098 (let* ((font 4099 (ly:paper-get-font layout 4100 (cons '((font-encoding . fetaMusic) 4101 (font-name . #f)) 4102 props))) 4103 (rest-glyph-name-candidate 4104 (get-glyph-name font 4105 (get-glyph-name-candidates log style))) 4106 (rest-glyph-name 4107 (if (string-null? rest-glyph-name-candidate) 4108 ;; If no glyph name can be found, select default rests. Though 4109 ;; this usually means an unsupported style has been chosen, it 4110 ;; also prevents unrelated 'style settings from other grobs 4111 ;; (e.g., TextSpanner and TimeSignature) leaking into markup. 4112 ;; If even for default style no rest can be found, warn and return 4113 ;; an empty string. 4114 (let* ((default-candidate 4115 (get-glyph-name-candidates log 'default)) 4116 (default-glyph 4117 (get-glyph-name font default-candidate))) 4118 (if (string-null? default-glyph) 4119 (ly:warning "Cannot find glyph ~a" default-candidate)) 4120 default-glyph) 4121 rest-glyph-name-candidate)) 4122 (rest-glyph (ly:font-get-glyph font rest-glyph-name)) 4123 (dot (ly:font-get-glyph font "dots.dot")) 4124 (dot-width (interval-length (ly:stencil-extent dot X))) 4125 (dots (and (> dot-count 0) 4126 (apply ly:stencil-add 4127 (map (lambda (x) 4128 (ly:stencil-translate-axis 4129 dot (* 2 x dot-width) X)) 4130 (iota dot-count)))))) 4131 ;; Apart from mensural-, neomensural- and petrucci-style ledgered 4132 ;; glyphs are taken for whole and half rests. 4133 ;; If they are dotted, move the dots in X-direction to avoid collision. 4134 (if (and dots 4135 (< log 2) 4136 (>= log 0) 4137 (not (member style '(neomensural mensural petrucci)))) 4138 (set! dots (ly:stencil-translate-axis dots dot-width X))) 4139 4140 ;; Add dots to the rest-glyph. 4141 ;; 4142 ;; Not sure how to vertical align dots. 4143 ;; For now the dots are centered for half, whole or longer rests. 4144 ;; Otherwise placed near the top of the rest. 4145 ;; 4146 ;; Dots for rests with (< log 0) dots are allowed. 4147 (if dots 4148 (set! rest-glyph 4149 (ly:stencil-add 4150 (ly:stencil-translate 4151 dots 4152 (cons 4153 (+ (cdr (ly:stencil-extent rest-glyph X)) dot-width) 4154 (if (< log 2) 4155 (interval-center (ly:stencil-extent rest-glyph Y)) 4156 (- (interval-end (ly:stencil-extent rest-glyph Y)) 4157 (/ (* 2 dot-width) 3))))) 4158 rest-glyph))) 4159 rest-glyph)) 4160 4161(define-markup-command 4162 (multi-measure-rest-by-number layout props duration-scale) 4163 (index?) 4164 #:category music 4165 #:properties ((font-size 0) 4166 (style '()) 4167 (word-space) 4168 (thick-thickness 6.6) 4169 (hair-thickness 2.0) 4170 (expand-limit 10) 4171 (width 8) 4172 (multi-measure-rest-number #t)) 4173 " 4174@cindex multi-measure rest, within text, by @code{duration-scale} 4175 4176Returns a multi-measure rest symbol. 4177 4178If the number of measures is greater than the number given by 4179@code{expand-limit} a horizontal line is printed. For every multi-measure rest 4180lasting more than one measure a number is printed on top. 4181 4182@lilypond[verbatim,quote] 4183\\markup { 4184 Multi-measure rests may look like 4185 \\multi-measure-rest-by-number #12 4186 or 4187 \\multi-measure-rest-by-number #7 4188 (church rests) 4189} 4190@end lilypond" 4191 4192 (define (mmr-numbers nmbr) 4193 "A multi-measure rest may contain glyphs representing durations of 8, 4, 2 4194and 1 measure. Calculates a list containing the amounts of each glyph needed 4195for a multi-measure rest of the length given with @var{nmbr}. 4196Example: A multi-measure rest of 15 measures contains one glyphs for 41978@tie{}bars, one glyph for 4@tie{}bars, one glyph for 2@tie{}bars and one glyph 4198for 1@tie{}bar, i.e. 4199@code{(mmr-numbers 15)} returns @code{'(1 1 1 1)}." 4200 (define (helper i init l) 4201 (if (not (integer? init)) 4202 (reverse l) 4203 (helper (remainder i init) (/ init 2) (cons (quotient i init) l)))) 4204 ;; longest mmr-glyph represents eight measures, thus init is 8 4205 (helper nmbr 8 '())) 4206 4207 (define (get-glyph-name-candidates dur-log style) 4208 "Returns a string with the name of a rest glyph corresponding to 4209@var{dur-log}. @var{style} specifies the suffix of the glyph: If @var{style} is 4210a symbol but not @code{'default}, choose this @var{style}. @code{'petrucci} is 4211special-cased to return @code{'mensural}. If @var{style} is @code{'()} or 4212@code{'default} no suffix is used. The found glyph may not exist in the current 4213font. In this case it gets replaced by a glyph with @var{style] set to 4214@code{'default} in a different procedure later on." 4215 (let* ((style-strg 4216 (cond ((eq? style 'petrucci) 'mensural) 4217 ((and (symbol? style) (not (eq? style 'default))) 4218 style) 4219 (else "")))) 4220 (format #f "rests.~a~a~a" 4221 (if (zero? dur-log) "" "M") 4222 dur-log 4223 style-strg))) 4224 4225 (let ((mmr-stil empty-stencil) 4226 (staff-space (ly:output-def-lookup layout 'staff-space))) 4227 ;; if the MMR is longer then the amount of measures provided by 4228 ;; `expand-limit` print a horizontal line 4229 ;; otherwise compose the MMR from selected glyphs 4230 (if (> duration-scale expand-limit) 4231 (let* ((blot (ly:output-def-lookup layout 'blot-diameter)) 4232 (line-thickness (ly:output-def-lookup layout 'line-thickness)) 4233 (thick-thick (* thick-thickness line-thickness)) 4234 (half-thick-thick (/ thick-thick 2)) 4235 (hair-thick (* hair-thickness line-thickness)) 4236 (half-hair-thick (/ hair-thick 2))) 4237 (set! mmr-stil 4238 (ly:stencil-add 4239 (ly:round-filled-box 4240 (cons 0 width) 4241 (cons (- half-thick-thick) half-thick-thick) 4242 blot) 4243 (ly:round-filled-box 4244 (cons (- half-hair-thick) half-hair-thick) 4245 (cons (- staff-space) staff-space) 4246 blot) 4247 (ly:round-filled-box 4248 (cons (- width half-hair-thick) (+ width half-hair-thick)) 4249 (cons (- staff-space) staff-space) 4250 blot)))) 4251 (let* (;; get a list containing the multipliers of the needed glyphs for 4252 ;; 8-, 4-, 2-, 1-measure. 4253 (counted-glyphs-list (mmr-numbers duration-scale)) 4254 ;; get a nested list for the duration-log of each needed glyph. 4255 ;; example: for a 7-bar MMR it returns '(() (2) (1) (0)) 4256 ;; the sublist may contain multiple entries if needed 4257 ;; example: for a 16-bar MMR it returns '((3 3) () () ()) 4258 (dur-log-amounts 4259 ;; (iota 4 3 -1) is the list of possible duration-logs for MMRs 4260 (map make-list counted-glyphs-list (iota 4 3 -1))) 4261 ;; get a flat list of found MMR-glyphs-candidates 4262 (glyph-string-list 4263 (append-map 4264 (lambda (x) 4265 (if (null? x) 4266 (list "") 4267 (map 4268 (lambda (y) (get-glyph-name-candidates y style)) 4269 x))) 4270 dur-log-amounts)) 4271 ;; ensure current font is 'fetaMusic, deny any font-name setting 4272 ;; from elsewhere 4273 (font 4274 (ly:paper-get-font 4275 layout 4276 (cons '((font-encoding . fetaMusic) 4277 (font-name . #f)) 4278 props))) 4279 ;; get a list of glyph-stencils, ready to build the final MMR 4280 (glyph-stils 4281 (map 4282 (lambda (count cand) 4283 ;; examine the glyph-candidate: 4284 ;; if not found in current font replace it with a 4285 ;; default-style glyph 4286 (let* ((stil-cand (ly:font-get-glyph font cand)) 4287 (stil 4288 (if (ly:stencil-empty? stil-cand) 4289 (ly:font-get-glyph 4290 font 4291 (get-glyph-name-candidates count 'default)) 4292 stil-cand))) 4293 ;; Return false for a string-null-candidate, will be 4294 ;; filtered lateron. 4295 ;; If duration-log of the MMR-glyph is zero move it up by 4296 ;; one staff-space 4297 (if (string-null? cand) 4298 #f 4299 (ly:stencil-translate-axis 4300 stil 4301 (if (zero? count) staff-space 0) 4302 Y)))) 4303 (iota 4 3 -1) 4304 glyph-string-list))) 4305 ;; `stack-stencil-line` removes non-stencils 4306 (set! mmr-stil (stack-stencil-line word-space glyph-stils)))) 4307 4308 ;; Print the number above a multi-measure-rest. 4309 ;; Depends on duration, style and multi-measure-rest-number set #t 4310 (if (or (> duration-scale expand-limit) 4311 (and multi-measure-rest-number 4312 (> duration-scale 1) 4313 (not (member style '(neomensural mensural petrucci))))) 4314 (let* ((mmr-stil-x-center 4315 (interval-center (ly:stencil-extent mmr-stil X))) 4316 (duration-markup 4317 (make-fontsize-markup -2 4318 (make-override-markup '(font-encoding . fetaText) 4319 (number->string duration-scale)))) 4320 (mmr-number-stil 4321 (interpret-markup layout props duration-markup)) 4322 (mmr-number-stil-x-center 4323 (interval-center (ly:stencil-extent mmr-number-stil X)))) 4324 4325 (set! mmr-stil 4326 (ly:stencil-combine-at-edge 4327 mmr-stil 4328 Y UP 4329 (ly:stencil-translate-axis 4330 mmr-number-stil 4331 (- mmr-stil-x-center mmr-number-stil-x-center) 4332 X) 4333 ;; Ugh, hardcoded 4334 (if (> duration-scale expand-limit) 0 0.8))))) 4335 mmr-stil)) 4336 4337(define-markup-command (rest layout props duration) 4338 (ly:duration?) 4339 #:category music 4340 #:properties (rest-by-number-markup 4341 multi-measure-rest-by-number-markup) 4342 4343" 4344@cindex rest, within text, by duration 4345@cindex multi-measure rest, within text, by duration 4346 4347Returns a rest symbol. 4348 4349If @code{multi-measure-rest} is set to true, a multi-measure 4350rest symbol my be returned. In this case the duration needs to be entered as 4351@code{@{ 1*2 @}}to get a multi-measure rest for two bars. Actually, it's only 4352the scaling factor that determines the length, the basic duration is 4353disregarded. 4354@lilypond[verbatim,quote] 4355\\markup { 4356 Rests: 4357 \\hspace #2 4358 \\rest { 4.. } 4359 \\hspace #2 4360 \\rest { \\breve } 4361 \\hspace #2 4362 Multi-measure rests: 4363 \\override #'(multi-measure-rest . #t) 4364 { 4365 \\hspace #2 4366 \\override #'(multi-measure-rest-number . #f) 4367 \\rest { 1*7 } 4368 \\hspace #2 4369 \\rest { 1*12 } 4370 } 4371} 4372@end lilypond" 4373 (let ((duration-scale (ly:duration-scale duration)) 4374 (mmr? (chain-assoc-get 'multi-measure-rest props))) 4375 (if (and (index? duration-scale) mmr?) 4376 (multi-measure-rest-by-number-markup layout props duration-scale) 4377 (rest-by-number-markup layout props 4378 (ly:duration-log duration) 4379 (ly:duration-dot-count duration))))) 4380 4381;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4382;; fermata markup 4383;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4384 4385(define-markup-command (fermata layout props) () 4386 #:category music 4387 #:properties ((direction UP)) 4388 "Create a fermata glyph. When @var{direction} is @code{DOWN}, use 4389an inverted glyph. Note that within music, one would usually use the 4390@code{\\fermata} articulation instead of a markup. 4391 4392@lilypond[verbatim,quote] 4393 { c''1^\\markup \\fermata d''1_\\markup \\fermata } 4394 4395\\markup { \\fermata \\override #`(direction . ,DOWN) \\fermata } 4396@end lilypond 4397" 4398 (interpret-markup layout props 4399 (make-musicglyph-markup 4400 (if (eqv? direction DOWN) 4401 "scripts.dfermata" 4402 "scripts.ufermata")))) 4403 4404;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4405;; translating. 4406;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4407 4408(define-markup-command (lower layout props amount arg) 4409 (number? markup?) 4410 #:category align 4411 " 4412@cindex lowering text 4413 4414Lower @var{arg} by the distance @var{amount}. 4415A negative @var{amount} indicates raising; see also @code{\\raise}. 4416 4417@lilypond[verbatim,quote] 4418\\markup { 4419 one 4420 \\lower #3 4421 two 4422 three 4423} 4424@end lilypond" 4425 (ly:stencil-translate-axis (interpret-markup layout props arg) 4426 (- amount) Y)) 4427 4428(define-markup-command (translate-scaled layout props offset arg) 4429 (number-pair? markup?) 4430 #:category align 4431 #:properties ((font-size 0)) 4432 " 4433@cindex translating text 4434@cindex scaling text 4435 4436Translate @var{arg} by @var{offset}, scaling the offset by the 4437@code{font-size}. 4438 4439@lilypond[verbatim,quote] 4440\\markup { 4441 \\fontsize #5 { 4442 * \\translate #'(2 . 3) translate 4443 \\hspace #2 4444 * \\translate-scaled #'(2 . 3) translate-scaled 4445 } 4446} 4447@end lilypond" 4448 (let* ((factor (magstep font-size)) 4449 (scaled (cons (* factor (car offset)) 4450 (* factor (cdr offset))))) 4451 (ly:stencil-translate (interpret-markup layout props arg) 4452 scaled))) 4453 4454(define-markup-command (raise layout props amount arg) 4455 (number? markup?) 4456 #:category align 4457 " 4458@cindex raising text 4459 4460Raise @var{arg} by the distance @var{amount}. 4461A negative @var{amount} indicates lowering, see also @code{\\lower}. 4462 4463The argument to @code{\\raise} is the vertical displacement amount, 4464measured in (global) staff spaces. @code{\\raise} and @code{\\super} 4465raise objects in relation to their surrounding markups. 4466 4467If the text object itself is positioned above or below the staff, then 4468@code{\\raise} cannot be used to move it, since the mechanism that 4469positions it next to the staff cancels any shift made with 4470@code{\\raise}. For vertical positioning, use the @code{padding} 4471and/or @code{extra-offset} properties. 4472 4473@lilypond[verbatim,quote] 4474\\markup { 4475 C 4476 \\small 4477 \\bold 4478 \\raise #1.0 4479 9/7+ 4480} 4481@end lilypond" 4482 (ly:stencil-translate-axis (interpret-markup layout props arg) amount Y)) 4483 4484(define-markup-command (fraction layout props arg1 arg2) 4485 (markup? markup?) 4486 #:category other 4487 #:properties ((font-size 0)) 4488 " 4489@cindex creating text fraction 4490 4491Make a fraction of two markups. 4492@lilypond[verbatim,quote] 4493\\markup { 4494 π ≈ 4495 \\fraction 355 113 4496} 4497@end lilypond" 4498 (let* ((m1 (interpret-markup layout props arg1)) 4499 (m2 (interpret-markup layout props arg2)) 4500 (factor (magstep font-size)) 4501 (boxdimen (cons (* factor -0.05) (* factor 0.05))) 4502 (padding (* factor 0.2)) 4503 (baseline (* factor 0.6)) 4504 (offset (* factor 0.75))) 4505 (set! m1 (ly:stencil-aligned-to m1 X CENTER)) 4506 (set! m2 (ly:stencil-aligned-to m2 X CENTER)) 4507 (let* ((x1 (ly:stencil-extent m1 X)) 4508 (x2 (ly:stencil-extent m2 X)) 4509 (line (ly:round-filled-box (interval-union x1 x2) boxdimen 0.0)) 4510 ;; should stack mols separately, to maintain LINE on baseline 4511 (stack (stack-lines DOWN padding baseline (list m1 line m2)))) 4512 (set! stack 4513 (ly:stencil-aligned-to stack Y CENTER)) 4514 (set! stack 4515 (ly:stencil-aligned-to stack X LEFT)) 4516 ;; should have EX dimension 4517 ;; empirical anyway 4518 (ly:stencil-translate-axis stack offset Y)))) 4519 4520(define-markup-command (normal-size-super layout props arg) 4521 (markup?) 4522 #:category font 4523 #:properties ((font-size 0)) 4524 " 4525@cindex setting superscript, in standard font size 4526 4527Set @var{arg} in superscript with a normal font size. 4528 4529@lilypond[verbatim,quote] 4530\\markup { 4531 default 4532 \\normal-size-super { 4533 superscript in standard size 4534 } 4535} 4536@end lilypond" 4537 (ly:stencil-translate-axis 4538 (interpret-markup layout props arg) 4539 (* 1.0 (magstep font-size)) Y)) 4540 4541(define-markup-command (super layout props arg) 4542 (markup?) 4543 #:category font 4544 #:properties ((font-size 0)) 4545 " 4546@cindex superscript text 4547 4548Set @var{arg} in superscript. 4549 4550@lilypond[verbatim,quote] 4551\\markup { 4552 E = 4553 \\concat { 4554 mc 4555 \\super 4556 2 4557 } 4558} 4559@end lilypond" 4560 (ly:stencil-translate-axis 4561 (interpret-markup 4562 layout 4563 (cons `((font-size . ,(- font-size 3))) props) 4564 arg) 4565 (* 1.0 (magstep font-size)) ; original font-size 4566 Y)) 4567 4568(define-markup-command (translate layout props offset arg) 4569 (number-pair? markup?) 4570 #:category align 4571 " 4572@cindex translating text 4573 4574Translate @var{arg} relative to its surroundings. @var{offset} 4575is a pair of numbers representing the displacement in the X and Y axis. 4576 4577@lilypond[verbatim,quote] 4578\\markup { 4579 * 4580 \\translate #'(2 . 3) 4581 \\line { translated two spaces right, three up } 4582} 4583@end lilypond" 4584 (ly:stencil-translate (interpret-markup layout props arg) 4585 offset)) 4586 4587(define-markup-command (sub layout props arg) 4588 (markup?) 4589 #:category font 4590 #:properties ((font-size 0)) 4591 " 4592@cindex subscript text 4593 4594Set @var{arg} in subscript. 4595 4596@lilypond[verbatim,quote] 4597\\markup { 4598 \\concat { 4599 H 4600 \\sub { 4601 2 4602 } 4603 O 4604 } 4605} 4606@end lilypond" 4607 (ly:stencil-translate-axis 4608 (interpret-markup 4609 layout 4610 (cons `((font-size . ,(- font-size 3))) props) 4611 arg) 4612 (* -0.75 (magstep font-size)) ; original font-size 4613 Y)) 4614 4615(define-markup-command (normal-size-sub layout props arg) 4616 (markup?) 4617 #:category font 4618 #:properties ((font-size 0)) 4619 " 4620@cindex setting subscript, in standard font size 4621 4622Set @var{arg} in subscript with a normal font size. 4623 4624@lilypond[verbatim,quote] 4625\\markup { 4626 default 4627 \\normal-size-sub { 4628 subscript in standard size 4629 } 4630} 4631@end lilypond" 4632 (ly:stencil-translate-axis 4633 (interpret-markup layout props arg) 4634 (* -0.75 (magstep font-size)) 4635 Y)) 4636 4637;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4638;; brackets. 4639;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4640 4641(define-markup-command (hbracket layout props arg) 4642 (markup?) 4643 #:category graphic 4644 " 4645@cindex placing horizontal brackets, around text 4646 4647Draw horizontal brackets around @var{arg}. 4648 4649@lilypond[verbatim,quote] 4650\\markup { 4651 \\hbracket { 4652 \\line { 4653 one two three 4654 } 4655 } 4656} 4657@end lilypond" 4658 (let ((th 0.1) ;; todo: take from GROB. 4659 (m (interpret-markup layout props arg))) 4660 (bracketify-stencil m X th (* 2.5 th) th))) 4661 4662(define-markup-command (bracket layout props arg) 4663 (markup?) 4664 #:category graphic 4665 " 4666@cindex placing vertical brackets, around text 4667 4668Draw vertical brackets around @var{arg}. 4669 4670@lilypond[verbatim,quote] 4671\\markup { 4672 \\bracket { 4673 \\note {2.} #UP 4674 } 4675} 4676@end lilypond" 4677 (let ((th 0.1) ;; todo: take from GROB. 4678 (m (interpret-markup layout props arg))) 4679 (bracketify-stencil m Y th (* 2.5 th) th))) 4680 4681(define-markup-command (parenthesize layout props arg) 4682 (markup?) 4683 #:category graphic 4684 #:properties ((angularity 0) 4685 (padding) 4686 (size 1) 4687 (thickness 1) 4688 (line-thickness 0.1) 4689 (width 0.25)) 4690 " 4691@cindex placing parentheses, around text 4692 4693Draw parentheses around @var{arg}. This is useful for parenthesizing 4694a column containing several lines of text. 4695 4696@lilypond[verbatim,quote] 4697\\markup { 4698 \\parenthesize 4699 \\column { 4700 foo 4701 bar 4702 } 4703 \\override #'(angularity . 2) 4704 \\parenthesize 4705 \\column { 4706 bah 4707 baz 4708 } 4709} 4710@end lilypond" 4711 (let* ((m (interpret-markup layout props arg)) 4712 (scaled-width (* size width)) 4713 (scaled-thickness 4714 (* line-thickness thickness)) 4715 (half-thickness 4716 (min (* size 0.5 scaled-thickness) 4717 (* (/ 4 3.0) scaled-width))) 4718 (padding (or padding half-thickness))) 4719 (parenthesize-stencil 4720 m half-thickness scaled-width angularity padding))) 4721 4722 4723;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4724;; Delayed markup evaluation 4725;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4726 4727(define-markup-command (page-ref layout props label gauge default) 4728 (symbol? markup? markup?) 4729 #:category other 4730 " 4731@cindex referencing page number, in text 4732 4733Reference to a page number. @var{label} is the label set on the referenced 4734page (using @code{\\label} or @code{\\tocItem}), @var{gauge} a markup used to estimate 4735the maximum width of the page number, and @var{default} the value to display 4736when @var{label} is not found. 4737 4738(If the current book or bookpart is set to use roman numerals for page numbers, 4739the reference will be formatted accordingly -- in which case the @var{gauge}'s 4740width may require additional tweaking.)" 4741 (let* ((gauge-stencil (interpret-markup layout props gauge)) 4742 (x-ext (ly:stencil-extent gauge-stencil X)) 4743 (y-ext (ly:stencil-extent gauge-stencil Y)) 4744 ;; Ugh -- code duplication with ly/toc-init.ly -vv 4745 (assoc-name-get 4746 (lambda (name ls) 4747 (do ((ls ls (cdr ls)) (result '() result)) 4748 ((null? ls) result) 4749 (if (and (car ls) (eq? name (assoc-get 'name (cdar ls)))) 4750 (set! result (cons (car ls) result))))))) 4751 4752 (ly:stencil-outline 4753 (ly:make-stencil 4754 `(delay-stencil-evaluation 4755 ,(delay (ly:stencil-expr 4756 (let* ((table (ly:output-def-lookup layout 'label-page-table)) 4757 (alist-table (ly:output-def-lookup layout 'label-alist-table)) 4758 (retrieve-id (if (list? alist-table) 4759 (let ((entry (assoc-name-get label alist-table))) 4760 (if (null? entry) 4761 #f 4762 (caar entry))) 4763 #f)) 4764 (page-number (if (list? table) 4765 (assoc-get (or retrieve-id label) table) 4766 #f)) 4767 (number-type (ly:output-def-lookup layout 'page-number-type)) 4768 (page-markup (if page-number 4769 (number-format number-type page-number) 4770 default)) 4771 (page-stencil (interpret-markup layout props page-markup)) 4772 (gap (- (interval-length x-ext) 4773 (interval-length (ly:stencil-extent page-stencil X))))) 4774 (interpret-markup layout props 4775 (make-line-markup 4776 (list 4777 (make-hspace-markup gap) 4778 page-markup))))))) 4779 x-ext 4780 y-ext) 4781 (make-filled-box-stencil x-ext y-ext)))) 4782 4783;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4784;; scaling 4785;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4786 4787(define-markup-command (scale layout props factor-pair arg) 4788 (number-pair? markup?) 4789 #:category graphic 4790 " 4791@cindex scaling markup 4792@cindex mirroring markup 4793 4794Scale @var{arg}. @var{factor-pair} is a pair of numbers 4795representing the scaling-factor in the X and Y axes. 4796Negative values may be used to produce mirror images. 4797 4798@lilypond[verbatim,quote] 4799\\markup { 4800 \\line { 4801 \\scale #'(2 . 1) 4802 stretched 4803 \\scale #'(1 . -1) 4804 mirrored 4805 } 4806} 4807@end lilypond" 4808 (let ((stil (interpret-markup layout props arg)) 4809 (sx (car factor-pair)) 4810 (sy (cdr factor-pair))) 4811 (ly:stencil-scale stil sx sy))) 4812 4813;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4814;; Repeating 4815;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4816 4817(define-markup-command (pattern layout props count axis space pattern) 4818 (index? index? number? markup?) 4819 #:category other 4820 " 4821Prints @var{count} times a @var{pattern} markup. 4822Patterns are spaced apart by @var{space} (defined as for 4823@code{\\hspace} or @code{\\vspace}, respectively). 4824Patterns are distributed on @var{axis}. 4825 4826@lilypond[verbatim,quote] 4827\\markup \\column { 4828 \"Horizontally repeated :\" 4829 \\pattern #7 #X #2 \\flat 4830 \\null 4831 \"Vertically repeated :\" 4832 \\pattern #3 #Y #0.5 \\flat 4833} 4834@end lilypond" 4835 (let* ((pattern-stencil (interpret-markup layout props pattern)) 4836 ;; \vspace uses a factor of 3 in contrast to \hspace 4837 (space (if (= axis X) space (* 3.0 space)))) 4838 (stack-stencils axis 1 space (make-list count pattern-stencil)))) 4839 4840(define-markup-command (fill-with-pattern layout props space dir pattern left right) 4841 (number? ly:dir? markup? markup? markup?) 4842 #:category align 4843 #:properties ((word-space) 4844 (line-width)) 4845 " 4846Put @var{left} and @var{right} in a horizontal line of width @code{line-width} 4847with a line of markups @var{pattern} in between. 4848Patterns are spaced apart by @var{space}. 4849Patterns are aligned to the @var{dir} markup. 4850 4851@lilypond[verbatim,quote,line-width=14\\cm] 4852\\markup \\column { 4853 \"right-aligned :\" 4854 \\fill-with-pattern #1 #RIGHT . first right 4855 \\fill-with-pattern #1 #RIGHT . second right 4856 \\null 4857 \"center-aligned :\" 4858 \\fill-with-pattern #1.5 #CENTER - left right 4859 \\null 4860 \"left-aligned :\" 4861 \\override #'(line-width . 50) 4862 \\fill-with-pattern #2 #LEFT : left first 4863 \\override #'(line-width . 50) 4864 \\fill-with-pattern #2 #LEFT : left second 4865} 4866@end lilypond" 4867 (let* ((pattern-stencil (interpret-markup layout props pattern)) 4868 (pattern-x-extent (ly:stencil-extent pattern-stencil X)) 4869 (pattern-width (interval-length pattern-x-extent)) 4870 (left-stencil (interpret-markup layout props left)) 4871 (left-width (interval-length (ly:stencil-extent left-stencil X))) 4872 (right-stencil (interpret-markup layout props right)) 4873 (right-width (interval-length (ly:stencil-extent right-stencil X))) 4874 (middle-width (max 0 (- line-width (+ (+ left-width right-width) (* word-space 2))))) 4875 (period (+ space pattern-width)) 4876 (count (inexact->exact (truncate (/ (- middle-width pattern-width) period)))) 4877 (x-offset (+ (* (- (- middle-width (* count period)) pattern-width) (/ (1+ dir) 2)) (abs (car pattern-x-extent))))) 4878 (interpret-markup layout props 4879 (make-line-markup 4880 (list 4881 (make-stencil-markup left-stencil) 4882 (make-with-dimensions-markup 4883 (cons 0 middle-width) 4884 '(0 . 0) 4885 (make-translate-markup 4886 (cons x-offset 0) 4887 (make-pattern-markup 4888 (1+ count) X space 4889 (make-stencil-markup pattern-stencil)))) 4890 (make-stencil-markup right-stencil)))))) 4891 4892;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4893;; Replacements 4894;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4895 4896(define-markup-command (replace layout props replacements arg) 4897 (list? markup?) 4898 #:category font 4899 #:properties ((replacement-alist)) 4900 " 4901Used to automatically replace a string by another in the markup @var{arg}. 4902Each pair of the alist @var{replacements} specifies what should be replaced. 4903The @code{key} is the string to be replaced by the @code{value} string. 4904 4905@lilypond[verbatim,quote] 4906\\markup \\replace #'((\"thx\" . \"Thanks!\")) thx 4907@end lilypond" 4908 (interpret-markup 4909 layout 4910 (prepend-alist-chain 'replacement-alist 4911 (append replacement-alist replacements) 4912 props) 4913 arg)) 4914 4915 4916;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4917;; conditionals 4918;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4919 4920(define-markup-command (if layout props condition? argument) 4921 (procedure? markup?) 4922 #:category conditionals 4923 "Test @var{condition}, and only insert @var{argument} if it is true. 4924The condition is provided as a procedure taking an output definition 4925and a property alist chain. The procedure is applied, and its result 4926determines whether to print the markup. This command is most useful inside 4927@code{odd@/Header@/Markup} or similar. Here is an example printing page 4928numbers in bold: 4929 4930@example 4931\\paper @{ 4932 oddHeaderMarkup = 4933 \\markup \\fill-line @{ 4934 \"\" 4935 \\if #print-page-number 4936 \\bold \\fromproperty #'page:page-number-string 4937 @} 4938 evenHeaderMarkup = 4939 \\markup \\fill-line @{ 4940 \\if #print-page-number 4941 \\bold \\fromproperty #'page:page-number-string 4942 \"\" 4943 @} 4944@} 4945@end example" 4946 (if (condition? layout props) 4947 (interpret-markup layout props argument) 4948 empty-stencil)) 4949 4950(define-markup-command (unless layout props condition? argument) 4951 (procedure? markup?) 4952 #:category conditionals 4953 "Similar to @code{\\if}, printing the argument if the condition 4954is false. 4955 4956The following example shows how to print the copyright notice on 4957all pages but the last instead of just the first page. 4958 4959@example 4960\\paper @{ 4961 oddFooterMarkup = \\markup @{ 4962 \\unless #on-last-page-of-part \\fill-line @{ 4963 \\fromproperty #'header:copyright 4964 @} 4965 @} 4966@} 4967 4968\\header @{ 4969 copyright = \"© LilyPond Authors. License: GFDL.\" 4970 tagline = \"© LilyPond Authors. Documentation placed 4971under the GNU Free Documentation License 4972version 1.3.\" 4973@} 4974@end example" 4975 (if (condition? layout props) 4976 empty-stencil 4977 (interpret-markup layout props argument))) 4978 4979;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4980;; Markup list commands 4981;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 4982 4983(define-public (space-lines baseline stils) 4984 (let space-stil ((stils stils) 4985 (result (list))) 4986 (if (null? stils) 4987 (reverse! result) 4988 (let* ((stil (car stils)) 4989 (dy-top (max (- (/ baseline 1.5) 4990 (interval-bound (ly:stencil-extent stil Y) UP)) 4991 0.0)) 4992 (dy-bottom (max (+ (/ baseline 3.0) 4993 (interval-bound (ly:stencil-extent stil Y) DOWN)) 4994 0.0)) 4995 (new-stil (ly:make-stencil 4996 (ly:stencil-expr stil) 4997 (ly:stencil-extent stil X) 4998 (cons (- (interval-bound (ly:stencil-extent stil Y) DOWN) 4999 dy-bottom) 5000 (+ (interval-bound (ly:stencil-extent stil Y) UP) 5001 dy-top))))) 5002 (space-stil (cdr stils) (cons new-stil result)))))) 5003 5004(define-markup-list-command (justified-lines layout props args) 5005 (markup-list?) 5006 #:properties ((baseline-skip) 5007 wordwrap-internal-markup-list) 5008 " 5009@cindex justifying lines of text 5010 5011Like @code{\\justify}, but return a list of lines instead of a single markup. 5012Use @code{\\override-lines #'(line-width . @var{X})} to set the line width; 5013@var{X}@tie{}is the number of staff spaces." 5014 (space-lines baseline-skip 5015 (interpret-markup-list layout props 5016 (make-wordwrap-internal-markup-list #t args)))) 5017 5018(define-markup-list-command (wordwrap-lines layout props args) 5019 (markup-list?) 5020 #:properties ((baseline-skip) 5021 wordwrap-internal-markup-list) 5022 "Like @code{\\wordwrap}, but return a list of lines instead of a single markup. 5023Use @code{\\override-lines #'(line-width . @var{X})} to set the line width, 5024where @var{X} is the number of staff spaces." 5025 (space-lines baseline-skip 5026 (interpret-markup-list layout props 5027 (make-wordwrap-internal-markup-list #f args)))) 5028 5029(define-markup-list-command (column-lines layout props args) 5030 (markup-list?) 5031 #:properties ((baseline-skip)) 5032 "Like @code{\\column}, but return a list of lines instead of a single markup. 5033@code{baseline-skip} determines the space between each markup in @var{args}." 5034 (space-lines baseline-skip 5035 (interpret-markup-list layout props args))) 5036 5037(define-markup-list-command (override-lines layout props new-prop args) 5038 (pair? markup-list?) 5039 "Like @code{\\override}, for markup lists." 5040 (interpret-markup-list layout 5041 (cons (if (pair? (car new-prop)) new-prop (list new-prop)) 5042 props) 5043 args)) 5044 5045(define-markup-list-command (table layout props column-align lst) 5046 (number-list? markup-list?) 5047 #:properties ((padding 0) 5048 (baseline-skip)) 5049 "@cindex creating a table 5050 5051Returns a table. 5052 5053@var{column-align} specifies how each column is aligned, possible values are 5054-1, 0, 1. The number of elements in @var{column-align} determines how many 5055columns will be printed. 5056The entries to print are given by @var{lst}, a markup-list. If needed, the last 5057row is filled up with @code{point-stencil}s. 5058Overriding @code{padding} may be used to increase columns horizontal distance. 5059Overriding @code{baseline-skip} to increase rows vertical distance. 5060@lilypond[verbatim,quote] 5061\\markuplist { 5062 \\override #'(padding . 2) 5063 \\table 5064 #'(0 1 0 -1) 5065 { 5066 \\underline { center-aligned right-aligned 5067 center-aligned left-aligned } 5068 one \\number 1 thousandth \\number 0.001 5069 eleven \\number 11 hundredth \\number 0.01 5070 twenty \\number 20 tenth \\number 0.1 5071 thousand \\number 1000 one \\number 1.0 5072 } 5073} 5074@end lilypond 5075" 5076 5077 (define (split-lst initial-lst lngth result-lst) 5078 ;; split a list into a list of sublists of length lngth 5079 ;; eg. (split-lst '(1 2 3 4 5 6) 2 '()) 5080 ;; -> ((1 2) (3 4) (5 6)) 5081 (cond ((not (integer? (/ (length initial-lst) lngth))) 5082 (ly:warning 5083 "Can't split list of length ~a into ~a parts, returning empty list" 5084 (length initial-lst) lngth) 5085 '()) 5086 ((null? initial-lst) 5087 (reverse result-lst)) 5088 (else 5089 (split-lst 5090 (drop initial-lst lngth) 5091 lngth 5092 (cons (take initial-lst lngth) result-lst))))) 5093 5094 (define (dists-list init padding lst) 5095 ;; Returns a list, where each element of `lst' is 5096 ;; added to the sum of the previous elements of `lst' plus padding. 5097 ;; `init' will be the first element of the resulting list. The addition 5098 ;; starts with the values of `init', `padding' and `(car lst)'. 5099 ;; eg. (dists-list 0.01 0.1 '(1 2 3 4))) 5100 ;; -> (0.01 1.11 3.21 6.31 10.41) 5101 (if (or (not (number? init)) 5102 (not (number? padding)) 5103 (not (number-list? lst))) 5104 (begin 5105 (ly:warning 5106 "not fitting argument for `dists-list', return empty lst ") 5107 '()) 5108 (reverse 5109 (fold (lambda (elem rl) (cons (+ elem padding (car rl)) rl)) 5110 (list init) 5111 lst)))) 5112 5113 (let* (;; get the number of columns 5114 (columns (length column-align)) 5115 (init-stils (interpret-markup-list layout props lst)) 5116 ;; If the given markup-list is the result of a markup-list call, their 5117 ;; length may not be easily predictable, thus we add point-stencils 5118 ;; to fill last row of the table. 5119 (rem (remainder (length init-stils) columns)) 5120 (filled-stils 5121 (if (zero? rem) 5122 init-stils 5123 (append init-stils (make-list (- columns rem) point-stencil)))) 5124 ;; get the stencils in sublists of length `columns' 5125 (stils 5126 (split-lst filled-stils columns '())) 5127 ;; procedure to return stencil-length 5128 ;; If it is nan, return 0 5129 (lengths-proc 5130 (lambda (m) 5131 (let ((lngth (interval-length (ly:stencil-extent m X)))) 5132 (if (nan? lngth) 0 lngth)))) 5133 ;; get the max width of each column in a list 5134 (columns-max-x-lengths 5135 (map 5136 (lambda (x) 5137 (apply max 0 5138 (map 5139 lengths-proc 5140 (map (lambda (l) (list-ref l x)) stils)))) 5141 (iota columns))) 5142 ;; create a list of (basic) distances, which each column should 5143 ;; moved, using `dists-list'. Some padding may be added. 5144 (dist-sequence 5145 (dists-list 0 padding columns-max-x-lengths)) 5146 ;; Get all stencils of a row, moved accurately to build columns. 5147 ;; If the items of a column are aligned other than left, we need to 5148 ;; move them to avoid collisions: 5149 ;; center aligned: move all items half the width of the widest item 5150 ;; right aligned: move all items the full width of the widest item. 5151 ;; Added to the default-offset calculated in `dist-sequence'. 5152 ;; `stencils-for-row-proc' needs four arguments: 5153 ;; stil - a stencil 5154 ;; dist - a numerical value as basic offset in X direction 5155 ;; column - a numerical value for the column we're in 5156 ;; x-align - a numerical value how current column should be 5157 ;; aligned, where (-1, 0, 1) means (LEFT, CENTER, RIGHT) 5158 (stencils-for-row-proc 5159 (lambda (stil dist column x-align) 5160 (ly:stencil-translate-axis 5161 (ly:stencil-aligned-to stil X x-align) 5162 (cond ((member x-align '(0 1)) 5163 (let* (;; get the stuff for relevant column 5164 (stuff-for-column 5165 (map 5166 (lambda (s) (list-ref s column)) 5167 stils)) 5168 ;; get length of every column-item 5169 (lengths-for-column 5170 (map lengths-proc stuff-for-column)) 5171 (widest 5172 (apply max 0 lengths-for-column))) 5173 (+ dist (/ widest (if (= x-align 0) 2 1))))) 5174 (else dist)) 5175 X))) 5176 ;; get a list of rows using `ly:stencil-add' on a list of stencils 5177 (rows 5178 (map 5179 (lambda (stil-list) 5180 (apply ly:stencil-add 5181 (map 5182 ;; the procedure creating the stencils: 5183 stencils-for-row-proc 5184 ;; the procedure's args: 5185 stil-list 5186 dist-sequence 5187 (iota columns) 5188 column-align))) 5189 stils))) 5190 (space-lines baseline-skip rows))) 5191 5192(define-markup-list-command (string-lines layout props strg)(string?) 5193 #:properties ((split-char #\newline)) 5194 " 5195Takes the string @var{strg} and splits it at the character provided by the 5196property @code{split-char}, defaulting to @code{#\\newline}. 5197Surrounding whitespace is removed from every resulting string. 5198The returned list of markups is ready to be formatted by other markup or markup 5199list commands like @code{\\column}, @code{\\line}, etc. 5200 5201@lilypond[verbatim,quote] 5202\\markup { 5203 \\column 5204 \\string-lines 5205 \"foo, foo, 5206 bar, bar, 5207 buzz, buzz!\" 5208} 5209@end lilypond" 5210 (interpret-markup-list layout props 5211 (map string-trim-both (string-split strg split-char)))) 5212 5213(define-markup-list-command (map-markup-commands layout props compose args) 5214 (procedure? markup-list?) 5215 "This applies the function @var{compose} to every markup in 5216@var{args} (including elements of markup list command calls) in order 5217to produce a new markup list. Since the return value from a markup 5218list command call is not a markup list but rather a list of stencils, 5219this requires passing those stencils off as the results of individual 5220markup calls. That way, the results should work out as long as no 5221markups rely on side effects." 5222 (let ((key (make-symbol "key"))) 5223 (catch 5224 key 5225 (lambda () 5226 ;; if `compose' does not actually interpret its markup 5227 ;; argument, we still need to return a list of stencils, 5228 ;; created from the single returned stencil 5229 (list 5230 (interpret-markup layout props 5231 (compose 5232 (make-on-the-fly-markup 5233 (lambda (layout props m) 5234 ;; here all effects of `compose' on the 5235 ;; properties should be visible, so we 5236 ;; call interpret-markup-list at this 5237 ;; point of time and harvest its 5238 ;; stencils 5239 (throw key 5240 (interpret-markup-list 5241 layout props args))) 5242 (make-null-markup)))))) 5243 (lambda (key stencils) 5244 (map 5245 (lambda (sten) 5246 (interpret-markup layout props 5247 (compose (make-stencil-markup sten)))) 5248 stencils))))) 5249