| 1 : |
ktanaka |
1.1 |
(defun hrev (prim) |
| 2 : |
|
|
(do ((l (car prim)(cdr l))(newpoints)) |
| 3 : |
|
|
((atom l) |
| 4 : |
|
|
(do ((ll (cadr prim)(cdr ll))(newelements)) |
| 5 : |
|
|
((atom ll) |
| 6 : |
|
|
`(,(nreverse newpoints),(nreverse newelements) .,(cddr prim))) |
| 7 : |
|
|
(cond ((eq 'outline (caar ll)) |
| 8 : |
|
|
(lets ((points (cadar ll)) |
| 9 : |
|
|
(len (length points)) |
| 10 : |
|
|
(curve (assq 'curve (cddar ll))) |
| 11 : |
|
|
(curve (cond (curve (cdr curve))))) |
| 12 : |
|
|
(push `(outline ,(reverse points) |
| 13 : |
|
|
(curve .,(reverse (mapcar curve |
| 14 : |
|
|
#'(lambda (x) (- len 1 x)))))) |
| 15 : |
|
|
newelements))) |
| 16 : |
|
|
(t (push (car ll) newelements))))) |
| 17 : |
|
|
(push `(,(difference 400 (caar l)).,(cdar l)) newpoints))) |
| 18 : |
|
|
(defun vrev (prim) |
| 19 : |
|
|
(do ((l (car prim)(cdr l))(newpoints)) |
| 20 : |
|
|
((atom l) |
| 21 : |
|
|
(do ((ll (cadr prim)(cdr ll))(newelements)) |
| 22 : |
|
|
((atom ll) |
| 23 : |
|
|
`(,(nreverse newpoints),(nreverse newelements) .,(cddr prim))) |
| 24 : |
|
|
(cond ((eq 'outline (caar ll)) |
| 25 : |
|
|
(lets ((points (cadar ll)) |
| 26 : |
|
|
(len (length points)) |
| 27 : |
|
|
(curve (assq 'curve (cddar ll))) |
| 28 : |
|
|
(curve (cond (curve (cdr curve))))) |
| 29 : |
|
|
(push `(outline ,(reverse points) |
| 30 : |
|
|
(curve .,(reverse (mapcar curve |
| 31 : |
|
|
#'(lambda (x) (- len 1 x)))))) |
| 32 : |
|
|
newelements))) |
| 33 : |
|
|
(t (push (car ll) newelements))))) |
| 34 : |
|
|
(push `(,(caar l) ,(difference 400 (cadar l)).,(cddar l)) newpoints))) |
Annotation of /lisp/test/rev.l
Parent Directory
| 
Revision Log