X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Ffont.scm;h=7118c072056539aa6eb52f332722c685e998a1ce;hb=12186b6828aee7aa298076d684835d629b757f2a;hp=f8fc42abcb14902b8833b7f864b24e25c49ba0d3;hpb=c26d3ace597521dcc473ae70d9a058f6783d2c88;p=lilypond.git diff --git a/scm/font.scm b/scm/font.scm index f8fc42abcb..7118c07205 100644 --- a/scm/font.scm +++ b/scm/font.scm @@ -1,97 +1,120 @@ -;;; -;;; font.scm -- implement Font stuff -;;; -;;; source file of the GNU LilyPond music typesetter -;;; -;;; (c) 2000 Jan Nieuwenhuizen -;;; - - -;; corresponding properties: -;; -;; font-series font-shape font-family font-name font-size font-points -;; -(define style-sheet-alist - '( - (paper16 . ( - ("medium upright music feta 0 16" . "feta16") - ("medium upright music feta -1 13" . "feta13") - ("medium upright music feta -2 11" . "feta11") - ("medium upright music feta 1 20" . "feta20") - ("medium upright music feta 2 23" . "feta23") - ("medium upright orator feta-nummer 0 8" . "feta-nummer8") - ("medium upright orator feta-nummer -4 4" . "feta-nummer4") - ("medium upright roman cmr 0 8" . "cmr8") - ("medium upright roman cmr 1 10" . "cmr10") - ("bold upright roman cmbx 0 8" . "cmbx8") - ("bold upright roman cmbx 1 10" . "cmbx10") - ("medium italic roman cmbx 0 8" . "cmbx8") - ("medium italic roman cmbx 1 10" . "cmbx10") - )) - (paper20 . ( - ("medium upright music feta 0 20" . "feta20") - ("medium upright music feta -1 16" . "feta16") - ("medium upright music feta -2 13" . "feta13") - ("medium upright music feta 1 23" . "feta23") - ("medium upright music feta 2 26" . "feta26") - ("medium upright orator feta-nummer 0 10" . "feta-nummer10") - ("medium upright orator feta-nummer -4 5" . "feta-nummer5") - ("medium upright roman cmr 0 10" . "cmr10") - ("medium upright roman cmr 1 12" . "cmr12") - ("bold upright roman cmbx 0 10" . "cmbx10") - ("bold upright roman cmbx 1 12" . "cmbx12") - ("medium italic roman cmbx 0 10" . "cmbx10") - ("medium italic roman cmbx 1 12" . "cmbx12") - )) - )) - -(define (get-font-name style properties-alist) - (let ((font-regexp - (let loop ((p '(font-series font-shape font-family font-name font-size font-points)) (s "")) - (let* ((key (if (pair? p) (car p) p)) - (entry (assoc key properties-alist)) - (value (if entry (cdr entry) "[^ ]+"))) - (if (pair? (cdr p)) - (loop (cdr p) (string-append s value " ")) - (string-append (string-append s value)))))) - (style-sheet (cdr (assoc style style-sheet-alist)))) - ;;(display "regex: `") - ;;(display font-regexp) - ;;(display "'") - ;;(newline) - (let loop ((fonts style-sheet)) - ;;(display "font: `") - ;;(display (caar fonts)) - ;;(display "' = ") - ;;(display (cdar fonts)) - ;;(newline) - (if (string-match font-regexp (caar fonts)) - (cdar fonts) - (if (pair? (cdr fonts)) - (loop (cdr fonts)) - '()))))) - -(define markup-to-properties-alist - '((series . font-series) - (shape . font-shape) - (family . font-family) - (name . font-name) - (size . font-size) - (point . font-point))) - -(define markup-abbrev-to-properties-alist - '((rows . (align . 0)) - (lines . (align . 1)) - (roman . (font-family . "roman")) - (music . (font-family . "music")) - (bold . (font-series . "bold")) - (italic . (font-shape . "italic")))) - -(define (markup-to-properties markup) - ;;(display "markup: ") - ;;(display markup) - ;;(newline) - (if (pair? markup) - (cons (cdr (assoc (car markup) markup-to-properties-alist)) (cdr markup)) - (cdr (assoc markup markup-abbrev-to-properties-alist)))) - +;;;; font.scm -- implement Font stuff +;;;; +;;;; source file of the GNU LilyPond music typesetter +;;;; +;;;; (c) 2000--2004 Jan Nieuwenhuizen +;;;; Han-Wen Nienhuys + +;; Should separate default sizes +;; into separate list/alist ? + + +" +Each entry in this vector has the following format + + + (cons + #(QUALIFIERS) + (cons DEFAULT-SIZE + #(SIZE-FONT-ENTRIES... ) )) + +where each SIZE-FONT-ENTRY is + + (cons DESIGN-SIZE FONT-NAME) + +or + + (cons DESIGN-SIZE (list FONT-NAME1 FONT-NAME2 .. )) + +" + +(define-public (magstep x) + (exp (* (/ x 6) (log 2)))) + +(define-public paper20-font-vector + '((#(medium upright number) . + (10 . #((10.0 . "feta-nummer10")))) + (#(medium upright roman) . + (10.0 . #((6.0 . "cmr6") + (8.0 . "cmr8") + (10.0 . "cmr10") + (17.0 . "cmr17") + ))) + (#(* * music). + (20.0 . #((11.22 . ("feta11" "parmesan11")) + (12.60 . ("feta13" "parmesan13")) + (14.14 . ("feta14" "parmesan14")) + (15.87 . ("feta16" "parmesan16")) + (17.82 . ("feta18" "parmesan18")) + (20.0 . ("feta20" "parmesan20")) + (22.45 . ("feta23" "parmesan23")) + (25.20 . ("feta26" "parmesan26")) + ))) + (#(medium upright sans) . + (10.0 . #((8.0 . "cmss8") + (10.0 . "cmss10") + (12.0 . "cmss12") + (17.0 . "cmss17") + ))) + (#(medium upright typewriter) . + (10.0 . #((8.0 . "cmtt8") + (10.0 . "cmtt10") + (12.0 . "cmtt12") + ))) + (#(bold italic roman) . + (10.0 . #((8.0 . "cmbxti8") + (10.0 . "cmbxti10") + (14.0 . "cmbxti14") + ))) + (#(medium italic roman) . + (10.0 . #((7.0 . "cmti7") + (10.0 . "cmti10") + (12.0 . "cmti12") + ))) + (#(bold upright roman) . + (10.0 . #((6.0 . "cmbx6") + (8.0 . "cmbx8") + (10.0 . "cmbx10") + (12.0 . "cmbx12") + ))) + (#(bold-narrow upright roman) . + (10.0 . #((10.0 . "cmb10") + ))) + (#(medium caps roman) . + (10.0 . #((10.0 . "cmcsc10")))) + + (#(* * dynamic) . + (14.0 . #((6.0 . "feta-din6") + (8.0 . "feta-din8") + (10.0 . "feta-din10") + (12.0 . "feta-din10") + (14.0 . "feta-din14") + (17.0 . "feta-din17") + ))) + (#(* * math) . + (10.0 . #((10.0 . "msam10")))) + )) + +(define (scale-font-entry entry factor) + (cons + (car entry) + (cons (* (cadr entry) factor) + (cddr entry)))) + +(define size-independent-fonts + '((#(* * braces) . + (10 . #((10.0 . ("feta-braces00" + "feta-braces10" + "feta-braces20" + "feta-braces30" + "feta-braces40" + "feta-braces50" + "feta-braces60" + "feta-braces70" + "feta-braces80"))))))) + +(define-public (scale-font-list factor) + (append size-independent-fonts + (map (lambda (y) (scale-font-entry y factor)) paper20-font-vector))) + +