* scm/output-ascii-script.scm (as-font-alist-alist):

[lilypond.git] / scm / font.scm

diff --git a/scm/font.scm b/scm/font.scm
index e4d95ba338e6fa64bc92fe89741d7b5e2c67ab23..0d1cd0f5faf629db2cc1a6d353c0589ef958c70b 100644 (file)
--- a/scm/font.scm
+++ b/scm/font.scm
@@ -3,7 +3,7 @@
 ;;;
 ;;; source file of the GNU LilyPond music typesetter
 ;;; 
-;;; (c) 2000--2002 Jan Nieuwenhuizen <janneke@gnu.org>
+;;; (c)  2000--2003 Jan Nieuwenhuizen <janneke@gnu.org>
 ;;;
 
 (define style-to-font-alist
@@ -19,7 +19,7 @@
        ((eq? name 'font-shape) 2)
        ((eq? name 'font-family) 3)
        ((eq? name 'font-design-size) 4)
-       (else (ly-warning "unknown font field name"))
+       (else (ly:warning "unknown font field name"))
        )
        ))
 
@@ -39,7 +39,8 @@
        font-descr-alist)
       )
 
-(define paper-style-sheet-alist
+
+(define size-independent-fonts
   `(
     ((* * * braces *) . ("feta-braces0"
                         "feta-braces1"
@@ -89,9 +90,9 @@
     ((3 medium italic roman 12) . "cmti12")
     ((2 medium italic roman 12) . "cmti12")
     ((1 medium italic roman 12) . "cmti12") ;;; ugh. Should add magnification here! 
-    ((0 medium italic roman 10) . "cmti12")
-    ((-1 medium italic roman 8) . "cmti10")    
-    ((-2 medium italic roman 7) . "cmti8")
+    ((0 medium italic roman 10) . "cmti10")
+    ((-1 medium italic roman 8) . "cmti8")    
+    ((-2 medium italic roman 7) . "cmti7")
     ((-3 medium italic roman 7) . "cmti7")    
 
     ;;; cmbx17 is sauter, not commonly available as Type1.
@@ -225,61 +226,9 @@
             paper20-style-sheet-alist))
        font-list-alist)))
 
-(define-public (make-style-sheet sym)
-  `((fonts . ,(append paper-style-sheet-alist
-                     (cdr (assoc sym font-list-alist))))
-    (font-defaults
-     . ((font-family . music)
-       (font-relative-size . 0)
-       (font-shape . upright)
-       (font-series . medium)
-       ))
-    (style-alist
-     . ((finger . ((font-family . number) (font-relative-size . -3)))
-       (volta . ((font-family . number) (font-relative-size . -2)))
-       (tuplet . ((font-family . roman) (font-shape . italic) (font-relative-size . -1)))
-
-       (timesig . ((font-family . number) ))
-       (timesig-symbol . ((font-family . music) ))
-       
-       (mmrest . ((font-family . number) ))
-       (mmrest-symbol . ((font-family . music) ))
-
-       (mark-number . ((font-family . number) (font-relative-size . 1)))
-       (mark-letter . ((font-family . roman)
-                       (font-series . bold)
-                       (font-shape . upright)
-                       (font-relative-size . 2)))
-       
-       (script . ((font-family . roman) (font-relative-size . -1)))
-       (large . ((font-family . roman) (font-relative-size . 1)))
-       (Large . ((font-series . bold) (font-family . roman)
-                 (font-relative-size . 2)))
-       (dynamic . ((font-family . dynamic) (font-relative-size . 0)))
-       ))
-    (properties-to-font .
-                       ,Font_interface::properties_to_font_name)
-
-    (markup-to-properties . ,markup-to-properties)
-    (abbreviation-alist
-     . ((columns . ((axis . 0)))
-       (lines . ((axis . 1)))
-       (roman . ((font-family . roman)))
-       (music . ((font-family . music) (lookup . name)))
-       (finger . ((font-style . finger)))
-       (bold . ((font-series . bold)))
-       (upright . ((font-shape . upright)))
-       (italic . ((font-shape . italic)))
-       (named . ((lookup . name)))
-       (overstrike . ((extent . (0 . 0))))
-       (super . ((raise . 1) (font-relative-size . -1) (extent . (0 . 0))))
-       (sub . ((raise . -1) (font-relative-size . -1) (extent . (0 . 0))))
-       (text . ((lookup . value)))
-       )
-     )
-    
-    )
-  )
+(define-public (make-font-list sym)
+  (append size-independent-fonts
+         (cdr (assoc sym font-list-alist))))
 
 (define (qualifiers-to-fontnames  qualifiers font-descr-alist)
   " reduce the font list by successively applying a font-qualifier."
@@ -374,7 +323,8 @@ and warn if the selected font is not unique.
        selected)       ; return the topmost.
     ))
 
-(define (markup-to-properties sheet markup)
+(define-public (markup-to-properties abbrev-alist style-alist markup)
+  "DOCME."
   ;; (display "markup: `")
   ;; (write markup)
   ;; (display "'\n")
@@ -389,19 +339,18 @@ and warn if the selected font is not unique.
               (or (not (pair? (cdr markup)))
                   (number? (cadr markup))))
          (if (equal? '() (cdr markup))
-             (markup-to-properties sheet (car markup))
+             (markup-to-properties abbrev-alist style-alist (car markup))
              (list markup))
          
          (if (equal? '() (cdr markup))
-             (markup-to-properties sheet (car markup))
-             (append (markup-to-properties sheet (car markup))
-                     (markup-to-properties sheet (cdr markup)))))
+             (markup-to-properties abbrev-alist style-alist (car markup))
+             (append (markup-to-properties abbrev-alist style-alist (car markup))
+                     (markup-to-properties abbrev-alist style-alist (cdr markup)))))
       
       ;; markup is single abbreviation
       (let ((entry (assoc markup
                          ;; assoc-chain?
-                         (append (cdr (assoc 'abbreviation-alist sheet))
-                                 (cdr (assoc 'style-alist sheet))))))
+                         (append abbrev-alist style-alist))))
        (if entry
            (cdr entry)
            (list (cons markup #t))))))
@@ -438,3 +387,24 @@ and warn if the selected font is not unique.
 
 
 )
+
+;;; ascii-script font init
+(define as-font-sheet-alist
+  '((as5 . (((* * * braces *) . ("as-braces9"))
+           ((* * * number *) . "as-number1")
+           ((0 * * music *) . ("as5"))
+           ((0 * * roman *) . "as-dummy")))
+    (as9 . (((* * * braces *) . ("as-braces9"))
+           ((0 medium upright number 10) . "as-number4")
+           ((* * * number 5) . "as-number1")
+           ((0 * * music *) . ("as9"))
+           ((0 * * roman *) . "as-dummy")))))
+
+(define-public (as-make-font-list sym)
+  (set! font-list-alist
+       (append font-list-alist as-font-sheet-alist))
+  (make-font-list sym))
+
+
+
+