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