video.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956
  1. {
  2. $Id$
  3. This file is part of the Free Pascal run time library.
  4. Copyright (c) 1999-2000 by Florian Klaempfl
  5. member of the Free Pascal development team
  6. Video unit for linux
  7. See the file COPYING.FPC, included in this distribution,
  8. for details about the copyright.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  12. **********************************************************************}
  13. unit Video;
  14. interface
  15. {$i videoh.inc}
  16. implementation
  17. uses
  18. BaseUnix, Strings, TermInfo, termio;
  19. {$i video.inc}
  20. Type TConsoleType = (ttyNetwork,ttyLinux,ttyFreeBSD,ttyNetBSD);
  21. var
  22. LastCursorType : byte;
  23. TtyFd: Longint;
  24. Console: TConsoleType;
  25. {$ifdef logging}
  26. f: file;
  27. const
  28. logstart: string = '';
  29. nl: char = #10;
  30. logend: string = #10#10;
  31. {$endif logging}
  32. {$ifdef cpui386}
  33. {$ASMMODE ATT}
  34. {$endif cpui386}
  35. const
  36. can_delete_term : boolean = false;
  37. ACSIn : string = '';
  38. ACSOut : string = '';
  39. InACS : boolean =false;
  40. function IsACS(var ch,ACSchar : char): boolean;
  41. begin
  42. IsACS:=false;
  43. case ch of
  44. #24, #30: {}
  45. ch:='^';
  46. #25, #31: {}
  47. ch:='v';
  48. #26, #16: {Never introduce a ctrl-Z ... }
  49. ch:='>';
  50. {#27,needed in Escape sequences} #17: {}
  51. ch:='<';
  52. #176, #177, #178: {°±²}
  53. begin
  54. IsACS:=true;
  55. ACSChar:='a';
  56. end;
  57. #180, #181, #182, #185: {´µ¶¹}
  58. begin
  59. IsACS:=true;
  60. ACSChar:='u';
  61. end;
  62. #183, #184, #187, #191: {·¸»¿}
  63. begin
  64. IsACS:=true;
  65. ACSChar:='k';
  66. end;
  67. #188, #189, #190, #217: {¼½¾Ù}
  68. begin
  69. IsACS:=true;
  70. ACSChar:='j';
  71. end;
  72. #192, #200, #211, #212: {ÀÈÓÔ}
  73. begin
  74. IsACS:=true;
  75. ACSChar:='m';
  76. end;
  77. #193, #202, #207, #208: {ÁÊÏÐ}
  78. begin
  79. IsACS:=true;
  80. ACSChar:='v';
  81. end;
  82. #194, #203, #209, #210: {ÂËÑÒ}
  83. begin
  84. IsACS:=true;
  85. ACSChar:='w';
  86. end;
  87. #195, #198, #199, #204: {ÃÆÇÌ}
  88. begin
  89. IsACS:=true;
  90. ACSChar:='t';
  91. end;
  92. #196, #205: {ÄÍ}
  93. begin
  94. IsACS:=true;
  95. ACSChar:='q';
  96. end;
  97. #179, #186: {³º}
  98. begin
  99. IsACS:=true;
  100. ACSChar:='x';
  101. end;
  102. #197, #206, #215, #216: {ÅÎר}
  103. begin
  104. IsACS:=true;
  105. ACSChar:='n';
  106. end;
  107. #201, #213, #214, #218: {ÉÕÖÚ}
  108. begin
  109. IsACS:=true;
  110. ACSChar:='l';
  111. end;
  112. #254: { þ }
  113. begin
  114. ch:='*';
  115. end;
  116. { Shadows for Buttons }
  117. #220: { Ü }
  118. begin
  119. IsACS:=true;
  120. ACSChar:='a';
  121. end;
  122. #223: { ß }
  123. begin
  124. IsACS:=true;
  125. ACSChar:='a';
  126. end;
  127. end;
  128. end;
  129. function SendEscapeSeqNdx(Ndx: Word) : boolean;
  130. var
  131. P,pdelay: PChar;
  132. begin
  133. SendEscapeSeqNdx:=false;
  134. if not assigned(cur_term_Strings) then
  135. exit{RunError(219)};
  136. P:=cur_term_Strings^[Ndx];
  137. if assigned(p) then
  138. begin { Do not transmit the delays }
  139. pdelay:=strpos(p,'$<');
  140. if assigned(pdelay) then
  141. pdelay^:=#0;
  142. fpWrite(stdoutputhandle, P^, StrLen(P));
  143. SendEscapeSeqNdx:=true;
  144. if assigned(pdelay) then
  145. pdelay^:='$';
  146. end;
  147. end;
  148. procedure SendEscapeSeq(const S: String);
  149. begin
  150. fpWrite(stdoutputhandle, S[1], Length(S));
  151. end;
  152. Function IntStr(l:longint):string;
  153. var
  154. s : string;
  155. begin
  156. Str(l,s);
  157. IntStr:=s;
  158. end;
  159. Function XY2Ansi(x,y,ox,oy:longint):String;
  160. {
  161. Returns a string with the escape sequences to go to X,Y on the screen.
  162. Note that x, y, ox, oy are 1-based (i.e. top-left corner of the screen
  163. is (1, 1)), while SetCursorPos parameters and CursorX and CursorY
  164. are 0-based (top-left corner of the screen is (0, 0)).
  165. }
  166. Begin
  167. if y=oy then
  168. begin
  169. if x=ox then
  170. begin
  171. XY2Ansi:='';
  172. exit;
  173. end;
  174. if x=1 then
  175. begin
  176. XY2Ansi:=#13;
  177. exit;
  178. end;
  179. if x>ox then
  180. begin
  181. XY2Ansi:=#27'['+IntStr(x-ox)+'C';
  182. exit;
  183. end
  184. else
  185. begin
  186. XY2Ansi:=#27'['+IntStr(ox-x)+'D';
  187. exit;
  188. end;
  189. end;
  190. if x=ox then
  191. begin
  192. if y>oy then
  193. begin
  194. XY2Ansi:=#27'['+IntStr(y-oy)+'B';
  195. exit;
  196. end
  197. else
  198. begin
  199. XY2Ansi:=#27'['+IntStr(oy-y)+'A';
  200. exit;
  201. end;
  202. end;
  203. if ((x=1) and (oy+1=y)) and (console<>ttyfreebsd) then
  204. XY2Ansi:=#13#10
  205. else
  206. XY2Ansi:=#27'['+IntStr(y)+';'+IntStr(x)+'H';
  207. End;
  208. const
  209. AnsiTbl : string[8]='04261537';
  210. Function Attr2Ansi(Attr,OAttr:longint):string;
  211. {
  212. Convert Attr to an Ansi String, the Optimal code is calculate
  213. with use of the old OAttr
  214. }
  215. var
  216. hstr : string[16];
  217. OFg,OBg,Fg,Bg : longint;
  218. procedure AddSep(ch:char);
  219. begin
  220. if length(hstr)>0 then
  221. hstr:=hstr+';';
  222. hstr:=hstr+ch;
  223. end;
  224. begin
  225. if Attr=OAttr then
  226. begin
  227. Attr2Ansi:='';
  228. exit;
  229. end;
  230. Hstr:='';
  231. Fg:=Attr and $f;
  232. Bg:=Attr shr 4;
  233. OFg:=OAttr and $f;
  234. OBg:=OAttr shr 4;
  235. if (OFg<>7) or (Fg=7) or ((OFg>7) and (Fg<8)) or ((OBg>7) and (Bg<8)) then
  236. begin
  237. hstr:='0';
  238. OFg:=7;
  239. OBg:=0;
  240. end;
  241. if (Fg>7) and (OFg<8) then
  242. begin
  243. AddSep('1');
  244. OFg:=OFg or 8;
  245. end;
  246. if (Bg and 8)<>(OBg and 8) then
  247. begin
  248. AddSep('5');
  249. OBg:=OBg or 8;
  250. end;
  251. if (Fg<>OFg) then
  252. begin
  253. AddSep('3');
  254. hstr:=hstr+AnsiTbl[(Fg and 7)+1];
  255. end;
  256. if (Bg<>OBg) then
  257. begin
  258. AddSep('4');
  259. hstr:=hstr+AnsiTbl[(Bg and 7)+1];
  260. end;
  261. if hstr='0' then
  262. hstr:='';
  263. Attr2Ansi:=#27'['+hstr+'m';
  264. end;
  265. procedure UpdateTTY(Force:boolean);
  266. type
  267. tchattr=packed record
  268. {$ifdef ENDIAN_LITTLE}
  269. ch : char;
  270. attr : byte;
  271. {$else}
  272. attr : byte;
  273. ch : char;
  274. {$endif}
  275. end;
  276. var
  277. outbuf : array[0..1023+255] of char;
  278. chattr : tchattr;
  279. skipped : boolean;
  280. outptr,
  281. spaces,
  282. eol,
  283. x,y,
  284. LastX,LastY,
  285. SpaceAttr,
  286. LastAttr : longint;
  287. p,pold : pvideocell;
  288. LastLineWidth : Longint;
  289. procedure TransformUsingACS(var st : string);
  290. var
  291. res : string;
  292. i : longint;
  293. ch,ACSch : char;
  294. begin
  295. res:='';
  296. for i:=1 to length(st) do
  297. begin
  298. ch:=st[i];
  299. if IsACS(ch,ACSch) then
  300. begin
  301. if not InACS then
  302. begin
  303. res:=res+ACSIn;
  304. InACS:=true;
  305. end;
  306. res:=res+ACSch;
  307. end
  308. else
  309. begin
  310. if InACS then
  311. begin
  312. res:=res+ACSOut+Attr2Ansi(LastAttr,0);
  313. InACS:=false;
  314. end;
  315. res:=res+ch;
  316. end;
  317. end;
  318. st:=res;
  319. end;
  320. procedure outdata(hstr:string);
  321. begin
  322. If Length(HStr)>0 Then
  323. Begin
  324. while (eol>0) do
  325. begin
  326. hstr:=#13#10+hstr;
  327. dec(eol);
  328. end;
  329. if NoExtendedFrame and (ACSIn<>'') and (ACSOut<>'') then
  330. TransformUsingACS(Hstr);
  331. move(hstr[1],outbuf[outptr],length(hstr));
  332. inc(outptr,length(hstr));
  333. if outptr>=1024 then
  334. begin
  335. {$ifdef logging}
  336. blockwrite(f,logstart[1],length(logstart));
  337. blockwrite(f,nl,1);
  338. blockwrite(f,outptr,sizeof(outptr));
  339. blockwrite(f,nl,1);
  340. blockwrite(f,outbuf,outptr);
  341. blockwrite(f,nl,1);
  342. {$endif logging}
  343. fpWrite(stdoutputhandle,outbuf,outptr);
  344. outptr:=0;
  345. end;
  346. end;
  347. end;
  348. procedure OutClr(c:byte);
  349. begin
  350. if c=LastAttr then
  351. exit;
  352. OutData(Attr2Ansi(c,LastAttr));
  353. LastAttr:=c;
  354. end;
  355. procedure OutSpaces;
  356. begin
  357. if (Spaces=0) then
  358. exit;
  359. OutClr(SpaceAttr);
  360. OutData(Space(Spaces));
  361. LastX:=x;
  362. LastY:=y;
  363. Spaces:=0;
  364. end;
  365. function GetTermString(ndx:word):String;
  366. var
  367. P,pdelay: PChar;
  368. begin
  369. GetTermString:='';
  370. if not assigned(cur_term_Strings) then
  371. exit{RunError(219)};
  372. P:=cur_term_Strings^[Ndx];
  373. if assigned(p) then
  374. begin { Do not transmit the delays }
  375. pdelay:=strpos(p,'$<');
  376. if assigned(pdelay) then
  377. pdelay^:=#0;
  378. GetTermString:=StrPas(p);
  379. if assigned(pdelay) then
  380. pdelay^:='$';
  381. end;
  382. end;
  383. begin
  384. OutPtr:=0;
  385. Eol:=0;
  386. skipped:=true;
  387. p:=PVideoCell(VideoBuf);
  388. pold:=PVideoCell(OldVideoBuf);
  389. { init Attr, X,Y and set autowrap off }
  390. SendEscapeSeq(#27'[m'#27'[?7l'{#27'[H'} );
  391. // 1.0.x: SendEscapeSeq(#27'[m'{#27'[H'});
  392. LastAttr:=7;
  393. LastX:=-1;
  394. LastY:=-1;
  395. for y:=1 to ScreenHeight do
  396. begin
  397. SpaceAttr:=0;
  398. Spaces:=0;
  399. LastLineWidth:=ScreenWidth;
  400. If (y=ScreenHeight) And (Console=ttyFreeBSD) {And :am: is on} Then
  401. LastLineWidth:=ScreenWidth-2;
  402. for x:=1 to LastLineWidth do
  403. begin
  404. if (not force) and (p^=pold^) then
  405. begin
  406. if (Spaces>0) then
  407. OutSpaces;
  408. skipped:=true;
  409. end
  410. else
  411. begin
  412. if skipped then
  413. begin
  414. OutData(XY2Ansi(x,y,LastX,LastY));
  415. LastX:=x;
  416. LastY:=y;
  417. skipped:=false;
  418. end;
  419. chattr:=tchattr(p^);
  420. if chattr.ch in [#0,#255] then
  421. chattr.ch:=' ';
  422. if chattr.ch=' ' then
  423. begin
  424. if Spaces=0 then
  425. SpaceAttr:=chattr.Attr;
  426. if (chattr.attr and $f0)=(spaceattr and $f0) then
  427. chattr.Attr:=SpaceAttr
  428. else
  429. begin
  430. OutSpaces;
  431. SpaceAttr:=chattr.Attr;
  432. end;
  433. inc(Spaces);
  434. end
  435. else
  436. begin
  437. if (Spaces>0) then
  438. OutSpaces;
  439. if ord(chattr.ch)<32 then
  440. begin
  441. Chattr.Attr:= $ff xor Chattr.Attr;
  442. ChAttr.ch:= chr(ord(chattr.ch)+ord('A')-1);
  443. end;
  444. if LastAttr<>chattr.Attr then
  445. OutClr(chattr.Attr);
  446. OutData(chattr.ch);
  447. LastX:=x+1;
  448. LastY:=y;
  449. end;
  450. p^:=tvideocell(chattr);
  451. end;
  452. inc(p);
  453. inc(pold);
  454. end;
  455. if (Spaces>0) then
  456. OutSpaces;
  457. if force then
  458. inc(eol)
  459. else
  460. skipped:=true;
  461. end;
  462. eol:=0;
  463. {if am in capabilities? Then}
  464. If (Console=ttyFreeBSD) and (Plongint(p)^<>plongint(pold)^) Then
  465. Begin
  466. OutData(XY2Ansi(ScreenWidth,ScreenHeight,LastX,LastY));
  467. OutData(#8);
  468. {Output last char}
  469. chattr:=tchattr(p[1]);
  470. if LastAttr<>chattr.Attr then
  471. OutClr(chattr.Attr);
  472. OutData(chattr.ch);
  473. inc(LastX);
  474. // OutData(XY2Ansi(ScreenWidth-1,ScreenHeight,LastX,LastY));
  475. // OutData(GetTermString(Insert_character));
  476. OutData(#8+#27+'[1@');
  477. chattr:=tchattr(p^);
  478. if LastAttr<>chattr.Attr then
  479. OutClr(chattr.Attr);
  480. OutData(chattr.ch);
  481. inc(LastX);
  482. end;
  483. OutData(XY2Ansi(CursorX+1,CursorY+1,LastX,LastY));
  484. {$ifdef logging}
  485. blockwrite(f,logstart[1],length(logstart));
  486. blockwrite(f,nl,1);
  487. blockwrite(f,outptr,sizeof(outptr));
  488. blockwrite(f,nl,1);
  489. blockwrite(f,outbuf,outptr);
  490. blockwrite(f,nl,1);
  491. {$endif logging}
  492. fpWrite(stdoutputhandle,outbuf,outptr);
  493. if InACS then
  494. SendEscapeSeqNdx(exit_alt_charset_mode);
  495. {turn autowrap on}
  496. // SendEscapeSeq(#27'[?7h');
  497. end;
  498. var
  499. preInitVideoTio, postInitVideoTio: termio.termios;
  500. inputRaw, outputRaw: boolean;
  501. procedure saveRawSettings(const tio: termio.termios);
  502. Begin
  503. with tio do
  504. begin
  505. inputRaw :=
  506. ((c_iflag and (IGNBRK or BRKINT or PARMRK or ISTRIP or
  507. INLCR or IGNCR or ICRNL or IXON)) = 0) and
  508. ((c_lflag and (ECHO or ECHONL or ICANON or ISIG or IEXTEN)) = 0);
  509. outPutRaw :=
  510. ((c_oflag and OPOST) = 0) and
  511. ((c_cflag and (CSIZE or PARENB)) = 0) and
  512. ((c_cflag and CS8) <> 0);
  513. end;
  514. end;
  515. procedure restoreRawSettings(tio: termio.termios);
  516. begin
  517. with tio do
  518. begin
  519. if inputRaw then
  520. begin
  521. c_iflag := c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or
  522. INLCR or IGNCR or ICRNL or IXON));
  523. c_lflag := c_lflag and
  524. (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN));
  525. c_cc[VMIN]:=1;
  526. c_cc[VTIME]:=0;
  527. end;
  528. if outPutRaw then
  529. begin
  530. c_oflag := c_oflag and not(OPOST);
  531. c_cflag := c_cflag and not(CSIZE or PARENB) or CS8;
  532. end;
  533. end;
  534. TCSetAttr(1,TCSANOW,tio);
  535. end;
  536. procedure prepareInitVideo;
  537. begin
  538. TCGetAttr(1,preInitVideoTio);
  539. saveRawSettings(preInitVideoTio);
  540. end;
  541. procedure videoInitDone;
  542. begin
  543. TCGetAttr(1,postInitVideoTio);
  544. restoreRawSettings(postInitVideoTio);
  545. end;
  546. procedure prepareDoneVideo;
  547. var
  548. tio: termio.termios;
  549. begin
  550. TCGetAttr(1,tio);
  551. saveRawSettings(tio);
  552. TCSetAttr(1,TCSANOW,postInitVideoTio);
  553. end;
  554. procedure doneVideoDone;
  555. begin
  556. restoreRawSettings(preInitVideoTio);
  557. end;
  558. procedure SysInitVideo;
  559. const
  560. fontstr : string[3]=#27'(K';
  561. var
  562. ThisTTY: String[30];
  563. FName: String;
  564. WS: packed record
  565. ws_row, ws_col, ws_xpixel, ws_ypixel: Word;
  566. end;
  567. Err: Longint;
  568. prev_term : TerminalCommon_ptr1;
  569. begin
  570. {$ifndef CPUI386}
  571. LowAscii:=false;
  572. {$endif CPUI386}
  573. { check for tty }
  574. ThisTTY:=TTYName(stdinputhandle);
  575. if (IsATTY(stdinputhandle)<>-1) then
  576. begin
  577. { save current terminal characteristics and remove rawness }
  578. prepareInitVideo;
  579. { write code to set a correct font }
  580. fpWrite(stdoutputhandle,fontstr[1],length(fontstr));
  581. { running on a tty, find out whether locally or remotely }
  582. TTyfd:=-1;
  583. Console:=TTyNetwork; {Default: Network or other vtxxx tty}
  584. if (Copy(ThisTTY, 1, 8) = '/dev/tty') and
  585. not (ThisTTY[9] IN ['p'..'u','P']) then // FreeBSD has these
  586. begin
  587. { running on the console }
  588. Case ThisTTY[9] of
  589. '0'..'9' : begin { running Linux on native console or native-emulation }
  590. FName:='/dev/vcsa' + ThisTTY[9];
  591. { open console, $1b6=rw-rw-rw- }
  592. TTYFd:=fpOpen(FName, $1b6, O_RdWr);
  593. IF TTYFd <>-1 Then
  594. Console:=ttyLinux;
  595. end;
  596. 'v' : { check for (Free?)BSD native}
  597. If (ThisTTY[10]>='0') and (ThisTTY[10]<='9') Then
  598. Console:=ttyFreeBSD; {TTYFd ?}
  599. end;
  600. end;
  601. If (Copy(fpGetEnv('TERM'),1,4)='cons') Then // cons<lines>
  602. Console:=ttyFreeBSD;
  603. If Console<>ttylinux Then
  604. begin
  605. { running on a remote terminal, no error with /dev/vcsa }
  606. LowAscii:=false;
  607. //TTYFd:=stdoutputhandle;
  608. end;
  609. fpioctl(stdinputhandle, TIOCGWINSZ, @WS);
  610. if WS.ws_Col=0 then
  611. WS.ws_Col:=80;
  612. if WS.ws_Row=0 then
  613. WS.ws_Row:=25;
  614. ScreenWidth:=WS.ws_Col;
  615. { TDrawBuffer only has FVMaxWidth elements
  616. larger values lead to crashes }
  617. if ScreenWidth> FVMaxWidth then
  618. ScreenWidth:=FVMaxWidth;
  619. ScreenHeight:=WS.ws_Row;
  620. CursorX:=0;
  621. CursorY:=0;
  622. LastCursorType:=$ff;
  623. ScreenColor:=True;
  624. { Start with a clear screen }
  625. if Console<>ttylinux then
  626. begin
  627. prev_term:=cur_term;
  628. setupterm(nil, stdoutputhandle, err);
  629. can_delete_term:=assigned(prev_term) and (prev_term<>cur_term);
  630. SendEscapeSeqNdx(cursor_home);
  631. SendEscapeSeqNdx(cursor_normal);
  632. SendEscapeSeqNdx(cursor_visible);
  633. SendEscapeSeqNdx(enter_ca_mode);
  634. SetCursorType(crUnderLine);
  635. If Console=ttyFreeBSD Then
  636. SendEscapeSeqNdx(exit_am_mode);
  637. end
  638. else if not assigned(cur_term) then
  639. begin
  640. setupterm(nil, stdoutputhandle, err);
  641. can_delete_term:=false;
  642. end;
  643. if assigned(cur_term_Strings) then
  644. begin
  645. ACSIn:=StrPas(cur_term_Strings^[enter_alt_charset_mode]);
  646. ACSOut:=StrPas(cur_term_Strings^[exit_alt_charset_mode]);
  647. if (ACSIn<>'') and (ACSOut<>'') then
  648. SendEscapeSeqNdx(ena_acs);
  649. if pos('$<',ACSIn)>0 then
  650. ACSIn:=Copy(ACSIn,1,Pos('$<',ACSIn)-1);
  651. if pos('$<',ACSOut)>0 then
  652. ACSOut:=Copy(ACSOut,1,Pos('$<',ACSOut)-1);
  653. If fpGetEnv('TERM')='xterm' then
  654. NoExtendedFrame := true; {use of acs for xterm is ok}
  655. end
  656. else
  657. begin
  658. ACSIn:='';
  659. ACSOut:='';
  660. end;
  661. {$ifdef logging}
  662. assign(f,'video.log');
  663. rewrite(f,1);
  664. {$endif logging}
  665. { save new terminal characteristics and possible restore rawness }
  666. videoInitDone;
  667. end
  668. else
  669. ErrorCode:=errVioInit; { not a TTY }
  670. end;
  671. procedure SysDoneVideo;
  672. begin
  673. prepareDoneVideo;
  674. if Console=ttylinux then
  675. SetCursorPos(0,0)
  676. else
  677. begin
  678. SendEscapeSeqNdx(exit_ca_mode);
  679. SendEscapeSeqNdx(cursor_home);
  680. SendEscapeSeqNdx(cursor_normal);
  681. SendEscapeSeqNdx(cursor_visible);
  682. SetCursorType(crUnderLine);
  683. SendEscapeSeq(#27'[H');
  684. end;
  685. ACSIn:='';
  686. ACSOut:='';
  687. doneVideoDone;
  688. { FreeBSD gives an error here.
  689. According to Pierre this could be more a NCurses version thing that
  690. a FreeBSD one. FreeBSD 4.4 has ncurses 5.
  691. MvdV102003: Since I ran 1.1 with newer FreeBSD without problem, I let it be for now}
  692. if can_delete_term then
  693. begin
  694. del_curterm(cur_term);
  695. can_delete_term:=false;
  696. end;
  697. {$ifdef logging}
  698. close(f);
  699. {$endif logging}
  700. end;
  701. procedure SysClearScreen;
  702. begin
  703. if Console=ttylinux then
  704. UpdateScreen(true)
  705. else
  706. begin
  707. SendEscapeSeq(#27'[0m');
  708. SendEscapeSeqNdx(clear_screen);
  709. end;
  710. end;
  711. procedure SysUpdateScreen(Force: Boolean);
  712. var
  713. DoUpdate : boolean;
  714. i : longint;
  715. p1,p2 : plongint;
  716. begin
  717. if not force then
  718. begin
  719. {$ifdef cpui386}
  720. asm
  721. pushl %esi
  722. pushl %edi
  723. movl VideoBuf,%esi
  724. movl OldVideoBuf,%edi
  725. movl VideoBufSize,%ecx
  726. shrl $2,%ecx
  727. repe
  728. cmpsl
  729. setne DoUpdate
  730. popl %edi
  731. popl %esi
  732. end;
  733. {$else not cpui386}
  734. p1:=plongint(VideoBuf);
  735. p2:=plongint(OldVideoBuf);
  736. for i:=0 to VideoBufSize div 2 do
  737. if (p1^<>p2^) then
  738. begin
  739. DoUpdate:=true;
  740. break;
  741. end
  742. else
  743. begin
  744. { Inc does add sizeof(longint) to both pointer values }
  745. inc(p1);
  746. inc(p2);
  747. end;
  748. {$endif not cpui386}
  749. end
  750. else
  751. DoUpdate:=true;
  752. if not DoUpdate then
  753. exit;
  754. if Console=ttylinux then
  755. begin
  756. fplSeek(TTYFd, 4, Seek_Set);
  757. fpWrite(TTYFd, VideoBuf^,VideoBufSize);
  758. end
  759. else
  760. begin
  761. UpdateTTY(force);
  762. end;
  763. Move(VideoBuf^, OldVideoBuf^, VideoBufSize);
  764. end;
  765. function SysGetCapabilities: Word;
  766. begin
  767. { about cpColor... we should check the terminfo database... }
  768. SysGetCapabilities:=cpUnderLine + cpBlink + cpColor;
  769. end;
  770. procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
  771. var
  772. Pos : array [1..2] of Byte;
  773. begin
  774. if (CursorX=NewCursorX) and (CursorY=NewCursorY) then
  775. exit;
  776. if Console=ttylinux then
  777. begin
  778. fplSeek(TTYFd, 2, Seek_Set);
  779. Pos[1]:=NewCursorX;
  780. Pos[2]:=NewCursorY;
  781. fpWrite(TTYFd, Pos, 2);
  782. end
  783. else
  784. begin
  785. { newcursorx,y and CursorX,Y are 0 based ! }
  786. SendEscapeSeq(XY2Ansi(NewCursorX+1,NewCursorY+1,CursorX+1,CursorY+1));
  787. end;
  788. CursorX:=NewCursorX;
  789. CursorY:=NewCursorY;
  790. end;
  791. function SysGetCursorType: Word;
  792. begin
  793. SysGetCursorType:=LastCursorType;
  794. end;
  795. procedure SysSetCursorType(NewType: Word);
  796. begin
  797. If LastCursorType=NewType then
  798. exit;
  799. LastCursorType:=NewType;
  800. case NewType of
  801. crBlock :
  802. Begin
  803. If not SendEscapeSeqNdx(cursor_visible) then
  804. If Console<>ttyFreeBSD Then // should be done only for linux?
  805. SendEscapeSeq(#27'[?17;0;64c');
  806. End;
  807. crHidden :
  808. Begin
  809. If not SendEscapeSeqNdx(cursor_invisible) then
  810. If Console<>ttyFreeBSD Then
  811. SendEscapeSeq(#27'[?1c');
  812. End;
  813. else
  814. begin
  815. If not SendEscapeSeqNdx(cursor_normal) then
  816. If Console<>ttyFreeBSD Then
  817. SendEscapeSeq(#27'[?2c');
  818. end;
  819. end;
  820. end;
  821. Const
  822. SysVideoDriver : TVideoDriver = (
  823. InitDriver : @SysInitVideo;
  824. DoneDriver : @SysDoneVideo;
  825. UpdateScreen : @SysUpdateScreen;
  826. ClearScreen : @SysClearScreen;
  827. SetVideoMode : Nil;
  828. GetVideoModeCount : Nil;
  829. GetVideoModeData : Nil;
  830. SetCursorPos : @SysSetCursorPos;
  831. GetCursorType : @SysGetCursorType;
  832. SetCursorType : @SysSetCursorType;
  833. GetCapabilities : @SysGetCapabilities;
  834. );
  835. initialization
  836. SetVideoDriver(SysVideoDriver);
  837. end.
  838. {
  839. $Log$
  840. Revision 1.27 2004-12-28 15:30:04 florian
  841. * fixed raw mode for non i386 targets
  842. * fixed some alignment issues
  843. Revision 1.26 2004/12/26 12:22:05 peter
  844. * cursorx,cursory 0 based, fixes 3468
  845. Revision 1.25 2004/10/05 17:16:24 armin
  846. * enable acs on xterm by default
  847. Revision 1.24 2004/10/03 20:16:43 armin
  848. * SysUpdateScreen modified esi and edi
  849. Revision 1.23 2004/07/09 19:03:35 peter
  850. * isatty return cint again
  851. Revision 1.21 2004/07/03 13:29:23 daniel
  852. * Compilation fix.
  853. Revision 1.20 2003/11/19 17:11:40 marco
  854. * termio unit
  855. Revision 1.19 2003/11/17 10:05:51 marco
  856. * threads for FreeBSD. Not working tho
  857. Revision 1.18 2003/10/26 15:32:25 marco
  858. * partial fix for bug 2212.
  859. Revision 1.17 2003/10/25 22:48:52 marco
  860. * small after merge fixes
  861. Revision 1.16 2003/10/24 17:51:39 marco
  862. * merged some fixes from 1.0.x
  863. Revision 1.15 2003/10/17 22:13:30 olle
  864. * changed i386 to cpui386
  865. Revision 1.14 2003/09/14 20:15:01 marco
  866. * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
  867. Revision 1.13 2003/03/26 12:45:21 armin
  868. * added wrapoff to avoid problems in the ide with some terminal emulators
  869. Revision 1.12 2002/09/07 16:01:28 peter
  870. * old logs removed and tabs fixed
  871. Revision 1.11 2002/07/06 16:50:17 marco
  872. * Fix for corrupt color-attr after some ACS-mode changes. (Pierre, Strassbourg
  873. meeting)
  874. }