This is the second try for a porrectus engraver.  Some issues from the
TODO list have been solved, but even more have been added.  Hence,
there will be (at least) a third try...

The most important changes are:

* Syntax change: \porrectus -> \~, reflecting recent discussion with
  Mark and Mats.  The syntax that Mark and I were discussing, is a
  kind of compact, flexible low-level syntax that operates in terms of
  ligature primitives.  Such a low-level syntax is necessary because it
  is not appropriate to provide individual syntactical constructs for all
  of (if I remember right) over 90 types of complex ligatures.  Still,
  my plan for the (far) future is to also provide a scheme-based
  high-level syntax that maps to the low-level syntax, thereby
  providing at least the most important complex ligatures as scheme
  functions, each taking just a list of pitches as argument.  The
  keyword \porrectus is a candidate to be reintroduced as part of this
  high-level language.
* New porrectus properties: porrectus-width, line-thickness.
* Bugfix: left<->right confusion in porrectus-engraver.cc.
* Bugfix: Box dimensions for horizontal slope molecule in porrectus.cc.
* Enhanced mensural style porrectus shape, considering optical
  illusion in vertical endings due to slope.  Simplified drawing.
* Code clean-up.

By the way, when issueing a "diff -Naur lilypond-1.5.10
lilypond-1.5.10.NEW", I detected that the files

lilypond-1.5.10/Documentation/pictures/out/lilypond-icon.xpm
lilypond-1.5.10/make/out/lilypond.lsm
lilypond-1.5.10/make/out/lilypond.mandrake.spec
lilypond-1.5.10/make/out/lilypond.redhat.spec
lilypond-1.5.10/make/out/lilypond.suse.spec

were erroneously still in the lilypond-1.5.10 directory hierarchy.  I
had to remove these manually before re-running diff.

Han-Wen wrote a while ago:
> > + * moment of the second note.  Actually, it should take the moment of
> > + * the first note.
> > + *
> > + * TODO: Introduce "\~" as alternative syntax for "\porrectus"?
>
> Looking at the output, maybe it's more appropriate to have this
> engraver react to glissando requests?  OTOH, that might lead to weird
> syntax.

No, while glissando is a spanner, porrectus is an item since it has a
fixed width.  It seems that syntax like "c \someRequest d" only works
for spanners: When \someRequest is encountered, the current moment
already has been incremented by the duration of the preceding note
request, and announcing a grob afterwards seems to confuse lily (I
guess the grob will inserted into the tree at the wrong place,
right?): I tried to force the porrectus item to have the same moment
as the preceding note request by announcing the grob with the
preceding note request as second argument.  But that results only in a
"Separation_item: I've been drinking too much"; the porrectus will
still be aligned with the second note.

> > not at all a good idea to use the transparent property for hiding note
> > heads that contribute to the porrectus.  But forcing them to suicide
is
> > not an option, since the porrectus relies on properties that are set
on
> > the note heads.
>
> You can always copy the relevant information from the grobs and then
> kill them.  

If I kill a note-head item, I fear that other engravers or grobs may
assume this note-head still to be alive.  Or do you think that should
not be a problem?

> An entirely different way of handling it is, to take somehow take over
> the note head engraver (i.e. modifying it to temporarily switch it
> off), and have the porrectus engraver accept Note_reqs and generate the
> ligature without any note head grobs. That also stops the stem
> engraver from generating stems. It would however, require prefix
> syntax, something like
>
>              \startLigature c4 d4 \endLigature

Ok, I think I finally got it: I need prefix syntax, because this seems
to be the only way to avoid the above "I've been drinking too much"
problem (unless I rewrite the music iteration process...).  Since, as
I already told, I will anyway need to introduce some surrounding
syntax (e.g. for getting right accidentals and spacing handling), the
"take over" approach really may be the best solution (although I fear
that it will result in a dirty hack).  So, the syntax for a (lonely)
porrectus will be something like "\startLigature c4 \~ d4
\endLigature".  I will have a look into it.

Greetings,
           Juergen
diff -Naur lilypond-1.5.10/input/test/ancient-font.ly 
lilypond-1.5.10.NEW/input/test/ancient-font.ly
--- lilypond-1.5.10/input/test/ancient-font.ly  Mon Sep 10 11:49:54 2001
+++ lilypond-1.5.10.NEW/input/test/ancient-font.ly      Thu Sep 20 04:11:41 2001
@@ -44,7 +44,7 @@
        a! b!
        \property Staff.BarLine \override #'bar-size = #3.0 \bar "|"
        \property Voice.NoteHead \override #'style = #'vaticana_virga
