X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ffont.scm;h=0d1cd0f5faf629db2cc1a6d353c0589ef958c70b;hb=824deccb0aafd303e9af99c8ec5105108b9f06aa;hp=ffdae61043eb1ca7b7c5dc60a2e77760c1925ba2;hpb=8dbb0048c1ac59125562d5adc1c68512eab8541b;p=lilypond.git diff --git a/scm/font.scm b/scm/font.scm index ffdae61043..0d1cd0f5fa 100644 --- a/scm/font.scm +++ b/scm/font.scm @@ -3,7 +3,7 @@ ;;; ;;; source file of the GNU LilyPond music typesetter ;;; -;;; (c) 2000--2001 Jan Nieuwenhuizen +;;; (c) 2000--2003 Jan Nieuwenhuizen ;;; (define style-to-font-alist @@ -18,9 +18,8 @@ ((eq? name 'font-series) 1) ((eq? name 'font-shape) 2) ((eq? name 'font-family) 3) - ((eq? name 'font-name) 4) - ((eq? name 'font-design-size) 5) - (else (ly-warning "unknown font field name")) + ((eq? name 'font-design-size) 4) + (else (ly:warning "unknown font field name")) ) )) @@ -40,119 +39,145 @@ font-descr-alist) ) -(define paper-style-sheet-alist - '( - ((8 * * braces feta-braces 8) . "feta-braces8") - ((7 * * braces feta-braces 7) . "feta-braces7") - ((6 * * braces feta-braces 6) . "feta-braces6") - ((5 * * braces feta-braces 5) . "feta-braces5") - ((4 * * braces feta-braces 4) . "feta-braces4") - ((3 * * braces feta-braces 3) . "feta-braces3") - ((2 * * braces feta-braces 2) . "feta-braces2") - ((1 * * braces feta-braces 1) . "feta-braces1") - ((0 * * braces feta-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-name +;; (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 upright number feta-nummer 13) . "feta-nummer13") - ((2 medium upright number feta-nummer 13) . "feta-nummer13") - ((1 medium upright number feta-nummer 11) . "feta-nummer11") - ((0 medium upright number feta-nummer 10) . "feta-nummer10") - ((-1 medium upright number feta-nummer 8) . "feta-nummer8") - ((-2 medium upright number feta-nummer 7) . "feta-nummer7") - ((-3 medium upright number feta-nummer 6) . "feta-nummer6") - ((-4 medium upright number feta-nummer 5) . "feta-nummer5") - ((-5 medium upright number feta-nummer 4) . "feta-nummer4") - - ((4 medium upright roman cmr 17) . "cmr17") - ((3 medium upright roman cmr 17) . "cmr17") - ((2 medium upright roman cmr 12) . "cmr12") - ((1 medium upright roman cmr 12) . "cmr12") - ((0 medium upright roman cmr 10) . "cmr10") - ((-1 medium upright roman cmr 8) . "cmr8" ) - ((-2 medium upright roman cmr 7) . "cmr7" ) - ((-3 medium upright roman cmr 6) . "cmr6" ) - ((-4 medium upright roman cmr 5) . "cmr5" ) - ((-5 medium upright roman cmr 5) . "cmr5" ) - - ((3 medium italic roman cmti 12) . "cmti12") - ((2 medium italic roman cmti 12) . "cmti12") - ((1 medium italic roman cmti 12) . "cmti12") - ((0 medium italic roman cmti 10) . "cmti10") - ((-1 medium italic roman cmti 8) . "cmti8") - ((-2 medium italic roman cmti 7) . "cmti7") - ((-3 medium italic roman cmti 7) . "cmti7") - - ((2 bold upright roman cmbx 12) . "cmbx12") - ((1 bold upright roman cmbx 12) . "cmbx12") - ((0 bold upright roman cmbx 10) . "cmbx10") - ((-1 bold upright roman cmbx 8) . "cmbx8") - ((-2 bold upright roman cmbx 7) . "cmbx7") + ((3 medium upright number 13) . "feta-nummer13") + ((2 medium upright number 13) . "feta-nummer13") + ((1 medium upright number 11) . "feta-nummer11") + ((0 medium upright number 10) . "feta-nummer10") + ((-1 medium upright number 8) . "feta-nummer8") + ((-2 medium upright number 7) . "feta-nummer7") + ((-3 medium upright number 6) . "feta-nummer6") + ((-4 medium upright number 5) . "feta-nummer5") + ((-5 medium upright number 4) . "feta-nummer4") + + ((4 medium upright roman 17) . "cmr17") + ((3 medium upright roman 17) . "cmr17") + ((2 medium upright roman 12) . "cmr12") + ((1 medium upright roman 12) . "cmr12") + ((0 medium upright roman 10) . "cmr10") + ((-1 medium upright roman 8) . "cmr8" ) + ((-2 medium upright roman 7) . "cmr7" ) + ((-3 medium upright roman 6) . "cmr6" ) + ((-4 medium upright roman 5) . "cmr5" ) + ((-5 medium upright roman 5) . "cmr5" ) + + ((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) . "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. + ((4 bold upright roman 17) . "cmr17") + ((3 bold upright roman 17) . "cmr17") - ((2 bold italic roman cmbxti 12) . "cmbxti12") - ((1 bold italic roman cmbxti 12) . "cmbxti12") - ((0 bold italic roman cmbxti 10) . "cmbxti10") - ((-1 bold italic roman cmbxti 8) . "cmbxti8") - ((-2 bold italic roman cmbxti 7) . "cmbxti7") + ((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 upright roman 7) . "cmbx7") - ((4 medium upright typewriter cmtt 17) . "cmtt17") - ((3 medium upright typewriter cmtt 17) . "cmtt17") - ((2 medium upright typewriter cmtt 12) . "cmtt12") - ((1 medium upright typewriter cmtt 12) . "cmtt12") - ((0 medium upright typewriter cmtt 10) . "cmtt10") - ((-1 medium upright typewriter cmtt 8) . "cmtt8" ) - ((-2 medium upright typewriter cmtt 7) . "cmtt7" ) - ((-3 medium upright typewriter cmtt 6) . "cmtt6" ) - ((-4 medium upright typewriter cmtt 5) . "cmtt5" ) - ((-5 medium upright typewriter cmtt 5) . "cmtt5" ) + ((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") - ((3 medium caps roman cmcsc 12) . "cmcsc12") - ((2 medium caps roman cmcsc 12) . "cmcsc12") - ((1 medium caps roman cmcsc 12) . "cmcsc12") - ((0 medium caps roman cmcsc 10) . "cmcsc10") - ((-1 medium caps roman cmcsc 8) . "cmcsc8") - ((-2 medium caps roman cmcsc 7) . "cmcsc7") - ((-3 medium caps roman cmcsc 7) . "cmcsc7") - - ((3 * * dynamic feta-din 19) . "feta-din19") - ((2 * * dynamic feta-din 19) . "feta-din19") - ((1 * * dynamic feta-din 17) . "feta-din17") - ((0 * * dynamic feta-din 14) . "feta-din14") - ((-1 * * dynamic feta-din 12) . "feta-din12") - ((-2 * * dynamic feta-din 9) . "feta-din9") - ((-3 * * dynamic feta-din 8) . "feta-din8") - ((-4 * * dynamic feta-din 7) . "feta-din7") - ((-5 * * dynamic feta-din 6) . "feta-din6") - - ((2 * * music feta 26) . "feta26") - ((1 * * music feta 23) . "feta23") - ((0 * * music feta 20) . "feta20") - ((-0.5 * * music feta 20) . "feta19") - ((-1 * * music feta 16) . "feta16") - ((-2 * * music feta 13) . "feta13") - ((-3 * * music feta 11) . "feta11") - ((-4 * * music feta 11) . "feta11") - - ((0 * * math msam 10) . "msam10") - ((-1 * * math msam 10) . "msam10") - ((-2 * * math msam 10) . "msam10") - ((-3 * * math msam 10) . "msam10") + ((4 medium upright typewriter 17) . "cmtt17") + ((3 medium upright typewriter 17) . "cmtt17") + ((2 medium upright typewriter 12) . "cmtt12") + ((1 medium upright typewriter 12) . "cmtt12") + ((0 medium upright typewriter 10) . "cmtt10") + ((-1 medium upright typewriter 8) . "cmtt8" ) + ((-2 medium upright typewriter 7) . "cmtt7" ) + ((-3 medium upright typewriter 6) . "cmtt6" ) + ((-4 medium upright typewriter 5) . "cmtt5" ) + ((-5 medium upright typewriter 5) . "cmtt5" ) + + ((3 medium caps roman 12) . "cmcsc12") + ((2 medium caps roman 12) . "cmcsc12") + ((1 medium caps roman 12) . "cmcsc12") + ((0 medium caps roman 10) . "cmcsc10") + ((-1 medium caps roman 8) . "cmcsc8") + ((-2 medium caps roman 7) . "cmcsc7") + ((-3 medium caps roman 7) . "cmcsc7") + + ((3 * * dynamic 19) . "feta-din19") + ((2 * * dynamic 19) . "feta-din19") + ((1 * * dynamic 17) . "feta-din17") + ((0 * * dynamic 14) . "feta-din14") + ((-1 * * dynamic 12) . "feta-din12") + ((-2 * * dynamic 9) . "feta-din9") + ((-3 * * dynamic 8) . "feta-din8") + ((-4 * * dynamic 7) . "feta-din7") + ((-5 * * dynamic 6) . "feta-din6") + + ((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") + ((-2 * * math 10) . "msam10") + ((-3 * * 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. " @@ -162,6 +187,7 @@ (map-alist-keys func (cdr list))) )) + ;; (define (map-alist-vals func list) "map a function FUNC over the vals of LIST, leaving the keys." @@ -182,64 +208,27 @@ '((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." @@ -316,7 +305,7 @@ and warn if the selected font is not unique. (define (properties-to-font-name fonts properties-alist-list) (let* ( ;; change order to change priorities of qualifiers. - (q-order '(font-name font-family font-series font-shape + (q-order '(font-family font-series font-shape font-design-size font-relative-size)) (rawqualifiers (map (lambda (x) (chain-assoc x properties-alist-list)) @@ -334,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") @@ -349,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)))))) @@ -398,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)) + + + +