]> git.donarmstrong.com Git - lilypond.git/commitdiff
patch::: 1.3.96.jcn4
authorJan Nieuwenhuizen <janneke@gnu.org>
Sat, 21 Oct 2000 01:28:45 +0000 (03:28 +0200)
committerJan Nieuwenhuizen <janneke@gnu.org>
Sat, 21 Oct 2000 01:28:45 +0000 (03:28 +0200)
1.3.96.jcn4
===========

* Added new code for font selection and scm text markup.  Only used
  for testing in \textscript SCM. See input/test/markup.ly.

12 files changed:
CHANGES
VERSION
input/test/markup.ly [new file with mode: 0644]
lily/include/musical-request.hh
lily/include/text-item.hh [new file with mode: 0644]
lily/lookup.cc
lily/parser.yy
lily/text-engraver.cc
lily/text-item.cc
ly/declarations.ly
ly/engraver.ly
scm/font.scm [new file with mode: 0644]

diff --git a/CHANGES b/CHANGES
index e96d44c89e0e1b0e68a61c3289339bb1a98f1180..bc926e0c508e42f70ab029f2e0b4f33c4977385b 100644 (file)
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,9 @@
+1.3.96.jcn4
+===========
+
+* Added new code for font selection and scm text markup.  Only used
+  for testing in \textscript SCM. See input/test/markup.ly.
+
 1.3.96.jcn3
 ===========
 
diff --git a/VERSION b/VERSION
index a09a984736b979782a26c97865df1becd59138b1..f6e5bfab63099390c2d8a84c7ca5da8e2bd7933b 100644 (file)
--- a/VERSION
+++ b/VERSION
@@ -2,7 +2,7 @@ PACKAGE_NAME=LilyPond
 MAJOR_VERSION=1
 MINOR_VERSION=3
 PATCH_LEVEL=96
-MY_PATCH_LEVEL=jcn3
+MY_PATCH_LEVEL=jcn4
 
 # use the above to send patches: MY_PATCH_LEVEL is always empty for a
 # released version.
diff --git a/input/test/markup.ly b/input/test/markup.ly
new file mode 100644 (file)
index 0000000..23647e7
--- /dev/null
@@ -0,0 +1,24 @@
+%
+% Test new font selection and scm text markup
+%
+
+\score{
+       \notes\relative c''{
+               a-"text"
+               b-\textscript #"texta"
+               c-\textscript #'(bold "textb")
+               d-\textscript #'(lines "een" "twee" "drie")
+               e-\textscript #'(lines (bold "een") 
+                 (rows "en" "dat" "is" ((family . "orator") "2"))
+                 (italic "drie"))
+       }
+       \paper{
+               linewidth = -1.\mm;
+               \translator{
+                       \ScoreContext
+                       TextScript \push #'style-sheet = #'paper16
+                       TextScript \push #'font-family = #'roman
+                       TextScript \pop #'no-spacing-rods
+               }
+       }
+}
index e928984f3b89fa96dd849543204b8e421e56c682..da3d1c484caab60213011825f98c0fb22d00ab02 100644 (file)
@@ -66,16 +66,17 @@ protected:
   VIRTUAL_COPY_CONS(Music);
 };
 
-class Text_script_req : public Script_req {
+class Text_script_req : public Script_req
+{
 public:
-  String text_str_;
+  String text_str_;  // to be deprecated
+  String style_str_; // to be deprecated
+
+  SCM text_scm_;
 
-  // should be generic property of some kind.. 
-  String style_str_;
 protected:
   VIRTUAL_COPY_CONS(Music);
   virtual bool do_equal_b (Request const*)const;
-
 };
 
 
diff --git a/lily/include/text-item.hh b/lily/include/text-item.hh
new file mode 100644 (file)
index 0000000..1f8beff
--- /dev/null
@@ -0,0 +1,25 @@
+/*   
+  text-item.hh -- declare Text_item
+
+  source file of the GNU LilyPond music typesetter
+  
+ (c) 1998--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+  Jan Nieuwenhuizen <janneke@gnu.org>
+ */
+
+#ifndef TEXT_ITEM
+#define TEXT_ITEM
+
+#include "lily-guile.hh"
+#include "molecule.hh"
+
+class Text_item
+{
+public:
+  DECLARE_SCHEME_CALLBACK (brew_molecule, (SCM));
+  static Molecule text2molecule (Score_element *me, SCM text, SCM properties);
+  static Molecule string2molecule (Score_element *me, SCM text, SCM properties);
+  static Molecule markup_sentence2molecule (Score_element *me, SCM markup_sentence, SCM properties);
+};
+
+#endif /* TEXT_ITEM */
index 62ad7fbb916c52c9ead74cba161b23784bee3172..ef4089ca36be7d2cda60993e51708911fa2c9dc2 100644 (file)
@@ -197,6 +197,8 @@ Lookup::frame (Box b, Real thick)
 
 
 /*
+  JUNKME
    TODO: THIS IS UGLY.
    Since the user has direct access to TeX marcos,
    that currently provide the  only way to do
@@ -236,7 +238,7 @@ sanitise_TeX_string (String text)
 }
 
 /**
-   TODO!
+   JUNKME
  */
 String
 sanitise_PS_string (String t)
@@ -245,7 +247,7 @@ sanitise_PS_string (String t)
 }
 
 /**
-TODO: move into Text_item. UGH: paper_l argument shoudl be junked.
+   JUNKME
 */
 Molecule
 Lookup::text (String style, String text, Paper_def *paper_l) 