-       ces' b! ces'! \porrectus ges! \porrectus fes!
+       ces' b! ces'! \~ ges! \~ fes!
        \breathe
        \clef "vaticana_fa1"
        \property Voice.NoteHead \override #'style = #'vaticana_quilisma
@@ -128,28 +128,30 @@
        \property Voice.Porrectus \override #'solid = ##f
        \property Voice.Porrectus \override #'add-stem = ##t
        \property Voice.Porrectus \override #'stem-direction = #1
+       \property Voice.Porrectus \override #'line-thickness = #0.7
+       % \property Voice.Porrectus \override #'porrectus-width = #3.0
        \key a \major
 
        % IMPORTANT NOTE:
        %
-       % The porrectus syntax is subject to change.  For proper
-       % use, it may eventually change into something like this:
+       % The porrectus syntax is definitely subject to change.  For
+       % proper use, it may eventually change into something like this:
        %
-       % \ligature { e \porrectus c }
+       % \startLigature e \~ c \endLigature
        %
        % 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"
-       cis' e' \porrectus d' gis' \porrectus e'
+       cis' e' \~ d' gis' \~ e'
        \property Staff.forceClef = ##t
        \clef "neo_mensural_c2"
 
-       fis' \porrectus b cis''
-       b \porrectus a a \porrectus fis
+       fis' \~ b cis''
+       b \~ a a \~ fis
        \clef "petrucci_c2"
-       cis \porrectus fis ces1 % \bar "|"
+       cis \~ fis ces1 % \bar "|"
 
        \clef "petrucci_c2"
        r\longa
@@ -189,8 +191,8 @@
        % porrectus grobs.  Is this an initialization bug in the line
        % breaking algorithm?
 
-       bes'! \porrectus as'! \porrectus cis''!
-       bes'! \porrectus fis'! as'! \porrectus ges'!
+       bes'! \~ as'! \~ cis''!
+       bes'! \~ fis'! as'! \~ ges'!
        \property Staff.forceClef = ##t
        \clef "mensural_g"
        e' d' c'1 \bar "|"
diff -Naur lilypond-1.5.10/lily/include/porrectus.hh 
lilypond-1.5.10.NEW/lily/include/porrectus.hh
--- lilypond-1.5.10/lily/include/porrectus.hh   Mon Sep 10 11:49:54 2001
+++ lilypond-1.5.10.NEW/lily/include/porrectus.hh       Tue Sep 18 02:44:03 2001
@@ -17,15 +17,19 @@
 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 *);
+  static void set_left_head (Grob *, Item *);
+  static Item *get_left_head (Grob *);
+  static void set_right_head (Grob *, Item *);
+  static Item *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_vaticana_molecule (Item *, Real,
+                                         bool, Real, Real,
+                                         bool, Direction);
+  static Molecule brew_mensural_molecule (Item *, Real,
+                                         bool, Real, Real,
+                                         bool, Direction);
   static Molecule brew_horizontal_slope (Real, Real, Real);
   static Molecule create_ledger_line (Interval, Grob *);
   static Molecule create_streepjes (Grob *, int, int, Interval);
diff -Naur lilypond-1.5.10/lily/lexer.ll lilypond-1.5.10.NEW/lily/lexer.ll
--- lilypond-1.5.10/lily/lexer.ll       Sun Sep 16 19:11:28 2001
+++ lilypond-1.5.10.NEW/lily/lexer.ll   Wed Sep 19 00:03:47 2001
@@ -457,6 +457,8 @@
        return E_OPEN;
     case ')':
        return E_CLOSE;
+    case '~':
+       return E_TILDE;
     default:
        return E_CHAR;
     }
diff -Naur lilypond-1.5.10/lily/my-lily-lexer.cc 
lilypond-1.5.10.NEW/lily/my-lily-lexer.cc
--- lilypond-1.5.10/lily/my-lily-lexer.cc       Sun Sep 16 19:11:28 2001
+++ lilypond-1.5.10.NEW/lily/my-lily-lexer.cc   Tue Sep 18 23:38:12 2001
@@ -80,7 +80,6 @@
   {"repeat", REPEAT},
   {"addlyrics", ADDLYRICS},
   {"partcombine", PARTCOMBINE},
-  {"porrectus", PORRECTUS},
   {"score", SCORE},
   {"script", SCRIPT},
   {"stylesheet", STYLESHEET},
