remove tail, filter-list, filter-out-list,

[lilypond.git] / scm / font.scm

diff --git a/scm/font.scm b/scm/font.scm
index 805d26cab997f82ce98e95c87aa71d16b779f8f0..fa6835c34092e09307a075f1dfb7c85b07d0f81c 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"))
        )
        ))
 
@@ -33,7 +33,7 @@
 
 (define (filter-field field-name value font-descr-alist)
   "return those descriptions from FONT-DESCR-LIST whose FIELD-NAME matches VALUE"
-      (filter-list
+      (filter
        (lambda (x) (let* (field-value (font-field field-name (car x))) 
                     (or (eq? field-value '*) (eq? value field-value))))
        font-descr-alist)
@@ -90,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.
@@ -289,39 +289,9 @@ and warn if the selected font is not unique.
   ))
 
 
-(define (chain-assoc x alist-list)
-  (if (null? alist-list)
-      #f
-      (let* ((handle (assoc x (car alist-list))))
-       (if (pair? handle)
-           handle
-           (chain-assoc x (cdr alist-list))))))
+; there used to be a Scheme  properties-to-font-name function,
+; but that is  superseeded by the C++ version  out of speed concerns.
 
-;; TODO
-;; the C++ version  in font-interface.cc is usually used.
-;;
-;; FIXME: this has silently been broken by the introduction
-;;        of wildcards in the font list.    
-(define (properties-to-font-name fonts properties-alist-list)
-  (let*  (
-         ;; change order to change priorities of qualifiers.
-         (q-order '(font-family font-series font-shape
-                              font-design-size font-relative-size))
-         (rawqualifiers (map (lambda (x)
-                               (chain-assoc x properties-alist-list))
-                             q-order))
-         (qualifiers (filter-list pair? rawqualifiers))
-         (selected (find-first-font qualifiers fonts))
-         (err (current-error-port)))
-
-    (if (equal? selected "")
-       (begin
-         (display "\ncouldn't find any font satisfying " err)
-         (write qualifiers err)
-         "cmr10"
-         )
-       selected)       ; return the topmost.
-    ))
 
 (define-public (markup-to-properties abbrev-alist style-alist markup)
   "DOCME."
@@ -376,7 +346,7 @@ and warn if the selected font is not unique.
 
 (if #f (begin
         (define (test-module)
-          (display (filter-list pair? '(1 2 (1 2) (1 .2)))
+          (display (filter pair? '(1 2 (1 2) (1 .2)))
                    (display (filter-field 'font-name 'cmbx paper20-style-sheet-alist))
                    
                    (display (qualifiers-to-fontname '((font-name . cmbx)) paper20-style-sheet-alist))
@@ -387,3 +357,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))
+
+
+
+