1Unit oCrt;
2{---------------------------------------------------------------------------
3                                 CncWare
4                         (c) Copyright 1999-2000
5 ---------------------------------------------------------------------------
6  Filename..: ocrt.pp
7  Programmer: Ken J. Wright, ken@cncware.com
8  Date......: 03/01/99
9
10  Purpose - crt unit replacement plus OOP windows using ncurses.
11
12  NOTE: All of the crt procedures & functions have been replaced with ncurses
13  driven versions. This makes the ncurses library a little easier to use in a
14  Pascal program and benefits from terminal independence.
15
16-------------------------------<< REVISIONS >>--------------------------------
17  Ver  |   Date   | Prog| Description
18-------+----------+-----+-----------------------------------------------------
19  1.00 | 03/01/99 | kjw | Initial Release.
20       | 03/22/99 | kjw | Added nDelWindow(), delwin() does not nil pointer.
21  1.01 | 11/22/99 | kjw | Added the following: nEcho, ClrEol, ClrBot, InsLine,
22                        | DelLine, Delay, nClrEol, nClrBot, nInsLine, nDelLine,
23                        | nRefresh, nScroll, nDrawBox, nNewWindow, nWinColor,
24                        | nWriteScr, nFrame & some functions for returning
25                        | line drawing character values.
26  1.02 | 11/26/99 | kjw | Added nKeypressed().
27  1.03 | 12/01/99 | kjw | Added global boolean nIsActive.
28  1.04 | 12/03/99 | kjw | 1) Added procedures nHline, nVLine, & nWriteAC.
29                        | 2) Changed all the line draw character functions
30                        | (i.e., nHL, nVL) to return the longint value from
31                        | ncurses rather than the character value (which was
32                        | not very useful!). Now these can be passed to
33                        | nWriteAC() to correctly write the line drawing
34                        | characters.
35                        | 3) Added more of the ACS characters.
36  1.05 | 12/08/99 | kjw | 1) StartCurses() is now done as part of the unit
37                        | initialization block. EndCurses() is done via an
38                        | exit procedure.
39                        | 2) nIsActive is now a function (safer!).
40                        | 3) Added panel unit for windowing.
41                        | 4) Added tnWindow object.
42  1.10 | 12/12/99 | kjw | Added nSEdit().
43  1.11 | 12/12/99 | kjw | Added Special property to tEC object. Now any normal
44                        | character can trigger sedit to exit.
45------------------------------------------------------------------------------
46  2.00 | 12/13/99 | kjw | nCrt renamed to oCrt. A new nCrt has been created
47                        | which is a drop-in replacement for the FPC crt unit.
48                        | oCrt contains all of nCrt plus the OOP extensions.
49                        | All of the common code is in ncrt.inc.
50  2.01 | 12/15/99 | kjw | 1) A tnWindow object now becomes the target for
51                        | stdout following Init & Show. A Hide will put the
52                        | target back to stdscr.
53                        | 2) Added nSetActiveWin() to manually pick a target
54                        | window for stdout.
55  2.02 | 12/15/99 | kjw | 1) PutFrame applied keypad to stdscr instead of sub.
56                        | 2) See ncrt.inc
57  2.03 | 12/16/99 | kjw | 1) See ncrt.inc
58                        | 2) Added shift/f-key constants.
59  2.04 | 01/04/00 | kjw | See ncrt.inc
60  2.05 | 01/06/00 | kjw | 1) See ncrt.inc.
61                        | 2) Added boolean internal_fwrite. FWrite was failing
62                        | when trying to write outside of the active window.
63                        | 3) nSEdit was not handling tec.firsttime correctly
64                        | when a tec.special was processed.
65  2.06 | 01/11/00 | kjw | See ncrt.inc.
66  2.07 | 01/31/00 | kjw | 1) See ncrt.inc.
67                        | 2) Added getcolor, getframecolor, getheadercolor
68                        | methods to tnWindow.
69  2.08 | 06/09/00 | kjw | 1) Added Picture property to tEC object. This is
70                        | used for picture input masking in nSEdit.
71                        | 2) Added nCheckPxPicture() function.
72                        | 3) nSEdit() changed to use picture input masking.
73                        | See pxpic.txt for a description of the picture
74                        | string format.
75
76  2.08.01 | 06/11/2000 | kjw
77          | Fixed the spin cycle problem in nCheckPXPicture.
78  2.09.00 | 06/16/2000 | kjw
79          | 1) nSEdit renamed to nEdit. Now nSEdit just calls nEdit() for
80          | compatibility.
81          | 2) Added overloaded nEdit functions for Integer, LongInt, and
82          | Real types.
83          | 3) Changed nEdit() embedding of control characters to preface
84          | with a ^P. Also now uses a highlight attribute for the control
85          | characters.
86          | 4) Added control character cursor control to nEdit().
87          | 5) Added Esc/1..0 = F1..F10 to nEdit().
88          | 6) Added '@' to match set in pxpic.inc.
89          | 7) tnWindow.Align was not positioning properly. Off by one.
90          | 8) tnWindow.Init used wrong pointer for keypad and intrflush.
91          | 9) tnWindow.Edit was messing up ec.Special.
92  2.09.01 | 06/16/2000 | kjw
93          | 1) nStdScr (tnWindow) added and initialized at unit startup.
94          | nStdScr can be used for a default full screen window.
95          | 2) nEdit overloaded to work without a window pointer. It works
96          | with the currently active window.
97  2.10.00 | 06/23/2000 | kjw
98          | 1) Added character mapping to the tEC object. This includes the
99          | ChMap property and the AddChMap() and ClrChMap() methods.
100          | 2) Added AppendMode property to the tEC object. The character
101          | typed in nEdit() is always appended to the current string
102          | regardless of cursor position. Useful when ExitMode is true.
103          | 3) tnWindow.Done was not re-assigning an ActiveWn.
104          | 4) nEdit LeftArrow was allowing < x.
105          | 5) Added nEditNumber() function.
106          | 6) Added nEditDate() function.
107          | 7) I made a command decision and renamed the tEC.FirstTime
108          | property to tEC.ClearMode as it is more descriptive.
109  2.11.00 | 1) Cleaned up some loose ends with 2.10.
110          | 2) Some more overloading
111          | 3) Removed tnWindow.readln, write, and writeln methods.
112          | 4) See ncrt.inc.
113  2.12.00 | 1) Remove the "n" from the tnWindow.editxxx functions for
114          | consistancy. Procedurals are prefaced with an "n". Object methods
115          | are not.
116          | 2) Procedural FWrite renamed to nFWrite.
117          | 3) tEC object type renamed to tnEC.
118          | 4) Added nMakeWindow(), a one line procedural wrapper for
119          | tnWindow.Init and tnWindow.PutHeader.
120          | 5) Added GetX, GetY, IsFramed methods to tnWindow;
121          | 6) Fixed nFWrite for too long strings;
122          | 7) tnWindow.Align was wrong when justify was none.
123  2.13.00 | 06/30/00 | kjw | See ncrt.inc
124  2.14.00 | 07/05/00 | kjw | See ncrt.inc
125  2.15.00 | 07/12/00 | kjw |
126          | 1) Renamed IsBold to nIsBold. Renamed SetColorPair to nSetColorPair.
127          | 2) Added tnMenu object (not functional);
128          | 07/17/00 | kjw |
129          | 2) Argh!! Align method had another mistake. Changed x/y=1 to =0.
130          | 3) Added nShowMessage() function.
131          | 4) tnMenu is now minimally functional.
132          | 07/25/00 | kjw |
133          | 1) tnMenu fully functional for current level.
134  2.16.00 | 08/14/2000 | kjw |
135          | 1) Added Get/SetMark(), IsActive(), IsValid(), IsAssigned(),
136          | SetIndex() to tnMenu.
137          | 08/18/2000 | kjw |
138          | 1) Added nkXXX constants for all(?) extended keys.
139          | 2) Changed all uses of extended keys to use new nkXXX's.
140          | 3) Edit overloaded to return a nkXXX in ch rather that a char.
141          | 4) Resize method added to tnWindow.
142          | 5) AddChMap overloaded for preferred (easier) use with nkXXX's.
143          | 08/24/2000 | kjw |
144          | 1) Added nReadScr, nReadScrStr, nReadScrColor, nWriteScrStr,
145          | nGrabScreen, nPopScreen, nReleaseScreen.
146          | 2) Fixed some trouble with PrevWn accuracy.
147  2.16.01 | 05/26/2009 | kjw |
148          | 1) Corrected error with tnWindow.PutFrame and wattr_get. Recent
149          | updates to ncurses and ocrt by the FreePascal team introduced an
150          | error with tnWindow.PutFrame's use of wattr_get.
151------------------------------------------------------------------------------
152}
153Interface
154
155Uses
156{$ifdef unix}
157    baseunix,
158    termio,
159{$endif}
160  ncurses,panel,menu,
161  dos;  {dos needed for TextRec}
162
163Const
164
165   { decimal number format, us or european }
166   nUS = 0;
167   nEURO = 1;
168   nDecFmt : byte = nUS;
169
170   { border styles for text boxes }
171   btNone : integer = 0;
172   btSingle : integer = 1;
173   btDouble : integer = 2;
174
175   { ordinal keycodes, new style, preferred }
176   nkEnter     = 13;       { Enter key }
177   nkEsc       = 27;       { Home key }
178   nkHome      = -71;      { Home key }
179   nkUp        = -72;      { Up arrow }
180   nkPgUp      = -73;      { PgUp key }
181   nkLeft      = -75;      { Left arrow }
182   nkRight     = -77;      { Right arrow }
183   nkEnd       = -79;      { End key }
184   nkDown      = -80;      { Down arrow }
185   nkPgDn      = -81;      { PgDn key }
186   nkIns       = -82;      { Insert key }
187   nkDel       = -83;      { Delete key }
188   nkCtrlLeft  = -115;     { Ctrl/left arrow }
189   nkCtrlRight = -116;     { Ctrl/right arrow }
190   nkF1        = -59;      { f1 key }
191   nkF2        = -60;      { f2 key }
192   nkF3        = -61;      { f3 key }
193   nkF4        = -62;      { f4 key }
194   nkF5        = -63;      { f5 key }
195   nkF6        = -64;      { f6 key }
196   nkF7        = -65;      { f7 key }
197   nkF8        = -66;      { f8 key }
198   nkF9        = -67;      { f9 key }
199   nkF10       = -68;      { f10 key }
200   nkF11       = -84;      { shift/f1 key }
201   nkF12       = -85;      { shift/f2 key }
202   nkF13       = -86;      { shift/f3 key }
203   nkF14       = -87;      { shift/f4 key }
204   nkF15       = -88;      { shift/f5 key }
205   nkF16       = -89;      { shift/f6 key }
206   nkF17       = -90;      { shift/f7 key }
207   nkF18       = -91;      { shift/f8 key }
208   nkF19       = -92;      { shift/f9 key }
209   nkF20       = -93;      { shift/f10 key }
210   nkAltA      = -30;      { alt/a }
211   nkAltB      = -48;      { alt/b }
212   nkAltC      = -46;      { alt/c }
213   nkAltD      = -32;      { alt/d }
214   nkAltE      = -18;      { alt/e }
215   nkAltF      = -33;      { alt/f }
216   nkAltG      = -34;      { alt/g }
217   nkAltH      = -35;      { alt/h }
218   nkAltI      = -23;      { alt/i }
219   nkAltJ      = -36;      { alt/j }
220   nkAltK      = -37;      { alt/k }
221   nkAltL      = -38;      { alt/l }
222   nkAltM      = -50;      { alt/m }
223   nkAltN      = -49;      { alt/n }
224   nkAltO      = -24;      { alt/o }
225   nkAltP      = -25;      { alt/p }
226   nkAltQ      = -16;      { alt/q }
227   nkAltR      = -19;      { alt/r }
228   nkAltS      = -31;      { alt/s }
229   nkAltT      = -20;      { alt/t }
230   nkAltU      = -22;      { alt/u }
231   nkAltV      = -47;      { alt/v }
232   nkAltW      = -17;      { alt/w }
233   nkAltX      = -45;      { alt/x }
234   nkAltY      = -21;      { alt/y }
235   nkAltZ      = -44;      { alt/z }
236   nkAlt1      = -120;     { alt/1 }
237   nkAlt2      = -121;     { alt/2 }
238   nkAlt3      = -122;     { alt/3 }
239   nkAlt4      = -123;     { alt/4 }
240   nkAlt5      = -124;     { alt/5 }
241   nkAlt6      = -125;     { alt/6 }
242   nkAlt7      = -126;     { alt/7 }
243   nkAlt8      = -127;     { alt/8 }
244   nkAlt9      = -128;     { alt/9 }
245   nkAlt0      = -129;     { alt/0 }
246   nkAltMinus  = -130;     { alt/- }
247   nkAltEqual  = -131;     { alt/= }
248   nkAltTab    = -15;      { alt/tab }
249
250   { ordinal key codes (old style, don't break any apps!) }
251   nKeyEnter     = nkEnter;
252   nKeyEsc       = nkEsc;
253   nKeyHome      = abs(nkHome);
254   nKeyUp        = abs(nkUp);
255   nKeyPgUp      = abs(nkPgUp);
256   nKeyLeft      = abs(nkLeft);
257   nKeyRight     = abs(nkRight);
258   nKeyEnd       = abs(nkEnd);
259   nKeyDown      = abs(nkDown);
260   nKeyPgDn      = abs(nkPgDn);
261   nKeyIns       = abs(nkIns);
262   nKeyDel       = abs(nkDel);
263   nKeyCtrlLeft  = abs(nkCtrlLeft);
264   nKeyCtrlRight = abs(nkCtrlRight);
265   nKeyF1        = abs(nkF1);
266   nKeyF2        = abs(nkF2);
267   nKeyF3        = abs(nkF3);
268   nKeyF4        = abs(nkF4);
269   nKeyF5        = abs(nkF5);
270   nKeyF6        = abs(nkF6);
271   nKeyF7        = abs(nkF7);
272   nKeyF8        = abs(nkF8);
273   nKeyF9        = abs(nkF9);
274   nKeyF10       = abs(nkF10);
275   nKeyF11       = abs(nkF11);
276   nKeyF12       = abs(nkF12);
277   nKeyF13       = abs(nkF13);
278   nKeyF14       = abs(nkF14);
279   nKeyF15       = abs(nkF15);
280   nKeyF16       = abs(nkF16);
281   nKeyF17       = abs(nkF17);
282   nKeyF18       = abs(nkF18);
283   nKeyF19       = abs(nkF19);
284   nKeyF20       = abs(nkF20);
285
286   { character mapping }
287   nMaxChMaps    = 255;     { maximun index for character mapping }
288
289   { menus }
290   nMAXMENUITEMS = 100;
291
292Type
293   {*** structures to save a screen via nGrabScreen ***}
294   pnOneRow = pchtype;
295   { a buffer for a max of 256 chtype items accessed via pchar }
296   tnOneRow = array [0..1023] of char;
297   { a one way linked list of screen rows }
298   pnRowBuf = ^tnRowBuf;
299   tnRowBuf = Record
300      row : pnOneRow;    { one row of a screen }
301      next : pnRowBuf;   { next row in the list }
302   End;
303   { the header record of a saved screen }
304   pnScreenBuf = ^tnScreenBuf;
305   tnScreenBuf = Record
306      x,                 { column origin }
307      y,                 { row origin }
308      n : integer;       { number of columns }
309      first : pnRowBuf;  { pointer to first row in list }
310   End;
311
312   tnS10 = string[10];
313
314   { for scrolling a window }
315   tnUpDown = (up,down);
316   { for window & header positioning }
317   tnJustify = (none,left,center,right,top,bottom);
318   { used for nEC character mapping }
319   (********* Note : these are obsolete *******)
320   nChMapStr = string[4];
321   {nChMap = array [1..nMaxChMaps] of nChMapStr;}
322   (*******************************************)
323   nChMap = array [1..nMaxChMaps,1..2] of integer;
324
325   { used for nSEdit }
326   {------------------------------------------------------------------------
327     ClearMode = true : passed string is initialized to ''.
328      IsHidden = true : causes a string of '*' to display in place of
329                        the actual characters typed.
330       InsMode        : toggle for insert/overwrite mode.
331      ExitMode = true : sedit exits after every keystroke.
332               = false: sedit only exits when #27,#13, or any extended
333                        key *except* for Home,End,RArrow,LArrow.
334       Special        : If a pressed key is found in this string, then
335                        sedit exits without processing.
336       Picture        : An input mask string. See pxpic.txt for an
337                        explanation of picture strings.
338     CtrlColor        : The highlight color for embedded control characters.
339         ChMap        : An array of character triplets describing a character
340                        that is typed and what it should map to.
341    ------------------------------------------------------------------------}
342   tnEC = Object
343      ClearMode,
344      IsHidden,
345      InsMode,
346      ExitMode,
347      AppendMode : boolean;
348      Special : string;
349      Picture : string;
350      CtrlColor : integer;
351      ChMap : nChMap;
352      Constructor Init(ft,ih,im,em,ap : boolean;
353                                  s,p : string;
354                                   cc : integer;
355                                   mp : nChMap);
356      Destructor Done;
357      Function AddChMap(_in,_out : integer) : integer;
358      Function AddChMap(mp : nChMapStr) : integer;
359      Procedure ClrChMap(idx : integer);
360   End;
361
362   pwin = PWindow;
363
364   pnWindow = ^tnWindow;
365   tnWindow = Object
366      Private
367          wn : pwindow;       { pointer to win or sub to read/write to }
368         win : pwindow;       { pointer to main window record }
369         sub : pwindow;       { sub window if a bordered window }
370         pan : ppanel;        { pointer to panel record }
371         subp : ppanel;       { sub panel if a bordered window }
372         visible : boolean;   { is the window visible? }
373         hasframe : boolean;
374         wincolor,            { window color }
375         framecolor,          { frame color }
376         hdrcolor : integer;  { header color }
377         hdrpos : tnJustify;  { header alignment }
378         header : string[80]; { header string }
379         Procedure init_wins(x,y,x1,y1 : integer);
380         Procedure done_wins;
381      Public
382         data : pointer;      { a pointer to user defined data }
383         ec : tnEC;           { edit control settings }
384         Constructor Init(x,y,x1,y1,wcolor : integer;
385                                    border : boolean;
386                                    fcolor : integer);
387         Destructor Done;
388         Procedure Resize(cols_,rows_ : integer);
389         Procedure Active;  { make this the current window }
390         Procedure Show;    { display the window }
391         Procedure Hide;    { hide the window }
392         Procedure ClrScr;
393         Procedure ClrEol;
394         Procedure ClrBot;
395         Procedure InsLine;
396         Procedure DelLine;
397         Procedure GotoXY(x,y : integer);
398          Function WhereX : integer;
399          Function WhereY : integer;
400          Function ReadKey : char;
401         Procedure WriteAC(x,y,att,c : longint);
402         Procedure FWrite(x,y,att,z : integer; s : string);
403         Procedure DrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
404          Function GetHeader : string;
405         Procedure PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
406         Procedure SetColor(att : integer);
407          Function GetColor : integer;
408          Function GetFrameColor : integer;
409          Function GetHeaderColor : integer;
410         Procedure PutFrame(att : integer);
411         Procedure Move(x,y : integer);
412         Procedure Scroll(ln : integer; dir : tnUpDown);
413         Procedure Align(hpos,vpos : tnJustify);
414          Function Rows : integer;
415          Function Cols : integer;
416          Function GetX : integer;
417          Function GetY : integer;
418          Function IsFramed : boolean;
419          Function IsVisible : Boolean;
420          Function Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : integer) : String;
421          Function Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : integer) : LongInt;
422          Function Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : integer) : Real;
423          Function Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
424          Function Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
425          Function Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
426          Function EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
427          Function EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
428          Function EditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
429   End;
430
431   pnMenuStr = ^tnMenuStr;
432   tnMenuStr = array [0..79] of char; { storage for menu item text }
433   pnMenu = ^tnMenu;
434   tnMenu = Object
435      Private
436         tc,   { text (item) color }
437         cc,   { cursor (current item) color }
438         fc,   { frame color }
439         hc,   { header Color }
440         gc,   { non-selectable color }
441         x,y,  { top,left corner of window }
442         r,c,  { how many rows & columns of items to display }
443         wid,  { minimum window width }
444         iidx, { item index }
445         merr  { menu error code }
446               : integer;
447         loopon,
448         framed,
449         posted : boolean; { is the menu posted? }
450         mark : tnS10;
451         items : array[1..nMAXMENUITEMS] of pnMenuStr;
452         pi : array[1..nMAXMENUITEMS] of pItem;
453         pm : pMenu;
454         win : pnWindow;
455         Procedure InitWin;
456         Procedure ClearItem(idx : integer);
457         Procedure AddItem(i : integer; s : string);
458         Function Selectable(idx : integer) : boolean;
459         Function IsValid(idx : integer) : boolean;
460      Public
461         Constructor Init(_x,_y,_w,_r,_c,_tc,_cc,_gc : integer;
462                          _fr : boolean; _fc : integer);
463         Destructor Done;
464         Procedure Post;            { create the menu of current items }
465         Procedure UnPost;          { unbind the items and free the menu }
466         Procedure Start;           { start user input, includes show }
467         Procedure Stop;            { a shortcut for hide,unpost }
468         Procedure Show;            { display the menu, includes post }
469         Procedure Hide;            { remove the menu from the display }
470          Function Wind : pnWindow; { pointer to the window object }
471         Procedure Move(_x,_y : integer);       { shortcut window move }
472         Procedure Align(hpos,vpos : tnJustify);{ shortcut window align }
473         Procedure PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
474         Procedure Clear;           { unpost and clear the menu item list }
475          Function Add(s : string) : integer; { append a menu item }
476         Procedure Insert(idx : integer; s : string); { insert a menu item }
477         Procedure Remove(idx : integer);     { delete a menu item }
478         Procedure Change(idx : integer; s : string); { change an item }
479         Procedure Active(idx : integer; b : boolean); { toggle gray }
480          Function IsActive(idx : integer) : boolean; { item active ? }
481         Procedure Spin(b : boolean);{ toggle item looping }
482          Function Status : integer;{ return the current error/status code }
483          Function Index : integer; { return the current item index }
484         Procedure SetIndex(idx : integer); { set the item index }
485          Function Count : integer; { number of items in the menu }
486          Function Rows(_r : integer) : integer; {get/set menu rows }
487          Function Cols(_c : integer) : integer; {get/set menu columns }
488          Function IsAssigned(idx : integer) : boolean; { valid & assigned }
489          Function GetMark : string; { return the item mark string }
490         Procedure SetMark(ms : string); { set the mark string }
491         Procedure Refresh;
492         Procedure SetColor(att : byte);       { change text color }
493         Procedure SetCursorColor(att : byte); { change cursor color }
494         Procedure SetFrameColor(att : byte);  { change frame color }
495         Procedure SetGrayColor(att : byte);   { change inactive color }
496   End;
497
498Var
499   nStdScr : tnWindow; { default window created at unit initialization }
500   nscreen : pwin;     { pointer to ncurses stdscr }
501   nEC : tnEC;         { global edit control object }
502
503Procedure nSetActiveWin(win : pwindow);
504Procedure nDoNow(donow : boolean);
505 Function nKeypressed(timeout : word) : boolean;
506Procedure nEcho(b : boolean);
507Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
508Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
509Procedure nDelWindow(var win : pWindow);
510Procedure nWinColor(win : pWindow; att : integer);
511Procedure nClrScr(win : pWindow; att : integer);
512Procedure nClrEol(win : pWindow);
513Procedure nClrBot(win : pWindow);
514Procedure nInsLine(win : pWindow);
515Procedure nDelLine(win : pWindow);
516Procedure nGotoXY(win : pWindow; x,y : integer);
517 Function nWhereX(win : pWindow) : integer;
518 Function nWhereY(win :  pWindow) : integer;
519 Function nReadkey(win : pWindow) : char;
520 Function nReadln(win : pWindow) : string;
521Procedure nWrite(win : pWindow; s : string);
522Procedure nWriteln(win : pWindow; s : string);
523Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
524Procedure nRefresh(win : pWindow);
525Procedure nScroll(win : pWindow; lines : integer; dir : tnUpDown);
526Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer);
527Procedure nFrame(win : pWindow);
528 Function nRows(win : pWindow) : integer;
529 Function nCols(win : pWindow) : integer;
530 Function nHL : longint; { horizontal line }
531 Function nVL : longint; { vertical line }
532 Function nUL : longint; { upper left corner }
533 Function nLL : longint; { lower loft corner }
534 Function nUR : longint; { upper right corner }
535 Function nLR : longint; { lower right corner }
536 Function nLT : longint; { left tee }
537 Function nRT : longint; { right tee }
538 Function nTT : longint; { top tee }
539 Function nBT : longint; { bottom tee }
540 Function nPL : longint; { plus, + }
541 Function nLA : longint; { left arrow }
542 Function nRA : longint; { right arrow }
543 Function nUA : longint; { up arror }
544 Function nDA : longint; { down arrow }
545 Function nDI : longint; { diamond }
546 Function nCB : longint; { checkerboard }
547 Function nDG : longint; { degree }
548 Function nPM : longint; { plus/minus }
549 Function nBL : longint; { bullet }
550Procedure nHLine(win : pwindow; col,row,attr,x : integer);
551Procedure nVLine(win : pwindow; col,row,attr,y : integer);
552Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint);
553 Function nIsBold(att : integer) : boolean;
554 Function nSetColorPair(att : integer) : integer;
555Procedure nFWrite(win : pwindow; col,row,attrib : integer; clear : integer; s : string);
556Procedure nFWrite(col,row,attrib : integer; clear : integer; s : string);
557 Function nSEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
558 Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
559 Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
560 Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
561 Function nEdit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
562 Function nEdit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
563 Function nEdit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
564 Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var chv : integer) : String;
565 Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:LongInt;Var ch : integer) : LongInt;
566 Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:Real;Var ch : integer) : Real;
567 Function nEdit(x,y,att,z,CursPos:Integer;es:String;Var ch : integer) : String;
568 Function nEdit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : integer) : LongInt;
569 Function nEdit(x,y,att,z,CursPos:Integer;es:Real;Var ch : integer) : Real;
570 Function nEditNumber(win : pwindow; x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
571 Function nEditNumber(win : pwindow; x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
572 Function nEditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
573 Function nEditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
574 Function nEditDate(win : pwindow; x,y,att : integer;initv : string;var esc : boolean) : string;
575 Function nEditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
576Procedure nMakeWindow(var win : tnWindow;x1,y1,x2,y2,ta,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
577Procedure nMakeWindow(var win : pnWindow;x1,y1,x2,y2,ta,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
578Procedure nMakeMenu(var mnu : tnMenu;x,y,_w,_r,_c,ta,ca,ga,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
579Procedure nMakeMenu(var mnu : pnMenu;x,y,_w,_r,_c,ta,ca,ga,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
580 Function nShowMessage(msg : string;matt : byte;hdr : string;hatt : byte;ack : boolean) : pnWindow;
581 Function nReadScr(win : pWindow; x,y,n : integer) : string;
582 Function nReadScr(x,y,n : integer) : string;
583 Function nReadScrStr(win : pWindow; x,y,n : integer; buf : pchtype) : pchtype;
584 Function nReadScrStr(x,y,n : integer; buf : pchtype) : pchtype;
585 Function nReadScrColor(win : pWindow; x,y : integer) : integer;
586 Function nReadScrColor(x,y : integer) : integer;
587Procedure nWriteScrStr(win : pWindow; x,y : integer; s : pchtype);
588Procedure nWriteScrStr(x,y : integer; s : pchtype);
589Procedure nGrabScreen(var p : pnScreenBuf; x,y,c,r : integer; win : pWindow);
590Procedure nGrabScreen(var p : pnScreenBuf; x,y,c,r : integer);
591Procedure nGrabScreen(var p : pnScreenBuf);
592Procedure nPopScreen(p : pnScreenBuf; x,y : integer; win : pWindow);
593Procedure nPopScreen(p : pnScreenBuf; x,y : integer);
594Procedure nPopScreen(p : pnScreenBuf);
595Procedure nReleaseScreen(p : pnScreenBuf);
596 Function nCheckPxPicture(var s, Pic : string; var CPos : integer) : word;
597
598{$i ncrt.inc}
599{$i pxpic.inc}
600
601Var
602   _chmap : nChMap;
603
604{---------------------------------------------------------------------
605  tnWindow.Init
606
607  Create a new window.
608       x = upper left corner x, screen relative
609       y = upper left corner y, screen relative
610      x1 = lower right corner x, screen relative
611      y1 = lower right corner y, screen relative
612  wcolor = window/text color
613  border = include a frame?
614  fcolor = frame color
615 ---------------------------------------------------------------------}
616Constructor tnWindow.Init(x,y,x1,y1,wcolor : integer;
617                           border : boolean;
618                           fcolor : integer);
619Var
620   mp : nChMap;
621Begin
622   hasframe := border;
623   wincolor := wcolor;
624   framecolor := fcolor;
625   hdrcolor := wcolor;
626   header := '';
627   data := nil;
628   visible := false;
629   init_wins(x,y,x1,y1);
630   FillChar(mp,SizeOf(mp),#0);
631   ec.Init(false,false,false,false,false,'','',15,mp);
632   ec.ClrChMap(0);
633   SetActiveWn(wn);
634End;
635
636{ deallocate the window }
637Destructor tnWindow.Done;
638Begin
639   done_wins;
640   ec.Done;
641   SetActiveWn(nscreen);
642End;
643
644Procedure tnWindow.init_wins(x,y,x1,y1 : integer);
645Begin
646   win := nil;
647   sub := nil;
648   pan := nil;
649   subp := nil;
650   win := newwin(y1-y+1,x1-x+1,y-1,x-1);
651   pan := new_panel(win);
652   hide_panel(pan);
653   If hasframe Then
654      PutFrame(framecolor)
655   Else Begin
656      wn := win;
657      wbkgd(win,COLOR_PAIR(nSetColorPair(wincolor)));
658      If nisbold(wincolor) then wattr_on(win,A_BOLD,nil);
659      scrollok(win,bool(true));
660      intrflush(win,bool(false));
661      keypad(win,bool(true));
662   End;
663End;
664
665Procedure tnWindow.done_wins;
666Begin
667   If subp <> nil Then del_panel(subp);
668   If pan <> nil Then del_panel(pan);
669   If sub <> nil Then delwin(sub);
670   If (win <> nil) and (win <> stdscr) Then delwin(win);
671   subp := nil;
672   pan := nil;
673   sub := nil;
674   If win <> stdscr Then win := nil;
675End;
676
677Procedure tnWindow.ReSize(cols_,rows_ : integer);
678Var
679   xx,yy,
680   mx,my : integer;
681   vis : boolean;
682Begin
683   xx := GetX;
684   yy := GetY;
685   { can't be larger than full screen }
686   If cols_ > nMaxCols Then cols_ := nMaxCols;
687   If rows_ > nMaxRows Then rows_ := nMaxRows;
688   { set the bottom, right corner }
689   mx := xx+cols_-1;
690   my := yy+rows_-1;
691   { expand left? }
692   If mx > nMaxCols Then xx := nMaxCols-cols_+1;
693   { expand up? }
694   If my > nMaxRows Then yy := nMaxRows-rows_+1;
695   If xx < 1 Then xx := 1;
696   If yy < 1 Then yy := 1;
697   { reset the bottom, right corner }
698   mx := xx+cols_-1;
699   my := yy+rows_-1;
700   { constrain to full screen }
701   If mx > nMaxCols Then mx := nMaxCols;
702   If my > nMaxRows Then my := nMaxRows;
703   vis := visible;
704   Hide;
705   visible := vis;
706   done_wins;
707   init_wins(xx,yy,mx,my);
708   If visible Then Show;
709End;
710
711{ make the window current for all normal crt requests }
712Procedure tnWindow.Active;
713Begin
714   SetActiveWn(wn);
715End;
716
717{ display the window and move to the top }
718Procedure tnWindow.Show;
719Begin
720   SetActiveWn(wn);
721   visible := true;
722   show_panel(pan);
723   If subp <> nil Then show_panel(subp);
724   update_panels;
725   doupdate;
726End;
727
728{ hide the window }
729Procedure tnWindow.Hide;
730Begin
731   { don't go back to yourself }
732   If PrevWn <> wn Then
733      SetActiveWn(PrevWn)
734   Else
735      SetActiveWn(stdscr);
736   visible := false;
737   If subp <> nil Then hide_panel(subp);
738   hide_panel(pan);
739   update_panels;
740   doupdate;
741   GotoXY(WhereX,WhereY);
742End;
743
744Procedure tnWindow.ClrScr;
745Begin
746   tmp_b := dorefresh;
747   dorefresh := visible;
748   nClrScr(wn,wincolor);
749   dorefresh := tmp_b;
750End;
751
752Procedure tnWindow.ClrEol;
753Begin
754   tmp_b := dorefresh;
755   dorefresh := visible;
756   nClrEol(wn);
757   dorefresh := tmp_b;
758End;
759
760Procedure tnWindow.ClrBot;
761Begin
762   tmp_b := dorefresh;
763   dorefresh := visible;
764   nClrBot(wn);
765   dorefresh := tmp_b;
766End;
767
768Procedure tnWindow.InsLine;
769Begin
770   tmp_b := dorefresh;
771   dorefresh := visible;
772   nInsLine(wn);
773   dorefresh := tmp_b;
774End;
775
776Procedure tnWindow.DelLine;
777Begin
778   tmp_b := dorefresh;
779   dorefresh := visible;
780   nDelLine(wn);
781   dorefresh := tmp_b;
782End;
783
784{ return the window border header string }
785Function tnWindow.GetHeader : string;
786Begin
787   GetHeader := header;
788End;
789
790{----------------------------------------------------------------------
791  put/replace a header string at the top of a bordered window
792
793     hdr = header string (top line of window, only if hasframe = true)
794  hcolor = header line color
795    hpos = justfication of header string, left, center, or right
796 ----------------------------------------------------------------------}
797Procedure tnWindow.PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
798Var
799   cp,
800   hx,
801   len : integer;
802   att,
803   mx,my : longint;
804Begin
805   If Hasframe Then Begin
806      If hdr <> '' Then Begin
807         header := hdr;
808         hdrcolor := hcolor;
809         hdrpos := hpos;
810         getmaxyx(win,my,mx);
811         nHline(win,2,1,framecolor,mx-1);
812         len := mx-2;
813         hdr := Copy(hdr,1,len);
814         len := Length(hdr);
815         Case hpos of
816           left   : hx := 1;
817           center : hx := (mx - len) div 2;
818           right  : hx := (mx - len) - 1;
819         End;
820         mvwaddstr(win,0,hx,StrPCopy(ps,hdr));
821         cp := nSetColorPair(hcolor);
822         If nIsBold(hcolor) Then
823            att := A_BOLD
824         Else
825            att := A_NORMAL;
826         mvwchgat(win,0,hx,len,att,cp,Nil);
827      End;
828   End;
829End;
830
831{ set the the color of the writable window }
832Procedure tnWindow.SetColor(att : integer);
833Begin
834   wbkgd(wn,COLOR_PAIR(nSetColorPair(att)));
835   If nisbold(att) then
836     wattr_set(wn,A_BOLD,0,Nil);
837   wincolor := att;
838   If visible Then wrefresh(wn);
839End;
840
841{ get the writeable window color }
842Function tnWindow.GetColor : integer;
843Begin
844   GetColor := wincolor;
845End;
846
847{ get the frame color }
848Function tnWindow.GetFrameColor : integer;
849Begin
850   GetFrameColor := framecolor;
851End;
852
853{ get the header color }
854Function tnWindow.GetHeaderColor : integer;
855Begin
856   GetHeaderColor := hdrcolor;
857End;
858
859{ frame an un-framed window, or update the frame color of a framed window }
860Procedure tnWindow.PutFrame(att : integer);
861Var
862   x,y,
863   mx,my,
864   atts : longint;
865   junk : smallint;
866
867Begin
868   wbkgd(win,COLOR_PAIR(nSetColorPair(att)));
869   wattr_get(win,@atts,@junk,nil);
870   If nisbold(att) then wattr_on(win,atts or A_BOLD,Nil);
871   box(win,ACS_VLINE,ACS_HLINE);
872   framecolor := att;
873   If framecolor = -1 Then framecolor := wincolor;
874   hasframe := true;
875   If header <> '' Then PutHeader(header,hdrcolor,hdrpos);
876   If sub = nil Then Begin
877      getbegyx(win,y,x);
878      getmaxyx(win,my,mx);
879      sub := newwin(my-2,mx-2,y+1,x+1);
880      If sub <> nil Then Begin
881         subp := new_panel(sub);
882         hide_panel(subp);
883         wbkgd(sub,COLOR_PAIR(nSetColorPair(wincolor)));
884         If nisbold(wincolor) then wattr_on(sub,A_BOLD,Nil);
885         scrollok(sub,bool(true));
886         intrflush(sub,bool(false));
887         keypad(sub,bool(true));
888         wn := sub;
889      End;
890   End;
891   touchwin(sub);
892   If visible Then Begin
893      wrefresh(win);
894      wrefresh(sub);
895   End;
896End;
897
898{ move the window }
899Procedure tnWindow.Move(x,y : integer);
900Begin
901   move_panel(pan,y-1,x-1);
902   If subp <> nil Then move_panel(subp,y,x);
903   If visible Then Begin
904      update_panels;
905      doupdate;
906   End;
907End;
908
909Procedure tnWindow.Align(hpos,vpos : tnJustify);
910Var
911   x,y,
912   bx,by : longint;
913Begin
914   getmaxyx(win,y,x);
915   getbegyx(win,by,bx);
916   Case hpos of
917      none   : x := bx;
918      left   : x := 0;
919      right  : x := MaxCols - x;
920      center : x := (MaxCols - x) div 2;
921   End;
922   Case vpos of
923      none   : y := by;
924      top    : y := 0;
925      bottom : y := MaxRows - y;
926      center : y := (MaxRows - y) div 2;
927   End;
928   move(x+1,y+1);
929End;
930
931Procedure tnWindow.Scroll(ln : integer; dir : tnUpDown);
932Begin
933   nScroll(wn,ln,dir);
934End;
935
936Procedure tnWindow.GotoXY(x,y : integer);
937Begin
938   tmp_b := dorefresh;
939   dorefresh := visible;
940   nGotoXY(wn,x,y);
941   dorefresh := tmp_b;
942End;
943
944Function tnWindow.WhereX : integer;
945Begin
946   WhereX := nWhereX(wn);
947End;
948
949Function tnWindow.WhereY : integer;
950Begin
951   WhereY := nWhereY(wn);
952End;
953
954Function tnWindow.ReadKey : char;
955Begin
956   ReadKey := nReadKey(wn);
957End;
958
959Procedure tnWindow.WriteAC(x,y,att,c : longint);
960Begin
961   tmp_b := dorefresh;
962   dorefresh := visible;
963   nWriteAC(wn,x,y,att,c);
964   dorefresh := tmp_b;
965End;
966
967Procedure tnWindow.FWrite(x,y,att,z : integer; s : string);
968Begin
969   tmp_b := dorefresh;
970   dorefresh := visible;
971   nFWrite(wn,x,y,att,z,s);
972   dorefresh := tmp_b;
973End;
974
975Procedure tnWindow.DrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
976Begin
977   tmp_b := dorefresh;
978   dorefresh := visible;
979   nDrawBox(wn,LineStyle,x1,y1,x2,y2,att);
980   dorefresh := tmp_b;
981End;
982
983Function tnWindow.Rows : integer;
984Begin
985   Rows := nRows(wn);
986End;
987
988Function tnWindow.Cols : integer;
989Begin
990   Cols := nCols(wn);
991End;
992
993Function tnWindow.GetX : integer;
994Var
995   x,y : longint;
996Begin
997   getbegyx(win,y,x);
998   GetX := x+1;
999End;
1000
1001Function tnWindow.GetY : integer;
1002Var
1003   x,y : longint;
1004Begin
1005   getbegyx(win,y,x);
1006   GetY := y+1;
1007End;
1008
1009Function tnWindow.IsFramed : boolean;
1010Begin
1011   IsFramed := hasframe;
1012End;
1013
1014Function tnWindow.IsVisible : boolean;
1015Begin
1016   IsVisible := visible;
1017End;
1018
1019Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : integer) : String;
1020var
1021   tmp_ec : tnec;
1022Begin
1023   { save global ec}
1024   tmp_ec := nEC;
1025   { init global ec to window ec }
1026   nEC := ec;
1027   Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
1028   { re-init window ec to possible changed values }
1029   ec.ClearMode := nEC.ClearMode;
1030   ec.InsMode := nEC.InsMode;
1031   { init global ec to saved }
1032   nEC := tmp_ec;
1033End;
1034
1035Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
1036var
1037   i : integer;
1038Begin
1039   Edit := Edit(x,y,att,z,CursPos,es,i);
1040   ch := chr(abs(i));
1041End;
1042
1043{ overload for longint }
1044Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : integer) : LongInt;
1045var
1046   tmp_ec : tnec;
1047Begin
1048   tmp_ec := nEC;
1049   nEC := ec;
1050   Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
1051   ec.ClearMode := nEC.ClearMode;
1052   ec.InsMode := nEC.InsMode;
1053   nEC := tmp_ec;
1054End;
1055
1056Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
1057var
1058   i : integer;
1059Begin
1060   Edit := Edit(x,y,att,z,CursPos,es,i);
1061   ch := chr(abs(i));
1062End;
1063
1064{ overload for real }
1065Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : integer) : Real;
1066var
1067   tmp_ec : tnec;
1068Begin
1069   tmp_ec := nEC;
1070   nEC := ec;
1071   Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
1072   ec.ClearMode := nEC.ClearMode;
1073   ec.InsMode := nEC.InsMode;
1074   nEC := tmp_ec;
1075End;
1076
1077Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
1078var
1079   i : integer;
1080Begin
1081   Edit := Edit(x,y,att,z,CursPos,es,i);
1082   ch := chr(abs(i));
1083End;
1084
1085Function tnWindow.EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
1086var
1087   tmp_ec : tnec;
1088Begin
1089   tmp_ec := nEC;
1090   nEC := ec;
1091   EditNumber := nEditNumber(wn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
1092   ec.ClearMode := nEC.ClearMode;
1093   ec.InsMode := nEC.InsMode;
1094   nEC := tmp_ec;
1095End;
1096
1097Function tnWindow.EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
1098var
1099   tmp_ec : tnec;
1100Begin
1101   tmp_ec := nEC;
1102   nEC := ec;
1103   EditNumber := nEditNumber(wn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
1104   ec.ClearMode := nEC.ClearMode;
1105   ec.InsMode := nEC.InsMode;
1106   nEC := tmp_ec;
1107End;
1108
1109Function tnWindow.EditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
1110var
1111   tmp_ec : tnec;
1112Begin
1113   tmp_ec := nEC;
1114   nEC := ec;
1115   EditDate := nEditDate(wn,x,y,att,initv,esc);
1116   ec.ClearMode := nEC.ClearMode;
1117   ec.InsMode := nEC.InsMode;
1118   nEC := tmp_ec;
1119End;
1120
1121{--------------------------- tnEC -------------------------------}
1122
1123Constructor tnEC.Init(ft,ih,im,em,ap : boolean;
1124                                 s,p : string;
1125                                  cc : integer;
1126                                  mp : nChMap);
1127Begin
1128   ClearMode := ft;
1129   IsHidden := ih;
1130   InsMode := im;
1131   ExitMode := em;
1132   AppendMode := ap;
1133   Special := s;
1134   Picture := p;
1135   CtrlColor := cc;
1136   ChMap := mp;
1137End;
1138
1139Destructor tnEC.Done;
1140Begin
1141End;
1142
1143{ Add or replace a character map }
1144{ Preferred }
1145Function tnEC.AddChMap(_in,_out : integer) : integer;
1146Var
1147   i : integer;
1148Begin
1149   i := 0;
1150   Repeat
1151      inc(i);
1152   Until (i > nMaxChMaps) or (ChMap[i,1] = _in) or (ChMap[i,1] = 0);
1153   If i <= nMaxChMaps Then Begin
1154      AddChMap := i;
1155      ChMap[i,1] := _in;
1156      ChMap[i,2] := _out;
1157   End Else
1158      AddChMap := 0;
1159End;
1160
1161{ Add or replace a character map }
1162{ Obsolete, overloaded }
1163Function tnEC.AddChMap(mp : nChMapStr) : integer;
1164Var
1165   i : integer;
1166   _in,_out : integer;
1167Begin
1168   { convert to new type }
1169   If mp[1] = #0 Then
1170      _in := ord(mp[2]) * (-1)
1171   Else
1172      _in := ord(mp[1]);
1173   If mp[3] = #0 Then
1174      _out := ord(mp[4]) * (-1)
1175   Else
1176      _out := ord(mp[3]);
1177   AddChMap := AddChMap(_in,_out);
1178End;
1179
1180Procedure tnEC.ClrChMap(idx : integer);
1181Begin
1182   Case idx of
1183      0 : FillChar(ChMap,SizeOf(ChMap),0);
1184      1..nMaxChMaps : Begin
1185         ChMap[idx,1] := 0;
1186         ChMap[idx,2] := 0;
1187      End;
1188   End;
1189End;
1190
1191{==========================================================================}
1192
1193{ set the active window for write(ln), read(ln) }
1194Procedure nSetActiveWin(win : pwindow);
1195Begin
1196   SetActiveWn(win);
1197End;
1198
1199{----------------------------------------------------------------
1200  Set the refresh toggle.
1201  If true, then all changes to a window are immediate. If false,
1202  then changes appear following the next call to nRefresh.
1203 ----------------------------------------------------------------}
1204Procedure nDoNow(donow : boolean);
1205Begin
1206   dorefresh := donow;
1207End;
1208
1209{-----------------------------------------------------
1210  Set the echo flag.
1211  This determines whether or not, characters are
1212  echoed to the display when entered via the keyboard.
1213 -----------------------------------------------------}
1214Procedure nEcho(b : boolean);
1215Begin
1216   Case b of
1217      true : echo;
1218      false: noecho;
1219   End;
1220   isEcho := b;
1221End;
1222
1223{ create a new subwindow of stdscr }
1224Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
1225Begin
1226   nDelWindow(win);
1227   win := subwin(stdscr,y1-y+1,x1-x+1,y-1,x-1);
1228   If win = nil then Exit;
1229   intrflush(win,bool(false));
1230   keypad(win,bool(true));
1231   scrollok(win,bool(true));
1232   SetActiveWn(win);
1233End;
1234
1235{ create a new window }
1236Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
1237Begin
1238   nDelWindow(win);
1239   win := newwin(y1-y+1,x1-x+1,y-1,x-1);
1240   If win = nil then Exit;
1241   intrflush(win,bool(false));
1242   keypad(win,bool(true));
1243   scrollok(win,bool(true));
1244   SetActiveWn(win);
1245End;
1246
1247{ repaint a window }
1248Procedure nRefresh(win : pWindow);
1249Begin
1250   touchwin(win);
1251   wrefresh(win);
1252End;
1253
1254{----------------------------------------------
1255 Wait for a key to be pressed, with a timeout.
1256 If a key is pressed, then nKeypressed returns
1257 immediately as true, otherwise it return as
1258 false after the timeout period.
1259 ----------------------------------------------}
1260function nKeypressed(timeout : word) : boolean;
1261var
1262   fds : TFDSet;
1263   maxFD : longint;
1264Begin
1265   fpFD_Zero(fds);
1266   maxFD := 1;
1267   { turn on stdin bit }
1268   If fpFD_IsSet(STDIN,fds)=0 Then
1269     fpFD_Set(STDIN,fds);
1270   { wait for some input }
1271   If fpSelect(maxFD,@fds,nil,nil,timeout) > 0 Then
1272      nKeypressed := TRUE
1273   Else
1274      nKeypressed := FALSE;
1275End;
1276
1277{---------------------------------
1278  read input string from a window
1279 ---------------------------------}
1280Function nReadln(win : pWindow) : string;
1281Begin
1282   wgetstr(win,ps);
1283   nReadln := StrPas(ps);
1284End;
1285
1286{ write a string to a window without refreshing screen }
1287{ DON'T update PrevWn! }
1288Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
1289Var
1290   tmp : pwindow;
1291Begin
1292   tmp := ActiveWn;
1293   tmp_b := doRefresh;
1294   ActiveWn := win;
1295   doRefresh := false;
1296   nFWrite(win,x,y,att,0,s);
1297   ActiveWn := tmp;
1298   doRefresh := tmp_b;
1299End;
1300
1301{----------------------------------------------------------
1302  Scroll a window, up or down, a specified number of lines.
1303  lines = number of lines to scroll.
1304  dir = direction, up or down.
1305 ----------------------------------------------------------}
1306Procedure nScroll(win : pWindow; lines : integer; dir : tnUpDown);
1307Begin
1308   ScrollOk(win,bool(True));
1309   Case dir of
1310        up : lines := abs(lines);
1311      down : lines := abs(lines) * (-1);
1312   End;
1313   wscrl(win,lines);
1314   If doRefresh Then wRefresh(win);
1315End;
1316
1317{ draw a colored box, with or without a border }
1318Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer);
1319Var
1320   sub : pWindow;
1321   x,y : longint;
1322Begin
1323   getbegyx(win,y,x);
1324   sub := subwin(win,y2-y1+1,x2-x1+1,y+y1-1,x+x1-1);
1325   If sub = nil Then exit;
1326   wbkgd(sub,CursesAtts(att));
1327   werase(sub);
1328   case LineStyle of
1329      1,2 : box(sub, ACS_VLINE, ACS_HLINE);
1330   End;
1331   If doRefresh Then wrefresh(sub);
1332   nDelWindow(sub);
1333End;
1334
1335{---------------------------
1336  add a border to a window,
1337  waits for a refresh
1338 ---------------------------}
1339Procedure nFrame(win : pWindow);
1340Begin
1341   box(win, ACS_VLINE, ACS_HLINE);
1342End;
1343
1344{-----------------------------------------------------------
1345  write a string to a window at the current cursor position
1346  followed by a newline
1347 -----------------------------------------------------------}
1348Procedure nWriteln(win : pWindow; s : string);
1349Begin
1350   waddstr(win,StrPCopy(ps,s+#10));
1351   If doRefresh Then wrefresh(win);
1352End;
1353
1354{ return then number of rows in a window }
1355Function nRows(win : pWindow) : integer;
1356Var
1357   x,y : longint;
1358Begin
1359   getmaxyx(win,y,x);
1360   nRows := y;
1361End;
1362
1363{ return then number of columns in a window }
1364Function nCols(win : pWindow) : integer;
1365Var
1366   x,y : longint;
1367Begin
1368   getmaxyx(win,y,x);
1369   nCols := x;
1370End;
1371
1372{-------------------------------------------------------
1373 Line drawing characters have to be handled specially.
1374 Use nWriteAC() to write these characters. They cannot
1375 be simply included as characters in a string.
1376 -------------------------------------------------------}
1377
1378{ returns horizontal line character }
1379Function nHL : longint;
1380Begin
1381   nHL := ACS_HLINE;
1382End;
1383
1384{ returns vertical line character }
1385Function nVL : longint;
1386Begin
1387   nVL := ACS_VLINE;
1388End;
1389
1390{ returns upper left corner character }
1391Function nUL : longint;
1392Begin
1393   nUL := ACS_ULCORNER;
1394End;
1395
1396{ returns lower left corner character }
1397Function nLL : longint;
1398Begin
1399   nLL := ACS_LLCORNER;
1400End;
1401
1402{ returns upper right corner character }
1403Function nUR : longint;
1404Begin
1405   nUR := ACS_URCORNER;
1406End;
1407
1408{ returns lower right corner character }
1409Function nLR : longint;
1410Begin
1411   nLR := ACS_LRCORNER;
1412End;
1413
1414{ returns left tee character }
1415Function nLT : longint;
1416Begin
1417   nLT := ACS_LTEE;
1418End;
1419
1420{ returns right tee character }
1421Function nRT : longint;
1422Begin
1423   nRT := ACS_RTEE;
1424End;
1425
1426{ returns top tee character }
1427Function nTT : longint;
1428Begin
1429   nTT := ACS_TTEE;
1430End;
1431
1432{ returns bottom tee character }
1433Function nBT : longint;
1434Begin
1435   nBT := ACS_BTEE;
1436End;
1437
1438{ returns plus/cross character }
1439Function nPL : longint;
1440Begin
1441   nPL := ACS_PLUS;
1442End;
1443
1444{ returns left arrow character }
1445Function nLA : longint;
1446Begin
1447   nLA := ACS_LARROW;
1448End;
1449
1450{ returns right arrow character }
1451Function nRA : longint;
1452Begin
1453   nRA := ACS_RARROW;
1454End;
1455
1456{ returns up arrow character }
1457Function nUA : longint;
1458Begin
1459   nUA := ACS_UARROW;
1460End;
1461
1462{ returns down arrow character }
1463Function nDA : longint;
1464Begin
1465   nDA := ACS_DARROW;
1466End;
1467
1468{ returns diamond character }
1469Function nDI : longint;
1470Begin
1471   nDI := ACS_DIAMOND;
1472End;
1473
1474{ returns checkerboard character }
1475Function nCB : longint;
1476Begin
1477   nCB := ACS_CKBOARD;
1478End;
1479
1480{ returns degree character }
1481Function nDG : longint;
1482Begin
1483   nDG := ACS_DEGREE;
1484End;
1485
1486{ returns plus/minus character }
1487Function nPM : longint;
1488Begin
1489   nPM := ACS_PLMINUS;
1490End;
1491
1492{ returns bullet character }
1493Function nBL : longint;
1494Begin
1495   nBL := ACS_BULLET;
1496End;
1497
1498{ draw a horizontal line with color and a start & end position }
1499Procedure nHLine(win : pwindow; col,row,attr,x : integer);
1500var
1501   sub : pwindow;
1502   bx,by : longint;
1503Begin
1504   getbegyx(win,by,bx);
1505   sub := subwin(win,1,x-col+1,by+row-1,bx+col-1);
1506   If sub = nil Then Exit;
1507   x := getmaxx(sub);
1508   wbkgd(sub,CursesAtts(attr));
1509   mvwhline(sub,0,0,ACS_HLINE,x);
1510   If doRefresh Then wrefresh(sub);
1511   delwin(sub);
1512End;
1513
1514{ draw a vertical line with color and a start & end position }
1515Procedure nVLine(win : pwindow; col,row,attr,y : integer);
1516var sub : pwindow;
1517Begin
1518   sub := subwin(win,y-row+1,1,row-1,col-1);
1519   If sub = nil Then Exit;
1520   wbkgd(sub,CursesAtts(attr));
1521   mvwvline(sub,0,0,ACS_VLINE,y);
1522   If doRefresh Then wrefresh(sub);
1523   delwin(sub);
1524End;
1525
1526{----------------------------------------------------------------
1527  Write a character from the alternate character set. A normal
1528  value from the alternate character set is larger than $400000.
1529  If the value passed here is 128..255, then we assume it to be
1530  the ordinal value from the IBM extended character set, and try
1531  to map it to curses correctly. If it does not map, then we just
1532  make it an alternate character and hope the output is what the
1533  programmer expected. Note: this will work on the Linux console
1534  just fine, but for other terminals the passed value must match
1535  the termcap definition for the alternate character.
1536  Note: The cursor returns to it's original position.
1537 ----------------------------------------------------------------}
1538Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint);
1539var
1540   xx,yy,
1541   cp : longint;
1542Begin
1543   If acs_char in [0..255] Then Begin
1544      Case acs_char of
1545         176 : acs_char := ACS_CKBOARD;
1546         179 : acs_char := ACS_VLINE;
1547         180 : acs_char := ACS_RTEE;
1548         191 : acs_char := ACS_URCORNER;
1549         192 : acs_char := ACS_LLCORNER;
1550         193 : acs_char := ACS_BTEE;
1551         194 : acs_char := ACS_TTEE;
1552         195 : acs_char := ACS_LTEE;
1553         196 : acs_char := ACS_HLINE;
1554         197 : acs_char := ACS_PLUS;
1555         218 : acs_char := ACS_ULCORNER;
1556         217 : acs_char := ACS_LRCORNER;
1557         241 : acs_char := ACS_PLMINUS;
1558         248 : acs_char := ACS_DEGREE;
1559         249 : acs_char := ACS_BULLET;
1560         else  acs_char := acs_char or A_ALTCHARSET;
1561      End;
1562   End;
1563   { save the current cursor position }
1564   getyx(win,yy,xx);
1565   cp := nSetColorPair(att);
1566   { write character with current attributes }
1567   mvwaddch(win,y-1,x-1,acs_char);
1568   { update with new attributes }
1569   If nIsBold(att) Then
1570      att := A_BOLD or A_ALTCHARSET
1571   Else
1572      att := A_NORMAL or A_ALTCHARSET;
1573   mvwchgat(win,y-1,x-1,1,att,cp,Nil);
1574   { return cursor to saved position }
1575   wmove(win,yy,xx);
1576   If doRefresh Then wrefresh(win);
1577End;
1578
1579{-------------------------------------------------------------------
1580 write a string to stdscr with color, without moving the cursor
1581
1582   Col    = x start position
1583   Row    = y start position
1584   Attrib = color (0..127), note color = (background*16)+foreground
1585   Clear  = clear line up to x position
1586   s      = string to write
1587 -------------------------------------------------------------------}
1588Procedure nFWrite(win : pwindow; col,row,attrib : integer; clear : integer; s : string);
1589var
1590   clr : array [0..255] of char;
1591   cs : string;
1592   sub : pWindow;
1593   x,y,
1594   mx,my,
1595   xx,yy : longint;
1596   ctrl : boolean;
1597Begin
1598   if Clear > 0 Then Begin
1599      FillChar(clr,SizeOf(clr),' ');
1600      clr[SizeOf(clr)-1] := #0;
1601      If Clear > MaxCols Then Clear := MaxCols;
1602      cs := Copy(StrPas(clr),1,(Clear-Col)-Length(s)+1);
1603   End Else
1604      cs := '';
1605   s := s+cs;
1606   If s = '' Then Exit;
1607   getyx(win,yy,xx);
1608   getbegyx(win,y,x);
1609   getmaxyx(win,my,mx);
1610   If Length(s) > mx Then s := Copy(s,1,mx);
1611   sub := subwin(win,1,Length(s),y+row-1,x+col-1);
1612   If sub = nil Then Exit;
1613   cs := s;
1614   ctrl := false;
1615   { look for embedded control characters }
1616   For x := 1 to Length(s) Do Begin
1617      If s[x] in [#0..#31] Then Begin
1618         s[x] := ' ';
1619         ctrl := true;
1620      End;
1621   End;
1622   wbkgd(sub,COLOR_PAIR(nSetColorPair(Attrib)));
1623   If nisbold(Attrib) then
1624      wattr_on(sub,A_BOLD,Nil);
1625   mvwaddstr(sub,0,0,StrPCopy(ps,s));
1626   { highlight the embedded control characters substitutes }
1627   If ctrl Then Begin
1628      { nEC is always the current edit control object }
1629      If Attrib <> nEC.CtrlColor Then
1630         nWinColor(sub,nEC.CtrlColor)
1631      Else Begin
1632         { reverse the highlight color if same as current attribute }
1633         bg := nEC.CtrlColor div 16;
1634         fg := nEC.CtrlColor - (bg * 16);
1635         While bg > 7 Do dec(bg,8);
1636         While fg > 7 Do dec(fg,8);
1637         nWinColor(sub,(fg*16)+bg);
1638      End;
1639      For x := 1 to Length(cs) Do Begin
1640         If cs[x] in [#0..#31] Then
1641            mvwaddch(sub,0,x-1,ord(cs[x])+64);
1642      End;
1643   End;
1644   If doRefresh Then wrefresh(sub);
1645   delwin(sub);
1646   wmove(win,yy,xx);
1647End;
1648
1649{ overload - no pointer }
1650Procedure nFWrite(col,row,attrib : integer; clear : integer; s : string);
1651Begin
1652   nFWrite(ActiveWn,col,row,attrib,clear,s);
1653End;
1654
1655{ compatibility for the old function name }
1656Function nSEdit(win : pwindow; x,y,att,z,CursPos:integer;
1657                es:string;var ch : char) : string;
1658Var
1659   s : string;
1660Begin
1661   s := nEdit(win,x,y,att,z,CursPos,es,ch);
1662   nSEdit := s;
1663End;
1664
1665{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1666{                            String Editor                           }
1667Function nEdit(win : pwindow;     { window to work in }
1668               x,y,               { base x,y coordinates of edit region }
1669               att,               { color attribute }
1670               z,                 { right-most column of edit region }
1671               CursPos:integer;   { place cursor on this column at start }
1672               es:string;         { initial value of string }
1673               var chv : integer  { ordinal value of character typed, }
1674                                  { negative for extended keys }
1675               ) : string;
1676Var
1677   ZMode,
1678   AppendMode,
1679   SEditExit : boolean;
1680   prvx,
1681   prvy,
1682   pidx,
1683   pres,
1684   Index : integer;
1685   ts,
1686   hes : string;
1687   isextended : boolean;
1688   ch : char;
1689
1690{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1691Procedure NewString;
1692BEGIN
1693   nEdit := es;
1694   hes := es;
1695   FillChar(hes[1],Length(hes),'*');
1696END;
1697
1698Procedure WriteString;
1699Var
1700   xx,yy : integer;
1701Begin
1702   xx := nWhereX(win);
1703   yy := nWhereY(win);
1704   If nEC.IsHidden Then
1705      nFWrite(win,x,y,att,z,hes)
1706   Else
1707      nFWrite(win,x,y,att,z,es);
1708   nGotoXY(win,xx,yy);
1709End;
1710
1711{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1712Procedure EInsMode;
1713Begin
1714   nEC.InsMode := (not nEC.InsMode)
1715End;
1716
1717{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1718Procedure WriteChar;
1719var s : string;
1720Begin
1721   ts := es;
1722   If AppendMode Then Begin
1723      es := es + ' ';
1724      Index := Length(es);
1725   End Else Begin
1726      If nWhereX(win) >= Length(es)+x Then Repeat
1727         es := es + ' ';
1728      Until Length(es)+x-1 = nWhereX(win);
1729      If es = '' Then es := ' ';
1730      If Length(es)+x-1 = nWhereX(win) Then Index := Length(es);
1731   End;
1732   es[Index] := ch;
1733   s := Copy(es,1,Index);
1734   If nCheckPxPicture(s,nEC.Picture,pidx) <> 0 Then Begin
1735      { no error, picture satisfied }
1736      If (Length(s) > Length(es)) or
1737         ((Length(s) = Length(es)) and (s <> es)) Then Begin
1738         { expanded/changed by picture }
1739         es := s;
1740      End;
1741      If pidx > Index Then Begin
1742         If pidx > Length(es) Then pidx := Length(es);
1743         If pidx > Index Then Index := pidx;
1744      End;
1745   End Else Begin
1746      { error, did not fit the picture }
1747      Sound(1000);
1748      Delay(50);
1749      NoSound;
1750      es := ts;
1751      Dec(Index);
1752   End;
1753   NewString;
1754   WriteString;
1755   If (Index < z-x+1) or not ZMode Then Begin
1756      Index := Index+1;
1757      nGotoXY(win,x+Index-1,y);
1758   End;
1759End;
1760
1761{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1762Procedure EInsert;            { Insert      }
1763Begin
1764   If Length(es) < Z-X+1 Then Begin
1765      ts := es;
1766      Insert(' ',es,Index);
1767      If nCheckPXPicture(es,nEC.Picture,pidx) = 0 Then Begin
1768         Sound(1000);
1769         Delay(50);
1770         NoSound;
1771         es := ts;
1772         ch := #255;
1773      End;
1774      NewString;
1775      WriteString;
1776   End;
1777End;
1778
1779{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1780Procedure EDelete;            { Delete      }
1781Begin
1782   ts := es;
1783   Delete(es,Index,1);
1784   If nCheckPXPicture(es,nEC.Picture,pidx) = 0 Then Begin
1785      Sound(1000);
1786      Delay(50);
1787      NoSound;
1788      es := ts;
1789      ch := #255;
1790   End;
1791   NewString;
1792   WriteString;
1793End;
1794
1795{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1796Procedure ECtrlEnd;           { <CTRL> End  }
1797Begin
1798   Delete(es,Index,Length(es));
1799   NewString;
1800   WriteString;
1801End;
1802
1803{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1804Procedure EHome;             { Home        }
1805Begin
1806   Index := 1;
1807   nGotoXY(win,x,y);
1808End;
1809
1810{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1811Procedure ELeftArrow;         { Left Arrow  }
1812Begin
1813   If nWhereX(win) > x Then Begin
1814      dec(Index);
1815      nGotoXY(win,nWhereX(win)-1,nWhereY(win));
1816   End;
1817End;
1818
1819{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1820Procedure ERightArrow;       { Right Arrow }
1821Begin
1822   If Index < z-x+1 Then Begin
1823      nGotoXY(win,nWhereX(win)+1,nWhereY(win));
1824      Index := Index + 1;
1825   End;
1826End;
1827
1828{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1829Procedure EEnd;               { End         }
1830Begin
1831   Index := Length(es)+1;
1832   If Index > z-x+1 Then Index := Length(es);
1833   If Index < 1 Then Index := 1;
1834   If Index > MaxCols Then Index := MaxCols;
1835   nGotoXY(win,x+(Index-1),y);
1836End;
1837
1838{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1839Procedure EBackSpace;          { Backspace  }
1840Begin
1841   Index := Index - 1;
1842   If Index < 1 Then Begin
1843      Index := 1;
1844      Exit;
1845   End Else
1846      If nWhereX(win) > x Then nGotoXY(win,nWhereX(win) - 1,nWhereY(win));
1847   Delete(es,Index,1);
1848   NewString;
1849   WriteString;
1850   nGotoXY(win,x+(Index-1),y);
1851End;
1852
1853{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1854Procedure ETurboBackSpace; { Ctrl/Backspace  }
1855Begin
1856   If Index = 1 Then Exit;
1857   Delete(es,1,Index-1);
1858   NewString;
1859   Index := 1;
1860   If nWhereX(win) > x Then nGotoXY(win,1,nWhereY(win));
1861   WriteString;
1862   nGotoXY(win,x,y);
1863END;
1864
1865{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1866Procedure ECtrlLeftArrow;{ Ctrl Left Arrow }
1867Begin
1868   If nEC.IsHidden Then Begin
1869      EHome;
1870      Exit;
1871   End;
1872   If es[Index-1] = ' ' Then Index := Index-1;
1873   If es[Index] <> ' ' Then Begin
1874      While (Index > 1) And (es[Index] <> ' ') Do
1875         Index := Index-1;
1876   End Else
1877   If es[Index] = ' ' Then Begin
1878      While (Index > 1) And (es[Index] = ' ') Do
1879         Index := Index-1;
1880      While (Index > 1) And (es[Index] <> ' ') Do
1881         Index := Index-1;
1882   End;
1883   If Index = 1 Then
1884      nGotoXY(win,x,y)
1885   Else Begin
1886      nGotoXY(win,x+Index,y);
1887      Index := Index+1;
1888   End;
1889End;
1890
1891{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1892Procedure ECtrlRightArrow;{ Ctrl Right Arrow  }
1893Begin
1894   If nEC.IsHidden Then Begin
1895      EEnd;
1896      Exit;
1897   End;
1898   While (Index < Length(es)) And (es[Index] <> ' ') Do
1899   Begin
1900        Index := Index+1;
1901   End;
1902   While (Index < Length(es)) And (es[Index] = ' ') Do
1903   Begin
1904        Index := Index+1;
1905   End;
1906   nGotoXY(win,x+Index-1,y);
1907End;
1908
1909{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1910Procedure CheckForWriteChar(embed : boolean);
1911Begin
1912   If embed or Not (Ch In [#27,#255]) Then Begin
1913      If (ch in [#10,#13]) and (not embed) {and not ControlKey} Then exit;
1914      If nEC.ClearMode Then Begin
1915         es := '';
1916         WriteString;
1917         nGotoXY(win,X,Y);
1918         Index := 1;
1919         WriteChar;
1920         nEC.ClearMode := False;
1921      End Else Begin
1922         If nEC.InsMode Then Begin
1923            EInsert;
1924            WriteChar;
1925         End Else WriteChar;
1926      End;
1927   End;
1928End;
1929
1930{~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1931Procedure ProcessSpecialKey;
1932begin
1933   If ch = #129 Then ch := #68; { Linux, map Esc/0 to F10 }
1934   chv := ord(ch) * (-1);       { set the return value }
1935
1936   Case ch of
1937   #16..#25,
1938   #30..#38,
1939   #44..#50,
1940   #59..#68,
1941   #84..#90,
1942  #92..#113,
1943       #118,
1944       #132,
1945        #72,
1946        #73,
1947        #80,
1948        #81 : Begin SEditExit:=True;Exit;End;
1949        #71 : EHome;
1950        #75 : ELeftArrow;
1951        #77 : ERightArrow;
1952        #79 : EEnd;
1953        #82 : EInsMode;
1954        #83 : EDelete;
1955        #15,
1956       #115 : ECtrlLeftArrow;
1957       #116 : ECtrlRightArrow;
1958       #117 : ECtrlEnd;
1959   End;
1960End;
1961
1962{~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
1963Procedure ProcessNormalKey;
1964Var
1965   i : integer;
1966   ctrl : boolean;
1967begin
1968   chv := ord(ch); { set the return value }
1969   For i := 1 to Length(nEC.Special) Do Begin
1970      If ch = nEC.Special[i] Then Begin
1971         SEditExit:=True;
1972         Exit;
1973      End;
1974   End;
1975   ctrl := false;
1976   { standard control key assignments }
1977   case ch of
1978      #0..#15,
1979      #17..#31 : Begin
1980         nEC.ClearMode := False;
1981         Case ch of
1982            #1 : EHome;
1983            #5 : EEnd;
1984            #2 : ELeftArrow;
1985            #6 : ERightArrow;
1986           #19 : ECtrlLeftArrow;
1987            #4 : ECtrlRightArrow;
1988            #7 : EDelete;
1989            #9 : EInsMode;
1990            #8 : EBackSpace;
1991           #10 : ch := #13;
1992           #13 : Begin
1993                    pres := nCheckPxPicture(es,nEC.Picture,pidx);
1994                    If pres <> 2 Then Begin
1995                       Sound(1000);
1996                       Delay(50);
1997                       NoSound;
1998                       ch := #255;
1999                    End;
2000                 End;
2001           #27 : If KeyPressed Then Begin
2002                    { covers up a Linux peculiarity where the next }
2003                    { character typed bleeds through with esc/1..9 }
2004                    nGotoXY(win,prvx,prvy);
2005                    WriteString;
2006                    ch := ReadKey;
2007                    { make it a function key }
2008                    If ch in ['1'..'9'] Then Begin
2009                       ch := Char(Ord(ch)+10);
2010                       chv := ord(ch) * (-1);
2011                    End Else ch := #27;
2012                    SEditExit := true;
2013                 End;
2014         End;
2015         Exit;
2016      End;
2017      #16 : Begin
2018               { embed control characters in the string }
2019               ch := UpCase(ReadKey);
2020               If ch in ['@','2','A'..'Z'] Then Begin
2021                  ctrl := true;
2022                  If ch = '2' Then ch := '@';
2023                  ch := Char(Ord(ch)-64);
2024                  chv := ord(ch);
2025               End;
2026            End;
2027     #127 : Begin nEC.ClearMode := False;ETurboBackSpace;Exit;End;
2028   end;
2029   CheckForWriteChar(ctrl);
2030   ch := #0;
2031end;
2032
2033{-----------------------------------------------------------------------
2034  Map a keystroke to another character, normal or extended.
2035
2036  The maps are 4 character strings interpreted as 2 sets of character
2037  pairs that represent the following:
2038
2039  1st char - If it is #0 then it is an extended char. Use the 2nd
2040             character to identify.
2041  2nd char - Only used if 1st char is #0.
2042
2043  The first pair of the string is the actual key pressed.
2044  The second pair is what that key should be become.
2045
2046  #0#59 = F1, extended key
2047  #59#0 = ; , normal key
2048
2049  So a map of #0#59#59#0 maps the F1 key to the ; key,
2050          and #0#59#0#60 maps the F1 key to the F2 key,
2051          and #0#59#0#0 maps the F1 key to a null.
2052
2053   Examples:
2054     #0#59#0#60 = map F1 to F2
2055     #1#0#0#59  = map ^A to F1
2056     #0#59#1#0  = map F1 to ^A
2057     #0#59#0#0  = map F1 to ^@ (null)
2058     #0#0#0#59  = map ^@ to F1
2059     #97#0#65#0 = map a to A
2060}
2061Procedure MapKey(var ch : char;var eflag : boolean);
2062Var
2063   i,
2064   cv : integer;
2065   s2 : string[2];
2066   s4 : string[4];
2067Begin
2068   cv := Ord(ch);
2069   If eflag Then cv := cv * (-1);
2070   i := 0;
2071   { look for a character map assignment }
2072   Repeat
2073      inc(i);
2074   Until (i > nMaxChMaps) or (nEC.ChMap[i,1] = cv);
2075   { if found, then re-assign ch to the mapped key }
2076   If i <= nMaxChMaps Then Begin
2077      cv := nEC.ChMap[i,2];
2078      eflag := (cv < 0);
2079      ch := chr(abs(cv));
2080   End;
2081(*
2082   { look for a character map assignment }
2083   i := 0;
2084   s4 := #0#0#0#0;
2085   Case eflag of
2086      true  : s2 := #0+ch;
2087      false : s2 := ch+#0;
2088   End;
2089   Repeat
2090      inc(i);
2091   Until (i > nMaxChMaps) or (pos(s2,nEC.ChMap[i]) = 1);
2092   { if found, then re-assign ch to the mapped key }
2093   If i <= nMaxChMaps Then Begin
2094      system.Move(nEC.ChMap[i,1],s4[1],Length(nEC.ChMap[i]));
2095      s2 := Copy(s4,3,2);
2096      eflag := (s2[1] = #0);
2097      Case eflag of
2098         true  : ch := s2[2];
2099         false : ch := s2[1];
2100      End;
2101      If ch = #0 Then eflag := false;
2102   End;
2103*)
2104End;
2105
2106{============================================================================}
2107Begin
2108   SEditExit := nEC.ExitMode;
2109   AppendMode := nEC.AppendMode;
2110   ZMode := z <> 0;
2111   If CursPos > Length(es)+x Then
2112      Index := Length(es)+1                { End Of String    }
2113   Else Index := CursPos+1-x;              { Inside Of String }
2114   If Not ZMode then z := x+length(es);
2115   Newstring;
2116   WriteString;
2117   nGotoXY(win,CursPos,y);
2118   Repeat
2119      prvx := nWhereX(win); { save for ProcessNormalKey }
2120      prvy := nWhereY(win);
2121      If Not ZMode then z := x+length(es);
2122      ch := ReadKey;
2123      isextended := (ch = #0);
2124      If isextended Then
2125         ch := ReadKey;
2126      MapKey(ch,isextended);
2127      If isextended Then
2128         ProcessSpecialKey
2129      Else
2130         ProcessNormalKey;
2131   Until (ch In [#13,#27]) or SEditExit;
2132   nEC.ClearMode := False;
2133   NewString;
2134End;{ of nEdit }
2135
2136{ compatibility for old ch type }
2137Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
2138                es:string;var ch : char) : string;
2139Var i : integer;
2140Begin
2141   nEdit := nEdit(win,x,y,att,z,CursPos,es,i);
2142   ch := chr(abs(i));
2143End;
2144
2145{ nEdit using currently active window }
2146Function nEdit(x,y,att,z,CursPos:integer;
2147               es:string;var ch : integer) : string;
2148Begin
2149   nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
2150End;
2151
2152Function nEdit(x,y,att,z,CursPos:integer;
2153               es:string;var ch : char) : string;
2154Var i : integer;
2155Begin
2156   nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,i);
2157   ch := chr(ord(i));
2158End;
2159
2160{ overload for longint type }
2161Function nEdit(x,y,att,z,CursPos:integer;
2162               es:longint;var ch : integer) : longint;
2163Begin
2164   nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
2165End;
2166
2167Function nEdit(x,y,att,z,CursPos:integer;
2168               es:longint;var ch : char) : longint;
2169Begin
2170   nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
2171End;
2172
2173{ longint with pointer }
2174Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
2175                es:LongInt;var ch : integer) : LongInt;
2176Var
2177   savpic,
2178   ess : string;
2179   esv,
2180   err : longint;
2181Begin
2182   Str(es:0,ess);
2183   savpic := nEC.Picture;
2184   If savpic = '' Then nEC.Picture := '[-]#*#';
2185   ess := nEdit(win,x,y,att,z,CursPos,ess,ch);
2186   nEC.Picture := savpic;
2187   val(ess,esv,err);
2188   nEdit := esv;
2189End;
2190
2191Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
2192               es:longint;var ch : char) : longint;
2193Var i : integer;
2194Begin
2195   nEdit := nEdit(win,x,y,att,z,CursPos,es,i);
2196   ch := chr(abs(i));
2197End;
2198
2199{ overload for real type }
2200Function nEdit(x,y,att,z,CursPos:integer;
2201               es:real;var ch : integer) : real;
2202Begin
2203   nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
2204End;
2205
2206Function nEdit(x,y,att,z,CursPos:integer;
2207               es:real;var ch : char) : real;
2208Var i : integer;
2209Begin
2210   nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,i);
2211   ch := chr(abs(i));
2212End;
2213
2214{ with pointer }
2215Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
2216                es:Real;var ch : integer) : Real;
2217Var
2218   savpic,
2219   ess : string;
2220   esv : real;
2221   i,
2222   err : Integer;
2223Begin
2224   Str(es:0:12,ess);
2225   While ess[Length(ess)] = '0' Do Delete(ess,Length(ess),1);
2226   savpic := nEC.Picture;
2227   If savpic = '' Then Begin
2228      Case nDecFmt of
2229         nUS   : nEC.Picture := '[+,-]#*#[[.*#][{E,e}[+,-]#[#][#][#]]]';
2230         nEURO : Begin
2231                    nEC.Picture := '[+,-]#*#[[;,*#][{E,e}[+,-]#[#][#][#]]]';
2232                    For i := 1 to Length(ess) Do
2233                       If ess[i] = '.' Then ess[i] := ',';
2234                 End;
2235      End;
2236   End;
2237   ess := nEdit(win,x,y,att,z,CursPos,ess,ch);
2238   nEC.Picture := savpic;
2239   For i := 1 to Length(ess) Do If ess[i] = ',' Then ess[i] := '.';
2240   val(ess,esv,err);
2241   nEdit := esv;
2242End;
2243
2244Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
2245               es:real;var ch : char) : real;
2246Var i : integer;
2247Begin
2248   nEdit := nEdit(win,x,y,att,z,CursPos,es,i);
2249   ch := chr(abs(i));
2250End;
2251
2252{ And now some sugar for Rainer Hantsch! }
2253{------------------------------------------------------------------------
2254  This is a right justified number editor. As a digit is typed, the
2255  existing number string gets pushed left and the new digit is appended.
2256  If decimal columns are specified, then pressing <space> will enter the
2257  decimal character (. or ,). A background string can be specified that
2258  fills the empty spaces.
2259 ------------------------------------------------------------------------}
2260Function nEditNumber(
2261       win : pwindow;
2262         x,              { edit field start column }
2263         y,              { edit field start row }
2264       att,              { edit field color attribute }
2265       wid,              { edit field width }
2266      decm : integer;    { number of decimal columns }
2267       bgd : string;     { background string -
2268                           if bgd = '', then no background
2269                           if bgd = a single character, then is used as the
2270                           background fill character.
2271                           if bgd length is longer than wid, then the entire
2272                           bgd string is used as the background.}
2273     initv,              { initial value }
2274      minv,              { range minimum value }
2275      maxv  : real;      { range maximum value }
2276   var esc : boolean     { if Esc key pressed = true, else = false }
2277) : real;
2278
2279Const
2280   { up to 12 decimal places }
2281   decs : string = '[#][#][#][#][#][#][#][#][#][#][#][#]';
2282Var
2283   r : real;
2284   s,s1,s2 : string;
2285   i,
2286   e,
2287   bc,
2288   bx : integer;
2289   ch : char;
2290   fill : array [0..255] of char;
2291   tmp_ec : tnEC;
2292Begin
2293   tmp_ec := nEC;
2294   nEC.ExitMode := true;
2295   nEC.AppendMode := true;
2296   nEC.ClrChMap(0);
2297   nEC.AddChMap(#7#0#0+Char(nKeyDel));
2298   nEC.AddChMap(#8#0#0+Char(nKeyDel));
2299   If decm > (Length(decs) div 3) Then
2300      decm := (Length(decs) div 3);
2301   If decm >= wid Then decm := (wid - 1);
2302   If decm > 0 Then Begin
2303      nEC.Picture := '[-]*#[{.}'+Copy(decs,1,(decm*3))+']';
2304      If nDecFmt = nEURO Then Begin
2305         nEC.Picture[8] := ',';
2306         Insert(';',nEC.Picture,8);
2307         nEC.AddChMap('.'+#0+','+#0);
2308      End;
2309   End Else
2310      nEC.Picture := '[-]*#';
2311   If bgd = '' Then Begin
2312      bgd := ' ';
2313      bc := att;
2314   End Else
2315      bc := nEC.CtrlColor;
2316   If Length(bgd) < wid Then Begin
2317      FillChar(fill,wid,bgd[1]);
2318      fill[wid] := #0;
2319      bgd := StrPas(fill);
2320   End;
2321   bx := x;
2322   If Length(bgd) > wid Then inc(x);
2323   str(initv:wid:decm,s);
2324   While s[1] = ' ' Do Delete(s,1,1);
2325   If Pos('.',s) <> 0 Then
2326      While s[Length(s)] = '0' Do Delete(s,Length(s),1);
2327   If decm = 0 Then Delete(s,Pos('.',s),1);
2328   If nDecFmt = nEURO Then For i := 1 to Length(s) Do
2329      If s[i] = '.' Then s[i] := ',';
2330   Repeat
2331      nFWrite(win,bx,y,bc,bx+Length(bgd)-(x-bx),copy(bgd,1,wid-length(s)+(x-bx)));
2332      If x > bx Then
2333         nFWrite(win,x+wid,y,bc,0,copy(bgd,wid+2,length(bgd)));
2334      s1 := nEdit(win,x+wid-Length(s),y,att,x+wid-1,x+wid-1,s,ch);
2335      s2 := s1;
2336      If nDecFmt = nEURO Then For i := 1 to Length(s2) Do
2337         If s2[i] = ',' Then s2[i] := '.';
2338      val(s2,r,e);
2339      If (s1 = '') or ((e = 0) and (r >= minv) and (r <= maxv)) Then
2340         s := s1
2341      Else
2342         If ch <> #27 then Begin
2343            ch := #0;
2344            Sound(1000);
2345            Delay(50);
2346            NoSound;
2347         End;
2348      nEC.AppendMode := Length(s) < wid;
2349   Until ch in [#13,#27];
2350   esc := (ch = #27);
2351   nEditNumber := r;
2352   nEC := tmp_ec;
2353End;
2354
2355{ overload - real, no pointer }
2356Function nEditNumber(
2357   x,y,att,wid,decm : integer;
2358                bgd : string;
2359              initv,
2360               minv,
2361               maxv : real;
2362            var esc : boolean) : real;
2363Begin
2364   nEditNumber := nEditNumber(ActiveWn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
2365End;
2366
2367{ overload for longint }
2368Function nEditNumber(
2369                win : pwindow;
2370   x,y,att,wid,decm : integer;
2371                bgd : string;
2372              initv,
2373               minv,
2374               maxv : longint;
2375            var esc : boolean) : longint;
2376Var
2377   r : real;
2378Begin
2379   r := nEditNumber(win,x,y,att,wid,0,bgd,Real(initv),Real(minv),Real(maxv),esc);
2380   nEditNumber := Trunc(r);
2381End;
2382
2383{ overload - longint, no pointer }
2384Function nEditNumber(
2385   x,y,att,wid,decm : integer;
2386                bgd : string;
2387              initv,
2388               minv,
2389               maxv : longint;
2390            var esc : boolean) : longint;
2391Var
2392   r : real;
2393Begin
2394   r := nEditNumber(ActiveWn,x,y,att,wid,0,bgd,Real(initv),Real(minv),Real(maxv),esc);
2395   nEditNumber := Trunc(r);
2396End;
2397
2398{ More sugar for Rainer }
2399{------------------------------------------------------------------------
2400  A date string editor.
2401 ------------------------------------------------------------------------}
2402Function nEditDate(
2403       win : pwindow;
2404         x,           { edit field start column }
2405         y,           { edit field start row }
2406       att : integer; { edit field color attribute }
2407     initv : string;     { initial value }
2408   var esc : boolean     { if Esc key pressed = true, else = false }
2409) : string;
2410
2411Var
2412   s : string;
2413   i : integer;
2414   ch : char;
2415   tmp_ec : tnEC;
2416
2417Begin
2418   tmp_ec := nEC;
2419   nEC.InsMode := false;
2420   nEC.ClearMode := false;
2421   nEC.ExitMode := false;
2422   nEC.AppendMode := false;
2423   Case nDecFmt of
2424      nUS :  Begin
2425         nEC.Picture := '{#,m,M}{#,m,M}/{#,d,D}{#,d,D}/{#,y,Y}{#,y,Y}{#,y,Y}{#,y,Y}';
2426         s := 'mm/dd/yyyy';
2427      End;
2428      nEURO : Begin
2429         nEC.Picture := '{#,d,D}{#,d,D}/{#,m,M}{#,m,M}/{#,y,Y}{#,y,Y}{#,y,Y}{#,y,Y}';
2430         s := 'dd/mm/yyyy';
2431      End;
2432   End;
2433   If nCheckPxPicture(initv,nEC.Picture,i) <> 0 Then
2434      system.move(initv[1],s[1],Length(initv));
2435   nEC.AddChMap(#7#0#0+Char(nKeyLeft));
2436   nEC.AddChMap(#8#0#0+Char(nKeyLeft));
2437   nEC.AddChMap(#0+Char(nKeyDel)+#0+Char(nKeyLeft));
2438   Repeat
2439      s := nEdit(win,x,y,att,x+9,x,s,ch);
2440      If ch = #13 Then Begin
2441         For i := 1 to Length(s) Do
2442            If s[i] in ['m','d','y'] Then ch := #0;
2443      End;
2444   Until ch in [#13,#27];
2445   esc := (ch = #27);
2446   nEditDate := s;
2447   nEC := tmp_ec;
2448End;
2449
2450{ overload - no pointer }
2451Function nEditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
2452Begin
2453   nEditDate := nEditDate(ActiveWn,x,y,att,initv,esc);
2454End;
2455
2456{ A one-line procedural wrapper }
2457Procedure nMakeWindow(
2458    var win : tnWindow;
2459    x1,y1,
2460    x2,y2,
2461    ta,ba,ha : integer;
2462    hasframe : boolean;
2463    hdrpos : tnJustify;
2464    hdrtxt : string);
2465Begin
2466   win.init(x1,y1,x2,y2,ta,hasframe,ba);
2467   If hdrtxt <> '' Then win.PutHeader(hdrtxt,ha,hdrpos);
2468End;
2469
2470{ And with a window pointer }
2471Procedure nMakeWindow(
2472    var win : pnWindow;
2473    x1,y1,
2474    x2,y2,
2475    ta,ba,ha : integer;
2476    hasframe : boolean;
2477    hdrpos : tnJustify;
2478    hdrtxt : string);
2479Begin
2480   New(win,init(x1,y1,x2,y2,ta,hasframe,ba));
2481   If hdrtxt <> '' Then win^.PutHeader(hdrtxt,ha,hdrpos);
2482End;
2483
2484{--------------------------------------------------------------------
2485  Display a message in a centered and framed box. With ack set to
2486  false, the window remains active for further use in the program.
2487
2488  Inputs:
2489     msg = message to display
2490     matt = message color
2491     hdr  = header text at frame top
2492     hatt = header/frame color
2493     ack  = TRUE : display ftr text and wait for a keypress, then
2494                   remove the window.
2495            FALSE: don't display ftr, don't wait for a keypress, and
2496                   don't remove the window.
2497  Output:
2498     a nil pointer if ack = true,
2499     a pointer to the tnWindow object if ack = false
2500 --------------------------------------------------------------------}
2501Function nShowMessage(msg : string;
2502                     matt : byte;
2503                      hdr : string;
2504                     hatt : byte;
2505                      ack : boolean) : pnWindow;
2506const
2507   ftr = 'Press Any Key';
2508   acklns : shortint = 0;
2509var
2510   i,j,
2511   cr,
2512   wid,
2513   maxwid,
2514   lines : integer;
2515   mwin : pnWindow;
2516Begin
2517   wid := 0;
2518   maxwid := Length(hdr);
2519   If ack and (Length(ftr) > maxwid) Then
2520      maxwid := Length(ftr);
2521   lines := 1;
2522   { how many rows does this window need ? }
2523   For i := 1 to Length(msg) Do Begin
2524      inc(wid);
2525      { let's be consistant! }
2526      If msg[i] = #13 Then msg[i] := #10;
2527      { either a forced line break or we need to word-wrap }
2528      If (msg[i] = #10) or (wid >= (MaxCols-2)) Then Begin
2529         inc(lines);
2530         j := 0;
2531         If not (msg[i] in [#10,#32]) Then Begin
2532            { we're in a word, so find the previous space (if any) }
2533            Repeat
2534               inc(j);
2535            Until (j=wid) or ((i-j) <= 0) or (msg[i-j] = #32);
2536            If ((i-j) > 0) and (msg[i-j] = #32) Then Begin
2537               wid := wid-j;
2538               msg[i-j] := #10  { force a line break }
2539            End Else
2540               j := 0;
2541         End;
2542         If wid > maxwid Then maxwid := wid;
2543         wid := j; { either 0 or word-wrap remnent }
2544      End;
2545   End;
2546   If wid > maxwid Then maxwid := wid;
2547   If ack Then acklns := 1 else acklns := 0;
2548   { make the message window }
2549   New(mwin,Init(1,1,maxwid+2,lines+acklns+2,matt,true,hatt));
2550   With mwin^ Do Begin
2551      PutHeader(hdr,hatt,center);
2552      Align(center,center);
2553      If lines = 1 Then
2554         { one-liners get centered }
2555         Write(msg:Length(msg)+((maxwid-Length(msg)) div 2))
2556      Else
2557         Write(msg);
2558      Show;
2559      If ack Then Begin
2560         cr := nCursor(cOff);
2561         FWrite(((cols-Length(ftr)) div 2)+1,rows,matt,0,ftr);
2562{
2563  The following line can be used in place of the line above to place the
2564  footer text in the frame instead of with the message body. Make sure to
2565  keep acklns=0.
2566
2567         nFWrite(win,((ncols(win)-Length(ftr)) div 2)+1,nrows(win),hatt,0,ftr);
2568}
2569         Readkey;
2570         While Keypressed Do Readkey;
2571         Hide;
2572         nCursor(cr);
2573      End;
2574   End;
2575   If ack Then Begin
2576      Dispose(mwin,Done);
2577      mwin := nil;
2578   End;
2579   nShowMessage := mwin;
2580End;
2581
2582{---------------------------------------
2583  Read a character string from a window
2584  win - window to extract info from.
2585    x - starting column.
2586    y - starting row.
2587    n - number of characters to read.
2588 ---------------------------------------}
2589Function nReadScr(win : pWindow; x,y,n : integer) : string;
2590Var
2591   i,idx : integer;
2592   s : string;
2593   c : longint;
2594   { array of char/attr values, 4 bytes each, max 256 }
2595   buf : array[0..1023] of char;
2596   p : pchtype;
2597Begin
2598   s := '';
2599   p := nReadScrStr(win,x,y,n,@buf);
2600   If p <> nil Then Begin
2601      idx := 0;
2602      For i := 1 to n Do Begin
2603         system.move(buf[idx],c,SizeOf(c));
2604         s := s + chr(c and A_CHARTEXT);
2605         inc(idx,SizeOf(c));
2606      End;
2607   End;
2608   nReadScr := s;
2609End;
2610
2611{ overload for current window }
2612Function nReadScr(x,y,n : integer) : string;
2613Begin
2614   nReadScr := nReadScr(ActiveWn,x,y,n);
2615End;
2616
2617Function nReadScrStr(win : pWindow; x,y,n : integer; buf : pchtype) : pchtype;
2618Var
2619   cx,cy : integer;
2620   mx,my : longint;
2621Begin
2622   cx := nWhereX(win);
2623   cy := nWhereY(win);
2624   If win <> nil Then Begin
2625      getmaxyx(win,my,mx);
2626      If (x in [1..mx]) and (y in [1..my]) Then Begin
2627         { n is contrained to the right margin, so no need to range check }
2628         mvwinchnstr(win,y-1,x-1,buf,n);
2629         nGotoXY(win,cx,cy);
2630      End;
2631   End;
2632   nReadScrStr := buf;
2633End;
2634
2635{ overload for current window }
2636Function nReadScrStr(x,y,n : integer; buf : pchtype) : pchtype;
2637Begin
2638   nReadScrStr := nReadScrStr(ActiveWn,x,y,n,buf);
2639End;
2640
2641Function nReadScrColor(win : pWindow; x,y : integer) : integer;
2642Var
2643   cl,
2644   fg,bg,
2645   cx,cy : integer;
2646   c,cv,
2647   mx,my : longint;
2648Begin
2649   cl := -1;
2650   cx := nWhereX(win);
2651   cy := nWhereY(win);
2652   If win <> nil Then Begin
2653      getmaxyx(win,my,mx);
2654      If (x in [1..mx]) and (y in [1..my]) Then Begin
2655         c := mvwinch(win,y-1,x-1);
2656         nGotoXY(win,cx,cy);
2657         cv := PAIR_NUMBER(c and A_COLOR);
2658         pair_content(cv,@fg,@bg);
2659         fg := c2ibm(fg);
2660         bg := c2ibm(bg);
2661         cv := (c and A_ATTRIBUTES);
2662         If A_BOLD and cv = A_BOLD Then inc(fg,8);
2663         cl := (bg*16)+fg;
2664      End;
2665   End;
2666   nReadScrColor := cl;
2667End;
2668
2669{ overload for current window }
2670Function nReadScrColor(x,y : integer) : integer;
2671Begin
2672   nReadScrColor := nReadScrColor(ActiveWn,x,y);
2673End;
2674
2675{ write a string with attributes, previously saved with nReadScrStr }
2676Procedure nWriteScrStr(win : pWindow; x,y : integer; s : pchtype);
2677Begin
2678   mvwaddchstr(win,y-1,x-1,s);
2679   If doRefresh Then wrefresh(win);
2680End;
2681
2682{ overload for current window }
2683Procedure nWriteScrStr(x,y : integer; s : pchtype);
2684Begin
2685   mvwaddchstr(ActiveWn,y-1,x-1,s);
2686   If doRefresh Then wrefresh(ActiveWn);
2687End;
2688
2689{---------------------------------------
2690 save a rectangular portion of a window
2691   x = start column
2692   y = start row
2693   c = number of columns
2694   r = number of rows
2695 ---------------------------------------}
2696Procedure nGrabScreen(var p : pnScreenBuf; x,y,c,r : integer; win : pWindow);
2697Var
2698   mx,my : longint;
2699   i,
2700   cx,cy : integer;
2701   prb,trb : pnRowBuf;
2702Begin
2703   nReleaseScreen(p);
2704   getmaxyx(win,my,mx);
2705   If not (x in [1..mx]) or Not (y in [1..my]) Then Begin
2706      p := nil;
2707      Exit;
2708   End;
2709   cx := nWhereX(win);
2710   cy := nWhereY(win);
2711   New(p);
2712   p^.x := x;
2713   p^.y := y;
2714   p^.n := c;
2715   p^.first := nil;
2716   trb := nil;
2717   For i := 0 to r-1 Do Begin
2718      If (y+i in [1..my]) Then Begin
2719         New(prb);
2720         GetMem(prb^.row,c*SizeOf(chtype));
2721         mvwinchnstr(win,y-1+i,x-1,prb^.row,c);
2722         If trb <> nil Then trb^.Next := prb;
2723         prb^.next := nil;
2724         trb := prb;
2725         If i = 0 Then p^.First := prb;
2726      End;
2727   End;
2728   nGotoXY(win,cx,cy);
2729End;
2730
2731{ overload for current window }
2732Procedure nGrabScreen(var p : pnScreenBuf; x,y,c,r : integer);
2733Begin
2734   nGrabScreen(p,x,y,c,r,ActiveWn);
2735End;
2736
2737{ overload for current full window }
2738Procedure nGrabScreen(var p : pnScreenBuf);
2739Var
2740   c,r : longint;
2741Begin
2742   getmaxyx(ActiveWn,r,c);
2743   nGrabScreen(p,1,1,c,r,ActiveWn);
2744End;
2745
2746{-----------------------------------------
2747 restore a window saved with nGrabScreen
2748   p = pointer to the saved buffer
2749   x = start restore to this column
2750   y = start restore to this row
2751   win = restore to this window
2752 -----------------------------------------}
2753Procedure nPopScreen(p : pnScreenBuf; x,y : integer; win : pWindow);
2754Var
2755   cx,cy : integer;
2756   mx,my : longint;
2757   pb : pnRowBuf;
2758Begin
2759   If p = nil Then Exit;
2760   getmaxyx(win,my,mx);
2761   If Not (x in [1..mx]) or Not (y in [1..my]) Then Exit;
2762   dec(x);
2763   cx := nWhereX(win);
2764   cy := nWhereY(win);
2765   pb := p^.First;
2766   While pb <> nil Do Begin
2767      If (pb^.row <> nil) and (y in [1..my]) Then
2768         mvwaddchnstr(win,y-1,x,pb^.row,p^.n);
2769      inc(y);
2770      pb := pb^.next;
2771   End;
2772   nGotoXY(win,cx,cy);
2773   If doRefresh Then wrefresh(win);
2774End;
2775
2776{ overload for current window, defined position }
2777Procedure nPopScreen(p : pnScreenBuf; x,y : integer);
2778Begin
2779   nPopScreen(p,x,y,ActiveWn);
2780End;
2781
2782{ overload for current window, saved position }
2783Procedure nPopScreen(p : pnScreenBuf);
2784Begin
2785   If p = nil Then Exit;
2786   nPopScreen(p,p^.x,p^.y,ActiveWn);
2787End;
2788
2789{ free up the memory used to store a grabbed screen }
2790Procedure nReleaseScreen(p : pnScreenBuf);
2791Var
2792   cur,tmp : pnRowBuf;
2793Begin
2794   If p = nil Then Exit;
2795   If p^.first <> nil Then Begin
2796      cur := p^.first;
2797      While cur <> nil Do Begin
2798         tmp := cur^.next;
2799         If cur^.row <> nil Then FreeMem(cur^.row,p^.n * SizeOf(chtype));
2800         Dispose(cur);
2801         cur := tmp;
2802      End;
2803   End;
2804   Dispose(p);
2805End;
2806
2807{============================== tnMenu ====================================}
2808
2809{ A one-line procedural wrapper }
2810Procedure nMakeMenu(
2811    var mnu : tnMenu;
2812    x,y,
2813    _w,_r,_c,
2814    ta,ca,ga,ba,ha : integer;
2815    hasframe : boolean;
2816    hdrpos : tnJustify;
2817    hdrtxt : string);
2818Begin
2819   mnu.init(x,y,_w,_r,_c,ta,ca,ga,hasframe,ba);
2820   If hdrtxt <> '' Then mnu.PutHeader(hdrtxt,ha,hdrpos);
2821End;
2822
2823{ And with a menu pointer }
2824Procedure nMakeMenu(
2825    var mnu : pnMenu;
2826    x,y,
2827    _w,_r,_c,
2828    ta,ca,ga,ba,ha : integer;
2829    hasframe : boolean;
2830    hdrpos : tnJustify;
2831    hdrtxt : string);
2832Begin
2833   New(mnu,init(x,y,_w,_r,_c,ta,ca,ga,hasframe,ba));
2834   If hdrtxt <> '' Then mnu^.PutHeader(hdrtxt,ha,hdrpos);
2835End;
2836
2837Constructor tnMenu.Init(_x,_y,_w,_r,_c,_tc,_cc,_gc : integer;
2838                         _fr : boolean; _fc : integer);
2839Begin
2840   x := _x;
2841   y := _y;
2842   wid := _w;
2843   r := _r;
2844   c := _c;
2845   tc := _tc;
2846   cc := _cc;
2847   gc := _gc;
2848   framed := _fr;
2849   fc := _fc;
2850   hc := fc;
2851   iidx := 0;
2852   mark := '';
2853   posted := false;
2854   If wid > MaxCols Then wid := MaxCols;
2855   InitWin;
2856   Spin(false);
2857End;
2858
2859Destructor tnMenu.Done;
2860Begin
2861   UnPost;
2862   Clear;
2863   Dispose(win,Done);
2864End;
2865
2866Procedure tnMenu.InitWin;
2867Const
2868   xhgt : shortint = 0;
2869Begin
2870   If framed Then xhgt := 2 Else xhgt := 0;
2871   New(win,Init(x,y,(x+wid-1),(y+r+xhgt-1),tc,framed,fc));
2872End;
2873
2874Procedure tnMenu.Post;
2875Var
2876   bx,by,
2877   mx,my : longint;
2878   p : pchar;
2879   a : array[0..SizeOf(tnS10)-1] of char;
2880Begin
2881   { could already be posted }
2882   UnPost;
2883   { see if the window size has changed (a new longer item added?) }
2884   getmaxyx(win^.win,my,mx);
2885   If (wid <> mx) Then Begin
2886      getbegyx(win^.win,by,bx);
2887      Dispose(win,Done);
2888      x := bx+1;
2889      y := by+1;
2890      InitWin;
2891   End;
2892   { create the new menu }
2893   pm := new_menu(@pi);
2894   { only show item text }
2895   menu_opts_off(pm,O_SHOWDESC);
2896   { bind the windows }
2897   set_menu_win(pm,win^.win);
2898   set_menu_sub(pm,win^.wn);
2899   { set the rows and columns }
2900   set_menu_format(pm,r,c);
2901   { set the colors }
2902   set_menu_fore(pm,CursesAtts(cc));
2903   set_menu_back(pm,CursesAtts(tc));
2904   set_menu_grey(pm,CursesAtts(gc));
2905   p := StrPCopy(a,mark);
2906   set_menu_mark(pm,p);
2907   merr := post_menu(pm);
2908   posted := (merr = E_OK);
2909   Spin(loopon);
2910End;
2911
2912Procedure tnMenu.UnPost;
2913Begin
2914   merr := unpost_menu(pm);
2915   merr := free_menu(pm);
2916   pm := nil;
2917   posted := false;
2918End;
2919
2920Procedure tnMenu.Show;
2921Begin
2922   If not posted Then Post;
2923   win^.Show;
2924End;
2925
2926{ Start user interaction loop }
2927Procedure tnMenu.Start;
2928Const
2929   select = #13;
2930   cancel = #27;
2931Var
2932   key : char;
2933   i,cnt,
2934   prev,
2935   savecurs,
2936   xkey : integer;
2937   direction : longint;
2938Begin
2939   Show;
2940   iidx := 0;
2941   savecurs := nCursor(cOFF);
2942   Repeat
2943      prev := iidx;
2944      win^.Show;
2945      key := readkey;
2946      xkey := 0;
2947      case key of
2948         #0 : xkey := ord(readkey);
2949         ^F : xkey := nKeyHome;
2950         ^L : xkey := nKeyEnd;
2951         #9,
2952         ^N : xkey := nKeyDown;
2953         ^P : xkey := nKeyUp;
2954         else menu_driver(pm,ord(key));
2955      end;
2956      case xkey of
2957         nKeyHome : menu_driver(pm,REQ_FIRST_ITEM);
2958         nKeyEnd  : menu_driver(pm,REQ_LAST_ITEM);
2959         nKeyRight,
2960         nKeyDown : menu_driver(pm,REQ_NEXT_ITEM);
2961         nKeyLeft,
2962         nKeyUp   : menu_driver(pm,REQ_PREV_ITEM);
2963      end;
2964      iidx := item_index(current_item(pm)) + 1;
2965      If (not Selectable(iidx)) and (key <> cancel) Then Begin
2966         cnt := Count;
2967         If cnt > 1 Then Begin
2968            { temporarily enable spinning }
2969            If not loopon Then
2970               menu_opts_off(pm,O_NONCYCLIC);
2971            { which way to another item? }
2972            If iidx > prev Then
2973               direction := REQ_NEXT_ITEM
2974            Else
2975               direction := REQ_PREV_ITEM;
2976            Repeat
2977               menu_driver(pm,direction);
2978               i := item_index(current_item(pm)) + 1;
2979            Until Selectable(i) or (i = iidx);
2980            { reset spin }
2981            Spin(loopon);
2982            { keep prev honest }
2983            iidx := item_index(current_item(pm)) + 1;
2984         End;
2985      End;
2986   Until key in [select,cancel];
2987   menu_driver(pm,REQ_CLEAR_PATTERN);
2988   If iidx = ERR Then merr := iidx;
2989   If key = cancel Then iidx := 0;
2990   nCursor(savecurs);
2991End;
2992
2993Procedure tnMenu.Stop;
2994Begin
2995   Hide;
2996   UnPost;
2997End;
2998
2999Procedure tnMenu.Hide;
3000Begin
3001   win^.Hide;
3002End;
3003
3004Function tnMenu.Wind : pnWindow;
3005Begin
3006   Wind := win;
3007End;
3008
3009Procedure tnMenu.Align(hpos,vpos : tnJustify);
3010Begin
3011   win^.Align(hpos,vpos);
3012End;
3013
3014Procedure tnMenu.Move(_x,_y : integer);
3015Begin
3016   win^.Move(_x,_y);
3017End;
3018
3019Procedure tnMenu.PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
3020Begin
3021   win^.PutHeader(hdr,hcolor,hpos);
3022End;
3023
3024Procedure tnMenu.Clear;
3025Var
3026   i : integer;
3027Begin
3028   UnPost;
3029   For i := 1 to nMAXMENUITEMS Do ClearItem(i);
3030End;
3031
3032{ is this menu item selectable }
3033Function tnMenu.Selectable(idx : integer) : boolean;
3034Begin
3035   Selectable := IsAssigned(idx) and
3036   ((O_SELECTABLE and item_opts(pi[idx])) = O_SELECTABLE);
3037End;
3038
3039Function tnMenu.IsValid(idx : integer) : boolean;
3040Begin
3041   IsValid := ((idx >= 1) and (idx <= nMAXMENUITEMS));
3042End;
3043
3044Function tnMenu.IsAssigned(idx : integer) : boolean;
3045Begin
3046   IsAssigned := IsValid(idx) and (pi[idx] <> nil);
3047End;
3048
3049Procedure tnMenu.ClearItem(idx : integer);
3050Begin
3051   If IsValid(idx) Then Begin
3052      If items[idx] <> nil Then Begin
3053         merr := free_item(pi[idx]);
3054         If merr = E_OK Then Begin
3055            FreeMem(items[idx],StrLen(items[idx]^)+1);
3056            pi[idx] := nil;
3057            items[idx] := nil;
3058         End;
3059      End;
3060   End Else merr := E_BAD_ARGUMENT;
3061End;
3062
3063Procedure tnMenu.AddItem(i : integer; s : string);
3064Const
3065   fwid : shortint = 0;
3066   iwid : shortint = 1;
3067Var
3068   rl : integer;
3069   sp1,sp2,sp3 : plongint;
3070Begin
3071   If IsValid(i) Then Begin
3072      sp1:=nil; sp2:=nil; sp3:=nil;
3073      ClearItem(i);
3074      GetMem(items[i],Length(s)+1);
3075      StrPCopy(items[i]^,s);
3076      pi[i] := new_item(pchar(items[i]),nil);
3077      If pi[i] <> Nil Then Begin
3078         merr := E_OK;
3079         { Expand the window width if necessary. Limit to screen width.
3080           Add possibly 2 for the frame, the item indicator length, and
3081           the item spacing value. }
3082         If framed Then fwid := 2;
3083         if c > 1 Then Begin
3084            If posted Then Begin
3085               { need a valid pm }
3086               menu_spacing(pm,sp1,sp2,sp3);
3087               iwid := Length(GetMark) + sp3^;
3088            End Else
3089               iwid := Length(GetMark) + 1;
3090         End Else
3091            iwid := 0;
3092         { required length }
3093         rl := ((Length(s)+iwid)*c)+fwid;
3094         { expand? }
3095         If rl > wid Then wid := rl;
3096         If wid > MaxCols Then wid := MaxCols;
3097      End Else merr := E_REQUEST_DENIED;
3098   End Else merr := E_BAD_ARGUMENT;
3099End;
3100
3101Function tnMenu.Add(s : string) : integer;
3102Var
3103   i : integer;
3104Begin
3105   i := 0;
3106   Add := 0;
3107   Repeat
3108      inc(i);
3109   Until (i > nMAXMENUITEMS) or (items[i] = nil);
3110   AddItem(i,s);
3111   If merr = E_OK Then Add := i;
3112End;
3113
3114Procedure tnMenu.Insert(idx : integer; s : string);
3115Begin
3116   If IsValid(idx) Then Begin
3117      ClearItem(nMAXMENUITEMS);
3118      If idx < nMAXMENUITEMS Then Begin
3119         { shift the pointer list up and keep lists syncronized }
3120         system.Move(pi[idx],pi[idx+1],SizeOf(pnMenuStr)*(nMAXMENUITEMS-idx));
3121         system.Move(items[idx],items[idx+1],SizeOf(pItem)*(nMAXMENUITEMS-idx));
3122         pi[idx] := nil;
3123         items[idx] := nil;
3124      End;
3125      AddItem(idx,s);
3126   End Else merr := E_BAD_ARGUMENT;
3127End;
3128
3129Procedure tnMenu.Remove(idx : integer);
3130Begin
3131   If IsValid(idx) Then Begin
3132      ClearItem(idx);
3133      { shift the pointer list down and keep lists syncronized }
3134      system.Move(pi[idx+1],pi[idx],SizeOf(pnMenuStr)*(nMAXMENUITEMS-idx));
3135      system.Move(items[idx+1],items[idx],SizeOf(pItem)*(nMAXMENUITEMS-idx));
3136      pi[nMAXMENUITEMS] := nil;
3137      items[nMAXMENUITEMS] := nil;
3138   End Else merr := E_BAD_ARGUMENT;
3139End;
3140
3141Procedure tnMenu.Change(idx : integer; s : string);
3142Begin
3143   AddItem(idx,s);
3144End;
3145
3146{ toggle a menu item's selectability }
3147Procedure tnMenu.Active(idx : integer; b : boolean);
3148Begin
3149   Case b of
3150      true : item_opts_on(pi[idx],O_SELECTABLE);
3151      false : item_opts_off(pi[idx],O_SELECTABLE);
3152   End;
3153End;
3154
3155{ is the item selectable? }
3156Function tnMenu.IsActive(idx : integer) : boolean;
3157Begin
3158   IsActive := Selectable(idx);
3159End;
3160
3161{ Toggle item looping. Moves to first/last when bottom/top is reached }
3162Procedure tnMenu.Spin(b : boolean);
3163Begin
3164   loopon := b;
3165   If posted Then
3166    Case b of
3167       true : menu_opts_off(pm,O_NONCYCLIC);
3168       false : menu_opts_on(pm,O_NONCYCLIC);
3169    End;
3170End;
3171
3172{ return most recent error status }
3173Function tnMenu.Status : integer;
3174Begin
3175   Status := merr;
3176End;
3177
3178Function tnMenu.Index : integer;
3179Begin
3180   Index := iidx;
3181End;
3182
3183Procedure tnMenu.SetIndex(idx : integer);
3184Begin
3185   If IsValid(idx) and IsAssigned(idx) and Selectable(idx) Then Begin
3186      set_current_item(pm,pi[idx]);
3187      iidx := idx;
3188   End;
3189End;
3190
3191Function tnMenu.Count : integer;
3192Begin
3193   Count := item_count(pm);
3194End;
3195
3196Function tnMenu.Rows(_r : integer) : integer;
3197Begin
3198   Rows := r;
3199   If _r > 0 Then r := _r;
3200End;
3201
3202Function tnMenu.Cols(_c : integer) : integer;
3203Begin
3204   Cols := c;
3205   If _c > 0 Then c := _c;
3206End;
3207
3208{ get the item indicator prefix string }
3209Function tnMenu.GetMark : string;
3210Begin
3211   If posted Then
3212      GetMark := StrPas(menu_mark(pm))
3213   Else
3214      GetMark := mark;
3215End;
3216
3217{ set the item indicator prefix string }
3218Procedure tnMenu.SetMark(ms : string);
3219Begin
3220   mark := ms;
3221End;
3222
3223Procedure tnMenu.Refresh;
3224Begin
3225   Post;
3226   Show;
3227End;
3228
3229Procedure tnMenu.SetColor(att : byte);
3230Begin
3231   tc := att;
3232   If posted Then set_menu_back(pm,CursesAtts(tc));
3233End;
3234
3235Procedure tnMenu.SetCursorColor(att : byte);
3236Begin
3237   cc := att;
3238   If posted Then set_menu_fore(pm,CursesAtts(cc));
3239End;
3240
3241Procedure tnMenu.SetFrameColor(att : byte);
3242Begin
3243   fc := att;
3244   If posted Then Wind^.PutFrame(att);
3245End;
3246
3247Procedure tnMenu.SetGrayColor(att : byte);
3248Begin
3249   gc := att;
3250   If posted Then set_menu_grey(pm,CursesAtts(gc));
3251End;
3252
3253{----------------------- initialize the unit!------------------------- }
3254Begin
3255   FillChar(_chmap,SizeOf(_chmap),0);
3256   nEC.Init(false,false,false,false,false,'','',15,_chmap);
3257   { load the color pairs array with color pair indices (0..63) }
3258   For bg := 0 to 7 Do For fg := 0 to 7 do cp[bg,fg] := (bg*8)+fg;
3259   { initialize ncurses }
3260   If StartCurses(ActiveWn) Then Begin
3261      { save pointer to ncurses stdscr }
3262      nscreen := ActiveWn;
3263      { defaults, crtassign, etc. }
3264      nInit;
3265      { create the default full screen, non-bordered window object }
3266      nStdScr.Init(1,1,MaxCols,MaxRows,7,false,0);
3267      { default read/write to stdscr }
3268      ActiveWn := nscreen;
3269   End Else Begin
3270      CursesFailed;
3271   End;
3272End. { of Unit oCrt }
3273
3274