-;;;
-;;; font.scm -- implement Font stuff
-;;;
-;;; source file of the GNU LilyPond music typesetter
-;;;
-;;; (c) 2000 Jan Nieuwenhuizen <janneke@gnu.org>
-;;;
-
-
-;; 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 <janneke@gnu.org>
+;;;; Han-Wen Nienhuys <hanwen@cs.uu.nl>
+
+;; 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)))
+
+
projects / lilypond.git / blobdiff