View of /renderer/lib.l

Parent Directory

Revision Log

*** empty log message ***

(defun kanjilib())
(declare (trans minchowidth meshsize) special)
; ベクトルの長さ
;
(defun length2 (a)
  (lets ((x (car a))
	 (y (cadr a)))
	(sqrt (float (plus (times x x)(times y y))))))
;
; ベクトルの単位ベクトル
;
(defun norm2 (a)
  (lets ((x (car a))
	 (y (cadr a))
	 (len (sqrt (float (plus (times x x)(times y y))))))
	(list (quotient x len)(quotient y len))))
;
; ベクトルの長さを指定
;
(defun normlen2 (len a)
  (times2 len (norm2 a)))
;
; ベクトルのスカラー倍
;
(defun times2 (len a)
  (list (times len (car a))(times len (cadr a))))
;
; 2点の距離
;
(defun metric2 (a b)
  (let ((x0 (car a))(y0 (cadr a))(x1 (car b))(y1 (cadr b)))
    (sqrt (plus (times (difference x0 x1)(difference x0 x1))
		(times (difference y0 y1)(difference y0 y1))))))
;
; ベクトルの足し算
;
(defun _plus2 (a b)
  (list (plus (car a)(car b))(plus (cadr a)(cadr b))))
;
(macro plus2 (l)
       (do ((ll (cdr l) (cdr ll))
	    (ret (car l)))
	 ((atom ll)ret)
	 (setq ret `(_plus2 ,(car ll) ,ret))))
;
; ベクトルの引き算
;
(defun diff2 (a b)
  (list (difference (car a)(car b))(difference (cadr a)(cadr b))))
;
; 2点の分割点
;
(defun inter2 (p0 p1 s)
  (lets ((x0 (car p0))(y0 (cadr p0))
	 (x1 (car p1))(y1 (cadr p1))
	 (s1 (difference 1.0 s)))
    (list (plus (times x0 s1)(times x1 s))
	  (plus (times y0 s1)(times y1 s)))))
;
; 2点の内積
;
(defun mul2 (a b)
  (plus (times (car a)(car b))(times (cadr a)(cadr b))))
;
; ベクトルの90度回転
;
(defun rot90 (point)
  (let ((x (car point))
	(y (cadr point)))
    (list y (minus x))))
;
; ベクトルの-90度回転
;
(defun rot270 (point)
  (let ((x (car point))
	(y (cadr point)))
    (list (minus y) x)))
;
; ベクトルの任意度回転(thetaは0から2piまで)
;
(defun rot (vector theta)
  (lets ((y (rot90 vector))
	 (costheta (cos theta))
	 (sintheta (sin theta)))
    (plus2 (times2 costheta vector)(times2 sintheta y))))
;
; degree
;
(defun degree (deg)
  (quotient (times 3.14159265 deg) 180))
;
; ベクトルbから見たaの角度のcos
;
(defun costheta (a b)
  (let ((len (times (length2 a)(length2 b))))
    (cond ((equal len 0.0)0.0)
	  (t (quotient (mul2 a b) len)))))
;
; ベクトルbから見たaの角度のsin
;
(defun sintheta (a b)
  (costheta (rot270 a) b))
;
;
;
(defun arccos1 (cos)
  (cond ((greaterp cos 1.0)0.0)
	((lessp cos -1.0)3.14159)
	(t (arccos cos))))
;
; ベクトルd1から見たd0の角度
;
(defun theta (d1 d0)
  (lets ((costheta (costheta d1 d0))
	 (sintheta (costheta (rot270 d1) d0))
	 (theta (arccos1 costheta)))
;    (print costheta)
    (cond ((minusp sintheta)(minus theta))
	  (t theta))))
;
(defun minustheta (theta)
  (let ((minustheta (difference theta 3.14159265)))
    (cond ((lessp minustheta -3.14159265)minustheta)
	  (t (plus minustheta 6.2831853)))))
;
; 逆行列
;
(defun rmat (mat)
  (let ((eigen (quotient 1.0 (difference (times (vref mat 0)(vref mat 3))
					 (times (vref mat 1)(vref mat 2)))))
	(ret (vector 4)))
    (vset ret 0 (times eigen (vref mat 3)))
    (vset ret 1 (times eigen -1.0 (vref mat 1)))
    (vset ret 2 (times eigen -1.0 (vref mat 2)))
    (vset ret 3 (times eigen (vref mat 0)))
    ret))
;
; アフィン変換
;
(defun affine (point trans)
  (let ((x (car point))
	(y (cadr point)))
    (list
     (plus (vref trans 4)(times x (vref trans 0))(times y (vref trans 2)))
     (plus (vref trans 5)(times x (vref trans 1))(times y (vref trans 3))))))
;
;
;
(macro defelement (l)
  `(defprop ,(cadr l)
	    (lambda (points alist) .,(cddr l))
;	    mincho))
	    ,(car l)))
