)
))
-(define (filter-list pred? list)
- "return that part of LIST for which PRED is true."
- (if (null? list) '()
- (let* (
- (rest (filter-list pred? (cdr list)))
- )
- (if (pred? (car list))
- (cons (car list) rest)
- rest
- )
- )
- )
- )
-
;;;;;;;;; TODO TODO . (should not use filtering?)
;; this is bad, since we generate garbage every font-lookup.
;; otoh, if the qualifiers is narrow enough , we don't generate much garbage.
;; (also tried to vary the order of this list, with little effect)
(define paper20-style-sheet-alist
'(
+ ;; why are font-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")
((-3 medium upright typewriter cmtt 6) . "cmtt6" )
((-4 medium upright typewriter cmtt 5) . "cmtt5" )
((-5 medium upright typewriter cmtt 5) . "cmtt5" )
-
- ;; should use the same brace font every where and fix C++ code.
- ((2 * * braces feta-braces 26) . "feta-braces26")
- ((1 * * braces feta-braces 23) . "feta-braces23")
- ((0 * * braces feta-braces 20) . "feta-braces20")
- ((-1 * * braces feta-braces 16) . "feta-braces16")
- ((-2 * * braces feta-braces 13) . "feta-braces13")
- ((-3 * * braces feta-braces 11) . "feta-braces11")
+
+ ((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")
+
+ ;; smallest needs 8 steps: -3 to +5, so
+ ;; biggest also needs 8 available steps: +2 to + 10
+ ((10 * * braces feta-braces 3) . "feta-braces3")
+ ((9 * * braces feta-braces 3) . "feta-braces3")
+ ((8 * * braces feta-braces 3) . "feta-braces3")
+ ((7 * * braces feta-braces 3) . "feta-braces3")
+ ((6 * * braces feta-braces 3) . "feta-braces3")
+ ((5 * * braces feta-braces 3) . "feta-braces3")
+ ((4 * * braces feta-braces 2) . "feta-braces2")
+ ((3 * * braces feta-braces 1) . "feta-braces1")
+ ((2 * * braces feta-braces 0) . "feta-braces0")
+ ((1 * * braces feta-braces 0) . "feta-braces0")
+ ((0 * * braces feta-braces 0) . "feta-braces0")
+ ((-1 * * braces feta-braces 0) . "feta-braces0")
+ ((-2 * * braces feta-braces 0) . "feta-braces0")
+ ((-3 * * braces feta-braces 0) . "feta-braces0")
((3 * * dynamic feta-din 19) . "feta-din19")
((2 * * dynamic feta-din 19) . "feta-din19")
(properties-to-font .
,Font_interface::properties_to_font_name)
- ;; FIXME: this is a not-so-cool idea to use ALIGN
- ;; RAISE, LOOKUP, since they are not proper elt-properties,
- ;; and might interfere with them.
(markup-to-properties . ,markup-to-properties)
(abbreviation-alist
- . ((rows . ((align . 0)))
- (lines . ((align . 1)))
+ . ((columns . ((axis . 0)))
+ (lines . ((axis . 1)))
(roman . ((font-family . roman)))
(music . ((font-family . music) (lookup . name)))
(finger . ((font-style . finger)))
(upright . ((font-shape . upright)))
(italic . ((font-shape . italic)))
(named . ((lookup . name)))
- (super . ((raise . 1) (font-relative-size . -1)))
- (sub . ((raise . -1) (font-relative-size . -1)))
+ (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 (wild-eq? x y)
+ (or (eq? x y)
+ (eq? x '*)
+ (eq? y '*)))
+
(define (font-qualifies? qualifiers font-desc)
"does FONT-DESC satisfy QUALIFIERS?"
(if (null? qualifiers) #t
- (if (eq? (font-field (caar qualifiers) font-desc) (cdar qualifiers))
+ (if (wild-eq? (font-field (caar qualifiers) font-desc) (cdar qualifiers))
(font-qualifies? (cdr qualifiers) font-desc)
- #f
- )
- )
- )
+ #f)))
(define (find-first-font qualifiers fonts)
(if (null? fonts)
(define (chain-assoc x alist-list)
(if (null? alist-list)
#f
- (let* (
- (handle (assoc x (car alist-list)))
- )
+ (let* ((handle (assoc x (car alist-list))))
(if (pair? handle)
handle
- (chain-assoc x (cdr alist-list))
- )
- )
- )
- )
+ (chain-assoc x (cdr alist-list))))))
;; TODO
;; the C++ version in font-interface.cc is usually used.
+;;
+;; FIXME: this has silently been broken by the introduction
+;; of wildcards in the font list.
(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 font-design-size font-relative-size))
- (rawqualifiers (map (lambda (x) (chain-assoc x properties-alist-list))
+ (q-order '(font-name font-family font-series font-shape
+ font-design-size font-relative-size))
+ (rawqualifiers (map (lambda (x)
+ (chain-assoc x properties-alist-list))
q-order))
(qualifiers (filter-list pair? rawqualifiers))
- (selected (find-first-font qualifiers fonts))
- (err (current-error-port))
- )
+ (selected (find-first-font qualifiers fonts))
+ (err (current-error-port)))
(if (equal? selected "")
(begin
;; (display "'\n")
(if (pair? markup)
- (if (and (symbol? (car markup)) (not (pair? (cdr markup))))
+ ;; This is hairy. We want to allow:
+ ;; ((foo bar) "text")
+ ;; ((foo (bar . 1)) "text")
+ ;; ((foo . (0 . 1)))
+
+ (if (and (symbol? (car markup))
+ (or (not (pair? (cdr markup)))
+ (number? (cadr markup))))
(if (equal? '() (cdr markup))
(markup-to-properties sheet (car markup))
(list markup))
projects / lilypond.git / blobdiff