Annotation of /skeleton-edit/version.lAnnotation of /skeleton-edit/version.l
Parent Directory
| 
Revision Log
Revision: 1.1 - (view) (download)
| 1 : | ktanaka | 1.1 | ;; |
| 2 : | ;; version.l | ||
| 3 : | ;; $Revision: 1.2 $ | ||
| 4 : | ;; | ||
| 5 : | |||
| 6 : | (defun version-up-skeleton (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-skeleton (eval x)))))) | ||
| 42 : | (close standard-output))) | ||
| 43 : | |||
| 44 : | |||
| 45 : |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |