summaryrefslogtreecommitdiff
path: root/packages/ncurses
diff options
context:
space:
mode:
authormarco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2>2008-01-26 14:51:36 +0000
committermarco <marco@3ad0048d-3df7-0310-abae-a5850022a9f2>2008-01-26 14:51:36 +0000
commitd0cfd23290b9d1b09708d384faa7f7efd1fa2fdd (patch)
tree8e3a0889733d820d2f6a7e9ad63f7d9526c5dd6f /packages/ncurses
parenta74195eea615fce3897ce9fd9b633b6c44110a51 (diff)
downloadfpc-d0cfd23290b9d1b09708d384faa7f7efd1fa2fdd.tar.gz
* ncurses moved. makefile.fpc + fpmake included, makefile in separate commit
git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@9930 3ad0048d-3df7-0310-abae-a5850022a9f2
Diffstat (limited to 'packages/ncurses')
-rw-r--r--packages/ncurses/Makefile.fpc27
-rw-r--r--packages/ncurses/examples/db_demo.pp188
-rw-r--r--packages/ncurses/examples/edit_demo.pp603
-rw-r--r--packages/ncurses/examples/firework.pp136
-rw-r--r--packages/ncurses/examples/menu_demo.pp105
-rw-r--r--packages/ncurses/examples/ocrt_demo.pp227
-rw-r--r--packages/ncurses/examples/screen_demo.pp53
-rw-r--r--packages/ncurses/fpmake.pp54
-rw-r--r--packages/ncurses/src/eti.inc46
-rw-r--r--packages/ncurses/src/menu.pp284
-rw-r--r--packages/ncurses/src/ncrt.inc937
-rw-r--r--packages/ncurses/src/ncrt.pp44
-rw-r--r--packages/ncurses/src/ncurses.pp1708
-rw-r--r--packages/ncurses/src/ocrt.pp3266
-rw-r--r--packages/ncurses/src/panel.pp64
-rw-r--r--packages/ncurses/src/pxpic.inc448
-rw-r--r--packages/ncurses/src/pxpic.txt390
-rw-r--r--packages/ncurses/tests/testn.pp31
18 files changed, 8611 insertions, 0 deletions
diff --git a/packages/ncurses/Makefile.fpc b/packages/ncurses/Makefile.fpc
new file mode 100644
index 0000000000..2d83e7fe90
--- /dev/null
+++ b/packages/ncurses/Makefile.fpc
@@ -0,0 +1,27 @@
+#
+# Makefile.fpc for NCurses bindings
+#
+
+[package]
+name=ncurses
+version=2.0.0
+
+[target]
+units=ncurses panel ncrt ocrt menu
+examples=firework testn ocrt_demo edit_demo db_demo screen_demo
+
+[require]
+libc=y
+
+[install]
+fpcpackage=y
+
+[compiler]
+includedir=src
+sourcedir=src tests examples
+
+[default]
+fpcdir=../..
+
+[rules]
+.NOTPARALLEL:
diff --git a/packages/ncurses/examples/db_demo.pp b/packages/ncurses/examples/db_demo.pp
new file mode 100644
index 0000000000..b2c24193f5
--- /dev/null
+++ b/packages/ncurses/examples/db_demo.pp
@@ -0,0 +1,188 @@
+{------------------------------------------------------------------------------
+ CncWare
+ (c) Copyright 2000
+ ------------------------------------------------------------------------------
+ Filename..: db_demo.pp
+ Programmer: Ken J. Wright, ken@cncware.com
+ Date......: 06/29/2000
+
+ Purpose - Demonstrate the use of oCrt in a simulated database record editor.
+
+-------------------------------<< REVISIONS >>---------------------------------
+ Ver | Date | Prog| Description
+-------+------------+-----+----------------------------------------------------
+ 1.00 | 06/29/2000 | kjw | Initial Release.
+-------------------------------------------------------------------------------
+}
+Program db_demo;
+Uses oCrt;
+Const
+ MAXCOLS = 6;
+ MAXROWS = 10;
+Type
+ tAddress = Record
+ FirstName,
+ LastName,
+ Street : string[40];
+ Country : string[2];
+ Zip : string[5];
+ City : string[30];
+ End;
+
+ tFields = Record
+ x,y,wid : integer;
+ pic : string;
+ End;
+
+Var
+ win : tnWindow;
+ address : Array [1..MAXROWS] of tAddress;
+ fields : Array [1..MAXCOLS] of tFields;
+ s : string;
+ i,
+ m1,m2,
+ att1,att2,att3,
+ row,
+ col : integer;
+ ch : char;
+ IsDone : boolean;
+
+Procedure Display(row : integer);
+Begin
+ With address[row] Do Begin
+ For i := 1 to MAXCOLS Do Begin
+ With fields[i] Do Begin
+ Case i of
+ 1 : s := FirstName;
+ 2 : s := LastName;
+ 3 : s := Street;
+ 4 : s := Country;
+ 5 : s := Zip;
+ 6 : s := City;
+ End;
+ win.FWrite(x,y,att1,x+wid-1,s);
+ End;
+ End;
+ End;
+ col := 1;
+End;
+
+{ bind the arrow keys so they trigger an exit }
+Procedure BindArrows;
+Begin
+ win.ec.Special := ^I^R^L^P^N;
+ m1 := win.ec.AddChMap(#0+Char(nKeyRight)+^R#0);
+ m2 := win.ec.AddChMap(#0+Char(nKeyLeft)+^L#0);
+ win.FWrite(1,win.Rows,48,0,'[F2]-Arrows');
+End;
+
+Procedure UnBindArrows;
+Begin
+ win.ec.Special := ^R^L^P^N;
+ win.ec.ClrChMap(m1);
+ win.ec.ClrChMap(m2);
+ win.FWrite(1,win.Rows,62,0,'[F2]-Arrows');
+End;
+
+Begin
+ FillChar(address,SizeOf(address),#0);
+ With address[1] Do Begin
+ FirstName := 'Rainer';
+ LastName := 'Hantsch';
+ Street := '12345 Some Street';
+ Country := 'A';
+ Zip := '1030';
+ City := 'Vienna';
+ End;
+
+ For i := 1 to MAXCOLS Do Begin
+ With fields[i] Do Begin
+ Case i of
+ 1 : Begin x := 14; y := 2; wid := 40; pic := ''; End;
+ 2 : Begin x := 14; y := 3; wid := 40; pic := ''; End;
+ 3 : Begin x := 14; y := 4; wid := 40; pic := ''; End;
+ 4 : Begin x := 14; y := 5; wid := 2; pic := ''; End;
+ 5 : Begin x := 19; y := 5; wid := 5; pic := '*#'; End;
+ 6 : Begin x := 27; y := 5; wid := 30; pic := ''; End;
+ End;
+ End;
+ End;
+
+ att1 := 19; { field display color }
+ att2 := 31; { field edit color }
+ att3 := 23; { labels color }
+
+ nMakeWindow(win,1,1,60,10,att3,30,63,true,center,' Rainer''s Address Book ');
+ With win Do Begin
+ Align(center,center);
+ FWrite(1,Rows,48,Cols,'[F2]-Arrows [F10]-Exit [Tab]-NextField [^P]-Prev [^N]-Next');
+ Writeln;
+ Writeln(' First Name [ ]');
+ Writeln(' Last Name [ ]');
+ Writeln(' Street [ ]');
+ Write (' Zip/City [ ]-[ ] [ ]');
+ Show;
+ ec.AddChMap(^P#0#0+Char(nKeyPgUp));
+ ec.AddChMap(^N#0#0+Char(nKeyPgDn));
+ BindArrows;
+ row := 1;
+ col := 1;
+ display(row);
+ IsDone := false;
+ Repeat
+ Str(row:2,s);
+ FWrite((cols-10) div 2,rows-1,26,0,'Record #'+s);
+ With address[row] Do Begin
+ With fields[col] Do Begin
+ ec.Picture := pic;
+ Case col of
+ 1 : s := FirstName;
+ 2 : s := LastName;
+ 3 : s := Street;
+ 4 : s := Country;
+ 5 : s := Zip;
+ 6 : s := City;
+ End;
+ s := Edit(x,y,att2,x+wid-1,x+Length(s),s,ch);
+ If ch <> #27 Then
+ Case col of
+ 1 : FirstName := s;
+ 2 : LastName := s;
+ 3 : Street := s;
+ 4 : Country := s;
+ 5 : Zip := s;
+ 6 : City := s;
+ End;
+ FWrite(x,y,att1,x+wid-1,s);
+ Case Ord(ch) of
+ 9,
+ 13,
+ Ord(^r) : Inc(col);
+ Ord(^l) : Dec(col);
+ nKeyUp : Case col of
+ 1 : col := 4;
+ 2,3,4 : Dec(col);
+ 5,6 : col := 3;
+ End;
+ nKeyDown : Case col of
+ 1..3 : Inc(col);
+ 4..6 : col := 1;
+ End;
+ nKeyPgDn : Inc(row);
+ nKeyPgUp : Dec(row);
+ nKeyF2 : UnBindArrows; { use arrows for editing }
+ nKeyF10 : IsDone := true;
+ End;
+ End;
+ End;
+ If row > MAXROWS Then row := MAXROWS;
+ If row < 1 Then row := 1;
+ If col > MAXCOLS Then col := 1;
+ If col < 1 Then col := MAXCOLS;
+ If Ord(ch) in [nKeyPgUp,nKeyPgDn] Then Display(row);
+ If Ord(ch) <> nKeyF2 Then BindArrows; { arrows for navigation }
+ Until IsDone;
+ Hide;
+ Done;
+ End;
+End.
diff --git a/packages/ncurses/examples/edit_demo.pp b/packages/ncurses/examples/edit_demo.pp
new file mode 100644
index 0000000000..63ae884df8
--- /dev/null
+++ b/packages/ncurses/examples/edit_demo.pp
@@ -0,0 +1,603 @@
+Program Edit_Demo;
+{---------------------------------------------------------------------------
+ CncWare
+ (c) Copyright 1999-2000
+ ---------------------------------------------------------------------------
+ Filename..: edit_demo.pp
+ Programmer: Ken J. Wright, ken@cncware.com
+ Date......: 12/12/99
+
+ Purpose - Demonstrate the use of the oCrt unit.
+
+-------------------------------<< REVISIONS >>--------------------------------
+ Ver | Date | Prog| Description
+-------+----------+-----+-----------------------------------------------------
+ 1.00 | 12/12/99 | kjw | Initial Release.
+ 1.01 | 12/13/99 | kjw | Changed to use oCrt.
+ 1.02 | 06/16/00 | kjw | Added help & goto line pop-up screens.
+ | Changes for control keys.
+ 1.03 | 07/25/00 | kjw | Added use of new tnMenu object.
+------------------------------------------------------------------------------
+}
+uses oCrt;
+
+const
+ MAXLINES = 52; { allow for long screens }
+ CURLINES : Integer = MAXLINES; { adjusted later }
+ FRAMED = true;
+ NOFRAME = false;
+ bg = 16; { background color multiplier }
+
+type
+ { doubly linked list of strings to edit }
+ pLine = ^tLine;
+ tLine = Record
+ s : ^string;
+ next,
+ prev : pLine;
+ End;
+ s80 = string[80];
+
+var
+ hdr, { list head }
+ line, { current position in list }
+ line1 : pLine; { first list item of current page }
+ ss : array[1..MAXLINES] of s80; { a sliding screen buffer }
+ xp,yp : string; { x & y positions for the status line }
+ EdWin, { main edit window }
+ StatWin : tnWindow; { status line }
+ mnu0 : tnMenu; { main menu }
+ mnu1 : pnMenu; { dynamic menu for sub menus }
+ xi, { integer scratch pad }
+ cv, { edit character return value }
+ idx : integer; { current screen buffer row index }
+ cline, { current line number }
+ dlines : integer; { number of displayed lines }
+ lines : longint; { total number of lines in the list }
+ mactive, { is the menu active? }
+ Finished : boolean; { exit when finished }
+ tf : text; { the text file we are reading/writing }
+ fnam : string; { name of the current file, tf }
+
+
+{ replace the old string with a new one }
+Procedure ReallocateLine(var p : pLine; s : string);
+Begin
+ If p = Nil Then Exit;
+ If p^.s^ <> s Then Begin
+ FreeMem(p^.s,Length(p^.s^)+1);
+ GetMem(p^.s,Length(s)+1);
+ p^.s^ := s;
+ End;
+End;
+
+{ insert a new pline into the edit list before p }
+Procedure InsertLine(var p : pLine; s : string);
+Var
+ tmp : pLine;
+Begin
+ New(tmp);
+ GetMem(tmp^.s,Length(s)+1);
+ tmp^.s^ := s;
+ tmp^.prev := p^.prev;
+ tmp^.next := p;
+ p^.prev := tmp;
+ tmp^.prev^.next := tmp;
+ inc(lines);
+End;
+
+{ delete a pline from the edit list }
+Procedure DeleteLine(var p : pLine);
+Var
+ tmp : pLine;
+Begin
+ FreeMem(p^.s,Length(p^.s^));
+ tmp := p^.next;
+ tmp^.prev := p^.prev;
+ p^.prev^.next := tmp;
+ Dispose(p);
+ p := tmp;
+ dec(lines);
+ If cline > lines Then cline := lines;
+End;
+
+{ return the minimum of two integer values }
+Function Min(i1,i2 : integer) : integer;
+Begin
+ If i1 < i2 Then
+ Min := i1
+ Else
+ Min := i2;
+End;
+
+{ fill the edit buffer starting with position h in the edit list }
+Procedure LoadLines(var h : pLine);
+Var
+ tmp : pLine;
+ i : integer;
+Begin
+ FillChar(ss,SizeOf(ss),#0);
+ tmp := h;
+ If tmp = hdr Then tmp := tmp^.Next;
+ For i := 1 to CURLINES Do Begin
+ If (tmp <> Nil) and (tmp <> hdr) Then Begin
+ ss[i] := tmp^.s^;
+ tmp := tmp^.next;
+ dlines := i;
+ End;
+ End;
+End;
+
+{ display the edit buffer in the edit window }
+Procedure DisplayLines;
+Var
+ i : integer;
+Begin
+ With EdWin Do Begin
+ For i := 1 to CURLINES Do Begin
+ FWrite(1,i,GetColor,Cols,ss[i]);
+ End;
+ End;
+End;
+
+{ free the entire edit list }
+Procedure ClearLines(var h : pLine);
+Var
+ tmp : pLine;
+Begin
+ If h <> Nil Then Begin
+ tmp := h^.prev;
+ If (tmp <> h) and (tmp^.s <> Nil) Then Begin
+ FreeMem(tmp^.s,Length(tmp^.s^)+1);
+ tmp^.next := h;
+ Dispose(tmp);
+ End;
+ End;
+ New(h);
+ h^.next := h;
+ h^.prev := h;
+ h^.s := nil;
+End;
+
+Function PromptFile(hs : string; var s : string) : integer;
+Var
+ win : pnWindow;
+ ret : integer;
+Begin
+ New(win,Init(1,1,EdWin.Cols,3,cyan*bg,FRAMED,cyan*bg+white));
+ With win^ Do Begin
+ PutHeader(hs,GetFrameColor,center);
+ FWrite(2,1,GetColor,0,'Filename: ');
+ Align(center,center);
+ Show;
+ s := Edit(12,1,GetColor+white,Cols,12,fnam,ret);
+ PromptFile := ret;
+ Hide;
+ End;
+ Dispose(win,Done);
+End;
+
+{ prompt for, and open a text file }
+Function OpenFile(var f : text; prompt : boolean) : boolean;
+Var
+ s : string;
+ tst : text;
+ ret : integer;
+Begin
+ If prompt Then
+ ret := PromptFile('Open File',s)
+ Else Begin
+ s := fnam;
+ ret := nkEnter;
+ End;
+ If ret = nkEnter Then Begin
+ Assign(tst,s);
+ {$I-}
+ Reset(tst);
+ {$I+}
+ If IoResult = 0 Then Begin
+ Close(tst);
+ Assign(f,s);
+ Reset(f);
+ OpenFile := true;
+ fnam := s;
+ End Else Begin
+ nShowMessage('Could not open file "'+s+'"',79,' Error ',78,true);
+ OpenFile := false;
+ End;
+ End Else
+ OpenFile := false;
+End;
+
+{ read a file line by line into the edit list }
+Procedure ReadFile(var f : text; prompt : boolean);
+Var
+ err : boolean;
+ s : string;
+ win : pnWindow;
+Begin
+ If Not OpenFile(f,prompt) Then Exit;
+ ClearLines(hdr);
+ lines := 0;
+ win := nShowMessage('Reading "'+fnam+'"...',47,' Open File ',46,false);
+ {$I-}
+ Repeat
+ If Not Eof(f) Then Begin
+ Readln(f,s);
+ err := (IoResult <> 0);
+ If Not Err Then InsertLine(hdr,s);
+ End;
+ Until Eof(f) or err;
+ Close(f);
+ {$I+}
+ win^.Hide;
+ win^.Done;
+ line1 := hdr^.next;
+ line := line1;
+ LoadLines(line1);
+ DisplayLines;
+ idx := 1;
+End;
+
+{ save the edit list to disk }
+Procedure SaveFile(var f : text);
+Var
+ tmp : text;
+ s,
+ tnam : string;
+ cur : pLine;
+ win : pnWindow;
+Begin
+ If PromptFile('Save File',s) = nkEsc Then
+ Exit
+ Else
+ fnam := s;
+ tnam := fnam+'~';
+ Assign(tmp,tnam);
+ Assign(f,fnam);
+ win := nShowMessage('Saving "'+fnam+'"...',47,' Save File ',46,false);
+ {$I-}
+ Reset(tmp);
+ If IoResult = 0 Then Begin
+ Close(tmp);
+ Erase(tmp);
+ Rename(f,tnam);
+ Assign(f,fnam);
+ End;
+ ReWrite(f);
+ cur := hdr^.next;
+ Repeat
+ If cur <> hdr Then Writeln(f,cur^.s^);
+ cur := cur^.next;
+ Until cur = hdr;
+ Close(f);
+ {$I+}
+ win^.Hide;
+ win^.Done;
+End;
+
+{ make the menu appear active }
+Procedure MenuUp;
+Begin
+ With mnu0 Do Begin
+ SetColor(48);
+ SetCursorColor(79);
+ Show;
+ End;
+ StatWin.FWrite(1,1,StatWin.GetColor,0,'Esc=Edit');
+End;
+
+{ make the menu appear inactive }
+Procedure MenuDown;
+Begin
+ With mnu0 Do Begin
+ SetColor(56);
+ SetCursorColor(56);
+ Show;
+ End;
+ StatWin.FWrite(1,1,StatWin.GetColor,0,'Esc=Menu');
+End;
+
+{ execute the File submenu }
+Procedure Menu_File;
+Begin
+ mnu0.SetIndex(1);
+ MenuUp;
+ New(mnu1,Init(1,1,0,3,1,48,79,8,FRAMED,62));
+ With mnu1^ Do Begin
+ Add('Open');
+ Add('Save');
+ Add('Exit - F10');
+ Post; { need the item count for move }
+ Move(1,nMaxRows-Count-2);
+ Start;
+ Case Index of
+ 1 : ReadFile(tf,true);
+ 2 : SaveFile(tf);
+ 3 : Finished := true;
+ End;
+ Hide;
+ End;
+ Dispose(mnu1,Done);
+ MenuDown;
+End;
+
+{ display the help screen }
+Procedure Help;
+Var
+ hwin : pnWindow;
+Begin
+ mnu0.SetIndex(4);
+ MenuUp;
+ New(hwin,Init(1,1,40,20,62,FRAMED,49));
+ With hwin^ Do Begin
+ Align(center,center);
+ PutHeader('Edit_Demo Help',15,center);
+ FWrite(2, 2,63,0,'Ctrl/Q - Move to column 1');
+ FWrite(2, 3,63,0,'Ctrl/W - Move to end of line');
+ FWrite(2, 4,63,0,'Ctrl/A - Move to previous word');
+ FWrite(2, 5,63,0,'Ctrl/F - Move to next word');
+ FWrite(2, 6,63,0,'Ctrl/G - Delete character');
+ FWrite(2, 7,63,0,'Ctrl/H - Destructive Backspace');
+ FWrite(2, 8,63,0,'Ctrl/D - Move forward one column');
+ FWrite(2, 9,63,0,'Ctrl/S - Move back one column');
+ FWrite(2,10,63,0,'Ctrl/I - Toggle Insert/Overwrite');
+ FWrite(2,11,63,0,'Ctrl/P - Embed control character');
+ FWrite(2,12,63,0,'Ctrl/L - Goto line number');
+ FWrite(2,13,63,0,'Ctrl/N - Insert new line');
+ FWrite(2,14,63,0,'Ctrl/Y - Delete current line');
+ FWrite(2,15,63,0,'Ctrl/X - Move down one line');
+ FWrite(2,16,63,0,'Ctrl/E - Move up one line');
+ FWrite(2,17,63,0,'Esc/1..0 - F1..F10');
+ Show;
+ Repeat Until Keypressed;
+ While KeyPressed Do ReadKey;
+ Hide;
+ End;
+ Dispose(hwin,Done);
+ MenuDown;
+End;
+
+{ goto the specified line in the edit buffer }
+Function GotoLine : boolean;
+Var
+ gwin : pnWindow;
+ l,
+ ii : longint;
+ esc : boolean;
+ aline : pline;
+Begin
+ New(gwin,Init(1,1,40,3,62,FRAMED,49));
+ With gwin^ Do Begin
+ Align(center,center);
+ PutHeader('Goto Line Number',15,center);
+ FWrite(2,1,63,0,'Line: ');
+ Show;
+ ec.ClearMode := true;
+ ii := EditNumber(8,1,63,8,0,'',cline,1,lines,esc);
+{ If esc or not (i in [1..lines]) Then i := ii;}
+ Hide;
+ End;
+ Dispose(gwin,Done);
+ If Not esc Then Begin
+ l := 0;
+ aline := hdr;
+ Repeat
+ inc(l);
+ aline := aline^.next;
+ Until (l = ii);
+ line1 := aline;
+ cline := l;
+ End;
+ GotoLine := (Not esc);
+End;
+
+{ initialize the global stuff }
+Procedure EditInit;
+Begin
+ With mnu0 Do Begin
+ Init(1,1,45,1,5,56,56,7,NOFRAME,0);
+ Add('File');
+ Add('InsLn');
+ Add('DelLn');
+ Add('Help');
+ Add('Exit');
+ Post;
+ Align(left,bottom);
+ End;
+ With StatWin Do Begin
+ Init(1,1,nStdScr.Cols-(mnu0.Wind^.Cols),1,48,NOFRAME,0);
+ Align(right,bottom);
+ Show;
+ End;
+ MenuDown;
+ With EdWin Do Begin
+ Init(1,1,nStdScr.Cols,nStdScr.Rows-1,30,FRAMED,31);
+ PutHeader(' oCrt Editor Demonstration ',15,center);
+ Show;
+ GotoXY(1,1);
+ {--------------------------------------------------------------------
+ The next line causes sedit to exit after every keystroke so we can
+ capture the insert mode and cursor positions for display update.
+ Alternatively, we could setup an ec.Special string to exit only on
+ certain keystrokes of interest.
+ --------------------------------------------------------------------}
+ ec.ExitMode := true;
+ { too re-assign a built-in key, put it in ec.special,
+ then use it in the case statement below
+
+ EdWin.ec.Special := EdWin.ec.Special + #5;
+ }
+ { now let's bind some keystrokes to the editor window }
+ ec.AddChMap(^a#0#0+chr(nKeyCtrlLeft));
+ ec.AddChMap(^s#0#0+chr(nKeyLeft));
+ ec.AddChMap(^f#0#0+chr(nKeyCtrlRight));
+ ec.AddChMap(^d#0#0+chr(nKeyRight));
+ ec.AddChMap(^e#0#0+chr(nKeyUp));
+ ec.AddChMap(^x#0#0+chr(nKeyDown));
+ ec.AddChMap(^q#0#0+chr(nKeyHome));
+ ec.AddChMap(^w#0#0+chr(nKeyEnd));
+ { define the number of edit window rows }
+ CURLINES := Min(MAXLINES,Rows);
+ End;
+ FillChar(ss,SizeOf(ss),#0);
+ nEscDelay(250);
+ idx := 1;
+ Finished := false;
+ mactive := false;
+ ClearLines(hdr);
+ If ParamCount > 0 Then Begin
+ fnam := ParamStr(1);
+ ReadFile(tf,false);
+ End Else
+ fnam := '';
+ { an empty list? }
+ If hdr^.next = hdr Then Begin
+ InsertLine(hdr,'');
+ line1 := hdr^.next;
+ line := line1;
+ dlines := 1;
+ End;
+ cline := 1;
+End;
+
+Begin
+ EditInit;
+ Repeat
+ With EdWin Do Begin
+ Case ec.InsMode of
+ true : StatWin.FWrite(11,1,StatWin.GetColor,0,'Ins');
+ false: StatWin.FWrite(11,1,StatWin.GetColor,0,'Ovr');
+ End;
+ Str(WhereX:0,xp);
+ Str(cline:0,yp);
+ StatWin.FWrite(16,1,StatWin.GetColor,StatWin.Cols,'Col:'+xp+' Row:'+yp);
+ If mactive Then Begin
+ With mnu0 Do Begin
+ MenuUp;
+ Start;
+ Case Index Of
+ 1 : cv := nkAltF;
+ 2 : cv := nkF1;
+ 3 : cv := nkF2;
+ 4 : cv := nkF3;
+ 5 : cv := nkF10;
+ Else cv := 0;
+ End;
+ MenuDown;
+ Show;
+ End;
+ mactive := false;
+ Active;
+ GotoXY(WhereX,WhereY);
+ End Else Begin
+ ss[idx] := Edit(1,idx,26,Cols,WhereX,ss[idx],cv);
+ FWrite(1,idx,GetColor,Cols,ss[idx]);
+ ReallocateLine(line,ss[idx]);
+ End;
+ Case cv of
+ 12 : If GotoLine Then Begin
+ idx := 1;
+ LoadLines(line1);
+ DisplayLines;
+ End;
+ {5,}
+ nkUp : Begin
+ dec(idx);
+ dec(cline);
+ If (idx < 1) and (line1^.prev <> hdr) Then Begin
+ line1 := line1^.prev;
+ LoadLines(line1);
+ DisplayLines;
+ End;
+ End;
+ nkDown : Begin
+ inc(idx);
+ inc(cline);
+ If idx > CURLINES Then Begin
+ line1 := line1^.next;
+ LoadLines(line1);
+ DisplayLines;
+ End;
+ End;
+ nkPgUp : Begin
+ For xi := 1 to CURLINES Do Begin
+ line1 := line1^.prev;
+ dec(cline);
+ If line1 = hdr Then
+ line1 := line1^.next;
+ End;
+ LoadLines(line1);
+ DisplayLines;
+ End;
+ nkPgDn : Begin
+ If dlines = CURLINES Then Begin
+ For xi := 1 to CURLINES Do Begin
+ inc(cline);
+ line1 := line1^.next;
+ If line1 = hdr Then
+ line1 := line1^.prev;
+ End;
+ LoadLines(line1);
+ DisplayLines;
+ End;
+ End;
+ nkEnter: Begin
+ GotoXY(1,WhereY);
+ If line^.next = hdr Then Begin
+ InsertLine(hdr,'');
+ If dlines < CURLINES Then inc(dlines);
+ End;
+ If idx < CURLINES Then
+ inc(idx)
+ Else Begin
+ line1 := line1^.next;
+ LoadLines(line1);
+ DisplayLines;
+ End;
+ inc(cline);
+ End;
+ 14, { ctrl/n }
+ nkF1 : Begin
+ { first displayed line? }
+ If line1 = line Then Begin
+ line1 := line1^.prev;
+ InsertLine(line,'');
+ line1 := line1^.next;
+ End Else
+ InsertLine(line,'');
+ LoadLines(line1);
+ DisplayLines;
+ End;
+ 25, { ctrl/y }
+ nkF2 : Begin
+ { first displayed line? }
+ If line1 = line Then line1 := line^.next;
+ DeleteLine(line);
+ LoadLines(line1);
+ DisplayLines;
+ End;
+ nkAltH,
+ nkF3 : Help;
+ nkEsc : mactive := true;
+ nkF10 : Finished := true;
+ nkAltF : menu_file;
+ End;
+ Active;
+ If idx > CURLINES Then idx := CURLINES; { keep in window, }
+ If idx > dlines Then idx := dlines; { but not below last }
+ If idx < 1 Then idx := 1;
+ If cline < 1 Then cline := 1;
+ If cline > lines Then cline := lines;
+ GotoXY(WhereX,idx);
+ line := line1;
+ For xi := 1 to idx-1 Do Begin
+ line := line^.next;
+ End;
+ End;
+ Until Finished;
+ ClearLines(hdr);
+ EdWin.Done;
+ StatWin.Done;
+ ClrScr;
+End.
diff --git a/packages/ncurses/examples/firework.pp b/packages/ncurses/examples/firework.pp
new file mode 100644
index 0000000000..f03e8881d5
--- /dev/null
+++ b/packages/ncurses/examples/firework.pp
@@ -0,0 +1,136 @@
+{
+}
+program firework;
+uses
+ ncurses;
+
+CONST
+ my_bg : LONGINT = COLOR_BLACK;
+
+Procedure showit;
+begin
+ refresh;
+ napms(120);
+end;
+
+Function get_colour(Var bold : chtype) : longint;
+Var
+ attr : longint;
+begin
+ attr:=random(16) + 1;
+ bold:=A_NORMAL;
+ if (attr > 8) then
+ begin
+ bold:=A_BOLD;
+ attr:=attr and 7;
+ end;
+ get_colour:=attr;
+end;
+
+
+Procedure explode(Row,Col : longint);
+var
+ Bold : chtype;
+begin
+ ncurses.erase;
+ mvaddstr(row,col,'-');
+ showit;
+
+ init_pair(1,get_colour(bold),my_bg);
+ attrset(COLOR_PAIR(1) or bold);
+ mvaddstr(row-1,col-1,' - ');
+ mvaddstr(row,col-1,'-+-');
+ mvaddstr(row+1,col-1,' - ');
+ showit;
+
+ init_pair(1,get_colour(bold),my_bg);
+ attrset(COLOR_PAIR(1) or bold);
+ mvaddstr(row-2,col-2,' --- ');
+ mvaddstr(row-1,col-2,'-+++-');
+ mvaddstr(row, col-2,'-+#+-');
+ mvaddstr(row+1,col-2,'-+++-');
+ mvaddstr(row+2,col-2,' --- ');
+ showit;
+
+
+ init_pair(1,get_colour(bold),my_bg);
+ attrset(COLOR_PAIR(1) or bold);
+ mvaddstr(row-2,col-2,' +++ ');
+ mvaddstr(row-1,col-2,'++#++');
+ mvaddstr(row, col-2,'+# #+');
+ mvaddstr(row+1,col-2,'++#++');
+ mvaddstr(row+2,col-2,' +++ ');
+ showit;
+
+ init_pair(1,get_colour(bold),my_bg);
+ attrset(COLOR_PAIR(1) or bold);
+ mvaddstr(row-2,col-2,' # ');
+ mvaddstr(row-1,col-2,'## ##');
+ mvaddstr(row, col-2,'# #');
+ mvaddstr(row+1,col-2,'## ##');
+ mvaddstr(row+2,col-2,' # ');
+ showit;
+
+ init_pair(1,get_colour(bold),my_bg);
+ attrset(COLOR_PAIR(1) or bold);
+ mvaddstr(row-2,col-2,' # # ');
+ mvaddstr(row-1,col-2,'# #');
+ mvaddstr(row, col-2,' ');
+ mvaddstr(row+1,col-2,'# #');
+ mvaddstr(row+2,col-2,' # # ');
+ showit;
+end;
+
+Var
+ startp,endp,row,diff,flag : longint;
+ direction : boolean;
+begin
+ flag:=0;
+ initscr;
+ if (has_colors<>0) then
+ start_color;
+ curs_set(0);
+ randomize;
+ cbreak;
+ While true do
+ begin
+ repeat
+ startp:=random (COLS -3);
+ endp:=random (COLS - 3);
+ If startp < 2 then
+ startp:=2;
+ If endp <2 then
+ endp:=2;
+ direction:=startp > endp ;
+ diff:=abs(startp-endp);
+ until (diff>2) and (diff<(LINES-2));
+ attrset(A_NORMAL);
+ for row:=0 to diff do
+ begin;
+ If direction then
+ mvaddstr(LINES - row,startp + row ,'/')
+ else
+ mvaddstr(LINES - row,startp - row ,'\');
+ inc(flag);
+ if flag<>0 then
+ begin
+ showit;
+ erase;
+ flag:=0;
+ end;
+ end;
+ inc(flag);
+ if (flag<>0) then
+ begin
+ showit;
+ flag:=0;
+ end;
+ randomize;
+ If Direction then
+ explode(LINES-row,startp+diff)
+ Else
+ explode(LINES-row,startp-diff);
+ erase;
+ showit;
+ end;
+end.
diff --git a/packages/ncurses/examples/menu_demo.pp b/packages/ncurses/examples/menu_demo.pp
new file mode 100644
index 0000000000..183793fc45
--- /dev/null
+++ b/packages/ncurses/examples/menu_demo.pp
@@ -0,0 +1,105 @@
+uses
+ ncurses,menu;
+
+const
+ choices : array[0..5] of pchar = (
+ 'Choice 1',
+ 'Choice 2',
+ 'Choice 3',
+ 'Choice 4',
+ 'Exit',
+ nil
+ );
+procedure print_in_middle(win : PWINDOW;starty,startx,width : longint;_string : pchar;color : chtype);
+ var
+ length,x,y : longint;
+ temp : single;
+ 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;
+
+ length := strlen(_string);
+ temp := (width - length)/ 2;
+ x := startx + round(temp);
+ wattron(win, color);
+ mvwprintw(win, y, x, '%s', [_string]);
+ wattroff(win, color);
+ refresh;
+ end;
+
+var
+ my_items : ppitem;
+ c : longint;
+ my_menu : pmenu;
+ my_menu_win : pwindow;
+ i,n_choices : longint;
+
+begin
+ { Initialize curses }
+ initscr;
+ start_color;
+ cbreak;
+ noecho;
+ keypad(stdscr, 1);
+ init_pair(1, COLOR_RED, COLOR_BLACK);
+
+ { Create items }
+ n_choices := high(choices);
+ getmem(my_items,n_choices*sizeof(pitem));
+ for i:=0 to n_choices-1 do
+ my_items[i] := new_item(choices[i], choices[i]);
+
+ { Create menu }
+ my_menu := new_menu(ppitem(my_items));
+
+ { Create the window to be associated with the menu }
+ my_menu_win := newwin(10, 40, 4, 4);
+ keypad(my_menu_win, 1);
+
+ { Set main window and sub window }
+ set_menu_win(my_menu, my_menu_win);
+ set_menu_sub(my_menu, derwin(my_menu_win, 6, 38, 3, 1));
+
+ { Set menu mark to the string ' * ' }
+ set_menu_mark(my_menu, ' * ');
+
+ { Print a border around the main window and print a title }
+ box(my_menu_win, 0, 0);
+ print_in_middle(my_menu_win, 1, 0, 40, 'My Menu', COLOR_PAIR(1));
+ mvwaddch(my_menu_win, 2, 0, ACS_LTEE);
+ mvwhline(my_menu_win, 2, 1, ACS_HLINE, 38);
+ mvwaddch(my_menu_win, 2, 39, ACS_RTEE);
+ mvprintw(LINES - 2, 0, 'F1 to exit',[]);
+ refresh();
+
+ { Post the menu }
+ post_menu(my_menu);
+ wrefresh(my_menu_win);
+
+ c:=wgetch(my_menu_win);
+ 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);
+ end;
+ wrefresh(my_menu_win);
+ c:=wgetch(my_menu_win);
+ end;
+
+ { Unpost and free all the memory taken up }
+ unpost_menu(my_menu);
+ free_menu(my_menu);
+ for i:=0 to n_choices-1 do
+ free_item(my_items[i]);
+ endwin();
+end.
diff --git a/packages/ncurses/examples/ocrt_demo.pp b/packages/ncurses/examples/ocrt_demo.pp
new file mode 100644
index 0000000000..36ad7a82d8
--- /dev/null
+++ b/packages/ncurses/examples/ocrt_demo.pp
@@ -0,0 +1,227 @@
+Program ocrt_demo;
+{---------------------------------------------------------------------------
+ CncWare
+ (c) Copyright 1999-2000
+ ---------------------------------------------------------------------------
+ Filename..: ocrt_demo.pp
+ Programmer: Ken J. Wright
+ Date......: 11/22/99
+
+ Purpose - Demonstrate the use of nCrt.
+
+-------------------------------<< REVISIONS >>--------------------------------
+ Ver | Date | Prog| Description
+-------+----------+-----+----------------------------------------------------
+ 1.00 | 11/22/99 | kjw | Initial Release.
+ 1.01 | 12/10/99 | kjw | Added OOP stuff.
+ 1.02 | 12/13/99 | kjw | 1) Changed from nCrt to oCrt.
+ | 2) Renamed from ncrt_demo to ocrt_demo.
+ | 3) Added some standard crt code at beginning.
+ 1.03 | 01/06/00 | kjw | Some minor changes for ncrt mods.
+ 1.04 | 06/27/00 | kjw | Changes for ncrt mods.
+------------------------------------------------------------------------------
+}
+uses oCrt;
+var
+ win,win1,
+ stdscr : pwin;
+ s : string;
+ c : char;
+ i,j,k,x,y : integer;
+
+var
+ win11,win22 : pnWindow;
+ win33,msgbox : TnWindow;
+
+Begin
+ { some nCrt standard in/out stuff, like crt }
+ TextColor(15);
+ TextBackground(1);
+ TextAttr := TextAttr + blink;
+ ClrScr;
+ GotoXY(2,35);
+ Writeln(1.0:0:4,' This should be blinking text');
+ Window(10,10,70,15);
+ TextAttr := TextAttr - blink;
+ TextBackground(2);
+ ClrScr;
+ s := ' : ';
+ for i := 1 to 6 do
+ writeln(i:0,s,'No blinking here');
+ writeln('Press Enter');
+ readln(s);
+ TextBackground(3);
+ Write('input a number [i]: ');
+ Readln(i);
+ Write('input two numbers [j k]: ');
+ Readln(j,k);
+ Window(20,11,60,16);
+ TextBackground(0);
+ TextColor(15);
+ ClrScr;
+ writeln('i: ',i);
+ writeln('j: ',j);
+ writeln('k: ',k);
+ Write('Press a key: ');
+ readkey;
+ TextMode(LastMode);
+ write('Press a key: ');
+ repeat until keypressed;
+ while keypressed do readkey;
+
+ { now some oCrt basics }
+ stdscr := nscreen;
+ nClrScr(stdscr,7);
+ nDrawBox(stdscr,btSingle,1,1,80,3,31);
+ nFWrite(27,2,30,0,'nCrt Demonstration Program');
+ nNewWindow(win1,9,9,71,16);
+ nClrScr(win1,95);
+ nWriteScr(win1,3,2,95,'This is a background window.');
+ nWriteScr(win1,10,3,95,'It was built first, then displayed later.');
+ nFWrite(stdscr,1,24,15,80,'Enter some text, press [Enter]');
+ nWindow(win,10,10,70,15);
+ nClrScr(win,31);
+ nGotoXY(win,1,1);
+ s := nReadln(win);
+ If s <> 'oop' Then Begin { skip right to OOP section? }
+ nFWrite(stdscr,1,24,15,80,'Enter some more text, press [Enter]');
+ nGotoXY(win,nWhereX(win),nWhereY(win));
+ s := nReadln(win);
+ nFWrite(stdscr,1,24,79,80,'Please wait...');
+ nGotoXY(win,1,1);
+ Delay(500);
+ nDelLine(win);
+ Delay(500);
+ nInsLine(win);
+ Delay(500);
+ nFrame(win1);
+ nRefresh(win1);
+ Delay(4000);
+ nRefresh(win);
+ Delay(2000);
+ { force nCrt to use full screen }
+ nSetActiveWin(stdscr);
+ ClrScr;
+ nFWrite(1,24,14,80,'Enter even more text, press [Enter]');
+ s := nReadln(stdscr);
+ nClrScr(win,47);
+ nFWrite(1,24,11,80,'Press some keys, followed by [Esc]');
+ nGotoXY(win,5,1);
+ x := nWhereX(win);
+ y := nWhereY(win);
+ i := 0;
+ { turn off oCrt keyboard echo }
+ nEcho(false);
+ repeat
+ c := nReadkey(win);
+ DelLine;
+ inc(i);
+ until (c = #27) or (i >= 8);
+ While i > 0 Do Begin
+ InsLine;
+ dec(i);
+ End;
+ { turn on oCrt keyboard echo }
+ nEcho(true);
+ str(x:0,s);
+ nWrite(win,'x = '+s+', ');
+ str(y:0,s);
+ nWrite(win,'y = '+s);
+ nWriteln(stdscr,'press a key...');
+ readkey;
+ nDrawBox(stdscr,btSingle,11,11,69,14,63);
+ nFWrite(30,11,79,49,' nCrt Demo Program');
+ nDelWindow(win);
+ nDelWindow(win1);
+ nWindow(win,2,2,79,24);
+ nFrame(stdscr);
+ nFrame(win);
+ nDelWindow(win);
+ End;
+ { and now for some object oCrt }
+ win := nscreen;
+ New(win11,Init(1,1,nStdScr.Cols,nStdScr.Rows,31,true,30));
+ win11^.PutHeader(' Now for some OOP with nCrt! ',79,center);
+ win11^.DrawBox(1,1,1,78,3,62);
+ New(win22,Init(20,7,60,17,47,false,0));
+ win33.Init(30,15,50,20,79,true,78);
+ win33.PutHeader(' Little Window ',15,right);
+ Writeln('And here is window #3');
+ win11^.Show;
+ GotoXY(2,2);
+ Write('Please press a key...');
+ ReadKey;
+ msgbox.init(25,11,55,13,47,true,47);
+ s := 'Please enter a string';
+ msgbox.FWrite((msgbox.cols-length(s)) div 2,1,46,0,s);
+ msgbox.Show;
+ win11^.Active;
+ GotoXY(1,10);
+ msgbox.Show;
+ win11^.Active;
+ Readln(s);
+ msgbox.Hide;
+ win22^.Show;
+ Writeln(s);
+ Delay(2000);
+ win11^.Hide;
+ win22^.Active;
+ Writeln('Hiding window 1...');
+ Delay(2000);
+ win33.Show;
+ Delay(2000);
+ win11^.Show;
+ Writeln('Showing window 1');
+ win22^.Show;
+ Writeln('Showing window 2');
+ win33.Show;
+ Write('Showing window 3');
+ nKeypressed(2000);
+ While Keypressed Do Readkey;
+ win11^.Hide;
+ win33.Active;
+ Write('Hiding window 1');
+ win22^.PutFrame(62);
+ win22^.PutHeader(' New frame color ',63,center);
+ win22^.Show;
+ win33.Show;
+ nKeypressed(3000);
+ While Keypressed Do Readkey;
+ win22^.Hide;
+ win33.Active;
+ Write('Hiding window 2');
+ nKeypressed(2000);
+ While Keypressed Do Readkey;
+ win33.SetColor(47);
+ nKeypressed(2000);
+ While Keypressed Do Readkey;
+ x := 30;
+ y := 15;
+ win33.ClrScr;
+ for i := 1 to 11 do Begin
+ TextAttr := win33.GetColor;
+ dec(x);
+ dec(y);
+ str(i:0,s);
+ win33.Move(x,y);
+ Writeln('Moved by '+s);
+ nFWrite(stdscr,1,nStdScr.Rows,63,80,'Moved by '+s);
+ Delay(250);
+ End;
+ win33.Align(center,none);
+ win33.PutHeader('Left Header',14,left);
+ win33.Show;
+ Delay(1000);
+ win33.PutHeader('Right Header',14,right);
+ win33.Show;
+ Delay(1000);
+ win33.PutHeader('Center Header',15,center);
+ win33.Show;
+ Delay(2000);
+ Dispose(win11,Done);
+ Dispose(win22,Done);
+ win33.Done;
+ msgbox.Done;
+ NormVideo;
+ ClrScr;
+End.
diff --git a/packages/ncurses/examples/screen_demo.pp b/packages/ncurses/examples/screen_demo.pp
new file mode 100644
index 0000000000..0a6ab2b5f1
--- /dev/null
+++ b/packages/ncurses/examples/screen_demo.pp
@@ -0,0 +1,53 @@
+program screen_demo;
+{---------------------------------------------------------------------------
+ CncWare
+ (c) Copyright 2000
+ ---------------------------------------------------------------------------
+ Filename..: screen_demo.pp
+ Programmer: Ken J. Wright
+ Date......: 08/24/2000
+
+ Purpose - Demonstrate Linux screen saving/restoring with oCrt.
+
+-------------------------------<< REVISIONS >>--------------------------------
+ Ver | Date | Prog| Description
+-------+----------+-----+----------------------------------------------------
+ 1.00 | 08/24/00 | kjw | Initial Release.
+------------------------------------------------------------------------------
+}
+uses ocrt;
+var
+ i,j : integer;
+ pb : pnScreenBuf;
+begin
+ For i := 1 to 24 Do Begin
+ TextColor(i);
+ For j := 1 to 79 Do Write(chr(j+32));
+ writeln;
+ End;
+ nGrabScreen(pb);
+ Write('screen stored, press a key to clear');readkey;
+ NormVideo;
+ ClrScr;
+ Write('press a key to restore previous screen');readkey;
+ nPopScreen(pb);
+ GotoXY(1,nMaxRows);
+ Write('press a key to restore to a smaller window');readkey;
+ ClrScr;
+ Window(10,5,70,20);
+ nPopScreen(pb);
+ Window(1,1,nMaxCols,nMaxRows);
+ GotoXY(1,nMaxRows);
+ Write('press a key to offset stored screen');readkey;
+ ClrScr;
+ nPopScreen(pb,5,3);
+ GotoXY(1,nMaxRows);
+ Write('press a key to restore a portion of this screen in multiple ');readkey;
+ nGrabScreen(pb,5,3,8,10);
+ ClrScr;
+ For i := 0 to 7 Do For j := 0 to 1 Do
+ nPopScreen(pb,i*10+1,j*12+1);
+ GotoXY(1,nMaxRows);
+ { make sure to clean up! }
+ nReleaseScreen(pb);
+end.
diff --git a/packages/ncurses/fpmake.pp b/packages/ncurses/fpmake.pp
new file mode 100644
index 0000000000..f8e803e653
--- /dev/null
+++ b/packages/ncurses/fpmake.pp
@@ -0,0 +1,54 @@
+{$ifndef ALLPACKAGES}
+{$mode objfpc}{$H+}
+program fpmake;
+
+uses fpmkunit;
+
+Var
+ P : TPackage;
+ T : TTarget;
+begin
+ With Installer do
+ begin
+{$endif ALLPACKAGES}
+
+ P:=AddPackage('ncurses');
+{$ifdef ALLPACKAGES}
+ P.Directory:='ncurses';
+{$endif ALLPACKAGES}
+ P.Version:='2.0.0';
+ P.SourcePath.Add('src');
+
+ T:=P.Targets.AddUnit('menu.pp');
+ with T.Dependencies do
+ begin
+ AddInclude('eti.inc');
+ AddUnit('ncurses');
+ end;
+ T:=P.Targets.AddUnit('ncrt.pp');
+ with T.Dependencies do
+ begin
+ AddInclude('ncrt.inc');
+ AddUnit('ncurses');
+ end;
+ T:=P.Targets.AddUnit('ncurses.pp');
+ T:=P.Targets.AddUnit('ocrt.pp');
+ with T.Dependencies do
+ begin
+ AddInclude('ncrt.inc');
+ AddInclude('pxpic.inc');
+ AddUnit('ncurses');
+ AddUnit('panel');
+ AddUnit('menu');
+ end;
+ T:=P.Targets.AddUnit('panel.pp');
+ with T.Dependencies do
+ begin
+ AddUnit('ncurses');
+ end;
+
+{$ifndef ALLPACKAGES}
+ Run;
+ end;
+end.
+{$endif ALLPACKAGES}
diff --git a/packages/ncurses/src/eti.inc b/packages/ncurses/src/eti.inc
new file mode 100644
index 0000000000..b8eff9d779
--- /dev/null
+++ b/packages/ncurses/src/eti.inc
@@ -0,0 +1,46 @@
+ {
+ Copyright (c) 1998 Free Software Foundation, Inc.
+
+ Permission is hereby granted, free of charge, to any person obtaining a
+ copy of this software and associated documentation files (the
+ "Software"), to deal in the Software without restriction, including
+ without limitation the rights to use, copy, modify, merge, publish,
+ distribute, distribute with modifications, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the Software is
+ furnished to do so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included
+ in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+ OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+ DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+ OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+ THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+ Except as contained in this notice, the name(s) of the above copyright
+ holders shall not be used in advertising or otherwise to promote the
+ sale, use or other dealings in this Software without prior written
+ authorization.
+ }
+ {
+ Author: Juergen Pfeifer <Juergen.Pfeifer@T-Online.de> 1995,1997
+ }
+ const
+ E_OK = 0;
+ E_SYSTEM_ERROR = -(1);
+ E_BAD_ARGUMENT = -(2);
+ E_POSTED = -(3);
+ E_CONNECTED = -(4);
+ E_BAD_STATE = -(5);
+ E_NO_ROOM = -(6);
+ E_NOT_POSTED = -(7);
+ E_UNKNOWN_COMMAND = -(8);
+ E_NO_MATCH = -(9);
+ E_NOT_SELECTABLE = -(10);
+ E_NOT_CONNECTED = -(11);
+ E_REQUEST_DENIED = -(12);
+ E_INVALID_FIELD = -(13);
+ E_CURRENT = -(14);
diff --git a/packages/ncurses/src/menu.pp b/packages/ncurses/src/menu.pp
new file mode 100644
index 0000000000..01ee086750
--- /dev/null
+++ b/packages/ncurses/src/menu.pp
@@ -0,0 +1,284 @@
+unit menu;
+{---------------------------------------------------------------------------
+ CncWare
+----------------------------------------------------------------------------
+ Filename..: menu.pp
+ Programmer: Ken J. Wright
+ Date......: 07/12/2000
+
+ Purpose - Link to the Linux 'menu' library for ncurses menuing
+ functions.
+
+-------------------------------< Revisions >---------------------------------
+ Revision| Date | Prog| Description
+-----------------------------------------------------------------------------
+ 1.00 | 07/12/00 | kjw | Initial release.
+-----------------------------------------------------------------------------
+}
+{ Automatically converted by H2PAS.EXE from menu.h
+ Utility made by Florian Klaempfl 25th-28th september 96
+ Improvements made by Mark A. Malakanov 22nd-25th may 97
+ Further improvements by Michael Van Canneyt, April 1998
+ define handling and error recovery by Pierre Muller, June 1998 }
+
+
+ interface
+
+ { C default packing is dword }
+
+{$PACKRECORDS 4}
+ {
+ Copyright (c) 1998 Free Software Foundation, Inc.
+
+ Permission is hereby granted, free of charge, to any person obtaining a
+ copy of this software and associated documentation files (the
+ "Software"), to deal in the Software without restriction, including
+ without limitation the rights to use, copy, modify, merge, publish,
+ distribute, distribute with modifications, sublicense, and/or sell
+ copies of the Software, and to permit persons to whom the Software is
+ furnished to do so, subject to the following conditions:
+
+ The above copyright notice and this permission notice shall be included
+ in all copies or substantial portions of the Software.
+
+ THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS
+ OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+ MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+ IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+ DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+ OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR
+ THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+
+ Except as contained in this notice, the name(s) of the above copyright
+ holders shall not be used in advertising or otherwise to promote the
+ sale, use or other dealings in this Software without prior written
+ authorization.
+ }
+ {
+ Author: Juergen Pfeifer <Juergen.Pfeifer@T-Online.de> 1995,1997
+ }
+
+{$linklib menu}
+
+uses ncurses;
+
+{$include eti.inc}
+
+ const
+ libmenu = 'menu';
+
+ type
+ Menu_Options = longint;
+ Item_Options = longint;
+
+
+ const
+ { Menu options: }
+ O_ONEVALUE = $01;
+ O_SHOWDESC = $02;
+ O_ROWMAJOR = $04;
+ O_IGNORECASE = $08;
+ O_SHOWMATCH = $10;
+ O_NONCYCLIC = $20;
+ { Item options: }
+ O_SELECTABLE = $01;
+
+ type
+
+ tTEXT = record
+ str : pchar;
+ length : word;
+ end;
+
+ tITEM = record
+ name : tTEXT; { name of menu item }
+ description : tTEXT; { description of item, optional in display }
+ imenu : ^tagMENU; { Pointer to parent menu }
+ userptr : pointer; { Pointer to user defined per item data }
+ opt : Item_Options; { Item options }
+ index : integer; { Item number if connected to a menu }
+ y : integer; { y and x location of item in menu }
+ x : integer;
+ value : bool; { Selection value }
+ left : ^tagITEM; { neighbour items }
+ right : ^tagITEM;
+ up : ^tagITEM;
+ down : ^tagITEM;
+ end;
+
+ pITEM = ^tITEM;
+ ppITEM = ^pITEM;
+
+ tagITEM = tITEM;
+
+ Menu_Hook = procedure;cdecl;
+
+ tMENU = record
+ height : integer; { Nr. of chars high }
+ width : integer; { Nr. of chars wide }
+ rows : integer; { Nr. of items high }
+ cols : integer; { Nr. of items wide }
+ frows : integer; { Nr. of formatted items high }
+ fcols : integer; { Nr. of formatted items wide }
+ arows : integer; { Nr. of items high (actual) }
+ namelen : integer; { Max. name length }
+ desclen : integer; { Max. description length }
+ marklen : integer; { Length of mark, if any }
+ itemlen : integer; { Length of one item }
+ spc_desc : integer; { Spacing for descriptor }
+ spc_cols : integer; { Spacing for columns }
+ spc_rows : integer; { Spacing for rows }
+ pattern : ^char; { Buffer to store match chars }
+ pindex : integer; { Index into pattern buffer }
+ win : ^WINDOW; { Window containing menu }
+ sub : ^WINDOW; { Subwindow for menu display }
+ userwin : ^WINDOW; { User's window }
+ usersub : ^WINDOW; { User's subwindow }
+ items : ^pITEM; { array of items }
+ nitems : integer; { Nr. of items in menu }
+ curitem : pITEM; { Current item }
+ toprow : integer; { Top row of menu }
+ fore : chtype; { Selection attribute }
+ back : chtype; { Nonselection attribute }
+ grey : chtype; { Inactive attribute }
+ pad : byte; { Pad character }
+ menuinit : Menu_Hook; { User hooks }
+ menuterm : Menu_Hook;
+ iteminit : Menu_Hook;
+ itemterm : Menu_Hook;
+ userptr : pointer; { Pointer to menus user data }
+ mark : pchar; { Pointer to marker string }
+ opt : Menu_Options; { Menu options }
+ status : word; { Internal state of menu }
+ end;
+
+ pMENU = ^tMENU;
+ ppMENU = ^pMENU;
+
+ tagMENU = tMENU;
+
+ const
+ { Define keys }
+ REQ_LEFT_ITEM = KEY_MAX + 1;
+ REQ_RIGHT_ITEM = KEY_MAX + 2;
+ REQ_UP_ITEM = KEY_MAX + 3;
+ REQ_DOWN_ITEM = KEY_MAX + 4;
+ REQ_SCR_ULINE = KEY_MAX + 5;
+ REQ_SCR_DLINE = KEY_MAX + 6;
+ REQ_SCR_DPAGE = KEY_MAX + 7;
+ REQ_SCR_UPAGE = KEY_MAX + 8;
+ REQ_FIRST_ITEM = KEY_MAX + 9;
+ REQ_LAST_ITEM = KEY_MAX + 10;
+ REQ_NEXT_ITEM = KEY_MAX + 11;
+ REQ_PREV_ITEM = KEY_MAX + 12;
+ REQ_TOGGLE_ITEM = KEY_MAX + 13;
+ REQ_CLEAR_PATTERN = KEY_MAX + 14;
+ REQ_BACK_PATTERN = KEY_MAX + 15;
+ REQ_NEXT_MATCH = KEY_MAX + 16;
+ REQ_PREV_MATCH = KEY_MAX + 17;
+ MIN_MENU_COMMAND = KEY_MAX + 1;
+ MAX_MENU_COMMAND = KEY_MAX + 17;
+ {
+ Some AT&T code expects MAX_COMMAND to be out-of-band not
+ just for menu commands but for forms ones as well.
+ /
+ #if defined(MAX_COMMAND)
+ # if (MAX_MENU_COMMAND > MAX_COMMAND)
+ # error Something is wrong -- MAX_MENU_COMMAND is greater than MAX_COMMAND
+ # elif (MAX_COMMAND != (KEY_MAX + 128))
+ # error Something is wrong -- MAX_COMMAND is already inconsistently defined.
+ # endif
+ #else
+ # define MAX_COMMAND (KEY_MAX + 128)
+ #endif
+ }
+ { --------- prototypes for libmenu functions ----------------------------- }
+
+ function menu_items(_para1:pMENU):ppITEM;cdecl;external libmenu;
+ function current_item(_para1:pMENU):pITEM;cdecl;external libmenu;
+ function new_item(_para1:pchar; _para2:pchar):pITEM;cdecl;external libmenu;
+ function new_menu(_para1:ppITEM):pMENU;cdecl;external libmenu;
+ function item_opts(_para1:pITEM):Item_Options;cdecl;external libmenu;
+ function menu_opts(_para1:pMENU):Menu_Options;cdecl;external libmenu;
+(*
+ function item_init(_para1:pMENU):Menu_Hook;
+ begin
+ { You must implemented this function }
+ end;
+ function item_term(_para1:pMENU):Menu_Hook;
+ begin
+ { You must implemented this function }
+ end;
+ function menu_init(_para1:pMENU):Menu_Hook;
+ begin
+ { You must implemented this function }
+ end;
+ function menu_term(_para1:pMENU):Menu_Hook;
+ begin
+ { You must implemented this function }
+ end;
+*)
+ function menu_sub(_para1:pMENU):pWINDOW;cdecl;external libmenu;
+ function menu_win(_para1:pMENU):pWINDOW;cdecl;external libmenu;
+ function item_description(_para1:pITEM):pchar;cdecl;external libmenu;
+ function item_name(_para1:pITEM):pchar;cdecl;external libmenu;
+ function menu_mark(_para1:pMENU):pchar;cdecl;external libmenu;
+ function menu_request_name(_para1:longint):pchar;cdecl;external libmenu;
+ function menu_pattern(_para1:pMENU):pchar;cdecl;external libmenu;
+ function menu_userptr(_para1:pMENU):pointer;cdecl;external libmenu;
+ function item_userptr(_para1:pITEM):pointer;cdecl;external libmenu;
+ function menu_back(_para1:pMENU):chtype;cdecl;external libmenu;
+ function menu_fore(_para1:pMENU):chtype;cdecl;external libmenu;
+ function menu_grey(_para1:pMENU):chtype;cdecl;external libmenu;
+ function free_item(_para1:pITEM):longint;cdecl;external libmenu;
+ function free_menu(_para1:pMENU):longint;cdecl;external libmenu;
+ function item_count(_para1:pMENU):longint;cdecl;external libmenu;
+ function item_index(_para1:pITEM):longint;cdecl;external libmenu;
+ function item_opts_off(_para1:pITEM; _para2:Item_Options):longint;cdecl;external libmenu;
+ function item_opts_on(_para1:pITEM; _para2:Item_Options):longint;cdecl;external libmenu;
+ function menu_driver(_para1:pMENU; _para2:longint):longint;cdecl;external libmenu;
+ function menu_opts_off(_para1:pMENU; _para2:Menu_Options):longint;cdecl;external libmenu;
+ function menu_opts_on(_para1:pMENU; _para2:Menu_Options):longint;cdecl;external libmenu;
+ function menu_pad(_para1:pMENU):longint;cdecl;external libmenu;
+ function pos_menu_cursor(_para1:pMENU):longint;cdecl;external libmenu;
+ function post_menu(_para1:pMENU):longint;cdecl;external libmenu;
+ function scale_menu(_para1:pMENU; _para2:plongint; _para3:plongint):longint;cdecl;external libmenu;
+ function set_current_item(menu:pMENU; item:pITEM):longint;cdecl;external libmenu;
+{ function set_item_init(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;external libmenu;}
+ function set_item_opts(_para1:pITEM; _para2:Item_Options):longint;cdecl;external libmenu;
+{ function set_item_term(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;external libmenu;}
+ function set_item_userptr(_para1:pITEM; _para2:pointer):longint;cdecl;external libmenu;
+ function set_item_value(_para1:pITEM; _para2:bool):longint;cdecl;external libmenu;
+ function set_menu_back(_para1:pMENU; _para2:chtype):longint;cdecl;external libmenu;
+ function set_menu_fore(_para1:pMENU; _para2:chtype):longint;cdecl;external libmenu;
+ function set_menu_format(_para1:pMENU; _para2:longint; _para3:longint):longint;cdecl;external libmenu;
+ function set_menu_grey(_para1:pMENU; _para2:chtype):longint;cdecl;external libmenu;
+{ function set_menu_init(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;external libmenu;}
+ function set_menu_items(_para1:pMENU; _para2:ppITEM):longint;cdecl;external libmenu;
+ function set_menu_mark(_para1:pMENU; _para2:pchar):longint;cdecl;external libmenu;
+ function set_menu_opts(_para1:pMENU; _para2:Menu_Options):longint;cdecl;external libmenu;
+ function set_menu_pad(_para1:pMENU; _para2:longint):longint;cdecl;external libmenu;
+ function set_menu_pattern(_para1:pMENU; _para2:pchar):longint;cdecl;external libmenu;
+ function set_menu_sub(_para1:pMENU; _para2:pWINDOW):longint;cdecl;external libmenu;
+{ function set_menu_term(_para1:pMENU; _para2:Menu_Hook):longint;cdecl;external libmenu;}
+ function set_menu_userptr(_para1:pMENU; _para2:pointer):longint;cdecl;external libmenu;
+ function set_menu_win(_para1:pMENU; _para2:pWINDOW):longint;cdecl;external libmenu;
+ function set_top_row(_para1:pMENU; _para2:longint):longint;cdecl;external libmenu;
+ function top_row(_para1:pMENU):longint;cdecl;external libmenu;
+ function unpost_menu(_para1:pMENU):longint;cdecl;external libmenu;
+ function menu_request_by_name(_para1:pchar):longint;cdecl;external libmenu;
+ function set_menu_spacing(_para1:pMENU; _para2:longint; _para3:longint; _para4:longint):longint;cdecl;external libmenu;
+ function menu_spacing(_para1:pMENU; _para2:plongint; _para3:plongint; _para4:plongint):longint;cdecl;external libmenu;
+ function item_value(_para1:pITEM):bool;cdecl;external libmenu;
+ function item_visible(_para1:pITEM):bool;cdecl;external libmenu;
+(*
+ procedure menu_format(_para1:pMENU; _para2:plongint; _para3:plongint);
+ begin
+ { You must implemented this function }
+ end;
+*)
+
+ implementation
+
+begin
+end.
diff --git a/packages/ncurses/src/ncrt.inc b/packages/ncurses/src/ncrt.inc
new file mode 100644
index 0000000000..1158e7569b
--- /dev/null
+++ b/packages/ncurses/src/ncrt.inc
@@ -0,0 +1,937 @@
+{---------------------------------------------------------------------------
+ CncWare
+ (c) Copyright 1999-2000
+ Portions copyright the FreePascal Team
+ ---------------------------------------------------------------------------
+ Filename..: ncrt.inc
+ Programmer: Ken J. Wright, ken@cncware.com
+ Date......: 03/01/99
+
+ Purpose - Code that is common to nCrt and oCrt.
+
+-------------------------------<< REVISIONS >>--------------------------------
+ Ver | Date | Prog| Description
+-------+----------+-----+-----------------------------------------------------
+ 2.00 | 12/13/99 | kjw | Initial Release.
+ 2.02 | 12/15/99 | kjw | Removed use of endwin. Replaced with tcget/setattr.
+ 2.03 | 12/16/99 | kjw | 1) Added shifted f-keys to nReadkey.
+ | 2) Added raw & scrollok to StartCurses.
+ | 3) Added alt'd keyset support.
+ 2.04 | 01/04/00 | kjw | keypressed changed back to method of using getch
+ | rather than select.
+ 2.05 | 01/06/00 | kjw | 1) StartCurses now defaults to echo. Readkey sets to
+ | noecho. This allows nCrt to handle echoing in the
+ | default manor, but allows oCrt to control echoing
+ | in the app with nEcho. Note: Read(ln) will always
+ | echo as normal, regardless of any setting by nEcho.
+ | Also set DoRefresh to true.
+ | 2) nDelWindow now checks for stdscr or curscr and
+ | makes sure that ActiveWn is not nil.
+ | 3) Window() now moves to 1,1 and does not do a
+ | clrscr.
+ 2.06 | 01/11/00 | kjw | 1) Oops! 2.04 change went back to stdscr vs. ActiveWn.
+ | Keypressed works correctly with windows again.
+ | 2) ClrEol works correctly now with color.
+ 2.07 | 01/31/00 | kjw | 1) Added NCRT_VERSION constants.
+ | 2) Added prev_textattr to detect a change in
+ | TextAttr value so current color gets updated.
+ | 3) See ocrt.pp
+ 2.08 | 06/09/00 | kjw | See ocrt.pp
+
+ 2.08.01 | 06/11/2000 | kjw | See ocrt.pp
+ 2.09.00 | 06/16/2000 | kjw | See ocrt.pp
+ 2.10.00 | 06/16/2000 | kjw | See ocrt.pp
+ 2.11.00 | 06/27/2000 | kjw
+ | 1) See ocrt.pp
+ | 2) Now uses ncurses for CrtRead so console control characters
+ | work correctly (i.e., <ctrl/h>, <backspace>, etc.).
+ 2.12.00 | 06/29/2000 | kjw | See ocrt.pp
+ 2.13.00 | 06/30/2000 | kjw
+ | Added nStop and nStart procedures.
+ 2.14.00 | 07/05/2000 | kjw
+ | 1) Added nCursor and nEscDelay functions.
+ | 2) Added nInit and moved code from ncrt.pp & ocrt.pp to it.
+ | 3) KEY_ALTMINUS & KEYALTEQUAL were reversed, but mapping ended
+ | up correct.
+ 2.15.00 | 1) Added nMaxRows & nMaxCols constants.
+ | 2) See ocrt.pp
+ 2.16.00 | 08/14/2000 | kjw | See ocrt.pp
+ | 08/24/2000 | kjw |
+ | 1) Added nTermName.
+ | 2) Added CursesFailed.
+ | 3) Moved all common initialization code to nInit.
+ | 4) prev_textattr more reliable.
+------------------------------------------------------------------------------
+}
+
+Procedure AssignCrt(var F: Text);
+Procedure ClrEol;
+Procedure ClrScr;
+Procedure ClrBot;
+Procedure Delay(DTime: Word);
+Procedure DelLine;
+Procedure GotoXY(x,y : integer);
+Procedure HighVideo;
+Procedure InsLine;
+ Function Keypressed : boolean;
+Procedure LowVideo;
+Procedure NormVideo;
+Procedure NoSound;
+ Function Readkey : char;
+Procedure Sound(hz : word);
+Procedure TextBackground(att : byte);
+Procedure TextColor(att : byte);
+Procedure TextMode(mode : word);
+ Function WhereX : integer;
+ Function WhereY : integer;
+Procedure Window(x,y,x1,y1 : integer);
+Procedure nStop;
+Procedure nStart;
+ Function nCursor(c : integer) : integer;
+ Function nEscDelay(d : longint) : longint;
+ Function nTermName : string;
+
+Const
+
+ NCRT_VERSION_MAJOR = 2;
+ NCRT_VERSION_MINOR = 16;
+ NCRT_VERSION_PATCH = 0;
+ NCRT_VERSION = '2.16.00';
+
+ { CRT modes }
+ BW40 = 0; { 40x25 B/W on Color Adapter }
+ CO40 = 1; { 40x25 Color on Color Adapter }
+ BW80 = 2; { 80x25 B/W on Color Adapter }
+ CO80 = 3; { 80x25 Color on Color Adapter }
+ Mono = 7; { 80x25 on Monochrome Adapter }
+ Font8x8 = 256; { Add-in for ROM font }
+
+ { Mode constants for 3.0 compatibility }
+ C40 = CO40;
+ C80 = CO80;
+
+ Black = 0;
+ Blue = 1;
+ Green = 2;
+ Cyan = 3;
+ Red = 4;
+ Magenta = 5;
+ Brown = 6;
+ LightGray = 7;
+ DarkGray = 8;
+ LightBlue = 9;
+ LightGreen = 10;
+ LightCyan = 11;
+ LightRed = 12;
+ LightMagenta = 13;
+ Yellow = 14;
+ White = 15;
+ Blink = 128;
+
+ TextAttr : Byte = $07;
+ LastMode : Word = 3;
+ WindMin : Word = $0;
+ WindMax : Word = $184f;
+
+ { support for the alt'd characters }
+ { these get initialized by StartCurses }
+ KEY_ALTA = 465; { alt/a }
+ KEY_ALTB = 466;
+ KEY_ALTC = 467;
+ KEY_ALTD = 468;
+ KEY_ALTE = 469;
+ KEY_ALTF = 470;
+ KEY_ALTG = 471;
+ KEY_ALTH = 472;
+ KEY_ALTI = 473;
+ KEY_ALTJ = 474;
+ KEY_ALTK = 475;
+ KEY_ALTL = 476;
+ KEY_ALTM = 477;
+ KEY_ALTN = 478;
+ KEY_ALTO = 479;
+ KEY_ALTP = 480;
+ KEY_ALTQ = 481;
+ KEY_ALTR = 482;
+ KEY_ALTS = 483;
+ KEY_ALTT = 484;
+ KEY_ALTU = 485;
+ KEY_ALTV = 486;
+ KEY_ALTW = 487;
+ KEY_ALTX = 488;
+ KEY_ALTY = 489;
+ KEY_ALTZ = 490; { alt/z }
+ KEY_ALT1 = 491; { alt/1 }
+ KEY_ALT2 = 492; { alt/2 }
+ KEY_ALT3 = 493; { alt/3 }
+ KEY_ALT4 = 494; { alt/4 }
+ KEY_ALT5 = 495; { alt/5 }
+ KEY_ALT6 = 496; { alt/6 }
+ KEY_ALT7 = 497; { alt/7 }
+ KEY_ALT8 = 498; { alt/8 }
+ KEY_ALT9 = 499; { alt/9 }
+ KEY_ALT0 = 500; { alt/0 }
+ KEY_ALTMINUS = 501; { alt/- }
+ KEY_ALTEQUAL = 502; { alt/= }
+ KEY_ALTTAB = 503; { alt/tab }
+
+ { cursor type }
+ cOFF = 0; { invisible cursor }
+ cON = 1; { normal cursor }
+ cBIG = 2; { very visible cursor }
+
+ { fullscreen size }
+ nMaxRows : word = 25; { reset at startup to terminal setting }
+ nMaxCols : word = 80; { for columns and rows }
+
+ var
+ CheckBreak,
+ CheckEOF,
+ CheckSnow,
+ DirectVideo: Boolean;
+
+Implementation
+
+uses strings;
+
+Const
+ { standard file descriptors }
+ STDIN = 0;
+ STDOUT = 1;
+ STDERR = 2;
+
+Var
+ ExitSave : pointer; { pointer to original exit proc }
+ fg,bg : integer; { foreground & background }
+ cp : array [0..7,0..7] of integer; { color pair array }
+ ps : array [0..255] of char; { for use with pchars }
+ doRefresh : boolean; { immediate refresh toggle }
+ SubWn, { window created from window() }
+ PrevWn, { previous window when active changes }
+ ActiveWn : pwindow; { current active window for stdout }
+ tmp_b : boolean;
+ isEcho : boolean; { keeps track of echo status }
+ MaxRows, { set at startup to terminal values }
+ MaxCols : longint; { for columns and rows }
+ tios : TermIOS; { saves the term settings at startup }
+ prev_textattr : integer; { detect change in TextAttr }
+
+{==========================================================================}
+
+{ set the active window for write(ln), read(ln) }
+Procedure SetActiveWn(win : pwindow);
+Begin
+ If win <> ActiveWn Then PrevWn := ActiveWn;
+ { don't set to a nil window! }
+ If win <> Nil Then
+ ActiveWn := win
+ Else
+ ActiveWn := stdscr;
+End;
+
+{--------------------------------------------
+ initialize ncurses screen & keyboard, and
+ return a pointer to stdscr.
+ NOTE: This is done at unit initialization.
+ --------------------------------------------}
+Function StartCurses(var win : pWindow) : Boolean;
+Var
+ i : integer;
+ s : string[3];
+Begin
+ { save the current terminal settings }
+ tcGetAttr(STDIN,tios);
+ if initscr=Nil then Begin
+ StartCurses := false;
+ win := nil;
+ Exit;
+ End Else Begin
+ StartCurses := true;
+ start_color;
+ cbreak; { disable keyboard buffering }
+ raw; { disable flow control, etc. }
+ echo; { echo keypresses }
+ nonl; { don't process cr in newline }
+ intrflush(stdscr,bool(false));
+ keypad(stdscr,bool(true));
+ scrollok(stdscr,bool(true));
+ win := stdscr;
+ isEcho := true;
+ doRefresh := true;
+ getmaxyx(stdscr,MaxRows,MaxCols);
+ { make these values visible to apps }
+ nMaxRows := MaxRows;
+ nMaxCols := MaxCols;
+ { define the the alt'd keysets for ncurses }
+ { alt/a .. atl/z }
+ for i := ord('a') to ord('z') do Begin
+ s := #27+chr(i)+#0;
+ define_key(@s[1],(KEY_ALTA-97)+i);
+ End;
+ { alt/1 .. alt/9 }
+ for i := 1 to 9 do Begin
+ s := #27+chr(i)+#0;
+ define_key(@s[1],(KEY_ALT1-1)+i);
+ End;
+ s := #27+'0'+#0; define_key(@s[1],KEY_ALT0); { alt/0 }
+ s := #27+'-'+#0; define_key(@s[1],KEY_ALTMINUS); { alt/- }
+ s := #27+'='+#0; define_key(@s[1],KEY_ALTEQUAL); { alt/= }
+ s := #27+#9+#0; define_key(@s[1],KEY_ALTTAB); { alt/tab }
+ End;
+End;
+
+{----------------------------------
+ Shutdown ncurses.
+ NOTE: This is done via ExitProc.
+ ----------------------------------}
+Procedure EndCurses;
+Begin
+ { restore the original terminal settings }
+ { and leave the screen how the app left it }
+ tcSetAttr(STDIN,TCSANOW,tios);
+End;
+
+{--------------------------------------------------------
+ This disables any curses activity until a refresh.
+ Use this BEFORE any shelling (shell,exec,execv,etc)
+ to put the terminal temporarily back into cooked mode.
+ --------------------------------------------------------}
+Procedure nStop;
+Begin
+ endwin;
+End;
+
+{---------------------------------------------
+ Simply a refresh to re-establish the curses
+ terminal settings following an nStop.
+ ---------------------------------------------}
+Procedure nStart;
+Begin
+ refresh;
+End;
+
+{ see if the specified attribute is high intensity }
+Function nIsBold(att : integer) : boolean;
+Begin
+ bg := att div 16;
+ fg := att - (bg * 16);
+ nisbold := (fg > 7);
+End;
+
+{ map a curses color to an ibm color }
+Function c2ibm(c : integer) : integer;
+{ ncurses constants
+ COLOR_BLACK = 0;
+ COLOR_RED = 1;
+ COLOR_GREEN = 2;
+ COLOR_YELLOW = 3;
+ COLOR_BLUE = 4;
+ COLOR_MAGENTA = 5;
+ COLOR_CYAN = 6;
+ COLOR_WHITE = 7;
+}
+Var
+ att : integer;
+Begin
+ Case c of
+ COLOR_BLACK : att := black;
+ COLOR_RED : att := red;
+ COLOR_GREEN : att := green;
+ COLOR_YELLOW : att := brown;
+ COLOR_BLUE : att := blue;
+ COLOR_MAGENTA : att := magenta;
+ COLOR_CYAN : att := cyan;
+ COLOR_WHITE : att := lightgray;
+ else att := c;
+ End;
+ c2ibm := att;
+End;
+
+{ map an ibm color to a curses color }
+Function ibm2c(c : integer) : integer;
+Var
+ att : integer;
+Begin
+ Case c of
+ black : att := COLOR_BLACK;
+ red : att := COLOR_RED;
+ green : att := COLOR_GREEN;
+ brown : att := COLOR_YELLOW;
+ blue : att := COLOR_BLUE;
+ magenta : att := COLOR_MAGENTA;
+ cyan : att := COLOR_CYAN;
+ lightgray : att := COLOR_WHITE;
+ else att := c;
+ End;
+ ibm2c := att;
+End;
+
+{ initialize a color pair }
+Function nSetColorPair(att : integer) : integer;
+var
+ i : integer;
+Begin
+ bg := att div 16;
+ fg := att - (bg * 16);
+ While bg > 7 Do dec(bg,8);
+ While fg > 7 Do dec(fg,8);
+ bg := ibm2c(bg);
+ fg := ibm2c(fg);
+ i := cp[bg,fg];
+ init_pair(i,fg,bg);
+ nSetColorPair := i;
+End;
+
+{ map a standard color attribute to an ncurses attribute }
+Function CursesAtts(att : byte) : longint;
+Var
+ atts : longint;
+Begin
+ atts := COLOR_PAIR(nSetColorPair(att));
+ If nIsBold(att) Then atts := atts or A_BOLD;
+ If (att and $80) = $80 Then atts := atts or A_BLINK;
+ CursesAtts := atts;
+End;
+
+{------------------------------------------------
+ Delete a window.
+ NOTE: This does not clear it from the display.
+ ------------------------------------------------}
+Procedure nDelWindow(var win : pWindow);
+Begin
+ If (win = stdscr) or (win = curscr) Then Exit;
+ If win <> Nil Then delwin(win);
+ win := Nil;
+ If ActiveWn = Nil Then SetActiveWn(stdscr);
+End;
+
+{-----------------------------------------
+ Set the current text color of a window,
+ delayed until next refresh.
+ -----------------------------------------}
+Procedure nWinColor(win : pWindow; att : integer);
+Begin
+ wattrset(win,CursesAtts(att));
+ prev_textattr := att;
+End;
+
+{ clear the specified window }
+procedure nClrScr(win : pWindow; att : integer);
+Begin
+ wbkgd(win,CursesAtts(att));
+ TouchWin(win);
+ werase(win);
+ If doRefresh Then wrefresh(win);
+ prev_textattr := att;
+End;
+
+{ clear from the cursor to the end of line in a window }
+Procedure nClrEol(win : pWindow);
+Var
+ tmp : pwindow;
+ x,y,
+ xb,yb,
+ xm,ym : longint;
+Begin
+ {--------------------------------------------------------
+ In order to have the correct color, we must define and
+ clear a temporary window. ncurses wclrtoeol() uses the
+ window background color rather that the current color
+ attribute ;-(
+ --------------------------------------------------------}
+ getyx(win,y,x);
+ getbegyx(win,yb,xb);
+ getmaxyx(win,ym,xm);
+ tmp := subwin(win,1,xm-x,yb+y,xb+x);
+ If tmp = nil then Exit;
+ wbkgd(tmp,CursesAtts(TextAttr));
+ werase(tmp);
+{ wclrtoeol(win);}
+ If doRefresh Then wrefresh(tmp);
+ delwin(tmp);
+End;
+
+{ clear from the cursor to the bottom in a window }
+Procedure nClrBot(win : pWindow);
+Begin
+ wclrtobot(win);
+ If doRefresh Then wrefresh(win);
+End;
+
+{ insert a line at the cursor line in a window }
+Procedure nInsLine(win : pWindow);
+Begin
+ winsertln(win);
+ If doRefresh Then wrefresh(win);
+End;
+
+{ delete line at the cursor in a window }
+Procedure nDelLine(win : pWindow);
+Begin
+ wdeleteln(win);
+ If doRefresh Then wrefresh(win);
+End;
+
+{ position cursor in a window }
+Procedure nGotoXY(win : pWindow; x,y : integer);
+Begin
+ wmove(win,y-1,x-1);
+ touchwin(win);
+ If doRefresh Then wrefresh(win);
+End;
+
+{ find cursor x position in a window }
+Function nWhereX(win : pWindow) : integer;
+var x,y : longint;
+Begin
+ getyx(win,y,x);
+ nWhereX := x+1;
+End;
+
+{ find cursor y position in a window }
+Function nWhereY(win : pWindow) : integer;
+var x,y : longint;
+Begin
+ getyx(win,y,x);
+ nWhereY := y+1;
+End;
+
+{---------------------------------------------------------------------
+ read a keystroke from a window, including function keys and extended
+ keys (arrows, etc.)
+ Note: Make sure that keypad(win,true) has been issued prior to use.
+ ( nWindow does this )
+ ---------------------------------------------------------------------}
+Function nReadkey(win : pWindow) : char;
+var
+ c : char;
+ l : longint;
+ xtnded : boolean;
+Begin
+ l := wgetch(win);
+ { if it's an extended key, then map to the IBM values }
+ if l > 255 then begin
+ xtnded := true;
+ c := #27;
+ Case l of
+ KEY_BREAK : Begin xtnded := false; c := #3; End;
+ KEY_BACKSPACE : Begin xtnded := false; c := #8; End;
+ KEY_IC : c := #82; { insert }
+ KEY_DC : c := #83; { delete }
+ KEY_HOME : c := #71; { home }
+ KEY_END : c := #79; { end }
+ KEY_UP : c := #72; { up arrow }
+ KEY_DOWN : c := #80; { down arrow }
+ KEY_LEFT : c := #75; { left arrow }
+ KEY_RIGHT : c := #77; { right arrow }
+ KEY_NPAGE : c := #81; { page down }
+ KEY_PPAGE : c := #73; { page up }
+ KEY_ALTA : c := #30; { alt/a }
+ KEY_ALTB : c := #48;
+ KEY_ALTC : c := #46;
+ KEY_ALTD : c := #32;
+ KEY_ALTE : c := #18;
+ KEY_ALTF : c := #33;
+ KEY_ALTG : c := #34;
+ KEY_ALTH : c := #35;
+ KEY_ALTI : c := #23;
+ KEY_ALTJ : c := #36;
+ KEY_ALTK : c := #37;
+ KEY_ALTL : c := #38;
+ KEY_ALTM : c := #50;
+ KEY_ALTN : c := #49;
+ KEY_ALTO : c := #24;
+ KEY_ALTP : c := #25;
+ KEY_ALTQ : c := #16;
+ KEY_ALTR : c := #19;
+ KEY_ALTS : c := #31;
+ KEY_ALTT : c := #20;
+ KEY_ALTU : c := #22;
+ KEY_ALTV : c := #47;
+ KEY_ALTW : c := #17;
+ KEY_ALTX : c := #45;
+ KEY_ALTY : c := #21;
+ KEY_ALTZ : c := #44; { alt/z }
+ KEY_ALT1 : c := #120; { alt/1 }
+ KEY_ALT2 : c := #121; { alt/2 }
+ KEY_ALT3 : c := #122; { alt/3 }
+ KEY_ALT4 : c := #123; { alt/4 }
+ KEY_ALT5 : c := #124; { alt/5 }
+ KEY_ALT6 : c := #125; { alt/6 }
+ KEY_ALT7 : c := #126; { alt/7 }
+ KEY_ALT8 : c := #127; { alt/8 }
+ KEY_ALT9 : c := #128; { alt/9 }
+ KEY_ALT0 : c := #129; { alt/0 }
+ KEY_ALTMINUS : c := #130; { alt/- }
+ KEY_ALTEQUAL : c := #131; { alt/= }
+ KEY_ALTTAB : c := #15; { alt/tab }
+ Else
+ Begin
+ If l = Key_f(1) Then c := #59 Else
+ If l = Key_f(2) Then c := #60 Else
+ If l = Key_f(3) Then c := #61 Else
+ If l = Key_f(4) Then c := #62 Else
+ If l = Key_f(5) Then c := #63 Else
+ If l = Key_f(6) Then c := #64 Else
+ If l = Key_f(7) Then c := #65 Else
+ If l = Key_f(8) Then c := #66 Else
+ If l = Key_f(9) Then c := #67 Else
+ If l = Key_f(10) Then c := #68 Else
+ If l = Key_f(11) Then c := #84 Else
+ If l = Key_f(12) Then c := #85 Else
+ If l = Key_f(13) Then c := #86 Else
+ If l = Key_f(14) Then c := #87 Else
+ If l = Key_f(15) Then c := #88 Else
+ If l = Key_f(16) Then c := #89 Else
+ If l = Key_f(17) Then c := #90 Else
+ If l = Key_f(18) Then c := #91 Else
+ If l = Key_f(19) Then c := #92 Else
+ If l = Key_f(20) Then c := #93;
+ End;
+ End;
+ If xtnded Then Begin
+ nReadKey := #0;
+ ungetch(ord(c));
+ Exit;
+ End Else
+ nReadkey := c;
+ End Else
+ nReadkey := chr(ord(l));
+End;
+
+{ write a string to a window at the current cursor position }
+Procedure nWrite(win : pWindow; s : string);
+Begin
+ If TextAttr <> prev_textattr Then
+ nWinColor(win,TextAttr);
+ waddstr(win,StrPCopy(ps,s));
+ If doRefresh Then wrefresh(win);
+End;
+
+{=========================================================================
+ CrtWrite, CrtRead, CrtReturn, CrtClose, CrtOpen, AssignCrt.
+ These functions come from the FPC distribution rtl/linux/crt unit.
+ These are the hooks into the input/output stream needed for write(ln)
+ and read(ln).
+ =========================================================================}
+
+{ used by CrtWrite }
+Procedure DoWrite(temp : string);
+Begin
+ nWrite(ActiveWn,temp);
+End;
+
+Function CrtWrite(Var F: TextRec): Integer;
+{
+ Top level write function for CRT
+}
+Var
+ Temp : String;
+ idx,i : Longint;
+{ oldflush : boolean;}
+Begin
+{ oldflush:=ttySetFlush(Flushing);}
+ idx:=0;
+ while (F.BufPos>0) do
+ begin
+ i:=F.BufPos;
+ if i>255 then
+ i:=255;
+ system.Move(F.BufPTR^[idx],Temp[1],F.BufPos);
+ Temp[0]:=Chr(i);
+ DoWrite(Temp);
+ dec(F.BufPos,i);
+ inc(idx,i);
+ end;
+{ ttySetFlush(oldFLush);}
+ CrtWrite:=0;
+End;
+
+Function CrtRead(Var F: TextRec): Integer;
+{
+ Read from CRT associated file.
+}
+Begin
+ { let's use ncurses instead! }
+ FillChar(F.BufPtr^, F.BufSize, #0);
+ wgetnstr(ActiveWn,F.BufPtr^, F.BufSize-1);
+ F.BufEnd := Length(StrPas(F.BufPtr^))+1;
+ F.BufPtr^[F.BufEnd-1] := #10;
+ F.BufPos:=0;
+{ CrtWrite(F);}
+ CrtRead:=0;
+End;
+
+Function CrtReturn(Var F:TextRec):Integer;
+Begin
+ F.BufEnd := 0;
+ F.BufPos:= 0;
+ CrtReturn:=0;
+end;
+
+Function CrtClose(Var F: TextRec): Integer;
+{
+ Close CRT associated file.
+}
+Begin
+ F.Mode:=fmClosed;
+ CrtClose:=0;
+End;
+
+Function CrtOpen(Var F: TextRec): Integer;
+{
+ Open CRT associated file.
+}
+Begin
+ If F.Mode=fmOutput Then
+ begin
+ TextRec(F).InOutFunc:=@CrtWrite;
+ TextRec(F).FlushFunc:=@CrtWrite;
+ end
+ Else
+ begin
+ F.Mode:=fmInput;
+ TextRec(F).InOutFunc:=@CrtRead;
+ TextRec(F).FlushFunc:=@CrtReturn;
+ end;
+ TextRec(F).CloseFunc:=@CrtClose;
+ CrtOpen:=0;
+End;
+
+procedure AssignCrt(var F: Text);
+{
+ Assign a file to the console. All output on file goes to console instead.
+}
+begin
+ Assign(F,'');
+ TextRec(F).OpenFunc:=@CrtOpen;
+end;
+
+{==========================================================================
+ Standard crt unit replacements
+ ==========================================================================}
+{ set the text background color }
+Procedure TextBackground(att : byte);
+Begin
+ TextAttr:=
+ ((att shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
+ nWinColor(ActiveWn,TextAttr);
+End;
+
+{ set the text foreground color }
+Procedure TextColor(att : byte);
+Begin
+ TextAttr := (att and $8f) or (TextAttr and $70);
+ nWinColor(ActiveWn,TextAttr);
+End;
+
+{ set to high intensity }
+Procedure HighVideo;
+Begin
+ TextColor(TextAttr Or $08);
+End;
+
+{ set to low intensity }
+Procedure LowVideo;
+Begin
+ TextColor(TextAttr And $77);
+End;
+
+{ set to normal display colors }
+Procedure NormVideo;
+Begin
+ TextColor(7);
+ TextBackGround(0);
+End;
+
+{ clear stdscr }
+Procedure ClrScr;
+Begin
+ nClrScr(ActiveWn,TextAttr);
+End;
+
+{ clear from the cursor to the end of line in stdscr }
+Procedure ClrEol;
+Begin
+ nClrEol(ActiveWn);
+End;
+
+{ clear from the cursor to the bottom of stdscr }
+Procedure ClrBot;
+Begin
+ nClrBot(ActiveWn);
+End;
+
+{ insert a line at the cursor line in stdscr }
+Procedure InsLine;
+Begin
+ nInsLine(ActiveWn);
+End;
+
+{ delete line at the cursor in stdscr }
+Procedure DelLine;
+Begin
+ nDelLine(ActiveWn);
+End;
+
+{ position cursor in stdscr }
+Procedure GotoXY(x,y : integer);
+Begin
+ nGotoXY(ActiveWn,x,y);
+End;
+
+{ find cursor x position in stdscr }
+Function WhereX : integer;
+Begin
+ WhereX := nWhereX(ActiveWn);
+End;
+
+{ find cursor y position in stdscr }
+Function WhereY : integer;
+Begin
+ WhereY := nWhereY(ActiveWn);
+End;
+
+{ Wait for DTime milliseconds }
+Procedure Delay(DTime: Word);
+Begin
+ fpselect(0,nil,nil,nil,DTime);
+End;
+
+{ create a new subwindow of stdscr }
+Procedure Window(x,y,x1,y1 : integer);
+Begin
+ nDelWindow(SubWn);
+ SubWn := subwin(stdscr,y1-y+1,x1-x+1,y-1,x-1);
+ If SubWn = nil then Exit;
+ intrflush(SubWn,bool(false));
+ keypad(SubWn,bool(true));
+ scrollok(SubWn,bool(true));
+ SetActiveWn(SubWn);
+ GotoXY(1,1);
+End;
+
+{------------------------------------------------------
+ Check if a key has been pressed.
+ Note: this is best used along with select() on STDIN,
+ as it can suck up lots of cpu time.
+ Better yet, use nKeypressed instead if you don't need
+ to include file descriptors other than STDIN.
+ ------------------------------------------------------}
+function Keypressed : boolean;
+var
+ l : longint;
+{ fd : fdSet;}
+Begin
+ Keypressed := FALSE;
+ nodelay(ActiveWn,bool(TRUE));
+ l := wgetch(ActiveWn);
+ If l <> ERR Then Begin { ERR = -(1) from unit ncurses }
+ ungetch(l);
+ Keypressed := TRUE;
+ End;
+ nodelay(ActiveWn,bool(FALSE));
+
+{ Below is more efficient code, but does not work well with
+ nReadkey & extended keys because nReadkey's ungetch does not
+ force a change in STDIN. So, a "while keypressed" block does
+ not produce the expected results when trapping for char(0)
+ followed by a second scan code.
+
+ FD_Zero(fd);
+ fd_Set(STDIN,fd);
+ Keypressed := (Select(STDIN+1,@fd,nil,nil,0) > 0);
+}
+End;
+
+{ silently read a key from stdscr }
+Function Readkey : char;
+Begin
+ tmp_b := IsEcho;
+ noecho;
+ Readkey := nReadkey(ActiveWn);
+ If tmp_b Then echo;
+End;
+
+{ a cheap replacement! }
+Procedure Sound(hz : word);
+Begin
+ Beep;
+ wrefresh(ActiveWn);
+End;
+
+Procedure NoSound;
+Begin
+End;
+
+Procedure TextMode(mode : word);
+Begin
+ nDelWindow(SubWn);
+ SetActiveWn(stdscr);
+ LastMode := mode;
+ DirectVideo := true;
+ CheckSnow := true;
+ NormVideo;
+ ClrScr;
+End;
+
+{ Set the cursor visibility. Returns the previous value }
+{ or (-1) if value c is not supported by the terminal. }
+Function nCursor(c : integer) : integer;
+Begin
+ nCursor := curs_set(c);
+End;
+
+{ Set the <esc> key delay time in milliseconds. }
+{ Use d=(-1) to return current value without updating. }
+Function nEscDelay(d : longint) : longint;
+Begin
+ nEscDelay := ESCDELAY;
+ If d >= 0 Then ESCDELAY := d;
+End;
+
+{ return the current terminal name (same as $TERM env variable) }
+Function nTermName : string;
+Begin
+ nTermName := StrPas(termname);
+End;
+
+{ could not initialize ncurses }
+Procedure CursesFailed;
+Begin
+ { give 'em a clue! }
+ Writeln('StartCurses() failed');
+ Halt;
+End;
+
+{ exit procedure to ensure curses is closed up cleanly }
+Procedure nExit;
+Begin
+ ExitProc := ExitSave;
+ EndCurses;
+End;
+
+Procedure nInit;
+Begin
+ { set the unit exit procedure }
+ ExitSave := ExitProc;
+ ExitProc := @nExit;
+ { load the color pairs array with color pair indices (0..63 }
+ For bg := 0 to 7 Do For fg := 0 to 7 do cp[bg,fg] := (bg*8)+fg;
+ { initial window pointers }
+ SubWn := nil;
+ PrevWn := ActiveWn;
+ { basic gray on black screen }
+ TextMode(LastMode);
+ { Redirect the standard output }
+ assigncrt(Output);
+ Rewrite(Output);
+ TextRec(Output).Handle:=StdOutputHandle;
+ { Redirect the standard input }
+ assigncrt(Input);
+ Reset(Input);
+ TextRec(Input).Handle:=StdInputHandle;
+ { some defaults }
+ nEscDelay(500); { default is 1000 (1 second) }
+ nCursor(cON); { normal cursor }
+End;
diff --git a/packages/ncurses/src/ncrt.pp b/packages/ncurses/src/ncrt.pp
new file mode 100644
index 0000000000..e775a05555
--- /dev/null
+++ b/packages/ncurses/src/ncrt.pp
@@ -0,0 +1,44 @@
+Unit nCrt;
+{---------------------------------------------------------------------------
+ CncWare
+ (c) Copyright 1999-2000
+ Portions copyright the FreePascal Team
+ ---------------------------------------------------------------------------
+ Filename..: ncrt.pp
+ Programmer: Ken J. Wright, ken@cncware.com
+ Date......: 03/01/99
+
+ Purpose - A crt replacement using ncurses.
+
+-------------------------------<< REVISIONS >>--------------------------------
+ Ver | Date | Prog| Description
+-------+----------+-----+-----------------------------------------------------
+ 1.00 | 03/01/99 | kjw | Initial Release.
+------------------------------------------------------------------------------
+ 2.00 | 12/13/99 | kjw | nCrt is now a drop-in replacement for the standard
+ | FPC crt unit. All the previous OOP features have
+ | been moved to a new unit, oCrt (object crt).
+ | See ocrt.pp & ncrt.inc for a complete revision
+ | history.
+------------------------------------------------------------------------------
+}
+Interface
+
+Uses
+{$ifdef Unix}
+ baseunix,
+ termio,
+{$endif}
+ ncurses,
+ dos; {dos needed for TextRec}
+
+{$i ncrt.inc}
+
+Begin
+ { initialize ncurses }
+ If StartCurses(ActiveWn) Then
+ { defaults, crtassign, etc. }
+ nInit
+ Else
+ CursesFailed;
+End. { of Unit nCrt }
diff --git a/packages/ncurses/src/ncurses.pp b/packages/ncurses/src/ncurses.pp
new file mode 100644
index 0000000000..e6e3c1107c
--- /dev/null
+++ b/packages/ncurses/src/ncurses.pp
@@ -0,0 +1,1708 @@
+{
+ Copyright (c) 1998 by Michael Van Canneyt
+ member of the Free Pascal development team
+
+ Unit to access the ncurses library
+
+ See the file COPYING.FPC included in this distribution,
+ for details about the copyright.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+{$mode objfpc}
+{
+ Many thanks to Ken Wright for his patches !
+}
+unit ncurses;
+interface
+
+{$packrecords C}
+{$ifdef OpenBSD} // openbsd curses=ncurses. Openbsd ocurses=old curses.
+{$linklib curses}
+{$else}
+{$linklib ncurses}
+{$endif}
+{$linklib c}
+
+{ Manually Added types }
+type
+ Bool = byte;
+ PINTEGER = ^Longint;
+ PLongint = ^ longint;
+ PFILE = pointer;
+
+const
+{$ifndef openbsd}
+ libncurses = 'ncurses';
+{$else openbsd}
+ libncurses = 'curses';
+{$endif openbsd}
+ NCURSES_VERSION_MAJOR = 5;
+ NCURSES_VERSION_MINOR = 0;
+ NCURSES_VERSION_PATCH = 19991023;
+ NCURSES_VERSION = '5.0';
+
+type
+ chtype = longint;
+ pchtype = pchar;
+
+const
+ CXX_BUILTIN_BOOL = 1;
+type
+ CXX_TYPE_OF_BOOL = char;
+
+var
+{$ifndef darwin}
+ COLORS : longint; cvar; external;
+ COLOR_PAIRS : longint; cvar; external;
+{$else darwin}
+ COLORS : longint; external libncurses name 'COLORS';
+ COLOR_PAIRS : longint; external libncurses name 'COLOR_PAIRS';
+{$endif darwin}
+
+ const
+ COLOR_BLACK = 0;
+ COLOR_RED = 1;
+ COLOR_GREEN = 2;
+ COLOR_YELLOW = 3;
+ COLOR_BLUE = 4;
+ COLOR_MAGENTA = 5;
+ COLOR_CYAN = 6;
+ COLOR_WHITE = 7;
+
+type
+ tacs_map = array [char] of chtype;
+ pacs_map = ^tacs_map;
+
+var
+{$ifndef darwin}
+ acs_map : tacs_map; cvar; external;
+{$else darwin}
+ acs_map : tacs_map; external libncurses name 'acs_map';
+{$endif darwin}
+
+ function ACS_ULCORNER : chtype;
+ function ACS_LLCORNER : chtype;
+ function ACS_URCORNER : chtype;
+ function ACS_LRCORNER : chtype;
+ function ACS_LTEE : chtype;
+ function ACS_RTEE : chtype;
+ function ACS_BTEE : chtype;
+ function ACS_TTEE : chtype;
+ function ACS_HLINE : chtype;
+ function ACS_VLINE : chtype;
+ function ACS_PLUS : chtype;
+ function ACS_S1 : chtype;
+ function ACS_S9 : chtype;
+ function ACS_DIAMOND : chtype;
+ function ACS_CKBOARD : chtype;
+ function ACS_DEGREE : chtype;
+ function ACS_PLMINUS : chtype;
+ function ACS_BULLET : chtype;
+ function ACS_LARROW : chtype;
+ function ACS_RARROW : chtype;
+ function ACS_DARROW : chtype;
+ function ACS_UARROW : chtype;
+ function ACS_BOARD : chtype;
+ function ACS_LANTERN : chtype;
+ function ACS_BLOCK : chtype;
+ function ACS_S3 : chtype;
+ function ACS_S7 : chtype;
+ function ACS_LEQUAL : chtype;
+ function ACS_GEQUAL : chtype;
+ function ACS_PI : chtype;
+ function ACS_NEQUAL : chtype;
+ function ACS_STERLING : chtype;
+ {
+ Line drawing ACS names are of the form ACS_trbl, where t is the top, r
+ is the right, b is the bottom, and l is the left. t, r, b, and l might
+ be B (blank), S (single), D (double), or T (thick). The subset defined
+ here only uses B and S.
+ }
+ {
+ #define ACS_BSSB ACS_ULCORNER
+ #define ACS_SSBB ACS_LLCORNER
+ #define ACS_BBSS ACS_URCORNER
+ #define ACS_SBBS ACS_LRCORNER
+ #define ACS_SBSS ACS_RTEE
+ #define ACS_SSSB ACS_LTEE
+ #define ACS_SSBS ACS_BTEE
+ #define ACS_BSSS ACS_TTEE
+ #define ACS_BSBS ACS_HLINE
+ #define ACS_SBSB ACS_VLINE
+ #define ACS_SSSS ACS_PLUS
+ }
+
+ const
+ ERR = -(1);
+ OK = 0;
+ _SUBWIN = $01;
+ _ENDLINE = $02;
+ _FULLWIN = $04;
+ _SCROLLWIN = $08;
+ _ISPAD = $10;
+ _HASMOVED = $20;
+ _WRAPPED = $40;
+ {
+ this value is used in the firstchar and lastchar fields to mark
+ unchanged lines
+ }
+ _NOCHANGE = -(1);
+ {
+ this value is used in the oldindex field to mark lines created by insertions
+ and scrolls.
+ }
+ _NEWINDEX = -(1);
+ {
+ typedef struct screen SCREEN;
+ typedef struct _win_st WINDOW;
+ }
+
+ type
+
+ attr_t = chtype;
+ ldat = record
+ text : ^chtype;
+ firstchar : smallint;
+ lastchar : smallint;
+ oldindex : smallint;
+ end;
+
+ _win_st = record
+ _cury : smallint;
+ _curx : smallint;
+ _maxy : smallint;
+ _maxx : smallint;
+ _begy : smallint;
+ _begx : smallint;
+ _flags : smallint;
+ _attrs : attr_t;
+ _bkgd : chtype;
+ _notimeout : bool;
+ _clear : bool;
+ _leaveok : bool;
+ _scroll : bool;
+ _idlok : bool;
+ _idcok : bool;
+ _immed : bool;
+ _sync : bool;
+ _use_keypad : bool;
+ _delay : longint;
+ _line : ^ldat;
+ _regtop : smallint;
+ _regbottom : smallint;
+ _parx : longint;
+ _pary : longint;
+ _parent : ^WINDOW;
+ _pad : record
+ _pad_y : smallint;
+ _pad_x : smallint;
+ _pad_top : smallint;
+ _pad_left : smallint;
+ _pad_bottom : smallint;
+ _pad_right : smallint;
+ end;
+ _yoffset : smallint;
+ end;
+ WINDOW = _win_st;
+ PWINDOW = ^WINDOW;
+ SCREEN=WINDOW;
+ PSCREEN = PWINDOW;
+
+ var
+{$ifndef darwin}
+ stdscr : PWINDOW; cvar; external;
+ curscr : PWINDOW; cvar; external;
+ newscr : PWINDOW; cvar; external;
+ LINES : longint; cvar; external;
+ COLS : longint; cvar; external;
+ TABSIZE : longint; cvar; external;
+ ESCDELAY: longint; cvar; external;
+{$else darwin}
+ stdscr : PWINDOW; external libncurses name 'stdscr';
+ curscr : PWINDOW; external libncurses name 'curscr';
+ newscr : PWINDOW; external libncurses name 'newscr';
+ LINES : longint; external libncurses name 'LINES';
+ COLS : longint; external libncurses name 'COLS';
+ TABSIZE : longint; external libncurses name 'TABSIZE';
+ ESCDELAY: longint; external libncurses name 'ESCDELAY';
+{$endif darwin}
+
+ function define_key(_para1:pchar; _para2:longint):longint; cdecl;external libncurses;
+ function keyok(_para1:longint; _para2:bool):longint; cdecl;external libncurses;
+ function resizeterm(_para1:longint; _para2:longint):longint; cdecl;external libncurses;
+ function use_default_colors:longint; cdecl;external libncurses;
+ function wresize(_para1:pWINDOW; _para2:longint; _para3:longint):longint; cdecl;external libncurses;
+ {
+ extern char ttytype[];
+ }
+ function baudrate:longint; cdecl;external libncurses;
+ function beep:longint; cdecl;external libncurses;
+ function can_change_color:bool; cdecl;external libncurses;
+ function cbreak:longint; cdecl;external libncurses;
+ function clearok(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+ function color_content(_para1:longint; _para2:plongint; _para3:plongint; _para4:plongint):longint; cdecl;external libncurses;
+
+ function copywin(_para1:pWINDOW; _para2:pWINDOW; _para3:longint; _para4:longint; _para5:longint;
+ _para6:longint; _para7:longint; _para8:longint; _para9:longint):longint;cdecl;external libncurses;
+ function curs_set(_para1:longint):longint; cdecl;external libncurses;
+ function def_prog_mode:longint; cdecl;external libncurses;
+ function def_shell_mode:longint; cdecl;external libncurses;
+ function delay_output(_para1:longint):longint; cdecl;external libncurses;
+ procedure delscreen(_para1:pSCREEN);cdecl;external libncurses;
+ function delwin(_para1:pWINDOW):longint; cdecl;external libncurses;
+
+ function doupdate:longint; cdecl;external libncurses;
+
+ function echo:longint; cdecl;external libncurses;
+ function endwin:longint; cdecl;external libncurses;
+ function erasechar:char; cdecl;external libncurses;
+ procedure filter;cdecl;external libncurses;
+ function flash:longint; cdecl;external libncurses;
+ function flushinp:longint; cdecl;external libncurses;
+
+ function halfdelay(_para1:longint):longint; cdecl;external libncurses;
+ function has_colors:bool; cdecl;external libncurses;
+ function has_ic:longint; cdecl;external libncurses;
+ function has_il:longint; cdecl;external libncurses;
+ procedure idcok(_para1:pWINDOW; _para2:bool);cdecl;external libncurses;
+ function idlok(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+ procedure immedok(_para1:pWINDOW; _para2:bool);cdecl;external libncurses;
+
+ function init_color(_para1:longint; _para2:longint; _para3:longint; _para4:longint):longint; cdecl;external libncurses;
+ function init_pair(_para1:longint; _para2:longint; _para3:longint):longint; cdecl;external libncurses;
+ function intrflush(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+ function isendwin:longint; cdecl;external libncurses;
+ function is_linetouched(_para1:pWINDOW; _para2:longint):longint; cdecl;external libncurses;
+ function is_wintouched(_para1:pWINDOW):longint; cdecl;external libncurses;
+
+
+ function keypad(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+ function killchar:char; cdecl;external libncurses;
+ function leaveok(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+
+ function meta(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+ function mvcur(_para1:longint; _para2:longint; _para3:longint; _para4:longint):longint; cdecl;external libncurses;
+ function mvderwin(_para1:pWINDOW; _para2:longint; _para3:longint):longint; cdecl;external libncurses;
+ function mvprintw(_para1:longint;_para2:longint;_para3:pchar;_para4:array of const):longint; cdecl;external libncurses;
+ {
+ extern int mvscanw(int,int,const char ,...)
+ GCC_SCANFLIKE(3,4);
+ }
+ function mvwin(_para1:pWINDOW; _para2:longint; _para3:longint):longint; cdecl;external libncurses;
+ function mvwprintw(_para1:pWINDOW;_para2,_para3:longint;_para4:pchar;_para5:array of const):longint; cdecl;external libncurses;
+ {
+ extern int mvwprintw(WINDOW ,int,int,const char ,...)
+ GCC_PRINTFLIKE(4,5);
+ extern int mvwscanw(WINDOW ,int,int,const char ,...)
+ GCC_SCANFLIKE(4,5);
+ }
+ function napms(_para1:longint):longint; cdecl;external libncurses;
+
+ function nl:longint; cdecl;external libncurses;
+ function nocbreak:longint; cdecl;external libncurses;
+ function nodelay(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+ function noecho:longint; cdecl;external libncurses;
+ function nonl:longint; cdecl;external libncurses;
+ function noqiflush:longint; cdecl;external libncurses;
+ function noraw:longint; cdecl;external libncurses;
+ function notimeout(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+
+ function overlay(_para1:pWINDOW; _para2:pWINDOW):longint; cdecl;external libncurses;
+
+ function overwrite(_para1:pWINDOW; _para2:pWINDOW):longint; cdecl;external libncurses;
+ function pair_content(_para1:longint; _para2:plongint; _para3:plongint):longint; cdecl;external libncurses;
+
+ function pechochar(_para1:pWINDOW; _para2:chtype):longint; cdecl;external libncurses;
+ function pnoutrefresh(_para1:pWINDOW; _para2:longint; _para3:longint; _para4:longint; _para5:longint;
+ _para6:longint; _para7:longint):longint;cdecl;external libncurses;
+ function prefresh(_para1:pWINDOW; _para2:longint; _para3:longint; _para4:longint; _para5:longint;
+ _para6:longint; _para7:longint):longint;cdecl;external libncurses;
+ {
+ extern int printw(const char ,...)
+ GCC_PRINTFLIKE(1,2);
+ }
+ function putp(_para1:pchar):longint; cdecl;external libncurses;
+ function putwin(_para1:pWINDOW; _para2:pFILE):longint; cdecl;external libncurses;
+ function qiflush:longint; cdecl;external libncurses;
+ function raw:longint; cdecl;external libncurses;
+ function resetty:longint; cdecl;external libncurses;
+ function reset_prog_mode:longint; cdecl;external libncurses;
+ function reset_shell_mode:longint; cdecl;external libncurses;
+{
+ function ripoffline(_para1:longint; init:function (_para1:pWINDOW; _para2:longint):longint):longint; cdecl;external libncurses;
+}
+ function savetty:longint; cdecl;external libncurses;
+ {
+ extern int scanw(const char ,...)
+ GCC_SCANFLIKE(1,2);
+ }
+ function scr_dump(_para1:pchar):longint; cdecl;external libncurses;
+
+ function scr_init(_para1:pchar):longint; cdecl;external libncurses;
+ function scrollok(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+
+ function scr_restore(_para1:pchar):longint; cdecl;external libncurses;
+ function scr_set(_para1:pchar):longint; cdecl;external libncurses;
+
+ function slk_attroff(_para1:attr_t):longint; cdecl;external libncurses;
+ function slk_attron(_para1:attr_t):longint; cdecl;external libncurses;
+ function slk_attrset(_para1:attr_t):longint; cdecl;external libncurses;
+ function slk_attr:attr_t; cdecl;external libncurses;
+ function slk_clear:longint; cdecl;external libncurses;
+ function slk_init(_para1:longint):longint; cdecl;external libncurses;
+
+ function slk_noutrefresh:longint; cdecl;external libncurses;
+ function slk_refresh:longint; cdecl;external libncurses;
+ function slk_restore:longint; cdecl;external libncurses;
+
+ function slk_set(_para1:longint; _para2:pchar; _para3:longint):longint; cdecl;external libncurses;
+ function slk_touch:longint; cdecl;external libncurses;
+ function start_color:longint; cdecl;external libncurses;
+
+ function syncok(_para1:pWINDOW; _para2:bool):longint; cdecl;external libncurses;
+ function termattrs:chtype; cdecl;external libncurses;
+
+ function tigetflag(_para1:pchar):longint; cdecl;external libncurses;
+
+ function tigetnum(_para1:pchar):longint; cdecl;external libncurses;
+
+ function derwin (_para1:pWINDOW; _para2:longint; _para3:longint; _para4:longint; _para5:longint):PWINDOW; cdecl;external libncurses;
+ function dupwin (_para1:pWINDOW):PWINDOW; cdecl;external libncurses;
+ function getwin (_para1:pFILE):PWINDOW; cdecl;external libncurses;
+ function initscr :PWINDOW; cdecl;external libncurses;
+ function keyname (_para1:longint):pchar; cdecl;external libncurses;
+ function longname :pchar; cdecl;external libncurses;
+ function newpad (_para1:longint; _para2:longint):PWINDOW; cdecl;external libncurses;
+ function newterm (_para1:pchar; _para2:pFILE; _para3:pFILE):PSCREEN; cdecl;external libncurses;
+ function newwin (_para1:longint; _para2:longint; _para3:longint; _para4:longint):PWINDOW; cdecl;external libncurses;
+ function set_term (_para1:pSCREEN):PSCREEN; cdecl;external libncurses;
+ function slk_label (_para1:longint):pchar; cdecl;external libncurses;
+ function subpad (_para1:pWINDOW; _para2:longint; _para3:longint; _para4:longint; _para5:longint):PWINDOW; cdecl;external libncurses;
+ function subwin (_para1:pWINDOW; _para2:longint; _para3:longint; _para4:longint; _para5:longint):PWINDOW; cdecl;external libncurses;
+ function termname :pchar; cdecl;external libncurses;
+ function tigetstr (_para1:pchar):pchar; cdecl;external libncurses;
+ function typeahead(_para1:longint):longint; cdecl;external libncurses;
+ function ungetch(_para1:longint):longint; cdecl;external libncurses;
+ procedure use_env(_para1:bool);cdecl;external libncurses;
+ function vidattr(_para1:chtype):longint; cdecl;external libncurses;
+{
+ function vidputs(_para1:chtype; _para2:function (_para1:longint):longint):longint; cdecl;external libncurses;
+}
+{
+ function vwprintw(_para1:pWINDOW; _para2:pchar; _para3:va_list):longint; cdecl;external libncurses;
+ function vwscanw(_para1:pWINDOW; _para2:pchar; _para3:va_list):longint; cdecl;external libncurses;
+}
+ function waddch(_para1:pWINDOW; _para2:chtype):longint; cdecl;external libncurses;
+ function waddchnstr(_para1:pWINDOW; _para2:pchtype; _para3:longint):longint; cdecl;external libncurses;
+ function waddnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external libncurses;
+ function wattr_on(_para1:pWINDOW; _para2:attr_t):longint; cdecl;external libncurses;
+ function wattr_off(_para1:pWINDOW; _para2:attr_t):longint; cdecl;external libncurses;
+ function wattr_set(win : pwindow; at : longint) : longint; cdecl;external libncurses;
+ function wattron(win : pwindow;at : longint) : longint; cdecl;external libncurses;
+ function wattroff(win : pwindow;at : longint) : longint; cdecl;external libncurses;
+ function wattrset(win : pwindow;at : longint) : longint; cdecl;external libncurses;
+ function wbkgd(_para1:pWINDOW; _para2:chtype):longint; cdecl;external libncurses;
+ procedure wbkgdset(_para1:pWINDOW; _para2:chtype);cdecl;external libncurses;
+ function wborder(_para1:pWINDOW; _para2:chtype; _para3:chtype; _para4:chtype; _para5:chtype;
+ _para6:chtype; _para7:chtype; _para8:chtype; _para9:chtype):longint;cdecl;external libncurses;
+ function wchgat(_para1:pWINDOW; _para2:longint; _para3:attr_t; _para4:longint; _para5:pointer):longint; cdecl;external libncurses;
+ function wclear(_para1:pWINDOW):longint; cdecl;external libncurses;
+ function wclrtobot(_para1:pWINDOW):longint; cdecl;external libncurses;
+ function wclrtoeol(_para1:pWINDOW):longint; cdecl;external libncurses;
+ procedure wcursyncup(_para1:pWINDOW);cdecl;external libncurses;
+ function wdelch(_para1:pWINDOW):longint; cdecl;external libncurses;
+ function wechochar(_para1:pWINDOW; _para2:chtype):longint; cdecl;external libncurses;
+ function werase(_para1:pWINDOW):longint; cdecl;external libncurses;
+ function wgetch(_para1:pWINDOW):longint; cdecl;external libncurses;
+ function wgetnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external libncurses;
+ function whline(_para1:pWINDOW; _para2:chtype; _para3:longint):longint; cdecl;external libncurses;
+ function winch (win : PWindow) : longint; cdecl;external libncurses;
+ function winchnstr(_para1:pWINDOW; _para2:pchtype; _para3:longint):longint; cdecl;external libncurses;
+ function winnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external libncurses;
+ function winsch(_para1:pWINDOW; _para2:chtype):longint; cdecl;external libncurses;
+ function winsdelln(_para1:pWINDOW; _para2:longint):longint; cdecl;external libncurses;
+ function winsnstr(_para1:pWINDOW; _para2:pchar; _para3:longint):longint; cdecl;external libncurses;
+ function wmove(_para1:pWINDOW; _para2:longint; _para3:longint):longint; cdecl;external libncurses;
+ function wnoutrefresh(_para1:pWINDOW):longint; cdecl;external libncurses;
+ {
+ extern int wprintw(WINDOW ,const char ,...)
+ GCC_PRINTFLIKE(2,3);
+ }
+ function wredrawln(_para1:pWINDOW; _para2:longint; _para3:longint):longint; cdecl;external libncurses;
+ function wrefresh(_para1:pWINDOW):longint; cdecl;external libncurses;
+ {
+ extern int wscanw(WINDOW ,const char ,...)
+ GCC_SCANFLIKE(2,3);
+ }
+ function wscrl(_para1:pWINDOW; _para2:longint):longint; cdecl;external libncurses;
+ function wsetscrreg(_para1:pWINDOW; _para2:longint; _para3:longint):longint; cdecl;external libncurses;
+ procedure wsyncdown(_para1:pWINDOW);cdecl;external libncurses;
+ procedure wsyncup(_para1:pWINDOW);cdecl;external libncurses;
+ function wtimeout(_para1:pWINDOW; _para2:longint):longint; cdecl;external libncurses;
+ function wtouchln(_para1:pWINDOW; _para2:longint; _para3:longint; _para4:longint):longint; cdecl;external libncurses;
+ function wvline(_para1:pWINDOW; _para2:chtype; _para3:longint):longint; cdecl;external libncurses;
+ function mvwchgat(_para1:pWINDOW; _para2:longint; _para3:longint;
+ _para4:longint; _para5:longint; _para6:longint;
+ _para7:longint):longint;cdecl;external libncurses;
+ function PAIR_NUMBER(_para1:longint):longint;cdecl;external libncurses;
+
+ const
+ A_NORMAL = 0;
+ A_ATTRIBUTES = (not 0) shl 8;
+ A_CHARTEXT=(1 shl (0 + 8)) - 1;
+ A_COLOR=((1 shl 8) - 1) shl 8;
+ A_STANDOUT = 1 shl (8 + 8);
+ A_UNDERLINE = 1 shl (9 + 8);
+ A_REVERSE = 1 shl (10 + 8);
+ A_BLINK = 1 shl (11 + 8);
+ A_DIM = 1 shl (12 + 8);
+ A_BOLD = 1 shl (13 + 8);
+ A_ALTCHARSET = 1 shl (14 + 8);
+ A_INVIS = 1 shl (15 + 8);
+ A_PROTECT = 1 shl (16 + 8);
+ A_HORIZONTAL = 1 shl (17 + 8);
+ A_LEFT = 1 shl (18 + 8);
+ A_LOW = 1 shl (19 + 8);
+ A_RIGHT = 1 shl (20 + 8);
+ A_TOP = 1 shl (21 + 8);
+ A_VERTICAL = 1 shl (22 + 8);
+ function color_pair(n : longint): longint;
+{
+ PAIR_NUMBER = (a(@(A_COLOR))) shr 8;
+}
+
+ {
+ pseudo functions
+ }
+ function wgetstr(w : pwindow;s : pchar) : longint;
+ function getnstr(s : pchar;n : longint) : longint;
+ function setterm(term : longint) : longint;
+ function fixterm : longint;
+ function resetterm : longint;
+ function saveterm : longint;
+ function crmode : longint;
+ function nocrmode : longint;
+ procedure getyx (win : pwindow; var y,x : longint);
+ procedure getbegyx(win : pwindow; var y,x : longint);
+ procedure getmaxyx(win : pwindow; var y,x : longint);
+ procedure getparyx(win : pwindow; var y,x : longint);
+ procedure getsyx (var y,x : longint);
+ procedure setsyx (y,x : longint);
+ function getattrs(win : pwindow) : longint;
+ function getcurx(win : pwindow) : longint;
+ function getcury(win : pwindow) : longint;
+ function getbegx(win : pwindow) : longint;
+ function getbegy(win : pwindow) : longint;
+ function getmaxx(win : pwindow) : longint;
+ function getmaxy(win : pwindow) : longint;
+ function getparx(win : pwindow) : longint;
+ function getpary(win : pwindow) : longint;
+ function wstandout(win : pwindow) : longint;
+ function wstandend(win : pwindow) : longint;
+{kjw, 08/24/2000, changed to cdecl; external
+ function wattr_set(win : pwindow; at : longint) : longint;
+ function wattron(win : pwindow;at : longint) : longint;
+ function wattroff(win : pwindow;at : longint) : longint;
+ function wattrset(win : pwindow;at : longint) : longint;
+}
+ function scroll(win : pwindow) : longint;
+ function touchwin(win : pwindow) : longint;
+ function touchline(win : pwindow;s,c : longint) : longint;
+ function untouchwin(win : pwindow) : longint;
+ function box(win : pwindow;v,h : longint) : longint;
+ function border(ls,rs,ts,bs,tl,tr,bl,br : longint) : longint;
+ function hline(ch,n : longint) : longint;
+ function vline(ch,n : longint) : longint;
+ function winstr(w : pwindow;s : pchar) : longint;
+ function winchstr(w : pwindow;s : pchar) : longint;
+ function winsstr(w : pwindow;s : pchar) : longint;
+ function redrawwin(w : pwindow) : longint;
+ function waddstr(win : pwindow;st : pchar) : longint;
+ function waddchstr(win : pwindow;st : pchar) : longint;
+ {
+ pseudo functions for standard screen
+ }
+ function addch(ch : longint) : longint;
+ function addchnstr(st : pchar;n : longint) : longint;
+ function addchstr(st : pchar) : longint;
+ function addnstr(st : pchar;n : longint) : longint;
+ function addstr(st : pchar) : longint;
+ function attroff(at : longint) : longint;
+ function attron(at : longint) : longint;
+ function attrset(at : longint) : longint;
+ function bkgd(ch : longint) : longint;
+ procedure bkgdset(ch : longint);
+ function clear : longint;
+ function clrtobot : longint;
+ function clrtoeol : longint;
+ function delch : longint;
+ function deleteln : longint;
+ function echochar(c : longint) : longint;
+ function erase : longint;
+ function getch : longint;
+ function getstr(st : pchar) : longint;
+ function inch : longint;
+ function inchnstr(s : pchar;n : longint) : longint;
+ function inchstr(s : pchar) : longint;
+ function innstr(s : pchar;n : longint) : longint;
+ function insch(c : longint) : longint;
+ function insdelln(n : longint) : longint;
+ function insertln : longint;
+ function insnstr(s : pchar;n : longint) : longint;
+ function insstr(s : pchar) : longint;
+ function instr(s : pchar) : longint;
+ function move(y,x : longint) : longint;
+ function refresh : longint;
+ function scrl(n : longint) : longint;
+ function setscrreg(t,b : longint) : longint;
+ function standend : longint;
+ function standout : longint;
+ function timeout(delay : longint) : longint;
+ function wdeleteln(win : pwindow) : longint;
+ function winsertln(win : pwindow) : longint;
+ {
+ mv functions
+ }
+ function mvwaddch(win : pwindow;y,x : longint; ch : chtype) : longint;
+ function mvwaddchnstr(win : pwindow;y,x : longint;st : pchar;n : longint) : longint;
+ function mvwaddchstr(win : pwindow;y,x : longint;st : pchar) : longint;
+ function mvwaddnstr(win : pwindow;y,x : longint;st : pchar;n : longint) : longint;
+ function mvwaddstr(win : pwindow;y,x : longint;st : pchar) : longint;
+ function mvwdelch(win : pwindow;y,x : longint) : longint;
+ function mvwgetch(win : pwindow;y,x : longint) : longint;
+ function mvwgetnstr(win : pwindow;y,x : longint;st : pchar;n: longint) : longint;
+ function mvwgetstr(win : pwindow;y,x : longint;st: pchar) : longint;
+ function mvwhline(win : pwindow;y,x : longint;c : chtype;n : longint) : longint;
+ function mvwinch(win : pwindow;y,x : longint) : longint;
+ function mvwinchnstr(win : pwindow;y,x : longint;s : pchar; n : longint) : longint;
+ function mvwinchstr(win : pwindow;y,x : longint;s : pchar) : longint;
+ function mvwinnstr(win : pwindow;y,x : longint;s : pchar;n : longint) : longint;
+ function mvwinsch(win : pwindow;y,x : longint;c : chtype) : longint;
+ function mvwinsnstr(win : pwindow;y,x : longint;s : pchar;n : longint) : longint;
+ function mvwinsstr(win : pwindow;y,x : longint;s : pchar) : longint;
+ function mvwinstr(win : pwindow;y,x : longint;s : pchar) : longint;
+ function mvwvline(win : pwindow;y,x : longint;c : chtype;n : longint) : longint;
+ function mvaddch(y,x,ch : longint) : longint;
+ function mvaddchnstr(y,x : longint; st: pchar;n : longint) : longint;
+ function mvaddchstr(y,x : longint; st : pchar) : longint;
+ function mvaddnstr(y,x : longint; st : pchar;n : longint) : longint;
+ function mvaddstr(y,x : longint; st : pchar) : longint;
+ function mvdelch(y,x : longint) : longint;
+ function mvgetch(y,x : longint) : longint;
+ function mvgetnstr(y,x : longint; st : pchar;n : longint) : longint;
+ function mvgetstr(y,x : longint; st : pchar) : longint;
+ function mvhline(y,x : longint;c : chtype;n : longint) : longint;
+ function mvinch(y,x : longint) : longint;
+ function mvinchnstr(y,x : longint; s : pchar;n : longint) : longint;
+ function mvinchstr(y,x : longint; s : pchar) : longint;
+ function mvinnstr(y,x : longint; s : pchar;n : longint) : longint;
+ function mvinsch(y,x: longint;c : chtype) : longint;
+ function mvinsnstr(y,x : longint; s : pchar;n : longint) : longint;
+ function mvinsstr(y,x : longint; s : pchar) : longint;
+ function mvinstr(y,x : longint; s : pchar) : longint;
+ function mvvline(y,x,c,n : longint) : longint;
+ function attr_get : longint;
+ function attr_off(a : longint) : longint;
+ function attr_on(a : longint) : longint;
+ function attr_set(a : longint) : longint;
+ function chgat(n,a,c,o : longint) : longint;
+ function getbkgd(win : pwindow) : longint;
+ function slk_attr_off(a : longint) : longint;
+ function slk_attr_on(a : longint) : longint;
+ function slk_attr_set(a : longint) : longint;
+ function vid_attr(a : longint) : longint;
+ function wattr_get(win : pwindow) : longint;
+ {
+ Pseudo-character tokens outside ASCII range. The curses wgetch() function
+ will return any given one of these only if the corresponding k- capability
+ is defined in your terminal's terminfo entry.
+ }
+ const {octal}
+ KEY_CODE_YES = 256; {0400}
+ KEY_MIN = 257; {0401}
+ KEY_BREAK = 257; {0401}
+ KEY_DOWN = 258; {0402}
+ KEY_UP = 259; {0403}
+ KEY_LEFT = 260; {0404}
+ KEY_RIGHT = 261; {0405}
+ KEY_HOME = 262; {0406}
+ KEY_BACKSPACE = 263; {0407}
+ KEY_F0 = 264; {0410}
+
+ function KEY_F(n : longint) : longint;
+
+ const
+ KEY_DL = 328; {0510}
+ KEY_IL = 329; {0511}
+ KEY_DC = 330; {0512}
+ KEY_IC = 331; {0513}
+ KEY_EIC = 332; {0514}
+ KEY_CLEAR = 333; {0515}
+ KEY_EOS = 334; {0516}
+ KEY_EOL = 335; {0517}
+ KEY_SF = 336; {0520}
+ KEY_SR = 337; {0521}
+ KEY_NPAGE = 338; {0522}
+ KEY_PPAGE = 339; {0523}
+ KEY_STAB = 340; {0524}
+ KEY_CTAB = 341; {0525}
+ KEY_CATAB = 342; {0526}
+ KEY_ENTER = 343; {0527}
+ KEY_SRESET = 344; {0530}
+ KEY_RESET = 345; {0531}
+ KEY_PRINT = 346; {0532}
+ KEY_LL = 347; {0533}
+ KEY_A1 = 348; {0534}
+ KEY_A3 = 349; {0535}
+ KEY_B2 = 350; {0536}
+ KEY_C1 = 351; {0537}
+ KEY_C3 = 352; {0540}
+ KEY_BTAB = 353; {0541}
+ KEY_BEG = 354; {0542}
+ KEY_CANCEL = 355; {0543}
+ KEY_CLOSE = 356; {0544}
+ KEY_COMMAND = 357; {0545}
+ KEY_COPY = 358; {0546}
+ KEY_CREATE = 359; {0547}
+ KEY_END = 360; {0550}
+ KEY_EXIT = 361; {0551}
+ KEY_FIND = 362; {0552}
+ KEY_HELP = 363; {0553}
+ KEY_MARK = 364; {0554}
+ KEY_MESSAGE = 365; {0555}
+ KEY_MOVE = 366; {0556}
+ KEY_NEXT = 367; {0557}
+ KEY_OPEN = 368; {0560}
+ KEY_OPTIONS = 369; {0561}
+ KEY_PREVIOUS = 370; {0562}
+ KEY_REDO = 371; {0563}
+ KEY_REFERENCE = 372; {0564}
+ KEY_REFRESH = 373; {0565}
+ KEY_REPLACE = 374; {0566}
+ KEY_RESTART = 375; {0567}
+ KEY_RESUME = 376; {0570}
+ KEY_SAVE = 377; {0571}
+ KEY_SBEG = 378; {0572}
+ KEY_SCANCEL = 379; {0573}
+ KEY_SCOMMAND = 380; {0574}
+ KEY_SCOPY = 381; {0575}
+ KEY_SCREATE = 382; {0576}
+ KEY_SDC = 383; {0577}
+ KEY_SDL = 384; {0600}
+ KEY_SELECT = 385; {0601}
+ KEY_SEND = 386; {0602}
+ KEY_SEOL = 387; {0603}
+ KEY_SEXIT = 388; {0604}
+ KEY_SFIND = 389; {0605}
+ KEY_SHELP = 390; {0606}
+ KEY_SHOME = 391; {0607}
+ KEY_SIC = 392; {0610}
+ KEY_SLEFT = 393; {0611}
+ KEY_SMESSAGE = 394; {0612}
+ KEY_SMOVE = 395; {0613}
+ KEY_SNEXT = 396; {0614}
+ KEY_SOPTIONS = 397; {0615}
+ KEY_SPREVIOUS = 398; {0616}
+ KEY_SPRINT = 399; {0617}
+ KEY_SREDO = 400; {0620}
+ KEY_SREPLACE = 401; {0621}
+ KEY_SRIGHT = 402; {0622}
+ KEY_SRSUME = 403; {0623}
+ KEY_SSAVE = 404; {0624}
+ KEY_SSUSPEND = 405; {0625}
+ KEY_SUNDO = 406; {0626}
+ KEY_SUSPEND = 407; {0627}
+ KEY_UNDO = 408; {0630}
+ KEY_MOUSE = 409; {0631}
+ KEY_RESIZE = 410; {0632}
+ KEY_MAX = 511; {0777}
+
+ function mcprint(_para1:pchar; _para2:longint):longint;cdecl;external libncurses;
+ function has_key(_para1:longint):longint;cdecl;external libncurses;
+
+implementation
+
+function wgetstr(w : pwindow;s : pchar) : longint;
+begin
+ wgetstr:=wgetnstr(w,s,-(1));
+end;
+
+function getnstr(s : pchar;n : longint) : longint;
+begin
+ getnstr:=wgetnstr(stdscr,s,n);
+end;
+
+function setterm(term : longint) : longint;
+begin
+ {
+ setterm:=setupterm(term,1,plongint(0));
+ }
+ setterm:=0;
+end;
+
+function fixterm : longint;
+begin
+ fixterm:=reset_prog_mode;
+end;
+
+function resetterm : longint;
+begin
+ resetterm:=reset_shell_mode;
+end;
+
+function saveterm : longint;
+begin
+ saveterm:=def_prog_mode;
+end;
+
+function crmode : longint;
+begin
+ crmode:=cbreak;
+end;
+
+function nocrmode : longint;
+begin
+ nocrmode:=nocbreak;
+end;
+
+procedure getsyx(var y,x : longint);
+begin
+ getyx(stdscr,y,x);
+end;
+
+function getattrs(win : pwindow) : longint;
+var
+ if_local1 : longint;
+begin
+ if win<>nil then
+ if_local1:=win^._attrs
+ else
+ if_local1:=A_NORMAL;
+ getattrs:=if_local1;
+end;
+
+function getcurx(win : pwindow) : longint;
+var
+ if_local1 : longint;
+begin
+ if win<>nil then
+ if_local1:=win^._curx
+ else
+ if_local1:=ERR;
+ getcurx:=if_local1;
+end;
+
+function getcury(win : pwindow) : longint;
+var
+ if_local1 : longint;
+begin
+ if win<>Nil then
+ if_local1:=win^._cury
+ else
+ if_local1:=ERR;
+ getcury:=if_local1;
+end;
+function getbegx(win : pwindow) : longint;
+var
+ if_local1 : longint;
+
+begin
+ if win<>Nil then
+ if_local1:=win^._begx
+ else
+ if_local1:=ERR;
+ getbegx:=if_local1;
+end;
+
+function getbegy(win : pwindow) : longint;
+var
+ if_local1 : longint;
+begin
+ if win<>Nil then
+ if_local1:=win^._begy
+ else
+ if_local1:=ERR;
+ getbegy:=if_local1;
+end;
+
+function getmaxx(win : pwindow) : longint;
+var
+ if_local1 : longint;
+begin
+ if win<>Nil then
+ if_local1:=(win^._maxx) + 1
+ else
+ if_local1:=ERR;
+ getmaxx:=if_local1;
+end;
+
+function getmaxy(win : pwindow) : longint;
+var
+ if_local1 : longint;
+begin
+ if win<>Nil then
+ if_local1:=(win^._maxy) + 1
+ else
+ if_local1:=ERR;
+ getmaxy:=if_local1;
+end;
+
+function getparx(win : pwindow) : longint;
+var
+ if_local1 : longint;
+begin
+ if win<>Nil then
+ if_local1:=win^._parx
+ else
+ if_local1:=ERR;
+ getparx:=if_local1;
+end;
+
+function getpary(win : pwindow) : longint;
+var
+ if_local1 : longint;
+begin
+ if win<>Nil then
+ if_local1:=win^._pary
+ else
+ if_local1:=ERR;
+ getpary:=if_local1;
+end;
+
+function wstandout(win : pwindow) : longint;
+begin
+ wstandout:=wattr_set(win,A_STANDOUT);
+end;
+
+function wstandend(win : pwindow) : longint;
+begin
+ wstandend:=wattr_set(win,A_NORMAL);
+end;
+
+(*
+function wattron(win : pwindow;at : longint) : longint;
+begin
+ wattron:=wattr_on(win,at);
+end;
+
+function wattroff(win : pwindow;at : longint) : longint;
+begin
+ wattroff:=wattr_off(win,at);
+end;
+
+function wattrset(win : pwindow;at : longint) : longint;
+begin
+ wattrset:=wattr_set(win,at);
+end;
+*)
+function scroll(win : pwindow) : longint;
+begin
+ scroll:=wscrl(win,1);
+end;
+
+function touchwin(win : pwindow) : longint;
+begin
+ touchwin:=wtouchln(win,0,getmaxy(win),1);
+end;
+
+function touchline(win : pwindow;s,c : longint) : longint;
+begin
+ touchline:=wtouchln(win,s,c,1);
+end;
+
+function untouchwin(win : pwindow) : longint;
+begin
+ untouchwin:=wtouchln(win,0,getmaxy(win),0);
+end;
+
+function box(win : pwindow;v,h : longint) : longint;
+begin
+ box:=wborder(win,v,v,h,h,0,0,0,0);
+end;
+
+function border(ls,rs,ts,bs,tl,tr,bl,br : longint) : longint;
+begin
+ border:=wborder(stdscr,ls,rs,ts,bs,tl,tr,bl,br);
+end;
+
+function hline(ch,n : longint) : longint;
+begin
+ hline:=whline(stdscr,ch,n);
+end;
+
+function vline(ch,n : longint) : longint;
+begin
+ vline:=wvline(stdscr,ch,n);
+end;
+
+function winstr(w : pwindow;s : pchar) : longint;
+begin
+ winstr:=winnstr(w,s,-(1));
+end;
+
+function winchstr(w : pwindow;s : pchar) : longint;
+begin
+ winchstr:=winchnstr(w,s,-1);
+end;
+
+function winsstr(w : pwindow;s : pchar) : longint;
+begin
+ winsstr:=winsnstr(w,s,-(1));
+end;
+
+function redrawwin(w : pwindow) : longint;
+begin
+ redrawwin:=wredrawln(w,0,(w^._maxy) + 1);
+end;
+
+function waddstr(win : pwindow;st : pchar) : longint;
+begin
+ waddstr:=waddnstr(win,st,-1);
+end;
+
+function waddchstr(win : pwindow;st : pchar) : longint;
+begin
+ waddchstr:=waddchnstr(win,st,-1);
+end;
+
+function addch(ch : longint) : longint;
+begin
+ addch:=waddch(stdscr,ch);
+end;
+
+function addchnstr(st : pchar;n : longint) : longint;
+begin
+ addchnstr:=waddchnstr(stdscr,st,n);
+end;
+
+function addchstr(st : pchar) : longint;
+begin
+ addchstr:=waddchstr(stdscr,st);
+end;
+
+function addnstr(st : pchar;n : longint) : longint;
+begin
+ addnstr:=waddnstr(stdscr,st,n);
+end;
+
+function addstr(st : pchar) : longint;
+begin
+ addstr:=waddnstr(stdscr,st,-1);
+end;
+
+function attroff(at : longint) : longint;
+begin
+ attroff:=wattroff(stdscr,at);
+end;
+
+function attron(at : longint) : longint;
+begin
+ attron:=wattron(stdscr,at);
+end;
+
+function attrset(at : longint) : longint;
+begin
+ attrset:=wattrset(stdscr,at);
+end;
+
+function bkgd(ch : longint) : longint;
+begin
+ bkgd:=wbkgd(stdscr,ch);
+end;
+
+procedure bkgdset(ch : longint);
+begin
+ wbkgdset(stdscr,ch);
+end;
+
+function clear : longint;
+begin
+ clear:=wclear(stdscr);
+end;
+
+function clrtobot : longint;
+begin
+ clrtobot:=wclrtobot(stdscr);
+end;
+
+function clrtoeol : longint;
+begin
+ clrtoeol:=wclrtoeol(stdscr);
+end;
+
+function delch : longint;
+begin
+ delch:=wdelch(stdscr);
+end;
+
+function deleteln : longint;
+begin
+ deleteln:=winsdelln(stdscr,-1);
+end;
+
+function echochar(c : longint) : longint;
+begin
+ echochar:=wechochar(stdscr,c);
+end;
+
+function erase : longint;
+begin
+ erase:=werase(stdscr);
+end;
+
+function getch : longint;
+begin
+ getch:=wgetch(stdscr);
+end;
+
+function getstr(st : pchar) : longint;
+begin
+ getstr:=wgetstr(stdscr,st);
+end;
+
+function inch : longint;
+begin
+ inch:=winch(stdscr);
+end;
+
+function inchnstr(s : pchar;n : longint) : longint;
+begin
+ inchnstr:=winchnstr(stdscr,s,n);
+end;
+
+function inchstr(s : pchar) : longint;
+begin
+ inchstr:=winchstr(stdscr,s);
+end;
+
+function innstr(s : pchar;n : longint) : longint;
+begin
+ innstr:=winnstr(stdscr,s,n);
+end;
+
+function insch(c : longint) : longint;
+begin
+ insch:=winsch(stdscr,c);
+end;
+
+function insdelln(n : longint) : longint;
+begin
+ insdelln:=winsdelln(stdscr,n);
+end;
+
+function insertln : longint;
+begin
+ insertln:=winsdelln(stdscr,1);
+end;
+
+function insnstr(s : pchar;n : longint) : longint;
+begin
+ insnstr:=winsnstr(stdscr,s,n);
+end;
+
+function insstr(s : pchar) : longint;
+begin
+ insstr:=winsstr(stdscr,s);
+end;
+
+function instr(s : pchar) : longint;
+begin
+ instr:=winstr(stdscr,s);
+end;
+
+function move(y,x : longint) : longint;
+begin
+ move:=wmove(stdscr,y,x);
+end;
+
+function refresh : longint;
+begin
+ refresh:=wrefresh(stdscr);
+end;
+
+function scrl(n : longint) : longint;
+begin
+ scrl:=wscrl(stdscr,n);
+end;
+
+function setscrreg(t,b : longint) : longint;
+begin
+ setscrreg:=wsetscrreg(stdscr,t,b);
+end;
+
+function standend : longint;
+begin
+ standend:=wstandend(stdscr);
+end;
+
+function standout : longint;
+begin
+ standout:=wstandout(stdscr);
+end;
+
+function timeout(delay : longint) : longint;
+begin
+ timeout:=wtimeout(stdscr,delay);
+end;
+
+function wdeleteln(win : pwindow) : longint;
+begin
+ wdeleteln:=winsdelln(win,-1);
+end;
+
+function winsertln(win : pwindow) : longint;
+begin
+ winsertln:=winsdelln(win,1);
+end;
+
+function mvaddch(y,x,ch : longint) : longint;
+begin
+ mvaddch:=mvwaddch(stdscr,y,x,ch);
+end;
+
+function mvaddchnstr(y,x: longint;st : pchar;n : longint) : longint;
+begin
+ mvaddchnstr:=mvwaddchnstr(stdscr,y,x,st,n);
+end;
+
+function mvaddchstr(y,x : longint;st : pchar) : longint;
+begin
+ mvaddchstr:=mvwaddchstr(stdscr,y,x,st);
+end;
+
+function mvaddnstr(y,x: longint;st : pchar; n : longint) : longint;
+begin
+ mvaddnstr:=mvwaddnstr(stdscr,y,x,st,n);
+end;
+
+function mvaddstr(y,x : longint;st : pchar) : longint;
+begin
+ mvaddstr:=mvwaddstr(stdscr,y,x,st);
+end;
+
+function mvdelch(y,x : longint) : longint;
+begin
+ mvdelch:=mvwdelch(stdscr,y,x);
+end;
+
+function mvgetch(y,x : longint) : longint;
+begin
+ mvgetch:=mvwgetch(stdscr,y,x);
+end;
+
+function mvgetnstr(y,x : longint;st : pchar;n : longint) : longint;
+begin
+ mvgetnstr:=mvwgetnstr(stdscr,y,x,st,n);
+end;
+
+function mvgetstr(y,x: longint;st : pchar) : longint;
+begin
+ mvgetstr:=mvwgetstr(stdscr,y,x,st);
+end;
+
+function mvhline(y,x : longint;c : chtype;n : longint) : longint;
+begin
+ mvhline:=mvwhline(stdscr,y,x,c,n);
+end;
+
+function mvinch(y,x : longint) : longint;
+begin
+ mvinch:=mvwinch(stdscr,y,x);
+end;
+
+function mvinchnstr(y,x : longint;s : pchar;n : longint) : longint;
+begin
+ mvinchnstr:=mvwinchnstr(stdscr,y,x,s,n);
+end;
+
+function mvinchstr(y,x : longint;s : pchar) : longint;
+begin
+ mvinchstr:=mvwinchstr(stdscr,y,x,s);
+end;
+
+function mvinnstr(y,x : longint;s : pchar;n : longint) : longint;
+begin
+ mvinnstr:=mvwinnstr(stdscr,y,x,s,n);
+end;
+
+function mvinsch(y,x: longint;c : chtype) : longint;
+begin
+ mvinsch:=mvwinsch(stdscr,y,x,c);
+end;
+
+function mvinsnstr(y,x : longint;s : pchar;n : longint) : longint;
+begin
+ mvinsnstr:=mvwinsnstr(stdscr,y,x,s,n);
+end;
+
+function mvinsstr(y,x : longint;s : pchar) : longint;
+begin
+ mvinsstr:=mvwinsstr(stdscr,y,x,s);
+end;
+
+function mvinstr(y,x : longint;s : pchar) : longint;
+begin
+ mvinstr:=mvwinstr(stdscr,y,x,s);
+end;
+
+function mvvline(y,x,c,n : longint) : longint;
+begin
+ mvvline:=mvwvline(stdscr,y,x,c,n);
+end;
+
+function attr_get : longint;
+begin
+ attr_get:=wattr_get(stdscr);
+end;
+
+function attr_off(a : longint) : longint;
+begin
+ attr_off:=wattr_off(stdscr,a);
+end;
+
+function attr_on(a : longint) : longint;
+begin
+ attr_on:=wattr_on(stdscr,a);
+end;
+
+function attr_set(a : longint) : longint;
+begin
+ attr_set:=wattr_set(stdscr,a);
+end;
+
+function chgat(n,a,c,o : longint) : longint;
+begin
+ chgat:=wchgat(stdscr,n,a,c,pointer(ptrint(o)));
+end;
+
+function getbkgd(win : pwindow) : longint;
+begin
+ getbkgd:=win^._bkgd;
+end;
+
+function mvchgat(y,x,n,a,c,o : longint) : longint;
+begin
+ mvchgat:=mvwchgat(stdscr,y,x,n,a,c,o);
+end;
+
+function slk_attr_off(a : longint) : longint;
+begin
+ slk_attr_off:=slk_attroff(a);
+end;
+
+function slk_attr_on(a : longint) : longint;
+begin
+ slk_attr_on:=slk_attron(a);
+end;
+
+function slk_attr_set(a : longint) : longint;
+begin
+ slk_attr_set:=slk_attrset(a);
+end;
+
+function vid_attr(a : longint) : longint;
+begin
+ vid_attr:=vidattr(a);
+end;
+
+function wattr_get(win : pwindow) : longint;
+begin
+ wattr_get:=win^._attrs;
+end;
+
+function KEY_F(n : longint) : longint;
+begin
+ KEY_F:=KEY_F0 + n;
+end;
+
+procedure getyx(win : pwindow; var y,x : longint);
+begin
+ X:=ERR;
+ Y:=ERR;
+ if Win<>Nil then
+ begin
+ Y:=win^._cury;
+ X:=Win^._curx;
+ end;
+end;
+
+procedure getbegyx(win : pwindow; var y,x : longint);
+begin
+ X:=ERR;
+ Y:=ERR;
+ if Win<>Nil then
+ begin
+ Y:=win^._begy;
+ X:=Win^._begx;
+ end;
+end;
+
+procedure getmaxyx(win : pwindow; var y,x : longint);
+begin
+ X:=ERR;
+ Y:=ERR;
+ if Win<>Nil then
+ begin
+ Y:=win^._maxy+1;
+ X:=Win^._maxx+1;
+ end;
+end;
+
+procedure getparyx(win : pwindow; var y,x : longint);
+begin
+ X:=ERR;
+ Y:=ERR;
+ if Win<>Nil then
+ begin
+ Y:=win^._pary;
+ X:=Win^._parx;
+ end;
+end;
+(* kjw, 08/23/2000, external in v4.2
+function winch (win : PWindow) : longint;
+begin
+ if win<>nil then
+ winch:=win^._line[win^._cury].text[Win^ ._curx]
+ else
+ winch:=0;
+end;
+
+function wattr_set(win : pwindow; at : longint) : longint;
+begin
+ If win<>nil then
+ begin
+ win^._attrs := at;
+ wattr_set:=at;
+ end
+ else
+ wattr_set:=0;
+end;
+*)
+procedure setsyx (y,x : longint);
+begin
+ stdscr^._cury := y;
+ stdscr^._curx := x;
+end;
+
+function mvwaddch(win : pwindow;y,x : longint; ch : chtype) : longint;
+begin
+ if wmove(win,y,x) = ERR then
+ exit(ERR)
+ else
+ exit(waddch(win,ch))
+end;
+
+function mvwaddchnstr(win : pwindow;y,x : longint;st : pchar;n : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(waddchnstr(win,st,n))
+end;
+
+function mvwaddchstr(win : pwindow;y,x : longint;st : pchar) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(waddchnstr(win,st,-1))
+end;
+
+function mvwaddnstr(win : pwindow;y,x : longint;st : pchar;n : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(waddnstr(win,st,n))
+end;
+
+function mvwaddstr(win : pwindow;y,x : longint;st : pchar) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(waddnstr(win,st,-1))
+end;
+
+function mvwdelch(win : pwindow;y,x : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(wdelch(win))
+end;
+
+function mvwgetch(win : pwindow;y,x : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(wgetch(win))
+end;
+
+function mvwgetnstr(win : pwindow;y,x : longint;st : pchar;n: longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(wgetnstr(win,st,n))
+end;
+
+function mvwgetstr(win : pwindow;y,x : longint;st: pchar) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(wgetstr(win,st))
+end;
+
+function mvwhline(win : pwindow;y,x : longint;c : chtype;n : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(whline(win,c,n))
+end;
+
+function mvwinch(win : pwindow;y,x : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(winch(win))
+end;
+
+function mvwinchnstr(win : pwindow;y,x : longint;s : pchar; n : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(winchnstr(win,s,n))
+end;
+
+function mvwinchstr(win : pwindow;y,x : longint;s : pchar) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(winchstr(win,s))
+end;
+
+function mvwinnstr(win : pwindow;y,x : longint;s : pchar;n : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(winnstr(win,s,n))
+end;
+
+function mvwinsch(win : pwindow;y,x : longint;c : chtype) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(winsch(win,c))
+end;
+
+function mvwinsnstr(win : pwindow;y,x : longint;s : pchar;n : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(winsnstr(win,s,n))
+end;
+
+function mvwinsstr(win : pwindow;y,x : longint;s : pchar) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(winsstr(win,s))
+end;
+
+function mvwinstr(win : pwindow;y,x : longint;s : pchar) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(winstr(win,s))
+end;
+
+function mvwvline(win : pwindow;y,x : longint;c : chtype;n : longint) : longint;
+begin
+ if wmove (win,y,x)=ERR then
+ exit(ERR)
+ else
+ exit(wvline(win,c,n))
+end;
+
+function color_pair(n : longint): longint;
+begin
+ color_pair:=n shl 8;
+end;
+
+function ACS_ULCORNER : chtype;
+begin
+ ACS_ULCORNER:=acs_map['l'];
+end;
+
+function ACS_LLCORNER : chtype;
+begin
+ ACS_LLCORNER:=acs_map['m'];
+end;
+
+function ACS_URCORNER : chtype;
+begin
+ ACS_URCORNER:=acs_map['k'];
+end;
+
+function ACS_LRCORNER : chtype;
+begin
+ ACS_LRCORNER:=acs_map['j'];
+end;
+
+function ACS_LTEE : chtype;
+begin
+ ACS_LTEE:=acs_map['t'];
+end;
+
+function ACS_RTEE : chtype;
+begin
+ ACS_RTEE:=acs_map['u'];
+end;
+
+function ACS_BTEE : chtype;
+begin
+ ACS_BTEE:=acs_map['v'];
+end;
+
+function ACS_TTEE : chtype;
+begin
+ ACS_TTEE:=acs_map['w'];
+end;
+
+function ACS_HLINE : chtype;
+begin
+ ACS_HLINE:=acs_map['q'];
+end;
+
+function ACS_VLINE : chtype;
+begin
+ ACS_VLINE:=acs_map['x'];
+end;
+
+function ACS_PLUS : chtype;
+begin
+ ACS_PLUS:=acs_map['n'];
+end;
+
+function ACS_S1 : chtype;
+begin
+ ACS_S1 :=acs_map['o'];
+end;
+
+function ACS_S9 : chtype;
+begin
+ ACS_S9 :=acs_map['s'];
+end;
+
+function ACS_DIAMOND : chtype;
+begin
+ ACS_DIAMOND:=acs_map['`'];
+end;
+
+function ACS_CKBOARD : chtype;
+begin
+ ACS_CKBOARD:=acs_map['a'];
+end;
+
+function ACS_DEGREE : chtype;
+begin
+ ACS_DEGREE:=acs_map['f'];
+end;
+
+function ACS_PLMINUS : chtype;
+begin
+ ACS_PLMINUS:=acs_map['g'];
+end;
+
+function ACS_BULLET : chtype;
+begin
+ ACS_BULLET:=acs_map['~'];
+end;
+
+function ACS_LARROW : chtype;
+begin
+ ACS_LARROW:=acs_map[','];
+end;
+
+function ACS_RARROW : chtype;
+begin
+ ACS_RARROW:=acs_map['+'];
+end;
+
+function ACS_DARROW : chtype;
+begin
+ ACS_DARROW:=acs_map['.'];
+end;
+
+function ACS_UARROW : chtype;
+begin
+ ACS_UARROW:=acs_map['-'];
+end;
+
+function ACS_BOARD : chtype;
+begin
+ ACS_BOARD:=acs_map['h'];
+end;
+
+function ACS_LANTERN : chtype;
+begin
+ ACS_LANTERN:=acs_map['i'];
+end;
+
+function ACS_BLOCK : chtype;
+begin
+ ACS_BLOCK:=acs_map['0'];
+end;
+
+function ACS_S3 : chtype;
+begin
+ ACS_S3 :=acs_map['p'];
+end;
+
+function ACS_S7 : chtype;
+begin
+ ACS_S7 :=acs_map['r'];
+end;
+
+function ACS_LEQUAL : chtype;
+begin
+ ACS_LEQUAL:=acs_map['y'];
+end;
+
+function ACS_GEQUAL : chtype;
+begin
+ ACS_GEQUAL:=acs_map['z'];
+end;
+
+function ACS_PI : chtype;
+begin
+ ACS_PI :=acs_map['{'];
+end;
+
+function ACS_NEQUAL : chtype;
+begin
+ ACS_NEQUAL:=acs_map['|'];
+end;
+
+function ACS_STERLING : chtype;
+begin
+ ACS_STERLING:=acs_map['}'];
+end;
+
+end.
diff --git a/packages/ncurses/src/ocrt.pp b/packages/ncurses/src/ocrt.pp
new file mode 100644
index 0000000000..eb24313626
--- /dev/null
+++ b/packages/ncurses/src/ocrt.pp
@@ -0,0 +1,3266 @@
+Unit oCrt;
+{---------------------------------------------------------------------------
+ CncWare
+ (c) Copyright 1999-2000
+ ---------------------------------------------------------------------------
+ Filename..: ocrt.pp
+ Programmer: Ken J. Wright, ken@cncware.com
+ Date......: 03/01/99
+
+ Purpose - crt unit replacement plus OOP windows using ncurses.
+
+ NOTE: All of the crt procedures & functions have been replaced with ncurses
+ driven versions. This makes the ncurses library a little easier to use in a
+ Pascal program and benefits from terminal independence.
+
+-------------------------------<< REVISIONS >>--------------------------------
+ Ver | Date | Prog| Description
+-------+----------+-----+-----------------------------------------------------
+ 1.00 | 03/01/99 | kjw | Initial Release.
+ | 03/22/99 | kjw | Added nDelWindow(), delwin() does not nil pointer.
+ 1.01 | 11/22/99 | kjw | Added the following: nEcho, ClrEol, ClrBot, InsLine,
+ | DelLine, Delay, nClrEol, nClrBot, nInsLine, nDelLine,
+ | nRefresh, nScroll, nDrawBox, nNewWindow, nWinColor,
+ | nWriteScr, nFrame & some functions for returning
+ | line drawing character values.
+ 1.02 | 11/26/99 | kjw | Added nKeypressed().
+ 1.03 | 12/01/99 | kjw | Added global boolean nIsActive.
+ 1.04 | 12/03/99 | kjw | 1) Added procedures nHline, nVLine, & nWriteAC.
+ | 2) Changed all the line draw character functions
+ | (i.e., nHL, nVL) to return the longint value from
+ | ncurses rather than the character value (which was
+ | not very useful!). Now these can be passed to
+ | nWriteAC() to correctly write the line drawing
+ | characters.
+ | 3) Added more of the ACS characters.
+ 1.05 | 12/08/99 | kjw | 1) StartCurses() is now done as part of the unit
+ | initialization block. EndCurses() is done via an
+ | exit procedure.
+ | 2) nIsActive is now a function (safer!).
+ | 3) Added panel unit for windowing.
+ | 4) Added tnWindow object.
+ 1.10 | 12/12/99 | kjw | Added nSEdit().
+ 1.11 | 12/12/99 | kjw | Added Special property to tEC object. Now any normal
+ | character can trigger sedit to exit.
+------------------------------------------------------------------------------
+ 2.00 | 12/13/99 | kjw | nCrt renamed to oCrt. A new nCrt has been created
+ | which is a drop-in replacement for the FPC crt unit.
+ | oCrt contains all of nCrt plus the OOP extensions.
+ | All of the common code is in ncrt.inc.
+ 2.01 | 12/15/99 | kjw | 1) A tnWindow object now becomes the target for
+ | stdout following Init & Show. A Hide will put the
+ | target back to stdscr.
+ | 2) Added nSetActiveWin() to manually pick a target
+ | window for stdout.
+ 2.02 | 12/15/99 | kjw | 1) PutFrame applied keypad to stdscr instead of sub.
+ | 2) See ncrt.inc
+ 2.03 | 12/16/99 | kjw | 1) See ncrt.inc
+ | 2) Added shift/f-key constants.
+ 2.04 | 01/04/00 | kjw | See ncrt.inc
+ 2.05 | 01/06/00 | kjw | 1) See ncrt.inc.
+ | 2) Added boolean internal_fwrite. FWrite was failing
+ | when trying to write outside of the active window.
+ | 3) nSEdit was not handling tec.firsttime correctly
+ | when a tec.special was processed.
+ 2.06 | 01/11/00 | kjw | See ncrt.inc.
+ 2.07 | 01/31/00 | kjw | 1) See ncrt.inc.
+ | 2) Added getcolor, getframecolor, getheadercolor
+ | methods to tnWindow.
+ 2.08 | 06/09/00 | kjw | 1) Added Picture property to tEC object. This is
+ | used for picture input masking in nSEdit.
+ | 2) Added nCheckPxPicture() function.
+ | 3) nSEdit() changed to use picture input masking.
+ | See pxpic.txt for a description of the picture
+ | string format.
+
+ 2.08.01 | 06/11/2000 | kjw
+ | Fixed the spin cycle problem in nCheckPXPicture.
+ 2.09.00 | 06/16/2000 | kjw
+ | 1) nSEdit renamed to nEdit. Now nSEdit just calls nEdit() for
+ | compatibility.
+ | 2) Added overloaded nEdit functions for Integer, LongInt, and
+ | Real types.
+ | 3) Changed nEdit() embedding of control characters to preface
+ | with a ^P. Also now uses a highlight attribute for the control
+ | characters.
+ | 4) Added control character cursor control to nEdit().
+ | 5) Added Esc/1..0 = F1..F10 to nEdit().
+ | 6) Added '@' to match set in pxpic.inc.
+ | 7) tnWindow.Align was not positioning properly. Off by one.
+ | 8) tnWindow.Init used wrong pointer for keypad and intrflush.
+ | 9) tnWindow.Edit was messing up ec.Special.
+ 2.09.01 | 06/16/2000 | kjw
+ | 1) nStdScr (tnWindow) added and initialized at unit startup.
+ | nStdScr can be used for a default full screen window.
+ | 2) nEdit overloaded to work without a window pointer. It works
+ | with the currently active window.
+ 2.10.00 | 06/23/2000 | kjw
+ | 1) Added character mapping to the tEC object. This includes the
+ | ChMap property and the AddChMap() and ClrChMap() methods.
+ | 2) Added AppendMode property to the tEC object. The character
+ | typed in nEdit() is always appended to the current string
+ | regardless of cursor position. Useful when ExitMode is true.
+ | 3) tnWindow.Done was not re-assigning an ActiveWn.
+ | 4) nEdit LeftArrow was allowing < x.
+ | 5) Added nEditNumber() function.
+ | 6) Added nEditDate() function.
+ | 7) I made a command decision and renamed the tEC.FirstTime
+ | property to tEC.ClearMode as it is more descriptive.
+ 2.11.00 | 1) Cleaned up some loose ends with 2.10.
+ | 2) Some more overloading
+ | 3) Removed tnWindow.readln, write, and writeln methods.
+ | 4) See ncrt.inc.
+ 2.12.00 | 1) Remove the "n" from the tnWindow.editxxx functions for
+ | consistancy. Procedurals are prefaced with an "n". Object methods
+ | are not.
+ | 2) Procedural FWrite renamed to nFWrite.
+ | 3) tEC object type renamed to tnEC.
+ | 4) Added nMakeWindow(), a one line procedural wrapper for
+ | tnWindow.Init and tnWindow.PutHeader.
+ | 5) Added GetX, GetY, IsFramed methods to tnWindow;
+ | 6) Fixed nFWrite for too long strings;
+ | 7) tnWindow.Align was wrong when justify was none.
+ 2.13.00 | 06/30/00 | kjw | See ncrt.inc
+ 2.14.00 | 07/05/00 | kjw | See ncrt.inc
+ 2.15.00 | 07/12/00 | kjw |
+ | 1) Renamed IsBold to nIsBold. Renamed SetColorPair to nSetColorPair.
+ | 2) Added tnMenu object (not functional);
+ | 07/17/00 | kjw |
+ | 2) Argh!! Align method had another mistake. Changed x/y=1 to =0.
+ | 3) Added nShowMessage() function.
+ | 4) tnMenu is now minimally functional.
+ | 07/25/00 | kjw |
+ | 1) tnMenu fully functional for current level.
+ 2.16.00 | 08/14/2000 | kjw |
+ | 1) Added Get/SetMark(), IsActive(), IsValid(), IsAssigned(),
+ | SetIndex() to tnMenu.
+ | 08/18/2000 | kjw |
+ | 1) Added nkXXX constants for all(?) extended keys.
+ | 2) Changed all uses of extended keys to use new nkXXX's.
+ | 3) Edit overloaded to return a nkXXX in ch rather that a char.
+ | 4) Resize method added to tnWindow.
+ | 5) AddChMap overloaded for preferred (easier) use with nkXXX's.
+ | 08/24/2000 | kjw |
+ | 1) Added nReadScr, nReadScrStr, nReadScrColor, nWriteScrStr,
+ | nGrabScreen, nPopScreen, nReleaseScreen.
+ | 2) Fixed some trouble with PrevWn accuracy.
+------------------------------------------------------------------------------
+}
+Interface
+
+Uses
+{$ifdef unix}
+ baseunix,
+ termio,
+{$endif}
+ ncurses,panel,menu,
+ dos; {dos needed for TextRec}
+
+Const
+
+ { decimal number format, us or european }
+ nUS = 0;
+ nEURO = 1;
+ nDecFmt : byte = nUS;
+
+ { border styles for text boxes }
+ btNone : integer = 0;
+ btSingle : integer = 1;
+ btDouble : integer = 2;
+
+ { ordinal keycodes, new style, preferred }
+ nkEnter = 13; { Enter key }
+ nkEsc = 27; { Home key }
+ nkHome = -71; { Home key }
+ nkUp = -72; { Up arrow }
+ nkPgUp = -73; { PgUp key }
+ nkLeft = -75; { Left arrow }
+ nkRight = -77; { Right arrow }
+ nkEnd = -79; { End key }
+ nkDown = -80; { Down arrow }
+ nkPgDn = -81; { PgDn key }
+ nkIns = -82; { Insert key }
+ nkDel = -83; { Delete key }
+ nkCtrlLeft = -115; { Ctrl/left arrow }
+ nkCtrlRight = -116; { Ctrl/right arrow }
+ nkF1 = -59; { f1 key }
+ nkF2 = -60; { f2 key }
+ nkF3 = -61; { f3 key }
+ nkF4 = -62; { f4 key }
+ nkF5 = -63; { f5 key }
+ nkF6 = -64; { f6 key }
+ nkF7 = -65; { f7 key }
+ nkF8 = -66; { f8 key }
+ nkF9 = -67; { f9 key }
+ nkF10 = -68; { f10 key }
+ nkF11 = -84; { shift/f1 key }
+ nkF12 = -85; { shift/f2 key }
+ nkF13 = -86; { shift/f3 key }
+ nkF14 = -87; { shift/f4 key }
+ nkF15 = -88; { shift/f5 key }
+ nkF16 = -89; { shift/f6 key }
+ nkF17 = -90; { shift/f7 key }
+ nkF18 = -91; { shift/f8 key }
+ nkF19 = -92; { shift/f9 key }
+ nkF20 = -93; { shift/f10 key }
+ nkAltA = -30; { alt/a }
+ nkAltB = -48; { alt/b }
+ nkAltC = -46; { alt/c }
+ nkAltD = -32; { alt/d }
+ nkAltE = -18; { alt/e }
+ nkAltF = -33; { alt/f }
+ nkAltG = -34; { alt/g }
+ nkAltH = -35; { alt/h }
+ nkAltI = -23; { alt/i }
+ nkAltJ = -36; { alt/j }
+ nkAltK = -37; { alt/k }
+ nkAltL = -38; { alt/l }
+ nkAltM = -50; { alt/m }
+ nkAltN = -49; { alt/n }
+ nkAltO = -24; { alt/o }
+ nkAltP = -25; { alt/p }
+ nkAltQ = -16; { alt/q }
+ nkAltR = -19; { alt/r }
+ nkAltS = -31; { alt/s }
+ nkAltT = -20; { alt/t }
+ nkAltU = -22; { alt/u }
+ nkAltV = -47; { alt/v }
+ nkAltW = -17; { alt/w }
+ nkAltX = -45; { alt/x }
+ nkAltY = -21; { alt/y }
+ nkAltZ = -44; { alt/z }
+ nkAlt1 = -120; { alt/1 }
+ nkAlt2 = -121; { alt/2 }
+ nkAlt3 = -122; { alt/3 }
+ nkAlt4 = -123; { alt/4 }
+ nkAlt5 = -124; { alt/5 }
+ nkAlt6 = -125; { alt/6 }
+ nkAlt7 = -126; { alt/7 }
+ nkAlt8 = -127; { alt/8 }
+ nkAlt9 = -128; { alt/9 }
+ nkAlt0 = -129; { alt/0 }
+ nkAltMinus = -130; { alt/- }
+ nkAltEqual = -131; { alt/= }
+ nkAltTab = -15; { alt/tab }
+
+ { ordinal key codes (old style, don't break any apps!) }
+ nKeyEnter = nkEnter;
+ nKeyEsc = nkEsc;
+ nKeyHome = abs(nkHome);
+ nKeyUp = abs(nkUp);
+ nKeyPgUp = abs(nkPgUp);
+ nKeyLeft = abs(nkLeft);
+ nKeyRight = abs(nkRight);
+ nKeyEnd = abs(nkEnd);
+ nKeyDown = abs(nkDown);
+ nKeyPgDn = abs(nkPgDn);
+ nKeyIns = abs(nkIns);
+ nKeyDel = abs(nkDel);
+ nKeyCtrlLeft = abs(nkCtrlLeft);
+ nKeyCtrlRight = abs(nkCtrlRight);
+ nKeyF1 = abs(nkF1);
+ nKeyF2 = abs(nkF2);
+ nKeyF3 = abs(nkF3);
+ nKeyF4 = abs(nkF4);
+ nKeyF5 = abs(nkF5);
+ nKeyF6 = abs(nkF6);
+ nKeyF7 = abs(nkF7);
+ nKeyF8 = abs(nkF8);
+ nKeyF9 = abs(nkF9);
+ nKeyF10 = abs(nkF10);
+ nKeyF11 = abs(nkF11);
+ nKeyF12 = abs(nkF12);
+ nKeyF13 = abs(nkF13);
+ nKeyF14 = abs(nkF14);
+ nKeyF15 = abs(nkF15);
+ nKeyF16 = abs(nkF16);
+ nKeyF17 = abs(nkF17);
+ nKeyF18 = abs(nkF18);
+ nKeyF19 = abs(nkF19);
+ nKeyF20 = abs(nkF20);
+
+ { character mapping }
+ nMaxChMaps = 255; { maximun index for character mapping }
+
+ { menus }
+ nMAXMENUITEMS = 100;
+
+Type
+ {*** structures to save a screen via nGrabScreen ***}
+ pnOneRow = pchar;
+ { a buffer for a max of 256 chtype items accessed via pchar }
+ tnOneRow = array [0..1023] of char;
+ { a one way linked list of screen rows }
+ pnRowBuf = ^tnRowBuf;
+ tnRowBuf = Record
+ row : pnOneRow; { one row of a screen }
+ next : pnRowBuf; { next row in the list }
+ End;
+ { the header record of a saved screen }
+ pnScreenBuf = ^tnScreenBuf;
+ tnScreenBuf = Record
+ x, { column origin }
+ y, { row origin }
+ n : integer; { number of columns }
+ first : pnRowBuf; { pointer to first row in list }
+ End;
+
+ tnS10 = string[10];
+
+ { for scrolling a window }
+ tnUpDown = (up,down);
+ { for window & header positioning }
+ tnJustify = (none,left,center,right,top,bottom);
+ { used for nEC character mapping }
+ (********* Note : these are obsolete *******)
+ nChMapStr = string[4];
+ {nChMap = array [1..nMaxChMaps] of nChMapStr;}
+ (*******************************************)
+ nChMap = array [1..nMaxChMaps,1..2] of integer;
+
+ { used for nSEdit }
+ {------------------------------------------------------------------------
+ ClearMode = true : passed string is initialized to ''.
+ IsHidden = true : causes a string of '*' to display in place of
+ the actual characters typed.
+ InsMode : toggle for insert/overwrite mode.
+ ExitMode = true : sedit exits after every keystroke.
+ = false: sedit only exits when #27,#13, or any extended
+ key *except* for Home,End,RArrow,LArrow.
+ Special : If a pressed key is found in this string, then
+ sedit exits without processing.
+ Picture : An input mask string. See pxpic.txt for an
+ explanation of picture strings.
+ CtrlColor : The highlight color for embedded control characters.
+ ChMap : An array of character triplets describing a character
+ that is typed and what it should map to.
+ ------------------------------------------------------------------------}
+ tnEC = Object
+ ClearMode,
+ IsHidden,
+ InsMode,
+ ExitMode,
+ AppendMode : boolean;
+ Special : string;
+ Picture : string;
+ CtrlColor : integer;
+ ChMap : nChMap;
+ Constructor Init(ft,ih,im,em,ap : boolean;
+ s,p : string;
+ cc : integer;
+ mp : nChMap);
+ Destructor Done;
+ Function AddChMap(_in,_out : integer) : integer;
+ Function AddChMap(mp : nChMapStr) : integer;
+ Procedure ClrChMap(idx : integer);
+ End;
+
+ pwin = ^Window;
+
+ pnWindow = ^tnWindow;
+ tnWindow = Object
+ Private
+ wn : pwindow; { pointer to win or sub to read/write to }
+ win : pwindow; { pointer to main window record }
+ sub : pwindow; { sub window if a bordered window }
+ pan : ppanel; { pointer to panel record }
+ subp : ppanel; { sub panel if a bordered window }
+ visible : boolean; { is the window visible? }
+ hasframe : boolean;
+ wincolor, { window color }
+ framecolor, { frame color }
+ hdrcolor : integer; { header color }
+ hdrpos : tnJustify; { header alignment }
+ header : string[80]; { header string }
+ Procedure init_wins(x,y,x1,y1 : integer);
+ Procedure done_wins;
+ Public
+ data : pointer; { a pointer to user defined data }
+ ec : tnEC; { edit control settings }
+ Constructor Init(x,y,x1,y1,wcolor : integer;
+ border : boolean;
+ fcolor : integer);
+ Destructor Done;
+ Procedure Resize(cols_,rows_ : integer);
+ Procedure Active; { make this the current window }
+ Procedure Show; { display the window }
+ Procedure Hide; { hide the window }
+ Procedure ClrScr;
+ Procedure ClrEol;
+ Procedure ClrBot;
+ Procedure InsLine;
+ Procedure DelLine;
+ Procedure GotoXY(x,y : integer);
+ Function WhereX : integer;
+ Function WhereY : integer;
+ Function ReadKey : char;
+ Procedure WriteAC(x,y,att,c : longint);
+ Procedure FWrite(x,y,att,z : integer; s : string);
+ Procedure DrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
+ Function GetHeader : string;
+ Procedure PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
+ Procedure SetColor(att : integer);
+ Function GetColor : integer;
+ Function GetFrameColor : integer;
+ Function GetHeaderColor : integer;
+ Procedure PutFrame(att : integer);
+ Procedure Move(x,y : integer);
+ Procedure Scroll(ln : integer; dir : tnUpDown);
+ Procedure Align(hpos,vpos : tnJustify);
+ Function Rows : integer;
+ Function Cols : integer;
+ Function GetX : integer;
+ Function GetY : integer;
+ Function IsFramed : boolean;
+ Function IsVisible : Boolean;
+ Function Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : integer) : String;
+ Function Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : integer) : LongInt;
+ Function Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : integer) : Real;
+ Function Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
+ Function Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
+ Function Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
+ Function EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
+ Function EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
+ Function EditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
+ End;
+
+ pnMenuStr = ^tnMenuStr;
+ tnMenuStr = array [0..79] of char; { storage for menu item text }
+ pnMenu = ^tnMenu;
+ tnMenu = Object
+ Private
+ tc, { text (item) color }
+ cc, { cursor (current item) color }
+ fc, { frame color }
+ hc, { header Color }
+ gc, { non-selectable color }
+ x,y, { top,left corner of window }
+ r,c, { how many rows & columns of items to display }
+ wid, { minimum window width }
+ iidx, { item index }
+ merr { menu error code }
+ : integer;
+ loopon,
+ framed,
+ posted : boolean; { is the menu posted? }
+ mark : tnS10;
+ items : array[1..nMAXMENUITEMS] of pnMenuStr;
+ pi : array[1..nMAXMENUITEMS] of pItem;
+ pm : pMenu;
+ win : pnWindow;
+ Procedure InitWin;
+ Procedure ClearItem(idx : integer);
+ Procedure AddItem(i : integer; s : string);
+ Function Selectable(idx : integer) : boolean;
+ Function IsValid(idx : integer) : boolean;
+ Public
+ Constructor Init(_x,_y,_w,_r,_c,_tc,_cc,_gc : integer;
+ _fr : boolean; _fc : integer);
+ Destructor Done;
+ Procedure Post; { create the menu of current items }
+ Procedure UnPost; { unbind the items and free the menu }
+ Procedure Start; { start user input, includes show }
+ Procedure Stop; { a shortcut for hide,unpost }
+ Procedure Show; { display the menu, includes post }
+ Procedure Hide; { remove the menu from the display }
+ Function Wind : pnWindow; { pointer to the window object }
+ Procedure Move(_x,_y : integer); { shortcut window move }
+ Procedure Align(hpos,vpos : tnJustify);{ shortcut window align }
+ Procedure PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
+ Procedure Clear; { unpost and clear the menu item list }
+ Function Add(s : string) : integer; { append a menu item }
+ Procedure Insert(idx : integer; s : string); { insert a menu item }
+ Procedure Remove(idx : integer); { delete a menu item }
+ Procedure Change(idx : integer; s : string); { change an item }
+ Procedure Active(idx : integer; b : boolean); { toggle gray }
+ Function IsActive(idx : integer) : boolean; { item active ? }
+ Procedure Spin(b : boolean);{ toggle item looping }
+ Function Status : integer;{ return the current error/status code }
+ Function Index : integer; { return the current item index }
+ Procedure SetIndex(idx : integer); { set the item index }
+ Function Count : integer; { number of items in the menu }
+ Function Rows(_r : integer) : integer; {get/set menu rows }
+ Function Cols(_c : integer) : integer; {get/set menu columns }
+ Function IsAssigned(idx : integer) : boolean; { valid & assigned }
+ Function GetMark : string; { return the item mark string }
+ Procedure SetMark(ms : string); { set the mark string }
+ Procedure Refresh;
+ Procedure SetColor(att : byte); { change text color }
+ Procedure SetCursorColor(att : byte); { change cursor color }
+ Procedure SetFrameColor(att : byte); { change frame color }
+ Procedure SetGrayColor(att : byte); { change inactive color }
+ End;
+
+Var
+ nStdScr : tnWindow; { default window created at unit initialization }
+ nscreen : pwin; { pointer to ncurses stdscr }
+ nEC : tnEC; { global edit control object }
+
+Procedure nSetActiveWin(win : pwindow);
+Procedure nDoNow(donow : boolean);
+ Function nKeypressed(timeout : word) : boolean;
+Procedure nEcho(b : boolean);
+Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
+Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
+Procedure nDelWindow(var win : pWindow);
+Procedure nWinColor(win : pWindow; att : integer);
+Procedure nClrScr(win : pWindow; att : integer);
+Procedure nClrEol(win : pWindow);
+Procedure nClrBot(win : pWindow);
+Procedure nInsLine(win : pWindow);
+Procedure nDelLine(win : pWindow);
+Procedure nGotoXY(win : pWindow; x,y : integer);
+ Function nWhereX(win : pWindow) : integer;
+ Function nWhereY(win : pWindow) : integer;
+ Function nReadkey(win : pWindow) : char;
+ Function nReadln(win : pWindow) : string;
+Procedure nWrite(win : pWindow; s : string);
+Procedure nWriteln(win : pWindow; s : string);
+Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
+Procedure nRefresh(win : pWindow);
+Procedure nScroll(win : pWindow; lines : integer; dir : tnUpDown);
+Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer);
+Procedure nFrame(win : pWindow);
+ Function nRows(win : pWindow) : integer;
+ Function nCols(win : pWindow) : integer;
+ Function nHL : longint; { horizontal line }
+ Function nVL : longint; { vertical line }
+ Function nUL : longint; { upper left corner }
+ Function nLL : longint; { lower loft corner }
+ Function nUR : longint; { upper right corner }
+ Function nLR : longint; { lower right corner }
+ Function nLT : longint; { left tee }
+ Function nRT : longint; { right tee }
+ Function nTT : longint; { top tee }
+ Function nBT : longint; { bottom tee }
+ Function nPL : longint; { plus, + }
+ Function nLA : longint; { left arrow }
+ Function nRA : longint; { right arrow }
+ Function nUA : longint; { up arror }
+ Function nDA : longint; { down arrow }
+ Function nDI : longint; { diamond }
+ Function nCB : longint; { checkerboard }
+ Function nDG : longint; { degree }
+ Function nPM : longint; { plus/minus }
+ Function nBL : longint; { bullet }
+Procedure nHLine(win : pwindow; col,row,attr,x : integer);
+Procedure nVLine(win : pwindow; col,row,attr,y : integer);
+Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint);
+ Function nIsBold(att : integer) : boolean;
+ Function nSetColorPair(att : integer) : integer;
+Procedure nFWrite(win : pwindow; col,row,attrib : integer; clear : integer; s : string);
+Procedure nFWrite(col,row,attrib : integer; clear : integer; s : string);
+ Function nSEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
+ Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
+ Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
+ Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
+ Function nEdit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
+ Function nEdit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
+ Function nEdit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
+ Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var chv : integer) : String;
+ Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:LongInt;Var ch : integer) : LongInt;
+ Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:Real;Var ch : integer) : Real;
+ Function nEdit(x,y,att,z,CursPos:Integer;es:String;Var ch : integer) : String;
+ Function nEdit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : integer) : LongInt;
+ Function nEdit(x,y,att,z,CursPos:Integer;es:Real;Var ch : integer) : Real;
+ Function nEditNumber(win : pwindow; x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
+ Function nEditNumber(win : pwindow; x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
+ Function nEditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
+ Function nEditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
+ Function nEditDate(win : pwindow; x,y,att : integer;initv : string;var esc : boolean) : string;
+ Function nEditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
+Procedure nMakeWindow(var win : tnWindow;x1,y1,x2,y2,ta,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
+Procedure nMakeWindow(var win : pnWindow;x1,y1,x2,y2,ta,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
+Procedure nMakeMenu(var mnu : tnMenu;x,y,_w,_r,_c,ta,ca,ga,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
+Procedure nMakeMenu(var mnu : pnMenu;x,y,_w,_r,_c,ta,ca,ga,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
+ Function nShowMessage(msg : string;matt : byte;hdr : string;hatt : byte;ack : boolean) : pnWindow;
+ Function nReadScr(win : pWindow; x,y,n : integer) : string;
+ Function nReadScr(x,y,n : integer) : string;
+ Function nReadScrStr(win : pWindow; x,y,n : integer; buf : pchtype) : pchtype;
+ Function nReadScrStr(x,y,n : integer; buf : pchtype) : pchtype;
+ Function nReadScrColor(win : pWindow; x,y : integer) : integer;
+ Function nReadScrColor(x,y : integer) : integer;
+Procedure nWriteScrStr(win : pWindow; x,y : integer; s : pchtype);
+Procedure nWriteScrStr(x,y : integer; s : pchtype);
+Procedure nGrabScreen(var p : pnScreenBuf; x,y,c,r : integer; win : pWindow);
+Procedure nGrabScreen(var p : pnScreenBuf; x,y,c,r : integer);
+Procedure nGrabScreen(var p : pnScreenBuf);
+Procedure nPopScreen(p : pnScreenBuf; x,y : integer; win : pWindow);
+Procedure nPopScreen(p : pnScreenBuf; x,y : integer);
+Procedure nPopScreen(p : pnScreenBuf);
+Procedure nReleaseScreen(p : pnScreenBuf);
+ Function nCheckPxPicture(var s, Pic : string; var CPos : integer) : word;
+
+{$i ncrt.inc}
+{$i pxpic.inc}
+
+Var
+ _chmap : nChMap;
+
+{---------------------------------------------------------------------
+ tnWindow.Init
+
+ Create a new window.
+ x = upper left corner x, screen relative
+ y = upper left corner y, screen relative
+ x1 = lower right corner x, screen relative
+ y1 = lower right corner y, screen relative
+ wcolor = window/text color
+ border = include a frame?
+ fcolor = frame color
+ ---------------------------------------------------------------------}
+Constructor tnWindow.Init(x,y,x1,y1,wcolor : integer;
+ border : boolean;
+ fcolor : integer);
+Var
+ mp : nChMap;
+Begin
+ hasframe := border;
+ wincolor := wcolor;
+ framecolor := fcolor;
+ hdrcolor := wcolor;
+ header := '';
+ data := nil;
+ visible := false;
+ init_wins(x,y,x1,y1);
+ FillChar(mp,SizeOf(mp),#0);
+ ec.Init(false,false,false,false,false,'','',15,mp);
+ ec.ClrChMap(0);
+ SetActiveWn(wn);
+End;
+
+{ deallocate the window }
+Destructor tnWindow.Done;
+Begin
+ done_wins;
+ ec.Done;
+ SetActiveWn(nscreen);
+End;
+
+Procedure tnWindow.init_wins(x,y,x1,y1 : integer);
+Begin
+ win := nil;
+ sub := nil;
+ pan := nil;
+ subp := nil;
+ win := newwin(y1-y+1,x1-x+1,y-1,x-1);
+ pan := new_panel(win);
+ hide_panel(pan);
+ If hasframe Then
+ PutFrame(framecolor)
+ Else Begin
+ wn := win;
+ wbkgd(win,COLOR_PAIR(nSetColorPair(wincolor)));
+ If nisbold(wincolor) then wattr_on(win,A_BOLD);
+ scrollok(win,bool(true));
+ intrflush(win,bool(false));
+ keypad(win,bool(true));
+ End;
+End;
+
+Procedure tnWindow.done_wins;
+Begin
+ If subp <> nil Then del_panel(subp);
+ If pan <> nil Then del_panel(pan);
+ If sub <> nil Then delwin(sub);
+ If (win <> nil) and (win <> stdscr) Then delwin(win);
+ subp := nil;
+ pan := nil;
+ sub := nil;
+ If win <> stdscr Then win := nil;
+End;
+
+Procedure tnWindow.ReSize(cols_,rows_ : integer);
+Var
+ xx,yy,
+ mx,my : integer;
+ vis : boolean;
+Begin
+ xx := GetX;
+ yy := GetY;
+ { can't be larger than full screen }
+ If cols_ > nMaxCols Then cols_ := nMaxCols;
+ If rows_ > nMaxRows Then rows_ := nMaxRows;
+ { set the bottom, right corner }
+ mx := xx+cols_-1;
+ my := yy+rows_-1;
+ { expand left? }
+ If mx > nMaxCols Then xx := nMaxCols-cols_+1;
+ { expand up? }
+ If my > nMaxRows Then yy := nMaxRows-rows_+1;
+ If xx < 1 Then xx := 1;
+ If yy < 1 Then yy := 1;
+ { reset the bottom, right corner }
+ mx := xx+cols_-1;
+ my := yy+rows_-1;
+ { constrain to full screen }
+ If mx > nMaxCols Then mx := nMaxCols;
+ If my > nMaxRows Then my := nMaxRows;
+ vis := visible;
+ Hide;
+ visible := vis;
+ done_wins;
+ init_wins(xx,yy,mx,my);
+ If visible Then Show;
+End;
+
+{ make the window current for all normal crt requests }
+Procedure tnWindow.Active;
+Begin
+ SetActiveWn(wn);
+End;
+
+{ display the window and move to the top }
+Procedure tnWindow.Show;
+Begin
+ SetActiveWn(wn);
+ visible := true;
+ show_panel(pan);
+ If subp <> nil Then show_panel(subp);
+ update_panels;
+ doupdate;
+End;
+
+{ hide the window }
+Procedure tnWindow.Hide;
+Begin
+ { don't go back to yourself }
+ If PrevWn <> wn Then
+ SetActiveWn(PrevWn)
+ Else
+ SetActiveWn(stdscr);
+ visible := false;
+ If subp <> nil Then hide_panel(subp);
+ hide_panel(pan);
+ update_panels;
+ doupdate;
+ GotoXY(WhereX,WhereY);
+End;
+
+Procedure tnWindow.ClrScr;
+Begin
+ tmp_b := dorefresh;
+ dorefresh := visible;
+ nClrScr(wn,wincolor);
+ dorefresh := tmp_b;
+End;
+
+Procedure tnWindow.ClrEol;
+Begin
+ tmp_b := dorefresh;
+ dorefresh := visible;
+ nClrEol(wn);
+ dorefresh := tmp_b;
+End;
+
+Procedure tnWindow.ClrBot;
+Begin
+ tmp_b := dorefresh;
+ dorefresh := visible;
+ nClrBot(wn);
+ dorefresh := tmp_b;
+End;
+
+Procedure tnWindow.InsLine;
+Begin
+ tmp_b := dorefresh;
+ dorefresh := visible;
+ nInsLine(wn);
+ dorefresh := tmp_b;
+End;
+
+Procedure tnWindow.DelLine;
+Begin
+ tmp_b := dorefresh;
+ dorefresh := visible;
+ nDelLine(wn);
+ dorefresh := tmp_b;
+End;
+
+{ return the window border header string }
+Function tnWindow.GetHeader : string;
+Begin
+ GetHeader := header;
+End;
+
+{----------------------------------------------------------------------
+ put/replace a header string at the top of a bordered window
+
+ hdr = header string (top line of window, only if hasframe = true)
+ hcolor = header line color
+ hpos = justfication of header string, left, center, or right
+ ----------------------------------------------------------------------}
+Procedure tnWindow.PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
+Var
+ cp,
+ hx,
+ len : integer;
+ att,
+ mx,my : longint;
+Begin
+ If Hasframe Then Begin
+ If hdr <> '' Then Begin
+ header := hdr;
+ hdrcolor := hcolor;
+ hdrpos := hpos;
+ getmaxyx(win,my,mx);
+ nHline(win,2,1,framecolor,mx-1);
+ len := mx-2;
+ hdr := Copy(hdr,1,len);
+ len := Length(hdr);
+ Case hpos of
+ left : hx := 1;
+ center : hx := (mx - len) div 2;
+ right : hx := (mx - len) - 1;
+ End;
+ mvwaddstr(win,0,hx,StrPCopy(ps,hdr));
+ cp := nSetColorPair(hcolor);
+ If nIsBold(hcolor) Then
+ att := A_BOLD
+ Else
+ att := A_NORMAL;
+ mvwchgat(win,0,hx,len,att,cp,0);
+ End;
+ End;
+End;
+
+{ set the the color of the writable window }
+Procedure tnWindow.SetColor(att : integer);
+Begin
+ wbkgd(wn,COLOR_PAIR(nSetColorPair(att)));
+ If nisbold(att) then wattr_set(wn,A_BOLD);
+ wincolor := att;
+ If visible Then wrefresh(wn);
+End;
+
+{ get the writeable window color }
+Function tnWindow.GetColor : integer;
+Begin
+ GetColor := wincolor;
+End;
+
+{ get the frame color }
+Function tnWindow.GetFrameColor : integer;
+Begin
+ GetFrameColor := framecolor;
+End;
+
+{ get the header color }
+Function tnWindow.GetHeaderColor : integer;
+Begin
+ GetHeaderColor := hdrcolor;
+End;
+
+{ frame an un-framed window, or update the frame color of a framed window }
+Procedure tnWindow.PutFrame(att : integer);
+Var
+ x,y,
+ mx,my,
+ atts : longint;
+Begin
+ wbkgd(win,COLOR_PAIR(nSetColorPair(att)));
+ atts := wattr_get(win);
+ If nisbold(att) then wattr_on(win,atts or A_BOLD);
+ box(win,ACS_VLINE,ACS_HLINE);
+ framecolor := att;
+ If framecolor = -1 Then framecolor := wincolor;
+ hasframe := true;
+ If header <> '' Then PutHeader(header,hdrcolor,hdrpos);
+ If sub = nil Then Begin
+ getbegyx(win,y,x);
+ getmaxyx(win,my,mx);
+ sub := newwin(my-2,mx-2,y+1,x+1);
+ If sub <> nil Then Begin
+ subp := new_panel(sub);
+ hide_panel(subp);
+ wbkgd(sub,COLOR_PAIR(nSetColorPair(wincolor)));
+ If nisbold(wincolor) then wattr_on(sub,A_BOLD);
+ scrollok(sub,bool(true));
+ intrflush(sub,bool(false));
+ keypad(sub,bool(true));
+ wn := sub;
+ End;
+ End;
+ touchwin(sub);
+ If visible Then Begin
+ wrefresh(win);
+ wrefresh(sub);
+ End;
+End;
+
+{ move the window }
+Procedure tnWindow.Move(x,y : integer);
+Begin
+ move_panel(pan,y-1,x-1);
+ If subp <> nil Then move_panel(subp,y,x);
+ If visible Then Begin
+ update_panels;
+ doupdate;
+ End;
+End;
+
+Procedure tnWindow.Align(hpos,vpos : tnJustify);
+Var
+ x,y,
+ bx,by : longint;
+Begin
+ getmaxyx(win,y,x);
+ getbegyx(win,by,bx);
+ Case hpos of
+ none : x := bx;
+ left : x := 0;
+ right : x := MaxCols - x;
+ center : x := (MaxCols - x) div 2;
+ End;
+ Case vpos of
+ none : y := by;
+ top : y := 0;
+ bottom : y := MaxRows - y;
+ center : y := (MaxRows - y) div 2;
+ End;
+ move(x+1,y+1);
+End;
+
+Procedure tnWindow.Scroll(ln : integer; dir : tnUpDown);
+Begin
+ nScroll(wn,ln,dir);
+End;
+
+Procedure tnWindow.GotoXY(x,y : integer);
+Begin
+ tmp_b := dorefresh;
+ dorefresh := visible;
+ nGotoXY(wn,x,y);
+ dorefresh := tmp_b;
+End;
+
+Function tnWindow.WhereX : integer;
+Begin
+ WhereX := nWhereX(wn);
+End;
+
+Function tnWindow.WhereY : integer;
+Begin
+ WhereY := nWhereY(wn);
+End;
+
+Function tnWindow.ReadKey : char;
+Begin
+ ReadKey := nReadKey(wn);
+End;
+
+Procedure tnWindow.WriteAC(x,y,att,c : longint);
+Begin
+ tmp_b := dorefresh;
+ dorefresh := visible;
+ nWriteAC(wn,x,y,att,c);
+ dorefresh := tmp_b;
+End;
+
+Procedure tnWindow.FWrite(x,y,att,z : integer; s : string);
+Begin
+ tmp_b := dorefresh;
+ dorefresh := visible;
+ nFWrite(wn,x,y,att,z,s);
+ dorefresh := tmp_b;
+End;
+
+Procedure tnWindow.DrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
+Begin
+ tmp_b := dorefresh;
+ dorefresh := visible;
+ nDrawBox(wn,LineStyle,x1,y1,x2,y2,att);
+ dorefresh := tmp_b;
+End;
+
+Function tnWindow.Rows : integer;
+Begin
+ Rows := nRows(wn);
+End;
+
+Function tnWindow.Cols : integer;
+Begin
+ Cols := nCols(wn);
+End;
+
+Function tnWindow.GetX : integer;
+Var
+ x,y : longint;
+Begin
+ getbegyx(win,y,x);
+ GetX := x+1;
+End;
+
+Function tnWindow.GetY : integer;
+Var
+ x,y : longint;
+Begin
+ getbegyx(win,y,x);
+ GetY := y+1;
+End;
+
+Function tnWindow.IsFramed : boolean;
+Begin
+ IsFramed := hasframe;
+End;
+
+Function tnWindow.IsVisible : boolean;
+Begin
+ IsVisible := visible;
+End;
+
+Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : integer) : String;
+var
+ tmp_ec : tnec;
+Begin
+ { save global ec}
+ tmp_ec := nEC;
+ { init global ec to window ec }
+ nEC := ec;
+ Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
+ { re-init window ec to possible changed values }
+ ec.ClearMode := nEC.ClearMode;
+ ec.InsMode := nEC.InsMode;
+ { init global ec to saved }
+ nEC := tmp_ec;
+End;
+
+Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
+var
+ i : integer;
+Begin
+ Edit := Edit(x,y,att,z,CursPos,es,i);
+ ch := chr(abs(i));
+End;
+
+{ overload for longint }
+Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : integer) : LongInt;
+var
+ tmp_ec : tnec;
+Begin
+ tmp_ec := nEC;
+ nEC := ec;
+ Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
+ ec.ClearMode := nEC.ClearMode;
+ ec.InsMode := nEC.InsMode;
+ nEC := tmp_ec;
+End;
+
+Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
+var
+ i : integer;
+Begin
+ Edit := Edit(x,y,att,z,CursPos,es,i);
+ ch := chr(abs(i));
+End;
+
+{ overload for real }
+Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : integer) : Real;
+var
+ tmp_ec : tnec;
+Begin
+ tmp_ec := nEC;
+ nEC := ec;
+ Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
+ ec.ClearMode := nEC.ClearMode;
+ ec.InsMode := nEC.InsMode;
+ nEC := tmp_ec;
+End;
+
+Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
+var
+ i : integer;
+Begin
+ Edit := Edit(x,y,att,z,CursPos,es,i);
+ ch := chr(abs(i));
+End;
+
+Function tnWindow.EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
+var
+ tmp_ec : tnec;
+Begin
+ tmp_ec := nEC;
+ nEC := ec;
+ EditNumber := nEditNumber(wn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
+ ec.ClearMode := nEC.ClearMode;
+ ec.InsMode := nEC.InsMode;
+ nEC := tmp_ec;
+End;
+
+Function tnWindow.EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
+var
+ tmp_ec : tnec;
+Begin
+ tmp_ec := nEC;
+ nEC := ec;
+ EditNumber := nEditNumber(wn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
+ ec.ClearMode := nEC.ClearMode;
+ ec.InsMode := nEC.InsMode;
+ nEC := tmp_ec;
+End;
+
+Function tnWindow.EditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
+var
+ tmp_ec : tnec;
+Begin
+ tmp_ec := nEC;
+ nEC := ec;
+ EditDate := nEditDate(wn,x,y,att,initv,esc);
+ ec.ClearMode := nEC.ClearMode;
+ ec.InsMode := nEC.InsMode;
+ nEC := tmp_ec;
+End;
+
+{--------------------------- tnEC -------------------------------}
+
+Constructor tnEC.Init(ft,ih,im,em,ap : boolean;
+ s,p : string;
+ cc : integer;
+ mp : nChMap);
+Begin
+ ClearMode := ft;
+ IsHidden := ih;
+ InsMode := im;
+ ExitMode := em;
+ AppendMode := ap;
+ Special := s;
+ Picture := p;
+ CtrlColor := cc;
+ ChMap := mp;
+End;
+
+Destructor tnEC.Done;
+Begin
+End;
+
+{ Add or replace a character map }
+{ Preferred }
+Function tnEC.AddChMap(_in,_out : integer) : integer;
+Var
+ i : integer;
+Begin
+ i := 0;
+ Repeat
+ inc(i);
+ Until (i > nMaxChMaps) or (ChMap[i,1] = _in) or (ChMap[i,1] = 0);
+ If i <= nMaxChMaps Then Begin
+ AddChMap := i;
+ ChMap[i,1] := _in;
+ ChMap[i,2] := _out;
+ End Else
+ AddChMap := 0;
+End;
+
+{ Add or replace a character map }
+{ Obsolete, overloaded }
+Function tnEC.AddChMap(mp : nChMapStr) : integer;
+Var
+ i : integer;
+ _in,_out : integer;
+Begin
+ { convert to new type }
+ If mp[1] = #0 Then
+ _in := ord(mp[2]) * (-1)
+ Else
+ _in := ord(mp[1]);
+ If mp[3] = #0 Then
+ _out := ord(mp[4]) * (-1)
+ Else
+ _out := ord(mp[3]);
+ AddChMap := AddChMap(_in,_out);
+End;
+
+Procedure tnEC.ClrChMap(idx : integer);
+Begin
+ Case idx of
+ 0 : FillChar(ChMap,SizeOf(ChMap),0);
+ 1..nMaxChMaps : Begin
+ ChMap[idx,1] := 0;
+ ChMap[idx,2] := 0;
+ End;
+ End;
+End;
+
+{==========================================================================}
+
+{ set the active window for write(ln), read(ln) }
+Procedure nSetActiveWin(win : pwindow);
+Begin
+ SetActiveWn(win);
+End;
+
+{----------------------------------------------------------------
+ Set the refresh toggle.
+ If true, then all changes to a window are immediate. If false,
+ then changes appear following the next call to nRefresh.
+ ----------------------------------------------------------------}
+Procedure nDoNow(donow : boolean);
+Begin
+ dorefresh := donow;
+End;
+
+{-----------------------------------------------------
+ Set the echo flag.
+ This determines whether or not, characters are
+ echoed to the display when entered via the keyboard.
+ -----------------------------------------------------}
+Procedure nEcho(b : boolean);
+Begin
+ Case b of
+ true : echo;
+ false: noecho;
+ End;
+ isEcho := b;
+End;
+
+{ create a new subwindow of stdscr }
+Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
+Begin
+ nDelWindow(win);
+ win := subwin(stdscr,y1-y+1,x1-x+1,y-1,x-1);
+ If win = nil then Exit;
+ intrflush(win,bool(false));
+ keypad(win,bool(true));
+ scrollok(win,bool(true));
+ SetActiveWn(win);
+End;
+
+{ create a new window }
+Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
+Begin
+ nDelWindow(win);
+ win := newwin(y1-y+1,x1-x+1,y-1,x-1);
+ If win = nil then Exit;
+ intrflush(win,bool(false));
+ keypad(win,bool(true));
+ scrollok(win,bool(true));
+ SetActiveWn(win);
+End;
+
+{ repaint a window }
+Procedure nRefresh(win : pWindow);
+Begin
+ touchwin(win);
+ wrefresh(win);
+End;
+
+{----------------------------------------------
+ Wait for a key to be pressed, with a timeout.
+ If a key is pressed, then nKeypressed returns
+ immediately as true, otherwise it return as
+ false after the timeout period.
+ ----------------------------------------------}
+function nKeypressed(timeout : word) : boolean;
+var
+ fds : TFDSet;
+ maxFD : longint;
+Begin
+ fpFD_Zero(fds);
+ maxFD := 1;
+ { turn on stdin bit }
+ If fpFD_IsSet(STDIN,fds)=0 Then
+ fpFD_Set(STDIN,fds);
+ { wait for some input }
+ If fpSelect(maxFD,@fds,nil,nil,timeout) > 0 Then
+ nKeypressed := TRUE
+ Else
+ nKeypressed := FALSE;
+End;
+
+{---------------------------------
+ read input string from a window
+ ---------------------------------}
+Function nReadln(win : pWindow) : string;
+Begin
+ wgetstr(win,ps);
+ nReadln := StrPas(ps);
+End;
+
+{ write a string to a window without refreshing screen }
+{ DON'T update PrevWn! }
+Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
+Var
+ tmp : pwindow;
+Begin
+ tmp := ActiveWn;
+ tmp_b := doRefresh;
+ ActiveWn := win;
+ doRefresh := false;
+ nFWrite(win,x,y,att,0,s);
+ ActiveWn := tmp;
+ doRefresh := tmp_b;
+End;
+
+{----------------------------------------------------------
+ Scroll a window, up or down, a specified number of lines.
+ lines = number of lines to scroll.
+ dir = direction, up or down.
+ ----------------------------------------------------------}
+Procedure nScroll(win : pWindow; lines : integer; dir : tnUpDown);
+Begin
+ ScrollOk(win,bool(True));
+ Case dir of
+ up : lines := abs(lines);
+ down : lines := abs(lines) * (-1);
+ End;
+ wscrl(win,lines);
+ If doRefresh Then wRefresh(win);
+End;
+
+{ draw a colored box, with or without a border }
+Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer);
+Var
+ sub : pWindow;
+ x,y : longint;
+Begin
+ getbegyx(win,y,x);
+ sub := subwin(win,y2-y1+1,x2-x1+1,y+y1-1,x+x1-1);
+ If sub = nil Then exit;
+ wbkgd(sub,CursesAtts(att));
+ werase(sub);
+ case LineStyle of
+ 1,2 : box(sub, ACS_VLINE, ACS_HLINE);
+ End;
+ If doRefresh Then wrefresh(sub);
+ nDelWindow(sub);
+End;
+
+{---------------------------
+ add a border to a window,
+ waits for a refresh
+ ---------------------------}
+Procedure nFrame(win : pWindow);
+Begin
+ box(win, ACS_VLINE, ACS_HLINE);
+End;
+
+{-----------------------------------------------------------
+ write a string to a window at the current cursor position
+ followed by a newline
+ -----------------------------------------------------------}
+Procedure nWriteln(win : pWindow; s : string);
+Begin
+ waddstr(win,StrPCopy(ps,s+#10));
+ If doRefresh Then wrefresh(win);
+End;
+
+{ return then number of rows in a window }
+Function nRows(win : pWindow) : integer;
+Var
+ x,y : longint;
+Begin
+ getmaxyx(win,y,x);
+ nRows := y;
+End;
+
+{ return then number of columns in a window }
+Function nCols(win : pWindow) : integer;
+Var
+ x,y : longint;
+Begin
+ getmaxyx(win,y,x);
+ nCols := x;
+End;
+
+{-------------------------------------------------------
+ Line drawing characters have to be handled specially.
+ Use nWriteAC() to write these characters. They cannot
+ be simply included as characters in a string.
+ -------------------------------------------------------}
+
+{ returns horizontal line character }
+Function nHL : longint;
+Begin
+ nHL := ACS_HLINE;
+End;
+
+{ returns vertical line character }
+Function nVL : longint;
+Begin
+ nVL := ACS_VLINE;
+End;
+
+{ returns upper left corner character }
+Function nUL : longint;
+Begin
+ nUL := ACS_ULCORNER;
+End;
+
+{ returns lower left corner character }
+Function nLL : longint;
+Begin
+ nLL := ACS_LLCORNER;
+End;
+
+{ returns upper right corner character }
+Function nUR : longint;
+Begin
+ nUR := ACS_URCORNER;
+End;
+
+{ returns lower right corner character }
+Function nLR : longint;
+Begin
+ nLR := ACS_LRCORNER;
+End;
+
+{ returns left tee character }
+Function nLT : longint;
+Begin
+ nLT := ACS_LTEE;
+End;
+
+{ returns right tee character }
+Function nRT : longint;
+Begin
+ nRT := ACS_RTEE;
+End;
+
+{ returns top tee character }
+Function nTT : longint;
+Begin
+ nTT := ACS_TTEE;
+End;
+
+{ returns bottom tee character }
+Function nBT : longint;
+Begin
+ nBT := ACS_BTEE;
+End;
+
+{ returns plus/cross character }
+Function nPL : longint;
+Begin
+ nPL := ACS_PLUS;
+End;
+
+{ returns left arrow character }
+Function nLA : longint;
+Begin
+ nLA := ACS_LARROW;
+End;
+
+{ returns right arrow character }
+Function nRA : longint;
+Begin
+ nRA := ACS_RARROW;
+End;
+
+{ returns up arrow character }
+Function nUA : longint;
+Begin
+ nUA := ACS_UARROW;
+End;
+
+{ returns down arrow character }
+Function nDA : longint;
+Begin
+ nDA := ACS_DARROW;
+End;
+
+{ returns diamond character }
+Function nDI : longint;
+Begin
+ nDI := ACS_DIAMOND;
+End;
+
+{ returns checkerboard character }
+Function nCB : longint;
+Begin
+ nCB := ACS_CKBOARD;
+End;
+
+{ returns degree character }
+Function nDG : longint;
+Begin
+ nDG := ACS_DEGREE;
+End;
+
+{ returns plus/minus character }
+Function nPM : longint;
+Begin
+ nPM := ACS_PLMINUS;
+End;
+
+{ returns bullet character }
+Function nBL : longint;
+Begin
+ nBL := ACS_BULLET;
+End;
+
+{ draw a horizontal line with color and a start & end position }
+Procedure nHLine(win : pwindow; col,row,attr,x : integer);
+var
+ sub : pwindow;
+ bx,by : longint;
+Begin
+ getbegyx(win,by,bx);
+ sub := subwin(win,1,x-col+1,by+row-1,bx+col-1);
+ If sub = nil Then Exit;
+ x := getmaxx(sub);
+ wbkgd(sub,CursesAtts(attr));
+ mvwhline(sub,0,0,ACS_HLINE,x);
+ If doRefresh Then wrefresh(sub);
+ delwin(sub);
+End;
+
+{ draw a vertical line with color and a start & end position }
+Procedure nVLine(win : pwindow; col,row,attr,y : integer);
+var sub : pwindow;
+Begin
+ sub := subwin(win,y-row+1,1,row-1,col-1);
+ If sub = nil Then Exit;
+ wbkgd(sub,CursesAtts(attr));
+ mvwvline(sub,0,0,ACS_VLINE,y);
+ If doRefresh Then wrefresh(sub);
+ delwin(sub);
+End;
+
+{----------------------------------------------------------------
+ Write a character from the alternate character set. A normal
+ value from the alternate character set is larger than $400000.
+ If the value passed here is 128..255, then we assume it to be
+ the ordinal value from the IBM extended character set, and try
+ to map it to curses correctly. If it does not map, then we just
+ make it an alternate character and hope the output is what the
+ programmer expected. Note: this will work on the Linux console
+ just fine, but for other terminals the passed value must match
+ the termcap definition for the alternate character.
+ Note: The cursor returns to it's original position.
+ ----------------------------------------------------------------}
+Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint);
+var
+ xx,yy,
+ cp : longint;
+Begin
+ If acs_char in [0..255] Then Begin
+ Case acs_char of
+ 176 : acs_char := ACS_CKBOARD;
+ 179 : acs_char := ACS_VLINE;
+ 180 : acs_char := ACS_RTEE;
+ 191 : acs_char := ACS_URCORNER;
+ 192 : acs_char := ACS_LLCORNER;
+ 193 : acs_char := ACS_BTEE;
+ 194 : acs_char := ACS_TTEE;
+ 195 : acs_char := ACS_LTEE;
+ 196 : acs_char := ACS_HLINE;
+ 197 : acs_char := ACS_PLUS;
+ 218 : acs_char := ACS_ULCORNER;
+ 217 : acs_char := ACS_LRCORNER;
+ 241 : acs_char := ACS_PLMINUS;
+ 248 : acs_char := ACS_DEGREE;
+ 249 : acs_char := ACS_BULLET;
+ else acs_char := acs_char or A_ALTCHARSET;
+ End;
+ End;
+ { save the current cursor position }
+ getyx(win,yy,xx);
+ cp := nSetColorPair(att);
+ { write character with current attributes }
+ mvwaddch(win,y-1,x-1,acs_char);
+ { update with new attributes }
+ If nIsBold(att) Then
+ att := A_BOLD or A_ALTCHARSET
+ Else
+ att := A_NORMAL or A_ALTCHARSET;
+ mvwchgat(win,y-1,x-1,1,att,cp,0);
+ { return cursor to saved position }
+ wmove(win,yy,xx);
+ If doRefresh Then wrefresh(win);
+End;
+
+{-------------------------------------------------------------------
+ write a string to stdscr with color, without moving the cursor
+
+ Col = x start position
+ Row = y start position
+ Attrib = color (0..127), note color = (background*16)+foreground
+ Clear = clear line up to x position
+ s = string to write
+ -------------------------------------------------------------------}
+Procedure nFWrite(win : pwindow; col,row,attrib : integer; clear : integer; s : string);
+var
+ clr : array [0..255] of char;
+ cs : string;
+ sub : pWindow;
+ x,y,
+ mx,my,
+ xx,yy : longint;
+ ctrl : boolean;
+Begin
+ if Clear > 0 Then Begin
+ FillChar(clr,SizeOf(clr),' ');
+ clr[SizeOf(clr)-1] := #0;
+ If Clear > MaxCols Then Clear := MaxCols;
+ cs := Copy(StrPas(clr),1,(Clear-Col)-Length(s)+1);
+ End Else
+ cs := '';
+ s := s+cs;
+ If s = '' Then Exit;
+ getyx(win,yy,xx);
+ getbegyx(win,y,x);
+ getmaxyx(win,my,mx);
+ If Length(s) > mx Then s := Copy(s,1,mx);
+ sub := subwin(win,1,Length(s),y+row-1,x+col-1);
+ If sub = nil Then Exit;
+ cs := s;
+ ctrl := false;
+ { look for embedded control characters }
+ For x := 1 to Length(s) Do Begin
+ If s[x] in [#0..#31] Then Begin
+ s[x] := ' ';
+ ctrl := true;
+ End;
+ End;
+ wbkgd(sub,COLOR_PAIR(nSetColorPair(Attrib)));
+ If nisbold(Attrib) then
+ wattr_on(sub,A_BOLD);
+ mvwaddstr(sub,0,0,StrPCopy(ps,s));
+ { highlight the embedded control characters substitutes }
+ If ctrl Then Begin
+ { nEC is always the current edit control object }
+ If Attrib <> nEC.CtrlColor Then
+ nWinColor(sub,nEC.CtrlColor)
+ Else Begin
+ { reverse the highlight color if same as current attribute }
+ bg := nEC.CtrlColor div 16;
+ fg := nEC.CtrlColor - (bg * 16);
+ While bg > 7 Do dec(bg,8);
+ While fg > 7 Do dec(fg,8);
+ nWinColor(sub,(fg*16)+bg);
+ End;
+ For x := 1 to Length(cs) Do Begin
+ If cs[x] in [#0..#31] Then
+ mvwaddch(sub,0,x-1,ord(cs[x])+64);
+ End;
+ End;
+ If doRefresh Then wrefresh(sub);
+ delwin(sub);
+ wmove(win,yy,xx);
+End;
+
+{ overload - no pointer }
+Procedure nFWrite(col,row,attrib : integer; clear : integer; s : string);
+Begin
+ nFWrite(ActiveWn,col,row,attrib,clear,s);
+End;
+
+{ compatibility for the old function name }
+Function nSEdit(win : pwindow; x,y,att,z,CursPos:integer;
+ es:string;var ch : char) : string;
+Var
+ s : string;
+Begin
+ s := nEdit(win,x,y,att,z,CursPos,es,ch);
+ nSEdit := s;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+{ String Editor }
+Function nEdit(win : pwindow; { window to work in }
+ x,y, { base x,y coordinates of edit region }
+ att, { color attribute }
+ z, { right-most column of edit region }
+ CursPos:integer; { place cursor on this column at start }
+ es:string; { initial value of string }
+ var chv : integer { ordinal value of character typed, }
+ { negative for extended keys }
+ ) : string;
+Var
+ ZMode,
+ AppendMode,
+ SEditExit : boolean;
+ prvx,
+ prvy,
+ pidx,
+ pres,
+ Index : integer;
+ ts,
+ hes : string;
+ isextended : boolean;
+ ch : char;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure NewString;
+BEGIN
+ nEdit := es;
+ hes := es;
+ FillChar(hes[1],Length(hes),'*');
+END;
+
+Procedure WriteString;
+Var
+ xx,yy : integer;
+Begin
+ xx := nWhereX(win);
+ yy := nWhereY(win);
+ If nEC.IsHidden Then
+ nFWrite(win,x,y,att,z,hes)
+ Else
+ nFWrite(win,x,y,att,z,es);
+ nGotoXY(win,xx,yy);
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure EInsMode;
+Begin
+ nEC.InsMode := (not nEC.InsMode)
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure WriteChar;
+var s : string;
+Begin
+ ts := es;
+ If AppendMode Then Begin
+ es := es + ' ';
+ Index := Length(es);
+ End Else Begin
+ If nWhereX(win) >= Length(es)+x Then Repeat
+ es := es + ' ';
+ Until Length(es)+x-1 = nWhereX(win);
+ If es = '' Then es := ' ';
+ If Length(es)+x-1 = nWhereX(win) Then Index := Length(es);
+ End;
+ es[Index] := ch;
+ s := Copy(es,1,Index);
+ If nCheckPxPicture(s,nEC.Picture,pidx) <> 0 Then Begin
+ { no error, picture satisfied }
+ If (Length(s) > Length(es)) or
+ ((Length(s) = Length(es)) and (s <> es)) Then Begin
+ { expanded/changed by picture }
+ es := s;
+ End;
+ If pidx > Index Then Begin
+ If pidx > Length(es) Then pidx := Length(es);
+ If pidx > Index Then Index := pidx;
+ End;
+ End Else Begin
+ { error, did not fit the picture }
+ Sound(1000);
+ Delay(50);
+ NoSound;
+ es := ts;
+ Dec(Index);
+ End;
+ NewString;
+ WriteString;
+ If (Index < z-x+1) or not ZMode Then Begin
+ Index := Index+1;
+ nGotoXY(win,x+Index-1,y);
+ End;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure EInsert; { Insert }
+Begin
+ If Length(es) < Z-X+1 Then Begin
+ ts := es;
+ Insert(' ',es,Index);
+ If nCheckPXPicture(es,nEC.Picture,pidx) = 0 Then Begin
+ Sound(1000);
+ Delay(50);
+ NoSound;
+ es := ts;
+ ch := #255;
+ End;
+ NewString;
+ WriteString;
+ End;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure EDelete; { Delete }
+Begin
+ ts := es;
+ Delete(es,Index,1);
+ If nCheckPXPicture(es,nEC.Picture,pidx) = 0 Then Begin
+ Sound(1000);
+ Delay(50);
+ NoSound;
+ es := ts;
+ ch := #255;
+ End;
+ NewString;
+ WriteString;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure ECtrlEnd; { <CTRL> End }
+Begin
+ Delete(es,Index,Length(es));
+ NewString;
+ WriteString;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure EHome; { Home }
+Begin
+ Index := 1;
+ nGotoXY(win,x,y);
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure ELeftArrow; { Left Arrow }
+Begin
+ If nWhereX(win) > x Then Begin
+ dec(Index);
+ nGotoXY(win,nWhereX(win)-1,nWhereY(win));
+ End;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure ERightArrow; { Right Arrow }
+Begin
+ If Index < z-x+1 Then Begin
+ nGotoXY(win,nWhereX(win)+1,nWhereY(win));
+ Index := Index + 1;
+ End;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure EEnd; { End }
+Begin
+ Index := Length(es)+1;
+ If Index > z-x+1 Then Index := Length(es);
+ If Index < 1 Then Index := 1;
+ If Index > MaxCols Then Index := MaxCols;
+ nGotoXY(win,x+(Index-1),y);
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure EBackSpace; { Backspace }
+Begin
+ Index := Index - 1;
+ If Index < 1 Then Begin
+ Index := 1;
+ Exit;
+ End Else
+ If nWhereX(win) > x Then nGotoXY(win,nWhereX(win) - 1,nWhereY(win));
+ Delete(es,Index,1);
+ NewString;
+ WriteString;
+ nGotoXY(win,x+(Index-1),y);
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure ETurboBackSpace; { Ctrl/Backspace }
+Begin
+ If Index = 1 Then Exit;
+ Delete(es,1,Index-1);
+ NewString;
+ Index := 1;
+ If nWhereX(win) > x Then nGotoXY(win,1,nWhereY(win));
+ WriteString;
+ nGotoXY(win,x,y);
+END;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure ECtrlLeftArrow;{ Ctrl Left Arrow }
+Begin
+ If nEC.IsHidden Then Begin
+ EHome;
+ Exit;
+ End;
+ If es[Index-1] = ' ' Then Index := Index-1;
+ If es[Index] <> ' ' Then Begin
+ While (Index > 1) And (es[Index] <> ' ') Do
+ Index := Index-1;
+ End Else
+ If es[Index] = ' ' Then Begin
+ While (Index > 1) And (es[Index] = ' ') Do
+ Index := Index-1;
+ While (Index > 1) And (es[Index] <> ' ') Do
+ Index := Index-1;
+ End;
+ If Index = 1 Then
+ nGotoXY(win,x,y)
+ Else Begin
+ nGotoXY(win,x+Index,y);
+ Index := Index+1;
+ End;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure ECtrlRightArrow;{ Ctrl Right Arrow }
+Begin
+ If nEC.IsHidden Then Begin
+ EEnd;
+ Exit;
+ End;
+ While (Index < Length(es)) And (es[Index] <> ' ') Do
+ Begin
+ Index := Index+1;
+ End;
+ While (Index < Length(es)) And (es[Index] = ' ') Do
+ Begin
+ Index := Index+1;
+ End;
+ nGotoXY(win,x+Index-1,y);
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure CheckForWriteChar(embed : boolean);
+Begin
+ If embed or Not (Ch In [#27,#255]) Then Begin
+ If (ch in [#10,#13]) and (not embed) {and not ControlKey} Then exit;
+ If nEC.ClearMode Then Begin
+ es := '';
+ WriteString;
+ nGotoXY(win,X,Y);
+ Index := 1;
+ WriteChar;
+ nEC.ClearMode := False;
+ End Else Begin
+ If nEC.InsMode Then Begin
+ EInsert;
+ WriteChar;
+ End Else WriteChar;
+ End;
+ End;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure ProcessSpecialKey;
+begin
+ If ch = #129 Then ch := #68; { Linux, map Esc/0 to F10 }
+ chv := ord(ch) * (-1); { set the return value }
+
+ Case ch of
+ #16..#25,
+ #30..#38,
+ #44..#50,
+ #59..#68,
+ #84..#90,
+ #92..#113,
+ #118,
+ #132,
+ #72,
+ #73,
+ #80,
+ #81 : Begin SEditExit:=True;Exit;End;
+ #71 : EHome;
+ #75 : ELeftArrow;
+ #77 : ERightArrow;
+ #79 : EEnd;
+ #82 : EInsMode;
+ #83 : EDelete;
+ #15,
+ #115 : ECtrlLeftArrow;
+ #116 : ECtrlRightArrow;
+ #117 : ECtrlEnd;
+ End;
+End;
+
+{~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
+Procedure ProcessNormalKey;
+Var
+ i : integer;
+ ctrl : boolean;
+begin
+ chv := ord(ch); { set the return value }
+ For i := 1 to Length(nEC.Special) Do Begin
+ If ch = nEC.Special[i] Then Begin
+ SEditExit:=True;
+ Exit;
+ End;
+ End;
+ ctrl := false;
+ { standard control key assignments }
+ case ch of
+ #0..#15,
+ #17..#31 : Begin
+ nEC.ClearMode := False;
+ Case ch of
+ #1 : EHome;
+ #5 : EEnd;
+ #2 : ELeftArrow;
+ #6 : ERightArrow;
+ #19 : ECtrlLeftArrow;
+ #4 : ECtrlRightArrow;
+ #7 : EDelete;
+ #9 : EInsMode;
+ #8 : EBackSpace;
+ #10 : ch := #13;
+ #13 : Begin
+ pres := nCheckPxPicture(es,nEC.Picture,pidx);
+ If pres <> 2 Then Begin
+ Sound(1000);
+ Delay(50);
+ NoSound;
+ ch := #255;
+ End;
+ End;
+ #27 : If KeyPressed Then Begin
+ { covers up a Linux peculiarity where the next }
+ { character typed bleeds through with esc/1..9 }
+ nGotoXY(win,prvx,prvy);
+ WriteString;
+ ch := ReadKey;
+ { make it a function key }
+ If ch in ['1'..'9'] Then Begin
+ ch := Char(Ord(ch)+10);
+ chv := ord(ch) * (-1);
+ End Else ch := #27;
+ SEditExit := true;
+ End;
+ End;
+ Exit;
+ End;
+ #16 : Begin
+ { embed control characters in the string }
+ ch := UpCase(ReadKey);
+ If ch in ['@','2','A'..'Z'] Then Begin
+ ctrl := true;
+ If ch = '2' Then ch := '@';
+ ch := Char(Ord(ch)-64);
+ chv := ord(ch);
+ End;
+ End;
+ #127 : Begin nEC.ClearMode := False;ETurboBackSpace;Exit;End;
+ end;
+ CheckForWriteChar(ctrl);
+ ch := #0;
+end;
+
+{-----------------------------------------------------------------------
+ Map a keystroke to another character, normal or extended.
+
+ The maps are 4 character strings interpreted as 2 sets of character
+ pairs that represent the following:
+
+ 1st char - If it is #0 then it is an extended char. Use the 2nd
+ character to identify.
+ 2nd char - Only used if 1st char is #0.
+
+ The first pair of the string is the actual key pressed.
+ The second pair is what that key should be become.
+
+ #0#59 = F1, extended key
+ #59#0 = ; , normal key
+
+ So a map of #0#59#59#0 maps the F1 key to the ; key,
+ and #0#59#0#60 maps the F1 key to the F2 key,
+ and #0#59#0#0 maps the F1 key to a null.
+
+ Examples:
+ #0#59#0#60 = map F1 to F2
+ #1#0#0#59 = map ^A to F1
+ #0#59#1#0 = map F1 to ^A
+ #0#59#0#0 = map F1 to ^@ (null)
+ #0#0#0#59 = map ^@ to F1
+ #97#0#65#0 = map a to A
+}
+Procedure MapKey(var ch : char;var eflag : boolean);
+Var
+ i,
+ cv : integer;
+ s2 : string[2];
+ s4 : string[4];
+Begin
+ cv := Ord(ch);
+ If eflag Then cv := cv * (-1);
+ i := 0;
+ { look for a character map assignment }
+ Repeat
+ inc(i);
+ Until (i > nMaxChMaps) or (nEC.ChMap[i,1] = cv);
+ { if found, then re-assign ch to the mapped key }
+ If i <= nMaxChMaps Then Begin
+ cv := nEC.ChMap[i,2];
+ eflag := (cv < 0);
+ ch := chr(abs(cv));
+ End;
+(*
+ { look for a character map assignment }
+ i := 0;
+ s4 := #0#0#0#0;
+ Case eflag of
+ true : s2 := #0+ch;
+ false : s2 := ch+#0;
+ End;
+ Repeat
+ inc(i);
+ Until (i > nMaxChMaps) or (pos(s2,nEC.ChMap[i]) = 1);
+ { if found, then re-assign ch to the mapped key }
+ If i <= nMaxChMaps Then Begin
+ system.Move(nEC.ChMap[i,1],s4[1],Length(nEC.ChMap[i]));
+ s2 := Copy(s4,3,2);
+ eflag := (s2[1] = #0);
+ Case eflag of
+ true : ch := s2[2];
+ false : ch := s2[1];
+ End;
+ If ch = #0 Then eflag := false;
+ End;
+*)
+End;
+
+{============================================================================}
+Begin
+ SEditExit := nEC.ExitMode;
+ AppendMode := nEC.AppendMode;
+ ZMode := z <> 0;
+ If CursPos > Length(es)+x Then
+ Index := Length(es)+1 { End Of String }
+ Else Index := CursPos+1-x; { Inside Of String }
+ If Not ZMode then z := x+length(es);
+ Newstring;
+ WriteString;
+ nGotoXY(win,CursPos,y);
+ Repeat
+ prvx := nWhereX(win); { save for ProcessNormalKey }
+ prvy := nWhereY(win);
+ If Not ZMode then z := x+length(es);
+ ch := ReadKey;
+ isextended := (ch = #0);
+ If isextended Then
+ ch := ReadKey;
+ MapKey(ch,isextended);
+ If isextended Then
+ ProcessSpecialKey
+ Else
+ ProcessNormalKey;
+ Until (ch In [#13,#27]) or SEditExit;
+ nEC.ClearMode := False;
+ NewString;
+End;{ of nEdit }
+
+{ compatibility for old ch type }
+Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
+ es:string;var ch : char) : string;
+Var i : integer;
+Begin
+ nEdit := nEdit(win,x,y,att,z,CursPos,es,i);
+ ch := chr(abs(i));
+End;
+
+{ nEdit using currently active window }
+Function nEdit(x,y,att,z,CursPos:integer;
+ es:string;var ch : integer) : string;
+Begin
+ nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
+End;
+
+Function nEdit(x,y,att,z,CursPos:integer;
+ es:string;var ch : char) : string;
+Var i : integer;
+Begin
+ nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,i);
+ ch := chr(ord(i));
+End;
+
+{ overload for longint type }
+Function nEdit(x,y,att,z,CursPos:integer;
+ es:longint;var ch : integer) : longint;
+Begin
+ nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
+End;
+
+Function nEdit(x,y,att,z,CursPos:integer;
+ es:longint;var ch : char) : longint;
+Begin
+ nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
+End;
+
+{ longint with pointer }
+Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
+ es:LongInt;var ch : integer) : LongInt;
+Var
+ savpic,
+ ess : string;
+ esv,
+ err : longint;
+Begin
+ Str(es:0,ess);
+ savpic := nEC.Picture;
+ If savpic = '' Then nEC.Picture := '[-]#*#';
+ ess := nEdit(win,x,y,att,z,CursPos,ess,ch);
+ nEC.Picture := savpic;
+ val(ess,esv,err);
+ nEdit := esv;
+End;
+
+Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
+ es:longint;var ch : char) : longint;
+Var i : integer;
+Begin
+ nEdit := nEdit(win,x,y,att,z,CursPos,es,i);
+ ch := chr(abs(i));
+End;
+
+{ overload for real type }
+Function nEdit(x,y,att,z,CursPos:integer;
+ es:real;var ch : integer) : real;
+Begin
+ nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
+End;
+
+Function nEdit(x,y,att,z,CursPos:integer;
+ es:real;var ch : char) : real;
+Var i : integer;
+Begin
+ nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,i);
+ ch := chr(abs(i));
+End;
+
+{ with pointer }
+Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
+ es:Real;var ch : integer) : Real;
+Var
+ savpic,
+ ess : string;
+ esv : real;
+ i,
+ err : Integer;
+Begin
+ Str(es:0:12,ess);
+ While ess[Length(ess)] = '0' Do Delete(ess,Length(ess),1);
+ savpic := nEC.Picture;
+ If savpic = '' Then Begin
+ Case nDecFmt of
+ nUS : nEC.Picture := '[+,-]#*#[[.*#][{E,e}[+,-]#[#][#][#]]]';
+ nEURO : Begin
+ nEC.Picture := '[+,-]#*#[[;,*#][{E,e}[+,-]#[#][#][#]]]';
+ For i := 1 to Length(ess) Do
+ If ess[i] = '.' Then ess[i] := ',';
+ End;
+ End;
+ End;
+ ess := nEdit(win,x,y,att,z,CursPos,ess,ch);
+ nEC.Picture := savpic;
+ For i := 1 to Length(ess) Do If ess[i] = ',' Then ess[i] := '.';
+ val(ess,esv,err);
+ nEdit := esv;
+End;
+
+Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
+ es:real;var ch : char) : real;
+Var i : integer;
+Begin
+ nEdit := nEdit(win,x,y,att,z,CursPos,es,i);
+ ch := chr(abs(i));
+End;
+
+{ And now some sugar for Rainer Hantsch! }
+{------------------------------------------------------------------------
+ This is a right justified number editor. As a digit is typed, the
+ existing number string gets pushed left and the new digit is appended.
+ If decimal columns are specified, then pressing <space> will enter the
+ decimal character (. or ,). A background string can be specified that
+ fills the empty spaces.
+ ------------------------------------------------------------------------}
+Function nEditNumber(
+ win : pwindow;
+ x, { edit field start column }
+ y, { edit field start row }
+ att, { edit field color attribute }
+ wid, { edit field width }
+ decm : integer; { number of decimal columns }
+ bgd : string; { background string -
+ if bgd = '', then no background
+ if bgd = a single character, then is used as the
+ background fill character.
+ if bgd length is longer than wid, then the entire
+ bgd string is used as the background.}
+ initv, { initial value }
+ minv, { range minimum value }
+ maxv : real; { range maximum value }
+ var esc : boolean { if Esc key pressed = true, else = false }
+) : real;
+
+Const
+ { up to 12 decimal places }
+ decs : string = '[#][#][#][#][#][#][#][#][#][#][#][#]';
+Var
+ r : real;
+ s,s1,s2 : string;
+ i,
+ e,
+ bc,
+ bx : integer;
+ ch : char;
+ fill : array [0..255] of char;
+ tmp_ec : tnEC;
+Begin
+ tmp_ec := nEC;
+ nEC.ExitMode := true;
+ nEC.AppendMode := true;
+ nEC.ClrChMap(0);
+ nEC.AddChMap(#7#0#0+Char(nKeyDel));
+ nEC.AddChMap(#8#0#0+Char(nKeyDel));
+ If decm > (Length(decs) div 3) Then
+ decm := (Length(decs) div 3);
+ If decm >= wid Then decm := (wid - 1);
+ If decm > 0 Then Begin
+ nEC.Picture := '[-]*#[{.}'+Copy(decs,1,(decm*3))+']';
+ If nDecFmt = nEURO Then Begin
+ nEC.Picture[8] := ',';
+ Insert(';',nEC.Picture,8);
+ nEC.AddChMap('.'+#0+','+#0);
+ End;
+ End Else
+ nEC.Picture := '[-]*#';
+ If bgd = '' Then Begin
+ bgd := ' ';
+ bc := att;
+ End Else
+ bc := nEC.CtrlColor;
+ If Length(bgd) < wid Then Begin
+ FillChar(fill,wid,bgd[1]);
+ fill[wid] := #0;
+ bgd := StrPas(fill);
+ End;
+ bx := x;
+ If Length(bgd) > wid Then inc(x);
+ str(initv:wid:decm,s);
+ While s[1] = ' ' Do Delete(s,1,1);
+ If Pos('.',s) <> 0 Then
+ While s[Length(s)] = '0' Do Delete(s,Length(s),1);
+ If decm = 0 Then Delete(s,Pos('.',s),1);
+ If nDecFmt = nEURO Then For i := 1 to Length(s) Do
+ If s[i] = '.' Then s[i] := ',';
+ Repeat
+ nFWrite(win,bx,y,bc,bx+Length(bgd)-(x-bx),copy(bgd,1,wid-length(s)+(x-bx)));
+ If x > bx Then
+ nFWrite(win,x+wid,y,bc,0,copy(bgd,wid+2,length(bgd)));
+ s1 := nEdit(win,x+wid-Length(s),y,att,x+wid-1,x+wid-1,s,ch);
+ s2 := s1;
+ If nDecFmt = nEURO Then For i := 1 to Length(s2) Do
+ If s2[i] = ',' Then s2[i] := '.';
+ val(s2,r,e);
+ If (s1 = '') or ((e = 0) and (r >= minv) and (r <= maxv)) Then
+ s := s1
+ Else
+ If ch <> #27 then Begin
+ ch := #0;
+ Sound(1000);
+ Delay(50);
+ NoSound;
+ End;
+ nEC.AppendMode := Length(s) < wid;
+ Until ch in [#13,#27];
+ esc := (ch = #27);
+ nEditNumber := r;
+ nEC := tmp_ec;
+End;
+
+{ overload - real, no pointer }
+Function nEditNumber(
+ x,y,att,wid,decm : integer;
+ bgd : string;
+ initv,
+ minv,
+ maxv : real;
+ var esc : boolean) : real;
+Begin
+ nEditNumber := nEditNumber(ActiveWn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
+End;
+
+{ overload for longint }
+Function nEditNumber(
+ win : pwindow;
+ x,y,att,wid,decm : integer;
+ bgd : string;
+ initv,
+ minv,
+ maxv : longint;
+ var esc : boolean) : longint;
+Var
+ r : real;
+Begin
+ r := nEditNumber(win,x,y,att,wid,0,bgd,Real(initv),Real(minv),Real(maxv),esc);
+ nEditNumber := Trunc(r);
+End;
+
+{ overload - longint, no pointer }
+Function nEditNumber(
+ x,y,att,wid,decm : integer;
+ bgd : string;
+ initv,
+ minv,
+ maxv : longint;
+ var esc : boolean) : longint;
+Var
+ r : real;
+Begin
+ r := nEditNumber(ActiveWn,x,y,att,wid,0,bgd,Real(initv),Real(minv),Real(maxv),esc);
+ nEditNumber := Trunc(r);
+End;
+
+{ More sugar for Rainer }
+{------------------------------------------------------------------------
+ A date string editor.
+ ------------------------------------------------------------------------}
+Function nEditDate(
+ win : pwindow;
+ x, { edit field start column }
+ y, { edit field start row }
+ att : integer; { edit field color attribute }
+ initv : string; { initial value }
+ var esc : boolean { if Esc key pressed = true, else = false }
+) : string;
+
+Var
+ s : string;
+ i : integer;
+ ch : char;
+ tmp_ec : tnEC;
+
+Begin
+ tmp_ec := nEC;
+ nEC.InsMode := false;
+ nEC.ClearMode := false;
+ nEC.ExitMode := false;
+ nEC.AppendMode := false;
+ Case nDecFmt of
+ nUS : Begin
+ nEC.Picture := '{#,m,M}{#,m,M}/{#,d,D}{#,d,D}/{#,y,Y}{#,y,Y}{#,y,Y}{#,y,Y}';
+ s := 'mm/dd/yyyy';
+ End;
+ nEURO : Begin
+ nEC.Picture := '{#,d,D}{#,d,D}/{#,m,M}{#,m,M}/{#,y,Y}{#,y,Y}{#,y,Y}{#,y,Y}';
+ s := 'dd/mm/yyyy';
+ End;
+ End;
+ If nCheckPxPicture(initv,nEC.Picture,i) <> 0 Then
+ system.move(initv[1],s[1],Length(initv));
+ nEC.AddChMap(#7#0#0+Char(nKeyLeft));
+ nEC.AddChMap(#8#0#0+Char(nKeyLeft));
+ nEC.AddChMap(#0+Char(nKeyDel)+#0+Char(nKeyLeft));
+ Repeat
+ s := nEdit(win,x,y,att,x+9,x,s,ch);
+ If ch = #13 Then Begin
+ For i := 1 to Length(s) Do
+ If s[i] in ['m','d','y'] Then ch := #0;
+ End;
+ Until ch in [#13,#27];
+ esc := (ch = #27);
+ nEditDate := s;
+ nEC := tmp_ec;
+End;
+
+{ overload - no pointer }
+Function nEditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
+Begin
+ nEditDate := nEditDate(ActiveWn,x,y,att,initv,esc);
+End;
+
+{ A one-line procedural wrapper }
+Procedure nMakeWindow(
+ var win : tnWindow;
+ x1,y1,
+ x2,y2,
+ ta,ba,ha : integer;
+ hasframe : boolean;
+ hdrpos : tnJustify;
+ hdrtxt : string);
+Begin
+ win.init(x1,y1,x2,y2,ta,hasframe,ba);
+ If hdrtxt <> '' Then win.PutHeader(hdrtxt,ha,hdrpos);
+End;
+
+{ And with a window pointer }
+Procedure nMakeWindow(
+ var win : pnWindow;
+ x1,y1,
+ x2,y2,
+ ta,ba,ha : integer;
+ hasframe : boolean;
+ hdrpos : tnJustify;
+ hdrtxt : string);
+Begin
+ New(win,init(x1,y1,x2,y2,ta,hasframe,ba));
+ If hdrtxt <> '' Then win^.PutHeader(hdrtxt,ha,hdrpos);
+End;
+
+{--------------------------------------------------------------------
+ Display a message in a centered and framed box. With ack set to
+ false, the window remains active for further use in the program.
+
+ Inputs:
+ msg = message to display
+ matt = message color
+ hdr = header text at frame top
+ hatt = header/frame color
+ ack = TRUE : display ftr text and wait for a keypress, then
+ remove the window.
+ FALSE: don't display ftr, don't wait for a keypress, and
+ don't remove the window.
+ Output:
+ a nil pointer if ack = true,
+ a pointer to the tnWindow object if ack = false
+ --------------------------------------------------------------------}
+Function nShowMessage(msg : string;
+ matt : byte;
+ hdr : string;
+ hatt : byte;
+ ack : boolean) : pnWindow;
+const
+ ftr = 'Press Any Key';
+ acklns : shortint = 0;
+var
+ i,j,
+ cr,
+ wid,
+ maxwid,
+ lines : integer;
+ mwin : pnWindow;
+Begin
+ wid := 0;
+ maxwid := Length(hdr);
+ If ack and (Length(ftr) > maxwid) Then
+ maxwid := Length(ftr);
+ lines := 1;
+ { how many rows does this window need ? }
+ For i := 1 to Length(msg) Do Begin
+ inc(wid);
+ { let's be consistant! }
+ If msg[i] = #13 Then msg[i] := #10;
+ { either a forced line break or we need to word-wrap }
+ If (msg[i] = #10) or (wid >= (MaxCols-2)) Then Begin
+ inc(lines);
+ j := 0;
+ If not (msg[i] in [#10,#32]) Then Begin
+ { we're in a word, so find the previous space (if any) }
+ Repeat
+ inc(j);
+ Until (j=wid) or ((i-j) <= 0) or (msg[i-j] = #32);
+ If ((i-j) > 0) and (msg[i-j] = #32) Then Begin
+ wid := wid-j;
+ msg[i-j] := #10 { force a line break }
+ End Else
+ j := 0;
+ End;
+ If wid > maxwid Then maxwid := wid;
+ wid := j; { either 0 or word-wrap remnent }
+ End;
+ End;
+ If wid > maxwid Then maxwid := wid;
+ If ack Then acklns := 1 else acklns := 0;
+ { make the message window }
+ New(mwin,Init(1,1,maxwid+2,lines+acklns+2,matt,true,hatt));
+ With mwin^ Do Begin
+ PutHeader(hdr,hatt,center);
+ Align(center,center);
+ If lines = 1 Then
+ { one-liners get centered }
+ Write(msg:Length(msg)+((maxwid-Length(msg)) div 2))
+ Else
+ Write(msg);
+ Show;
+ If ack Then Begin
+ cr := nCursor(cOff);
+ FWrite(((cols-Length(ftr)) div 2)+1,rows,matt,0,ftr);
+{
+ The following line can be used in place of the line above to place the
+ footer text in the frame instead of with the message body. Make sure to
+ keep acklns=0.
+
+ nFWrite(win,((ncols(win)-Length(ftr)) div 2)+1,nrows(win),hatt,0,ftr);
+}
+ Readkey;
+ While Keypressed Do Readkey;
+ Hide;
+ nCursor(cr);
+ End;
+ End;
+ If ack Then Begin
+ Dispose(mwin,Done);
+ mwin := nil;
+ End;
+ nShowMessage := mwin;
+End;
+
+{---------------------------------------
+ Read a character string from a window
+ win - window to extract info from.
+ x - starting column.
+ y - starting row.
+ n - number of characters to read.
+ ---------------------------------------}
+Function nReadScr(win : pWindow; x,y,n : integer) : string;
+Var
+ i,idx : integer;
+ s : string;
+ c : longint;
+ { array of char/attr values, 4 bytes each, max 256 }
+ buf : array[0..1023] of char;
+ p : pchar;
+Begin
+ s := '';
+ p := nReadScrStr(win,x,y,n,buf);
+ If p <> nil Then Begin
+ idx := 0;
+ For i := 1 to n Do Begin
+ system.move(buf[idx],c,SizeOf(c));
+ s := s + chr(c and A_CHARTEXT);
+ inc(idx,SizeOf(c));
+ End;
+ End;
+ nReadScr := s;
+End;
+
+{ overload for current window }
+Function nReadScr(x,y,n : integer) : string;
+Begin
+ nReadScr := nReadScr(ActiveWn,x,y,n);
+End;
+
+Function nReadScrStr(win : pWindow; x,y,n : integer; buf : pchtype) : pchtype;
+Var
+ cx,cy : integer;
+ mx,my : longint;
+Begin
+ cx := nWhereX(win);
+ cy := nWhereY(win);
+ If win <> nil Then Begin
+ getmaxyx(win,my,mx);
+ If (x in [1..mx]) and (y in [1..my]) Then Begin
+ { n is contrained to the right margin, so no need to range check }
+ mvwinchnstr(win,y-1,x-1,buf,n);
+ nGotoXY(win,cx,cy);
+ End;
+ End;
+ nReadScrStr := buf;
+End;
+
+{ overload for current window }
+Function nReadScrStr(x,y,n : integer; buf : pchtype) : pchtype;
+Begin
+ nReadScrStr := nReadScrStr(ActiveWn,x,y,n,buf);
+End;
+
+Function nReadScrColor(win : pWindow; x,y : integer) : integer;
+Var
+ cl,
+ fg,bg,
+ cx,cy : integer;
+ c,cv,
+ mx,my : longint;
+Begin
+ cl := -1;
+ cx := nWhereX(win);
+ cy := nWhereY(win);
+ If win <> nil Then Begin
+ getmaxyx(win,my,mx);
+ If (x in [1..mx]) and (y in [1..my]) Then Begin
+ c := mvwinch(win,y-1,x-1);
+ nGotoXY(win,cx,cy);
+ cv := PAIR_NUMBER(c and A_COLOR);
+ pair_content(cv,@fg,@bg);
+ fg := c2ibm(fg);
+ bg := c2ibm(bg);
+ cv := (c and A_ATTRIBUTES);
+ If A_BOLD and cv = A_BOLD Then inc(fg,8);
+ cl := (bg*16)+fg;
+ End;
+ End;
+ nReadScrColor := cl;
+End;
+
+{ overload for current window }
+Function nReadScrColor(x,y : integer) : integer;
+Begin
+ nReadScrColor := nReadScrColor(ActiveWn,x,y);
+End;
+
+{ write a string with attributes, previously saved with nReadScrStr }
+Procedure nWriteScrStr(win : pWindow; x,y : integer; s : pchtype);
+Begin
+ mvwaddchstr(win,y-1,x-1,s);
+ If doRefresh Then wrefresh(win);
+End;
+
+{ overload for current window }
+Procedure nWriteScrStr(x,y : integer; s : pchtype);
+Begin
+ mvwaddchstr(ActiveWn,y-1,x-1,s);
+ If doRefresh Then wrefresh(ActiveWn);
+End;
+
+{---------------------------------------
+ save a rectangular portion of a window
+ x = start column
+ y = start row
+ c = number of columns
+ r = number of rows
+ ---------------------------------------}
+Procedure nGrabScreen(var p : pnScreenBuf; x,y,c,r : integer; win : pWindow);
+Var
+ mx,my : longint;
+ i,
+ cx,cy : integer;
+ prb,trb : pnRowBuf;
+Begin
+ nReleaseScreen(p);
+ getmaxyx(win,my,mx);
+ If not (x in [1..mx]) or Not (y in [1..my]) Then Begin
+ p := nil;
+ Exit;
+ End;
+ cx := nWhereX(win);
+ cy := nWhereY(win);
+ New(p);
+ p^.x := x;
+ p^.y := y;
+ p^.n := c;
+ p^.first := nil;
+ trb := nil;
+ For i := 0 to r-1 Do Begin
+ If (y+i in [1..my]) Then Begin
+ New(prb);
+ GetMem(prb^.row,c*SizeOf(chtype));
+ mvwinchnstr(win,y-1+i,x-1,prb^.row,c);
+ If trb <> nil Then trb^.Next := prb;
+ prb^.next := nil;
+ trb := prb;
+ If i = 0 Then p^.First := prb;
+ End;
+ End;
+ nGotoXY(win,cx,cy);
+End;
+
+{ overload for current window }
+Procedure nGrabScreen(var p : pnScreenBuf; x,y,c,r : integer);
+Begin
+ nGrabScreen(p,x,y,c,r,ActiveWn);
+End;
+
+{ overload for current full window }
+Procedure nGrabScreen(var p : pnScreenBuf);
+Var
+ c,r : longint;
+Begin
+ getmaxyx(ActiveWn,r,c);
+ nGrabScreen(p,1,1,c,r,ActiveWn);
+End;
+
+{-----------------------------------------
+ restore a window saved with nGrabScreen
+ p = pointer to the saved buffer
+ x = start restore to this column
+ y = start restore to this row
+ win = restore to this window
+ -----------------------------------------}
+Procedure nPopScreen(p : pnScreenBuf; x,y : integer; win : pWindow);
+Var
+ cx,cy : integer;
+ mx,my : longint;
+ pb : pnRowBuf;
+Begin
+ If p = nil Then Exit;
+ getmaxyx(win,my,mx);
+ If Not (x in [1..mx]) or Not (y in [1..my]) Then Exit;
+ dec(x);
+ cx := nWhereX(win);
+ cy := nWhereY(win);
+ pb := p^.First;
+ While pb <> nil Do Begin
+ If (pb^.row <> nil) and (y in [1..my]) Then
+ mvwaddchnstr(win,y-1,x,pb^.row,p^.n);
+ inc(y);
+ pb := pb^.next;
+ End;
+ nGotoXY(win,cx,cy);
+ If doRefresh Then wrefresh(win);
+End;
+
+{ overload for current window, defined position }
+Procedure nPopScreen(p : pnScreenBuf; x,y : integer);
+Begin
+ nPopScreen(p,x,y,ActiveWn);
+End;
+
+{ overload for current window, saved position }
+Procedure nPopScreen(p : pnScreenBuf);
+Begin
+ If p = nil Then Exit;
+ nPopScreen(p,p^.x,p^.y,ActiveWn);
+End;
+
+{ free up the memory used to store a grabbed screen }
+Procedure nReleaseScreen(p : pnScreenBuf);
+Var
+ cur,tmp : pnRowBuf;
+Begin
+ If p = nil Then Exit;
+ If p^.first <> nil Then Begin
+ cur := p^.first;
+ While cur <> nil Do Begin
+ tmp := cur^.next;
+ If cur^.row <> nil Then FreeMem(cur^.row,p^.n * SizeOf(chtype));
+ Dispose(cur);
+ cur := tmp;
+ End;
+ End;
+ Dispose(p);
+End;
+
+{============================== tnMenu ====================================}
+
+{ A one-line procedural wrapper }
+Procedure nMakeMenu(
+ var mnu : tnMenu;
+ x,y,
+ _w,_r,_c,
+ ta,ca,ga,ba,ha : integer;
+ hasframe : boolean;
+ hdrpos : tnJustify;
+ hdrtxt : string);
+Begin
+ mnu.init(x,y,_w,_r,_c,ta,ca,ga,hasframe,ba);
+ If hdrtxt <> '' Then mnu.PutHeader(hdrtxt,ha,hdrpos);
+End;
+
+{ And with a menu pointer }
+Procedure nMakeMenu(
+ var mnu : pnMenu;
+ x,y,
+ _w,_r,_c,
+ ta,ca,ga,ba,ha : integer;
+ hasframe : boolean;
+ hdrpos : tnJustify;
+ hdrtxt : string);
+Begin
+ New(mnu,init(x,y,_w,_r,_c,ta,ca,ga,hasframe,ba));
+ If hdrtxt <> '' Then mnu^.PutHeader(hdrtxt,ha,hdrpos);
+End;
+
+Constructor tnMenu.Init(_x,_y,_w,_r,_c,_tc,_cc,_gc : integer;
+ _fr : boolean; _fc : integer);
+Begin
+ x := _x;
+ y := _y;
+ wid := _w;
+ r := _r;
+ c := _c;
+ tc := _tc;
+ cc := _cc;
+ gc := _gc;
+ framed := _fr;
+ fc := _fc;
+ hc := fc;
+ iidx := 0;
+ mark := '';
+ posted := false;
+ If wid > MaxCols Then wid := MaxCols;
+ InitWin;
+ Spin(false);
+End;
+
+Destructor tnMenu.Done;
+Begin
+ UnPost;
+ Clear;
+ Dispose(win,Done);
+End;
+
+Procedure tnMenu.InitWin;
+Const
+ xhgt : shortint = 0;
+Begin
+ If framed Then xhgt := 2 Else xhgt := 0;
+ New(win,Init(x,y,(x+wid-1),(y+r+xhgt-1),tc,framed,fc));
+End;
+
+Procedure tnMenu.Post;
+Var
+ bx,by,
+ mx,my : longint;
+ p : pchar;
+ a : array[0..SizeOf(tnS10)-1] of char;
+Begin
+ { could already be posted }
+ UnPost;
+ { see if the window size has changed (a new longer item added?) }
+ getmaxyx(win^.win,my,mx);
+ If (wid <> mx) Then Begin
+ getbegyx(win^.win,by,bx);
+ Dispose(win,Done);
+ x := bx+1;
+ y := by+1;
+ InitWin;
+ End;
+ { create the new menu }
+ pm := new_menu(@pi);
+ { only show item text }
+ menu_opts_off(pm,O_SHOWDESC);
+ { bind the windows }
+ set_menu_win(pm,win^.win);
+ set_menu_sub(pm,win^.wn);
+ { set the rows and columns }
+ set_menu_format(pm,r,c);
+ { set the colors }
+ set_menu_fore(pm,CursesAtts(cc));
+ set_menu_back(pm,CursesAtts(tc));
+ set_menu_grey(pm,CursesAtts(gc));
+ p := StrPCopy(a,mark);
+ set_menu_mark(pm,p);
+ merr := post_menu(pm);
+ posted := (merr = E_OK);
+ Spin(loopon);
+End;
+
+Procedure tnMenu.UnPost;
+Begin
+ merr := unpost_menu(pm);
+ merr := free_menu(pm);
+ pm := nil;
+ posted := false;
+End;
+
+Procedure tnMenu.Show;
+Begin
+ If not posted Then Post;
+ win^.Show;
+End;
+
+{ Start user interaction loop }
+Procedure tnMenu.Start;
+Const
+ select = #13;
+ cancel = #27;
+Var
+ key : char;
+ i,cnt,
+ prev,
+ savecurs,
+ xkey : integer;
+ direction : longint;
+Begin
+ Show;
+ iidx := 0;
+ savecurs := nCursor(cOFF);
+ Repeat
+ prev := iidx;
+ win^.Show;
+ key := readkey;
+ xkey := 0;
+ case key of
+ #0 : xkey := ord(readkey);
+ ^F : xkey := nKeyHome;
+ ^L : xkey := nKeyEnd;
+ #9,
+ ^N : xkey := nKeyDown;
+ ^P : xkey := nKeyUp;
+ else menu_driver(pm,ord(key));
+ end;
+ case xkey of
+ nKeyHome : menu_driver(pm,REQ_FIRST_ITEM);
+ nKeyEnd : menu_driver(pm,REQ_LAST_ITEM);
+ nKeyRight,
+ nKeyDown : menu_driver(pm,REQ_NEXT_ITEM);
+ nKeyLeft,
+ nKeyUp : menu_driver(pm,REQ_PREV_ITEM);
+ end;
+ iidx := item_index(current_item(pm)) + 1;
+ If (not Selectable(iidx)) and (key <> cancel) Then Begin
+ cnt := Count;
+ If cnt > 1 Then Begin
+ { temporarily enable spinning }
+ If not loopon Then
+ menu_opts_off(pm,O_NONCYCLIC);
+ { which way to another item? }
+ If iidx > prev Then
+ direction := REQ_NEXT_ITEM
+ Else
+ direction := REQ_PREV_ITEM;
+ Repeat
+ menu_driver(pm,direction);
+ i := item_index(current_item(pm)) + 1;
+ Until Selectable(i) or (i = iidx);
+ { reset spin }
+ Spin(loopon);
+ { keep prev honest }
+ iidx := item_index(current_item(pm)) + 1;
+ End;
+ End;
+ Until key in [select,cancel];
+ menu_driver(pm,REQ_CLEAR_PATTERN);
+ If iidx = ERR Then merr := iidx;
+ If key = cancel Then iidx := 0;
+ nCursor(savecurs);
+End;
+
+Procedure tnMenu.Stop;
+Begin
+ Hide;
+ UnPost;
+End;
+
+Procedure tnMenu.Hide;
+Begin
+ win^.Hide;
+End;
+
+Function tnMenu.Wind : pnWindow;
+Begin
+ Wind := win;
+End;
+
+Procedure tnMenu.Align(hpos,vpos : tnJustify);
+Begin
+ win^.Align(hpos,vpos);
+End;
+
+Procedure tnMenu.Move(_x,_y : integer);
+Begin
+ win^.Move(_x,_y);
+End;
+
+Procedure tnMenu.PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
+Begin
+ win^.PutHeader(hdr,hcolor,hpos);
+End;
+
+Procedure tnMenu.Clear;
+Var
+ i : integer;
+Begin
+ UnPost;
+ For i := 1 to nMAXMENUITEMS Do ClearItem(i);
+End;
+
+{ is this menu item selectable }
+Function tnMenu.Selectable(idx : integer) : boolean;
+Begin
+ Selectable := IsAssigned(idx) and
+ ((O_SELECTABLE and item_opts(pi[idx])) = O_SELECTABLE);
+End;
+
+Function tnMenu.IsValid(idx : integer) : boolean;
+Begin
+ IsValid := ((idx >= 1) and (idx <= nMAXMENUITEMS));
+End;
+
+Function tnMenu.IsAssigned(idx : integer) : boolean;
+Begin
+ IsAssigned := IsValid(idx) and (pi[idx] <> nil);
+End;
+
+Procedure tnMenu.ClearItem(idx : integer);
+Begin
+ If IsValid(idx) Then Begin
+ If items[idx] <> nil Then Begin
+ merr := free_item(pi[idx]);
+ If merr = E_OK Then Begin
+ FreeMem(items[idx],StrLen(items[idx]^)+1);
+ pi[idx] := nil;
+ items[idx] := nil;
+ End;
+ End;
+ End Else merr := E_BAD_ARGUMENT;
+End;
+
+Procedure tnMenu.AddItem(i : integer; s : string);
+Const
+ fwid : shortint = 0;
+ iwid : shortint = 1;
+Var
+ rl : integer;
+ sp1,sp2,sp3 : plongint;
+Begin
+ If IsValid(i) Then Begin
+ sp1:=nil; sp2:=nil; sp3:=nil;
+ ClearItem(i);
+ GetMem(items[i],Length(s)+1);
+ StrPCopy(items[i]^,s);
+ pi[i] := new_item(pchar(items[i]),nil);
+ If pi[i] <> Nil Then Begin
+ merr := E_OK;
+ { Expand the window width if necessary. Limit to screen width.
+ Add possibly 2 for the frame, the item indicator length, and
+ the item spacing value. }
+ If framed Then fwid := 2;
+ if c > 1 Then Begin
+ If posted Then Begin
+ { need a valid pm }
+ menu_spacing(pm,sp1,sp2,sp3);
+ iwid := Length(GetMark) + sp3^;
+ End Else
+ iwid := Length(GetMark) + 1;
+ End Else
+ iwid := 0;
+ { required length }
+ rl := ((Length(s)+iwid)*c)+fwid;
+ { expand? }
+ If rl > wid Then wid := rl;
+ If wid > MaxCols Then wid := MaxCols;
+ End Else merr := E_REQUEST_DENIED;
+ End Else merr := E_BAD_ARGUMENT;
+End;
+
+Function tnMenu.Add(s : string) : integer;
+Var
+ i : integer;
+Begin
+ i := 0;
+ Add := 0;
+ Repeat
+ inc(i);
+ Until (i > nMAXMENUITEMS) or (items[i] = nil);
+ AddItem(i,s);
+ If merr = E_OK Then Add := i;
+End;
+
+Procedure tnMenu.Insert(idx : integer; s : string);
+Begin
+ If IsValid(idx) Then Begin
+ ClearItem(nMAXMENUITEMS);
+ If idx < nMAXMENUITEMS Then Begin
+ { shift the pointer list up and keep lists syncronized }
+ system.Move(pi[idx],pi[idx+1],SizeOf(pnMenuStr)*(nMAXMENUITEMS-idx));
+ system.Move(items[idx],items[idx+1],SizeOf(pItem)*(nMAXMENUITEMS-idx));
+ pi[idx] := nil;
+ items[idx] := nil;
+ End;
+ AddItem(idx,s);
+ End Else merr := E_BAD_ARGUMENT;
+End;
+
+Procedure tnMenu.Remove(idx : integer);
+Begin
+ If IsValid(idx) Then Begin
+ ClearItem(idx);
+ { shift the pointer list down and keep lists syncronized }
+ system.Move(pi[idx+1],pi[idx],SizeOf(pnMenuStr)*(nMAXMENUITEMS-idx));
+ system.Move(items[idx+1],items[idx],SizeOf(pItem)*(nMAXMENUITEMS-idx));
+ pi[nMAXMENUITEMS] := nil;
+ items[nMAXMENUITEMS] := nil;
+ End Else merr := E_BAD_ARGUMENT;
+End;
+
+Procedure tnMenu.Change(idx : integer; s : string);
+Begin
+ AddItem(idx,s);
+End;
+
+{ toggle a menu item's selectability }
+Procedure tnMenu.Active(idx : integer; b : boolean);
+Begin
+ Case b of
+ true : item_opts_on(pi[idx],O_SELECTABLE);
+ false : item_opts_off(pi[idx],O_SELECTABLE);
+ End;
+End;
+
+{ is the item selectable? }
+Function tnMenu.IsActive(idx : integer) : boolean;
+Begin
+ IsActive := Selectable(idx);
+End;
+
+{ Toggle item looping. Moves to first/last when bottom/top is reached }
+Procedure tnMenu.Spin(b : boolean);
+Begin
+ loopon := b;
+ If posted Then
+ Case b of
+ true : menu_opts_off(pm,O_NONCYCLIC);
+ false : menu_opts_on(pm,O_NONCYCLIC);
+ End;
+End;
+
+{ return most recent error status }
+Function tnMenu.Status : integer;
+Begin
+ Status := merr;
+End;
+
+Function tnMenu.Index : integer;
+Begin
+ Index := iidx;
+End;
+
+Procedure tnMenu.SetIndex(idx : integer);
+Begin
+ If IsValid(idx) and IsAssigned(idx) and Selectable(idx) Then Begin
+ set_current_item(pm,pi[idx]);
+ iidx := idx;
+ End;
+End;
+
+Function tnMenu.Count : integer;
+Begin
+ Count := item_count(pm);
+End;
+
+Function tnMenu.Rows(_r : integer) : integer;
+Begin
+ Rows := r;
+ If _r > 0 Then r := _r;
+End;
+
+Function tnMenu.Cols(_c : integer) : integer;
+Begin
+ Cols := c;
+ If _c > 0 Then c := _c;
+End;
+
+{ get the item indicator prefix string }
+Function tnMenu.GetMark : string;
+Begin
+ If posted Then
+ GetMark := StrPas(menu_mark(pm))
+ Else
+ GetMark := mark;
+End;
+
+{ set the item indicator prefix string }
+Procedure tnMenu.SetMark(ms : string);
+Begin
+ mark := ms;
+End;
+
+Procedure tnMenu.Refresh;
+Begin
+ Post;
+ Show;
+End;
+
+Procedure tnMenu.SetColor(att : byte);
+Begin
+ tc := att;
+ If posted Then set_menu_back(pm,CursesAtts(tc));
+End;
+
+Procedure tnMenu.SetCursorColor(att : byte);
+Begin
+ cc := att;
+ If posted Then set_menu_fore(pm,CursesAtts(cc));
+End;
+
+Procedure tnMenu.SetFrameColor(att : byte);
+Begin
+ fc := att;
+ If posted Then Wind^.PutFrame(att);
+End;
+
+Procedure tnMenu.SetGrayColor(att : byte);
+Begin
+ gc := att;
+ If posted Then set_menu_grey(pm,CursesAtts(gc));
+End;
+
+{----------------------- initialize the unit!------------------------- }
+Begin
+ FillChar(_chmap,SizeOf(_chmap),0);
+ nEC.Init(false,false,false,false,false,'','',15,_chmap);
+ { load the color pairs array with color pair indices (0..63) }
+ For bg := 0 to 7 Do For fg := 0 to 7 do cp[bg,fg] := (bg*8)+fg;
+ { initialize ncurses }
+ If StartCurses(ActiveWn) Then Begin
+ { save pointer to ncurses stdscr }
+ nscreen := ActiveWn;
+ { defaults, crtassign, etc. }
+ nInit;
+ { create the default full screen, non-bordered window object }
+ nStdScr.Init(1,1,MaxCols,MaxRows,7,false,0);
+ { default read/write to stdscr }
+ ActiveWn := nscreen;
+ End Else Begin
+ CursesFailed;
+ End;
+End. { of Unit oCrt }
+
diff --git a/packages/ncurses/src/panel.pp b/packages/ncurses/src/panel.pp
new file mode 100644
index 0000000000..042c2173d4
--- /dev/null
+++ b/packages/ncurses/src/panel.pp
@@ -0,0 +1,64 @@
+unit panel;
+{---------------------------------------------------------------------------
+ CncWare
+----------------------------------------------------------------------------
+ Filename..: panel.pp
+ Programmer: Ken J. Wright
+ Date......: 12/08/1999
+
+ Purpose - Link to the Linux 'panel' library for ncurses windowing
+ functions. The panel library handles overlapping windows,
+ whereas, native ncurses windowing is only tiled.
+
+-------------------------------< Revisions >---------------------------------
+ Revision| Date | Prog| Description
+-----------------------------------------------------------------------------
+ 1.00 | 12/08/99 | kjw | Initial release.
+-----------------------------------------------------------------------------
+}
+interface
+uses ncurses;
+
+{$PACKRECORDS 4}
+{$linklib panel}
+
+ const
+ libpanel = 'panel';
+
+ type
+
+ pPANEL = ^_PANEL;
+
+ _PANEL = record
+ win : ^WINDOW;
+ wstarty : longint;
+ wendy : longint;
+ wstartx : longint;
+ wendx : longint;
+ below : ppanel;
+ above : ppanel;
+ user : longint; { NCURSES_CONST void user; }
+ obscure : pointer;
+ end;
+
+ function panel_window(_para1:pPANEL):pWINDOW;cdecl;external libpanel;
+ procedure update_panels;cdecl;external libpanel;
+ function hide_panel(_para1:pPANEL):longint;cdecl;external libpanel;
+ function show_panel(_para1:pPANEL):longint;cdecl;external libpanel;
+ function del_panel(_para1:pPANEL):longint;cdecl;external libpanel;
+ function top_panel(_para1:pPANEL):longint;cdecl;external libpanel;
+ function bottom_panel(_para1:pPANEL):longint;cdecl;external libpanel;
+ function new_panel(_para1:pWINDOW):pPANEL;cdecl;external libpanel;
+ function panel_above(_para1:pPANEL):pPANEL;cdecl;external libpanel;
+ function panel_below(_para1:pPANEL):pPANEL;cdecl;external libpanel;
+
+ { extern int set_panel_userptr(PANEL , NCURSES_CONST void ); }
+ { extern NCURSES_CONST void panel_userptr(const PANEL ); }
+
+ function move_panel(_para1:pPANEL; _para2:longint; _para3:longint):longint;cdecl;external libpanel;
+ function replace_panel(_para1:pPANEL; _para2:pWINDOW):longint;cdecl;external libpanel;
+ function panel_hidden(_para1:pPANEL):longint;cdecl;external libpanel;
+
+implementation
+
+end.
diff --git a/packages/ncurses/src/pxpic.inc b/packages/ncurses/src/pxpic.inc
new file mode 100644
index 0000000000..42dbfe2fbf
--- /dev/null
+++ b/packages/ncurses/src/pxpic.inc
@@ -0,0 +1,448 @@
+{---------------------------------------------------------------------------
+ CncWare
+ Created and Copyright (c) 1991 J. John Sprenger
+----------------------------------------------------------------------------
+ Filename..: pxpic.inc
+ Programmer: Ken J. Wright, ken@cncware.com
+ Date......: 06/09/2000
+
+ Purpose - Duplicates the functionality of the TPXPictureValidator.IsValid
+ method from Turbo Vision's validate unit. This function was
+ extracted from a unit called fmtline written by J. John Sprenger.
+ It was actually written before the validate unit was available
+ from Borland in TV2.0.
+
+-------------------------------<< REVISIONS >>--------------------------------
+ Ver | Date | Prog| Description
+-------+----------+-----+-----------------------------------------------------
+ 1.00 | 06/10/00 | kjw | Initial Release.
+ 1.01 | 06/11/00 | kjw | Finally debugged the spin cycle! The AnyLeft function
+ | missed a condition that left it an endless loop.
+ | Added the boolean "done" to fix it.
+ 1.02 | 06/15/00 | kjw | Added '@' to the match set.
+------------------------------------------------------------------------------}
+
+ { Created and Copyright (c) 1991 J. John Sprenger }
+
+ { tFormatLine.CheckPicture is the function that inspects }
+ { the input string passed as S against the Pic string }
+ { which holds the Paradox-form Picture. If an error is }
+ { found the position of the error is placed in CPos. }
+
+function nCheckPxPicture(var s, Pic : string;
+ var CPos : integer) : word;
+ const
+ { flError, flCharOk and flFormatOK are constants used }
+ { by tFormatLine.CheckPicture. flError is returned }
+ { when an error is found, flCharOk when an character }
+ { is found to be appropriate, And flFormatOk when the }
+ { entire input string is found acceptable. }
+ flError = $0000;
+ flCharOK = $0001;
+ flFormatOK = $0002;
+
+ var
+ Resolved : integer;
+ TempIndex : integer;
+
+ { Function Copy represents a bit of syntactic sugar for }
+ { the benefit of the author. It changes the Copy func. }
+ { so that its parameters represent start and end points }
+ { rather than a start point followed by a quantity. }
+ function Copy(s : string; start, stop : integer) : string;
+ begin
+ if stop < start then Copy:=''
+ else Copy:=System.Copy(s,start,stop-start+1);
+ end;
+
+ { Function FindMatch recursively locates the matching }
+ (* grouping characters for "{" and "[". *)
+ function FindMatch(P : string) : integer;
+ var
+ i:integer;
+ match:boolean;
+ begin
+ i:=2;
+ match:=false;
+ while (i<=length(P)) and not match do begin
+ if ((p[i]=']') and (p[1]='[')) or ((p[i]='}') and
+ (p[1]='{')) then
+ match:=true;
+ if p[i]='{' then
+ i:=i+FindMatch(Copy(p,i,length(p)))
+ else
+ if p[i]='[' then
+ i:=i+FindMatch(Copy(p,i,length(P)))
+ else inc(i);
+ end;
+ FindMatch:=i-1;
+ end;
+
+ { Function CP is the heart of tFormatLine. It }
+ { determines if the string, s, passed to it fits the }
+ { requirements of the picture, Pic. The number of }
+ { characters successfully resolved is returned in the }
+ { parameter resolved. When groups or repetitions are }
+ { encountered CP will call itself recursively. }
+ function CP(var s : string; Pic : string; var CPos :
+ integer; var Resolved : integer) : word;
+ const
+ CharMatchSet = ['#', '?', '&', '''', '@', '!'];
+ var
+ i : integer;
+ index : integer;
+ result_ : word;
+ commit : boolean;
+ Groupcount : integer;
+
+ { Procedure Succeed resolves defaults and <Space> }
+ { default requests }
+
+ { Note:
+ The little patch below to exclude group end checking during
+ expansion lets autofill work as it should, however it also
+ autofills prematurely when there are more optionals or
+ alternates. I haven't quite figured how to make this work
+ correctly within the current recursion scheme.
+ kjw
+ }
+ procedure Succeed;
+ var
+ t : integer;
+ found : boolean;
+ begin
+ if (i <= Length(s)) and
+ (s[i]=' ') and
+ (Pic[index]<>' ') and
+ (Pic[index]<>',')
+ then begin
+ t:=index;
+ found:=false;
+ while (t<=length(pic)) and not found do begin
+ if not (Pic[t] in (CharMatchSet+
+ ['*','[','{',',',']','}'])) then begin
+ if pic[t]=';' then inc(t);
+ s[i]:=Pic[t];
+ found:=true;
+ end;
+ inc(t);
+ end;
+ end;
+ if (i>length(s)) then
+ {----------------------}
+ { Expand with defaults }
+ while not (Pic[index] in
+ (CharMatchSet+['*','[','{',',',']','}'])) and
+ (index<=length(Pic)) and
+ not(Pic[index-1] in [(*'}',*)','(*,']'*)]) do begin {kjw}
+ if Pic[index]=';' then inc(index);
+ s[i]:=Pic[index];
+ if i>length(s) then begin
+ CPos:=i;
+ s[0]:=char(i);
+ end;
+ inc(i);
+ inc(index);
+ end;
+ end;
+
+ { Function AnyLeft returns true if there are no required }
+ { characters left in the Picture string. }
+ function AnyLeft : boolean;
+ var
+ TempIndex : integer;
+ done : boolean; {kjw, 06/11/2000}
+ begin
+ done := false;
+ TempIndex:=index;
+ while ((Pic[TempIndex]='[') or (Pic[TempIndex]='*'))
+ and (TempIndex<=Length(Pic))
+ and (Pic[TempIndex]<>',')
+ and not done do begin
+ if Pic[TempIndex]='[' then
+ Tempindex:=Tempindex+FindMatch(Copy(Pic,index, Length(Pic)))
+ else begin
+ if not (Pic[TempIndex+1] in ['0'..'9']) then begin
+ inc(TempIndex);
+ if Pic[TempIndex] in ['{','['] then
+ tempIndex:=TempIndex+ FindMatch(Copy(pic,index,length(pic)))
+ else inc(TempIndex);
+ end else done := true;
+ end;
+ end;
+ AnyLeft:=(TempIndex<=length(Pic)) and
+ (Pic[TempIndex]<>',');
+ end;
+
+ { Function CharMatch determines if the current character }
+ { matches the corresponding character mask in the }
+ { Picture string. Alters the character if necessary. }
+ function CharMatch : word;
+ var result_ : word;
+ begin
+ result_:=flError;
+ case Pic[index] of
+ '#': if s[i] in ['0'..'9'] then result_:=flCharOk;
+ '?': if s[i] in ['A'..'Z','a'..'z'] then
+ result_:=flCharOk;
+ '&': if s[i] in ['A'..'Z','a'..'z'] then
+ begin
+ result_:=flCharOk;
+ s[i]:=upcase(s[i]);
+ end;
+ '''': result_:=flCharOk;
+ '@': result_:=flCharOk;
+ '!': begin
+ result_:=flCharOk;
+ s[i]:=upcase(s[i]);
+ end;
+ end;
+ if result_<>flError then commit:=true;
+ CharMatch:=result_;
+ end;
+
+ { Function Literal handles characters which are needed }
+ { by the picture but otherwise used as format specifiers. }
+ { All such characters are preceded by the ';' in the }
+ { picture string. }
+ function Literal : word;
+ var result_ : word;
+ begin
+ inc(index);
+ if s[i]=Pic[index] then result_:=flCharOk
+ else result_:=flError;
+ if result_<>flError then commit:=true;
+ Literal:=result_;
+ end;
+
+ { Function Group handles required and optional groups }
+ { in the picture string. These are designated by the }
+ (* "{","}" and "[","]" character pairs. *)
+ function Group:word;
+ var
+ result_: word;
+ TempS: string;
+ TempPic: string;
+ TempCPos: integer;
+ PicEnd: integer;
+ TempIndex: integer;
+ SwapIndex:integer;
+ SwapPic : string;
+ begin
+ TempPic:=Copy(Pic,index,length(Pic));
+ PicEnd:=FindMatch(TempPic);
+ TempPic:=Copy(TempPic,2,PicEnd-1);
+ TempS:=Copy(s,i,length(s));
+ TempCPos:=1;
+
+ result_:=CP(TempS,TempPic,TempCPos,TempIndex);
+
+ if result_=flCharOK then inc(GroupCount);
+ if (result_=flFormatOK) and (groupcount>0) then
+ dec(GroupCount);
+ if result_<>flError then result_:=flCharOk;
+
+ SwapIndex:=index;
+ index:=TempIndex;
+ SwapPic:=Pic;
+ Pic:=TempPic;
+ if not AnyLeft then result_:=flCharOk;
+ pic:=SwapPic;
+ index:=SwapIndex;
+ if i>1 then s:=copy(s,1,i-1)+TempS else s:=TempS;
+
+ CPos:=Cpos+TempCPos-1;
+ if Pic[index]='[' then begin
+ if result_<>flError then
+ i:=i+TempCPos-1
+ else dec(i);
+ result_:=flCharOK;
+ end
+ else i:=i+TempCPos-1;
+ index:=index+PicEnd-1;
+ Group:=result_;
+ end;
+
+ { Function Repetition handles characters that may be }
+ { repeated in the input string. The picture string }
+ { indicates this possiblity with "*" character. }
+ function Repetition:word;
+ var
+ result_:word;
+ count:integer;
+ TempPic:string;
+ TempS:string;
+ TempCPos:integer;
+ TempIndex:integer;
+ SwapIndex:integer;
+ SwapPic:string;
+ PicEnd:integer;
+ commit:boolean;
+
+ procedure MakeCount;
+ var nstr:string;
+ code:integer;
+ begin
+ if Pic[index] in ['0'..'9'] then begin
+ nstr:='';
+ repeat
+ nstr:=nstr+Pic[index];
+ inc(index);
+ until not(Pic[index] in ['0'..'9']);
+ val(nstr,count,code);
+ end
+ else count:=512;
+ end;
+
+ procedure MakePic;
+ begin
+ if Pic[index] in ['{','['] then begin
+ TempPic:=copy(Pic,index,length(Pic));
+ PicEnd:=FindMatch(TempPic);
+ TempPic:=Copy(TempPic,2,PicEnd-1);
+ end
+ else begin
+ if Pic[index]<>';' then begin
+ TempPic:=''+Pic[index];
+ PicEnd:=3;
+ if index=1 then
+ pic:='{'+pic[index]+'}'+ copy(pic,index+1,length(pic))
+ else pic:=copy(pic,1,index-1)+
+ '{'+pic[index]+'}'+
+ copy(pic,index+1,length(pic));
+ end
+ else begin
+ TempPic:=Pic[index]+Pic[index+1];
+ PicEnd:=4;
+ if index=1 then
+ pic:='{' + pic[index] + pic[index+1]+'}' +
+ copy(pic,index+1,length(pic))
+ else pic:=copy(pic,1,index-1) + '{' + pic[index] +
+ pic[index+1] + '}' + copy(pic,index+1,length(pic));
+ end;
+ end;
+ end;
+
+ begin
+ inc(index);
+ MakeCount;
+ MakePic;
+ result_:=flCharOk;
+ while (count<>0) and (result_<>flError) and
+ (i<=length(s)) do begin
+ commit:=false;
+ TempS:=Copy(s,i,length(s));
+ TempCPos:=1;
+ result_:=CP(TempS,TempPic,TempCPos,TempIndex);
+
+ if result_=flCharOK then inc(GroupCount);
+ if (result_=flFormatOK) and (groupcount > 0) then
+ dec(GroupCount);
+ if result_<>flError then result_:=flCharOk;
+
+ SwapIndex:=Index;
+ Index:=TempIndex;
+ SwapPic:=Pic;
+ Pic:=TempPic;
+ if (not AnyLeft) then result_:=flCharOk;
+ Pic:=SwapPic;
+ index:=SwapIndex;
+ if i>1 then s:=copy(s,1,i-1)+TempS else s:=TempS;
+ Cpos:=Cpos+TempCpos-1;
+ if (count>255) then begin
+ if result_<>flError then begin
+ i:=i+TempCpos-1;
+ if not commit then commit:=true;
+ result_:=flCharOk;
+ end
+ else dec(i);
+ end
+ else i:=i+TempCPos-1;
+ inc(i);
+ dec(count);
+ end;
+ dec(i);
+ index:=index+PicEnd-1;
+ if result_=flError then
+ if (count>255) and not commit
+ then result_:=flCharOk;
+ repetition:=result_;
+ end;
+
+ begin { of function CP}
+ i:=1;
+ index:=1;
+ result_:=flCharOk;
+ commit:=false;
+ Groupcount:=0;
+ while (i<=length(s)) and (result_<>flError) do begin
+ if index>length(Pic) then result_:=flError
+ else begin
+ if s[i]=' ' then Succeed;
+ if Pic[index] in CharMatchSet then
+ result_:=CharMatch
+ else
+ if Pic[index]=';' then
+ result_:=Literal
+ else
+ if (Pic[index]='{') or (Pic[index]='[') then
+ result_:=Group
+ else
+ if Pic[index]='*' then
+ result_:=Repetition
+ else
+ if Pic[index] in [',','}',']'] then
+ result_:=flError
+ else
+ if Pic[index]=s[i] then begin
+ result_:=flCharOk;
+ commit:=true;
+ end
+ else result_:=flError;
+ if (result_ = flError) and not commit then begin
+ TempIndex:=Index;
+ while (TempIndex<=length(Pic)) and
+ ((Pic[TempIndex]<>',') and
+ (Pic[TempIndex-1]<>';')) do begin
+ if (Pic[TempIndex]='{') or
+ (Pic[TempIndex]=']') then
+ Index:=FindMatch(Copy( Pic,
+ TempIndex,length(Pic)))+TempIndex-1;
+ inc(TempIndex);
+ end;
+ if Pic[TempIndex]=',' then begin
+ if Pic[TempIndex-1]<>';' then begin
+ result_:=flCharOk;
+ index:=TempIndex;
+ inc(index);
+ end;
+ end;
+ end
+ else if result_<>flError then begin
+ inc(i);
+ inc(index);
+ Succeed;
+ end;
+
+ end;
+ end;
+ Resolved:=index;
+
+ if (result_=flCharOk) and
+ (GroupCount=0) and
+ (not AnyLeft or ((Pic[index-1]=',') and
+ (Pic[index-2]<>';'))) then
+ result_:=flFormatOk;
+
+ CPos:=i-1;
+ CP:=result_;
+ end;
+
+begin{ of function CheckPicture}
+ Resolved:=0;
+ CPos := 0;
+ If (Pic = '') or (s = '') Then
+ nCheckPxPicture := flFormatOk
+ Else
+ nCheckPxPicture:=CP(s,Pic,CPos,Resolved);
+end;
diff --git a/packages/ncurses/src/pxpic.txt b/packages/ncurses/src/pxpic.txt
new file mode 100644
index 0000000000..729558511a
--- /dev/null
+++ b/packages/ncurses/src/pxpic.txt
@@ -0,0 +1,390 @@
+This text describes the Paradox picture input masking capabilities. It comes
+from chapter 5 of the Paradox PAL Programmers Guide for Paradox 4.0. This is
+what the nSEdit() function in the oCrt unit uses to mask user input when a
+picture string has been set for the nEC.Picture property.
+
+CHAPTER 5
+
+Using pictures to format input
+
+A PAL picture is a powerful and flexible tool for controlling what a
+user can type into a field during data entry. You can use pictures to
+
+a) shape and limit what the user can type into a field
+
+b) make data entry easier by filling in required or default values
+ automatically.
+
+You can think of pictures as a way to define new field types by
+imposing restrictions on existing ones. In effect, the Social Security
+number picture in Example 5-1 defines a new type of alphanumeric
+field. So would a picture of a telephone number (with or without the
+area code), or a part number in which X is always the second
+character. Pictures can also help users fill in default or repetitive
+values during data entry. For instance, through a picture, you can
+specify that the X in the part number will be filled in automatically.
+
+Example 5-1 Using a picture to format input.
+
+Suppose you want a user to enter Social Security numbers. Use a picture
+to make sure the input has the proper format.
+
+PICTURE = "###-##-###"
+
+The picture fills in the hyphens automatically and ensures that the user types
+the proper number of digits -- no other characters will be accepted.
+
+When a picture is specified, the user must fill it exactly and
+completely. In Example 5-1, if a user starts by typing a letter, a beep
+results. If someone tries to leave the field before typing all the digits,
+Paradox displays the message Incomplete field and leaves the cursor
+in the field.
+
+While a user is typing data into a picture, pressing Backspace or Del
+erases characters and Ctrl-Backspace clears the field as long as the
+resulting entry fills the picture. You can also design the picture to fill
+in optional characters when the user presses Space.
+
+How to define pictures
+
+A picture is a kind of pattern. It consists of a sequence of literal
+characters interlaced with any of the match characters listed in
+Table 5-1.
+
+Table 5-1 Match characters in pictures
+
+Picture element Description
+---------------- --------------------------------------------
+
+Match characters
+
+# Accept only a digit
+? Accept only a letter (upper- or lowercase)
+& Accept only a letter, convert to uppercase
+@ Accept any character
+! Accept any character, convert to uppercase
+t Any character taken literally
+
+Special characters
+
+; Take next character literally
+* Repetition count
+[] Option
+{} Grouping operators
+, Set of alternatives
+---------------------------------------------------------------
+Any number, letter, or punctuation character not defined as one of the unique
+match or special characters (that is, anything you can type that isn't on this
+list) is taken literally.
+
+The Social Security number in Example 5-1 was specified with the
+picture ###-##-####. The # is a match character that accepts only
+digits in its place. The hyphen is a literal character, meaning that it
+must literally appear in the typed value (matched exactly).
+Literal characters in a picture are filled in automatically unless
+
+a) you specify otherwise (see "Inhibiting automatic fill-in" later in
+ this chapter)
+b) they occur at the beginning of a picture (this helps to
+ accommodate blank fields)
+
+For example, when the cursor arrives at a blank field governed by the
+picture
+
+ABC-###
+
+the "ABC-" is not filled in automatically because it occurs at the
+beginning of the picture. But as soon as the user types A or a, or
+presses Space, the "ABC-" appears.
+
+If you want to specify a literal character that happens to be a match
+character, precede it with a semicolon (;). For example, here's how
+you'd specify a part number that contains three letters, a hyphen, and
+a number sign (#):
+
+???-;#
+
+If you omitted the semicolon, the picture would call for three letters,
+a hyphen, and a digit. You can use the semicolon in a picture to
+precede any of the characters in Table 5-1 that you want to be taken
+literallyincluding the semicolon itself. Here are some other
+examples:
+
+$*#.##;@ ; price each, like $345.67@
+*?;? ; questions, adding ? to any text
+###;,### ; six-digit number with comma separating thousands,
+ ; like 345.678
+???;;;# ; part number with three letters, semicolon, and
+ ; number sign, like ABC;#
+
+
+Special features of
+pictures
+
+The special features of pictures are described in detail in the
+following sections. These spedal features are summarized in Table 5-2
+
+Table 5-2 Special features of pictures
+
+Operator Name Examples Satisfied by
+-------- -------- ----------------- ---------------------------------------
+* Repeat *5# Five numbers; equivalent to #####
+ *# Zero or more numbers
+ (*#.##), *#.## Currency amounts, negative or
+ positive
+ &*? Initial capitalization of a single word
+{ } Set *5{##} Ten numbers or five times the set of
+ two numbers
+
+ {20,40,60,75,100}W Light bulbs in different wattages
+[ ] Optional ###-####[###[#]] Phone number with or without a 3-
+ or 4-digit extension
+ *[&[*?][@][ ]] Any number of capitalized words
+ and initials
+, Alternative RED,BLUE Literals "RED" or "BLUE"; entering
+ an R fills RED, a B fills BLUE
+ ###,## 2- or 3-digit number; ##,### would
+ not work
+{ } Inhibit ###{-)## The hyphen is not filled in
+ Fill automatically: the user must press
+ Space to have the hvohen filled in
+------------------------------------------------------------------------------
+
+Repetition counts
+
+You'll find the repetition count match character (*) useful when
+specifying pictures for long fields. For example, these two pictures
+are equivalent:
+
+*25#
+#########################
+
+The match character * in the first picture is followed by a number,
+which is the number of times to repeat the match character or literal
+that follows. If you omit the *, the picture would mean the number 25
+followed by any other digit.
+
+To repeat a group of match characters, enclose the group in braces {}
+following the number of repetitions:
+
+*3{##:} ; equivalent to ##:##:##:
+
+Notice how this picture mixes literal and match characters in the
+group. Each group consists of two digits to be typed by the user and
+a colon to be filled in by Paradox.
+
+Also use the grouping braces {} when you want to repeat a single
+number, as in
+
+*3{5}# ; equivalent to 555# (three fives followed by any other digit)
+
+Without the braces, Paradox would think you wanted *35#, 35
+repetitions of "#".
+
+Omitting the number after the *, tells Paradox to accept zero or more
+repetitions of the character or group. You might use this variation
+when you want the user to type at least a certain number of
+characters, but perhaps more. For example, this picture in a State field
+
+&&*&
+
+requires at least the two-letter state abbreviation, but would also
+accept a state name spelled out in full.
+
+To use the * as a literal character in a picture, precede it with a
+semicolon (;). For example,
+
+;*###;* ; equivalent to *###*
+
+Optional elements
+
+You can make part of a value optional by enclosing the
+corresponding part of the picture within brackets [ ]. This means that
+the user can enter data for that part of the value, but is not required
+to do so. The user can accept the optional part by typing a character
+that fits it or by pressing Space if the character is a literal.
+
+Note: When the user reaches an optional part of a value, any matching
+character accepts the entire optional part. For example,
+
+[###l ###-####
+
+doesn't make the area code optional. Suppose the user tries to skip the
+area code and types the first digit of the phone number. Since this
+matches the first optional character, Paradox assumes it is the area
+code and requires all 10 digits.
+
+Similarly, the following picture won't work to specify a number with
+either two or three digits:
+
+[#]##
+
+since the first digit typed is always understood to be the [#]. To
+specify an optional number of digits, place the optional portion after
+the required portion:
+
+##[#]
+
+Here, the first two digits typed will match the mandatory #
+characters, and the third digit may or may not be added. Remember
+that pictures are always scanned left to right, so the optional portion
+of a repeating element should always come at the end.
+
+Example 5-2 demonstrates the correct way to create a picture for a
+telephone number with an optional area code.
+
+Example 5-2 Options in pictures
+
+The following picture accepts a 7-digit telephone number with an optional,
+parenthesized 3-digit area code:
+
+[(###)] ### - ####
+
+The user can fill in this field in two ways:
+
+a) If the first character typed is the left parenthesis or Space,
+ it matches the optional part of the picture and Paradox will look for a
+ 3-digit area code before the 7-digit number.
+
+b) If the first character typed is a digit, Paradox ignores the option and
+ skips to the required digits. The right parenthesis (if used) and hyphen
+ are filled in automatically.
+
+Literal characters at the beginning of an optional part of a value are
+never filled in automatically. For example, in the picture
+
+#[ABC]#
+
+the characters "ABC" are not automatically filled in after the user
+types the first digit. They are filled in if the user types "A" or "a" or
+presses Space. The automatic fill-in occurs only when the filled-in
+characters are mandatory, or when the user explicitly elects the
+option by typing the first character or pressing Space.
+
+Optional elements can be nested, as in the following picture:
+
+#[[#[a]]
+
+Because the characters [ and ] are used to specify options, they must
+be preceded by a semicolon (;) if you want to use them literally in a
+picture.
+
+Alternative choices
+
+Many applications require the user to type one of several possible
+choices as part or all of a data value. A part number, for example,
+might consist of a three-digit number, followed by a color code of
+RED, GRE, YEL, or BLU, followed by another three-digit number.
+You specify a set of alternatives in a picture as a comma-separated list
+of alternatives. For example, you could specify the color-coded part
+numbers like this:
+
+###RED###, ###G RE###, ###YEL###, ###BLU###
+
+or, more succinctly,
+
+###{RED,GRE,YEL,BLU}###
+
+Both of these pictures have the same effect. In the second, the braces
+have been used to group the alternatives.
+
+As with bracketed options, literal characters at the beginning of an
+alternative are not filled in automatically. For example, if the user
+types 345 in the preceding example, the characters RED are not then
+filled in. But if the user then presses Spacebar or types r, the ED is
+filled in. Similarly, if the user types g, the RE is filled in, and so on.
+Paradox always fills in the first matching alternative it finds; thafs
+why RED is filled in when the user presses Space. To get one of the
+other options, the user must type its first letter.
+
+Example 5-3 Alternatives in a date picture
+
+The following example lets you restrict input in a date field to dates falling
+within the first week of a month:
+
+#[#]/{1.2,3,4.5,6,7}/##[#][#]
+
+Note the use of optional digits to permit months to have either one or two
+digits and years to have two, three, or four. Again, since pictures are scanned
+from left to right, the optional elements always come at the end of that part of
+the picture.
+
+The different alternatives need not be composed of literal characters;
+they can be picture specifications of any kind (Example 5-3). For
+example, here's another way of specifying a two- or three-digit
+number:
+
+###,##
+
+Again, the picture ##,### wouldn't do the job, because once the first
+two digits are typed, the first alternative will be selected and the
+picture will be fully satisfied. If the user then types a third digit, a
+beep sounds.
+
+The following picture specifies that an alphanumeric value can either
+be True or False:
+
+True,False
+
+Using this picture or variations on it, you can easily obtain the effect
+of a logical value or create a field of type logical in a Paradox table.
+
+As with other match characters, if you want to use a comma (,) as a
+literal character in a picture, you must precede it with a semicolon (;).
+
+Inhibiting automatic fill-in
+
+Some users find automatic fill-in of literal characters annoying
+particularly if they seldom look at the screen as they type. To inhibit
+it, simply enclose the literal characters you don't want filled in within
+braces I }. For example, this picture inhibits the fill-in of hyphens in
+Social Security numbers:
+
+###{-}##{-}####
+
+When the user types the first three digits, the hyphen (-) is not filled
+in. To enter it, the user can press - or Space.
+
+Sometimes you must inhibit fill-in to get the effect you want. In the
+color-coded part numbers in the previous section, suppose we had
+the color code BRO in addition to RED, GRE, YEL, and BLU. Adding
+BRO to the preceding picture gives
+
+###{RED,GRE,YEL,BLU,BRO}###
+
+Now suppose the user types three digits and then a b. Since BLU is
+the first possible match (left to right), Paradox would fill in the LU
+automatically. This could be wrong, since the user may have had
+BRO in mind rather than BLU. To solve this problem, use either of
+these pictures to inhibit automatic fill-in of the L:
+
+###{RED,GRE,YEL,B{L}U,BRO}###
+
+###{RED,GRE,YEL,B{LU,RO}}###
+
+The second picture, in effect, factors the letter B out of both BLU and
+BRO. This forces the user to type two characters to specify the blue or
+brown color code. The (LU, RO} is a set of alternative choices that has
+been nested within the larger set of choices.
+
+Going a step further, here's how you could inhibit all of the fill-in:
+
+###(R{E}{D},G{R}{E},Y{E}{L},B{L}{U},B{R}{0}}###
+
+Picture examples
+
+By using PAL's regular and special match characters, you can create
+an almost endless variety of picturesin effect, new data typesfor
+your applications. Here are just a few examples:
+
+(*#.##),*#.## ; currency amounts, using parentheses for
+ ; negative quantities
+#[#][#]*{;,###} ; positive integers with commas separating
+ ; groups of three digits
+{20,40,60,75,100}W ; light bulbs in different wattages
+{A,B,C.D,E,F,G,H}[R]##-## ; tire sizes
+&*? ; initial capitalization of a single word
+&. &. &*? ; two initials followed by a capitalized name
+ ; of any length
+*[&[*?][@][ ]] ; any number of capitalized words or initials
+{##}:{##}:{##} ; for time
diff --git a/packages/ncurses/tests/testn.pp b/packages/ncurses/tests/testn.pp
new file mode 100644
index 0000000000..b60c41e4bd
--- /dev/null
+++ b/packages/ncurses/tests/testn.pp
@@ -0,0 +1,31 @@
+{
+
+ Simple ncurses test
+}
+program testn;
+uses
+ ncurses;
+
+var
+ win : pWINDOW;
+begin
+ if initscr=Nil then halt(1);
+ start_color;
+ win:= newwin (10,60,10,10);
+ if win=nil then
+ begin
+ endwin;
+ halt(1);
+ end;
+ init_pair(1,COLOR_WHITE,COLOR_BLUE);
+ wbkgd(win, COLOR_PAIR(1));
+ erase;
+ refresh;
+ box(win, ACS_VLINE, ACS_HLINE);
+ wrefresh(win);
+ mvwaddstr(win,1,1,'Press any key to continue !');
+ wrefresh(win);
+ raw;
+ wgetch(win);
+ endwin;
+end.
View Lorry Controller Status