(y (cdr dest)))
(make-line-stencil th 0 0 x y)))
+(define-markup-command (draw-dashed-line layout props dest)
+ (number-pair?)
+ #:category graphic
+ #:properties ((thickness 1)
+ (on 1)
+ (off 1)
+ (phase 0)
+ (full-length #t))
+ "
+@cindex drawing dashed lines within text
+
+A dashed line.
+
+If @code{full-length} is set to #t (default) the dashed-line extends to the
+whole length given by @var{dest}, without white space at beginning or end.
+@code{off} will then be altered to fit.
+To insist on the given (or default) values of @code{on}, @code{off} use
+@code{\\override #'(full-length . #f)}
+Manual settings for @code{on},@code{off} and @code{phase} are possible.
+@lilypond[verbatim,quote]
+\\markup {
+ \\draw-dashed-line #'(5.1 . 2.3)
+ \\override #'(on . 0.3)
+ \\override #'(off . 0.5)
+ \\draw-dashed-line #'(5.1 . 2.3)
+}
+@end lilypond"
+ (let* ((line-thickness (ly:output-def-lookup layout 'line-thickness))
+ ;; Calculate the thickness to be used.
+ (th (* line-thickness thickness))
+ (half-thick (/ th 2))
+ ;; Get the extensions in x- and y-direction.
+ (x (car dest))
+ (y (cdr dest))
+ ;; Calculate the length of the dashed line.
+ (line-length (sqrt (+ (expt x 2) (expt y 2)))))
+
+ (if (and full-length (not (= (+ on off) 0)))
+ (begin
+ ;; Add double-thickness to avoid overlapping.
+ (set! off (+ (* 2 th) off))
+ (let* (;; Make a guess how often the off/on-pair should be printed
+ ;; after the initial `on´.
+ ;; Assume a minimum of 1 to avoid division by zero.
+ (guess (max 1 (round (/ (- line-length on) (+ off on)))))
+ ;; Not sure about the value or why corr is necessary at all,
+ ;; but it seems to be necessary.
+ (corr (if (= on 0)
+ (/ line-thickness 10)
+ 0))
+ ;; Calculate a new value for off to fit the
+ ;; line-length.
+ (new-off (/ (- line-length corr (* (1+ guess) on)) guess))
+ )
+ (cond
+
+ ;; Settings for (= on 0). Resulting in a dotted line.
+
+ ;; If line-length isn't shorter than `th´, change the given
+ ;; value for `off´ to fit the line-length.
+ ((and (= on 0) (< th line-length))
+ (set! off new-off))
+
+ ;; If the line-length is shorter than `th´, it makes no
+ ;; sense to adjust `off´. The rounded edges of the lines
+ ;; would prevent any nice output.
+ ;; Do nothing.
+ ;; This will result in a single dot for very short lines.
+ ((and (= on 0) (>= th line-length))
+ #f)
+
+ ;; Settings for (not (= on 0)). Resulting in a dashed line.
+
+ ;; If line-length isn't shorter than one go of on-off-on,
+ ;; change the given value for `off´ to fit the line-length.
+ ((< (+ (* 2 on) off) line-length)
+ (set! off new-off))
+ ;; If the line-length is too short, but greater than
+ ;; (* 4 th) set on/off to (/ line-length 3)
+ ((< (* 4 th) line-length)
+ (set! on (/ line-length 3))
+ (set! off (/ line-length 3)))
+ ;; If the line-length is shorter than (* 4 th), it makes
+ ;; no sense trying to adjust on/off. The rounded edges of
+ ;; the lines would prevent any nice output.
+ ;; Simply set `on´ to line-length.
+ (else
+ (set! on line-length))))))
+
+ ;; If `on´ or `off´ is negative, or the sum of `on' and `off' equals zero a
+ ;; ghostscript-error occurs while calling
+ ;; (ly:make-stencil (list 'dashed-line th on off x y phase) x-ext y-ext)
+ ;; Better be paranoid.
+ (if (or (= (+ on off) 0)
+ (negative? on)
+ (negative? off))
+ (begin
+ (ly:warning "Can't print a line - setting on/off to default")
+ (set! on 1)
+ (set! off 1)))
+
+ ;; To give the lines produced by \draw-line and \draw-dashed-line the same
+ ;; length, half-thick has to be added to the stencil-extensions.
+ (ly:make-stencil
+ (list 'dashed-line th on off x y phase)
+ (interval-widen (ordered-cons 0 x) half-thick)
+ (interval-widen (ordered-cons 0 y) half-thick))))
+
+(define-markup-command (draw-dotted-line layout props dest)
+ (number-pair?)
+ #:category graphic
+ #:properties ((thickness 1)
+ (off 1)
+ (phase 0))
+ "
+@cindex drawing dotted lines within text
+
+A dotted line.
+
+The dotted-line always extends to the whole length given by @var{dest}, without
+white space at beginning or end.
+Manual settings for @code{off} are possible to get larger or smaller space
+between the dots.
+The given (or default) value of @code{off} will be altered to fit the
+line-length.
+@lilypond[verbatim,quote]
+\\markup {
+ \\draw-dotted-line #'(5.1 . 2.3)
+ \\override #'(thickness . 2)
+ \\override #'(off . 0.2)
+ \\draw-dotted-line #'(5.1 . 2.3)
+}
+@end lilypond"
+
+ (let ((new-props (prepend-alist-chain 'on 0
+ (prepend-alist-chain 'full-length #t props))))
+
+ (interpret-markup layout
+ new-props
+ (markup #:draw-dashed-line dest))))
+
(define-markup-command (draw-hline layout props)
()
#:category graphic
@lilypond[verbatim,quote]
\\markup {
- \\with-url #\"http://lilypond.org/web/\" {
+ \\with-url #\"http://lilypond.org/\" {
LilyPond ... \\italic {
music notation for everyone
}
(ly:stencil-extent m X)
)))
-;; todo: fix negative space
(define-markup-command (hspace layout props amount)
(number?)
#:category align
}
@end lilypond"
(let ((corrected-space (- amount word-space)))
- (if (> corrected-space 0)
- (ly:make-stencil "" (cons 0 corrected-space) '(0 . 0))
- (ly:make-stencil "" (cons corrected-space corrected-space) '(0 . 0)))))
+ (ly:make-stencil "" (cons 0 corrected-space) '(0 . 0))))
-;; todo: fix negative space
(define-markup-command (vspace layout props amount)
(number?)
#:category align
}
@end lilypond"
(let ((amount (* amount 3.0)))
- (if (> amount 0)
- (ly:make-stencil "" (cons 0 0) (cons 0 amount))
- (ly:make-stencil "" (cons 0 0) (cons amount amount)))))
+ (ly:make-stencil "" (cons 0 0) (cons 0 amount))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(new-commands (map (lambda (x)
(cond
;; for rmoveto, rlineto
- ((and (relative? x) (eq? 3 (length x)))
+ ((and (relative? x) (= 3 (length x)))
(let ((cp (cons
(+ (car current-point)
(second x))
(list (car cp)
(cdr cp))))
;; for rcurveto
- ((and (relative? x) (eq? 7 (length x)))
+ ((and (relative? x) (= 7 (length x)))
(let* ((old-cp current-point)
(cp (cons
(+ (car old-cp)
(car cp)
(cdr cp))))
;; for moveto, lineto
- ((eq? 3 (length x))
+ ((= 3 (length x))
(set-point (cons (second x)
(third x)))
(drop x 1))
;; for curveto
- ((eq? 7 (length x))
+ ((= 7 (length x))
(set-point (cons (sixth x)
(seventh x)))
(drop x 1))
X-extent
Y-extent)))
+(define-markup-list-command (score-lines layout props score)
+ (ly:score?)
+ "
+This is the same as the @code{\\score} markup but delivers its
+systems as a list of lines. This is not usually called directly by
+the user. Instead, it is called when the parser encounters
+@code{\\score} in a context where only markup lists are allowed. When
+used as the argument of a toplevel @code{\\markuplist}, the result can
+be split across pages."
+ (let ((output (ly:score-embedded-format score layout)))
+
+ (if (ly:music-output? output)
+ (map
+ (lambda (paper-system)
+ ;; shift such that the refpoint of the bottom staff of
+ ;; the first system is the baseline of the score
+ (ly:stencil-translate-axis
+ (paper-system-stencil paper-system)
+ (- (car (paper-system-staff-extents paper-system)))
+ Y))
+ (vector->list (ly:paper-score-paper-systems output)))
+ (begin
+ (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
+ '()))))
+
(define-markup-command (score layout props score)
(ly:score?)
#:category music
"
@cindex inserting music into text
-Inline an image of music.
+Inline an image of music. The reference point (usually the middle
+staff line) of the lowest staff in the top system is placed on the
+baseline.
@lilypond[verbatim,quote]
\\markup {
}
}
@end lilypond"
- (let ((output (ly:score-embedded-format score layout)))
-
- (if (ly:music-output? output)
- (stack-stencils Y DOWN baseline-skip
- (map paper-system-stencil
- (vector->list
- (ly:paper-score-paper-systems output))))
- (begin
- (ly:warning (_"no systems found in \\score markup, does it have a \\layout block?"))
- empty-stencil))))
+ (stack-stencils Y DOWN baseline-skip
+ (score-lines-markup-list layout props score)))
(define-markup-command (null layout props)
()
(interpret-markup layout
(prepend-alist-chain 'word-space 0 props)
- (make-line-markup (if (markup-command-list? args)
- args
- (concat-string-args args)))))
+ (make-line-markup
+ (make-override-lines-markup-list
+ (cons 'word-space
+ (chain-assoc-get 'word-space props))
+ (if (markup-command-list? args)
+ args
+ (concat-string-args args))))))
(define (wordwrap-stencils stencils
justify base-space line-width text-dir)
(number? number? number?)
#:category music
#:properties ((font-size 0)
- (style '()))
+ (flag-style '())
+ (style '()))
"
@cindex notes within text by log and dot-count
-Construct a note symbol, with stem. By using fractional values for
+Construct a note symbol, with stem and flag. By using fractional values for
@var{dir}, longer or shorter stems can be obtained.
+Supports all note-head-styles.
+Supported flag-styles are @code{default}, @code{old-straight-flag} and
+@code{modern-straight-flag}.
@lilypond[verbatim,quote]
\\markup {
@end lilypond"
(define (get-glyph-name-candidates dir log style)
(map (lambda (dir-name)
- (format #f "noteheads.~a~a" dir-name
- (if (and (symbol? style)
- (not (equal? 'default style)))
- (select-head-glyph style (min log 2))
- (min log 2))))
- (list (if (= dir UP) "u" "d")
- "s")))
+ (format #f "noteheads.~a~a" dir-name
+ (if (and (symbol? style)
+ (not (equal? 'default style)))
+ (select-head-glyph style (min log 2))
+ (min log 2))))
+ (list (if (= dir UP) "u" "d")
+ "s")))
(define (get-glyph-name font cands)
(if (null? cands)
- ""
- (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
- (get-glyph-name font (cdr cands))
- (car cands))))
+ ""
+ (if (ly:stencil-empty? (ly:font-get-glyph font (car cands)))
+ (get-glyph-name font (cdr cands))
+ (car cands))))
+
+ (define (buildflags flag-stencil remain curr-stencil spacing)
+ ;; Function to recursively create a stencil with @code{remain} flags
+ ;; from the single-flag stencil @code{curr-stencil}, which is already
+ ;; translated to the position of the previous flag position.
+ ;;
+ ;; Copy and paste from /scm/flag-styles.scm
+ (if (> remain 0)
+ (let* ((translated-stencil
+ (ly:stencil-translate-axis curr-stencil spacing Y))
+ (new-stencil (ly:stencil-add flag-stencil translated-stencil)))
+ (buildflags new-stencil (- remain 1) translated-stencil spacing))
+ flag-stencil))
+
+ (define (straight-flag-mrkp flag-thickness flag-spacing
+ upflag-angle upflag-length
+ downflag-angle downflag-length
+ dir)
+ ;; Create a stencil for a straight flag. @var{flag-thickness} and
+ ;; @var{flag-spacing} are given in staff spaces, @var{upflag-angle} and
+ ;; @var{downflag-angle} are given in degrees, and @var{upflag-length} and
+ ;; @var{downflag-length} are given in staff spaces.
+ ;;
+ ;; All lengths are scaled according to the font size of the note.
+ ;;
+ ;; From /scm/flag-styles.scm, modified to fit here.
+
+ (let* ((stem-up (> dir 0))
+ ; scale with the note size
+ (factor (magstep font-size))
+ (stem-thickness (* factor 0.1))
+ (line-thickness (ly:output-def-lookup layout 'line-thickness))
+ (half-stem-thickness (/ (* stem-thickness line-thickness) 2))
+ (raw-length (if stem-up upflag-length downflag-length))
+ (angle (if stem-up upflag-angle downflag-angle))
+ (flag-length (+ (* raw-length factor) half-stem-thickness))
+ (flag-end (polar->rectangular flag-length angle))
+ (thickness (* flag-thickness factor))
+ (thickness-offset (cons 0 (* -1 thickness dir)))
+ (spacing (* -1 flag-spacing factor dir))
+ (start (cons (- half-stem-thickness) (* half-stem-thickness dir)))
+ ; The points of a round-filled-polygon need to be given in
+ ; clockwise order, otherwise the polygon will be enlarged by
+ ; blot-size*2!
+ (points (if stem-up (list start flag-end
+ (offset-add flag-end thickness-offset)
+ (offset-add start thickness-offset))
+ (list start
+ (offset-add start thickness-offset)
+ (offset-add flag-end thickness-offset)
+ flag-end)))
+ (stencil (ly:round-filled-polygon points half-stem-thickness))
+ ; Log for 1/8 is 3, so we need to subtract 3
+ (flag-stencil (buildflags stencil (- log 3) stencil spacing)))
+ flag-stencil))
(let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
- props)))
- (size-factor (magstep font-size))
- (stem-length (* size-factor (max 3 (- log 1))))
+ props)))
+ (size-factor (magstep font-size))
+ (blot (ly:output-def-lookup layout 'blot-diameter))
(head-glyph-name
- (let ((result (get-glyph-name font (get-glyph-name-candidates
- (sign dir) log style))))
- (if (string-null? result)
- ;; If no glyph name can be found, select default heads. Though
- ;; this usually means an unsupported style has been chosen, it
- ;; also prevents unrelated 'style settings from other grobs
- ;; (e.g., TextSpanner and TimeSignature) leaking into markup.
- (get-glyph-name font (get-glyph-name-candidates
- (sign dir) log 'default))
- result)))
+ (let ((result (get-glyph-name font
+ (get-glyph-name-candidates
+ (sign dir) log style))))
+ (if (string-null? result)
+ ;; If no glyph name can be found, select default heads.
+ ;; Though this usually means an unsupported style has been
+ ;; chosen, it also prevents unrelated 'style settings from
+ ;; other grobs (e.g., TextSpanner and TimeSignature) leaking
+ ;; into markup.
+ (get-glyph-name font
+ (get-glyph-name-candidates
+ (sign dir) log 'default))
+ result)))
(head-glyph (ly:font-get-glyph font head-glyph-name))
- (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
- (stem-thickness (* size-factor 0.13))
+ (ancient-flags? (or (eq? style 'mensural) (eq? style 'neomensural)))
+ (attach-indices (ly:note-head::stem-attachment font head-glyph-name))
+ (stem-length (* size-factor (max 3 (- log 1))))
+ ;; With ancient-flags we want a tighter stem
+ (stem-thickness (* size-factor (if ancient-flags? 0.1 0.13)))
(stemy (* dir stem-length))
(attach-off (cons (interval-index
- (ly:stencil-extent head-glyph X)
- (* (sign dir) (car attach-indices)))
- (* (sign dir) ; fixme, this is inconsistent between X & Y.
- (interval-index
- (ly:stencil-extent head-glyph Y)
- (cdr attach-indices)))))
+ (ly:stencil-extent head-glyph X)
+ (* (sign dir) (car attach-indices)))
+ ; fixme, this is inconsistent between X & Y.
+ (* (sign dir)
+ (interval-index
+ (ly:stencil-extent head-glyph Y)
+ (cdr attach-indices)))))
+ ;; For a tighter stem (with ancient-flags) the stem-width has to be
+ ;; adjusted.
+ (stem-X-corr (if ancient-flags? (* 0.5 dir stem-thickness) 0))
(stem-glyph (and (> log 0)
- (ly:round-filled-box
- (ordered-cons (car attach-off)
- (+ (car attach-off)
- (* (- (sign dir)) stem-thickness)))
- (cons (min stemy (cdr attach-off))
- (max stemy (cdr attach-off)))
- (/ stem-thickness 3))))
-
+ (ly:round-filled-box
+ (ordered-cons (+ stem-X-corr (car attach-off))
+ (+ stem-X-corr (car attach-off)
+ (* (- (sign dir)) stem-thickness)))
+ (cons (min stemy (cdr attach-off))
+ (max stemy (cdr attach-off)))
+ (/ stem-thickness 3))))
(dot (ly:font-get-glyph font "dots.dot"))
(dotwid (interval-length (ly:stencil-extent dot X)))
(dots (and (> dot-count 0)
(ly:stencil-translate-axis
dot (* 2 x dotwid) X))
(iota dot-count)))))
+ ;; Straight-flags. Values taken from /scm/flag-style.scm
+ (modern-straight-flag (straight-flag-mrkp 0.55 1 -18 1.1 22 1.2 dir))
+ (old-straight-flag (straight-flag-mrkp 0.55 1 -45 1.2 45 1.4 dir))
+ ;; Calculate a corrective to avoid a gap between
+ ;; straight-flags and the stem.
+ (flag-style-Y-corr (if (or (eq? flag-style 'modern-straight-flag)
+ (eq? flag-style 'old-straight-flag))
+ (/ blot 10 (* -1 dir))
+ 0))
(flaggl (and (> log 2)
(ly:stencil-translate
- (ly:font-get-glyph font
- (string-append "flags."
- (if (> dir 0) "u" "d")
- (number->string log)))
- (cons (+ (car attach-off) (if (< dir 0)
- stem-thickness 0))
- stemy)))))
+ (cond ((eq? flag-style 'modern-straight-flag)
+ modern-straight-flag)
+ ((eq? flag-style 'old-straight-flag)
+ old-straight-flag)
+ (else
+ (ly:font-get-glyph font
+ (format #f (if ancient-flags?
+ "flags.mensural~a2~a"
+ "flags.~a~a")
+ (if (> dir 0) "u" "d")
+ log))))
+ (cons (+ (car attach-off)
+ ;; For tighter stems (with ancient-flags) the
+ ;; flag has to be adjusted different.
+ (if (and (not ancient-flags?) (< dir 0))
+ stem-thickness
+ 0))
+ (+ stemy flag-style-Y-corr))))))
;; If there is a flag on an upstem and the stem is short, move the dots
;; to avoid the flag. 16th notes get a special case because their flags
;; hang lower than any other flags.
+ ;; Not with ancient flags or straight-flags.
(if (and dots (> dir 0) (> log 2)
- (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
- (set! dots (ly:stencil-translate-axis dots 0.5 X)))
+ (or (eq? flag-style 'default) (null? flag-style))
+ (not ancient-flags?)
+ (or (< dir 1.15) (and (= log 4) (< dir 1.3))))
+ (set! dots (ly:stencil-translate-axis dots 0.5 X)))
(if flaggl
(set! stem-glyph (ly:stencil-add flaggl stem-glyph)))
(if (ly:stencil? stem-glyph)
(if (ly:stencil? dots)
(set! stem-glyph
(ly:stencil-add
- (ly:stencil-translate-axis
- dots
- (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
- X)
- stem-glyph)))
+ (ly:stencil-translate-axis
+ dots
+ (+ (cdr (ly:stencil-extent head-glyph X)) dotwid)
+ X)
+ stem-glyph)))
stem-glyph))
(define-public log2
"Parse the `duration-string', e.g. ''4..'' or ''breve.'',
and return a (log dots) list."
(let ((match (regexp-exec (make-regexp "(breve|longa|maxima|[0-9]+)(\\.*)")
- duration-string)))
+ duration-string)))
(if (and match (string=? duration-string (match:substring match 0)))
(let ((len (match:substring match 1))
(dots (match:substring match 2)))
(let ((parsed (parse-simple-duration duration)))
(note-by-number-markup layout props (car parsed) (cadr parsed) dir)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; the rest command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-markup-command (rest-by-number layout props log dot-count)
+ (number? number?)
+ #:category music
+ #:properties ((font-size 0)
+ (style '())
+ (multi-measure-rest #f))
+ "
+@cindex rests or multi-measure-rests within text by log and dot-count
+
+A rest or multi-measure-rest symbol.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\rest-by-number #3 #2
+ \\hspace #2
+ \\rest-by-number #0 #1
+ \\hspace #2
+ \\override #'(multi-measure-rest . #t)
+ \\rest-by-number #0 #0
+}
+@end lilypond"
+
+ (define (get-glyph-name-candidates log style)
+ (let* (;; Choose the style-string to be added.
+ ;; If no glyph exists, select others for the specified styles
+ ;; otherwise defaulting.
+ (style-strg
+ (cond (
+ ;; 'baroque needs to be special-cased, otherwise
+ ;; `select-head-glyph´ would catch neomensural-glyphs for
+ ;; this style, if (< log 0).
+ (eq? style 'baroque)
+ (string-append (number->string log) ""))
+ ((eq? style 'petrucci)
+ (string-append (number->string log) "mensural"))
+ ;; In other cases `select-head-glyph´ from output-lib.scm
+ ;; works for rest-glyphs, too.
+ ((and (symbol? style) (not (eq? style 'default)))
+ (select-head-glyph style log))
+ (else log)))
+ ;; Choose ledgered glyphs for whole and half rest.
+ ;; Except for the specified styles, logs and MultiMeasureRests.
+ (ledger-style-rests
+ (if (and (or (list? style)
+ (not (member style
+ '(neomensural mensural petrucci))))
+ (not multi-measure-rest)
+ (or (= log 0) (= log 1)))
+ "o"
+ "")))
+ (format #f "rests.~a~a" style-strg ledger-style-rests)))
+
+ (define (get-glyph-name font cands)
+ (if (ly:stencil-empty? (ly:font-get-glyph font cands))
+ ""
+ cands))
+
+ (let* ((font
+ (ly:paper-get-font layout
+ (cons '((font-encoding . fetaMusic)) props)))
+ (rest-glyph-name
+ (let ((result
+ (get-glyph-name font
+ (get-glyph-name-candidates log style))))
+ (if (string-null? result)
+ ;; If no glyph name can be found, select default rests. Though
+ ;; this usually means an unsupported style has been chosen, it
+ ;; also prevents unrelated 'style settings from other grobs
+ ;; (e.g., TextSpanner and TimeSignature) leaking into markup.
+ (get-glyph-name font (get-glyph-name-candidates log 'default))
+ result)))
+ (rest-glyph (ly:font-get-glyph font rest-glyph-name))
+ (dot (ly:font-get-glyph font "dots.dot"))
+ (dot-width (interval-length (ly:stencil-extent dot X)))
+ (dots (and (> dot-count 0)
+ (apply ly:stencil-add
+ (map (lambda (x)
+ (ly:stencil-translate-axis
+ dot (* 2 x dot-width) X))
+ (iota dot-count))))))
+
+ ;; Apart from mensural-, neomensural- and petrucci-style ledgered
+ ;; glyphs are taken for whole and half rests.
+ ;; If they are dotted, move the dots in X-direction to avoid collision.
+ (if (and dots
+ (< log 2)
+ (>= log 0)
+ (not (member style '(neomensural mensural petrucci))))
+ (set! dots (ly:stencil-translate-axis dots dot-width X)))
+
+ ;; Add dots to the rest-glyph.
+ ;;
+ ;; Not sure how to vertical align dots.
+ ;; For now the dots are centered for half, whole or longer rests.
+ ;; Otherwise placed near the top of the rest.
+ ;;
+ ;; Dots for rests with (< log 0) dots are allowed, but not
+ ;; if multi-measure-rest is set #t.
+ (if (and (not multi-measure-rest) dots)
+ (set! rest-glyph
+ (ly:stencil-add
+ (ly:stencil-translate
+ dots
+ (cons
+ (+ (cdr (ly:stencil-extent rest-glyph X)) dot-width)
+ (if (< log 2)
+ (interval-center (ly:stencil-extent rest-glyph Y))
+ (- (interval-end (ly:stencil-extent rest-glyph Y))
+ (/ (* 2 dot-width) 3)))))
+ rest-glyph)))
+ rest-glyph))
+
+(define-markup-command (rest layout props duration)
+ (string?)
+ #:category music
+ #:properties ((style '())
+ (multi-measure-rest #f)
+ (multi-measure-rest-number #t)
+ (word-space 0.6))
+ "
+@cindex rests or multi-measure-rests within text by string
+
+This produces a rest, with the @var{duration} for the rest type and
+augmentation dots.
+@code{\"breve\"}, @code{\"longa\"} and @code{\"maxima\"} are valid
+input-strings.
+
+Printing MultiMeasureRests could be enabled with
+@code{\\override #'(multi-measure-rest . #t)}
+If MultiMeasureRests are taken, the MultiMeasureRestNumber is printed above.
+This is enabled for all styles using default-glyphs.
+Could be disabled with @code{\\override #'(multi-measure-rest-number . #f)}
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\rest #\"4..\"
+ \\hspace #2
+ \\rest #\"breve\"
+ \\hspace #2
+ \\override #'(multi-measure-rest . #t)
+ {
+ \\rest #\"7\"
+ \\hspace #2
+ \\override #'(multi-measure-rest-number . #f)
+ \\rest #\"7\"
+ }
+}
+@end lilypond"
+ ;; Get the number of mmr-glyphs.
+ ;; Store them in a list.
+ ;; example: (mmr-numbers 25) -> '(3 0 0 1)
+ (define (mmr-numbers nmbr)
+ (let* ((8-bar-glyph (floor (/ nmbr 8)))
+ (8-remainder (remainder nmbr 8))
+ (4-bar-glyph (floor (/ 8-remainder 4)))
+ (4-remainder (remainder nmbr 4))
+ (2-bar-glyph (floor (/ 4-remainder 2)))
+ (2-remainder (remainder 4-remainder 2))
+ (1-bar-glyph (floor (/ 2-remainder 1))))
+ (list 8-bar-glyph 4-bar-glyph 2-bar-glyph 1-bar-glyph)))
+
+ ;; Get the correct mmr-glyphs.
+ ;; Store them in a list.
+ ;; example:
+ ;; (get-mmr-glyphs '(1 0 1 0) '("rests.M3" "rests.M2" "rests.M1" "rests.0"))
+ ;; -> ("rests.M3" "rests.M1")
+ (define (get-mmr-glyphs lst1 lst2)
+ (define (helper l1 l2 l3)
+ (if (null? l1)
+ (reverse l3)
+ (helper (cdr l1)
+ (cdr l2)
+ (append (make-list (car l1) (car l2)) l3))))
+ (helper lst1 lst2 '()))
+
+ ;; If duration is not valid, print a warning and return empty-stencil
+ (if (or (and (not (integer? (car (parse-simple-duration duration))))
+ (not multi-measure-rest))
+ (and (= (string-length (car (string-split duration #\. ))) 1)
+ (= (string->number (car (string-split duration #\. ))) 0)))
+ (begin
+ (ly:warning (_ "not a valid duration string: ~a - ignoring") duration)
+ empty-stencil)
+ (let* (
+ ;; For simple rests:
+ ;; Get a (log dots) list.
+ (parsed (parse-simple-duration duration))
+ ;; Create the rest-stencil
+ (stil
+ (rest-by-number-markup layout props (car parsed) (cadr parsed)))
+ ;; For MultiMeasureRests:
+ ;; Get the duration-part of duration
+ (dur-part-string (car (string-split duration #\. )))
+ ;; Get the duration of MMR:
+ ;; If not a number (eg. "maxima") calculate it.
+ (mmr-duration
+ (or (string->number dur-part-string) (expt 2 (abs (car parsed)))))
+ ;; Get a list of the correct number of each mmr-glyph.
+ (count-mmr-glyphs-list (mmr-numbers mmr-duration))
+ ;; Create a list of mmr-stencils,
+ ;; translating the glyph for a whole rest.
+ (mmr-stils-list
+ (map
+ (lambda (x)
+ (let ((single-mmr-stil
+ (rest-by-number-markup layout props (* -1 x) 0)))
+ (if (= x 0)
+ (ly:stencil-translate-axis
+ single-mmr-stil
+ ;; Ugh, hard-coded, why 1?
+ 1
+ Y)
+ single-mmr-stil)))
+ (get-mmr-glyphs count-mmr-glyphs-list (reverse (iota 4)))))
+ ;; Adjust the space between the mmr-glyphs,
+ ;; if not default-glyphs are used.
+ (word-space (if (member style
+ '(neomensural mensural petrucci))
+ (/ (* word-space 2) 3)
+ word-space))
+ ;; Create the final mmr-stencil
+ ;; via `stack-stencil-line´ from /scm/markup.scm
+ (mmr-stil (stack-stencil-line word-space mmr-stils-list)))
+
+ ;; Print the number above a multi-measure-rest
+ ;; Depends on duration, style and multi-measure-rest-number set #t
+ (if (and multi-measure-rest
+ multi-measure-rest-number
+ (> mmr-duration 1)
+ (not (member style '(neomensural mensural petrucci))))
+ (let* ((mmr-stil-x-center
+ (interval-center (ly:stencil-extent mmr-stil X)))
+ (duration-markup
+ (markup
+ #:fontsize -2
+ #:override '(font-encoding . fetaText)
+ (number->string mmr-duration)))
+ (mmr-number-stil
+ (interpret-markup layout props duration-markup))
+ (mmr-number-stil-x-center
+ (interval-center (ly:stencil-extent mmr-number-stil X))))
+
+ (set! mmr-stil (ly:stencil-combine-at-edge
+ mmr-stil
+ Y UP
+ (ly:stencil-translate-axis
+ mmr-number-stil
+ (- mmr-stil-x-center mmr-number-stil-x-center)
+ X)
+ ;; Ugh, hardcoded
+ 0.8))))
+ (if multi-measure-rest
+ mmr-stil
+ stil))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; translating.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(pair? markup-list?)
"Like @code{\\override}, for markup lists."
(interpret-markup-list layout (cons (list new-prop) props) args))
+
+(define-markup-list-command (map-markup-commands layout props compose args)
+ (procedure? markup-list?)
+ "This applies the function @var{compose} to every markup in
+@var{args} (including elements of markup list command calls) in order
+to produce a new markup list. Since the return value from a markup
+list command call is not a markup list but rather a list of stencils,
+this requires passing those stencils off as the results of individual
+markup calls. That way, the results should work out as long as no
+markups rely on side effects."
+ (let ((key (make-symbol "key")))
+ (catch
+ key
+ (lambda ()
+ ;; if `compose' does not actually interpret its markup
+ ;; argument, we still need to return a list of stencils,
+ ;; created from the single returned stencil
+ (list
+ (interpret-markup layout props
+ (compose
+ (make-on-the-fly-markup
+ (lambda (layout props m)
+ ;; here all effects of `compose' on the
+ ;; properties should be visible, so we
+ ;; call interpret-markup-list at this
+ ;; point of time and harvest its
+ ;; stencils
+ (throw key
+ (interpret-markup-list
+ layout props args)))
+ (make-null-markup))))))
+ (lambda (key stencils)
+ (map
+ (lambda (sten)
+ (interpret-markup layout props
+ (compose (make-stencil-markup sten))))
+ stencils)))))