lilypond-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Improve elbowed-hairpin (issue 324800043 by address@hidden)


From: thomasmorley65
Subject: Improve elbowed-hairpin (issue 324800043 by address@hidden)
Date: Sat, 22 Apr 2017 16:09:49 -0700

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,
address@hidden'((0.3 . 0.7) (0.8 . 0.9) (1.0 . 1.0))} means that at the point
address@hidden'((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.
address@hidden 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 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





reply via email to

[Prev in Thread] Current Thread [Next in Thread]