Annotation of /renderer/sym.lAnnotation of /renderer/sym.l
Parent Directory
| 
Revision Log
Revision: 1.1 - (view) (download)
| 1 : | ktanaka | 1.1 | (defelement mincho outline |
| 2 : | (lets ((points (reverse (cdr (reverse (mapcar points #'(lambda (x) `(,(car x) ,(cadr x)))))))) | ||
| 3 : | (npoints (length points)) | ||
| 4 : | (cpoints (assq 'curve alist)) | ||
| 5 : | (cpoints (and cpoints (cdr cpoints))) | ||
| 6 : | ; (dummy (print `(cpoints ,cpoints))) | ||
| 7 : | (apoints (do ((i 0 (1+ i))(l cpoints)(ret)) | ||
| 8 : | ((>= i npoints)(nreverse ret)) | ||
| 9 : | (cond ((and l (equal i (car l))) | ||
| 10 : | (setq l (cdr l))) | ||
| 11 : | (t (push i ret))))) | ||
| 12 : | ; (dummy (print `(apoints ,apoints))) | ||
| 13 : | ; (apoints (and apoints (cdr apoints))) | ||
| 14 : | ; (apoints (filter apoints #'(lambda (x) (< x npoints)))) | ||
| 15 : | ) | ||
| 16 : | (cond (apoints | ||
| 17 : | (do ((l apoints (cdr l)) | ||
| 18 : | (ret `((angle .,(nth (car apoints) points))))) | ||
| 19 : | ((atom (cdr l)) | ||
| 20 : | (setq ret (append ret (cdr (curve_points (append (nthcdr (car l) points) | ||
| 21 : | (take (1+ (car apoints)) points)))))) | ||
| 22 : | ; (prind ret) | ||
| 23 : | `(,(adjust-points (car points)ret) | ||
| 24 : | ((angle .,(car points))(angle .,(car points))))) | ||
| 25 : | (setq ret (append ret | ||
| 26 : | (cdr (curve_points (take (1+ (- (cadr l) (car l))) (nthcdr (car l) points)))))) | ||
| 27 : | ; (prind ret) | ||
| 28 : | )) | ||
| 29 : | (t | ||
| 30 : | (round_points points))))) | ||
| 31 : | (defun adjust-points (point points) | ||
| 32 : | (do ((i 0 (1+ i))(l points (cdr l))) | ||
| 33 : | ((atom l)points) | ||
| 34 : | (and (equal (car point) (cadr (car l))) | ||
| 35 : | (equal (cadr point)(caddr (car l))) | ||
| 36 : | (exit (append l (take i (cdr points))))))) | ||
| 37 : | (defun take (n l) | ||
| 38 : | (cond ((or (<= n 0)(atom l))nil) | ||
| 39 : | (t (cons (car l)(take (1- n) (cdr l)))))) | ||
| 40 : | (defun curve_points (points) | ||
| 41 : | ; (prind points) | ||
| 42 : | (cond ((equal 2 (length points)) | ||
| 43 : | `((angle .,(car points))(angle .,(cadr points)))) | ||
| 44 : | (t | ||
| 45 : | (tenhokan points #'(lambda (x) x))))) | ||
| 46 : | (defun round_points (points) | ||
| 47 : | (lets ((out1 (tenhokan points | ||
| 48 : | #'(lambda (x) x) | ||
| 49 : | t))) | ||
| 50 : | `(,out1 | ||
| 51 : | ((angle .,(car points))(angle .,(car points)))))) |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |