;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2000--2010 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2000--2011 Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;; Jan Nieuwenhuizen <janneke@gnu.org>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;;; using `chain-assoc-get' (more on that below)
;;;
;;; args...
-;;; the command arguments. There are restrictions on the
-;;; possible arguments for a markup command.
-;;; First, arguments are distinguished according to their type:
-;;; 1) a markup (or a string), corresponding to type predicate `markup?'
-;;; 2) a list of markups, corresponding to type predicate `markup-list?'
-;;; 3) any scheme object, corresponding to type predicates such as
-;;; `list?', 'number?', 'boolean?', etc.
-;;; The supported arrangements of arguments, according to their type, are:
-;;; - no argument
-;;; - markup
-;;; - scheme
-;;; - markup, markup
-;;; - markup-list
-;;; - scheme, scheme
-;;; - scheme, markup
-;;; - scheme, scheme, markup
-;;; - scheme, scheme, markup, markup
-;;; - scheme, markup, markup
-;;; - scheme, scheme, scheme
-;;; This combinations are hard-coded in the lexer and in the parser
-;;; (lily/lexer.ll and lily/parser.yy)
+;;; the command arguments.
+;;; There is no limitation on the order of command arguments.
+;;; However, markup functions taking a markup as their last
+;;; argument are somewhat special as you can apply them to a
+;;; markup list, and the result is a markup list where the
+;;; markup function (with the specified leading arguments) has
+;;; been applied to every element of the original markup list.
+;;;
+;;; Since replicating the leading arguments for applying a
+;;; markup function to a markup list is cheap mostly for
+;;; Scheme arguments, you avoid performance pitfalls by just
+;;; using Scheme arguments for the leading arguments of markup
+;;; functions that take a markup as their last argument.
;;;
;;; args-signature
;;; the arguments signature, i.e. a list of type predicates which
(define-markup-command (underline layout props arg)
(markup?)
#:category font
- #:properties ((thickness 1))
+ #:properties ((thickness 1) (offset 2))
"
@cindex underlining text
Underline @var{arg}. Looks at @code{thickness} to determine line
-thickness and y-offset.
+thickness, and @code{offset} to determine line y-offset.
@lilypond[verbatim,quote]
-\\markup {
- default
- \\hspace #2
- \\override #'(thickness . 2)
- \\underline {
- underline
- }
+\\markup \\fill-line {
+ \\underline \"underlined\"
+ \\override #'(offset . 5)
+ \\override #'(thickness . 1)
+ \\underline \"underlined\"
+ \\override #'(offset . 1)
+ \\override #'(thickness . 5)
+ \\underline \"underlined\"
}
@end lilypond"
- (let* ((thick (* (ly:output-def-lookup layout 'line-thickness)
- thickness))
+ (let* ((thick (ly:output-def-lookup layout 'line-thickness))
+ (underline-thick (* thickness thick))
(markup (interpret-markup layout props arg))
(x1 (car (ly:stencil-extent markup X)))
(x2 (cdr (ly:stencil-extent markup X)))
- (y (* thick -2))
- (line (make-line-stencil thick x1 y x2 y)))
+ (y (* thick (- offset)))
+ (line (make-line-stencil underline-thick x1 y x2 y)))
(ly:stencil-add markup line)))
(define-markup-command (box layout props arg)
(make-simple-markup ""))
;; helper for justifying lines.
-(define (get-fill-space word-count line-width text-widths)
+(define (get-fill-space word-count line-width word-space text-widths)
"Calculate the necessary paddings between each two adjacent texts.
- The lengths of all texts are stored in @var{text-widths}.
- The normal formula for the padding between texts a and b is:
- padding = line-width/(word-count - 1) - (length(a) + length(b))/2
- The first and last padding have to be calculated specially using the
- whole length of the first or last text.
- Return a list of paddings."
+ The lengths of all texts are stored in @var{text-widths}.
+ The normal formula for the padding between texts a and b is:
+ padding = line-width/(word-count - 1) - (length(a) + length(b))/2
+ The first and last padding have to be calculated specially using the
+ whole length of the first or last text.
+ All paddings are checked to be at least word-space, to ensure that
+ no texts collide.
+ Return a list of paddings."
(cond
((null? text-widths) '())
(cons
(- (- (/ line-width (1- word-count)) (car text-widths))
(/ (car (cdr text-widths)) 2))
- (get-fill-space word-count line-width (cdr text-widths))))
+ (get-fill-space word-count line-width word-space (cdr text-widths))))
;; special case last padding
((= (length text-widths) 2)
(list (- (/ line-width (1- word-count))
(+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
(else
- (cons
- (- (/ line-width (1- word-count))
- (/ (+ (car text-widths) (car (cdr text-widths))) 2))
- (get-fill-space word-count line-width (cdr text-widths))))))
+ (let ((default-padding
+ (- (/ line-width (1- word-count))
+ (/ (+ (car text-widths) (car (cdr text-widths))) 2))))
+ (cons
+ (if (> word-space default-padding)
+ word-space
+ default-padding)
+ (get-fill-space word-count line-width word-space (cdr text-widths)))))))
(define-markup-command (fill-line layout props args)
(markup-list?)
#:category align
#:properties ((text-direction RIGHT)
- (word-space 1)
- (line-width #f))
+ (word-space 0.6)
+ (line-width #f))
"Put @var{markups} in a horizontal line of width @var{line-width}.
The markups are spaced or flushed to fill the entire line.
If there are no arguments, return an empty stencil.
}
@end lilypond"
(let* ((orig-stencils (interpret-markup-list layout props args))
- (stencils
- (map (lambda (stc)
- (if (ly:stencil-empty? stc)
- point-stencil
- stc)) orig-stencils))
- (text-widths
- (map (lambda (stc)
- (if (ly:stencil-empty? stc)
- 0.0
- (interval-length (ly:stencil-extent stc X))))
- stencils))
- (text-width (apply + text-widths))
- (word-count (length stencils))
- (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
- (fill-space
- (cond
- ((= word-count 1)
- (list
- (/ (- line-width text-width) 2)
- (/ (- line-width text-width) 2)))
- ((= word-count 2)
- (list
- (- line-width text-width)))
- (else
- (get-fill-space word-count line-width text-widths))))
- (fill-space-normal
- (map (lambda (x)
- (if (< x word-space)
- word-space
- x))
- fill-space))
-
- (line-stencils (if (= word-count 1)
- (list
- point-stencil
- (car stencils)
- point-stencil)
- stencils)))
-
- (if (= text-direction LEFT)
- (set! line-stencils (reverse line-stencils)))
+ (stencils
+ (map (lambda (stc)
+ (if (ly:stencil-empty? stc)
+ point-stencil
+ stc)) orig-stencils))
+ (text-widths
+ (map (lambda (stc)
+ (if (ly:stencil-empty? stc)
+ 0.0
+ (interval-length (ly:stencil-extent stc X))))
+ stencils))
+ (text-width (apply + text-widths))
+ (word-count (length stencils))
+ (line-width (or line-width (ly:output-def-lookup layout 'line-width)))
+ (fill-space
+ (cond
+ ((= word-count 1)
+ (list
+ (/ (- line-width text-width) 2)
+ (/ (- line-width text-width) 2)))
+ ((= word-count 2)
+ (list
+ (- line-width text-width)))
+ (else
+ (get-fill-space word-count line-width word-space text-widths))))
+
+ (line-contents (if (= word-count 1)
+ (list
+ point-stencil
+ (car stencils)
+ point-stencil)
+ stencils)))
(if (null? (remove ly:stencil-empty? orig-stencils))
- empty-stencil
- (ly:stencil-translate-axis
- (stack-stencils-padding-list X
- RIGHT fill-space-normal line-stencils)
- (- (car (ly:stencil-extent (car stencils) X)))
- X))))
+ empty-stencil
+ (begin
+ (if (= text-direction LEFT)
+ (set! line-contents (reverse line-contents)))
+ (set! line-contents
+ (stack-stencils-padding-list
+ X RIGHT fill-space line-contents))
+ (if (> word-count 1)
+ ;; shift s.t. stencils align on the left edge, even if
+ ;; first stencil had negative X-extent (e.g. center-column)
+ ;; (if word-count = 1, X-extents are already normalized in
+ ;; the definition of line-contents)
+ (set! line-contents
+ (ly:stencil-translate-axis
+ line-contents
+ (- (car (ly:stencil-extent (car stencils) X)))
+ X)))
+ line-contents))))
(define-markup-command (line layout props args)
(markup-list?)
;; symbols.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define-markup-command (musicglyph layout props glyph-name)
+ (string?)
+ #:category music
+ "@var{glyph-name} is converted to a musical symbol; for example,
+@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
+the music font. See @ruser{The Feta font} for a complete listing of
+the possible glyphs.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\musicglyph #\"f\"
+ \\musicglyph #\"rests.2\"
+ \\musicglyph #\"clefs.G_change\"
+}
+@end lilypond"
+ (let* ((font (ly:paper-get-font layout
+ (cons '((font-encoding . fetaMusic)
+ (font-name . #f))
+
+ props)))
+ (glyph (ly:font-get-glyph font glyph-name)))
+ (if (null? (ly:stencil-expr glyph))
+ (ly:warning (_ "Cannot find glyph ~a") glyph-name))
+
+ glyph))
+
(define-markup-command (doublesharp layout props)
()
#:category music
props))
name)))
-(define-markup-command (musicglyph layout props glyph-name)
- (string?)
- #:category music
- "@var{glyph-name} is converted to a musical symbol; for example,
-@code{\\musicglyph #\"accidentals.natural\"} selects the natural sign from
-the music font. See @ruser{The Feta font} for a complete listing of
-the possible glyphs.
-
-@lilypond[verbatim,quote]
-\\markup {
- \\musicglyph #\"f\"
- \\musicglyph #\"rests.2\"
- \\musicglyph #\"clefs.G_change\"
-}
-@end lilypond"
- (let* ((font (ly:paper-get-font layout
- (cons '((font-encoding . fetaMusic)
- (font-name . #f))
-
- props)))
- (glyph (ly:font-get-glyph font glyph-name)))
- (if (null? (ly:stencil-expr glyph))
- (ly:warning (_ "Cannot find glyph ~a") glyph-name))
-
- glyph))
-
-
(define-markup-command (lookup layout props glyph-name)
(string?)
#:category other
x-ext
y-ext)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; scaling
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-markup-command (scale layout props factor-pair arg)
+ (number-pair? markup?)
+ #:category graphic
+ "
+@cindex scaling markup
+@cindex mirroring markup
+
+Scale @var{arg}. @var{factor-pair} is a pair of numbers
+representing the scaling-factor in the X and Y axes.
+Negative values may be used to produce mirror images.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\line {
+ \\scale #'(2 . 1)
+ stretched
+ \\scale #'(1 . -1)
+ mirrored
+ }
+}
+@end lilypond"
+ (let ((stil (interpret-markup layout props arg))
+ (sx (car factor-pair))
+ (sy (cdr factor-pair)))
+ (ly:stencil-scale stil sx sy)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Markup list commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
projects / lilypond.git / blobdiff