View of /lisp/test/changeprim.l

Parent Directory

Revision Log

change to CVS wadalab font project

(defun changeprimfile (filename (outfile))
  (let ((is (inopen (stream filename)))
	(standard-output 
	 (cond (outfile (outopen (stream outfile)))
	       (t standard-output)))
	(l nil)
	(err:end-of-file (function (lambda (x (y))(throw 'eof)))))
    (catch 'eof
      (loop
       (setq l (read is))
       (match l
	 (('setq prim ('quote data))
	  (prind `(setq ,prim ',(changeprim data))))
	 (dummy (prind l)))))))
(defun changeprim (prim)
  (match prim
    ((points lines .alist)
     (do ((l lines (cdr l))
	  (p)(p2)(p3)(p4))
       ((atom l)prim)
       (match (car l)
	 (('kokoro (n1 n2 n3 n4) . any)
	  (setq p2 (nth n2 points) p3 (nth n3 points) p4 (nth n4 points))
	  (rplaca (cdr p2) (plus 18 (cadr p2)))
	  (rplaca (cdr p3) (plus 18 (cadr p3)))
;	  (rplaca (cdr p4) (plus 18 (cadr p4)))
	  )
	 (('tatehane (n1 n2 n3) . any)
	  (setq p2 (nth n2 points) p3 (nth n3 points))
	  (rplaca (cdr p2) (plus 18 (cadr p2)))
	  (rplaca (cdr p3) (plus 18 (cadr p3))))
	 (('kagi (n1 n2 n3) . any)
	  (setq p2 (nth n2 points) p3 (nth n3 points))
	  (rplaca (cdr p2) (plus 18 (cadr p2)))
	  (rplaca (cdr p3) (plus 18 (cadr p3))))
	 (('tsukurihane (n1 n2 n3 n4) . any)
	  (setq p3 (nth n3 points) p4 (nth n4 points))
	  (rplaca (cdr p3) (plus 18 (cadr p3)))
	  (rplaca (cdr p4) (plus 18 (cadr p4)))))))
    (any prim)))
	 
(defun expand2file(ak filename)
  (let ((standard-output (outopen (stream filename))))
    (do ((l ak (cdr l)))
      ((atom l)(close standard-output))
      (prind `(setq ,(car l) ',(applykanji (car l) 'mincho-patch))))))