From 3190769e772000a10192e865a9019416179d0115 Mon Sep 17 00:00:00 2001
From: hanwen <hanwen>
Date: Sun, 4 Jul 2004 22:23:28 +0000
Subject: [PATCH] * input/regression/beam-quant-standard.ly: new file: test
standard beam quants.
* scm/beam.scm (check-quant-callbacks): new function
(check-beam-quant): new function: check whether current beam
quants match argument.
* lily/beam-quanting.cc (score_forbidden_quants): fix problem with
forbidden quant for sitting (upstem)/hanging (downstem) on outer
staffline line.
---
ChangeLog | 15 ++++++
Documentation/topdocs/NEWS.texi | 2 +-
THANKS | 5 +-
input/regression/beam-quant-standard.ly | 66 +++++++++++++++++++++++++
lily/beam-quanting.cc | 11 ++++-
lily/grob-scheme.cc | 2 +-
lily/lexer.ll | 6 ++-
lily/parser.yy | 6 +++
scm/beam.scm | 37 ++++++++++++++
scm/define-grobs.scm | 4 +-
10 files changed, 145 insertions(+), 9 deletions(-)
create mode 100644 input/regression/beam-quant-standard.ly
diff --git a/ChangeLog b/ChangeLog
index a9224f4c5f..f9908737b5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,20 @@
+2004-07-05 Han-Wen Nienhuys <hanwen@xs4all.nl>
+
+ * input/regression/beam-quant-standard.ly: new file: test standard
+ beam quants.
+
+ * scm/beam.scm (check-quant-callbacks): new function
+ (check-beam-quant): new function: check whether current beam
+ quants match argument.
+
+ * lily/beam-quanting.cc (score_forbidden_quants): fix problem with
+ forbidden quant for sitting (upstem)/hanging (downstem) on outer
+ staffline line.
+
2004-07-04 Han-Wen Nienhuys <hanwen@xs4all.nl>
+ * lily/parser.yy (Generic_prefix_music_scm): add (scm,scm) music functions.
+
* lily/note-collision.cc (do_shifts): align colliding notes to
their leftmost note.
diff --git a/Documentation/topdocs/NEWS.texi b/Documentation/topdocs/NEWS.texi
index 0d5adb215c..11cbda4cd4 100644
--- a/Documentation/topdocs/NEWS.texi
+++ b/Documentation/topdocs/NEWS.texi
@@ -8,7 +8,7 @@
@itemize @bullet
-@item Collisions are now correctly aligned relative to notes in other staves.
+@item Colliding notes are now correctly aligned relative to notes in other staves.
@item An experimental GNOME output backend is available for developers.
It depends on several unreleased packages such as gnome-guile TLA and
diff --git a/THANKS b/THANKS
index 97fd22193d..595448a3ab 100644
--- a/THANKS
+++ b/THANKS
@@ -23,13 +23,14 @@ BUG HUNTERS/SUGGESTIONS
Dave Phillips
David Bobroff
David Brandon
+Heinz Stolba
+Kristof Bastiaensen
+Martin Norbäck
Peter Rosenbeck
Stephen Pollei
Bertalan Fodor
Thomas Scharlowski
Yuval Harel
-Martin Norbäck
-Kristof Bastiaensen
Release 2.2
diff --git a/input/regression/beam-quant-standard.ly b/input/regression/beam-quant-standard.ly
new file mode 100644
index 0000000000..4bf8cdfda7
--- /dev/null
+++ b/input/regression/beam-quant-standard.ly
@@ -0,0 +1,66 @@
+\header {
+
+ texidoc = "This file tests a few standard beam quants."
+
+}
+
+
+%
+% todo: make the check-quant function throw an error for incorrect quants
+%
+
+\paper { raggedright = ##t }
+
+
+%
+% #(ly:set-option 'debug-beam #t)
+
+assertquant =
+#(def-music-function (location l r) (pair? pair?)
+ (let* ((f (check-quant-callbacks l r)))
+
+ #{
+ \override Beam #'position-callbacks = $f
+ #}
+
+))
+
+
+\relative {
+ \assertquant #'(1 . 0) #'(1 . 0)
+ e8[ e]
+ e4
+ e4
+ \assertquant #'(2 . -1) #'(2 . -1)
+ f8[ f]
+ e4
+ e4
+ \assertquant #'(2 . 0) #'(2 . 0)
+ g8[ g]
+ e4
+ e4
+ \assertquant #'(2 . 1) #'(2 . 1)
+ a8[ a]
+ e4 e4 e4
+ \once \override Beam #'inspect-quants = #'(2.2 . 2.2)
+ a8[ a]
+ e4
+ e4
+
+ \assertquant #'(0 . 1) #'(1 . 0)
+ d8[ e]
+ e4
+ e4
+ \assertquant #'(1 . 0) #'(1 . 1)
+ e8[ f]
+ e4
+ e4
+ \assertquant #'(2 . -1) #'(2 . 0)
+ f8[ g]
+ e4
+ e4
+ \assertquant #'(2 . 0) #'(2 . 1)
+ g8[ a]
+ e4
+ e4
+ }
diff --git a/lily/beam-quanting.cc b/lily/beam-quanting.cc
index 25df72abb1..fc4ff9810c 100644
--- a/lily/beam-quanting.cc
+++ b/lily/beam-quanting.cc
@@ -476,8 +476,15 @@ Beam::score_forbidden_quants (Real yl, Real yr,
This test is too weak; we should really check all lines.
*/
Direction stem_dir = dirs[d];
- Real gap1 = y[d] - stem_dir * ((j-1) * beam_translation + thickness / 2 - slt/2 );
- Real gap2 = y[d] - stem_dir * (j * beam_translation - thickness / 2 + slt/2);
+
+ /*
+ The 2.2 factor is to provide a little leniency for
+ borderline cases. If we do 2.0, then the upper outer line
+ will be in the gap of the (2,sit) quant, leading to a
+ false demerit.
+ */
+ Real gap1 = y[d] - stem_dir * ((j-1) * beam_translation + thickness / 2 - slt/2.2 );
+ Real gap2 = y[d] - stem_dir * (j * beam_translation - thickness / 2 + slt/2.2);
Interval gap;
gap.add_point (gap1);
diff --git a/lily/grob-scheme.cc b/lily/grob-scheme.cc
index ce1438f064..7e3c05f74d 100644
--- a/lily/grob-scheme.cc
+++ b/lily/grob-scheme.cc
@@ -1,5 +1,5 @@
/*
- grob-scheme.cc --
+ grob-scheme.cc -- Scheme entry points for the grob datatype
source file of the GNU LilyPond music typesetter
diff --git a/lily/lexer.ll b/lily/lexer.ll
index 377e9f1e9b..7b517b90e6 100644
--- a/lily/lexer.ll
+++ b/lily/lexer.ll
@@ -913,6 +913,10 @@ music_function_type (SCM func)
{
return MUSIC_FUNCTION_SCM_MUSIC;
}
+ else if (type == ly_symbol2scm ("scm-scm"))
+ {
+ return MUSIC_FUNCTION_SCM_SCM;
+ }
else if (type == ly_symbol2scm ("music-music"))
{
return MUSIC_FUNCTION_MUSIC_MUSIC;
@@ -932,7 +936,7 @@ music_function_type (SCM func)
else
{
/* TODO: print location */
- error ("Can not find sigature for music function.");
+ error ("Can not find signature for music function.");
}
return MUSIC_FUNCTION_SCM;
diff --git a/lily/parser.yy b/lily/parser.yy
index 1c2712250f..a0c2170b51 100644
--- a/lily/parser.yy
+++ b/lily/parser.yy
@@ -353,6 +353,7 @@ or
%token <scm> MUSIC_FUNCTION_MUSIC
%token <scm> MUSIC_FUNCTION_MUSIC_MUSIC
%token <scm> MUSIC_FUNCTION_SCM
+%token <scm> MUSIC_FUNCTION_SCM_SCM
%token <scm> MUSIC_FUNCTION_SCM_MUSIC
%token <scm> MUSIC_FUNCTION_SCM_MUSIC_MUSIC
%token <scm> MUSIC_FUNCTION_SCM_SCM_MUSIC
@@ -988,6 +989,11 @@ Generic_prefix_music_scm:
$$ = scm_list_4 ($1, make_input (THIS->pop_spot ()), $3, $4->self_scm ());
scm_gc_unprotect_object ($4->self_scm ());
}
+ | MUSIC_FUNCTION_SCM_SCM {
+ THIS->push_spot ();
+ } embedded_scm embedded_scm {
+ $$ = scm_list_4 ($1, make_input (THIS->pop_spot ()), $3, $4);
+ }
| MUSIC_FUNCTION_MUSIC_MUSIC {
THIS->push_spot ();
} Music Music {
diff --git a/scm/beam.scm b/scm/beam.scm
index d20458eb53..ab79154115 100644
--- a/scm/beam.scm
+++ b/scm/beam.scm
@@ -59,3 +59,40 @@
(dir-compare (/ (car total) (car count)) (/ (cdr total) (cdr count)))
(dir-compare (car count) (cdr count))))
+
+(define ((check-beam-quant posl posr) beam)
+ "Check whether BEAM has POSL and POSR quants. POSL are (POSITION
+. QUANT) pairs, where QUANT is -1 (hang), 0 (center), 1 (sit) or -2/ 2 (inter)
+
+"
+ (let*
+ ((posns (ly:grob-property beam 'positions))
+ (thick (ly:grob-property beam 'thickness))
+ (paper (ly:grob-paper beam))
+ (lthick (ly:output-def-lookup paper 'linethickness))
+ (staff-thick lthick) ; fixme.
+ (quant->coord (lambda (p q)
+ (if (= 2 (abs q))
+ (+ p (/ q 4.0))
+ (+ p (- (* 0.5 q thick) (* 0.5 q lthick))))))
+ (want-l (quant->coord (car posl) (cdr posl)))
+ (want-r (quant->coord (car posr) (cdr posr)))
+ (almost-equal (lambda (x y) (< (abs (- x y)) 1e-3))))
+
+ (if (or (not (almost-equal want-l (car posns)))
+ (not (almost-equal want-r (cdr posns))))
+ (ly:warn
+ (format "Error in beam quanting found. Want (~S,~S) found (~S)."
+ want-l want-r posns
+ )))))
+
+(define-public (check-quant-callbacks l r)
+ (list Beam::least_squares
+ Beam::check_concave
+ Beam::slope_damping
+ Beam::shift_region_to_valid
+ Beam::quanting
+ (check-beam-quant l r)
+ ))
+
+
diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm
index dfedef5caa..8d18393e7c 100644
--- a/scm/define-grobs.scm
+++ b/scm/define-grobs.scm
@@ -964,8 +964,8 @@
;; FIXME this should come from 'lengths
-; (beamed-lengths . (3.26 3.26 1.5))
- (beamed-lengths . (3.5 3.5 3.5 4.5 5.0))
+ (beamed-lengths . (3.26 3.26 1.5))
+; (beamed-lengths . (3.5 3.5 3.5 4.5 5.0))
;; We use the normal minima as minimum for the ideal lengths,
;; and the extreme minima as abolute minimum length.
--
2.39.5