X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fdefine-markup-commands.scm;h=0b9e7c954026a84d0b47715460df97e53f2a53f2;hb=533aa02038dcd4010f3d73a73db98514051521cc;hp=4cffe4c248279435865597612bd2bc979c73a5d7;hpb=fba53fe32502b6d62ffbd251e1fbf22e5e5ed24f;p=lilypond.git diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index 4cffe4c248..0b9e7c9540 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -2,7 +2,7 @@ ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 2000--2006 Han-Wen Nienhuys +;;;; (c) 2000--2007 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen @@ -28,7 +28,9 @@ (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)) (s (ly:make-stencil @@ -74,7 +76,9 @@ optionally filled." @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) @@ -113,12 +117,30 @@ the PDF backend." (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))) @@ -347,9 +369,7 @@ grestore 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) @@ -405,7 +425,7 @@ If there are no arguments, return an empty stencil." "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)) ) @@ -439,7 +459,9 @@ equivalent to @code{\"fi\"}." (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) @@ -521,32 +543,28 @@ equivalent to @code{\"fi\"}." (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* @@ -624,7 +642,7 @@ the line width, where @var{X} is the number of staff spaces." @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))) @@ -641,11 +659,11 @@ of the @code{#'direction} layout property." (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))) @@ -922,65 +940,40 @@ some punctuation. It doesn't have any letters." "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." @@ -1105,9 +1098,9 @@ Use the filled head if @var{filled} is specified." 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)) @@ -1168,7 +1161,8 @@ figured bass notation." ((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) @@ -1491,3 +1485,41 @@ when @var{label} is not found." (markup #:concat (#:hspace gap page-markup))))))) x-ext y-ext))) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 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))