scm/encoding.scm

   1 ;;;; encoding.scm -- font encoding
   2 ;;;;
   3 ;;;;  source file of the GNU LilyPond music typesetter
   4 ;;;;
   5 ;;;; (c) 2004 Jan Nieuwenhuizen <janneke@gnu.org>
   6
   7 ;; WIP
   8 ;; encoding.ly:
   9 ;; #(display (reencode-string "adobe" "latin1" "hellö fóebär"))
  10 ;;
  11
  12
  13 (define-public (read-encoding-file filename)
  14   "Read .enc file, return as a vector of symbols."
  15   (let* ((raw (ly:kpathsea-gulp-file filename))
  16          (string (regexp-substitute/global #f "%[^\n]*" raw 'pre "" 'post))
  17          (start (string-index string #\[))
  18          (end (string-index string #\]))
  19          (ps-lst (string-tokenize (substring string (+ start 1) end)))
  20          (lst (map (lambda (x) (substring x 1)) ps-lst)))
  21     (list->vector lst)))
  22
  23 (define (make-encoding-table encoding-vector)
  24   "Return a hash table mapping names to chars. ENCODING-VECTOR is a
  25 vector of symbols."
  26
  27   (let* ((h (make-hash-table 256)))
  28
  29     (for-each
  30      (lambda (i)
  31        (hash-set! h (vector-ref encoding-vector i)
  32                   (integer->char i)))
  33      (iota 256))
  34
  35     h))
  36
  37 (define-public (reencode-string permutation str)
  38   "Apply PERMUTATION, a vector of [0..256) -> char, to STR"
  39   (string-map (lambda (chr)
  40                 (vector-ref permutation (char->integer chr)))
  41               str))
  42
  43 (define-public (make-encoding-permutation input-encoding output-encoding)
  44   "Contruct a permutation by applying output-encoding after input-encoding "
  45   (list->vector
  46    (map
  47     (lambda (byte)
  48       (let ((new-char (hash-ref
  49                        output-encoding (vector-ref input-encoding byte) #f)))
  50                        ;;input-encoding (vector-ref output-encoding byte) #f)))
  51
  52         ;; substitute space for unknown characters.
  53         (if (char? new-char)
  54             new-char
  55             #\ )))
  56     (iota 256))))
  57
  58
  59 (define (get-coding-from-file filename)
  60   "Read FILENAME, return a list containing encoding vector and table"
  61    (let* ((vec (read-encoding-file filename))
  62           (tab (make-encoding-table vec)))
  63     (list vec tab)))
  64
  65 ;; coding-alist maps NAME -> (list VECTOR TAB)
  66 (define coding-alist
  67
  68   (map (lambda (x)
  69          (cons (car x)
  70                (delay (get-coding-from-file (cdr x)))))
  71
  72        '(
  73          ;; teTeX
  74          ("TeX typewriter text" . "09fbbfac.enc") ;; cmtt10
  75          ("TeX math symbols" . "10037936.enc") ;; cmbsy
  76          ("ASCII caps and digits" . "1b6d048e.enc") ;; cminch
  77          ("TeX math italic" . "aae443f0.enc")  ;; cmmi10
  78          ("TeX extended ASCII" . "d9b29452.enc")
  79          ("TeX text" . "f7b6d320.enc")
  80          ("TeX text without f-ligatures" . "0ef0afca.enc")
  81          ("Extended TeX Font Encoding - Latin" . "tex256.enc")
  82
  83          ("T1" . "tex256.enc")
  84
  85          ;; FIXME: find full Adobe; for testing -- almost Adobe:
  86          ("adobe" . "ad.enc")
  87
  88          ("latin1" . "cork.enc")
  89
  90          ;; LilyPond.
  91          ("feta braces" . "feta-braces-a.enc")
  92          ("feta number" . "feta-nummer10.enc")
  93          ("feta music" . "feta20.enc")
  94          ("parmesan music" . "parmesan20.enc"))
  95        ))
  96
  97 (define (get-coding coding-name)
  98   (force (assoc-get coding-name coding-alist )))
  99
 100 (define-public (get-coding-vector coding-name)
 101   (car (get-coding coding-name)))
 102
 103 (define-public (get-coding-table coding-name)
 104   (cadr (get-coding coding-name)))
 105
 106
 107 ;;; JUNKME
 108 ;;; what's this for? --hwn
 109 ;; (define-public (encoded-index font-coding input-coding code)
 110 ;; This was used by simplistic first incarnation of reencode-string --jcn