View of /renderer/out2ps.lView of /renderer/out2ps.l
Parent Directory
| 
Revision Log
*** empty log message ***
;
; ファイルのヘッダの出力
;
(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)(kanji))
((atom ol))
(setq kanji (car ol))
(princ ";" terminal-output)
; (princ (gccount) terminal-output)
(print kanji terminal-output)
(setq l
(cond ((eq kanji ' ) nil) ; スペース
((not (boundp kanji)) nil)
(t
(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 kanji 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 kanji))
(logand 128 (sref kanji 0)))
(setq kstr (long-hex-image
(plus (logand 127 (sref kanji 1))
(times 256 (logand 127 (sref kanji 0)))))))
((and (= 7 (string-length kanji))
(string-equal (substring kanji 0 2) "1-"))
(setq kstr
(long-hex-image
(plus (logand 127 (plus 32 (number-value (substring kanji 5 7))))
(times 256 (logand 127 (plus 32 (number-value (substring kanji 2 4)))))))))
(t
(setq kstr "2121")))
(princ type1)
(format " </c> CompD/n" kstr)
(format "0 70 moveto </c> show/n" kstr)))
(setq ii (1+ ii))
(cond ((eq ii col)
(gc)
(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")))
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |