diff -urN lilypond-1.5.9/input/test/ancient-font.ly lilypond-1.5.9.NEW/input/test/ancient-font.ly --- lilypond-1.5.9/input/test/ancient-font.ly Mon Sep 3 10:32:57 2001 +++ lilypond-1.5.9.NEW/input/test/ancient-font.ly Mon Sep 10 03:22:11 2001 @@ -27,6 +27,10 @@ \property Staff.Accidentals \override #'style = #'vaticana \property Staff.Custos \override #'style = #'vaticana \property Voice.NoteHead \override #'style = #'vaticana_punctum + \property Voice.Porrectus \override #'style = #'vaticana + \property Voice.Porrectus \override #'solid = ##t + \property Voice.Porrectus \override #'add-stem = ##t + \property Voice.Porrectus \override #'stem-direction = #-1 \key es \major \clef "vaticana_fa2" c!1 des! e! f! ges! @@ -37,10 +41,10 @@ \clef "vaticana_do2" \property Voice.NoteHead \override #'style = #'vaticana_subbipunctum - a! b! ces' + a! b! \property Staff.BarLine \override #'bar-size = #3.0 \bar "|" \property Voice.NoteHead \override #'style = #'vaticana_virga - b! a! ges fes + ces' b! ces'! \porrectus ges! \porrectus fes! \breathe \clef "vaticana_fa1" \property Voice.NoteHead \override #'style = #'vaticana_quilisma @@ -112,69 +116,92 @@ % \property Staff.StaffSymbol \override #'line-count = #5 \context Staff \outputproperty #(make-type-checker 'staff-symbol-interface) #'line-count = #5 - + \notes \transpose c' { \property Voice.noAutoBeaming = ##t \property Staff.KeySignature \override #'style = #'mensural \property Staff.Accidentals \override #'style = #'mensural \property Staff.Custos \override #'style = #'mensural - \property Voice.NoteHead \override #'style = #'neo_mensural - \property Voice.Rest \override #'style = #'neo_mensural + \property Voice.NoteHead \override #'style = #'neo_mensural + \property Voice.Rest \override #'style = #'neo_mensural + \property Voice.Porrectus \override #'style = #'mensural + \property Voice.Porrectus \override #'solid = ##f + \property Voice.Porrectus \override #'add-stem = ##t + \property Voice.Porrectus \override #'stem-direction = #1 \key a \major + + % IMPORTANT NOTE: + % + % The porrectus syntax is subject to change. For proper + % use, it may eventually change into something like this: + % + % \ligature { e \porrectus c } + % + % The reason is that there needs to be some enclosing instance + % for correct handling of line breaking, alignment with + % adjacent note heads, and placement of accidentals. + \clef "neo_mensural_c2" - c2 dis es fis ges - \property Staff.forceClef = ##t + cis' e' \porrectus d' gis' \porrectus e' + \property Staff.forceClef = ##t \clef "neo_mensural_c2" - ais bes cis' - bis as gis fes + + fis' \porrectus b cis'' + b \porrectus a a \porrectus fis \clef "petrucci_c2" - e d c1 \bar "|" + cis \porrectus fis ces1 % \bar "|" \clef "petrucci_c2" r\longa - \property Staff.forceClef = ##t + \property Staff.forceClef = ##t \clef "mensural_c2" r\breve r1 r2 \clef "mensural_g" r4 r8 r16 r32 r32 \bar "|" - \property Voice.NoteHead \override #'style = #'mensural + \property Voice.NoteHead \override #'style = #'mensural \property Voice.Stem \override #'style = #'mensural \property Voice.Stem \override #'thickness = #1.0 - \property Voice.Rest \override #'style = #'mensural + \property Voice.Rest \override #'style = #'mensural \clef "petrucci_f" c8 b, c16 b, c32 b, c64 b, c b, d8 e d16 e d32 e d64 e d e r\longa - \property Staff.forceClef = ##t + \property Staff.forceClef = ##t \clef "petrucci_f" - r\breve r1 \bar "|" + r\breve r1 % \bar "|" \clef "mensural_f" - % FIXME: need this to avoid segmentation fault on r8/r16/r32 - % (Strange: what has Voice.Stem style to do with mensural rests?) + % FIXME: must set Voice.Stem style to #'neo_mensural to avoid + % segmentation fault on r8/r16/r32. (Strange: what has + % Voice.Stem style to do with mensural rests?) \property Voice.Stem \override #'style = #'neo_mensural - r2 r4 r8 r16 r32 r32 \property Voice.Stem \override #'style = #'mensural - \property Staff.forceClef = ##t + \property Staff.forceClef = ##t \clef "mensural_f" e2 f g \clef "mensural_g" - as'! bes'! cis''! - bes'! as'! gis'! fis'! - \property Staff.forceClef = ##t + + % FIXME: In the second and all subsequent lines of score, the + % stems and accidentals of the junked notes keep visible on + % porrectus grobs. Is this an initialization bug in the line + % breaking algorithm? + + bes'! \porrectus as'! \porrectus cis''! + bes'! \porrectus fis'! as'! \porrectus ges'! + \property Staff.forceClef = ##t \clef "mensural_g" e' d' c'1 \bar "|" - \property Staff.forceClef = ##t + \property Staff.forceClef = ##t \clef "petrucci_g" c'2 d' e' f' g' \clef "petrucci_g" as'! bes'! cis''! bes'! as'! gis'! fis'! - \property Staff.forceClef = ##t + \property Staff.forceClef = ##t \clef "mensural_g" es'! des'! cis'!1 \bar "||" } diff -urN lilypond-1.5.9/lily/command-request.cc lilypond-1.5.9.NEW/lily/command-request.cc --- lilypond-1.5.9/lily/command-request.cc Fri Apr 13 01:32:50 2001 +++ lilypond-1.5.9.NEW/lily/command-request.cc Thu Sep 6 01:37:56 2001 @@ -115,6 +115,7 @@ ADD_MUSIC (Melisma_req); ADD_MUSIC (Melodic_req); ADD_MUSIC (Note_req); +ADD_MUSIC (Porrectus_req); ADD_MUSIC (Rest_req); ADD_MUSIC (Rhythmic_req); ADD_MUSIC (Script_req); diff -urN lilypond-1.5.9/lily/include/command-request.hh lilypond-1.5.9.NEW/lily/include/command-request.hh --- lilypond-1.5.9/lily/include/command-request.hh Sun Apr 1 14:59:01 2001 +++ lilypond-1.5.9.NEW/lily/include/command-request.hh Thu Sep 6 04:33:54 2001 @@ -51,6 +51,10 @@ VIRTUAL_COPY_CONS (Music); }; +class Porrectus_req : public Request { + VIRTUAL_COPY_CONS (Music); +}; + /** Handle key changes. */ diff -urN lilypond-1.5.9/lily/include/lily-proto.hh lilypond-1.5.9.NEW/lily/include/lily-proto.hh --- lilypond-1.5.9/lily/include/lily-proto.hh Sun Mar 11 19:10:33 2001 +++ lilypond-1.5.9.NEW/lily/include/lily-proto.hh Thu Sep 6 02:07:07 2001 @@ -132,6 +132,7 @@ class Piano_bar_engraver; class Pitch_squash_engraver; +class Porrectus_req; class Property_iterator; class Rational; class Relative_octave_music; diff -urN lilypond-1.5.9/lily/include/porrectus.hh lilypond-1.5.9.NEW/lily/include/porrectus.hh --- lilypond-1.5.9/lily/include/porrectus.hh Thu Jan 1 01:00:00 1970 +++ lilypond-1.5.9.NEW/lily/include/porrectus.hh Sun Sep 9 05:49:05 2001 @@ -0,0 +1,34 @@ +/* + porrectus.hh + + Copyright (C) 2001 Juergen Reuter + + written for the GNU LilyPond music typesetter +*/ + +#ifndef PORRECTUS_HH +#define PORRECTUS_HH + +#include "lily-guile.hh" + +/* + porrectus ligature +*/ +class Porrectus +{ +public: + static void set_left_head (Grob *, SCM); + static SCM get_left_head (Grob *); + static void set_right_head (Grob *, SCM); + static SCM get_right_head (Grob *); + DECLARE_SCHEME_CALLBACK (brew_molecule, (SCM)); + +private: + static Molecule brew_vaticana_molecule (Item *, bool, bool, Direction, Real); + static Molecule brew_mensural_molecule (Item *, bool, bool, Direction, Real); + static Molecule brew_horizontal_slope (Real, Real, Real); + static Molecule create_ledger_line (Interval, Grob *); + static Molecule create_streepjes (Grob *, int, int, Interval); +}; + +#endif // PORRECTUS_HH diff -urN lilypond-1.5.9/lily/my-lily-lexer.cc lilypond-1.5.9.NEW/lily/my-lily-lexer.cc --- lilypond-1.5.9/lily/my-lily-lexer.cc Wed Jul 11 14:54:52 2001 +++ lilypond-1.5.9.NEW/lily/my-lily-lexer.cc Thu Sep 6 01:40:02 2001 @@ -81,6 +81,7 @@ {"repeat", REPEAT}, {"addlyrics", ADDLYRICS}, {"partcombine", PARTCOMBINE}, + {"porrectus", PORRECTUS}, {"score", SCORE}, {"script", SCRIPT}, {"stylesheet", STYLESHEET}, diff -urN lilypond-1.5.9/lily/parser.yy lilypond-1.5.9.NEW/lily/parser.yy --- lilypond-1.5.9/lily/parser.yy Tue Aug 14 13:41:27 2001 +++ lilypond-1.5.9.NEW/lily/parser.yy Thu Sep 6 23:40:13 2001 @@ -207,6 +207,7 @@ %token PAPER %token PARTIAL %token PENALTY +%token PORRECTUS %token PROPERTY %token OVERRIDE SET REVERT %token PT_T @@ -1214,6 +1215,9 @@ } | BREATHE { $$ = new Breathing_sign_req; + } + | PORRECTUS { + $$ = new Porrectus_req; } ; diff -urN lilypond-1.5.9/lily/porrectus-engraver.cc lilypond-1.5.9.NEW/lily/porrectus-engraver.cc --- lilypond-1.5.9/lily/porrectus-engraver.cc Thu Jan 1 01:00:00 1970 +++ lilypond-1.5.9.NEW/lily/porrectus-engraver.cc Mon Sep 10 02:06:32 2001 @@ -0,0 +1,237 @@ +/* + porrectus-engraver.cc -- implement Porrectus_engraver + + Copyright (C) 2001 Juergen Reuter + + written for the GNU LilyPond music typesetter +*/ + +/* + * FIXME: Currently, when creating a porrectus item, it takes the + * moment of the second note. Actually, it should take the moment of + * the first note. + * + * TODO: Introduce "\~" as alternative syntax for "\porrectus"? + * + * TODO: Hufnagel support. + * + * TODO: Fine-tuning of porrectus shape. In particular, the mensural + * non-solid shape could either be slightly bigger in height, or the + * extrem points could be slightly vertically shifted apart. + * + * TODO: For white mensural (i.e. #'style=#'mensural, #'solid=##f) + * porrectus grobs, it is possible to automatically determine all + * porrectus specific properties (add-stem, stem-direction) solely + * from the duration of the contributing notes and time-signature. + * Introduce a boolean grob property called auto-config, so that, if + * turned on, lily automatically sets the remaining properties + * properly. + * + * TODO: The following issues are not (and should not be) handled by + * this engraver: (1) accidentals placement, (2) avoiding line + * breaking inbetween porrectus, (3) spacing. For example, currently + * only the accidental for the second note (cp. the above FIXME) is + * printed. These issues should be resolved by some sort of ligature + * context that encloses use of this engraver, using syntax like: + * \ligature { e \porrectus c }. + * + * TODO: Do not allow a series of adjacent porrectus requests, as in: + * e \porrectus d \porrectus c. + */ + +#include "staff-symbol-referencer.hh" +#include "porrectus.hh" +#include "musical-request.hh" +#include "command-request.hh" +#include "rhythmic-head.hh" +#include "item.hh" +#include "engraver.hh" +#include "pqueue.hh" + +// TODO: PHead_melodic_tuple is duplicated code from tie-engraver.cc. +// Maybe put this into public class? +struct PHead_melodic_tuple { + Melodic_req *req_l_; + Grob *head_l_; + Moment end_; + PHead_melodic_tuple (); + PHead_melodic_tuple (Grob*, Melodic_req*, Moment); + static int pitch_compare (PHead_melodic_tuple const &, + PHead_melodic_tuple const &); + static int time_compare (PHead_melodic_tuple const &, + PHead_melodic_tuple const &); +}; + +inline int compare (PHead_melodic_tuple const &a, PHead_melodic_tuple const &b) +{ + return PHead_melodic_tuple::time_compare (a,b); +} + +class Porrectus_engraver : public Engraver { +public: + Porrectus_engraver (); + VIRTUAL_COPY_CONS (Translator); + +protected: + virtual bool try_music (Music *req_l); + virtual void create_grobs (); + virtual void stop_translation_timestep (); + virtual void start_translation_timestep (); + virtual void acknowledge_grob (Grob_info); + +private: + PQueue past_notes_pq_; + Porrectus_req *porrectus_req_l_; + Array left_heads_; + Array right_heads_; + Link_array porrectus_p_arr_; +}; + +Porrectus_engraver::Porrectus_engraver () +{ + porrectus_req_l_ = 0; +} + +bool +Porrectus_engraver::try_music (Music *m) +{ + if (Porrectus_req *req_l_ = dynamic_cast (m)) + { + porrectus_req_l_ = req_l_; + return true; + } + else + return false; +} + +void +Porrectus_engraver::acknowledge_grob (Grob_info info_l_) +{ + if (Rhythmic_head::has_interface (info_l_.elem_l_)) + { + Note_req *note_req_l_ = dynamic_cast (info_l_.req_l_); + if (!note_req_l_) + return; + left_heads_.push (PHead_melodic_tuple (info_l_.elem_l_, note_req_l_, + now_mom () + + note_req_l_->length_mom ())); + } +} + +void +Porrectus_engraver::create_grobs () +{ + if (porrectus_req_l_) + { + left_heads_.sort (PHead_melodic_tuple::pitch_compare); + right_heads_.sort (PHead_melodic_tuple::pitch_compare); + + SCM head_list = SCM_EOL; + + int i = left_heads_.size () - 1; + int j = right_heads_.size () - 1; + + while ((i >= 0) && (j >= 0)) + { + head_list = + gh_cons (gh_cons (right_heads_[j].head_l_->self_scm (), + left_heads_[i].head_l_->self_scm ()), + head_list); + + past_notes_pq_. insert (left_heads_[i]); + left_heads_.del (i); + right_heads_.del (j); + i--; + j--; + } + + for (SCM s = head_list; gh_pair_p (s); s = gh_cdr (s)) + { + SCM caar = gh_caar (s); + SCM cdar = gh_cdar (s); + + Item *left_head = dynamic_cast (unsmob_grob (caar)); + Item *right_head = dynamic_cast (unsmob_grob (cdar)); + left_head->set_grob_property("transparent", gh_bool2scm(true)); + right_head->set_grob_property("transparent", gh_bool2scm(true)); + + Grob *porrectus_p_ = new Item (get_property ("Porrectus")); + Porrectus::set_left_head(porrectus_p_, caar); + Porrectus::set_right_head(porrectus_p_, cdar); + porrectus_p_arr_.push (porrectus_p_); + announce_grob (porrectus_p_, 0); + } + } +} + +void +Porrectus_engraver::stop_translation_timestep () +{ + for (int i = 0; i < left_heads_.size (); i++) + { + past_notes_pq_.insert (left_heads_[i]); + } + left_heads_.clear (); + + for (int i = 0; i < porrectus_p_arr_.size (); i++) + { + typeset_grob (porrectus_p_arr_[i]); + } + porrectus_p_arr_.clear (); +} + +void +Porrectus_engraver::start_translation_timestep () +{ + porrectus_req_l_ = 0; + Moment now = now_mom (); + while (past_notes_pq_.size () && past_notes_pq_.front ().end_ < now) + past_notes_pq_.delmin (); + + right_heads_.clear (); + while (past_notes_pq_.size () && + (past_notes_pq_.front ().end_ == now)) + right_heads_.push (past_notes_pq_.get ()); +} + +ADD_THIS_TRANSLATOR (Porrectus_engraver); + +// TODO: PHead_melodic_tuple is duplicated code from tie-engraver.cc. +// Maybe put this into public class? + +PHead_melodic_tuple::PHead_melodic_tuple () +{ + head_l_ = 0; + req_l_ = 0; + end_ = 0; +} + +PHead_melodic_tuple::PHead_melodic_tuple (Grob *h, Melodic_req*m, Moment mom) +{ + head_l_ = h; + req_l_ = m; + end_ = mom; +} + +/* + signed compare, should use pitchget_mus_property ("pitch"); + SCM p2 = h2.req_l_->get_mus_property ("pitch"); + + int result = Pitch::compare (*unsmob_pitch (p1), + *unsmob_pitch (p2)); + return result; +} + +int +PHead_melodic_tuple::time_compare (PHead_melodic_tuple const&h1, + PHead_melodic_tuple const &h2) +{ + int result = Moment::compare(h1.end_, h2.end_); + return result; +} diff -urN lilypond-1.5.9/lily/porrectus.cc lilypond-1.5.9.NEW/lily/porrectus.cc --- lilypond-1.5.9/lily/porrectus.cc Thu Jan 1 01:00:00 1970 +++ lilypond-1.5.9.NEW/lily/porrectus.cc Mon Sep 10 00:13:44 2001 @@ -0,0 +1,374 @@ +/* + porrectus.cc -- implement Porrectus + + Copyright (C) 2001 Juergen Reuter + + written for the GNU LilyPond music typesetter + + TODO: --> see porrectus-engraver.cc +*/ + +#include "staff-symbol-referencer.hh" +#include "porrectus.hh" +#include "item.hh" +#include "molecule.hh" +#include "pitch.hh" +#include "lookup.hh" +#include "debug.hh" +#include "dimensions.hh" +#include "direction.hh" +#include "bezier.hh" +#include "font-interface.hh" +#include "math.h" // rint + +void +Porrectus::set_left_head (Grob *me, SCM left_head) +{ + if (left_head == SCM_EOL) + { + warning (_ ("(left_head == SCM_EOL) (ignored)")); + } + me->set_grob_property ("left-head", left_head); +} + +SCM +Porrectus::get_left_head (Grob *me) +{ + SCM left_head = me->get_grob_property ("left-head"); + return left_head; +} + +void +Porrectus::set_right_head (Grob *me, SCM right_head) +{ + if (right_head == SCM_EOL) + { + warning (_ ("(right_head == SCM_EOL) (ignored)")); + } + me->set_grob_property ("right-head", right_head); +} + +SCM +Porrectus::get_right_head (Grob *me) +{ + SCM right_head = me->get_grob_property ("right-head"); + return right_head; +} + +// Uugh. The following two functions are almost duplicated code from +// custos.cc, which itself is similar to code in note-head.cc. Maybe +// this should be moved to staff-symbol-referencer.cc? +Molecule +Porrectus::create_ledger_line (Interval x_extent, Grob *me) +{ + Molecule line; + Molecule slice = Font_interface::get_default_font (me)->find_by_name ("noteheads-ledgerending"); + Interval slice_x_extent = slice.extent (X_AXIS); + Interval slice_y_extent = slice.extent (Y_AXIS); + + // Create left ending of ledger line. + Molecule left_ending = slice; + left_ending.translate_axis (x_extent[LEFT] - slice_x_extent[LEFT], X_AXIS); + if (x_extent.length () > slice_x_extent.length ()) + line.add_molecule (left_ending); + + // Create right ending of ledger line. + Molecule right_ending = slice; + right_ending.translate_axis (x_extent[RIGHT] - slice_x_extent[RIGHT], + X_AXIS); + line.add_molecule (right_ending); + + // Fill out space between left and right ending of ledger line by + // lining up a series of slices in a row between them. + Molecule fill_out_slice = left_ending; + Real thick = slice_y_extent.length (); + Real delta_x = slice_x_extent.length () - thick; + Real xpos = x_extent [LEFT] + 2*delta_x + thick/2; // TODO: check: thick*2? + while (xpos <= x_extent[RIGHT]) + { + fill_out_slice.translate_axis (delta_x, X_AXIS); + line.add_molecule (fill_out_slice); + xpos += delta_x; + } + + return line; +} + +Molecule +Porrectus::create_streepjes (Grob *me, + int pos, + int interspaces, + Interval extent) +{ + Real inter_f = Staff_symbol_referencer::staff_space (me)/2; + int streepjes_i = abs (pos) < interspaces + ? 0 + : (abs (pos) - interspaces) /2; + Molecule molecule = Molecule(); + if (streepjes_i) + { + Direction dir = (Direction)sign (pos); + Molecule ledger_line (create_ledger_line (extent, me)); + ledger_line.set_empty (true); + Real offs = (Staff_symbol_referencer::on_staffline (me, pos)) + ? 0.0 + : -dir * inter_f; + for (int i = 0; i < streepjes_i; i++) + { + Molecule streep (ledger_line); + streep.translate_axis (-dir * inter_f * i * 2 + offs, + Y_AXIS); + molecule.add_molecule (streep); + } + } + return molecule; +} + +MAKE_SCHEME_CALLBACK (Porrectus,brew_molecule,1); +SCM +Porrectus::brew_molecule (SCM smob) +{ + Item *me = (Item *)unsmob_grob (smob); + + SCM scm_style = me->get_grob_property ("style"); + String style; + if ((gh_symbol_p (scm_style)) && (scm_style != SCM_EOL)) + style = ly_scm2string (scm_symbol_to_string (scm_style)); + else { + warning (_ ("porrectus style undefined; using mensural")); + style = "mensural"; + } + + bool solid = to_boolean (me->get_grob_property ("solid")); + bool add_stem = to_boolean (me->get_grob_property ("add-stem")); + + SCM stem_direction_scm = me->get_grob_property ("stem-direction"); + Direction stem_direction = + gh_number_p (stem_direction_scm) ? to_dir (stem_direction_scm) : DOWN; + if (!stem_direction) + stem_direction = DOWN; + + SCM left_head_scm = get_left_head (me); + SCM right_head_scm = get_right_head (me); + if ((left_head_scm == SCM_EOL) || (right_head_scm == SCM_EOL)) + { + warning (_ ("junking lonely porrectus")); + return SCM_EOL; + } + + Item *left_head = dynamic_cast (unsmob_grob (left_head_scm)); + Item *right_head = dynamic_cast (unsmob_grob (right_head_scm)); + if (!left_head || !right_head) + { + warning (_ ("junking lonely porrectus")); + return SCM_EOL; + } + + Real left_position_f = Staff_symbol_referencer::position_f (left_head); + Real right_position_f = Staff_symbol_referencer::position_f (right_head); + Real interval = right_position_f - left_position_f; + + Molecule molecule; + if (String::compare_i (style, "vaticana") == 0) + molecule = brew_vaticana_molecule (me, solid, add_stem, stem_direction, + interval); + else if (String::compare_i (style, "mensural") == 0) + molecule = brew_mensural_molecule (me, solid, add_stem, stem_direction, + interval); + else + return SCM_EOL; + + Real space = Staff_symbol_referencer::staff_space (me); + Real head_extent = molecule.extent (X_AXIS).length (); + Interval extent (-0.2 * head_extent, 1.2 * head_extent); + int interspaces = Staff_symbol_referencer::line_count (me)-1; + + molecule.translate_axis (left_position_f * space/2, Y_AXIS); + + Molecule left_head_streepjes = + create_streepjes (me, (int)rint (left_position_f), interspaces, extent); + left_head_streepjes.translate_axis (left_position_f * space/2, Y_AXIS); + molecule.add_molecule (left_head_streepjes); + + Molecule right_head_streepjes = + create_streepjes (me, (int)rint (right_position_f), interspaces, extent); + right_head_streepjes.translate_axis (right_position_f * space/2, Y_AXIS); + molecule.add_molecule (right_head_streepjes); + + return molecule.smobbed_copy(); +} + +Molecule +Porrectus::brew_vaticana_molecule (Item *me, + bool solid, + bool add_stem, + Direction stem_direction, + Real interval) +{ + Real space = Staff_symbol_referencer::staff_space (me); + Real line_thickness = space/6; + Real width = 2.4 * space; + Molecule molecule = Molecule (); + + if (interval >= 0.0) + { + warning (_ ("ascending vaticana style porrectus (ignored)")); + } + + if (add_stem) + { + bool consider_interval = + ((stem_direction == DOWN) && (interval < 0.0)) || + ((stem_direction == UP) && (interval > 0.0)); + + Interval stem_box_x (-line_thickness/2, +line_thickness/2); + Interval stem_box_y; + + if (consider_interval) + { + Real y_length = interval / 2.0; + if (y_length < 1.2 * space) + y_length = 1.2 * space; + stem_box_y = Interval (0, y_length); + } + else + stem_box_y = Interval (0, space); + + Real y_correction = + (stem_direction == UP) ? + 0.3 * space : + - 0.3 * space - stem_box_y.length(); + + Box stem_box (stem_box_x, stem_box_y); + Molecule stem = Lookup::filledbox (stem_box); + stem.translate_axis (y_correction, Y_AXIS); + molecule.add_molecule(stem); + } + + Box vertical_edge (Interval (-line_thickness/2, +line_thickness/2), + Interval (-4*line_thickness/2, +4*line_thickness/2)); + Molecule left_edge = Lookup::filledbox (vertical_edge); + Molecule right_edge = Lookup::filledbox (vertical_edge); + right_edge.translate_axis (width, X_AXIS); + right_edge.translate_axis (interval / 2.0, Y_AXIS); + molecule.add_molecule(left_edge); + molecule.add_molecule(right_edge); + + Bezier bezier; + bezier.control_[0] = Offset (0.00 * width, 0.0); + bezier.control_[1] = Offset (0.33 * width, interval / 2.0); + bezier.control_[2] = Offset (0.66 * width, interval / 2.0); + bezier.control_[3] = Offset (1.00 * width, interval / 2.0); + + Molecule slice; + slice = Lookup::slur (bezier, 0.0, line_thickness); + slice.translate_axis (-3 * line_thickness/2, Y_AXIS); + molecule.add_molecule (slice); + if (solid) + for (int i = -2; i < +2; i++) + { + slice = Lookup::slur (bezier, 0.0, line_thickness); + slice.translate_axis (i * line_thickness/2, Y_AXIS); + molecule.add_molecule (slice); + } + slice = Lookup::slur (bezier, 0.0, line_thickness); + slice.translate_axis (+3 * line_thickness/2, Y_AXIS); + molecule.add_molecule (slice); + + return molecule; +} + +Molecule +Porrectus::brew_mensural_molecule (Item *me, + bool solid, + bool add_stem, + Direction stem_direction, + Real interval) +{ + Real space = Staff_symbol_referencer::staff_space (me); + Real line_thickness = space/6; + Real width = 2.4 * space; + Molecule molecule = Molecule (); + + if (add_stem) + { + // Uugh. This is currently the same as in + // brew_vaticana_molecule, but may eventually be changed. + + bool consider_interval = + ((stem_direction == DOWN) && (interval < 0.0)) || + ((stem_direction == UP) && (interval > 0.0)); + + Interval stem_box_x (0, line_thickness); + Interval stem_box_y; + + if (consider_interval) + { + Real y_length = interval / 2.0; + if (y_length < 1.2 * space) + y_length = 1.2 * space; + stem_box_y = Interval (0, y_length); + } + else + stem_box_y = Interval (0, space); + + Real y_correction = + (stem_direction == UP) ? + 0.3 * space : + - 0.3 * space - stem_box_y.length(); + + Box stem_box (stem_box_x, stem_box_y); + Molecule stem = Lookup::filledbox (stem_box); + stem.translate_axis (y_correction, Y_AXIS); + molecule.add_molecule(stem); + } + + Real slope = (interval / 2.0) / width; + + Molecule left_edge = + brew_horizontal_slope (line_thickness, slope, 3.5 * line_thickness); + left_edge.translate_axis (0.25 * line_thickness, Y_AXIS); + molecule.add_molecule(left_edge); + + Molecule right_edge = + brew_horizontal_slope (line_thickness, slope, 3.5 * line_thickness); + right_edge.translate_axis (width - line_thickness, X_AXIS); + right_edge.translate_axis (interval / 2.0 * (1.0 - (line_thickness/width)) + + 0.25 * line_thickness, Y_AXIS); + molecule.add_molecule(right_edge); + + Molecule bottom_edge = + Porrectus::brew_horizontal_slope (width, slope, line_thickness); + bottom_edge.translate_axis (-3 * line_thickness/2, Y_AXIS); + molecule.add_molecule (bottom_edge); + + Molecule top_edge = + Porrectus::brew_horizontal_slope (width, slope, line_thickness); + top_edge.translate_axis (+3 * line_thickness/2, Y_AXIS); + molecule.add_molecule (top_edge); + + if (solid) + { + Molecule core = + Porrectus::brew_horizontal_slope (width, slope, 6 * line_thickness/2); + core.translate_axis (-line_thickness/2, Y_AXIS); + molecule.add_molecule (core); + } + + return molecule; +} + +Molecule +Porrectus::brew_horizontal_slope(Real width, Real slope, Real line_thickness) +{ + SCM width_scm = gh_double2scm (width); + SCM slope_scm = gh_double2scm (slope); + SCM line_thickness_scm = gh_double2scm (line_thickness); + SCM horizontal_slope = gh_list (ly_symbol2scm ("beam"), + width_scm, slope_scm, + line_thickness_scm, SCM_UNDEFINED); + Box b (Interval (0, width), + Interval (0, width * slope + + sqrt (sqr(line_thickness/slope) + sqr (line_thickness)))); + return Molecule (b, horizontal_slope); +} diff -urN lilypond-1.5.9/ly/engraver-init.ly lilypond-1.5.9.NEW/ly/engraver-init.ly --- lilypond-1.5.9/ly/engraver-init.ly Fri Aug 10 14:56:43 2001 +++ lilypond-1.5.9.NEW/ly/engraver-init.ly Thu Sep 6 23:52:20 2001 @@ -149,6 +149,7 @@ \consists "Phrasing_slur_engraver" \consists "Slur_engraver" \consists "Tie_engraver" + \consists "Porrectus_engraver" \consists "Tuplet_engraver" \consists "A2_engraver" diff -urN lilypond-1.5.9/scm/generic-property.scm lilypond-1.5.9.NEW/scm/generic-property.scm --- lilypond-1.5.9/scm/generic-property.scm Sun Aug 19 22:01:54 2001 +++ lilypond-1.5.9.NEW/scm/generic-property.scm Mon Sep 10 00:10:15 2001 @@ -167,6 +167,16 @@ (list (list 'noteNameStyle symbol? 'style)))) +(define generic-porrectus-properties + (cons 'porrectus-interface + (list + (list 'porrectusStyle symbol? 'style) + (list 'porrectusSolid boolean? 'solid) + (list 'porrectusAddStem boolean? 'add-stem) + (list 'porrectusStemDirection dir? 'stem-direction) + ))) + + (define generic-rest-properties (cons 'rest-interface (list (list 'restStyle string? 'reststyle)))) @@ -246,6 +256,7 @@ generic-tie-column-properties generic-tuplet-spanner-properties generic-notehead-properties + generic-porrectus-properties generic-rest-properties generic-slur-properties generic-beam-properties diff -urN lilypond-1.5.9/scm/grob-description.scm lilypond-1.5.9.NEW/scm/grob-description.scm --- lilypond-1.5.9/scm/grob-description.scm Wed Aug 22 23:23:14 2001 +++ lilypond-1.5.9.NEW/scm/grob-description.scm Mon Sep 10 00:07:39 2001 @@ -302,6 +302,16 @@ (meta . ,(grob-description "LyricText" lyric-syllable-interface text-interface font-interface )) )) + (Porrectus . ( + (style . mensural) + (solid . #f) + (add-stem . #t) + (stem-direction . 1) + (molecule-callback . ,Porrectus::brew_molecule) + (meta . ,(grob-description "Porrectus" + porrectus-interface)) + )) + (RehearsalMark . ( (molecule-callback . ,Text_item::brew_molecule) (X-offset-callbacks . (,Side_position_interface::aligned_on_self)) diff -urN lilypond-1.5.9/scm/grob-property-description.scm lilypond-1.5.9.NEW/scm/grob-property-description.scm --- lilypond-1.5.9/scm/grob-property-description.scm Mon Aug 20 23:53:21 2001 +++ lilypond-1.5.9.NEW/scm/grob-property-description.scm Mon Sep 10 02:44:03 2001 @@ -29,6 +29,7 @@ (grob-property-description 'X-offset-callbacks list? "list of functions, each taking an grob and axis argument. The function determine the position relative to this grob's parent. The last one in the list is called first.") (grob-property-description 'Y-extent-callback procedure? "see @code{X-extent-callback}.") (grob-property-description 'Y-offset-callbacks list? "see @code{X-offset-callbacks}.") +(grob-property-description 'add-stem boolean? "Add stem to porrectus?.") (grob-property-description 'after-line-breaking-callback procedure? "Procedure taking a grob as argument. This procedure is called (using dependency resolution) after line breaking. Return value is ignored.") (grob-property-description 'align number? "the alignment of the text, 0 is horizontal, 1 is vertical.") @@ -269,6 +270,7 @@ (grob-property-description 'side-support list? "the support, a list of grobs.") (grob-property-description 'slope number? "some kind of slope") (grob-property-description 'slope-limit number? "set slope to zero if slope is running away steeper than this.") +(grob-property-description 'solid boolean? "should porrectus be solidly filled?.") (grob-property-description 'space-alist list? "Alist of break align spacing tuples. See basic-property.scm") (grob-property-description 'space-function procedure? "function of type multiplicity -> real (in staffspace).") (grob-property-description 'spacing-procedure procedure? "procedure @@ -281,6 +283,7 @@ (grob-property-description 'staff-symbol boolean? "the staff symbol grob that we're in.") (grob-property-description 'staffline-clearance number? "don't get closer than this to stafflines.") (grob-property-description 'stem ly-grob? "pointer to Stem object.") +(grob-property-description 'stem-direction dir? "up or down?.") (grob-property-description 'stem-end-position number? "Where does the stem end (the end is opposite to the support-head.") (grob-property-description 'stem-length number? "length of stem.") (grob-property-description 'stem-shorten list? "shorten stems in forced directions given flag multiplicity.") diff -urN lilypond-1.5.9/scm/interface-description.scm lilypond-1.5.9.NEW/scm/interface-description.scm --- lilypond-1.5.9/scm/interface-description.scm Fri Sep 7 18:39:30 2001 +++ lilypond-1.5.9.NEW/scm/interface-description.scm Mon Sep 10 01:20:22 2001 @@ -568,6 +568,13 @@ (lily-interface + 'porrectus-interface + "A porrectus ligature, joining two note heads into a single grob." + '( + )) + + + (lily-interface 'spaceable-element-interface "An grob (generally a Paper_column) that takes part in the spacing problem. " diff -urN lilypond-1.5.9/scm/translator-description.scm lilypond-1.5.9.NEW/scm/translator-description.scm --- lilypond-1.5.9/scm/translator-description.scm Fri Aug 10 14:56:43 2001 +++ lilypond-1.5.9.NEW/scm/translator-description.scm Thu Sep 6 23:23:12 2001 @@ -436,6 +436,16 @@ ))) (cons + 'Porrectus_engraver + (engraver-description + "Porrectus_engraver" + "Join adjacent notes to a porrectus ligature." + '(Porrectus) + '( + ))) + + + (cons 'Property_engraver (engraver-description "Property_engraver"