ncrt.inc 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805
  1. {---------------------------------------------------------------------------
  2. CncWare
  3. (c) Copyright 1999
  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. ------------------------------------------------------------------------------
  34. }
  35. Procedure AssignCrt(var F: Text);
  36. Procedure ClrEol;
  37. Procedure ClrScr;
  38. Procedure ClrBot;
  39. Procedure Delay(DTime: Word);
  40. Procedure DelLine;
  41. Procedure GotoXY(x,y : integer);
  42. Procedure HighVideo;
  43. Procedure InsLine;
  44. Function Keypressed : boolean;
  45. Procedure LowVideo;
  46. Procedure NormVideo;
  47. Procedure NoSound;
  48. Function Readkey : char;
  49. Procedure Sound(hz : word);
  50. Procedure TextBackground(att : byte);
  51. Procedure TextColor(att : byte);
  52. Procedure TextMode(mode : word);
  53. Function WhereX : integer;
  54. Function WhereY : integer;
  55. Procedure Window(x,y,x1,y1 : integer);
  56. Const
  57. { CRT modes }
  58. BW40 = 0; { 40x25 B/W on Color Adapter }
  59. CO40 = 1; { 40x25 Color on Color Adapter }
  60. BW80 = 2; { 80x25 B/W on Color Adapter }
  61. CO80 = 3; { 80x25 Color on Color Adapter }
  62. Mono = 7; { 80x25 on Monochrome Adapter }
  63. Font8x8 = 256; { Add-in for ROM font }
  64. { Mode constants for 3.0 compatibility }
  65. C40 = CO40;
  66. C80 = CO80;
  67. Black = 0;
  68. Blue = 1;
  69. Green = 2;
  70. Cyan = 3;
  71. Red = 4;
  72. Magenta = 5;
  73. Brown = 6;
  74. LightGray = 7;
  75. DarkGray = 8;
  76. LightBlue = 9;
  77. LightGreen = 10;
  78. LightCyan = 11;
  79. LightRed = 12;
  80. LightMagenta = 13;
  81. Yellow = 14;
  82. White = 15;
  83. Blink = 128;
  84. TextAttr : Byte = $07;
  85. LastMode : Word = 3;
  86. WindMin : Word = $0;
  87. WindMax : Word = $184f;
  88. { support for the alt'd characters }
  89. { these get initialized by StartCurses }
  90. KEY_ALTA = 465; { alt/a }
  91. KEY_ALTB = 466;
  92. KEY_ALTC = 467;
  93. KEY_ALTD = 468;
  94. KEY_ALTE = 469;
  95. KEY_ALTF = 470;
  96. KEY_ALTG = 471;
  97. KEY_ALTH = 472;
  98. KEY_ALTI = 473;
  99. KEY_ALTJ = 474;
  100. KEY_ALTK = 475;
  101. KEY_ALTL = 476;
  102. KEY_ALTM = 477;
  103. KEY_ALTN = 478;
  104. KEY_ALTO = 479;
  105. KEY_ALTP = 480;
  106. KEY_ALTQ = 481;
  107. KEY_ALTR = 482;
  108. KEY_ALTS = 483;
  109. KEY_ALTT = 484;
  110. KEY_ALTU = 485;
  111. KEY_ALTV = 486;
  112. KEY_ALTW = 487;
  113. KEY_ALTX = 488;
  114. KEY_ALTY = 489;
  115. KEY_ALTZ = 490; { alt/z }
  116. KEY_ALT1 = 491; { alt/1 }
  117. KEY_ALT2 = 492; { alt/2 }
  118. KEY_ALT3 = 493; { alt/3 }
  119. KEY_ALT4 = 494; { alt/4 }
  120. KEY_ALT5 = 495; { alt/5 }
  121. KEY_ALT6 = 496; { alt/6 }
  122. KEY_ALT7 = 497; { alt/7 }
  123. KEY_ALT8 = 498; { alt/8 }
  124. KEY_ALT9 = 499; { alt/9 }
  125. KEY_ALT0 = 500; { alt/0 }
  126. KEY_ALTEQUAL = 501; { alt/- }
  127. KEY_ALTMINUS = 502; { alt/= }
  128. KEY_ALTTAB = 503; { alt/tab }
  129. var
  130. CheckBreak,
  131. CheckEOF,
  132. CheckSnow,
  133. DirectVideo: Boolean;
  134. Implementation
  135. uses strings;
  136. Const
  137. { standard file descriptors }
  138. STDIN = 0;
  139. STDOUT = 1;
  140. STDERR = 2;
  141. Var
  142. ExitSave : pointer; { pointer to original exit proc }
  143. fg,bg : integer; { foreground & background }
  144. cp : array [0..7,0..7] of integer; { color pair array }
  145. ps : array [0..255] of char; { for use with pchars }
  146. doRefresh : boolean; { immediate refresh toggle }
  147. SubWn, { window created from window() }
  148. ActiveWn : pwindow; { current active window for stdout }
  149. tmp_b : boolean;
  150. isEcho : boolean; { keeps track of echo status }
  151. MaxRows, { set at startup to terminal values }
  152. MaxCols : longint; { for columns and rows }
  153. tios : TermIOS; { saves the term settings at startup }
  154. {==========================================================================
  155. This code chunk is from the FPC source tree in rtl/inc/textrec.inc.
  156. It is the internal format of a variable of type "Text" as defined and
  157. described in the Borland Pascal docs.
  158. ==========================================================================}
  159. const
  160. TextRecNameLength = 256;
  161. TextRecBufSize = 256;
  162. type
  163. TextBuf = array[0..TextRecBufSize-1] of char;
  164. TextRec = Packed Record
  165. Handle,
  166. Mode,
  167. bufsize,
  168. _private,
  169. bufpos,
  170. bufend : longint;
  171. bufptr : ^textbuf;
  172. openfunc,
  173. inoutfunc,
  174. flushfunc,
  175. closefunc : pointer;
  176. UserData : array[1..16] of byte;
  177. name : array[0..textrecnamelength-1] of char;
  178. buffer : textbuf;
  179. End;
  180. {==========================================================================}
  181. {--------------------------------------------
  182. initialize ncurses screen & keyboard, and
  183. return a pointer to stdscr.
  184. NOTE: This is done at unit initialization.
  185. --------------------------------------------}
  186. Function StartCurses(var win : pWindow) : Boolean;
  187. Var
  188. i : integer;
  189. s : string[3];
  190. Begin
  191. { save the current terminal settings }
  192. tcGetAttr(STDIN,tios);
  193. if initscr=Nil then Begin
  194. StartCurses := false;
  195. Exit;
  196. End Else Begin
  197. StartCurses := true;
  198. start_color;
  199. cbreak; { disable keyboard buffering }
  200. raw; { disable flow control, etc. }
  201. echo; { echo keypresses }
  202. nonl; { don't process cr in newline }
  203. intrflush(stdscr,bool(false));
  204. keypad(stdscr,bool(true));
  205. scrollok(stdscr,bool(true));
  206. win := stdscr;
  207. isEcho := true;
  208. doRefresh := true;
  209. getmaxyx(stdscr,MaxRows,MaxCols);
  210. { define the the alt'd keysets for ncurses }
  211. { alt/a .. atl/z }
  212. for i := ord('a') to ord('z') do Begin
  213. s := #27+chr(i)+#0;
  214. define_key(@s[1],400+i-32);
  215. End;
  216. { alt/1 .. alt/9 }
  217. for i := 1 to 9 do Begin
  218. s := #27+chr(i)+#0;
  219. define_key(@s[1],490+i);
  220. End;
  221. s := #27+'0'+#0; define_key(@s[1],500); { alt/0 }
  222. s := #27+'-'+#0; define_key(@s[1],501); { alt/- }
  223. s := #27+'='+#0; define_key(@s[1],502); { alt/= }
  224. s := #27+#9+#0; define_key(@s[1],503); { alt/tab }
  225. End;
  226. End;
  227. {----------------------------------
  228. Shutdown ncurses.
  229. NOTE: This is done via ExitProc.
  230. ----------------------------------}
  231. Procedure EndCurses;
  232. Begin
  233. { restore the original terminal settings }
  234. { and leave the screen how the app left it }
  235. tcSetAttr(STDIN,TCSANOW,tios);
  236. End;
  237. { see if the specified attribute is high intensity }
  238. Function IsBold(att : integer) : boolean;
  239. Begin
  240. bg := att div 16;
  241. fg := att - (bg * 16);
  242. isbold := (fg > 7);
  243. End;
  244. { initialize a color pair }
  245. Function SetColorPair(att : integer) : integer;
  246. var
  247. i : integer;
  248. { ncurses constants
  249. COLOR_BLACK = 0;
  250. COLOR_RED = 1;
  251. COLOR_GREEN = 2;
  252. COLOR_YELLOW = 3;
  253. COLOR_BLUE = 4;
  254. COLOR_MAGENTA = 5;
  255. COLOR_CYAN = 6;
  256. COLOR_WHITE = 7;
  257. }
  258. Begin
  259. bg := att div 16;
  260. fg := att - ((att div 16) * 16);
  261. While bg > 7 Do dec(bg,8);
  262. While fg > 7 Do dec(fg,8);
  263. { map to ncurses color values }
  264. case bg of
  265. 0 : bg := COLOR_BLACK;
  266. 1 : bg := COLOR_BLUE;
  267. 2 : bg := COLOR_GREEN;
  268. 3 : bg := COLOR_CYAN;
  269. 4 : bg := COLOR_RED;
  270. 5 : bg := COLOR_MAGENTA;
  271. 6 : bg := COLOR_YELLOW;
  272. 7 : bg := COLOR_WHITE;
  273. end;
  274. case fg of
  275. 0 : fg := COLOR_BLACK;
  276. 1 : fg := COLOR_BLUE;
  277. 2 : fg := COLOR_GREEN;
  278. 3 : fg := COLOR_CYAN;
  279. 4 : fg := COLOR_RED;
  280. 5 : fg := COLOR_MAGENTA;
  281. 6 : fg := COLOR_YELLOW;
  282. 7 : fg := COLOR_WHITE;
  283. end;
  284. i := cp[bg,fg];
  285. init_pair(i,fg,bg);
  286. SetColorPair := i;
  287. End;
  288. { map a standard color attribute to an ncurses attribute }
  289. Function CursesAtts(att : byte) : longint;
  290. Var
  291. atts : longint;
  292. Begin
  293. atts := COLOR_PAIR(SetColorPair(att));
  294. If IsBold(att) Then atts := atts or A_BOLD;
  295. If (att and $80) = $80 Then atts := atts or A_BLINK;
  296. CursesAtts := atts;
  297. End;
  298. {------------------------------------------------
  299. Delete a window.
  300. NOTE: This does not clear it from the display.
  301. ------------------------------------------------}
  302. Procedure nDelWindow(var win : pWindow);
  303. Begin
  304. If (win = stdscr) or (win = curscr) Then Exit;
  305. If win <> Nil Then delwin(win);
  306. win := Nil;
  307. If ActiveWn = Nil Then ActiveWn := stdscr;
  308. End;
  309. {-----------------------------------------
  310. Set the current text color of a window,
  311. delayed until next refresh.
  312. -----------------------------------------}
  313. Procedure nWinColor(win : pWindow; att : integer);
  314. Begin
  315. wattr_set(win,CursesAtts(att));
  316. End;
  317. { clear the specified window }
  318. procedure nClrScr(win : pWindow; att : integer);
  319. Begin
  320. wbkgd(win,CursesAtts(att));
  321. TouchWin(win);
  322. werase(win);
  323. If doRefresh Then wrefresh(win);
  324. End;
  325. { clear from the cursor to the end of line in a window }
  326. Procedure nClrEol(win : pWindow);
  327. Var
  328. tmp : pwindow;
  329. x,y,
  330. xb,yb,
  331. xm,ym : longint;
  332. Begin
  333. {--------------------------------------------------------
  334. In order to have the correct color, we must define and
  335. clear a temporary window. ncurses wclrtoeol() uses the
  336. window background color rather that the current color
  337. attribute ;-(
  338. --------------------------------------------------------}
  339. getyx(win,y,x);
  340. getbegyx(win,yb,xb);
  341. getmaxyx(win,ym,xm);
  342. tmp := subwin(win,1,xm-x,yb+y,xb+x);
  343. If tmp = nil then Exit;
  344. wbkgd(tmp,CursesAtts(TextAttr));
  345. werase(tmp);
  346. { wclrtoeol(win);}
  347. If doRefresh Then wrefresh(tmp);
  348. delwin(tmp);
  349. End;
  350. { clear from the cursor to the bottom in a window }
  351. Procedure nClrBot(win : pWindow);
  352. Begin
  353. wclrtobot(win);
  354. If doRefresh Then wrefresh(win);
  355. End;
  356. { insert a line at the cursor line in a window }
  357. Procedure nInsLine(win : pWindow);
  358. Begin
  359. winsertln(win);
  360. If doRefresh Then wrefresh(win);
  361. End;
  362. { delete line at the cursor in a window }
  363. Procedure nDelLine(win : pWindow);
  364. Begin
  365. wdeleteln(win);
  366. If doRefresh Then wrefresh(win);
  367. End;
  368. { position cursor in a window }
  369. Procedure nGotoXY(win : pWindow; x,y : integer);
  370. Begin
  371. wmove(win,y-1,x-1);
  372. touchwin(win);
  373. If doRefresh Then wrefresh(win);
  374. End;
  375. { find cursor x position in a window }
  376. Function nWhereX(win : pWindow) : integer;
  377. var x,y : longint;
  378. Begin
  379. getyx(win,y,x);
  380. nWhereX := x+1;
  381. End;
  382. { find cursor y position in a window }
  383. Function nWhereY(win : pWindow) : integer;
  384. var x,y : longint;
  385. Begin
  386. getyx(win,y,x);
  387. nWhereY := y+1;
  388. End;
  389. {---------------------------------------------------------------------
  390. read a keystroke from a window, including function keys and extended
  391. keys (arrows, etc.)
  392. Note: Make sure that keypad(win,true) has been issued prior to use.
  393. ( nWindow does this )
  394. ---------------------------------------------------------------------}
  395. Function nReadkey(win : pWindow) : char;
  396. var
  397. c : char;
  398. l : longint;
  399. xtnded : boolean;
  400. Begin
  401. l := wgetch(win);
  402. { if it's an extended key, then map to the IBM values }
  403. if l > 255 then begin
  404. xtnded := true;
  405. c := #27;
  406. Case l of
  407. KEY_BREAK : Begin xtnded := false; c := #3; End;
  408. KEY_BACKSPACE : Begin xtnded := false; c := #8; End;
  409. KEY_IC : c := #82; { insert }
  410. KEY_DC : c := #83; { delete }
  411. KEY_HOME : c := #71; { home }
  412. KEY_END : c := #79; { end }
  413. KEY_UP : c := #72; { up arrow }
  414. KEY_DOWN : c := #80; { down arrow }
  415. KEY_LEFT : c := #75; { left arrow }
  416. KEY_RIGHT : c := #77; { right arrow }
  417. KEY_NPAGE : c := #81; { page down }
  418. KEY_PPAGE : c := #73; { page up }
  419. KEY_ALTA : c := #30; { alt/a }
  420. KEY_ALTB : c := #48;
  421. KEY_ALTC : c := #46;
  422. KEY_ALTD : c := #32;
  423. KEY_ALTE : c := #18;
  424. KEY_ALTF : c := #33;
  425. KEY_ALTG : c := #34;
  426. KEY_ALTH : c := #35;
  427. KEY_ALTI : c := #23;
  428. KEY_ALTJ : c := #36;
  429. KEY_ALTK : c := #37;
  430. KEY_ALTL : c := #38;
  431. KEY_ALTM : c := #50;
  432. KEY_ALTN : c := #49;
  433. KEY_ALTO : c := #24;
  434. KEY_ALTP : c := #25;
  435. KEY_ALTQ : c := #16;
  436. KEY_ALTR : c := #19;
  437. KEY_ALTS : c := #31;
  438. KEY_ALTT : c := #20;
  439. KEY_ALTU : c := #22;
  440. KEY_ALTV : c := #47;
  441. KEY_ALTW : c := #17;
  442. KEY_ALTX : c := #45;
  443. KEY_ALTY : c := #21;
  444. KEY_ALTZ : c := #44; { alt/z }
  445. KEY_ALT1 : c := #120; { alt/1 }
  446. KEY_ALT2 : c := #121; { alt/2 }
  447. KEY_ALT3 : c := #122; { alt/3 }
  448. KEY_ALT4 : c := #123; { alt/4 }
  449. KEY_ALT5 : c := #124; { alt/5 }
  450. KEY_ALT6 : c := #125; { alt/6 }
  451. KEY_ALT7 : c := #126; { alt/7 }
  452. KEY_ALT8 : c := #127; { alt/8 }
  453. KEY_ALT9 : c := #128; { alt/9 }
  454. KEY_ALT0 : c := #129; { alt/0 }
  455. KEY_ALTEQUAL : c := #130; { alt/- }
  456. KEY_ALTMINUS : c := #131; { alt/= }
  457. KEY_ALTTAB : c := #15; { alt/tab }
  458. Else
  459. Begin
  460. If l = Key_f(1) Then c := #59 Else
  461. If l = Key_f(2) Then c := #60 Else
  462. If l = Key_f(3) Then c := #61 Else
  463. If l = Key_f(4) Then c := #62 Else
  464. If l = Key_f(5) Then c := #63 Else
  465. If l = Key_f(6) Then c := #64 Else
  466. If l = Key_f(7) Then c := #65 Else
  467. If l = Key_f(8) Then c := #66 Else
  468. If l = Key_f(9) Then c := #67 Else
  469. If l = Key_f(10) Then c := #68 Else
  470. If l = Key_f(11) Then c := #84 Else
  471. If l = Key_f(12) Then c := #85 Else
  472. If l = Key_f(13) Then c := #86 Else
  473. If l = Key_f(14) Then c := #87 Else
  474. If l = Key_f(15) Then c := #88 Else
  475. If l = Key_f(16) Then c := #89 Else
  476. If l = Key_f(17) Then c := #90 Else
  477. If l = Key_f(18) Then c := #91 Else
  478. If l = Key_f(19) Then c := #92 Else
  479. If l = Key_f(20) Then c := #93;
  480. End;
  481. End;
  482. If xtnded Then Begin
  483. nReadKey := #0;
  484. ungetch(ord(c));
  485. Exit;
  486. End Else
  487. nReadkey := c;
  488. End Else
  489. nReadkey := chr(ord(l));
  490. End;
  491. { write a string to a window at the current cursor position }
  492. Procedure nWrite(win : pWindow; s : string);
  493. Begin
  494. waddstr(win,StrPCopy(ps,s));
  495. If doRefresh Then wrefresh(win);
  496. End;
  497. {=========================================================================
  498. CrtWrite, CrtRead, CrtReturn, CrtClose, CrtOpen, AssignCrt.
  499. These functions come from the FPC distribution rtl/linux/crt unit.
  500. These are the hooks into the input/output stream needed for write(ln)
  501. and read(ln).
  502. =========================================================================}
  503. { used by CrtWrite }
  504. Procedure DoWrite(temp : string);
  505. Begin
  506. nWrite(ActiveWn,temp);
  507. End;
  508. Function CrtWrite(Var F: TextRec): Integer;
  509. {
  510. Top level write function for CRT
  511. }
  512. Var
  513. Temp : String;
  514. idx,i : Longint;
  515. { oldflush : boolean;}
  516. Begin
  517. { oldflush:=ttySetFlush(Flushing);}
  518. idx:=0;
  519. while (F.BufPos>0) do
  520. begin
  521. i:=F.BufPos;
  522. if i>255 then
  523. i:=255;
  524. system.Move(F.BufPTR^[idx],Temp[1],F.BufPos);
  525. Temp[0]:=Chr(i);
  526. DoWrite(Temp);
  527. dec(F.BufPos,i);
  528. inc(idx,i);
  529. end;
  530. { ttySetFlush(oldFLush);}
  531. CrtWrite:=0;
  532. End;
  533. Function CrtRead(Var F: TextRec): Integer;
  534. {
  535. Read from CRT associated file.
  536. }
  537. var
  538. i : longint;
  539. Begin
  540. F.BufEnd:=fdRead(F.Handle, F.BufPtr^, F.BufSize);
  541. { fix #13 only's -> #10 to overcome terminal setting }
  542. for i:=1to F.BufEnd do
  543. begin
  544. if (F.BufPtr^[i-1]=#13) and (F.BufPtr^[i]<>#10) then
  545. F.BufPtr^[i-1]:=#10;
  546. end;
  547. F.BufPos:=F.BufEnd;
  548. CrtWrite(F);
  549. CrtRead:=0;
  550. End;
  551. Function CrtReturn(Var F:TextRec):Integer;
  552. Begin
  553. CrtReturn:=0;
  554. end;
  555. Function CrtClose(Var F: TextRec): Integer;
  556. {
  557. Close CRT associated file.
  558. }
  559. Begin
  560. F.Mode:=fmClosed;
  561. CrtClose:=0;
  562. End;
  563. Function CrtOpen(Var F: TextRec): Integer;
  564. {
  565. Open CRT associated file.
  566. }
  567. Begin
  568. If F.Mode=fmOutput Then
  569. begin
  570. TextRec(F).InOutFunc:=@CrtWrite;
  571. TextRec(F).FlushFunc:=@CrtWrite;
  572. end
  573. Else
  574. begin
  575. F.Mode:=fmInput;
  576. TextRec(F).InOutFunc:=@CrtRead;
  577. TextRec(F).FlushFunc:=@CrtReturn;
  578. end;
  579. TextRec(F).CloseFunc:=@CrtClose;
  580. CrtOpen:=0;
  581. End;
  582. procedure AssignCrt(var F: Text);
  583. {
  584. Assign a file to the console. All output on file goes to console instead.
  585. }
  586. begin
  587. Assign(F,'');
  588. TextRec(F).OpenFunc:=@CrtOpen;
  589. end;
  590. {==========================================================================
  591. Standard crt unit replacements
  592. ==========================================================================}
  593. { set the text background color }
  594. Procedure TextBackground(att : byte);
  595. Begin
  596. TextAttr:=
  597. ((att shl 4) and ($f0 and not Blink)) or (TextAttr and ($0f OR Blink) );
  598. nWinColor(ActiveWn,TextAttr);
  599. End;
  600. { set the text foreground color }
  601. Procedure TextColor(att : byte);
  602. Begin
  603. TextAttr := (att and $8f) or (TextAttr and $70);
  604. nWinColor(ActiveWn,TextAttr);
  605. End;
  606. { set to high intensity }
  607. Procedure HighVideo;
  608. Begin
  609. TextColor(TextAttr Or $08);
  610. End;
  611. { set to low intensity }
  612. Procedure LowVideo;
  613. Begin
  614. TextColor(TextAttr And $77);
  615. End;
  616. { set to normal display colors }
  617. Procedure NormVideo;
  618. Begin
  619. TextColor(7);
  620. TextBackGround(0);
  621. End;
  622. { clear stdscr }
  623. Procedure ClrScr;
  624. Begin
  625. nClrScr(ActiveWn,TextAttr);
  626. End;
  627. { clear from the cursor to the end of line in stdscr }
  628. Procedure ClrEol;
  629. Begin
  630. nClrEol(ActiveWn);
  631. End;
  632. { clear from the cursor to the bottom of stdscr }
  633. Procedure ClrBot;
  634. Begin
  635. nClrBot(ActiveWn);
  636. End;
  637. { insert a line at the cursor line in stdscr }
  638. Procedure InsLine;
  639. Begin
  640. nInsLine(ActiveWn);
  641. End;
  642. { delete line at the cursor in stdscr }
  643. Procedure DelLine;
  644. Begin
  645. nDelLine(ActiveWn);
  646. End;
  647. { position cursor in stdscr }
  648. Procedure GotoXY(x,y : integer);
  649. Begin
  650. nGotoXY(ActiveWn,x,y);
  651. End;
  652. { find cursor x position in stdscr }
  653. Function WhereX : integer;
  654. Begin
  655. WhereX := nWhereX(ActiveWn);
  656. End;
  657. { find cursor y position in stdscr }
  658. Function WhereY : integer;
  659. Begin
  660. WhereY := nWhereY(ActiveWn);
  661. End;
  662. { Wait for DTime milliseconds }
  663. Procedure Delay(DTime: Word);
  664. Begin
  665. Select(0,nil,nil,nil,DTime);
  666. End;
  667. { create a new subwindow of stdscr }
  668. Procedure Window(x,y,x1,y1 : integer);
  669. Begin
  670. nDelWindow(SubWn);
  671. SubWn := subwin(stdscr,y1-y+1,x1-x+1,y-1,x-1);
  672. If SubWn = nil then Exit;
  673. intrflush(SubWn,bool(false));
  674. keypad(SubWn,bool(true));
  675. scrollok(SubWn,bool(true));
  676. ActiveWn := SubWn;
  677. GotoXY(1,1);
  678. End;
  679. {------------------------------------------------------
  680. Check if a key has been pressed.
  681. Note: this is best used along with select() on STDIN,
  682. as it can suck up lots of cpu time.
  683. Better yet, use nKeypressed instead if you don't need
  684. to include file descriptors other than STDIN.
  685. ------------------------------------------------------}
  686. function Keypressed : boolean;
  687. var
  688. l : longint;
  689. fd : fdSet;
  690. Begin
  691. Keypressed := FALSE;
  692. nodelay(ActiveWn,bool(TRUE));
  693. l := wgetch(ActiveWn);
  694. If l <> ERR Then Begin { ERR = -(1) from unit ncurses }
  695. ungetch(l);
  696. Keypressed := TRUE;
  697. End;
  698. nodelay(ActiveWn,bool(FALSE));
  699. { Below is more efficient code, but does not work well with
  700. nReadkey & extended keys because nReadkey's ungetch does not
  701. force a change in STDIN. So, a "while keypressed" block does
  702. not produce the expected results when trapping for char(0)
  703. followed by a second scan code.
  704. FD_Zero(fd);
  705. fd_Set(STDIN,fd);
  706. Keypressed := (Select(STDIN+1,@fd,nil,nil,0) > 0);
  707. }
  708. End;
  709. { silently read a key from stdscr }
  710. Function Readkey : char;
  711. Begin
  712. tmp_b := IsEcho;
  713. noecho;
  714. Readkey := nReadkey(ActiveWn);
  715. If tmp_b Then echo;
  716. End;
  717. { a cheap replacement! }
  718. Procedure Sound(hz : word);
  719. Begin
  720. Beep;
  721. wrefresh(ActiveWn);
  722. End;
  723. Procedure NoSound;
  724. Begin
  725. End;
  726. Procedure TextMode(mode : word);
  727. Begin
  728. nDelWindow(SubWn);
  729. ActiveWn := stdscr;
  730. NormVideo;
  731. LastMode := mode;
  732. DirectVideo := true;
  733. CheckSnow := true;
  734. NormVideo;
  735. ClrScr;
  736. End;
  737. { exit procedure to ensure curses is closed up cleanly }
  738. Procedure nExit;
  739. Begin
  740. ExitProc := ExitSave;
  741. EndCurses;
  742. End;