From 763040707f9c7776065b2c0b3104f93ad735cd62 Mon Sep 17 00:00:00 2001 From: Reinhold Kainhofer Date: Tue, 17 Jun 2008 23:25:37 +0200 Subject: [PATCH 1/1] Change flag creation to use the 'flag prop (function returning the stencil) -) Added the 'flag grob property to the stem: It's a function taking the stem grob and returning a stencil for the whole flag (including a possible grace slash). It uses the 'flag-style property with the exact same values as previously, so any existing score should still be working. The default is ly:stem::calc-flag (implemented in C++), but I also implemented the default styles (no-flag, normal-flag and mensural-flag) in Scheme, where the function default-flag also uses the 'flag-style grob property. Both (the flag creation in C++ and in Scheme) show practically the same performance[*], so we might get rid of one of them in the future. Flag creation using scheme can thus be enabled by \override Stem #'flag = #default-flag flag creation in C++ can be explicitly enabled by \override Stem #'flag = #ly:stem::calc-flag -) Implemented the default flag styles as scheme-functions, so that one can re-use them in one's own flag style functions. The default flags functions are implemented in a modular way, so one can easily create styles that adjust only some aspects of the default flags. An example style implemented in the regression test is to use mirrored flags (i.e. flags always pointing to the left). This can be implemented by creating the flag for the opposite stem direction and rotating it by 180 degrees ;-) -) Added regression tests to check that the default flag styles all keep working. -) In the regression tests, I also added some custom styles: weighted-flag, where the flags are shown as one big black box and the "number" of flags is indicated by the height of the box. The other example is the mirrored-normal-flag style mentioned above (useful for tutorials about music notation to show that flags should *NOT* be printed to the left!) The real motivation for this feature, namely straight flags (either old-style with a large slant or modern-style with a much smaller slant), is not yet implemented, but should not be too hard, using the ly:round-filled-polygon function. [*] We now have two ways to generate flags: One C++ implementation (ly:stem::calc-flag) and one pure-Scheme implementation (default-flag). Both require the same amount of memory and there is hardly any difference in their runtime. For example, a file consisting of 10,000 eighth notes (nothing else) needs ~1.5GB RAM and runs for a bit over 3 minutes here, with the C++ implementation beating the Scheme implementation by mere 5 seconds: In C++: real 3m9.133s user 3m4.896s In Scheme: real 3m14.016s user 3m10.024s --- input/regression/flags-default.ly | 62 +++++++++++++++ input/regression/flags-in-scheme.ly | 42 +++++++++++ lily/include/stem.hh | 1 + lily/staff-symbol-referencer-scheme.cc | 14 ++++ lily/stem.cc | 76 ++++++++++++------- lily/stencil-scheme.cc | 4 +- scm/define-grob-properties.scm | 12 ++- scm/define-grobs.scm | 1 + scm/flag-styles.scm | 128 ++++++++++++++++++++++++++++++++ scm/lily.scm | 1 + scm/safe-lily.scm | 3 +- 11 files changed, 310 insertions(+), 34 deletions(-) create mode 100644 input/regression/flags-default.ly create mode 100644 input/regression/flags-in-scheme.ly create mode 100644 scm/flag-styles.scm diff --git a/input/regression/flags-default.ly b/input/regression/flags-default.ly new file mode 100644 index 0000000..bed879f --- /dev/null +++ b/input/regression/flags-default.ly @@ -0,0 +1,62 @@ +\version "2.11.57" + +\header { + texidoc = "Default flag styles: '(), 'mensural and 'no-flag. + Compare all three methods to print them (C++ default implementation, + Scheme implementation using the 'flag-style grob property and + setting the 'flag property explicitly to the desired Scheme function. + All three lines should be absolutely identical." +} + + +% 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 + s2 \break + + % Old settings: default, 'mensural, 'no-flag + \mark "Default flags (C++)" + \testnotes + + \mark "Symbol: 'mensural (C++)" + \override Stem #'flag-style = #'mensural + \testnotes + + \mark "Symbol: 'no-flag (C++)" + \override Stem #'flag-style = #'no-flag + \testnotes + + \break + + % The same, but with the Scheme implementation of default-flag + \override Stem #'flag = #default-flag + \revert Stem #'flag-style + \mark "Default flags (Scheme)" + \testnotes + + \mark "Symbol: 'mensural (Scheme)" + \override Stem #'flag-style = #'mensural + \testnotes + + \mark "Symbol: 'no-flag (Scheme)" + \override Stem #'flag-style = #'no-flag + \testnotes + + \break + + % New settings: no settings, normal-flag, mensural-flag, no-flag + \mark "Function: normal-flag" + \override Stem #'flag = #normal-flag + \testnotes + + \mark "Function: mensural-flag" + \override Stem #'flag = #mensural-flag + \testnotes + + \mark "Function: no-flag" + \override Stem #'flag = #no-flag + \testnotes +} diff --git a/input/regression/flags-in-scheme.ly b/input/regression/flags-in-scheme.ly new file mode 100644 index 0000000..0707f84 --- /dev/null +++ b/input/regression/flags-in-scheme.ly @@ -0,0 +1,42 @@ +\version "2.11.57" + +\header { + texidoc = "The 'flag property of the Stem grob can be set to a custom +scheme function to generate the glyph for the flag." +} + + +% 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 } + +#(define-public (weight-flag stem-grob) + (let* ((log (- (ly:grob-property stem-grob 'duration-log) 2)) + (is-up (eqv? (ly:grob-property stem-grob 'direction) UP)) + (yext (if is-up (cons (* log -0.8) 0) (cons 0 (* log 0.8)))) + (flag-stencil (make-filled-box-stencil '(-0.4 . 0.4) yext)) + (stroke-style (ly:grob-property stem-grob 'stroke-style)) + (stroke-stencil (if (equal? stroke-style "grace") (make-line-stencil 0.2 -0.9 -0.4 0.9 -0.4) empty-stencil))) + (ly:stencil-add flag-stencil stroke-stencil))) + + +% Create a flag stencil by looking up the glyph from the font +#(define (inverted-flag stem-grob) + (let* ((dir (if (eqv? (ly:grob-property stem-grob 'direction) UP) "d" "u")) + (flag (retrieve-glyph-flag "" dir "" stem-grob)) + (stroke-style (ly:grob-property stem-grob 'stroke-style)) + (stencil (if (null? stroke-style) flag + (add-stroke-glyph flag stem-grob dir stroke-style "")))) + (ly:stencil-rotate stencil 180 -1 -1))) + +{ + \override Score.RehearsalMark #'self-alignment-X = #LEFT + \time 2/4 + \mark "Function: weight-flag (custom)" + \override Stem #'flag = #weight-flag + \testnotes + + \mark "Function: inverted-flag (custom)" + \override Stem #'flag = #inverted-flag + \testnotes + +} diff --git a/lily/include/stem.hh b/lily/include/stem.hh index 7de67b0..26ceec7 100644 --- a/lily/include/stem.hh +++ b/lily/include/stem.hh @@ -55,5 +55,6 @@ public: DECLARE_SCHEME_CALLBACK (pure_height, (SCM, SCM, SCM)); DECLARE_SCHEME_CALLBACK (height, (SCM)); DECLARE_SCHEME_CALLBACK (calc_cross_staff, (SCM)); + DECLARE_SCHEME_CALLBACK (calc_flag, (SCM)); }; #endif diff --git a/lily/staff-symbol-referencer-scheme.cc b/lily/staff-symbol-referencer-scheme.cc index 8e0094f..84391d4 100644 --- a/lily/staff-symbol-referencer-scheme.cc +++ b/lily/staff-symbol-referencer-scheme.cc @@ -8,6 +8,7 @@ #include "grob.hh" #include "staff-symbol-referencer.hh" +#include "staff-symbol.hh" #include "libc-extension.hh" LY_DEFINE (ly_grob_staff_position, "ly:grob-staff-position", @@ -23,3 +24,16 @@ LY_DEFINE (ly_grob_staff_position, "ly:grob-staff-position", else return scm_from_double (pos); } + +LY_DEFINE (ly_position_on_line_p, "ly:position-on-line?", + 2, 0, 0, (SCM sg, SCM spos), + "Return whether @var{pos} is on a line of the staff associated with the the grob @var{sg} (even on an extender line).") +{ + LY_ASSERT_SMOB (Grob, sg, 1); + LY_ASSERT_TYPE (scm_is_number, spos, 1); + Grob *g = unsmob_grob (sg); + Grob *st = Staff_symbol_referencer::get_staff_symbol (g); + int pos = scm_to_int (spos); + bool on_line = st ? Staff_symbol::on_line (g, pos) : false; + return scm_from_bool (on_line); +} diff --git a/lily/stem.cc b/lily/stem.cc index b517b6e..c66712f 100644 --- a/lily/stem.cc +++ b/lily/stem.cc @@ -570,29 +570,25 @@ Stem::stem_end_position (Grob *me) return robust_scm2double (me->get_property ("stem-end-position"), 0); } -Stencil -Stem::flag (Grob *me) +MAKE_SCHEME_CALLBACK (Stem, calc_flag, 1); +SCM +Stem::calc_flag (SCM smob) { - int log = duration_log (me); - if (log < 3 - || unsmob_grob (me->get_object ("beam"))) - return Stencil (); + Grob *me = unsmob_grob (smob); - if (!is_normal_stem (me)) - return Stencil (); - + int log = duration_log (me); /* TODO: maybe property stroke-style should take different values, e.g. "" (i.e. no stroke), "single" and "double" (currently, it's '() or "grace"). */ string flag_style; - SCM flag_style_scm = me->get_property ("flag-style"); + SCM flag_style_scm = me->get_property ("flag-style"); if (scm_is_symbol (flag_style_scm)) flag_style = ly_symbol2string (flag_style_scm); if (flag_style == "no-flag") - return Stencil (); + return Stencil ().smobbed_copy (); bool adjust = true; @@ -607,14 +603,14 @@ Stem::flag (Grob *me) */ { if (adjust) - { - int p = (int) (rint (stem_end_position (me))); - staffline_offs - = Staff_symbol_referencer::on_line (me, p) ? "0" : "1"; - } + { + int p = (int) (rint (stem_end_position (me))); + staffline_offs + = Staff_symbol_referencer::on_line (me, p) ? "0" : "1"; + } else - staffline_offs = "2"; - } + staffline_offs = "2"; + } else staffline_offs = ""; @@ -631,17 +627,40 @@ Stem::flag (Grob *me) { string stroke_style = ly_scm2string (stroke_style_scm); if (!stroke_style.empty ()) - { - string font_char = to_string (dir) + stroke_style; - Stencil stroke = fm->find_by_name ("flags." + font_char); - if (stroke.is_empty ()) - me->warning (_f ("flag stroke `%s' not found", font_char)); - else - flag.add_stencil (stroke); - } - } + { + string font_char = to_string (dir) + stroke_style; + Stencil stroke = fm->find_by_name ("flags." + font_char); + if (stroke.is_empty ()) + me->warning (_f ("flag stroke `%s' not found", font_char)); + else + flag.add_stencil (stroke); + } + } + + return flag.smobbed_copy (); +} + - return flag; +Stencil +Stem::flag (Grob *me) +{ + int log = duration_log (me); + if (log < 3 + || unsmob_grob (me->get_object ("beam"))) + return Stencil (); + + if (!is_normal_stem (me)) + return Stencil (); + + // This get_property call already evaluates the scheme function with + // the grob passed as argument! Thus, we only have to check if a valid + // stencil is returned. + SCM flag_style_scm = me->get_property ("flag"); + if (Stencil *flag = unsmob_stencil (flag_style_scm)) { + return *flag; + } else { + return Stencil (); + } } MAKE_SCHEME_CALLBACK (Stem, width, 1); @@ -1032,6 +1051,7 @@ ADD_INTERFACE (Stem, "details " "direction " "duration-log " + "flag " "flag-style " "french-beaming " "length " diff --git a/lily/stencil-scheme.cc b/lily/stencil-scheme.cc index 3262533..8fbf14d 100644 --- a/lily/stencil-scheme.cc +++ b/lily/stencil-scheme.cc @@ -288,7 +288,9 @@ LY_DEFINE (ly_bracket, "ly:bracket", LY_DEFINE (ly_stencil_rotate, "ly:stencil-rotate", 4, 0, 0, (SCM stil, SCM angle, SCM x, SCM y), "Return a stencil @var{stil} rotated @var{angle} degrees around" - " point (@var{x}, @var{y}).") + " point (@var{x}, @var{y}) given in multiples of the stencil " + "extents, i.e. (0,0) means the center of the stencil, (1,-1) the " + "left upper corner.") { Stencil *s = unsmob_stencil (stil); LY_ASSERT_SMOB (Stencil, stil, 1); diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm index cd122c5..1232af6 100644 --- a/scm/define-grob-properties.scm +++ b/scm/define-grob-properties.scm @@ -204,11 +204,15 @@ problem, we pad each item by this amount (by adding the @q{car} on the left side of the item and adding the @q{cdr} on the right side of the item). In order to make a grob take up no horizontal space at all, set this to @code{(+inf.0 . -inf.0)}.") + (flag ,procedure? "A function returning the full flag stencil for +the @code{Stem}, which is passed to the function as the only argument. +The default ly:stem::calc-stencil function uses the @code{flag-style} +property to determine the correct glyph for the +flag. By providing your own function, you can create arbitrary flags.") (flag-count ,number? "The number of tremolo beams.") - (flag-style ,symbol? "A string determining what style of flag -glyph is typeset on a @code{Stem}. Valid options include @code{()} -and @code{mensural}. Additionally, @code{no-flag} switches off the -flag.") + (flag-style ,symbol? "A function determining what style of flag +glyph is typeset on a @code{Stem}. Valid options include @code{()}, address@hidden'mensural} and @code{'no-flag}, which switches off the flag.") (font-encoding ,symbol? "The font encoding is the broadest category for selecting a font. Options include: @code{fetaMusic}, @code{fetaNumber}, @code{TeX-text}, @code{TeX-math}, diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index f8a6526..975d425 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -1625,6 +1625,7 @@ (length . ,ly:stem::calc-length) (thickness . 1.3) (cross-staff . ,ly:stem::calc-cross-staff) + (flag . ,ly:stem::calc-flag) (details . ( ;; 3.5 (or 3 measured from note head) is standard length diff --git a/scm/flag-styles.scm b/scm/flag-styles.scm new file mode 100644 index 0000000..4bc57f0 --- /dev/null +++ b/scm/flag-styles.scm @@ -0,0 +1,128 @@ +;;;; flag-styles.scm +;;;; +;;;; source file of the GNU LilyPOnd music typesetter +;;;; + +;; No flag: Simply return empty stencil +(define-public (no-flag stem-grob) + empty-stencil) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Straight flags +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +;; ;; 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)) + + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;;; Flags created from feta glyphs (normal and mensural flags) +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +;; Add the stroke to the flag: Load the correct glyph from the font and add it +(define-public (add-stroke-glyph stencil stem-grob dir stroke-style flag-style) + (if (not (string? stroke-style)) + stencil + ; Otherwise: look up the stroke glyph and combine it with the flag + (let* ((font-char (string-append "flags." flag-style dir stroke-style)) + (alt-font-char (string-append "flags." dir stroke-style)) + (font (ly:grob-default-font stem-grob)) + (tmpstencil (ly:font-get-glyph font font-char)) + (stroke-stencil (if (ly:stencil-empty? tmpstencil) + (ly:font-get-glyph font alt-font-char) + tmpstencil))) + (if (ly:stencil-empty? stroke-stencil) + (begin + (ly:warning (_ "flag stroke `~a' or `~a'not found") font-char alt-font-char) + stencil) + (ly:stencil-add stencil stroke-stencil))))) + +(define-public (retrieve-glyph-flag flag-style dir dir-modifier stem-grob) + (let* ((log (ly:grob-property stem-grob 'duration-log)) + (font (ly:grob-default-font stem-grob)) + (font-char (string-append "flags." flag-style dir dir-modifier (number->string log))) + (flag (ly:font-get-glyph font font-char))) + (if (ly:stencil-empty? flag) + (ly:warning "flag ~a not found" font-char)) + flag)) + +;; Create a flag stencil by looking up the glyph from the font +(define-public (create-glyph-flag flag-style dir-modifier stem-grob) + (let* ((dir (if (eqv? (ly:grob-property stem-grob 'direction) UP) "u" "d")) + (flag (retrieve-glyph-flag flag-style dir dir-modifier stem-grob)) + (stroke-style (ly:grob-property stem-grob 'stroke-style))) + (if (null? stroke-style) + flag + (add-stroke-glyph flag stem-grob dir stroke-style flag-style)))) + + +; Mensural flags; Flags are always aligned with staff lines -> use corresponding glyphs +;; For notes on staff lines, use different +;; flags than for notes between staff lines. The idea is that +;; flags are always vertically aligned with the staff lines, +;; regardless if the note head is on a staff line or between two +;; staff lines. In other words, the inner end of a flag always +;; touches a staff line. +(define-public (mensural-flag stem-grob) + (let* ((adjust #t) + (stem-end (inexact->exact (round (ly:grob-property stem-grob 'stem-end-position)))) + ; For some reason the stem-end is a real instead of an integer... + (dir-modifier (if (ly:position-on-line? stem-grob stem-end) "1" "0")) + (modifier (if adjust dir-modifier "2"))) + (create-glyph-flag "mensural" modifier stem-grob))) + + +; Simulates the "old" way: look up glyphs flags.[ud]style[1234] from the +; feta font and use it for the flag stencil +(define-public ((glyph-flag flag-style) stem-grob) + (create-glyph-flag flag-style "" stem-grob)) + + +(define-public (normal-flag stem-grob) + (create-glyph-flag "" "" stem-grob)) + +(define-public (default-flag stem-grob) + (let* ((flag-style-symbol (ly:grob-property stem-grob 'flag-style)) + (flag-style (if (symbol? flag-style-symbol) + (symbol->string flag-style-symbol) + ""))) + (cond + ((equal? flag-style "") (normal-flag stem-grob)) + ((equal? flag-style "mensural") (mensural-flag stem-grob)) + ((equal? flag-style "no-flag") (no-flag stem-grob)) + (else ((glyph-flag flag-style) stem-grob))))) diff --git a/scm/lily.scm b/scm/lily.scm index e518ce2..a7ff41a 100644 --- a/scm/lily.scm +++ b/scm/lily.scm @@ -337,6 +337,7 @@ The syntax is the same as `define*-public'." "font.scm" "encoding.scm" + "flag-styles.scm" "fret-diagrams.scm" "harp-pedals.scm" "predefined-fretboards.scm" diff --git a/scm/safe-lily.scm b/scm/safe-lily.scm index 6c29178..ae3d56c 100644 --- a/scm/safe-lily.scm +++ b/scm/safe-lily.scm @@ -92,6 +92,7 @@ ly:number->string ly:option-usage ly:output-def-clone + ly:output-def-lookup ly:output-def-scope ly:output-description ly:paper-book? @@ -100,7 +101,6 @@ ly:paper-get-font ly:paper-get-number ly:paper-system? - ly:output-def-lookup ly:parser-parse-string ly:pitch-alteration ly:pitch-diff @@ -112,6 +112,7 @@ ly:pitch-transpose ly:pitch