paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:09:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Examples from 10820. Russian one needs testing. Makefile will follow

Browse Source 
git-svn-id: trunk@10878 -
This commit is contained in:
marco 2008-05-04 15:51:26 +00:00
parent 71d268db32
commit 5edafaab61
18 changed files with 2607 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
.gitattributes vendored
View File

@ -3219,7 +3219,23 @@ packages/ncurses/examples/edit_demo.pp svneol=native#text/plain
packages/ncurses/examples/firework.pp svneol=native#text/plain
packages/ncurses/examples/menu_demo.pp svneol=native#text/plain
packages/ncurses/examples/ocrt_demo.pp svneol=native#text/plain
packages/ncurses/examples/ru/messages.mo -text
packages/ncurses/examples/screen_demo.pp svneol=native#text/plain
packages/ncurses/examples/t1form.pp svneol=native#text/plain
packages/ncurses/examples/t1menu.pp svneol=native#text/plain
packages/ncurses/examples/t1panel.pp svneol=native#text/plain
packages/ncurses/examples/t2form.pp svneol=native#text/plain
packages/ncurses/examples/t2menu.pp svneol=native#text/plain
packages/ncurses/examples/t2panel.pp svneol=native#text/plain
packages/ncurses/examples/t3form.pp svneol=native#text/plain
packages/ncurses/examples/tbackground.pp svneol=native#text/plain
packages/ncurses/examples/tclock.pp svneol=native#text/plain
packages/ncurses/examples/tevent.pp svneol=native#text/plain
packages/ncurses/examples/tmouse.pp svneol=native#text/plain
packages/ncurses/examples/tnlshello.pp svneol=native#text/plain
packages/ncurses/examples/tnlshello_ru_UTF8.pot svneol=native#text/plain
packages/ncurses/examples/tpad.pp svneol=native#text/plain
packages/ncurses/examples/twindow.pp svneol=native#text/plain
packages/ncurses/fpmake.pp svneol=native#text/plain
packages/ncurses/src/eti.inc svneol=native#text/plain
packages/ncurses/src/form.pp svneol=native#text/plain

2
packages/ncurses/Makefile.fpc
View File

@ -8,7 +8,7 @@ version=2.0.0
[target]
units=ncurses panel ncrt ocrt menu form
examples=firework testn ocrt_demo edit_demo db_demo screen_demo
examples=firework testn ocrt_demo edit_demo db_demo screen_demo t1form t1menu t1panel t2form t2menu t2panel t3form tbackground tclock tevent tmouse tnlshello tpad twindow
[require]
libc=y

BIN
packages/ncurses/examples/ru/messages.mo Normal file
View File

Binary file not shown.

83
packages/ncurses/examples/t1form.pp Normal file
View File

@ -0,0 +1,83 @@
program form_basic;
{
Example 25. Forms Basics
from ncurses howto
Possible bug: moving cursors before first char doesn't seem to work.
}
{$MODE OBJFPC}
uses
ncurses, form;
var
field: array[0..2] of PFIELD;
my_form: PFORM;
ch: Longint;
begin
try
(* Initialize curses *)
initscr();
cbreak();
noecho();
keypad(stdscr, TRUE);
(* Initialize the fields *)
field[0] := new_field(1, 10, 4, 18, 0, 0);
field[1] := new_field(1, 10, 6, 18, 0, 0);
field[2] := nil;
(* Set field options *)
set_field_back(field[0], A_UNDERLINE); { Print a line for the option }
field_opts_off(field[0], O_AUTOSKIP); { Don't go to next field when this }
{ Field is filled up }
set_field_back(field[1], A_UNDERLINE);
field_opts_off(field[1], O_AUTOSKIP);
(* Create the form and post it *)
my_form := new_form(field);
post_form(my_form);
refresh();
mvprintw(2, 10, 'Cursor up/down to move, F1 to Exit');
mvprintw(4, 10, 'Value 1:');
mvprintw(6, 10, 'Value 2:');
refresh();
(* Loop through to get user requests *)
ch := getch();
while ch <> KEY_F(1) do
begin
case ch of
KEY_DOWN:
(* Go to next field *)
begin
form_driver(my_form, REQ_NEXT_FIELD);
{ Go to the end of the present buffer
Leaves nicely at the last character }
form_driver(my_form, REQ_END_LINE);
end;
KEY_UP:
(* Go to previous field *)
begin
form_driver(my_form, REQ_PREV_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
else
{ If this is a normal character, it gets
Printed }
form_driver(my_form, ch);
end;
ch := getch();
end
finally
(* Un post form and free the memory *)
unpost_form(my_form);
free_form(my_form);
free_field(field[0]);
free_field(field[1]);
endwin();
end;
end.

65
packages/ncurses/examples/t1menu.pp Normal file
View File

@ -0,0 +1,65 @@
{
Example 18. Menu Basics
from ncurses howto
}
program Menu_Basics;
{$MODE OBJFPC}
uses
ncurses, menu;
const
choices: array[0..4] of PChar =
(
'Choice 1',
'Choice 2',
'Choice 3',
'Choice 4',
'Exit'
);
var
my_items: ppITEM;
my_menu: pMENU;
c, n_choices, i: Longint;
cur_item: pITEM;
begin
try
initscr();
cbreak();
noecho();
keypad(stdscr, TRUE);
n_choices := 5;
GetMem(my_items, (n_choices+1)*sizeof(pITEM));
for i := 0 to n_choices - 1 do
my_items[i] := new_item(choices[i], choices[i]);
my_items[n_choices] := nil;
my_menu := new_menu(my_items);
mvprintw(LINES - 2, 0, 'F1 to Exit');
post_menu(my_menu);
refresh();
c := getch();
while c <> KEY_F(1) do
begin
case c of
KEY_DOWN: menu_driver(my_menu, REQ_DOWN_ITEM);
KEY_UP: menu_driver(my_menu, REQ_UP_ITEM);
else
end;
c := getch();
end
finally
free_item(my_items[0]);
free_item(my_items[1]);
free_menu(my_menu);
FreeMem(my_items, (n_choices+1)*sizeof(pITEM));
endwin();
end;
end.

190
packages/ncurses/examples/t1panel.pp Normal file
View File

@ -0,0 +1,190 @@
{
Example 17. Panel Hiding and Showing example
from ncurses howto
}
program test_panel;
{$MODE OBJFPC}
uses
ncurses, panel, sysutils;
Type
PANEL_DATA = record
hide: Boolean; (* TRUE if panel is hidden *)
end;
PPWINDOW = ^PWINDOW;
const
NLINES = 10;
NCOLS = 40;
procedure print_in_middle(win: PWINDOW; starty, startx, width: Longint; str: AnsiString; color: chtype);
var
slength, x, y: Longint;
temp: Double;
begin
if win = nil then
win := stdscr;
getyx(win, y, x);
if startx <> 0 then
x := startx;
if starty <> 0 then
y := starty;
if width = 0 then
width := 80;
slength := Length(str);
temp := (width - slength)/ 2;
x := startx + round(temp);
wattron(win, color);
mvwaddstr(win, y, x, PChar(str));
wattroff(win, color);
refresh();
end;
(* Show the window with a border and a label *)
procedure win_show(win: PWINDOW; lab: AnsiString; label_color: Longint);
var
startx, starty, height, width: Smallint;
begin
getbegyx(win, starty, startx);
getmaxyx(win, height, width);
box(win, 0, 0);
mvwaddch(win, 2, 0, ACS_LTEE);
mvwhline(win, 2, 1, ACS_HLINE, width - 2);
mvwaddch(win, 2, width - 1, ACS_RTEE);
print_in_middle(win, 1, 0, width, lab, COLOR_PAIR(label_color));
end;
(* Put all the windows *)
procedure init_wins(wins: PPWINDOW; n: Longint);
var
x, y, i: Longint;
lab: AnsiString;
begin
y := 2;
x := 10;
for i := 0 to n - 1 do
begin
wins[i] := newwin(NLINES, NCOLS, y, x);
FmtStr(lab, 'Window Number %d', [i + 1]);
win_show(wins[i], lab, i + 1);
y += 3;
x += 7;
end
end;
var
my_wins: array[0..2] of PWINDOW;
my_panels: array[0..2] of PPANEL;
panel_datas: array[0..2] of PANEL_DATA;
temp: ^PANEL_DATA;
ch: chtype;
begin
try
(* Initialize curses *)
initscr();
start_color();
cbreak();
noecho();
keypad(stdscr, TRUE);
(* Initialize all the colors *)
init_pair(1, COLOR_RED, COLOR_BLACK);
init_pair(2, COLOR_GREEN, COLOR_BLACK);
init_pair(3, COLOR_BLUE, COLOR_BLACK);
init_pair(4, COLOR_CYAN, COLOR_BLACK);
init_wins(my_wins, 3);
(* Attach a panel to each window *) (* Order is bottom up *)
my_panels[0] := new_panel(my_wins[0]); (* Push 0, order: stdscr-0 *)
my_panels[1] := new_panel(my_wins[1]); (* Push 1, order: stdscr-0-1 *)
my_panels[2] := new_panel(my_wins[2]); (* Push 2, order: stdscr-0-1-2 *)
(* Initialize panel datas saying that nothing is hidden *)
panel_datas[0].hide := FALSE;
panel_datas[1].hide := FALSE;
panel_datas[2].hide := FALSE;
set_panel_userptr(my_panels[0], @panel_datas[0]);
set_panel_userptr(my_panels[1], @panel_datas[1]);
set_panel_userptr(my_panels[2], @panel_datas[2]);
(* Update the stacking order. 2nd panel will be on top *)
update_panels();
(* Show it on the screen *)
attron(COLOR_PAIR(4));
mvprintw(LINES - 3, 0, 'Show or Hide a window with "a"(first window) "b"(Second Window) "c"(Third Window)');
mvprintw(LINES - 2, 0, 'F1 to Exit');
attroff(COLOR_PAIR(4));
doupdate();
ch := getch;
while ch <> KEY_F(1) do
begin
case ch of
chtype('a'):
begin
temp := panel_userptr(my_panels[0]);
if temp^.hide = FALSE then
begin
hide_panel(my_panels[0]);
temp^.hide := TRUE;
end
else
begin
show_panel(my_panels[0]);
temp^.hide := FALSE;
end
end;
chtype('b'):
begin
temp := panel_userptr(my_panels[1]);
if temp^.hide = FALSE then
begin
hide_panel(my_panels[1]);
temp^.hide := TRUE;
end
else
begin
show_panel(my_panels[1]);
temp^.hide := FALSE;
end
end;
chtype('c'):
begin
temp := panel_userptr(my_panels[2]);
if temp^.hide = FALSE then
begin
hide_panel(my_panels[2]);
temp^.hide := TRUE;
end
else
begin
show_panel(my_panels[2]);
temp^.hide := FALSE;
end
end
else
end;
update_panels();
doupdate();
ch := getch;
end;
finally
endwin();
end;
end.

186
packages/ncurses/examples/t2form.pp Normal file
View File

@ -0,0 +1,186 @@
program form_test_2;
{$MODE OBJFPC}
uses
ncurses, form, libc;
var
my_bg: Smallint = COLOR_BLACK;
field: array[0..5] of PFIELD;
my_form: PFORM;
i, ch: Longint;
begin
try
setlocale(LC_ALL, ''); { Tested with Russian UTF-8 locale }
(* Initialize curses *)
initscr();
cbreak();
noecho();
keypad(stdscr, TRUE);
(* Initialize colors *)
if has_colors() then
begin
start_color();
if (use_default_colors() = OK) then
my_bg := -1
else
my_bg := COLOR_BLACK;
init_pair(1, COLOR_YELLOW, my_bg);
init_pair(2, COLOR_MAGENTA, my_bg);
init_pair(3, COLOR_WHITE, my_bg);
init_pair(4, COLOR_WHITE, COLOR_BLUE);
init_pair(5, COLOR_WHITE, COLOR_GREEN);
init_pair(6, COLOR_YELLOW, COLOR_GREEN);
init_pair(7, COLOR_BLACK, COLOR_CYAN);
end;
(* Initialize the fields *)
for i := 0 to 3 do
begin
field[i] := new_field(1, 30, 2 + i * 2, 10, 0, 0);
field_opts_off(field[i], O_AUTOSKIP);
end;
field[4] := new_field(7, 30, 2, 42, 0, 0);
field[5] := nil;
(* Set field options *)
set_field_fore(field[0], COLOR_PAIR(2));
set_field_back(field[0], A_UNDERLINE OR COLOR_PAIR(3));
set_field_fore(field[1], COLOR_PAIR(1));
set_field_back(field[1], A_UNDERLINE OR COLOR_PAIR(1));
field_opts_off(field[1], O_ACTIVE);
set_field_fore(field[2], COLOR_PAIR(4));
set_field_back(field[2], A_UNDERLINE OR COLOR_PAIR(4));
field_opts_off(field[2], O_PUBLIC);
set_field_fore(field[3], COLOR_PAIR(5));
set_field_back(field[3], A_UNDERLINE OR COLOR_PAIR(5));
field_opts_off(field[3], O_STATIC);
set_field_fore(field[4], COLOR_PAIR(7));
set_field_back(field[4], COLOR_PAIR(7));
(* Create the form and post it *)
my_form := new_form(field);
post_form(my_form);
(* Center Justification *)
set_field_just(field[0], JUSTIFY_CENTER);
set_field_buffer(field[0], 0, 'This is a static Field');
set_field_just(field[1], JUSTIFY_CENTER);
set_field_buffer(field[1], 0, 'This is a inactive Field');
(* Set focus to the blue field *)
set_current_field(my_form, field[0]);
for i := 0 to 3 do
mvprintw(2 + i * 2, 2, 'Value %d:', i + 1);
mvaddstr(LINES - 2, 0, 'F1 to Exit');
refresh();
(* Loop through to get user requests *)
ch := getch();
while (ch <> KEY_F(1)) AND (ch <> 27) do
begin
case ch of
9: { TAB }
begin
if form_driver(my_form, REQ_NEXT_WORD) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_NEXT_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
end;
KEY_NPAGE:
(* Go to next field *)
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_NEXT_FIELD);
{ Go to the end of the present buffer
Leaves nicely at the last character }
form_driver(my_form, REQ_END_LINE);
end;
KEY_PPAGE:
(* Go to previous field *)
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_PREV_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
KEY_DOWN:
if form_driver(my_form, REQ_DOWN_CHAR) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_DOWN_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
KEY_UP:
if form_driver(my_form, REQ_UP_CHAR) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_UP_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
KEY_LEFT:
if form_driver(my_form, REQ_LEFT_CHAR) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_LEFT_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
KEY_RIGHT:
if form_driver(my_form, REQ_RIGHT_CHAR) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_RIGHT_FIELD);
end;
KEY_BACKSPACE: form_driver(my_form, REQ_DEL_PREV);
10: { ENTER }
begin
form_driver(my_form, 10);
if form_driver(my_form, REQ_NEXT_LINE) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_NEXT_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
end;
else
{ If this is a normal character, it gets
Printed }
form_driver(my_form, ch);
end;
ch := getch();
end;
refresh();
finally
unpost_form(my_form);
free_form(my_form);
endwin();
for i := 0 to 4 do
begin
if field_status(field[i]) then
begin
writeln;
writeln('Value ', i,':');
writeln(field_buffer(field[i], 0));
end;
free_field(field[i]);
end
end;
end.