diff -Naur lilypond-1.5.10/lily/parser.yy lilypond-1.5.10.NEW/lily/parser.yy
--- lilypond-1.5.10/lily/parser.yy      Sun Sep 16 19:11:28 2001
+++ lilypond-1.5.10.NEW/lily/parser.yy  Wed Sep 19 00:22:36 2001
@@ -215,7 +215,6 @@
 %token PAPER
 %token PARTIAL
 %token PENALTY
-%token PORRECTUS
 %token PROPERTY
 %token OVERRIDE SET REVERT 
 %token PT_T
@@ -242,7 +241,7 @@
 %token CONTEXT
 
 /* escaped */
-%token E_CHAR E_EXCLAMATION E_SMALLER E_BIGGER E_OPEN E_CLOSE
+%token E_CHAR E_EXCLAMATION E_SMALLER E_BIGGER E_OPEN E_CLOSE E_TILDE
 %token CHORD_BASS CHORD_COLON CHORD_MINUS CHORD_CARET 
 
 %type <i>      exclamations questions dots
@@ -1236,11 +1235,10 @@
        | BREATHE {
                $$ = new Breathing_sign_req;
        }
-       | PORRECTUS {
+       | E_TILDE {
                $$ = new Porrectus_req;
        }
        ;
-
 
 verbose_command_req:
        COMMANDSPANREQUEST bare_int STRING { /*TODO: junkme */
diff -Naur lilypond-1.5.10/lily/porrectus-engraver.cc 
lilypond-1.5.10.NEW/lily/porrectus-engraver.cc
--- lilypond-1.5.10/lily/porrectus-engraver.cc  Mon Sep 10 11:49:54 2001
+++ lilypond-1.5.10.NEW/lily/porrectus-engraver.cc      Thu Sep 20 03:48:47 2001
@@ -11,33 +11,34 @@
  * moment of the second note.  Actually, it should take the moment of
  * the first note.
  *
- * TODO: Introduce "\~" as alternative syntax for "\porrectus"?
+ * FIXME: Turn off typesetting of stems, flags, dots, etc.
  *
  * 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: Fine-tuning of vaticana-style porrectus shape; in particular,
+ * ensure solidity if solid is set to #t and thickness is very small.
  *
  * 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.
+ * turned on, lily automatically sets the properties add-stem and
+ * stem-direction 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: The following issues are currently not handled by this
+ * engraver: (1) accidentals placement, (2) avoiding line breaking
+ * inbetween porrectus, (3) spacing.  (Han-Wen says: for (2), look at
+ * beam engraver.)  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 \~ c }.
  *
  * TODO: Do not allow a series of adjacent porrectus requests, as in:
- * e \porrectus d \porrectus c.
- */
+ * e \~ d \~ c.
+ *
+ * TODO: Junk duplicate (or rather triple) implementation of
+ * create_ledger_line in porrectus.cc, custos.cc and note-head.cc.  */
 
 #include "staff-symbol-referencer.hh"
 #include "porrectus.hh"
@@ -112,9 +113,9 @@
       Note_req *note_req_l_ = dynamic_cast <Note_req *> (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 ()));
+      right_heads_.push (PHead_melodic_tuple (info_l_.elem_l_, note_req_l_,
+                                             now_mom () +
+                                             note_req_l_->length_mom ()));
     }
 }
 
@@ -125,41 +126,27 @@
     {
       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<Item*> (unsmob_grob (caar));
-         Item *right_head = dynamic_cast<Item*> (unsmob_grob (cdar));
+         Item *left_head = dynamic_cast<Item*> (left_heads_[i].head_l_);
+         Item *right_head = dynamic_cast<Item*> (right_heads_[j].head_l_);
          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::set_left_head(porrectus_p_, left_head);
+         Porrectus::set_right_head(porrectus_p_, right_head);
          porrectus_p_arr_.push (porrectus_p_);
-         announce_grob (porrectus_p_, 0);
+         announce_grob (porrectus_p_, porrectus_req_l_);
+
+         past_notes_pq_. insert (right_heads_[i]);
+         left_heads_.del (i);
+         right_heads_.del (j);
+         i--;
+         j--;
        }
     }
 }
