;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2000--2012 Han-Wen Nienhuys <hanwen@xs4all.nl>
+;;;; Copyright (C) 2000--2014 Han-Wen Nienhuys <hanwen@xs4all.nl>
;;;; Jan Nieuwenhuizen <janneke@gnu.org>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
"
@cindex paths, drawing
@cindex drawing paths
-Draws a path with line thickness @var{thickness} according to the
+Draws a path with line @var{thickness} according to the
directions given in @var{commands}. @var{commands} is a list of
lists where the @code{car} of each sublist is a drawing command and
the @code{cdr} comprises the associated arguments for each command.
-Line-cap styles and line-join styles may be customized by
-overriding the @code{line-cap-style} and @code{line-join-style}
-properties, respectively. Available line-cap styles are
-@code{'butt}, @code{'round}, and @code{'square}. Available
-line-join styles are @code{'miter}, @code{'round}, and
-@code{'bevel}.
-
-The property @code{filled} specifies whether or not the path is
-filled with color.
-
There are seven commands available to use in the list
@code{commands}: @code{moveto}, @code{rmoveto}, @code{lineto},
@code{rlineto}, @code{curveto}, @code{rcurveto}, and
Note that a sequence of commands @emph{must} begin with a
@code{moveto} or @code{rmoveto} to work with the SVG output.
+Line-cap styles and line-join styles may be customized by
+overriding the @code{line-cap-style} and @code{line-join-style}
+properties, respectively. Available line-cap styles are
+@code{'butt}, @code{'round}, and @code{'square}. Available
+line-join styles are @code{'miter}, @code{'round}, and
+@code{'bevel}.
+
+The property @code{filled} specifies whether or not the path is
+filled with color.
+
@lilypond[verbatim,quote]
samplePath =
#'((moveto 0 0)
\\markup {
\\path #0.25 #samplePath
+
+ \\override #'(line-join-style . miter) \\path #0.25 #samplePath
+
+ \\override #'(filled . #t) \\path #0.25 #samplePath
}
@end lilypond"
(let* ((half-thickness (/ thickness 2))
(define-markup-list-command (score-lines layout props score)
(ly:score?)
- "
-This is the same as the @code{\\score} markup but delivers its
-systems as a list of lines. This is not usually called directly by
-the user. Instead, it is called when the parser encounters
-@code{\\score} in a context where only markup lists are allowed. When
-used as the argument of a toplevel @code{\\markuplist}, the result can
-be split across pages."
+ "This is the same as the @code{\\score} markup but delivers its
+systems as a list of lines. Its @var{score} argument is entered in
+braces like it would be for @code{\\score}."
(let ((output (ly:score-embedded-format score layout)))
(if (ly:music-output? output)
(make-simple-markup ""))
;; helper for justifying lines.
-(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.
- All paddings are checked to be at least word-space, to ensure that
- no texts collide.
- Return a list of paddings."
+(define (get-fill-space
+ word-count line-width word-space text-widths constant-space?)
+ "Calculate the necessary paddings between adjacent texts in a
+single justified line. The lengths of all texts are stored in
+@var{text-widths}.
+When @var{constant-space?} is @code{#t}, the formula for the padding
+between texts is:
+padding = (line-width - total-text-width)/(word-count - 1)
+When @var{constant-space?} is @code{#f}, the formula for the
+padding between interior texts a and b is:
+padding = line-width/(word-count - 1) - (length(a) + length(b))/2
+In this case, 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) '())
-
- ;; special case first padding
- ((= (length text-widths) word-count)
- (cons
- (- (- (/ line-width (1- word-count)) (car text-widths))
- (/ (car (cdr text-widths)) 2))
- (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
- (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)))))))
+ ((null? text-widths) '())
+ (constant-space?
+ (make-list
+ (1- word-count)
+ ;; Ensure that space between words cannot be
+ ;; less than word-space.
+ (max
+ word-space
+ (/ (- line-width (apply + text-widths))
+ (1- word-count)))))
+
+ ;; special case first padding
+ ((= (length text-widths) word-count)
+ (cons
+ (- (- (/ line-width (1- word-count)) (car text-widths))
+ (/ (cadr text-widths) 2))
+ (get-fill-space
+ word-count line-width word-space (cdr text-widths)
+ constant-space?)))
+ ;; special case last padding
+ ((= (length text-widths) 2)
+ (list (- (/ line-width (1- word-count))
+ (+ (/ (car text-widths) 2) (cadr text-widths)))
+ 0))
+ (else
+ (let ((default-padding
+ (- (/ line-width (1- word-count))
+ (/ (+ (car text-widths) (cadr 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)
+ constant-space?))))))
+
+(define (justify-line-helper
+ layout props args text-direction word-space line-width constant-space?)
+ "Return a stencil which spreads @var{args} along a line of width
+@var{line-width}. If @var{constant-space?} is set to @code{#t}, the
+space between words is constant. If @code{#f}, the distance between
+words varies according to their relative lengths."
+ (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 word-space text-widths
+ constant-space?))))
+ (line-contents (if (= word-count 1)
+ (list
+ point-stencil
+ (car stencils)
+ point-stencil)
+ stencils)))
+
+ (if (null? (remove ly:stencil-empty? orig-stencils))
+ 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 (fill-line layout props args)
(markup-list?)
}
}
@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 word-space text-widths))))
+ (justify-line-helper
+ layout props args text-direction word-space line-width #f))
- (line-contents (if (= word-count 1)
- (list
- point-stencil
- (car stencils)
- point-stencil)
- stencils)))
+(define-markup-command (justify-line layout props args)
+ (markup-list?)
+ #:category align
+ #:properties ((text-direction RIGHT)
+ (word-space 0.6)
+ (line-width #f))
+ "Put @var{markups} in a horizontal line of width @var{line-width}.
+The markups are spread to fill the entire line and separated by equal
+space. If there are no arguments, return an empty stencil.
- (if (null? (remove ly:stencil-empty? orig-stencils))
- 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))))
+@lilypond[verbatim,quote]
+\\markup {
+ \\justify-line {
+ Space between neighboring words is constant
+ }
+}
+@end lilypond"
+ (justify-line-helper
+ layout props args text-direction word-space line-width #t))
(define-markup-command (line layout props args)
(markup-list?)
"Perform simple wordwrap, return stencil of each line."
(define space (if justify
;; justify only stretches lines.
- (* 0.7 base-space)
- base-space))
- (define (stencil-space stencil line-start)
- (if (ly:stencil-empty? stencil X)
- 0
- (cdr (ly:stencil-extent
- (ly:stencil-stack (if line-start
- empty-stencil
- point-stencil)
- X RIGHT stencil)
- X))))
- (define (take-list width space stencils
- accumulator accumulated-width)
- "Return (head-list . tail) pair, with head-list fitting into width"
- (if (null? stencils)
- (cons accumulator stencils)
- (let* ((first (car stencils))
- (first-wid (stencil-space first (null? accumulator)))
- (newwid (+ (if (or (ly:stencil-empty? first Y)
- (ly:stencil-empty? first X))
- 0 space)
- first-wid accumulated-width)))
- (if (or (null? accumulator)
- (< newwid width))
- (take-list width space
- (cdr stencils)
- (cons first accumulator)
- newwid)
- (cons accumulator stencils)))))
- (let loop ((lines '())
- (todo stencils))
- (let* ((line-break (take-list line-width space todo
- '() 0.0))
- (line-stencils (car line-break))
- (space-left (- line-width
- (stencil-space
- (stack-stencil-line 0 line-stencils)
- #t)))
- (line-words (count (lambda (s) (not (or (ly:stencil-empty? s Y)
- (ly:stencil-empty? s X))))
- 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.
- ((null? (cdr line-break))
- base-space)
- ((< line-words 2) space)
- (else (/ space-left (1- line-words)))))
- (line (stack-stencil-line line-word-space
- (if (= text-dir RIGHT)
- (reverse line-stencils)
- line-stencils))))
- (if (pair? (cdr line-break))
- (loop (cons line lines)
- (cdr line-break))
- (begin
- (if (= text-dir LEFT)
- (set! line
- (ly:stencil-translate-axis
- line
- (- line-width (interval-end (ly:stencil-extent line X)))
- X)))
- (reverse (cons line lines)))))))
+ (* 0.7 base-space)
+ base-space))
+ (define (stencil-len s)
+ (interval-end (ly:stencil-extent s X)))
+ (define (maybe-shift line)
+ (if (= text-dir LEFT)
+ (ly:stencil-translate-axis
+ line
+ (- line-width (stencil-len line))
+ X)
+ line))
+ (if (null? stencils)
+ '()
+ (let loop ((lines '())
+ (todo stencils))
+ (let word-loop
+ ((line (first todo))
+ (todo (cdr todo))
+ (word-list (list (first todo))))
+ (cond
+ ((pair? todo)
+ (let ((new (if (= text-dir LEFT)
+ (ly:stencil-stack (car todo) X RIGHT line space)
+ (ly:stencil-stack line X RIGHT (car todo) space))))
+ (cond
+ ((<= (stencil-len new) line-width)
+ (word-loop new (cdr todo)
+ (cons (car todo) word-list)))
+ (justify
+ (let* ((word-list
+ ;; This depends on stencil stacking being
+ ;; associative so that stacking
+ ;; left-to-right and right-to-left leads to
+ ;; the same result
+ (if (= text-dir LEFT)
+ word-list
+ (reverse! word-list)))
+ (len (stencil-len line))
+ (stretch (- line-width len))
+ (spaces
+ (- (stencil-len
+ (stack-stencils X RIGHT (1+ space) word-list))
+ len)))
+ (if (zero? spaces)
+ ;; Uh oh, nothing to fill.
+ (loop (cons (maybe-shift line) lines) todo)
+ (loop (cons
+ (stack-stencils X RIGHT
+ (+ space (/ stretch spaces))
+ word-list)
+ lines)
+ todo))))
+ (else ;; not justify
+ (loop (cons (maybe-shift line) lines) todo)))))
+ ;; todo is null
+ (justify
+ ;; Now we have the last line assembled with space
+ ;; which is compressed. We want to use the
+ ;; uncompressed version instead if it fits, and the
+ ;; justified version if it doesn't.
+ (let* ((word-list
+ ;; This depends on stencil stacking being
+ ;; associative so that stacking
+ ;; left-to-right and right-to-left leads to
+ ;; the same result
+ (if (= text-dir LEFT)
+ word-list
+ (reverse! word-list)))
+ (big-line (stack-stencils X RIGHT base-space word-list))
+ (big-len (stencil-len big-line))
+ (len (stencil-len line)))
+ (reverse! lines
+ (list
+ (if (> big-len line-width)
+ (stack-stencils X RIGHT
+ (/
+ (+
+ (* (- big-len line-width)
+ space)
+ (* (- line-width len)
+ base-space))
+ (- big-len len))
+ word-list)
+ (maybe-shift big-line))))))
+ (else ;; not justify
+ (reverse! lines (list (maybe-shift line)))))))))
+
(define-markup-list-command (wordwrap-internal layout props justify args)
(boolean? markup-list?)
Construct a note symbol, with stem and flag. By using fractional values for
@var{dir}, longer or shorter stems can be obtained.
Supports all note-head-styles.
-Supported flag-styles are @code{default}, @code{old-straight-flag} and
-@code{modern-straight-flag}.
+Supported flag-styles are @code{default}, @code{old-straight-flag},
+@code{modern-straight-flag} and @code{flat-flag}.
@lilypond[verbatim,quote]
\\markup {
(raw-length (if stem-up upflag-length downflag-length))
(angle (if stem-up upflag-angle downflag-angle))
(flag-length (+ (* raw-length factor) half-stem-thickness))
- (flag-end (polar->rectangular flag-length angle))
+ (flag-end (if (= angle 0)
+ (cons flag-length (* half-stem-thickness dir))
+ (polar->rectangular flag-length angle)))
(thickness (* flag-thickness factor))
(thickness-offset (cons 0 (* -1 thickness dir)))
(spacing (* -1 flag-spacing factor dir))
;; The points of a round-filled-polygon need to be given in
;; clockwise order, otherwise the polygon will be enlarged by
;; blot-size*2!
- (points (if stem-up (list start flag-end
- (offset-add flag-end thickness-offset)
- (offset-add start thickness-offset))
+ (points (if stem-up
+ (list start
+ flag-end
+ (offset-add flag-end thickness-offset)
+ (offset-add start thickness-offset))
(list start
(offset-add start thickness-offset)
(offset-add flag-end thickness-offset)
;; Straight-flags. Values taken from /scm/flag-style.scm
(modern-straight-flag (straight-flag-mrkp 0.55 1 -18 1.1 22 1.2 dir))
(old-straight-flag (straight-flag-mrkp 0.55 1 -45 1.2 45 1.4 dir))
+ (flat-flag (straight-flag-mrkp 0.55 1.0 0 1.0 0 1.0 dir))
;; Calculate a corrective to avoid a gap between
;; straight-flags and the stem.
(flag-style-Y-corr (if (or (eq? flag-style 'modern-straight-flag)
- (eq? flag-style 'old-straight-flag))
+ (eq? flag-style 'old-straight-flag)
+ (eq? flag-style 'flat-flag))
(/ blot 10 (* -1 dir))
0))
(flaggl (and (> log 2)
modern-straight-flag)
((eq? flag-style 'old-straight-flag)
old-straight-flag)
+ ((eq? flag-style 'flat-flag)
+ flat-flag)
(else
(ly:font-get-glyph font
(format #f (if ancient-flags?
@code{\\fermata} articulation instead of a markup.
@lilypond[verbatim,quote]
- { c1^\\markup \\fermata d1_\\markup \\fermata }
+ { c''1^\\markup \\fermata d''1_\\markup \\fermata }
\\markup { \\fermata \\override #`(direction . ,DOWN) \\fermata }
@end lilypond
(define-markup-command (normal-size-super layout props arg)
(markup?)
#:category font
- #:properties ((baseline-skip))
+ #:properties ((font-size 0))
"
@cindex setting superscript in standard font size
@end lilypond"
(ly:stencil-translate-axis
(interpret-markup layout props arg)
- (* 0.5 baseline-skip) Y))
+ (* 1.0 (magstep font-size)) Y))
(define-markup-command (super layout props arg)
(markup?)
#:category font
- #:properties ((font-size 0)
- (baseline-skip))
+ #:properties ((font-size 0))
"
@cindex superscript text
layout
(cons `((font-size . ,(- font-size 3))) props)
arg)
- (* 0.5 baseline-skip)
+ (* 1.0 (magstep font-size)) ; original font-size
Y))
(define-markup-command (translate layout props offset arg)
(define-markup-command (sub layout props arg)
(markup?)
#:category font
- #:properties ((font-size 0)
- (baseline-skip))
+ #:properties ((font-size 0))
"
@cindex subscript text
layout
(cons `((font-size . ,(- font-size 3))) props)
arg)
- (* -0.5 baseline-skip)
+ (* -0.75 (magstep font-size)) ; original font-size
Y))
(define-markup-command (normal-size-sub layout props arg)
(markup?)
#:category font
- #:properties ((baseline-skip))
+ #:properties ((font-size 0))
"
@cindex setting subscript in standard font size
@end lilypond"
(ly:stencil-translate-axis
(interpret-markup layout props arg)
- (* -0.5 baseline-skip)
+ (* -0.75 (magstep font-size))
Y))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
projects / lilypond.git / blobdiff