[wadalabfont-kit] / renderer / mincho.l  

View of /renderer/mincho.l

Parent Directory | Revision Log
Revision: 1.5 - (download) (annotate)
Thu Jul 3 11:42:38 2003 UTC (21 years, 5 months ago) by ktanaka
Branch: MAIN
Changes since 1.4: +2 -34 lines 
*** empty log message ***

; 単位は400*400の座標系
(declare (minchowidth tateyokoratio minchoheight tatekazari tome1 kazariheight tomeheight meshsize mw) special)
; mwはmincho-primの中で設定される
; (setq mw minchowidth)
;
; ライブラリをexfileする
(cond ((definedp 'kanjilib))
      (t (exfile 'lib.l)))

;
(defkazari mincho (yoko 0 yoko 1)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3)))
    `((angle .,(inter2 p0 p2 0.5))
      (angle .,(inter2 p1 p3 -0.5)))))
;
(defkazari mincho ((migi shin-nyuu) 0 (migi shin-nyuu) 1)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3)))
    `((angle .,p2)
      (bezier .,p0)
      (bezier .,p1)
      (angle .,p3))))
;
(defkazari mincho (hidari 2 hidari 3)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3)))
    `((angle .,p2)
      (bezier .,p0)
      (bezier .,p1)
      (angle .,p3))))
;
(defkazari mincho (migiue 0 migiue 1)
  (lets ((p0 (vref cross 1))
	 (p1 (vref cross 0))
	 (p2 (vref cross 3))
	 (p3 (vref cross 2))
	 (d0 (norm2 (diff2 p3 p1)))
	 (len (metric2 p0 p1))
	 (theta (theta d0 '(0.0 1.0)))
	 (psi 1.4)
	 (cospsi (cos psi))
	 (sinpsi (sin psi))
	 (p4 (inter2 p1 p3 (times 0.5 cospsi)))
	 (p5 (inter2 p0 p2 (times -0.5 cospsi)))
	 (w (times mw tatekazari))
	 (fai (plus psi 0.6))
	 (w1 (times 0.8 (times 0.82 w)))
	 (p6 (plus2 p4 (normlen2 w1 d0)))
	 (dp6 (plus2 (normlen2 (cos fai)(diff2 p3 p1))
		     (normlen2 (sin fai)(diff2 p1 p0))))
	 (p7 (cross2 p4 p6 (diff2 p4 p5) dp6))
	 (len0 (metric2 p7 p6))
	 (len1 (metric2 p7 p5))
	 (len2 (quotient len1 3.0))
	 )
    (cond ((lessp len1 len0)
	   `(
	     (angle .,p6)
	     (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7))))
	     (bezier .,p7)
	     (angle .,(plus2 p7 (normlen2 len0 (diff2 p5 p7))))
	     (angle .,p5)))
	  (t
	   `((angle .,p6)
	     (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7))))
	     (bezier .,p7)
	     (angle .,p5))))))
;
(defkazari mincho (yoko 2 yoko 3)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (w tome1)
	 (len0 (metric2 p0 p1))
	 (w1 (plus w len0))
	 (w2 (times w1 1.3))
	 (p4 (plus2 p0 (normlen2 (times w2 0.25) (diff2 p0 p2))))
	 (p5 (plus2 p4 (normlen2 w2 (diff2 p2 p0))(normlen2 w1 (diff2 p1 p0))))
	 (p6 (plus2 p4 (normlen2 (plus w2 (times 0.7 w))(diff2 p2 p0))
		    (normlen2 len0 (diff2 p1 p0))))
	 (p7 (inter2 p4 p5 0.5))
	 (p8 (plus2 p4 (normlen2 (times w2 0.5)(diff2 p2 p0)))))
    `((angle .,p8)
      (bezier .,(inter2 p8 p4 0.66666))
      (bezier .,(inter2 p7 p4 0.66666))
      (angle .,p7)
      (angle .,p5)
      (angle .,p6))))
;
(defkazari mincho ((tate hidari tatehidari tatehane kokoro tasuki magaritate kagi) 0 
	    (tate hidari tatehidari tatehane kokoro tasuki magaritate kagi) 1)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (d0 (norm2 (diff2 p3 p1)))
	 (len (metric2 p0 p1))
	 (theta (theta d0 '(0.0 1.0)))
	 (theta (cond ((plusp theta)0)(theta)))
	 (psi (plus 1.32 (times theta -0.85)))
	 (cospsi (cos psi))
	 (sinpsi (sin psi))
	 (p4 (inter2 p1 p3 (times 0.5 cospsi)))
	 (p5 (inter2 p0 p2 (times -0.5 cospsi)))
;	 (w (times mw tatekazari))
	 (w (times (metric2 p0 p1) tatekazari 0.5))
	 (fai (plus psi 0.8))
	 (w1 (times 1.2 w))
	 (p6 (plus2 p4 (normlen2 w1 d0)))
	 (dp6 (plus2 (normlen2 (cos fai)(diff2 p3 p1))
		     (normlen2 (sin fai)(diff2 p1 p0))))
	 (p7 (cross2 p4 p6 (diff2 p4 p5) dp6))
	 (len0 (metric2 p7 p6))
	 (len1 (metric2 p7 p5))
	 (len2 (quotient len1 3.0))
	 )
    (cond ((lessp len1 len0)
	   `((angle .,p5)
	     (angle .,(plus2 p7 (normlen2 (min len0 (metric2 p5 p7))
					  (diff2 p5 p7))))
	     (bezier .,p7)
	     (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7))))
	     (angle .,p6))
	   )
	  (t
	   `((angle .,p5)
	     (bezier .,p7)
	     (bezier .,(plus2 p7 (normlen2 len2 (diff2 p6 p7))))
	     (angle .,p6))))))
