From 12186b6828aee7aa298076d684835d629b757f2a Mon Sep 17 00:00:00 2001 From: Jan Nieuwenhuizen Date: Wed, 25 Feb 2004 18:29:38 +0000 Subject: [PATCH] * scm/define-markup-commands.scm (smallcaps): New markup command. * scm/output-ps.scm (output-scopes): Experimental markup output. * lily/stencil-scheme.cc (ly_stencil_get_expr): New accessor. * lily/paper-outputter.cc (output_metadata): Add parameter PAPER. --- ChangeLog | 17 +++ lily/include/paper-outputter.hh | 2 +- lily/paper-outputter.cc | 3 +- lily/paper-score.cc | 10 +- lily/stencil-scheme.cc | 193 ++++++++++++++++---------------- lily/stencil.cc | 51 +++------ scm/auto-beam.scm | 12 +- scm/clef.scm | 180 ++++++++++++++--------------- scm/define-grobs.scm | 4 +- scm/define-markup-commands.scm | 22 ++-- scm/define-music-types.scm | 6 + scm/document-functions.scm | 7 ++ scm/document-markup.scm | 6 + scm/document-music.scm | 6 + scm/document-translation.scm | 12 +- scm/font.scm | 20 ++-- scm/new-markup.scm | 6 + scm/output-pdf.scm | 10 +- scm/output-pdftex.scm | 16 +-- scm/output-ps.scm | 118 ++++++++++++------- scm/output-tex.scm | 14 +-- scm/paper.scm | 40 +++---- scm/script.scm | 5 + scm/stencil.scm | 94 ++++++++-------- scm/to-xml.scm | 6 + 25 files changed, 450 insertions(+), 410 deletions(-) diff --git a/ChangeLog b/ChangeLog index 6714fa7e4b..3353b326a2 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,20 @@ +2004-02-25 Jan Nieuwenhuizen + + * scm/define-markup-commands.scm (smallcaps): New markup command. + + * scm/output-ps.scm (output-scopes): Experimental markup output. + + * scm/: Add missing headers. + + * lily/stencil-scheme.cc (ly_stencil_get_expr): New accessor. + + * lily/paper-outputter.cc (output_metadata): Add parameter PAPER. + +2004-02-25 Jan Nieuwenhuizen + + * lily/stencil-scheme.cc (ly_stencil_get_expr): New function. + Stray style cleanups. + 2004-02-25 Han-Wen Nienhuys * lily/note-collision.cc (check_meshing_chords): bugfix for dot / diff --git a/lily/include/paper-outputter.hh b/lily/include/paper-outputter.hh index 14d357664e..82c3594522 100644 --- a/lily/include/paper-outputter.hh +++ b/lily/include/paper-outputter.hh @@ -38,7 +38,7 @@ public: void dump_scheme (SCM); - void output_metadata (SCM); + void output_metadata (SCM, Paper_def*); void output_music_output_def (Music_output_def* odef); void output_scheme (SCM scm); }; diff --git a/lily/paper-outputter.cc b/lily/paper-outputter.cc index 561c830387..5e64c895b5 100644 --- a/lily/paper-outputter.cc +++ b/lily/paper-outputter.cc @@ -58,7 +58,7 @@ Paper_outputter::output_scheme (SCM scm) } void -Paper_outputter::output_metadata (SCM scopes) +Paper_outputter::output_metadata (SCM scopes, Paper_def *paper) { SCM fields = SCM_EOL; for (int i = dump_header_fieldnames_global.size (); i--;) @@ -66,6 +66,7 @@ Paper_outputter::output_metadata (SCM scopes) fields); output_scheme (scm_list_n (ly_symbol2scm ("output-scopes"), + paper->self_scm (), scm_list_n (ly_symbol2scm ("quote"), scopes, SCM_UNDEFINED), scm_list_n (ly_symbol2scm ("quote"), diff --git a/lily/paper-score.cc b/lily/paper-score.cc index 9037d8dd8a..79a8266930 100644 --- a/lily/paper-score.cc +++ b/lily/paper-score.cc @@ -106,16 +106,12 @@ Paper_score::process (String outname) Last one first. */ if (header_) - { - scopes = scm_cons (header_, scopes); - } + scopes = scm_cons (header_, scopes); if (global_input_file->header_ && global_input_file->header_ != header_) - { - scopes = scm_cons (global_input_file->header_, scopes); - } + scopes = scm_cons (global_input_file->header_, scopes); - outputter_->output_metadata (scopes); + outputter_->output_metadata (scopes, paper_); outputter_->output_music_output_def (paper_); SCM scm = scm_list_n (ly_symbol2scm ("header-end"), SCM_UNDEFINED); diff --git a/lily/stencil-scheme.cc b/lily/stencil-scheme.cc index 40905bfdeb..dd902cadd7 100644 --- a/lily/stencil-scheme.cc +++ b/lily/stencil-scheme.cc @@ -1,97 +1,102 @@ /* - stencil-scheme.cc -- implement Stencil + stencil-scheme.cc -- implement Stencil scheme accessors source file of the GNU LilyPond music typesetter (c) 1997--2004 Han-Wen Nienhuys */ -#include "stencil.hh" #include "font-metric.hh" +#include "stencil.hh" -LY_DEFINE(ly_stencil_set_extent_x,"ly:stencil-set-extent!", 3 , 0, 0, - (SCM mol, SCM axis, SCM np), - "Set the extent (@var{extent} must be a pair of numbers) of @var{mol} in \n" - "@var{axis} direction (0 or 1 for x- and y-axis respectively).\n" - ) +LY_DEFINE (ly_stencil_set_extent_x,"ly:stencil-set-extent!", 3 , 0, 0, + (SCM stil, SCM axis, SCM np), + "Set the extent of @var{stil} " + "(@var{extent} must be a pair of numbers) " + "in @var{axis} direction (0 or 1 for x- and y-axis respectively).") { - Stencil* m = unsmob_stencil (mol); - SCM_ASSERT_TYPE (m, mol, SCM_ARG1, __FUNCTION__, "stencil"); + Stencil *s = unsmob_stencil (stil); + SCM_ASSERT_TYPE (s, stil, SCM_ARG1, __FUNCTION__, "stencil"); SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG2, __FUNCTION__, "axis"); SCM_ASSERT_TYPE (is_number_pair (np), np, SCM_ARG3, __FUNCTION__, "number pair"); Interval iv = ly_scm2interval (np); - m->dim_[Axis (gh_scm2int (axis))] = iv; + s->dim_[Axis (gh_scm2int (axis))] = iv; return SCM_UNDEFINED; } - -LY_DEFINE(ly_translate_stencil_axis,"ly:stencil-translate-axis", 3, 0, 0, - (SCM mol, SCM amount, SCM axis), - "Return a @var{mol}, but translated by @var{amount} in @var{axis} direction") +LY_DEFINE (ly_translate_stencil_axis,"ly:stencil-translate-axis", 3, 0, 0, + (SCM stil, SCM amount, SCM axis), + "Return a @var{stil}, " + "but translated by @var{amount} in @var{axis} direction.") { - Stencil* m = unsmob_stencil (mol); - SCM_ASSERT_TYPE (m, mol, SCM_ARG1, __FUNCTION__, "stencil"); + Stencil *s = unsmob_stencil (stil); + SCM_ASSERT_TYPE (s, stil, SCM_ARG1, __FUNCTION__, "stencil"); SCM_ASSERT_TYPE (gh_number_p (amount), amount, SCM_ARG2, __FUNCTION__, "number pair"); SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis"); - - Stencil q (*m); + Stencil q (*s); q.translate_axis (gh_scm2double (amount), Axis (gh_scm2int (axis))); return q.smobbed_copy(); } -LY_DEFINE(ly_translate_stencil,"ly:stencil-translate", 2, 0, 0, - (SCM mol, SCM offset), - "Return a @var{mol}, but translated by @var{offset} (a pair of numbers).") +LY_DEFINE (ly_translate_stencil,"ly:stencil-translate", 2, 0, 0, + (SCM stil, SCM offset), + "Return a @var{stil}, " + "but translated by @var{offset} (a pair of numbers).") { - Stencil* m = unsmob_stencil (mol); - SCM_ASSERT_TYPE (m, mol, SCM_ARG1, __FUNCTION__, "stencil"); + Stencil *s = unsmob_stencil (stil); + SCM_ASSERT_TYPE (s, stil, SCM_ARG1, __FUNCTION__, "stencil"); SCM_ASSERT_TYPE (is_number_pair (offset), offset, SCM_ARG2, __FUNCTION__, "number pair"); Offset o = ly_scm2offset (offset); - Stencil q (*m); + Stencil q (*s); q.translate (o); return q.smobbed_copy(); } -LY_DEFINE(ly_stencil_get_extent, - "ly:stencil-get-extent", 2 , 0, 0, (SCM mol, SCM axis), - "Return a pair of numbers signifying the extent of @var{mol} in " -"@var{axis} direction (0 or 1 for x and y axis respectively)." -) +LY_DEFINE (ly_stencil_get_expr, + "ly:stencil-get-expr", 1 , 0, 0, (SCM stil), + "Return the expression of @var{stil}.") { - Stencil *m = unsmob_stencil (mol); - SCM_ASSERT_TYPE (m, mol, SCM_ARG1, __FUNCTION__, "stencil"); + Stencil *s = unsmob_stencil (stil); + SCM_ASSERT_TYPE (s, stil, SCM_ARG1, __FUNCTION__, "stencil"); + return s->get_expr (); +} + +LY_DEFINE (ly_stencil_get_extent, + "ly:stencil-get-extent", 2 , 0, 0, (SCM stil, SCM axis), + "Return a pair of numbers signifying the extent of @var{stil} in " + "@var{axis} direction (0 or 1 for x and y axis respectively).") +{ + Stencil *s = unsmob_stencil (stil); + SCM_ASSERT_TYPE (s, stil, SCM_ARG1, __FUNCTION__, "stencil"); SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG2, __FUNCTION__, "axis"); - return ly_interval2scm (m->extent (Axis (gh_scm2int (axis)))); + return ly_interval2scm (s->extent (Axis (gh_scm2int (axis)))); } - -LY_DEFINE(ly_stencil_combined_at_edge, - "ly:stencil-combine-at-edge", - 4, 2, 0, (SCM first, SCM axis, SCM direction, - SCM second, - SCM padding, - SCM minimum), - "Construct a stencil by putting @var{second} next to " -"@var{first}. @var{axis} can be 0 (x-axis) or 1 (y-axis), @var{direction} can be " -"-1 (left or down) or 1 (right or up). " -"The stencils are juxtaposed with @var{padding} as extra space. If " -"this puts the reference points closer than @var{minimum}, they are moved " -"by the latter amount.") - +LY_DEFINE (ly_stencil_combined_at_edge, + "ly:stencil-combine-at-edge", + 4, 2, 0, (SCM first, SCM axis, SCM direction, + SCM second, + SCM padding, + SCM minimum), + "Construct a stencil by putting @var{second} next to @var{first}. " + "@var{axis} can be 0 (x-axis) or 1 (y-axis), " + "@var{direction} can be -1 (left or down) or 1 (right or up). " + "The stencils are juxtaposed with @var{padding} as extra space. " + "If this puts the reference points closer than @var{minimum}, " + "they are moved by the latter amount.") { - Stencil * m1 = unsmob_stencil (first); - Stencil * m2 = unsmob_stencil (second); + Stencil *s1 = unsmob_stencil (first); + Stencil *s2 = unsmob_stencil (second); Stencil result; - - SCM_ASSERT_TYPE(is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis"); - SCM_ASSERT_TYPE(is_direction (direction), direction, SCM_ARG4, __FUNCTION__, "dir"); + SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG3, __FUNCTION__, "axis"); + SCM_ASSERT_TYPE (is_direction (direction), direction, SCM_ARG4, __FUNCTION__, "dir"); Real p = 0.0; if (padding != SCM_UNDEFINED) @@ -99,30 +104,26 @@ LY_DEFINE(ly_stencil_combined_at_edge, SCM_ASSERT_TYPE(gh_number_p (padding), padding, SCM_ARG5, __FUNCTION__, "number"); p = gh_scm2double (padding); } - Real m =0.0; + Real m = 0.0; if (minimum != SCM_UNDEFINED) { SCM_ASSERT_TYPE(gh_number_p (minimum), minimum, SCM_ARG6, __FUNCTION__, "number"); m = gh_scm2double (minimum); } - if (m1) - result = *m1; - if (m2) - result.add_at_edge (Axis (gh_scm2int (axis)), Direction (gh_scm2int (direction)), - *m2, p, m); + if (s1) + result = *s1; + if (s2) + result.add_at_edge (Axis (gh_scm2int (axis)), + Direction (gh_scm2int (direction)), *s2, p, m); return result.smobbed_copy (); } -/* - FIXME: support variable number of arguments. - - */ -LY_DEFINE(ly_stencil_add , - "ly:stencil-add", 0, 0, 1, (SCM args), - "Combine stencils. Takes any number of arguments." - ) +/* FIXME: support variable number of arguments. */ +LY_DEFINE (ly_stencil_add , + "ly:stencil-add", 0, 0, 1, (SCM args), + "Combine stencils. Takes any number of arguments.") { #define FUNC_NAME __FUNCTION__ SCM_VALIDATE_REST_ARGUMENT (args); @@ -131,43 +132,37 @@ LY_DEFINE(ly_stencil_add , while (!SCM_NULLP (args)) { - Stencil * m = unsmob_stencil (gh_car (args)); - - if (!m) - SCM_ASSERT_TYPE(m, gh_car (args), SCM_ARGn, __FUNCTION__, - "Stencil"); - - result.add_stencil (*m); + Stencil *s = unsmob_stencil (gh_car (args)); + if (!s) + SCM_ASSERT_TYPE (s, gh_car (args), SCM_ARGn, __FUNCTION__, "Stencil"); + result.add_stencil (*s); args = gh_cdr (args); } return result.smobbed_copy (); } -LY_DEFINE(ly_make_stencil, - "ly:make-stencil", 3, 0, 0, (SCM expr, SCM xext, SCM yext), - " \n" - "Stencils are a device independent output expressions." - "They carry two pieces of information: \n\n" - "1: a specification of how to print this object. " - "This specification is processed by the output backends, for example " - "@file{scm/output-tex.scm}.\n\n" - "2: the vertical and horizontal extents of the object.\n\n" - - ) +LY_DEFINE (ly_make_stencil, + "ly:make-stencil", 3, 0, 0, (SCM expr, SCM xext, SCM yext), + " \n" + "Stencils are a device independent output expressions." + "They carry two pieces of information: \n\n" + "1: a specification of how to print this object. " + "This specification is processed by the output backends, " + " for example @file{scm/output-tex.scm}.\n\n" + "2: the vertical and horizontal extents of the object.\n\n") { SCM_ASSERT_TYPE (is_number_pair (xext), xext, SCM_ARG2, __FUNCTION__, "number pair"); SCM_ASSERT_TYPE (is_number_pair (yext), yext, SCM_ARG3, __FUNCTION__, "number pair"); Box b (ly_scm2interval (xext), ly_scm2interval(yext)); - Stencil m (b, expr); - return m.smobbed_copy (); + Stencil s (b, expr); + return s.smobbed_copy (); } - SCM -fontify_atom (Font_metric const * met, SCM f) +fontify_atom (Font_metric const *met, SCM f) { if (f == SCM_EOL) return f; @@ -176,25 +171,27 @@ fontify_atom (Font_metric const * met, SCM f) ly_quote_scm (met->description_), f, SCM_UNDEFINED); } -LY_DEFINE(ly_fontify_atom,"ly:fontify-atom", 2, 0, 0, - (SCM met, SCM f), - "Add a font selection command for the font metric @var{met} to @var{f}.") +LY_DEFINE (ly_fontify_atom,"ly:fontify-atom", 2, 0, 0, + (SCM met, SCM f), + "Add a font selection command for the font metric @var{met} " + "to @var{f}.") { SCM_ASSERT_TYPE(unsmob_metrics (met), met, SCM_ARG1, __FUNCTION__, "font metric"); return fontify_atom (unsmob_metrics (met), f); } -LY_DEFINE(ly_align_to_x,"ly:stencil-align-to!", 3, 0, 0, (SCM mol, SCM axis, SCM dir), - "Align @var{mol} using its own extents. @var{dir} is a number -1, 1 are " - " left and right respectively. Other values are interpolated (so 0 means " - " the center. ") +LY_DEFINE (ly_align_to_x,"ly:stencil-align-to!", 3, 0, 0, (SCM stil, SCM axis, SCM dir), + + "Align @var{stil} using its own extents. " + "@var{dir} is a number -1, 1 are left and right respectively. " + "Other values are interpolated (so 0 means the center. ") { - SCM_ASSERT_TYPE(unsmob_stencil (mol), mol, SCM_ARG1, __FUNCTION__, "stencil"); - SCM_ASSERT_TYPE(is_axis (axis), axis, SCM_ARG2, __FUNCTION__, "axis"); - SCM_ASSERT_TYPE(gh_number_p (dir), dir, SCM_ARG3, __FUNCTION__, "number"); + SCM_ASSERT_TYPE (unsmob_stencil (stil), stil, SCM_ARG1, __FUNCTION__, "stencil"); + SCM_ASSERT_TYPE (is_axis (axis), axis, SCM_ARG2, __FUNCTION__, "axis"); + SCM_ASSERT_TYPE (gh_number_p (dir), dir, SCM_ARG3, __FUNCTION__, "number"); - unsmob_stencil (mol)->align_to ((Axis)gh_scm2int (axis), + unsmob_stencil (stil)->align_to ((Axis)gh_scm2int (axis), gh_scm2double (dir)); return SCM_UNDEFINED; diff --git a/lily/stencil.cc b/lily/stencil.cc index ba2d24e6d8..a983241fc1 100644 --- a/lily/stencil.cc +++ b/lily/stencil.cc @@ -23,9 +23,8 @@ SCM Stencil::smobbed_copy () const { - Stencil * m = new Stencil (*this); - - return m->smobbed_self (); + Stencil *s = new Stencil (*this); + return s->smobbed_self (); } Interval @@ -68,24 +67,20 @@ Stencil::translate (Offset o) dim_.translate (o); } - void -Stencil::translate_axis (Real x,Axis a) +Stencil::translate_axis (Real x, Axis a) { Offset o (0,0); o[a] = x; translate (o); } - - void -Stencil::add_stencil (Stencil const &m) +Stencil::add_stencil (Stencil const &s) { expr_ = scm_list_n (ly_symbol2scm ("combine-stencil"), - m.expr_, - expr_, SCM_UNDEFINED); - dim_.unite (m.dim_); + s.expr_, expr_, SCM_UNDEFINED); + dim_.unite (s.dim_); } void @@ -103,7 +98,6 @@ Stencil::set_empty (bool e) } } - void Stencil::align_to (Axis a, Real x) { @@ -114,15 +108,13 @@ Stencil::align_to (Axis a, Real x) translate_axis (-i.linear_combination (x), a); } -/* - See scheme Function. - */ +/* See scheme Function. */ void -Stencil::add_at_edge (Axis a, Direction d, Stencil const &m, Real padding, +Stencil::add_at_edge (Axis a, Direction d, Stencil const &s, Real padding, Real minimum) { Real my_extent= is_empty () ? 0.0 : dim_[a][d]; - Interval i (m.extent (a)); + Interval i (s.extent (a)); Real his_extent; if (i.is_empty ()) { @@ -130,23 +122,19 @@ Stencil::add_at_edge (Axis a, Direction d, Stencil const &m, Real padding, his_extent = 0.0; } else - his_extent = i[-d]; + his_extent = i[-d]; - Real offset = (my_extent - his_extent) + d*padding; - if (minimum > 0 && fabs (offset) < minimum) + Real offset = (my_extent - his_extent) + d * padding; + if (minimum > 0 && fabs (offset) < minimum) offset = sign (offset) * minimum; - Stencil toadd (m); + Stencil toadd (s); toadd.translate_axis (offset, a); add_stencil (toadd); } - - -/* - Hmm... maybe this is not such a good idea ; stuff can be empty, - while expr_ == '() - */ +/* Hmm... maybe this is not such a good idea ; stuff can be empty, + while expr_ == '() */ bool Stencil::is_empty () const { @@ -159,34 +147,27 @@ Stencil::get_expr () const return expr_; } - - Box Stencil::extent_box () const { return dim_; } -IMPLEMENT_SIMPLE_SMOBS (Stencil); - int Stencil::print_smob (SCM , SCM port, scm_print_state *) { scm_puts ("#", port); - return 1; } - SCM Stencil::mark_smob (SCM s) { Stencil *r = (Stencil *) ly_cdr (s); - return r->expr_; } +IMPLEMENT_SIMPLE_SMOBS (Stencil); IMPLEMENT_TYPE_P (Stencil, "ly:stencil?"); IMPLEMENT_DEFAULT_EQUAL_P (Stencil); - diff --git a/scm/auto-beam.scm b/scm/auto-beam.scm index bfc3203534..a5df65464a 100644 --- a/scm/auto-beam.scm +++ b/scm/auto-beam.scm @@ -1,10 +1,8 @@ -;;; -;;; auto-beam.scm -- Auto-beam-engraver settings -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2000--2004 Jan Nieuwenhuizen -;;; +;;;; auto-beam.scm -- Auto-beam-engraver settings +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Jan Nieuwenhuizen ;;; specify generic beam begin and end times diff --git a/scm/clef.scm b/scm/clef.scm index fdece57e37..6e0cff1f67 100644 --- a/scm/clef.scm +++ b/scm/clef.scm @@ -1,66 +1,70 @@ +;;;; clef.scm -- Clef settings +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2004 Han-Wen Nienhuys + ;; (name . (glyph clef-position octavation)) ;; -;; -- the name clefOctavation is misleading. The value 7 is 1 octave, not 7 Octaves. - -(define supported-clefs '( - ("treble" . ("clefs-G" -2 0)) - ("violin" . ("clefs-G" -2 0)) - ("G" . ("clefs-G" -2 0)) - ("G2" . ("clefs-G" -2 0)) - ("french" . ("clefs-G" -4 0)) - ("soprano" . ("clefs-C" -4 0)) - ("mezzosoprano" . ("clefs-C" -2 0)) - ("alto" . ("clefs-C" 0 0)) - ("C" . ("clefs-C" 0 0)) - ("tenor" . ("clefs-C" 2 0)) - ("baritone" . ("clefs-C" 4 0)) - ("varbaritone" . ("clefs-F" 0 0)) - ("bass" . ("clefs-F" 2 0)) - ("F" . ( "clefs-F" 2 0)) - ("subbass" . ("clefs-F" 4 0)) - ("percussion" . ("clefs-percussion" 0 0)) - ("tab" . ("clefs-tab" 0 0)) - - ;; should move mensural stuff to separate file? - ("vaticana_do1" . ("clefs-vaticana_do" -1 0)) - ("vaticana_do2" . ("clefs-vaticana_do" 1 0)) - ("vaticana_do3" . ("clefs-vaticana_do" 3 0)) - ("vaticana_fa1" . ("clefs-vaticana_fa" -1 0)) - ("vaticana_fa2" . ("clefs-vaticana_fa" 1 0)) - ("medicaea_do1" . ("clefs-medicaea_do" -1 0)) - ("medicaea_do2" . ("clefs-medicaea_do" 1 0)) - ("medicaea_do3" . ("clefs-medicaea_do" 3 0)) - ("medicaea_fa1" . ("clefs-medicaea_fa" -1 0)) - ("medicaea_fa2" . ("clefs-medicaea_fa" 1 0)) - ("hufnagel_do1" . ("clefs-hufnagel_do" -1 0)) - ("hufnagel_do2" . ("clefs-hufnagel_do" 1 0)) - ("hufnagel_do3" . ("clefs-hufnagel_do" 3 0)) - ("hufnagel_fa1" . ("clefs-hufnagel_fa" -1 0)) - ("hufnagel_fa2" . ("clefs-hufnagel_fa" 1 0)) - ("hufnagel_do_fa" . ("clefs-hufnagel_do_fa" 4 0)) - ("mensural_c1" . ("clefs-mensural_c" -2 0)) - ("mensural_c2" . ("clefs-mensural_c" 0 0)) - ("mensural_c3" . ("clefs-mensural_c" 2 0)) - ("mensural_c4" . ("clefs-mensural_c" 4 0)) - ("mensural_f" . ("clefs-mensural_f" 2 0)) - ("mensural_g" . ("clefs-mensural_g" -2 0)) - ("neo_mensural_c1" . ("clefs-neo_mensural_c" -4 0)) - ("neo_mensural_c2" . ("clefs-neo_mensural_c" -2 0)) - ("neo_mensural_c3" . ("clefs-neo_mensural_c" 0 0)) - ("neo_mensural_c4" . ("clefs-neo_mensural_c" 2 0)) - ("petrucci_c1" . ("clefs-petrucci_c1" -4 0)) - ("petrucci_c2" . ("clefs-petrucci_c2" -2 0)) - ("petrucci_c3" . ("clefs-petrucci_c3" 0 0)) - ("petrucci_c4" . ("clefs-petrucci_c4" 2 0)) - ("petrucci_c5" . ("clefs-petrucci_c5" 4 0)) - ("petrucci_f" . ("clefs-petrucci_f" 2 0)) - ("petrucci_g" . ("clefs-petrucci_g" -2 0)) - ) -) +;; -- the name clefOctavation is misleading. The value 7 is 1 octave, +;; not 7 Octaves. +(define supported-clefs + '(("treble" . ("clefs-G" -2 0)) + ("violin" . ("clefs-G" -2 0)) + ("G" . ("clefs-G" -2 0)) + ("G2" . ("clefs-G" -2 0)) + ("french" . ("clefs-G" -4 0)) + ("soprano" . ("clefs-C" -4 0)) + ("mezzosoprano" . ("clefs-C" -2 0)) + ("alto" . ("clefs-C" 0 0)) + ("C" . ("clefs-C" 0 0)) + ("tenor" . ("clefs-C" 2 0)) + ("baritone" . ("clefs-C" 4 0)) + ("varbaritone" . ("clefs-F" 0 0)) + ("bass" . ("clefs-F" 2 0)) + ("F" . ("clefs-F" 2 0)) + ("subbass" . ("clefs-F" 4 0)) + ("percussion" . ("clefs-percussion" 0 0)) + ("tab" . ("clefs-tab" 0 0)) + ;; should move mensural stuff to separate file? + ("vaticana_do1" . ("clefs-vaticana_do" -1 0)) + ("vaticana_do2" . ("clefs-vaticana_do" 1 0)) + ("vaticana_do3" . ("clefs-vaticana_do" 3 0)) + ("vaticana_fa1" . ("clefs-vaticana_fa" -1 0)) + ("vaticana_fa2" . ("clefs-vaticana_fa" 1 0)) + ("medicaea_do1" . ("clefs-medicaea_do" -1 0)) + ("medicaea_do2" . ("clefs-medicaea_do" 1 0)) + ("medicaea_do3" . ("clefs-medicaea_do" 3 0)) + ("medicaea_fa1" . ("clefs-medicaea_fa" -1 0)) + ("medicaea_fa2" . ("clefs-medicaea_fa" 1 0)) + ("hufnagel_do1" . ("clefs-hufnagel_do" -1 0)) + ("hufnagel_do2" . ("clefs-hufnagel_do" 1 0)) + ("hufnagel_do3" . ("clefs-hufnagel_do" 3 0)) + ("hufnagel_fa1" . ("clefs-hufnagel_fa" -1 0)) + ("hufnagel_fa2" . ("clefs-hufnagel_fa" 1 0)) + ("hufnagel_do_fa" . ("clefs-hufnagel_do_fa" 4 0)) + ("mensural_c1" . ("clefs-mensural_c" -2 0)) + ("mensural_c2" . ("clefs-mensural_c" 0 0)) + ("mensural_c3" . ("clefs-mensural_c" 2 0)) + ("mensural_c4" . ("clefs-mensural_c" 4 0)) + ("mensural_f" . ("clefs-mensural_f" 2 0)) + ("mensural_g" . ("clefs-mensural_g" -2 0)) + ("neo_mensural_c1" . ("clefs-neo_mensural_c" -4 0)) + ("neo_mensural_c2" . ("clefs-neo_mensural_c" -2 0)) + ("neo_mensural_c3" . ("clefs-neo_mensural_c" 0 0)) + ("neo_mensural_c4" . ("clefs-neo_mensural_c" 2 0)) + ("petrucci_c1" . ("clefs-petrucci_c1" -4 0)) + ("petrucci_c2" . ("clefs-petrucci_c2" -2 0)) + ("petrucci_c3" . ("clefs-petrucci_c3" 0 0)) + ("petrucci_c4" . ("clefs-petrucci_c4" 2 0)) + ("petrucci_c5" . ("clefs-petrucci_c5" 4 0)) + ("petrucci_f" . ("clefs-petrucci_f" 2 0)) + ("petrucci_g" . ("clefs-petrucci_g" -2 0)))) -;; "an alist mapping GLYPHNAME to the position of the central C for that symbol" +;; "an alist mapping GLYPHNAME to the position of the central C for +;; that symbol" (define c0-pitch-alist '(("clefs-G" . -4) ("clefs-C" . 0) @@ -84,22 +88,16 @@ ("clefs-petrucci_c4" . 0) ("clefs-petrucci_c5" . 0) ("clefs-petrucci_f" . 4) - ("clefs-petrucci_g" . -4) - ) -) + ("clefs-petrucci_g" . -4))) (define-public (make-clef-set clef-name) "Generate the clef setting commands for a clef with name CL." (define (make-prop-set props) - (let* - ( - (m (make-music-by-name 'PropertySet)) - ) + (let ((m (make-music-by-name 'PropertySet))) (map (lambda (x) (ly:music-set-property! m (car x) (cdr x))) props) - m - )) - + m)) + (let ((e '()) (c0 0) (oct 0) @@ -109,43 +107,29 @@ (begin (set! clef-name (match:substring match 1)) (set! oct - (* - (if (equal? (match:substring match 2) "^") - -1 1) - (- (string->number (match:substring match 3)) 1)) - ))) - + (* (if (equal? (match:substring match 2) "^") -1 1) + (- (string->number (match:substring match 3)) 1))))) (set! e (assoc clef-name supported-clefs)) (if (pair? e) - (let* - ( - (musics (map make-prop-set - - `(((symbol . clefGlyph) - (value . ,(cadr e)) - ) - ((symbol . centralCPosition) - (value . ,(+ oct (caddr e) (cdr (assoc (cadr e) c0-pitch-alist)))) - ) - ((symbol . clefPosition) - (value . ,(caddr e)) - ) - ((symbol . clefOctavation) - (value . ,(- oct)) - ) - ))) - (seq (make-music-by-name 'SequentialMusic)) - (csp (make-music-by-name 'ContextSpeccedMusic)) - ) + (let* ((musics + (map make-prop-set + `(((symbol . clefGlyph) + (value . ,(cadr e))) + ((symbol . centralCPosition) + (value . ,(+ oct + (caddr e) + (cdr (assoc (cadr e) c0-pitch-alist))))) + ((symbol . clefPosition) (value . ,(caddr e))) + ((symbol . clefOctavation) (value . ,(- oct)))))) + (seq (make-music-by-name 'SequentialMusic)) + (csp (make-music-by-name 'ContextSpeccedMusic))) (ly:music-set-property! seq 'elements musics) (context-spec-music seq 'Staff)) (begin (ly:warn (format "Unknown clef type `~a' See scm/lily.scm for supported clefs" clef-name)) - (make-music-by-name 'Music) - - ) - ))) + (make-music-by-name 'Music))))) + diff --git a/scm/define-grobs.scm b/scm/define-grobs.scm index da534bce97..ae596edf25 100644 --- a/scm/define-grobs.scm +++ b/scm/define-grobs.scm @@ -1,8 +1,8 @@ -;;;; grob-description.scm -- part of generated backend documentation +;;;; define-grobs.scm -- ;;;; ;;;; source file of the GNU LilyPond music typesetter ;;;; -;;;; (c) 1998--2004 Han-Wen Nienhuys +;;;; (c) 1998--2004 Han-Wen Nienhuys ;;;; Jan Nieuwenhuizen ;;;; distances are given in linethickness (thicknesses) and diff --git a/scm/define-markup-commands.scm b/scm/define-markup-commands.scm index 7a51b8af51..df32a05e7a 100644 --- a/scm/define-markup-commands.scm +++ b/scm/define-markup-commands.scm @@ -121,19 +121,24 @@ some punctuation. It doesn't have any letters. " "Set font size to -3." (interpret-markup paper (prepend-alist-chain 'font-size -3 props) arg)) +(def-markup-command (caps paper props arg) (markup?) + (interpret-markup paper (prepend-alist-chain 'font-shape 'caps props) arg)) + (def-markup-command (dynamic paper props arg) (markup?) "Use the dynamic font. This font only contains s, f, m, z, p, and r. When producing phrases, like ``piu f'', the normal words (like -``piu'') should be done in a different font. -The recommend font for this is bold and italic +``piu'') should be done in a different font. The recommend font for +this is bold and italic " - (interpret-markup paper (prepend-alist-chain 'font-family 'dynamic props) arg)) + (interpret-markup + paper (prepend-alist-chain 'font-family 'dynamic props) arg)) (def-markup-command (italic paper props arg) (markup?) (interpret-markup paper (prepend-alist-chain 'font-shape 'italic props) arg)) (def-markup-command (typewriter paper props arg) (markup?) - (interpret-markup paper (prepend-alist-chain 'font-family 'typewriter props) arg)) + (interpret-markup + paper (prepend-alist-chain 'font-family 'typewriter props) arg)) (def-markup-command (doublesharp paper props) () (interpret-markup paper props (markup #:musicglyph "accidentals-4"))) @@ -503,8 +508,7 @@ FIXME: is this working? (def-markup-command (markletter paper props num) (integer?) - "Make a markup letter for @var{num}. The letters start with A to Z -(skipping I), and continues with double letters." - - (Text_item::interpret_markup paper props (number->markletter-string num))) - + "Make a markup letter for @var{num}. The letters start with A to Z + (skipping I), and continues with double letters." + + (Text_item::interpret_markup paper props (number->markletter-string num))) diff --git a/scm/define-music-types.scm b/scm/define-music-types.scm index 5cd4e91f45..cac28f33d8 100644 --- a/scm/define-music-types.scm +++ b/scm/define-music-types.scm @@ -1,3 +1,9 @@ +;;;; define-music-types.scm -- +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 1998--2004 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen (define-public music-descriptions `( diff --git a/scm/document-functions.scm b/scm/document-functions.scm index 19b619b365..8924af01c6 100644 --- a/scm/document-functions.scm +++ b/scm/document-functions.scm @@ -1,3 +1,10 @@ +;;;; document-funcions.scm -- part of generated backend documentation +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 1998--2004 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen + (use-modules (ice-9 regex) ) diff --git a/scm/document-markup.scm b/scm/document-markup.scm index 599015f8c3..77c5d5228a 100644 --- a/scm/document-markup.scm +++ b/scm/document-markup.scm @@ -1,3 +1,9 @@ +;;;; document-markup.scm -- part of generated backend documentation +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 1998--2004 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen (define (doc-markup-function func) (let* diff --git a/scm/document-music.scm b/scm/document-music.scm index c0d8157c78..b1ab6613c4 100644 --- a/scm/document-music.scm +++ b/scm/document-music.scm @@ -1,3 +1,9 @@ +;;;; document-markup.scm -- part of generated backend documentation +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 1998--2004 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen (define (music-props-doc) (make diff --git a/scm/document-translation.scm b/scm/document-translation.scm index f1e509eeb8..ac3843c656 100644 --- a/scm/document-translation.scm +++ b/scm/document-translation.scm @@ -1,9 +1,9 @@ -;;; engraver-doumentation-lib.scm -- Functions for engraver documentation -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2000--2004 Han-Wen Nienhuys -;;; Jan Nieuwenhuizen +;;;; document-translation.scm -- Functions for engraver documentation +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen (define (engraver-makes-grob? name-symbol grav) diff --git a/scm/font.scm b/scm/font.scm index 6afc80cfb1..7118c07205 100644 --- a/scm/font.scm +++ b/scm/font.scm @@ -1,10 +1,9 @@ -;;; -;;; font.scm -- implement Font stuff -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2000--2004 Jan Nieuwenhuizen -;;; +;;;; font.scm -- implement Font stuff +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys ;; Should separate default sizes ;; into separate list/alist ? @@ -32,7 +31,6 @@ or (define-public (magstep x) (exp (* (/ x 6) (log 2)))) - (define-public paper20-font-vector '((#(medium upright number) . (10 . #((10.0 . "feta-nummer10")))) @@ -117,8 +115,6 @@ or (define-public (scale-font-list factor) (append size-independent-fonts - (map (lambda (y) (scale-font-entry y factor)) paper20-font-vector) - )) - -; + (map (lambda (y) (scale-font-entry y factor)) paper20-font-vector))) + diff --git a/scm/new-markup.scm b/scm/new-markup.scm index 43f493d79e..4b8758b32b 100644 --- a/scm/new-markup.scm +++ b/scm/new-markup.scm @@ -1,3 +1,9 @@ +;;;; new-markup.scm -- +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2003--2004 Han-Wen Nienhuys + " Internally markup is stored as lists, whose head is a function. diff --git a/scm/output-pdf.scm b/scm/output-pdf.scm index 78cbe58677..051d29d751 100644 --- a/scm/output-pdf.scm +++ b/scm/output-pdf.scm @@ -1,8 +1,8 @@ -;;; pdf.scm -- implement Scheme output routines for PDF. -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2001--2004 Stephen Peters +;;;; pdf.scm -- implement Scheme output routines for PDF. +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2001--2004 Stephen Peters ;currently no font commands; this is a helper for pdftex.scm. diff --git a/scm/output-pdftex.scm b/scm/output-pdftex.scm index 6f38f6b873..ad3e3469b5 100644 --- a/scm/output-pdftex.scm +++ b/scm/output-pdftex.scm @@ -1,11 +1,11 @@ -;;; pdftex.scm -- implement Scheme output routines for PDFTeX -;;; -;;; source file of the GNU LilyPond music typesetter -;;; modified from the existing tex.scm -;;; -;;; (c) 1998--2004 Jan Nieuwenhuizen -;;; Han-Wen Nienhuys -;;; Stephen Peters +;;;; pdftex.scm -- implement Scheme output routines for PDFTeX +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; modified from the existing tex.scm +;;;; +;;;; (c) 1998--2004 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys +;;;; Stephen Peters ;; TODO: port this to the new module framework. diff --git a/scm/output-ps.scm b/scm/output-ps.scm index 3270a05cbf..7c9e516769 100644 --- a/scm/output-ps.scm +++ b/scm/output-ps.scm @@ -8,7 +8,6 @@ (debug-enable 'backtrace) - (define-module (scm output-ps)) (define this-module (current-module)) @@ -25,8 +24,10 @@ ;; Module entry (define-public (ps-output-expression expr port) - (display (eval expr this-module) port)) + (display (expression->string expr) port)) +(define (expression->string expr) + (eval expr this-module)) ;; Global vars @@ -102,10 +103,13 @@ cmbxti8 cmcsc12 cmcsc7 - cmtt17))) + cmtt17 + + ;;; FIXME: added + cmbx8))) (define (define-fonts internal-external-name-mag-pairs) - + (define (font-load-command name-mag command) ;; frobnicate NAME to jibe with external definitions. @@ -118,6 +122,8 @@ (regexp-substitute/global #f "feta([a-z-]*)([0-9]+)" name 'pre "GNU-LilyPond-feta" 1 "-" 2 'post)) (else name))) + ;;(format (current-error-port) "DEFINE-FONTS: ~S\n" internal-external-name-mag-pairs) + (string-append "/" command " { /" @@ -212,20 +218,25 @@ (define (fontify name-mag-pair exp) (define (select-font name-mag-pair) - (let* ((c (assoc name-mag-pair font-name-alist))) - (if (eq? c #f) + (let ((c (assoc name-mag-pair font-name-alist))) + + (if c + (string-append " " (cddr c) " ") (begin - (display "FAILED\n") - (display (object-type (car name-mag-pair))) - (display (object-type (caaar font-name-alist))) - (ly:warn (string-append - "Programming error: No such font known " - (car name-mag-pair) " " - (ly:number->string (cdr name-mag-pair)))) + (ly:warn + (format "Programming error: No such font: ~S" name-mag-pair)) - ;; Upon error, issue no command - "") - (string-append " " (cddr c) " ")))) + (display "FAILED\n" (current-error-port)) + (if #f ;(pair? name-mag-pair)) + (display (object-type (car name-mag-pair)) (current-error-port)) + (write name-mag-pair (current-error-port))) + (if #f ; (pair? font-name-alist) + (display + (object-type (caaar font-name-alist)) (current-error-port)) + (write font-name-alist (current-error-port))) + + ;; (format #f "\n%FAILED: (select-font ~S)\n" name-mag-pair)) + "")))) (string-append (select-font name-mag-pair) exp)) @@ -332,30 +343,55 @@ (define (ps-number-def a b c) (string-append "/" a (symbol->string b) " " c " def\n")) -(define (output-scopes scopes fields basename) - (define (output-scope scope) - (apply - string-append - (module-map - (lambda (sym var) - (let ((val (variable-ref var)) - (tex-key (symbol->string sym))) - - (if (memq sym fields) - (header-to-file basename sym val)) - - (cond - ((string? val) - (ps-string-def "lilypond" sym val)) - - ((number? val) - (ps-number-def "lilypond" sym - (if (integer? val) - (number->string val) - (number->string (exact->inexact val))))) - (else "")))) - scope))) + +(define (output-scopes paper scopes fields basename) + + ;; FIXME: customise/generate these + (let ((nmp '((("feta20" . 0.569055118110236) "feta20" . 1.0) + (("cmbx10" . 0.569055118110236) "cmbx10" . 1.0) + (("cmr10" . 0.569055118110236) "cmr10" . 1.0) + (("cmr10" . 0.638742773474948) "cmr10" . 1.0) + (("cmcsc10" . 0.451659346558038) "cmcs10" . 1.0) + (("cmcsc10" . 0.638742773474948) "cmcs10" . 1.0) + (("cmbx8" . 0.564574183197548) "cmbx8" . 1.0))) + + (props '(((font-family . roman) + (word-space . 1) + (font-shape . upright) + (font-size . -2))))) + - (apply string-append - (map output-scope scopes)) ) + (define (output-scope scope) + (apply + string-append + (module-map + (lambda (sym var) + (let ((val (variable-ref var)) + (tex-key (symbol->string sym))) + + (if (memq sym fields) + (header-to-file basename sym val)) + + (cond + ;; define strings, for /make-lilypond-title to pick up + ((string? val) (ps-string-def "lilypond" sym val)) + + ;; output markups ourselves + ((markup? val) (string-append + (expression->string + (ly:stencil-get-expr + (interpret-markup paper props val))) + "\n")) + ((number? val) (ps-number-def + "lilypond" sym (if (integer? val) + (number->string val) + (number->string + (exact->inexact val))))) + (else "")))) + scope))) + (string-append + ;; urg + " 0 0 moveto\n" + (define-fonts nmp) + (apply string-append (map output-scope scopes))))) diff --git a/scm/output-tex.scm b/scm/output-tex.scm index ff3ecebcea..7c7a104f25 100644 --- a/scm/output-tex.scm +++ b/scm/output-tex.scm @@ -92,7 +92,7 @@ (ly:output-def-scope pd)))) -(define (output-scopes scopes fields basename) +(define (output-scopes paper scopes fields basename) (define (output-scope scope) (apply string-append @@ -119,12 +119,10 @@ (map output-scope scopes))) (define (select-font name-mag-pair) - (let* - ( - (c (assoc name-mag-pair font-name-alist)) - ) + (let ((c (assoc name-mag-pair font-name-alist))) - (if (eq? c #f) + (if c + (string-append "\\" (cddr c)) (begin (ly:warn (string-append "Programming error: No such font known " @@ -141,9 +139,7 @@ (write font-name-alist (current-error-port))) ;; (format #f "\n%FAILED: (select-font ~S)\n" name-mag-pair)) - "") - - (string-append "\\" (cddr c))))) + "")))) ;; top-of-file, wtf? ugh: tagline? (define (top-of-file) diff --git a/scm/paper.scm b/scm/paper.scm index 7267c08773..3a9c908a8e 100644 --- a/scm/paper.scm +++ b/scm/paper.scm @@ -1,9 +1,8 @@ - ; paper.scm - manipulate the paper block. -; -; (C) 2004 Han-Wen Nienhuys - -; the functions are fairly basic here. - +;;;; paper.scm -- manipulate the paper block. +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2004 Han-Wen Nienhuys (define-public (paper-set-staff-size sz) @@ -26,29 +25,26 @@ (module-define! m 'ledgerlinethickness (+ (* 0.5 pt) (/ ss 10))) (module-define! m 'blotdiameter (* 0.35 pt)) (module-define! m 'interscoreline (* 4 mm)) + ;; REMOVEME (module-define! m 'lineheight (* 14 ss)))) (define-public (set-global-staff-size sz) "Set the default staff size, where SZ is thought to be in PT." - (let* - ((old-mod (current-module)) - (pap (eval '$defaultpaper old-mod)) - (new-paper (ly:output-def-clone pap)) - (new-scope (ly:output-def-scope new-paper)) - ) + (let* ((old-mod (current-module)) + (pap (eval '$defaultpaper old-mod)) + (new-paper (ly:output-def-clone pap)) + (new-scope (ly:output-def-scope new-paper))) (set-current-module new-scope) (paper-set-staff-size (* sz (eval 'pt new-scope))) (set-current-module old-mod) - (module-define! old-mod '$defaultpaper new-paper) - )) - + (module-define! old-mod '$defaultpaper new-paper))) (define paper-alist '(("a4" . (cons (* 210 mm) (* 297.9 mm))) - ("a3" . (cons (* 297.9 mm) (* 420 mm))) - ("legal" . (cons (* 8.5 in) (* 14.0 in))) + ("a3" . (cons (* 297.9 mm) (* 420 mm))) + ("legal" . (cons (* 8.5 in) (* 14.0 in))) ("letter" . (cons (* 8.5 in) (* 11.0 in))) - ("tabloid" . (cons (* 11.0 in) (* 17.0 in)))) ) + ("tabloid" . (cons (* 11.0 in) (* 17.0 in))))) ;; todo: take dimension arguments. @@ -56,15 +52,13 @@ (define (set-paper-dimensions m w h) "M is a module (ie. paper->scope_ )" - (let* - ( (mm (eval 'mm m)) ) - + (let* ((mm (eval 'mm m))) (module-define! m 'hsize w) (module-define! m 'vsize h) (module-define! m 'linewidth (- w (* 20 mm))) (module-define! m 'raggedright #f) (module-define! m 'packed #f) - (module-define! m 'indent (/ w 14)) )) + (module-define! m 'indent (/ w 14)))) (define-public (set-paper-size name) @@ -86,4 +80,4 @@ (module-define! (current-module) '$defaultpaper new-paper) ) (ly:warning (string-append "Unknown papersize: " name)) - ))) + ))) \ No newline at end of file diff --git a/scm/script.scm b/scm/script.scm index d125b6c95a..29f93cba30 100644 --- a/scm/script.scm +++ b/scm/script.scm @@ -1,3 +1,8 @@ +;;;; script.scm -- Script definitions +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Han-Wen Nienhuys (set! default-script-alist (append diff --git a/scm/stencil.scm b/scm/stencil.scm index 146a72c3ab..1e88d6c4dc 100644 --- a/scm/stencil.scm +++ b/scm/stencil.scm @@ -1,46 +1,46 @@ +;;;; stenicil.scm -- +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2003--2004 Han-Wen Nienhuys -(define-public (stack-stencils axis dir padding mols) - "Stack stencils MOLS in direction AXIS,DIR, using PADDING." - (if (null? mols) +(define-public (stack-stencils axis dir padding stils) + "Stack stencils STILS in direction AXIS,DIR, using PADDING." + (if (null? stils) '() - (if (pair? mols) - (ly:stencil-combine-at-edge (car mols) axis dir - (stack-stencils axis dir padding (cdr mols)) - padding - ) - ) - )) + (if (pair? stils) + (ly:stencil-combine-at-edge + (car stils) axis dir (stack-stencils axis dir padding (cdr stils)) + padding)))) - -(define-public (stack-lines dir padding baseline mols) +(define-public (stack-lines dir padding baseline stils) "Stack vertically with a baseline-skip." - (if (null? mols) + (if (null? stils) '() - (if (null? (cdr mols)) - (car mols) - (ly:stencil-combine-at-edge (car mols) Y dir - (stack-lines dir padding baseline (cdr mols)) - padding baseline - ) - ))) + (if (null? (cdr stils)) + (car stils) + (ly:stencil-combine-at-edge + (car stils) Y dir + (stack-lines dir padding baseline (cdr stils)) + padding baseline)))) (define-public (fontify-text font-metric text) "Set TEXT with font FONT-METRIC, returning a stencil." (let* ((b (ly:text-dimension font-metric text))) (ly:make-stencil - (ly:fontify-atom font-metric `(text ,text)) (car b) (cdr b)) - )) + (ly:fontify-atom font-metric `(text ,text)) (car b) (cdr b)))) -(define-public (bracketify-stencil mol axis thick protusion padding) - "Add brackets around MOL, producing a new stencil." +(define-public (bracketify-stencil stil axis thick protusion padding) + "Add brackets around STIL, producing a new stencil." - (let* ((ext (ly:stencil-get-extent mol axis)) + (let* ((ext (ly:stencil-get-extent stil axis)) (lb (ly:bracket axis ext thick (- protusion))) (rb (ly:bracket axis ext thick protusion))) - (set! mol (ly:stencil-combine-at-edge mol (other-axis axis) 1 lb padding)) - (set! mol (ly:stencil-combine-at-edge mol (other-axis axis) -1 rb padding)) - mol - )) + (set! stil + (ly:stencil-combine-at-edge stil (other-axis axis) 1 lb padding)) + (set! stil + (ly:stencil-combine-at-edge stil (other-axis axis) -1 rb padding)) + stil)) (define-public (make-filled-box-stencil xext yext) "Make a filled box." @@ -48,8 +48,7 @@ (ly:make-stencil (list 'filledbox (- (car xext)) (cdr xext) (- (car yext)) (cdr yext)) - xext yext) -) + xext yext)) (define-public (box-grob-stencil grob) @@ -60,25 +59,24 @@ encloses the contents. (yext (ly:grob-extent grob grob 1)) (thick 0.1)) - (ly:stencil-add (make-filled-box-stencil xext (cons (- (car yext) thick) (car yext) )) - (make-filled-box-stencil xext (cons (cdr yext) (+ (cdr yext) thick) )) - (make-filled-box-stencil (cons (cdr xext) (+ (cdr xext) thick)) yext) - (make-filled-box-stencil (cons (- (car xext) thick) (car xext)) yext)))) - + (ly:stencil-add + (make-filled-box-stencil xext (cons (- (car yext) thick) (car yext))) + (make-filled-box-stencil xext (cons (cdr yext) (+ (cdr yext) thick))) + (make-filled-box-stencil (cons (cdr xext) (+ (cdr xext) thick)) yext) + (make-filled-box-stencil (cons (- (car xext) thick) (car xext)) yext)))) ;; TODO merge this and prev function. -(define-public (box-stencil mol thick padding) - "Add a box around MOL, producing a new stencil." - (let* ( - (x-ext (interval-widen (ly:stencil-get-extent mol 0) padding)) - (y-ext (interval-widen (ly:stencil-get-extent mol 1) padding)) +(define-public (box-stencil stil thick padding) + "Add a box around STIL, producing a new stencil." + (let* ((x-ext (interval-widen (ly:stencil-get-extent stil 0) padding)) + (y-ext (interval-widen (ly:stencil-get-extent stil 1) padding)) (y-rule (make-filled-box-stencil (cons 0 thick) y-ext)) (x-rule (make-filled-box-stencil (interval-widen x-ext thick) - (cons 0 thick))) - ) - (set! mol (ly:stencil-combine-at-edge mol X 1 y-rule padding)) - (set! mol (ly:stencil-combine-at-edge mol X -1 y-rule padding)) - (set! mol (ly:stencil-combine-at-edge mol Y 1 x-rule 0.0)) - (set! mol (ly:stencil-combine-at-edge mol Y -1 x-rule 0.0)) + (cons 0 thick)))) + + (set! stil (ly:stencil-combine-at-edge stil X 1 y-rule padding)) + (set! stil (ly:stencil-combine-at-edge stil X -1 y-rule padding)) + (set! stil (ly:stencil-combine-at-edge stil Y 1 x-rule 0.0)) + (set! stil (ly:stencil-combine-at-edge stil Y -1 x-rule 0.0)) - mol)) + stil)) diff --git a/scm/to-xml.scm b/scm/to-xml.scm index afe8084170..d88649315a 100644 --- a/scm/to-xml.scm +++ b/scm/to-xml.scm @@ -1,3 +1,9 @@ +;;;; to-xml.scm -- dump parse tree as xml +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2003--2004 Han-Wen Nienhuys +;;;; Jan Nieuwenhuizen (use-modules (ice-9 regex) (srfi srfi-1) -- 2.39.2