patch::: 1.3.96.jcn5

1.3.96.jcn5
===========

* Added support for font styles and papersize style sheets.

diff --git a/CHANGES b/CHANGES
index bc926e0c508e42f70ab029f2e0b4f33c4977385b..646cec37874f3c054a005c50cb9e162639ef82e6 100644 (file)
--- a/CHANGES
+++ b/CHANGES
@@ -1,3 +1,8 @@
+1.3.96.jcn5
+===========
+
+* Added support for font styles and papersize style sheets.
+
 1.3.96.jcn4
 ===========
 

diff --git a/VERSION b/VERSION
index f6e5bfab63099390c2d8a84c7ca5da8e2bd7933b..444172cee6068a1deec3a4d8cd72a768c0033632 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=jcn4
+MY_PATCH_LEVEL=jcn5
 
 # 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
index 23647e7c84148b51e704000916078b16a19b789a..9b3e531c11295664ef84a2a18b9e29452b4a1aba 100644 (file)
--- a/input/test/markup.ly
+++ b/input/test/markup.ly
@@ -11,6 +11,7 @@
                e-\textscript #'(lines (bold "een") 
                  (rows "en" "dat" "is" ((family . "orator") "2"))
                  (italic "drie"))
+               f-\textscript #'(finger "3")
        }
        \paper{
                linewidth = -1.\mm;

diff --git a/lily/text-item.cc b/lily/text-item.cc
index 7d242ed48e915406151a1b177de34baad9adb353..c715035e4954d9c1d0853ce2d1f78601328582e8 100644 (file)
--- a/lily/text-item.cc
+++ b/lily/text-item.cc
@@ -57,9 +57,19 @@ Text_item::text2molecule (Score_element *me, SCM text, SCM properties)
 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);
+  SCM style = scm_assoc (ly_symbol2scm ("font-style"), properties);
+  SCM paper = me->get_elt_property ("style-sheet");
+  SCM font_name;
+  if (gh_pair_p (style))
+    {
+      SCM f = me->get_elt_property ("style-to-font-name");
+      font_name = gh_call2 (f, paper, gh_cdr (style));
+    }
+  else
+    {
+      SCM f = me->get_elt_property ("properties-to-font-name");
+      font_name = gh_call2 (f, paper, properties);
+    }
   String font_str = "roman";
   if (gh_string_p (font_name))
     font_str = ly_scm2string (font_name);

diff --git a/ly/engraver.ly b/ly/engraver.ly
index 4b65ba68ed01f3b3aac36b01e48817bb29e9cc88..26d6ae9c74a95e688b9b2ee84326985e592fcb48 100644 (file)
--- a/ly/engraver.ly
+++ b/ly/engraver.ly
@@ -851,7 +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)
+               (properties-to-font-name . ,properties-to-font-name)
+               (style-to-font-name . ,style-to-font-name)
                (markup-to-properties . ,markup-to-properties)
                (name . "TextScript") 
        )

diff --git a/scm/font.scm b/scm/font.scm
index f8fc42abcb14902b8833b7f864b24e25c49ba0d3..96a8cb521b8d9180bdb62a54fde6eb5b03020c9e 100644 (file)
--- a/scm/font.scm
+++ b/scm/font.scm
@@ -1,97 +1,132 @@
 ;;;
 ;;; font.scm -- implement Font stuff
 ;;;
-;;;  source file of the GNU LilyPond music typesetter
+;;; source file of the GNU LilyPond music typesetter
 ;;; 
 ;;; (c) 2000 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 
-
-;; corresponding properties:
+        
+;; Corresponding properties:
 ;;
-;;   font-series font-shape font-family font-name font-size font-points
+;;   font-series font-shape font-family font-name font-point font-size
 ;;
-(define style-sheet-alist
+
+(define style-to-font-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")
-               ))
+    (finger . "* * orator * * -4")
+    (volta . "* * orator * * -3")
+    (timesig . "* * orator * * 0")
+    (mark . "* * orator * * 2")
+    (script . "* * roman * * -1")
+    (large . "* * roman * * 1")
+    (Large . "bold * roman * * 2")
+    (dynamic . "bold * dynamic * * 0")
     ))
 
