From: Thomas Morley Date: Sat, 22 Apr 2017 17:48:13 +0000 (+0200) Subject: Issue 5123 Improve elbowed-hairpin X-Git-Url: https://git.donarmstrong.com/?p=lilypond.git;a=commitdiff_plain;h=605634765732eab978057b8a1af7efe641c81049 Issue 5123 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. --- diff --git a/scm/output-lib.scm b/scm/output-lib.scm index 56e348da3d..282cb233a7 100644 --- a/scm/output-lib.scm +++ b/scm/output-lib.scm @@ -1165,21 +1165,51 @@ between the two text elements." '(bound-details left padding) (+ my-padding script-padding))))))) +(define-public (make-connected-line points grob) + "Takes a list of points, @var{points}. +Returns a line connecting @var{points}, using @code{ly:line-interface::line}, +gets layout information from @var{grob}" + (define (connected-points grob ls pts) + (if (not (pair? (cdr pts))) + (reduce 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)))) + (if (< (length points) 2) + (begin + (ly:warning + "´make-connected-line´ needs at least two points: ~a" + points) + empty-stencil) + (connected-points grob '() points))) + (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 +1217,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 2))) + (downlist (scale-coords coords lenx (/ leny -2))) + (stil + (ly:stencil-aligned-to + (ly:stencil-translate + (ly:stencil-add + (hairpin::print-part uplist decresc? grob) + (if mirrored? + (hairpin::print-part downlist decresc? grob) + empty-stencil)) + (cons xtrans ytrans)) + Y CENTER)) + (stil-y-extent (ly:stencil-extent stil Y))) + ;; Return a final stencil properly aligned in Y-axis direction and with + ;; proper extents. Otherwise stencil-operations like 'box-stencil' will + ;; return badly. Extent in X-axis direction is taken from the original, + ;; in Y-axis direction from the new stencil. + (ly:make-stencil (ly:stencil-expr stil) xex stil-y-extent)) + ;; return empty, if no Hairpin.stencil present. '()))) (export elbowed-hairpin) (define-public flared-hairpin - (elbowed-hairpin '((0.95 . 0.4) (1.0 . 1.0)) #t)) + (elbowed-hairpin '((0 . 0) (0.95 . 0.4) (1.0 . 1.0)) #t)) (define-public constante-hairpin - (elbowed-hairpin '((1.0 . 0.0) (1.0 . 1.0)) #f)) + (elbowed-hairpin '((0 . 0) (1.0 . 0.0) (1.0 . 1.0)) #f)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; lyrics