Browse Source

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

git-svn-id: trunk@10878 -
marco 17 years ago
parent
commit
5edafaab61

+ 16 - 0
.gitattributes

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

+ 1 - 1
packages/ncurses/Makefile.fpc

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


+ 83 - 0
packages/ncurses/examples/t1form.pp

@@ -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 - 0
packages/ncurses/examples/t1menu.pp

@@ -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 - 0
packages/ncurses/examples/t1panel.pp

@@ -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 - 0
packages/ncurses/examples/t2form.pp

@@ -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 - 0
packages/ncurses/examples/t2menu.pp

@@ -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 - 0
packages/ncurses/examples/t2panel.pp

@@ -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 - 0
packages/ncurses/examples/t3form.pp

@@ -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 - 0
packages/ncurses/examples/tbackground.pp

@@ -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 - 0
packages/ncurses/examples/tclock.pp

@@ -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 - 0
packages/ncurses/examples/tevent.pp

@@ -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 - 0
packages/ncurses/examples/tmouse.pp

@@ -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 - 0
packages/ncurses/examples/tnlshello.pp

@@ -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 - 0
packages/ncurses/examples/tnlshello_ru_UTF8.pot

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

+ 567 - 0
packages/ncurses/examples/tpad.pp

@@ -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 - 0
packages/ncurses/examples/twindow.pp

@@ -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.