]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/font.scm
* scm/output-ascii-script.scm (as-font-alist-alist):
[lilypond.git] / scm / font.scm
index 64b320ce6e6526a3c65a71918308b6998065b03d..0d1cd0f5faf629db2cc1a6d353c0589ef958c70b 100644 (file)
@@ -3,7 +3,7 @@
 ;;;
 ;;; source file of the GNU LilyPond music typesetter
 ;;; 
-;;; (c) 2000--2001 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"))
        )
        ))
 
        font-descr-alist)
       )
 
-(define paper-style-sheet-alist
-  '(
-    ((8 * * braces 8) . "feta-braces8")
-    ((7 * * braces 7) . "feta-braces7")
-    ((6 * * braces 6) . "feta-braces6")
-    ((5 * * braces 5) . "feta-braces5")
-    ((4 * * braces 4) . "feta-braces4")
-    ((3 * * braces 3) . "feta-braces3")
-    ((2 * * braces 2) . "feta-braces2")
-    ((1 * * braces 1) . "feta-braces1")
-    ((0 * * braces 0) . "feta-braces0")
-    ))
+
+(define size-independent-fonts
+  `(
+    ((* * * braces *) . ("feta-braces0"
+                        "feta-braces1"
+                        "feta-braces2"
+                        "feta-braces3"
+                        "feta-braces4"
+                        "feta-braces5"
+                        "feta-braces6"
+                        "feta-braces7"
+                        "feta-braces8") )))
 
 ;; FIXME: what about this comment?:
+
+;; font-lookup seems a  little inefficient -- walking this entire list
+;; for a single font.
+;;
 ;;   should really have name/pt size at the front of the list.
 ;;   (also tried to vary the order of this list, with little effect)
 ;;
 ;; (font-relative-size font-series font-shape font-family 
 ;; font-design-size)
+
 (define paper20-style-sheet-alist
   '(
     ;; why are font file names strings, not symbols?
@@ -85,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.
     ((2 bold italic roman 12) . "cmbxti12")
     ((1 bold italic roman 12) . "cmbxti12")
     ((0 bold italic roman 10) . "cmbxti10")
+
     ((-1 bold italic roman 8) . "cmbxti8")
     ((-2 bold italic roman 7) . "cmbxti7")
     
     ((-4 * * dynamic 7) . "feta-din7")
     ((-5 * * dynamic 6) . "feta-din6")
 
-    ((2 * * music 26) . "feta26")
-    ((1 * * music 23) . "feta23")
-    ((0 * * music 20) . "feta20")
-    ((-0.5 * * music 20) . "feta19")    
-    ((-1 * * music 16) . "feta16")
-    ((-2 * * music 13) . "feta13")
-    ((-3 * * music 11) . "feta11")
-    ((-4 * * music 11) . "feta11")
-
-    ((2 * * ancient 26) . "parmesan26")
-    ((1 * * ancient 23) . "parmesan23")
-    ((0 * * ancient 20) . "parmesan20")
-    ((-0.5 * * ancient 20) . "parmesan19")    
-    ((-1 * * ancient 16) . "parmesan16")
-    ((-2 * * ancient 13) . "parmesan13")
-    ((-3 * * ancient 11) . "parmesan11")
-    ((-4 * * ancient 11) . "parmesan11")
+    ((2 * * music 26) . ("feta26" "parmesan26"))
+    ((1 * * music 23) . ("feta23" "parmesan23"))
+    ((0 * * music 20) . ("feta20" "parmesan20"))
+    ((-1 * * music 16) . ("feta16" "parmesan16"))
+    ((-2 * * music 13) . ("feta13" "parmesan13"))
+    ((-3 * * music 11) . ("feta11" "parmesan11"))
+    ((-4 * * music 11) . ("feta11" "parmesan11"))
+    
+    ((2 * * ancient 26) . ("feta26" "parmesan26"))
+    ((1 * * ancient 23) . ("feta23" "parmesan23"))
+    ((0 * * ancient 20) . ("feta20" "parmesan20"))
+    ((-1 * * ancient 16) . ("feta16" "parmesan16"))
+    ((-2 * * ancient 13) . ("feta13" "parmesan13"))
+    ((-3 * * ancient 11) . ("feta11" "parmesan11"))
+    ((-4 * * ancient 11) . ("feta11" "parmesan11"))
 
     ((0 * * math 10) . "msam10")
     ((-1 * * math 10) . "msam10")
 ;; 
 (define (change-relative-size font-desc decrement)
   "return a FONT-DESCR with relative size decremented by DECREMENT"
-  (cons (- (car font-desc) decrement) (cdr font-desc))
+
+  (if (number? (car font-desc))
+      (cons (- (car font-desc) decrement) (cdr font-desc))
+      font-desc)
   )
 
+(define (change-rhs-size font-desc from to )
+  (cons (car font-desc)
+       (regexp-substitute/global #f from (cdr font-desc) 'pre to 'post))
+
+  )
+  
 ;; 
 (define (map-alist-keys func list)
   "map a  function FUNC over the keys of an alist LIST, leaving the vals. "
                  '((paper11 . -3)
                    (paper13 . -2)
                    (paper16 . -1)
-                   (paper19 . -0.5)    
                    (paper20 . 0)
                    (paper23 . 1)
                    (paper26 . 2)
                    ))
   )
 
-
-(define (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)))
-       )
-     )
-    
-    )
-  )
+;;
+;; make a kludged up paper-19 style sheet. Broken by virtual fonts.
+;;
+(if #f
+    (set! font-list-alist
+      (cons
+       (cons
+       'paper19
+       (map (lambda (x) (change-rhs-size x "20" "19"))
+            paper20-style-sheet-alist))
+       font-list-alist)))
+
+(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."
@@ -352,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")
@@ -367,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))))))
@@ -416,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))
+
+
+
+