;
(defmacro defprimitive (fonttype name data)
  (cond (fonttype `(putprop ',name ,data ',fonttype))
	(t `(setq ,name ,data))))
;
(defmacro defjoint (fonttype name data)
  (cond (fonttype `(putprop ',name ,data ',fonttype))
	(t `(setq ,name ,data))))
;
(defmacro deftypehook (fonttype data)
  `(putprop 'typehook ,data ',fonttype))
;
(defmacro subfont (child parent)
  `(putprop ',child ',parent 'parent))
;
(macro defkazari (l)
  (let ((sym (gensym (car l))))       
    `(progn
       (defun ,sym (cross).,(cddr l))
       (putprop 'allkazari 
	      `(,',(append (cadr l) (ncons sym))
		. ,(get 'allkazari ',(car l)))
	      ',(car l)))))
;
(defmacro def-type1-hint (type elements body)
  (cond ((consp elements)
	 (do ((ret)
	      (l elements (cdr l)))
	   ((atom l) `(progn .,ret))
	   (push `(def-type1-hint ,type ,(car l) ,body) ret)))
	(t
	 `(putprop ',elements 
		   (cons (cons ',type (function (lambda (points (alist))
						 ,body)))
			 (get ',elements 'type1))
		   'type1))))
;
;
(defun mincho1 (d0 d1 src ratio)
  (lets ((d0x (float (car d0)))(d0y (float (cadr d0)))
	 (d1x (float (car d1)))(d1y (float (cadr d1)))
	 (s (car src))(outline (cdr src))
	 (s0x (float (car s)))(s0y (float (cadr s)))
	 (s1x (float (caddr s)))(s1y (float (cadddr s)))
	 (trans (type1-trans s0x s0y s1x s1y d0x d0y d1x d1y ratio)))
	 (affine-outline outline trans)))
;
;
(defun type1-trans (s0x s0y s1x s1y d0x d0y d1x d1y ratio)
  (lets ((rvec (vector 6))
	 (slen (metric2 (list s0x s0y)(list s1x s1y)))
	 (dlen (metric2 (list d0x d0y)(list d1x d1y)))
	 (a (quotient dlen slen))
	 (b ratio)
	 (costheta (quotient (difference s1x s0x) slen))
	 (sintheta (minus (quotient (difference s1y s0y) slen)))
	 (offx (difference (times costheta s0x)(times sintheta s0y)))
	 (offy (plus (times sintheta s0x)(times costheta s0y)))
	 (cosfai (quotient (difference d1x d0x) dlen))
	 (sinfai (quotient (difference d1y d0y) dlen)))
	(vset rvec 0 (difference (times a costheta cosfai)(times b sintheta sinfai)))
	(vset rvec 1 (plus (times a costheta sinfai)(times b sintheta cosfai)))
	(vset rvec 2 (difference 0.0 (times a sintheta cosfai)(times b costheta sinfai)))
	(vset rvec 3 (difference (times b costheta cosfai)(times a sintheta sinfai)))
	(vset rvec 4 (plus d0x (minus (times a cosfai offx)) (times b sinfai offy)))
	(vset rvec 5 (difference d0y (times a sinfai offx)(times b cosfai offy)))
	rvec))
;
;
(defun affine-outline (outline trans)
  (mapcar outline (function(lambda (y) (mapcar y (function(lambda (x) (cons (car x)(affine (cdr x) trans)))))))))
;
;
;
(defun niku2 (p0 p1 r0 r1 w0 w1 w2 w3)
  (lets ((l0 (norm2 (rot270 (diff2 p1 p0)))))
;    (break)
	`(((angle .,(plus2 p0 (times2 w0 l0)))
	   (bezier .,(plus2 (inter2 p0 p1 r0)(times2 w1 l0)))
	   (bezier .,(plus2 (inter2 p1 p0 r1)(times2 w2 l0)))
	   (angle .,(plus2 p1 (times2 w3 l0))))
	  ((angle .,(diff2 p0 (times2 w0 l0)))
	   (bezier .,(diff2 (inter2 p0 p1 r0)(times2 w1 l0)))
	   (bezier .,(diff2 (inter2 p1 p0 r1)(times2 w2 l0)))
	   (angle .,(diff2 p1 (times2 w3 l0)))))))
;
;
;
(comment
(defun niku3 (p0 p1 p2 r0 r1 w0 w1 w2 w3)
  (lets ((len (plus (metric2 p0 p1)(metric2 p1 p2)))
	 (d0 (diff2 p1 p0))
	 (d1 (diff2 p1 p2))
	 (l0 (norm2 (list (minus (cadr d0))(car d0))))
	 (l1 (norm2 (list (cadr d1)(minus (car d1)))))
	 (l2 (times2 0.5 (plus2 l0 l1)))
	 (tt (metric2 l2 l0))
	 (s (metric2 l2 '(0.0 0.0)))
	 (dlen (times (plus w0 w3) (quotient tt s))))
	(cond ((minusp (mul2 l0 d1))(setq dlen (minus dlen))))
	`(((angle .,(plus2 p0 (times2 w0 l0)))
	   (bezier .,(plus2 p0 (plus2 (normlen2 (times r0 (plus len dlen))d0)(times2 w1 l0))))
	   (bezier .,(plus2 p2 (plus2 (normlen2 (times r1 (plus len dlen))d1)(times2 w2 l1))))
	   (angle .,(plus2 p2 (times2 w3 l1))))
	  ((angle .,(diff2 p0 (times2 w0 l0)))
	   (bezier .,(plus2 p0 (diff2 (normlen2 (times r0 (difference len dlen))d0)(times2 w1 l0))))
	   (bezier .,(plus2 p2 (diff2 (normlen2 (times r1 (difference len dlen))d1)(times2 w2 l1))))
	   (angle .,(diff2 p2 (times2 w3 l1)))))))

)
;
;
;
(defun bez3 (p0 p1 p2 w0 w1 w2 w3 alpha beta)
  (lets ((d0 (diff2 p2 p0))
	 (d1 (diff2 p1 p0))
	 (theta (theta d1 d0))
	 (d2 (diff2 p2 p1))
	 (psi (minus (theta d2 d0)))
	 (len (length2 d0))
	 (f1 (min (length2 d1) (times len (quotient (_f theta psi) alpha))))
	 (f2 (min (length2 d2) (times len (quotient (_f psi theta) beta))))
	 (p3 (plus2 p0 (normlen2 f1 d1)))
	 (p4 (plus2 p2 (normlen2 (minus f2)d2)))
	 (v1 (rot270 d1))
	 (v2 (rot270 d2)))
;    (prind (list theta psi))
    `(((angle .,(plus2 p0 (normlen2 w0 v1)))
       (bezier .,(plus2 p3(normlen2 w1 v1)))
       (bezier .,(plus2 p4(normlen2 w2 v2)))
       (angle .,(plus2 p2 (normlen2 w3 v2))))
      ((angle .,(plus2 p0 (normlen2 (minus w0) v1)))
       (bezier .,(plus2 p3 (normlen2 (minus w1) v1)))
       (bezier .,(plus2 p4 (normlen2 (minus w2) v2)))
       (angle .,(plus2 p2 (normlen2 (minus w3) v2)))))))
;
;
;
(defun movexy (x y (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0))))
  (let ((ret (vector 6 trans)))
    (vset ret 4 (plus (vref ret 4)(float x)))
    (vset ret 5 (plus (vref ret 5)(float y)))
    ret))

(defun movex (x (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0))))
  (let ((ret (vector 6 trans)))
    (vset ret 4 (plus (vref ret 4)(float x)))
    ret))

(defun movey (y (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0))))
  (let ((ret (vector 6 trans)))
    (vset ret 5 (plus (vref ret 5)(float y)))
    ret))

(defun scalex (x (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0))))
  (let ((ret (vector 6 trans)))
    (vset ret 0 (times (vref ret 0)(float x)))
    (vset ret 2 (times (vref ret 2)(float x)))
    (vset ret 4 (times (vref ret 4)(float x)))
    ret))

