[wadalabfont-kit] / skeleton-edit / version.l  

View of /skeleton-edit/version.l

Parent Directory | Revision Log
Revision: 1.1 - (download) (annotate)
Fri Jun 27 00:52:12 2003 UTC (20 years, 10 months ago) by ktanaka
Branch: MAIN
CVS Tags: SNAP-20040518, SNAP-20030702, SNAP-20030630, HEAD
*** 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