]> git.donarmstrong.com Git - lilypond.git/blobdiff - lily/text-item.cc
move from abe.ly
[lilypond.git] / lily / text-item.cc
index 29538a1f8bc87ea480115b49e164da5a2286a562..098ef17402e5cad7cba87197374826aee0c61181 100644 (file)
@@ -3,12 +3,12 @@
 
   source file of the GNU LilyPond music typesetter
   
(c) 1998--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
 (c) 1998--2003 Han-Wen Nienhuys <hanwen@cs.uu.nl>
   Jan Nieuwenhuizen <janneke@gnu.org>
  */
 #include <math.h>
 
-#include "debug.hh"
+#include "warn.hh"
 #include "text-item.hh"
 #include "paper-def.hh"
 #include "font-interface.hh"
 #include "main.hh"
 #include "all-font-metrics.hh"
 #include "afm.hh"
-
+#include "lookup.hh"
+#include "virtual-font-metric.hh"
 
 /*
-    TEXT : STRING | (MARKUP SENTENCE)
-    MARKUP: PROPERTY | ABBREV
-    SENTENCE: TEXT | SENTENCE TEXT
-    PROPERTY: (key . value)
-    ABBREV: rows lines roman music bold italic named super sub text, or any font-style
- */
-
-/*
-  FIXME:
-
-  rewrite routines and syntax to be like
 
   TEXT: STRING
-      | (head-expression* TEXT*)
-      ;
+        | (MARKUP? TEXT+)
+        ;
 
-  head-expression is a list, containing a tag and a variable number of
-  arguments. If necessary, the number of arguments can be stored in a alist,
+  HEAD: MARKUP-ITEM | (MARKUP-ITEM+)
 
-  '(
-   (tag1 . argcount1)
-   (tag2 . argcount2)
-
-   ... etc
+  MARKUP-ITEM: PROPERTY | ABBREV | FONT-STYLE
+  PROPERTY: (key . value)
+  ABBREV: rows lines roman music bold italic named super sub text
    
-   )
-
-   or even entries like
-
-   (tag . (argcount function-to-handle-the-tag  ))
-
-   use baselineskip for setting (lines ...)
-
 */
 
 Molecule
@@ -60,30 +39,52 @@ Text_item::text2molecule (Grob *me, SCM text, SCM alist_chain)
 {
   if (gh_string_p (text))
     return string2molecule (me, text, alist_chain);
-  else if (gh_list_p (text))
+  else if (gh_pair_p (text))
     {
-      if (!gh_pair_p (gh_car (text)) && gh_string_p (gh_car (text)))
-       return string2molecule (me, gh_car (text), alist_chain);
+      /* urg, why not just do  this in markup_text2molecule ? */
+      if (gh_string_p (ly_car (text)))
+       return markup_text2molecule (me,
+                                    gh_append2 (scm_list_n (SCM_EOL,
+                                                        SCM_UNDEFINED),
+                                                text),
+                                    alist_chain);
+      /*
+       Allow (faulty) texts that are in an extra list:
+       #'(("foo"))
+       */
+      else if (scm_ilength (text) <= 1)
+       return text2molecule (me, ly_car (text), alist_chain);
       else
-       return markup_sentence2molecule (me, text, alist_chain);
+       return markup_text2molecule (me, text, alist_chain);
     }
   return Molecule ();
 }
-            
+
+
+MAKE_SCHEME_CALLBACK(Text_item,text_to_molecule,3);
+SCM
+Text_item::text_to_molecule (SCM grob, SCM props, SCM markup)
+{
+  Grob *me = unsmob_grob (grob);
+  
+  return Text_item::text2molecule (me, markup, props).smobbed_copy();
+}
+
+
 Molecule
 Text_item::string2molecule (Grob *me, SCM text, SCM alist_chain)
 {
   SCM style = ly_assoc_chain (ly_symbol2scm ("font-style"),
                              alist_chain);
-  if  (gh_pair_p (style) && gh_symbol_p (gh_cdr (style)))
-    alist_chain = Font_interface::add_style (me, gh_cdr(style), alist_chain);
+  if (gh_pair_p (style) && gh_symbol_p (ly_cdr (style)))
+    alist_chain = Font_interface::add_style (me, ly_cdr (style), alist_chain);
 
   Font_metric *fm = Font_interface::get_font (me, alist_chain);
   
   SCM lookup = ly_assoc_chain (ly_symbol2scm ("lookup"), alist_chain);
     
   Molecule mol;
-  if (gh_pair_p (lookup) && gh_cdr (lookup) ==ly_symbol2scm ("name"))
+  if (gh_pair_p (lookup) && ly_cdr (lookup) ==ly_symbol2scm ("name"))
     mol = lookup_character (me, fm, text);
   else
     mol = lookup_text (me, fm, text);
@@ -98,98 +99,128 @@ Text_item::lookup_character (Grob *, Font_metric*fm, SCM char_name)
 }
 
 
