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 "T1" "T1" "hellö"))
  12 ;;#(format (current-error-port) "a:~S\n"
  13 ;;  (encoded-index "TeX text" "TeX text" 65))
  14 ;;
  15 ;;#(format (current-error-port) "b:~S\n"
  16 ;;  (encoded-index "TeX text" "TeX extended ASCII" 176))
  17 ;;
  18
  19 (define coding-file-alist
  20   ;; teTeX
  21   '(("TeX typewriter text" . "09fbbfac.enc") ;; cmtt10
  22     ("TeX math symbols" . "10037936.enc") ;; cmbsy
  23     ("ASCII caps and digits" . "1b6d048e") ;; cminch
  24     ("TeX math italic" . "aae443f0.enc")  ;; cmmi10
  25     ("TeX extended ASCII" . "d9b29452.enc")
  26     ("TeX text" . "f7b6d320.enc")
  27     ("TeX text without f-ligatures" . "0ef0afca.enc")
  28     ("Extended TeX Font Encoding - Latin" . "tex256.enc")
  29
  30     ("T1" . "tex256.enc")
  31
  32
  33     ;; LilyPond.
  34     ("feta braces" . "feta-braces0.enc")
  35     ("feta number" . "feta-nummer10.enc")
  36     ("feta music" . "feta20.enc")
  37     ("parmesan music" . "parmesan20.enc")))
  38
  39 (define encoding-alist '())
  40
  41 (define (read-coding-file coding)
  42   (let* ((raw (ly:gulp-file (assoc-get coding coding-file-alist)))
  43          ;;(raw (ly:gulp-file "f7b6d320.enc"))
  44          (string (regexp-substitute/global #f "%[^\n]*" raw 'pre "" 'post))
  45          (start (string-index string #\[))
  46          (end (string-index string #\]))
  47          (ps-lst (string-tokenize (substring string (+ start 1) end)))
  48          (lst (map (lambda (x) (substring x 1)) ps-lst))
  49          (vector (list->vector lst))
  50          (table (make-hash-table 256)))
  51     (do ((i 0 (+ i 1)))
  52         ((>= i 256))
  53       (hash-create-handle! table (vector-ref vector i) i))
  54     (let ((entry (cons coding (cons vector table))))
  55       (set! encoding-alist (append (list entry) encoding-alist))
  56       (cdr entry))))
  57
  58 (define (get-coding-table coding)
  59   (let ((entry (assoc-get coding encoding-alist #f)))
  60     (if entry (cdr entry)
  61         (cdr (read-coding-file coding)))))
  62
  63 (define (get-coding-vector coding)
  64   (let ((entry (assoc-get coding encoding-alist #f)))
  65     (if entry (car entry)
  66         (car (read-coding-file coding)))))
  67
  68 (define-public (encoded-index font-coding input-coding code)
  69   (format (current-error-port) "CODE: ~S\n" code)
  70   (let* ((font (get-coding-table font-coding))
  71          (in (get-coding-vector input-coding))
  72          (char (vector-ref in code)))
  73     (format (current-error-port) "CHAR: ~S\ng" char)
  74     (hash-ref font char)))
  75
  76 (define-public (reencode-string font-coding input-coding s)
  77   ;; ughr?
  78   (list->string
  79    (map integer->char
  80         (map (lambda (x) (encoded-index font-coding input-coding x))
  81              (map char->integer (string->list s))))))
  82