@@ -167,11 +154,11 @@
 void
 Porrectus_engraver::stop_translation_timestep ()
 {
-  for (int i = 0; i < left_heads_.size (); i++)
+  for (int i = 0; i < right_heads_.size (); i++)
     {
-      past_notes_pq_.insert (left_heads_[i]);
+      past_notes_pq_.insert (right_heads_[i]);
     }
-  left_heads_.clear ();
+  right_heads_.clear ();
 
   for (int i = 0; i < porrectus_p_arr_.size (); i++)
     {
@@ -188,10 +175,10 @@
   while (past_notes_pq_.size () && past_notes_pq_.front ().end_ < now)
     past_notes_pq_.delmin ();
 
-  right_heads_.clear ();
+  left_heads_.clear ();
   while (past_notes_pq_.size () &&
         (past_notes_pq_.front ().end_ == now))
-    right_heads_.push (past_notes_pq_.get ());
+    left_heads_.push (past_notes_pq_.get ());
 }
 
 ADD_THIS_TRANSLATOR (Porrectus_engraver);
diff -Naur lilypond-1.5.10/lily/porrectus.cc lilypond-1.5.10.NEW/lily/porrectus.cc
--- lilypond-1.5.10/lily/porrectus.cc   Mon Sep 10 11:49:54 2001
+++ lilypond-1.5.10.NEW/lily/porrectus.cc       Thu Sep 20 03:32:49 2001
@@ -19,40 +19,67 @@
 #include "direction.hh"
 #include "bezier.hh"
 #include "font-interface.hh"
+#include "paper-def.hh"
 #include "math.h" // rint
 
 void
-Porrectus::set_left_head (Grob *me, SCM left_head)
+Porrectus::set_left_head (Grob *me, Item *left_head)
 {
-  if (left_head == SCM_EOL)
+  if (left_head != 0)
     {
-      warning (_ ("(left_head == SCM_EOL) (ignored)"));
+      me->set_grob_property ("left-head", left_head->self_scm());
+    }
+  else
+    {
+      programming_error (_ ("(left_head == 0)"));
+      me->set_grob_property ("left-head", SCM_EOL);
     }
-  me->set_grob_property ("left-head", left_head);
 }
 
-SCM
+Item *
 Porrectus::get_left_head (Grob *me)
 {
-  SCM left_head = me->get_grob_property ("left-head");
-  return left_head;
+  SCM left_head_scm = me->get_grob_property ("left-head");
+  if (left_head_scm == SCM_EOL)
+    {
+      programming_error (_ ("undefined left_head"));
+      return 0;
+    }
+  else
+    {
+      Item *left_head = dynamic_cast<Item*> (unsmob_grob (left_head_scm));
+      return left_head;
+    }
 }
 
 void
-Porrectus::set_right_head (Grob *me, SCM right_head)
+Porrectus::set_right_head (Grob *me, Item *right_head)
 {
-  if (right_head == SCM_EOL)
+  if (right_head != 0)
+    {
+      me->set_grob_property ("right-head", right_head->self_scm());
+    }
+  else
     {
-      warning (_ ("(right_head == SCM_EOL) (ignored)"));
+      programming_error (_ ("(right_head == 0)"));
+      me->set_grob_property ("right-head", SCM_EOL);
     }
-  me->set_grob_property ("right-head", right_head);
 }
 
-SCM
+Item *
 Porrectus::get_right_head (Grob *me)
 {
-  SCM right_head = me->get_grob_property ("right-head");
-  return right_head;
+  SCM right_head_scm = me->get_grob_property ("right-head");
+  if (right_head_scm == SCM_EOL)
+    {
+      programming_error (_ ("undefined right_head"));
+      return 0;
+    }
+  else
+    {
+      Item *right_head = dynamic_cast<Item*> (unsmob_grob (right_head_scm));
+      return right_head;
+    }
 }
 
 // Uugh.  The following two functions are almost duplicated code from
@@ -148,19 +175,12 @@
   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<Item*> (unsmob_grob (left_head_scm));
-  Item *right_head = dynamic_cast<Item*> (unsmob_grob (right_head_scm));
+  Item *left_head = get_left_head (me);
+  Item *right_head = get_right_head (me);
   if (!left_head || !right_head)
     {
       warning (_ ("junking lonely porrectus"));
+      me->suicide ();
       return SCM_EOL;
     }
 
@@ -169,12 +189,40 @@
   Real interval = right_position_f - left_position_f;
 
   Molecule molecule;
+
+  SCM line_thickness_scm = me->get_grob_property ("line-thickness");
+  Real line_thickness;
+  if (gh_number_p (line_thickness_scm))
+    {
+      line_thickness = gh_scm2double (line_thickness_scm);
+    }
+  else
+    {
+      line_thickness = 1.0;
+    }
+  Real thickness =
+    line_thickness * me->paper_l ()->get_var ("stafflinethickness");
+
+  SCM porrectus_width_scm = me->get_grob_property ("porrectus-width");
+  Real porrectus_width;
+  if (gh_number_p (porrectus_width_scm))
+    {
+      porrectus_width = gh_scm2double (porrectus_width_scm);
+    }
+  else
+    {
+      porrectus_width = 2.4;
+    }
+  Real width = porrectus_width * Staff_symbol_referencer::staff_space (me);
+
   if (String::compare_i (style, "vaticana") == 0)
-    molecule = brew_vaticana_molecule (me, solid, add_stem, stem_direction,
-                                      interval);
+    molecule = brew_vaticana_molecule (me, interval,
+                                      solid, width, thickness,
+                                      add_stem, stem_direction);
   else if (String::compare_i (style, "mensural") == 0)
-    molecule = brew_mensural_molecule (me, solid, add_stem, stem_direction,
-                                      interval);
+    molecule = brew_mensural_molecule (me, interval,
+                                      solid, width, thickness,
+                                      add_stem, stem_direction);
   else
     return SCM_EOL;
 
@@ -200,28 +248,27 @@
 
 Molecule
 Porrectus::brew_vaticana_molecule (Item *me,
+                                  Real interval,
                                   bool solid,
+                                  Real width,
+                                  Real thickness,
                                   bool add_stem,
-                                  Direction stem_direction,
-                                  Real interval)
+                                  Direction stem_direction)
 {
   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)"));
