;;;; define-markup-commands.scm -- markup commands
;;;;
;;;; source file of the GNU LilyPond music typesetter
-;;;;
-;;;; (c) 2000--2008 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;;
+;;;; (c) 2000--2009 Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;; Jan Nieuwenhuizen <janneke@gnu.org>
-
-;;; markup commands
-;;; * each markup function should have a doc string with
-;; syntax, description and example.
+;;;
+;;; Markup commands and markup-list commands definitions.
+;;;
+;;; Markup commands which are part of LilyPond, are defined
+;;; in the (lily) module, which is the current module in this file,
+;;; using the `define-builtin-markup-command' macro.
+;;;
+;;; Usage:
+;;;
+;;; (define-builtin-markup-command (command-name layout props args...)
+;;; args-signature
+;;; category
+;;; property-bindings
+;;; documentation-string
+;;; ..body..)
+;;;
+;;; with:
+;;; command-name
+;;; the name of the markup command
+;;;
+;;; layout and props
+;;; arguments that are automatically passed to the command when it
+;;; is interpreted.
+;;; `layout' is an output def, which properties can be accessed
+;;; using `ly:output-def-lookup'.
+;;; `props' is a list of property settings which can be accessed
+;;; 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 distingued 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)
+;;;
+;;; args-signature
+;;; the arguments signature, i.e. a list of type predicates which
+;;; are used to type check the arguments, and also to define the general
+;;; argument types (markup, markup-list, scheme) that the command is
+;;; expecting.
+;;; For instance, if a command expects a number, then a markup, the
+;;; signature would be: (number? markup?)
+;;;
+;;; category
+;;; for documentation purpose, builtin markup commands are grouped by
+;;; category. This can be any symbol. When documentation is generated,
+;;; the symbol is converted to a capitalized string, where hyphens are
+;;; replaced by spaces.
+;;;
+;;; property-bindings
+;;; this is used both for documentation generation, and to ease
+;;; programming the command itself. It is list of
+;;; (property-name default-value)
+;;; or (property-name)
+;;; elements. Each property is looked-up in the `props' argument, and
+;;; the symbol naming the property is bound to its value.
+;;; When the property is not found in `props', then the symbol is bound
+;;; to the given default value. When no default value is given, #f is
+;;; used instead.
+;;; Thus, using the following property bindings:
+;;; ((thickness 0.1)
+;;; (font-size 0))
+;;; is equivalent to writing:
+;;; (let ((thickness (chain-assoc-get 'thickness props 0.1))
+;;; (font-size (chain-assoc-get 'font-size props 0)))
+;;; ..body..)
+;;; When a command `B' internally calls an other command `A', it may
+;;; desirable to see in `B' documentation all the properties and
+;;; default values used by `A'. In that case, add `A-markup' to the
+;;; property-bindings of B. (This is used when generating
+;;; documentation, but won't create bindings.)
+;;;
+;;; documentation-string
+;;; the command documentation string (used to generate manuals)
+;;;
+;;; body
+;;; the command body. The function is supposed to return a stencil.
+;;;
+;;; Each markup command definition shall have a documentation string
+;;; with description, syntax and example.
(use-modules (ice-9 regex))
(half (/ thickness 2)))
(ly:make-stencil
- `(polygon ',(list
+ `(polygon ',(list
0 (/ thickness -2)
width (+ (* width slope) (/ thickness -2))
width (+ (* width slope) (/ thickness 2))
}
}
c,8. c16 c4 r
-@end lilypond"
+@end lilypond"
(let ((th (* (ly:output-def-lookup layout 'line-thickness)
thickness))
(pad (* (magstep font-size) box-padding))
(ly:make-stencil "" (cons 0 amount) '(-1 . 1))
(ly:make-stencil "" (cons amount amount) '(-1 . 1))))
+;; todo: fix negative space
+(define-builtin-markup-command (vspace layout props amount)
+ (number?)
+ align
+ ()
+ "
+@cindex creating vertical spaces in text
+
+Create an invisible object taking up vertical space
+of @var{amount} multiplied by 3.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\center-column {
+ one
+ \\vspace #2
+ two
+ \\vspace #5
+ three
+ }
+}
+@end lilypond"
+ (let ((amount (* amount 3.0)))
+ (if (> amount 0)
+ (ly:make-stencil "" (cons -1 1) (cons 0 amount))
+ (ly:make-stencil "" (cons -1 1) (cons amount amount)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; importing graphics.
"Extract the bbox from STRING, or return #f if not present."
(let*
((match (regexp-exec bbox-regexp string)))
-
+
(if match
(map (lambda (x)
(string->number (match:substring match x)))
(cdr (iota 5)))
-
+
#f)))
(define-builtin-markup-command (epsfile layout props axis size file-name)
command string.
@lilypond[verbatim,quote]
-eyeglassesps = #\"
+ringsps = #\"
0.15 setlinewidth
- -0.9 0 translate
- 1.1 1.1 scale
- 1.2 0.7 moveto
- 0.7 0.7 0.5 0 361 arc
- stroke
- 2.20 0.70 0.50 0 361 arc
+ 0.9 0.6 moveto
+ 0.4 0.6 0.5 0 361 arc
stroke
- 1.45 0.85 0.30 0 180 arc
+ 1.0 0.6 0.5 0 361 arc
stroke
- 0.20 0.70 moveto
- 0.80 2.00 lineto
- 0.92 2.26 1.30 2.40 1.15 1.70 curveto
- stroke
- 2.70 0.70 moveto
- 3.30 2.00 lineto
- 3.42 2.26 3.80 2.40 3.65 1.70 curveto
- stroke\"
+ \"
-eyeglasses = \\markup {
- \\with-dimensions #'(0 . 4.4) #'(0 . 2.5)
- \\postscript #eyeglassesps
+rings = \\markup {
+ \\with-dimensions #'(-0.2 . 1.6) #'(0 . 1.2)
+ \\postscript #ringsps
}
\\relative c'' {
- c2^\\eyeglasses
- a2_\\eyeglasses
+ c2^\\rings
+ a2_\\rings
}
@end lilypond"
;; FIXME
(define-builtin-markup-command (score layout props score)
(ly:score?)
music
- ()
+ ((baseline-skip))
"
@cindex inserting music into text
}
}
@end lilypond"
- (let* ((output (ly:score-embedded-format score layout)))
+ (let ((output (ly:score-embedded-format score layout)))
(if (ly:music-output? output)
- (paper-system-stencil
- (vector-ref (ly:paper-score-paper-systems output) 0))
+ (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))))
(join-stencil (interpret-markup layout props tie-str))
)
- (interpret-markup layout
+ (interpret-markup layout
(prepend-alist-chain
'word-space
(/ (interval-length (ly:stencil-extent join-stencil X)) -3.5)
Return a list of paddings."
(cond
((null? text-widths) '())
-
+
;; special case first padding
((= (length text-widths) word-count)
- (cons
+ (cons
(- (- (/ line-width (1- word-count)) (car text-widths))
(/ (car (cdr text-widths)) 2))
(get-fill-space word-count line-width (cdr text-widths))))
(list (- (/ line-width (1- word-count))
(+ (/ (car text-widths) 2) (car (cdr text-widths)))) 0))
(else
- (cons
+ (cons
(- (/ line-width (1- word-count))
(/ (+ (car text-widths) (car (cdr text-widths))) 2))
(get-fill-space word-count line-width (cdr text-widths))))))
stencils))
(text-width (apply + text-widths))
(word-count (length stencils))
- (prop-line-width (chain-assoc-get 'line-width props #f))
(line-width (or line-width (ly:output-def-lookup layout 'line-width)))
(fill-space
(cond
- ((= word-count 1)
+ ((= word-count 1)
(list
(/ (- line-width text-width) 2)
(/ (- line-width text-width) 2)))
((= word-count 2)
(list
(- line-width text-width)))
- (else
+ (else
(get-fill-space word-count line-width text-widths))))
(fill-space-normal
(map (lambda (x)
word-space
x))
fill-space))
-
+
(line-stencils (if (= word-count 1)
(list
point-stencil
empty-stencil
(stack-stencils-padding-list X
RIGHT fill-space-normal line-stencils))))
-
+
(define-builtin-markup-command (line layout props args)
(markup-list?)
align
(define (wordwrap-stencils stencils
justify base-space line-width text-dir)
- "Perform simple wordwrap, return stencil of each line."
+ "Perform simple wordwrap, return stencil of each line."
(define space (if justify
;; justify only stretches lines.
(* 0.7 base-space)
line-stencils))))
(line-word-space (cond ((not justify) space)
;; don't stretch last line of paragraph.
- ;; hmmm . bug - will overstretch the last line in some case.
+ ;; hmmm . bug - will overstretch the last line in some case.
((null? (cdr line-break))
base-space)
((null? line-stencils) 0.0)
((baseline-skip)
wordwrap-string-internal-markup-list)
"Wordwrap a string. Paragraphs may be separated with double newlines.
-
+
@lilypond[verbatim,quote]
\\markup {
\\override #'(line-width . 40)
((baseline-skip)
wordwrap-string-internal-markup-list)
"Justify a string. Paragraphs may be separated with double newlines
-
+
@lilypond[verbatim,quote]
\\markup {
\\override #'(line-width . 40)
align
()
"Wordwrap the data which has been assigned to @var{symbol}.
-
+
@lilypond[verbatim,quote]
\\header {
title = \"My title\"
- description = \"Lorem ipsum dolor sit amet, consectetur adipisicing
+ myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
elit, sed do eiusmod tempor incididunt ut labore et dolore magna
aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco
laboris nisi ut aliquip ex ea commodo consequat.\"
\\column {
\\fill-line { \\fromproperty #'header:title }
\\null
- \\wordwrap-field #'header:descr
+ \\wordwrap-field #'header:myText
}
}
}
align
()
"Justify the data which has been assigned to @var{symbol}.
-
+
@lilypond[verbatim,quote]
\\header {
title = \"My title\"
- description = \"Lorem ipsum dolor sit amet, consectetur adipisicing
+ myText = \"Lorem ipsum dolor sit amet, consectetur adipisicing
elit, sed do eiusmod tempor incididunt ut labore et dolore magna
aliqua. Ut enim ad minim veniam, quis nostrud exercitation ullamco
laboris nisi ut aliquip ex ea commodo consequat.\"
\\column {
\\fill-line { \\fromproperty #'header:title }
\\null
- \\justify-field #'header:description
+ \\justify-field #'header:myText
}
}
}
;;
;; TODO: should extract baseline-skip from each argument somehow..
-;;
+;;
(define-builtin-markup-command (column layout props args)
(markup-list?)
align
(define (general-column align-dir baseline mols)
"Stack @var{mols} vertically, aligned to @var{align-dir} horizontally."
-
+
(let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols)))
(stack-lines -1 0.0 baseline aligned-mols)))
align
((baseline-skip))
"
-@cindex text columns, left-aligned
+@cindex text columns, left-aligned
Put @code{args} in a left-aligned column.
"
@cindex setting extent of text objects
-Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
+Set the dimensions of @var{arg} to @var{x} and@tie{}@var{y}."
(let* ((m (interpret-markup layout props arg)))
(ly:make-stencil (ly:stencil-expr m) x y)))
align
()
"Add padding @var{amount} all around @var{arg}.
-
+
@lilypond[verbatim,quote]
\\markup {
\\box {
other
()
"Make @var{arg} transparent.
-
+
@lilypond[verbatim,quote]
\\markup {
\\transparent {
font
()
"Decrease the font size relative to the current setting.
-
+
@lilypond[verbatim,quote]
\\markup {
\\fontsize #3.5 {
}
@end lilypond"
(interpret-markup
- layout
+ layout
(prepend-alist-chain 'font-size (magnification->font-size sz) props)
arg))
font
()
"Switch to bold font-series.
-
+
@lilypond[verbatim,quote]
\\markup {
default
font
()
"Switch to the sans serif font family.
-
+
@lilypond[verbatim,quote]
\\markup {
default
font
()
"Set font family to @code{roman}.
-
+
@lilypond[verbatim,quote]
\\markup {
\\sans \\bold {
font
()
"Set font size to default.
-
+
@lilypond[verbatim,quote]
\\markup {
\\teeny {
font
()
"Set font size to -1.
-
+
@lilypond[verbatim,quote]
\\markup {
default
font
()
"Set font size to -2.
-
+
@lilypond[verbatim,quote]
\\markup {
default
font
()
"Set font size to -3.
-
+
@lilypond[verbatim,quote]
\\markup {
default
font
()
"Set @code{font-shape} to @code{caps}
-
+
Note: @code{\\fontCaps} requires the installation and selection of
fonts which support the @code{caps} font shape."
(interpret-markup layout (prepend-alist-chain 'font-shape 'caps props) arg))
font
()
"Use a text font instead of music symbol or music alphabet font.
-
+
@lilypond[verbatim,quote]
\\markup {
\\number {
font
()
"Use @code{font-family} typewriter for @var{arg}.
-
+
@lilypond[verbatim,quote]
\\markup {
default
\\sesquisharp
}
@end lilypond"
- (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
+ (interpret-markup layout props (markup #:musicglyph (assoc-get 3/4 standard-alteration-glyph-name-alist ""))))
(define-builtin-markup-command (sharp layout props)
()
(ly:make-stencil (list 'color color (ly:stencil-expr stil))
(ly:stencil-extent stil X)
(ly:stencil-extent stil Y))))
-\f
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; glyphs
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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))
other
()
"Lookup a glyph by name.
-
+
@lilypond[verbatim,quote]
\\markup {
\\override #'(font-encoding . fetaBraces) {
(define (number->markletter-string vec n)
"Double letters for big marks."
(let* ((lst (vector-length vec)))
-
+
(if (>= n lst)
(string-append (number->markletter-string vec (1- (quotient n lst)))
(number->markletter-string vec (remainder n lst)))
(num-y (interval-widen (cons center center) (abs dy)))
(is-sane (and (interval-sane? num-x) (interval-sane? num-y)))
(slash-stencil (if is-sane
- (make-line-stencil thickness
+ (make-line-stencil thickness
(car num-x) (- (interval-center num-y) dy)
(cdr num-x) (+ (interval-center num-y) dy))
#f)))
@end lilypond"
(slashed-digit-internal layout props num #f font-size thickness))
+;; eyeglasses
+(define eyeglassesps
+ "0.15 setlinewidth
+ -0.9 0 translate
+ 1.1 1.1 scale
+ 1.2 0.7 moveto
+ 0.7 0.7 0.5 0 361 arc
+ stroke
+ 2.20 0.70 0.50 0 361 arc
+ stroke
+ 1.45 0.85 0.30 0 180 arc
+ stroke
+ 0.20 0.70 moveto
+ 0.80 2.00 lineto
+ 0.92 2.26 1.30 2.40 1.15 1.70 curveto
+ stroke
+ 2.70 0.70 moveto
+ 3.30 2.00 lineto
+ 3.42 2.26 3.80 2.40 3.65 1.70 curveto
+ stroke")
+
+(define-builtin-markup-command (eyeglasses layout props) () other ()
+ "Prints out eyeglasses, indicating strongly to look at the conductor.
+@lilypond[verbatim,quote]
+\\markup { \\eyeglasses }
+@end lilypond"
+ (interpret-markup layout props
+ (make-with-dimensions-markup '(-0.61 . 3.22) '(0.2 . 2.41)
+ (make-postscript-markup eyeglassesps))))
+
+(define-builtin-markup-command (left-brace layout props size)
+ (number?)
+ other
+ ()
+ "
+A feta brace in point size @var{size}.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\left-brace #35
+ \\hspace #2
+ \\left-brace #45
+}
+@end lilypond"
+ (let* ((font (ly:paper-get-font layout
+ (cons '((font-encoding . fetaBraces)
+ (font-name . #f))
+ props)))
+ (glyph-count (1- (ly:otf-glyph-count font)))
+ (scale (ly:output-def-lookup layout 'output-scale))
+ (scaled-size (/ (ly:pt size) scale))
+ (glyph (lambda (n)
+ (ly:font-get-glyph font (string-append "brace"
+ (number->string n)))))
+ (get-y-from-brace (lambda (brace)
+ (interval-length
+ (ly:stencil-extent (glyph brace) Y))))
+ (find-brace (binary-search 0 glyph-count get-y-from-brace scaled-size))
+ (glyph-found (glyph find-brace)))
+
+ (if (or (null? (ly:stencil-expr glyph-found))
+ (< scaled-size (interval-length (ly:stencil-extent (glyph 0) Y)))
+ (> scaled-size (interval-length
+ (ly:stencil-extent (glyph glyph-count) Y))))
+ (begin
+ (ly:warning (_ "no brace found for point size ~S ") size)
+ (ly:warning (_ "defaulting to ~S pt")
+ (/ (* scale (interval-length
+ (ly:stencil-extent glyph-found Y)))
+ (ly:pt 1)))))
+ glyph-found))
+
+(define-builtin-markup-command (right-brace layout props size)
+ (number?)
+ other
+ ()
+ "
+A feta brace in point size @var{size}, rotated 180 degrees.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\right-brace #45
+ \\hspace #2
+ \\right-brace #35
+}
+@end lilypond"
+ (interpret-markup layout props (markup #:rotate 180 #:left-brace size)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; the note command.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
"")))
(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))))
-
+
(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))))
(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)
stem-glyph)))
stem-glyph))
-(define-public log2
+(define-public log2
(let ((divisor (log 2)))
(lambda (z) (inexact->exact (/ (log z) divisor)))))
()
"
@cindex raising text
-
+
Raise @var{arg} by the distance @var{amount}.
A negative @var{amount} indicates lowering, see also @code{\\lower}.
font
((font-size 0)
(baseline-skip))
- "
+ "
@cindex superscript text
Set @var{arg} in superscript.
()
"
@cindex translating text
-
+
Translate @var{arg} relative to its surroundings. @var{offset}
is a pair of numbers representing the displacement in the X and Y axis.
(interpret-markup layout props arg)
(* -0.5 baseline-skip)
Y))
-\f
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; brackets.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
()
"
@cindex placing horizontal brackets around text
-
+
Draw horizontal brackets around @var{arg}.
@lilypond[verbatim,quote]
()
"
@cindex placing vertical brackets around text
-
+
Draw vertical brackets around @var{arg}.
@lilypond[verbatim,quote]
(let ((th 0.1) ;; todo: take from GROB.
(m (interpret-markup layout props arg)))
(bracketify-stencil m Y th (* 2.5 th) th)))
-\f
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Delayed markup evaluation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
`(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-number (if (list? table)
+ (assoc-get label table)
+ #f))
(page-markup (if page-number (format "~a" page-number) default))
(page-stencil (interpret-markup layout props page-markup))
(gap (- (interval-length x-ext)
(markup #:concat (#:hspace gap page-markup)))))))
x-ext
y-ext)))
-\f
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Markup list commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
((baseline-skip))
"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)
+ (space-lines baseline-skip
(interpret-markup-list layout props args)))
(define-builtin-markup-list-command (override-lines layout props new-prop args)
projects / lilypond.git / blobdiff