paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-12 00:26:16 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Unix video unit character set conversion overhaul

Browse Source 
git-svn-id: trunk@3243 -
This commit is contained in:
daniel 2006-04-17 12:39:02 +00:00
parent e8e0d2b6eb
commit f009b5700a
4 changed files with 275 additions and 131 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
rtl/inc/video.inc
View File

@ -76,6 +76,7 @@ begin
end; end;
end; end;
(*
Procedure AssignVideoBuf (OldCols, OldRows : Word); Procedure AssignVideoBuf (OldCols, OldRows : Word);
Var NewVideoBuf,NewOldVideoBuf : PVideoBuf; Var NewVideoBuf,NewOldVideoBuf : PVideoBuf;
@ -109,6 +110,37 @@ begin
VideoBuf:=NewVideoBuf; VideoBuf:=NewVideoBuf;
OldVideoBuf:=NewOldVideoBuf; OldVideoBuf:=NewOldVideoBuf;
end; end;
*)
Procedure AssignVideoBuf (OldCols, OldRows : Word);
var NewVideoBuf,NewOldVideoBuf:PVideoBuf;
C,R,old_rowstart,new_rowstart:word;
begin
VideoBufSize:=ScreenWidth*ScreenHeight*sizeof(TVideoCell);
GetMem(NewVideoBuf,VideoBufSize);
GetMem(NewOldVideoBuf,VideoBufSize);
{Move contents of old videobuffers to new if there are any.}
if VideoBuf<>nil then
begin
if ScreenWidth<OldCols then
OldCols:=ScreenWidth;
if ScreenHeight<OldRows then
OldRows:=ScreenHeight;
old_rowstart:=0;
new_rowstart:=0;
repeat
move(VideoBuf^[old_rowstart],NewVideoBuf^[new_rowstart],C*sizeof(TVideoCell));
move(OldVideoBuf^[old_rowstart],NewOldVideoBuf^[new_rowstart],C*sizeof(TVideoCell));
inc(old_rowstart,OldCols);
inc(new_rowstart,ScreenWidth);
dec(OldRows);
until OldRows=0;
end;
FreeVideoBuf;
VideoBuf:=NewVideoBuf;
OldVideoBuf:=NewOldVideoBuf;
end;
Procedure InitVideo; Procedure InitVideo;

15
rtl/inc/videoh.inc
View File

@ -98,9 +98,18 @@ var
VideoBufSize : Longint; VideoBufSize : Longint;
CursorLines : Byte; CursorLines : Byte;
const const {The following constants were variables in the past.
LowAscii : Boolean = true; - Lowascii was set to true if ASCII characters < 32 were available
NoExtendedFrame : Boolean = false; - NoExtendedFrame was set to true if the double with line drawing
characters were set to true.
These variables did exist because of VT100 limitations on Unix. However,
only part of the character set problem was solved this way. Nowadays, the
video unit converts characters to the output character set (which might be
VT100) automatically, so the user does not need to worry about it anymore.}
LowAscii = true;
NoExtendedFrame = false;
FVMaxWidth = 132; FVMaxWidth = 132;
Procedure LockScreenUpdate; Procedure LockScreenUpdate;

1
rtl/os2/video.pp
View File

@ -94,7 +94,6 @@ begin
ScreenColor := Color >= Colors_16; ScreenColor := Color >= Colors_16;
end; end;
VioGetCurPos (CursorY, CursorX, 0); VioGetCurPos (CursorY, CursorX, 0);
LowAscii := true;
SetCursorType (LastCursorType); SetCursorType (LastCursorType);
{ Get the address of the videobuffer.} { Get the address of the videobuffer.}
if VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0) = 0 then if VioGetBuf (SysVideoBuf, PWord (@VideoBufSize)^, 0) = 0 then

346
rtl/unix/video.pp
View File

