| ; という瘢雹2つのoutlineを得る. |
; という瘢雹2つのoutlineを得る. |
| ; |
; |
| (defun makeoutline (orig) |
(defun makeoutline (orig) |
| (lets ((all)(ass)) |
(lets ((all)(ass)(ret)) |
| (do ((l (append_outs orig)(cdr l))(i 0)(j 0 (1+ j))) |
(do ((l (append_outs orig)(cdr l))(i 0)(j 0 (1+ j))) |
| ((atom l)) |
((atom l)) |
| (setq ret (append_self (car l))) |
(setq ret (append_self (car l))) |
| (maxbx (max bx0 bx1 bx2 bx3)) |
(maxbx (max bx0 bx1 bx2 bx3)) |
| (maxby (max by0 by1 by2 by3)) |
(maxby (max by0 by1 by2 by3)) |
| (minbx (min bx0 bx1 bx2 bx3)) |
(minbx (min bx0 bx1 bx2 bx3)) |
| (minby (min by0 by1 by2 by3))(ret)(len0)(len1)) |
(minby (min by0 by1 by2 by3))(ret)(len0)(len1)(lena)(lenb)(ss)(tt)) |
| (cond ((or (lessp maxax minbx)(lessp maxbx minax) |
(cond ((or (lessp maxax minbx)(lessp maxbx minax) |
| (lessp maxay minby)(lessp maxby minay)) |
(lessp maxay minby)(lessp maxby minay)) |
| nil) |
nil) |
| (maxbx (max bx0 bx1 bx2 bx3)) |
(maxbx (max bx0 bx1 bx2 bx3)) |
| (maxby (max by0 by1 by2 by3)) |
(maxby (max by0 by1 by2 by3)) |
| (minbx (min bx0 bx1 bx2 bx3)) |
(minbx (min bx0 bx1 bx2 bx3)) |
| (minby (min by0 by1 by2 by3))(ret)) |
(minby (min by0 by1 by2 by3))(ret)(lena)(lenb)(ss)(tt)) |
| (cond ((or (lessp maxax minbx)(lessp maxbx minax) |
(cond ((or (lessp maxax minbx)(lessp maxbx minax) |
| (lessp maxay minby)(lessp maxby minay)) |
(lessp maxay minby)(lessp maxby minay)) |
| nil) |
nil) |
| ; (prind `(tracestart ,point ,i ,j)) |
; (prind `(tracestart ,point ,i ,j)) |
| (lets ((l (nth j (nth i outs))) |
(lets ((l (nth j (nth i outs))) |
| (type (caar l)) |
(type (caar l)) |
| (crosses (cdr l))(cross)) |
(crosses (cdr l))(cross)(point1)) |
| (do ((ll crosses (cdr ll))) |
(do ((ll crosses (cdr ll))) |
| ((atom ll)) |
((atom ll)) |
| (and (equal point (third (car ll)))(exit (setq cross ll)))) |
(and (equal point (third (car ll)))(exit (setq cross ll)))) |
| i))))) |
i))))) |
| (bezier |
(bezier |
| (lets ((p0 (second (car l)))(p1 (third (car l))) |
(lets ((p0 (second (car l)))(p1 (third (car l))) |
| (p2 (fourth (car l)))(p3 (fifth (car l)))) |
(p2 (fourth (car l)))(p3 (fifth (car l)))(t0)(t3)(c)(point3)) |
| (cond |
(cond |
| ((cdr cross) |
((cdr cross) |
| (setq t0 (caar cross) t3 (caadr cross)) |
(setq t0 (caar cross) t3 (caadr cross)) |
| (or (memq (second (car ll)) '(-2 -3 2 3)) |
(or (memq (second (car ll)) '(-2 -3 2 3)) |
| (lets ((p0 (third (car ll))) |
(lets ((p0 (third (car ll))) |
| (tlen (plus alllen (times tmplen (first (car ll))))) |
(tlen (plus alllen (times tmplen (first (car ll))))) |
| (p1)(len (times -1 tmplen (first (car ll))))) |
(p1)(len (times -1 tmplen (first (car ll))))(pos)) |
| (setq |
(setq |
| pos |
pos |
| (catch 'found |
(catch 'found |
| ; (prind `(len ,len loop_len ,loop_len)) |
; (prind `(len ,len loop_len ,loop_len)) |
| )))) |
)))) |
| ; (prind sorted) |
; (prind sorted) |
| (do ((l sorted (cdr l))(ret)(wait)) |
(do ((l sorted (cdr l))(ret)(wait)(unflatten)) |
| ((atom l) |
((atom l) |
| ; (prind (reverse ret)) |
; (prind (reverse ret)) |
| (setq unflatten (unflatten_outline (mapcar (nreverse ret) #'car))) |
(setq unflatten (unflatten_outline (mapcar (nreverse ret) #'car))) |
| (defun checkwinding (out) |
(defun checkwinding (out) |
| (do ((l (cdr (append out (ncons (car out)))) (cdr l)) |
(do ((l (cdr (append out (ncons (car out)))) (cdr l)) |
| (lastdir (diff2 (cdr (cadr out))(cdr (car out)))) |
(lastdir (diff2 (cdr (cadr out))(cdr (car out)))) |
| (thetasum 0.0)) |
(thetasum 0.0)(thisdir)) |
| ((atom (cdr l)) |
((atom (cdr l)) |
| (setq thisdir (diff2 (cdr (cadr out))(cdr (car out)))) |
(setq thisdir (diff2 (cdr (cadr out))(cdr (car out)))) |
| (setq thetasum (plus thetasum (theta thisdir lastdir))) |
(setq thetasum (plus thetasum (theta thisdir lastdir))) |