View of /renderer/naal.l

Parent Directory

Revision Log

*** empty log message ***

(declare (naalr local_gothicwidth) special)
(deftypehook gothic
  (function gothic-prim))
(subfont naal gothic)
(setq circle-ratio (quotient (times 4.0 (difference (sqrt 2) 1)) 3.0))
(defkazari naal ((tate hidari  tatehidari kokoro magaritate tasuki tatehane tsukurihane kagi) 0
		 yoko 1)
  (naalout (vref cross 0)(vref cross 1)(vref cross 2)(vref cross 3)))
(defkazari naal ((tate hidari  tatehidari kokoro magaritate tasuki tatehane tsukurihane kagi) 1
		 yoko 0)
  (naalin  (vref cross 0)(vref cross 1)(vref cross 2)(vref cross 3)))
(defkazari naal ((tate hidari  tatehidari kokoro magaritate tasuki tatehane tsukurihane kagi) 1
		 yoko 3)
  (naalout (vref cross 2)(vref cross 3)(vref cross 0)(vref cross 1)))
(defkazari naal ((tate hidari  tatehidari kokoro magaritate tasuki tatehane tsukurihane kagi) 0
		 yoko 2)
  (naalin (vref cross 2)(vref cross 3)(vref cross 0)(vref cross 1)))
(defkazari naal ((tate hidari  tatehidari kokoro magaritate tasuki tatehane tsukurihane kagi) 2
		 (kozato yoko) 0)
  (naalout (vref cross 1)(vref cross 0)(vref cross 3)(vref cross 2)))
(defkazari naal ((tate hidari  tatehidari kokoro magaritate tasuki tatehane tsukurihane kagi) 3
		 (kozato yoko) 1)
  (naalin (vref cross 1)(vref cross 0)(vref cross 3)(vref cross 2)))
(defkazari naal ((tate hidari  tatehidari kokoro magaritate tasuki tatehane tsukurihane kagi) 3
		 yoko 2)
  (naalout (vref cross 3)(vref cross 2)(vref cross 1)(vref cross 0)))
(defkazari naal ((tate hidari  tatehidari kokoro magaritate tasuki tatehane tsukurihane kagi) 2
		 yoko 3)
  (naalin (vref cross 3)(vref cross 2)(vref cross 1)(vref cross 0)))

(defkazari naal ((yoko ten migiue kozato tasuki sanzui) 0
		 (yoko ten migiue kozato tasuki sanzui) 1)
  (naalstart (vref cross 0)(vref cross 1)(vref cross 2)(vref cross 3)))
(defkazari naal ((kagi) 0
		 (kagi) 1)
  (naalstart (vref cross 0)(vref cross 1)(vref cross 2)(vref cross 3)))
(defkazari naal ((yoko ten migiue kozato kagi tasuki sanzui) 2
		 (yoko ten migiue kozato kagi tasuki sanzui) 3)
  (reverse 
   (naalstart (vref cross 1)(vref cross 0)(vref cross 3)(vref cross 2))))
(defkazari naal ((tate hidari  tatehidari kokoro magaritate tasuki migi) 0
		 (tate hidari  tatehidari kokoro magaritate tasuki migi) 1)
  (naalstart (vref cross 0)(vref cross 1)(vref cross 2)(vref cross 3)))
(defkazari naal ((tate hidari  tatehidari magaritate migi) 2
		 (tate hidari  tatehidari magaritate migi) 3)
  (reverse 
   (naalstart (vref cross 1)(vref cross 0)(vref cross 3)(vref cross 2))))
(defkazari naal ((tatehane tsukurihane shin-nyuu hira-long) 0
		 (tatehane tsukurihane shin-nyuu hira-long) 1)
  (naalstart (vref cross 0)(vref cross 1)(vref cross 2)(vref cross 3)))
(defkazari naal ((shin-nyuu hira-long) 2
		 (shin-nyuu hira-long) 3)
 (reverse 
   (naalstart (vref cross 1)(vref cross 0)(vref cross 3)(vref cross 2))))
(defkazari naal ((tatehane tsukurihane kokoro tasuki) 2
		 (tatehane tsukurihane kokoro tasuki) 3)
  (reverse 
   (naalstart1 (vref cross 1)(vref cross 0)(vref cross 3)(vref cross 2) 20)))
(defun naalstart1 (p0 p1 p2 p3 offset)
  (lets ((v (normlen2 offset (diff2 p0 p2))))
    (naalstart (plus2 p0 v)(plus2 p1 v)(plus2 p2 v)(plus2 p3 v))))

;
(defun naalhane (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 a3)
	 (b0 (diff2 p0 l0))
	 (b1 (diff2 (diff2 p1 l0) l1))
	 (b2 (diff2 p2 (normlen2 w1 l1)))
	 (b4 b2)
	 (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)))))
