;;;;
;;;; 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)))
"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)
;; Markup list commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (space-lines baseline-skip lines)
+(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))
(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 #'(line-width . @var{X})} to set the line width;
+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 #'(line-width . @var{X})} to set the line width,
+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)))
projects / lilypond.git / blobdiff