;	     
;    (break)
;  `((angle .,p5)
;    (bezier .,
;     (plus2 p4 (normlen2 (times 0.2 len) (diff2 p4 p5))))
;    (bezier .,
;     (plus2 p4 (normlen2 (times 0.5 len) (diff2 p4 p5))))
;    (angle .,
;     (plus2 p4 (normlen2 (times len 0.4) d0))))))

;
(defkazari mincho (migi 2 migi 3)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (d0 (norm2 (diff2 p3 p1)))
	 (len (metric2 p0 p1))
	 (sintheta (times -0.4 (car d0))))
	    `((angle .,(plus2 p0 (times2 0.3 (diff2 p2 p0))))
	      (bezier .,
	       (plus2 p2
		      (times2 (plus 0.4 sintheta)(diff2 p1 p3))
		      (times2 0.3 (diff2 p3 p2))))
	      (bezier .,
	       (plus2 p3
		       (times2 (plus 0.6 sintheta)(diff2 p1 p3))
		       (times2 0.2 (diff2 p2 p3))))
	      (angle .,
	       (plus2 p3 (times2 (plus 0.9 sintheta)(diff2 p1 p3)))))))
;
(defkazari mincho (shin-nyuu 2 shin-nyuu 3)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (len (metric2 p0 p1)))
	`((angle .,(plus2 p0 (times2 0.3 (diff2 p2 p0))))
	  (bezier .,(plus2 p0 (times2 0.5 (diff2 p1 p0))))
	  (bezier .,(plus2 p0 (times2 0.5 (diff2 p1 p0))))
	  (angle .,(plus2 p1 (times2 0.7 (diff2 p1 p3)))))))
;
(defkazari mincho ((tate magaritate kagi)2 (tate magaritate kagi) 3)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (p4 (times2 0.5 (plus2 p0 p1)))
	 (p5 (plus2 p1 (times2 1.0 (diff2 p3 p1))))
	 (p6 (plus2 p0 (times2 0.6 (diff2 p2 p0)))))
  `((angle .,p6)
    (bezier .,(plus2 p6 (times2 0.7 (diff2 p0 p6))))
    (bezier .,(plus2 p4 (times2 0.7 (diff2 p0 p4))))
    (angle .,p4)
    (bezier .,(plus2 p4 (times2 0.8 (diff2 p1 p4))))
    (bezier .,(plus2 p5 (times2 0.8 (diff2 p1 p5))))
    (angle .,p5))))
;
;(defkazari mincho (ten 2 ten 3)
;  (lets ((p0 (vref cross 0))
;	 (p1 (vref cross 1))
;	 (p2 (vref cross 2))
;	 (p3 (vref cross 3))
;	 (p4 (times2 0.5 (plus2 p0 p1)))
;	 (p5 (plus2 p1 (times2 1.0 (diff2 p3 p1))))
;	 (p6 (plus2 p0 (times2 0.6 (diff2 p2 p0)))))
;  `((angle .,p6)
;    (bezier .,(plus2 p6 (times2 0.7 (diff2 p0 p6))))
;    (bezier .,(plus2 p4 (times2 0.7 (diff2 p0 p4))))
;    (angle .,p4)
;    (bezier .,(plus2 p4 (times2 0.8 (diff2 p1 p4))))
;    (bezier .,(plus2 p5 (times2 0.8 (diff2 p1 p5))))
;    (angle .,p5))))
;
(defkazari mincho ((tate magaritate) 2 yoko 0)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (len (metric2 p0 p2))
	 (p4 (plus2 p0 (normlen2 len (diff2 p0 p1))))
	 (p5 (plus2 p2 (normlen2 len (diff2 p2 p3)))))
    `((angle .,(inter2 p0 p1 0.1))
      (bezier .,p4)
      (bezier .,p5)
      (angle .,p2)      )))
