ocrt.pp 95 KB

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