[wadalabfont-kit] / lisp / disp.l

Diff of /lisp/disp.l

-version 1.4, Mon Jun 30 13:24:32 2003 UTC
+version 1.5, Thu Jul  3 02:01:26 2003 UTC
  Line 241
  Line 241
  Line 241
      (do ((l elements (cdr l)))
        ((atom l)`(,(car x) ,(nreverse ret) .,(cddr x)))
        (or (memq (caar l) '(xlimit ylimit))(push (car l) ret)))))
+ ;
+ ; 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) ; 想定しない入力
+              ))))))
+ (defun jointtest (prim1 prim2 affine type)
+   (filltest
+    (rmlimit (appendpart prim1
+                (affinepart prim2 affine))) type))

-Generate output suitable for use with a patch program
+Legend:



Removed from v.1.4
 


changed lines


 
Added in v.1.5
 Legend:



Removed from v.1.4
 


changed lines


 
Added in v.1.5
-Removed from v.1.4
+Added in v.1.5

ktanaka

Diff of /lisp/disp.l

ViewCVS and CVS Help