[wadalabfont-kit] / renderer / out2ps.l  

Diff of /renderer/out2ps.l

Parent Directory | Revision Log

version 1.6, Thu Jul 3 02:01:26 2003 UTC version 1.8, Tue Aug 26 07:06:51 2003 UTC
Line 1 
Line 1 
 ;  ;
 ; $B%U%!%$%k$N%X%C%@$N=PNO(B  ; ファイルのヘッダの出力
 ;  ;
   
 (defun outputFileHeader (scale line col)  (defun outputFileHeader (scale line col)
Line 117 
Line 117 
 /CharStrings 256 dict def CharStrings /.notdef <10bf317079ca388fe763> put  /CharStrings 256 dict def CharStrings /.notdef <10bf317079ca388fe763> put
 /FontName newname def  /FontName newname def
 /PaintType 0 def  /PaintType 0 def
 /UniqueId 9876 def  /UniqueID 9876 def
 /Private 8 dict def  /Private 8 dict def
 Private begin  Private begin
 /BlueValues [] def  /BlueValues [] def
Line 140 
Line 140 
 /Encoding KanjiEncoding def  /Encoding KanjiEncoding def
 /FDepVector fdepvector def  /FDepVector fdepvector def
 /FontName newname def  /FontName newname def
 /UniqueId 9876 def  /UniqueID 9876 def
 end  end
 newname dup dup load definefont  newname dup dup load definefont
 def  def
Line 196 
Line 196 
 )  )
 )  )
 ;  ;
 ; $B%Z!<%8$4$H$N%X%C%@$N=PNO(B  ; ページごとのヘッダの出力
 ;  ;
 (defun outputPageHeader (page psfile printfile scale )  (defun outputPageHeader (page psfile printfile scale )
   (lets ((date (date-time)))    (lets ((date (date-time)))
Line 211 
Line 211 
     (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  (defun out-to-ps-all (outlines tag psfile
                                (nameflag)                                 (nameflag)
Line 228 
Line 228 
     (outputPageHeader page psfile printfile scale)      (outputPageHeader page psfile printfile scale)
     (do      (do
         ((ol outlines (cdr ol))          ((ol outlines (cdr ol))
          (l nil))           (l nil)(kanji))
       ((atom ol))        ((atom ol))
         (setq kanji (car ol))
       (princ ";" terminal-output)        (princ ";" terminal-output)
 ;     (princ (gccount) terminal-output)  ;     (princ (gccount) terminal-output)
       (print (car ol) terminal-output)        (print kanji terminal-output)
       (setq l        (setq l
             (let ((err:argument-type #'(lambda (x (y))(throw 'err)))              (cond ((eq kanji '　) nil) ; スペース
                   (err:number-of-arguments #'(lambda (x (y))(throw 'err)))                    ((not (boundp kanji)) nil)
                   (err:unbound-variable #'(lambda (x (y))(throw 'err)))                    (t
                   (err:undefined-function #'(lambda (x (y))(throw 'err)))                     (let (
                   (err:zero-division #'(lambda (x (y))(throw 'err))))  ;                 (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                (catch 'err
                 (skeleton2list (setq skeleton (normkanji (rm-limit (applykanji (car ol) tag)))) tag))))                         (skeleton2list (setq skeleton (normkanji (rm-limit (applykanji kanji tag)))) tag))))))
       (cond        (cond
        ((atom l)         ((atom l)
         (format "0 setlinewidth newpath 0 0 moveto 400 0 lineto/n")          (format "0 setlinewidth newpath 0 0 moveto 400 0 lineto/n")
Line 251 
Line 257 
         (format "400 400 lineto 0 400 lineto 0 0 lineto stroke/n")          (format "400 400 lineto 0 400 lineto 0 0 lineto stroke/n")
         (setq hints (type1hints skeleton tag))          (setq hints (type1hints skeleton tag))
         (setq type1 (out2type1 (makeoutline l) hints))          (setq type1 (out2type1 (makeoutline l) hints))
         (cond ((and (= 2 (string-length (car ol)))          (cond ((and (= 2 (string-length kanji))
                     (logand 128 (sref (car ol) 0)))                      (logand 128 (sref kanji 0)))
                (setq kstr (long-hex-image                 (setq kstr (long-hex-image
                            (plus (logand 127 (sref (car ol) 1))                             (plus (logand 127 (sref kanji 1))
                                  (times 256 (logand 127 (sref (car ol) 0)))))))                                   (times 256 (logand 127 (sref kanji 0)))))))
               ((and (= 7 (string-length (car ol)))                ((and (= 7 (string-length kanji))
                     (string-equal (substring (car ol) 0 2) "1-"))                      (string-equal (substring kanji 0 2) "1-"))
                (setq kstr                 (setq kstr
                      (long-hex-image                       (long-hex-image
                       (plus (logand 127 (plus 32 (number-value (substring (car ol) 5 7))))                        (plus (logand 127 (plus 32 (number-value (substring kanji 5 7))))
                             (times 256 (logand 127 (plus 32 (number-value (substring (car ol) 2 4)))))))))                              (times 256 (logand 127 (plus 32 (number-value (substring kanji 2 4)))))))))
                (t                 (t
                (setq kstr "2121")))                 (setq kstr "2121")))
         (princ type1)          (princ type1)
Line 269 
Line 275 
         (format "0 70 moveto </c> show/n" kstr)))          (format "0 70 moveto </c> show/n" kstr)))
       (setq ii (1+ ii))        (setq ii (1+ ii))
       (cond ((eq ii col)        (cond ((eq ii col)
                (gc)
              (format "500 /c translate/n" (* -500 (1- col)))               (format "500 /c translate/n" (* -500 (1- col)))
              (setq ii 0)               (setq ii 0)
              (setq jj (1+ jj))               (setq jj (1+ jj))

Generate output suitable for use with a patch program
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.8
ktanaka

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help