1 : |
ktanaka |
1.1 |
;; |
2 : |
|
|
;; version.l |
3 : |
|
|
;; $Revision$ |
4 : |
|
|
;; |
5 : |
|
|
|
6 : |
|
|
(defun version-up-skelton (prim) |
7 : |
|
|
(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 : |
|
|
',(version-up-skelton (eval x)))))) |
42 : |
|
|
(close standard-output))) |
43 : |
|
|
|
44 : |
|
|
|
45 : |
|
|
|