[wadalabfont-kit] / renderer / apply.l  

Diff of /renderer/apply.l

Parent Directory | Revision Log

version 1.5, Tue Jul 1 08:46:45 2003 UTC version 1.7, Thu Jul 3 02:01:26 2003 UTC
Line 1 
Line 1 
 ;(cond ((definedp 'init_window))  
 ;      (t (code-load "window.o" "-lX11")))  
 ; ライブラリをexfileする  
 ;(cond ((definedp 'kanjilib))  
 ;      (t (exfile 'lib.l)))  
 ;  
 ;(cond ((definedp 'unpackprim))  
 ;       (t (exfile 'pack.l)))  
 ; bez  
 ; Bezier曲線を直線群で近似する  
 ;  
 (defun bez (x0 y0 x1 y1 x2 y2 x3 y3 (dlist))  
   (lets ((maxx (max x0 x1 x2 x3))  
          (maxy (max y0 y1 y2 y3))  
          (minx (min x0 x1 x2 x3))  
          (miny (min y0 y1 y2 y3)))  
     (cond  
      ((or (lessp (difference maxx minx) 2)  
           (lessp (difference maxy miny) 2))  
       `((,(fix x3) . ,(fix y3)).,dlist))  
      (t  
       (lets ((tempx (times 0.125 (plus x0 (times 3 x1)(times 3 x2) x3)))  
              (tempy (times 0.125 (plus y0 (times 3 y1)(times 3 y2) y3))))  
         (bez tempx tempy  
              (times (plus x3 x2 x2 x1) 0.25)  
              (times (plus y3 y2 y2 y1) 0.25)  
              (times (plus x3 x2) 0.5)  
              (times (plus y3 y2) 0.5)  
              x3 y3  
              (bez x0 y0  
                   (times (plus x0 x1) 0.5)  
                   (times (plus y0 y1) 0.5)  
                   (times (plus x0 x1 x1 x2) 0.25)  
                   (times (plus y0 y1 y1 y2) 0.25)  
                   tempx tempy dlist)))))))  
 ;  
 ; アウトラインから折れ線への変換を行なう  
 ;  
   
 (defun setpart1 (l)  
   (and l  
   (lets ((last (car l))  
          (curx (cadr last))  
          (cury (caddr last))  
          (x0)(y0)(x1)(y1)(x2)(y2)  
          (ret `((,(fix curx).,(fix cury)))))  
     (do ((ll (cdr l) (cdr ll)))  
       ((atom ll)ret)  
       (match ll  
         ((('angle x0 y0).next)  
          (setq ret `((,(fix x0).,(fix y0)).,ret))  
          (setq curx x0 cury y0))  
         ((('bezier x0 y0)('bezier x1 y1))  
          (exit (bez curx cury x0 y0 x1 y1 (cadr last)(caddr last) ret)))  
         ((('bezier x0 y0)('bezier x1 y1)('angle x2 y2).next)  
          (setq ret (bez curx cury x0 y0 x1 y1 x2 y2 ret))  
          (setq curx x2 cury y2)  
          (setq ll (cddr ll)))  
         (any (break) ; 想定しない入力  
              ))))))  
 ;  ;
 ; スケルトンからアウトラインへの変換を行なう  ; スケルトンからアウトラインへの変換を行なう
 ;  ;
   
   ;
   ; pointsのn番目を取り，floatに変換する
   ;
 (defun point-n (n points)  (defun point-n (n points)
   (let ((point (nth n points)))    (let ((point (nth n points)))
     `(,(float (car point)),(float (cadr point)) .,(cddr point))))      `(,(float (car point)),(float (cadr point)) .,(cddr point))))
   
   ;
   ; points全体をfloatに変換する
   ;
 (defun floatlist (list)  (defun floatlist (list)
   (mapcar list    (mapcar list
     (function (lambda (x) `(,(float (car x)),(float (cadr x)).,(cddr x))))))      (function (lambda (x) `(,(float (car x)),(float (cadr x)).,(cddr x))))))
   ;
   ; 見てのとおり
   ;
 (defun appendrev (a b) (append a (reverse b)))  (defun appendrev (a b) (append a (reverse b)))
   ;
   ;
   ;
 (defun skeleton2list (l tag)  (defun skeleton2list (l tag)
     ; 仮想的なエレメント xlimit, ylimitを取り除く
   (setq l (rm-limit l))    (setq l (rm-limit l))
     ; 書体固有のスケルトン変形関数が定義されている場合は呼び出す
   (let ((func (get-def 'typehook tag)))    (let ((func (get-def 'typehook tag)))
     (and func (setq l (funcall func l))))      (and func (setq l (funcall func l))))
   (let ((linkpoints nil)    (let ((linkpoints nil)
Line 100 
Line 54 
         ((atom lll))          ((atom lll))
 ;       (push (point-n  (car lll) points) partpoint)  ;       (push (point-n  (car lll) points) partpoint)
         (push (nth (car lll) points) partpoint))          (push (nth (car lll) points) partpoint))
         (setq partpoint (nreverse partpoint))
   
 ;; tag に対するプロパティが未定義のときのため(石井)  ;; tag に対するプロパティが未定義のときのため(石井)
 ;; if を使わないように直す(田中)  ;; if を使わないように直す(田中)
Line 107 
Line 62 
             (lets ((funcname (get-def type tag))              (lets ((funcname (get-def type tag))
                    (result (cond (funcname                     (result (cond (funcname
                                   (funcall funcname                                    (funcall funcname
                                            (nreverse partpoint)(cddr part)))                                             partpoint(cddr part)))
                                  (t                                   (t
                                   (print (list 'undefined tag))                                    (print (list 'undefined tag))
                                   (funcall (get type 'mincho)                                    (funcall (get type 'mincho)
                                            (nreverse partpoint)(cddr part))))))                                             partpoint(cddr part))))))
               `(lines ,result)))                `(lines ,result)))
   
       (push tmpline linelist)        (push tmpline linelist)
Line 925 
Line 880 
                      (*$ 0.5 sqrt51 costheta)                       (*$ 0.5 sqrt51 costheta)
                      (*$ 0.5 sqrt35 cosfai))))))                       (*$ 0.5 sqrt35 cosfai))))))
   
   ;
   ; Gauss-Seidel 法により三重対角行列の解を求めているが，
   ; 優対角行列でない場合は問題があり
   ; LU分解の方が良い?
   ;
 (defun gs (n array x b)  (defun gs (n array x b)
   (do ((i 0 (1+ i)))    (do ((i 0 (1+ i)))
     ((> i 10))      ((> i 10))

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

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help