paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-27 01:37:21 +01:00
Code Issues Packages Projects Releases Wiki Activity

* More video improvements

Browse Source 
git-svn-id: trunk@3103 -
This commit is contained in:
daniel 2006-04-01 10:24:22 +00:00
parent 147716b74d
commit e93081c0d0
1 changed files with 109 additions and 143 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

230
rtl/unix/video.pp
View File

@ -34,12 +34,15 @@ uses baseunix,termio,strings
{$i video.inc} {$i video.inc}
Type TConsoleType = (ttyNetwork type Tconsole_type=(ttyNetwork
{$ifdef linux},ttyLinux{$endif} {$ifdef linux},ttyLinux{$endif}
,ttyFreeBSD ,ttyFreeBSD
,ttyNetBSD); ,ttyNetBSD);
type Ttermcode=( Tconversion=(cv_none,
cv_vga_to_acs);
Ttermcode=(
enter_alt_charset_mode, enter_alt_charset_mode,
exit_alt_charset_mode, exit_alt_charset_mode,
clear_screen, clear_screen,
@ -55,7 +58,7 @@ type Ttermcode=(
Ttermcodes=array[Ttermcode] of Pchar; Ttermcodes=array[Ttermcode] of Pchar;
Ptermcodes=^Ttermcodes; Ptermcodes=^Ttermcodes;
const term_codes_ansi:Ttermcodes= {Linux escape sequences are equal to ansi sequences} const term_codes_ansi:Ttermcodes=
(#$1B#$5B#$31#$31#$6D, {enter_alt_charset_mode} (#$1B#$5B#$31#$31#$6D, {enter_alt_charset_mode}
#$1B#$5B#$31#$30#$6D, {exit_alt_charset_mode} #$1B#$5B#$31#$30#$6D, {exit_alt_charset_mode}
#$1B#$5B#$48#$1B#$5B#$4A, {clear_screen} #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen}
@ -155,10 +158,12 @@ const terminal_names:array[0..8] of string[7]=(
@term_codes_vt220, @term_codes_vt220,
@term_codes_xterm); @term_codes_xterm);
const convert:Tconversion=cv_none;
var var
LastCursorType : byte; LastCursorType : byte;
TtyFd: Longint; TtyFd: Longint;
Console: TConsoleType; Console: Tconsole_type;
cur_term_strings:Ptermcodes; cur_term_strings:Ptermcodes;
{$ifdef logging} {$ifdef logging}
f: file; f: file;
@ -178,95 +183,61 @@ const
{ can_delete_term : boolean = false;} { can_delete_term : boolean = false;}
ACSIn : string = ''; ACSIn : string = '';
ACSOut : string = ''; ACSOut : string = '';
InACS : boolean =false; 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.}
function IsACS(var ch,ACSchar : char): boolean;
begin begin
IsACS:=false;
case ch of case ch of
#18:
convert_vga_to_acs:=word('|');
#24, #30: {} #24, #30: {}
ch:='^'; convert_vga_to_acs:=word('^');
#25, #31: {} #25, #31: {}
ch:='v'; convert_vga_to_acs:=word('v');
#26, #16: {Never introduce a ctrl-Z ... } #26, #16: {Never introduce a ctrl-Z ... }
ch:='>'; convert_vga_to_acs:=word('>');
{#27,needed in Escape sequences} #17: {} {#27,} #17: {}
ch:='<'; convert_vga_to_acs:=word('<');
#176, #177, #178: {°±²} #176, #177, #178: {°±²}
begin convert_vga_to_acs:=$f800+word('a');
IsACS:=true;
ACSChar:='a';
end;
#180, #181, #182, #185: {´µ¶¹} #180, #181, #182, #185: {´µ¶¹}
begin convert_vga_to_acs:=$f800+word('u');
IsACS:=true;
ACSChar:='u';
end;
#183, #184, #187, #191: {·¸»¿} #183, #184, #187, #191: {·¸»¿}
begin convert_vga_to_acs:=$f800+word('k');
IsACS:=true;
ACSChar:='k';
end;
#188, #189, #190, #217: {¼½¾Ù} #188, #189, #190, #217: {¼½¾Ù}
begin convert_vga_to_acs:=$f800+word('j');
IsACS:=true;
ACSChar:='j';
end;
#192, #200, #211, #212: {ÀÈÓÔ} #192, #200, #211, #212: {ÀÈÓÔ}
begin convert_vga_to_acs:=$f800+word('m');
IsACS:=true;
ACSChar:='m';
end;
#193, #202, #207, #208: {ÁÊÏÐ} #193, #202, #207, #208: {ÁÊÏÐ}
begin convert_vga_to_acs:=$f800+word('v');
IsACS:=true;
ACSChar:='v';
end;
#194, #203, #209, #210: {ÂËÑÒ} #194, #203, #209, #210: {ÂËÑÒ}
begin convert_vga_to_acs:=$f800+word('w');
IsACS:=true;
ACSChar:='w';
end;
#195, #198, #199, #204: {ÃÆÇÌ} #195, #198, #199, #204: {ÃÆÇÌ}
begin convert_vga_to_acs:=$f800+word('t');
IsACS:=true;
ACSChar:='t';
end;
#196, #205: {ÄÍ} #196, #205: {ÄÍ}
begin convert_vga_to_acs:=$f800+word('q');
IsACS:=true;
ACSChar:='q';
end;
#179, #186: {³º} #179, #186: {³º}
begin convert_vga_to_acs:=$f800+word('x');
IsACS:=true;
ACSChar:='x';
end;
#197, #206, #215, #216: {ÅÎ×Ø} #197, #206, #215, #216: {ÅÎ×Ø}
begin convert_vga_to_acs:=$f800+word('n');
IsACS:=true;
ACSChar:='n';
end;
#201, #213, #214, #218: {ÉÕÖÚ} #201, #213, #214, #218: {ÉÕÖÚ}
begin convert_vga_to_acs:=$f800+word('l');
IsACS:=true;
ACSChar:='l';
end;
#254: { þ } #254: { þ }
begin convert_vga_to_acs:=word('*');
ch:='*';
end;
{ Shadows for Buttons } { Shadows for Buttons }
#220: { Ü } #220 { Ü },
begin
IsACS:=true;
ACSChar:='a';
end;
#223: { ß } #223: { ß }
begin convert_vga_to_acs:=$f800+word('a');
IsACS:=true; else
ACSChar:='a'; convert_vga_to_acs:=word(ch);
end;
end; end;
end; end;
@ -298,12 +269,10 @@ begin
end; end;
Function IntStr(l:longint):string; function IntStr(l:longint):string;
var
s : string;
begin begin
Str(l,s); Str(l,intstr);
IntStr:=s;
end; end;
@ -315,7 +284,18 @@ Function XY2Ansi(x,y,ox,oy:longint):String;
is (1, 1)), while SetCursorPos parameters and CursorX and CursorY is (1, 1)), while SetCursorPos parameters and CursorX and CursorY
are 0-based (top-left corner of the screen is (0, 0)). are 0-based (top-left corner of the screen is (0, 0)).
} }
Begin
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 if y=oy then
begin begin
if x=ox then if x=ox then
@ -328,40 +308,27 @@ Begin
XY2Ansi:=#13; XY2Ansi:=#13;
exit; exit;
end; end;
if x>ox then delta:=ox-x;
begin direction:=char(byte('C')+byte(x<=ox));
XY2Ansi:=#27'['+IntStr(x-ox)+'C';
exit;
end
else
begin
XY2Ansi:=#27'['+IntStr(ox-x)+'D';
exit;
end;
end; end;
if x=ox then if x=ox then
begin begin
if y>oy then delta:=oy-y;
begin direction:=char(byte('A')+byte(y>oy));
XY2Ansi:=#27'['+IntStr(y-oy)+'B';
exit;
end
else
begin
XY2Ansi:=#27'['+IntStr(oy-y)+'A';
exit;
end; end;
end;
if ((x=1) and (oy+1=y)) and (console<>ttyfreebsd) then if direction='H' then
XY2Ansi:=#13#10 movement:=intstr(y)+';'+intstr(x)
else else
XY2Ansi:=#27'['+IntStr(y)+';'+IntStr(x)+'H'; movement:=intstr(abs(delta));
End;
xy2ansi:=#27'['+movement+direction;
end;
const const ansitbl:array[0..7] of char='04261537';
AnsiTbl : string[8]='04261537';
Function Attr2Ansi(Attr,OAttr:longint):string; Function Attr2Ansi(Attr,OAttr:longint):string;
{ {
Convert Attr to an Ansi String, the Optimal code is calculate Convert Attr to an Ansi String, the Optimal code is calculate
@ -408,12 +375,12 @@ begin
if (Fg<>OFg) then if (Fg<>OFg) then
begin begin
AddSep('3'); AddSep('3');
hstr:=hstr+AnsiTbl[(Fg and 7)+1]; hstr:=hstr+AnsiTbl[fg and 7];
end; end;
if (Bg<>OBg) then if (Bg<>OBg) then
begin begin
AddSep('4'); AddSep('4');
hstr:=hstr+AnsiTbl[(Bg and 7)+1]; hstr:=hstr+AnsiTbl[bg and 7];
end; end;
if hstr='0' then if hstr='0' then
hstr:=''; hstr:='';
@ -445,37 +412,38 @@ var
p,pold : pvideocell; p,pold : pvideocell;
LastLineWidth : Longint; LastLineWidth : Longint;
procedure TransformUsingACS(var st : string); procedure transform_using_acs(var st:string);
var
res : string; var res:string;
i : longint; i:byte;
ch,ACSch : char; c:char;
begin converted:word;
begin
res:=''; res:='';
for i:=1 to length(st) do for i:=1 to length(st) do
begin begin
ch:=st[i]; c:=st[i];
if IsACS(ch,ACSch) then converted:=convert_vga_to_acs(c);
if converted and $ff00=$f800 then
begin begin
if not InACS then if not in_ACS then
begin begin
res:=res+ACSIn; res:=res+ACSIn;
InACS:=true; in_ACS:=true;
end; end;
res:=res+ACSch; c:=char(converted and $ff);
end end
else else
begin if in_ACS then
if InACS then
begin begin
res:=res+ACSOut+Attr2Ansi(LastAttr,0); res:=res+ACSOut+Attr2Ansi(LastAttr,0);
InACS:=false; in_ACS:=false;
end;
res:=res+ch;
end; end;
res:=res+c;
end; end;
st:=res; st:=res;
end; end;
@ -488,8 +456,8 @@ end;
hstr:=#13#10+hstr; hstr:=#13#10+hstr;
dec(eol); dec(eol);
end; end;
if NoExtendedFrame and (ACSIn<>'') and (ACSOut<>'') then if (convert=cv_vga_to_acs) and (ACSIn<>'') and (ACSOut<>'') then
TransformUsingACS(Hstr); transform_using_acs(Hstr);
move(hstr[1],outbuf[outptr],length(hstr)); move(hstr[1],outbuf[outptr],length(hstr));
inc(outptr,length(hstr)); inc(outptr,length(hstr));
if outptr>=1024 then if outptr>=1024 then
@ -527,6 +495,7 @@ end;
Spaces:=0; Spaces:=0;
end; end;
(*
function GetTermString(ndx:Ttermcode):String; function GetTermString(ndx:Ttermcode):String;
var var
P{,pdelay}: PChar; P{,pdelay}: PChar;
@ -545,6 +514,7 @@ begin
pdelay^:='$';} pdelay^:='$';}
end; end;
end; end;
*)
begin begin
OutPtr:=0; OutPtr:=0;
@ -657,7 +627,7 @@ begin
blockwrite(f,nl,1); blockwrite(f,nl,1);
{$endif logging} {$endif logging}
fpWrite(stdoutputhandle,outbuf,outptr); fpWrite(stdoutputhandle,outbuf,outptr);
if InACS then if in_ACS then
SendEscapeSeqNdx(exit_alt_charset_mode); SendEscapeSeqNdx(exit_alt_charset_mode);
{turn autowrap on} {turn autowrap on}
// SendEscapeSeq(#27'[?7h'); // SendEscapeSeq(#27'[?7h');
@ -803,9 +773,6 @@ const font_vga:array[0..6] of char=#15#27'%@'#27'(U';
font_custom:array[0..2] of char=#27'(K'; font_custom:array[0..2] of char=#27'(K';
begin begin
{$ifndef CPUI386}
LowAscii:=false;
{$endif CPUI386}
{ check for tty } { check for tty }
if (IsATTY(stdinputhandle)=1) then if (IsATTY(stdinputhandle)=1) then
begin begin
@ -863,7 +830,6 @@ begin
{No VGA font :( } {No VGA font :( }
fpwrite(stdoutputhandle,font_custom,3); fpwrite(stdoutputhandle,font_custom,3);
{ running on a remote terminal, no error with /dev/vcsa } { running on a remote terminal, no error with /dev/vcsa }
LowAscii:=false;
{$ifdef linux} {$ifdef linux}
end; end;
{$endif} {$endif}
@ -908,7 +874,7 @@ begin
if pos('$<',ACSOut)>0 then if pos('$<',ACSOut)>0 then
ACSOut:=Copy(ACSOut,1,Pos('$<',ACSOut)-1);} ACSOut:=Copy(ACSOut,1,Pos('$<',ACSOut)-1);}
If fpGetEnv('TERM')='xterm' then If fpGetEnv('TERM')='xterm' then
NoExtendedFrame := true; {use of acs for xterm is ok} convert:=cv_vga_to_acs; {use of acs for xterm is ok}
end end
else else
begin begin
@ -932,6 +898,7 @@ var font_custom:array[0..2] of char=#27'(K';
begin begin
prepareDoneVideo; prepareDoneVideo;
SetCursorType(crUnderLine);
{$ifdef linux} {$ifdef linux}
if Console=ttylinux then if Console=ttylinux then
SetCursorPos(0,0) SetCursorPos(0,0)
@ -942,7 +909,6 @@ begin
SendEscapeSeqNdx(cursor_home); SendEscapeSeqNdx(cursor_home);
SendEscapeSeqNdx(cursor_normal); SendEscapeSeqNdx(cursor_normal);
SendEscapeSeqNdx(cursor_visible); SendEscapeSeqNdx(cursor_visible);
SetCursorType(crUnderLine);
SendEscapeSeq(#27'[H'); SendEscapeSeq(#27'[H');
if cur_term_strings=@term_codes_linux then if cur_term_strings=@term_codes_linux then
begin begin