@ -13,7 +13,7 @@
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
**********************************************************************} **********************************************************************}
unit Video; unit video;
{$I-} {$I-}
{$GOTO on} {$GOTO on}
@ -24,6 +24,35 @@ unit Video;
{$i videoh.inc} {$i videoh.inc}
type Tencoding=(cp437, {Codepage 437}
cp850, {Codepage 850}
cp852, {Codepage 852}
cp866, {Codepage 866}
koi8r, {KOI8-R codepage}
iso01, {ISO 8859-1}
iso02, {ISO 8859-2}
iso03, {ISO 8859-3}
iso04, {ISO 8859-4}
iso05, {ISO 8859-5}
iso06, {ISO 8859-6}
iso07, {ISO 8859-7}
iso08, {ISO 8859-8}
iso09, {ISO 8859-9}
iso10, {ISO 8859-10}
iso13, {ISO 8859-13}
iso14, {ISO 8859-14}
iso15); {ISO 8859-15}
const {Contains all code pages that can be considered a normal vga font.
Note: KOI8-R has line drawing characters in wrong place. Support
can perhaps be added, for now we'll let it rest.}
vga_codepages=[cp437,cp850,cp852,cp866];
iso_codepages=[iso01,iso02,iso03,iso04,iso05,iso06,iso07,iso08,
iso09,iso10,iso13,iso14,iso15];
var internal_codepage,external_codepage:Tencoding;
{*****************************************************************************} {*****************************************************************************}
implementation implementation
{*****************************************************************************} {*****************************************************************************}
@ -32,7 +61,7 @@ uses baseunix,termio,strings
{$ifdef linux},linuxvcs{$endif}; {$ifdef linux},linuxvcs{$endif};
{$i video.inc} {$i video.inc}
{$i convert.inc}
type Tconsole_type=(ttyNetwork type Tconsole_type=(ttyNetwork
{$ifdef linux},ttyLinux{$endif} {$ifdef linux},ttyLinux{$endif}
@ -40,7 +69,9 @@ type Tconsole_type=(ttyNetwork
,ttyNetBSD); ,ttyNetBSD);
Tconversion=(cv_none, Tconversion=(cv_none,
cv_vga_to_acs); cv_cp437_to_iso01,
cv_cp850_to_iso01,
cv_linuxlowascii_to_vga);
Ttermcode=( Ttermcode=(
enter_alt_charset_mode, enter_alt_charset_mode,
@ -48,7 +79,8 @@ type Tconsole_type=(ttyNetwork
clear_screen, clear_screen,
cursor_home, cursor_home,
cursor_normal, cursor_normal,
cursor_visible, cursor_visible_underline,
cursor_visible_block,
cursor_invisible, cursor_invisible,
enter_ca_mode, enter_ca_mode,
exit_ca_mode, exit_ca_mode,
@ -64,7 +96,8 @@ const term_codes_ansi:Ttermcodes=
#$1B#$5B#$48#$1B#$5B#$4A, {clear_screen} #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen}
#$1B#$5B#$48, {cursor_home} #$1B#$5B#$48, {cursor_home}
nil, {cursor_normal} nil, {cursor_normal}
nil, {cursor_visible} nil, {cursor visible, underline}
nil, {cursor visible, block}
nil, {cursor_invisible} nil, {cursor_invisible}
nil, {enter_ca_mode} nil, {enter_ca_mode}
nil, {exit_ca_mode} nil, {exit_ca_mode}
@ -77,7 +110,8 @@ const term_codes_ansi:Ttermcodes=
#$1B#$5B#$48#$1B#$5B#$4A, {clear_screen} #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen}
#$1B#$5B#$48, {cursor_home} #$1B#$5B#$48, {cursor_home}
#$1B#$5B#$3D#$30#$43, {cursor_normal} #$1B#$5B#$3D#$30#$43, {cursor_normal}
#$1B#$5B#$3D#$31#$43, {cursor_visible} #$1B#$5B#$3D#$31#$43, {cursor visible, underline}
#$1B#$5B#$3D#$31#$43, {cursor visible, block}
nil, {cursor_invisible} nil, {cursor_invisible}
nil, {enter_ca_mode} nil, {enter_ca_mode}
nil, {exit_ca_mode} nil, {exit_ca_mode}
@ -89,9 +123,10 @@ const term_codes_ansi:Ttermcodes=
#$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}
#$1B#$5B#$48, {cursor_home} #$1B#$5B#$48, {cursor_home}
#$1B#$5B#$3F#$32#$35#$68#$1B#$5B#$3F#$30#$63, {cursor_normal} #$1B'[?25h'#$1B'[?0c', {cursor_normal}
#$1B#$5B#$3F#$32#$35#$68#$1B#$5B#$3F#$30#$63, {cursor_visible} #$1B'[?0c', {cursor visible, underline}
#$1B#$5B#$3F#$32#$35#$6C, {cursor_invisible} #$1B'[?17;0;127c', {cursor visible, block}
#$1B'[?1c', {cursor_invisible}
nil, {enter_ca_mode} nil, {enter_ca_mode}
nil, {exit_ca_mode} nil, {exit_ca_mode}
nil, {exit_am_mode} nil, {exit_am_mode}
@ -103,7 +138,8 @@ const term_codes_ansi:Ttermcodes=
#$1B#$5B#$48#$1B#$5B#$4A{#$24#$3C#$35#$30#$3E}, {clear_screen} #$1B#$5B#$48#$1B#$5B#$4A{#$24#$3C#$35#$30#$3E}, {clear_screen}
#$1B#$5B#$48, {cursor_home} #$1B#$5B#$48, {cursor_home}
nil, {cursor_normal} nil, {cursor_normal}
nil, {cursor_visible} nil, {cursor visible, underline}
nil, {cursor visible, block}
nil, {cursor_invisible} nil, {cursor_invisible}
nil, {enter_ca_mode} nil, {enter_ca_mode}
nil, {exit_ca_mode} nil, {exit_ca_mode}
@ -116,7 +152,8 @@ const term_codes_ansi:Ttermcodes=
#$1B#$5B#$48#$1B#$5B#$4A, {clear_screen} #$1B#$5B#$48#$1B#$5B#$4A, {clear_screen}
#$1B#$5B#$48, {cursor_home} #$1B#$5B#$48, {cursor_home}
nil, {cursor_normal} nil, {cursor_normal}
nil, {cursor_visible} nil, {cursor visible, underline}
nil, {cursor visible, block}
nil, {cursor_invisible} nil, {cursor_invisible}
nil, {enter_ca_mode} nil, {enter_ca_mode}
nil, {exit_ca_mode} nil, {exit_ca_mode}
@ -129,7 +166,8 @@ const term_codes_ansi:Ttermcodes=
#$1B#$5B#$48#$1B#$5B#$32#$4A, {clear_screen} #$1B#$5B#$48#$1B#$5B#$32#$4A, {clear_screen}
#$1B#$5B#$48, {cursor_home} #$1B#$5B#$48, {cursor_home}
#$1B#$5B#$3F#$31#$32#$6C#$1B#$5B#$3F#$32#$35#$68, {cursor_normal} #$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#$31#$32#$3B#$32#$35#$68, {cursor visible, underline}
#$1B#$5B#$3F#$31#$32#$3B#$32#$35#$68, {cursor visible, block}
#$1B#$5B#$3F#$32#$35#$6C, {cursor_invisible} #$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#$68, {enter_ca_mode}
#$1B#$5B#$3F#$31#$30#$34#$39#$6C, {exit_ca_mode} #$1B#$5B#$3F#$31#$30#$34#$39#$6C, {exit_ca_mode}
@ -242,24 +280,17 @@ begin
end; end;
function SendEscapeSeqNdx(Ndx:Ttermcode) : boolean; procedure SendEscapeSeqNdx(ndx:Ttermcode);
var
P{,pdelay}:PChar; var p:PChar;
begin begin
SendEscapeSeqNdx:=false; { Always true because of vt100 default.
if not assigned(cur_term_Strings) then if not assigned(cur_term_Strings) then
exit{RunError(219)}; exit}{RunError(219)};
P:=cur_term_Strings^[Ndx]; p:=cur_term_strings^[ndx];
if assigned(p) then if p<>nil then
begin { Do not transmit the delays } fpwrite(stdoutputhandle,p^,strlen(p));
{ pdelay:=strpos(p,'$<');
if assigned(pdelay) then
pdelay^:=#0;}
fpWrite(stdoutputhandle, P^, StrLen(P));
SendEscapeSeqNdx:=true;
{ if assigned(pdelay) then
pdelay^:='$';}
end;
end; end;
@ -325,8 +356,6 @@ begin
xy2ansi:=#27'['+movement+direction; xy2ansi:=#27'['+movement+direction;
end; end;
const ansitbl:array[0..7] of char='04261537'; const ansitbl:array[0..7] of char='04261537';
Function Attr2Ansi(Attr,OAttr:longint):string; Function Attr2Ansi(Attr,OAttr:longint):string;
@ -412,24 +441,30 @@ var
p,pold : pvideocell; p,pold : pvideocell;
LastLineWidth : Longint; LastLineWidth : Longint;
procedure transform_using_acs(var st:string); function transform_cp437_to_iso01(const st:string):string;
var res:string; var i:byte;
i:byte;
c:char; c:char;
converted:word; converted:word;
begin begin
res:=''; transform_cp437_to_iso01:='';
for i:=1 to length(st) do for i:=1 to length(st) do
begin begin
c:=st[i]; c:=st[i];
converted:=convert_vga_to_acs(c); case c of
#0..#31:
converted:=convert_lowascii_to_iso01[c];
#128..#255:
converted:=convert_cp437_to_iso01[c];
else
converted:=byte(c);
end;
if converted and $ff00=$f800 then if converted and $ff00=$f800 then
begin begin
if not in_ACS then if not in_ACS then
begin begin
res:=res+ACSIn; transform_cp437_to_iso01:=transform_cp437_to_iso01+ACSIn;
in_ACS:=true; in_ACS:=true;
end; end;
c:=char(converted and $ff); c:=char(converted and $ff);
@ -437,17 +472,92 @@ var
else else
if in_ACS then if in_ACS then
begin begin
res:=res+ACSOut+Attr2Ansi(LastAttr,0); transform_cp437_to_iso01:=transform_cp437_to_iso01+ACSOut+
Attr2Ansi(LastAttr,0);
in_ACS:=false; in_ACS:=false;
end; end;
res:=res+c; transform_cp437_to_iso01:=transform_cp437_to_iso01+c;
end; end;
st:=res;
end; end;
function transform_cp850_to_iso01(const st:string):string;
var i:byte;
c:char;
converted:word;
begin
transform_cp850_to_iso01:='';
for i:=1 to length(st) do
begin
c:=st[i];
case c of
#0..#31:
converted:=convert_lowascii_to_iso01[c];
#128..#255:
converted:=convert_cp850_to_iso01[c];
else
converted:=byte(c);
end;
if converted and $ff00=$f800 then
begin
if not in_ACS then
begin
transform_cp850_to_iso01:=transform_cp850_to_iso01+ACSIn;
in_ACS:=true;
end;
end
else
if in_ACS then
begin
transform_cp850_to_iso01:=transform_cp850_to_iso01+ACSOut+
Attr2Ansi(LastAttr,0);
in_ACS:=false;
end;
c:=char(converted and $ff);
transform_cp850_to_iso01:=transform_cp850_to_iso01+c;
end;
end;
function transform_linuxlowascii_to_vga(const st:string):string;
var i:byte;
c:char;
converted:word;
begin
transform_linuxlowascii_to_vga:='';
for i:=1 to length(st) do
begin
c:=st[i];
case c of
#0..#31:
converted:=convert_linuxlowascii_to_vga[c];
else
converted:=byte(c);
end;
c:=char(converted and $ff);
transform_linuxlowascii_to_vga:=transform_linuxlowascii_to_vga+c;
end;
end;
function transform(const hstr:string):string;
begin
case convert of
cv_linuxlowascii_to_vga:
transform:=transform_linuxlowascii_to_vga(hstr);
cv_cp437_to_iso01:
transform:=transform_cp437_to_iso01(hstr);
cv_cp850_to_iso01:
transform:=transform_cp850_to_iso01(hstr);
else
transform:=hstr;
end;
end;
procedure outdata(hstr:string); procedure outdata(hstr:string);
begin begin
If Length(HStr)>0 Then If Length(HStr)>0 Then
Begin Begin
@ -456,8 +566,8 @@ var
hstr:=#13#10+hstr; hstr:=#13#10+hstr;
dec(eol); dec(eol);
end; end;
if (convert=cv_vga_to_acs) and (ACSIn<>'') and (ACSOut<>'') then { if (convert=cv_vga_to_acs) and (ACSIn<>'') and (ACSOut<>'') then
transform_using_acs(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
@ -553,8 +663,8 @@ begin
skipped:=false; skipped:=false;
end; end;
chattr:=tchattr(p^); chattr:=tchattr(p^);
if chattr.ch in [#0,#255] then { if chattr.ch in [#0,#255] then
chattr.ch:=' '; chattr.ch:=' ';}
if chattr.ch=' ' then if chattr.ch=' ' then
begin begin
if Spaces=0 then if Spaces=0 then
@ -572,14 +682,14 @@ begin
begin begin
if (Spaces>0) then if (Spaces>0) then
OutSpaces; OutSpaces;
if ord(chattr.ch)<32 then { if ord(chattr.ch)<32 then
begin begin
Chattr.Attr:= $ff xor Chattr.Attr; Chattr.Attr:= $ff xor Chattr.Attr;
ChAttr.ch:=chr(ord(chattr.ch)+ord('A')-1); ChAttr.ch:=chr(ord(chattr.ch)+ord('A')-1);
end; end;}
if LastAttr<>chattr.Attr then if LastAttr<>chattr.Attr then
OutClr(chattr.Attr); OutClr(chattr.Attr);
OutData(chattr.ch); OutData(transform(chattr.ch));
LastX:=x+1; LastX:=x+1;
LastY:=y; LastY:=y;
end; end;
@ -597,15 +707,15 @@ begin
end; end;
eol:=0; eol:=0;
{if am in capabilities? Then} {if am in capabilities? Then}
If (Console=ttyFreeBSD) and (Plongint(p)^<>plongint(pold)^) Then if (Console=ttyFreeBSD) and (Plongint(p)^<>plongint(pold)^) Then
Begin begin
OutData(XY2Ansi(ScreenWidth,ScreenHeight,LastX,LastY)); OutData(XY2Ansi(ScreenWidth,ScreenHeight,LastX,LastY));
OutData(#8); OutData(#8);
{Output last char} {Output last char}
chattr:=tchattr(p[1]); chattr:=tchattr(p[1]);
if LastAttr<>chattr.Attr then if LastAttr<>chattr.Attr then
OutClr(chattr.Attr); OutClr(chattr.Attr);
OutData(chattr.ch); OutData(transform(chattr.ch));
inc(LastX); inc(LastX);
// OutData(XY2Ansi(ScreenWidth-1,ScreenHeight,LastX,LastY)); // OutData(XY2Ansi(ScreenWidth-1,ScreenHeight,LastX,LastY));
// OutData(GetTermString(Insert_character)); // OutData(GetTermString(Insert_character));
@ -614,7 +724,7 @@ begin
chattr:=tchattr(p^); chattr:=tchattr(p^);
if LastAttr<>chattr.Attr then if LastAttr<>chattr.Attr then
OutClr(chattr.Attr); OutClr(chattr.Attr);
OutData(chattr.ch); OutData(transform(chattr.ch));
inc(LastX); inc(LastX);
end; end;
OutData(XY2Ansi(CursorX+1,CursorY+1,LastX,LastY)); OutData(XY2Ansi(CursorX+1,CursorY+1,LastX,LastY));
@ -689,7 +799,8 @@ var
inputRaw, outputRaw: boolean; inputRaw, outputRaw: boolean;
procedure saveRawSettings(const tio: termio.termios); procedure saveRawSettings(const tio: termio.termios);
Begin
begin
with tio do with tio do
begin begin
inputRaw := inputRaw :=
@ -725,6 +836,45 @@ begin
TCSetAttr(1,TCSANOW,tio); TCSetAttr(1,TCSANOW,tio);
end; end;
procedure decide_codepages;
var s:string;
begin
{$ifdef linux}
if console=ttyLinux then
begin
s:=upcase(fpgetenv('CONSOLEFONT_CP'));
if s='CP437' then
external_codepage:=cp437
else if s='CP850' then
external_codepage:=cp850;
end;
{$endif}
{A non-vcsa Linux console can display most control characters, but not all.}
if {$ifdef linux}(console<>ttyLinux) and{$endif}
(cur_term_strings=@term_codes_linux) then
convert:=cv_linuxlowascii_to_vga;
case external_codepage of
iso01: {West Europe}
begin
internal_codepage:=cp850;
convert:=cv_cp850_to_iso01;
end;
iso02: {East Europe}
internal_codepage:=cp852;
iso05: {Cyrillic}
internal_codepage:=cp866;
else
if internal_codepage in vga_codepages then
internal_codepage:=external_codepage
else
{We don't know how to convert to the external codepage. Use codepage
437 in the hope that the actual font has similarity to codepage 437.}
internal_codepage:=cp437;
end;
end;
procedure prepareInitVideo; procedure prepareInitVideo;
begin begin
@ -769,7 +919,7 @@ var
ThisTTY: String[30]; ThisTTY: String[30];
{$endif} {$endif}
const font_vga:array[0..6] of char=#15#27'%@'#27'(U'; const font_vga:array[0..11] of char=#15#27'%@'#27'(U'#27'[3h';
font_custom:array[0..2] of char=#27'(K'; font_custom:array[0..2] of char=#27'(K';
begin begin
@ -782,6 +932,7 @@ begin
TTyfd:=-1; TTyfd:=-1;
Console:=TTyNetwork; {Default: Network or other vtxxx tty} Console:=TTyNetwork; {Default: Network or other vtxxx tty}
cur_term_strings:=@term_codes_vt100; {Default: vt100} cur_term_strings:=@term_codes_vt100; {Default: vt100}
external_codepage:=iso01; {Default: ISO-8859-1}
{$ifdef linux} {$ifdef linux}
if vcs_device>=0 then if vcs_device>=0 then
begin begin
@ -796,7 +947,10 @@ begin
begin begin
ttyfd:=fpopen(fname,$1b6,O_RDWR); ttyfd:=fpopen(fname,$1b6,O_RDWR);
if ttyfd<>-1 then if ttyfd<>-1 then
begin
console:=ttylinux; console:=ttylinux;
external_codepage:=cp437; {VCSA defaults to codepage 437.}
end;
end; end;
end; end;
{$endif} {$endif}
@ -824,11 +978,12 @@ begin
{Executed in case ttylinux is false (i.e. no vcsa), but {Executed in case ttylinux is false (i.e. no vcsa), but
TERM=linux.} TERM=linux.}
{Enable the VGA character set (codepage 437,850,....)} {Enable the VGA character set (codepage 437,850,....)}
fpwrite(stdoutputhandle,font_vga,7); fpwrite(stdoutputhandle,font_vga,sizeof(font_vga));
external_codepage:=cp437; {Now default to codepage 437.}
end end
else else
{No VGA font :( } {No VGA font :( }
fpwrite(stdoutputhandle,font_custom,3); fpwrite(stdoutputhandle,font_custom,sizeof(font_vga));
{ running on a remote terminal, no error with /dev/vcsa } { running on a remote terminal, no error with /dev/vcsa }
{$ifdef linux} {$ifdef linux}
end; end;
@ -855,7 +1010,7 @@ begin
{$endif} {$endif}
SendEscapeSeqNdx(cursor_home); SendEscapeSeqNdx(cursor_home);
SendEscapeSeqNdx(cursor_normal); SendEscapeSeqNdx(cursor_normal);
SendEscapeSeqNdx(cursor_visible); SendEscapeSeqNdx(cursor_visible_underline);
SendEscapeSeqNdx(enter_ca_mode); SendEscapeSeqNdx(enter_ca_mode);
SetCursorType(crUnderLine); SetCursorType(crUnderLine);
If Console=ttyFreeBSD Then If Console=ttyFreeBSD Then
@ -863,24 +1018,21 @@ begin
{$ifdef linux} {$ifdef linux}
end; end;
{$endif} {$endif}
{ Always true because of vt100 default...
if assigned(cur_term_Strings) then if assigned(cur_term_Strings) then
begin begin}
ACSIn:=StrPas(cur_term_strings^[enter_alt_charset_mode]); ACSIn:=StrPas(cur_term_strings^[enter_alt_charset_mode]);
ACSOut:=StrPas(cur_term_strings^[exit_alt_charset_mode]); ACSOut:=StrPas(cur_term_strings^[exit_alt_charset_mode]);
if (ACSIn<>'') and (ACSOut<>'') then if (ACSIn<>'') and (ACSOut<>'') then
SendEscapeSeqNdx(ena_acs); SendEscapeSeqNdx(ena_acs);
{ if pos('$<',ACSIn)>0 then (* If fpGetEnv('TERM')='xterm' then
ACSIn:=Copy(ACSIn,1,Pos('$<',ACSIn)-1); convert:=cv_vga_to_acs; {use of acs for xterm is ok}*)
if pos('$<',ACSOut)>0 then { end
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 else
begin begin
ACSIn:=''; ACSIn:='';
ACSOut:=''; ACSOut:='';
end; end;}
{$ifdef logging} {$ifdef logging}
assign(f,'video.log'); assign(f,'video.log');
rewrite(f,1); rewrite(f,1);
@ -890,6 +1042,8 @@ begin
end end
else else
ErrorCode:=errVioInit; { not a TTY } ErrorCode:=errVioInit; { not a TTY }
decide_codepages;
end; end;
procedure SysDoneVideo; procedure SysDoneVideo;
@ -908,7 +1062,7 @@ begin
SendEscapeSeqNdx(exit_ca_mode); SendEscapeSeqNdx(exit_ca_mode);
SendEscapeSeqNdx(cursor_home); SendEscapeSeqNdx(cursor_home);
SendEscapeSeqNdx(cursor_normal); SendEscapeSeqNdx(cursor_normal);
SendEscapeSeqNdx(cursor_visible); SendEscapeSeqNdx(cursor_visible_underline);
SendEscapeSeq(#27'[H'); SendEscapeSeq(#27'[H');
if cur_term_strings=@term_codes_linux then if cur_term_strings=@term_codes_linux then
begin begin
@ -951,51 +1105,13 @@ var
i : longint; i : longint;
p1,p2 : plongint; p1,p2 : plongint;
begin 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} {$ifdef linux}
if Console=ttylinux then if console=ttylinux then
update_vcsa(force) update_vcsa(force)
else else
{$endif} {$endif}
UpdateTTY(force); updateTTY(force);
Move(VideoBuf^, OldVideoBuf^, VideoBufSize); move(VideoBuf^,OldVideoBuf^,VideoBufSize);
end; end;
@ -1041,23 +1157,11 @@ begin
LastCursorType:=NewType; LastCursorType:=NewType;
case NewType of case NewType of
crBlock: crBlock:
Begin SendEscapeSeqNdx(cursor_visible_block);
If not SendEscapeSeqNdx(cursor_visible) then
If Console<>ttyFreeBSD Then // should be done only for linux?
SendEscapeSeq(#27'[?17;0;64c');
End;
crHidden: crHidden:
Begin SendEscapeSeqNdx(cursor_invisible);
If not SendEscapeSeqNdx(cursor_invisible) then
If Console<>ttyFreeBSD Then
SendEscapeSeq(#27'[?1c');
End;
else else
begin SendEscapeSeqNdx(cursor_normal);
If not SendEscapeSeqNdx(cursor_normal) then
If Console<>ttyFreeBSD Then
SendEscapeSeq(#27'[?2c');
end;
end; end;
end; end;