| 1 : |
ktanaka |
1.1 |
;; |
| 2 : |
|
|
;; version.l |
| 3 : |
ktanaka |
1.2 |
;; $Revision: 1.1.1.1 $ |
| 4 : |
ktanaka |
1.1 |
;; |
| 5 : |
|
|
|
| 6 : |
ktanaka |
1.2 |
(defun version-up-skeleton (prim) |
| 7 : |
ktanaka |
1.1 |
(let ((points (get-points prim)) |
| 8 : |
|
|
(elems (get-lines prim)) |
| 9 : |
|
|
(aux (get-aux-info prim))) |
| 10 : |
|
|
(setq |
| 11 : |
|
|
elems |
| 12 : |
|
|
(mapcar elems |
| 13 : |
|
|
#'(lambda (el) |
| 14 : |
|
|
(if (and (eq (first el) 'hira-circle) |
| 15 : |
|
|
(eq (length (second el)) 1)) |
| 16 : |
|
|
(let ((hira-c (get-info el 'hiracircle))) |
| 17 : |
|
|
(if (null hira-c) |
| 18 : |
|
|
(setq hira-c (list 30 30 *default-hirawidth*))) |
| 19 : |
|
|
(lets ((center (nth (caadr el) points)) |
| 20 : |
|
|
(x0 (first center)) |
| 21 : |
|
|
(y0 (second center)) |
| 22 : |
|
|
(x1 (- x0 (first hira-c))) |
| 23 : |
|
|
(y1 (- y0 (second hira-c)))) |
| 24 : |
|
|
(setq points (append points (ncons (list x1 y1)))) |
| 25 : |
|
|
(setq el |
| 26 : |
|
|
(cons 'hira-circle |
| 27 : |
|
|
(cons (list (caadr el) |
| 28 : |
|
|
(1- (length points))) |
| 29 : |
|
|
(cddr el)))) |
| 30 : |
|
|
(put-info el 'hirawidth (list 0 (third hira-c))) |
| 31 : |
|
|
(rem-info el 'hiracircle) |
| 32 : |
|
|
el))) |
| 33 : |
|
|
el))) |
| 34 : |
|
|
(cons points (cons elems aux)))) |
| 35 : |
|
|
|
| 36 : |
|
|
(defun output () |
| 37 : |
|
|
(let ((standard-output (outopen (stream 'papipu)))) |
| 38 : |
|
|
(mapcar '(¤Ñ ¤Ô ¤× ¤Ú ¤Ý ¡û) |
| 39 : |
|
|
#'(lambda (x) |
| 40 : |
|
|
(prind `(setq ,x |
| 41 : |
ktanaka |
1.2 |
',(version-up-skeleton (eval x)))))) |
| 42 : |
ktanaka |
1.1 |
(close standard-output))) |
| 43 : |
|
|
|
| 44 : |
|
|
|
| 45 : |
|
|
|
Annotation of /lisp/tools/version.l
Parent Directory
| 
Revision Log