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 ;; cp /usr/share/texmf/dvips/base/*.enc mf/out
   9 ;; cp /usr/share/texmf/dvips/tetex/*.enc mf/out
  10 ;; encoding.ly:
  11 ;; #(display (reencode-string "adobe" "latin1" "hellö fóebär"))
  12 ;;
  13
  14
  15 (define (read-encoding-file filename)
  16   "Read .enc file, returning a vector of symbols."
  17   (let* ((raw (ly:gulp-file filename))
  18          (string (regexp-substitute/global #f "%[^\n]*" raw 'pre "" 'post))
  19          (start (string-index string #\[))
  20          (end (string-index string #\]))
  21          (ps-lst (string-tokenize (substring string (+ start 1) end)))
  22          (lst (map (lambda (x) (substring x 1)) ps-lst))
  23          (vector (list->vector lst)))
  24
  25     vector))
  26
  27 (define (make-encoding-table encoding-vector)
  28   "Return a hash table mapping names to chars. ENCODING-VECTOR is a
  29 vector of symbols."
  30
  31   (let* ((h (make-hash-table 256)))
  32
  33     (for-each
  34      (lambda (i)
  35        (hash-set! h (vector-ref encoding-vector i)
  36                   (integer->char i)))
  37      (iota 256))
  38
  39     h))
  40
  41 (define-public (reencode-string permutation str)
  42   "Apply PERMUTATION, a vector of [0..256) -> char, to STR"
  43   (string-map (lambda (chr)
  44                 (vector-ref permutation (char->integer chr)))
  45               str))
  46
  47 (define-public (encoding-permutation input-encoding
  48                                      output-encoding)
  49
  50   "Contruct a permutation by applying output-encoding after input-encoding "
  51   (list->vector
  52    (map
  53     (lambda (chr)
  54       (let*
  55           ((new-char (hash-ref output-encoding
  56                                (vector-ref input-encoding (char->integer chr)) #f)))
  57
  58         ;; substitute space for unknown characters.
  59         (if (char? new-char)
  60             new-char
  61             #\ )))
  62     (iota 256))))
  63
  64
  65 (define (get-coding-from-file filename)
  66   "Read FILENAME, return a list containing encoding vector and table"
  67
  68   (let*
  69       ((vec (read-encoding-file filename))
  70        (tab (make-encoding-table vec)))
  71     (list vec tab)))
  72
  73 ;; coding-alist maps NAME -> (list VECTOR TAB)
  74 (define coding-alist
  75
  76   (map (lambda (x)
  77          (cons (car x)
  78                (delay (get-coding-from-file (cdr x)))))
  79
  80        '(
  81          ;; teTeX
  82          ("TeX typewriter text" . "09fbbfac.enc") ;; cmtt10
  83          ("TeX math symbols" . "10037936.enc") ;; cmbsy
  84          ("ASCII caps and digits" . "1b6d048e.enc") ;; cminch
  85          ("TeX math italic" . "aae443f0.enc")  ;; cmmi10
  86          ("TeX extended ASCII" . "d9b29452.enc")
  87          ("TeX text" . "f7b6d320.enc")
  88          ("TeX text without f-ligatures" . "0ef0afca.enc")
  89          ("Extended TeX Font Encoding - Latin" . "tex256.enc")
  90
  91          ("T1" . "tex256.enc")
  92
  93          ;; for testing -- almost adome
  94          ("adobe" . "ad.enc")
  95          ("latin1" . "cork.enc")
  96
  97          ;; LilyPond.
  98          ("feta braces" . "feta-braces0.enc")
  99          ("feta number" . "feta-nummer10.enc")
 100          ("feta music" . "feta20.enc")
 101          ("parmesan music" . "parmesan20.enc"))
 102        ))
 103
 104 (define (get-coding coding-name)
 105   (force (assoc-get coding-name coding-alist )))
 106
 107 (define (get-coding-vector coding-name)
 108   (car (get-coding coding-name)))
 109
 110 (define (get-coding-table coding-name)
 111   (cadr (get-coding coding-name)))
 112
 113
 114 ;;; what's this for? --hwn
 115 (define-public (encoded-index font-coding input-coding code)
 116   (format (current-error-port) "CODE: ~S\n" code)
 117   (let* ((font (get-coding-table font-coding))
 118          (in (get-coding-vector input-coding))
 119          (char (vector-ref in code)))
 120     (format (current-error-port) "CHAR: ~S\n" char)
 121     (hash-ref font char)))
 122