-(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)
+(define paper20-style-sheet-alist-template
+  '(
+    (("medium upright music feta 20" . 0) . "feta20")
+    (("medium upright music feta 16" . -1) . "feta16")
+    (("medium upright music feta 13" . -2) . "feta13")
+    (("medium upright music feta 23" . 1) . "feta23")
+    (("medium upright music feta 26" . 2) . "feta26")
+    (("medium upright braces feta-braces 20" . 0) . "feta-braces20")
+    (("bold italic dynamic feta 10" . 0) . "feta-din10")
+    ;; Hmm
+    (("medium upright orator feta-nummer 13" . 3) . "feta-nummer13")
+    (("medium upright orator feta-nummer 13" . 2) . "feta-nummer13")
+    (("medium upright orator feta-nummer 12" . 1) . "feta-nummer12")
+    (("medium upright orator feta-nummer 10" . 0) . "feta-nummer10")
+    (("medium upright orator feta-nummer 8" . -1) . "feta-nummer8")
+    (("medium upright orator feta-nummer 6" . -2) . "feta-nummer6")
+    (("medium upright orator feta-nummer 5" . -3) . "feta-nummer5")
+    (("medium upright orator feta-nummer 4" . -4) . "feta-nummer4")
+    (("medium upright orator feta-nummer 3" . -5) . "feta-nummer3")
+    (("medium upright roman cmr 8" . -1) . "cmr8" )
+    (("medium upright roman cmr 10" . 0) . "cmr10")
+    (("medium upright roman cmr 12" . 1) . "cmr12")
+    (("bold upright roman cmbx 10" . 0) . "cmbx10")
+    (("bold upright roman cmbx 12" . 1) . "cmbx12")
+    (("medium italic roman cmbx 10" . 0) . "cmbx10")
+    (("medium italic roman cmbx 12" . 1) . "cmbx12")
+    ))
+
+(define (style-sheet-template-entry-compile entry size)
+  (cons 
+   (string-append (caar entry)
+                 " "
+                 (number->string (- (cdar entry) size))
+                 " ")
+   (cdr entry)))
+   
+(define style-sheet-alist
+  `(
+    (paper11 . ,(map (lambda (x) (style-sheet-template-entry-compile x -3))
+                    paper20-style-sheet-alist-template))
+    (paper13 . ,(map (lambda (x) (style-sheet-template-entry-compile x -2))
+                    paper20-style-sheet-alist-template))
+    (paper16 . ,(map (lambda (x) (style-sheet-template-entry-compile x -1))
+                    paper20-style-sheet-alist-template))
+    (paper20 . ,(map (lambda (x) (style-sheet-template-entry-compile x 0))
+                    paper20-style-sheet-alist-template))
+    (paper23 . ,(map (lambda (x) (style-sheet-template-entry-compile x 1))
+                    paper20-style-sheet-alist-template))
+    (paper26 . ,(map (lambda (x) (style-sheet-template-entry-compile x 2))
+                    paper20-style-sheet-alist-template))
+     ))
+
+(define (font-regexp-to-font-name paper regexp)
+  (let ((style-sheet (cdr (assoc paper style-sheet-alist))))
     (let loop ((fonts style-sheet))
-      ;;(display "font: `")
-      ;;(display (caar fonts))
-      ;;(display "' = ")
-      ;;(display (cdar fonts))
-      ;;(newline)
-      (if (string-match font-regexp (caar fonts))
+      (if (string-match regexp (caar fonts))
          (cdar fonts)
          (if (pair? (cdr fonts))
              (loop (cdr fonts))
              '())))))
-       
+
+(define (properties-to-font-name paper properties-alist)
+  (let ((font-regexp (apply string-append
+        (map (lambda (key)
+               (string-append
+                (let ((entry (assoc key properties-alist)))
+                  (if entry (cdr entry) "[^ ]+"))
+                " "))
+             '(font-series font-shape font-family font-name font-point font-size)))))
+    (font-regexp-to-font-name paper font-regexp)))
+
 (define markup-to-properties-alist
-  '((series . font-series)
+  '(
+    (style . font-style)
+    (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"))))
+    (point . font-point)
+    ))
     
+(define markup-abbrev-to-properties-alist
+  (append
+   '(
+     (rows . (align . 0))
+     (lines . (align . 1))
+     (roman . (font-family . "roman"))
+     (music . (font-family . "music"))
+     (bold . (font-series . "bold"))
+     (italic . (font-shape . "italic")))
+   (map (lambda (x) (cons (car x) (cons 'font-style (car x))))
+       style-to-font-alist)))
+  
 (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))))
        
+(define (style-to-font-name paper style)
+  (let* ((entry (assoc style style-to-font-alist))
+        (font (if entry (cdr entry) "* * * * * *"))
+        (font-regexp
+         (regexp-substitute/global #f "\\*" font 'pre "[^ ]+" 'post)))
+    (font-regexp-to-font-name paper font-regexp)))
+