[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.7, Thu Jul 3 11:42:38 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 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.7
ktanaka

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help