(defun scalexy (x y(trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0))))
  (let ((ret (vector 6 trans)))
    (vset ret 0 (times (vref ret 0)(float x)))
    (vset ret 1 (times (vref ret 1)(float y)))
    (vset ret 2 (times (vref ret 2)(float x)))
    (vset ret 3 (times (vref ret 3)(float y)))
    (vset ret 4 (times (vref ret 4)(float x)))
    (vset ret 5 (times (vref ret 5)(float y)))
    ret))

(defun scaley (y (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0))))
  (let ((ret (vector 6 trans)))
    (vset ret 1 (times (vref ret 1)(float y)))
    (vset ret 3 (times (vref ret 3)(float y)))
    (vset ret 5 (times (vref ret 5)(float y)))
    ret))
;
(defun rotate (theta (trans (vector 6 '(1.0 0.0 0.0 1.0 0.0 0.0))))
  (lets ((ret (vector 6))
	 (costheta (cos theta))
	 (sintheta (sin theta))
	 (msintheta (minus sintheta)))
    (vset ret 0 (plus (times costheta (vref trans 0))
		      (times msintheta (vref trans 1))))
    (vset ret 1 (plus (times sintheta (vref trans 0))
		      (times costheta (vref trans 1))))
    (vset ret 2 (plus (times costheta (vref trans 2))
		      (times msintheta (vref trans 3))))
    (vset ret 3 (plus (times sintheta (vref trans 2))
		      (times costheta (vref trans 3))))
    (vset ret 4 (plus (times costheta (vref trans 4))
		      (times msintheta (vref trans 5))))
    (vset ret 5 (plus (times sintheta (vref trans 4))
		      (times costheta (vref trans 5))))))

;
(defun points2spline (points)
  (do ((l (cdr points)(cdr l))
       (outline `((angle .,(car points)))))
    ((atom (cdr l))
     (rplacd (car outline) (car l))
     (nreverse outline))
    (push `(bezier .,(car l)) outline)
    (push `(bezier .,(car l)) outline)
    (push `(angle .,(inter2 (car l)(cadr l) 0.5)) outline)))
;
; dwは
;
(defun curve1 (p0 p1 p2 p3 w0 w1 w2 w3 (dlist '(nil nil)))
  (width-curve p0 p3 (times2 3.0 (diff2 p1 p0))
	       (times2 3.0 (diff2 p3 p2))
	       w0 w3 
	       (times 3.0 (difference w1 w0))
	       (times 3.0 (difference w3 w2))
	       1.0 dlist))
;
(defun width-curve (p1 p2 dp1 dp2 w1 w2 dw1 dw2 ti (dlist '(nil nil)))
;  (prind `(,p1 ,p2 ,dp1 ,dp2 ,w1 ,w2 ,dw1 ,dw2 ,ti))
  (lets ((titi (times ti ti))
	 (ddp1 (plus2 (times2 (quotient 6.0 titi)
			      (diff2 p2 p1))
		      (times2 (quotient -4.0 ti) dp1)
		      (times2 (quotient -2.0 ti) dp2)))
	 (ddp2  (plus2 (times2 (quotient 6.0 titi)
			      (diff2 p1 p2))
		      (times2 (quotient 4.0 ti) dp2)
		      (times2 (quotient 2.0 ti) dp1)))
	 (mid-p (plus2 (times2 0.5 p1)
		      (times2 (times 0.125 ti) dp1)
		      (times2 (times -0.125 ti) dp2)
		      (times2 0.5 p2)))
	 (mid-dp (plus2 (times2 (quotient 1.5 ti) (diff2 p2 p1))
		      (times2 -0.25 (plus2 dp2 dp1))))
	 (mid-w (plus (times 0.5 w1)
		      (times ti 0.125 dw1)
		      (times ti -0.125 dw2)
		      (times 0.5 w2)))
	 (mid-dw (plus (times (quotient 1.5 ti) (difference w2 w1))
		      (times -0.25 (plus dw2 dw1))))
	 (mid-1 (plus2 mid-p (normlen2 mid-w (rot270 mid-dp))))
	 (mid-2 (diff2 mid-p (normlen2 mid-w (rot270 mid-dp))))
	 (dp1_ddp1 (mul2 dp1 ddp1))
	 (dp2_ddp2 (mul2 dp2 ddp2))
	 (lendp1 (length2 dp1))
	 (lendp2 (length2 dp2))
	 (lendp1_3 (quotient 1.0 (times lendp1 lendp1 lendp1)))
	 (lendp2_3 (quotient 1.0 (times lendp2 lendp2 lendp2)))
	 (a1 (plus2 p1 (normlen2 w1 (rot270 dp1))))
	 (a2 (plus2 p2 (normlen2 w2 (rot270 dp2))))
	 (a3 (plus2 a1
		 (times2 (quotient ti 3.0)
			 (plus2 dp1
				(times2 (quotient dw1 lendp1) (rot270 dp1))
				(times2 (quotient w1 lendp1) (rot270 ddp1))
				(times2 (times -1.0 w1 dp1_ddp1 lendp1_3)
					(rot270 dp1))))))
	 (a4 (plus2 a2
		 (times2 (quotient ti -3.0)
			 (plus2 dp2
				(times2 (quotient dw2 lendp2)(rot270 dp2))
				(times2 (quotient w2 lendp2) (rot270 ddp2))
				(times2 (times -1.0 w2 dp2_ddp2 lendp2_3)
					(rot270 dp2))))))
	 (mid-a (plus2 (times2 0.125 a1)(times2 0.375 a3)
		       (times2 0.375 a4)(times2 0.125 a2)))
	 (b1 (diff2 p1 (normlen2 w1 (rot270 dp1))))
	 (b2 (diff2 p2 (normlen2 w2 (rot270 dp2))))
	 (b3 (plus2 b1
		 (times2 (quotient ti 3.0)
			 (plus2 dp1
				(times2 (quotient dw1 lendp1) (rot90 dp1))
				(times2 (quotient w1 lendp1) (rot90 ddp1))
				(times2 (times -1.0 w1 dp1_ddp1 lendp1_3)
					(rot90 dp1))))))
	 (b4 (plus2 b2
		 (times2 (quotient ti -3.0)
			 (plus2 dp2
				(times2 (quotient dw2 lendp2) (rot90 dp2))
				(times2 (quotient w2 lendp2) (rot90 ddp2))
				(times2 (times -1.0 w2 dp2_ddp2 lendp2_3)
					(rot90 dp2))))))
	 (mid-b (plus2 (times2 0.125 b1)(times2 0.375 b3)
		       (times2 0.375 b4)(times2 0.125 b2)))
	 (test 'bezier))
    (cond ((or (lessp 1.0 (metric2 mid-1 mid-a))
	       (lessp 1.0 (metric2 mid-2 mid-b)))
	   (lets ((out2 (width-curve mid-p p2 mid-dp dp2 mid-w w2 mid-dw dw2 
				     (times 0.5 ti) dlist))
		  (out1 (width-curve p1 mid-p dp1 mid-dp w1 mid-w dw1 mid-dw
				     (times 0.5 ti) out2))
		  )
	     out1))
	  (t
	   `(((angle .,a1)
	      (,test .,a3)
	      (,test .,a4)
	      (angle .,a2)
	      .,(car dlist)
	      )
	     ((angle .,b1)
	      (,test .,b3)
	      (,test .,b4)
	      (angle .,b2)
	      .,(cadr dlist)))))))
;
;
(defun curve2 (p0 p1 p2 p3 w0 w1 w2 w3 (dlist '(nil nil)))
  (lets ((mid-p (cross2 p0 p3 (diff2 p1 p0)(diff2 p2 p3)))
	 (rate1 (//$ (metric2 p1 p0)(metric2 mid-p p0)))
	 (rate2 (//$ (metric2 p2 p3)(metric2 mid-p p3)))
	 (l0 (rot270 (diff2 p1 p0)))
	 (l3 (rot270 (diff2 p3 p2)))
	 (a0 (plus2 p0 (normlen2 w0 l0)))
	 (da0 (diff2 (plus2 p1 (normlen2 w1 l0)) a0))
	 (a3 (plus2 p3 (normlen2 w3 l3)))
	 (da3 (diff2 (plus2 p2 (normlen2 w2 l3)) a3))
	 (mid-a (cross2 a0 a3 da0 da3))
	 (a1 (inter2 a0 mid-a rate1))
	 (a2 (inter2 a3 mid-a rate2))
	 (r0 (rot90 (diff2 p1 p0)))
	 (r3 (rot90 (diff2 p3 p2)))
	 (b0 (plus2 p0 (normlen2 w0 r0)))
	 (db0 (diff2 (plus2 p1 (normlen2 w1 r0)) b0))
	 (b3 (plus2 p3 (normlen2 w3 r3)))
	 (db3 (diff2 (plus2 p2 (normlen2 w2 r3)) b3))
	 (mid-b (cross2 b0 b3 db0 db3))
	 (b1 (inter2 b0 mid-b rate1))
	 (b2 (inter2 b3 mid-b rate2))
	 (test 'bezier))
;    (break)
    `(((angle .,a0)(,test .,a1)(,test .,a2)(angle .,a3).,(car dlist))
      ((angle .,b0)(,test .,b1)(,test .,b2)(angle .,b3).,(cadr dlist)))))
;
(defun niku3 (p0 p1 p2 r0 r1 w0 w1 w2 w3)
  (lets ((len0 (metric2 p0 p1))
	 (len1 (metric2 p1 p2))
	 (len (plus len0 len1))
	 (rate0 (min 1.0 (quotient (times r0 len) len0)))
	 (rate1 (min 1.0 (quotient (times r1 len) len1))))
  (curve2 p0 (inter2 p0 p1 rate0) (inter2 p2 p1 rate1) p2 w0 w1 w2 w3)))

;
(defun cross2 (p0 p1 dp0 dp1)
  (cond ((lessp (abs (sintheta dp0 dp1)) 0.0001)
	 (times2 0.5 (plus2 p0 p1)))
	(t
	 (lets ((ax (float (car p0)))
		(ay (float (cadr p0)))
		(bx (float (car dp0)))
		(by (float (cadr dp0)))
		(cx (float (car p1)))
		(cy (float (cadr p1)))
		(dx (float (car dp1)))
		(dy (float (cadr dp1)))
		(mat2 (vector 4 (list bx by (-$ dx)(-$ dy))))
		(rmat nil)
		(rmat2 nil)
		(s nil))
	   (setq rmat2 (rmat mat2))
	   (setq s (+$ 
		    (*$ (vref rmat2 1)(-$ cx ax))
		    (*$ (vref rmat2 3)(-$ cy ay))))
	   `(,(+$ cx (*$ s dx)),(+$ cy (*$ s dy)))))))

;
(defun tenhokan (points 
		  (hokanfunc #'(lambda (x) (exp (times 0.66666 (log x)))))
		 (roundp nil)
		 )
;  (prind roundp)
  (lets ((npoints (length points))
	 (array (vector (* npoints npoints) 0.0))
	 (ti 
	  (vector npoints
		  (do ((l points (cdr l))
		       (ret))
		    ((atom (cdr l))
		     (push (funcall hokanfunc (metric2 (car l)(car points)))
			   ret)
		     (nreverse ret))
		    (push (funcall hokanfunc (metric2 (car l)(cadr l))) ret))))
	 (titi (vector npoints))
	 (pi
	  (vector npoints
		  (do ((l points (cdr l))
		       (ret))
		    ((atom l)(nreverse ret))
		    (push (car l) ret))))
	 (bi (vector npoints))
	 (bix (vector npoints))
	 (biy (vector npoints))
	 (dpix (vector npoints))
	 (dpiy (vector npoints))
	 (dpi (vector npoints))
	 (ddpi (vector npoints))
	 )
    (do ((i 0 (1+ i)))((>= i npoints))
	(vset titi i (times (vref ti i)(vref ti i))))
    (vset array 1 (quotient 1.0 (vref ti 0)))
    (cond (roundp
	   (vset array 0 (plus (quotient 2.0 (vref ti 0))
			       (quotient 2.0 (vref ti (- npoints 1)))))
	   (vset array (- npoints 1)
		 (quotient 1.0 (vref ti (- npoints 1))))
	   (vset bi 0
		 (plus2
		  (times2 (quotient -3.0 (vref titi (1- npoints)))
			  (vref pi (1- npoints)))
		  (times2 (difference (quotient 3.0 (vref titi (1- npoints)))
				      (quotient 3.0 (vref titi 0)))
			  (vref pi 0))
		  (times2 (quotient 3.0 (vref titi 0))
			  (vref pi 1)))))
	  (t
	   (vset array 0 (quotient 2.0 (vref ti 0)))
	   (vset bi 0 (times2 (quotient 3.0 (vref titi 0))
			      (diff2 (vref pi 1)(vref pi 0))))))
    (do ((i 0 (1+ i))
	 (j npoints (+ j npoints)))
      ((>= i (- npoints 2)))
      (vset array (+ j i) (quotient 1.0 (vref ti i)))
      (vset array (+ j i 1)(plus (quotient 2.0 (vref ti i))
				 (quotient 2.0 (vref ti (1+ i)))))
      (vset array (+ j i 2) (quotient 1.0 (vref ti (1+ i))))
      (vset bi (1+ i )
	    (plus2
	     (times2 (quotient -3.0 (vref titi i))(vref pi i))
	     (times2 (difference (quotient 3.0 (vref titi i))
			    (quotient 3.0 (vref titi (1+ i))))(vref pi (1+ i)))
	     (times2 (quotient 3.0 (vref titi (1+ i)))(vref pi (+ i 2))))))
    (vset array (- (* npoints npoints) 2)
	  (quotient 1.0 (vref ti (- npoints 2))))
    (cond (roundp
	   (vset array (1- (* npoints npoints))
		 (plus
		  (quotient 2.0 (vref ti (- npoints 2)))
		  (quotient 2.0 (vref ti (1- npoints)))))
	   (vset array (* (1- npoints) npoints) (quotient 1.0 (vref ti (1- npoints))))
	   (vset bi (1- npoints)
	    (plus2
	     (times2 (quotient -3.0 (vref titi (- npoints 2)))
		     (vref pi (- npoints 2)))
	     (times2 (difference (quotient 3.0 (vref titi (- npoints 2)))
				 (quotient 3.0 (vref titi (1- npoints))))
		     (vref pi (1- npoints)))
	     (times2 (quotient 3.0 (vref titi (1- npoints)))
		     (vref pi 0)))))
	  (t
	   (vset array (1- (* npoints npoints))
		 (quotient 2.0 (vref ti (- npoints 2))))
	   (vset bi (1- npoints)
		 (times2 (quotient 3.0 (vref titi (- npoints 2)))
			 (diff2 (vref pi (1- npoints))(vref pi (- npoints 2)))))))
    (do ((i 0 (1+ i)))((>= i npoints))
	(vset bix i (car (vref bi i)))
	(vset biy i (cadr (vref bi i)))
	(vset dpix i 0.0)
	(vset dpiy i 0.0)
	)
;    (prind array)
;    (prind bix)
;    (prind biy)
    (gs npoints array dpix bix)
    (gs npoints array dpiy biy)
    (do ((i 0 (1+ i)))((>= i npoints))
	(vset dpi i `(,(vref dpix i) ,(vref dpiy i))))
;    (prind pi)
;    (prind dpi)
    (do ((i 0 (1+ i))
	 (ret))
      ((>= i (1- npoints))
       (push `(angle .,(vref pi (1- npoints))) ret)
       (and roundp
	    (push `(bezier .,(plus2 (vref pi (1- npoints))
				    (times2 (times (vref ti (1- npoints)) 0.333333)
					    (vref dpi (1- npoints))))) ret)
	    (push `(bezier .,(plus2 (vref pi 0)
				    (times2 (times (vref ti (1- npoints)) -0.333333)
					    (vref dpi 0)))) ret)
	    (push `(angle .,(vref pi 0)) ret))
       (nreverse ret))
      (push `(angle .,(vref pi i)) ret)
      (push `(bezier .,(plus2 (vref pi i)
			      (times2 (times (vref ti i) 0.333333)
				      (vref dpi i)))) ret)
      (push `(bezier .,(plus2 (vref pi (1+ i))
			      (times2 (times (vref ti i) -0.333333)
				      (vref dpi (1+ i))))) ret))))
;
;
(defun line2 (p0 p1 width (dlist '(nil nil)))
  (lets ((diff (diff2 p1 p0))
	 (l0 (normlen2 width (rot270 diff))))
    `(((angle .,(plus2 p0 l0))
       (angle .,(plus2 p1 l0))
       .,(car dlist))
      ((angle .,(diff2 p0 l0))
       (angle .,(diff2 p1 l0))
       .,(cadr dlist)))))
;
(defun gridxy (point)
  `(,(times meshsize 
	    (fix (plus 0.5 (quotient (car point) meshsize))))
    ,(times meshsize 
	    (fix (plus 0.5 (quotient (cadr point) meshsize))))))
(defun gridhalfxy (point)
  `(,(plus (times 0.5 meshsize)
	   (times meshsize 
		  (fix (quotient (car point) meshsize))))
    ,(plus (times 0.5 meshsize)
	   (times meshsize 
		  (fix (quotient (cadr point) meshsize))))))
(defun grid (point dotsize)
  (cond ((oddp dotsize)
	 (gridxy point))
	((gridhalfxy point))))
;
(defun gridx (point dotsize)
  (cond ((not (oddp dotsize))
	 `(,(plus (times 0.5 meshsize)
		  (times meshsize 
			 (fix (quotient (car point) meshsize))))
	   ,(cadr point)))
	(`(,(times meshsize 
		   (fix (plus 0.5 (quotient (car point) meshsize))))
	   ,(cadr point)))))
;
(defun gridy (point dotsize)
  (cond ((not (oddp dotsize))
	 `(,(car point)
	   ,(plus (times 0.5 meshsize)
		  (times meshsize 
			 (fix (quotient (cadr point) meshsize))))))
	(`(,(car point)
	   ,(times meshsize 
		   (fix (plus 0.5 (quotient (cadr point) meshsize))))))))
;
(defun meshwidth (width)
  (fix (plus 0.5 (quotient (times 2 width) meshsize))))
;
(defun normwidth (dotsize)
  (times 0.5 meshsize (difference dotsize 0.5)))
;
(defun inter (a b s)
  (plus (times (difference 1.0 s) a)(times s b)))
;
(defun newbez (p0 p1 b0 b1 b2 b3)
  (lets ((crosses (cross2bez p0 p1 b0 b1 b2 b3))
	 (t1 (cdr crosses))(t2 (times t1 t1))(t3 (times t2 t1))
	 (db0 (times2 3.0 (diff2 b1 b0)))
	 (db3 (times2 3.0 (diff2 b3 b2)))
	 (n1 (plus2
	      (times2 t3 (plus2 (times2 2.0 (diff2 b0 b3))
				 db0 db3))
	      (times2 t2 (diff2 (times2 3.0 (diff2 b3 b0))
				(plus2 (times2 2.0 db0) db3)))
	      (times2 t1 db0)
	      b0))
	 (dn1 (plus2
	       (times2 t2 (plus2 (times2 6.0 (diff2 b0 b3))
				 (times2 3.0 (plus2 db0 db3))))
	       (times2 t1 (diff2 (times2 6.0 (diff2 b3 b0))
				(plus2 (times2 4.0 db0) (times2 2.0 db3))))
	       db0)))
    `(,b0 
      ,(plus2 b0 (times2 (quotient t1 3.0) db0))
      ,(diff2 n1 (times2 (quotient t1 3.0) dn1))
      ,n1)))