]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/font.scm
* Another grand 2003 update.
[lilypond.git] / scm / font.scm
index 93fd56addf7ede80a791d610d5524383aa77e35e..490976b86bf52b7fbc3cc4c6f5d2594ef00ba820 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?
 
     ((3 medium italic roman 12) . "cmti12")
     ((2 medium italic roman 12) . "cmti12")
-    ((1 medium italic roman 12) . "cmti12")
-    ((0 medium italic roman 10) . "cmti10")
-    ((-1 medium italic roman 8) . "cmti8")    
-    ((-2 medium italic roman 7) . "cmti7")
+    ((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")
     ((-3 medium italic roman 7) . "cmti7")    
 
-    ((2 bold upright roman 12) . "cmbx12")
+    ;;; cmbx17 is sauter, not commonly available as Type1.
+    ((4 bold upright roman 17) . "cmr17") 
+    ((3 bold upright roman 17) . "cmr17")
+    
+    ((2 bold upright roman 14) . "cmbx14")
     ((1 bold upright roman 12) . "cmbx12")
     ((0 bold upright roman 10) . "cmbx10")
     ((-1 bold upright roman 8) . "cmbx8")
     ((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. "
            (map-alist-keys func (cdr list)))
       ))
  
+
 ;; 
 (define (map-alist-vals func list)
   "map a function FUNC over the vals of  LIST, leaving the keys."
                  '((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 . ((font-family . number) (font-relative-size . 1)))
-       (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."
@@ -342,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")
@@ -357,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))))))