index 8d64ac3d47edff46acc2695c4988d13822cb54b2..1a1021ea9665e75433f07904348fff59d91b36e8 100644 (file)
@@ -1064,6 +1064,12 @@ verbose_request:
 
                $$ = ts_p;
        }
+       | TEXTSCRIPT embedded_scm {
+               Text_script_req *ts_p = new Text_script_req;
+               ts_p->text_scm_ = $2;
+               ts_p->set_spot (THIS->here_input ());
+               $$ = ts_p;
+       }
        | SPANREQUEST bare_int STRING {
                Span_req * sp_p = new Span_req;
                sp_p->span_dir_  = Direction($2);
index 2a30a0a6fbf330f023110bc224dac3f2874bea00..c16f43d46ddc1990fce85228d51256fa7dd8369a 100644 (file)
@@ -122,8 +122,14 @@ Text_engraver::do_process_music ()
       if (r->get_direction ())
        Side_position::set_direction (text, r->get_direction ());
       
-      text->set_elt_property ("text",
-                             ly_str02scm ( r->text_str_.ch_C ()));
+      if (r->text_str_.length_i ())
+       text->set_elt_property ("text",
+                               ly_str02scm ( r->text_str_.ch_C ()));
+      else
+       {
+         text->set_elt_property ("text", r->text_scm_);
+         text->set_elt_property ("scm-text", r->text_scm_);
+       }
       
       if (r->style_str_.length_i ())
        text->set_elt_property ("style", ly_str02scm (r->style_str_.ch_C()));
index feca94f8845ef460a56e1ffec8d37189e196ef10..7d242ed48e915406151a1b177de34baad9adb353 100644 (file)
 
   source file of the GNU LilyPond music typesetter
   
 (c) 1998--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
-  
+ (c) 1998--2000 Han-Wen Nienhuys <hanwen@cs.uu.nl>
+  Jan Nieuwenhuizen <janneke@gnu.org>
  */
 
-#include "debug.hh"
-#include "molecule.hh"
+#include "text-item.hh"
 #include "paper-def.hh"
 #include "lookup.hh"
 #include "staff-symbol-referencer.hh"
+#include "staff-symbol-referencer.hh"
+#include "main.hh"
+#include "all-font-metrics.hh"
+#include "afm.hh"
+
+/*
+  text: string | (markup sentence)
+  markup: markup-symbol | (markup-symbol . parameter)
+  sentence: text | sentence text
+  
+
+  Properties:
+
+  * Font:
+  ---* Type:
+  ------* Series: medium, bold
+  ------* Shape: upright, italic, slanted
+  ------* Family: roman, music, orator, typewriter
+
+  ---* Size:
+  ------* size: ...,-2,-1,0,1,2,... (style-sheet -> cmrXX, fetaXX)
+  ------* points: 11,13,16,20,23,26 (for feta)
+  ------* magnification: UNSIGNED
 
-struct Text_item
+  * Typesetting:
+  ---* kern: INT (staff-space)
+  ---* align: horizontal/vertical / lines / rows
+ */
+Molecule
+Text_item::text2molecule (Score_element *me, SCM text, SCM properties) 
 {
-  DECLARE_SCHEME_CALLBACK( brew_molecule, (SCM));
-};
+  if (gh_string_p (text))
+    return string2molecule (me, text, properties);
+  else if (gh_list_p (text))
+    {
+      if (!gh_pair_p (gh_car (text)) && gh_string_p (gh_car (text)))
+       return string2molecule (me, gh_car (text), properties);
+      else
+       return markup_sentence2molecule (me, text, properties);
+    }
+  return Molecule ();
+}
 
