]> git.donarmstrong.com Git - lilypond.git/commitdiff
* scm/encoding.scm (read-encoding-file): split up large function,
authorHan-Wen Nienhuys <hanwen@xs4all.nl>
Tue, 6 Apr 2004 00:03:58 +0000 (00:03 +0000)
committerHan-Wen Nienhuys <hanwen@xs4all.nl>
Tue, 6 Apr 2004 00:03:58 +0000 (00:03 +0000)
leave caching to (delay)

* lily/lily-guile.cc (LY_DEFINE): typecheck argument.

ChangeLog
lily/lexer.ll
lily/lily-guile.cc
mf/feta-beugel.mf
scm/encoding.scm

index dae08f1149db05ef24ce407bdcfe3665f1346145..694db14fd50551158f21f6eed6ed3a9b0f3a18a2 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,10 @@
+2004-04-06  Han-Wen Nienhuys   <hanwen@xs4all.nl>
+
+       * 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  <janneke@gnu.org>
 
        * lily/my-lily-lexer.cc (set_encoding): New method.
index a70a1af4789f829d6f1af1e8fd2df2d241bd360b..2f7b7fd91d6dfeebe5a4fe803a1be0deb073f31c 100644 (file)
@@ -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"); 
index 5a259137fd6166e983dc08055aec3f8f033977e7..d2b9eec3205c7fc803e8ed9c06e53a2634be21e5 100644 (file)
@@ -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 ());
 }
 
index 02781144723cf33a67c222a121fd6b30332a558e..aafc1a690ec19a4a2b9da6c5c41d5e3c95122c48 100644 (file)
@@ -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: <bug-lilypond@gnu.org>;
     fi
 
index 3c377743078fda1b9ace6d22daf5ba1be5b02701..c0f9f5f3d66875881ed28f54c226831d87b97009 100644 (file)
 ;; #(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 <coding>.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))
     (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))))))
-