diff options
Diffstat (limited to 'Master/texmf-dist/source/latex/otibet/pl2ovp.scm')
| -rw-r--r-- | Master/texmf-dist/source/latex/otibet/pl2ovp.scm | 166 |
1 files changed, 166 insertions, 0 deletions
diff --git a/Master/texmf-dist/source/latex/otibet/pl2ovp.scm b/Master/texmf-dist/source/latex/otibet/pl2ovp.scm new file mode 100644 index 00000000000..7dada025d74 --- /dev/null +++ b/Master/texmf-dist/source/latex/otibet/pl2ovp.scm @@ -0,0 +1,166 @@ +;; +;; pl2ovp.scm +;; (c) Norbert Preining 1997 +;; This file is part of the otibet-package. +;; +;; Converting pl to ovp file with a certain shift amount. +;; The FontDesignSize of the ovp-file can be given, also +;; the FONTAT value of the FONTMAP entry +;; +;; IMPORTANT: LIGTABLE will be deleted (at the moment)!!!!!! +;; +;; Provides: +;; (pl->ovp pl-filename ovp-filename shift ovp-designsize pl-at) +;; +;; pl-filename The name (with or without extansion) of the input +;; ovp-filename The name (with or without extension) of the output +;; shift The value a character in pl-filename will be shifted +;; e.g.: in pl: (CHARACTER H 23 ...) +;; shift = (hex->dec "1000") +;; -> in ovp (CHARACTER H 1023 ... SETCHAR H 23 ...) +;; ovp-designsize (DESIGNSIZE ...) +;; pl-at (MAPFONT D 0 ...(FONTAT ...)) +;; +(load 'convnum.scm) + +(define (convert-to-dec number mode) + (let ((num (if (number? number) + (number->string number) + (symbol->string number)))) + (case (string-ref mode 0) + (#\H (hex->dec num)) + (#\O (oct->dec num)) + (#\C (char->integer (string-ref num 0)))))) + +(define (list->sentence low) + (if (= (length low) 1) + (if (number? (car low)) + (number->string (car low)) + (symbol->string (car low))) + (string-append (if (number? (car low)) + (number->string (car low)) + (symbol->string (car low))) + " " + (list->sentence (cdr low))))) + +(define nextitem '()) +(define pl-fontdsize "") + +;; +;; pl-read-header +;; +;; liest den pl-file header bis zum ersten CHARACTER ein +;; LIGTABLE wird geloescht!!! +(define (pl-read-header inf outf designsize) + (let ((ni (if (= (length nextitem) 0) + (let ((tmp (read inf))) + (if (eof-object? tmp) + (error 'pl-read-header "Cannot read from Infile") + tmp)) + nextitem))) + (let ((tag (symbol->string (car ni)))) + (cond + ((or (string=? tag "FAMILY") + (string=? tag "COMMENT")) + (format outf "~a~%" ni) + (set! nextitem '()) + (pl-read-header inf outf designsize)) + ((string=? tag "FONTDIMEN") + (set! nextitem '()) + (format outf "(FONTDIMEN~%~a )~%" + (list-entries->string (cdr ni) " ")) + (pl-read-header inf outf designsize)) + ((string=? tag "DESIGNSIZE") + (set! nextitem '()) + (set! pl-fontdsize (number->string (caddr ni))) + (format outf "(DESIGNSIZE R ~a)~%" designsize) + (pl-read-header inf outf designsize)) + ((string=? tag "CODINGSCHEME") + (format outf "(CODINGSCHEME SHIFTED ~a)~%" (list->sentence (cdr ni))) + (set! nextitem '()) + (pl-read-header inf outf designsize)) + ((string=? tag "CHARACTER") + (set! nextitem ni)) + (else + (set! nextitem '()) + (pl-read-header inf outf designsize)))))) + + +(define (ovp-write-font-mapping outf fontname fontat fontdsize) + (format outf "(MAPFONT D 0~% (FONTNAME ~a)~% (FONTAT R ~a)~% (FONTDSIZE R ~a)~% )~%" fontname fontat fontdsize)) + +(define (list-entries->string lst head) + (if (= (length lst) 0) + "" + (string-append (format #f "~a~a~%" head (car lst)) + (list-entries->string (cdr lst) head)))) + +(define (pl-read-character inf outf shift) + (let ((ni (if (= (length nextitem) 0) + (read inf) + nextitem))) + (if (eof-object? ni) + #t + (letrec ((tag (symbol->string (car ni))) + (mode (symbol->string (cadr ni))) + (val (caddr ni)) + (decval (convert-to-dec val mode)) + (rs (if (number? shift) shift + (let ((tmp (string->number shift))) + (if (integer? tmp) tmp + (error 'pl-read-character "Shift not an integer: ~a." shift))))) + (restlst (cdddr ni))) + (if (not (string=? tag "CHARACTER")) + (error 'pl-read-character "Tag ~a wrong, not CHARACTER." tag) + (begin + (format outf + "(~a H ~a~%~a (MAP~% (SELECTFONT D 0)~% (SETCHAR ~a ~a)~% )~% )~%" + tag + (dec->hex (+ decval rs)) + (list-entries->string restlst " ") + mode + val) + (set! nextitem '()) + (pl-read-character inf outf shift))))))) + +(define (basename file ext) + (letrec ((fl (string-length file)) + (el (string-length ext)) + (bi (- fl el)) + (ei fl)) + (begin + (if (string=? (substring file bi ei) ext) + (substring file 0 bi) + file)))) + +;; +;; MAIN FUNCTION +;; +;; pl->ovp pl-filename ovp-filename shift ovp-designsize pl-at +;; +;; pl-filename The name (with or without extansion) of the input +;; ovp-filename The name (with or without extension) of the output +;; shift The value a character in pl-filename will be shifted +;; e.g.: in pl: (CHARACTER H 23 ...) +;; shift = (hex->dec "1000") +;; -> in ovp (CHARACTER H 1023 ... SETCHAR H 23 ...) +;; ovp-designsize (DESIGNSIZE ...) +;; pl-at (MAPFONT D 0 ...(FONTAT ...)) +;; +(define (pl->ovp pl-filename ovp-filename shift ovp-designsize pl-at) + (letrec ((ifnb (basename pl-filename ".pl")) + (ofnb (basename ovp-filename ".ovp")) + (ifn (string-append ifnb ".pl")) + (ofn (string-append ofnb ".ovp")) + (inf (open-input-file ifn)) + (outf (open-output-file ofn))) + (pl-read-header inf outf ovp-designsize) + (ovp-write-font-mapping outf + ifnb + pl-at + pl-fontdsize) + (pl-read-character inf outf shift) + (close-input-port inf) + (close-output-port outf))) + +; eof
\ No newline at end of file |