X-Git-Url: https://git.donarmstrong.com/?a=blobdiff_plain;f=scm%2Fencoding.scm;h=bebf515b6b83ac4df03b2408c2a284bfa2a0eef6;hb=90e4d7057f3857da049dfda3d130017d4719bd6b;hp=c0f9f5f3d66875881ed28f54c226831d87b97009;hpb=b5b249fde31cff02afe9e776986a39bd73dde0be;p=lilypond.git

diff --git a/scm/encoding.scm b/scm/encoding.scm
index c0f9f5f3d6..bebf515b6b 100644
--- a/scm/encoding.scm
+++ b/scm/encoding.scm
@@ -1,124 +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 <janneke@gnu.org>
-
-;; 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 (read-encoding-file filename)
-  "Read .enc file, returning a vector of symbols."
-  (let* ((raw (ly:gulp-file filename))
-	 (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)))
-
-    vector))
-
-(define (make-encoding-table encoding-vector)
-  "Return a hash table mapping names to chars. ENCODING-VECTOR is a
-vector of symbols."
-
-  (let* ((h (make-hash-table 256)))
-    
-    (for-each
-     (lambda (i)
-       (hash-set! h (vector-ref encoding-vector i)
-		  (integer->char i)))
-     (iota 256))
-
-    h))
-
-(define-public (reencode-string permutation str)
-  "Apply PERMUTATION (a vector of [0..256) -> [0..256) to STR"
-  (string-map (lambda (chr)
-		(vector-ref permutation (char->integer chr)))
-	      str))
-
-(define-public (encoding-permutation input-encoding
-				     output-encoding)
-
-  "Contruct a permutation by applying output-encoding after input-encoding "
-  (list->vector
-   (map
-    (lambda (chr)
-      (let*
-	  ((new-char (hash-ref output-encoding
-			       (vector-ref input-encoding (char->integer chr)) #f)))
-
-	;; substitute space for unknown characters.
-	(if (char? new-char)
-	    new-char
-	    #\ )))
-    (iota 256))))
-
-
-(define (get-coding-from-file filename)
-  "Read FILENAME, return a list containing encoding vector and table"
-  
-  (let*
-      ((vec (read-encoding-file filename))
-       (tab (make-encoding-table vec)))
-    (list vec tab)))
-
-
-
-;; coding-alist maps NAME -> (list VECTOR TAB)
-(define coding-alist
-  
-  (map (lambda (x)
-	 (cons (car x)
-	       (delay (get-coding-from-file (cdr x)))))
-       
-       '(
-	 ;; 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 (get-coding coding-name)
-  (force (assoc-get coding-name coding-alist )))
-
-(define (get-coding-vector coding-name)
-  (car (get-coding coding-name)))
-
-(define (get-coding-table coding-name)
-  (cadr (get-coding coding-name)))
-
-
-;;; what's this for? --hwn
-(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)))
-
+;;;; Copyright (C) 2004--2015 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;;
+;;;; 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 <http://www.gnu.org/licenses/>.
+
+(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 (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)))))))