433
packages/ncurses/examples/t2menu.pp Normal file
View File

@ -0,0 +1,433 @@
{$MODE OBJFPC}
program Menu_Example;
uses
ncurses, menu, panel, sysutils;
function st_middle(scrlen, itemlen: Smallint): Smallint; inline;
begin
st_middle := (scrlen - itemlen) div 2;
end;
procedure print_in_middle(win: PWINDOW; starty, startx: Smallint;
width: Longint; pair: Smallint;
const fmt: AnsiString; args: array of const);
var
tstr: AnsiString;
my, mx: Smallint;
begin
FmtStr(tstr, fmt, args);
getmaxyx(win, my, mx);
mx -= startx;
if (width > length(tstr)) OR (width < 2) then
width := length(tstr);
if width > mx then
width := mx;
wattron(win,COLOR_PAIR(pair));
mvwaddnstr(win,starty,startx + st_middle(mx,width),PChar(tstr),width);
wattroff(win,COLOR_PAIR(pair));
end;
type
PMinfo = ^TMinfo;
TMinfo = record
n, d: PChar;
end;
type
TSubmenu = class
private
_win: PWINDOW;
_pan: PPANEL;
_items: ppITEM;
_exit, _sitem: pITEM;
_menu: pMENU;
public
function doevent: chtype;
constructor create(szy,szx,nch: Smallint; choices: PMinfo;
pair: Smallint;const name: AnsiString);
destructor destroy; override;
property menu: pMENU read _menu;
property items: ppITEM read _items;
property sitem: pITEM read _sitem write _sitem ;
property win: PWINDOW read _win;
property pan: PPANEL read _pan;
end;
function TSubmenu.doevent: chtype;
function doenter(var ch: chtype): Boolean;
begin
if current_item(_menu) = _exit then
begin
doenter := false;
ch := -1
end
else
if current_item(_menu) = sitem then
begin
doenter := false;
ch := 10
end
else
doenter := true;
end;
var
ch: chtype = 0;
doiter: Boolean = true;
begin
while doiter do
begin
ch := wgetch(_win);
case ch of
KEY_DOWN: menu_driver(_menu, REQ_DOWN_ITEM);
KEY_UP: menu_driver(_menu, REQ_UP_ITEM);
KEY_LEFT: menu_driver(_menu, REQ_LEFT_ITEM);
KEY_RIGHT: menu_driver(_menu, REQ_RIGHT_ITEM);
KEY_NPAGE: menu_driver(_menu, REQ_SCR_DPAGE);
KEY_PPAGE: menu_driver(_menu, REQ_SCR_UPAGE);
chtype(' '): menu_driver(_menu, REQ_TOGGLE_ITEM);
10: doiter := doenter(ch); (* Enter *)
else
if menu_driver(_menu, ch) <> E_OK then
begin
doiter := false;
if (ch <> chtype('q')) AND (ch <> KEY_F(10)) then
ch := -1; (* Close menu *)
end
else
if (ch = KEY_MOUSE) then
doiter := doenter(ch);
end;
end;
update_panels();
doupdate();
doevent := ch;
end;
constructor TSubmenu.create(szy,szx,nch: Smallint; choices: PMinfo;
pair: Smallint;const name: AnsiString);
var
i: Longint = 0;
begin
GetMem(_items, (nch+1)*sizeof(pITEM));
for i := 0 to nch - 1 do
_items[i] := new_item(choices[i].n, choices[i].d);
_items[nch] := nil;
_exit := _items[i];
sitem := nil;
_menu := new_menu(_items);
//scale_menu(_menu, @mrows, @mcols);
_win := newwin(szy,szx,st_middle(LINES,szy),st_middle(COLS,szx));
//_win := newwin(mrows + 2, mcols + 2, st_middle(LINES,mrows+2),st_middle(COLS,mcols+2));
_pan := new_panel(_win);
keypad(_win, TRUE);
box(_win, ACS_VLINE, ACS_HLINE);
wbkgd(_win, COLOR_PAIR(pair));
set_menu_back(_menu, COLOR_PAIR(pair));
print_in_middle(_win,0,0,szx-2,pair,name,[]);
set_menu_win(_menu, _win);
set_menu_sub(_menu, derwin(_win, szy-2, szx-2, 1, 1));
//set_menu_sub(_menu, derwin(_win, mrows, mcols, 1, 1));
set_menu_mark(_menu, '-');
end;
destructor TSubmenu.destroy;
var
i: Longint = 0;
begin
unpost_menu(_menu);
free_menu(_menu);
while _items[i] <> nil do
begin
free_item(_items[i]); Inc(i);
end;
FreeMem(_items, (i+1)*sizeof(pITEM));
del_panel(_pan);
delwin(_win);
update_panels();
doupdate();
end;
type
Tmainptr = function: chtype;
const
EXIT_PROGRAM = KEY_MAX + 100;
function confirm_menu: chtype;
const
choices: array[0..2] of TMinfo =
(
(n:' Yes ';d:nil),
(n:'I dont know';d:nil),
(n:' No ';d:nil)
);
var
smenu: TSubmenu;
begin
smenu := TSubmenu.create(3, 41,3,choices,5,'Do you really want to quit?');
menu_opts_off(smenu.menu, O_SHOWDESC);
set_menu_format(smenu.menu, 1, 3);
post_menu(smenu.menu);
smenu.sitem := smenu.items[0];
confirm_menu := smenu.doevent;
if (confirm_menu = 10) OR (confirm_menu = chtype('q')) OR (confirm_menu = KEY_F(10)) then
confirm_menu := EXIT_PROGRAM
else
confirm_menu := -1;
smenu.destroy;
end;
(* Scrolling Menus example *)
function scroll_menu: chtype;
const
choices: array[0..9] of TMinfo =
(
(n: '1_'; d: 'Choice'),
(n: '2_'; d: 'Choice'),
(n: '3_'; d: 'Choice'),
(n: '4_'; d: 'Choice'),
(n: '5_'; d: 'Choice'),
(n: '6_'; d: 'Choice'),
(n: '7_'; d: 'Choice'),
(n: '8_'; d: 'Choice'),
(n: '9_'; d: 'Choice'),
(n: '..'; d: 'Close')
);
var
smenu: TSubmenu;
begin
mvaddstr(LINES - 3, COLS - 30, '"PAGEUP" "PAGEDOWN" - scroll');
refresh();
smenu := TSubmenu.create(8, 13,10,choices,6,'Scrolling');
set_menu_format(smenu.menu, 6, 1);
post_menu(smenu.menu);
scroll_menu := smenu.doevent;
smenu.destroy;
mvaddstr(LINES - 3, COLS - 30, ' ');
refresh();
end;
(* Milt Columnar Menus Example *)
function multicol_menu: chtype;
const
choices: array[0..24] of TMinfo =
(
(n:'1_';d:nil),(n:'2_';d:nil),(n:'3_';d:nil),(n:'4_';d:nil),(n:'5_';d:nil),
(n:'6_';d:nil),(n:'7_';d:nil),(n:'8_';d:nil),(n:'9_';d:nil),(n:'10';d:nil),
(n:'11';d:nil),(n:'12';d:nil),(n:'13';d:nil),(n:'14';d:nil),(n:'15';d:nil),
(n:'16';d:nil),(n:'17';d:nil),(n:'18';d:nil),(n:'19';d:nil),(n:'20';d:nil),
(n:'21';d:nil),(n:'22';d:nil),(n:'23';d:nil),(n:'24';d:nil),(n:'..';d:nil)
);
var
smenu: TSubmenu;
i: Longint;
begin
smenu := TSubmenu.create(7, 22,25,choices,5,'Multicol');
(* Set menu option not to show the description *)
menu_opts_off(smenu.menu, O_SHOWDESC);
set_menu_format(smenu.menu, 5, 5);
post_menu(smenu.menu);
multicol_menu := smenu.doevent;
smenu.destroy;
end;
(* Multi Valued Menus example *)
function multival_menu: chtype;
const
choices: array[0..5] of TMinfo =
(
(n: '1_'; d: 'Choice'),
(n: '2_'; d: 'Choice'),
(n: '3_'; d: 'Choice'),
(n: '4_'; d: 'Choice'),
(n: '5_'; d: 'Choice'),
(n: '..'; d: 'Close')
);
var
smenu: TSubmenu;
begin
mvaddstr(LINES - 3, COLS - 30, '"SPACE" - toggle choice');
refresh();
smenu := TSubmenu.create(8, 13,6,choices,7,'Multival');
menu_opts_off(smenu.menu, O_ONEVALUE);
post_menu(smenu.menu);
multival_menu := smenu.doevent;
smenu.destroy;
mvaddstr(LINES - 3, COLS - 30, ' ');
refresh();
end;
const
n_choices = 4;
choices: array[0..3] of TMinfo =
(
(n: '1_'; d: 'Scrolling Menus'),
(n: '2_'; d: 'Multi Columnar Menus'),
(n: '3_'; d: 'Multi Valued Menus'),
(n: '..'; d: 'Exit')
);
var
main_menu_win: PWINDOW;
main_menu_panel: PPANEL;
function mgetch: chtype;
begin
mgetch := wgetch(main_menu_win);
end;
var
my_bg: Smallint = COLOR_BLACK;
main_items: ppITEM;
cur_item: pITEM;
main_menu: pMENU;
ptr: Tmainptr = @mgetch;
ch: chtype = -1;
i: Longint;
begin
try
(* Initialize curses *)
initscr();
noecho();
cbreak();
keypad(stdscr, TRUE);
curs_set(0);
clear();
mousemask(ALL_MOUSE_EVENTS, nil);
if has_colors() then
begin
start_color();
if (use_default_colors() = OK) then
my_bg := -1
else
my_bg := COLOR_BLACK;
init_pair(1, COLOR_YELLOW, my_bg);
init_pair(2, COLOR_RED, my_bg);
init_pair(3, COLOR_MAGENTA, my_bg);
init_pair(4, COLOR_CYAN, my_bg);
init_pair(5, COLOR_WHITE, COLOR_RED);
init_pair(6, COLOR_WHITE, COLOR_BLUE);
init_pair(7, COLOR_WHITE, COLOR_GREEN);
end;
main_menu_win := newwin(8, 40, st_middle(LINES, 8) - 2, st_middle(COLS, 40) - 10);
main_menu_panel := new_panel(main_menu_win);
keypad(main_menu_win, TRUE);
(* Create items *)
GetMem(main_items, (n_choices+1)*sizeof(pITEM));
for i := 0 to n_choices-1 do
main_items[i] := new_item(choices[i].n, choices[i].d);
main_items[n_choices] := nil;
(* Set the user pointers *)
set_item_userptr(main_items[0], @scroll_menu);
set_item_userptr(main_items[1], @multicol_menu);
set_item_userptr(main_items[2], @multival_menu);
set_item_userptr(main_items[3], @confirm_menu);
(* Crate menu *)
main_menu := new_menu(main_items);
(* Set main window and sub window *)
set_menu_win(main_menu, main_menu_win);
set_menu_sub(main_menu, derwin(main_menu_win, 4, 38, 3, 1));
(* Set menu mark to the string "=>" *)
set_menu_mark(main_menu, '=>');
(* Print a border around the main window and print a title *)
box(main_menu_win, 0, 0);
wbkgd(main_menu_win, COLOR_PAIR(6));
set_menu_back(main_menu, COLOR_PAIR(6));
print_in_middle(main_menu_win, 1, 0, 40, COLOR_PAIR(6), 'Main Menu', []);
mvwaddch(main_menu_win, 2, 0, ACS_LTEE);
mvwhline(main_menu_win, 2, 1, ACS_HLINE, 38);
mvwaddch(main_menu_win, 2, 39, ACS_RTEE);
attron(COLOR_PAIR(4));
mvaddstr(LINES - 1, COLS - 30, 'Press "F10" or "q" to exit ');
attroff(COLOR_PAIR(4));
refresh();
(* Post the menu *)
post_menu(main_menu);
wrefresh(main_menu_win);
while ch <> EXIT_PROGRAM do
begin
case ch of
KEY_DOWN: menu_driver(main_menu, REQ_DOWN_ITEM);
KEY_UP: menu_driver(main_menu, REQ_UP_ITEM);
-1: ptr := @mgetch; (* Restore ptr *)
10: (* Enter *)
begin
cur_item := current_item(main_menu); (* get current item *)
ptr := Tmainptr(item_userptr(cur_item)); (* set ptr to current item *)
end;
else
(* Process mouse and others events *)
if (menu_driver(main_menu, ch) = E_OK) AND (ch = KEY_MOUSE) then
begin
cur_item := current_item(main_menu);
ptr := Tmainptr(item_userptr(cur_item));
wrefresh(main_menu_win);
end;
end;
ch := ptr(); (* Call ptr function *)
if (ch = chtype('q')) OR (ch = KEY_F(10)) then
ch := confirm_menu();
end;
finally
unpost_menu(main_menu);
free_menu(main_menu);
for i := 0 to n_choices - 1 do
free_item(main_items[i]);
FreeMem(main_items, (n_choices+1)*sizeof(pITEM));
del_panel(main_menu_panel);
delwin(main_menu_win);
curs_set(1);
endwin();
end;
end.

