-;;;; 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
-;; encoding.ly:
-;; #(display (reencode-string "adobe" "latin1" "hellö fóebär"))
-;;
-
-
-(define-public (read-encoding-file filename)
- "Read .enc file, return (COMMAND-NAME . VECTOR-OF-SYMBOLS)."
- (let* ((raw (ly:kpathsea-gulp-file filename))
- (string (regexp-substitute/global #f "%[^\n]*" raw 'pre "" 'post))
- (command (match:substring
- (string-match "/([^ \t\n\r]*)[ \t\n\r]+[[]" string) 1))
- (encoding (match:substring (string-match "[[](.*)[]]" string) 1))
- (ps-lst (string-tokenize encoding))
- (lst (map (lambda (x) (string->symbol (substring x 1))) ps-lst))
- (vector (list->vector lst)))
- (cons command 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 mapping str)
- "Apply MAPPING, a vector of [0..256) -> char, to STR"
- (string-map (lambda (chr)
- (vector-ref mapping (char->integer chr)))
- str))
-
-(define-public (make-encoding-mapping input-encoding output-encoding)
- "Contruct a mapping by applying output-encoding after input-encoding "
- (list->vector
- (map
- (lambda (byte)
- (let ((new-char (hash-ref
- output-encoding (vector-ref input-encoding byte) #f)))
- ;;input-encoding (vector-ref output-encoding byte) #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* ((coding (read-encoding-file filename))
- (com (car coding))
- (vec (cdr coding))
- (tab (make-encoding-table vec)))
- (list com vec tab)))
-
-;; coding-alist maps NAME -> (list FILENAME COMMAND VECTOR TAB)
-(define coding-alist
-
- (map (lambda (x)
- (cons (car x)
- (cons (cdr 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.enc") ;; cminch
- ("TeX-math-italic" . "aae443f0.enc") ;; cmmi10
- ("TeX-extended-ASCII" . "d9b29452.enc")
- ("TeX-text" . "cmr.enc")
- ("TeX-text-without-f-ligatures" . "0ef0afca.enc")
- ("Extended-TeX-Font-Encoding---Latin" . "tex256.enc")
- ("AdobeStandardEncoding" . "8a.enc")
-
- ;; aliases
- ("T1" . "tex256.enc")
- ("adobe" . "8a.enc")
- ("latin1" . "cork.enc")
-
- ;; LilyPond.
- ("fetaBraces" . "feta-braces-a.enc")
- ("fetaNumber" . "feta-nummer10.enc")
- ("fetaMusic" . "feta20.enc")
- ("parmesanMusic" . "parmesan20.enc"))
- ))
-
-(define (get-coding coding-name)
- (let ((entry (assoc-get coding-name coding-alist)))
- (cons (car entry) (force (cdr entry)))))
-
-(define-public (get-coding-filename coding-name)
- (car (get-coding coding-name)))
-
-(define-public (get-coding-command coding-name)
- (cadr (get-coding coding-name)))
-
-(define-public (get-coding-vector coding-name)
- (caddr (get-coding coding-name)))
-
-(define-public (get-coding-table coding-name)
- (cadddr (get-coding coding-name)))
+;;;; 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)))))))
projects / lilypond.git / blobdiff