12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072 |
- Unit oCrt;
- {---------------------------------------------------------------------------
- CncWare
- (c) Copyright 1999-2000
- ---------------------------------------------------------------------------
- Filename..: ocrt.pp
- Programmer: Ken J. Wright, [email protected]
- Date......: 03/01/99
- Purpose - crt unit replacement plus OOP windows using ncurses.
- NOTE: All of the crt procedures & functions have been replaced with ncurses
- driven versions. This makes the ncurses library a little easier to use in a
- Pascal program and benefits from terminal independence.
- -------------------------------<< REVISIONS >>--------------------------------
- Ver | Date | Prog| Description
- -------+----------+-----+-----------------------------------------------------
- 1.00 | 03/01/99 | kjw | Initial Release.
- | 03/22/99 | kjw | Added nDelWindow(), delwin() does not nil pointer.
- 1.01 | 11/22/99 | kjw | Added the following: nEcho, ClrEol, ClrBot, InsLine,
- | DelLine, Delay, nClrEol, nClrBot, nInsLine, nDelLine,
- | nRefresh, nScroll, nDrawBox, nNewWindow, nWinColor,
- | nWriteScr, nFrame & some functions for returning
- | line drawing character values.
- 1.02 | 11/26/99 | kjw | Added nKeypressed().
- 1.03 | 12/01/99 | kjw | Added global boolean nIsActive.
- 1.04 | 12/03/99 | kjw | 1) Added procedures nHline, nVLine, & nWriteAC.
- | 2) Changed all the line draw character functions
- | (i.e., nHL, nVL) to return the longint value from
- | ncurses rather than the character value (which was
- | not very useful!). Now these can be passed to
- | nWriteAC() to correctly write the line drawing
- | characters.
- | 3) Added more of the ACS characters.
- 1.05 | 12/08/99 | kjw | 1) StartCurses() is now done as part of the unit
- | initialization block. EndCurses() is done via an
- | exit procedure.
- | 2) nIsActive is now a function (safer!).
- | 3) Added panel unit for windowing.
- | 4) Added tnWindow object.
- 1.10 | 12/12/99 | kjw | Added nSEdit().
- 1.11 | 12/12/99 | kjw | Added Special property to tEC object. Now any normal
- | character can trigger sedit to exit.
- ------------------------------------------------------------------------------
- 2.00 | 12/13/99 | kjw | nCrt renamed to oCrt. A new nCrt has been created
- | which is a drop-in replacement for the FPC crt unit.
- | oCrt contains all of nCrt plus the OOP extensions.
- | All of the common code is in ncrt.inc.
- 2.01 | 12/15/99 | kjw | 1) A tnWindow object now becomes the target for
- | stdout following Init & Show. A Hide will put the
- | target back to stdscr.
- | 2) Added nSetActiveWin() to manually pick a target
- | window for stdout.
- 2.02 | 12/15/99 | kjw | 1) PutFrame applied keypad to stdscr instead of sub.
- | 2) See ncrt.inc
- 2.03 | 12/16/99 | kjw | 1) See ncrt.inc
- | 2) Added shift/f-key constants.
- 2.04 | 01/04/00 | kjw | See ncrt.inc
- 2.05 | 01/06/00 | kjw | 1) See ncrt.inc.
- | 2) Added boolean internal_fwrite. FWrite was failing
- | when trying to write outside of the active window.
- | 3) nSEdit was not handling tec.firsttime correctly
- | when a tec.special was processed.
- 2.06 | 01/11/00 | kjw | See ncrt.inc.
- 2.07 | 01/31/00 | kjw | 1) See ncrt.inc.
- | 2) Added getcolor, getframecolor, getheadercolor
- | methods to tnWindow.
- 2.08 | 06/09/00 | kjw | 1) Added Picture property to tEC object. This is
- | used for picture input masking in nSEdit.
- | 2) Added nCheckPxPicture() function.
- | 3) nSEdit() changed to use picture input masking.
- | See pxpic.txt for a description of the picture
- | string format.
- 2.08.01 | 06/11/2000 | kjw
- | Fixed the spin cycle problem in nCheckPXPicture.
- 2.09.00 | 06/16/2000 | kjw
- | 1) nSEdit renamed to nEdit. Now nSEdit just calls nEdit() for
- | compatibility.
- | 2) Added overloaded nEdit functions for Integer, LongInt, and
- | Real types.
- | 3) Changed nEdit() embedding of control characters to preface
- | with a ^P. Also now uses a highlight attribute for the control
- | characters.
- | 4) Added control character cursor control to nEdit().
- | 5) Added Esc/1..0 = F1..F10 to nEdit().
- | 6) Added '@' to match set in pxpic.inc.
- | 7) tnWindow.Align was not positioning properly. Off by one.
- | 8) tnWindow.Init used wrong pointer for keypad and intrflush.
- | 9) tnWindow.Edit was messing up ec.Special.
- 2.09.01 | 06/16/2000 | kjw
- | 1) nStdScr (tnWindow) added and initialized at unit startup.
- | nStdScr can be used for a default full screen window.
- | 2) nEdit overloaded to work without a window pointer. It works
- | with the currently active window.
- 2.10.00 | 06/23/2000 | kjw
- | 1) Added character mapping to the tEC object. This includes the
- | ChMap property and the AddChMap() and ClrChMap() methods.
- | 2) Added AppendMode property to the tEC object. The character
- | typed in nEdit() is always appended to the current string
- | regardless of cursor position. Useful when ExitMode is true.
- | 3) tnWindow.Done was not re-assigning an ActiveWn.
- | 4) nEdit LeftArrow was allowing < x.
- | 5) Added nEditNumber() function.
- | 6) Added nEditDate() function.
- | 7) I made a command decision and renamed the tEC.FirstTime
- | property to tEC.ClearMode as it is more descriptive.
- 2.11.00 | 1) Cleaned up some loose ends with 2.10.
- | 2) Some more overloading
- | 3) Removed tnWindow.readln, write, and writeln methods.
- | 4) See ncrt.inc.
- 2.12.00 | 1) Remove the "n" from the tnWindow.editxxx functions for
- | consistancy. Procedurals are prefaced with an "n". Object methods
- | are not.
- | 2) Procedural FWrite renamed to nFWrite.
- | 3) tEC object type renamed to tnEC.
- | 4) Added nMakeWindow(), a one line procedural wrapper for
- | tnWindow.Init and tnWindow.PutHeader.
- | 5) Added GetX, GetY, IsFramed methods to tnWindow;
- | 6) Fixed nFWrite for too long strings;
- | 7) tnWindow.Align was wrong when justify was none.
- 2.13.00 | 06/30/00 | kjw | See ncrt.inc
- 2.14.00 | 07/05/00 | kjw | See ncrt.inc
- ------------------------------------------------------------------------------
- }
- Interface
- Uses linux,ncurses,panel;
- Const
- { decimal number format, us or european }
- nUS = 0;
- nEURO = 1;
- nDecFmt : byte = nUS;
- { border styles for text boxes }
- btNone : integer = 0;
- btSingle : integer = 1;
- btDouble : integer = 2;
- { ordinal key codes }
- nKeyEnter = 13; { Enter key }
- nKeyEsc = 27; { Home key }
- nKeyHome = 71; { Home key }
- nKeyUp = 72; { Up arrow }
- nKeyPgUp = 73; { PgUp key }
- nKeyLeft = 75; { Left arrow }
- nKeyRight = 77; { Right arrow }
- nKeyEnd = 79; { End key }
- nKeyDown = 80; { Down arrow }
- nKeyPgDn = 81; { PgDn key }
- nKeyIns = 82; { Insert key }
- nKeyDel = 83; { Delete key }
- nKeyCtrlLeft = 115; { Ctrl/left arrow }
- nKeyCtrlRight = 116; { Ctrl/right arrow }
- nKeyF1 = 59; { f1 key }
- nKeyF2 = 60; { f2 key }
- nKeyF3 = 61; { f3 key }
- nKeyF4 = 62; { f4 key }
- nKeyF5 = 63; { f5 key }
- nKeyF6 = 64; { f6 key }
- nKeyF7 = 65; { f7 key }
- nKeyF8 = 66; { f8 key }
- nKeyF9 = 67; { f9 key }
- nKeyF10 = 68; { f10 key }
- nKeyF11 = 84; { shift/f1 key }
- nKeyF12 = 85; { shift/f2 key }
- nKeyF13 = 86; { shift/f3 key }
- nKeyF14 = 87; { shift/f4 key }
- nKeyF15 = 88; { shift/f5 key }
- nKeyF16 = 89; { shift/f6 key }
- nKeyF17 = 90; { shift/f7 key }
- nKeyF18 = 91; { shift/f8 key }
- nKeyF19 = 92; { shift/f9 key }
- nKeyF20 = 93; { shift/f10 key }
- { character mapping }
- nMaxChMaps = 255; { maximun index for character mapping }
- { menus }
- nMAXMENUITEMS = 23;
- Type
- { for scrolling a window }
- tnUpDown = (up,down);
- { for window & header positioning }
- tnJustify = (none,left,center,right,top,bottom);
- { used for nEC character mapping }
- nChMapStr = string[4];
- nChMap = array [1..nMaxChMaps] of nChMapStr;
- { used for nSEdit }
- {------------------------------------------------------------------------
- ClearMode = true : passed string is initialized to ''.
- IsHidden = true : causes a string of '*' to display in place of
- the actual characters typed.
- InsMode : toggle for insert/overwrite mode.
- ExitMode = true : sedit exits after every keystroke.
- = false: sedit only exits when #27,#13, or any extended
- key *except* for Home,End,RArrow,LArrow.
- Special : If a pressed key is found in this string, then
- sedit exits without processing.
- Picture : An input mask string. See pxpic.txt for an
- explanation of picture strings.
- CtrlColor : The highlight color for embedded control characters.
- ChMap : An array of character triplets describing a character
- that is typed and what it should map to.
- ------------------------------------------------------------------------}
- tnEC = Object
- ClearMode,
- IsHidden,
- InsMode,
- ExitMode,
- AppendMode : boolean;
- Special : string;
- Picture : string;
- CtrlColor : integer;
- ChMap : nChMap;
- Constructor Init(ft,ih,im,em,ap : boolean;
- s,p : string;
- cc : integer;
- mp : nChMap);
- Destructor Done;
- Function AddChMap(mp : nChMapStr) : integer;
- Procedure ClrChMap(idx : integer);
- End;
- pwin = ^Window;
- pnWindow = ^tnWindow;
- tnWindow = Object
- Private
- wn : pwindow; { pointer to win or sub to read/write to }
- win : pwindow; { pointer to main window record }
- sub : pwindow; { sub window if a bordered window }
- pan : ppanel; { pointer to panel record }
- subp : ppanel; { sub panel if a bordered window }
- visible : boolean; { is the window visible? }
- hasframe : boolean;
- wincolor, { window color }
- framecolor, { frame color }
- hdrcolor : integer; { header color }
- header : string[80]; { header string }
- Public
- ec : tnEC; { edit control settings }
- Constructor Init(x,y,x1,y1,wcolor : integer;
- border : boolean;
- fcolor : integer);
- Destructor Done;
- Procedure Active; { make this the current window }
- Procedure Show; { display the window }
- Procedure Hide; { hide the window }
- Procedure ClrScr;
- Procedure ClrEol;
- Procedure ClrBot;
- Procedure InsLine;
- Procedure DelLine;
- Procedure GotoXY(x,y : integer);
- Function WhereX : integer;
- Function WhereY : integer;
- Function ReadKey : char;
- Procedure WriteAC(x,y,att,c : longint);
- Procedure FWrite(x,y,att,z : integer; s : string);
- Procedure DrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
- Function GetHeader : string;
- Procedure PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
- Procedure SetColor(att : integer);
- Function GetColor : integer;
- Function GetFrameColor : integer;
- Function GetHeaderColor : integer;
- Procedure PutFrame(att : integer);
- Procedure Move(x,y : integer);
- Procedure Scroll(ln : integer; dir : tnUpDown);
- Procedure Align(hpos,vpos : tnJustify);
- Function Rows : integer;
- Function Cols : integer;
- Function GetX : integer;
- Function GetY : integer;
- Function IsFramed : boolean;
- Function Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
- Function Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
- Function Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
- Function EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
- Function EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
- Function EditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
- End;
- Var
- nStdScr : tnWindow; { default window created at unit initialization }
- nscreen : pwin; { pointer to ncurses stdscr }
- nEC : tnEC; { global edit control object }
- Procedure nSetActiveWin(win : pwindow);
- Procedure nDoNow(donow : boolean);
- Function nKeypressed(timeout : word) : boolean;
- Procedure nEcho(b : boolean);
- Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
- Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
- Procedure nDelWindow(var win : pWindow);
- Procedure nWinColor(win : pWindow; att : integer);
- Procedure nClrScr(win : pWindow; att : integer);
- Procedure nClrEol(win : pWindow);
- Procedure nClrBot(win : pWindow);
- Procedure nInsLine(win : pWindow);
- Procedure nDelLine(win : pWindow);
- Procedure nGotoXY(win : pWindow; x,y : integer);
- Function nWhereX(win : pWindow) : integer;
- Function nWhereY(win : pWindow) : integer;
- Function nReadkey(win : pWindow) : char;
- Function nReadln(win : pWindow) : string;
- Procedure nWrite(win : pWindow; s : string);
- Procedure nWriteln(win : pWindow; s : string);
- Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
- Procedure nRefresh(win : pWindow);
- Procedure nScroll(win : pWindow; lines : integer; dir : tnUpDown);
- Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer);
- Procedure nFrame(win : pWindow);
- Function nRows(win : pWindow) : integer;
- Function nCols(win : pWindow) : integer;
- Function nHL : longint; { horizontal line }
- Function nVL : longint; { vertical line }
- Function nUL : longint; { upper left corner }
- Function nLL : longint; { lower loft corner }
- Function nUR : longint; { upper right corner }
- Function nLR : longint; { lower right corner }
- Function nLT : longint; { left tee }
- Function nRT : longint; { right tee }
- Function nTT : longint; { top tee }
- Function nBT : longint; { bottom tee }
- Function nPL : longint; { plus, + }
- Function nLA : longint; { left arrow }
- Function nRA : longint; { right arrow }
- Function nUA : longint; { up arror }
- Function nDA : longint; { down arrow }
- Function nDI : longint; { diamond }
- Function nCB : longint; { checkerboard }
- Function nDG : longint; { degree }
- Function nPM : longint; { plus/minus }
- Function nBL : longint; { bullet }
- Procedure nHLine(win : pwindow; col,row,attr,x : integer);
- Procedure nVLine(win : pwindow; col,row,attr,y : integer);
- Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint);
- Function IsBold(att : integer) : boolean;
- Function SetColorPair(att : integer) : integer;
- Procedure nFWrite(win : pwindow; col,row,attrib : integer; clear : integer; s : string);
- Procedure nFWrite(col,row,attrib : integer; clear : integer; s : string);
- Function nSEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
- Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
- Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
- Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
- Function nEdit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
- Function nEdit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
- Function nEdit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
- Function nEditNumber(win : pwindow; x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
- Function nEditNumber(win : pwindow; x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
- Function nEditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
- Function nEditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
- Function nEditDate(win : pwindow; x,y,att : integer;initv : string;var esc : boolean) : string;
- Function nEditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
- Procedure nMakeWindow(var win : tnWindow;x1,y1,x2,y2,ta,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
- Function nCheckPxPicture(var s, Pic : string; var CPos : integer) : word;
- {$i ncrt.inc}
- {$i pxpic.inc}
- Var
- _chmap : nChMap;
- {---------------------------------------------------------------------
- tnWindow.Init
- Create a new window.
- x = upper left corner x, screen relative
- y = upper left corner y, screen relative
- x1 = lower right corner x, screen relative
- y1 = lower right corner y, screen relative
- wcolor = window/text color
- border = include a frame?
- fcolor = frame color
- ---------------------------------------------------------------------}
- Constructor tnWindow.Init(x,y,x1,y1,wcolor : integer;
- border : boolean;
- fcolor : integer);
- Var
- mp : nChMap;
- Begin
- visible := false;
- hasframe := false;
- wincolor := wcolor;
- framecolor := fcolor;
- hdrcolor := wcolor;
- header := '';
- win := nil;
- sub := nil;
- pan := nil;
- subp := nil;
- visible := false;
- win := newwin(y1-y+1,x1-x+1,y-1,x-1);
- pan := new_panel(win);
- hide_panel(pan);
- If border Then
- PutFrame(fcolor)
- Else Begin
- wn := win;
- wbkgd(win,COLOR_PAIR(SetColorPair(wcolor)));
- If isbold(wcolor) then wattr_on(win,A_BOLD);
- scrollok(win,bool(true));
- intrflush(win,bool(false));
- keypad(win,bool(true));
- End;
- FillChar(mp,SizeOf(mp),#0);
- ec.Init(false,false,false,false,false,'','',15,mp);
- ActiveWn := wn;
- End;
- { deallocate the window }
- Destructor tnWindow.Done;
- Begin
- If subp <> nil Then del_panel(subp);
- If pan <> nil Then del_panel(pan);
- If sub <> nil Then delwin(sub);
- If (win <> nil) and (win <> stdscr) Then delwin(win);
- ec.Done;
- ActiveWn := nscreen;
- End;
- { make the window current for all normal crt requests }
- Procedure tnWindow.Active;
- Begin
- ActiveWn := wn;
- End;
- { display the window and move to the top }
- Procedure tnWindow.Show;
- Begin
- ActiveWn := wn;
- visible := true;
- show_panel(pan);
- If subp <> nil Then show_panel(subp);
- update_panels;
- doupdate;
- End;
- { hide the window }
- Procedure tnWindow.Hide;
- Begin
- ActiveWn := stdscr;
- { ActiveWn := nStdScr.win;}
- visible := false;
- If subp <> nil Then hide_panel(subp);
- hide_panel(pan);
- update_panels;
- doupdate;
- End;
- Procedure tnWindow.ClrScr;
- Begin
- tmp_b := dorefresh;
- dorefresh := visible;
- nClrScr(wn,wincolor);
- dorefresh := tmp_b;
- End;
- Procedure tnWindow.ClrEol;
- Begin
- tmp_b := dorefresh;
- dorefresh := visible;
- nClrEol(wn);
- dorefresh := tmp_b;
- End;
- Procedure tnWindow.ClrBot;
- Begin
- tmp_b := dorefresh;
- dorefresh := visible;
- nClrBot(wn);
- dorefresh := tmp_b;
- End;
- Procedure tnWindow.InsLine;
- Begin
- tmp_b := dorefresh;
- dorefresh := visible;
- nInsLine(wn);
- dorefresh := tmp_b;
- End;
- Procedure tnWindow.DelLine;
- Begin
- tmp_b := dorefresh;
- dorefresh := visible;
- nDelLine(wn);
- dorefresh := tmp_b;
- End;
- { return the window border header string }
- Function tnWindow.GetHeader : string;
- Begin
- GetHeader := header;
- End;
- {----------------------------------------------------------------------
- put/replace a header string at the top of a bordered window
- hdr = header string (top line of window, only if hasframe = true)
- hcolor = header line color
- hpos = justfication of header string, left, center, or right
- ----------------------------------------------------------------------}
- Procedure tnWindow.PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
- Var
- cp,
- hx,
- len : integer;
- att,
- mx,my : longint;
- Begin
- If Hasframe Then Begin
- If hdr <> '' Then Begin
- header := hdr;
- hdrcolor := hcolor;
- getmaxyx(win,my,mx);
- nHline(win,2,1,framecolor,mx-1);
- len := mx-2;
- hdr := Copy(hdr,1,len);
- len := Length(hdr);
- Case hpos of
- left : hx := 1;
- center : hx := (mx - len) div 2;
- right : hx := (mx - len) - 1;
- End;
- mvwaddstr(win,0,hx,StrPCopy(ps,hdr));
- cp := SetColorPair(hcolor);
- If IsBold(hcolor) Then
- att := A_BOLD
- Else
- att := A_NORMAL;
- mvwchgat(win,0,hx,len,att,cp,0);
- End;
- End;
- End;
- { set the the color of the writable window }
- Procedure tnWindow.SetColor(att : integer);
- Begin
- wbkgd(wn,COLOR_PAIR(SetColorPair(att)));
- If isbold(att) then wattr_set(wn,A_BOLD);
- wincolor := att;
- If visible Then wrefresh(wn);
- End;
- { get the writeable window color }
- Function tnWindow.GetColor : integer;
- Begin
- GetColor := wincolor;
- End;
- { get the frame color }
- Function tnWindow.GetFrameColor : integer;
- Begin
- GetFrameColor := framecolor;
- End;
- { get the header color }
- Function tnWindow.GetHeaderColor : integer;
- Begin
- GetHeaderColor := hdrcolor;
- End;
- { frame an un-framed window, or update the frame color of a framed window }
- Procedure tnWindow.PutFrame(att : integer);
- Var
- x,y,
- mx,my,
- atts : longint;
- Begin
- wbkgd(win,COLOR_PAIR(SetColorPair(att)));
- atts := wattr_get(win);
- If isbold(att) then wattr_on(win,atts or A_BOLD);
- box(win,ACS_VLINE,ACS_HLINE);
- framecolor := att;
- If framecolor = -1 Then framecolor := wincolor;
- hasframe := true;
- If sub = nil Then Begin
- getbegyx(win,y,x);
- getmaxyx(win,my,mx);
- sub := newwin(my-2,mx-2,y+1,x+1);
- If sub <> nil Then Begin
- subp := new_panel(sub);
- hide_panel(subp);
- wbkgd(sub,COLOR_PAIR(SetColorPair(wincolor)));
- If isbold(wincolor) then wattr_on(sub,A_BOLD);
- scrollok(sub,bool(true));
- intrflush(sub,bool(false));
- keypad(sub,bool(true));
- wn := sub;
- End;
- End;
- touchwin(sub);
- If visible Then Begin
- wrefresh(win);
- wrefresh(sub);
- End;
- End;
- { move the window }
- Procedure tnWindow.Move(x,y : integer);
- Begin
- move_panel(pan,y-1,x-1);
- If subp <> nil Then move_panel(subp,y,x);
- If visible Then Begin
- update_panels;
- doupdate;
- End;
- End;
- Procedure tnWindow.Align(hpos,vpos : tnJustify);
- Var
- x,y,
- bx,by : longint;
- Begin
- getmaxyx(win,y,x);
- getbegyx(win,by,bx);
- Case hpos of
- none : x := bx;
- left : x := 1;
- right : x := MaxCols - x;
- center : x := (MaxCols - x) div 2;
- End;
- Case vpos of
- none : y := by;
- top : y := 1;
- bottom : y := MaxRows - y;
- center : y := (MaxRows - y) div 2;
- End;
- move(x+1,y+1);
- End;
- Procedure tnWindow.Scroll(ln : integer; dir : tnUpDown);
- Begin
- nScroll(wn,ln,dir);
- End;
- Procedure tnWindow.GotoXY(x,y : integer);
- Begin
- tmp_b := dorefresh;
- dorefresh := visible;
- nGotoXY(wn,x,y);
- dorefresh := tmp_b;
- End;
- Function tnWindow.WhereX : integer;
- Begin
- WhereX := nWhereX(wn);
- End;
- Function tnWindow.WhereY : integer;
- Begin
- WhereY := nWhereY(wn);
- End;
- Function tnWindow.ReadKey : char;
- Begin
- ReadKey := nReadKey(wn);
- End;
- Procedure tnWindow.WriteAC(x,y,att,c : longint);
- Begin
- tmp_b := dorefresh;
- dorefresh := visible;
- nWriteAC(wn,x,y,att,c);
- dorefresh := tmp_b;
- End;
- Procedure tnWindow.FWrite(x,y,att,z : integer; s : string);
- Begin
- tmp_b := dorefresh;
- dorefresh := visible;
- nFWrite(wn,x,y,att,z,s);
- dorefresh := tmp_b;
- End;
- Procedure tnWindow.DrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
- Begin
- tmp_b := dorefresh;
- dorefresh := visible;
- nDrawBox(wn,LineStyle,x1,y1,x2,y2,att);
- dorefresh := tmp_b;
- End;
- Function tnWindow.Rows : integer;
- Begin
- Rows := nRows(wn);
- End;
- Function tnWindow.Cols : integer;
- Begin
- Cols := nCols(wn);
- End;
- Function tnWindow.GetX : integer;
- Var
- x,y : longint;
- Begin
- getbegyx(win,y,x);
- GetX := x+1;
- End;
- Function tnWindow.GetY : integer;
- Var
- x,y : longint;
- Begin
- getbegyx(win,y,x);
- GetY := y+1;
- End;
- Function tnWindow.IsFramed : boolean;
- Begin
- IsFramed := hasframe;
- End;
- Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
- var
- tmp_ec : tnec;
- Begin
- { save global ec}
- tmp_ec := nEC;
- { init global ec to window ec }
- nEC := ec;
- Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
- { re-init window ec to possible changed values }
- ec.ClearMode := nEC.ClearMode;
- ec.InsMode := nEC.InsMode;
- { init global ec to saved }
- nEC := tmp_ec;
- End;
- { overload for longint }
- Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
- var
- tmp_ec : tnec;
- Begin
- tmp_ec := nEC;
- nEC := ec;
- Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
- ec.ClearMode := nEC.ClearMode;
- ec.InsMode := nEC.InsMode;
- nEC := tmp_ec;
- End;
- { overload for real }
- Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
- var
- tmp_ec : tnec;
- Begin
- tmp_ec := nEC;
- nEC := ec;
- Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
- ec.ClearMode := nEC.ClearMode;
- ec.InsMode := nEC.InsMode;
- nEC := tmp_ec;
- End;
- Function tnWindow.EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
- var
- tmp_ec : tnec;
- Begin
- tmp_ec := nEC;
- nEC := ec;
- EditNumber := nEditNumber(wn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
- ec.ClearMode := nEC.ClearMode;
- ec.InsMode := nEC.InsMode;
- nEC := tmp_ec;
- End;
- Function tnWindow.EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
- var
- tmp_ec : tnec;
- Begin
- tmp_ec := nEC;
- nEC := ec;
- EditNumber := nEditNumber(wn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
- ec.ClearMode := nEC.ClearMode;
- ec.InsMode := nEC.InsMode;
- nEC := tmp_ec;
- End;
- Function tnWindow.EditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
- var
- tmp_ec : tnec;
- Begin
- tmp_ec := nEC;
- nEC := ec;
- EditDate := nEditDate(wn,x,y,att,initv,esc);
- ec.ClearMode := nEC.ClearMode;
- ec.InsMode := nEC.InsMode;
- nEC := tmp_ec;
- End;
- {--------------------------- tnEC -------------------------------}
- Constructor tnEC.Init(ft,ih,im,em,ap : boolean;
- s,p : string;
- cc : integer;
- mp : nChMap);
- Begin
- ClearMode := ft;
- IsHidden := ih;
- InsMode := im;
- ExitMode := em;
- AppendMode := ap;
- Special := s;
- Picture := p;
- CtrlColor := cc;
- ChMap := mp;
- End;
- Destructor tnEC.Done;
- Begin
- End;
- { Add or replace a character map }
- Function tnEC.AddChMap(mp : nChMapStr) : integer;
- Var
- i : integer;
- Begin
- i := 0;
- Repeat
- inc(i);
- Until (i > nMaxChMaps) or (Copy(ChMap[i],1,2) = Copy(mp,1,2)) or (ChMap[i] = '');
- If i <= nMaxChMaps Then Begin
- AddChMap := i;
- ChMap[i] := mp;
- End Else
- AddChMap := 0;
- End;
- Procedure tnEC.ClrChMap(idx : integer);
- Begin
- Case idx of
- 0 : FillChar(ChMap,SizeOf(ChMap),#0);
- 1..nMaxChMaps : ChMap[idx] := '';
- End;
- End;
- {==========================================================================}
- { set the active window for write(ln), read(ln) }
- Procedure nSetActiveWin(win : pwindow);
- Begin
- ActiveWn := win;
- End;
- {----------------------------------------------------------------
- Set the refresh toggle.
- If true, then all changes to a window are immediate. If false,
- then changes appear following the next call to nRefresh.
- ----------------------------------------------------------------}
- Procedure nDoNow(donow : boolean);
- Begin
- dorefresh := donow;
- End;
- {-----------------------------------------------------
- Set the echo flag.
- This determines whether or not, characters are
- echoed to the display when entered via the keyboard.
- -----------------------------------------------------}
- Procedure nEcho(b : boolean);
- Begin
- Case b of
- true : echo;
- false: noecho;
- End;
- isEcho := b;
- End;
- { create a new subwindow of stdscr }
- Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
- Begin
- nDelWindow(win);
- win := subwin(stdscr,y1-y+1,x1-x+1,y-1,x-1);
- If win = nil then Exit;
- intrflush(win,bool(false));
- keypad(win,bool(true));
- scrollok(win,bool(true));
- ActiveWn := win;
- End;
- { create a new window }
- Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
- Begin
- nDelWindow(win);
- win := newwin(y1-y+1,x1-x+1,y-1,x-1);
- If win = nil then Exit;
- intrflush(win,bool(false));
- keypad(win,bool(true));
- scrollok(win,bool(true));
- ActiveWn := win;
- End;
- { repaint a window }
- Procedure nRefresh(win : pWindow);
- Begin
- touchwin(win);
- wrefresh(win);
- End;
- {----------------------------------------------
- Wait for a key to be pressed, with a timeout.
- If a key is pressed, then nKeypressed returns
- immediately as true, otherwise it return as
- false after the timeout period.
- ----------------------------------------------}
- function nKeypressed(timeout : word) : boolean;
- var
- fds : FDSet;
- maxFD : longint;
- Begin
- FD_Zero(fds);
- maxFD := 1;
- { turn on stdin bit }
- If not FD_IsSet(STDIN,fds) Then FD_Set(STDIN,fds);
- { wait for some input }
- If Select(maxFD,@fds,nil,nil,timeout) > 0 Then
- nKeypressed := TRUE
- Else
- nKeypressed := FALSE;
- End;
- {---------------------------------
- read input string from a window
- ---------------------------------}
- Function nReadln(win : pWindow) : string;
- Begin
- wgetstr(win,ps);
- nReadln := StrPas(ps);
- End;
- { write a string to a window without refreshing screen }
- Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
- Var
- tmp : pwindow;
- Begin
- tmp := ActiveWn;
- tmp_b := doRefresh;
- ActiveWn := win;
- doRefresh := false;
- nFWrite(win,x,y,att,0,s);
- ActiveWn := tmp;
- doRefresh := tmp_b;
- End;
- {----------------------------------------------------------
- Scroll a window, up or down, a specified number of lines.
- lines = number of lines to scroll.
- dir = direction, up or down.
- ----------------------------------------------------------}
- Procedure nScroll(win : pWindow; lines : integer; dir : tnUpDown);
- Begin
- ScrollOk(win,bool(True));
- Case dir of
- up : lines := abs(lines);
- down : lines := abs(lines) * (-1);
- End;
- wscrl(win,lines);
- If doRefresh Then wRefresh(win);
- End;
- { draw a colored box, with or without a border }
- Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer);
- Var
- sub : pWindow;
- x,y : longint;
- Begin
- getbegyx(win,y,x);
- sub := subwin(win,y2-y1+1,x2-x1+1,y+y1-1,x+x1-1);
- If sub = nil Then exit;
- wbkgd(sub,CursesAtts(att));
- werase(sub);
- case LineStyle of
- 1,2 : box(sub, ACS_VLINE, ACS_HLINE);
- End;
- If doRefresh Then wrefresh(sub);
- nDelWindow(sub);
- End;
- {---------------------------
- add a border to a window,
- waits for a refresh
- ---------------------------}
- Procedure nFrame(win : pWindow);
- Begin
- box(win, ACS_VLINE, ACS_HLINE);
- End;
- {-----------------------------------------------------------
- write a string to a window at the current cursor position
- followed by a newline
- -----------------------------------------------------------}
- Procedure nWriteln(win : pWindow; s : string);
- Begin
- waddstr(win,StrPCopy(ps,s+#10));
- If doRefresh Then wrefresh(win);
- End;
- { return then number of rows in a window }
- Function nRows(win : pWindow) : integer;
- Var
- x,y : longint;
- Begin
- getmaxyx(win,y,x);
- nRows := y;
- End;
- { return then number of columns in a window }
- Function nCols(win : pWindow) : integer;
- Var
- x,y : longint;
- Begin
- getmaxyx(win,y,x);
- nCols := x;
- End;
- {-------------------------------------------------------
- Line drawing characters have to be handled specially.
- Use nWriteAC() to write these characters. They cannot
- be simply included as characters in a string.
- -------------------------------------------------------}
- { returns horizontal line character }
- Function nHL : longint;
- Begin
- nHL := ACS_HLINE;
- End;
- { returns vertical line character }
- Function nVL : longint;
- Begin
- nVL := ACS_VLINE;
- End;
- { returns upper left corner character }
- Function nUL : longint;
- Begin
- nUL := ACS_ULCORNER;
- End;
- { returns lower left corner character }
- Function nLL : longint;
- Begin
- nLL := ACS_LLCORNER;
- End;
- { returns upper right corner character }
- Function nUR : longint;
- Begin
- nUR := ACS_URCORNER;
- End;
- { returns lower right corner character }
- Function nLR : longint;
- Begin
- nLR := ACS_LRCORNER;
- End;
- { returns left tee character }
- Function nLT : longint;
- Begin
- nLT := ACS_LTEE;
- End;
- { returns right tee character }
- Function nRT : longint;
- Begin
- nRT := ACS_RTEE;
- End;
- { returns top tee character }
- Function nTT : longint;
- Begin
- nTT := ACS_TTEE;
- End;
- { returns bottom tee character }
- Function nBT : longint;
- Begin
- nBT := ACS_BTEE;
- End;
- { returns plus/cross character }
- Function nPL : longint;
- Begin
- nPL := ACS_PLUS;
- End;
- { returns left arrow character }
- Function nLA : longint;
- Begin
- nLA := ACS_LARROW;
- End;
- { returns right arrow character }
- Function nRA : longint;
- Begin
- nRA := ACS_RARROW;
- End;
- { returns up arrow character }
- Function nUA : longint;
- Begin
- nUA := ACS_UARROW;
- End;
- { returns down arrow character }
- Function nDA : longint;
- Begin
- nDA := ACS_DARROW;
- End;
- { returns diamond character }
- Function nDI : longint;
- Begin
- nDI := ACS_DIAMOND;
- End;
- { returns checkerboard character }
- Function nCB : longint;
- Begin
- nCB := ACS_CKBOARD;
- End;
- { returns degree character }
- Function nDG : longint;
- Begin
- nDG := ACS_DEGREE;
- End;
- { returns plus/minus character }
- Function nPM : longint;
- Begin
- nPM := ACS_PLMINUS;
- End;
- { returns bullet character }
- Function nBL : longint;
- Begin
- nBL := ACS_BULLET;
- End;
- { draw a horizontal line with color and a start & end position }
- Procedure nHLine(win : pwindow; col,row,attr,x : integer);
- var
- sub : pwindow;
- bx,by : longint;
- Begin
- getbegyx(win,by,bx);
- sub := subwin(win,1,x-col+1,by+row-1,bx+col-1);
- If sub = nil Then Exit;
- x := getmaxx(sub);
- wbkgd(sub,CursesAtts(attr));
- mvwhline(sub,0,0,ACS_HLINE,x);
- If doRefresh Then wrefresh(sub);
- delwin(sub);
- End;
- { draw a vertical line with color and a start & end position }
- Procedure nVLine(win : pwindow; col,row,attr,y : integer);
- var sub : pwindow;
- Begin
- sub := subwin(win,y-row+1,1,row-1,col-1);
- If sub = nil Then Exit;
- wbkgd(sub,CursesAtts(attr));
- mvwvline(sub,0,0,ACS_VLINE,y);
- If doRefresh Then wrefresh(sub);
- delwin(sub);
- End;
- {----------------------------------------------------------------
- Write a character from the alternate character set. A normal
- value from the alternate character set is larger than $400000.
- If the value passed here is 128..255, then we assume it to be
- the ordinal value from the IBM extended character set, and try
- to map it to curses correctly. If it does not map, then we just
- make it an alternate character and hope the output is what the
- programmer expected. Note: this will work on the Linux console
- just fine, but for other terminals the passed value must match
- the termcap definition for the alternate character.
- Note: The cursor returns to it's original position.
- ----------------------------------------------------------------}
- Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint);
- var
- xx,yy,
- cp : longint;
- Begin
- If acs_char in [0..255] Then Begin
- Case acs_char of
- 176 : acs_char := ACS_CKBOARD;
- 179 : acs_char := ACS_VLINE;
- 180 : acs_char := ACS_RTEE;
- 191 : acs_char := ACS_URCORNER;
- 192 : acs_char := ACS_LLCORNER;
- 193 : acs_char := ACS_BTEE;
- 194 : acs_char := ACS_TTEE;
- 195 : acs_char := ACS_LTEE;
- 196 : acs_char := ACS_HLINE;
- 197 : acs_char := ACS_PLUS;
- 218 : acs_char := ACS_ULCORNER;
- 217 : acs_char := ACS_LRCORNER;
- 241 : acs_char := ACS_PLMINUS;
- 248 : acs_char := ACS_DEGREE;
- 249 : acs_char := ACS_BULLET;
- else acs_char := acs_char or A_ALTCHARSET;
- End;
- End;
- { save the current cursor position }
- getyx(win,yy,xx);
- cp := SetColorPair(att);
- { write character with current attributes }
- mvwaddch(win,y-1,x-1,acs_char);
- { update with new attributes }
- If IsBold(att) Then
- att := A_BOLD or A_ALTCHARSET
- Else
- att := A_NORMAL or A_ALTCHARSET;
- mvwchgat(win,y-1,x-1,1,att,cp,0);
- { return cursor to saved position }
- wmove(win,yy,xx);
- If doRefresh Then wrefresh(win);
- End;
- {-------------------------------------------------------------------
- write a string to stdscr with color, without moving the cursor
- Col = x start position
- Row = y start position
- Attrib = color (0..127), note color = (background*16)+foreground
- Clear = clear line up to x position
- s = string to write
- -------------------------------------------------------------------}
- Procedure nFWrite(win : pwindow; col,row,attrib : integer; clear : integer; s : string);
- var
- clr : array [0..255] of char;
- cs : string;
- sub : pWindow;
- x,y,
- mx,my,
- xx,yy : longint;
- ctrl : boolean;
- Begin
- if Clear > 0 Then Begin
- FillChar(clr,SizeOf(clr),' ');
- clr[SizeOf(clr)-1] := #0;
- If Clear > MaxCols Then Clear := MaxCols;
- cs := Copy(StrPas(clr),1,(Clear-Col)-Length(s)+1);
- End Else
- cs := '';
- s := s+cs;
- If s = '' Then Exit;
- getyx(win,yy,xx);
- getbegyx(win,y,x);
- getmaxyx(win,my,mx);
- If Length(s) > mx Then s := Copy(s,1,mx);
- sub := subwin(win,1,Length(s),y+row-1,x+col-1);
- If sub = nil Then Exit;
- cs := s;
- ctrl := false;
- { look for embedded control characters }
- For x := 1 to Length(s) Do Begin
- If s[x] in [#0..#31] Then Begin
- s[x] := ' ';
- ctrl := true;
- End;
- End;
- wbkgd(sub,COLOR_PAIR(SetColorPair(Attrib)));
- If isbold(Attrib) then
- wattr_on(sub,A_BOLD);
- mvwaddstr(sub,0,0,StrPCopy(ps,s));
- { highlight the embedded control characters substitutes }
- If ctrl Then Begin
- { nEC is always the current edit control object }
- If Attrib <> nEC.CtrlColor Then
- nWinColor(sub,nEC.CtrlColor)
- Else Begin
- { reverse the highlight color if same as current attribute }
- bg := nEC.CtrlColor div 16;
- fg := nEC.CtrlColor - (bg * 16);
- While bg > 7 Do dec(bg,8);
- While fg > 7 Do dec(fg,8);
- nWinColor(sub,(fg*16)+bg);
- End;
- For x := 1 to Length(cs) Do Begin
- If cs[x] in [#0..#31] Then
- mvwaddch(sub,0,x-1,ord(cs[x])+64);
- End;
- End;
- If doRefresh Then wrefresh(sub);
- delwin(sub);
- wmove(win,yy,xx);
- End;
- { overload - no pointer }
- Procedure nFWrite(col,row,attrib : integer; clear : integer; s : string);
- Begin
- nFWrite(ActiveWn,col,row,attrib,clear,s);
- End;
- { compatibility for the old function name }
- Function nSEdit(win : pwindow; x,y,att,z,CursPos:integer;
- es:string;var ch : char) : string;
- Var
- s : string;
- Begin
- s := nEdit(win,x,y,att,z,CursPos,es,ch);
- nSEdit := s;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- { String Editor }
- Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
- es:string;var ch : char) : string;
- Var
- ZMode,
- AppendMode,
- SEditExit : boolean;
- prvx,
- prvy,
- pidx,
- pres,
- Index : integer;
- ts,
- hes : string;
- isextended : boolean;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure NewString;
- BEGIN
- nEdit := es;
- hes := es;
- FillChar(hes[1],Length(hes),'*');
- END;
- Procedure WriteString;
- Var
- xx,yy : integer;
- Begin
- xx := nWhereX(win);
- yy := nWhereY(win);
- If nEC.IsHidden Then
- nFWrite(win,x,y,att,z,hes)
- Else
- nFWrite(win,x,y,att,z,es);
- nGotoXY(win,xx,yy);
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure EInsMode;
- Begin
- nEC.InsMode := (not nEC.InsMode)
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure WriteChar;
- var s : string;
- Begin
- ts := es;
- If AppendMode Then Begin
- es := es + ' ';
- Index := Length(es);
- End Else Begin
- If nWhereX(win) >= Length(es)+x Then Repeat
- es := es + ' ';
- Until Length(es)+x-1 = nWhereX(win);
- If es = '' Then es := ' ';
- If Length(es)+x-1 = nWhereX(win) Then Index := Length(es);
- End;
- es[Index] := ch;
- s := Copy(es,1,Index);
- If nCheckPxPicture(s,nEC.Picture,pidx) <> 0 Then Begin
- { no error, picture satisfied }
- If (Length(s) > Length(es)) or
- ((Length(s) = Length(es)) and (s <> es)) Then Begin
- { expanded/changed by picture }
- es := s;
- End;
- If pidx > Index Then Begin
- If pidx > Length(es) Then pidx := Length(es);
- If pidx > Index Then Index := pidx;
- End;
- End Else Begin
- { error, did not fit the picture }
- Sound(1000);
- Delay(50);
- NoSound;
- es := ts;
- Dec(Index);
- End;
- NewString;
- WriteString;
- If (Index < z-x+1) or not ZMode Then Begin
- Index := Index+1;
- nGotoXY(win,x+Index-1,y);
- End;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure EInsert; { Insert }
- Begin
- If Length(es) < Z-X+1 Then Begin
- ts := es;
- Insert(' ',es,Index);
- If nCheckPXPicture(es,nEC.Picture,pidx) = 0 Then Begin
- Sound(1000);
- Delay(50);
- NoSound;
- es := ts;
- ch := #255;
- End;
- NewString;
- WriteString;
- End;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure EDelete; { Delete }
- Begin
- ts := es;
- Delete(es,Index,1);
- If nCheckPXPicture(es,nEC.Picture,pidx) = 0 Then Begin
- Sound(1000);
- Delay(50);
- NoSound;
- es := ts;
- ch := #255;
- End;
- NewString;
- WriteString;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure ECtrlEnd; { <CTRL> End }
- Begin
- Delete(es,Index,Length(es));
- NewString;
- WriteString;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure EHome; { Home }
- Begin
- Index := 1;
- nGotoXY(win,x,y);
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure ELeftArrow; { Left Arrow }
- Begin
- If nWhereX(win) > x Then Begin
- dec(Index);
- nGotoXY(win,nWhereX(win)-1,nWhereY(win));
- End;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure ERightArrow; { Right Arrow }
- Begin
- If Index < z-x+1 Then Begin
- nGotoXY(win,nWhereX(win)+1,nWhereY(win));
- Index := Index + 1;
- End;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure EEnd; { End }
- Begin
- Index := Length(es)+1;
- If Index > z-x+1 Then Index := Length(es);
- If Index < 1 Then Index := 1;
- If Index > MaxCols Then Index := MaxCols;
- nGotoXY(win,x+(Index-1),y);
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure EBackSpace; { Backspace }
- Begin
- Index := Index - 1;
- If Index < 1 Then Begin
- Index := 1;
- Exit;
- End Else
- If nWhereX(win) > x Then nGotoXY(win,nWhereX(win) - 1,nWhereY(win));
- Delete(es,Index,1);
- NewString;
- WriteString;
- nGotoXY(win,x+(Index-1),y);
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure ETurboBackSpace; { Ctrl/Backspace }
- Begin
- If Index = 1 Then Exit;
- Delete(es,1,Index-1);
- NewString;
- Index := 1;
- If nWhereX(win) > x Then nGotoXY(win,1,nWhereY(win));
- WriteString;
- nGotoXY(win,x,y);
- END;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure ECtrlLeftArrow;{ Ctrl Left Arrow }
- Begin
- If nEC.IsHidden Then Begin
- EHome;
- Exit;
- End;
- If es[Index-1] = ' ' Then Index := Index-1;
- If es[Index] <> ' ' Then Begin
- While (Index > 1) And (es[Index] <> ' ') Do
- Index := Index-1;
- End Else
- If es[Index] = ' ' Then Begin
- While (Index > 1) And (es[Index] = ' ') Do
- Index := Index-1;
- While (Index > 1) And (es[Index] <> ' ') Do
- Index := Index-1;
- End;
- If Index = 1 Then
- nGotoXY(win,x,y)
- Else Begin
- nGotoXY(win,x+Index,y);
- Index := Index+1;
- End;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure ECtrlRightArrow;{ Ctrl Right Arrow }
- Begin
- If nEC.IsHidden Then Begin
- EEnd;
- Exit;
- End;
- While (Index < Length(es)) And (es[Index] <> ' ') Do
- Begin
- Index := Index+1;
- End;
- While (Index < Length(es)) And (es[Index] = ' ') Do
- Begin
- Index := Index+1;
- End;
- nGotoXY(win,x+Index-1,y);
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure CheckForWriteChar(embed : boolean);
- Begin
- If embed or Not (Ch In [#27,#255]) Then Begin
- If (ch in [#10,#13]) and (not embed) {and not ControlKey} Then exit;
- If nEC.ClearMode Then Begin
- es := '';
- WriteString;
- nGotoXY(win,X,Y);
- Index := 1;
- WriteChar;
- nEC.ClearMode := False;
- End Else Begin
- If nEC.InsMode Then Begin
- EInsert;
- WriteChar;
- End Else WriteChar;
- End;
- End;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure ProcessSpecialKey;
- begin
- If ch = #129 Then ch := #68; { Linux, map Esc/0 to F10 }
- Case ch of
- #16..#25,
- #30..#38,
- #44..#50,
- #59..#68,
- #84..#90,
- #92..#113,
- #118,
- #132,
- #72,
- #73,
- #80,
- #81 : Begin SEditExit:=True;Exit;End;
- #71 : EHome;
- #75 : ELeftArrow;
- #77 : ERightArrow;
- #79 : EEnd;
- #82 : EInsMode;
- #83 : EDelete;
- #15,
- #115 : ECtrlLeftArrow;
- #116 : ECtrlRightArrow;
- #117 : ECtrlEnd;
- End;
- End;
- {~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
- Procedure ProcessNormalKey;
- Var
- i : integer;
- ctrl : boolean;
- begin
- For i := 1 to Length(nEC.Special) Do Begin
- If ch = nEC.Special[i] Then Begin
- SEditExit:=True;
- Exit;
- End;
- End;
- ctrl := false;
- case ch of
- #0..#15,
- #17..#31 : Begin
- nEC.ClearMode := False;
- Case ch of
- #1 : EHome;
- #5 : EEnd;
- #2 : ELeftArrow;
- #6 : ERightArrow;
- #19 : ECtrlLeftArrow;
- #4 : ECtrlRightArrow;
- #7 : EDelete;
- #9 : EInsMode;
- #8 : EBackSpace;
- #10 : ch := #13;
- #13 : Begin
- pres := nCheckPxPicture(es,nEC.Picture,pidx);
- If pres <> 2 Then Begin
- Sound(1000);
- Delay(50);
- NoSound;
- ch := #255;
- End;
- End;
- #27 : If KeyPressed Then Begin
- { covers up a Linux peculiarity where the next }
- { character typed bleeds through with esc/1..9 }
- nGotoXY(win,prvx,prvy);
- WriteString;
- ch := ReadKey;
- { make it a function key }
- If ch in ['1'..'9'] Then
- ch := Char(Ord(ch)+10)
- Else ch := #27;
- SEditExit := true;
- End;
- End;
- Exit;
- End;
- #16 : Begin
- { embed control characters in the string }
- ch := UpCase(ReadKey);
- If ch in ['@','2','A'..'Z'] Then Begin
- ctrl := true;
- If ch = '2' Then ch := '@';
- ch := Char(Ord(ch)-64);
- End;
- End;
- #127 : Begin nEC.ClearMode := False;ETurboBackSpace;Exit;End;
- end;
- CheckForWriteChar(ctrl);
- ch := #0;
- end;
- {-----------------------------------------------------------------------
- Map a keystroke to another character, normal or extended.
- The maps are 4 character strings interpreted as 2 sets of character
- pairs that represent the following:
- 1st char - If it is #0 then it is an extended char. Use the 2nd
- character to identify.
- 2nd char - Only used if 1st char is #0.
- The first pair of the string is the actual key pressed.
- The second pair is what that key should be become.
- #0#59 = F1, extended key
- #59#0 = ; , normal key
- So a map of #0#59#59#0 maps the F1 key to the ; key,
- and #0#59#0#60 maps the F1 key to the F2 key,
- and #0#59#0#0 maps the F1 key to a null.
- Examples:
- #0#59#0#60 = map F1 to F2
- #1#0#0#59 = map ^A to F1
- #0#59#1#0 = map F1 to ^A
- #0#59#0#0 = map F1 to ^@ (null)
- #0#0#0#59 = map ^@ to F1
- #97#0#65#0 = map a to A
- }
- Procedure MapKey(var ch : char;var eflag : boolean);
- Var
- i : integer;
- s2 : string[2];
- s4 : string[4];
- Begin
- { look for a character map assignment }
- i := 0;
- s4 := #0#0#0#0;
- Case eflag of
- true : s2 := #0+ch;
- false : s2 := ch+#0;
- End;
- Repeat
- inc(i);
- Until (i > nMaxChMaps) or (pos(s2,nEC.ChMap[i]) = 1);
- { if found, then re-assign ch to the mapped key }
- If i <= nMaxChMaps Then Begin
- system.Move(nEC.ChMap[i,1],s4[1],Length(nEC.ChMap[i]));
- s2 := Copy(s4,3,2);
- eflag := (s2[1] = #0);
- Case eflag of
- true : ch := s2[2];
- false : ch := s2[1];
- End;
- If ch = #0 Then eflag := false;
- End;
- End;
- {============================================================================}
- Begin
- SEditExit := nEC.ExitMode;
- AppendMode := nEC.AppendMode;
- ZMode := z <> 0;
- If CursPos > Length(es)+x Then
- Index := Length(es)+1 { End Of String }
- Else Index := CursPos+1-x; { Inside Of String }
- If Not ZMode then z := x+length(es);
- Newstring;
- WriteString;
- nGotoXY(win,CursPos,y);
- Repeat
- prvx := nWhereX(win); { save for ProcessNormalKey }
- prvy := nWhereY(win);
- If Not ZMode then z := x+length(es);
- ch := ReadKey;
- isextended := (ch = #0);
- If isextended Then
- ch := ReadKey;
- MapKey(ch,isextended);
- If isextended Then
- ProcessSpecialKey
- Else
- ProcessNormalKey;
- Until (ch In [#13,#27]) or SEditExit;
- nEC.ClearMode := False;
- NewString;
- End;{ of nEdit }
- { nEdit using currently active window }
- Function nEdit(x,y,att,z,CursPos:integer;
- es:string;var ch : char) : string;
- Begin
- nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
- End;
- { overload for longint type }
- Function nEdit(x,y,att,z,CursPos:integer;
- es:longint;var ch : char) : longint;
- Begin
- nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
- End;
- { with pointer }
- Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
- es:LongInt;var ch : char) : LongInt;
- Var
- savpic,
- ess : string;
- esv,
- err : longint;
- Begin
- Str(es:0,ess);
- savpic := nEC.Picture;
- If savpic = '' Then nEC.Picture := '[-]#*#';
- ess := nEdit(win,x,y,att,z,CursPos,ess,ch);
- nEC.Picture := savpic;
- val(ess,esv,err);
- nEdit := esv;
- End;
- { overload for real type }
- Function nEdit(x,y,att,z,CursPos:integer;
- es:real;var ch : char) : real;
- Begin
- nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
- End;
- { with pointer }
- Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
- es:Real;var ch : char) : Real;
- Var
- savpic,
- ess : string;
- esv : real;
- i,
- err : Integer;
- Begin
- Str(es:0:12,ess);
- While ess[Length(ess)] = '0' Do Delete(ess,Length(ess),1);
- savpic := nEC.Picture;
- If savpic = '' Then Begin
- Case nDecFmt of
- nUS : nEC.Picture := '[+,-]#*#[[.*#][{E,e}[+,-]#[#][#][#]]]';
- nEURO : Begin
- nEC.Picture := '[+,-]#*#[[;,*#][{E,e}[+,-]#[#][#][#]]]';
- For i := 1 to Length(ess) Do
- If ess[i] = '.' Then ess[i] := ',';
- End;
- End;
- End;
- ess := nEdit(win,x,y,att,z,CursPos,ess,ch);
- nEC.Picture := savpic;
- For i := 1 to Length(ess) Do If ess[i] = ',' Then ess[i] := '.';
- val(ess,esv,err);
- nEdit := esv;
- End;
- { And now some sugar for Rainer Hantsch! }
- {------------------------------------------------------------------------
- This is a right justified number editor. As a digit is typed, the
- existing number string gets pushed left and the new digit is appended.
- If decimal columns are specified, then pressing <space> will enter the
- decimal character (. or ,). A background string can be specified that
- fills the empty spaces.
- ------------------------------------------------------------------------}
- Function nEditNumber(
- win : pwindow;
- x, { edit field start column }
- y, { edit field start row }
- att, { edit field color attribute }
- wid, { edit field width }
- decm : integer; { number of decimal columns }
- bgd : string; { background string -
- if bgd = '', then no background
- if bgd = a single character, then is used as the
- background fill character.
- if bgd length is longer than wid, then the entire
- bgd string is used as the background.}
- initv, { initial value }
- minv, { range minimum value }
- maxv : real; { range maximum value }
- var esc : boolean { if Esc key pressed = true, else = false }
- ) : real;
- Const
- { up to 12 decimal places }
- decs : string = '[#][#][#][#][#][#][#][#][#][#][#][#]';
- Var
- r : real;
- s,s1,s2 : string;
- i,
- e,
- bc,
- bx : integer;
- ch : char;
- fill : array [0..255] of char;
- tmp_ec : tnEC;
- Begin
- tmp_ec := nEC;
- nEC.ExitMode := true;
- nEC.AppendMode := true;
- nEC.ClrChMap(0);
- nEC.AddChMap(#7#0#0+Char(nKeyDel));
- nEC.AddChMap(#8#0#0+Char(nKeyDel));
- If decm > (Length(decs) div 3) Then
- decm := (Length(decs) div 3);
- If decm >= wid Then decm := (wid - 1);
- If decm > 0 Then Begin
- nEC.Picture := '[-]*#[{.}'+Copy(decs,1,(decm*3))+']';
- If nDecFmt = nEURO Then Begin
- nEC.Picture[8] := ',';
- Insert(';',nEC.Picture,8);
- nEC.AddChMap('.'+#0+','+#0);
- End;
- End Else
- nEC.Picture := '[-]*#';
- If bgd = '' Then Begin
- bgd := ' ';
- bc := att;
- End Else
- bc := nEC.CtrlColor;
- If Length(bgd) < wid Then Begin
- FillChar(fill,wid,bgd[1]);
- fill[wid] := #0;
- bgd := StrPas(fill);
- End;
- bx := x;
- If Length(bgd) > wid Then inc(x);
- str(initv:wid:decm,s);
- While s[1] = ' ' Do Delete(s,1,1);
- If Pos('.',s) <> 0 Then
- While s[Length(s)] = '0' Do Delete(s,Length(s),1);
- If decm = 0 Then Delete(s,Pos('.',s),1);
- If nDecFmt = nEURO Then For i := 1 to Length(s) Do
- If s[i] = '.' Then s[i] := ',';
- Repeat
- nFWrite(win,bx,y,bc,bx+Length(bgd)-(x-bx),copy(bgd,1,wid-length(s)+(x-bx)));
- If x > bx Then
- nFWrite(win,x+wid,y,bc,0,copy(bgd,wid+2,length(bgd)));
- s1 := nEdit(win,x+wid-Length(s),y,att,x+wid-1,x+wid-1,s,ch);
- s2 := s1;
- If nDecFmt = nEURO Then For i := 1 to Length(s2) Do
- If s2[i] = ',' Then s2[i] := '.';
- val(s2,r,e);
- If (s1 = '') or ((e = 0) and (r >= minv) and (r <= maxv)) Then
- s := s1
- Else
- If ch <> #27 then Begin
- ch := #0;
- Sound(1000);
- Delay(50);
- NoSound;
- End;
- nEC.AppendMode := Length(s) < wid;
- Until ch in [#13,#27];
- esc := (ch = #27);
- nEditNumber := r;
- nEC := tmp_ec;
- End;
- { overload - real, no pointer }
- Function nEditNumber(
- x,y,att,wid,decm : integer;
- bgd : string;
- initv,
- minv,
- maxv : real;
- var esc : boolean) : real;
- Begin
- nEditNumber := nEditNumber(ActiveWn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
- End;
- { overload for longint }
- Function nEditNumber(
- win : pwindow;
- x,y,att,wid,decm : integer;
- bgd : string;
- initv,
- minv,
- maxv : longint;
- var esc : boolean) : longint;
- Var
- r : real;
- Begin
- r := nEditNumber(win,x,y,att,wid,0,bgd,Real(initv),Real(minv),Real(maxv),esc);
- nEditNumber := Trunc(r);
- End;
- { overload - longint, no pointer }
- Function nEditNumber(
- x,y,att,wid,decm : integer;
- bgd : string;
- initv,
- minv,
- maxv : longint;
- var esc : boolean) : longint;
- Var
- r : real;
- Begin
- r := nEditNumber(ActiveWn,x,y,att,wid,0,bgd,Real(initv),Real(minv),Real(maxv),esc);
- nEditNumber := Trunc(r);
- End;
- { More sugar for Rainer }
- {------------------------------------------------------------------------
- A date string editor.
- ------------------------------------------------------------------------}
- Function nEditDate(
- win : pwindow;
- x, { edit field start column }
- y, { edit field start row }
- att : integer; { edit field color attribute }
- init : string; { initial value }
- var esc : boolean { if Esc key pressed = true, else = false }
- ) : string;
- Const
- wid = 10;
- Var
- s : string;
- i : integer;
- ch : char;
- tmp_ec : tnEC;
- Begin
- tmp_ec := nEC;
- nEC.InsMode := false;
- nEC.ClearMode := false;
- nEC.ExitMode := false;
- nEC.AppendMode := false;
- Case nDecFmt of
- nUS : Begin
- nEC.Picture := '{#,m,M}{#,m,M}/{#,d,D}{#,d,D}/{#,y,Y}{#,y,Y}{#,y,Y}{#,y,Y}';
- s := 'mm/dd/yyyy';
- End;
- nEURO : Begin
- nEC.Picture := '{#,d,D}{#,d,D}/{#,m,M}{#,m,M}/{#,y,Y}{#,y,Y}{#,y,Y}{#,y,Y}';
- s := 'dd/mm/yyyy';
- End;
- End;
- If nCheckPxPicture(init,nEC.Picture,i) <> 0 Then
- system.move(init[1],s[1],Length(init));
- nEC.AddChMap(#7#0#0+Char(nKeyLeft));
- nEC.AddChMap(#8#0#0+Char(nKeyLeft));
- nEC.AddChMap(#0+Char(nKeyDel)+#0+Char(nKeyLeft));
- Repeat
- s := nEdit(x,y,att,x+9,x,s,ch);
- If ch = #13 Then Begin
- For i := 1 to Length(s) Do
- If s[i] in ['m','d','y'] Then ch := #0;
- End;
- Until ch in [#13,#27];
- esc := (ch = #27);
- nEditDate := s;
- nEC := tmp_ec;
- End;
- { overload - no pointer }
- Function nEditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
- Begin
- nEditDate := nEditDate(ActiveWn,x,y,att,initv,esc);
- End;
- { A one-line procedural wrapper }
- Procedure nMakeWindow(
- var win : tnWindow;
- x1,y1,
- x2,y2,
- ta,ba,ha : integer;
- hasframe : boolean;
- hdrpos : tnJustify;
- hdrtxt : string);
- Begin
- win.init(x1,y1,x2,y2,ta,hasframe,ba);
- If hdrtxt <> '' Then win.PutHeader(hdrtxt,ha,hdrpos);
- End;
- {----------------------- initialize the unit!------------------------- }
- Begin
- FillChar(_chmap,SizeOf(_chmap),#0);
- nEC.Init(false,false,false,false,false,'','',15,_chmap);
- { load the color pairs array with color pair indices (0..63) }
- For bg := 0 to 7 Do For fg := 0 to 7 do cp[bg,fg] := (bg*8)+fg;
- { initialize ncurses }
- If StartCurses(ActiveWn) Then Begin
- { save pointer to ncurses stdscr }
- nscreen := ActiveWn;
- { create the default full screen window object }
- nStdScr.Init(1,1,MaxCols,MaxRows,7,false,0);
- End Else
- Halt;
- { crtassign }
- nInit;
- { set the unit exit procedure }
- ExitSave := ExitProc;
- ExitProc := @nExit;
- End. { of Unit nCrt }
|