X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fencoding.scm;h=bebf515b6b83ac4df03b2408c2a284bfa2a0eef6;hb=90e4d7057f3857da049dfda3d130017d4719bd6b;hp=3c377743078fda1b9ace6d22daf5ba1be5b02701;hpb=4a98a67526954d161e92cce82baa317ad5df761d;p=lilypond.git diff --git a/scm/encoding.scm b/scm/encoding.scm index 3c37774307..bebf515b6b 100644 --- a/scm/encoding.scm +++ b/scm/encoding.scm @@ -1,82 +1,71 @@ -;;;; encoding.scm -- font encoding +;;;; This file is part of LilyPond, the GNU music typesetter. ;;;; -;;;; source file of the GNU LilyPond music typesetter -;;;; -;;;; (c) 2004 Jan Nieuwenhuizen - -;; WIP -;; cp /usr/share/texmf/dvips/base/*.enc mf/out -;; cp /usr/share/texmf/dvips/tetex/*.enc mf/out -;; encoding.ly: -;; #(display (reencode-string "adobe" "latin1" "hellö fóebär")) -;; - -(define coding-file-alist - ;; teTeX - '(("TeX typewriter text" . "09fbbfac.enc") ;; cmtt10 - ("TeX math symbols" . "10037936.enc") ;; cmbsy - ("ASCII caps and digits" . "1b6d048e") ;; cminch - ("TeX math italic" . "aae443f0.enc") ;; cmmi10 - ("TeX extended ASCII" . "d9b29452.enc") - ("TeX text" . "f7b6d320.enc") - ("TeX text without f-ligatures" . "0ef0afca.enc") - ("Extended TeX Font Encoding - Latin" . "tex256.enc") - - ("T1" . "tex256.enc") - - ;; for testing -- almost adome - ("adobe" . "ad.enc") - ("latin1" . "cork.enc") - - ;; LilyPond. - ("feta braces" . "feta-braces0.enc") - ("feta number" . "feta-nummer10.enc") - ("feta music" . "feta20.enc") - ("parmesan music" . "parmesan20.enc"))) - -(define encoding-alist '()) - -;; TODO: run this once and 'cache' output of (write lst) in .scm ? -(define (read-coding-file coding) - (let* ((raw (ly:gulp-file (assoc-get coding coding-file-alist))) - ;;(raw (ly:gulp-file "f7b6d320.enc")) - (string (regexp-substitute/global #f "%[^\n]*" raw 'pre "" 'post)) - (start (string-index string #\[)) - (end (string-index string #\])) - (ps-lst (string-tokenize (substring string (+ start 1) end))) - (lst (map (lambda (x) (substring x 1)) ps-lst)) - (vector (list->vector lst)) - (table (make-hash-table 256))) - (do ((i 0 (+ i 1))) - ((>= i 256)) - (hash-create-handle! table (vector-ref vector i) i)) - (let ((entry (cons coding (cons vector table)))) - (set! encoding-alist (append (list entry) encoding-alist)) - (cdr entry)))) - -(define (get-coding-table coding) - (let ((entry (assoc-get coding encoding-alist #f))) - (if entry (cdr entry) - (cdr (read-coding-file coding))))) +;;;; Copyright (C) 2004--2015 Jan Nieuwenhuizen +;;;; +;;;; LilyPond is free software: you can redistribute it and/or modify +;;;; it under the terms of the GNU General Public License as published by +;;;; the Free Software Foundation, either version 3 of the License, or +;;;; (at your option) any later version. +;;;; +;;;; LilyPond is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;;; GNU General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU General Public License +;;;; along with LilyPond. If not, see . -(define (get-coding-vector coding) - (let ((entry (assoc-get coding encoding-alist #f))) - (if entry (car entry) - (car (read-coding-file coding))))) +(define-public latin1-coding-vector + #(.notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef + .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef + .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef + .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef + %% 0x20 + space exclam quotedbl numbersign dollar percent ampersand quoteright + parenleft parenright asterisk plus comma hyphen period slash + zero one two three four five six seven + eight nine colon semicolon less equal greater question + %% 0x40 + at A B C D E F G + H I J K L M N O + P Q R S T U V W + X Y Z bracketleft backslash bracketright asciicircum underscore + %% 0x60 + `quoteleft a b c d e f g + h i j k l m n o + p q r s t u v w + x y z braceleft bar braceright asciitilde .notdef + %% 0x80 + .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef + .notdef .notdef .notdef .notdef .notdef .notdef .notdef .notdef + dotlessi grave acute circumflex tilde macron breve dotaccent + dieresis .notdef ring cedilla .notdef hungarumlaut ogonek caron + %% 0xA0 + space exclamdown cent sterling currency yen brokenbar section + dieresis copyright ordfeminine guillemotleft logicalnot hyphen registered macron + degree plusminus twosuperior threesuperior acute mu paragraph periodcentered + cedilla onesuperior ordmasculine guillemotright onequarter onehalf threequarters questiondown + %% 0xC0 + Agrave Aacute Acircumflex Atilde Adieresis Aring AE Ccedilla + Egrave Eacute Ecircumflex Edieresis Igrave Iacute Icircumflex Idieresis + Eth Ntilde Ograve Oacute Ocircumflex Otilde Odieresis multiply + Oslash Ugrave Uacute Ucircumflex Udieresis Yacute Thorn germandbls + %% 0xE0 + agrave aacute acircumflex atilde adieresis aring ae ccedilla + egrave eacute ecircumflex edieresis igrave iacute icircumflex idieresis + eth ntilde ograve oacute ocircumflex otilde odieresis divide + oslash ugrave uacute ucircumflex udieresis yacute thorn ydieresis)) -(define-public (encoded-index font-coding input-coding code) - (format (current-error-port) "CODE: ~S\n" code) - (let* ((font (get-coding-table font-coding)) - (in (get-coding-vector input-coding)) - (char (vector-ref in code))) - (format (current-error-port) "CHAR: ~S\n" char) - (hash-ref font char))) -(define-public (reencode-string font-coding input-coding s) - ;; ughr? - (list->string - (map integer->char - (map (lambda (x) (encoded-index font-coding input-coding x)) - ;;(map char->integer (string->list s)))))) - (map char->integer (plain-string->list s)))))) +(define-public (decode-byte-string str) + "Return vector of glyphname symbols that correspond to string, +assuming that @var{str} is byte-coded using latin-1 encoding." + (let* ((len (string-length str)) + (output-vector (make-vector len '.notdef))) + (do + ((idx 0 (1+ idx))) + ((>= idx len) output-vector) + (vector-set! output-vector idx + (vector-ref latin1-coding-vector + (char->integer (string-ref str idx)))))))