169
packages/ncurses/examples/t2panel.pp Normal file
View File

@ -0,0 +1,169 @@
program test_panel;
{$MODE OBJFPC}
uses
ncurses, panel, sysutils;
Type
PPWINDOW = ^PWINDOW;
PPPANEL = ^PPANEL;
const
NLINES = 8;
NCOLS = 32;
procedure print_in_middle(win: PWINDOW; starty, startx, width: Longint; str: AnsiString; color: chtype);
var
slength: Longint;
x, y: Longint;
temp: Double;
begin
if win = nil then
win := stdscr;
getyx(win, y, x);
if startx <> 0 then
x := startx;
if starty <> 0 then
y := starty;
if width = 0 then
width := 80;
slength := Length(str);
temp := (width - slength)/ 2;
x := startx + round(temp);
wattron(win, color);
mvwaddstr(win, y, x, PChar(str));
wattroff(win, color);
refresh();
end;
procedure win_show(win: PWINDOW; lab: AnsiString; label_color: Longint);
var
startx, starty, height, width: Longint;
begin
getbegyx(win, starty, startx);
getmaxyx(win, height, width);
box(win, 0, 0);
mvwaddch(win, 2, 0, ACS_LTEE);
mvwhline(win, 2, 1, ACS_HLINE, width - 2);
mvwaddch(win, 2, width - 1, ACS_RTEE);
print_in_middle(win, 1, 0, width, lab, COLOR_PAIR(label_color));
end;
procedure init_panels(pans: PPPANEL; n: Longint);
var
x, y, i: Longint;
lab: AnsiString;
win: PWINDOW;
begin
y := 2;
x := 3;
for i := 0 to n - 1 do
begin
win := newwin(NLINES, NCOLS, y, x);
FmtStr(lab, 'Window Number %d', [i + 1]);
win_show(win, lab, i + 1);
pans[i] := new_panel(win);
y += 2;
x += 4;
end
end;
procedure select(var oldp: PPANEL; newp: PPANEL);
var
win: PWINDOW;
begin
win := panel_window(oldp);
wattroff(win,A_BOLD);
box(win,0,0);
win := panel_window(newp);
wattron(win,A_BOLD);
box(win,0,0);
oldp := newp;
end;
var
my_panels: array[0..4] of PPANEL;
selected: PPANEL;
ch: chtype;
begin
try
(* Initialize curses *)
initscr();
start_color();
cbreak();
noecho();
keypad(stdscr, TRUE);
(* Initialize all the colors *)
init_pair(1, COLOR_RED, COLOR_BLACK);
init_pair(2, COLOR_GREEN, COLOR_BLACK);
init_pair(3, COLOR_BLUE, COLOR_BLACK);
init_pair(4, COLOR_CYAN, COLOR_BLACK);
init_pair(5, COLOR_YELLOW, COLOR_BLACK);
init_panels(my_panels, 5);
set_panel_userptr(my_panels[0], my_panels[4]);
set_panel_userptr(my_panels[1], my_panels[3]);
set_panel_userptr(my_panels[2], my_panels[1]);
set_panel_userptr(my_panels[3], my_panels[0]);
set_panel_userptr(my_panels[4], my_panels[2]);
select(selected,my_panels[4]);
(* Update the stacking order. 2nd panel will be on top *)
update_panels();
(* Show it on the screen *)
attron(COLOR_PAIR(4));
mvprintw(LINES - 5, 1, 't : top');
mvprintw(LINES - 4, 1, 'h : show or hide toggle');
mvprintw(LINES - 3, 1, '1..5, home, end, up, down, tab : navigate ');
mvprintw(LINES - 2, 1, 'F1 : to Exit');
attroff(COLOR_PAIR(4));
doupdate();
ch := getch;
while ch <> KEY_F(1) do
begin
case ch of
chtype('1'): select(selected,my_panels[0]);
chtype('2'): select(selected,my_panels[1]);
chtype('3'): select(selected,my_panels[2]);
chtype('4'): select(selected,my_panels[3]);
chtype('5'): select(selected,my_panels[4]);
KEY_HOME: select(selected,panel_above(nil));
KEY_END: select(selected,panel_below(nil));
KEY_UP: select(selected,panel_above(selected));
KEY_DOWN: select(selected,panel_below(selected));
9: select(selected,panel_userptr(selected));
chtype('t'): top_panel(selected);
chtype('h'):
begin
if panel_hidden(selected) = OK then
hide_panel(selected)
else
show_panel(selected);
end;
else
end;
update_panels();
doupdate();
ch := getch;
end;
finally
endwin();
end;
end.

