ncrt.inc 25 KB

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