video.pp 21 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940
  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. end
  657. else
  658. begin
  659. ACSIn:='';
  660. ACSOut:='';
  661. end;
  662. {$ifdef logging}
  663. assign(f,'video.log');
  664. rewrite(f,1);
  665. {$endif logging}
  666. { save new terminal characteristics and possible restore rawness }
  667. videoInitDone;
  668. end
  669. else
  670. ErrorCode:=errVioInit; { not a TTY }
  671. end;
  672. procedure SysDoneVideo;
  673. begin
  674. prepareDoneVideo;
  675. if Console=ttylinux then
  676. SetCursorPos(1,1)
  677. else
  678. begin
  679. SendEscapeSeqNdx(exit_ca_mode);
  680. SendEscapeSeqNdx(cursor_home);
  681. SendEscapeSeqNdx(cursor_normal);
  682. SendEscapeSeqNdx(cursor_visible);
  683. SetCursorType(crUnderLine);
  684. SendEscapeSeq(#27'[H');
  685. end;
  686. ACSIn:='';
  687. ACSOut:='';
  688. doneVideoDone;
  689. { FreeBSD gives an error here.
  690. According to Pierre this could be more a NCurses version thing that
  691. a FreeBSD one. FreeBSD 4.4 has ncurses 5.
  692. MvdV102003: Since I ran 1.1 with newer FreeBSD without problem, I let it be for now}
  693. if can_delete_term then
  694. begin
  695. del_curterm(cur_term);
  696. can_delete_term:=false;
  697. end;
  698. {$ifdef logging}
  699. close(f);
  700. {$endif logging}
  701. end;
  702. procedure SysClearScreen;
  703. begin
  704. if Console=ttylinux then
  705. UpdateScreen(true)
  706. else
  707. begin
  708. SendEscapeSeq(#27'[0m');
  709. SendEscapeSeqNdx(clear_screen);
  710. end;
  711. end;
  712. procedure SysUpdateScreen(Force: Boolean);
  713. var
  714. DoUpdate : boolean;
  715. i : longint;
  716. p1,p2 : plongint;
  717. begin
  718. if not force then
  719. begin
  720. {$ifdef cpui386}
  721. asm
  722. movl VideoBuf,%esi
  723. movl OldVideoBuf,%edi
  724. movl VideoBufSize,%ecx
  725. shrl $2,%ecx
  726. repe
  727. cmpsl
  728. setne DoUpdate
  729. end;
  730. {$else not cpui386}
  731. p1:=plongint(VideoBuf);
  732. p2:=plongint(OldVideoBuf);
  733. for i:=0 to VideoBufSize div 2 do
  734. if (p1^<>p2^) then
  735. begin
  736. DoUpdate:=true;
  737. break;
  738. end
  739. else
  740. begin
  741. { Inc does add sizeof(longint) to both pointer values }
  742. inc(p1);
  743. inc(p2);
  744. end;
  745. {$endif not cpui386}
  746. end
  747. else
  748. DoUpdate:=true;
  749. if not DoUpdate then
  750. exit;
  751. if Console=ttylinux then
  752. begin
  753. fplSeek(TTYFd, 4, Seek_Set);
  754. fpWrite(TTYFd, VideoBuf^,VideoBufSize);
  755. end
  756. else
  757. begin
  758. UpdateTTY(force);
  759. end;
  760. Move(VideoBuf^, OldVideoBuf^, VideoBufSize);
  761. end;
  762. function SysGetCapabilities: Word;
  763. begin
  764. { about cpColor... we should check the terminfo database... }
  765. SysGetCapabilities:=cpUnderLine + cpBlink + cpColor;
  766. end;
  767. procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
  768. var
  769. Pos : array [1..2] of Byte;
  770. begin
  771. if (CursorX=NewCursorX+1) and (CursorY=NewCursorY+1) then
  772. exit;
  773. if Console=ttylinux then
  774. begin
  775. fplSeek(TTYFd, 2, Seek_Set);
  776. Pos[1]:=NewCursorX;
  777. Pos[2]:=NewCursorY;
  778. fpWrite(TTYFd, Pos, 2);
  779. end
  780. else
  781. begin
  782. { newcursorx,y is 0 based ! }
  783. SendEscapeSeq(XY2Ansi(NewCursorX+1,NewCursorY+1,CursorX,CursorY));
  784. end;
  785. CursorX:=NewCursorX+1;
  786. CursorY:=NewCursorY+1;
  787. end;
  788. function SysGetCursorType: Word;
  789. begin
  790. SysGetCursorType:=LastCursorType;
  791. end;
  792. procedure SysSetCursorType(NewType: Word);
  793. begin
  794. If LastCursorType=NewType then
  795. exit;
  796. LastCursorType:=NewType;
  797. case NewType of
  798. crBlock :
  799. Begin
  800. If not SendEscapeSeqNdx(cursor_visible) then
  801. If Console<>ttyFreeBSD Then // should be done only for linux?
  802. SendEscapeSeq(#27'[?17;0;64c');
  803. End;
  804. crHidden :
  805. Begin
  806. If not SendEscapeSeqNdx(cursor_invisible) then
  807. If Console<>ttyFreeBSD Then
  808. SendEscapeSeq(#27'[?1c');
  809. End;
  810. else
  811. begin
  812. If not SendEscapeSeqNdx(cursor_normal) then
  813. If Console<>ttyFreeBSD Then
  814. SendEscapeSeq(#27'[?2c');
  815. end;
  816. end;
  817. end;
  818. Const
  819. SysVideoDriver : TVideoDriver = (
  820. InitDriver : @SysInitVideo;
  821. DoneDriver : @SysDoneVideo;
  822. UpdateScreen : @SysUpdateScreen;
  823. ClearScreen : @SysClearScreen;
  824. SetVideoMode : Nil;
  825. GetVideoModeCount : Nil;
  826. GetVideoModeData : Nil;
  827. SetCursorPos : @SysSetCursorPos;
  828. GetCursorType : @SysGetCursorType;
  829. SetCursorType : @SysSetCursorType;
  830. GetCapabilities : @SysGetCapabilities;
  831. );
  832. initialization
  833. SetVideoDriver(SysVideoDriver);
  834. end.
  835. {
  836. $Log$
  837. Revision 1.23 2004-07-09 19:03:35 peter
  838. * isatty return cint again
  839. Revision 1.21 2004/07/03 13:29:23 daniel
  840. * Compilation fix.
  841. Revision 1.20 2003/11/19 17:11:40 marco
  842. * termio unit
  843. Revision 1.19 2003/11/17 10:05:51 marco
  844. * threads for FreeBSD. Not working tho
  845. Revision 1.18 2003/10/26 15:32:25 marco
  846. * partial fix for bug 2212.
  847. Revision 1.17 2003/10/25 22:48:52 marco
  848. * small after merge fixes
  849. Revision 1.16 2003/10/24 17:51:39 marco
  850. * merged some fixes from 1.0.x
  851. Revision 1.15 2003/10/17 22:13:30 olle
  852. * changed i386 to cpui386
  853. Revision 1.14 2003/09/14 20:15:01 marco
  854. * Unix reform stage two. Remove all calls from Unix that exist in Baseunix.
  855. Revision 1.13 2003/03/26 12:45:21 armin
  856. * added wrapoff to avoid problems in the ide with some terminal emulators
  857. Revision 1.12 2002/09/07 16:01:28 peter
  858. * old logs removed and tabs fixed
  859. Revision 1.11 2002/07/06 16:50:17 marco
  860. * Fix for corrupt color-attr after some ACS-mode changes. (Pierre, Strassbourg
  861. meeting)
  862. }