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