;
(defkazari mincho ((tate magaritate) 3 yoko 2)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (len (metric2 p0 p2))
	 (p4 (plus2 p0 (normlen2 len (diff2 p0 p1))))
	 (p5 (plus2 p2 (normlen2 len (diff2 p2 p3)))))
    `((angle .,(inter2 p2 p3 0.1))
      (bezier .,p5)
      (bezier .,p4)
      (angle .,p0))))
;
(comment
(defkazari mincho (kozato 2 kozato 3)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (p4 (plus2 p0 (diff2 p0 p1)))
	 (p5 (plus2 (times2 0.5 (plus2 p0 p1)) (times2 0.1 (diff2 p1 p3))))
	 (p6 (plus2 p0 (times2 0.5 (diff2 p2 p0))))
	 (p7 (plus2 (times2 0.5 (plus2 p4 p0)) (times2 0.1 (diff2 p3 p1)))))
  `((angle .,p2)
    (bezier .,p6)
    (bezier .,p6)
    (angle .,p4)
    (bezier .,p7)
    (bezier .,p7)
    (angle .,p0)
    (bezier .,p5)
    (bezier .,p1)
    (angle .,p3))))
)
;    
(defkazari mincho ((migi tate hidari tatehidari kokoro magaritate tasuki) 0
		   yoko 1)
  (lets ((w (times mw kazariheight))
	 (p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (len (metric2 p3 p1))
	 (len1 (max len (times 2 w))))
    `((angle .,(plus2 p1 (normlen2 w (diff2 p1 p0))))
      (angle .,(plus2 p1 (normlen2 len1 (diff2 p3 p1)))))))
;
(defkazari mincho ((tate hidari tatehidari) 0 hidari 2)
  (lets ((minchoheight (times mw kazariheight)))
    `((angle .,(plus2 (vref cross 1)
		      (normlen2 
		       minchoheight
		       (diff2 (vref cross 1)(vref cross 0)))))
      (angle .,(vref cross 2)))))
  
(defkazari mincho ((tate hidari tatehane kokoro tsukurihane magaritate tasuki migi) 1 yoko 3)
  (lets ((p0 (vref cross 0))
	 (p1 (vref cross 1))
	 (p2 (vref cross 2))
	 (p3 (vref cross 3))
	 (d1 (diff2 p1 p3))
	 (d0 (rot90 d1))
; added by tanaka 1993/3/1
	 (p3 (cond ((plusp (mul2 d1 (diff2 p2 p3)))
		    p3)
		   (t (cross2 p1 p2 (diff2 p3 p1) (rot270 d1)))))
	 (p1 (plus2 p3 d1))
	 (w0 (times mw 1.333 tatekazari))
	 (w1 (times mw kazariheight))
	 (const1 (quotient (times w0 0.4) w1))
	 (p7 p1)
	 (p6 (plus2 p7 (normlen2 (times w1 -0.7) d1)
		    (normlen2 (times -1.0 w1) d0)))
	 (p8 (cross2 p6 p2 
		     (plus2 (normlen2 1.0 d0)(normlen2 -1.3 d1))
		     (diff2 p3 p2)))
	 (p9 (plus2 p3 (normlen2 (times -0.3 w0) d0)))
	 (p4)(p5)(w2))
    (cond ((plusp (mul2 (diff2 p3 p2)(diff2 p8 p9)))
	   (setq p8 p9)
	   (setq w2 (difference w1 (times 0.3 w0)))
	   (setq p6 (plus2 p8 (normlen2 (times w2 -1.0) d0)
			   (normlen2 (times w2 1.3) d1)))
	   (setq p7 (plus2 p6 (normlen2 (times w1 1.0) d0)
			   (normlen2 (times 0.7 w1) d1)))))
    (setq p4 (plus2 p8 (normlen2 (times 1.0 w0) (diff2 p2 p3))))
    (setq p5 (cross2 p8 p4 (diff2 p8 p6)
		     (rot (diff2 p8 p6) 
			  (max (degree 50)
			       (difference (theta (diff2 p3 p2)(diff2 p8 p6))
					   (degree 70))))))
;    (break)
    (setq p8 (inter2 p5 p6 
		     (min 0.9 (quotient (metric2 p5 p4)(metric2 p5 p8)))))
    `((angle .,p4)
      (bezier .,(inter2 p4 p5 0.9))
      (bezier .,(inter2 p8 p5 0.9))
;      (angle .,p5)
      (angle .,p8)
      (angle .,p6)
      (angle .,p7))))

	  

;
;
; 点の定義
;
(defelement mincho ten
  (lets ((dotsize (meshwidth mw))
	 (w (times meshsize 0.5 dotsize))
	 (p0 (grid (car points) dotsize))
	 (p1 (grid (cadr points) dotsize))
	 (len (metric2 p0 p1)))
    (mincho1 
     p0 
     p1
     '((80 171 136 255)
       ((angle 80 171)(bezier 119 214)(bezier 104 256)(angle 136 255))
       ((angle 80 171)(bezier 155 204)(bezier 173 251)(angle 136 255)))
     (cond ((lessp (times 3.0 w) len)
	    (quotient w 20.0))
	   (t (quotient len 60.0))))))
;
; 縦棒の定義
;
(defelement mincho tate
    (lets ((dotsize (meshwidth mw))
	   (p0 (gridx (car points) dotsize))
	   (p1 (gridx (cadr points) dotsize))
	   (w (min (normwidth dotsize)(times 0.35 (metric2 p0 p1))))
	   )
;      (print `(tate ,dotsize))
      (cond ((lessp (times 0.08 w) meshsize)
	     (line2 p0 p1 w))
	    (t
	     (niku2 p0 p1 0.4 0.4 w (times w 0.92)(times w 0.92) w)))))
;
; 横棒の定義
;
(defelement mincho yoko
  (lets ((dotsize (meshwidth (times mw tateyokoratio)))
	 (w (normwidth dotsize))
	 (p0 (gridy (car points) dotsize))
	 (p1 (gridy (cadr points) dotsize)))
    (line2 p0 p1 w)))
;
; 右上はらいの定義
;
(defelement mincho migiue
  (lets ((dotsize (meshwidth mw))
	 (w0 (normwidth dotsize))
;	 (w1 (normwidth 1))
	 (w1 0)
      	 (p0 (gridy (car points) dotsize))
	 (p1 (gridy (cadr points) dotsize))
	 (p2 (gridy (caddr points) 1)))
    (niku3 p0 p1 p2 0.3 0.3 w0 (inter w0 w1 0.3)(inter w0 w1 0.7) w1)))
;
; 右はらいの定義
;
(defelement mincho migi
  (lets ((dotsize0 (meshwidth (times mw 0.5)))
	 (w0 (normwidth dotsize0))
	 (dotsize1 (meshwidth (times mw 1.2)))
	 (w1 (normwidth dotsize1))
	 (p0 (grid (car points) dotsize0))
	 (p1 (cadr points))
	 (p2 (grid (caddr points) dotsize1)))
    (niku3 p0 p1 p2 0.3 0.3 
	   w0 (inter w0 w1 0.25)(inter w0 w1 0.75) w1)))
