*** empty log message ***
;; ;; version.l ;; $Revision: 1.1 $ ;; (defun version-up-skeleton (prim) (let ((points (get-points prim)) (elems (get-lines prim)) (aux (get-aux-info prim))) (setq elems (mapcar elems #'(lambda (el) (if (and (eq (first el) 'hira-circle) (eq (length (second el)) 1)) (let ((hira-c (get-info el 'hiracircle))) (if (null hira-c) (setq hira-c (list 30 30 *default-hirawidth*))) (lets ((center (nth (caadr el) points)) (x0 (first center)) (y0 (second center)) (x1 (- x0 (first hira-c))) (y1 (- y0 (second hira-c)))) (setq points (append points (ncons (list x1 y1)))) (setq el (cons 'hira-circle (cons (list (caadr el) (1- (length points))) (cddr el)))) (put-info el 'hirawidth (list 0 (third hira-c))) (rem-info el 'hiracircle) el))) el))) (cons points (cons elems aux)))) (defun output () (let ((standard-output (outopen (stream 'papipu)))) (mapcar '(¤Ñ ¤Ô ¤× ¤Ú ¤Ý ¡û) #'(lambda (x) (prind `(setq ,x ',(version-up-skeleton (eval x)))))) (close standard-output)))
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |