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

* fixes for window (from "Heinz Ziegenhorn" <info@ziegenhorn.de>)

Browse Source
This commit is contained in:
peter 1998-07-04 11:17:18 +00:00
parent 34ade816f2
commit e5557711dc
1 changed files with 57 additions and 60 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
rtl/linux/crt.pp
View File

@ -161,7 +161,7 @@ end;
Optimal AnsiString Conversion Routines Optimal AnsiString Conversion Routines
*****************************************************************************} *****************************************************************************}
Function XY2Ansi(x,y,ox,oy:byte):String; Function XY2Ansi(x,y,ox,oy:longint):String;
{ {
Returns a string with the escape sequences to go to X,Y on the screen Returns a string with the escape sequences to go to X,Y on the screen
} }
@ -212,14 +212,14 @@ End;
const const
AnsiTbl : string[8]='04261537'; AnsiTbl : string[8]='04261537';
Function Attr2Ansi(Attr,OAttr:byte):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
with use of the old OAttr with use of the old OAttr
} }
var var
hstr : string[16]; hstr : string[16];
OFg,OBg,Fg,Bg : byte; OFg,OBg,Fg,Bg : longint;
procedure AddSep(ch:char); procedure AddSep(ch:char);
begin begin
@ -272,13 +272,13 @@ end;
Function Ansi2Attr(Const HStr:String;oattr:byte):byte; Function Ansi2Attr(Const HStr:String;oattr:longint):longint;
{ {
Convert an Escape sequence to an attribute value, uses Oattr as the last Convert an Escape sequence to an attribute value, uses Oattr as the last
color written color written
} }
var var
i,j : byte; i,j : longint;
begin begin
i:=2; i:=2;
if (Length(HStr)<3) or (Hstr[1]<>#27) or (Hstr[2]<>'[') then if (Length(HStr)<3) or (Hstr[1]<>#27) or (Hstr[2]<>'[') then
@ -369,7 +369,7 @@ End;
{Send String to Remote} {Send String to Remote}
procedure ttySendStr(const hstr:string); procedure ttySendStr(const hstr:string);
var var
i : word; i : longint;
begin begin
for i:=1to length(hstr) do for i:=1to length(hstr) do
ttySendChar(hstr[i]); ttySendChar(hstr[i]);
@ -382,7 +382,7 @@ end;
{Get Char from Remote} {Get Char from Remote}
function ttyRecvChar:char; function ttyRecvChar:char;
var var
Readed,i : word; Readed,i : longint;
begin begin
{Buffer Empty? Yes, Input from StdIn} {Buffer Empty? Yes, Input from StdIn}
if (InHead=InTail) then if (InHead=InTail) then
@ -418,7 +418,7 @@ end;
Screen Routines not Window Depended Screen Routines not Window Depended
*****************************************************************************} *****************************************************************************}
procedure ttyGotoXY(x,y:byte); procedure ttyGotoXY(x,y:longint);
{ {
Goto XY on the Screen, if a value is 0 the goto the current Goto XY on the Screen, if a value is 0 the goto the current
postion of that value and always recalc the ansicode for it postion of that value and always recalc the ansicode for it
@ -435,13 +435,11 @@ begin
CurrY:=$ff; CurrY:=$ff;
end; end;
if Redir then if Redir then
begin begin
if longint(y)-longint(CurrY)=1 then if longint(y)-longint(CurrY)=1 then
ttySendStr(#10); ttySendStr(#10);
end end
else else
ttySendStr(XY2Ansi(x,y,CurrX,CurrY)); ttySendStr(XY2Ansi(x,y,CurrX,CurrY));
CurrX:=x; CurrX:=x;
CurrY:=y; CurrY:=y;
@ -449,7 +447,7 @@ end;
procedure ttyColor(a:byte); procedure ttyColor(a:longint);
{ {
Set Attribute to A, only output if not the last attribute is set Set Attribute to A, only output if not the last attribute is set
} }
@ -470,7 +468,7 @@ procedure ttyWrite(const s:string);
Write a string to the output, memory copy and Current X&Y are also updated Write a string to the output, memory copy and Current X&Y are also updated
} }
var var
i : word; i : longint;
begin begin
ttySendStr(s); ttySendStr(s);
{Update MemCopy} {Update MemCopy}
@ -535,7 +533,7 @@ begin
end; end;
procedure LineWrite(temp:String); procedure LineWrite(const temp:String);
{ {
Write a Line to the screen, doesn't write on 80,25 under Dos Write a Line to the screen, doesn't write on 80,25 under Dos
the Current CurrX is set to WinMax. NO MEMORY UPDATE! the Current CurrX is set to WinMax. NO MEMORY UPDATE!
@ -549,27 +547,31 @@ end;
procedure DoEmptyLine(y,xl,xh:byte); procedure DoEmptyLine(y,xl,xh:longint);
{ {
Write an Empty line at Row Y from Col Xl to XH, Memory is also updated Write an Empty line at Row Y from Col Xl to XH, Memory is also updated
} }
var
len : longint;
begin begin
ttyGotoXY(xl,y); ttyGotoXY(xl,y);
LineWrite(Space(xh-xl+1)); len:=xh-xl+1;
FillChar(Scrn[y],ScreenWidth,' '); LineWrite(Space(len));
FillChar(ScrnCol[y],ScreenWidth,TextAttr); FillChar(Scrn[y,xl],len,' ');
FillChar(ScrnCol[y,xl],len,TextAttr);
end; end;
procedure DoScrollLine(y1,y2,xl,xh:byte); procedure DoScrollLine(y1,y2,xl,xh:longint);
{ {
Move Line y1 to y2, use only columns Xl-Xh, Memory is updated also Move Line y1 to y2, use only columns Xl-Xh, Memory is updated also
} }
var var
Temp : string; Temp : string;
len,
OldAttr, OldAttr,
x,attr : byte; x,attr : longint;
begin begin
ttyGotoXY(xl,y2); ttyGotoXY(xl,y2);
OldAttr:=$ff; OldAttr:=$ff;
@ -590,8 +592,9 @@ begin
end; end;
End; End;
{Update memory copy} {Update memory copy}
Move(Scrn[y1,1],Scrn[y2,1],ScreenWidth); len:=xh-xl+1;
Move(ScrnCol[y1,1],ScrnCol[y2,1],ScreenWidth); Move(Scrn[y1,xl],Scrn[y2,xl],len);
Move(ScrnCol[y1,xl],ScrnCol[y2,xl],len);
end; end;
@ -686,9 +689,9 @@ Var
CY : Integer; CY : Integer;
oldflush : boolean; oldflush : boolean;
I : Integer; I : Integer;
Begin Begin
{ See if color has changed } { See if color has changed }
if OldTextAttr<>TextAttr then if OldTextAttr<>TextAttr then
begin begin
i:=TextAttr; i:=TextAttr;
@ -720,25 +723,36 @@ Procedure ClrEol;
{ {
Clear from current position to end of line. Clear from current position to end of line.
} }
Var I : integer; var
len,i : longint;
IsLastLine : boolean;
Begin Begin
{ See if color has changed } { See if color has changed }
if OldTextAttr<>TextAttr then if OldTextAttr<>TextAttr then
begin begin
i:=TextAttr; i:=TextAttr;
TextAttr:=OldTextAttr; TextAttr:=OldTextAttr;
ttyColor(i); ttyColor(i);
end; end;
if FullWin then if FullWin or (WinMaxX = ScreenWidth) then
begin begin
if not Redir then if not Redir then
ttySendStr(#27'[K'); ttySendStr(#27'[K');
end end
else else
begin begin
ttySendStr(Space(WinMaxX-CurrX)); { Tweak windmax so no scrolling happends }
ttyGotoXY(0,CurrY); len:=WinMaxX-CurrX+1;
IsLastLine:=false;
if CurrY=WinMaxY then
begin
inc(WindMax,$0203);
IsLastLine:=true;
end;
ttySendStr(Space(len));
if IsLastLine then
dec(WindMax,$0203);
ttyGotoXY(0,0);
end; end;
End; End;
@ -764,7 +778,7 @@ End;
Procedure ScrollScrnRegionUp(xl,yl,xh,yh, count: Byte); Procedure ScrollScrnRegionUp(xl,yl,xh,yh, count: longint);
{ {
Scroll the indicated region count lines up. The empty lines are filled Scroll the indicated region count lines up. The empty lines are filled
with blanks in the current color. The screen position is restored with blanks in the current color. The screen position is restored
@ -792,7 +806,7 @@ End;
Procedure ScrollScrnRegionDown(xl,yl,xh,yh, count: Byte); Procedure ScrollScrnRegionDown(xl,yl,xh,yh, count: longint);
{ {
Scroll the indicated region count lines down. The empty lines are filled Scroll the indicated region count lines down. The empty lines are filled
with blanks in the current color. The screen position is restored with blanks in the current color. The screen position is restored
@ -820,24 +834,6 @@ End;
Procedure ScrollWindow(xl,yl,xh,yh : Byte; count: LongInt);
{
Scroll the indicated region up or down, depending on the sign
of count.
}
begin
If ((xl>xh) or (xh>ScreenWidth)) or
((yl>yh) or (yl>ScreenHeight)) or
(abs(Count)>yh-yl+1) then
exit;
If count<0 then
ScrollScrnRegionDown (xl,yl,xh,yh,abs(count))
else
ScrollScrnRegionUp (xl,yl,xh,yh,count);
end;
{************************************************************************* {*************************************************************************
KeyBoard KeyBoard
*************************************************************************} *************************************************************************}
@ -847,7 +843,7 @@ Const
var var
KeyBuffer : Array[0..KeyBufferSize-1] of Char; KeyBuffer : Array[0..KeyBufferSize-1] of Char;
KeyPut, KeyPut,
KeySend : Byte; KeySend : longint;
Procedure PushKey(Ch:char); Procedure PushKey(Ch:char);
Var Var
@ -894,7 +890,7 @@ const
#044#045#046#047#048#049#050#120#121#122#123#124#125#126#127#128#129#130#131; #044#045#046#047#048#049#050#120#121#122#123#124#125#126#127#128#129#130#131;
Function FAltKey(ch:char):byte; Function FAltKey(ch:char):byte;
var var
Idx : byte; Idx : longint;
Begin Begin
Idx:=Pos(ch,AltKeyStr); Idx:=Pos(ch,AltKeyStr);
if Idx>0 then if Idx>0 then
@ -925,7 +921,7 @@ Function ReadKey:char;
Var Var
ch : char; ch : char;
OldState, OldState,
State : Word; State : longint;
Begin Begin
{Check Buffer first} {Check Buffer first}
if KeySend<>KeyPut then if KeySend<>KeyPut then
@ -1083,13 +1079,13 @@ Procedure DoWrite(const s:String);
var var
found, found,
OldFlush : boolean; OldFlush : boolean;
x,y : byte; x,y,
i,j, i,j,
SendBytes : word; SendBytes : longint;
function AnsiPara(var hstr:string):byte; function AnsiPara(var hstr:string):byte;
var var
k,j : byte; k,j : longint;
code : word; code : word;
begin begin
j:=pos(';',hstr); j:=pos(';',hstr);
@ -1104,7 +1100,7 @@ var
procedure SendText; procedure SendText;
var var
LeftX : word; LeftX : longint;
begin begin
while (SendBytes>0) do while (SendBytes>0) do
begin begin
@ -1126,7 +1122,6 @@ var
begin begin
oldflush:=ttySetFlush(Flushing); oldflush:=ttySetFlush(Flushing);
{ Support textattr:= changing } { Support textattr:= changing }
if OldTextAttr<>TextAttr then if OldTextAttr<>TextAttr then
begin begin
i:=TextAttr; i:=TextAttr;
@ -1134,7 +1129,6 @@ begin
ttyColor(i); ttyColor(i);
end; end;
{ write the stuff } { write the stuff }
SendBytes:=0; SendBytes:=0;
i:=1; i:=1;
while (i<=length(s)) do while (i<=length(s)) do
@ -1270,7 +1264,7 @@ Begin
begin begin
if (F.BufPtr^[i-1]=#13) and (F.BufPtr^[i]<>#10) then if (F.BufPtr^[i-1]=#13) and (F.BufPtr^[i]<>#10) then
F.BufPtr^[i-1]:=#10; F.BufPtr^[i-1]:=#10;
end; end;
F.BufPos:=F.BufEnd; F.BufPos:=F.BufEnd;
CrtWrite(F); CrtWrite(F);
CrtRead:=0; CrtRead:=0;
@ -1465,7 +1459,10 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.6 1998-06-19 16:51:50 peter Revision 1.7 1998-07-04 11:17:18 peter
* fixes for window (from "Heinz Ziegenhorn" <info@ziegenhorn.de>)
Revision 1.6 1998/06/19 16:51:50 peter
* added #13 -> #10 translation for CrtRead to overcome readln probs * added #13 -> #10 translation for CrtRead to overcome readln probs
Revision 1.5 1998/06/19 14:47:52 michael Revision 1.5 1998/06/19 14:47:52 michael