; ; ファイルのヘッダの出力 ; (defun outputFileHeader (scale line col) (format "%!/n%%BoundingBox: 45 45 /c /c/n" (plus 55 (fix (times 0.001 scale (- (* line 500) 100)))) (plus 55 (fix (times 0.001 scale (- (* col 500) 100))))) (princ "%! /KanjiEncoding [ % \x00 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 % \x20 0 1 2 3 4 5 6 7 8 0 0 0 0 0 0 0 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 % \x40 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 % \x60 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 0 0 0 0 0 0 0 0 0 0 0 % \x80 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 % \xA0 0 1 2 3 4 5 6 7 8 0 0 0 0 0 0 0 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 % \xC0 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 % \xE0 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 0 0 0 0 0 0 0 0 0 0 0 ] readonly def /KanjiSubEncoding { %\x00 /.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 %\x20 /.notdef /c21 /c22 /c23 /c24 /c25 /c26 /c27 /c28 /c29 /c2A /c2B /c2C /c2D /c2E /c2F /c30 /c31 /c32 /c33 /c34 /c35 /c36 /c37 /c38 /c39 /c3A /c3B /c3C /c3D /c3E /c3F %\x40 /c40 /c41 /c42 /c43 /c44 /c45 /c46 /c47 /c48 /c49 /c4A /c4B /c4C /c4D /c4E /c4F /c50 /c51 /c52 /c53 /c54 /c55 /c56 /c57 /c58 /c59 /c5A /c5B /c5C /c5D /c5E /c5F %\x60 /c60 /c61 /c62 /c63 /c64 /c65 /c66 /c67 /c68 /c69 /c6A /c6B /c6C /c6D /c6E /c6F /c70 /c71 /c72 /c73 /c74 /c75 /c76 /c77 /c78 /c79 /c7A /c7B /c7C /c7D /c7E /.notdef %\x80 /.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 %\xA0 /.notdef /c21 /c22 /c23 /c24 /c25 /c26 /c27 /c28 /c29 /c2A /c2B /c2C /c2D /c2E /c2F /c30 /c31 /c32 /c33 /c34 /c35 /c36 /c37 /c38 /c39 /c3A /c3B /c3C /c3D /c3E /c3F %\xC0 /c40 /c41 /c42 /c43 /c44 /c45 /c46 /c47 /c48 /c49 /c4A /c4B /c4C /c4D /c4E /c4F /c50 /c51 /c52 /c53 /c54 /c55 /c56 /c57 /c58 /c59 /c5A /c5B /c5C /c5D /c5E /c5F %\xE0 /c60 /c61 /c62 /c63 /c64 /c65 /c66 /c67 /c68 /c69 /c6A /c6B /c6C /c6D /c6E /c6F /c70 /c71 /c72 /c73 /c74 /c75 /c76 /c77 /c78 /c79 /c7A /c7B /c7C /c7D /c7E /.notdef } cvlit readonly def /T1NF { /newname exch def newname 20 dict def newname load begin /FontType 1 def /FontInfo 8 dict def FontInfo begin /version (001.001) readonly def /FullName (PROLKANJI) readonly def /FamilyName (PROLKANJI) readonly def /Weight (Medium) readonly def /ItalicAngle 0 def /isFixedPitch false def /UnderlinerPosition 0 def /UnderlineThichness 0 def end %/FontMatrix [.001 0 0 .001 0 0] def /FontMatrix [.001 0 0 .001 0 -0.16] def /FontBBox [0 0 1000 1000] def /Encoding KanjiSubEncoding def /CharStrings 256 dict def CharStrings /.notdef <10bf317079ca388fe763> put /FontName newname def /PaintType 0 def /UniqueId 9876 def /Private 8 dict def Private begin /BlueValues [] def /password 5839 def end end newname dup dup load definefont %[lw-h 0 0 lw-v 0 0] makefont def } def /T0NF { /newname exch def /fdepvector exch def newname 20 dict def newname load begin /FontType 0 def /FontMatrix [1 0 0 1 0 0] def /FMapType 2 def /Encoding KanjiEncoding def /FDepVector fdepvector def /FontName newname def /UniqueId 9876 def end newname dup dup load definefont def } def /T1D { 2 dict begin /ch-code exch def /ch-data exch def currentfont /CharStrings get ch-code ch-data put } def /CompNF { /newname1 exch def newname1 dup length string cvs /str exch def str length /len exch def /fdepvector 78 array def /j 1 def 16#21 1 16#74 { /i exch def KanjiEncoding i get 0 gt { len 4 add string /newstr exch def newstr 0 str putinterval newstr len (.r) putinterval newstr len 2 add i 16 2 string cvrs putinterval newstr cvn /newlit exch def newlit T1NF /newfont newlit findfont def fdepvector j newfont put /j j 1 add def } if } for fdepvector 0 fdepvector 1 get put /j 0 def fdepvector newname1 T0NF } def /CompD { 20 dict begin /code exch def /charstr exch def code 0 get /high exch def code 1 get /low exch def currentfont /Encoding get high get /index exch def currentfont /FDepVector get index get /lowfont exch def lowfont /Encoding get low get /tmpkey exch def lowfont /CharStrings get tmpkey charstr put end } def /show1 {false charpath 0 setlinewidth stroke} def " ) ) ; ; ページごとのヘッダの出力 ; (defun outputPageHeader (page psfile printfile scale ) (lets ((date (date-time))) (format "50 50 translate/n0.001 /c mul dup scale/n" scale) (format "//Helvetica findfont 70 scalefont setfont/n") (and printfile (format "0 -70 moveto (/c-/c-/c /c:/c File: /c Page: /c) show/n" (substring date 0 2) (substring date 2 4)(substring date 4 6) (substring date 6 8)(substring date 8 10) psfile page)) (format "//Wadalab-mincho-10 CompNF/n") (format "//Wadalab-mincho-10 findfont 400 scalefont setfont/n"))) ; ; ファイルの生成 ; (defun out-to-ps-all (outlines tag psfile (nameflag) (col 9)(line (fix (times 0.67 col))) (printfile t)) (lets ((standard-output (outopen (stream psfile))) (scale (fix (times 160.0 (min (//$ 9.0 (float col)) (//$ 6.0 (float line)))))) (ii nil)(jj nil)(page nil)(last nil) (skeleton)(hints)(type1)(kstr) (next nil)(nextnext nil)(x1 nil)(y1 nil)(x2 nil)(y2 nil)) (outputFileHeader scale line col) (setq ii 0 jj 0 page 1) (outputPageHeader page psfile printfile scale) (do ((ol outlines (cdr ol)) (l nil)) ((atom ol)) (princ ";" terminal-output) ; (princ (gccount) terminal-output) (print (car ol) terminal-output) (setq l (let ((err:argument-type #'(lambda (x (y))(throw 'err))) (err:number-of-arguments #'(lambda (x (y))(throw 'err))) (err:unbound-variable #'(lambda (x (y))(throw 'err))) (err:undefined-function #'(lambda (x (y))(throw 'err))) (err:zero-division #'(lambda (x (y))(throw 'err)))) (catch 'err (skeleton2list (setq skeleton (normkanji (rm-limit (applykanji (car ol) tag)))) tag)))) (cond ((atom l) (format "0 setlinewidth newpath 0 0 moveto 400 0 lineto/n") (format "400 400 lineto 0 400 lineto 0 0 lineto stroke/n") ) (t (format "0 setlinewidth newpath 0 0 moveto 400 0 lineto/n") (format "400 400 lineto 0 400 lineto 0 0 lineto stroke/n") (setq hints (type1hints skeleton tag)) (setq type1 (out2type1 (makeoutline l) hints)) (cond ((and (= 2 (string-length (car ol))) (logand 128 (sref (car ol) 0))) (setq kstr (long-hex-image (plus (logand 127 (sref (car ol) 1)) (times 256 (logand 127 (sref (car ol) 0))))))) ((and (= 7 (string-length (car ol))) (string-equal (substring (car ol) 0 2) "1-")) (setq kstr (long-hex-image (plus (logand 127 (plus 32 (number-value (substring (car ol) 5 7)))) (times 256 (logand 127 (plus 32 (number-value (substring (car ol) 2 4))))))))) (t (setq kstr "2121"))) (princ type1) (format " CompD/n" kstr) (format "0 70 moveto show/n" kstr))) (setq ii (1+ ii)) (cond ((eq ii col) (format "500 /c translate/n" (* -500 (1- col))) (setq ii 0) (setq jj (1+ jj)) (cond ((and (eq jj line)(consp (cdr ol))) (format "showpage/n") (setq page (1+ page)) (outputPageHeader page psfile printfile scale) (setq jj 0)))) (t (format "0 500 translate/n")))) (format "showpage/n")))