From 90718547de93b6011d08daef54e1a6162a783462 Mon Sep 17 00:00:00 2001 From: Reinhold Kainhofer Date: Sat, 13 Dec 2008 14:25:02 +0100 Subject: [PATCH] Implement straight flags in scheme --- input/regression/flags-straight.ly | 35 ++++++++++++ scm/flag-styles.scm | 101 +++++++++++++++++++++++------------ 2 files changed, 101 insertions(+), 35 deletions(-) create mode 100644 input/regression/flags-straight.ly diff --git a/input/regression/flags-straight.ly b/input/regression/flags-straight.ly new file mode 100644 index 0000000..d3bdd5a --- /dev/null +++ b/input/regression/flags-straight.ly @@ -0,0 +1,35 @@ +\version "2.11.57" + +\header { + texidoc = "Straight flag styles." +} + + +% test notes, which will be shown in different style: +testnotes = { \autoBeamOff c'8 d'16 c'32 d'64 \acciaccatura {c'8} d'64 c''8 d''16 c''32 d''64 \acciaccatura {c''8} d''64 } + +{ + \override Score.RehearsalMark #'self-alignment-X = #LEFT + \time 2/4 + R2 \break + + \mark "normal" + \testnotes +% \break + + \mark "modern straight" + \override Stem #'flag = #modern-straight-flag + \testnotes + \break + + \mark "old straight (large angles)" + \override Stem #'flag = #old-straight-flag + \testnotes +% \break + + \mark "custom slant" + \override Stem #'flag = #(straight-flag 0.35 0.8 -5 0.5 60 2.0) + \testnotes + + +} diff --git a/scm/flag-styles.scm b/scm/flag-styles.scm index acdc381..de4206c 100644 --- a/scm/flag-styles.scm +++ b/scm/flag-styles.scm @@ -13,41 +13,72 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;; ;; TODO -;; (define-public (add-stroke-straight stencil dir stroke-style) -;; stencil -;; ) -;; -;; ;; Create a stencil for a straight flag -;; ;; flag-thickness, -spacing are given in staff spaces -;; ;; *flag-length are given in black notehead widths -;; ;; TODO -;; (define-public (straight-flag flag-thickness flag-spacing -;; upflag-angle upflag-length -;; downflag-angle downflag-length) -;; (lambda (stem-grob) -;; (let* ((log (ly:grob-property stem-grob 'duration-log)) -;; (staff-space 1) ; TODO -;; (black-notehead-width 1) ; TODO -;; (stem-thickness 1) ; TODO: get rid of -;; (half-stem-thickness (/ stem-thickness 2)) -;; (staff-space 1) ; TODO -;; (up-length (+ (* upflag-length black-notehead-width) half-stem-thickness)) -;; (down-length (+ (* downflag-length black-notehead-width) half-stem-thickness)) -;; (thickness (* flag-thickness staff-space)) -;; (spacing (* flag-spacing staff-space))) -;; empty-stencil -;; ) -;; ) -;; ) -;; -;; ;; Modern straight flags: angles are not so large as with the old style -;; (define-public (modern-straight-flag stem-grob) -;; ((straight-flag 0.55 0.9 -18 0.95 22 1.0) stem-grob)) -;; -;; ;; Old-straight flags (Bach, etc.): quite large flag angles -;; (define-public (old-straight-flag stem-grob) -;; ((straight-flag 0.55 0.9 -45 0.95 45 1.0) stem-grob)) +;; TODO +(define-public (add-stroke-straight stencil dir stroke-style) + stencil +) + +(define-public (degree-to-radians deg) + "Convert the angle given in degree to radians." + (let ((pi 3.141592654)) + (/ (* deg pi) 180))) + +;; Create a stencil for a straight flag +;; flag-thickness, -spacing are given in staff spaces +;; *flag-length are given in black notehead widths +(define-public (straight-flag flag-thickness flag-spacing + upflag-angle upflag-length + downflag-angle downflag-length) + (lambda (stem-grob) + (let* ((log (ly:grob-property stem-grob 'duration-log)) + (stem-up? (eqv? (ly:grob-property stem-grob 'direction) UP)) + (staff-space 1) ; TODO: Does the staff-space scale with the note size? Otherwise we need something else + (black-notehead-width 1) ; TODO: How can I obtain the width of a black notehead (or anything that scales with the note size, in particular for grace notes)? + (grob-stem-thickness (ly:grob-property stem-grob 'thickness)) +; (line-thickness (ly:grob-property stem-grob 'line-thickness)) ; TODO: This doesn't work to get the thickness!!! + (line-thickness 0.2) ; TODO: This doesn't work to get the thickness!!! + (stem-thickness (* grob-stem-thickness line-thickness)) + (half-stem-thickness (/ stem-thickness 2)) + (up-length (+ (* upflag-length black-notehead-width) half-stem-thickness)) + (up-dy (* (sin (degree-to-radians upflag-angle)) up-length)) + (up-dx (* (cos (degree-to-radians upflag-angle)) up-length)) + (down-length (+ (* downflag-length black-notehead-width) half-stem-thickness)) + (down-dy (* (sin (degree-to-radians downflag-angle)) down-length)) + (down-dx (* (cos (degree-to-radians downflag-angle)) down-length)) + (thickness (* flag-thickness staff-space)) + (spacing (* flag-spacing staff-space)) + (start (- half-stem-thickness)) + (points (if stem-up? (list (cons start 0) + (cons up-dx up-dy) + (cons up-dx (- up-dy thickness)) + (cons start (- thickness))) + (list (cons start 0) + (cons start thickness) + (cons down-dx (+ down-dy thickness)) + (cons down-dx down-dy)))) + (stencil (ly:round-filled-polygon points half-stem-thickness)) + ) + (display "Half-stem-thickness: ")(display half-stem-thickness)(newline) + (display "Line-thickness: ")(display line-thickness)(newline) + ; Log for 1/8 is 3, so we need to subtract 3 plus 1 for the first recursion + (let buildflag ((flag-stencil stencil) (remain (- log 4)) (curr-stencil stencil)) + (if (> remain 0) + (let* ((translated-stencil (ly:stencil-translate-axis curr-stencil + (if stem-up? (- spacing) spacing) Y)) + (new-stencil (ly:stencil-add flag-stencil translated-stencil))) + (buildflag new-stencil (- remain 1) translated-stencil)) + flag-stencil)) + ) + ) +) + +;; Modern straight flags: angles are not so large as with the old style +(define-public (modern-straight-flag stem-grob) + ((straight-flag 0.55 1 -18 0.95 22 1.0) stem-grob)) + +;; Old-straight flags (Bach, etc.): quite large flag angles +(define-public (old-straight-flag stem-grob) + ((straight-flag 0.55 1 -45 1.2 45 1.4) stem-grob)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -- 1.5.6.3