+
 Molecule
-Text_item::lookup_text (Grob *me, Font_metric*fm, SCM text)
+Text_item::lookup_text (Grob *, Font_metric*fm, SCM text)
 {
-#if 0
-  /*
-    Fixme; should be done differently, move to font-interface?
+  SCM list = scm_list_n (ly_symbol2scm ("text"), text, SCM_UNDEFINED);
 
-    differently -- how/why?
-   */
-
-  SCM magnification = me->get_grob_property ("font-magnification");
-
-  Font_metric* metric = 0;
-  if (gh_number_p (magnification))
+  if (dynamic_cast<Virtual_font_metric*> (fm))
     {
-
-      Real realmag = pow (1.2, gh_scm2int (magnification));
-      metric = all_fonts_global_p->find_scaled (ly_scm2string (font_name), realmag);
-
-      assert (false);
+      /*
+       ARGH.
+       */
+      programming_error ("Can't use virtual font for text.");
     }
-#else
-  SCM magnification = me->get_grob_property ("font-magnification");
-
-  if (gh_number_p (magnification) && gh_scm2double (magnification) > 1)
-    programming_error ("font-magnification disabled");
-#endif
-  
-
-  SCM list = gh_list (ly_symbol2scm ("text"), text, SCM_UNDEFINED);
-  list = fontify_atom (fm, list);
+  else
+    list = fontify_atom (fm, list);
   
   return Molecule (fm->text_dimension (ly_scm2string (text)), list);
 }
 
+
+/*
+  TODO:
+
+  DOCME.
+
+
+  MARKUP_TEXT must be compound (may not be simple string.)
+  
+ */
 Molecule
