1 ;;;; encoding.scm -- font encoding
3 ;;;; source file of the GNU LilyPond music typesetter
5 ;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
9 ;; #(display (reencode-string "adobe" "latin1" "hellö fóebär"))
13 (define-public (read-encoding-file file-name)
14 "Read .enc file, return (COMMAND-NAME . VECTOR-OF-SYMBOLS)."
15 (let* ((path (ly:kpathsea-find-file file-name))
16 (unused (if (string? path) #t (ly:warn "can't find ~s" file-name)))
17 (raw (ly:gulp-file path))
18 (string (regexp-substitute/global #f "%[^\n]*" raw 'pre "" 'post))
19 (command (match:substring
20 (string-match "/([^ \t\n\r]*)[ \t\n\r]+[[]" string) 1))
21 (encoding (match:substring (string-match "[[](.*)[]]" string) 1))
22 (ps-lst (string-tokenize encoding))
23 (lst (map (lambda (x) (string->symbol (substring x 1))) ps-lst))
24 (vector (list->vector lst)))
25 (cons command vector)))
27 (define (make-encoding-table encoding-vector)
28 "Return a hash table mapping names to chars. ENCODING-VECTOR is a
31 (let* ((h (make-hash-table 256)))
35 (hash-set! h (vector-ref encoding-vector i)
41 (define-public (reencode-string mapping str)
42 "Apply MAPPING, a vector of [0..256) -> char, to STR"
43 (string-map (lambda (chr)
44 (vector-ref mapping (char->integer chr)))
47 (define-public (make-encoding-mapping input-encoding output-encoding)
48 "Contruct a mapping by applying output-encoding after input-encoding "
52 (let ((new-char (hash-ref
53 output-encoding (vector-ref input-encoding byte) #f)))
54 ;;input-encoding (vector-ref output-encoding byte) #f)))
56 ;; substitute space for unknown characters.
63 (define (get-coding-from-file file-name)
64 "Read FILE-NAME, return a list containing encoding vector and table"
65 (let* ((coding (read-encoding-file file-name))
66 (command (car coding))
68 (table (make-encoding-table vector)))
69 (list command vector table)))
71 ;; coding-alist maps NAME -> (list FILE-NAME COMMAND VECTOR TAB)
76 (cons (cdr x) (delay (get-coding-from-file (cdr x))))))
79 ;; teTeX font (output) encodings
80 ("TeX-typewriter-text" . "09fbbfac.enc") ;; cmtt10
81 ("TeX-math-symbols" . "10037936.enc") ;; cmbsy
82 ("ASCII-caps-and-digits" . "1b6d048e.enc") ;; cminch
83 ("TeX-math-italic" . "aae443f0.enc") ;; cmmi10
84 ("TeX-extended-ASCII" . "d9b29452.enc")
85 ("TeX-text" . "cmr.enc")
86 ("TeX-text-without-f-ligatures" . "0ef0afca.enc")
87 ("Extended-TeX-Font-Encoding---Latin" . "tex256.enc")
88 ("AdobeStandardEncoding" . "8a.enc")
93 ;; lmodern, encoding flavour latin1
94 ("cork-lm" . "cork-lm.enc")
97 ("latin1" . "latin1.enc")
100 ;; LilyPond FETA music font
101 ("fetaBraces" . "feta-braces-a.enc")
102 ("fetaNumber" . "feta-nummer10.enc")
103 ("fetaMusic" . "feta20.enc")
104 ("parmesanMusic" . "parmesan20.enc"))
107 ;; FIXME: this is broken, cannot get font encoding from font/AFM file,
108 ;; should use encoding from font-tree in fonts.scm
109 (define (get-coding coding-name)
110 (let ((entry (assoc-get coding-name coding-alist)))
112 (cons (car entry) (force (cdr entry)))
113 (if (equal? coding-name "feta-music")
115 (ly:warn "installation problem: deprecated encoding requested: ~S" coding-name)
117 (let ((fallback "latin1"))
118 (ly:programming-error "no such encoding: ~S" coding-name)
119 (ly:programming-error "programming error: cross thumbs, using: ~S:" fallback)
120 (get-coding fallback))))))
122 (define-public (get-coding-file-name coding-name)
123 (car (get-coding coding-name)))
125 (define-public (get-coding-command coding-name)
126 (cadr (get-coding coding-name)))
128 (define-public (get-coding-vector coding-name)
129 (caddr (get-coding coding-name)))
131 (define-public (get-coding-table coding-name)
132 (cadddr (get-coding coding-name)))
135 (define-public (decode-byte-string encoding-name str)
136 "Return vector of glyphname symbols that correspond to string,
137 assuming that STR is byte-coded using ENCODING-NAME."
140 ((coding-vector (get-coding-vector encoding-name))
141 (len (string-length str))
142 (output-vector (make-vector len '.notdef))
148 ((>= idx len) output-vector)
149 (vector-set! output-vector idx
150 (vector-ref coding-vector
151 (char->integer (string-ref str idx))))