+Molecule
+Text_item::string2molecule (Score_element *me, SCM text, SCM properties)
+{
+  SCM f = me->get_elt_property ("get-font-name");
+  SCM style = me->get_elt_property ("style-sheet");
+  SCM font_name = gh_call2 (f, style, properties);
+  String font_str = "roman";
+  if (gh_string_p (font_name))
+    font_str = ly_scm2string (font_name);
+    
+  SCM magnification = me->get_elt_property ("font-magnification");
 
-MAKE_SCHEME_CALLBACK(Text_item,brew_molecule,1);
+  Font_metric* metric_l = 0;
+  if (gh_number_p (magnification))
+    metric_l = all_fonts_global_p->find_scaled (font_str,
+                                               gh_scm2int (magnification));
+  else
+    metric_l = all_fonts_global_p->find_font (font_str);
 
-SCM 
-Text_item::brew_molecule (SCM sm) 
+  SCM list = gh_list (ly_symbol2scm ("text"), text, SCM_UNDEFINED);
+  list = fontify_atom (metric_l, list);
+
+  return Molecule (metric_l->text_dimension (ly_scm2string (text)), list);
+}
+
+Molecule
+Text_item::markup_sentence2molecule (Score_element *me, SCM markup_sentence,
+                                    SCM properties)
 {
-  Score_element * s = unsmob_element (sm);
+  SCM markup = gh_car (markup_sentence);
+  SCM sentence = gh_cdr (markup_sentence);
+  SCM f = me->get_elt_property ("markup-to-properties");
   
-  SCM style = s->get_elt_property ("style");
-  String st = gh_string_p (style) ?  ly_scm2string (style) : "";
-  SCM txt = s-> get_elt_property ("text");
-  String t = gh_string_p (txt) ? ly_scm2string (txt) : "";
+  SCM p = gh_cons (gh_call1 (f, markup), properties);
 
-  Molecule mol =  s->paper_l ()->lookup_l(0)->text (st, t, s->paper_l ());
+  Axis align = X_AXIS;
+  SCM a = scm_assoc (ly_symbol2scm ("align"), p);
+  if (gh_pair_p (a) && gh_number_p (gh_cdr (a)))
+    align = (Axis)gh_scm2int (gh_cdr (a));
 
-  SCM space =  s->get_elt_property ("word-space");
+  Molecule mol;
+  while (gh_pair_p (sentence))
+    {
+      Molecule m = text2molecule (me, gh_car (sentence), p);
+      if (!m.empty_b ())
+       mol.add_at_edge (align, align == X_AXIS ? RIGHT : DOWN, m, 0);
+      sentence = gh_cdr (sentence);
+    }
+  return mol;
+}
+
+MAKE_SCHEME_CALLBACK (Text_item, brew_molecule, 1);
+SCM 
+Text_item::brew_molecule (SCM smob) 
+{
+  Score_element *me = unsmob_element (smob);
+  
+  SCM text = me->get_elt_property ("scm-text");
+  Molecule mol;
+  if (text == SCM_EOL)
+    {
+      SCM style = me->get_elt_property ("style");
+      String st = gh_string_p (style) ?  ly_scm2string (style) : "";
+      SCM text = me->get_elt_property ("text");
+      String t = gh_string_p (text) ? ly_scm2string (text) : "";
+      
+      mol = me->paper_l ()->lookup_l (0)->text (st, t, me->paper_l ());
+    }
+  else
+    mol = text2molecule (me, text,
+                        gh_append2 (me->immutable_property_alist_,
+                                    me->mutable_property_alist_));
+
+  SCM space = me->get_elt_property ("word-space");
   if (gh_number_p (space))
     {
       Molecule m;
       m.set_empty (false);
-      mol.add_at_edge (X_AXIS, RIGHT, m, gh_scm2double (space)*
-                      Staff_symbol_referencer::staff_space (s));
+      mol.add_at_edge (X_AXIS, RIGHT, m, gh_scm2double (space)
+                      * Staff_symbol_referencer::staff_space (me));
     }
   return mol.create_scheme (); 
 }
 
-
index 452bc2b2ca8eb28e160b1254df5ab53b8b34d4c3..21bafc0db15e36b14c49eba545ce0bc15d7221b7 100644 (file)
@@ -5,6 +5,7 @@ maxima = \duration #'( -3 0 )
 
 #(begin
   (eval-string (ly-gulp-file "slur.scm"))
+  (eval-string (ly-gulp-file "font.scm"))
   (eval-string (ly-gulp-file "generic-property.scm"))
   (eval-string (ly-gulp-file "basic-properties.scm"))
  )
@@ -50,7 +51,6 @@ papersize = "a4"
 \include "property.ly"
 
 
-
 unusedEntry = \notes { c4 }            % reset default duration
 
 % music = "\melodic\relative c"