-Text_item::markup_sentence2molecule (Grob *me, SCM markup_sentence,
-                                    SCM alist_chain)
+Text_item::markup_text2molecule (Grob *me, SCM markup_text,
+                                SCM alist_chain)
 {
-  SCM sheet = me->paper_l ()->style_sheet_;
-  SCM f = gh_cdr (scm_assoc (ly_symbol2scm ("markup-to-properties"), sheet));
+  SCM f = me->get_paper ()->lookup_variable (ly_symbol2scm ("markup-to-properties"));
   
-  SCM markup = gh_car (markup_sentence);
-  SCM sentence = gh_cdr (markup_sentence);
-  
-  SCM p = gh_cons  (gh_call2 (f, sheet, markup), alist_chain);
+  SCM markup = ly_car (markup_text);
+  SCM text = ly_cdr (markup_text);
+
+  /* ARGRGRRGRARGRA
+   */
 
-  Axis align = X_AXIS;
-  SCM a = ly_assoc_chain (ly_symbol2scm ("align"), p);
-  if (gh_pair_p (a) && gh_number_p (gh_cdr (a)))
-    align = (Axis)gh_scm2int (gh_cdr (a));
+  SCM abbrev = me->get_paper ()->lookup_variable (ly_symbol2scm ("abbreviation-alist"));
+  SCM style = me->get_paper ()->lookup_variable (ly_symbol2scm ("style-alist"));
+  
+  SCM p = gh_cons (scm_call_3 (f, abbrev, style, markup), alist_chain);
 
   Real staff_space = Staff_symbol_referencer::staff_space (me);
-  Real kern = 0;
+
+  /*
+    Line mode is default.
+   */
+  Axis axis = X_AXIS;
+
+  SCM a = ly_assoc_chain (ly_symbol2scm ("axis"), p);
+  if (gh_pair_p (a) && ly_axis_p (ly_cdr (a)))
+    axis = (Axis)gh_scm2int (ly_cdr (a));
+
+  Real baseline_skip = 0;
+  SCM b = ly_assoc_chain (ly_symbol2scm ("baseline-skip"), p);
+  if (gh_pair_p (b) && gh_number_p (ly_cdr (b)))
+    baseline_skip = gh_scm2double (ly_cdr (b)) * staff_space;
+  
+  Real kern[2] = {0,0};
+
   SCM k = ly_assoc_chain (ly_symbol2scm ("kern"), p);
-  if (gh_pair_p (k) && gh_number_p (gh_cdr (k)))
-    kern = gh_scm2double (gh_cdr (k)) * staff_space;
+  if (gh_pair_p (k) && gh_number_p (ly_cdr (k)))
+    kern[axis] = gh_scm2double (ly_cdr (k)) * staff_space;
                             
   Real raise = 0;
   SCM r = ly_assoc_chain (ly_symbol2scm ("raise"), p);
-  if (gh_pair_p (r) && gh_number_p (gh_cdr (r)))
-    raise = gh_scm2double (gh_cdr (r)) * staff_space;
-
-#if 0
-  Offset o (align == X_AXIS ? kern : 0,
-           (align == Y_AXIS ? - kern : 0) + raise);
-#else
-  Offset o (0, (align == Y_AXIS ? - kern : 0) + raise);
-#endif
-  Molecule mol;
-  while (gh_pair_p (sentence))
+  if (gh_pair_p (r) && gh_number_p (ly_cdr (r)))
+    raise = gh_scm2double (ly_cdr (r)) * staff_space;
+  
+
+  Interval extent;
+  bool extent_b = false;
+  SCM e = ly_assoc_chain (ly_symbol2scm ("extent"), p);
+  if (gh_pair_p (e) && ly_number_pair_p (ly_cdr (e)))
     {
-      /* Ugh: this (kerning) only works if 'kern' is the first modifier of a
-        markup.  I guess the only solution is to rewrite markup definition,
-        see above. */
-      Molecule m = text2molecule (me, gh_car (sentence), p);
-      Real m_kern = 0;
-      SCM m_p = SCM_EOL;
-      if (gh_pair_p (gh_car (sentence)))
-       m_p = gh_cons  (gh_call2 (f, sheet, gh_caar (sentence)), alist_chain);
-      SCM m_k = ly_assoc_chain (ly_symbol2scm ("kern"), m_p);
-      if (gh_pair_p (m_k) && gh_number_p (gh_cdr (m_k)))
-       m_kern = gh_scm2double (gh_cdr (m_k)) * staff_space;
+      extent = Interval (gh_scm2double (ly_cadr (e)) * staff_space,
+                      gh_scm2double (ly_cddr (e)) * staff_space);
+      extent_b = true;
+    }
+
+  Offset o (kern[X_AXIS], raise - kern[Y_AXIS]);
+  
+  Molecule mol = Lookup::filledbox (Box (Interval (0,0), Interval (0,0)));
+
+  SCM cp = ly_deep_copy (p);
+  if (raise)
+    {
+      SCM cr = ly_assoc_chain (ly_symbol2scm ("raise"), cp);
+      scm_set_cdr_x (cr, gh_int2scm (0));
+    }
+  
+  while (gh_pair_p (text))
+    {
+      Molecule m = text2molecule (me, ly_car (text), cp);
 
       if (!m.empty_b ())
        {
-         m.translate (o);
-         mol.add_at_edge (align, align == X_AXIS ? RIGHT : DOWN, m, m_kern);
+         m.translate_axis (mol.extent (axis)[axis == X_AXIS ? RIGHT : DOWN]
+                           - (axis == Y_AXIS ? baseline_skip : 0),
+                           axis);
+         mol.add_molecule (m);
        }
-      sentence = gh_cdr (sentence);
+      text = ly_cdr (text);
+    }
+  
+  
+  /* Set extend to markup evented value. */
+  if (extent_b)
+    {
+      Box b = mol.extent_box ();
+      SCM expr = mol.get_expr ();
+
+      b[axis] = extent;
+      mol = Molecule (b, expr);
     }
+  
+  mol.translate (o);
+  
   return mol;
 }
 
@@ -210,8 +241,37 @@ Text_item::brew_molecule (SCM smob)
       Molecule m;
       m.set_empty (false);
       mol.add_at_edge (X_AXIS, RIGHT, m, gh_scm2double (space)
-                      * Staff_symbol_referencer::staff_space (me));
+                      * Staff_symbol_referencer::staff_space (me), 0);
     }
   return mol.smobbed_copy (); 
 }
 
+
+
+ADD_INTERFACE (Text_item,"text-interface",
+  "A scheme markup text, see @ref{Markup functions}.",
+  "text baseline-skip word-space");
+
+
+/*
+  Ugh. Duplicated from Scheme.
+ */
+bool
+new_markup_p (SCM x)
+{
+  return
+    gh_string_p (x) ||
+    (gh_pair_p (x)
+     && SCM_BOOL_F != scm_object_property (gh_car (x), ly_symbol2scm ("markup-signature")));
+}
+
+SCM
+new_markup_brewer ()
+{
+  static SCM proc ;
+
+  if (!proc)
+    proc = scm_c_eval_string ("brew-new-markup-molecule");
+
+  return proc;
+}