{ This file is part of the Free Pascal run time library. Copyright (c) 1999-2000 by Florian Klaempfl member of the Free Pascal development team Video unit for linux See the file COPYING.FPC, included in this distribution, for details about the copyright. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. **********************************************************************} unit Video; {$I-} {$GOTO on} {*****************************************************************************} interface {*****************************************************************************} {$i videoh.inc} {*****************************************************************************} implementation {*****************************************************************************} uses baseunix,termio,strings {$ifdef linux},linuxvcs{$endif}; {$i video.inc} type Tconsole_type=(ttyNetwork {$ifdef linux},ttyLinux{$endif} ,ttyFreeBSD ,ttyNetBSD); Tconversion=(cv_none, cv_vga_to_acs); Ttermcode=( enter_alt_charset_mode, exit_alt_charset_mode, clear_screen, cursor_home, cursor_normal, cursor_visible, cursor_invisible, enter_ca_mode, exit_ca_mode, exit_am_mode, ena_acs ); Ttermcodes=array[Ttermcode] of Pchar; Ptermcodes=^Ttermcodes; const term_codes_ansi:Ttermcodes= (#$1B#$5B#$31#$31#$6D, {enter_alt_charset_mode} #$1B#$5B#$31#$30#$6D, {exit_alt_charset_mode} #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen} #$1B#$5B#$48, {cursor_home} nil, {cursor_normal} nil, {cursor_visible} nil, {cursor_invisible} nil, {enter_ca_mode} nil, {exit_ca_mode} nil, {exit_am_mode} nil); {ena_acs} term_codes_freebsd:Ttermcodes= (nil, {enter_alt_charset_mode} nil, {exit_alt_charset_mode} #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen} #$1B#$5B#$48, {cursor_home} #$1B#$5B#$3D#$30#$43, {cursor_normal} #$1B#$5B#$3D#$31#$43, {cursor_visible} nil, {cursor_invisible} nil, {enter_ca_mode} nil, {exit_ca_mode} nil, {exit_am_mode} nil); {ena_acs} term_codes_linux:Ttermcodes= (#$1B#$5B#$31#$31#$6D, {enter_alt_charset_mode} #$1B#$5B#$31#$30#$6D, {exit_alt_charset_mode} #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen} #$1B#$5B#$48, {cursor_home} #$1B#$5B#$3F#$32#$35#$68#$1B#$5B#$3F#$30#$63, {cursor_normal} #$1B#$5B#$3F#$32#$35#$68#$1B#$5B#$3F#$30#$63, {cursor_visible} #$1B#$5B#$3F#$32#$35#$6C, {cursor_invisible} nil, {enter_ca_mode} nil, {exit_ca_mode} nil, {exit_am_mode} nil); {ena_acs} term_codes_vt100:Ttermcodes= (#$0E, {enter_alt_charset_mode} #$0F, {exit_alt_charset_mode} #$1B#$5B#$48#$1B#$5B#$4A{#$24#$3C#$35#$30#$3E}, {clear_screen} #$1B#$5B#$48, {cursor_home} nil, {cursor_normal} nil, {cursor_visible} nil, {cursor_invisible} nil, {enter_ca_mode} nil, {exit_ca_mode} #$1B#$5B#$3F#$37#$6C, {exit_am_mode} #$1B#$28#$42#$1B#$29#$30); {ena_acs} term_codes_vt220:Ttermcodes= (#$1B#$28#$30{#$24#$3C#$32#$3E}, {enter_alt_charset_mode} #$1B#$28#$42{#$24#$3C#$34#$3E}, {exit_alt_charset_mode} #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen} #$1B#$5B#$48, {cursor_home} nil, {cursor_normal} nil, {cursor_visible} nil, {cursor_invisible} nil, {enter_ca_mode} nil, {exit_ca_mode} #$1B#$5B#$3F#$37#$6C, {exit_am_mode} #$1B#$29#$30); {ena_acs} term_codes_xterm:Ttermcodes= (#$0E, {enter_alt_charset_mode} #$0F, {exit_alt_charset_mode} #$1B#$5B#$48#$1B#$5B#$32#$4A, {clear_screen} #$1B#$5B#$48, {cursor_home} #$1B#$5B#$3F#$31#$32#$6C#$1B#$5B#$3F#$32#$35#$68, {cursor_normal} #$1B#$5B#$3F#$31#$32#$3B#$32#$35#$68, {cursor_visible} #$1B#$5B#$3F#$32#$35#$6C, {cursor_invisible} #$1B#$5B#$3F#$31#$30#$34#$39#$68, {enter_ca_mode} #$1B#$5B#$3F#$31#$30#$34#$39#$6C, {exit_ca_mode} #$1B#$5B#$3F#$37#$6C, {exit_am_mode} #$1B#$28#$42#$1B#$29#$30); {ena_acs} const terminal_names:array[0..8] of string[7]=( 'ansi', 'cons', 'eterm', 'gnome', 'konsole', 'linux', 'vt100', 'vt220', 'xterm'); terminal_data:array[0..8] of Ptermcodes=( @term_codes_ansi, @term_codes_freebsd, @term_codes_xterm, @term_codes_xterm, @term_codes_xterm, @term_codes_linux, @term_codes_vt100, @term_codes_vt220, @term_codes_xterm); const convert:Tconversion=cv_none; var LastCursorType : byte; TtyFd: Longint; Console: Tconsole_type; cur_term_strings:Ptermcodes; {$ifdef logging} f: file; const logstart: string = ''; nl: char = #10; logend: string = #10#10; {$endif logging} {$ifdef cpui386} {$ASMMODE ATT} {$endif cpui386} const { can_delete_term : boolean = false;} ACSIn : string = ''; ACSOut : string = ''; in_ACS : boolean =false; function convert_vga_to_acs(ch:char):word; {Ch contains a character in the VGA character set (i.e. codepage 437). This routine tries to convert some VGA symbols as well as possible to the xterm alternate character set. Return type is word to allow expanding to UCS-2 characters in the future.} begin case ch of #18: convert_vga_to_acs:=word('|'); #24, #30: {} convert_vga_to_acs:=word('^'); #25, #31: {} convert_vga_to_acs:=word('v'); #26, #16: {Never introduce a ctrl-Z ... } convert_vga_to_acs:=word('>'); {#27,} #17: {} convert_vga_to_acs:=word('<'); #176, #177, #178: {°±²} convert_vga_to_acs:=$f800+word('a'); #180, #181, #182, #185: {´µ¶¹} convert_vga_to_acs:=$f800+word('u'); #183, #184, #187, #191: {·¸»¿} convert_vga_to_acs:=$f800+word('k'); #188, #189, #190, #217: {¼½¾Ù} convert_vga_to_acs:=$f800+word('j'); #192, #200, #211, #212: {ÀÈÓÔ} convert_vga_to_acs:=$f800+word('m'); #193, #202, #207, #208: {ÁÊÏÐ} convert_vga_to_acs:=$f800+word('v'); #194, #203, #209, #210: {ÂËÑÒ} convert_vga_to_acs:=$f800+word('w'); #195, #198, #199, #204: {ÃÆÇÌ} convert_vga_to_acs:=$f800+word('t'); #196, #205: {ÄÍ} convert_vga_to_acs:=$f800+word('q'); #179, #186: {³º} convert_vga_to_acs:=$f800+word('x'); #197, #206, #215, #216: {ÅÎר} convert_vga_to_acs:=$f800+word('n'); #201, #213, #214, #218: {ÉÕÖÚ} convert_vga_to_acs:=$f800+word('l'); #254: { þ } convert_vga_to_acs:=word('*'); { Shadows for Buttons } #220 { Ü }, #223: { ß } convert_vga_to_acs:=$f800+word('a'); else convert_vga_to_acs:=word(ch); end; end; function SendEscapeSeqNdx(Ndx:Ttermcode) : boolean; var P{,pdelay}:PChar; begin SendEscapeSeqNdx:=false; if not assigned(cur_term_Strings) then exit{RunError(219)}; P:=cur_term_Strings^[Ndx]; if assigned(p) then begin { Do not transmit the delays } { pdelay:=strpos(p,'$<'); if assigned(pdelay) then pdelay^:=#0;} fpWrite(stdoutputhandle, P^, StrLen(P)); SendEscapeSeqNdx:=true; { if assigned(pdelay) then pdelay^:='$';} end; end; procedure SendEscapeSeq(const S: String); begin fpWrite(stdoutputhandle, S[1], Length(S)); end; function IntStr(l:longint):string; begin Str(l,intstr); end; Function XY2Ansi(x,y,ox,oy:longint):String; { Returns a string with the escape sequences to go to X,Y on the screen. Note that x, y, ox, oy are 1-based (i.e. top-left corner of the screen is (1, 1)), while SetCursorPos parameters and CursorX and CursorY are 0-based (top-left corner of the screen is (0, 0)). } var delta:longint; direction:char; movement:string[32]; begin if ((x=1) and (oy+1=y)) and (console<>ttyfreebsd) then begin XY2Ansi:=#13#10; exit; end; direction:='H'; if y=oy then begin if x=ox then begin XY2Ansi:=''; exit; end; if x=1 then begin XY2Ansi:=#13; exit; end; delta:=ox-x; direction:=char(byte('C')+byte(x<=ox)); end; if x=ox then begin delta:=oy-y; direction:=char(byte('A')+byte(y>oy)); end; if direction='H' then movement:=intstr(y)+';'+intstr(x) else movement:=intstr(abs(delta)); xy2ansi:=#27'['+movement+direction; end; const ansitbl:array[0..7] of char='04261537'; Function Attr2Ansi(Attr,OAttr:longint):string; { Convert Attr to an Ansi String, the Optimal code is calculate with use of the old OAttr } var hstr : string[16]; OFg,OBg,Fg,Bg : longint; procedure AddSep(ch:char); begin if length(hstr)>0 then hstr:=hstr+';'; hstr:=hstr+ch; end; begin if Attr=OAttr then begin Attr2Ansi:=''; exit; end; Hstr:=''; Fg:=Attr and $f; Bg:=Attr shr 4; OFg:=OAttr and $f; OBg:=OAttr shr 4; if (OFg<>7) or (Fg=7) or ((OFg>7) and (Fg<8)) or ((OBg>7) and (Bg<8)) then begin hstr:='0'; OFg:=7; OBg:=0; end; if (Fg>7) and (OFg<8) then begin AddSep('1'); OFg:=OFg or 8; end; if (Bg and 8)<>(OBg and 8) then begin AddSep('5'); OBg:=OBg or 8; end; if (Fg<>OFg) then begin AddSep('3'); hstr:=hstr+AnsiTbl[fg and 7]; end; if (Bg<>OBg) then begin AddSep('4'); hstr:=hstr+AnsiTbl[bg and 7]; end; if hstr='0' then hstr:=''; Attr2Ansi:=#27'['+hstr+'m'; end; procedure UpdateTTY(Force:boolean); type tchattr=packed record {$ifdef ENDIAN_LITTLE} ch : char; attr : byte; {$else} attr : byte; ch : char; {$endif} end; var outbuf : array[0..1023+255] of char; chattr : tchattr; skipped : boolean; outptr, spaces, eol, x,y, LastX,LastY, SpaceAttr, LastAttr : longint; p,pold : pvideocell; LastLineWidth : Longint; procedure transform_using_acs(var st:string); var res:string; i:byte; c:char; converted:word; begin res:=''; for i:=1 to length(st) do begin c:=st[i]; converted:=convert_vga_to_acs(c); if converted and $ff00=$f800 then begin if not in_ACS then begin res:=res+ACSIn; in_ACS:=true; end; c:=char(converted and $ff); end else if in_ACS then begin res:=res+ACSOut+Attr2Ansi(LastAttr,0); in_ACS:=false; end; res:=res+c; end; st:=res; end; procedure outdata(hstr:string); begin If Length(HStr)>0 Then Begin while (eol>0) do begin hstr:=#13#10+hstr; dec(eol); end; if (convert=cv_vga_to_acs) and (ACSIn<>'') and (ACSOut<>'') then transform_using_acs(Hstr); move(hstr[1],outbuf[outptr],length(hstr)); inc(outptr,length(hstr)); if outptr>=1024 then begin {$ifdef logging} blockwrite(f,logstart[1],length(logstart)); blockwrite(f,nl,1); blockwrite(f,outptr,sizeof(outptr)); blockwrite(f,nl,1); blockwrite(f,outbuf,outptr); blockwrite(f,nl,1); {$endif logging} fpWrite(stdoutputhandle,outbuf,outptr); outptr:=0; end; end; end; procedure OutClr(c:byte); begin if c=LastAttr then exit; OutData(Attr2Ansi(c,LastAttr)); LastAttr:=c; end; procedure OutSpaces; begin if (Spaces=0) then exit; OutClr(SpaceAttr); OutData(Space(Spaces)); LastX:=x; LastY:=y; Spaces:=0; end; (* function GetTermString(ndx:Ttermcode):String; var P{,pdelay}: PChar; begin GetTermString:=''; if not assigned(cur_term_Strings) then exit{RunError(219)}; P:=cur_term_Strings^[Ndx]; if assigned(p) then begin { Do not transmit the delays } { pdelay:=strpos(p,'$<'); if assigned(pdelay) then pdelay^:=#0;} GetTermString:=StrPas(p); { if assigned(pdelay) then pdelay^:='$';} end; end; *) begin OutPtr:=0; Eol:=0; skipped:=true; p:=PVideoCell(VideoBuf); pold:=PVideoCell(OldVideoBuf); { init Attr, X,Y and set autowrap off } SendEscapeSeq(#27'[m'#27'[?7l'{#27'[H'} ); // 1.0.x: SendEscapeSeq(#27'[m'{#27'[H'}); LastAttr:=7; LastX:=-1; LastY:=-1; for y:=1 to ScreenHeight do begin SpaceAttr:=0; Spaces:=0; LastLineWidth:=ScreenWidth; If (y=ScreenHeight) And (Console=ttyFreeBSD) {And :am: is on} Then LastLineWidth:=ScreenWidth-2; for x:=1 to LastLineWidth do begin if (not force) and (p^=pold^) then begin if (Spaces>0) then OutSpaces; skipped:=true; end else begin if skipped then begin OutData(XY2Ansi(x,y,LastX,LastY)); LastX:=x; LastY:=y; skipped:=false; end; chattr:=tchattr(p^); if chattr.ch in [#0,#255] then chattr.ch:=' '; if chattr.ch=' ' then begin if Spaces=0 then SpaceAttr:=chattr.Attr; if (chattr.attr and $f0)=(spaceattr and $f0) then chattr.Attr:=SpaceAttr else begin OutSpaces; SpaceAttr:=chattr.Attr; end; inc(Spaces); end else begin if (Spaces>0) then OutSpaces; if ord(chattr.ch)<32 then begin Chattr.Attr:= $ff xor Chattr.Attr; ChAttr.ch:= chr(ord(chattr.ch)+ord('A')-1); end; if LastAttr<>chattr.Attr then OutClr(chattr.Attr); OutData(chattr.ch); LastX:=x+1; LastY:=y; end; p^:=tvideocell(chattr); end; inc(p); inc(pold); end; if (Spaces>0) then OutSpaces; if force then inc(eol) else skipped:=true; end; eol:=0; {if am in capabilities? Then} If (Console=ttyFreeBSD) and (Plongint(p)^<>plongint(pold)^) Then Begin OutData(XY2Ansi(ScreenWidth,ScreenHeight,LastX,LastY)); OutData(#8); {Output last char} chattr:=tchattr(p[1]); if LastAttr<>chattr.Attr then OutClr(chattr.Attr); OutData(chattr.ch); inc(LastX); // OutData(XY2Ansi(ScreenWidth-1,ScreenHeight,LastX,LastY)); // OutData(GetTermString(Insert_character)); OutData(#8+#27+'[1@'); chattr:=tchattr(p^); if LastAttr<>chattr.Attr then OutClr(chattr.Attr); OutData(chattr.ch); inc(LastX); end; OutData(XY2Ansi(CursorX+1,CursorY+1,LastX,LastY)); {$ifdef logging} blockwrite(f,logstart[1],length(logstart)); blockwrite(f,nl,1); blockwrite(f,outptr,sizeof(outptr)); blockwrite(f,nl,1); blockwrite(f,outbuf,outptr); blockwrite(f,nl,1); {$endif logging} fpWrite(stdoutputhandle,outbuf,outptr); if in_ACS then SendEscapeSeqNdx(exit_alt_charset_mode); {turn autowrap on} // SendEscapeSeq(#27'[?7h'); end; {$ifdef linux} procedure update_vcsa(force:boolean); const max_updates=64; label update,update_all,equal_loop,unequal_loop; var position,update_count,i:word; update_positions:array[0..max_updates-1] of word; update_lengths:array[0..max_updates-1] of word; begin if force then goto update_all; update_count:=0; i:=0; equal_loop: repeat if videobuf^[i]<>oldvideobuf^[i] then goto unequal_loop; inc(i); until i>videobufsize div 2; goto update; unequal_loop: if update_count>=max_updates then goto update_all; update_positions[update_count]:=i; update_lengths[update_count]:=0; inc(update_count); repeat if videobuf^[i]=oldvideobuf^[i] then goto equal_loop; inc(i); inc(update_lengths[update_count-1]); until i>videobufsize div 2; update: for i:=1 to update_count do begin position:=update_positions[i-1]; fppwrite(ttyfd,videobuf^[position],update_lengths[i-1]*2,4+position*2); end; exit; update_all: fppwrite(ttyfd,videobuf^,videobufsize,4); end; {$endif} var preInitVideoTio, postInitVideoTio: termio.termios; inputRaw, outputRaw: boolean; procedure saveRawSettings(const tio: termio.termios); Begin with tio do begin inputRaw := ((c_iflag and (IGNBRK or BRKINT or PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON)) = 0) and ((c_lflag and (ECHO or ECHONL or ICANON or ISIG or IEXTEN)) = 0); outPutRaw := ((c_oflag and OPOST) = 0) and ((c_cflag and (CSIZE or PARENB)) = 0) and ((c_cflag and CS8) <> 0); end; end; procedure restoreRawSettings(tio: termio.termios); begin with tio do begin if inputRaw then begin c_iflag := c_iflag and (not (IGNBRK or BRKINT or PARMRK or ISTRIP or INLCR or IGNCR or ICRNL or IXON)); c_lflag := c_lflag and (not (ECHO or ECHONL or ICANON or ISIG or IEXTEN)); c_cc[VMIN]:=1; c_cc[VTIME]:=0; end; if outPutRaw then begin c_oflag := c_oflag and not(OPOST); c_cflag := c_cflag and not(CSIZE or PARENB) or CS8; end; end; TCSetAttr(1,TCSANOW,tio); end; procedure prepareInitVideo; begin TCGetAttr(1,preInitVideoTio); saveRawSettings(preInitVideoTio); end; procedure videoInitDone; begin TCGetAttr(1,postInitVideoTio); restoreRawSettings(postInitVideoTio); end; procedure prepareDoneVideo; var tio: termio.termios; begin TCGetAttr(1,tio); saveRawSettings(tio); TCSetAttr(1,TCSANOW,postInitVideoTio); end; procedure doneVideoDone; begin restoreRawSettings(preInitVideoTio); end; procedure SysInitVideo; var FName: String; WS: packed record ws_row, ws_col, ws_xpixel, ws_ypixel: Word; end; { Err: Longint;} { prev_term : TerminalCommon_ptr1;} term:string; i:word; {$ifdef Linux} s:string[15]; {$endif} {$ifdef freebsd} ThisTTY: String[30]; {$endif} const font_vga:array[0..6] of char=#15#27'%@'#27'(U'; font_custom:array[0..2] of char=#27'(K'; begin { check for tty } if (IsATTY(stdinputhandle)=1) then begin { save current terminal characteristics and remove rawness } prepareInitVideo; { running on a tty, find out whether locally or remotely } TTyfd:=-1; Console:=TTyNetwork; {Default: Network or other vtxxx tty} cur_term_strings:=@term_codes_vt100; {Default: vt100} {$ifdef linux} if vcs_device>=0 then begin str(vcs_device,s); fname:='/dev/vcsa'+s; { open console, $1b6=rw-rw-rw- } ttyfd:=fpopen(fname,$1b6,O_RDWR); if ttyfd<>-1 then console:=ttylinux else if try_grab_vcsa then begin ttyfd:=fpopen(fname,$1b6,O_RDWR); if ttyfd<>-1 then console:=ttylinux; end; end; {$endif} {$ifdef freebsd} ThisTTY:=TTYName(stdinputhandle); if copy(ThisTTY, 1, 9) = '/dev/ttyv' then {FreeBSD has these} begin { check for (Free?)BSD native} if (ThisTTY[10]>='0') and (ThisTTY[10]<='9') Then Console:=ttyFreeBSD; {TTYFd ?} end; {$endif} term:=fpgetenv('TERM'); for i:=low(terminal_names) to high(terminal_names) do if copy(term,1,length(terminal_names[i]))=terminal_names[i] then cur_term_strings:=terminal_data[i]; if cur_term_strings=@term_codes_freebsd then console:=ttyFreeBSD; {$ifdef linux} if (console<>ttylinux) then begin {$endif} if cur_term_strings=@term_codes_linux then begin {Executed in case ttylinux is false (i.e. no vcsa), but TERM=linux.} {Enable the VGA character set (codepage 437,850,....)} fpwrite(stdoutputhandle,font_vga,7); end else {No VGA font :( } fpwrite(stdoutputhandle,font_custom,3); { running on a remote terminal, no error with /dev/vcsa } {$ifdef linux} end; {$endif} fpioctl(stdinputhandle, TIOCGWINSZ, @WS); if WS.ws_Col=0 then WS.ws_Col:=80; if WS.ws_Row=0 then WS.ws_Row:=25; ScreenWidth:=WS.ws_Col; { TDrawBuffer only has FVMaxWidth elements larger values lead to crashes } if ScreenWidth> FVMaxWidth then ScreenWidth:=FVMaxWidth; ScreenHeight:=WS.ws_Row; CursorX:=0; CursorY:=0; LastCursorType:=$ff; ScreenColor:=True; { Start with a clear screen } {$ifdef linux} if Console<>ttylinux then begin {$endif} SendEscapeSeqNdx(cursor_home); SendEscapeSeqNdx(cursor_normal); SendEscapeSeqNdx(cursor_visible); SendEscapeSeqNdx(enter_ca_mode); SetCursorType(crUnderLine); If Console=ttyFreeBSD Then SendEscapeSeqNdx(exit_am_mode); {$ifdef linux} end; {$endif} if assigned(cur_term_Strings) then begin ACSIn:=StrPas(cur_term_strings^[enter_alt_charset_mode]); ACSOut:=StrPas(cur_term_strings^[exit_alt_charset_mode]); if (ACSIn<>'') and (ACSOut<>'') then SendEscapeSeqNdx(ena_acs); { if pos('$<',ACSIn)>0 then ACSIn:=Copy(ACSIn,1,Pos('$<',ACSIn)-1); if pos('$<',ACSOut)>0 then ACSOut:=Copy(ACSOut,1,Pos('$<',ACSOut)-1);} If fpGetEnv('TERM')='xterm' then convert:=cv_vga_to_acs; {use of acs for xterm is ok} end else begin ACSIn:=''; ACSOut:=''; end; {$ifdef logging} assign(f,'video.log'); rewrite(f,1); {$endif logging} { save new terminal characteristics and possible restore rawness } videoInitDone; end else ErrorCode:=errVioInit; { not a TTY } end; procedure SysDoneVideo; var font_custom:array[0..2] of char=#27'(K'; begin prepareDoneVideo; SetCursorType(crUnderLine); {$ifdef linux} if Console=ttylinux then SetCursorPos(0,0) else begin {$endif} SendEscapeSeqNdx(exit_ca_mode); SendEscapeSeqNdx(cursor_home); SendEscapeSeqNdx(cursor_normal); SendEscapeSeqNdx(cursor_visible); SendEscapeSeq(#27'[H'); if cur_term_strings=@term_codes_linux then begin {Executed in case ttylinux is false (i.e. no vcsa), but TERM=linux.} {Enable the character set set through setfont} fpwrite(stdoutputhandle,font_custom,3); end; {$ifdef linux} end; {$endif} ACSIn:=''; ACSOut:=''; doneVideoDone; {$ifdef logging} close(f); {$endif logging} end; procedure SysClearScreen; begin {$ifdef linux} if Console=ttylinux then UpdateScreen(true) else begin {$endif} SendEscapeSeq(#27'[0m'); SendEscapeSeqNdx(clear_screen); {$ifdef linux} end; {$endif} end; procedure SysUpdateScreen(Force: Boolean); var DoUpdate : boolean; i : longint; p1,p2 : plongint; begin (* if not force then begin {$ifdef cpui386} asm pushl %esi pushl %edi movl VideoBuf,%esi movl OldVideoBuf,%edi movl VideoBufSize,%ecx shrl $2,%ecx repe cmpsl setne DoUpdate popl %edi popl %esi end; {$else not cpui386} p1:=plongint(VideoBuf); p2:=plongint(OldVideoBuf); for i:=0 to VideoBufSize div 2 do if (p1^<>p2^) then begin DoUpdate:=true; break; end else begin { Inc does add sizeof(longint) to both pointer values } inc(p1); inc(p2); end; {$endif not cpui386} end else DoUpdate:=true; if not DoUpdate then exit;*) {$ifdef linux} if Console=ttylinux then update_vcsa(force) else {$endif} UpdateTTY(force); Move(VideoBuf^, OldVideoBuf^, VideoBufSize); end; function SysGetCapabilities: Word; begin { about cpColor... we should check the terminfo database... } SysGetCapabilities:=cpUnderLine + cpBlink + cpColor; end; procedure SysSetCursorPos(NewCursorX, NewCursorY: Word); var Pos : array [1..2] of Byte; begin if (CursorX=NewCursorX) and (CursorY=NewCursorY) then exit; {$ifdef linux} if Console=ttylinux then begin Pos[1]:=NewCursorX; Pos[2]:=NewCursorY; fppwrite(ttyfd,pos,2,2); end else {$endif} { newcursorx,y and CursorX,Y are 0 based ! } SendEscapeSeq(XY2Ansi(NewCursorX+1,NewCursorY+1,CursorX+1,CursorY+1)); CursorX:=NewCursorX; CursorY:=NewCursorY; end; function SysGetCursorType: Word; begin SysGetCursorType:=LastCursorType; end; procedure SysSetCursorType(NewType: Word); begin If LastCursorType=NewType then exit; LastCursorType:=NewType; case NewType of crBlock : Begin If not SendEscapeSeqNdx(cursor_visible) then If Console<>ttyFreeBSD Then // should be done only for linux? SendEscapeSeq(#27'[?17;0;64c'); End; crHidden : Begin If not SendEscapeSeqNdx(cursor_invisible) then If Console<>ttyFreeBSD Then SendEscapeSeq(#27'[?1c'); End; else begin If not SendEscapeSeqNdx(cursor_normal) then If Console<>ttyFreeBSD Then SendEscapeSeq(#27'[?2c'); end; end; end; Const SysVideoDriver : TVideoDriver = ( InitDriver : @SysInitVideo; DoneDriver : @SysDoneVideo; UpdateScreen : @SysUpdateScreen; ClearScreen : @SysClearScreen; SetVideoMode : Nil; GetVideoModeCount : Nil; GetVideoModeData : Nil; SetCursorPos : @SysSetCursorPos; GetCursorType : @SysGetCursorType; SetCursorType : @SysSetCursorType; GetCapabilities : @SysGetCapabilities; ); initialization SetVideoDriver(SysVideoDriver); end.