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