video.pp 21 KB

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