From e98b34cf22b43d6e30e504e84cbd3aca0642fbe7 Mon Sep 17 00:00:00 2001 From: Reinhold Kainhofer Date: Thu, 21 Aug 2008 22:32:53 +0200 Subject: [PATCH 1/1] Feature: Implement flags being generated in Scheme If the 'flag-style property of the Stem grob is set to a Scheme function, \override Stem #'flag-style = #'my-flag-style with the function of the form #(define (my-flag-style grob-stem) ....) that function is called with the Stem grob as its sole argument and needs to return the full stencil for the flag, including a possible grace slash. In addition to self-defined custom scheme flag style functions, the following styles are predefined: -) #'() or #normal-flag (as a function): conventional flags -) #'mensural (as a symbol) or #mensural-flag (as a function): Mensural flag, shifted to line up with staff lines -) #'no-flag (as a symbol, "old syntax"), #no-flag (as a function, new): Displays no flag on the stem -) #'somestyle (a symbol) or #glyph-flag("somestyle"): Looks up the glyph "flags.somestyle[ud][3456]" from the feta font and uses it for the flag. The glyphs for the grace slash are named "flags.somestyle[ud]grace" Also added regtest for these features. To be able to implement the mensural flag style, I had to implement the function (ly:position-on-line? grob pos), which returns whether the given vertical position (in our case the stem end) is on a staff line. It is basically the same as the C++ method Staff_symbol_referencer::on_line. --- input/regression/flags-in-scheme.ly | 83 ++++++++++++++++++++++ lily/staff-symbol-referencer-scheme.cc | 14 ++++ lily/stem.cc | 85 ++++++++--------------- scm/define-grob-properties.scm | 10 ++- scm/flag-styles.scm | 118 ++++++++++++++++++++++++++++++++ scm/lily.scm | 1 + scm/safe-lily.scm | 3 +- 7 files changed, 253 insertions(+), 61 deletions(-) create mode 100644 input/regression/flags-in-scheme.ly create mode 100644 scm/flag-styles.scm diff --git a/input/regression/flags-in-scheme.ly b/input/regression/flags-in-scheme.ly new file mode 100644 index 0000000..8ce2cdf --- /dev/null +++ b/input/regression/flags-in-scheme.ly @@ -0,0 +1,83 @@ +\version "2.11.57" + +\header { + texidoc = "The 'flag-style property of the Stem grob can be set to a custom +scheme function to generate the glyph for the flag. + +In addition, '(), 'no-flag and 'mensural are allowed as symbols. +" +} + + +% 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 (test-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 + + % Old settings: default, 'mensural, 'no-flag + \mark "Default flags" + \testnotes + + \mark "Symbol: 'mensural" + \override Stem #'flag-style = #'mensural + \testnotes +% \break + + \mark "Symbol: 'no-flag" + \override Stem #'flag-style = #'no-flag + \testnotes + +% \mark "Old: 'straight" +% \override Stem #'flag-style = #'straight +% \testnotes +% \break + + % New settings: no settings, normal-flag, mensural-flag, no-flag + \mark "Function: normal-flag" + \override Stem #'flag-style = #normal-flag + \testnotes + + \mark "Function: mensural-flag" + \override Stem #'flag-style = #mensural-flag + \testnotes +% \break + + \mark "Function: no-flag" + \override Stem #'flag-style = #no-flag + \testnotes + +% \mark "New: modern-straight-flag" +% \override Stem #'flag-style = #modern-straight-flag +% \testnotes +% \break + + \mark "Function: test-flag (custom)" + \override Stem #'flag-style = #test-flag + \testnotes + + \mark "Function: inverted-normal-flag (custom)" + \override Stem #'flag-style = #inverted-flag + \testnotes +} 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..0b85b97 100644 --- a/lily/stem.cc +++ b/lily/stem.cc @@ -580,68 +580,41 @@ Stem::flag (Grob *me) if (!is_normal_stem (me)) return Stencil (); - - /* - 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; + // 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. If not, we'll have to manually call one of the + // pre-defined flag style functions 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 (); + if (Stencil *flag = unsmob_stencil (flag_style_scm)) { + return *flag; + } else { + string flag_style; - bool adjust = true; - - string staffline_offs; - if (flag_style == "mensural") - /* Mensural notation: 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. - */ - { - if (adjust) - { - int p = (int) (rint (stem_end_position (me))); - staffline_offs - = Staff_symbol_referencer::on_line (me, p) ? "0" : "1"; - } - else - staffline_offs = "2"; + if (scm_is_symbol (flag_style_scm)) { + flag_style = ly_symbol2string (flag_style_scm); } - else - staffline_offs = ""; - - char dir = (get_grob_direction (me) == UP) ? 'u' : 'd'; - string font_char = flag_style - + to_string (dir) + staffline_offs + to_string (log); - Font_metric *fm = Font_interface::get_default_font (me); - Stencil flag = fm->find_by_name ("flags." + font_char); - if (flag.is_empty ()) - me->warning (_f ("flag `%s' not found", font_char)); - - SCM stroke_style_scm = me->get_property ("stroke-style"); - if (scm_is_string (stroke_style_scm)) - { - 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); - } + // Shortcuts: setting flag-style to a symbol like #(), #'mensural or #'no-flag + if (flag_style == "mensural") { + flag_style_scm = ly_lily_module_constant ("mensural-flag"); + } else if (flag_style == "no-flag") { + flag_style_scm = ly_lily_module_constant ("no-flag"); + } else if (flag_style == "") { + // default style + flag_style_scm = ly_lily_module_constant ("normal-flag"); + } else { + // Any other symbol: Use the glyph style, which looks up the + // glyph flags.[ud]style[123456] from the feta font + flag_style_scm = scm_call_1 (ly_lily_module_constant ("glyph-flag"), ly_string2scm(flag_style)); } + SCM stc_scm = scm_call_1 (flag_style_scm, me->self_scm()); - return flag; + if (Stencil *flag = unsmob_stencil (stc_scm)) { + return *flag; + } else { + return Stencil (); + } + } } MAKE_SCHEME_CALLBACK (Stem, width, 1); diff --git a/scm/define-grob-properties.scm b/scm/define-grob-properties.scm index 49916fa..861eec6 100644 --- a/scm/define-grob-properties.scm +++ b/scm/define-grob-properties.scm @@ -205,10 +205,12 @@ 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-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 symbol determining what style of flag +glyph is typeset on a @code{Stem}. Valid options include @code{()}, address@hidden'mensural} or custom functions defined in scheme. Additionally, address@hidden'no-flag} switches off the flag. Custom scheme functions are +called with the Stem grob as its sole argument and should return the +complete stencil for the flag, including a possible grace slash.") (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/flag-styles.scm b/scm/flag-styles.scm new file mode 100644 index 0000000..bd50f35 --- /dev/null +++ b/scm/flag-styles.scm @@ -0,0 +1,118 @@ +;;;; 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) + (lambda (stem-grob) + (create-glyph-flag flag-style "" stem-grob))) + + +(define-public (normal-flag stem-grob) + (create-glyph-flag "" "" stem-grob)) diff --git a/scm/lily.scm b/scm/lily.scm index e518ce2..1631f03 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