index 79b9632739cba4cae7172d95806e0d56ee76c531..4b65ba68ed01f3b3aac36b01e48817bb29e9cc88 100644 (file)
@@ -851,6 +851,8 @@ ScoreContext = \translator {
                (no-spacing-rods . #t)
                (interfaces . (text-script-interface text-item-interface side-position-interface))
                (padding . 0.5)
+               (get-font-name . ,get-font-name)
+               (markup-to-properties . ,markup-to-properties)
                (name . "TextScript") 
        )
        TextSpanner = #`(
diff --git a/scm/font.scm b/scm/font.scm
new file mode 100644 (file)
index 0000000..f8fc42a
--- /dev/null
@@ -0,0 +1,97 @@
+;;;
+;;; font.scm -- implement Font stuff
+;;;
+;;;  source file of the GNU LilyPond music typesetter
+;;; 
+;;; (c) 2000 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;
+
+
+;; corresponding properties:
+;;
+;;   font-series font-shape font-family font-name font-size font-points
+;;
+(define style-sheet-alist
+  '(
+    (paper16 . (
+               ("medium upright music feta 0 16" . "feta16")
+               ("medium upright music feta -1 13" . "feta13")
+               ("medium upright music feta -2 11" . "feta11")
+               ("medium upright music feta 1 20" . "feta20")
+               ("medium upright music feta 2 23" . "feta23")
+               ("medium upright orator feta-nummer 0 8" . "feta-nummer8")
+               ("medium upright orator feta-nummer -4 4" . "feta-nummer4")
+               ("medium upright roman cmr 0 8" . "cmr8")
+               ("medium upright roman cmr 1 10" . "cmr10")
+               ("bold upright roman cmbx 0 8" . "cmbx8")
+               ("bold upright roman cmbx 1 10" . "cmbx10")
+               ("medium italic roman cmbx 0 8" . "cmbx8")
+               ("medium italic roman cmbx 1 10" . "cmbx10")
+               ))
+    (paper20 . (
+               ("medium upright music feta 0 20" . "feta20")
+               ("medium upright music feta -1 16" . "feta16")
+               ("medium upright music feta -2 13" . "feta13")
+               ("medium upright music feta 1 23" . "feta23")
+               ("medium upright music feta 2 26" . "feta26")
+               ("medium upright orator feta-nummer 0 10" . "feta-nummer10")
+               ("medium upright orator feta-nummer -4 5" . "feta-nummer5")
+               ("medium upright roman cmr 0 10" . "cmr10")
+               ("medium upright roman cmr 1 12" . "cmr12")
+               ("bold upright roman cmbx 0 10" . "cmbx10")
+               ("bold upright roman cmbx 1 12" . "cmbx12")
+               ("medium italic roman cmbx 0 10" . "cmbx10")
+               ("medium italic roman cmbx 1 12" . "cmbx12")
+               ))
+    ))
+
+(define (get-font-name style properties-alist)
+  (let ((font-regexp
+        (let loop ((p '(font-series font-shape font-family font-name font-size font-points)) (s ""))
+          (let* ((key (if (pair? p) (car p) p))
+                 (entry (assoc key properties-alist))
+                 (value (if entry (cdr entry) "[^ ]+")))
+            (if (pair? (cdr p))
+                (loop (cdr p) (string-append s value " "))
+                (string-append (string-append s value))))))
+       (style-sheet (cdr (assoc style style-sheet-alist))))
+    ;;(display "regex: `")
+    ;;(display font-regexp)
+    ;;(display "'")
+    ;;(newline)
+    (let loop ((fonts style-sheet))
+      ;;(display "font: `")
+      ;;(display (caar fonts))
+      ;;(display "' = ")
+      ;;(display (cdar fonts))
+      ;;(newline)
+      (if (string-match font-regexp (caar fonts))
+         (cdar fonts)
+         (if (pair? (cdr fonts))
+             (loop (cdr fonts))
+             '())))))
+       
+(define markup-to-properties-alist
+  '((series . font-series)
+    (shape . font-shape)
+    (family . font-family)
+    (name . font-name)
+    (size . font-size)
+    (point . font-point)))
+
+(define markup-abbrev-to-properties-alist
+  '((rows . (align . 0))
+    (lines . (align . 1))
+    (roman . (font-family . "roman"))
+    (music . (font-family . "music"))
+    (bold . (font-series . "bold"))
+    (italic . (font-shape . "italic"))))
+    
+(define (markup-to-properties markup)
+  ;;(display "markup: ")
+  ;;(display markup)
+  ;;(newline)
+  (if (pair? markup)
+      (cons (cdr (assoc (car markup) markup-to-properties-alist)) (cdr markup))
+      (cdr (assoc markup markup-abbrev-to-properties-alist))))
+