;;;;
;;;; source file of the GNU LilyPond music typesetter
;;;;
-;;;; (c) 2000--2006 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; (c) 2000--2007 Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;; Jan Nieuwenhuizen <janneke@gnu.org>
(number-pair?)
"A simple line. Uses the @code{thickness} property."
(let*
- ((th (chain-assoc-get 'thickness props 0.1))
+ ((th (*
+ (ly:output-def-lookup layout 'line-thickness)
+ (chain-assoc-get 'thickness props 1)))
(x (car dest))
- (y (cdr dest)))
+ (y (cdr dest))
+ (s (ly:make-stencil
+ `(draw-line
+ ,th
+ 0 0
+ ,x ,y)
- (ly:make-stencil
- `(draw-line
- ,th
- 0 0
- ,x ,y)
+ (cons (min x 0) (max x 0))
+ (cons (min y 0) (max y 0)))))
- (cons (min x 0) (min y 0))
- (cons (max x 0) (max y 0)))))
+ s))
(define-builtin-markup-command (draw-circle layout props radius thickness fill)
(number? number? boolean?)
@code{circle-padding} and @code{font-size} properties to determine line
thickness and padding around the markup."
- (let* ((th (chain-assoc-get 'thickness props 0.1))
+ (let* ((th
+ (* (ly:output-def-lookup layout 'line-thickness)
+ (chain-assoc-get 'thickness props 1)))
(size (chain-assoc-get 'font-size props 0))
(pad
(* (magstep size)
(cons (+ (- half) (car yext))
(+ half (cdr yext))))))
+(define-builtin-markup-command (underline layout props arg) (markup?)
+ "Underline @var{arg}. Looks at @code{thickness} to determine line
+thickness and y offset."
+ (let* ((thick (*
+ (ly:output-def-lookup layout 'line-thickness)
+ (chain-assoc-get 'thickness props 1)))
+ (markup (interpret-markup layout props arg))
+ (x1 (car (ly:stencil-extent markup X)))
+ (x2 (cdr (ly:stencil-extent markup X)))
+ (y (* thick -2))
+ (line (ly:make-stencil
+ `(draw-line ,thick ,x1 ,y ,x2 ,y)
+ (cons (min x1 0) (max x2 0))
+ (cons thick thick))))
+ (ly:stencil-add markup line)))
+
(define-builtin-markup-command (box layout props arg) (markup?)
"Draw a box round @var{arg}. Looks at @code{thickness},
@code{box-padding} and @code{font-size} properties to determine line
thickness and padding around the markup."
- (let* ((th (chain-assoc-get 'thickness props 0.1))
+ (let* ((th (*
+ (ly:output-def-lookup layout 'line-thickness)
+ (chain-assoc-get 'thickness props 1)))
(size (chain-assoc-get 'font-size props 0))
(pad (* (magstep size)
(chain-assoc-get 'box-padding props 0.2)))
The markups are spaced or flushed to fill the entire line.
If there are no arguments, return an empty stencil."
- (let* ((orig-stencils
- (map (lambda (x) (interpret-markup layout props x))
- markups))
+ (let* ((orig-stencils (interpret-markup-list layout props markups))
(stencils
(map (lambda (stc)
(if (ly:stencil-empty? stc)
"Put @var{args} in a horizontal line. The property @code{word-space}
determines the space between each markup in @var{args}."
(let*
- ((stencils (map (lambda (m) (interpret-markup layout props m)) args))
+ ((stencils (interpret-markup-list layout props args))
(space (chain-assoc-get 'word-space props))
(text-dir (chain-assoc-get 'text-direction props RIGHT))
)
(interpret-markup layout
(prepend-alist-chain 'word-space 0 props)
- (make-line-markup (concat-string-args args))))
+ (make-line-markup (if (markup-command-list? args)
+ args
+ (concat-string-args args)))))
(define (wordwrap-stencils stencils
justify base-space line-width text-dir)
(define (wordwrap-markups layout props args justify)
(let*
- ((baseline-skip (chain-assoc-get 'baseline-skip props))
- (prop-line-width (chain-assoc-get 'line-width props #f))
+ ((prop-line-width (chain-assoc-get 'line-width props #f))
(line-width (if prop-line-width prop-line-width
(ly:output-def-lookup layout 'line-width)))
(word-space (chain-assoc-get 'word-space props))
- (text-dir (chain-assoc-get 'text-direction props RIGHT))
- (lines (wordwrap-stencils
- (remove ly:stencil-empty?
- (map (lambda (m) (interpret-markup layout props m)) args))
- justify word-space line-width
- text-dir)
- ))
-
- (stack-lines DOWN 0.0 baseline-skip lines)))
+ (text-dir (chain-assoc-get 'text-direction props RIGHT)))
+ (wordwrap-stencils (remove ly:stencil-empty?
+ (interpret-markup-list layout props args))
+ justify word-space line-width
+ text-dir)))
(define-builtin-markup-command (justify layout props args) (markup-list?)
"Like wordwrap, but with lines stretched to justify the margins.
Use @code{\\override #'(line-width . @var{X})} to set the line width;
@var{X}@tie{}is the number of staff spaces."
- (wordwrap-markups layout props args #t))
+ (stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
+ (wordwrap-markups layout props args #t)))
(define-builtin-markup-command (wordwrap layout props args) (markup-list?)
"Simple wordwrap. Use @code{\\override #'(line-width . @var{X})} to set
the line width, where @var{X} is the number of staff spaces."
-
- (wordwrap-markups layout props args #f))
+ (stack-lines DOWN 0.0 (chain-assoc-get 'baseline-skip props)
+ (wordwrap-markups layout props args #f)))
(define (wordwrap-string layout props justify arg)
(let*
(define-builtin-markup-command (wordwrap-field layout props symbol) (symbol?)
- "Wordwrap the data which has been assigned to @var{symbol}.
+ "Wordwrap the data which has been assigned to @var{symbol}."
(let* ((m (chain-assoc-get symbol props)))
(if (string? m)
(interpret-markup layout props
(ly:make-stencil '() '(1 . -1) '(1 . -1)))))
(define-builtin-markup-command (justify-field layout props symbol) (symbol?)
- "Justify the data which has been assigned to @var{symbol}.
+ "Justify the data which has been assigned to @var{symbol}."
(let* ((m (chain-assoc-get symbol props)))
(if (string? m)
(interpret-markup layout props
@code{baseline-skip} determines the space between each markup in @var{args}."
(let*
- ((arg-stencils (map (lambda (m) (interpret-markup layout props m)) args))
+ ((arg-stencils (interpret-markup-list layout props args))
(skip (chain-assoc-get 'baseline-skip props)))
(if (number? dir) dir -1)
0.0
(chain-assoc-get 'baseline-skip props)
- (map (lambda (x) (interpret-markup layout props x)) args))))
+ (interpret-markup-list layout props args))))
(define-builtin-markup-command (center-align layout props args) (markup-list?)
"Put @code{args} in a centered column."
- (let* ((mols (map (lambda (x) (interpret-markup layout props x)) args))
+ (let* ((mols (interpret-markup-list layout props args))
(cmols (map (lambda (x) (ly:stencil-aligned-to x X CENTER)) mols)))
(stack-lines -1 0.0 (chain-assoc-get 'baseline-skip props) cmols)))
"Turn @code{text}, which should be a string, to small caps.
@example
\\markup \\smallCaps \"Text between double quotes\"
-@end example"
- (define (make-small-caps-markup chars)
- (cond ((null? chars)
- (markup))
- ((char-whitespace? (car chars))
- (markup #:fontsize -2 #:simple (string-upcase (list->string (cdr chars)))))
- (else
- (markup #:hspace -1
- #:fontsize -2 #:simple (string-upcase (list->string chars))))))
- (define (make-not-small-caps-markup chars)
- (cond ((null? chars)
- (markup))
- ((char-whitespace? (car chars))
- (markup #:simple (list->string (cdr chars))))
- (else
- (markup #:hspace -1
- #:simple (list->string chars)))))
- (define (small-caps-aux done-markups current-chars rest-chars small? after-space?)
- (cond ((null? rest-chars)
- ;; the end of the string: build the markup
- (make-line-markup (reverse! (cons ((if small?
- make-small-caps-markup
- make-not-small-caps-markup)
- (reverse! current-chars))
- done-markups))))
- ((char-whitespace? (car rest-chars))
- ;; a space char.
- (small-caps-aux done-markups current-chars (cdr rest-chars) small? #t))
- ((or (and small? (char-lower-case? (car rest-chars)))
- (and (not small?) (not (char-lower-case? (car rest-chars)))))
- ;; same case
- ;; add the char to the current char list
- (small-caps-aux done-markups
- (cons (car rest-chars)
- (if after-space?
- (cons #\space current-chars)
- current-chars))
- (cdr rest-chars)
- small?
- #f))
- (else
- ;; case change
- ;; make a markup with current chars, and start a new list with new char
- (small-caps-aux (cons ((if small?
- make-small-caps-markup
- make-not-small-caps-markup)
- (reverse! current-chars))
- done-markups)
- (if after-space?
- (list (car rest-chars) #\space)
- (list (car rest-chars)))
- (cdr rest-chars)
- (not small?)
- #f))))
- (interpret-markup layout props (small-caps-aux (list)
- (list)
- (cons #\space (string->list text))
- #f
- #f)))
+@end example
+
+Note: @code{\\smallCaps} does not support accented characters."
+ (define (char-list->markup chars lower)
+ (let ((final-string (string-upcase (reverse-list->string chars))))
+ (if lower
+ (markup #:fontsize -2 final-string)
+ final-string)))
+ (define (make-small-caps rest-chars currents current-is-lower prev-result)
+ (if (null? rest-chars)
+ (make-concat-markup
+ (reverse! (cons (char-list->markup currents current-is-lower)
+ prev-result)))
+ (let* ((ch (car rest-chars))
+ (is-lower (char-lower-case? ch)))
+ (if (or (and current-is-lower is-lower)
+ (and (not current-is-lower) (not is-lower)))
+ (make-small-caps (cdr rest-chars)
+ (cons ch currents)
+ is-lower
+ prev-result)
+ (make-small-caps (cdr rest-chars)
+ (list ch)
+ is-lower
+ (if (null? currents)
+ prev-result
+ (cons (char-list->markup
+ currents current-is-lower)
+ prev-result)))))))
+ (interpret-markup layout props
+ (if (string? text)
+ (make-small-caps (string->list text) (list) #f (list))
+ text)))
+
(define-builtin-markup-command (caps layout props arg) (markup?)
"Emit @var{arg} as small caps."
name)))
(define-builtin-markup-command (musicglyph layout props glyph-name) (string?)
- "@var{glyph0name} is converted to a musical symbol; for example,
+ "@var{glyph-name} is converted to a musical symbol; for example,
@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
-the music font. See @usermanref{The Feta font} for a complete listing of
+the music font. See @ruser{The Feta font} for a complete listing of
the possible glyphs."
(ly:font-get-glyph
(ly:paper-get-font layout (cons '((font-encoding . fetaMusic))
((mag (magstep (chain-assoc-get 'font-size props 0)))
(thickness
(* mag
- (chain-assoc-get 'thickness props 0.16)))
+ (ly:output-def-lookup layout 'line-thickness)
+ (chain-assoc-get 'thickness props 1.6)))
(dy (* mag 0.15))
(number-stencil (interpret-markup layout
(prepend-alist-chain 'font-encoding 'fetaNumber props)
Raising and lowering texts can be done with @code{\\super} and
@code{\\sub}:
-
+@c
@lilypond[verbatim,fragment,relative=1]
-c1^\\markup { E \"=\" \\concat { "mc" \\super \"2\" } }
+c1^\\markup { E \"=\" \\concat { \"mc\" \\super \"2\" } }
@end lilypond"
(ly:stencil-translate-axis
(interpret-markup
(m (interpret-markup layout props arg)))
(bracketify-stencil m Y th (* 2.5 th) th)))
\f
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Delayed markup evaluation
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-builtin-markup-command (page-ref layout props label gauge default)
+ (symbol? markup? markup?)
+ "Reference to a page number. @var{label} is the label set on the referenced
+page (using the @code{\\label} command), @var{gauge} a markup used to estimate
+the maximum width of the page number, and @var{default} the value to display
+when @var{label} is not found."
+ (let* ((gauge-stencil (interpret-markup layout props gauge))
+ (x-ext (ly:stencil-extent gauge-stencil X))
+ (y-ext (ly:stencil-extent gauge-stencil Y)))
+ (ly:make-stencil
+ `(delay-stencil-evaluation
+ ,(delay (ly:stencil-expr
+ (let* ((table (ly:output-def-lookup layout 'label-page-table))
+ (label-page (and (list? table) (assoc label table)))
+ (page-number (and label-page (cdr label-page)))
+ (page-markup (if page-number (format "~a" page-number) default))
+ (page-stencil (interpret-markup layout props page-markup))
+ (gap (- (interval-length x-ext)
+ (interval-length (ly:stencil-extent page-stencil X)))))
+ (interpret-markup layout props
+ (markup #:concat (#:hspace gap page-markup)))))))
+ x-ext
+ y-ext)))
+
+\f
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; size indications arrow
+;; Markup list commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-public (space-lines baseline-skip lines)
+ (map (lambda (line)
+ (stack-lines DOWN 0.0 (/ baseline-skip 2.0)
+ (list (ly:make-stencil "" (cons 0 0) (cons 0 0))
+ line
+ (ly:make-stencil "" (cons 0 0) (cons 0 0)))))
+ lines))
+
+(define-builtin-markup-list-command (justified-lines layout props args) (markup-list?)
+ "Like @code{\\justify}, but return a list of lines instead of a single markup.
+Use @code{\\override-lines #'(line-width . @var{X})} to set the line width;
+@var{X}@tie{}is the number of staff spaces."
+ (space-lines (chain-assoc-get 'baseline-skip props)
+ (wordwrap-markups layout props args #t)))
+
+(define-builtin-markup-list-command (wordwrap-lines layout props args) (markup-list?)
+ "Like @code{\\wordwrap}, but return a list of lines instead of a single markup.
+Use @code{\\override-lines #'(line-width . @var{X})} to set the line width,
+where @var{X} is the number of staff spaces."
+ (space-lines (chain-assoc-get 'baseline-skip props)
+ (wordwrap-markups layout props args #f)))
+
+(define-builtin-markup-list-command (column-lines layout props args) (markup-list?)
+ "Like @code{\\column}, but return a list of lines instead of a single markup.
+@code{baseline-skip} determines the space between each markup in @var{args}."
+ (space-lines (chain-assoc-get 'baseline-skip props)
+ (interpret-markup-list layout props args)))
+
+(define-builtin-markup-list-command (override-lines layout props new-prop args)
+ (pair? markup-list?)
+ "Like @code{\\override}, for markup lists."
+ (interpret-markup-list layout (cons (list new-prop) props) args))
projects / lilypond.git / blobdiff