From a0a40c02de757661518577105dbb644a6ecdbc4d Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Tue, 12 Nov 2002 20:47:41 +0000 Subject: [PATCH] *** empty log message *** --- ChangeLog | 50 ++++++ Documentation/user/refman.itely | 22 +++ aclocal.m4 | 2 +- input/regression/measure-grouping.ly | 31 ++-- input/test/cluster.ly | 46 ++++++ lily/cluster.cc | 197 ++++++++++++++++++++++++ lily/include/cluster.hh | 25 +++ lily/include/lily-proto.hh | 1 + lily/include/lookup.hh | 2 + lily/include/side-position-interface.hh | 4 +- lily/ligature-bracket-engraver.cc | 3 +- lily/ligature-engraver.cc | 2 +- lily/line-spanner.cc | 6 +- lily/lookup.cc | 158 ++++++++++++++++++- lily/measure-grouping-engraver.cc | 9 +- lily/measure-grouping-spanner.cc | 15 +- lily/mensural-ligature-engraver.cc | 2 +- lily/moment.cc | 64 ++++++-- lily/note-heads-engraver.cc | 4 +- lily/parser.yy | 38 +---- lily/side-position-interface.cc | 33 +++- ly/engraver-init.ly | 1 + ly/spanners-init.ly | 3 +- mf/parmesan-heads.mf | 2 +- ps/music-drawing-routines.ps | 29 +++- scm/ascii-script.scm | 4 + scm/grob-description.scm | 17 +- scm/grob-property-description.scm | 11 +- scm/music-functions.scm | 39 +++++ scm/music-types.scm | 23 ++- scm/pdf.scm | 2 + scm/ps.scm | 10 +- scm/sketch.scm | 2 + scm/tex.scm | 6 + 34 files changed, 758 insertions(+), 105 deletions(-) create mode 100644 input/test/cluster.ly create mode 100644 lily/cluster.cc create mode 100644 lily/include/cluster.hh diff --git a/ChangeLog b/ChangeLog index 2f2d5ad5a2..c0339516c6 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,53 @@ +2002-11-11 Juergen Reuter + + * lily/include/lily-proto.hh, ly/engraver-init.ly, + ly/spanners-init.ly, scm/grob-description.scm, + scm/grob-property-description.scm, scm/music-types.scm, + lily/cluster-engraver.cc, lily/cluster.cc, + lily/include/cluster.hh, input/test/cluster.ly: cluster + implementation + + * lily/include/lookup.hh, lily/lookup.cc, scm/pdf.scm + ps/music-drawing-routines.ps, scm/ascii-script.scm, scm/ps.scm, + scm/sketch.scm, scm/tex.scm: support for dots and polygons added + + * lily/lookup.cc: bugfix: fixed infinite loop in frame () + + * mf/parmesan-heads.mf: bugfix: vaticana punctum set_char_box + + * scm/grob-description.scm: bugfix: by default, use default note + head style when engraving ligatures + + * lily/note-heads-engraver.cc: bugfix: do not steal ligature events + + * lily/mensural-ligature-engraver.cc: bugfix: accept ligature + events + + * lily/ligature-bracket-engraver.cc: bugfix: accept ligature events + + * input/test/ancient-font.ly: bugfix: style -> flag-style + + * lily/ligature-engraver.cc: indentation fix + + * lily/parser.yy: indentation fixes + +2002-11-09 Han-Wen Nienhuys + + * input/regression/measure-grouping.ly: more elaborate example. + + * lily/moment.cc: ly:add-moment, ly:mul-moment, + ly:div-moment. New functions + + * scm/music-functions.scm (set-time-signature): new function, + allow inline time sig settings with measure grouping. + + * lily/parser.yy (command_element): move time sig construction + into Scheme. + + * lily/side-position-interface.cc (out_of_staff): new function, + like padding, but keep minimum distance from staff. Easier than + linespanners (dynamics, pedals), but roughly the same effect. + 2002-11-10 Heikki Junes * emacs-mode.el: Added spanish-note-replacements diff --git a/Documentation/user/refman.itely b/Documentation/user/refman.itely index 23b02e40cb..7153f98b75 100644 --- a/Documentation/user/refman.itely +++ b/Documentation/user/refman.itely @@ -966,6 +966,28 @@ inserted, and how automatic beams should be generated. Changing the value of @code{timeSignatureFraction} also causes a time signature symbol to be printed. +More options are available through the Scheme function +@code{set-time-signature}. In combination with the +@internalsref{Measure_grouping_engraver}, it will create +@internalsref{MeasureGrouping} signs. Such signs ease reading +rhythmically complex modern music. In the following example, the 9/8 +measure is subdivided in 2, 2, 2 and 3. This is passed to +@code{set-time-signature} as the third argument @code{(2 2 2 3)}. + +@lilypond[verbatim] +\score { \notes \relative c'' { + #(set-time-signature 9 8 '(2 2 2 3)) + g8 g d d g g a8-[-( bes g-]-) | + #(set-time-signature 5 8 '(3 2)) + a4. g4 + } + \paper { + linewidth = -1.0 + \translator { \StaffContext + \consists "Measure_grouping_engraver" + }}} +@end lilypond + @c . {Partial} @subsection Partial @cindex Partial diff --git a/aclocal.m4 b/aclocal.m4 index e448f2e47a..d9e1e9e964 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -1,6 +1,6 @@ dnl aclocal.m4 -*-shell-script-*- dnl WARNING WARNING WARNING -dnl do not edit! this is aclocal.m4, generated from /home/fred/lily/stepmake/aclocal.m4 +dnl do not edit! this is aclocal.m4, generated from /home/hanwen/usr/src/lilypond/stepmake/aclocal.m4 dnl aclocal.m4 -*-shell-script-*- dnl StepMake subroutines for configure.in diff --git a/input/regression/measure-grouping.ly b/input/regression/measure-grouping.ly index 2eca7d467f..b67dc479f3 100644 --- a/input/regression/measure-grouping.ly +++ b/input/regression/measure-grouping.ly @@ -1,23 +1,30 @@ \header { -texidoc = "The Measure_grouping_engraver adds triangles and brackets above beats -when you set beatGrouping. -(unfinished.) -" + texidoc = "The Measure_grouping_engraver adds triangles and +brackets above beats when you set beatGrouping. This shows a fragment +of Steve Martland's Dance Works. " + } + +\version "1.7.6" + + +%% TODO: should have 2/4 + 5/8 time sig style. \score { \notes \context Staff - { - \time 8/4 - \property Staff.beatGrouping = #'(3 3) - c4 c c c - c4 - \property Staff.beatGrouping = #'() - c c c - + \relative c' { + #(set-time-signature 2 4) + c8 a'4 a8-~ + #(set-time-signature 5 8 '(3 2)) + a8 bes4 r8 bes8-> + \time 2/4 + c,8 g'4 g8-~ + #(set-time-signature 5 8 '(3 2)) + g8 a4 g a-> } \paper { + linewidth = -1.0 \translator { \StaffContext \consists "Measure_grouping_engraver" } diff --git a/input/test/cluster.ly b/input/test/cluster.ly new file mode 100644 index 0000000000..4765611c1d --- /dev/null +++ b/input/test/cluster.ly @@ -0,0 +1,46 @@ +\version "1.7.4" +\header { + texidoc = "cluster demo." +} + +voiceI = % same as voiceII, but with ordinary notes + \context Voice = voiceI { + \notes \relative c' { + \stemUp + c4 f4 + a4 | \break + < g8 a8 > < e8 a8 > a4 c1 < d4 b4 > e4 | + c4 a4 f4 g4 a4 + } + } + +voiceII = % same as voiceI, but with cluster notation + \context Voice = voiceII { + \notes \relative c' { + \property Thread.NoteHead \set #'transparent = ##t + \property Voice.Stem \set #'transparent = ##t + \property Voice.Beam \set #'transparent = ##t + \property Staff.Accidental \set #'transparent = ##t + \property Voice.Cluster \set #'padding = #0.25 + \property Voice.Cluster \set #'shape = #'ramp + c4 f4 + \startCluster + a4 | \break + %%% do not try something like: < { g8 e8 } a4 > + %%% instead, do the following: < g8 a8 > < e8 a8 > + < g8 a8 > < e8 a8 > a4 c1 < d4 b4 > e4 | + c4 \stopCluster a4 f4 g4 a4 + } + } + +\score { + \context PianoStaff { + < + \voiceI + \voiceII + > + } + \paper{ + linewidth = 15.0 \cm + } +} diff --git a/lily/cluster.cc b/lily/cluster.cc new file mode 100644 index 0000000000..96040f5e92 --- /dev/null +++ b/lily/cluster.cc @@ -0,0 +1,197 @@ +/* + cluster.cc -- implement Cluster + + source file of the GNU LilyPond music typesetter + + (c) 2002 Juergen Reuter +*/ + +#include +#include "cluster.hh" +#include "grob.hh" +#include "spanner.hh" +#include "item.hh" +#include "pitch.hh" +#include "staff-symbol-referencer.hh" +#include "lookup.hh" +#include "box.hh" +#include "interval.hh" +#include "paper-def.hh" +#include "paper-column.hh" + +/* + * TODO: Add support for cubic spline segments. + */ +Molecule +brew_cluster_piece (Grob *me, Array bottom_points, Array top_points) +{ +#if 0 + Real blotdiameter = me->get_paper ()->get_var ("blotdiameter"); +#else + Real blotdiameter = Staff_symbol_referencer::staff_space (me)/2; +#endif + + Real padding; + SCM padding_scm = me->get_grob_property ("padding"); + if (gh_number_p (padding_scm)) + padding = gh_scm2double (padding_scm); + else + padding = 0.0; + Offset vpadding = Offset (0, padding); + Offset hpadding = Offset (0.5 * blotdiameter, 0); + Offset hvpadding = 0.5 * hpadding + vpadding; + + SCM shape_scm = me->get_grob_property ("shape"); + String shape; + if (gh_symbol_p (shape_scm)) + { + shape = ly_symbol2string (shape_scm); + } + else + { + shape = "leftsided-stairs"; + } + + + Molecule out = Molecule (); + Array points; + points.clear (); + int size = bottom_points.size (); + if (String::compare (shape, "leftsided-stairs") == 0) + { + for (int i = 0; i < size - 1; i++) + { + Box box; + box.add_point (bottom_points[i] - hvpadding); + box.add_point (Offset(top_points[i + 1][X_AXIS], + top_points[i][Y_AXIS]) + hvpadding); + out.add_molecule (Lookup::roundfilledbox (box, blotdiameter)); + } + } + else if (String::compare (shape, "rightsided-stairs") == 0) + { + for (int i = 0; i < size - 1; i++) + { + Box box; + box.add_point (Offset(bottom_points[i][X_AXIS], + bottom_points[i + 1][Y_AXIS]) - hvpadding); + box.add_point (top_points[i + 1] + hvpadding); + out.add_molecule (Lookup::roundfilledbox (box, blotdiameter)); + } + } + else if (String::compare (shape, "centered-stairs") == 0) + { + Real left_xmid = bottom_points[0][X_AXIS]; + for (int i = 0; i < size - 1; i++) + { + Real right_xmid = + 0.5 * (bottom_points[i][X_AXIS] + bottom_points[i + 1][X_AXIS]); + Box box; + box.add_point (Offset (left_xmid, bottom_points[i][Y_AXIS]) - + hvpadding); + box.add_point (Offset (right_xmid, top_points[i][Y_AXIS]) + + hvpadding); + out.add_molecule (Lookup::roundfilledbox (box, blotdiameter)); + left_xmid = right_xmid; + } + Real right_xmid = bottom_points[size - 1][X_AXIS]; + Box box; + box.add_point (Offset (left_xmid, bottom_points[size - 1][Y_AXIS]) - + hvpadding); + box.add_point (Offset (right_xmid, top_points[size - 1][Y_AXIS]) + + hvpadding); + out.add_molecule (Lookup::roundfilledbox (box, blotdiameter)); + } + else if (String::compare (shape, "ramp") == 0) + { + points.push (bottom_points[0] - vpadding + hpadding); + for (int i = 1; i < size - 1; i++) + { + points.push (bottom_points[i] - vpadding); + } + points.push (bottom_points[size - 1] - vpadding - hpadding); + points.push (top_points[size - 1] + vpadding - hpadding); + for (int i = size - 2; i > 0; i--) + { + points.push (top_points[i] + vpadding); + } + points.push (top_points[0] + vpadding + hpadding); + out.add_molecule (Lookup::round_filled_polygon (points, blotdiameter)); + } + else + { + me->warning (_f ("unknown cluster shape `%s'", shape.to_str0 ())); + } + return out; +} + +MAKE_SCHEME_CALLBACK (Cluster,brew_molecule,1); +SCM +Cluster::brew_molecule (SCM smob) +{ + Grob *me = unsmob_grob (smob); + + Spanner *spanner = dynamic_cast (me); + if (!spanner) { + me->programming_error ("Cluster::brew_molecule(): not a spanner"); + return SCM_EOL; + } + + Item *left_bound = spanner->get_bound (LEFT); + Item *right_bound = spanner->get_bound (RIGHT); + bool right_broken = right_bound->break_status_dir () != CENTER; + + Grob *common = left_bound->common_refpoint (right_bound, X_AXIS); + + Grob *column = 0; + Array bottom_points; + Array top_points; + bottom_points.clear (); + top_points.clear (); + SCM column_scm = SCM_EOL; + for (SCM columns_scm = me->get_grob_property ("segments"); + columns_scm != SCM_EOL; + columns_scm = ly_cdr (columns_scm)) { + column_scm = ly_car (columns_scm); + SCM col_scm = ly_car (column_scm); + if (gh_number_p (col_scm)) + // broken spanner: this column not in this piece + if (!column) + continue; // still have to expect columns + else + break; // ok, we have seen all columns + column = unsmob_grob (col_scm); + column_scm = ly_cdr (column_scm); + Real y = 0.5 * gh_scm2double (ly_car (column_scm)); + column_scm = ly_cdr (column_scm); + Pitch *pitch_min = unsmob_pitch (ly_car (column_scm)); + column_scm = ly_cdr (column_scm); + Pitch *pitch_max = unsmob_pitch (ly_car (column_scm)); + Real height = 0.5 * (pitch_max->steps () - pitch_min->steps ()); + Real x = column->relative_coordinate (common, X_AXIS); + if (right_broken) + x -= left_bound->relative_coordinate (common, X_AXIS); + bottom_points.push (Offset (x, y)); + top_points.push (Offset (x, y + height)); + } + if (right_broken) + { + Real y = 0.5 * gh_scm2double (ly_car (column_scm)); + column_scm = ly_cdr (column_scm); + Pitch *pitch_min = unsmob_pitch (ly_car (column_scm)); + column_scm = ly_cdr (column_scm); + Pitch *pitch_max = unsmob_pitch (ly_car (column_scm)); + Real height = 0.5 * (pitch_max->steps () - pitch_min->steps ()); + Real x = + right_bound->relative_coordinate (common, X_AXIS) - + left_bound->relative_coordinate (common, X_AXIS); + bottom_points.push (Offset (x, y)); + top_points.push (Offset (x, y + height)); + } + Molecule out = brew_cluster_piece (me, bottom_points, top_points); + return out.smobbed_copy (); +} + +ADD_INTERFACE (Cluster,"cluster-interface", + "A graphically drawn musical cluster.", + "shape padding"); diff --git a/lily/include/cluster.hh b/lily/include/cluster.hh new file mode 100644 index 0000000000..ee2f21e56e --- /dev/null +++ b/lily/include/cluster.hh @@ -0,0 +1,25 @@ +/* + cluster.hh + + source file of the GNU LilyPond music typesetter + + (C) 2002 Juergen Reuter +*/ + +#ifndef CLUSTER_HH +#define CLUSTER_HH + +#include "lily-guile.hh" +#include "molecule.hh" + +class Cluster +{ +public: + DECLARE_SCHEME_CALLBACK (brew_molecule, (SCM )); + // DECLARE_SCHEME_CALLBACK (after_line_breaking, (SCM)); + static bool has_interface (Grob *); + // DECLARE_SCHEME_CALLBACK (set_spacing_rods, (SCM )); +}; + +#endif // CLUSTER_HH + diff --git a/lily/include/lily-proto.hh b/lily/include/lily-proto.hh index 0caeb2bd22..3b5c0b1cf1 100644 --- a/lily/include/lily-proto.hh +++ b/lily/include/lily-proto.hh @@ -41,6 +41,7 @@ class Break_algorithm; class Change_iterator; class Change_translator; class Chord_tremolo_iterator; +class Cluster_engraver; class Column_x_positions; class Context_specced_music; class Engraver; diff --git a/lily/include/lookup.hh b/lily/include/lookup.hh index e4ffb541b7..0c5712dd4d 100644 --- a/lily/include/lookup.hh +++ b/lily/include/lookup.hh @@ -18,8 +18,10 @@ struct Lookup { + static Molecule dot (Offset p, Real radius); static Molecule bracket (Axis a, Interval iv, Real thick, Real protude); static Molecule accordion (SCM arg, Real interline_f, Font_metric*fm); + static Molecule round_filled_polygon (Array points, Real blotdiameter); static Molecule frame (Box b, Real thick); static Molecule slur (Bezier controls, Real cthick, Real thick); static Molecule bezier_sandwich (Bezier top_curve, Bezier bottom_curve); diff --git a/lily/include/side-position-interface.hh b/lily/include/side-position-interface.hh index 2fa633f9d9..9e107eb9d4 100644 --- a/lily/include/side-position-interface.hh +++ b/lily/include/side-position-interface.hh @@ -25,7 +25,9 @@ public: DECLARE_SCHEME_CALLBACK (aligned_on_support_refpoints, (SCM element, SCM axis)); DECLARE_SCHEME_CALLBACK (aligned_side, (SCM element, SCM axis)); - + + DECLARE_SCHEME_CALLBACK (out_of_staff, (SCM element, SCM axis)); + DECLARE_SCHEME_CALLBACK (quantised_position, (SCM element, SCM axis)); static SCM general_side_position (Grob*, Axis, bool); diff --git a/lily/ligature-bracket-engraver.cc b/lily/ligature-bracket-engraver.cc index 9266ccce61..59e7687907 100644 --- a/lily/ligature-bracket-engraver.cc +++ b/lily/ligature-bracket-engraver.cc @@ -8,6 +8,7 @@ */ #include "ligature-engraver.hh" #include "spanner.hh" +#include "warn.hh" class Ligature_bracket_engraver : public Ligature_engraver { @@ -35,7 +36,7 @@ Ligature_bracket_engraver::create_ligature_spanner () ENTER_DESCRIPTION(Ligature_bracket_engraver, /* descr */ "Handles Ligature_events by engraving Ligature brackets.", /* creats*/ "LigatureBracket", -/* accepts */ "", +/* accepts */ "ligature-event abort-event", /* acks */ "ligature-head-interface rest-interface", /* reads */ "", /* write */ ""); diff --git a/lily/ligature-engraver.cc b/lily/ligature-engraver.cc index bc96697c58..31529c820c 100644 --- a/lily/ligature-engraver.cc +++ b/lily/ligature-engraver.cc @@ -171,7 +171,7 @@ Ligature_engraver::acknowledge_grob (Grob_info info) if (Ligature_head::has_interface (info.grob_)) { info.grob_->set_grob_property ("ligature-primitive-callback", - brew_ligature_primitive_proc); + brew_ligature_primitive_proc); } else if (Rest::has_interface (info.grob_)) { diff --git a/lily/line-spanner.cc b/lily/line-spanner.cc index 7ae32efb41..2ea7b57c64 100644 --- a/lily/line-spanner.cc +++ b/lily/line-spanner.cc @@ -294,8 +294,10 @@ Line_spanner::brew_molecule (SCM smob) ADD_INTERFACE (Line_spanner, "line-spanner-interface", - "Generic line drawn between two objects, eg. for use with glissandi. -gap is measured in staff-spaces. ", + "Generic line drawn between two objects, eg. for use with glissandi.\n" +"gap is measured in staff-spaces.\n" +"The property 'type is one of: line, dashed-line, trill, dotted-line or zigzag.\n" +"\n", "gap dash-period dash-length zigzag-width zigzag-length thickness type"); diff --git a/lily/lookup.cc b/lily/lookup.cc index 67022a606e..1783f95467 100644 --- a/lily/lookup.cc +++ b/lily/lookup.cc @@ -23,6 +23,21 @@ #include "molecule.hh" #include "lookup.hh" #include "font-metric.hh" +#include "interval.hh" + +Molecule +Lookup::dot (Offset p, Real radius) +{ + SCM at = (scm_list_n (ly_symbol2scm ("dot"), + gh_double2scm (p[X_AXIS]), + gh_double2scm (p[Y_AXIS]), + gh_double2scm (radius), + SCM_UNDEFINED)); + Box box; + box.add_point (p - Offset (radius, radius)); + box.add_point (p + Offset (radius, radius)); + return Molecule (box, at); +} Molecule Lookup::beam (Real slope, Real width, Real thick) @@ -158,18 +173,149 @@ Lookup::roundfilledbox (Box b, Real blotdiameter) return Molecule (b,at); } +/* + * Create Molecule that represents a filled polygon with round edges. + * + * LIMITATIONS: + * + * (a) Only outer (convex) edges are rounded. + * + * (b) This algorithm works as expected only for polygons whose edges + * do not intersect. For example, the polygon ((0, 0), (q, 0), (0, + * q), (q, q)) has an intersection at point (q/2, q/2) and therefore + * will give a strange result. Even non-adjacent edges that just + * touch each other will in general not work as expected for non-null + * blotdiameter. + * + * (c) Given a polygon ((x0, y0), (x1, y1), ... , (x(n-1), y(n-1))), + * if there is a natural number k such that blotdiameter is greater + * than the maximum of { | (x(k mod n), y(k mod n)) - (x((k+1) mod n), + * y((k+1) mod n)) |, | (x(k mod n), y(k mod n)) - (x((k+2) mod n), + * y((k+2) mod n)) |, | (x((k+1) mod n), y((k+1) mod n)) - (x((k+2) + * mod n), y((k+2) mod n)) | }, then the outline of the rounded + * polygon will exceed the outline of the core polygon. In other + * words: Do not draw rounded polygons that have a leg smaller or + * thinner than blotdiameter (or set blotdiameter to a sufficiently + * small value -- maybe even 0.0)! + * + * NOTE: Limitations (b) and (c) arise from the fact that round edges + * are made by moulding sharp edges to round ones rather than adding + * to a core filled polygon. For details of these two different + * approaches, see the thread upon the ledger lines patch that started + * on March 25, 2002 on the devel mailing list. The below version of + * round_filled_polygon() sticks to the moulding model, which the + * majority of the list participants finally voted for. This, + * however, results in the above limitations and a much increased + * complexity of the algorithm, since it has to compute a shrinked + * polygon -- which is not trivial define precisely and unambigously. + * With the other approach, one simply could move a circle of size + * blotdiameter along all edges of the polygon (which is what the + * postscript routine in the backend effectively does, but on the + * shrinked polygon). --jr + */ +Molecule +Lookup::round_filled_polygon (Array points, Real blotdiameter) +{ + /* TODO: Maybe print a warning if one of the above limitations + applies to the given polygon. However, this is quite complicated + to check. */ + + /* remove consecutive duplicate points */ + const Real epsilon = 0.01; + for (int i = 0; i < points.size ();) + { + int next_i = (i + 1) % points.size (); + Real d = (points[i] - points[next_i]).length (); + if (d < epsilon) + points.del (next_i); + else + i++; + } + + /* special cases: degenerated polygons */ + if (points.size () == 0) + return Molecule (); + if (points.size () == 1) + return dot (points[0], 0.5 * blotdiameter); + if (points.size () == 2) + return line (blotdiameter, points[0], points[1]); + + /* shrink polygon in size by 0.5 * blotdiameter */ + Array shrinked_points; + shrinked_points.set_size (points.size ()); + bool ccw = 1; // true, if three adjacent points are counterclockwise ordered + for (int i = 0; i < points.size (); i++) + { + int i0 = i; + int i1 = (i + 1) % points.size (); + int i2 = (i + 2) % points.size (); + Offset p0 = points[i0]; + Offset p1 = points[i1]; + Offset p2 = points[i2]; + Offset p10 = p0 - p1; + Offset p12 = p2 - p1; + if (p10.length () != 0.0) + { // recompute ccw + Real phi = p10.arg (); + // rotate (p2 - p0) by (-phi) + Offset q = complex_multiply (p2 - p0, complex_exp (Offset (1.0, -phi))); + + if (q[Y_AXIS] > 0) + ccw = 1; + else if (q[Y_AXIS] < 0) + ccw = 0; + else {} // keep ccw unchanged + } + else {} // keep ccw unchanged + Offset p10n = (1.0 / p10.length ()) * p10; // normalize length to 1.0 + Offset p12n = (1.0 / p12.length ()) * p12; + Offset p13n = 0.5 * (p10n + p12n); + Offset p14n = 0.5 * (p10n - p12n); + Offset p13; + Real d = p13n.length () * p14n.length (); // distance p3n to line(p1..p0) + if (d < epsilon) + // special case: p0, p1, p2 are on a single line => build + // vector orthogonal to (p2-p0) of length 0.5 blotdiameter + { + p13[X_AXIS] = p10[Y_AXIS]; + p13[Y_AXIS] = -p10[X_AXIS]; + p13 = (0.5 * blotdiameter / p13.length ()) * p13; + } + else + p13 = (0.5 * blotdiameter / d) * p13n; + shrinked_points[i1] = p1 + ((ccw) ? p13 : -p13); + } + + /* build scm expression and bounding box */ + SCM shrinked_points_scm = SCM_EOL; + Box box; + for (int i = 0; i < shrinked_points.size (); i++) + { + SCM x = gh_double2scm (shrinked_points[i][X_AXIS]); + SCM y = gh_double2scm (shrinked_points[i][Y_AXIS]); + shrinked_points_scm = gh_cons (x, gh_cons (y, shrinked_points_scm)); + box.add_point (points[i]); + } + SCM polygon_scm = scm_list_n (ly_symbol2scm ("polygon"), + ly_quote_scm (ly_quote_scm (shrinked_points_scm)), + gh_double2scm (blotdiameter), + SCM_UNDEFINED); + + Molecule polygon = Molecule (box, polygon_scm); + shrinked_points.clear (); + return polygon; +} + Molecule Lookup::frame (Box b, Real thick) { Molecule m; Direction d = LEFT; - Axis a = X_AXIS; - while (a < NO_AXES) + for (Axis a = X_AXIS; a < NO_AXES; a = Axis (a + 1)) { + Axis o = Axis ((a+1)%NO_AXES); do { - Axis o = Axis ((a+1)%NO_AXES); - Box edges; edges[a] = b[a][d] + 0.5 * thick * Interval (-1, 1); edges[o][DOWN] = b[o][DOWN] - thick/2; @@ -555,8 +701,8 @@ Molecule Lookup::triangle (Interval iv, Real thick, Real protude) { Box b ; - b[X_AXIS] =iv; - b[Y_AXIS] = Interval (0, protude); + b[X_AXIS] = iv; + b[Y_AXIS] = Interval (0 ? protude); SCM s = scm_list_n (ly_symbol2scm ("symmetric-x-triangle"), gh_double2scm (thick), diff --git a/lily/measure-grouping-engraver.cc b/lily/measure-grouping-engraver.cc index bbeab81854..6cebd1f42f 100644 --- a/lily/measure-grouping-engraver.cc +++ b/lily/measure-grouping-engraver.cc @@ -20,7 +20,7 @@ protected: Spanner * grouping_; Rational stop_grouping_mom_; - virtual void start_translation_timestep (); + virtual void process_music (); virtual void finalize (); virtual void acknowledge_grob (Grob_info); }; @@ -30,9 +30,9 @@ Measure_grouping_engraver::finalize() { if (grouping_) { - grouping_->set_bound (RIGHT, - unsmob_grob (get_property ("currentCommandColumn"))); + grouping_->set_bound (RIGHT, unsmob_grob (get_property ("currentCommandColumn"))); typeset_grob (grouping_); + grouping_->suicide (); grouping_= 0; } } @@ -48,12 +48,11 @@ Measure_grouping_engraver::acknowledge_grob (Grob_info gi) } void -Measure_grouping_engraver::start_translation_timestep () +Measure_grouping_engraver::process_music () { Moment now = now_mom(); if (grouping_ && now.main_part_ >= stop_grouping_mom_ && !now.grace_part_) { - Side_position_interface::add_staff_support (grouping_); grouping_->set_bound (RIGHT, unsmob_grob (get_property ("currentMusicalColumn"))); typeset_grob (grouping_); diff --git a/lily/measure-grouping-spanner.cc b/lily/measure-grouping-spanner.cc index 55c76ae277..3702becd27 100644 --- a/lily/measure-grouping-spanner.cc +++ b/lily/measure-grouping-spanner.cc @@ -28,26 +28,33 @@ Measure_grouping::brew_molecule (SCM grob) Real t = me->get_paper ()->get_var ("linethickness") * gh_scm2double (thick); Grob *common = me->get_bound(LEFT)->common_refpoint (me->get_bound (RIGHT), X_AXIS); - Real w = me->get_bound (LEFT)->relative_coordinate (common, X_AXIS) - - me->get_bound (RIGHT)->relative_coordinate (common, X_AXIS); + + Interval rext = me->get_bound (RIGHT)->extent (common, X_AXIS); + + + Real w =(rext.empty_b() + ? me->get_bound (RIGHT)->relative_coordinate (common, X_AXIS) + : rext[RIGHT]) + - me->get_bound (LEFT)->relative_coordinate (common, X_AXIS); Interval iv (0,w); Molecule m; if (which == ly_symbol2scm ("bracket")) { - m = Lookup::bracket (X_AXIS, iv,t, gh_scm2double (height)); + m = Lookup::bracket (X_AXIS, iv, t,-gh_scm2double (height)); } else if (which == ly_symbol2scm ("triangle")) { m = Lookup::triangle (iv, t, gh_scm2double (height)); } + m.align_to (Y_AXIS, DOWN); return m.smobbed_copy(); } ADD_INTERFACE (Measure_grouping,"measure-grouping-interface", "indicate groups of beats. Valid choices for 'type are 'bracket and 'triangle.", - "thickness height"); + "thickness type height"); diff --git a/lily/mensural-ligature-engraver.cc b/lily/mensural-ligature-engraver.cc index a2631238f1..436e49bf17 100644 --- a/lily/mensural-ligature-engraver.cc +++ b/lily/mensural-ligature-engraver.cc @@ -567,7 +567,7 @@ Mensural_ligature_engraver::acknowledge_grob (Grob_info info) ENTER_DESCRIPTION (Mensural_ligature_engraver, /* descr */ "Handles Mensural_ligature_events by glueing special ligature heads together.", /* creats*/ "MensuralLigature", -/* accepts */ "", +/* accepts */ "ligature-event abort-event", /* acks */ "ligature-head-interface note-head-interface rest-interface", /* reads */ "", /* write */ ""); diff --git a/lily/moment.cc b/lily/moment.cc index 3889df8ea0..2101b28d31 100644 --- a/lily/moment.cc +++ b/lily/moment.cc @@ -48,29 +48,61 @@ Moment::print_smob (SCM s, SCM port, scm_print_state *) TODO: add optional factor argument. */ LY_DEFINE (make_moment,"ly:make-moment", 2,0,0, (SCM n, SCM d), - "create the rational number with main timing @var{n}/@var{d}. + "create the rational number with main timing @var{n}/@var{d}. \n" +"\n" +"\n" +"Moment is a point in musical time. It is consists of a pair of\n" +"rationals (@var{m},@var{g}), where @var{m} is the timing for the main\n" +"notes, and @var{g} the timing for grace notes. In absence of grace\n" +"notes, @var{g} is zero.\n" +) +{ + SCM_ASSERT_TYPE(SCM_INUMP (n), n, SCM_ARG1, __FUNCTION__, "integer"); + SCM_ASSERT_TYPE(SCM_INUMP (d), d, SCM_ARG2, __FUNCTION__, "integer"); + return Moment (Rational (gh_scm2int (n), gh_scm2int (d))).smobbed_copy(); +} -Moment is a point in musical time. It is consists of a pair of -rationals (@var{m},@var{g}), where @var{m} is the timing for the main -notes, and @var{g} the timing for grace notes. In absence of grace -notes, @var{g} is zero. -") +LY_DEFINE (add_moment,"ly:add-moment", 2,0,0, (SCM a, SCM b), + "Add two moments." +) { - Moment m (Rational (1,1)); + Moment * ma = unsmob_moment (a); + Moment * mb = unsmob_moment (b); + SCM_ASSERT_TYPE (ma, a, SCM_ARG1, __FUNCTION__, "moment"); + SCM_ASSERT_TYPE (mb, b, SCM_ARG2, __FUNCTION__, "moment"); - if (SCM_INUMP (n) && SCM_INUMP (d)) - { - m = Moment (Rational (gh_scm2int (n), gh_scm2int (d))); - } - else - { - ::error ("make-moment takes two integer arguments. Using 1/1"); - } + return (*ma + *mb).smobbed_copy(); +} - return m.smobbed_copy (); + +LY_DEFINE (mul_moment,"ly:mul-moment", 2,0,0, (SCM a, SCM b), + "Multiply two moments." +) +{ + Moment * ma = unsmob_moment (a); + Moment * mb = unsmob_moment (b); + SCM_ASSERT_TYPE (ma, a, SCM_ARG1, __FUNCTION__, "moment"); + SCM_ASSERT_TYPE (mb, b, SCM_ARG2, __FUNCTION__, "moment"); + + return (*ma * *mb).smobbed_copy(); +} + + + +LY_DEFINE (div_moment,"ly:div-moment", 2,0,0, (SCM a, SCM b), + "Divide two moments." +) +{ + Moment * ma = unsmob_moment (a); + Moment * mb = unsmob_moment (b); + SCM_ASSERT_TYPE (ma, a, SCM_ARG1, __FUNCTION__, "moment"); + SCM_ASSERT_TYPE (mb, b, SCM_ARG2, __FUNCTION__, "moment"); + + return (*ma / *mb).smobbed_copy(); } + SCM Moment::equal_p (SCM a, SCM b) { diff --git a/lily/note-heads-engraver.cc b/lily/note-heads-engraver.cc index cec76bd2ee..9d19e641d5 100644 --- a/lily/note-heads-engraver.cc +++ b/lily/note-heads-engraver.cc @@ -64,8 +64,8 @@ Note_heads_engraver::try_music (Music *m) Urg ; this is not protocol. We should accept and return true, or ignore. */ - in_ligature = (m->get_mus_property("span-direction") - == gh_int2scm (START)); + in_ligature = (to_dir (m->get_mus_property("span-direction")) == START); + return false; } return false; diff --git a/lily/parser.yy b/lily/parser.yy index 3569fda94c..bb919029b6 100644 --- a/lily/parser.yy +++ b/lily/parser.yy @@ -1221,7 +1221,7 @@ command_element: $$ = MY_MAKE_MUSIC("EventChord"); $$->set_mus_property ("elements", scm_cons (l->self_scm (), SCM_EOL)); - scm_gc_unprotect_object (l->self_scm()); + scm_gc_unprotect_object (l->self_scm()); $$->set_spot (THIS->here_input ()); } | E_RIGHTSQUARE { @@ -1232,8 +1232,7 @@ command_element: $$ = MY_MAKE_MUSIC("EventChord"); $$->set_mus_property ("elements", scm_cons (l->self_scm (), SCM_EOL)); $$->set_spot (THIS->here_input ()); - scm_gc_unprotect_object (l->self_scm()); - + scm_gc_unprotect_object (l->self_scm()); } | E_BACKSLASH { $$ = MY_MAKE_MUSIC("VoiceSeparator"); @@ -1277,34 +1276,13 @@ command_element: $$ = unsmob_music (result); } | TIME_T fraction { - Music * p1 = set_property_music (ly_symbol2scm ( "timeSignatureFraction"), $2); - - int l = gh_scm2int (ly_car ($2)); - int o = gh_scm2int (ly_cdr ($2)); - - Moment one_beat = Moment (1)/Moment (o); - Moment len = Moment (l) * one_beat; - - - Music *p2 = set_property_music (ly_symbol2scm ("measureLength"), len.smobbed_copy ()); - Music *p3 = set_property_music (ly_symbol2scm ("beatLength"), one_beat.smobbed_copy ()); - - SCM list = scm_list_n (p1->self_scm (), p2->self_scm (), p3->self_scm(), SCM_UNDEFINED); - Music *seq = MY_MAKE_MUSIC("SequentialMusic"); - seq->set_mus_property ("elements", list); - - - Music * sp = MY_MAKE_MUSIC("ContextSpeccedMusic"); - sp->set_mus_property ("element", seq->self_scm ()); - - scm_gc_unprotect_object (p3->self_scm ()); - scm_gc_unprotect_object (p2->self_scm ()); - scm_gc_unprotect_object (p1->self_scm ()); - scm_gc_unprotect_object (seq->self_scm ()); - - $$ = sp; + static SCM proc; + if (!proc) + proc = scm_c_eval_string ("make-time-signature-set"); - sp-> set_mus_property ("context-type", scm_makfrom0str ( "Timing")); + SCM result = scm_apply_2 (proc, gh_car ($2), gh_cdr ($2), SCM_EOL); + scm_gc_protect_object (result); + $$ = unsmob_music (result); } ; diff --git a/lily/side-position-interface.cc b/lily/side-position-interface.cc index d3b0f2a9e1..08e4d0bbb9 100644 --- a/lily/side-position-interface.cc +++ b/lily/side-position-interface.cc @@ -211,6 +211,37 @@ Side_position_interface::aligned_side (SCM element_smob, SCM axis) return gh_double2scm (o); } +/* + Maintain a minimum distance to the staff. This is similar to side + position with padding, but it will put adjoining objects on a row if + stuff sticks out of the staff a little. + */ +MAKE_SCHEME_CALLBACK (Side_position_interface,out_of_staff,2); +SCM +Side_position_interface::out_of_staff (SCM element_smob, SCM axis) +{ + Grob *me = unsmob_grob (element_smob); + Axis a = (Axis) gh_scm2int (axis); + + Grob * st = Staff_symbol_referencer::get_staff_symbol (me); + + if (!st) + return gh_int2scm (0); + + Real padding=0.0; + SCM spad = me->get_grob_property ("staff-padding"); + + if (gh_number_p (spad)) + padding = gh_scm2double (spad); + + Grob *common = me->common_refpoint (st, Y_AXIS); + Direction d = Side_position_interface::get_direction (me); + Interval staff_size = st->extent (common, Y_AXIS); + Interval me_ext = me->extent (common, a); + Real diff = d*staff_size[d] + padding - d*me_ext[-d]; + return gh_double2scm (diff >? 0); +} + void Side_position_interface::add_staff_support (Grob*me) { @@ -275,4 +306,4 @@ ADD_INTERFACE (Side_position_interface,"side-position-interface", "support). In this case, the direction signifies where to put the " "victim object relative to the support (left or right, up or down?) " , - "side-support-elements direction-source direction side-relative-direction minimum-space padding"); + "staff-padding side-support-elements direction-source direction side-relative-direction minimum-space padding"); diff --git a/ly/engraver-init.ly b/ly/engraver-init.ly index da2571f6bc..22d48f70a8 100644 --- a/ly/engraver-init.ly +++ b/ly/engraver-init.ly @@ -160,6 +160,7 @@ VoiceContext = \translator { \consists "Script_column_engraver" \consists "Rhythmic_column_engraver" \consists "Phrasing_slur_engraver" + \consists "Cluster_engraver" \consists "Slur_engraver" \consists "Tie_engraver" \consists "New_tie_engraver" diff --git a/ly/spanners-init.ly b/ly/spanners-init.ly index 4d022cc0d7..78d81ad999 100644 --- a/ly/spanners-init.ly +++ b/ly/spanners-init.ly @@ -1,6 +1,7 @@ \version "1.7.3" - +startCluster = #(make-span-event 'ClusterEvent START) +stopCluster = #(make-span-event 'ClusterEvent STOP) groupOpen = #(make-span-event 'NoteGroupingEvent START) groupClose = #(make-span-event 'NoteGroupingEvent STOP) diff --git a/mf/parmesan-heads.mf b/mf/parmesan-heads.mf index 49c964d937..d53c2e75ef 100644 --- a/mf/parmesan-heads.mf +++ b/mf/parmesan-heads.mf @@ -309,7 +309,7 @@ def punctum_char (expr verbose_name, internal_name, mudela_name, 2beta# = ht# * b_h; a# = beta# * a_b; wd# = 2a# / a_w; - set_char_box(0.50wd#, 0.10wd#, 0.5ht#, 0); + set_char_box(0.00wd#, 0.40wd#, 0.5ht#, 0); black_notehead_width# := wd#; % direction diff --git a/ps/music-drawing-routines.ps b/ps/music-drawing-routines.ps index 338272affd..75d7bbaa42 100644 --- a/ps/music-drawing-routines.ps +++ b/ps/music-drawing-routines.ps @@ -48,14 +48,13 @@ } bind def -/draw_symmetric_x_triangle % th w h +/draw_symmetric_x_triangle % h w th { setlinewidth 0 0 moveto - dup - 0 rlineto - 2 div - exch rlineto + dup 0 lineto + 2 div + exch lineto 0 0 lineto stroke } bind def @@ -119,6 +118,26 @@ } ifelse } bind def +/draw_polygon % x(n) y(n) x(n-1) y(n-1) ... x(1) y(1) n blot +{ + /blot exch def + + 0 setlinecap + blot setlinewidth + 1 setlinejoin + + /points exch def + 2 copy + moveto + 1 1 points {pop lineto} for + currentdict /testing known { + %% outline only, for testing: + stroke + }{ + closepath gsave stroke grestore fill + } ifelse +} bind def + /draw_repeat_slash % width slope thick { 1 setlinecap diff --git a/scm/ascii-script.scm b/scm/ascii-script.scm index c964fcf52f..d53cfb366f 100644 --- a/scm/ascii-script.scm +++ b/scm/ascii-script.scm @@ -85,6 +85,8 @@ sheet)) +(define (dot x y radius) "") ;; TODO + (define (beam width slope thick) (string-append (func "set-line-char" "#") @@ -128,6 +130,8 @@ (func "put" "/") ))) +(define (polygon points blotdiameter) "") ;; TODO + (define (char i) (func "char" i)) diff --git a/scm/grob-description.scm b/scm/grob-description.scm index 2b5e39b0f4..9aad6e3c75 100644 --- a/scm/grob-description.scm +++ b/scm/grob-description.scm @@ -231,6 +231,16 @@ (meta . ((interfaces . (clef-interface staff-symbol-referencer-interface font-interface break-aligned-interface item-interface )))) )) + (Cluster + . ( + (molecule-callback . ,Cluster::brew_molecule) + (spacing-procedure . ,Spanner::set_spacing_rods) + (minimum-length . 0.0) + (padding . 0.25) + (shape . leftsided-stairs) + (meta . ((interfaces . (cluster-interface spanner-interface)))) + )) + (ChordName . ( (molecule-callback . ,Chord_name::brew_molecule) @@ -448,7 +458,7 @@ (Y-offset-callbacks . (,Staff_symbol_referencer::callback)) (stem-attachment-function . ,note-head-style->attachment-coordinates) (font-family . ancient) - (style . mensural) + (style . default) (glyph-name-procedure . ,find-notehead-symbol) (meta . ((interfaces . (ligature-head-interface rhythmic-head-interface font-interface @@ -533,9 +543,10 @@ (MeasureGrouping . ( - (Y-offset-callbacks . (,Side_position_interface::aligned_side)) + (Y-offset-callbacks . (,Side_position_interface::out_of_staff + ,Side_position_interface::aligned_side)) (molecule-callback . ,Measure_grouping::brew_molecule) - (meta . ((interfaces . (spanner-interface measure-grouping-interface)))) + (meta . ((interfaces . (spanner-interface measure-grouping-interface)))) (staff-padding . 3) (padding . 2) (direction . 1) (thickness . 1) diff --git a/scm/grob-property-description.scm b/scm/grob-property-description.scm index bef73be012..a64711dba4 100644 --- a/scm/grob-property-description.scm +++ b/scm/grob-property-description.scm @@ -384,6 +384,7 @@ reference point. TODO: revise typing.") (grob-property-description 'self-alignment-Y number? "like self-alignment-X but for Y axis.") +(grob-property-description 'shape symbol? "shape of cluster segments. Valid values include 'leftsided-stairs', 'rightsided-stairs', 'centered-stairs', and 'ramp'.") (grob-property-description 'shorten number? "the amount of space that a stem should be shortened (DOCME!)") (grob-property-description 'shorten-pair number-pair? "the length on each side to shorten a text-spanner, for example a pedal bracket") (grob-property-description 'common-shortest-duration ly:moment? @@ -509,9 +510,6 @@ Like @code{bracket-visibility}, but for the number.") (grob-property-description 'tie ly:grob? "") (grob-property-description 'type symbol? " -one of: line, dashed-line, trill, dotted-line or zigzag. - -[FIXME: type is too generic for this doc, move doco to interface] ") (grob-property-description 'break-visibility procedure? "a function that takes the break direction and returns a cons of booleans containing (TRANSPARENT . EMPTY). @@ -567,6 +565,13 @@ columns. (grob-property-description 'cause scheme? "Any kind of causation objects (i.e. music, or perhaps translator) that was the cause for this grob. ") (grob-property-description 'font ly:font-metric? "Cached font metric object") (grob-property-description 'break-alignment-done boolean? "mark flag to signal we've done alignment already.") +(grob-property-description + 'staff-padding number? + "Maintain this much space to the staff. It's effect is similar to +the padding mechanism, but this will keep objects above and below the +staff in a row more often, when the heights of the notes vary. +") + (grob-property-description 'staff-symbol ly:grob? "the staff symbol grob that we're in.") (grob-property-description 'collision-done boolean? "") (grob-property-description 'rest ly:grob? "the staff symbol grob that we're in.") diff --git a/scm/music-functions.scm b/scm/music-functions.scm index 855add04dc..95b83cb1d6 100644 --- a/scm/music-functions.scm +++ b/scm/music-functions.scm @@ -236,6 +236,44 @@ this is not an override )) )) + +(define-public (make-property-set sym val) + (let* + ( + (m (make-music-by-name 'PropertySet)) + ) + (ly:set-mus-property! m 'symbol sym) + (ly:set-mus-property! m 'value val) + m + )) + +(define-public (make-time-signature-set num den . rest) + " Set properties for time signature NUM/DEN. +Rest can contain a list of beat groupings + +" + + (let* + ( + (set1 (make-property-set 'timeSignatureFraction (cons num den) )) + (beat (ly:make-moment 1 den)) + (len (ly:make-moment num den)) + (set2 (make-property-set 'beatLength beat)) + (set3 (make-property-set 'measureLength len)) + (set4 (make-property-set 'beatGrouping (if (pair? rest) + (car rest) + '()))) + (basic (list set1 set2 set3 set4)) + + ) + + (context-spec-music + (make-sequential-music basic) "Timing"))) + +(define-public (set-time-signature num den . rest) + (ly:export (apply make-time-signature-set `(,num ,den . ,rest))) + ) + (define-public (make-penalty-music pen) (let ((m (make-music-by-name 'BreakEvent))) @@ -368,6 +406,7 @@ this is not an override (not (eq? #f (memq symbol (ly:get-grob-property elt 'interfaces)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; warn for bare chords at start. diff --git a/scm/music-types.scm b/scm/music-types.scm index c8e223aa33..6b68a6226c 100644 --- a/scm/music-types.scm +++ b/scm/music-types.scm @@ -95,6 +95,13 @@ c8-[ c c-] c8") (internal-class-name . "Event") (types . (general-music event busy-playing-event)) )) + (ClusterEvent + . ( + (description . "Begins or ends a cluster.") + + (internal-class-name . "Event") + (types . (general-music cluster-event event)) + )) (ContextSpeccedMusic . ( (description . "") @@ -167,6 +174,14 @@ c8-[ c c-] c8") (internal-class-name . "Key_change_req") (types . (general-music key-change-event event)) )) + (LigatureEvent + . ( + (description . "") + + (internal-class-name . "Event") + (span-type . ligature) + (types . (general-music span-event ligature-event event)) + )) (LyricCombineMusic . ( (description . "") @@ -184,14 +199,6 @@ c8-[ c c-] c8") (internal-class-name . "Event") (types . (general-music rhythmic-event lyric-event event)) )) - (LigatureEvent - . ( - (description . "") - - (internal-class-name . "Event") - (span-type . ligature) - (types . (general-music event span-event ligature-event)) - )) (MarkEvent . ( (description . "") diff --git a/scm/pdf.scm b/scm/pdf.scm index 900854ed43..004f37e9a5 100644 --- a/scm/pdf.scm +++ b/scm/pdf.scm @@ -230,6 +230,8 @@ (define (text s) "") +(define (polygon points blotdiameter) "") ;; TODO + (define (draw-line thick fx fy tx ty) (string-append (setlineparams) (setlinewidth thick) diff --git a/scm/ps.scm b/scm/ps.scm index 3d1e99034f..29d14c0e5b 100644 --- a/scm/ps.scm +++ b/scm/ps.scm @@ -77,7 +77,7 @@ (define (symmetric-x-triangle thick w h) (string-append - (numbers->string (list thick w h )) + (numbers->string (list h w thick)) " draw_symmetric_x_triangle")) @@ -190,6 +190,14 @@ (ly:number->string y2) " lineto stroke")) +(define (polygon points blotdiameter) + (string-append + " " + (numbers->string points) + (ly:number->string (/ (length points) 2)) + (ly:number->string blotdiameter) + " draw_polygon")) + (define (end-output) "\nend-lilypond-output\n") diff --git a/scm/sketch.scm b/scm/sketch.scm index 532183942c..42d9e0da57 100644 --- a/scm/sketch.scm +++ b/scm/sketch.scm @@ -184,6 +184,8 @@ (define (roundfilledbox x y dx dy w h b) (sketch-filled-rectangle w 0 0 h x y)) +(define (polygon points blotdiameter) "") ;; TODO + (define (select-font name-mag-pair) ;; name-mag-pair: (quote ("feta20" . 0.569055118110236))"feta20"(quote ("feta20" . 0.569055118110236)) (let ((f (assoc (caadr name-mag-pair) font-alist))) diff --git a/scm/tex.scm b/scm/tex.scm index 41b43d2d68..af3470c02e 100644 --- a/scm/tex.scm +++ b/scm/tex.scm @@ -81,6 +81,9 @@ )) +(define (dot x y radius) + (embedded-ps (list 'dot x y radius))) + (define (beam width slope thick) (embedded-ps (list 'beam width slope thick))) @@ -260,6 +263,9 @@ (define (tuplet ht gapx dx dy thick dir) (embedded-ps (list 'tuplet ht gapx dx dy thick dir))) +(define (polygon points blotdiameter) + (embedded-ps (list 'polygon points blotdiameter))) + (define (draw-line thick fx fy tx ty) (embedded-ps (list 'draw-line thick fx fy tx ty))) -- 2.39.2