ocrt.pp 60 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072
  1. Unit oCrt;
  2. {---------------------------------------------------------------------------
  3. CncWare
  4. (c) Copyright 1999-2000
  5. ---------------------------------------------------------------------------
  6. Filename..: ocrt.pp
  7. Programmer: Ken J. Wright, [email protected]
  8. Date......: 03/01/99
  9. Purpose - crt unit replacement plus OOP windows using ncurses.
  10. NOTE: All of the crt procedures & functions have been replaced with ncurses
  11. driven versions. This makes the ncurses library a little easier to use in a
  12. Pascal program and benefits from terminal independence.
  13. -------------------------------<< REVISIONS >>--------------------------------
  14. Ver | Date | Prog| Description
  15. -------+----------+-----+-----------------------------------------------------
  16. 1.00 | 03/01/99 | kjw | Initial Release.
  17. | 03/22/99 | kjw | Added nDelWindow(), delwin() does not nil pointer.
  18. 1.01 | 11/22/99 | kjw | Added the following: nEcho, ClrEol, ClrBot, InsLine,
  19. | DelLine, Delay, nClrEol, nClrBot, nInsLine, nDelLine,
  20. | nRefresh, nScroll, nDrawBox, nNewWindow, nWinColor,
  21. | nWriteScr, nFrame & some functions for returning
  22. | line drawing character values.
  23. 1.02 | 11/26/99 | kjw | Added nKeypressed().
  24. 1.03 | 12/01/99 | kjw | Added global boolean nIsActive.
  25. 1.04 | 12/03/99 | kjw | 1) Added procedures nHline, nVLine, & nWriteAC.
  26. | 2) Changed all the line draw character functions
  27. | (i.e., nHL, nVL) to return the longint value from
  28. | ncurses rather than the character value (which was
  29. | not very useful!). Now these can be passed to
  30. | nWriteAC() to correctly write the line drawing
  31. | characters.
  32. | 3) Added more of the ACS characters.
  33. 1.05 | 12/08/99 | kjw | 1) StartCurses() is now done as part of the unit
  34. | initialization block. EndCurses() is done via an
  35. | exit procedure.
  36. | 2) nIsActive is now a function (safer!).
  37. | 3) Added panel unit for windowing.
  38. | 4) Added tnWindow object.
  39. 1.10 | 12/12/99 | kjw | Added nSEdit().
  40. 1.11 | 12/12/99 | kjw | Added Special property to tEC object. Now any normal
  41. | character can trigger sedit to exit.
  42. ------------------------------------------------------------------------------
  43. 2.00 | 12/13/99 | kjw | nCrt renamed to oCrt. A new nCrt has been created
  44. | which is a drop-in replacement for the FPC crt unit.
  45. | oCrt contains all of nCrt plus the OOP extensions.
  46. | All of the common code is in ncrt.inc.
  47. 2.01 | 12/15/99 | kjw | 1) A tnWindow object now becomes the target for
  48. | stdout following Init & Show. A Hide will put the
  49. | target back to stdscr.
  50. | 2) Added nSetActiveWin() to manually pick a target
  51. | window for stdout.
  52. 2.02 | 12/15/99 | kjw | 1) PutFrame applied keypad to stdscr instead of sub.
  53. | 2) See ncrt.inc
  54. 2.03 | 12/16/99 | kjw | 1) See ncrt.inc
  55. | 2) Added shift/f-key constants.
  56. 2.04 | 01/04/00 | kjw | See ncrt.inc
  57. 2.05 | 01/06/00 | kjw | 1) See ncrt.inc.
  58. | 2) Added boolean internal_fwrite. FWrite was failing
  59. | when trying to write outside of the active window.
  60. | 3) nSEdit was not handling tec.firsttime correctly
  61. | when a tec.special was processed.
  62. 2.06 | 01/11/00 | kjw | See ncrt.inc.
  63. 2.07 | 01/31/00 | kjw | 1) See ncrt.inc.
  64. | 2) Added getcolor, getframecolor, getheadercolor
  65. | methods to tnWindow.
  66. 2.08 | 06/09/00 | kjw | 1) Added Picture property to tEC object. This is
  67. | used for picture input masking in nSEdit.
  68. | 2) Added nCheckPxPicture() function.
  69. | 3) nSEdit() changed to use picture input masking.
  70. | See pxpic.txt for a description of the picture
  71. | string format.
  72. 2.08.01 | 06/11/2000 | kjw
  73. | Fixed the spin cycle problem in nCheckPXPicture.
  74. 2.09.00 | 06/16/2000 | kjw
  75. | 1) nSEdit renamed to nEdit. Now nSEdit just calls nEdit() for
  76. | compatibility.
  77. | 2) Added overloaded nEdit functions for Integer, LongInt, and
  78. | Real types.
  79. | 3) Changed nEdit() embedding of control characters to preface
  80. | with a ^P. Also now uses a highlight attribute for the control
  81. | characters.
  82. | 4) Added control character cursor control to nEdit().
  83. | 5) Added Esc/1..0 = F1..F10 to nEdit().
  84. | 6) Added '@' to match set in pxpic.inc.
  85. | 7) tnWindow.Align was not positioning properly. Off by one.
  86. | 8) tnWindow.Init used wrong pointer for keypad and intrflush.
  87. | 9) tnWindow.Edit was messing up ec.Special.
  88. 2.09.01 | 06/16/2000 | kjw
  89. | 1) nStdScr (tnWindow) added and initialized at unit startup.
  90. | nStdScr can be used for a default full screen window.
  91. | 2) nEdit overloaded to work without a window pointer. It works
  92. | with the currently active window.
  93. 2.10.00 | 06/23/2000 | kjw
  94. | 1) Added character mapping to the tEC object. This includes the
  95. | ChMap property and the AddChMap() and ClrChMap() methods.
  96. | 2) Added AppendMode property to the tEC object. The character
  97. | typed in nEdit() is always appended to the current string
  98. | regardless of cursor position. Useful when ExitMode is true.
  99. | 3) tnWindow.Done was not re-assigning an ActiveWn.
  100. | 4) nEdit LeftArrow was allowing < x.
  101. | 5) Added nEditNumber() function.
  102. | 6) Added nEditDate() function.
  103. | 7) I made a command decision and renamed the tEC.FirstTime
  104. | property to tEC.ClearMode as it is more descriptive.
  105. 2.11.00 | 1) Cleaned up some loose ends with 2.10.
  106. | 2) Some more overloading
  107. | 3) Removed tnWindow.readln, write, and writeln methods.
  108. | 4) See ncrt.inc.
  109. 2.12.00 | 1) Remove the "n" from the tnWindow.editxxx functions for
  110. | consistancy. Procedurals are prefaced with an "n". Object methods
  111. | are not.
  112. | 2) Procedural FWrite renamed to nFWrite.
  113. | 3) tEC object type renamed to tnEC.
  114. | 4) Added nMakeWindow(), a one line procedural wrapper for
  115. | tnWindow.Init and tnWindow.PutHeader.
  116. | 5) Added GetX, GetY, IsFramed methods to tnWindow;
  117. | 6) Fixed nFWrite for too long strings;
  118. | 7) tnWindow.Align was wrong when justify was none.
  119. 2.13.00 | 06/30/00 | kjw | See ncrt.inc
  120. 2.14.00 | 07/05/00 | kjw | See ncrt.inc
  121. ------------------------------------------------------------------------------
  122. }
  123. Interface
  124. Uses linux,ncurses,panel;
  125. Const
  126. { decimal number format, us or european }
  127. nUS = 0;
  128. nEURO = 1;
  129. nDecFmt : byte = nUS;
  130. { border styles for text boxes }
  131. btNone : integer = 0;
  132. btSingle : integer = 1;
  133. btDouble : integer = 2;
  134. { ordinal key codes }
  135. nKeyEnter = 13; { Enter key }
  136. nKeyEsc = 27; { Home key }
  137. nKeyHome = 71; { Home key }
  138. nKeyUp = 72; { Up arrow }
  139. nKeyPgUp = 73; { PgUp key }
  140. nKeyLeft = 75; { Left arrow }
  141. nKeyRight = 77; { Right arrow }
  142. nKeyEnd = 79; { End key }
  143. nKeyDown = 80; { Down arrow }
  144. nKeyPgDn = 81; { PgDn key }
  145. nKeyIns = 82; { Insert key }
  146. nKeyDel = 83; { Delete key }
  147. nKeyCtrlLeft = 115; { Ctrl/left arrow }
  148. nKeyCtrlRight = 116; { Ctrl/right arrow }
  149. nKeyF1 = 59; { f1 key }
  150. nKeyF2 = 60; { f2 key }
  151. nKeyF3 = 61; { f3 key }
  152. nKeyF4 = 62; { f4 key }
  153. nKeyF5 = 63; { f5 key }
  154. nKeyF6 = 64; { f6 key }
  155. nKeyF7 = 65; { f7 key }
  156. nKeyF8 = 66; { f8 key }
  157. nKeyF9 = 67; { f9 key }
  158. nKeyF10 = 68; { f10 key }
  159. nKeyF11 = 84; { shift/f1 key }
  160. nKeyF12 = 85; { shift/f2 key }
  161. nKeyF13 = 86; { shift/f3 key }
  162. nKeyF14 = 87; { shift/f4 key }
  163. nKeyF15 = 88; { shift/f5 key }
  164. nKeyF16 = 89; { shift/f6 key }
  165. nKeyF17 = 90; { shift/f7 key }
  166. nKeyF18 = 91; { shift/f8 key }
  167. nKeyF19 = 92; { shift/f9 key }
  168. nKeyF20 = 93; { shift/f10 key }
  169. { character mapping }
  170. nMaxChMaps = 255; { maximun index for character mapping }
  171. { menus }
  172. nMAXMENUITEMS = 23;
  173. Type
  174. { for scrolling a window }
  175. tnUpDown = (up,down);
  176. { for window & header positioning }
  177. tnJustify = (none,left,center,right,top,bottom);
  178. { used for nEC character mapping }
  179. nChMapStr = string[4];
  180. nChMap = array [1..nMaxChMaps] of nChMapStr;
  181. { used for nSEdit }
  182. {------------------------------------------------------------------------
  183. ClearMode = true : passed string is initialized to ''.
  184. IsHidden = true : causes a string of '*' to display in place of
  185. the actual characters typed.
  186. InsMode : toggle for insert/overwrite mode.
  187. ExitMode = true : sedit exits after every keystroke.
  188. = false: sedit only exits when #27,#13, or any extended
  189. key *except* for Home,End,RArrow,LArrow.
  190. Special : If a pressed key is found in this string, then
  191. sedit exits without processing.
  192. Picture : An input mask string. See pxpic.txt for an
  193. explanation of picture strings.
  194. CtrlColor : The highlight color for embedded control characters.
  195. ChMap : An array of character triplets describing a character
  196. that is typed and what it should map to.
  197. ------------------------------------------------------------------------}
  198. tnEC = Object
  199. ClearMode,
  200. IsHidden,
  201. InsMode,
  202. ExitMode,
  203. AppendMode : boolean;
  204. Special : string;
  205. Picture : string;
  206. CtrlColor : integer;
  207. ChMap : nChMap;
  208. Constructor Init(ft,ih,im,em,ap : boolean;
  209. s,p : string;
  210. cc : integer;
  211. mp : nChMap);
  212. Destructor Done;
  213. Function AddChMap(mp : nChMapStr) : integer;
  214. Procedure ClrChMap(idx : integer);
  215. End;
  216. pwin = ^Window;
  217. pnWindow = ^tnWindow;
  218. tnWindow = Object
  219. Private
  220. wn : pwindow; { pointer to win or sub to read/write to }
  221. win : pwindow; { pointer to main window record }
  222. sub : pwindow; { sub window if a bordered window }
  223. pan : ppanel; { pointer to panel record }
  224. subp : ppanel; { sub panel if a bordered window }
  225. visible : boolean; { is the window visible? }
  226. hasframe : boolean;
  227. wincolor, { window color }
  228. framecolor, { frame color }
  229. hdrcolor : integer; { header color }
  230. header : string[80]; { header string }
  231. Public
  232. ec : tnEC; { edit control settings }
  233. Constructor Init(x,y,x1,y1,wcolor : integer;
  234. border : boolean;
  235. fcolor : integer);
  236. Destructor Done;
  237. Procedure Active; { make this the current window }
  238. Procedure Show; { display the window }
  239. Procedure Hide; { hide the window }
  240. Procedure ClrScr;
  241. Procedure ClrEol;
  242. Procedure ClrBot;
  243. Procedure InsLine;
  244. Procedure DelLine;
  245. Procedure GotoXY(x,y : integer);
  246. Function WhereX : integer;
  247. Function WhereY : integer;
  248. Function ReadKey : char;
  249. Procedure WriteAC(x,y,att,c : longint);
  250. Procedure FWrite(x,y,att,z : integer; s : string);
  251. Procedure DrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
  252. Function GetHeader : string;
  253. Procedure PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
  254. Procedure SetColor(att : integer);
  255. Function GetColor : integer;
  256. Function GetFrameColor : integer;
  257. Function GetHeaderColor : integer;
  258. Procedure PutFrame(att : integer);
  259. Procedure Move(x,y : integer);
  260. Procedure Scroll(ln : integer; dir : tnUpDown);
  261. Procedure Align(hpos,vpos : tnJustify);
  262. Function Rows : integer;
  263. Function Cols : integer;
  264. Function GetX : integer;
  265. Function GetY : integer;
  266. Function IsFramed : boolean;
  267. Function Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
  268. Function Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
  269. Function Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
  270. Function EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
  271. Function EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
  272. Function EditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
  273. End;
  274. Var
  275. nStdScr : tnWindow; { default window created at unit initialization }
  276. nscreen : pwin; { pointer to ncurses stdscr }
  277. nEC : tnEC; { global edit control object }
  278. Procedure nSetActiveWin(win : pwindow);
  279. Procedure nDoNow(donow : boolean);
  280. Function nKeypressed(timeout : word) : boolean;
  281. Procedure nEcho(b : boolean);
  282. Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
  283. Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
  284. Procedure nDelWindow(var win : pWindow);
  285. Procedure nWinColor(win : pWindow; att : integer);
  286. Procedure nClrScr(win : pWindow; att : integer);
  287. Procedure nClrEol(win : pWindow);
  288. Procedure nClrBot(win : pWindow);
  289. Procedure nInsLine(win : pWindow);
  290. Procedure nDelLine(win : pWindow);
  291. Procedure nGotoXY(win : pWindow; x,y : integer);
  292. Function nWhereX(win : pWindow) : integer;
  293. Function nWhereY(win : pWindow) : integer;
  294. Function nReadkey(win : pWindow) : char;
  295. Function nReadln(win : pWindow) : string;
  296. Procedure nWrite(win : pWindow; s : string);
  297. Procedure nWriteln(win : pWindow; s : string);
  298. Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
  299. Procedure nRefresh(win : pWindow);
  300. Procedure nScroll(win : pWindow; lines : integer; dir : tnUpDown);
  301. Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer);
  302. Procedure nFrame(win : pWindow);
  303. Function nRows(win : pWindow) : integer;
  304. Function nCols(win : pWindow) : integer;
  305. Function nHL : longint; { horizontal line }
  306. Function nVL : longint; { vertical line }
  307. Function nUL : longint; { upper left corner }
  308. Function nLL : longint; { lower loft corner }
  309. Function nUR : longint; { upper right corner }
  310. Function nLR : longint; { lower right corner }
  311. Function nLT : longint; { left tee }
  312. Function nRT : longint; { right tee }
  313. Function nTT : longint; { top tee }
  314. Function nBT : longint; { bottom tee }
  315. Function nPL : longint; { plus, + }
  316. Function nLA : longint; { left arrow }
  317. Function nRA : longint; { right arrow }
  318. Function nUA : longint; { up arror }
  319. Function nDA : longint; { down arrow }
  320. Function nDI : longint; { diamond }
  321. Function nCB : longint; { checkerboard }
  322. Function nDG : longint; { degree }
  323. Function nPM : longint; { plus/minus }
  324. Function nBL : longint; { bullet }
  325. Procedure nHLine(win : pwindow; col,row,attr,x : integer);
  326. Procedure nVLine(win : pwindow; col,row,attr,y : integer);
  327. Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint);
  328. Function IsBold(att : integer) : boolean;
  329. Function SetColorPair(att : integer) : integer;
  330. Procedure nFWrite(win : pwindow; col,row,attrib : integer; clear : integer; s : string);
  331. Procedure nFWrite(col,row,attrib : integer; clear : integer; s : string);
  332. Function nSEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
  333. Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
  334. Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
  335. Function nEdit(win : pwindow; x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
  336. Function nEdit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
  337. Function nEdit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
  338. Function nEdit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
  339. Function nEditNumber(win : pwindow; x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
  340. Function nEditNumber(win : pwindow; x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
  341. Function nEditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
  342. Function nEditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
  343. Function nEditDate(win : pwindow; x,y,att : integer;initv : string;var esc : boolean) : string;
  344. Function nEditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
  345. Procedure nMakeWindow(var win : tnWindow;x1,y1,x2,y2,ta,ba,ha : integer;hasframe : boolean;hdrpos : tnJustify;hdrtxt : string);
  346. Function nCheckPxPicture(var s, Pic : string; var CPos : integer) : word;
  347. {$i ncrt.inc}
  348. {$i pxpic.inc}
  349. Var
  350. _chmap : nChMap;
  351. {---------------------------------------------------------------------
  352. tnWindow.Init
  353. Create a new window.
  354. x = upper left corner x, screen relative
  355. y = upper left corner y, screen relative
  356. x1 = lower right corner x, screen relative
  357. y1 = lower right corner y, screen relative
  358. wcolor = window/text color
  359. border = include a frame?
  360. fcolor = frame color
  361. ---------------------------------------------------------------------}
  362. Constructor tnWindow.Init(x,y,x1,y1,wcolor : integer;
  363. border : boolean;
  364. fcolor : integer);
  365. Var
  366. mp : nChMap;
  367. Begin
  368. visible := false;
  369. hasframe := false;
  370. wincolor := wcolor;
  371. framecolor := fcolor;
  372. hdrcolor := wcolor;
  373. header := '';
  374. win := nil;
  375. sub := nil;
  376. pan := nil;
  377. subp := nil;
  378. visible := false;
  379. win := newwin(y1-y+1,x1-x+1,y-1,x-1);
  380. pan := new_panel(win);
  381. hide_panel(pan);
  382. If border Then
  383. PutFrame(fcolor)
  384. Else Begin
  385. wn := win;
  386. wbkgd(win,COLOR_PAIR(SetColorPair(wcolor)));
  387. If isbold(wcolor) then wattr_on(win,A_BOLD);
  388. scrollok(win,bool(true));
  389. intrflush(win,bool(false));
  390. keypad(win,bool(true));
  391. End;
  392. FillChar(mp,SizeOf(mp),#0);
  393. ec.Init(false,false,false,false,false,'','',15,mp);
  394. ActiveWn := wn;
  395. End;
  396. { deallocate the window }
  397. Destructor tnWindow.Done;
  398. Begin
  399. If subp <> nil Then del_panel(subp);
  400. If pan <> nil Then del_panel(pan);
  401. If sub <> nil Then delwin(sub);
  402. If (win <> nil) and (win <> stdscr) Then delwin(win);
  403. ec.Done;
  404. ActiveWn := nscreen;
  405. End;
  406. { make the window current for all normal crt requests }
  407. Procedure tnWindow.Active;
  408. Begin
  409. ActiveWn := wn;
  410. End;
  411. { display the window and move to the top }
  412. Procedure tnWindow.Show;
  413. Begin
  414. ActiveWn := wn;
  415. visible := true;
  416. show_panel(pan);
  417. If subp <> nil Then show_panel(subp);
  418. update_panels;
  419. doupdate;
  420. End;
  421. { hide the window }
  422. Procedure tnWindow.Hide;
  423. Begin
  424. ActiveWn := stdscr;
  425. { ActiveWn := nStdScr.win;}
  426. visible := false;
  427. If subp <> nil Then hide_panel(subp);
  428. hide_panel(pan);
  429. update_panels;
  430. doupdate;
  431. End;
  432. Procedure tnWindow.ClrScr;
  433. Begin
  434. tmp_b := dorefresh;
  435. dorefresh := visible;
  436. nClrScr(wn,wincolor);
  437. dorefresh := tmp_b;
  438. End;
  439. Procedure tnWindow.ClrEol;
  440. Begin
  441. tmp_b := dorefresh;
  442. dorefresh := visible;
  443. nClrEol(wn);
  444. dorefresh := tmp_b;
  445. End;
  446. Procedure tnWindow.ClrBot;
  447. Begin
  448. tmp_b := dorefresh;
  449. dorefresh := visible;
  450. nClrBot(wn);
  451. dorefresh := tmp_b;
  452. End;
  453. Procedure tnWindow.InsLine;
  454. Begin
  455. tmp_b := dorefresh;
  456. dorefresh := visible;
  457. nInsLine(wn);
  458. dorefresh := tmp_b;
  459. End;
  460. Procedure tnWindow.DelLine;
  461. Begin
  462. tmp_b := dorefresh;
  463. dorefresh := visible;
  464. nDelLine(wn);
  465. dorefresh := tmp_b;
  466. End;
  467. { return the window border header string }
  468. Function tnWindow.GetHeader : string;
  469. Begin
  470. GetHeader := header;
  471. End;
  472. {----------------------------------------------------------------------
  473. put/replace a header string at the top of a bordered window
  474. hdr = header string (top line of window, only if hasframe = true)
  475. hcolor = header line color
  476. hpos = justfication of header string, left, center, or right
  477. ----------------------------------------------------------------------}
  478. Procedure tnWindow.PutHeader(hdr : string; hcolor : integer; hpos : tnJustify);
  479. Var
  480. cp,
  481. hx,
  482. len : integer;
  483. att,
  484. mx,my : longint;
  485. Begin
  486. If Hasframe Then Begin
  487. If hdr <> '' Then Begin
  488. header := hdr;
  489. hdrcolor := hcolor;
  490. getmaxyx(win,my,mx);
  491. nHline(win,2,1,framecolor,mx-1);
  492. len := mx-2;
  493. hdr := Copy(hdr,1,len);
  494. len := Length(hdr);
  495. Case hpos of
  496. left : hx := 1;
  497. center : hx := (mx - len) div 2;
  498. right : hx := (mx - len) - 1;
  499. End;
  500. mvwaddstr(win,0,hx,StrPCopy(ps,hdr));
  501. cp := SetColorPair(hcolor);
  502. If IsBold(hcolor) Then
  503. att := A_BOLD
  504. Else
  505. att := A_NORMAL;
  506. mvwchgat(win,0,hx,len,att,cp,0);
  507. End;
  508. End;
  509. End;
  510. { set the the color of the writable window }
  511. Procedure tnWindow.SetColor(att : integer);
  512. Begin
  513. wbkgd(wn,COLOR_PAIR(SetColorPair(att)));
  514. If isbold(att) then wattr_set(wn,A_BOLD);
  515. wincolor := att;
  516. If visible Then wrefresh(wn);
  517. End;
  518. { get the writeable window color }
  519. Function tnWindow.GetColor : integer;
  520. Begin
  521. GetColor := wincolor;
  522. End;
  523. { get the frame color }
  524. Function tnWindow.GetFrameColor : integer;
  525. Begin
  526. GetFrameColor := framecolor;
  527. End;
  528. { get the header color }
  529. Function tnWindow.GetHeaderColor : integer;
  530. Begin
  531. GetHeaderColor := hdrcolor;
  532. End;
  533. { frame an un-framed window, or update the frame color of a framed window }
  534. Procedure tnWindow.PutFrame(att : integer);
  535. Var
  536. x,y,
  537. mx,my,
  538. atts : longint;
  539. Begin
  540. wbkgd(win,COLOR_PAIR(SetColorPair(att)));
  541. atts := wattr_get(win);
  542. If isbold(att) then wattr_on(win,atts or A_BOLD);
  543. box(win,ACS_VLINE,ACS_HLINE);
  544. framecolor := att;
  545. If framecolor = -1 Then framecolor := wincolor;
  546. hasframe := true;
  547. If sub = nil Then Begin
  548. getbegyx(win,y,x);
  549. getmaxyx(win,my,mx);
  550. sub := newwin(my-2,mx-2,y+1,x+1);
  551. If sub <> nil Then Begin
  552. subp := new_panel(sub);
  553. hide_panel(subp);
  554. wbkgd(sub,COLOR_PAIR(SetColorPair(wincolor)));
  555. If isbold(wincolor) then wattr_on(sub,A_BOLD);
  556. scrollok(sub,bool(true));
  557. intrflush(sub,bool(false));
  558. keypad(sub,bool(true));
  559. wn := sub;
  560. End;
  561. End;
  562. touchwin(sub);
  563. If visible Then Begin
  564. wrefresh(win);
  565. wrefresh(sub);
  566. End;
  567. End;
  568. { move the window }
  569. Procedure tnWindow.Move(x,y : integer);
  570. Begin
  571. move_panel(pan,y-1,x-1);
  572. If subp <> nil Then move_panel(subp,y,x);
  573. If visible Then Begin
  574. update_panels;
  575. doupdate;
  576. End;
  577. End;
  578. Procedure tnWindow.Align(hpos,vpos : tnJustify);
  579. Var
  580. x,y,
  581. bx,by : longint;
  582. Begin
  583. getmaxyx(win,y,x);
  584. getbegyx(win,by,bx);
  585. Case hpos of
  586. none : x := bx;
  587. left : x := 1;
  588. right : x := MaxCols - x;
  589. center : x := (MaxCols - x) div 2;
  590. End;
  591. Case vpos of
  592. none : y := by;
  593. top : y := 1;
  594. bottom : y := MaxRows - y;
  595. center : y := (MaxRows - y) div 2;
  596. End;
  597. move(x+1,y+1);
  598. End;
  599. Procedure tnWindow.Scroll(ln : integer; dir : tnUpDown);
  600. Begin
  601. nScroll(wn,ln,dir);
  602. End;
  603. Procedure tnWindow.GotoXY(x,y : integer);
  604. Begin
  605. tmp_b := dorefresh;
  606. dorefresh := visible;
  607. nGotoXY(wn,x,y);
  608. dorefresh := tmp_b;
  609. End;
  610. Function tnWindow.WhereX : integer;
  611. Begin
  612. WhereX := nWhereX(wn);
  613. End;
  614. Function tnWindow.WhereY : integer;
  615. Begin
  616. WhereY := nWhereY(wn);
  617. End;
  618. Function tnWindow.ReadKey : char;
  619. Begin
  620. ReadKey := nReadKey(wn);
  621. End;
  622. Procedure tnWindow.WriteAC(x,y,att,c : longint);
  623. Begin
  624. tmp_b := dorefresh;
  625. dorefresh := visible;
  626. nWriteAC(wn,x,y,att,c);
  627. dorefresh := tmp_b;
  628. End;
  629. Procedure tnWindow.FWrite(x,y,att,z : integer; s : string);
  630. Begin
  631. tmp_b := dorefresh;
  632. dorefresh := visible;
  633. nFWrite(wn,x,y,att,z,s);
  634. dorefresh := tmp_b;
  635. End;
  636. Procedure tnWindow.DrawBox(LineStyle,x1,y1,x2,y2,att : Integer);
  637. Begin
  638. tmp_b := dorefresh;
  639. dorefresh := visible;
  640. nDrawBox(wn,LineStyle,x1,y1,x2,y2,att);
  641. dorefresh := tmp_b;
  642. End;
  643. Function tnWindow.Rows : integer;
  644. Begin
  645. Rows := nRows(wn);
  646. End;
  647. Function tnWindow.Cols : integer;
  648. Begin
  649. Cols := nCols(wn);
  650. End;
  651. Function tnWindow.GetX : integer;
  652. Var
  653. x,y : longint;
  654. Begin
  655. getbegyx(win,y,x);
  656. GetX := x+1;
  657. End;
  658. Function tnWindow.GetY : integer;
  659. Var
  660. x,y : longint;
  661. Begin
  662. getbegyx(win,y,x);
  663. GetY := y+1;
  664. End;
  665. Function tnWindow.IsFramed : boolean;
  666. Begin
  667. IsFramed := hasframe;
  668. End;
  669. Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:String;Var ch : Char) : String;
  670. var
  671. tmp_ec : tnec;
  672. Begin
  673. { save global ec}
  674. tmp_ec := nEC;
  675. { init global ec to window ec }
  676. nEC := ec;
  677. Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
  678. { re-init window ec to possible changed values }
  679. ec.ClearMode := nEC.ClearMode;
  680. ec.InsMode := nEC.InsMode;
  681. { init global ec to saved }
  682. nEC := tmp_ec;
  683. End;
  684. { overload for longint }
  685. Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:LongInt;Var ch : Char) : LongInt;
  686. var
  687. tmp_ec : tnec;
  688. Begin
  689. tmp_ec := nEC;
  690. nEC := ec;
  691. Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
  692. ec.ClearMode := nEC.ClearMode;
  693. ec.InsMode := nEC.InsMode;
  694. nEC := tmp_ec;
  695. End;
  696. { overload for real }
  697. Function tnWindow.Edit(x,y,att,z,CursPos:Integer;es:Real;Var ch : Char) : Real;
  698. var
  699. tmp_ec : tnec;
  700. Begin
  701. tmp_ec := nEC;
  702. nEC := ec;
  703. Edit := nEdit(wn,x,y,att,z,CursPos,es,ch);
  704. ec.ClearMode := nEC.ClearMode;
  705. ec.InsMode := nEC.InsMode;
  706. nEC := tmp_ec;
  707. End;
  708. Function tnWindow.EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : real;var esc : boolean) : real;
  709. var
  710. tmp_ec : tnec;
  711. Begin
  712. tmp_ec := nEC;
  713. nEC := ec;
  714. EditNumber := nEditNumber(wn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
  715. ec.ClearMode := nEC.ClearMode;
  716. ec.InsMode := nEC.InsMode;
  717. nEC := tmp_ec;
  718. End;
  719. Function tnWindow.EditNumber(x,y,att,wid,decm : integer;bgd : string;initv,minv,maxv : longint;var esc : boolean) : longint;
  720. var
  721. tmp_ec : tnec;
  722. Begin
  723. tmp_ec := nEC;
  724. nEC := ec;
  725. EditNumber := nEditNumber(wn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
  726. ec.ClearMode := nEC.ClearMode;
  727. ec.InsMode := nEC.InsMode;
  728. nEC := tmp_ec;
  729. End;
  730. Function tnWindow.EditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
  731. var
  732. tmp_ec : tnec;
  733. Begin
  734. tmp_ec := nEC;
  735. nEC := ec;
  736. EditDate := nEditDate(wn,x,y,att,initv,esc);
  737. ec.ClearMode := nEC.ClearMode;
  738. ec.InsMode := nEC.InsMode;
  739. nEC := tmp_ec;
  740. End;
  741. {--------------------------- tnEC -------------------------------}
  742. Constructor tnEC.Init(ft,ih,im,em,ap : boolean;
  743. s,p : string;
  744. cc : integer;
  745. mp : nChMap);
  746. Begin
  747. ClearMode := ft;
  748. IsHidden := ih;
  749. InsMode := im;
  750. ExitMode := em;
  751. AppendMode := ap;
  752. Special := s;
  753. Picture := p;
  754. CtrlColor := cc;
  755. ChMap := mp;
  756. End;
  757. Destructor tnEC.Done;
  758. Begin
  759. End;
  760. { Add or replace a character map }
  761. Function tnEC.AddChMap(mp : nChMapStr) : integer;
  762. Var
  763. i : integer;
  764. Begin
  765. i := 0;
  766. Repeat
  767. inc(i);
  768. Until (i > nMaxChMaps) or (Copy(ChMap[i],1,2) = Copy(mp,1,2)) or (ChMap[i] = '');
  769. If i <= nMaxChMaps Then Begin
  770. AddChMap := i;
  771. ChMap[i] := mp;
  772. End Else
  773. AddChMap := 0;
  774. End;
  775. Procedure tnEC.ClrChMap(idx : integer);
  776. Begin
  777. Case idx of
  778. 0 : FillChar(ChMap,SizeOf(ChMap),#0);
  779. 1..nMaxChMaps : ChMap[idx] := '';
  780. End;
  781. End;
  782. {==========================================================================}
  783. { set the active window for write(ln), read(ln) }
  784. Procedure nSetActiveWin(win : pwindow);
  785. Begin
  786. ActiveWn := win;
  787. End;
  788. {----------------------------------------------------------------
  789. Set the refresh toggle.
  790. If true, then all changes to a window are immediate. If false,
  791. then changes appear following the next call to nRefresh.
  792. ----------------------------------------------------------------}
  793. Procedure nDoNow(donow : boolean);
  794. Begin
  795. dorefresh := donow;
  796. End;
  797. {-----------------------------------------------------
  798. Set the echo flag.
  799. This determines whether or not, characters are
  800. echoed to the display when entered via the keyboard.
  801. -----------------------------------------------------}
  802. Procedure nEcho(b : boolean);
  803. Begin
  804. Case b of
  805. true : echo;
  806. false: noecho;
  807. End;
  808. isEcho := b;
  809. End;
  810. { create a new subwindow of stdscr }
  811. Procedure nWindow(var win : pWindow; x,y,x1,y1 : integer);
  812. Begin
  813. nDelWindow(win);
  814. win := subwin(stdscr,y1-y+1,x1-x+1,y-1,x-1);
  815. If win = nil then Exit;
  816. intrflush(win,bool(false));
  817. keypad(win,bool(true));
  818. scrollok(win,bool(true));
  819. ActiveWn := win;
  820. End;
  821. { create a new window }
  822. Procedure nNewWindow(var win : pWindow; x,y,x1,y1 : integer);
  823. Begin
  824. nDelWindow(win);
  825. win := newwin(y1-y+1,x1-x+1,y-1,x-1);
  826. If win = nil then Exit;
  827. intrflush(win,bool(false));
  828. keypad(win,bool(true));
  829. scrollok(win,bool(true));
  830. ActiveWn := win;
  831. End;
  832. { repaint a window }
  833. Procedure nRefresh(win : pWindow);
  834. Begin
  835. touchwin(win);
  836. wrefresh(win);
  837. End;
  838. {----------------------------------------------
  839. Wait for a key to be pressed, with a timeout.
  840. If a key is pressed, then nKeypressed returns
  841. immediately as true, otherwise it return as
  842. false after the timeout period.
  843. ----------------------------------------------}
  844. function nKeypressed(timeout : word) : boolean;
  845. var
  846. fds : FDSet;
  847. maxFD : longint;
  848. Begin
  849. FD_Zero(fds);
  850. maxFD := 1;
  851. { turn on stdin bit }
  852. If not FD_IsSet(STDIN,fds) Then FD_Set(STDIN,fds);
  853. { wait for some input }
  854. If Select(maxFD,@fds,nil,nil,timeout) > 0 Then
  855. nKeypressed := TRUE
  856. Else
  857. nKeypressed := FALSE;
  858. End;
  859. {---------------------------------
  860. read input string from a window
  861. ---------------------------------}
  862. Function nReadln(win : pWindow) : string;
  863. Begin
  864. wgetstr(win,ps);
  865. nReadln := StrPas(ps);
  866. End;
  867. { write a string to a window without refreshing screen }
  868. Procedure nWriteScr(win : pWindow; x,y,att : integer; s : string);
  869. Var
  870. tmp : pwindow;
  871. Begin
  872. tmp := ActiveWn;
  873. tmp_b := doRefresh;
  874. ActiveWn := win;
  875. doRefresh := false;
  876. nFWrite(win,x,y,att,0,s);
  877. ActiveWn := tmp;
  878. doRefresh := tmp_b;
  879. End;
  880. {----------------------------------------------------------
  881. Scroll a window, up or down, a specified number of lines.
  882. lines = number of lines to scroll.
  883. dir = direction, up or down.
  884. ----------------------------------------------------------}
  885. Procedure nScroll(win : pWindow; lines : integer; dir : tnUpDown);
  886. Begin
  887. ScrollOk(win,bool(True));
  888. Case dir of
  889. up : lines := abs(lines);
  890. down : lines := abs(lines) * (-1);
  891. End;
  892. wscrl(win,lines);
  893. If doRefresh Then wRefresh(win);
  894. End;
  895. { draw a colored box, with or without a border }
  896. Procedure nDrawBox(win : pWindow; LineStyle,x1,y1,x2,y2,att : Integer);
  897. Var
  898. sub : pWindow;
  899. x,y : longint;
  900. Begin
  901. getbegyx(win,y,x);
  902. sub := subwin(win,y2-y1+1,x2-x1+1,y+y1-1,x+x1-1);
  903. If sub = nil Then exit;
  904. wbkgd(sub,CursesAtts(att));
  905. werase(sub);
  906. case LineStyle of
  907. 1,2 : box(sub, ACS_VLINE, ACS_HLINE);
  908. End;
  909. If doRefresh Then wrefresh(sub);
  910. nDelWindow(sub);
  911. End;
  912. {---------------------------
  913. add a border to a window,
  914. waits for a refresh
  915. ---------------------------}
  916. Procedure nFrame(win : pWindow);
  917. Begin
  918. box(win, ACS_VLINE, ACS_HLINE);
  919. End;
  920. {-----------------------------------------------------------
  921. write a string to a window at the current cursor position
  922. followed by a newline
  923. -----------------------------------------------------------}
  924. Procedure nWriteln(win : pWindow; s : string);
  925. Begin
  926. waddstr(win,StrPCopy(ps,s+#10));
  927. If doRefresh Then wrefresh(win);
  928. End;
  929. { return then number of rows in a window }
  930. Function nRows(win : pWindow) : integer;
  931. Var
  932. x,y : longint;
  933. Begin
  934. getmaxyx(win,y,x);
  935. nRows := y;
  936. End;
  937. { return then number of columns in a window }
  938. Function nCols(win : pWindow) : integer;
  939. Var
  940. x,y : longint;
  941. Begin
  942. getmaxyx(win,y,x);
  943. nCols := x;
  944. End;
  945. {-------------------------------------------------------
  946. Line drawing characters have to be handled specially.
  947. Use nWriteAC() to write these characters. They cannot
  948. be simply included as characters in a string.
  949. -------------------------------------------------------}
  950. { returns horizontal line character }
  951. Function nHL : longint;
  952. Begin
  953. nHL := ACS_HLINE;
  954. End;
  955. { returns vertical line character }
  956. Function nVL : longint;
  957. Begin
  958. nVL := ACS_VLINE;
  959. End;
  960. { returns upper left corner character }
  961. Function nUL : longint;
  962. Begin
  963. nUL := ACS_ULCORNER;
  964. End;
  965. { returns lower left corner character }
  966. Function nLL : longint;
  967. Begin
  968. nLL := ACS_LLCORNER;
  969. End;
  970. { returns upper right corner character }
  971. Function nUR : longint;
  972. Begin
  973. nUR := ACS_URCORNER;
  974. End;
  975. { returns lower right corner character }
  976. Function nLR : longint;
  977. Begin
  978. nLR := ACS_LRCORNER;
  979. End;
  980. { returns left tee character }
  981. Function nLT : longint;
  982. Begin
  983. nLT := ACS_LTEE;
  984. End;
  985. { returns right tee character }
  986. Function nRT : longint;
  987. Begin
  988. nRT := ACS_RTEE;
  989. End;
  990. { returns top tee character }
  991. Function nTT : longint;
  992. Begin
  993. nTT := ACS_TTEE;
  994. End;
  995. { returns bottom tee character }
  996. Function nBT : longint;
  997. Begin
  998. nBT := ACS_BTEE;
  999. End;
  1000. { returns plus/cross character }
  1001. Function nPL : longint;
  1002. Begin
  1003. nPL := ACS_PLUS;
  1004. End;
  1005. { returns left arrow character }
  1006. Function nLA : longint;
  1007. Begin
  1008. nLA := ACS_LARROW;
  1009. End;
  1010. { returns right arrow character }
  1011. Function nRA : longint;
  1012. Begin
  1013. nRA := ACS_RARROW;
  1014. End;
  1015. { returns up arrow character }
  1016. Function nUA : longint;
  1017. Begin
  1018. nUA := ACS_UARROW;
  1019. End;
  1020. { returns down arrow character }
  1021. Function nDA : longint;
  1022. Begin
  1023. nDA := ACS_DARROW;
  1024. End;
  1025. { returns diamond character }
  1026. Function nDI : longint;
  1027. Begin
  1028. nDI := ACS_DIAMOND;
  1029. End;
  1030. { returns checkerboard character }
  1031. Function nCB : longint;
  1032. Begin
  1033. nCB := ACS_CKBOARD;
  1034. End;
  1035. { returns degree character }
  1036. Function nDG : longint;
  1037. Begin
  1038. nDG := ACS_DEGREE;
  1039. End;
  1040. { returns plus/minus character }
  1041. Function nPM : longint;
  1042. Begin
  1043. nPM := ACS_PLMINUS;
  1044. End;
  1045. { returns bullet character }
  1046. Function nBL : longint;
  1047. Begin
  1048. nBL := ACS_BULLET;
  1049. End;
  1050. { draw a horizontal line with color and a start & end position }
  1051. Procedure nHLine(win : pwindow; col,row,attr,x : integer);
  1052. var
  1053. sub : pwindow;
  1054. bx,by : longint;
  1055. Begin
  1056. getbegyx(win,by,bx);
  1057. sub := subwin(win,1,x-col+1,by+row-1,bx+col-1);
  1058. If sub = nil Then Exit;
  1059. x := getmaxx(sub);
  1060. wbkgd(sub,CursesAtts(attr));
  1061. mvwhline(sub,0,0,ACS_HLINE,x);
  1062. If doRefresh Then wrefresh(sub);
  1063. delwin(sub);
  1064. End;
  1065. { draw a vertical line with color and a start & end position }
  1066. Procedure nVLine(win : pwindow; col,row,attr,y : integer);
  1067. var sub : pwindow;
  1068. Begin
  1069. sub := subwin(win,y-row+1,1,row-1,col-1);
  1070. If sub = nil Then Exit;
  1071. wbkgd(sub,CursesAtts(attr));
  1072. mvwvline(sub,0,0,ACS_VLINE,y);
  1073. If doRefresh Then wrefresh(sub);
  1074. delwin(sub);
  1075. End;
  1076. {----------------------------------------------------------------
  1077. Write a character from the alternate character set. A normal
  1078. value from the alternate character set is larger than $400000.
  1079. If the value passed here is 128..255, then we assume it to be
  1080. the ordinal value from the IBM extended character set, and try
  1081. to map it to curses correctly. If it does not map, then we just
  1082. make it an alternate character and hope the output is what the
  1083. programmer expected. Note: this will work on the Linux console
  1084. just fine, but for other terminals the passed value must match
  1085. the termcap definition for the alternate character.
  1086. Note: The cursor returns to it's original position.
  1087. ----------------------------------------------------------------}
  1088. Procedure nWriteAC(win : pwindow; x,y : integer; att,acs_char : longint);
  1089. var
  1090. xx,yy,
  1091. cp : longint;
  1092. Begin
  1093. If acs_char in [0..255] Then Begin
  1094. Case acs_char of
  1095. 176 : acs_char := ACS_CKBOARD;
  1096. 179 : acs_char := ACS_VLINE;
  1097. 180 : acs_char := ACS_RTEE;
  1098. 191 : acs_char := ACS_URCORNER;
  1099. 192 : acs_char := ACS_LLCORNER;
  1100. 193 : acs_char := ACS_BTEE;
  1101. 194 : acs_char := ACS_TTEE;
  1102. 195 : acs_char := ACS_LTEE;
  1103. 196 : acs_char := ACS_HLINE;
  1104. 197 : acs_char := ACS_PLUS;
  1105. 218 : acs_char := ACS_ULCORNER;
  1106. 217 : acs_char := ACS_LRCORNER;
  1107. 241 : acs_char := ACS_PLMINUS;
  1108. 248 : acs_char := ACS_DEGREE;
  1109. 249 : acs_char := ACS_BULLET;
  1110. else acs_char := acs_char or A_ALTCHARSET;
  1111. End;
  1112. End;
  1113. { save the current cursor position }
  1114. getyx(win,yy,xx);
  1115. cp := SetColorPair(att);
  1116. { write character with current attributes }
  1117. mvwaddch(win,y-1,x-1,acs_char);
  1118. { update with new attributes }
  1119. If IsBold(att) Then
  1120. att := A_BOLD or A_ALTCHARSET
  1121. Else
  1122. att := A_NORMAL or A_ALTCHARSET;
  1123. mvwchgat(win,y-1,x-1,1,att,cp,0);
  1124. { return cursor to saved position }
  1125. wmove(win,yy,xx);
  1126. If doRefresh Then wrefresh(win);
  1127. End;
  1128. {-------------------------------------------------------------------
  1129. write a string to stdscr with color, without moving the cursor
  1130. Col = x start position
  1131. Row = y start position
  1132. Attrib = color (0..127), note color = (background*16)+foreground
  1133. Clear = clear line up to x position
  1134. s = string to write
  1135. -------------------------------------------------------------------}
  1136. Procedure nFWrite(win : pwindow; col,row,attrib : integer; clear : integer; s : string);
  1137. var
  1138. clr : array [0..255] of char;
  1139. cs : string;
  1140. sub : pWindow;
  1141. x,y,
  1142. mx,my,
  1143. xx,yy : longint;
  1144. ctrl : boolean;
  1145. Begin
  1146. if Clear > 0 Then Begin
  1147. FillChar(clr,SizeOf(clr),' ');
  1148. clr[SizeOf(clr)-1] := #0;
  1149. If Clear > MaxCols Then Clear := MaxCols;
  1150. cs := Copy(StrPas(clr),1,(Clear-Col)-Length(s)+1);
  1151. End Else
  1152. cs := '';
  1153. s := s+cs;
  1154. If s = '' Then Exit;
  1155. getyx(win,yy,xx);
  1156. getbegyx(win,y,x);
  1157. getmaxyx(win,my,mx);
  1158. If Length(s) > mx Then s := Copy(s,1,mx);
  1159. sub := subwin(win,1,Length(s),y+row-1,x+col-1);
  1160. If sub = nil Then Exit;
  1161. cs := s;
  1162. ctrl := false;
  1163. { look for embedded control characters }
  1164. For x := 1 to Length(s) Do Begin
  1165. If s[x] in [#0..#31] Then Begin
  1166. s[x] := ' ';
  1167. ctrl := true;
  1168. End;
  1169. End;
  1170. wbkgd(sub,COLOR_PAIR(SetColorPair(Attrib)));
  1171. If isbold(Attrib) then
  1172. wattr_on(sub,A_BOLD);
  1173. mvwaddstr(sub,0,0,StrPCopy(ps,s));
  1174. { highlight the embedded control characters substitutes }
  1175. If ctrl Then Begin
  1176. { nEC is always the current edit control object }
  1177. If Attrib <> nEC.CtrlColor Then
  1178. nWinColor(sub,nEC.CtrlColor)
  1179. Else Begin
  1180. { reverse the highlight color if same as current attribute }
  1181. bg := nEC.CtrlColor div 16;
  1182. fg := nEC.CtrlColor - (bg * 16);
  1183. While bg > 7 Do dec(bg,8);
  1184. While fg > 7 Do dec(fg,8);
  1185. nWinColor(sub,(fg*16)+bg);
  1186. End;
  1187. For x := 1 to Length(cs) Do Begin
  1188. If cs[x] in [#0..#31] Then
  1189. mvwaddch(sub,0,x-1,ord(cs[x])+64);
  1190. End;
  1191. End;
  1192. If doRefresh Then wrefresh(sub);
  1193. delwin(sub);
  1194. wmove(win,yy,xx);
  1195. End;
  1196. { overload - no pointer }
  1197. Procedure nFWrite(col,row,attrib : integer; clear : integer; s : string);
  1198. Begin
  1199. nFWrite(ActiveWn,col,row,attrib,clear,s);
  1200. End;
  1201. { compatibility for the old function name }
  1202. Function nSEdit(win : pwindow; x,y,att,z,CursPos:integer;
  1203. es:string;var ch : char) : string;
  1204. Var
  1205. s : string;
  1206. Begin
  1207. s := nEdit(win,x,y,att,z,CursPos,es,ch);
  1208. nSEdit := s;
  1209. End;
  1210. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1211. { String Editor }
  1212. Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
  1213. es:string;var ch : char) : string;
  1214. Var
  1215. ZMode,
  1216. AppendMode,
  1217. SEditExit : boolean;
  1218. prvx,
  1219. prvy,
  1220. pidx,
  1221. pres,
  1222. Index : integer;
  1223. ts,
  1224. hes : string;
  1225. isextended : boolean;
  1226. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1227. Procedure NewString;
  1228. BEGIN
  1229. nEdit := es;
  1230. hes := es;
  1231. FillChar(hes[1],Length(hes),'*');
  1232. END;
  1233. Procedure WriteString;
  1234. Var
  1235. xx,yy : integer;
  1236. Begin
  1237. xx := nWhereX(win);
  1238. yy := nWhereY(win);
  1239. If nEC.IsHidden Then
  1240. nFWrite(win,x,y,att,z,hes)
  1241. Else
  1242. nFWrite(win,x,y,att,z,es);
  1243. nGotoXY(win,xx,yy);
  1244. End;
  1245. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1246. Procedure EInsMode;
  1247. Begin
  1248. nEC.InsMode := (not nEC.InsMode)
  1249. End;
  1250. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1251. Procedure WriteChar;
  1252. var s : string;
  1253. Begin
  1254. ts := es;
  1255. If AppendMode Then Begin
  1256. es := es + ' ';
  1257. Index := Length(es);
  1258. End Else Begin
  1259. If nWhereX(win) >= Length(es)+x Then Repeat
  1260. es := es + ' ';
  1261. Until Length(es)+x-1 = nWhereX(win);
  1262. If es = '' Then es := ' ';
  1263. If Length(es)+x-1 = nWhereX(win) Then Index := Length(es);
  1264. End;
  1265. es[Index] := ch;
  1266. s := Copy(es,1,Index);
  1267. If nCheckPxPicture(s,nEC.Picture,pidx) <> 0 Then Begin
  1268. { no error, picture satisfied }
  1269. If (Length(s) > Length(es)) or
  1270. ((Length(s) = Length(es)) and (s <> es)) Then Begin
  1271. { expanded/changed by picture }
  1272. es := s;
  1273. End;
  1274. If pidx > Index Then Begin
  1275. If pidx > Length(es) Then pidx := Length(es);
  1276. If pidx > Index Then Index := pidx;
  1277. End;
  1278. End Else Begin
  1279. { error, did not fit the picture }
  1280. Sound(1000);
  1281. Delay(50);
  1282. NoSound;
  1283. es := ts;
  1284. Dec(Index);
  1285. End;
  1286. NewString;
  1287. WriteString;
  1288. If (Index < z-x+1) or not ZMode Then Begin
  1289. Index := Index+1;
  1290. nGotoXY(win,x+Index-1,y);
  1291. End;
  1292. End;
  1293. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1294. Procedure EInsert; { Insert }
  1295. Begin
  1296. If Length(es) < Z-X+1 Then Begin
  1297. ts := es;
  1298. Insert(' ',es,Index);
  1299. If nCheckPXPicture(es,nEC.Picture,pidx) = 0 Then Begin
  1300. Sound(1000);
  1301. Delay(50);
  1302. NoSound;
  1303. es := ts;
  1304. ch := #255;
  1305. End;
  1306. NewString;
  1307. WriteString;
  1308. End;
  1309. End;
  1310. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1311. Procedure EDelete; { Delete }
  1312. Begin
  1313. ts := es;
  1314. Delete(es,Index,1);
  1315. If nCheckPXPicture(es,nEC.Picture,pidx) = 0 Then Begin
  1316. Sound(1000);
  1317. Delay(50);
  1318. NoSound;
  1319. es := ts;
  1320. ch := #255;
  1321. End;
  1322. NewString;
  1323. WriteString;
  1324. End;
  1325. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1326. Procedure ECtrlEnd; { <CTRL> End }
  1327. Begin
  1328. Delete(es,Index,Length(es));
  1329. NewString;
  1330. WriteString;
  1331. End;
  1332. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1333. Procedure EHome; { Home }
  1334. Begin
  1335. Index := 1;
  1336. nGotoXY(win,x,y);
  1337. End;
  1338. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1339. Procedure ELeftArrow; { Left Arrow }
  1340. Begin
  1341. If nWhereX(win) > x Then Begin
  1342. dec(Index);
  1343. nGotoXY(win,nWhereX(win)-1,nWhereY(win));
  1344. End;
  1345. End;
  1346. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1347. Procedure ERightArrow; { Right Arrow }
  1348. Begin
  1349. If Index < z-x+1 Then Begin
  1350. nGotoXY(win,nWhereX(win)+1,nWhereY(win));
  1351. Index := Index + 1;
  1352. End;
  1353. End;
  1354. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1355. Procedure EEnd; { End }
  1356. Begin
  1357. Index := Length(es)+1;
  1358. If Index > z-x+1 Then Index := Length(es);
  1359. If Index < 1 Then Index := 1;
  1360. If Index > MaxCols Then Index := MaxCols;
  1361. nGotoXY(win,x+(Index-1),y);
  1362. End;
  1363. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1364. Procedure EBackSpace; { Backspace }
  1365. Begin
  1366. Index := Index - 1;
  1367. If Index < 1 Then Begin
  1368. Index := 1;
  1369. Exit;
  1370. End Else
  1371. If nWhereX(win) > x Then nGotoXY(win,nWhereX(win) - 1,nWhereY(win));
  1372. Delete(es,Index,1);
  1373. NewString;
  1374. WriteString;
  1375. nGotoXY(win,x+(Index-1),y);
  1376. End;
  1377. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1378. Procedure ETurboBackSpace; { Ctrl/Backspace }
  1379. Begin
  1380. If Index = 1 Then Exit;
  1381. Delete(es,1,Index-1);
  1382. NewString;
  1383. Index := 1;
  1384. If nWhereX(win) > x Then nGotoXY(win,1,nWhereY(win));
  1385. WriteString;
  1386. nGotoXY(win,x,y);
  1387. END;
  1388. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1389. Procedure ECtrlLeftArrow;{ Ctrl Left Arrow }
  1390. Begin
  1391. If nEC.IsHidden Then Begin
  1392. EHome;
  1393. Exit;
  1394. End;
  1395. If es[Index-1] = ' ' Then Index := Index-1;
  1396. If es[Index] <> ' ' Then Begin
  1397. While (Index > 1) And (es[Index] <> ' ') Do
  1398. Index := Index-1;
  1399. End Else
  1400. If es[Index] = ' ' Then Begin
  1401. While (Index > 1) And (es[Index] = ' ') Do
  1402. Index := Index-1;
  1403. While (Index > 1) And (es[Index] <> ' ') Do
  1404. Index := Index-1;
  1405. End;
  1406. If Index = 1 Then
  1407. nGotoXY(win,x,y)
  1408. Else Begin
  1409. nGotoXY(win,x+Index,y);
  1410. Index := Index+1;
  1411. End;
  1412. End;
  1413. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1414. Procedure ECtrlRightArrow;{ Ctrl Right Arrow }
  1415. Begin
  1416. If nEC.IsHidden Then Begin
  1417. EEnd;
  1418. Exit;
  1419. End;
  1420. While (Index < Length(es)) And (es[Index] <> ' ') Do
  1421. Begin
  1422. Index := Index+1;
  1423. End;
  1424. While (Index < Length(es)) And (es[Index] = ' ') Do
  1425. Begin
  1426. Index := Index+1;
  1427. End;
  1428. nGotoXY(win,x+Index-1,y);
  1429. End;
  1430. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1431. Procedure CheckForWriteChar(embed : boolean);
  1432. Begin
  1433. If embed or Not (Ch In [#27,#255]) Then Begin
  1434. If (ch in [#10,#13]) and (not embed) {and not ControlKey} Then exit;
  1435. If nEC.ClearMode Then Begin
  1436. es := '';
  1437. WriteString;
  1438. nGotoXY(win,X,Y);
  1439. Index := 1;
  1440. WriteChar;
  1441. nEC.ClearMode := False;
  1442. End Else Begin
  1443. If nEC.InsMode Then Begin
  1444. EInsert;
  1445. WriteChar;
  1446. End Else WriteChar;
  1447. End;
  1448. End;
  1449. End;
  1450. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1451. Procedure ProcessSpecialKey;
  1452. begin
  1453. If ch = #129 Then ch := #68; { Linux, map Esc/0 to F10 }
  1454. Case ch of
  1455. #16..#25,
  1456. #30..#38,
  1457. #44..#50,
  1458. #59..#68,
  1459. #84..#90,
  1460. #92..#113,
  1461. #118,
  1462. #132,
  1463. #72,
  1464. #73,
  1465. #80,
  1466. #81 : Begin SEditExit:=True;Exit;End;
  1467. #71 : EHome;
  1468. #75 : ELeftArrow;
  1469. #77 : ERightArrow;
  1470. #79 : EEnd;
  1471. #82 : EInsMode;
  1472. #83 : EDelete;
  1473. #15,
  1474. #115 : ECtrlLeftArrow;
  1475. #116 : ECtrlRightArrow;
  1476. #117 : ECtrlEnd;
  1477. End;
  1478. End;
  1479. {~~~~~~~~~~~~~~~~~~~~~~~~~~~~}
  1480. Procedure ProcessNormalKey;
  1481. Var
  1482. i : integer;
  1483. ctrl : boolean;
  1484. begin
  1485. For i := 1 to Length(nEC.Special) Do Begin
  1486. If ch = nEC.Special[i] Then Begin
  1487. SEditExit:=True;
  1488. Exit;
  1489. End;
  1490. End;
  1491. ctrl := false;
  1492. case ch of
  1493. #0..#15,
  1494. #17..#31 : Begin
  1495. nEC.ClearMode := False;
  1496. Case ch of
  1497. #1 : EHome;
  1498. #5 : EEnd;
  1499. #2 : ELeftArrow;
  1500. #6 : ERightArrow;
  1501. #19 : ECtrlLeftArrow;
  1502. #4 : ECtrlRightArrow;
  1503. #7 : EDelete;
  1504. #9 : EInsMode;
  1505. #8 : EBackSpace;
  1506. #10 : ch := #13;
  1507. #13 : Begin
  1508. pres := nCheckPxPicture(es,nEC.Picture,pidx);
  1509. If pres <> 2 Then Begin
  1510. Sound(1000);
  1511. Delay(50);
  1512. NoSound;
  1513. ch := #255;
  1514. End;
  1515. End;
  1516. #27 : If KeyPressed Then Begin
  1517. { covers up a Linux peculiarity where the next }
  1518. { character typed bleeds through with esc/1..9 }
  1519. nGotoXY(win,prvx,prvy);
  1520. WriteString;
  1521. ch := ReadKey;
  1522. { make it a function key }
  1523. If ch in ['1'..'9'] Then
  1524. ch := Char(Ord(ch)+10)
  1525. Else ch := #27;
  1526. SEditExit := true;
  1527. End;
  1528. End;
  1529. Exit;
  1530. End;
  1531. #16 : Begin
  1532. { embed control characters in the string }
  1533. ch := UpCase(ReadKey);
  1534. If ch in ['@','2','A'..'Z'] Then Begin
  1535. ctrl := true;
  1536. If ch = '2' Then ch := '@';
  1537. ch := Char(Ord(ch)-64);
  1538. End;
  1539. End;
  1540. #127 : Begin nEC.ClearMode := False;ETurboBackSpace;Exit;End;
  1541. end;
  1542. CheckForWriteChar(ctrl);
  1543. ch := #0;
  1544. end;
  1545. {-----------------------------------------------------------------------
  1546. Map a keystroke to another character, normal or extended.
  1547. The maps are 4 character strings interpreted as 2 sets of character
  1548. pairs that represent the following:
  1549. 1st char - If it is #0 then it is an extended char. Use the 2nd
  1550. character to identify.
  1551. 2nd char - Only used if 1st char is #0.
  1552. The first pair of the string is the actual key pressed.
  1553. The second pair is what that key should be become.
  1554. #0#59 = F1, extended key
  1555. #59#0 = ; , normal key
  1556. So a map of #0#59#59#0 maps the F1 key to the ; key,
  1557. and #0#59#0#60 maps the F1 key to the F2 key,
  1558. and #0#59#0#0 maps the F1 key to a null.
  1559. Examples:
  1560. #0#59#0#60 = map F1 to F2
  1561. #1#0#0#59 = map ^A to F1
  1562. #0#59#1#0 = map F1 to ^A
  1563. #0#59#0#0 = map F1 to ^@ (null)
  1564. #0#0#0#59 = map ^@ to F1
  1565. #97#0#65#0 = map a to A
  1566. }
  1567. Procedure MapKey(var ch : char;var eflag : boolean);
  1568. Var
  1569. i : integer;
  1570. s2 : string[2];
  1571. s4 : string[4];
  1572. Begin
  1573. { look for a character map assignment }
  1574. i := 0;
  1575. s4 := #0#0#0#0;
  1576. Case eflag of
  1577. true : s2 := #0+ch;
  1578. false : s2 := ch+#0;
  1579. End;
  1580. Repeat
  1581. inc(i);
  1582. Until (i > nMaxChMaps) or (pos(s2,nEC.ChMap[i]) = 1);
  1583. { if found, then re-assign ch to the mapped key }
  1584. If i <= nMaxChMaps Then Begin
  1585. system.Move(nEC.ChMap[i,1],s4[1],Length(nEC.ChMap[i]));
  1586. s2 := Copy(s4,3,2);
  1587. eflag := (s2[1] = #0);
  1588. Case eflag of
  1589. true : ch := s2[2];
  1590. false : ch := s2[1];
  1591. End;
  1592. If ch = #0 Then eflag := false;
  1593. End;
  1594. End;
  1595. {============================================================================}
  1596. Begin
  1597. SEditExit := nEC.ExitMode;
  1598. AppendMode := nEC.AppendMode;
  1599. ZMode := z <> 0;
  1600. If CursPos > Length(es)+x Then
  1601. Index := Length(es)+1 { End Of String }
  1602. Else Index := CursPos+1-x; { Inside Of String }
  1603. If Not ZMode then z := x+length(es);
  1604. Newstring;
  1605. WriteString;
  1606. nGotoXY(win,CursPos,y);
  1607. Repeat
  1608. prvx := nWhereX(win); { save for ProcessNormalKey }
  1609. prvy := nWhereY(win);
  1610. If Not ZMode then z := x+length(es);
  1611. ch := ReadKey;
  1612. isextended := (ch = #0);
  1613. If isextended Then
  1614. ch := ReadKey;
  1615. MapKey(ch,isextended);
  1616. If isextended Then
  1617. ProcessSpecialKey
  1618. Else
  1619. ProcessNormalKey;
  1620. Until (ch In [#13,#27]) or SEditExit;
  1621. nEC.ClearMode := False;
  1622. NewString;
  1623. End;{ of nEdit }
  1624. { nEdit using currently active window }
  1625. Function nEdit(x,y,att,z,CursPos:integer;
  1626. es:string;var ch : char) : string;
  1627. Begin
  1628. nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
  1629. End;
  1630. { overload for longint type }
  1631. Function nEdit(x,y,att,z,CursPos:integer;
  1632. es:longint;var ch : char) : longint;
  1633. Begin
  1634. nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
  1635. End;
  1636. { with pointer }
  1637. Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
  1638. es:LongInt;var ch : char) : LongInt;
  1639. Var
  1640. savpic,
  1641. ess : string;
  1642. esv,
  1643. err : longint;
  1644. Begin
  1645. Str(es:0,ess);
  1646. savpic := nEC.Picture;
  1647. If savpic = '' Then nEC.Picture := '[-]#*#';
  1648. ess := nEdit(win,x,y,att,z,CursPos,ess,ch);
  1649. nEC.Picture := savpic;
  1650. val(ess,esv,err);
  1651. nEdit := esv;
  1652. End;
  1653. { overload for real type }
  1654. Function nEdit(x,y,att,z,CursPos:integer;
  1655. es:real;var ch : char) : real;
  1656. Begin
  1657. nEdit := nEdit(ActiveWn,x,y,att,z,CursPos,es,ch);
  1658. End;
  1659. { with pointer }
  1660. Function nEdit(win : pwindow; x,y,att,z,CursPos:integer;
  1661. es:Real;var ch : char) : Real;
  1662. Var
  1663. savpic,
  1664. ess : string;
  1665. esv : real;
  1666. i,
  1667. err : Integer;
  1668. Begin
  1669. Str(es:0:12,ess);
  1670. While ess[Length(ess)] = '0' Do Delete(ess,Length(ess),1);
  1671. savpic := nEC.Picture;
  1672. If savpic = '' Then Begin
  1673. Case nDecFmt of
  1674. nUS : nEC.Picture := '[+,-]#*#[[.*#][{E,e}[+,-]#[#][#][#]]]';
  1675. nEURO : Begin
  1676. nEC.Picture := '[+,-]#*#[[;,*#][{E,e}[+,-]#[#][#][#]]]';
  1677. For i := 1 to Length(ess) Do
  1678. If ess[i] = '.' Then ess[i] := ',';
  1679. End;
  1680. End;
  1681. End;
  1682. ess := nEdit(win,x,y,att,z,CursPos,ess,ch);
  1683. nEC.Picture := savpic;
  1684. For i := 1 to Length(ess) Do If ess[i] = ',' Then ess[i] := '.';
  1685. val(ess,esv,err);
  1686. nEdit := esv;
  1687. End;
  1688. { And now some sugar for Rainer Hantsch! }
  1689. {------------------------------------------------------------------------
  1690. This is a right justified number editor. As a digit is typed, the
  1691. existing number string gets pushed left and the new digit is appended.
  1692. If decimal columns are specified, then pressing <space> will enter the
  1693. decimal character (. or ,). A background string can be specified that
  1694. fills the empty spaces.
  1695. ------------------------------------------------------------------------}
  1696. Function nEditNumber(
  1697. win : pwindow;
  1698. x, { edit field start column }
  1699. y, { edit field start row }
  1700. att, { edit field color attribute }
  1701. wid, { edit field width }
  1702. decm : integer; { number of decimal columns }
  1703. bgd : string; { background string -
  1704. if bgd = '', then no background
  1705. if bgd = a single character, then is used as the
  1706. background fill character.
  1707. if bgd length is longer than wid, then the entire
  1708. bgd string is used as the background.}
  1709. initv, { initial value }
  1710. minv, { range minimum value }
  1711. maxv : real; { range maximum value }
  1712. var esc : boolean { if Esc key pressed = true, else = false }
  1713. ) : real;
  1714. Const
  1715. { up to 12 decimal places }
  1716. decs : string = '[#][#][#][#][#][#][#][#][#][#][#][#]';
  1717. Var
  1718. r : real;
  1719. s,s1,s2 : string;
  1720. i,
  1721. e,
  1722. bc,
  1723. bx : integer;
  1724. ch : char;
  1725. fill : array [0..255] of char;
  1726. tmp_ec : tnEC;
  1727. Begin
  1728. tmp_ec := nEC;
  1729. nEC.ExitMode := true;
  1730. nEC.AppendMode := true;
  1731. nEC.ClrChMap(0);
  1732. nEC.AddChMap(#7#0#0+Char(nKeyDel));
  1733. nEC.AddChMap(#8#0#0+Char(nKeyDel));
  1734. If decm > (Length(decs) div 3) Then
  1735. decm := (Length(decs) div 3);
  1736. If decm >= wid Then decm := (wid - 1);
  1737. If decm > 0 Then Begin
  1738. nEC.Picture := '[-]*#[{.}'+Copy(decs,1,(decm*3))+']';
  1739. If nDecFmt = nEURO Then Begin
  1740. nEC.Picture[8] := ',';
  1741. Insert(';',nEC.Picture,8);
  1742. nEC.AddChMap('.'+#0+','+#0);
  1743. End;
  1744. End Else
  1745. nEC.Picture := '[-]*#';
  1746. If bgd = '' Then Begin
  1747. bgd := ' ';
  1748. bc := att;
  1749. End Else
  1750. bc := nEC.CtrlColor;
  1751. If Length(bgd) < wid Then Begin
  1752. FillChar(fill,wid,bgd[1]);
  1753. fill[wid] := #0;
  1754. bgd := StrPas(fill);
  1755. End;
  1756. bx := x;
  1757. If Length(bgd) > wid Then inc(x);
  1758. str(initv:wid:decm,s);
  1759. While s[1] = ' ' Do Delete(s,1,1);
  1760. If Pos('.',s) <> 0 Then
  1761. While s[Length(s)] = '0' Do Delete(s,Length(s),1);
  1762. If decm = 0 Then Delete(s,Pos('.',s),1);
  1763. If nDecFmt = nEURO Then For i := 1 to Length(s) Do
  1764. If s[i] = '.' Then s[i] := ',';
  1765. Repeat
  1766. nFWrite(win,bx,y,bc,bx+Length(bgd)-(x-bx),copy(bgd,1,wid-length(s)+(x-bx)));
  1767. If x > bx Then
  1768. nFWrite(win,x+wid,y,bc,0,copy(bgd,wid+2,length(bgd)));
  1769. s1 := nEdit(win,x+wid-Length(s),y,att,x+wid-1,x+wid-1,s,ch);
  1770. s2 := s1;
  1771. If nDecFmt = nEURO Then For i := 1 to Length(s2) Do
  1772. If s2[i] = ',' Then s2[i] := '.';
  1773. val(s2,r,e);
  1774. If (s1 = '') or ((e = 0) and (r >= minv) and (r <= maxv)) Then
  1775. s := s1
  1776. Else
  1777. If ch <> #27 then Begin
  1778. ch := #0;
  1779. Sound(1000);
  1780. Delay(50);
  1781. NoSound;
  1782. End;
  1783. nEC.AppendMode := Length(s) < wid;
  1784. Until ch in [#13,#27];
  1785. esc := (ch = #27);
  1786. nEditNumber := r;
  1787. nEC := tmp_ec;
  1788. End;
  1789. { overload - real, no pointer }
  1790. Function nEditNumber(
  1791. x,y,att,wid,decm : integer;
  1792. bgd : string;
  1793. initv,
  1794. minv,
  1795. maxv : real;
  1796. var esc : boolean) : real;
  1797. Begin
  1798. nEditNumber := nEditNumber(ActiveWn,x,y,att,wid,decm,bgd,initv,minv,maxv,esc);
  1799. End;
  1800. { overload for longint }
  1801. Function nEditNumber(
  1802. win : pwindow;
  1803. x,y,att,wid,decm : integer;
  1804. bgd : string;
  1805. initv,
  1806. minv,
  1807. maxv : longint;
  1808. var esc : boolean) : longint;
  1809. Var
  1810. r : real;
  1811. Begin
  1812. r := nEditNumber(win,x,y,att,wid,0,bgd,Real(initv),Real(minv),Real(maxv),esc);
  1813. nEditNumber := Trunc(r);
  1814. End;
  1815. { overload - longint, no pointer }
  1816. Function nEditNumber(
  1817. x,y,att,wid,decm : integer;
  1818. bgd : string;
  1819. initv,
  1820. minv,
  1821. maxv : longint;
  1822. var esc : boolean) : longint;
  1823. Var
  1824. r : real;
  1825. Begin
  1826. r := nEditNumber(ActiveWn,x,y,att,wid,0,bgd,Real(initv),Real(minv),Real(maxv),esc);
  1827. nEditNumber := Trunc(r);
  1828. End;
  1829. { More sugar for Rainer }
  1830. {------------------------------------------------------------------------
  1831. A date string editor.
  1832. ------------------------------------------------------------------------}
  1833. Function nEditDate(
  1834. win : pwindow;
  1835. x, { edit field start column }
  1836. y, { edit field start row }
  1837. att : integer; { edit field color attribute }
  1838. init : string; { initial value }
  1839. var esc : boolean { if Esc key pressed = true, else = false }
  1840. ) : string;
  1841. Const
  1842. wid = 10;
  1843. Var
  1844. s : string;
  1845. i : integer;
  1846. ch : char;
  1847. tmp_ec : tnEC;
  1848. Begin
  1849. tmp_ec := nEC;
  1850. nEC.InsMode := false;
  1851. nEC.ClearMode := false;
  1852. nEC.ExitMode := false;
  1853. nEC.AppendMode := false;
  1854. Case nDecFmt of
  1855. nUS : Begin
  1856. nEC.Picture := '{#,m,M}{#,m,M}/{#,d,D}{#,d,D}/{#,y,Y}{#,y,Y}{#,y,Y}{#,y,Y}';
  1857. s := 'mm/dd/yyyy';
  1858. End;
  1859. nEURO : Begin
  1860. nEC.Picture := '{#,d,D}{#,d,D}/{#,m,M}{#,m,M}/{#,y,Y}{#,y,Y}{#,y,Y}{#,y,Y}';
  1861. s := 'dd/mm/yyyy';
  1862. End;
  1863. End;
  1864. If nCheckPxPicture(init,nEC.Picture,i) <> 0 Then
  1865. system.move(init[1],s[1],Length(init));
  1866. nEC.AddChMap(#7#0#0+Char(nKeyLeft));
  1867. nEC.AddChMap(#8#0#0+Char(nKeyLeft));
  1868. nEC.AddChMap(#0+Char(nKeyDel)+#0+Char(nKeyLeft));
  1869. Repeat
  1870. s := nEdit(x,y,att,x+9,x,s,ch);
  1871. If ch = #13 Then Begin
  1872. For i := 1 to Length(s) Do
  1873. If s[i] in ['m','d','y'] Then ch := #0;
  1874. End;
  1875. Until ch in [#13,#27];
  1876. esc := (ch = #27);
  1877. nEditDate := s;
  1878. nEC := tmp_ec;
  1879. End;
  1880. { overload - no pointer }
  1881. Function nEditDate(x,y,att : integer;initv : string;var esc : boolean) : string;
  1882. Begin
  1883. nEditDate := nEditDate(ActiveWn,x,y,att,initv,esc);
  1884. End;
  1885. { A one-line procedural wrapper }
  1886. Procedure nMakeWindow(
  1887. var win : tnWindow;
  1888. x1,y1,
  1889. x2,y2,
  1890. ta,ba,ha : integer;
  1891. hasframe : boolean;
  1892. hdrpos : tnJustify;
  1893. hdrtxt : string);
  1894. Begin
  1895. win.init(x1,y1,x2,y2,ta,hasframe,ba);
  1896. If hdrtxt <> '' Then win.PutHeader(hdrtxt,ha,hdrpos);
  1897. End;
  1898. {----------------------- initialize the unit!------------------------- }
  1899. Begin
  1900. FillChar(_chmap,SizeOf(_chmap),#0);
  1901. nEC.Init(false,false,false,false,false,'','',15,_chmap);
  1902. { load the color pairs array with color pair indices (0..63) }
  1903. For bg := 0 to 7 Do For fg := 0 to 7 do cp[bg,fg] := (bg*8)+fg;
  1904. { initialize ncurses }
  1905. If StartCurses(ActiveWn) Then Begin
  1906. { save pointer to ncurses stdscr }
  1907. nscreen := ActiveWn;
  1908. { create the default full screen window object }
  1909. nStdScr.Init(1,1,MaxCols,MaxRows,7,false,0);
  1910. End Else
  1911. Halt;
  1912. { crtassign }
  1913. nInit;
  1914. { set the unit exit procedure }
  1915. ExitSave := ExitProc;
  1916. ExitProc := @nExit;
  1917. End. { of Unit nCrt }