241
packages/ncurses/examples/t3form.pp Normal file
View File

@ -0,0 +1,241 @@
{
Author: Vitaliy Trifonov
}
program form_test_3;
{$MODE OBJFPC}
uses
ncurses, form, libc;
function st_middle(scrlen, itemlen: Smallint): Smallint; inline;
begin
st_middle := (scrlen - itemlen) div 2;
end;
procedure draw;
function randomchar: chtype;
var
ch: Char = #0;
begin
while not (ch in ['0'..'9','A'..'Z','a'..'z']) do
ch := Char(Random(123));
randomchar := chtype(ch);
end;
function randompair: longint;
var
pair: longint = 0;
begin
while not (pair in [1..5]) do
pair := Random(6);
randompair := pair;
end;
var
y, x: Smallint;
begin
for y := 0 to LINES - 1 do
for x := 0 to COLS - 1 do
mvaddch(y, x, randomchar OR COLOR_PAIR(randompair));
end;
const
enumval: array[0..2] of PChar = ('one', 'two', 'three');
desc: array[0..5] of PChar =
(
'TYPE_ALPHA Char data, a min width 8',
'TYPE_ENUM one, two, three',
'TYPE_INTEGER -300 .. 300',
'TYPE_NUMERIC -30.0 .. 30.0',
'TYPE_REGEXP ^http://.+\.(ru|net|com)\s*$',
'TYPE_IPV4 An IP Version 4 address.'
);
var
my_bg: Smallint = COLOR_BLACK;
form_win: PWINDOW;
pair: Smallint;
field: array[0..6] of PFIELD;
my_form: PFORM;
i, frows, fcols, ch: Longint;
begin
try
setlocale(LC_ALL, '');
(* Initialize curses *)
initscr();
cbreak();
noecho();
keypad(stdscr, TRUE);
(* Initialize colors *)
if has_colors() then
begin
start_color();
if (use_default_colors() = OK) then
my_bg := -1
else
my_bg := COLOR_BLACK;
init_pair(1, COLOR_YELLOW, my_bg);
init_pair(2, COLOR_MAGENTA, my_bg);
init_pair(3, COLOR_WHITE, my_bg);
init_pair(4, COLOR_CYAN, my_bg);
init_pair(5, COLOR_GREEN, my_bg);
init_pair(6, COLOR_WHITE, COLOR_BLUE);
init_pair(7, COLOR_BLACK, COLOR_CYAN);
end;
for i := 0 to 5 do
begin
field[i] := new_field(1, 30, 2 + i * 3, 10, 0, 0);
field_opts_off(field[i], O_AUTOSKIP);
if i AND 1 = 0 then
pair := 7
else
pair := 6;
set_field_fore(field[i], COLOR_PAIR(pair));
set_field_back(field[i], A_UNDERLINE OR COLOR_PAIR(pair));
//set_field_pad(field[i],chtype(' '));
end;
draw;
refresh();
field[6] := nil;
set_field_type(field[0],TYPE_ALPHA,8);
set_field_type(field[1],TYPE_ENUM,PPChar(enumval),0,0);
set_field_type(field[2],TYPE_INTEGER,3,-300,300);
set_field_type(field[3],TYPE_NUMERIC,8,-30.0,30.0);
set_field_type(field[4],TYPE_REGEXP,'^http://.+\.(ru|net|com)\s*$');
set_field_type(field[5],TYPE_IPV4);
my_form := new_form(field);
(* Calculate the area required for the form *)
scale_form(my_form, @frows, @fcols);
(* Create the window to be associated with the form *)
//form_win := newwin(rows + 4, cols + 4, 4, 4);
form_win := newwin(frows + 4, fcols + 4, st_middle(LINES,frows+4), st_middle(COLS,fcols+4));
keypad(form_win, TRUE);
(* Set main window and sub window *)
set_form_win(my_form, form_win);
set_form_sub(my_form, derwin(form_win, frows, fcols, 2, 2));
(* Print a border around the main window and print a title *)
box(form_win, 0, 0);
//print_in_middle(my_form_win, 1, 0, cols + 4, "My Form", COLOR_PAIR(1));
post_form(my_form);
wrefresh(form_win);
for i := 0 to 5 do
mvwaddstr(form_win, 3 + i * 3, 1,desc[i]);
wrefresh(form_win);
//set_field_buffer(field[0], 0, 'Test Field');
//refresh();
(* Loop through to get user requests *)
ch := wgetch(form_win);
while (ch <> KEY_F(1)) AND (ch <> 27) do
begin
case ch of
9: { TAB }
begin
if form_driver(my_form, REQ_NEXT_WORD) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_NEXT_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
end;
KEY_NPAGE:
(* Go to next field *)
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_NEXT_FIELD);
{ Go to the end of the present buffer
Leaves nicely at the last character }
form_driver(my_form, REQ_END_LINE);
end;
KEY_PPAGE:
(* Go to previous field *)
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_PREV_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
KEY_DOWN:
if form_driver(my_form, REQ_DOWN_CHAR) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_DOWN_FIELD);
end;
KEY_UP:
if form_driver(my_form, REQ_UP_CHAR) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_UP_FIELD);
end;
KEY_LEFT:
if form_driver(my_form, REQ_LEFT_CHAR) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_LEFT_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
KEY_RIGHT:
if form_driver(my_form, REQ_RIGHT_CHAR) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_RIGHT_FIELD);
end;
KEY_BACKSPACE: form_driver(my_form, REQ_DEL_PREV);
10: { ENTER }
begin
form_driver(my_form, 10);
if form_driver(my_form, REQ_NEXT_LINE) <> E_OK then
begin
form_driver(my_form, REQ_VALIDATION);
form_driver(my_form, REQ_NEXT_FIELD);
form_driver(my_form, REQ_END_LINE);
end;
end;
else
{ If this is a normal character, it gets
Printed }
form_driver(my_form, ch);
end;
ch := wgetch(form_win);
end;
finally
unpost_form(my_form);
free_form(my_form);
delwin(form_win);
endwin();
for i := 0 to 5 do
begin
if field_status(field[i]) then
begin
writeln;
writeln('Value ', i,':');
writeln(field_buffer(field[i], 0));
end;
free_field(field[i]);
end
end;
end.

