summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/source/latex/otibet/pl2ovp.scm
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/source/latex/otibet/pl2ovp.scm')
-rw-r--r--Master/texmf-dist/source/latex/otibet/pl2ovp.scm166
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