(defun rm-limit (prim) |
; |
(do ((l (cadr prim) (cdr l))(ret)) |
; $B%U%!%$%k$N%X%C%@$N=PNO(B |
((atom l)`(,(car prim) ,(nreverse ret).,(cddr prim))) |
; |
(or (memq (caar l) '(xlimit ylimit)) |
|
(push (car l) ret)))) |
(defun outputFileHeader (scale line col) |
(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) |
|
(date (date-time))) |
|
(format "%!/n%%BoundingBox: 45 45 /c /c/n" |
(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 (- (* line 500) 100)))) |
(plus 55 (fix (times 0.001 scale (- (* col 500) 100))))) |
(plus 55 (fix (times 0.001 scale (- (* col 500) 100))))) |
(lets ((s (inopen (stream "../psfiles/compfont.ps"))) |
(princ |
(err:end-of-file #'(lambda (x (y))(throw 'eof)))) |
"%! |
(catch 'eof (loop (princ (readline s))(terpri)))) |
/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 |
|
" |
|
) |
|
) |
|
; |
|
; $B%Z!<%8$4$H$N%X%C%@$N=PNO(B |
|
; |
|
(defun outputPageHeader (page psfile printfile scale ) |
|
(lets ((date (date-time))) |
(format "50 50 translate/n0.001 /c mul dup scale/n" scale) |
(format "50 50 translate/n0.001 /c mul dup scale/n" scale) |
(format "//Helvetica findfont 70 scalefont setfont/n") |
(format "//Helvetica findfont 70 scalefont setfont/n") |
(setq ii 0 jj 0 page 1) |
|
(and printfile |
(and printfile |
(format "0 -70 moveto (/c-/c-/c /c:/c File: /c Page: /c) show/n" |
(format "0 -70 moveto (/c-/c-/c /c:/c File: /c Page: /c) show/n" |
(substring date 0 2) |
(substring date 0 2) |
(substring date 6 8)(substring date 8 10) |
(substring date 6 8)(substring date 8 10) |
psfile page)) |
psfile page)) |
(format "//Wadalab-mincho-10 CompNF/n") |
(format "//Wadalab-mincho-10 CompNF/n") |
(format "//Wadalab-mincho-10 findfont 400 scalefont setfont/n") |
(format "//Wadalab-mincho-10 findfont 400 scalefont setfont/n"))) |
|
; |
|
; $B%U%!%$%k$N@8@.(B |
|
; |
|
(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 |
(do |
((ol outlines (cdr ol)) |
((ol outlines (cdr ol)) |
(l nil)) |
(l nil)) |
(setq jj (1+ jj)) |
(setq jj (1+ jj)) |
(cond ((and (eq jj line)(consp (cdr ol))) |
(cond ((and (eq jj line)(consp (cdr ol))) |
(format "showpage/n") |
(format "showpage/n") |
(format "50 50 translate/n") |
|
(format "0.001 /c mul dup scale/n" scale) |
|
(format "//Helvetica findfont 70 scalefont setfont/n") |
|
(setq page (1+ page)) |
(setq page (1+ page)) |
(and printfile |
(outputPageHeader page psfile printfile scale) |
(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") |
|
(setq jj 0)))) |
(setq jj 0)))) |
(t (format "0 500 translate/n")))) |
(t (format "0 500 translate/n")))) |
(format "showpage/n"))) |
(format "showpage/n"))) |