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

* merged more fixes

Browse Source
This commit is contained in:
peter 2000-10-15 09:17:20 +00:00
parent a22e8f54c4
commit 8a20a53d22
1 changed files with 33 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

41
api/linux/video.inc
View File

@ -20,11 +20,15 @@ const
logend: string = #10#10; logend: string = #10#10;
{$endif logging} {$endif logging}
{$ASMMODE ATT} {$ASMMODE ATT}
const
can_delete_term : boolean = false;
procedure SendEscapeSeqNdx(Ndx: Word); procedure SendEscapeSeqNdx(Ndx: Word);
var var
P: PChar; P: PChar;
begin begin
if not assigned(cur_term_Strings) then
RunError(219);
P:=cur_term_Strings^[Ndx]; P:=cur_term_Strings^[Ndx];
if assigned(p) then if assigned(p) then
fdWrite(TTYFd, P^, StrLen(P)); fdWrite(TTYFd, P^, StrLen(P));
@ -122,8 +126,8 @@ begin
Hstr:=''; Hstr:='';
Fg:=Attr and $f; Fg:=Attr and $f;
Bg:=Attr shr 4; Bg:=Attr shr 4;
OFg:=Attr and $f; OFg:=OAttr and $f;
OBg:=Attr shr 4; OBg:=OAttr shr 4;
if (OFg<>7) or (Fg=7) or ((OFg>7) and (Fg<8)) or ((OBg>7) and (Bg<8)) then if (OFg<>7) or (Fg=7) or ((OFg>7) and (Fg<8)) or ((OBg>7) and (Bg<8)) then
begin begin
hstr:='0'; hstr:='0';
@ -270,6 +274,11 @@ begin
begin begin
if (Spaces>0) then if (Spaces>0) then
OutSpaces; OutSpaces;
if ord(chattr.ch)<32 then
begin
Chattr.Attr:= $ff xor Chattr.Attr;
ChAttr.ch:= chr(ord(chattr.ch)+$30);
end;
if LastAttr<>chattr.Attr then if LastAttr<>chattr.Attr then
OutClr(chattr.Attr); OutClr(chattr.Attr);
OutData(chattr.ch); OutData(chattr.ch);
@ -384,8 +393,11 @@ var
ws_row, ws_col, ws_xpixel, ws_ypixel: Word; ws_row, ws_col, ws_xpixel, ws_ypixel: Word;
end; end;
Err: Longint; Err: Longint;
prev_term : TerminalCommon_ptr1;
begin begin
{$ifndef CPUI386}
LowAscii:=false; LowAscii:=false;
{$endif CPUI386}
if VideoBufSize<>0 then if VideoBufSize<>0 then
begin begin
clearscreen; clearscreen;
@ -422,15 +434,20 @@ begin
begin begin
{ running on a remote terminal, no error with /dev/vcsa } { running on a remote terminal, no error with /dev/vcsa }
Console:=False; Console:=False;
LowAscii:=false;
TTYFd:=stdout; TTYFd:=stdout;
end; end;
ioctl(stdin, TIOCGWINSZ, @WS); ioctl(stdin, TIOCGWINSZ, @WS);
ScreenWidth:=WS.ws_Col;
ScreenHeight:=WS.ws_Row;
if WS.ws_Col=0 then if WS.ws_Col=0 then
WS.ws_Col:=80; WS.ws_Col:=80;
if WS.ws_Row=0 then if WS.ws_Row=0 then
WS.ws_Row:=25; 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:=1; CursorX:=1;
CursorY:=1; CursorY:=1;
ScreenColor:=True; ScreenColor:=True;
@ -441,7 +458,9 @@ begin
{ Start with a clear screen } { Start with a clear screen }
if not Console then if not Console then
begin begin
prev_term:=cur_term;
setupterm(nil, stdout, err); setupterm(nil, stdout, err);
can_delete_term:=assigned(prev_term) and (prev_term<>cur_term);
SendEscapeSeqNdx(cursor_home); SendEscapeSeqNdx(cursor_home);
SendEscapeSeqNdx(cursor_normal); SendEscapeSeqNdx(cursor_normal);
SendEscapeSeqNdx(cursor_visible); SendEscapeSeqNdx(cursor_visible);
@ -449,7 +468,10 @@ begin
SetCursorType(crUnderLine); SetCursorType(crUnderLine);
end end
else if not assigned(cur_term) then else if not assigned(cur_term) then
setupterm(nil, stdout, err); begin
setupterm(nil, stdout, err);
can_delete_term:=false;
end;
ClearScreen; ClearScreen;
{$ifdef logging} {$ifdef logging}
assign(f,'video.log'); assign(f,'video.log');
@ -483,10 +505,10 @@ begin
FreeMem(OldVideoBuf,VideoBufSize); FreeMem(OldVideoBuf,VideoBufSize);
VideoBufSize:=0; VideoBufSize:=0;
doneVideoDone; doneVideoDone;
if assigned(cur_term) then if can_delete_term then
begin begin
del_curterm(cur_term); del_curterm(cur_term);
cur_term := nil; can_delete_term:=false;
end; end;
{$ifdef logging} {$ifdef logging}
close(f); close(f);
@ -605,7 +627,10 @@ end;
{ {
$Log$ $Log$
Revision 1.5 2000-10-04 11:53:31 pierre Revision 1.6 2000-10-15 09:17:20 peter
* merged more fixes
Revision 1.5 2000/10/04 11:53:31 pierre
Add TargetEntry and TargetExit (merged) Add TargetEntry and TargetExit (merged)
Revision 1.4 2000/09/26 08:18:29 jonas Revision 1.4 2000/09/26 08:18:29 jonas