+      warning (_ ("ascending vaticana style porrectus"));
     }
 
   if (add_stem)
     {
       bool consider_interval =
-       ((stem_direction == DOWN) && (interval < 0.0)) ||
-       ((stem_direction == UP) && (interval > 0.0));
+       stem_direction * interval > 0.0;
 
-      Interval stem_box_x (-line_thickness/2, +line_thickness/2);
+      Interval stem_box_x (-thickness/2, +thickness/2);
       Interval stem_box_y;
 
       if (consider_interval)
@@ -245,8 +292,8 @@
       molecule.add_molecule(stem);
     }
 
-  Box vertical_edge (Interval (-line_thickness/2, +line_thickness/2),
-                    Interval (-4*line_thickness/2, +4*line_thickness/2));
+  Box vertical_edge (Interval (-thickness/2, +thickness/2),
+                    Interval (-4*thickness/2, +4*thickness/2));
   Molecule left_edge = Lookup::filledbox (vertical_edge);
   Molecule right_edge = Lookup::filledbox (vertical_edge);
   right_edge.translate_axis (width, X_AXIS);
@@ -261,18 +308,18 @@
   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);
+  slice = Lookup::slur (bezier, 0.0, thickness);
+  slice.translate_axis (-3 * 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);
+       slice = Lookup::slur (bezier, 0.0, thickness);
+       slice.translate_axis (i * 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);
+  slice = Lookup::slur (bezier, 0.0, thickness);
+  slice.translate_axis (+3 * thickness/2, Y_AXIS);
   molecule.add_molecule (slice);
 
   return molecule;
@@ -280,14 +327,14 @@
 
 Molecule
 Porrectus::brew_mensural_molecule (Item *me,
+                                  Real interval,
                                   bool solid,
+                                  Real width,
+                                  Real thickness,
                                   bool add_stem,
-                                  Direction stem_direction,
-                                  Real interval)
+                                  Direction stem_direction)
 {
   Real space = Staff_symbol_referencer::staff_space (me);
-  Real line_thickness = space/6;
-  Real width = 2.4 * space;
   Molecule molecule = Molecule ();
 
   if (add_stem)
@@ -296,10 +343,9 @@
       // brew_vaticana_molecule, but may eventually be changed.
 
       bool consider_interval =
-       ((stem_direction == DOWN) && (interval < 0.0)) ||
-       ((stem_direction == UP) && (interval > 0.0));
+       stem_direction * interval > 0.0;
 
-      Interval stem_box_x (0, line_thickness);
+      Interval stem_box_x (0, thickness);
       Interval stem_box_y;
 
       if (consider_interval)
@@ -325,50 +371,71 @@
 
   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);
+  // Compensate optical illusion regarding vertical position of left
+  // and right endings due to slope.
+  Real ypos_correction = -0.1*space * sign(slope);
+  Real slope_correction = 0.2*space * sign(slope);
+  Real corrected_slope = slope + slope_correction/width;
 
   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);
