ncrt.inc 25 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937
  1. {---------------------------------------------------------------------------
  2. CncWare
  3. (c) Copyright 1999-2000
  4. Portions copyright the FreePascal Team
  5. ---------------------------------------------------------------------------
  6. Filename..: ncrt.inc
  7. Programmer: Ken J. Wright, [email protected]
  8. Date......: 03/01/99
  9. Purpose - Code that is common to nCrt and oCrt.
  10. -------------------------------<< REVISIONS >>--------------------------------
  11. Ver | Date | Prog| Description
  12. -------+----------+-----+-----------------------------------------------------
  13. 2.00 | 12/13/99 | kjw | Initial Release.
  14. 2.02 | 12/15/99 | kjw | Removed use of endwin. Replaced with tcget/setattr.
  15. 2.03 | 12/16/99 | kjw | 1) Added shifted f-keys to nReadkey.
  16. | 2) Added raw & scrollok to StartCurses.
  17. | 3) Added alt'd keyset support.
  18. 2.04 | 01/04/00 | kjw | keypressed changed back to method of using getch
  19. | rather than select.
  20. 2.05 | 01/06/00 | kjw | 1) StartCurses now defaults to echo. Readkey sets to
  21. | noecho. This allows nCrt to handle echoing in the
  22. | default manor, but allows oCrt to control echoing
  23. | in the app with nEcho. Note: Read(ln) will always
  24. | echo as normal, regardless of any setting by nEcho.
  25. | Also set DoRefresh to true.
  26. | 2) nDelWindow now checks for stdscr or curscr and
  27. | makes sure that ActiveWn is not nil.
  28. | 3) Window() now moves to 1,1 and does not do a
  29. | clrscr.
  30. 2.06 | 01/11/00 | kjw | 1) Oops! 2.04 change went back to stdscr vs. ActiveWn.
  31. | Keypressed works correctly with windows again.
  32. | 2) ClrEol works correctly now with color.
  33. 2.07 | 01/31/00 | kjw | 1) Added NCRT_VERSION constants.
  34. | 2) Added prev_textattr to detect a change in
  35. | TextAttr value so current color gets updated.
  36. | 3) See ocrt.pp
  37. 2.08 | 06/09/00 | kjw | See ocrt.pp
  38. 2.08.01 | 06/11/2000 | kjw | See ocrt.pp
  39. 2.09.00 | 06/16/2000 | kjw | See ocrt.pp
  40. 2.10.00 | 06/16/2000 | kjw | See ocrt.pp
  41. 2.11.00 | 06/27/2000 | kjw
  42. | 1) See ocrt.pp
  43. | 2) Now uses ncurses for CrtRead so console control characters
  44. | work correctly (i.e., <ctrl/h>, <backspace>, etc.).
  45. 2.12.00 | 06/29/2000 | kjw | See ocrt.pp
  46. 2.13.00 | 06/30/2000 | kjw
  47. | Added nStop and nStart procedures.
  48. 2.14.00 | 07/05/2000 | kjw
  49. | 1) Added nCursor and nEscDelay functions.
  50. | 2) Added nInit and moved code from ncrt.pp & ocrt.pp to it.
  51. | 3) KEY_ALTMINUS & KEYALTEQUAL were reversed, but mapping ended
  52. | up correct.
  53. 2.15.00 | 1) Added nMaxRows & nMaxCols constants.
  54. | 2) See ocrt.pp
  55. 2.16.00 | 08/14/2000 | kjw | See ocrt.pp
  56. | 08/24/2000 | kjw |
  57. | 1) Added nTermName.
  58. | 2) Added CursesFailed.
  59. | 3) Moved all common initialization code to nInit.
  60. | 4) prev_textattr more reliable.
  61. ------------------------------------------------------------------------------
  62. }
  63. Procedure AssignCrt(var F: Text);
  64. Procedure ClrEol;
  65. Procedure ClrScr;
  66. Procedure ClrBot;
  67. Procedure Delay(DTime: Word);
  68. Procedure DelLine;
  69. Procedure GotoXY(x,y : integer);
  70. Procedure HighVideo;
  71. Procedure InsLine;
  72. Function Keypressed : boolean;
  73. Procedure LowVideo;
  74. Procedure NormVideo;
  75. Procedure NoSound;
  76. Function Readkey : char;
  77. Procedure Sound(hz : word);
  78. Procedure TextBackground(att : byte);
  79. Procedure TextColor(att : byte);
  80. Procedure TextMode(mode : word);
  81. Function WhereX : integer;
  82. Function WhereY : integer;
  83. Procedure Window(x,y,x1,y1 : integer);
  84. Procedure nStop;
  85. Procedure nStart;
  86. Function nCursor(c : integer) : integer;
  87. Function nEscDelay(d : longint) : longint;
  88. Function nTermName : string;
  89. Const
  90. NCRT_VERSION_MAJOR = 2;
  91. NCRT_VERSION_MINOR = 16;
  92. NCRT_VERSION_PATCH = 0;
  93. NCRT_VERSION = '2.16.00';
  94. { CRT modes }
  95. BW40 = 0; { 40x25 B/W on Color Adapter }
  96. CO40 = 1; { 40x25 Color on Color Adapter }
  97. BW80 = 2; { 80x25 B/W on Color Adapter }
  98. CO80 = 3; { 80x25 Color on Color Adapter }
  99. Mono = 7; { 80x25 on Monochrome Adapter }
  100. Font8x8 = 256; { Add-in for ROM font }
  101. { Mode constants for 3.0 compatibility }
  102. C40 = CO40;
  103. C80 = CO80;
  104. Black = 0;
  105. Blue = 1;
  106. Green = 2;
  107. Cyan = 3;
  108. Red = 4;
  109. Magenta = 5;
  110. Brown = 6;
  111. LightGray = 7;
  112. DarkGray = 8;
  113. LightBlue = 9;
  114. LightGreen = 10;
  115. LightCyan = 11;
  116. LightRed = 12;
  117. LightMagenta = 13;
  118. Yellow = 14;
  119. White = 15;
  120. Blink = 128;
  121. TextAttr : Byte = $07;
  122. LastMode : Word = 3;
  123. WindMin : Word = $0;
  124. WindMax : Word = $184f;
  125. { support for the alt'd characters }
  126. { these get initialized by StartCurses }
  127. KEY_ALTA = 465; { alt/a }
  128. KEY_ALTB = 466;
  129. KEY_ALTC = 467;
  130. KEY_ALTD = 468;
  131. KEY_ALTE = 469;
  132. KEY_ALTF = 470;
  133. KEY_ALTG = 471;
  134. KEY_ALTH = 472;
  135. KEY_ALTI = 473;
  136. KEY_ALTJ = 474;
  137. KEY_ALTK = 475;
  138. KEY_ALTL = 476;
  139. KEY_ALTM = 477;
  140. KEY_ALTN = 478;
  141. KEY_ALTO = 479;
  142. KEY_ALTP = 480;
  143. KEY_ALTQ = 481;
  144. KEY_ALTR = 482;
  145. KEY_ALTS = 483;
  146. KEY_ALTT = 484;
  147. KEY_ALTU = 485;
  148. KEY_ALTV = 486;
  149. KEY_ALTW = 487;
  150. KEY_ALTX = 488;
  151. KEY_ALTY = 489;
  152. KEY_ALTZ = 490; { alt/z }
  153. KEY_ALT1 = 491; { alt/1 }
  154. KEY_ALT2 = 492; { alt/2 }
  155. KEY_ALT3 = 493; { alt/3 }
  156. KEY_ALT4 = 494; { alt/4 }
  157. KEY_ALT5 = 495; { alt/5 }
  158. KEY_ALT6 = 496; { alt/6 }
  159. KEY_ALT7 = 497; { alt/7 }
  160. KEY_ALT8 = 498; { alt/8 }
  161. KEY_ALT9 = 499; { alt/9 }
  162. KEY_ALT0 = 500; { alt/0 }
  163. KEY_ALTMINUS = 501; { alt/- }
  164. KEY_ALTEQUAL = 502; { alt/= }
  165. KEY_ALTTAB = 503; { alt/tab }
  166. { cursor type }
  167. cOFF = 0; { invisible cursor }
  168. cON = 1; { normal cursor }
  169. cBIG = 2; { very visible cursor }
  170. { fullscreen size }
  171. nMaxRows : word = 25; { reset at startup to terminal setting }
  172. nMaxCols : word = 80; { for columns and rows }
  173. var
  174. CheckBreak,
  175. CheckEOF,
  176. CheckSnow,
  177. DirectVideo: Boolean;
  178. Implementation
  179. uses strings;
  180. Const
  181. { standard file descriptors }
  182. STDIN = 0;
  183. STDOUT = 1;
  184. STDERR = 2;
  185. Var
  186. ExitSave : pointer; { pointer to original exit proc }
  187. fg,bg : integer; { foreground & background }
  188. cp : array [0..7,0..7] of integer; { color pair array }
  189. ps : array [0..255] of char; { for use with pchars }
  190. doRefresh : boolean; { immediate refresh toggle }
  191. SubWn, { window created from window() }
  192. PrevWn, { previous window when active changes }
  193. ActiveWn : pwindow; { current active window for stdout }
  194. tmp_b : boolean;
  195. isEcho : boolean; { keeps track of echo status }
  196. MaxRows, { set at startup to terminal values }
  197. MaxCols : longint; { for columns and rows }
  198. tios : TermIOS; { saves the term settings at startup }
  199. prev_textattr : integer; { detect change in TextAttr }
  200. {==========================================================================}
  201. { set the active window for write(ln), read(ln) }
  202. Procedure SetActiveWn(win : pwindow);
  203. Begin
  204. If win <> ActiveWn Then PrevWn := ActiveWn;
  205. { don't set to a nil window! }
  206. If win <> Nil Then
  207. ActiveWn := win
  208. Else
  209. ActiveWn := stdscr;
  210. End;
  211. {--------------------------------------------
  212. initialize ncurses screen & keyboard, and
  213. return a pointer to stdscr.
  214. NOTE: This is done at unit initialization.
  215. --------------------------------------------}
  216. Function StartCurses(var win : pWindow) : Boolean;
  217. Var
  218. i : integer;
  219. s : string[3];
  220. Begin
  221. { save the current terminal settings }
  222. tcGetAttr(STDIN,tios);
  223. if initscr=Nil then Begin
  224. StartCurses := false;
  225. win := nil;
  226. Exit;
  227. End Else Begin
  228. StartCurses := true;
  229. start_color;
  230. cbreak; { disable keyboard buffering }
  231. raw; { disable flow control, etc. }
  232. echo; { echo keypresses }
  233. nonl; { don't process cr in newline }
  234. intrflush(stdscr,bool(false));
  235. keypad(stdscr,bool(true));
  236. scrollok(stdscr,bool(true));
  237. win := stdscr;
  238. isEcho := true;
  239. doRefresh := true;
  240. getmaxyx(stdscr,MaxRows,MaxCols);
  241. { make these values visible to apps }
  242. nMaxRows := MaxRows;
  243. nMaxCols := MaxCols;
  244. { define the the alt'd keysets for ncurses }
  245. { alt/a .. atl/z }
  246. for i := ord('a') to ord('z') do Begin
  247. s := #27+chr(i)+#0;
  248. define_key(@s[1],(KEY_ALTA-97)+i);
  249. End;
  250. { alt/1 .. alt/9 }
  251. for i := 1 to 9 do Begin
  252. s := #27+chr(i)+#0;
  253. define_key(@s[1],(KEY_ALT1-1)+i);
  254. End;
  255. s := #27+'0'+#0; define_key(@s[1],KEY_ALT0); { alt/0 }
  256. s := #27+'-'+#0; define_key(@s[1],KEY_ALTMINUS); { alt/- }
  257. s := #27+'='+#0; define_key(@s[1],KEY_ALTEQUAL); { alt/= }
  258. s := #27+#9+#0; define_key(@s[1],KEY_ALTTAB); { alt/tab }
  259. End;
  260. End;
  261. {----------------------------------
  262. Shutdown ncurses.
  263. NOTE: This is done via ExitProc.
  264. ----------------------------------}
  265. Procedure EndCurses;
  266. Begin
  267. { restore the original terminal settings }
  268. { and leave the screen how the app left it }
  269. tcSetAttr(STDIN,TCSANOW,tios);
  270. End;
  271. {--------------------------------------------------------
  272. This disables any curses activity until a refresh.
  273. Use this BEFORE any shelling (shell,exec,execv,etc)
  274. to put the terminal temporarily back into cooked mode.
  275. --------------------------------------------------------}
  276. Procedure nStop;
  277. Begin
  278. endwin;
  279. End;
  280. {---------------------------------------------
  281. Simply a refresh to re-establish the curses
  282. terminal settings following an nStop.
  283. ---------------------------------------------}
  284. Procedure nStart;
  285. Begin
  286. refresh;
  287. End;
  288. { see if the specified attribute is high intensity }
  289. Function nIsBold(att : integer) : boolean;
  290. Begin
  291. bg := att div 16;
  292. fg := att - (bg * 16);
  293. nisbold := (fg > 7);
  294. End;
  295. { map a curses color to an ibm color }
  296. Function c2ibm(c : integer) : integer;
  297. { ncurses constants
  298. COLOR_BLACK = 0;
  299. COLOR_RED = 1;
  300. COLOR_GREEN = 2;
  301. COLOR_YELLOW = 3;
  302. COLOR_BLUE = 4;
  303. COLOR_MAGENTA = 5;
  304. COLOR_CYAN = 6;
  305. COLOR_WHITE = 7;
  306. }
  307. Var
  308. att : integer;
  309. Begin
  310. Case c of
  311. COLOR_BLACK : att := black;
  312. COLOR_RED : att := red;
  313. COLOR_GREEN : att := green;
  314. COLOR_YELLOW : att := brown;
  315. COLOR_BLUE : att := blue;
  316. COLOR_MAGENTA : att := magenta;
  317. COLOR_CYAN : att := cyan;
  318. COLOR_WHITE : att := lightgray;
  319. else att := c;
  320. End;
  321. c2ibm := att;
  322. End;
  323. { map an ibm color to a curses color }
  324. Function ibm2c(c : integer) : integer;
  325. Var
  326. att : integer;
  327. Begin
  328. Case c of
  329. black : att := COLOR_BLACK;
  330. red : att := COLOR_RED;
  331. green : att := COLOR_GREEN;
  332. brown : att := COLOR_YELLOW;
  333. blue : att := COLOR_BLUE;
  334. magenta : att := COLOR_MAGENTA;
  335. cyan : att := COLOR_CYAN;
  336. lightgray : att := COLOR_WHITE;
  337. else att := c;
  338. End;
  339. ibm2c := att;
  340. End;
  341. { initialize a color pair }
  342. Function nSetColorPair(att : integer) : integer;
  343. var
  344. i : integer;
  345. Begin
  346. bg := att div 16;
  347. fg := att - (bg * 16);
  348. While bg > 7 Do dec(bg,8);
  349. While fg > 7 Do dec(fg,8);
  350. bg := ibm2c(bg);
  351. fg := ibm2c(fg);
  352. i := cp[bg,fg];
  353. init_pair(i,fg,bg);
  354. nSetColorPair := i;
  355. End;
  356. { map a standard color attribute to an ncurses attribute }
  357. Function CursesAtts(att : byte) : longint;
  358. Var
  359. atts : longint;
  360. Begin
  361. atts := COLOR_PAIR(nSetColorPair(att));
  362. If nIsBold(att) Then atts := atts or A_BOLD;
  363. If (att and $80) = $80 Then atts := atts or A_BLINK;
  364. CursesAtts := atts;
  365. End;
  366. {------------------------------------------------
  367. Delete a window.
  368. NOTE: This does not clear it from the display.
  369. ------------------------------------------------}
  370. Procedure nDelWindow(var win : pWindow);
  371. Begin
  372. If (win = stdscr) or (win = curscr) Then Exit;
  373. If win <> Nil Then delwin(win);
  374. win := Nil;
  375. If ActiveWn = Nil Then SetActiveWn(stdscr);
  376. End;
  377. {-----------------------------------------
  378. Set the current text color of a window,
  379. delayed until next refresh.
  380. -----------------------------------------}
  381. Procedure nWinColor(win : pWindow; att : integer);
  382. Begin
  383. wattrset(win,CursesAtts(att));
  384. prev_textattr := att;
  385. End;
  386. { clear the specified window }
  387. procedure nClrScr(win : pWindow; att : integer);
  388. Begin
  389. wbkgd(win,CursesAtts(att));
  390. TouchWin(win);
  391. werase(win);
  392. If doRefresh Then wrefresh(win);
  393. prev_textattr := att;
  394. End;
  395. { clear from the cursor to the end of line in a window }
  396. Procedure nClrEol(win : pWindow);
  397. Var
  398. tmp : pwindow;
  399. x,y,
  400. xb,yb,
  401. xm,ym : longint;
  402. Begin
  403. {--------------------------------------------------------
  404. In order to have the correct color, we must define and
  405. clear a temporary window. ncurses wclrtoeol() uses the
  406. window background color rather that the current color
  407. attribute ;-(
  408. --------------------------------------------------------}
  409. getyx(win,y,x);
  410. getbegyx(win,yb,xb);
  411. getmaxyx(win,ym,xm);
  412. tmp := subwin(win,1,xm-x,yb+y,xb+x);
  413. If tmp = nil then Exit;
  414. wbkgd(tmp,CursesAtts(TextAttr));
  415. werase(tmp);
  416. { wclrtoeol(win);}
  417. If doRefresh Then wrefresh(tmp);
  418. delwin(tmp);
  419. End;
  420. { clear from the cursor to the bottom in a window }
  421. Procedure nClrBot(win : pWindow);
  422. Begin
  423. wclrtobot(win);
  424. If doRefresh Then wrefresh(win);
  425. End;
  426. { insert a line at the cursor line in a window }
  427. Procedure nInsLine(win : pWindow);
  428. Begin
  429. winsertln(win);
  430. If doRefresh Then wrefresh(win);
  431. End;
  432. { delete line at the cursor in a window }
  433. Procedure nDelLine(win : pWindow);
  434. Begin
  435. wdeleteln(win);
  436. If doRefresh Then wrefresh(win);
  437. End;
  438. { position cursor in a window }
  439. Procedure nGotoXY(win : pWindow; x,y : integer);
  440. Begin
  441. wmove(win,y-1,x-1);
  442. touchwin(win);
  443. If doRefresh Then wrefresh(win);
  444. End;
  445. { find cursor x position in a window }
  446. Function nWhereX(win : pWindow) : integer;
  447. var x,y : longint;
  448. Begin
  449. getyx(win,y,x);
  450. nWhereX := x+1;
  451. End;
  452. { find cursor y position in a window }
  453. Function nWhereY(win : pWindow) : integer;
  454. var x,y : longint;
  455. Begin
  456. getyx(win,y,x);
  457. nWhereY := y+1;
  458. End;
  459. {---------------------------------------------------------------------
  460. read a keystroke from a window, including function keys and extended
  461. keys (arrows, etc.)
  462. Note: Make sure that keypad(win,true) has been issued prior to use.
  463. ( nWindow does this )
  464. ---------------------------------------------------------------------}
  465. Function nReadkey(win : pWindow) : char;
  466. var
  467. c : char;
  468. l : longint;
  469. xtnded : boolean;
  470. Begin
  471. l := wgetch(win);
  472. { if it's an extended key, then map to the IBM values }
  473. if l > 255 then begin
  474. xtnded := true;
  475. c := #27;
  476. Case l of
  477. KEY_BREAK : Begin xtnded := false; c := #3; End;
  478. KEY_BACKSPACE : Begin xtnded := false; c := #8; End;
  479. KEY_IC : c := #82; { insert }
  480. KEY_DC : c := #83; { delete }
  481. KEY_HOME : c := #71; { home }
  482. KEY_END : c := #79; { end }
  483. KEY_UP : c := #72; { up arrow }
  484. KEY_DOWN : c := #80; { down arrow }
  485. KEY_LEFT : c := #75; { left arrow }
  486. KEY_RIGHT : c := #77; { right arrow }
  487. KEY_NPAGE : c := #81; { page down }
  488. KEY_PPAGE : c := #73; { page up }
  489. KEY_ALTA : c := #30; { alt/a }
  490. KEY_ALTB : c := #48;
  491. KEY_ALTC : c := #46;
  492. KEY_ALTD : c := #32;
  493. KEY_ALTE : c := #18;
  494. KEY_ALTF : c := #33;
  495. KEY_ALTG : c := #34;
  496. KEY_ALTH : c := #35;
  497. KEY_ALTI : c := #23;
  498. KEY_ALTJ : c := #36;
  499. KEY_ALTK : c := #37;
  500. KEY_ALTL : c := #38;
  501. KEY_ALTM : c := #50;
  502. KEY_ALTN : c := #49;
  503. KEY_ALTO : c := #24;
  504. KEY_ALTP : c := #25;
  505. KEY_ALTQ : c := #16;
  506. KEY_ALTR : c := #19;
  507. KEY_ALTS : c := #31;
  508. KEY_ALTT : c := #20;
  509. KEY_ALTU : c := #22;
  510. KEY_ALTV : c := #47;
  511. KEY_ALTW : c := #17;
  512. KEY_ALTX : c := #45;
  513. KEY_ALTY : c := #21;
  514. KEY_ALTZ : c := #44; { alt/z }
  515. KEY_ALT1 : c := #120; { alt/1 }
  516. KEY_ALT2 : c := #121; { alt/2 }
  517. KEY_ALT3 : c := #122; { alt/3 }
  518. KEY_ALT4 : c := #123; { alt/4 }
  519. KEY_ALT5 : c := #124; { alt/5 }
  520. KEY_ALT6 : c := #125; { alt/6 }
  521. KEY_ALT7 : c := #126; { alt/7 }
  522. KEY_ALT8 : c := #127; { alt/8 }
  523. KEY_ALT9 : c := #128; { alt/9 }
  524. KEY_ALT0 : c := #129; { alt/0 }
  525. KEY_ALTMINUS : c := #130; { alt/- }
  526. KEY_ALTEQUAL : c := #131; { alt/= }
  527. KEY_ALTTAB : c := #15; { alt/tab }
  528. Else
  529. Begin
  530. If l = Key_f(1) Then c := #59 Else
  531. If l = Key_f(2) Then c := #60 Else
  532. If l = Key_f(3) Then c := #61 Else
  533. If l = Key_f(4) Then c := #62 Else
  534. If l = Key_f(5) Then c := #63 Else
  535. If l = Key_f(6) Then c := #64 Else
  536. If l = Key_f(7) Then c := #65 Else
  537. If l = Key_f(8) Then c := #66 Else
  538. If l = Key_f(9) Then c := #67 Else
  539. If l = Key_f(10) Then c := #68 Else
  540. If l = Key_f(11) Then c := #84 Else
  541. If l = Key_f(12) Then c := #85 Else
  542. If l = Key_f(13) Then c := #86 Else
  543. If l = Key_f(14) Then c := #87 Else
  544. If l = Key_f(15) Then c := #88 Else
  545. If l = Key_f(16) Then c := #89 Else
  546. If l = Key_f(17) Then c := #90 Else
  547. If l = Key_f(18) Then c := #91 Else
  548. If l = Key_f(19) Then c := #92 Else
  549. If l = Key_f(20) Then c := #93;
  550. End;
  551. End;
  552. If xtnded Then Begin
  553. nReadKey := #0;
  554. ungetch(ord(c));
  555. Exit;
  556. End Else
  557. nReadkey := c;
  558. End Else
  559. nReadkey := chr(ord(l));
  560. End;
  561. { write a string to a window at the current cursor position }
  562. Procedure nWrite(win : pWindow; s : string);
  563. Begin
  564. If TextAttr <> prev_textattr Then
  565. nWinColor(win,TextAttr);
  566. waddstr(win,StrPCopy(ps,s));
  567. If doRefresh Then wrefresh(win);
  568. End;
  569. {=========================================================================
  570. CrtWrite, CrtRead, CrtReturn, CrtClose, CrtOpen, AssignCrt.
  571. These functions come from the FPC distribution rtl/linux/crt unit.
  572. These are the hooks into the input/output stream needed for write(ln)
  573. and read(ln).
  574. =========================================================================}
  575. { used by CrtWrite }
  576. Procedure DoWrite(temp : string);
  577. Begin
  578. nWrite(ActiveWn,temp);
  579. End;
  580. Function CrtWrite(Var F: TextRec): Integer;
  581. {
  582. Top level write function for CRT
  583. }
  584. Var
  585. Temp : String;
  586. idx,i : Longint;
  587. { oldflush : boolean;}
  588. Begin
  589. { oldflush:=ttySetFlush(Flushing);}
  590. idx:=0;
  591. while (F.BufPos>0) do
  592. begin
  593. i:=F.BufPos;
  594. if i>255 then
  595. i:=255;
  596. system.Move(F.BufPTR^[idx],Temp[1],F.BufPos);
  597. Temp[0]:=Chr(i);
  598. DoWrite(Temp);
  599. dec(F.BufPos,i);
  600. inc(idx,i);
  601. end;
  602. { ttySetFlush(oldFLush);}
  603. CrtWrite:=0;
  604. End;
  605. Function CrtRead(Var F: TextRec): Integer;
  606. {
  607. Read from CRT associated file.
  608. }
  609. Begin
  610. { let's use ncurses instead! }
  611. FillChar(F.BufPtr^, F.BufSize, #0);
  612. wgetnstr(ActiveWn,F.BufPtr^, F.BufSize-1);
  613. F.BufEnd := Length(StrPas(F.BufPtr^))+1;
  614. F.BufPtr^[F.BufEnd-1] := #10;
  615. F.BufPos:=0;
  616. { CrtWrite(F);}
  617. CrtRead:=0;
  618. End;
  619. Function CrtReturn(Var F:TextRec):Integer;
  620. Begin
  621. F.BufEnd := 0;
  622. F.BufPos:= 0;
  623. CrtReturn:=0;
  624. end;
  625. Function CrtClose(Var F: TextRec): Integer;
  626. {
  627. Close CRT associated file.
  628. }
  629. Begin
  630. F.Mode:=fmClosed;
  631. CrtClose:=0;
  632. End;
  633. Function CrtOpen(Var F: TextRec): Integer;
  634. {
  635. Open CRT associated file.
  636. }
  637. Begin
  638. If F.Mode=fmOutput Then
  639. begin
  640. TextRec(F).InOutFunc:=@CrtWrite;
  641. TextRec(F).FlushFunc:=@CrtWrite;
  642. end
  643. Else
  644. begin
  645. F.Mode:=fmInput;
  646. TextRec(F).InOutFunc:=@CrtRead;
  647. TextRec(F).FlushFunc:=@CrtReturn;
  648. end;
  649. TextRec(F).CloseFunc:=@CrtClose;
  650. CrtOpen:=0;
  651. End;
  652. procedure AssignCrt(var F: Text);
  653. {
  654. Assign a file to the console. All output on file goes to console instead.
  655. }
  656. begin
  657. Assign(F,'');
  658. TextRec(F).OpenFunc:=@CrtOpen;
  659. end;
  660. {==========================================================================
  661. Standard crt unit replacements
  662. ==========================================================================}
  663. { set the text background color }
  664. Procedure TextBackground(att : byte);
  665. Begin
  666. TextAttr:=
  667. ((att shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
  668. nWinColor(ActiveWn,TextAttr);
  669. End;
  670. { set the text foreground color }
  671. Procedure TextColor(att : byte);
  672. Begin
  673. TextAttr := (att and $8f) or (TextAttr and $70);
  674. nWinColor(ActiveWn,TextAttr);
  675. End;
  676. { set to high intensity }
  677. Procedure HighVideo;
  678. Begin
  679. TextColor(TextAttr Or $08);
  680. End;
  681. { set to low intensity }
  682. Procedure LowVideo;
  683. Begin
  684. TextColor(TextAttr And $77);
  685. End;
  686. { set to normal display colors }
  687. Procedure NormVideo;
  688. Begin
  689. TextColor(7);
  690. TextBackGround(0);
  691. End;
  692. { clear stdscr }
  693. Procedure ClrScr;
  694. Begin
  695. nClrScr(ActiveWn,TextAttr);
  696. End;
  697. { clear from the cursor to the end of line in stdscr }
  698. Procedure ClrEol;
  699. Begin
  700. nClrEol(ActiveWn);
  701. End;
  702. { clear from the cursor to the bottom of stdscr }
  703. Procedure ClrBot;
  704. Begin
  705. nClrBot(ActiveWn);
  706. End;
  707. { insert a line at the cursor line in stdscr }
  708. Procedure InsLine;
  709. Begin
  710. nInsLine(ActiveWn);
  711. End;
  712. { delete line at the cursor in stdscr }
  713. Procedure DelLine;
  714. Begin
  715. nDelLine(ActiveWn);
  716. End;
  717. { position cursor in stdscr }
  718. Procedure GotoXY(x,y : integer);
  719. Begin
  720. nGotoXY(ActiveWn,x,y);
  721. End;
  722. { find cursor x position in stdscr }
  723. Function WhereX : integer;
  724. Begin
  725. WhereX := nWhereX(ActiveWn);
  726. End;
  727. { find cursor y position in stdscr }
  728. Function WhereY : integer;
  729. Begin
  730. WhereY := nWhereY(ActiveWn);
  731. End;
  732. { Wait for DTime milliseconds }
  733. Procedure Delay(DTime: Word);
  734. Begin
  735. fpselect(0,nil,nil,nil,DTime);
  736. End;
  737. { create a new subwindow of stdscr }
  738. Procedure Window(x,y,x1,y1 : integer);
  739. Begin
  740. nDelWindow(SubWn);
  741. SubWn := subwin(stdscr,y1-y+1,x1-x+1,y-1,x-1);
  742. If SubWn = nil then Exit;
  743. intrflush(SubWn,bool(false));
  744. keypad(SubWn,bool(true));
  745. scrollok(SubWn,bool(true));
  746. SetActiveWn(SubWn);
  747. GotoXY(1,1);
  748. End;
  749. {------------------------------------------------------
  750. Check if a key has been pressed.
  751. Note: this is best used along with select() on STDIN,
  752. as it can suck up lots of cpu time.
  753. Better yet, use nKeypressed instead if you don't need
  754. to include file descriptors other than STDIN.
  755. ------------------------------------------------------}
  756. function Keypressed : boolean;
  757. var
  758. l : longint;
  759. { fd : fdSet;}
  760. Begin
  761. Keypressed := FALSE;
  762. nodelay(ActiveWn,bool(TRUE));
  763. l := wgetch(ActiveWn);
  764. If l <> ERR Then Begin { ERR = -(1) from unit ncurses }
  765. ungetch(l);
  766. Keypressed := TRUE;
  767. End;
  768. nodelay(ActiveWn,bool(FALSE));
  769. { Below is more efficient code, but does not work well with
  770. nReadkey & extended keys because nReadkey's ungetch does not
  771. force a change in STDIN. So, a "while keypressed" block does
  772. not produce the expected results when trapping for char(0)
  773. followed by a second scan code.
  774. FD_Zero(fd);
  775. fd_Set(STDIN,fd);
  776. Keypressed := (Select(STDIN+1,@fd,nil,nil,0) > 0);
  777. }
  778. End;
  779. { silently read a key from stdscr }
  780. Function Readkey : char;
  781. Begin
  782. tmp_b := IsEcho;
  783. noecho;
  784. Readkey := nReadkey(ActiveWn);
  785. If tmp_b Then echo;
  786. End;
  787. { a cheap replacement! }
  788. Procedure Sound(hz : word);
  789. Begin
  790. Beep;
  791. wrefresh(ActiveWn);
  792. End;
  793. Procedure NoSound;
  794. Begin
  795. End;
  796. Procedure TextMode(mode : word);
  797. Begin
  798. nDelWindow(SubWn);
  799. SetActiveWn(stdscr);
  800. LastMode := mode;
  801. DirectVideo := true;
  802. CheckSnow := true;
  803. NormVideo;
  804. ClrScr;
  805. End;
  806. { Set the cursor visibility. Returns the previous value }
  807. { or (-1) if value c is not supported by the terminal. }
  808. Function nCursor(c : integer) : integer;
  809. Begin
  810. nCursor := curs_set(c);
  811. End;
  812. { Set the <esc> key delay time in milliseconds. }
  813. { Use d=(-1) to return current value without updating. }
  814. Function nEscDelay(d : longint) : longint;
  815. Begin
  816. nEscDelay := ESCDELAY;
  817. If d >= 0 Then ESCDELAY := d;
  818. End;
  819. { return the current terminal name (same as $TERM env variable) }
  820. Function nTermName : string;
  821. Begin
  822. nTermName := StrPas(termname);
  823. End;
  824. { could not initialize ncurses }
  825. Procedure CursesFailed;
  826. Begin
  827. { give 'em a clue! }
  828. Writeln('StartCurses() failed');
  829. Halt;
  830. End;
  831. { exit procedure to ensure curses is closed up cleanly }
  832. Procedure nExit;
  833. Begin
  834. ExitProc := ExitSave;
  835. EndCurses;
  836. End;
  837. Procedure nInit;
  838. Begin
  839. { set the unit exit procedure }
  840. ExitSave := ExitProc;
  841. ExitProc := @nExit;
  842. { load the color pairs array with color pair indices (0..63 }
  843. For bg := 0 to 7 Do For fg := 0 to 7 do cp[bg,fg] := (bg*8)+fg;
  844. { initial window pointers }
  845. SubWn := nil;
  846. PrevWn := ActiveWn;
  847. { basic gray on black screen }
  848. TextMode(LastMode);
  849. { Redirect the standard output }
  850. assigncrt(Output);
  851. Rewrite(Output);
  852. TextRec(Output).Handle:=StdOutputHandle;
  853. { Redirect the standard input }
  854. assigncrt(Input);
  855. Reset(Input);
  856. TextRec(Input).Handle:=StdInputHandle;
  857. { some defaults }
  858. nEscDelay(500); { default is 1000 (1 second) }
  859. nCursor(cON); { normal cursor }
  860. End;