67
packages/ncurses/examples/tbackground.pp Normal file
View File

@ -0,0 +1,67 @@
uses
ncurses, sysutils;
var
f, b: Smallint;
begin
initscr();
cbreak();
noecho();
if (has_colors()) then
begin
start_color();
pair_content(0, @f, @b);
printw(PChar('pair 0 contains (%d,%d)'#10), f, b);
getch();
printw('Initializing pair 1 to red/black'#10);
init_pair(1, COLOR_RED, COLOR_BLACK);
bkgdset(chtype(' ') OR COLOR_PAIR(1));
printw('RED/BLACK'#10);
getch();
printw('Initializing pair 2 to white/blue'#10);
init_pair(2, COLOR_WHITE, COLOR_BLUE);
bkgdset(chtype(' ') OR COLOR_PAIR(2));
printw('WHITE/BLUE'#10);
getch();
printw('Resetting colors to pair 0'#10);
bkgdset(chtype(' ') OR COLOR_PAIR(0));
printw('Default Colors'#10);
getch();
printw('Resetting colors to pair 1'#10);
bkgdset(chtype(' ') OR COLOR_PAIR(1));
printw('RED/BLACK'#10);
getch();
printw('Setting screen to pair 0'#10);
bkgd(chtype(' ') OR COLOR_PAIR(0));
getch();
printw('Setting screen to pair 1'#10);
bkgd(chtype(' ') OR COLOR_PAIR(1));
getch();
printw('Setting screen to pair 2'#10);
bkgd(chtype(' ') OR COLOR_PAIR(2));
getch();
printw('Setting screen to pair 0'#10);
bkgd(chtype(' ') OR COLOR_PAIR(0));
getch();
end
else
begin
printw('This demo requires a color terminal'#10);
getch();
end;
endwin();
end.

267
packages/ncurses/examples/tclock.pp Normal file
View File

@ -0,0 +1,267 @@
program tclock;
{$MODE OBJFPC}
uses
libc, ncurses, sysutils;
const
ASPECT = 2.2;
_2PI = 2.0 * PI;
function sign(_x: Integer): Integer;
begin
if _x < 0 then
sign := -1
else
sign := 1
end;
function A2X(angle,radius: Double): Integer; inline;
begin
A2X := round(ASPECT * radius * sin(angle))
end;
function A2Y(angle,radius: Double): Integer; inline;
begin
A2Y := round(radius * cos(angle))
end;
type
PRchar = ^TRchar;
TRchar = record
ry,rx: Smallint;
rch: chtype;
end;
procedure restore( rest: PRchar );
var
i: Longint = 0;
begin
while rest[i].rch <> 0 do
begin
with rest[i] do
mvaddch(ry, rx, rch);
Inc(i);
end;
freemem(rest)
end;
(* Draw a diagonal(arbitrary) line using Bresenham's alogrithm. *)
procedure dline(from_y, from_x, end_y, end_x: Smallint; ch: chtype; var rest: PRchar);
var
dx, dy: Smallint;
ax, ay: Smallint;
sx, sy: Smallint;
x, y, d, i: Smallint;
begin
dx := end_x - from_x;
dy := end_y - from_y;
ax := abs(dx * 2);
ay := abs(dy * 2);
sx := sign(dx);
sy := sign(dy);
x := from_x;
y := from_y;
i := 0;
if (ax > ay) then
begin
getmem(rest, sizeof(TRchar)*(abs(dx)+3));
d := ay - (ax DIV 2);
while true do
begin
move(y, x);
with rest[i] do
begin
rch := inch;
ry := y;
rx := x;
Inc(i)
end;
addch(ch);
if (x = end_x) then
begin
rest[i].rch := 0;
exit;
end;
if (d >= 0) then
begin
y += sy;
d -= ax;
end;
x += sx;
d += ay;
end
end
else
begin
getmem(rest, sizeof(TRchar)*(abs(dy)+3));
d := ax - (ay DIV 2);
while true do
begin
move(y, x);
with rest[i] do
begin
rch := inch;
ry := y;
rx := x;
Inc(i)
end;
addch(ch);
if (y = end_y) then
begin
rest[i].rch := 0;
exit;
end;
if (d >= 0) then
begin
x += sx;
d -= ay;
end;
y += sy;
d += ax;
end
end
end;
var
cx, cy: Integer;
cr, sradius, mradius, hradius: Double;
procedure clockinit;
const
title1 = 'Free pascal';
title2 = 'ncurses clock';
title3 = 'Press F10 or q to exit';
var
i: Integer;
vstr, tstr: AnsiString;
angle: Double;
begin
cx := (COLS - 1) DIV 2;
cy := LINES DIV 2;
if (cx / ASPECT < cy) then
cr := cx / ASPECT
else
cr := cy;
sradius := (8 * cr) / 9;
mradius := (3 * cr) / 4;
hradius := cr / 2;
for i := 1 to 24 do
begin
angle := i * _2PI / 24.0;
if (i MOD 2) = 0 then
begin
Str (i DIV 2, tstr);
attron(A_BOLD OR COLOR_PAIR(5));
mvaddstr(cy - A2Y(angle, sradius), cx + A2X(angle, sradius), @tstr[1]);
attroff(A_BOLD OR COLOR_PAIR(5));
end
else
begin
attron(COLOR_PAIR(1));
mvaddch(cy - A2Y(angle, sradius), cx + A2X(angle, sradius), chtype('.'));
attroff(COLOR_PAIR(1));
end
end;
vstr := curses_version;
attron(A_DIM OR COLOR_PAIR(2));
mvhline(cy , cx - round(sradius * ASPECT) + 1, ACS_HLINE, round(sradius * ASPECT) * 2 - 1);
mvvline(cy - round(sradius) + 1, cx , ACS_VLINE, round(sradius) * 2 - 1);
attroff(A_DIM OR COLOR_PAIR(1));
attron(COLOR_PAIR(3));
mvaddstr(cy - 5, cx - Length(title1) DIV 2, title1);
mvaddstr(cy - 4, cx - Length(title2) DIV 2, title2);
mvaddstr(cy - 3, cx - Length(vstr) DIV 2, PChar(vstr));
attroff(COLOR_PAIR(3));
attron(A_UNDERLINE);
mvaddstr(cy + 2, cx - Length(title3) DIV 2, title3);
attroff(A_UNDERLINE);
end;
var
angle: Double;
ch: chtype = 0;
Hour, Min, Sec, Msec: Word;
Hrest, Mrest, Srest: PRchar;
timestr: AnsiString;
my_bg: Smallint = COLOR_BLACK;
begin
setlocale(LC_ALL, '');
try
initscr();
noecho();
cbreak();
halfdelay(10);
keypad(stdscr, TRUE);
curs_set(0);
if (has_colors()) then
begin
start_color();
if (use_default_colors() = OK) then
my_bg := -1;
init_pair(1, COLOR_YELLOW, my_bg);
init_pair(2, COLOR_RED, my_bg);
init_pair(3, COLOR_GREEN, my_bg);
init_pair(4, COLOR_CYAN, my_bg);
init_pair(5, COLOR_YELLOW, COLOR_BLACK) ;
end;
clockinit;
repeat
if (ch = KEY_RESIZE) then
begin
flash();
erase();
wrefresh(curscr);
clockinit;
end;
decodeTime(Time, Hour, Min, Sec, Msec);
Hour := Hour MOD 12;
timestr := DateTimeToStr(Now);
mvaddstr(cy + round(sradius) - 4, cx - Length(timestr) DIV 2, PChar(timestr));
angle := Hour * _2PI / 12;
dline(cy, cx, cy - A2Y(angle, hradius), cx + A2X(angle, hradius), chtype('*'),Hrest);
angle := Min * _2PI / 60;
dline(cy, cx, cy - A2Y(angle, mradius), cx + A2X(angle, mradius), chtype('*'),Mrest);
angle := Sec * _2PI / 60;
dline(cy, cx, cy - A2Y(angle, sradius), cx + A2X(angle, sradius), chtype('.'),Srest);
ch := getch();
restore(Srest);
restore(Mrest);
restore(Hrest);
until (ch = chtype('q')) OR (ch = KEY_F(10));
finally
curs_set(1);
endwin();
end;
end.

40
packages/ncurses/examples/tevent.pp Normal file
View File

@ -0,0 +1,40 @@
program test_event;
{$MODE OBJFPC}
uses
ncurses, sysutils;
var
ch: chtype;
begin
try
initscr();
noecho();
clear();
cbreak();
keypad(stdscr, TRUE);
meta(stdscr, TRUE);
mousemask(1, nil);
mvaddstr(1, 1,'press F10 or q to exit');
mvaddstr(2, 1,'press 1 to cbreak mode');
mvaddstr(3, 1,'press 2 to raw mode');
mvaddstr(4, 1,'press 3 to halfdelay(10) mode');
repeat
ch := getch;
mvaddstr(LINES - 1, 1,' ');
case ch of
ERR: mvaddstr(LINES - 1, 1,'timeout: 1 sec');
chtype('1'): cbreak();
chtype('2'): raw();
chtype('3'): halfdelay(10);
else
mvaddstr(LINES - 1, 1,PChar(Format('name:%-14s code:%d', [ keyname(ch), ch ] )));
end;
until (ch = chtype('q')) OR (ch = KEY_F(10));
finally
endwin();
end;
end.

144
packages/ncurses/examples/tmouse.pp Normal file
View File

@ -0,0 +1,144 @@
program mouse_test;
{$MODE OBJFPC}
{$COPERATORS ON}
uses
ncurses, panel, sysutils;
procedure draw;
function randomchar: chtype;
var
ch: Char = #0;
begin
while not (ch in ['0'..'9','A'..'Z','a'..'z']) do
ch := Char(Random(123));
randomchar := chtype(ch);
end;
function randompair: longint;
var
pair: longint = 0;
begin
while not (pair in [1..5]) do
pair := Random(6);
randompair := pair;
end;
var
y, x: Smallint;
begin
for y := 0 to 2 do
for x := 0 to COLS - 7 do
mvaddch(y, x, randomchar OR COLOR_PAIR(randompair));
attron(A_BOLD OR COLOR_PAIR(7));
mvaddstr(0, COLS - 6, ' ');
mvaddstr(1, COLS - 6, ' QUIT ');
mvaddstr(2, COLS - 6, ' ');
attroff(A_BOLD OR COLOR_PAIR(7));
for y := 3 to LINES - 1 do
for x := 0 to COLS - 1 do
mvaddch(y, x, randomchar OR COLOR_PAIR(randompair));
end;
var
win: PWINDOW;
pan: PPANEL;
str: AnsiString;
function doevent: chtype;
var
event: MEVENT;
begin
getmouse(@event);
if (event.y > 2) OR (event.x < COLS - 6) then
begin
mvwaddstr(win, 1, 1, ' ');
str := Format('y := %D, x := %D', [event.y, event.x]);
mvwaddstr(win, 1, 2, PChar(str));
wattron(win,A_BOLD);
mvwaddch(win, 3, 9, mvinch(event.y,event.x ));
wattroff(win,A_BOLD);
halfdelay(12);
show_panel(pan);
if event.bstate AND BUTTON1_RELEASED<> 0 then
mvwaddstr(win, 5, 2,'BUTTON1_RELEASED')
else if event.bstate AND BUTTON2_RELEASED <> 0 then
mvwaddstr(win, 5, 2,'BUTTON2_RELEASED')
else if event.bstate AND BUTTON3_RELEASED <> 0 then
mvwaddstr(win, 5, 2,'BUTTON3_RELEASED')
else if event.bstate AND BUTTON1_PRESSED <> 0 then
mvwaddstr(win, 5, 2,'BUTTON1_PRESSED ')
else if event.bstate AND BUTTON2_PRESSED <> 0 then
mvwaddstr(win, 5, 2,'BUTTON2_PRESSED ')
else if event.bstate AND BUTTON3_PRESSED <> 0 then
mvwaddstr(win, 5, 2,'BUTTON3_PRESSED ')
else if event.bstate AND BUTTON1_CLICKED <> 0 then
mvwaddstr(win, 5, 2,'BUTTON1_CLICKED ')
else if event.bstate AND BUTTON2_CLICKED <> 0 then
mvwaddstr(win, 5, 2,'BUTTON2_CLICKED ')
else if event.bstate AND BUTTON3_CLICKED <> 0 then
mvwaddstr(win, 5, 2,'BUTTON3_CLICKED ');
doevent := wgetch(win);
cbreak();
hide_panel(pan);
end
else
doevent := chtype('q')
end;
var
ch: chtype = 0;
my_bg: Smallint = COLOR_BLACK;
begin
try
initscr();
noecho();
clear();
cbreak();
keypad(stdscr, TRUE);
curs_set(0);
mousemask(ALL_MOUSE_EVENTS, nil);
if (has_colors()) then
begin
start_color();
if (use_default_colors() = OK) then
my_bg := -1
else
my_bg := COLOR_BLACK;
init_pair(1, COLOR_YELLOW, my_bg);
init_pair(2, COLOR_RED, my_bg);
init_pair(3, COLOR_MAGENTA, my_bg);
init_pair(4, COLOR_CYAN, my_bg);
init_pair(5, COLOR_GREEN, my_bg);
init_pair(6, COLOR_WHITE, COLOR_BLUE);
init_pair(7, COLOR_WHITE, COLOR_RED);
end;
win:= newwin(7, 20, (LINES - 7) DIV 2 , (COLS - 20) DIV 2);
pan := new_panel(win);
box(win, ACS_VLINE, ACS_HLINE);
wbkgd(win, COLOR_PAIR(6));
draw;
repeat
if ch = KEY_MOUSE then
ch := doevent
else
ch := getch();
until (ch = chtype('q')) OR (ch = KEY_F(10));
finally
del_panel(pan);
delwin(win);
curs_set(1);
endwin();
end;
end.

49
packages/ncurses/examples/tnlshello.pp Normal file
View File

@ -0,0 +1,49 @@
{
rstconv -i tnlshello.rst -o tnlshello_ru_UTF8.pot
msgfmt tnlshello_ru_UTF8.pot
mv messages.mo ru
}
program nlshello;
{$mode objfpc}
uses
gettext, libc, ncurses;
resourcestring
hello_world = 'Hello world!';
press_key = 'Press any key to continue!';
var
win : pWINDOW;
begin
setlocale(LC_ALL, '');
try
initscr();
start_color;
noecho;
win:= newwin ( 10, COLS - 20, 5, 10);
init_pair(1,COLOR_WHITE,COLOR_BLUE);
init_pair(2,COLOR_RED,COLOR_BLUE);
wbkgd(win, COLOR_PAIR(1));
erase;
refresh;
box(win, ACS_VLINE, ACS_HLINE);
wrefresh(win);
mvwaddstr(win,1,3, curses_version);
TranslateResourcestrings('%s/messages.mo');
wattron(win,A_BLINK OR A_BOLD OR COLOR_PAIR(2));
mvwaddstr(win,3,3, PChar(hello_world));
wattroff(win,A_BLINK OR A_BOLD OR COLOR_PAIR(2));
mvwaddstr(win,5,3, PChar(press_key));
wrefresh(win);
getch();
finally
endwin();
end;
end.

7
packages/ncurses/examples/tnlshello_ru_UTF8.pot Normal file
View File

@ -0,0 +1,7 @@
#: nlshello:hello_world
msgid "Hello world!"
msgstr "Здравствуй мир!"
#: nlshello:press_key
msgid "Press any key to continue!"
msgstr "Нажмите любую клавишу для продолжения!"

567
packages/ncurses/examples/tpad.pp Normal file
View File

@ -0,0 +1,567 @@
{
Author: Vitaliy Trifonov
}
program pad_demo;
{$MODE OBJFPC}
{$IFDEF DEBUG}
{$ASSERTIONS ON}
{$OVERFLOWCHECKS ON}
{$RANGECHECKS ON}
{$CHECKPOINTER ON}
{$ENDIF}
uses
ncurses, panel, sysutils;
type
TNcCoord = array[0..1] of Smallint;
TNcStr = packed record
str: AnsiString;
attr: attr_t;
coord: TNcCoord;
end;
const y = 0; x = 1;
function CTRL( ch: chtype ): chtype; inline;
begin
CTRL := ch AND $001F
end;
function randomchar: chtype;
var
ch: Char = #0;
begin
while not (ch in ['0'..'9','A'..'Z','a'..'z']) do
ch := Char(Random(123));
randomchar := chtype(ch);
end;
function randompair: longint;
var
pair: longint = 0;
begin
while not (pair in [1..5]) do
pair := Random(6);
randompair := pair;
end;
procedure draw;
var
y, x: Smallint;
begin
for y := 0 to LINES - 1 do
for x := 0 to COLS - 1 do
mvaddch(y, x, randomchar OR COLOR_PAIR(randompair));
end;
procedure draw_pad(win: PWINDOW);
var
y, x, my, mx: Smallint;
begin
getmaxyx(win,my,mx);
wborder(win, ACS_CKBOARD,ACS_CKBOARD,ACS_CKBOARD,ACS_CKBOARD,
ACS_CKBOARD,ACS_CKBOARD,ACS_CKBOARD,ACS_CKBOARD);
for y := 1 to my - 2 do
if (y mod 5) = 1 then
for x := 1 to mx - 2 do
if (x mod 10) = 1 then
mvwaddch(win, y, x, randomchar OR COLOR_PAIR(randompair))
else
mvwaddch(win, y, x, ACS_HLINE)
else
for x := 1 to mx - 2 do
if (x mod 10) = 1 then
mvwaddch(win, y, x, ACS_VLINE)
else
mvwaddch(win, y, x, chtype(' '))
end;
function st_middle(scrlen, itemlen: Smallint): Smallint; inline;
begin
st_middle := (scrlen - itemlen) div 2;
end;
procedure print_in_middle(win: PWINDOW; var nstr: TNcStr; width: Longint);
var
my, mx: Smallint;
begin
getmaxyx(win, my, mx);
mx -= nstr.coord[1];
if (width > length(nstr.str)) OR (width < 1) then
width := length(nstr.str);
if width > mx then
width := mx;
nstr.coord[x] += st_middle(mx,width);
wattron(win,nstr.attr);
mvwaddnstr(win,nstr.coord[y],nstr.coord[x],PChar(nstr.str),width);
wattroff(win,nstr.attr);
end;
type
TBarData = packed record
beg, len, slen: Smallint;
end;
TPad = class
private
wyx, pyx, ppos, grid: TNcCoord;
hbar, vbar: TBarData;
padwin, projwin: PWINDOW;
panel: PPANEL;
header: TNcStr;
changed: Boolean;
procedure init_bars;
procedure draw_hbar;
procedure draw_vbar;
public
function scroll_right: Boolean;
function scroll_left: Boolean;
function scroll_down: Boolean;
function scroll_up: Boolean;
function doevent: chtype;
procedure dorefresh;
function move(const ncoord: array of Smallint): Boolean; inline;
function hide: Boolean; inline;
function show: Boolean; inline;
procedure resize;
function resize(const nsize: array of Smallint): Boolean;
constructor create(const parm: array of TNcCoord; const hdr: TNcStr);
destructor destroy; override;
property win: PWINDOW read padwin;
property ysize: Smallint read wyx[y];
property xsize: Smallint read wyx[x];
end;
procedure TPad.init_bars;
function get_scrl_len(blen, wsz, psz: Smallint): Smallint; inline;
begin
get_scrl_len := (blen * wsz) div psz;
end;
begin
hbar.beg := 4;
hbar.len := wyx[x] - hbar.beg * 2;
hbar.slen := get_scrl_len(hbar.len, wyx[x], pyx[x]);
vbar.beg := 2;
vbar.len := wyx[y] - vbar.beg * 2;
vbar.slen := get_scrl_len(vbar.len, wyx[y], pyx[y]);
end;
function get_scrl_beg(ind, slen, blen, wsz, psz, bbeg: Smallint): Smallint;
begin
if psz <> wsz then
get_scrl_beg := (ind * (blen - slen)) div (psz - wsz) + bbeg
else
get_scrl_beg := bbeg;
end;
procedure TPad.draw_hbar;
var
i, sbeg: Smallint;
begin
with hbar do
begin
sbeg := get_scrl_beg(ppos[x],hbar.slen,hbar.len,wyx[x], pyx[x],hbar.beg);
wattron(projwin,header.attr);
for i := beg to beg + len - 1 do
if (i < sbeg) OR (i > sbeg + slen) then
mvwaddch(projwin,wyx[y]-1,i ,ACS_CKBOARD)
else
mvwaddch(projwin,wyx[y]-1,i,ACS_BLOCK);
wattroff(projwin,header.attr);
end
end;
procedure TPad.draw_vbar;
var
i, sbeg: Smallint;
begin
with vbar do
begin
sbeg := get_scrl_beg(ppos[y],vbar.slen,vbar.len,wyx[y], pyx[y],vbar.beg);
wattron(projwin,header.attr);
for i := beg to beg + len - 1 do
if (i < sbeg) OR (i > sbeg + slen) then
mvwaddch(projwin,i,wyx[x]-1,ACS_CKBOARD)
else
mvwaddch(projwin,i,wyx[x]-1,ACS_BLOCK);
wattroff(projwin,header.attr);
end
end;
function TPad.scroll_right: Boolean;
begin
if ppos[x] > 0 then
begin
if (ppos[x] < grid[x]) then
ppos[x] := 0
else
ppos[x] -= grid[x];
draw_hbar;
changed := true;
scroll_right := true
end
else
scroll_right := false
end;
function TPad.scroll_left: Boolean;
var
dwidth: Longint;
begin
dwidth := pyx[x] - wyx[x] + 2;
if ppos[x] < dwidth then
begin
if ppos[x] > (dwidth - grid[x]) then
ppos[x] := dwidth
else
ppos[x] += grid[x];
draw_hbar;
changed := true;
scroll_left := true
end
else
scroll_left := false
end;
function TPad.scroll_down: Boolean;
begin
if ppos[y] > 0 then
begin
if ppos[y] < grid[y] then
ppos[y] := 0
else
ppos[y] -= grid[y];
draw_vbar;
changed := true;
scroll_down := true
end
else
scroll_down := false
end;
function TPad.scroll_up: Boolean;
var
dheight: Longint;
begin
dheight := pyx[y] - wyx[y] + 2;
if ppos[y] < dheight then
begin
if ppos[y] > (dheight - grid[x]) then
ppos[y] := dheight
else
ppos[y] += grid[x];
draw_vbar;
changed := true;
scroll_up := true
end
else
scroll_up := false
end;
function TPad.doevent: chtype;
var
ch: chtype;
rval: Boolean = true;
begin
ch := wgetch(projwin);
case ch of
KEY_DOWN: rval := scroll_up;
KEY_UP: rval := scroll_down;
KEY_LEFT: rval := scroll_right;
KEY_RIGHT: rval := scroll_left;
end;
if not rval then
begin
ncurses.beep();
flash();
end;
doevent := ch
end;
procedure TPad.dorefresh;
var
rval: Longint = OK;
begin
if changed then
begin
rval := copywin(padwin,projwin,ppos[y],ppos[x],1,1,wyx[y]-2,wyx[x]-2, 0);
assert(rval=OK,'copywin error');
if rval = OK then
changed := false;
end
end;
function TPad.move(const ncoord: array of Smallint): Boolean;
begin
move := move_panel(panel, ncoord[y], ncoord[x]) = OK
end;
function TPad.hide: Boolean;
begin
hide := hide_panel(panel) = OK
end;
function TPad.show: Boolean;
begin
show := show_panel(panel) = OK
end;
procedure TPad.resize;
var
nsize: TNcCoord;
doresize: Boolean = false;
begin
getbegyx(projwin,nsize[y],nsize[x]);
nsize[y] += wyx[y];
nsize[x] += wyx[x];
if nsize[y] > LINES then
begin
nsize[y] := LINES; doresize := true
end
else
nsize[y] := wyx[y];
if nsize[x] > COLS then
begin
nsize[x] := COLS; doresize := true
end
else
nsize[x] := wyx[x];
if doresize then
resize(nsize)
end;
function TPad.resize(const nsize: array of Smallint): Boolean;
var
by, bx: Smallint;
domove: Boolean = false;
tcoord: TNcCoord;
begin
if (nsize[y] <= LINES)AND(nsize[x] <= COLS) then
begin
if nsize[y] > pyx[y] + 2 then
tcoord[y] := pyx[y] + 2
else
tcoord[y] := nsize[y];
if nsize[x] > pyx[x] + 2 then
tcoord[x] := pyx[x] + 2
else
tcoord[x] := nsize[x];
getbegyx(projwin, by, bx);
if tcoord[y] + by >= LINES then
begin
by := LINES - tcoord[y]; domove := true
end;
if tcoord[x] + bx >= COLS then
begin
bx := COLS - tcoord[x]; domove := true
end;
if tcoord[x] > (pyx[x] - ppos[x]) then
scroll_right;
if tcoord[y] > (pyx[y] - ppos[y]) then
scroll_down;
hide_panel(panel);
wresize(projwin, tcoord[y], tcoord[x]);
if domove then
move_panel(panel, by, bx);
show_panel(panel);
box(projwin, ACS_VLINE, ACS_HLINE);
getmaxyx(projwin,wyx[y],wyx[x]);
header.coord[y] := 0; header.coord[x] := 0;
print_in_middle(projwin, header, 0);
init_bars;
draw_hbar;
draw_vbar;
changed := true;
resize := true
end
else
resize := false
end;
constructor TPad.create(const parm: array of TNcCoord; const hdr: TNcStr);
{$IFDEF DEBUG}
var
tysz, txsz: Smallint;
{$ENDIF}
begin
if parm[0,y] >= parm[1,y] + 2 then
wyx[y] := parm[1,y] + 2
else
wyx[y] := parm[0,y];
if parm[0,x] >= parm[1,x] + 2 then
wyx[x] := parm[1,x] + 2
else
wyx[x] := parm[0,x];
projwin := newwin(wyx[y], wyx[x], (LINES - wyx[y]) div 2, (COLS - wyx[x]) div 2);
intrflush(projwin, FALSE);
keypad(projwin, TRUE);
box(projwin, ACS_VLINE, ACS_HLINE);
panel := new_panel(projwin);
padwin := newpad(parm[1,y], parm[1,x]);
header := hdr;
pyx := parm[1];
grid := parm[2];
{$IFDEF DEBUG}
getmaxyx(projwin,tysz, txsz);
assert((wyx[y]=tysz)AND(wyx[x]=txsz), 'Invalid window');
getmaxyx(padwin,tysz, txsz);
assert((pyx[y]=tysz)AND(pyx[x]=txsz), 'Invalid pad');
{$ENDIF}
FmtStr(header.str, '%s, pad: h=%d w=%d, win: h=%d w=%d', [hdr.str,pyx[y],pyx[x],wyx[y],wyx[x]]);
print_in_middle(projwin, header, 0);
init_bars;
draw_hbar;
draw_vbar;
changed := true;
end;
destructor TPad.destroy;
begin
del_panel(panel);
delwin(padwin);
delwin(projwin);
end;
procedure init_stdscr;
begin
draw;
attron(COLOR_PAIR(7));
mvaddstr(LINES - 3, 0,'press "+" "-" to resize ');
mvaddstr(LINES - 2, 0,'press UP, DOWN, LEFT, RIGHT to scroll');
mvaddstr(LINES - 1, 0,'press F10 or q to exit ');
attroff(COLOR_PAIR(7));
end;
var
ch: chtype;
ncpad: TPad;
my_bg: Smallint = COLOR_BLACK;
wnd, pad, grid: TNcCoord;
code: Word;
header: TNcStr = (str:'Pad demo';attr:A_NORMAL;coord:(0,0));
begin
try
initscr();
noecho();
clear();
cbreak();
curs_set(0);
keypad(stdscr, TRUE);
meta(stdscr, TRUE);
mousemask(1, nil);
if has_colors() then
begin
start_color();
if (use_default_colors() = OK) then
my_bg := -1
else
my_bg := COLOR_BLACK;
init_pair(1, COLOR_YELLOW, my_bg);
init_pair(2, COLOR_MAGENTA, my_bg);
init_pair(3, COLOR_WHITE, my_bg);
init_pair(4, COLOR_CYAN, my_bg);
init_pair(5, COLOR_GREEN, my_bg);
init_pair(6, COLOR_WHITE, COLOR_BLUE);
init_pair(7, COLOR_BLACK, COLOR_YELLOW);
end;
init_stdscr;
//refresh();
wnd[y] := LINES - 6;
wnd[x] := COLS - 12;
pad[y] := wnd[y] + 6;
pad[x] := wnd[x] + 6;
grid[y] := 3;
grid[x] := 3;
if paramcount > 1 then
begin
val(ParamStr(1),pad[y],code);
val(ParamStr(2),pad[x],code);
end;
if paramcount > 3 then
begin
val(ParamStr(3),wnd[y],code);
val(ParamStr(4),wnd[x],code);
end;
header.attr := COLOR_PAIR(6);
ncpad := TPad.create([wnd,pad,grid],header);
draw_pad(ncpad.win);
ncpad.dorefresh;
update_panels();
doupdate();
repeat
ch := ncpad.doevent;
case ch of
chtype('+'): ncpad.resize([ncpad.ysize + 1,ncpad.xsize + 1]);
chtype('='): ncpad.resize([ncpad.ysize + 1,ncpad.xsize + 1]);
chtype('-'): ncpad.resize([ncpad.ysize - 1,ncpad.xsize - 1]);
chtype(' '): ncpad.resize([wnd[y],wnd[x]]);
KEY_RESIZE:
begin
flash();
init_stdscr;
ncpad.resize;
end;
end;
ncpad.dorefresh;
update_panels();
doupdate();
until (ch = chtype('q')) OR (ch = KEY_F(10));
finally
ncpad.destroy;
curs_set(1);
endwin();
end;
end.

82
packages/ncurses/examples/twindow.pp Normal file
View File

@ -0,0 +1,82 @@
program test_window;
{$mode objfpc}
uses
ncurses, panel, sysutils;
procedure printw(win: PWINDOW; y,x: Smallint; fmt: AnsiString; args: Array of const);
var
tstr: AnsiString;
begin
FmtStr(tstr, fmt, args);
mvwaddstr(win,y,x, PChar(tstr));
end;
procedure printinfo(win: PWINDOW);
begin
with win^ do
begin
printw(win,1 ,1,'_cury=%-3d, _curx=%-3d : cursor position',[_cury,_curx]);
printw(win,2 ,1,'_maxy=%-3d, _maxx=%-3d : maximums of x and y, NOT window size',[_maxy,_maxx]);
printw(win,3 ,1,'_begy=%-3d, _begx=%-3d : screen coords of upper-left-hand corner',[_begy,_begx]);
printw(win,4 ,1,'_flags=%-3d : window state flags',[_flags]);
printw(win,5 ,1,'_attrs=%-4d : current attribute for non-space character',[_attrs]);
printw(win,6 ,1,'_bkgd=%-3d : current background char/attribute pair',[_bkgd]);
printw(win,7 ,1,'_notimeout=%-1d : no time out on function-key entry?', [Byte(_notimeout)]);
printw(win,8 ,1,'_clear=%-1d : consider all data in the window invalid?',[Byte(_clear)]);
printw(win,9 ,1,'_leaveok=%-1d : OK to not reset cursor on exit?',[Byte(_leaveok)]);
printw(win,10,1,'_scroll=%-1d : OK to scroll this window?',[Byte(_scroll)]);
printw(win,11,1,'_idlok=%-1d : OK to use insert/delete line?',[Byte(_idlok)]);
printw(win,12,1,'_idcok=%-1d : OK to use insert/delete char?',[Byte(_idcok)]);
printw(win,13,1,'_immed=%-1d : window in immed mode? (not yet used)',[Byte(_immed)]);
printw(win,14,1,'_sync=%-1d : window in sync mode?',[Byte(_sync)]);
printw(win,15,1,'_use_keypad=%-1d : process function keys into KEY_ symbols?',[Byte(_use_keypad)]);
printw(win,16,1,'_delay=%-3d : 0 = nodelay, <0 = blocking, >0 = delay',[_delay]);
printw(win,17,1,'_parx=%-3d : x coordinate of this window in parent',[_parx]);
printw(win,18,1,'_pary=%-3d : y coordinate of this window in parent',[_pary]);
printw(win,19,1,'_yoffset=%-3d : real begy is _begy + _yoffset',[_yoffset]);
printw(win,20,1,'_bkgrnd.attr=%-4d : current background char/attribute pair',[_bkgrnd.attr]);
end;
end;
var
win : pWINDOW;
cy, cx, by, bx, my, mx: Longint;
begin
try
initscr();
start_color;
noecho;
init_pair(1,COLOR_WHITE,COLOR_BLUE);
init_pair(2,COLOR_RED,COLOR_BLUE);
win:= newwin( LINES - 2, COLS - 6, 1, 3);
wbkgd(win, COLOR_PAIR(1));
erase;
refresh;
box(win, ACS_VLINE, ACS_HLINE);
wmove(win,12,24);
printinfo(win);
wrefresh(win);
getch;
getyx(win,cy,cx);
getbegyx(win,by,bx);
getmaxyx(win,my,mx);
delwin(win);
clear();
printw(stdscr,1 ,1,'getyx(win,%d,%d)',[cy,cx]);
printw(stdscr,2 ,1,'getbegyx(win,%d,%d);',[by,bx]);
printw(stdscr,3 ,1,'getmaxyx(win,%d,%d);',[my,mx]);
getch;
finally
endwin();
end;
end.