1 : |
ktanaka |
1.1 |
|
2 : |
|
|
(defun move-win (win x y) |
3 : |
|
|
(setf (drawable-x win) x) |
4 : |
|
|
(setf (drawable-y win) y)) |
5 : |
|
|
|
6 : |
|
|
(defun create-menu-test (parent x y black white fnt cursor |
7 : |
|
|
item-list (colnum 1)) |
8 : |
|
|
(lets ((mw (create-win parent x y 10 10 black white fnt)) |
9 : |
|
|
(wins (mapcar item-list |
10 : |
|
|
#'(lambda (x) |
11 : |
|
|
(create-menu-item-win mw (second x) |
12 : |
|
|
0 0 |
13 : |
|
|
black white |
14 : |
|
|
fnt cursor)))) |
15 : |
|
|
(item-num (length item-list)) |
16 : |
|
|
(item-height (apply #'max |
17 : |
|
|
(mapcar wins #'drawable-height))) |
18 : |
|
|
(item-width (apply #'max |
19 : |
|
|
(mapcar wins #'drawable-width))) |
20 : |
|
|
(linnum (// (1- (+ item-num colnum)) colnum)) |
21 : |
|
|
(mw-height (+ (* linnum item-height) *menu-margin*)) |
22 : |
|
|
(mw-width (* colnum (+ *menu-margin* item-width)))) |
23 : |
|
|
(do ((item-wins wins) |
24 : |
|
|
(y 0 (+ y item-height))) |
25 : |
|
|
((endp item-wins)) |
26 : |
|
|
(do ((x 0 (+ x (+ item-width *menu-margin*))) |
27 : |
|
|
(c 0 (1+ c))) |
28 : |
|
|
((or (>= c colnum) (endp item-wins))) |
29 : |
|
|
(move-win (car item-wins) x y) |
30 : |
|
|
(setq item-wins (cdr item-wins)))) |
31 : |
|
|
|
32 : |
|
|
(do ((items item-list (cdr items)) |
33 : |
|
|
(windefs wins (cdr windefs))) |
34 : |
|
|
((or (endp items) (endp windefs))) |
35 : |
|
|
(princ (caar items)) (princ " ") |
36 : |
|
|
(set (caar items) (car windefs))) |
37 : |
|
|
(terpri) |
38 : |
|
|
|
39 : |
|
|
(mapcar wins #'(lambda (x) (resize-win x item-width item-height))) |
40 : |
|
|
(resize-win mw mw-width mw-height) |
41 : |
|
|
mw)) |
42 : |
|
|
|
43 : |
|
|
(defun test () |
44 : |
|
|
(setq test-win (create-menu-test |
45 : |
|
|
skeleditor 0 0 black white kanji-font roupe-cursor |
46 : |
|
|
'((test-1 "テト1") |
47 : |
|
|
(test-2 "テスト2") |
48 : |
|
|
(test-3 "テスト3") |
49 : |
|
|
(test-4 "テスト4") |
50 : |
|
|
(test-5 "テスト5")))) |
51 : |
|
|
(map-subwindows test-win) |
52 : |
|
|
(map-window test-win) |
53 : |
|
|
(display-force-output (window-display test-win))) |
54 : |
|
|
|