From 06a307a1cddf950cc3dd41f8fac49ced4c714ddd Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Fri, 5 May 2006 11:26:06 +0000 Subject: [PATCH] * scm/lily-library.scm (ordered-cons): new function. (interval-index): new function * lily/note-head-scheme.cc (LY_DEFINE): new file. * lily/note-head.cc (get_stem_attachment): new function. * scm/define-markup-commands.scm (note-by-number): read 'style property. * input/regression/markup-note.ly: show note-head style option. * mf/feta-bolletjes.mf (overdone_heads): fix attachment points for triangle head. --- ChangeLog | 18 ++++++++ input/regression/markup-note.ly | 79 +++++++++++++++++++-------------- lily/include/note-head.hh | 2 + lily/note-head-scheme.cc | 25 +++++++++++ lily/note-head.cc | 33 +++++++------- mf/feta-bolletjes.mf | 16 ++++--- scm/define-markup-commands.scm | 53 ++++++++++++++++------ scm/lily-library.scm | 16 +++++++ 8 files changed, 175 insertions(+), 67 deletions(-) create mode 100644 lily/note-head-scheme.cc diff --git a/ChangeLog b/ChangeLog index 85fbd261c4..a2130c3560 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,21 @@ +2006-05-05 Han-Wen Nienhuys + + * scm/lily-library.scm (ordered-cons): new function. + (interval-index): new function + + * lily/note-head-scheme.cc (LY_DEFINE): new file. + + * lily/note-head.cc (get_stem_attachment): new function. + + * scm/define-markup-commands.scm (note-by-number): read 'style + property. + + + * input/regression/markup-note.ly: show note-head style option. + + * mf/feta-bolletjes.mf (overdone_heads): fix attachment points for + triangle head. + 2006-05-04 Han-Wen Nienhuys * mf/GNUmakefile (NCSB_OTFS): remove old ncsb detection further. diff --git a/input/regression/markup-note.ly b/input/regression/markup-note.ly index 9061991ee7..e07b7dc4a5 100644 --- a/input/regression/markup-note.ly +++ b/input/regression/markup-note.ly @@ -5,39 +5,52 @@ } \version "2.7.39" -{ c4^\markup { - \note #"1" #1 - \note #"2" #1 - \note #"4" #1 - \note #"8" #1 - \note #"16" #1 - \note #"32" #1 - \note #"64" #1 - - \note #"1" #-1 - \note #"2" #-1 - \note #"4" #-1 - \note #"8" #-1 - \note #"16" #-1 - \note #"32" #-1 - \note #"64" #-1 - - \note #"1." #-1 - \note #"2." #-1 - \note #"4." #-1 - \note #"8." #-1 - \note #"16." #-1 - \note #"32." #-1 - \note #"64." #-1 - - \note #"1." #1 - \note #"2." #1 - \note #"4." #1 - \note #"8." #1 - \note #"16." #1 - \note #"32." #1 - \note #"64." #1 +\relative c'' +{ + c4^\markup { + \note #"1" #1 + \note #"2" #1 + \note #"4" #1 + \note #"8" #1 + \note #"16" #1 + \note #"32" #1 + \note #"64" #1 -} + \note #"1" #-1 + \note #"2" #-1 + \note #"4" #-1 + \note #"8" #-1 + \note #"16" #-1 + \note #"32" #-1 + \note #"64" #-1 + + \note #"1." #-1 + \note #"2." #-1 + \note #"4." #-1 + \note #"8." #-1 + \note #"16." #-1 + \note #"32." #-1 + \note #"64." #-1 + + \note #"1." #1 + \note #"2." #1 + \note #"4." #1 + \note #"8." #1 + \note #"16." #1 + \note #"32." #1 + \note #"64." #1 + + \override #'(style . cross) + { \note-by-number #2 #1 #1 + \note-by-number #2 #1 #-1 + } + \override #'(style . triangle) + { \note-by-number #2 #1 #1 + \note-by-number #2 #1 #-1 + } + + } + \override NoteHead #'style = #'triangle + c4 a } diff --git a/lily/include/note-head.hh b/lily/include/note-head.hh index 263ed5376f..55b1107f9f 100644 --- a/lily/include/note-head.hh +++ b/lily/include/note-head.hh @@ -26,6 +26,8 @@ public: static bool has_interface (Grob *); static Real stem_attachment_coordinate (Grob *, Axis a); static int get_balltype (Grob *); + + static Offset get_stem_attachment (Font_metric *, string); }; #endif // NOTEHEAD_HH diff --git a/lily/note-head-scheme.cc b/lily/note-head-scheme.cc new file mode 100644 index 0000000000..4b4c3e00a8 --- /dev/null +++ b/lily/note-head-scheme.cc @@ -0,0 +1,25 @@ +/* + note-head-scheme.cc -- implement Note_head bindings. + + source file of the GNU LilyPond music typesetter + + (c) 2006 Han-Wen Nienhuys + +*/ + +#include "note-head.hh" +#include "font-metric.hh" + + +LY_DEFINE(ly_note_head__stem_attachment, "ly:note-head::stem-attachment", + 2, 0, 0, (SCM font_metric, SCM glyph_name), + "Get attachment in @var{font-metric} for attaching a stem to notehead " + "@var{glyph-name}.") +{ + Font_metric *fm = unsmob_metrics (font_metric); + SCM_ASSERT_TYPE(fm, font_metric, SCM_ARG1, __FUNCTION__, "font metric"); + SCM_ASSERT_TYPE(scm_is_string (glyph_name), glyph_name, SCM_ARG2, __FUNCTION__, "string"); + + return ly_offset2scm (Note_head::get_stem_attachment (fm, ly_scm2string (glyph_name))); +} + diff --git a/lily/note-head.cc b/lily/note-head.cc index ef982c9925..5f86f6e401 100644 --- a/lily/note-head.cc +++ b/lily/note-head.cc @@ -26,9 +26,6 @@ using namespace std; #include "staff-symbol.hh" #include "warn.hh" -/* - clean up the mess left by ledger line handling. -*/ static Stencil internal_print (Grob *me, string *font_char) { @@ -47,21 +44,22 @@ internal_print (Grob *me, string *font_char) Font_metric *fm = Font_interface::get_default_font (me); string idx = "noteheads.s" + suffix; - Stencil out = fm->find_by_name (idx); if (out.is_empty ()) { string prefix = "noteheads."; + Grob *stem = unsmob_grob (me->get_object ("stem")); Direction stem_dir = stem ? get_grob_direction (stem) : CENTER; - + if (stem_dir == CENTER) programming_error ("must have stem dir for note head"); - + idx = prefix + ((stem_dir == UP) ? "u" : "d") + suffix; out = fm->find_by_name (idx); } + if (out.is_empty ()) { me->warning (_f ("note head `%s' not found", idx.c_str ())); @@ -107,15 +105,9 @@ Note_head::stem_attachment_coordinate (Grob *me, Axis a) return off [a]; } -MAKE_SCHEME_CALLBACK(Note_head, calc_stem_attachment, 1); -SCM -Note_head::calc_stem_attachment (SCM smob) +Offset +Note_head::get_stem_attachment (Font_metric *fm, string key) { - Grob *me = unsmob_grob (smob); - Font_metric *fm = Font_interface::get_default_font (me); - string key; - internal_print (me, &key); - Offset att; int k = fm->name_to_index (key); @@ -135,9 +127,20 @@ Note_head::calc_stem_attachment (SCM smob) } } - return ly_offset2scm (att); + return att; } +MAKE_SCHEME_CALLBACK(Note_head, calc_stem_attachment, 1); +SCM +Note_head::calc_stem_attachment (SCM smob) +{ + Grob *me = unsmob_grob (smob); + Font_metric *fm = Font_interface::get_default_font (me); + string key; + internal_print (me, &key); + + return ly_offset2scm (get_stem_attachment (fm, key)); +} int Note_head::get_balltype (Grob *me) diff --git a/mf/feta-bolletjes.mf b/mf/feta-bolletjes.mf index 1483af4d9f..7eda902975 100644 --- a/mf/feta-bolletjes.mf +++ b/mf/feta-bolletjes.mf @@ -336,6 +336,10 @@ endgroup enddef; +% +% +% UGH : xs not declared as argument. +% def define_triangle_shape (expr stemdir) = save triangle_a, triangle_b, triangle_c; save triangle_out_a, triangle_out_b, triangle_out_c; @@ -445,10 +449,10 @@ def define_triangle_shape (expr stemdir) = % attachment Y if stemdir = 1: charwy := ypart exact_right_point; - charwx := xpart exact_right_point; + charwx := xpart exact_right_point + .5 pen_thick# * xs; else: charwy := -ypart exact_down_point; - charwx := (width# - xpart exact_down_point); + charwx := (width# - xpart exact_down_point + xs * pen_thick#); fi enddef; @@ -503,14 +507,14 @@ def draw_small_triangle_head (expr dir) = enddef; -fet_beginchar ("Half trianglehead", "d1triangle"); +fet_beginchar ("Half trianglehead (downstem)", "d1triangle"); draw_small_triangle_head (-1); draw_staff (-2, 2, 0); fet_endchar; -fet_beginchar ("Half trianglehead", "u1triangle"); +fet_beginchar ("Half trianglehead (upstem)", "u1triangle"); draw_small_triangle_head (1); draw_staff (-2, 2, 0.5); @@ -531,14 +535,14 @@ def draw_closed_triangle_head (expr dir) = enddef; -fet_beginchar ("Quart trianglehead", "u2triangle"); +fet_beginchar ("Quart trianglehead (upstem)", "u2triangle"); draw_closed_triangle_head (1); draw_staff (-2, 2, 0); fet_endchar; -fet_beginchar ("Quart trianglehead", "d2triangle"); +fet_beginchar ("Quart trianglehead (downstem)", "d2triangle"); draw_closed_triangle_head (-1); draw_staff (-2, 2, 0.5); diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index 3485ef8b8b..436263ed47 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -1146,24 +1146,51 @@ figured bass notation" (define-markup-command (note-by-number layout props log dot-count dir) (number? number? number?) "Construct a note symbol, with stem. By using fractional values for @var{dir}, you can obtain longer or shorter stems." + (define (get-glyph-name-candidates dir log style) + (map (lambda (dir-name) + (format "noteheads.~a~a~a" dir-name (min log 2) + (if (and (symbol? style) + (not (equal? 'default style))) + (symbol->string style) + ""))) + (list (if (= dir UP) "u" "d") + "s"))) + + (define (get-glyph-name font cands) + (if (null? cands) + "" + (if (ly:stencil-empty? (ly:font-get-glyph font (car cands))) + (get-glyph-name font (cdr cands)) + (car cands)))) + (let* ((font (ly:paper-get-font layout (cons '((font-encoding . fetaMusic)) props))) - (size (chain-assoc-get 'font-size props 0)) - (stem-length (* (magstep size) (max 3 (- log 1)))) - (head-glyph (ly:font-get-glyph - font - (string-append "noteheads.s" (number->string (min log 2))))) - (stem-thickness 0.13) ;; TODO: should scale with font-size. + (size-factor (magstep (chain-assoc-get 'font-size props 0))) + (style (chain-assoc-get 'style props '())) + (stem-length (* size-factor (max 3 (- log 1)))) + (head-glyph-name (get-glyph-name font (get-glyph-name-candidates dir log style))) + (head-glyph (ly:font-get-glyph font head-glyph-name)) + (attach-indices (offset-scale + (ly:note-head::stem-attachment font head-glyph-name) dir)) + + (stem-thickness (* size-factor 0.13)) (stemy (* dir stem-length)) - (attachx (if (> dir 0) - (- (cdr (ly:stencil-extent head-glyph X)) stem-thickness) - 0)) - (attachy (* (magstep size) (* dir 0.28))) + (attach-off (cons (interval-index + (ly:stencil-extent head-glyph X) + (car attach-indices)) + (interval-index + (ly:stencil-extent head-glyph Y) + (cdr attach-indices)))) + (foo (display (list "attach idx" attach-indices " ext " + (ly:stencil-extent head-glyph X)))) + + (stem-glyph (and (> log 0) (ly:round-filled-box - (cons attachx (+ attachx stem-thickness)) - (cons (min stemy attachy) - (max stemy attachy)) + (ordered-cons (car attach-off) (+ (car attach-off) (* (- dir) stem-thickness))) + (cons (min stemy (cdr attach-off)) + (max stemy (cdr attach-off))) (/ stem-thickness 3)))) + (dot (ly:font-get-glyph font "dots.dot")) (dotwid (interval-length (ly:stencil-extent dot X))) (dots (and (> dot-count 0) diff --git a/scm/lily-library.scm b/scm/lily-library.scm index 6b2a8b4259..8ba25d5347 100644 --- a/scm/lily-library.scm +++ b/scm/lily-library.scm @@ -310,6 +310,10 @@ found." (define-public (offset-flip-y o) (cons (car o) (- (cdr o)))) +(define-public (offset-scale o scale) + (cons (* (car o) scale) + (* (cdr o) scale))) + (define-public (ly:list->offsets accum coords) (if (null? coords) accum @@ -335,8 +339,19 @@ found." (max 0 (- (cdr x) (car x)))) (define-public interval-start car) +(define-public (ordered-cons a b) + (cons (min a b) + (max a b))) + (define-public interval-end cdr) +(define-public (interval-index interval dir) + "Interpolate INTERVAL between between left (DIR=-1) and right (DIR=+1)" + + (* (+ (interval-start interval) (interval-end interval) + (* dir (- (interval-end interval) (interval-start interval)))) + 0.5)) + (define-public (interval-center x) "Center the number-pair X, when an interval" (if (interval-empty? x) @@ -370,6 +385,7 @@ found." (nan? (cdr i)) (inf? (cdr i))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; -- 2.39.5