Annotation of /lisp/test/changeprim.lAnnotation of /lisp/test/changeprim.l
Parent Directory
| 
Revision Log
Revision: 1.1.1.1 - (view) (download)
| 1 : | ktanaka | 1.1 | (defun changeprimfile (filename (outfile)) |
| 2 : | (let ((is (inopen (stream filename))) | ||
| 3 : | (standard-output | ||
| 4 : | (cond (outfile (outopen (stream outfile))) | ||
| 5 : | (t standard-output))) | ||
| 6 : | (l nil) | ||
| 7 : | (err:end-of-file (function (lambda (x (y))(throw 'eof))))) | ||
| 8 : | (catch 'eof | ||
| 9 : | (loop | ||
| 10 : | (setq l (read is)) | ||
| 11 : | (match l | ||
| 12 : | (('setq prim ('quote data)) | ||
| 13 : | (prind `(setq ,prim ',(changeprim data)))) | ||
| 14 : | (dummy (prind l))))))) | ||
| 15 : | (defun changeprim (prim) | ||
| 16 : | (match prim | ||
| 17 : | ((points lines .alist) | ||
| 18 : | (do ((l lines (cdr l)) | ||
| 19 : | (p)(p2)(p3)(p4)) | ||
| 20 : | ((atom l)prim) | ||
| 21 : | (match (car l) | ||
| 22 : | (('kokoro (n1 n2 n3 n4) . any) | ||
| 23 : | (setq p2 (nth n2 points) p3 (nth n3 points) p4 (nth n4 points)) | ||
| 24 : | (rplaca (cdr p2) (plus 18 (cadr p2))) | ||
| 25 : | (rplaca (cdr p3) (plus 18 (cadr p3))) | ||
| 26 : | ; (rplaca (cdr p4) (plus 18 (cadr p4))) | ||
| 27 : | ) | ||
| 28 : | (('tatehane (n1 n2 n3) . any) | ||
| 29 : | (setq p2 (nth n2 points) p3 (nth n3 points)) | ||
| 30 : | (rplaca (cdr p2) (plus 18 (cadr p2))) | ||
| 31 : | (rplaca (cdr p3) (plus 18 (cadr p3)))) | ||
| 32 : | (('kagi (n1 n2 n3) . any) | ||
| 33 : | (setq p2 (nth n2 points) p3 (nth n3 points)) | ||
| 34 : | (rplaca (cdr p2) (plus 18 (cadr p2))) | ||
| 35 : | (rplaca (cdr p3) (plus 18 (cadr p3)))) | ||
| 36 : | (('tsukurihane (n1 n2 n3 n4) . any) | ||
| 37 : | (setq p3 (nth n3 points) p4 (nth n4 points)) | ||
| 38 : | (rplaca (cdr p3) (plus 18 (cadr p3))) | ||
| 39 : | (rplaca (cdr p4) (plus 18 (cadr p4))))))) | ||
| 40 : | (any prim))) | ||
| 41 : | |||
| 42 : | (defun expand2file(ak filename) | ||
| 43 : | (let ((standard-output (outopen (stream filename)))) | ||
| 44 : | (do ((l ak (cdr l))) | ||
| 45 : | ((atom l)(close standard-output)) | ||
| 46 : | (prind `(setq ,(car l) ',(applykanji (car l) 'mincho-patch)))))) |
|
ktanaka Powered by ViewCVS 1.0-dev |
ViewCVS and CVS Help |