;
;しんにょう
;
(defelement mincho shin-nyuu
    (lets 
     ((dotsize0 (meshwidth (times mw 0.2)))
      (w0 (normwidth dotsize0))
      (dotsize1 (meshwidth (times mw 1.2)))
      (w1 (normwidth dotsize1))
      (p0 (grid (car points) dotsize0))
      (p1 (cadr points))
      (p2 (grid (caddr points) dotsize1))
      (len0 (metric2 p0 p1))
      (len1 (metric2 p1 p2))
      (len (plus len0 len1)))
     (curve2 p0 (inter2 p0 p1 0.5)(inter2 p2 p1 0.9) p2
	     w0 (inter w0 w1 0.2) (inter w0 w1 0.9) w1)))
;
; まがりたて 
;
(defelement mincho magaritate
  (lets ((dotsize (meshwidth mw))
	 (w0 (normwidth dotsize))
	 (w1 (times w0 0.9))
	 (p0 (grid (car points) dotsize))
	 (p1 (cadr points))
	 (p2 (grid (caddr points) dotsize)))
    (curve2 p0 (inter2 p0 p1 0.7)(inter2 p2 p1 0.7) p2 w0 w1 w1 w0)))
;
; かぎ
;
(defelement mincho kagi
  (lets ((dotsize0 (meshwidth mw))
	 (w0 (normwidth dotsize0))
	 (dotsize1 (meshwidth (times 1.0 mw)))
	 (w1 (normwidth dotsize1))
	 (p0 (gridx (car points) dotsize0))
	 (l0 (normlen2 w1 (rot90 (diff2 (caddr points)(cadr points)))))
	 (p1 (gridx (gridy (plus2 (cadr points) l0) dotsize1) dotsize0))
	 (p2 (gridy (plus2 (caddr points) l0) dotsize1))
	 (len0 (metric2 p0 p1))
	 (len1 (metric2 p1 p2))
	 (rate0 (min 0.9 (//$ (times w0 4.0) len0)))
	 (rate1 (min 0.9 (//$ (times w1 4.0) len1)))
	 (p01 (inter2 p1 p0 rate0))
	 (p12 (inter2 p1 p2 rate1)))
    (line2 p0 p01 w0
	   (curve2 p01 (inter2 p1 p01 0.1)(inter2 p1 p12 0.1) p12 w0 w0 w1 w1
		   (cond ((greaterp (metric2 p12 p2) w0)
			   (line2 p12 p2 w1))
			 (t `(nil nil)))))))
; 縦左はらいの定義
(defelement mincho tatehidari
  (lets ((dotsize (meshwidth mw))
	 (w (normwidth dotsize))
	 (p0 (grid (car points) dotsize))
	 (p1 (grid (cadr points) dotsize))
	 (p2 (grid (caddr points) dotsize))
	 (p3 (grid (cadddr points) dotsize))
	 (l0 (normlen2 w (rot90 (diff2 p0 p1))))
	 (w1 (//$ w (float (costheta l0 (diff2 p3 p2)))))
	 (l1 (plus2 (normlen2 w1 (diff2 p3 p2))
		    (normlen2 w1 (diff2 p1 p2)))))
    `(((angle .,(plus2 p0 l0))
       (angle .,(plus2 p1 l0))
       (bezier .,(plus2 (inter2 p1 p2 0.5) l0))
       (bezier .,(plus2 p2 l1))
       (angle .,p3))
      ((angle .,(diff2 p0 l0))
       (angle .,(diff2 p1 l0))
       (bezier .,(diff2 (inter2 p1 p2 0.5) l0))
       (bezier .,(diff2 p2 l1))
       (angle .,p3)))))
; こころ
(defelement mincho kokoro
  (lets ((dotsize0 (meshwidth mw))
	 (dotsize1 (meshwidth (times 1.0 mw)))
	 (w0 (normwidth dotsize0))
	 (w1 (normwidth dotsize1))
	 (p0 (gridx (car points) dotsize0))
	 (l0 (normlen2 w1 (rot90 (diff2 (caddr points)(cadr points)))))
	 (p1 (gridx (gridy (plus2 (cadr points) l0) dotsize1) dotsize0))
	 (p2 (gridy (plus2 (caddr points) l0) dotsize1))
	 (p3 (fourth points))
	 (w0 (min w0 (times 0.35 (metric2 p1 p2))))
	 (w1 (min w1 (times 0.35 (metric2 p1 p2))))
	 (w0 (min w0 (times 0.35 (metric2 p0 p1))))
	 (w1 (min w1 (times 0.35 (metric2 p0 p1))))
	 (p3 (plus2 p2
		    (normlen2 (min (metric2 p0 p1)
				   (max (metric2 p3 p2)(times w1 5.0)))
			      (diff2 p3 p2))))
	 (p3 (gridx p3 dotsize1))
	 (p23 (inter2 p2 p3 0.1))
	 (p12 (inter2 p1 p2 0.5))
	 (len0 (metric2 p0 p1))
	 (len1 (metric2 p1 p12))
	 (rate0 (min 0.9 (//$ (times w0 4.0) len0)))
	 (rate1 (min 0.9 (//$ (times w1 4.0) len1)))
	 (p01 (inter2 p1 p0 rate0))
	 (p4 (inter2 p1 p12 rate1))
	 (p5 (inter2 p12 p2 0.5))
	 (w2 (times w1 0.8))
	 (w3 (min (times w1 3.0)(plus w2 (times (metric2 p2 p3) 0.2))))
	 )
;    (prind w0)
    (cond ((lessp len0 (times 6.0 w0))
;	   (prind 'less)
	   (curve2 p0 (inter2 p1 p0 0.1)(inter2 p1 p4 0.1) p4 w0 w0 w1 w1
		   (line2 p4 p12 w1
			  (kokorohane p12 p5 p23 p3 w1 w2 w3))))
	  (t
	   (line2 p0 p01 w0
		  (curve2 p01 (inter2 p1 p01 0.1)(inter2 p1 p4 0.1) p4 w0 w0 w1 w1
			  (line2 p4 p12 w1
				 (kokorohane p12 p5 p23 p3 w1 w2 w3))))))))
;
(defun kokorohane (p0 p1 p2 p3 w0 w1 w2)
  (lets ((d0 (diff2 p1 p0))
	 (d1 (diff2 p2 p1))
	 (a4 (plus2 p2 (normlen2 w2 d1)))
	 (l0 (normlen2 w0 (rot270 d0)))
	 (l1 (normlen2 w0 (rot270 d1)))
	 (h0 (diff2 p2 (normlen2 w1 d1)))
	 (h1 (plus2 p2 (normlen2 w1 d1)))
	 (a0 (plus2 p0 l0))
	 (a3 (plus2 a4 l1))
	 (a1 (cross2 a0 a3 d0 d1))
	 (b0 (diff2 p0 l0))
	 (b1 (cross2 b0 (diff2 a4 l1) d0 d1))
	 (b2 (cross2 b1 p3 d1 (diff2 h0 p3)))
	 (b3 (diff2 b2 (normlen2 w0 d1)))
	 (bez0 (newbez b3 (plus2 b3 l1)
		       b0
		       (inter2 b0 b1 0.7)
		       (inter2 (diff2 a4 l1) b1 0.7)
		       (diff2 a4 l1)))
	 (b3 (fourth bez0))
	 (b2 (cross2 b3 p3 (diff2 (third bez0) b3) (diff2 h0 p3)))
	 (a2 (plus2 a3 (normlen2 (times -1.0 w2) d1)))
	 (a5 (cross2 (diff2 a4 l1) p3 d1 (diff2 h1 p3)))
	 (a7 (diff2 (diff2 a4 l1)
		    (normlen2 (min w0 (times 0.6 (metric2 a5 (diff2 a4 l1))))
			      d1)))
	 (a8 (plus2 h1 (normlen2 (min (times 1.5 w0)(metric2 h1 p3)) (diff2 p3 h1))))
	 (a9 (cross2 a8 a4 (diff2 a7 a8) l1))
	 (a9 (cond ((lessp (metric2 a4 a7)(metric2 a7 a9))(inter2 a4 a7 0.5))
		   (t a7)))
	 (a4 (inter2 a3 a4 0.8))
	 )
;    (print `((b3 ,b3) (b2 ,b2)))
    `(((angle .,a0)
       (bezier .,(inter2 a0 a1 0.7))
       (bezier .,(inter2 a2 a1 0.7))
       (angle .,a2)
       (bezier .,(inter2 a2 a3 0.666666))
       (bezier .,(inter2 a4 a3 0.666666))
       (angle .,a4)
       (bezier .,(inter2 a4 a9 0.66666))
       (bezier .,(inter2 a7 a9 0.66666))
       (angle .,a7)
       (bezier .,(inter2 a7 a8 0.66666))
       (bezier .,(inter2 p3 a8 0.66666))
       (angle .,p3))
      ((angle .,b0)
       (bezier .,(second bez0))
       (bezier .,(third bez0))
       (angle .,b3)
       (bezier .,(inter2 b3 b2 0.9))
       (bezier .,(inter2 p3 b2 0.9))
       (angle .,p3)))))
; たすき
(defelement mincho tasuki
  (lets ((dotsize0 (meshwidth mw))
	 (w0 (normwidth dotsize0))
	 (p0 (gridx (car points) dotsize0))
	 (l0 (normlen2 w0 (rot90 (diff2 (caddr points)(cadr points)))))
	 (p1 (gridx (gridy (plus2 (cadr points) l0) dotsize0) dotsize0))
	 (p2 (gridy (plus2 (caddr points) l0) dotsize0))
	 (p3 (fourth points))
	 (p3 (cond ((lessp (metric2 p3 p2)(times w0 2.5))
		    (plus2 p2 (normlen2 (times w0 2.5)(diff2 p3 p2))))
		   (t p3)))
	 (p3 (gridx p3 dotsize0))
	 (w2 (times w0 0.8))
	 (w3 (min (times w0 3.0)(plus w2 (times (metric2 p2 p3) 0.2))))
	 (p2 (plus2 p2 (normlen2 w3 (diff2 p1 p2))))
	 (p01 (inter2 p0 p1 0.6))
	 (p12 (inter2 p2 p1 0.6))
	 (p4 (inter2 p01 p12 0.5))
	 )
    (kokorohane p0 p1 p2 p3 w0 w2 w3)))
;    (curve2 p0 (inter2 p0 p01 0.99) (inter2 p4 p01 0.7) p4 w0 w0 w0 w0
;	    (kokorohane p4 p12 p2 p3 w0 w2 w3))))
; 縦跳ね
(defelement mincho tatehane
  (lets ((dotsize (meshwidth mw))
	 (w (normwidth dotsize))
	 (p0 (gridx (car points) dotsize))
	 (p1 (cadr points))
	 (p1 (gridx (plus2 p1 (normlen2 w (diff2 p0 p1))) dotsize))
	 (p2 (caddr points))
	 (p2 (grid (plus2 p2 (normlen2 w (diff2 p0 p1))) dotsize))
	 (p2 (plus2 p1 (normlen2 (max (metric2 p2 p1)(times w 1.8))
				 (diff2 p2 p1))))
	 (len0 (max (times 2.0 w)
		    (min (times 0.5 (metric2 p0 p1))
			 (times 0.5 (metric2 p1 p2)))))
	 (p01 (plus2 p1 (normlen2 len0 (diff2 p0 p1))))
	 (w1 (min (times w 1.4)
		  (plus w (times (metric2 p1 p2) 0.1))))
	 (w2 (min (times 0.8 (metric2 p2 p1))(times w 5.0)))
	 )
;    (break)
    (line2 p0 p01 w
	   (hane p01 p1 p2 w w1 w2))))
(defun hane (p0 p1 p2 w0 w1 w2)
  (lets ((d0 (diff2 p1 p0))
	 (d1 (diff2 p2 p1))
	 (l0 (normlen2 w0 (rot270 d0)))
	 (l1 (normlen2 w0 (rot270 d1)))
	 (a0 (plus2 p0 l0))
	 (a2 (plus2 p2 (normlen2 w1 l1)))
	 (d2 (diff2 a2 (plus2 l1 (diff2 p1 l0))))
	 (a1 (cross2 a0 a2 d0 d2))
	 (a3 (plus2 a2 (normlen2 w2 d2)))
	 (a4 (plus2 a1 (normlen2 (min (times 0.9 (metric2 a3 a1))
				      (times 1.5 (metric2 a1 a0)))
				 (diff2 a3 a1))))
	 (b0 (diff2 p0 l0))
	 (b1 (diff2 (diff2 p1 l0) l1))
	 (b2 (diff2 p2 (normlen2 w1 l1)))
	 (b4 (plus2 b1 (normlen2 (min (metric2 b2 b1)
				      (times 1.5 (metric2 b0 b1)))
				 (diff2 b2 b1))))
	 (t0 (plus2 a2 (normlen2 w0 d2)))
	 (t1 (diff2 p2 (normlen2 (times w1 -0.2) l1)))
	 (b3 (cross2 a3 b2 (diff2 t1 a3)(diff2 t0 b2)))
	 (b3 (cond ((lessp (metric2 a3 b3) 1.0)
		    (inter2 b2 a3 0.5))
		   (t b3)))
	 )
    `(((angle .,a0)
       (bezier .,(inter2 a0 a1 0.66666))
       (bezier .,(inter2 a4 a1 0.66666))
       (angle .,a4)
;       (angle .,a3)
       )
      ((angle .,b0)
       (bezier .,(inter2 b0 b1 0.66666))
       (bezier .,(inter2 b4 b1 0.66666))
       (angle .,b4)
       (angle .,b2)
       (bezier .,(inter2 b2 b3 0.66666))
       (bezier .,(inter2 a3 b3 0.66666))
       (angle .,a3)))))
; 旁の跳ね
(defelement mincho tsukurihane
  (lets ((dotsize (meshwidth mw))
	 (w (normwidth dotsize))
	 (p0 (gridx (car points) dotsize))
	 (p1 (gridx (cadr points) dotsize))
	 (p2 (caddr points))
	 (p2 (gridx (plus2 p2 (normlen2 w (diff2 p1 p2))) dotsize))
	 (p3 (cadddr points))
	 (p3 (cond ((lessp (metric2 p2 p3)(times 2.5 w))
		    (plus2 p2 (normlen2 (times 2.5 w) (diff2 p3 p2))))
		   (t p3)))
	 (p3 (grid (plus2 p3 (normlen2 w (diff2 p1 p2))) dotsize))
	 (l0 (normlen2 w (rot270 (diff2 p1 p0))))
	 (l1 (normlen2 w (rot270 (diff2 p1 p0))))
	 (l2 (normlen2 w (rot270 (diff2 p1 p0))))
	 (a0 (plus2 p0 l0))
	 (a1 (cross2 a0 (plus2 p2 l1)(diff2 p1 p0)(diff2 p2 p1)))
	 (a2 (cross2 (plus2 p2 l1)(plus2 p3 l2)(diff2 p2 p1)(diff2 p3 p2)))
	 (a3 (cross2 a0(plus2 p3 l2)(diff2 p1 p0)(diff2 p3 p2)))
	 (len0 (min (times 2.0 w)
		    (min (times 0.5 (metric2 p1 p2))
			 (times 0.5 (metric2 p2 p3)))))
	 (p12 (plus2 p2 (normlen2 len0 (diff2 p1 p2))))
	 (w1 (min (times w 1.4)
		  (plus w (times (metric2 p2 p3) 0.1))))
	 (w2 (min (times 0.8 (metric2 p3 p2))(times w 5.0))))
;    (prind `(,p0 ,p1 ,p12 ,p2 ,p3 ,a0 ,a1 ,a2 ,a3))
    (cond ((zerop (sintheta (diff2 p1 p0)(diff2 p2 p0)))
	   (line2 p0 p12 w
		  (hane p12 p2 p3 w w1 w2)))
	  ((greaterp (metric2 a0 a3)(metric2 a0 a1))
	   (setq p12 
		 (diff2 (plus2 a2 (normlen2 (min (times 0.5 (metric2 a1 a2))
						 (times 1.5 w))
					    (diff2 a1 a2)))
			l1))
;	   (prind p12)
	   (curve2 p0 (inter2 p0 p1 0.66666)(inter2 p12 p1 0.66666) p12 w w w w
		   (hane p12 p2 p3 w w1 w2)))
	  (t
	   (setq p12 (cross2 p0 p3 (diff2 p1 p0)(diff2 p2 p3)))
	   (hane p0 p12 p3 w w1 w2)))))
; こざと偏の一部
(defelement mincho kozato
  (lets ((dotsize (meshwidth mw))
	 (w (normwidth dotsize))
	 (p0 (gridx (car points) dotsize))
	 (p1 (gridx (cadr points) dotsize))
	 (p2 (caddr points))
	 (p2 (gridx (plus2 p2 (normlen2 w (diff2 p1 p2))) dotsize))
	 (p3 (cadddr points))
	 (p3 (grid (plus2 p3 (normlen2 w (diff2 p1 p2))) dotsize))
	 (len0 (max (times 2.0 w)
		    (times 0.5 (metric2 p1 p2))))
	 (p12 (plus2 p2 (normlen2 len0 (diff2 p1 p2))))
	 (w1 (min (times w 1.4)
		  (plus w (times (metric2 p2 p3) 0.1))))
	 (w2 (min (times 0.8 (metric2 p3 p2))(times w 5.0))))
    (curve2 p0 (inter2 p0 p1 0.66666)(inter2 p12 p1 0.66666) p12 
	    (times 0.2 w)
	    (times 0.7 w)
	    w w
	    (hane p12 p2 p3 w w1 w2))))
; さんずい
(defelement mincho sanzui
  (lets ((dotsize (meshwidth mw))
	 (w (normwidth dotsize))
	 (p0 (car points))
	 (p1 (cadr points))
	 (v (diff2 p1 p0))
	 (vx (car v))
	 (vy (cadr v))
	 (p0 (plus2 p0 `(,(times -0.8 (difference vx 34.0)) 0)))
	 (p2 (plus2 p0 `(,(times 0.03 vy) ,(times 0.3 vy))))
	 (p3 (plus2 p2 `(,(times 0.16 vy) ,(times 0.08 vy))))
	 (p0 (grid p0 dotsize))
	 (p1 (grid p1 1))
	 (p3 (grid p3 1))
	 (d0 (diff2 p2 p0))
	 (d1 (diff2 p1 p2))
	 (l0 (rot270 d0))
	 (w1 (times w (//$ 1.0 (sintheta d0 d1))))
;	 (w1 w)
	 (t0 (plus2 p2 (normlen2 w1 d0)))
	 (t1 (diff2 p2 (normlen2 w1 d0)))
	 (w2 (times 0.6 w (//$ -1.0 (sintheta d0 (diff2 p3 p2)))))
;	 (w2 w)
	 (t2 (plus2 p2 (normlen2 w2 d0)))
	 (t3 (diff2 p2 (normlen2 w2 d0)))
	 (b4 (cross2 p3 p1 (diff2 t2 p3)(diff2 t0 p1)))
	 (b4 (plus2 t2 (normlen2 (min (times 0.9 (metric2 t2 p3))
				      (metric2 b4 t2))
				(diff2 p3 t2))))
	 (a0 (plus2 p0 (normlen2 (times 1.5 w) l0)))
	 (a2 (cross2 a0 p1
		     (diff2 (plus2 p2 (normlen2 (times w 0.5) l0)) a0)
		     (diff2 t1 p1)))
	 (b0 (diff2 p0 (normlen2 (times 1.5 w) l0)))
	 (b2 (cross2 b0 p3 
		     (diff2 (plus2 p2 (normlen2 (times w -0.5) l0)) b0)
		     (diff2 t3 p3)))
	 (b1 (inter2 b0 b2 0.5))
	 (a1 (inter2 a0 a2 0.5))
	 (a3 (plus2 a2 (normlen2 (min (times 1.5 (metric2 a1 a2))
				      (times 0.9 (metric2 p1 a2)))
				 (diff2 p1 a2))))
	 (b5 (plus2 b4 (normlen2 (min (times 1.5 (metric2 p3 b4))
				      (times 0.9 (metric2 p1 b4)))
				 (diff2 p1 b4)))))
;    (break)
    `(((angle .,p0)
       (bezier .,(inter2 p0 a0 0.66666))
       (bezier .,(inter2 a1 a0 0.66666))
       (angle .,a1)
       (bezier .,(inter2 a1 a2 0.9))
       (bezier .,(inter2 a3 a2 0.9))
       (angle .,a3)
       (angle .,p1))
      ((angle .,p0)
       (bezier .,(inter2 p0 b0 0.66666))
       (bezier .,(inter2 b1 b0 0.66666))
       (angle .,b1)
       (bezier .,(inter2 b1 b2 0.66666))
       (bezier .,(inter2 p3 b2 1.0))
       (angle .,p3)
       (bezier .,(inter2 p3 b4 1.0))
       (bezier .,(inter2 b5 b4 0.66666))
       (angle .,b5)
       (angle .,p1)))))

; 左はらいの定義
(defelement mincho hidari
  (lets ((dotsize (meshwidth mw))
	 (w (normwidth dotsize))
	 (p0 (grid (car points) dotsize))
	 (p1 (grid (cadr points) dotsize))
	 (p2 (grid (caddr points) 1))
	 (w (min w (times 0.35 (metric2 p0 p2))))
	 (d0 (diff2 p1 p0))
	 (d1 (diff2 p2 p1))
	 (l0 (rot270 d0))
	 (l1 (rot270 d1))
	 (len0 (metric2 p0 p1))
	 (rate (//$ len0 (plus (metric2 p1 p2) len0)))
	 (theta (theta d0 d1))
	 (w1 (inter (times rate w) w
		    (min 1.0 (times theta 0.7))))
	 (rate0 (max 0.666666 
		     (plus 1.0 (times 0.5 
				      (difference 1.0 (quotient 1.0 rate))))))
	 (a0 (plus2 p0 (normlen2 w l0)))
	 (w2 (times 0.1 mw))
	 (a2 (plus2 p2 (normlen2 w2 l0)))
	 (a1 (cross2 a0 a2
		     (diff2 (plus2 p1 (normlen2 w1 l0)) a0)
		     (diff2 (plus2 p1 (normlen2 w1 l1)) a2)))
	 (a1 (cond ((or (greaterp (metric2 a0 a1)(metric2 a0 p2))
			(greaterp (metric2 a1 p2)(metric2 a0 p2)))
		    (inter2 a0 p2 0.5))
		   (t a1)))
	 (b0 (diff2 p0 (normlen2 w l0)))
	 (b2 (diff2 p2 (normlen2 w2 l0)))
	 (b1 (cross2 b0 b2
		     (diff2 (diff2 p1 (normlen2 w1 l0)) b0)
		     (diff2 (diff2 p1 (normlen2 w1 l1)) b2))))
;    (break)
    `(((angle .,a0)
       (bezier .,(inter2 a0 a1 rate0))
       (bezier .,(inter2 p2 a1 0.9))
       (angle .,a2))
      ((angle .,b0)
       (bezier .,(inter2 b0 b1 rate0))
       (bezier .,(inter2 p2 b1 0.8))
       (angle .,b2)))))
;
(defun last-joint (prim)
  (lets ((elements (cadr prim))
	 (lastpoints))
    (do ((l elements (cdr l)))
      ((atom l))
      (or (and (memq (caar l) '(hidari tatehidari migiue))
	       (push (car (last (cadar l))) lastpoints))
	  (and (memq (caar l) '(ten migi))
;	       (print (car (cadar l)))
	       (push (car (cadar l)) lastpoints))))
    (do ((l elements (cdr l))(newelements)(link))
      ((atom l) `(,(car prim),(nreverse newelements).,(cddr prim)))
      (cond ((setq link (assq 'link (cddar l)))
	     (do ((ll (cdr link)(cdr ll))(ret))
	       ((atom ll)
		(push `(,(caar l),(cadar l)
			(link .,(nreverse ret)).,(cddar l))
			newelements))
	       (or (memq (car ll) lastpoints)(push (car ll) ret))))
	    (t
	     (push (car l) newelements))))))
;
(defun mincho-prim (prim)
;  (prind 'hook)
  (lets ((prim (rm-geta prim (times minchowidth 2.0)))
	 (prim (last-joint prim))
	 (points (car prim))
	 (elements (cadr prim))
	 (alist (cddr prim))
	 (units (units 
		 `(,points ,elements 
			   .,(every alist 
				    #'(lambda (x) 
					(not (memq (car x) 
						   '(xunit yunit))))))))
	 (xunit (car units))
	 (yunit (cdr units))
	 (tome (times minchowidth tomeheight))
	 (points-alist)
	 (ylen)
	 (minylen)
	 )
    (do ((l elements (cdr l))(element)(link))
      ((atom l))
      (setq element (car l))
      (do ((ll (cadr element)(cdr ll))(ass))
	((atom ll))
	(setq ass (assq (car ll) points-alist))
	(cond (ass (rplacd ass (add1 (cdr ass))))
	      (t (push `(,(car ll) . 1)points-alist ))))
      (setq link (assq 'link (cddr element)))
      (and link 
	   (do ((ll (cdr link)(cdr ll))(ass))
	     ((atom ll))
	     (setq ass (assq (car ll) points-alist))
	     (cond (ass (rplacd ass (add1 (cdr ass))))
		   (t (push `(,(car ll) . 1)points-alist))))))
   (do ((l elements (cdr l))(element)(p0)(p1)(ylen))
      ((atom l))
      (setq element (car l))
      (cond ((eq (car element) 'yoko)
	     (setq p0 (nth (car (cadr element)) points))
	     (setq p1 (nth (cadr (cadr element)) points))
	     (setq ylen (metric2 p0 p1))
	     (cond ((and 
		     (eq 1 (cdr (assq (cadr (cadr element)) points-alist)))
		     (or (null minylen)(lessp ylen minylen)))
		    (setq minylen ylen))))))
   (cond ((null minylen)
	  (setq tome1 (min tome (times yunit 0.8))))
	 (t
	  (setq tome1 (min tome (times yunit 0.8)(quotient minylen 4.0)))))
;   (print `(,tome1 ,tome ,yunit ,minylen))
   (setq mw (min minchowidth (times xunit 0.25)))
;   (setq mw minchowidth)
  prim))
;
(deftypehook mincho
  (function mincho-prim))
;
(def-type1-hint mincho tate
  (lets ((p0 (car points))
	 (p1 (cadr points))
	 (x (car p0))
	 (w mw))
    (cond ((equal x (car p1))
	   `((v ,(difference x w).,(plus x w)))))))
(comment
(defelement mincho yoko
  (line2 (car points)(cadr points)(times mw tateyokoratio)))
)
;
(def-type1-hint mincho yoko
  (lets ((dotsize (meshwidth (times mw tateyokoratio)))
	 (w (normwidth dotsize))
	 (p0 (gridy (car points) dotsize))
	 (y (cadr p0))
	 (p1 (gridy (cadr points) dotsize)))
    (cond ((equal y (cadr p1))
	   `((h ,(difference y w).,(plus y w)))))))
ktanaka

Powered by ViewCVS 1.0-dev

ViewCVS and CVS Help