;; #(display (reencode-string "adobe" "latin1" "hellö fóebär"))
;;
-(define coding-file-alist
- ;; teTeX
- '(("TeX typewriter text" . "09fbbfac.enc") ;; cmtt10
- ("TeX math symbols" . "10037936.enc") ;; cmbsy
- ("ASCII caps and digits" . "1b6d048e") ;; cminch
- ("TeX math italic" . "aae443f0.enc") ;; cmmi10
- ("TeX extended ASCII" . "d9b29452.enc")
- ("TeX text" . "f7b6d320.enc")
- ("TeX text without f-ligatures" . "0ef0afca.enc")
- ("Extended TeX Font Encoding - Latin" . "tex256.enc")
-
- ("T1" . "tex256.enc")
- ;; for testing -- almost adome
- ("adobe" . "ad.enc")
- ("latin1" . "cork.enc")
-
- ;; LilyPond.
- ("feta braces" . "feta-braces0.enc")
- ("feta number" . "feta-nummer10.enc")
- ("feta music" . "feta20.enc")
- ("parmesan music" . "parmesan20.enc")))
-
-(define encoding-alist '())
-
-;; TODO: run this once and 'cache' output of (write lst) in <coding>.scm ?
-(define (read-coding-file coding)
- (let* ((raw (ly:gulp-file (assoc-get coding coding-file-alist)))
- ;;(raw (ly:gulp-file "f7b6d320.enc"))
+(define (read-encoding-file filename)
+ "Read .enc file, returning a vector of symbols."
+ (let* ((raw (ly:gulp-file filename))
(string (regexp-substitute/global #f "%[^\n]*" raw 'pre "" 'post))
(start (string-index string #\[))
(end (string-index string #\]))
(ps-lst (string-tokenize (substring string (+ start 1) end)))
(lst (map (lambda (x) (substring x 1)) ps-lst))
- (vector (list->vector lst))
- (table (make-hash-table 256)))
- (do ((i 0 (+ i 1)))
- ((>= i 256))
- (hash-create-handle! table (vector-ref vector i) i))
- (let ((entry (cons coding (cons vector table))))
- (set! encoding-alist (append (list entry) encoding-alist))
- (cdr entry))))
-
-(define (get-coding-table coding)
- (let ((entry (assoc-get coding encoding-alist #f)))
- (if entry (cdr entry)
- (cdr (read-coding-file coding)))))
-
-(define (get-coding-vector coding)
- (let ((entry (assoc-get coding encoding-alist #f)))
- (if entry (car entry)
- (car (read-coding-file coding)))))
+ (vector (list->vector lst)))
+
+ vector))
+
+(define (make-encoding-table encoding-vector)
+ "Return a hash table mapping names to chars. ENCODING-VECTOR is a
+vector of symbols."
+
+ (let* ((h (make-hash-table 256)))
+
+ (for-each
+ (lambda (i)
+ (hash-set! h (vector-ref encoding-vector i)
+ (integer->char i)))
+ (iota 256))
+
+ h))
+
+(define-public (reencode-string permutation str)
+ "Apply PERMUTATION (a vector of [0..256) -> [0..256) to STR"
+ (string-map (lambda (chr)
+ (vector-ref permutation (char->integer chr)))
+ str))
+
+(define-public (encoding-permutation input-encoding
+ output-encoding)
+
+ "Contruct a permutation by applying output-encoding after input-encoding "
+ (list->vector
+ (map
+ (lambda (chr)
+ (let*
+ ((new-char (hash-ref output-encoding
+ (vector-ref input-encoding (char->integer chr)) #f)))
+
+ ;; substitute space for unknown characters.
+ (if (char? new-char)
+ new-char
+ #\ )))
+ (iota 256))))
+
+(define (get-coding-from-file filename)
+ "Read FILENAME, return a list containing encoding vector and table"
+
+ (let*
+ ((vec (read-encoding-file filename))
+ (tab (make-encoding-table vec)))
+ (list vec tab)))
+
+
+
+;; coding-alist maps NAME -> (list VECTOR TAB)
+(define coding-alist
+
+ (map (lambda (x)
+ (cons (car x)
+ (delay (get-coding-from-file (cdr x)))))
+
+ '(
+ ;; teTeX
+ ("TeX typewriter text" . "09fbbfac.enc") ;; cmtt10
+ ("TeX math symbols" . "10037936.enc") ;; cmbsy
+ ("ASCII caps and digits" . "1b6d048e") ;; cminch
+ ("TeX math italic" . "aae443f0.enc") ;; cmmi10
+ ("TeX extended ASCII" . "d9b29452.enc")
+ ("TeX text" . "f7b6d320.enc")
+ ("TeX text without f-ligatures" . "0ef0afca.enc")
+ ("Extended TeX Font Encoding - Latin" . "tex256.enc")
+
+ ("T1" . "tex256.enc")
+
+ ;; for testing -- almost adome
+ ("adobe" . "ad.enc")
+ ("latin1" . "cork.enc")
+
+ ;; LilyPond.
+ ("feta braces" . "feta-braces0.enc")
+ ("feta number" . "feta-nummer10.enc")
+ ("feta music" . "feta20.enc")
+ ("parmesan music" . "parmesan20.enc"))
+ ))
+
+(define (get-coding coding-name)
+ (force (assoc-get coding-name coding-alist )))
+
+(define (get-coding-vector coding-name)
+ (car (get-coding coding-name)))
+
+(define (get-coding-table coding-name)
+ (cadr (get-coding coding-name)))
+
+
+;;; what's this for? --hwn
(define-public (encoded-index font-coding input-coding code)
(format (current-error-port) "CODE: ~S\n" code)
(let* ((font (get-coding-table font-coding))
(format (current-error-port) "CHAR: ~S\n" char)
(hash-ref font char)))
-(define-public (reencode-string font-coding input-coding s)
- ;; ughr?
- (list->string
- (map integer->char
- (map (lambda (x) (encoded-index font-coding input-coding x))
- ;;(map char->integer (string->list s))))))
- (map char->integer (plain-string->list s))))))
-