Browse Source

* fixes for window (from "Heinz Ziegenhorn" <[email protected]>)

peter 27 years ago
parent
commit
e5557711dc
1 changed files with 57 additions and 60 deletions
  1. 57 60
      rtl/linux/crt.pp

+ 57 - 60
rtl/linux/crt.pp

@@ -161,7 +161,7 @@ end;
                       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
 }
@@ -212,14 +212,14 @@ End;
 
 const
   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
   with use of the old OAttr
 }
 var
   hstr : string[16];
-  OFg,OBg,Fg,Bg : byte;
+  OFg,OBg,Fg,Bg : longint;
 
   procedure AddSep(ch:char);
   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
   color written
 }
 var
-  i,j : byte;
+  i,j : longint;
 begin
   i:=2;
   if (Length(HStr)<3) or (Hstr[1]<>#27) or (Hstr[2]<>'[') then
@@ -369,7 +369,7 @@ End;
 {Send String to Remote}
 procedure ttySendStr(const hstr:string);
 var
-  i : word;
+  i : longint;
 begin
   for i:=1to length(hstr) do
    ttySendChar(hstr[i]);
@@ -382,7 +382,7 @@ end;
 {Get Char from Remote}
 function ttyRecvChar:char;
 var
-  Readed,i : word;
+  Readed,i : longint;
 begin
 {Buffer Empty? Yes, Input from StdIn}
   if (InHead=InTail) then
@@ -418,7 +418,7 @@ end;
                        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
   postion of that value and always recalc the ansicode for it
@@ -435,13 +435,11 @@ begin
      CurrY:=$ff;
    end;
   if Redir then
-
    begin
      if longint(y)-longint(CurrY)=1 then
       ttySendStr(#10);
    end
   else
-
    ttySendStr(XY2Ansi(x,y,CurrX,CurrY));
   CurrX:=x;
   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
 }
@@ -470,7 +468,7 @@ procedure ttyWrite(const s:string);
   Write a string to the output, memory copy and Current X&Y are also updated
 }
 var
-  i : word;
+  i : longint;
 begin
   ttySendStr(s);
 {Update MemCopy}
@@ -535,7 +533,7 @@ begin
 end;
 
 
-procedure LineWrite(temp:String);
+procedure LineWrite(const temp:String);
 {
   Write a Line to the screen, doesn't write on 80,25 under Dos
   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
 }
+var
+  len : longint;
 begin
   ttyGotoXY(xl,y);
-  LineWrite(Space(xh-xl+1));
-  FillChar(Scrn[y],ScreenWidth,' ');
-  FillChar(ScrnCol[y],ScreenWidth,TextAttr);
+  len:=xh-xl+1;
+  LineWrite(Space(len));
+  FillChar(Scrn[y,xl],len,' ');
+  FillChar(ScrnCol[y,xl],len,TextAttr);
 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
 }
 var
   Temp    : string;
+  len,
   OldAttr,
-  x,attr : byte;
+  x,attr  : longint;
 begin
   ttyGotoXY(xl,y2);
   OldAttr:=$ff;
@@ -590,8 +592,9 @@ begin
       end;
    End;
 {Update memory copy}
-  Move(Scrn[y1,1],Scrn[y2,1],ScreenWidth);
-  Move(ScrnCol[y1,1],ScrnCol[y2,1],ScreenWidth);
+  len:=xh-xl+1;
+  Move(Scrn[y1,xl],Scrn[y2,xl],len);
+  Move(ScrnCol[y1,xl],ScrnCol[y2,xl],len);
 end;
 
 
@@ -686,9 +689,9 @@ Var
   CY        : Integer;
   oldflush  : boolean;
   I : Integer;
-  
+
 Begin
-  { See if color has changed } 
+  { See if color has changed }
   if OldTextAttr<>TextAttr then
    begin
      i:=TextAttr;
@@ -720,25 +723,36 @@ Procedure ClrEol;
 {
   Clear from current position to end of line.
 }
-Var I : integer;
-
+var
+  len,i : longint;
+  IsLastLine : boolean;
 Begin
-  { See if color has changed } 
+  { See if color has changed }
   if OldTextAttr<>TextAttr then
    begin
      i:=TextAttr;
      TextAttr:=OldTextAttr;
      ttyColor(i);
    end;
-  if FullWin then
+  if FullWin or (WinMaxX = ScreenWidth) then
    begin
      if not Redir then
       ttySendStr(#27'[K');
    end
   else
    begin
-     ttySendStr(Space(WinMaxX-CurrX));
-     ttyGotoXY(0,CurrY);
+   { Tweak windmax so no scrolling happends }
+     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;
 
@@ -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
   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
   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
 *************************************************************************}
@@ -847,7 +843,7 @@ Const
 var
   KeyBuffer : Array[0..KeyBufferSize-1] of Char;
   KeyPut,
-  KeySend   : Byte;
+  KeySend   : longint;
 
 Procedure PushKey(Ch:char);
 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;
 Function FAltKey(ch:char):byte;
 var
-  Idx : byte;
+  Idx : longint;
 Begin
   Idx:=Pos(ch,AltKeyStr);
   if Idx>0 then
@@ -925,7 +921,7 @@ Function ReadKey:char;
 Var
   ch       : char;
   OldState,
-  State    : Word;
+  State    : longint;
 Begin
 {Check Buffer first}
   if KeySend<>KeyPut then
@@ -1083,13 +1079,13 @@ Procedure DoWrite(const s:String);
 var
   found,
   OldFlush  : boolean;
-  x,y       : byte;
+  x,y,
   i,j,
-  SendBytes : word;
+  SendBytes : longint;
 
   function AnsiPara(var hstr:string):byte;
   var
-    k,j  : byte;
+    k,j  : longint;
     code : word;
   begin
     j:=pos(';',hstr);
@@ -1104,7 +1100,7 @@ var
 
   procedure SendText;
   var
-    LeftX : word;
+    LeftX : longint;
   begin
     while (SendBytes>0) do
      begin
@@ -1126,7 +1122,6 @@ var
 begin
   oldflush:=ttySetFlush(Flushing);
 { Support textattr:= changing }
-
   if OldTextAttr<>TextAttr then
    begin
      i:=TextAttr;
@@ -1134,7 +1129,6 @@ begin
      ttyColor(i);
    end;
 { write the stuff }
-
   SendBytes:=0;
   i:=1;
   while (i<=length(s)) do
@@ -1270,7 +1264,7 @@ Begin
    begin
      if (F.BufPtr^[i-1]=#13) and (F.BufPtr^[i]<>#10) then
       F.BufPtr^[i-1]:=#10;
-   end;  
+   end;
   F.BufPos:=F.BufEnd;
   CrtWrite(F);
   CrtRead:=0;
@@ -1465,7 +1459,10 @@ Begin
 End.
 {
   $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" <[email protected]>)
+
+  Revision 1.6  1998/06/19 16:51:50  peter
     * added #13 -> #10 translation for CrtRead to overcome readln probs
 
   Revision 1.5  1998/06/19 14:47:52  michael