-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1

Am Samstag, 23. August 2008 schrieb Han-Wen Nienhuys:
> On Fri, Aug 22, 2008 at 3:14 PM, Reinhold Kainhofer
> > So, to summarize what you suggest:
> > - -) Stem 'flag property: Always a scheme function returning the complete
> > stencil; The default scheme function calls some C++ function, which does
> > exactly what we have in Stem::flag right now (i.e. lookup a glyph from
> > the font, using the 'flag-style property for the name).
> > - -) Stem 'flag-style property: The name of the style, used only by the
> > default 'flag function.
> > - -) C++ function Stem::calc_flag: Contains the current code for flags
> > will be called by the default function of Stem 'flag.
>
> Yes- this follows the principle of least surprise.

Okay, attached is the updated patch, which gives users full control about the 
flag generation. It uses the Stem grob properties as outlined above. 
I implemented both a C++ and a scheme function to create the flags. There is a 
slight performance advantage for the C++ function (for a file containing only 
10,000 unbeamed eighth notes it is 5 seconds faster with a runtime of a 
little over 3 minutes, see below), so I left the C++ function in, but also 
did the Scheme implementation, so that users can take the existing styles and 
modify them. With this patch we now have the proper basis to implement the 
straight flags style originally requested.

Here's what the patch does (from the git log message):

  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~

 -) 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 some aspects of the default flags. An example style implemented
    in the test is to use mirrored flags (i.e. flags always pointing
    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

  ~~~~~~~~~~~~~~~~~~~~~~~~~~~~

Okay to push to master?

Cheers,
Reinhold

PS: What about the straight flags glyphs that we already designed? Should we 
simply drop that and do a pure Scheme implementation with all its drawbacks 
(no proper hinting, as pointed out by Werner in Bug #652)?
Werner, should the get_subpath function still be moved from parmesan-macros.mf 
to feta-macros.mf, even though it is not really required there?

- -- 
- ------------------------------------------------------------------
Reinhold Kainhofer, Vienna University of Technology, Austria
email: [EMAIL PROTECTED], http://reinhold.kainhofer.com/
 * Financial and Actuarial Mathematics, TU Wien, http://www.fam.tuwien.ac.at/
 * K Desktop Environment, http://www.kde.org, KOrganizer maintainer
 * Chorvereinigung "Jung-Wien", http://www.jung-wien.at/
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v1.4.6 (GNU/Linux)

iD8DBQFIuHhbTqjEwhXvPN0RAgLLAKDU27hViONsoCNluvtAK6OdCzFBewCg1RCQ
k5xw7RTw9XQxaZ/ZQ1M+J/4=
=PL5Q
-----END PGP SIGNATURE-----
From 763040707f9c7776065b2c0b3104f93ad735cd62 Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <[EMAIL PROTECTED]>
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{()},
[EMAIL PROTECTED]'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<?
    ly:pitch?
+   ly:position-on-line?
    ly:round-filled-box
    ly:run-translator
    ly:set-option
-- 
1.5.4.3

_______________________________________________
lilypond-devel mailing list
lilypond-devel@gnu.org
http://lists.gnu.org/mailman/listinfo/lilypond-devel

Reply via email to