;;;; 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
;;; functions that take a markup as their last argument.
;;;
;;; args-signature
-;;; the arguments signature, i.e. a list of type predicates which
+;;; 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.
;;;
;;; category
;;; for documentation purpose, builtin markup commands are grouped by
-;;; category. This can be any symbol. When documentation is generated,
+;;; 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
+;;; 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
+;;; 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
+;;; to the given default value. When no default value is given, #f is
;;; used instead.
;;; Thus, using the following property bindings:
;;; ((thickness 0.1)
;;; ..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
+;;; 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.
+;;; 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.
(y (cdr dest)))
(make-line-stencil th 0 0 x y)))
+(define-markup-command (draw-hline layout props)
+ ()
+ #:category graphic
+ #:properties ((draw-line-markup)
+ (line-width)
+ (span-factor 1))
+ "
+@cindex drawing a line across a page
+
+Draws a line across a page, where the property @code{span-factor}
+controls what fraction of the page is taken up.
+@lilypond[verbatim,quote]
+\\markup {
+ \\column {
+ \\draw-hline
+ \\override #'(span-factor . 1/3)
+ \\draw-hline
+ }
+}
+@end lilypond"
+ (interpret-markup layout
+ props
+ (markup #:draw-line (cons (* line-width
+ span-factor)
+ 0))))
+
(define-markup-command (draw-circle layout props radius thickness filled)
(number? number? boolean?)
#:category graphic
(ly:stencil-add (ly:make-stencil url-expr xextent yextent) stil)))
+(define-markup-command (page-link layout props page-number arg)
+ (number? markup?)
+ #:category other
+ "
+@cindex referencing page numbers in text
+
+Add a link to the page @var{page-number} around @var{arg}. This only works
+in the PDF backend.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\page-link #2 { \\italic { This links to page 2... } }
+}
+@end lilypond"
+ (let* ((stil (interpret-markup layout props arg))
+ (xextent (ly:stencil-extent stil X))
+ (yextent (ly:stencil-extent stil Y))
+ (old-expr (ly:stencil-expr stil))
+ (link-expr (list 'page-link page-number `(quote ,xextent) `(quote ,yextent))))
+
+ (ly:stencil-add (ly:make-stencil link-expr xextent yextent) stil)))
+
+(define-markup-command (with-link layout props label arg)
+ (symbol? markup?)
+ #:category other
+ "
+@cindex referencing page labels in text
+
+Add a link to the page holding label @var{label} around @var{arg}. This
+only works in the PDF backend.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\with-link #\"label\" {
+ \\italic { This links to the page containing the label... }
+ }
+}
+@end lilypond"
+ (let* ((arg-stencil (interpret-markup layout props arg))
+ (x-ext (ly:stencil-extent arg-stencil X))
+ (y-ext (ly:stencil-extent arg-stencil Y)))
+ (ly:make-stencil
+ `(delay-stencil-evaluation
+ ,(delay (ly:stencil-expr
+ (let* ((table (ly:output-def-lookup layout 'label-page-table))
+ (page-number (if (list? table)
+ (assoc-get label table)
+ #f))
+ (link-expr (list 'page-link page-number
+ `(quote ,x-ext) `(quote ,y-ext))))
+ (ly:stencil-add (ly:make-stencil link-expr x-ext y-ext)
+arg-stencil)))))
+ x-ext
+ y-ext)))
+
+
(define-markup-command (beam layout props width slope thickness)
(number? number? number?)
#:category graphic
;; FIXME
(ly:make-stencil
(list 'embedded-ps
- (format "
+ (format #f "
gsave currentpoint translate
0.1 setlinewidth
~a
indent = 0.0\\cm
\\context {
\\Score
- \\override RehearsalMark #'break-align-symbols =
- #'(time-signature key-signature)
- \\override RehearsalMark #'self-alignment-X = #LEFT
+ \\override RehearsalMark
+ #'break-align-symbols = #'(time-signature key-signature)
+ \\override RehearsalMark
+ #'self-alignment-X = #LEFT
}
\\context {
\\Staff
- \\override TimeSignature #'break-align-anchor-alignment = #LEFT
+ \\override TimeSignature
+ #'break-align-anchor-alignment = #LEFT
}
}
}
(define-markup-command (tied-lyric layout props str)
(string?)
#:category music
+ #:properties ((word-space))
"
@cindex simple text strings with tie characters
@end lilypond"
(if (string-contains str "~")
(let*
- ((parts (string-split str #\~))
- (tie-str (ly:wide-char->utf-8 #x203f))
+ ((half-space (/ word-space 2))
+ (parts (string-split str #\~))
+ (tie-str (markup #:hspace half-space
+ #:musicglyph "ties.lyric"
+ #:hspace half-space))
(joined (list-join parts tie-str))
(join-stencil (interpret-markup layout props tie-str))
)
(interpret-markup layout
- (prepend-alist-chain
- 'word-space
- (/ (interval-length (ly:stencil-extent join-stencil X)) -3.5)
- props)
- (make-line-markup joined)))
- ;(map (lambda (s) (interpret-markup layout props s)) parts))
+ props
+ (make-concat-markup joined)))
(interpret-markup layout props str)))
(define-public empty-markup
\\header {
title = \"My title\"
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.\"
+ 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.\"
}
\\paper {
(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)))
+ (let* ((aligned-mols (map (lambda (x) (ly:stencil-aligned-to x X align-dir)) mols))
+ (stacked-stencil (stack-lines -1 0.0 baseline aligned-mols))
+ (stacked-extent (ly:stencil-extent stacked-stencil X)))
+ (ly:stencil-translate-axis stacked-stencil (- (car stacked-extent)) X )))
(define-markup-command (center-column layout props args)
(markup-list?)
(list markup?))
(interpret-markup layout props (list anonymous-with-signature arg))))
+(define-markup-command (footnote layout props mkup note)
+ (markup? markup?)
+ #:category other
+ #:properties ((raise 0.5)
+ (padding 0.0))
+ "Have footnote @var{note} act as an annotation to the markup @var{mkup}.
+
+@lilypond[verbatim,quote]
+\\markup {
+ \\footnote a b
+ \\override #'(padding . 0.2)
+ \\footnote c d
+}
+@end lilypond"
+ (let* ((markup-stencil (interpret-markup layout props mkup))
+ (auto-numbering (ly:output-def-lookup layout
+ 'footnote-auto-numbering))
+ (footnote-hash (gensym "footnote"))
+ (stencil-seed 0)
+ (gauge-stencil (if auto-numbering
+ (interpret-markup
+ layout
+ props
+ ((ly:output-def-lookup
+ layout
+ 'footnote-numbering-function)
+ stencil-seed))
+ empty-stencil))
+ (x-ext (if auto-numbering
+ (ly:stencil-extent gauge-stencil X)
+ '(0 . 0)))
+ (y-ext (if auto-numbering
+ (ly:stencil-extent gauge-stencil Y)
+ '(0 . 0)))
+ (footnote-number
+ (if auto-numbering
+ `(delay-stencil-evaluation
+ ,(delay
+ (ly:stencil-expr
+ (let* ((table
+ (ly:output-def-lookup layout
+ 'number-footnote-table))
+ (footnote-stencil (if (list? table)
+ (assoc-get footnote-hash
+ table)
+ empty-stencil))
+ (footnote-stencil (if (ly:stencil? footnote-stencil)
+ footnote-stencil
+ (begin
+ (ly:programming-error
+"Cannot find correct footnote for a markup object.")
+ empty-stencil)))
+ (gap (- (interval-length x-ext)
+ (interval-length
+ (ly:stencil-extent footnote-stencil X))))
+ (y-trans (- (+ (cdr y-ext)
+ raise)
+ (cdr (ly:stencil-extent footnote-stencil
+ Y)))))
+ (ly:stencil-translate footnote-stencil
+ (cons gap y-trans))))))
+ '()))
+ (main-stencil (ly:stencil-combine-at-edge
+ markup-stencil
+ X
+ RIGHT
+ (ly:make-stencil footnote-number x-ext y-ext)
+ padding)))
+ (ly:stencil-add
+ main-stencil
+ (ly:make-stencil
+ `(footnote ,footnote-hash ,(interpret-markup layout props note))
+ '(0 . 0)
+ '(0 . 0)))))
+
(define-markup-command (override layout props new-prop arg)
(pair? markup?)
#:category other
@lilypond[verbatim,quote]
\\markup {
\\huge \\bold \\sans \\caps {
- Some text with font overrides
+ huge bold sans caps
\\hspace #2
\\normal-text {
- Default text, same font-size
+ huge normal
}
\\hspace #2
- More text as before
+ as before
}
}
@end lilypond"
;; 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
}
@end lilypond"
(let*
- ((name (format "arrowheads.~a.~a~a"
+ ((name (format #f "arrowheads.~a.~a~a"
(if filled
"close"
"open")
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
@end lilypond"
(define (get-glyph-name-candidates dir log style)
(map (lambda (dir-name)
- (format "noteheads.~a~a" dir-name
+ (format #f "noteheads.~a~a" dir-name
(if (and (symbol? style)
(not (equal? 'default style)))
(select-head-glyph style (min log 2))
(parenthesize-stencil
markup half-thickness scaled-width angularity padding)))
-\f
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Delayed markup evaluation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
"
@cindex referencing page numbers in text
-Reference to a page number. @var{label} is the label set on the referenced
+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."
(page-number (if (list? table)
(assoc-get label table)
#f))
- (page-markup (if page-number (format "~a" page-number) default))
+ (page-markup (if page-number (format #f "~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)))))
(sy (cdr factor-pair)))
(ly:stencil-scale stil sx sy)))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Repeating
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-markup-command (pattern layout props count axis space pattern)
+ (integer? integer? number? markup?)
+ #:category other
+ "
+Prints @var{count} times a @var{pattern} markup.
+Patterns are spaced apart by @var{space}.
+Patterns are distributed on @var{axis}.
+
+@lilypond[verbatim, quote]
+\\markup \\column {
+ \"Horizontally repeated :\"
+ \\pattern #7 #X #2 \\flat
+ \\null
+ \"Vertically repeated :\"
+ \\pattern #3 #Y #0.5 \\flat
+}
+@end lilypond"
+ (let ((pattern-width (interval-length
+ (ly:stencil-extent (interpret-markup layout props pattern) X)))
+ (new-props (prepend-alist-chain 'word-space 0 (prepend-alist-chain 'baseline-skip 0 props))))
+ (let loop ((i (1- count)) (patterns (markup)))
+ (if (zero? i)
+ (interpret-markup
+ layout
+ new-props
+ (if (= axis X)
+ (markup patterns pattern)
+ (markup #:column (patterns pattern))))
+ (loop (1- i)
+ (if (= axis X)
+ (markup patterns pattern #:hspace space)
+ (markup #:column (patterns pattern #:vspace space))))))))
+
+(define-markup-command (fill-with-pattern layout props space dir pattern left right)
+ (number? ly:dir? markup? markup? markup?)
+ #:category align
+ #:properties ((word-space)
+ (line-width))
+ "
+Put @var{left} and @var{right} in a horizontal line of width @code{line-width}
+with a line of markups @var{pattern} in between.
+Patterns are spaced apart by @var{space}.
+Patterns are aligned to the @var{dir} markup.
+
+@lilypond[verbatim, quote]
+\\markup \\column {
+ \"right-aligned :\"
+ \\fill-with-pattern #1 #RIGHT . first right
+ \\fill-with-pattern #1 #RIGHT . second right
+ \\null
+ \"center-aligned :\"
+ \\fill-with-pattern #1.5 #CENTER - left right
+ \\null
+ \"left-aligned :\"
+ \\override #'(line-width . 50)
+ \\fill-with-pattern #2 #LEFT : left first
+ \\override #'(line-width . 50)
+ \\fill-with-pattern #2 #LEFT : left second
+}
+@end lilypond"
+ (let* ((pattern-x-extent (ly:stencil-extent (interpret-markup layout props pattern) X))
+ (pattern-width (interval-length pattern-x-extent))
+ (left-width (interval-length (ly:stencil-extent (interpret-markup layout props left) X)))
+ (right-width (interval-length (ly:stencil-extent (interpret-markup layout props right) X)))
+ (middle-width (max 0 (- line-width (+ (+ left-width right-width) (* word-space 2)))))
+ (period (+ space pattern-width))
+ (count (truncate (/ (- middle-width pattern-width) period)))
+ (x-offset (+ (* (- (- middle-width (* count period)) pattern-width) (/ (1+ dir) 2)) (abs (car pattern-x-extent)))))
+ (interpret-markup layout props
+ (markup left
+ #:with-dimensions (cons 0 middle-width) '(0 . 0)
+ #:translate (cons x-offset 0)
+ #:pattern (1+ count) X space pattern
+ right))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Markup list commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
projects / lilypond.git / blobdiff