[wadalabfont-kit] / lisp / test / changeprim.l  

Annotation of /lisp/test/changeprim.l

Parent Directory | Revision Log

Revision: 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