| 1 : |
ktanaka |
1.1 |
;;-----------;; |
| 2 : |
|
|
;; aplyknj.l ;; |
| 3 : |
|
|
;;-----------;; |
| 4 : |
|
|
|
| 5 : |
|
|
;; applykanji が flonum で座標を返すので、fixnum になおす |
| 6 : |
|
|
|
| 7 : |
|
|
(defun zahyou-flonum->fixnum (prim) |
| 8 : |
|
|
(let ((zahyou (car prim)) |
| 9 : |
|
|
(restinfo (cdr prim))) |
| 10 : |
|
|
(cons (mapcar zahyou |
| 11 : |
|
|
#'(lambda (p) |
| 12 : |
|
|
(let ((x (first p)) |
| 13 : |
|
|
(y (second p)) |
| 14 : |
|
|
(info (cddr p))) |
| 15 : |
|
|
(cons (fix x) (cons (fix y) info))))) |
| 16 : |
|
|
restinfo))) |
| 17 : |
|
|
|
| 18 : |
|
|
|
| 19 : |
|
|
(defun kind-of-info (prims) |
| 20 : |
|
|
(let ((ret nil)) |
| 21 : |
|
|
(do ((p prims (cdr prims))) |
| 22 : |
|
|
((null p)) |
| 23 : |
|
|
(let ((info (cddr (applykanji (car p))))) |
| 24 : |
|
|
(mapcar info |
| 25 : |
|
|
#'(lambda (i) |
| 26 : |
|
|
(unless (assq (car i) ret) |
| 27 : |
|
|
(print i) |
| 28 : |
|
|
(push i ret)))))) |
| 29 : |
|
|
ret)) |
Annotation of /lisp/tools/aplyknj.l
Parent Directory
| 
Revision Log