+      Molecule solid_head =
+       brew_horizontal_slope (width, corrected_slope, 0.6*space);
+      molecule.add_molecule (solid_head);
     }
-
+  else
+    {
+      Molecule left_edge =
+         brew_horizontal_slope (thickness, corrected_slope, 0.6*space);
+      molecule.add_molecule(left_edge);
+
+      Molecule right_edge =
+         brew_horizontal_slope (thickness, corrected_slope, 0.6*space);
+      right_edge.translate_axis (width-thickness, X_AXIS);
+      right_edge.translate_axis (corrected_slope * (width-thickness), Y_AXIS);
+      molecule.add_molecule(right_edge);
+
+      Molecule bottom_edge =
+         brew_horizontal_slope (width, corrected_slope, thickness);
+      bottom_edge.translate_axis (-0.3*space, Y_AXIS);
+      molecule.add_molecule (bottom_edge);
+
+      Molecule top_edge =
+         brew_horizontal_slope (width, corrected_slope, thickness);
+      top_edge.translate_axis (+0.3*space, Y_AXIS);
+      molecule.add_molecule (top_edge);
+    }
+  molecule.translate_axis (ypos_correction, Y_AXIS);
   return molecule;
 }
 
+/*
+ * Horizontal Slope:
+ *
+ *            /|   ^
+ *           / |   |
+ *          /  |   | thickness
+ *         /   |   |
+ *        /    |   v
+ *       |    /
+ *       |   /
+ * (0,0) x  /slope=dy/dx
+ *       | /
+ *       |/
+ *
+ *       <----->
+ *        width
+ */
 Molecule
-Porrectus::brew_horizontal_slope(Real width, Real slope, Real line_thickness)
+Porrectus::brew_horizontal_slope(Real width, Real slope, Real thickness)
 {
   SCM width_scm = gh_double2scm (width);
   SCM slope_scm = gh_double2scm (slope);
-  SCM line_thickness_scm = gh_double2scm (line_thickness);
+  SCM thickness_scm = gh_double2scm (thickness);
   SCM horizontal_slope = gh_list (ly_symbol2scm ("beam"),
                                  width_scm, slope_scm,
-                                 line_thickness_scm, SCM_UNDEFINED);
+                                 thickness_scm, SCM_UNDEFINED);
   Box b (Interval (0, width),
-        Interval (0, width * slope +
-                  sqrt (sqr(line_thickness/slope) + sqr (line_thickness))));
+        Interval (-thickness/2, thickness/2 + width*slope));
   return Molecule (b, horizontal_slope);
 }
diff -Naur lilypond-1.5.10/scm/grob-description.scm 
lilypond-1.5.10.NEW/scm/grob-description.scm
--- lilypond-1.5.10/scm/grob-description.scm    Tue Sep 11 17:28:04 2001
+++ lilypond-1.5.10.NEW/scm/grob-description.scm        Tue Sep 18 03:11:47 2001
@@ -323,7 +323,10 @@
        
        (Porrectus . (
                (style . mensural)
+               (auto-properties . #t)
                (solid . #f)
+               (porrectus-width . 2.4)
+               (line-thickness . 1.0)
                (add-stem . #t)
                (stem-direction . 1)
                (molecule-callback . ,Porrectus::brew_molecule)
diff -Naur lilypond-1.5.10/scm/grob-property-description.scm 
lilypond-1.5.10.NEW/scm/grob-property-description.scm
--- lilypond-1.5.10/scm/grob-property-description.scm   Mon Sep 10 11:49:54 2001
+++ lilypond-1.5.10.NEW/scm/grob-property-description.scm       Tue Sep 18 03:14:29 
+2001
@@ -252,6 +252,7 @@
 (grob-property-description 'padding number? "add this much extra space between 
objects that are next to each other.")
 (grob-property-description 'parallel-beam boolean? "internal: true if there is a beam 
just as wide as the bracket .")
 (grob-property-description 'pitches list? "list of musical-pitch.")
+(grob-property-description 'porrectus-width number? "width of the porrectus ligature 
+measured in staff space.")
 (grob-property-description 'raise number? "height for text to be raised (a negative 
value lowers the text.")
 (grob-property-description 'right-padding number? "space right of accs.")
 (grob-property-description 'right-trim-amount number? "shortening of the lyric 
extender on the right.")

Reply via email to