-(define (define-fonts internal-external-name-mag-pairs)
-
- (define (fontname->designsize fontname)
- (let ((i (string-index fontname char-numeric?)))
- (string->number (substring fontname i))))
-
- (define (define-font command fontname scaling)
- (string-append
- "/" command " { /" fontname " findfont "
- (ly:number->string scaling) " output-scale div scalefont } bind def\n"))
-
- (define (reencode-font raw encoding command)
- (string-append
- raw " " encoding " /" command " reencode-font\n"
- "/" command "{ /" command " findfont 1 scalefont } bind def\n"))
-
- ;; frobnicate NAME to jibe with external definitions.
- (define (possibly-mangle-fontname fontname)
- (cond
- ((tex-font? fontname)
- ;; FIXME: we need proper Fontmap for CM fonts, like so:
- ;; /CMR10 (cmr10.pfb);
- ;; (string-upcase fontname)
- (string-append fontname ".pfb"))
- ((or (equal? (substring fontname 0 4) "feta")
- (equal? (substring fontname 0 4) "parm"))
- (regexp-substitute/global
- #f "(feta|parmesan)([a-z-]*)([0-9]+)"
- fontname 'pre "GNU-LilyPond-" 1 2 "-" 3 'post))
- (else fontname)))
-
- ;; (define (font-load-command name-mag command)
- (define (font-load-command lst)
- (let* ((key-name-size (car lst))
- (value (cdr lst))
- (value-name-size (car value))
- (command (cdr value))
- (fontname (car value-name-size))
- (mangled (possibly-mangle-fontname fontname))
- (encoding (assoc-get fontname font-encoding-alist))
- (designsize (if (tex-font? fontname)
- (/ 12 (fontname->designsize fontname))
- ;; This is about 12/20 :-)
- (cdr key-name-size)))
- (fontsize (cdr value-name-size))
- (scaling (* 12 (/ fontsize designsize)))
- (scaling (/ fontsize (/ designsize 12))))
-
- (if
- #f
- (begin
- (newline)
- (format (current-error-port) "key-name-size ~S\n" key-name-size)
- (format (current-error-port) "value ~S\n" value)
- (format (current-error-port) "value-name-size ~S\n" value-name-size)
- (format (current-error-port) "command ~S\n" command)
- (format (current-error-port) "designsize ~S\n" designsize)
- (format (current-error-port) "fontname ~S\n" fontname)
- (format (current-error-port) "mangled ~S\n" mangled)
- (format (current-error-port) "fontsize ~S\n" fontsize)
- (format (current-error-port) "scaling ~S\n" scaling)))
-
- (if encoding
- ;; FIXME: should rather tag encoded font
- (let ((raw (string-append command "-raw")))
- (string-append
- (define-font raw mangled scaling)
- (reencode-font raw encoding command)))
- (define-font command mangled scaling))))
-
- (define (ps-encoded-fontswitch name-mag-pair)
- (let* ((key (car name-mag-pair))
- (value (cdr name-mag-pair))
- (fontname (car value))
- (scaling (cdr value)))
- (cons key (cons value
- (string-append
- "lilyfont" fontname "-" (number->string scaling))))))
-
- (set! font-name-alist
- (map ps-encoded-fontswitch internal-external-name-mag-pairs))
- (apply string-append (map font-load-command font-name-alist)))
-
-(define (define-origin file line col) "")
-