Reviewers: ,
Message:
Please review.
Description:
Improve elbowed-hairpin
Let the lines be printed by the new make-connected-line-procedure,
using ly:line-interface::line. The new stencil now reacts on
overrides for style and dash-period/fraction.
Not closing Hairpins created by elbowed-hairpin are possible now.
Single disadvantage: The point-list needs to have (0 . 0) first,
if a closing Hairpin is wished.
The previous used make-connected-path did that automatically and
thus was not flexible enough.
Give the final stencil proper extents.
Cleanup, more descriptive naming, extent docstring.
Please review this at https://codereview.appspot.com/324800043/
Affected files (+56, -32 lines):
M scm/output-lib.scm
Index: scm/output-lib.scm
diff --git a/scm/output-lib.scm b/scm/output-lib.scm
index
56e348da3dbcb0c2bf6951d9e8913f357e38e6e9..76d17cb7c07251986b2b99150219c0bbc91b6203
100644
--- a/scm/output-lib.scm
+++ b/scm/output-lib.scm
@@ -1165,21 +1165,43 @@ between the two text elements."
'(bound-details left padding)
(+ my-padding
script-padding)))
+(define-public (make-connected-line pts grob)
+ "Returns a line connecting @var{pts}, gets layout information from
@var{grob}"
+ (define (connected-points grob ls pts)
+(if (not (pair? (cdr pts)))
+(apply ly:stencil-add empty-stencil ls)
+(connected-points
+ grob
+ (cons
+(ly:line-interface::line
+ grob
+ (car (first pts))
+ (cdr (first pts))
+ (car (second pts))
+ (cdr (second pts)))
+ls)
+ (cdr pts
+ (connected-points grob '() pts))
+
(define ((elbowed-hairpin coords mirrored?) grob)
"Create hairpin based on a list of @var{coords} in @code{(cons x y)}
form. @code{x} is the portion of the width consumed for a given line
and @code{y} is the portion of the height. For example,
-@code{'((0.3 . 0.7) (0.8 . 0.9) (1.0 . 1.0))} means that at the point
+@code{'((0 . 0) (0.3 . 0.7) (0.8 . 0.9) (1.0 . 1.0))} means that at the
point
where the hairpin has consumed 30% of its width, it must
be at 70% of its height. Once it is to 80% width, it
-must be at 90% height. It finishes at
-100% width and 100% height. @var{mirrored?} indicates if the hairpin
-is mirrored over the Y-axis or if just the upper part is drawn.
+must be at 90% height. It finishes at 100% width and 100% height.
+If @var{coords} does not begin with @code{'(0 . 0)} the final hairpin may
have
+an open tip. For example '(0 . 0.5) will cause an open end of 50% of the
usual
+height.
+@var{mirrored?} indicates if the hairpin is mirrored over the Y-axis or if
+just the upper part is drawn.
Returns a function that accepts a hairpin grob as an argument
and draws the stencil based on its coordinates.
+
@lilypond[verbatim,quote]
#(define simple-hairpin
- (elbowed-hairpin '((1.0 . 1.0)) #t))
+ (elbowed-hairpin '((0 . 0)(1.0 . 1.0)) #t))
\\relative c' {
\\override Hairpin #'stencil = #simple-hairpin
@@ -1187,50 +1209,52 @@ and draws the stencil based on its coordinates.
}
@end lilypond
"
- (define (pair-to-list pair)
-(list (car pair) (cdr pair)))
- (define (normalize-coords goods x y)
+ (define (scale-coords coords-list x y)
(map
- (lambda (coord)
- (cons (* x (car coord)) (* y (cdr coord
- goods))
- (define (my-c-p-s points thick decresc?)
-(make-connected-path-stencil
- points
- thick
- (if decresc? -1.0 1.0)
- 1.0
- #f
- #f))
+ (lambda (coord) (cons (* x (car coord)) (* y (cdr coord
+ coords-list))
+
+ (define (hairpin::print-part points decresc? me)
+(let ((stil (make-connected-line points me)))
+ (if decresc? (ly:stencil-scale stil -1 1) stil)))
+
;; outer let to trigger suicide
(let ((sten (ly:hairpin::print grob)))
(if (grob::is-live? grob)
(let* ((decresc? (eqv? (ly:grob-property grob 'grow-direction)
LEFT))
- (thick (ly:grob-property grob 'thickness 0.1))
- (thick (* thick (layout-line-thickness grob)))
(xex (ly:stencil-extent sten X))
(lenx (interval-length xex))
(yex (ly:stencil-extent sten Y))
(leny (interval-length yex))
(xtrans (+ (car xex) (if decresc? lenx 0)))
(ytrans (car yex))
- (uplist (map pair-to-list
-(normalize-coords coords lenx (/ leny 2
- (downlist (map pair-to-list
- (normalize-coords coords lenx (/ leny -2)
- (ly:stencil-translate
- (ly:stencil-add
-(my-c-p-s uplist thick decresc?)
-(if mirrored? (my-c-p-s downlist thick decresc?)
empty-stencil))
- (cons xtrans ytrans)))
+ (uplist (scale-coords coords lenx (/ leny
