From b5b249fde31cff02afe9e776986a39bd73dde0be Mon Sep 17 00:00:00 2001 From: Han-Wen Nienhuys Date: Tue, 6 Apr 2004 00:03:58 +0000 Subject: [PATCH] * scm/encoding.scm (read-encoding-file): split up large function, leave caching to (delay) * lily/lily-guile.cc (LY_DEFINE): typecheck argument. --- ChangeLog | 7 +++ lily/lexer.ll | 2 +- lily/lily-guile.cc | 1 + mf/feta-beugel.mf | 2 +- scm/encoding.scm | 150 +++++++++++++++++++++++++++++---------------- 5 files changed, 106 insertions(+), 56 deletions(-) diff --git a/ChangeLog b/ChangeLog index dae08f1149..694db14fd5 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,10 @@ +2004-04-06 Han-Wen Nienhuys + + * scm/encoding.scm (read-encoding-file): split up large function, + leave caching to (delay) + + * lily/lily-guile.cc (LY_DEFINE): typecheck argument. + 2004-04-05 Jan Nieuwenhuizen * lily/my-lily-lexer.cc (set_encoding): New method. diff --git a/lily/lexer.ll b/lily/lexer.ll index a70a1af478..2f7b7fd91d 100644 --- a/lily/lexer.ll +++ b/lily/lexer.ll @@ -488,7 +488,7 @@ HYPHEN -- return MARKUP_HEAD_SCM0_MARKUP1; else if (tag == ly_symbol2scm ("scheme0-scheme1-markup2")) return MARKUP_HEAD_SCM0_SCM1_MARKUP2; - else if (tag ==4 ly_symbol2scm ("scheme0-scheme1-scheme2")) + else if (tag == ly_symbol2scm ("scheme0-scheme1-scheme2")) return MARKUP_HEAD_SCM0_SCM1_SCM2; else { programming_error ("No parser tag defined for this signature. Abort"); diff --git a/lily/lily-guile.cc b/lily/lily-guile.cc index 5a259137fd..d2b9eec320 100644 --- a/lily/lily-guile.cc +++ b/lily/lily-guile.cc @@ -107,6 +107,7 @@ LY_DEFINE (ly_gulp_file, "ly:gulp-file", "Read the file @var{name}, and return its contents in a string. " "The file is looked up using the search path.") { + SCM_ASSERT_TYPE (gh_string_p (name), name, SCM_ARG1, __FUNCTION__, "string"); return scm_makfrom0str (gulp_file_to_string (ly_scm2string (name)).to_str0 ()); } diff --git a/mf/feta-beugel.mf b/mf/feta-beugel.mf index 0278114472..aafc1a690e 100644 --- a/mf/feta-beugel.mf +++ b/mf/feta-beugel.mf @@ -94,7 +94,7 @@ for i := 0 step 1 until font_count: y := y + increment; if y > infinity/hppp: - message "Resolution/magnification is too high"; + message "Resolution and/or magnification is too high"; error please report: ; fi diff --git a/scm/encoding.scm b/scm/encoding.scm index 3c37774307..c0f9f5f3d6 100644 --- a/scm/encoding.scm +++ b/scm/encoding.scm @@ -11,59 +11,109 @@ ;; #(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")) +(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)) - (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))))) - -(define (get-coding-vector coding) - (let ((entry (assoc-get coding encoding-alist #f))) - (if entry (car entry) - (car (read-coding-file coding))))) + (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)) @@ -72,11 +122,3 @@ (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)))))) - -- 2.39.2