(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)
(define-markup-command (hspace layout props amount)
(number?)
#:category align
+ #:properties ((word-space))
"
@cindex creating horizontal spaces in text
three
}
@end lilypond"
- (if (> amount 0)
- (ly:make-stencil "" (cons 0 amount) '(0 . 0))
- (ly:make-stencil "" (cons amount amount) '(0 . 0))))
+ (let ((corrected-space (- amount word-space)))
+ (if (> corrected-space 0)
+ (ly:make-stencil "" (cons 0 corrected-space) '(0 . 0))
+ (ly:make-stencil "" (cons corrected-space corrected-space) '(0 . 0)))))
;; todo: fix negative space
(define-markup-command (vspace layout props amount)
@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)))))
+ (ly:make-stencil "" (cons 0 0) (cons 0 amount))
+ (ly:make-stencil "" (cons 0 0) (cons amount amount)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
str))
'(0 . 0) '(0 . 0)))
+(define-markup-command (path layout props thickness commands) (number? list?)
+ #:category graphic
+ #:properties ((line-cap-style 'round)
+ (line-join-style 'round)
+ (filled #f))
+ "
+@cindex paths, drawing
+@cindex drawing paths
+Draws a path with line thickness @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
+@code{closepath}. Note that the commands that begin with @emph{r}
+are the relative variants of the other three commands.
+
+The commands @code{moveto}, @code{rmoveto}, @code{lineto}, and
+@code{rlineto} take 2 arguments; they are the X and Y coordinates
+for the destination point.
+
+The commands @code{curveto} and @code{rcurveto} create cubic
+Bézier curves, and take 6 arguments; the first two are the X and Y
+coordinates for the first control point, the second two are the X
+and Y coordinates for the second control point, and the last two
+are the X and Y coordinates for the destination point.
+
+The @code{closepath} command takes zero arguments and closes the
+current subpath in the active path.
+
+Note that a sequence of commands @emph{must} begin with a
+@code{moveto} or @code{rmoveto} to work with the SVG output.
+
+@lilypond[verbatim,quote]
+samplePath =
+ #'((moveto 0 0)
+ (lineto -1 1)
+ (lineto 1 1)
+ (lineto 1 -1)
+ (curveto -5 -5 -5 5 -1 0)
+ (closepath))
+
+\\markup {
+ \\path #0.25 #samplePath
+}
+@end lilypond"
+ (let* ((half-thickness (/ thickness 2))
+ (current-point '(0 . 0))
+ (set-point (lambda (lst) (set! current-point lst)))
+ (relative? (lambda (x)
+ (string-prefix? "r" (symbol->string (car x)))))
+ ;; For calculating extents, we want to modify the command
+ ;; list so that all coordinates are absolute.
+ (new-commands (map (lambda (x)
+ (cond
+ ;; for rmoveto, rlineto
+ ((and (relative? x) (eq? 3 (length x)))
+ (let ((cp (cons
+ (+ (car current-point)
+ (second x))
+ (+ (cdr current-point)
+ (third x)))))
+ (set-point cp)
+ (list (car cp)
+ (cdr cp))))
+ ;; for rcurveto
+ ((and (relative? x) (eq? 7 (length x)))
+ (let* ((old-cp current-point)
+ (cp (cons
+ (+ (car old-cp)
+ (sixth x))
+ (+ (cdr old-cp)
+ (seventh x)))))
+ (set-point cp)
+ (list (+ (car old-cp) (second x))
+ (+ (cdr old-cp) (third x))
+ (+ (car old-cp) (fourth x))
+ (+ (cdr old-cp) (fifth x))
+ (car cp)
+ (cdr cp))))
+ ;; for moveto, lineto
+ ((eq? 3 (length x))
+ (set-point (cons (second x)
+ (third x)))
+ (drop x 1))
+ ;; for curveto
+ ((eq? 7 (length x))
+ (set-point (cons (sixth x)
+ (seventh x)))
+ (drop x 1))
+ ;; keep closepath for filtering;
+ ;; see `without-closepath'.
+ (else x)))
+ commands))
+ ;; path-min-max does not accept 0-arg lists,
+ ;; and since closepath does not affect extents, filter
+ ;; out those commands here.
+ (without-closepath (filter (lambda (x)
+ (not (equal? 'closepath (car x))))
+ new-commands))
+ (extents (path-min-max
+ ;; set the origin to the first moveto
+ (list (list-ref (car without-closepath) 0)
+ (list-ref (car without-closepath) 1))
+ without-closepath))
+ (X-extent (cons (list-ref extents 0) (list-ref extents 1)))
+ (Y-extent (cons (list-ref extents 2) (list-ref extents 3)))
+ (command-list (fold-right append '() commands)))
+
+ ;; account for line thickness
+ (set! X-extent (interval-widen X-extent half-thickness))
+ (set! Y-extent (interval-widen Y-extent half-thickness))
+
+ (ly:make-stencil
+ `(path ,thickness `(,@',command-list)
+ ',line-cap-style ',line-join-style ,filled)
+ X-extent
+ Y-extent)))
+
(define-markup-command (score layout props score)
(ly:score?)
#:category music
(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 eyeglassespath
+ '((moveto 0.42 0.77)
+ (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
+ (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
+ (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
+ (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
+ (closepath)
+ (moveto 2.07 0.77)
+ (rcurveto 0 0.304 -0.246 0.55 -0.55 0.55)
+ (rcurveto -0.304 0 -0.55 -0.246 -0.55 -0.55)
+ (rcurveto 0 -0.304 0.246 -0.55 0.55 -0.55)
+ (rcurveto 0.304 0 0.55 0.246 0.55 0.55)
+ (closepath)
+ (moveto 1.025 0.935)
+ (rcurveto 0 0.182 -0.148 0.33 -0.33 0.33)
+ (rcurveto -0.182 0 -0.33 -0.148 -0.33 -0.33)
+ (moveto -0.68 0.77)
+ (rlineto 0.66 1.43)
+ (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)
+ (moveto 2.07 0.77)
+ (rlineto 0.66 1.43)
+ (rcurveto 0.132 0.286 0.55 0.44 0.385 -0.33)))
(define-markup-command (eyeglasses layout props)
()
\\markup { \\eyeglasses }
@end lilypond"
(interpret-markup layout props
- (make-with-dimensions-markup '(-0.61 . 3.22) '(0.2 . 2.41)
- (make-postscript-markup eyeglassesps))))
+ (make-override-markup '(line-cap-style . butt)
+ (make-path-markup 0.15 eyeglassespath))))
(define-markup-command (left-brace layout props size)
(number?)
projects / lilypond.git / blobdiff