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 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)))
  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 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)))
  45               str))
  46
  47 (define-public (make-encoding-mapping input-encoding output-encoding)
  48   "Contruct a mapping by applying output-encoding after input-encoding "
  49   (list->vector
  50    (map
  51     (lambda (byte)
  52       (let ((new-char (hash-ref
  53                        output-encoding (vector-ref input-encoding byte) #f)))
  54                        ;;input-encoding (vector-ref output-encoding byte) #f)))
  55
  56         ;; substitute space for unknown characters.
  57         (if (char? new-char)
  58             new-char
  59             #\ )))
  60     (iota 256))))
  61
  62
  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           (com (car coding))
  67           (vec (cdr coding))
  68           (tab (make-encoding-table vec)))
  69     (list com vec tab)))
  70
  71 ;; coding-alist maps NAME -> (list FILE-NAME COMMAND VECTOR TAB)
  72 (define coding-alist
  73
  74   (map (lambda (x)
  75          (cons (car x)
  76                (cons (cdr x) (delay (get-coding-from-file (cdr x))))))
  77
  78        '(
  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")
  89          ("T1" . "tex256.enc")
  90          ("adobe" . "8a.enc")
  91          ;; EC-fonts-mftraced
  92          ("ec" . "EC.enc")
  93          ;; lmodern, encoding flavour latin1
  94          ("cork-lm" . "cork-lm.enc")
  95
  96          ;; input encodings
  97          ("latin1" . "latin1.enc")
  98          ("cork" . "cork.enc")
  99
 100          ;; LilyPond FETA music font
 101          ("fetaBraces" . "feta-braces-a.enc")
 102          ("fetaNumber" . "feta-nummer10.enc")
 103          ("fetaMusic" . "feta20.enc")
 104          ("parmesanMusic" . "parmesan20.enc"))
 105        ))
 106
 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)))
 111     (if entry
 112         (cons (car entry) (force (cdr entry)))
 113         (if (equal? coding-name "feta-music")
 114             (begin
 115               (ly:warn "installation problem: deprecated encoding requested: ~S" coding-name)
 116               (exit 1))
 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))))))
 121
 122 (define-public (get-coding-file-name coding-name)
 123   (car (get-coding coding-name)))
 124
 125 (define-public (get-coding-command coding-name)
 126   (cadr (get-coding coding-name)))
 127
 128 (define-public (get-coding-vector coding-name)
 129   (caddr (get-coding coding-name)))
 130
 131 (define-public (get-coding-table coding-name)
 132   (cadddr (get-coding coding-name)))