(defun naalstart (p0 p1 p2 p3)
  (lets ((p0 (inter2 p0 p1 0.01))(p2 (inter2 p2 p3 0.01))
	 (p02 (inter2 p0 p2 0.499))
	 (p01 (inter2 p0 p1 0.45))
	 (p13 (inter2 p1 p3 0.45)))
    `((angle .,p02)
      (bezier .,(inter2 p02 p0 circle-ratio))
      (bezier .,(inter2 p01 p0 circle-ratio))
      (angle .,p01)
      (bezier .,(inter2 p01 p1 circle-ratio))
      (bezier .,(inter2 p13 p1 circle-ratio))
      (angle .,p13))))
(setq naalr nil)
(defun naalout (p0 p1 p2 p3)
  (lets	((l (min (plus (metric2 p3 p2) naalr) (times 1.9 (metric2 p3 p2))))
	 (a0 (plus2 p1 (normlen2 l(diff2 p0 p1))))
	 (a1 (plus2 p1 (normlen2 l(diff2 p3 p1)))))
    `((angle .,a0)
      (bezier .,(inter2 a0 p1 circle-ratio))
      (bezier .,(inter2 a1 p1 circle-ratio))
      (angle .,a1))))
(defun naalin (p0 p1 p2 p3)
  (lets ((costheta (costheta (diff2 p2 p3)(diff2 p2 p0)))
	 (diffl (times costheta (metric2 p2 p3)))
	 (l (difference (min naalr (times 0.9 (metric2 p3 p2))) diffl))
	 (b0 (plus2 p2 (normlen2 l (diff2 p2 p3))))
	 (b1 (plus2 p2 (normlen2 l (diff2 p2 p0)))))
    (cond ((greaterp costheta 0.3)
	   `((angle .,p2)))
	  (t
	   `((angle .,b0)
	     (bezier .,(inter2 b0 p2 circle-ratio))
	     (bezier .,(inter2 b1 p2 circle-ratio))
	     (angle .,b1))))))
;
(deftypehook naal
  (function naal-prim))
;
(defun naalr (prim)
  (lets ((points (car prim))
	 (elements (cadr prim))
	 (once)(twice)(ret (times local_gothicwidth 10)))
    (do ((l elements (cdr l)))
      ((atom l))
      (do ((ll (cadr (car l))(cdr ll)))
	((atom ll))
	(cond ((memq (car ll) twice))
	      ((memq (car ll) once)
	       (push (car ll) twice))
	      (t
	       (push (car ll) once)))))
    (do ((l elements (cdr l))(p0)(p1)(r))
      ((atom l)
       (times 0.49
	      (difference ret (times local_gothicwidth 2))))
      (cond ((and (memq (setq p0 (first (cadr (car l)))) twice)
		  (memq (setq p1 (car (last (cadr (car l))))) twice))
	     (setq r (metric2 (nth p0 points)(nth p1 points)))
	     (and (lessp r ret)(setq ret r)))
	    ((or (memq (setq p0 (first (cadr (car l)))) twice)
		 (memq (setq p1 (car (last (cadr (car l))))) twice))
	     (setq r (times 1.1 (metric2 (nth p0 points)(nth p1 points))))
	     (and (lessp r ret)(setq ret r)))))))
       
;
(defun naal-prim (prim)
  (lets ((prim (last-joint (gothic-prim prim))))
    (setq naalr (naalr prim))
    prim))
;
; 縦跳ね
;
(defelement gothic tatehane
  (lets ((p0 (car points))
	 (p1 (cadr points))
	 (p2 (caddr points))
	 (w local_gothicwidth)
	 (p1 (plus2 p1 (normlen2 w (diff2 p0 p1))))
	 (p2 (plus2 p2 (normlen2 w (diff2 p0 p1))))
	 (len0 (metric2 p0 p1))
	 (len1 (metric2 p1 p2))
	 (p01 (inter2 p1 p0 (quotient len1 len0)))
	 (p2 (plus2 p1 (normlen2 (max (times 2.0 w)(metric2 p2 p1))
				 (diff2 p2 p1)))))
    (line2 p0 p01 w (naalhane p01 p1 p2 w w w))))
;
; こざと偏の一部
;
(defelement gothic kozato
  (lets ((p0 (car points))
	(p1 (cadr points))
	(p2 (caddr points))
	(p3 (fourth points))
	(p12 (inter2 p1 p2 0.5))
	(w local_gothicwidth))
    (curve2 p0 (inter2 p0 p1 0.6)(inter2 p12 p1 0.6) p12
	    w w w w
	    (naalhane p12 p2 p3
		    w w w))))
;
; 旁の跳ね
;	    
(defelement gothic tsukurihane
  (lets ((p0 (car points))
	 (p1 (cadr points))
	 (p2 (caddr points))
	 (p3 (cadddr points))
	 (w local_gothicwidth)
	 (p2 (plus2 p2 (normlen2 w (diff2 p1 p2))))
	 (p3 (plus2 p3 (normlen2 w (diff2 p1 p2))))
	 (p3 (cond ((lessp (metric2 p2 p3) (times w 2))
		    (plus2 p2 (normlen2 (times w 2)(diff2 p3 p2))))
		   (t p3)))
	 (p4 (inter2 p1 p2 0.5))
	 )
    (curve2 p0 (inter2 p0 p1 0.6)(inter2 p4 p1 0.6) p4
	    w w w w
	    (naalhane p4 p2 p3
		    w w w))))