| 1 : |
ktanaka |
1.1 |
;; |
| 2 : |
|
|
;; primdisp.l |
| 3 : |
ktanaka |
1.3 |
;; $Revision: 1.2 $ |
| 4 : |
ktanaka |
1.1 |
;; |
| 5 : |
|
|
|
| 6 : |
|
|
(defun clear-win! (win) |
| 7 : |
|
|
(clear-area win :x 0 :y 0 :width (width-win win) :height (height-win win))) |
| 8 : |
|
|
|
| 9 : |
ktanaka |
1.2 |
(defun draw-nikuduked-skeleton (win prim mincho-gothic) |
| 10 : |
|
|
(setq prim (shapeup-skeleton prim)) |
| 11 : |
ktanaka |
1.1 |
(if (null (car prim)) |
| 12 : |
|
|
(beep win) |
| 13 : |
ktanaka |
1.2 |
(let ((outline (skeleton2list (applykanji prim) mincho-gothic)) |
| 14 : |
ktanaka |
1.1 |
(save (get-winprop win 'button-press-handler)) |
| 15 : |
|
|
(loopend nil)) |
| 16 : |
|
|
(clear-win! win) |
| 17 : |
|
|
(mapcar outline |
| 18 : |
|
|
(function (lambda (x) (fill-polygon-win! win (setpart1 x))))) |
| 19 : |
|
|
(display-force-output (window-display win))))) |
| 20 : |
|
|
|
| 21 : |
ktanaka |
1.2 |
(defun show-nikuduked-skeleton (win prim mincho-gothic) |
| 22 : |
|
|
(setq prim (shapeup-skeleton prim)) |
| 23 : |
ktanaka |
1.1 |
(if (null (car prim)) |
| 24 : |
|
|
(beep win) |
| 25 : |
ktanaka |
1.2 |
(let ((outline (skeleton2list (applykanji prim) mincho-gothic)) |
| 26 : |
ktanaka |
1.1 |
(save (get-winprop win 'button-press-handler)) |
| 27 : |
|
|
(loopend nil)) |
| 28 : |
|
|
(clear-win! win) |
| 29 : |
|
|
(mapcar outline |
| 30 : |
|
|
(function (lambda (x) (show-polygon-win! win (setpart1 x))))) |
| 31 : |
|
|
(display-force-output (window-display win))))) |
| 32 : |
|
|
|
| 33 : |
ktanaka |
1.2 |
(defun draw-nikuduked-skeleton-win! (win prim mincho-gothic) |
| 34 : |
|
|
(setq prim (shapeup-skeleton prim)) |
| 35 : |
ktanaka |
1.1 |
(if (null (car prim)) |
| 36 : |
|
|
(beep win) |
| 37 : |
ktanaka |
1.2 |
(let ((outline (skeleton2list (applykanji prim) mincho-gothic)) |
| 38 : |
ktanaka |
1.1 |
(save (get-winprop win 'button-press-handler)) |
| 39 : |
|
|
(loopend nil)) |
| 40 : |
|
|
(mapcar outline |
| 41 : |
|
|
(function (lambda (x) (fill-polygon-win! win (setpart1 x))))) |
| 42 : |
|
|
(display-force-output (window-display win))))) |
| 43 : |
|
|
|
Annotation of /lisp/tools/primdisp.l
Parent Directory
| 
Revision Log