]> git.donarmstrong.com Git - lilypond.git/blobdiff - scm/font.scm
* lily/parser.yy (assignment): allow SCM expression as assignment.
[lilypond.git] / scm / font.scm
index e4d95ba338e6fa64bc92fe89741d7b5e2c67ab23..805d26cab997f82ce98e95c87aa71d16b779f8f0 100644 (file)
@@ -39,7 +39,8 @@
        font-descr-alist)
       )
 
-(define paper-style-sheet-alist
+
+(define size-independent-fonts
   `(
     ((* * * braces *) . ("feta-braces0"
                         "feta-braces1"
             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))))))