+2006-05-05 Han-Wen Nienhuys <hanwen@lilypond.org>
+
+ * 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 <hanwen@lilypond.org>
* mf/GNUmakefile (NCSB_OTFS): remove old ncsb detection further.
}
\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
}
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
--- /dev/null
+/*
+ note-head-scheme.cc -- implement Note_head bindings.
+
+ source file of the GNU LilyPond music typesetter
+
+ (c) 2006 Han-Wen Nienhuys <hanwen@lilypond.org>
+
+*/
+
+#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)));
+}
+
#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)
{
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 ()));
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);
}
}
- 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)
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;
% 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;
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);
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);
(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)
(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
(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)
(nan? (cdr i))
(inf? (cdr i)))))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
projects / lilypond.git / commitdiff