t2menu.pp 11 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438
  1. {$MODE OBJFPC}
  2. program Menu_Example;
  3. uses
  4. ncurses, menu, panel, sysutils;
  5. function st_middle(scrlen, itemlen: Smallint): Smallint; inline;
  6. begin
  7. st_middle := (scrlen - itemlen) div 2;
  8. end;
  9. procedure print_in_middle(win: PWINDOW; starty, startx: Smallint;
  10. width: Longint; pair: NC_FPC_COLOR;
  11. const fmt: AnsiString; args: array of const);
  12. var
  13. tstr: AnsiString;
  14. my, mx: Smallint;
  15. begin
  16. FmtStr(tstr, fmt, args);
  17. getmaxyx(win, my, mx);
  18. mx -= startx;
  19. if (width > length(tstr)) OR (width < 2) then
  20. width := length(tstr);
  21. if width > mx then
  22. width := mx;
  23. wattron(win,pair);
  24. mvwaddnstr(win,starty,startx + st_middle(mx,width),PChar(tstr),width);
  25. wattroff(win,pair);
  26. end;
  27. type
  28. PMinfo = ^TMinfo;
  29. TMinfo = record
  30. n, d: PChar;
  31. end;
  32. type
  33. TSubmenu = class
  34. private
  35. _win: PWINDOW;
  36. _pan: PPANEL;
  37. _items: ppITEM;
  38. _exit, _sitem: pITEM;
  39. _menu: pMENU;
  40. public
  41. function doevent: chtype;
  42. constructor create(szy,szx,nch: Smallint; choices: PMinfo;
  43. pair: NC_FPC_COLOR;const name: AnsiString);
  44. destructor destroy; override;
  45. property menu: pMENU read _menu;
  46. property items: ppITEM read _items;
  47. property sitem: pITEM read _sitem write _sitem ;
  48. property win: PWINDOW read _win;
  49. property pan: PPANEL read _pan;
  50. end;
  51. function TSubmenu.doevent: chtype;
  52. function doenter(var ch: chtype): Boolean;
  53. begin
  54. if current_item(_menu) = _exit then
  55. begin
  56. doenter := false;
  57. ch := -1
  58. end
  59. else
  60. if current_item(_menu) = sitem then
  61. begin
  62. doenter := false;
  63. ch := 10
  64. end
  65. else
  66. doenter := true;
  67. end;
  68. var
  69. ch: chtype = 0;
  70. doiter: Boolean = true;
  71. begin
  72. while doiter do
  73. begin
  74. ch := wgetch(_win);
  75. case ch of
  76. KEY_DOWN: menu_driver(_menu, REQ_DOWN_ITEM);
  77. KEY_UP: menu_driver(_menu, REQ_UP_ITEM);
  78. KEY_LEFT: menu_driver(_menu, REQ_LEFT_ITEM);
  79. KEY_RIGHT: menu_driver(_menu, REQ_RIGHT_ITEM);
  80. KEY_NPAGE: menu_driver(_menu, REQ_SCR_DPAGE);
  81. KEY_PPAGE: menu_driver(_menu, REQ_SCR_UPAGE);
  82. chtype(' '): menu_driver(_menu, REQ_TOGGLE_ITEM);
  83. 10: doiter := doenter(ch); (* Enter *)
  84. else
  85. if menu_driver(_menu, ch) <> E_OK then
  86. begin
  87. doiter := false;
  88. if (ch <> chtype('q')) AND (ch <> KEY_F(10)) then
  89. ch := -1; (* Close menu *)
  90. end
  91. else
  92. if (ch = KEY_MOUSE) then
  93. doiter := doenter(ch);
  94. end;
  95. end;
  96. update_panels();
  97. doupdate();
  98. doevent := ch;
  99. end;
  100. constructor TSubmenu.create(szy,szx,nch: Smallint; choices: PMinfo;
  101. pair: NC_FPC_COLOR;const name: AnsiString);
  102. var
  103. i: Longint = 0;
  104. sy,sx: Smallint;
  105. //mrows,mcols: Longint;
  106. begin
  107. GetMem(_items, (nch+1)*sizeof(pITEM));
  108. for i := 0 to nch - 1 do
  109. _items[i] := new_item(choices[i].n, choices[i].d);
  110. _items[nch] := nil;
  111. _exit := _items[i];
  112. sitem := nil;
  113. _menu := new_menu(_items);
  114. //scale_menu(_menu, @mrows, @mcols);
  115. _win := newwin(szy,szx,st_middle(LINES,szy),st_middle(COLS,szx));
  116. //_win := newwin(mrows + 2, mcols + 2, st_middle(LINES,mrows+2),st_middle(COLS,mcols+2));
  117. _pan := new_panel(_win);
  118. keypad(_win, TRUE);
  119. box(_win, ACS_VLINE, ACS_HLINE);
  120. wbkgd(_win, COLOR_PAIR(pair));
  121. set_menu_back(_menu, COLOR_PAIR(pair));
  122. print_in_middle(_win,0,0,szx-2,pair,name,[]);
  123. set_menu_win(_menu, _win);
  124. set_menu_sub(_menu, derwin(_win, szy-2, szx-2, 1, 1));
  125. //set_menu_sub(_menu, derwin(_win, mrows, mcols, 1, 1));
  126. set_menu_mark(_menu, '-');
  127. end;
  128. destructor TSubmenu.destroy;
  129. var
  130. i: Longint = 0;
  131. begin
  132. unpost_menu(_menu);
  133. free_menu(_menu);
  134. while _items[i] <> nil do
  135. begin
  136. free_item(_items[i]); Inc(i);
  137. end;
  138. FreeMem(_items, (i+1)*sizeof(pITEM));
  139. del_panel(_pan);
  140. delwin(_win);
  141. update_panels();
  142. doupdate();
  143. end;
  144. type
  145. Tmainptr = function: chtype;
  146. const
  147. EXIT_PROGRAM = KEY_MAX + 100;
  148. function confirm_menu: chtype;
  149. const
  150. choices: array[0..2] of TMinfo =
  151. (
  152. (n:' Yes ';d:nil),
  153. (n:'I dont know';d:nil),
  154. (n:' No ';d:nil)
  155. );
  156. var
  157. smenu: TSubmenu;
  158. i: Longint;
  159. begin
  160. smenu := TSubmenu.create(3, 41,3,choices,5,'Do you really want to quit?');
  161. menu_opts_off(smenu.menu, O_SHOWDESC);
  162. set_menu_format(smenu.menu, 1, 3);
  163. post_menu(smenu.menu);
  164. smenu.sitem := smenu.items[0];
  165. confirm_menu := smenu.doevent;
  166. if (confirm_menu = 10) OR (confirm_menu = chtype('q')) OR (confirm_menu = KEY_F(10)) then
  167. confirm_menu := EXIT_PROGRAM
  168. else
  169. confirm_menu := -1;
  170. smenu.destroy;
  171. end;
  172. (* Scrolling Menus example *)
  173. function scroll_menu: chtype;
  174. const
  175. choices: array[0..9] of TMinfo =
  176. (
  177. (n: '1_'; d: 'Choice'),
  178. (n: '2_'; d: 'Choice'),
  179. (n: '3_'; d: 'Choice'),
  180. (n: '4_'; d: 'Choice'),
  181. (n: '5_'; d: 'Choice'),
  182. (n: '6_'; d: 'Choice'),
  183. (n: '7_'; d: 'Choice'),
  184. (n: '8_'; d: 'Choice'),
  185. (n: '9_'; d: 'Choice'),
  186. (n: '..'; d: 'Close')
  187. );
  188. var
  189. smenu: TSubmenu;
  190. i: Longint;
  191. begin
  192. mvaddstr(LINES - 3, COLS - 30, '"PAGEUP" "PAGEDOWN" - scroll');
  193. refresh();
  194. smenu := TSubmenu.create(8, 13,10,choices,6,'Scrolling');
  195. set_menu_format(smenu.menu, 6, 1);
  196. post_menu(smenu.menu);
  197. scroll_menu := smenu.doevent;
  198. smenu.destroy;
  199. mvaddstr(LINES - 3, COLS - 30, ' ');
  200. refresh();
  201. end;
  202. (* Milt Columnar Menus Example *)
  203. function multicol_menu: chtype;
  204. const
  205. choices: array[0..24] of TMinfo =
  206. (
  207. (n:'1_';d:nil),(n:'2_';d:nil),(n:'3_';d:nil),(n:'4_';d:nil),(n:'5_';d:nil),
  208. (n:'6_';d:nil),(n:'7_';d:nil),(n:'8_';d:nil),(n:'9_';d:nil),(n:'10';d:nil),
  209. (n:'11';d:nil),(n:'12';d:nil),(n:'13';d:nil),(n:'14';d:nil),(n:'15';d:nil),
  210. (n:'16';d:nil),(n:'17';d:nil),(n:'18';d:nil),(n:'19';d:nil),(n:'20';d:nil),
  211. (n:'21';d:nil),(n:'22';d:nil),(n:'23';d:nil),(n:'24';d:nil),(n:'..';d:nil)
  212. );
  213. var
  214. smenu: TSubmenu;
  215. i: Longint;
  216. begin
  217. smenu := TSubmenu.create(7, 22,25,choices,5,'Multicol');
  218. (* Set menu option not to show the description *)
  219. menu_opts_off(smenu.menu, O_SHOWDESC);
  220. set_menu_format(smenu.menu, 5, 5);
  221. post_menu(smenu.menu);
  222. multicol_menu := smenu.doevent;
  223. smenu.destroy;
  224. end;
  225. (* Multi Valued Menus example *)
  226. function multival_menu: chtype;
  227. const
  228. choices: array[0..5] of TMinfo =
  229. (
  230. (n: '1_'; d: 'Choice'),
  231. (n: '2_'; d: 'Choice'),
  232. (n: '3_'; d: 'Choice'),
  233. (n: '4_'; d: 'Choice'),
  234. (n: '5_'; d: 'Choice'),
  235. (n: '..'; d: 'Close')
  236. );
  237. var
  238. smenu: TSubmenu;
  239. i: Longint;
  240. begin
  241. mvaddstr(LINES - 3, COLS - 30, '"SPACE" - toggle choice');
  242. refresh();
  243. smenu := TSubmenu.create(8, 13,6,choices,7,'Multival');
  244. menu_opts_off(smenu.menu, O_ONEVALUE);
  245. post_menu(smenu.menu);
  246. multival_menu := smenu.doevent;
  247. smenu.destroy;
  248. mvaddstr(LINES - 3, COLS - 30, ' ');
  249. refresh();
  250. end;
  251. const
  252. n_choices = 4;
  253. choices: array[0..3] of TMinfo =
  254. (
  255. (n: '1_'; d: 'Scrolling Menus'),
  256. (n: '2_'; d: 'Multi Columnar Menus'),
  257. (n: '3_'; d: 'Multi Valued Menus'),
  258. (n: '..'; d: 'Exit')
  259. );
  260. var
  261. main_menu_win: PWINDOW;
  262. main_menu_panel: PPANEL;
  263. function mgetch: chtype;
  264. begin
  265. mgetch := wgetch(main_menu_win);
  266. end;
  267. var
  268. my_bg: NC_FPC_COLOR = COLOR_BLACK;
  269. main_items: ppITEM;
  270. cur_item: pITEM;
  271. main_menu: pMENU;
  272. ptr: Tmainptr = @mgetch;
  273. ch: chtype = -1;
  274. i: Longint;
  275. tstr: AnsiString;
  276. begin
  277. try
  278. (* Initialize curses *)
  279. initscr();
  280. noecho();
  281. cbreak();
  282. keypad(stdscr, TRUE);
  283. curs_set(0);
  284. clear();
  285. mousemask(ALL_MOUSE_EVENTS, nil);
  286. if has_colors() then
  287. begin
  288. start_color();
  289. if (use_default_colors() = OK) then
  290. my_bg := -1
  291. else
  292. my_bg := COLOR_BLACK;
  293. init_pair(1, COLOR_YELLOW, my_bg);
  294. init_pair(2, COLOR_RED, my_bg);
  295. init_pair(3, COLOR_MAGENTA, my_bg);
  296. init_pair(4, COLOR_CYAN, my_bg);
  297. init_pair(5, COLOR_WHITE, COLOR_RED);
  298. init_pair(6, COLOR_WHITE, COLOR_BLUE);
  299. init_pair(7, COLOR_WHITE, COLOR_GREEN);
  300. end;
  301. main_menu_win := newwin(8, 40, st_middle(LINES, 8) - 2, st_middle(COLS, 40) - 10);
  302. main_menu_panel := new_panel(main_menu_win);
  303. keypad(main_menu_win, TRUE);
  304. (* Create items *)
  305. GetMem(main_items, (n_choices+1)*sizeof(pITEM));
  306. for i := 0 to n_choices-1 do
  307. main_items[i] := new_item(choices[i].n, choices[i].d);
  308. main_items[n_choices] := nil;
  309. (* Set the user pointers *)
  310. set_item_userptr(main_items[0], @scroll_menu);
  311. set_item_userptr(main_items[1], @multicol_menu);
  312. set_item_userptr(main_items[2], @multival_menu);
  313. set_item_userptr(main_items[3], @confirm_menu);
  314. (* Crate menu *)
  315. main_menu := new_menu(main_items);
  316. (* Set main window and sub window *)
  317. set_menu_win(main_menu, main_menu_win);
  318. set_menu_sub(main_menu, derwin(main_menu_win, 4, 38, 3, 1));
  319. (* Set menu mark to the string "=>" *)
  320. set_menu_mark(main_menu, '=>');
  321. (* Print a border around the main window and print a title *)
  322. box(main_menu_win, 0, 0);
  323. wbkgd(main_menu_win, COLOR_PAIR(6));
  324. set_menu_back(main_menu, COLOR_PAIR(6));
  325. print_in_middle(main_menu_win, 1, 0, 40, COLOR_PAIR(6), 'Main Menu', []);
  326. mvwaddch(main_menu_win, 2, 0, ACS_LTEE);
  327. mvwhline(main_menu_win, 2, 1, ACS_HLINE, 38);
  328. mvwaddch(main_menu_win, 2, 39, ACS_RTEE);
  329. attron(COLOR_PAIR(4));
  330. mvaddstr(LINES - 1, COLS - 30, 'Press "F10" or "q" to exit ');
  331. attroff(COLOR_PAIR(4));
  332. refresh();
  333. (* Post the menu *)
  334. post_menu(main_menu);
  335. wrefresh(main_menu_win);
  336. while ch <> EXIT_PROGRAM do
  337. begin
  338. case ch of
  339. KEY_DOWN: menu_driver(main_menu, REQ_DOWN_ITEM);
  340. KEY_UP: menu_driver(main_menu, REQ_UP_ITEM);
  341. -1: ptr := @mgetch; (* Restore ptr *)
  342. 10: (* Enter *)
  343. begin
  344. cur_item := current_item(main_menu); (* get current item *)
  345. ptr := Tmainptr(item_userptr(cur_item)); (* set ptr to current item *)
  346. end;
  347. else
  348. (* Process mouse and others events *)
  349. if (menu_driver(main_menu, ch) = E_OK) AND (ch = KEY_MOUSE) then
  350. begin
  351. cur_item := current_item(main_menu);
  352. ptr := Tmainptr(item_userptr(cur_item));
  353. end;
  354. end;
  355. ch := ptr(); (* Call ptr function *)
  356. if (ch = chtype('q')) OR (ch = KEY_F(10)) then
  357. ch := confirm_menu();
  358. end;
  359. finally
  360. unpost_menu(main_menu);
  361. free_menu(main_menu);
  362. for i := 0 to n_choices - 1 do
  363. free_item(main_items[i]);
  364. FreeMem(main_items, (n_choices+1)*sizeof(pITEM));
  365. del_panel(main_menu_panel);
  366. delwin(main_menu_win);
  367. curs_set(1);
  368. endwin();
  369. end;
  370. end.