]> git.donarmstrong.com Git - lilypond.git/commitdiff
lilypond-1.5.10
authorfred <fred>
Wed, 27 Mar 2002 01:21:23 +0000 (01:21 +0000)
committerfred <fred>
Wed, 27 Mar 2002 01:21:23 +0000 (01:21 +0000)
input/test/ancient-font.ly
lily/command-request.cc
lily/include/command-request.hh
lily/include/lily-proto.hh
lily/include/porrectus.hh [new file with mode: 0644]
lily/porrectus-engraver.cc [new file with mode: 0644]
lily/porrectus.cc [new file with mode: 0644]
scm/grob-property-description.scm
scm/interface-description.scm
scm/translator-description.scm

index 405e6add22c2a38f86003f33048b311ebc1d38cf..c3f4ccf1551adaebfb3b429f6428bf587b0ffc2d 100644 (file)
@@ -27,6 +27,10 @@ upperVoice =  \context Staff = upperVoice <
        \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 @@ upperVoice =  \context Staff = upperVoice <
        \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 @@ lowerVoice =  \context Staff = lowerNotes <
     % \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 "||"
     }
index aac1ebe576fc16d628f3f26a10c83293197bc40f..ce8db7f353851be59e034193cda0fd48c88c2909 100644 (file)
@@ -115,6 +115,7 @@ ADD_MUSIC (Melisma_playing_req);
 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);
index 8c4cbeeb51fb9e5928af904a09b836c6a6cb1a6d..fa7d7f4e636f4a4ddc2a5f9e540b3369f35ea159 100644 (file)
@@ -51,6 +51,10 @@ class Breathing_sign_req : public Request {
   VIRTUAL_COPY_CONS (Music);
 };
 
+class Porrectus_req : public Request {
+  VIRTUAL_COPY_CONS (Music);
+};
+
 /**
     Handle key changes.
 */
index 7259cd3b28f7557ad0c97f5767f95520ac24a710..bafbe115783fb65be2d04885279513a49e12852d 100644 (file)
@@ -132,6 +132,7 @@ class Performer_group_performer;
 class Piano_bar_engraver;
 
 class Pitch_squash_engraver;
+class Porrectus_req;
 class Property_iterator;
 class Rational;
 class Relative_octave_music;
diff --git a/lily/include/porrectus.hh b/lily/include/porrectus.hh
new file mode 100644 (file)
index 0000000..8a11b03
--- /dev/null
@@ -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 --git a/lily/porrectus-engraver.cc b/lily/porrectus-engraver.cc
new file mode 100644 (file)
index 0000000..84d81f4
--- /dev/null
@@ -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<PHead_melodic_tuple> past_notes_pq_;
+  Porrectus_req *porrectus_req_l_;
+  Array<PHead_melodic_tuple> left_heads_;
+  Array<PHead_melodic_tuple> right_heads_;
+  Link_array<Grob> 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 <Porrectus_req *> (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 <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 ()));
+    }
+}
+
+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<Item*> (unsmob_grob (caar));
+         Item *right_head = dynamic_cast<Item*> (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 pitch<? 
+ */
+int
+PHead_melodic_tuple::pitch_compare (PHead_melodic_tuple const&h1,
+                                   PHead_melodic_tuple const &h2)
+{
+  SCM p1 = h1.req_l_->get_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 --git a/lily/porrectus.cc b/lily/porrectus.cc
new file mode 100644 (file)
index 0000000..bec95d8
--- /dev/null
@@ -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<Item*> (unsmob_grob (left_head_scm));
+  Item *right_head = dynamic_cast<Item*> (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);
+}
index f5ea904733756f26587b2f5553f6d290bc6caf8c..d47707af49949cb698e1661272d66ecc620096b5 100644 (file)
@@ -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 @@ reference point.
 (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 @@ itself.  Return value is ignored.")
 (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.")
index c11059a1c5b7a91f5488139407733e34e5d4b61a..9a375415ada435b0c4f0d2718435ecfb911d3c81 100644 (file)
@@ -567,6 +567,13 @@ contains-grace extra-space stretch-distance ))
 
 
 
+  (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
index ef856df0487711f3ec33e5ac8c7e4230767c2e29..b34c79ce2cb154e01f2c277fd1d8f90d40cde2ee 100644 (file)
@@ -435,6 +435,16 @@ making a single line staff that demonstrates the rhythm of a melody."
       squashedPosition
       )))
    
+   (cons
+    'Porrectus_engraver
+    (engraver-description
+     "Porrectus_engraver"
+     "Join adjacent notes to a porrectus ligature."
+     '(Porrectus)
+     '(
+      )))
+
+
    (cons
     'Property_engraver
     (engraver-description