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))))))
78 ;; teTeX font (output) encodings
79 ("TeX-typewriter-text" . "09fbbfac.enc") ;; cmtt10
80 ("TeX-math-symbols" . "10037936.enc") ;; cmbsy
81 ("ASCII-caps-and-digits" . "1b6d048e.enc") ;; cminch
82 ("TeX-math-italic" . "aae443f0.enc") ;; cmmi10
83 ("TeX-extended-ASCII" . "d9b29452.enc")
84 ("TeX-text" . "cmr.enc")
85 ("TeX-text-without-f-ligatures" . "0ef0afca.enc")
86 ("Extended-TeX-Font-Encoding---Latin" . "tex256.enc")
87 ("AdobeStandardEncoding" . "8a.enc")
91 ("Extended-TeX-Font-Encoding---Latin" . "EC.enc")
92 ;; lmodern, encoding flavour latin1
93 ("cork-lm" . "cork-lm.enc")
96 ("latin1" . "latin1.enc")
99 ;; LilyPond FETA music font
100 ("fetaBraces" . "feta-braces-a.enc")
101 ;;("fetaDynamic" . "feta-din10.enc")
102 ;;("fetaNumber" . "feta-nummer10.enc")
103 ("fetaDynamic" . "feta-alphabet20.enc")
104 ("fetaNumber" . "feta-alphabet20.enc")
105 ("fetaMusic" . "feta20.enc")
106 ("parmesanMusic" . "parmesan20.enc"))
109 ;; FIXME: this is broken, cannot get font encoding from font/AFM file,
110 ;; should use encoding from font-tree in fonts.scm
111 (define (get-coding coding-name)
112 (let ((entry (assoc-get coding-name coding-alist)))
114 (cons (car entry) (force (cdr entry)))
115 (if (equal? coding-name "feta-music")
117 (ly:warn "installation problem: deprecated encoding requested: ~S" coding-name)
119 (let ((fallback "latin1"))
120 (ly:programming-error "no such encoding: ~S" coding-name)
121 (ly:programming-error "programming error: cross thumbs, using: ~S:" fallback)
122 (get-coding fallback))))))
124 (define-public (get-coding-file-name coding-name)
125 (car (get-coding coding-name)))
127 (define-public (get-coding-command coding-name)
128 (cadr (get-coding coding-name)))
130 (define-public (get-coding-vector coding-name)
131 (caddr (get-coding coding-name)))
133 (define-public (get-coding-table coding-name)
134 (cadddr (get-coding coding-name)))
137 (define-public (decode-byte-string encoding-name str)
138 "Return vector of glyphname symbols that correspond to string,
139 assuming that STR is byte-coded using ENCODING-NAME."
141 (let* ((coding-vector (get-coding-vector encoding-name))
142 (len (string-length str))
143 (output-vector (make-vector len '.notdef)))
147 ((>= idx len) output-vector)
148 (vector-set! output-vector idx
149 (vector-ref coding-vector
150 (char->integer (string-ref str idx)))))))