+ get winsize at startup

+ ConsoleBuf to interface
This commit is contained in:
peter 1998-10-15 08:31:53 +00:00
parent 8d3acbf569
commit 0f609f0ee2

View File

@ -1,8 +1,8 @@
{ {
$Id$ $Id$
This file is part of the Free Pascal run time library. This file is part of the Free Pascal run time library.
Copyright (c) 1993,97 by Michael Van Canneyt, Copyright (c) 1993-98 by Michael Van Canneyt and Peter Vreman,
member of the Free Pascal development team. members of the Free Pascal development team.
See the file COPYING.FPC, included in this distribution, See the file COPYING.FPC, included in this distribution,
for details about the copyright. for details about the copyright.
@ -17,9 +17,7 @@ Interface
Const Const
{ Controlling consts } { Controlling consts }
Flushing=false; {if true then don't buffer output} Flushing=false; {if true then don't buffer output}
ScreenWidth = 80;
ScreenHeight = 25;
{ CRT modes } { CRT modes }
BW40 = 0; { 40x25 B/W on Color Adapter } BW40 = 0; { 40x25 B/W on Color Adapter }
@ -57,7 +55,6 @@ Const
Blink = 128; Blink = 128;
{Other Defaults} {Other Defaults}
TextAttr : Byte = $07; TextAttr : Byte = $07;
LastMode : Word = 3; LastMode : Word = 3;
WindMin : Word = $0; WindMin : Word = $0;
@ -68,6 +65,23 @@ var
CheckSnow, CheckSnow,
DirectVideo: Boolean; DirectVideo: Boolean;
Const
ScreenHeight : longint=25;
ScreenWidth : longint=80;
ConsoleMaxX=1024;
ConsoleMaxY=1024;
Type
TCharAttr=packed record
ch : char;
attr : byte;
end;
TConsoleBuf=Array[0..ConsoleMaxX*ConsoleMaxY-1] of TCharAttr;
PConsoleBuf=^TConsoleBuf;
var
ConsoleBuf : PConsoleBuf;
Procedure AssignCrt(Var F: Text); Procedure AssignCrt(Var F: Text);
Function KeyPressed: Boolean; Function KeyPressed: Boolean;
Function ReadKey: Char; Function ReadKey: Char;
@ -98,18 +112,10 @@ uses Linux;
The definitions of TextRec and FileRec are in separate files. The definitions of TextRec and FileRec are in separate files.
} }
{$i textrec.inc} {$i textrec.inc}
{$i filerec.inc}
Const Const
OldTextAttr : byte = $07; OldTextAttr : byte = $07;
Type
TScreen=Array[1..ScreenHeight,1..ScreenWidth] of char;
TScreenColors=Array[1..ScreenHeight,1..ScreenWidth] of byte;
Var Var
Scrn : TScreen;
ScrnCol : TScreenColors;
CurrX,CurrY : Byte; CurrX,CurrY : Byte;
ExitSave : Pointer; ExitSave : Pointer;
Redir : boolean; { is the output being redirected (not a TTY) } Redir : boolean; { is the output being redirected (not a TTY) }
@ -468,14 +474,15 @@ 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 : longint; idx,i : longint;
begin begin
ttySendStr(s); ttySendStr(s);
{Update MemCopy} {Update MemCopy}
idx:=(CurrY-1)*ScreenWidth-1;
for i:=1to length(s) do for i:=1to length(s) do
begin begin
Scrn[CurrY,CurrX]:=s[i]; ConsoleBuf^[idx+CurrX].ch:=s[i];
ScrnCol[CurrY,CurrX]:=TextAttr; ConsoleBuf^[idx+CurrX].attr:=TextAttr;
inc(CurrX); inc(CurrX);
if CurrX>ScreenWidth then if CurrX>ScreenWidth then
CurrX:=ScreenWidth; CurrX:=ScreenWidth;
@ -484,7 +491,7 @@ end;
Function WinMinX: Byte; Function WinMinX: Longint;
{ {
Current Minimum X coordinate Current Minimum X coordinate
} }
@ -494,7 +501,7 @@ End;
Function WinMinY: Byte; Function WinMinY: Longint;
{ {
Current Minimum Y Coordinate Current Minimum Y Coordinate
} }
@ -504,7 +511,7 @@ End;
Function WinMaxX: Byte; Function WinMaxX: Longint;
{ {
Current Maximum X coordinate Current Maximum X coordinate
} }
@ -514,7 +521,7 @@ End;
Function WinMaxY: Byte; Function WinMaxY: Longint;
{ {
Current Maximum Y coordinate; Current Maximum Y coordinate;
} }
@ -529,7 +536,7 @@ Function FullWin:boolean;
Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines Full Screen 80x25? Window(1,1,80,25) is used, allows faster routines
} }
begin begin
FullWin:=(WindMax-WindMin=$184f); FullWin:=(WinMaxX=ScreenWidth) and (WinMaxY=ScreenHeight);
end; end;
@ -557,8 +564,7 @@ begin
ttyGotoXY(xl,y); ttyGotoXY(xl,y);
len:=xh-xl+1; len:=xh-xl+1;
LineWrite(Space(len)); LineWrite(Space(len));
FillChar(Scrn[y,xl],len,' '); FillWord(ConsoleBuf^[(y-1)*ScreenWidth+xl-1],len,(TextAttr shl 8)+ord(' '));
FillChar(ScrnCol[y,xl],len,TextAttr);
end; end;
@ -569,22 +575,25 @@ procedure DoScrollLine(y1,y2,xl,xh:longint);
} }
var var
Temp : string; Temp : string;
len, idx,
OldAttr, OldAttr,
x,attr : longint; x,attr : longint;
begin begin
ttyGotoXY(xl,y2); ttyGotoXY(xl,y2);
{ precalc ConsoleBuf[] y-offset }
idx:=(y1-1)*ScreenWidth-1;
{ update screen }
OldAttr:=$ff; OldAttr:=$ff;
Temp:=''; Temp:='';
For x:=xl To xh Do For x:=xl To xh Do
Begin Begin
attr:=ScrnCol[y1,x]; attr:=ConsoleBuf^[idx+x].attr;
if attr<>OldAttr then if (attr<>OldAttr) and (not Redir) then
begin begin
temp:=temp+Attr2Ansi(Attr,OldAttr); temp:=temp+Attr2Ansi(Attr,OldAttr);
OldAttr:=Attr; OldAttr:=Attr;
end; end;
Temp:=Temp+Scrn[y1,x]; Temp:=Temp+ConsoleBuf^[idx+x].ch;
if (x=xh) or (length(Temp)>240) then if (x=xh) or (length(Temp)>240) then
begin begin
LineWrite(Temp); LineWrite(Temp);
@ -592,9 +601,7 @@ begin
end; end;
End; End;
{Update memory copy} {Update memory copy}
len:=xh-xl+1; Move(ConsoleBuf^[(y1-1)*ScreenWidth+xl-1],ConsoleBuf^[(y2-1)*ScreenWidth+xl-1],(xh-xl+1)*2);
Move(Scrn[y1,xl],Scrn[y2,xl],len);
Move(ScrnCol[y1,xl],ScrnCol[y2,xl],len);
end; end;
@ -686,10 +693,8 @@ Procedure ClrScr;
Clear the current window, and set the cursor on x1,y1 Clear the current window, and set the cursor on x1,y1
} }
Var Var
CY : Integer; CY,i : Longint;
oldflush : boolean; oldflush : boolean;
I : Integer;
Begin Begin
{ See if color has changed } { See if color has changed }
if OldTextAttr<>TextAttr then if OldTextAttr<>TextAttr then
@ -705,8 +710,7 @@ Begin
ttySendStr(#27'[H'#27'[2J'); ttySendStr(#27'[H'#27'[2J');
CurrX:=1; CurrX:=1;
CurrY:=1; CurrY:=1;
FillChar(Scrn,sizeof(Scrn),' '); FillWord(ConsoleBuf^,ScreenWidth*ScreenHeight,(TextAttr shl 8)+ord(' '));
FillChar(ScrnCol,sizeof(ScrnCol),TextAttr);
end end
else else
begin begin
@ -847,7 +851,7 @@ var
Procedure PushKey(Ch:char); Procedure PushKey(Ch:char);
Var Var
Tmp : Word; Tmp : Longint;
Begin Begin
Tmp:=KeyPut; Tmp:=KeyPut;
Inc(KeyPut); Inc(KeyPut);
@ -1407,6 +1411,26 @@ begin
end; end;
Procedure GetConsoleBuf;
var
WinInfo : TWinSize;
begin
if Assigned(ConsoleBuf) then
FreeMem(ConsoleBuf,ScreenHeight*ScreenWidth*2);
if (not Redir) and IOCtl(TextRec(Output).Handle,TIOCGWINSZ,@Wininfo) then
begin
ScreenWidth:=Wininfo.ws_col;
ScreenHeight:=Wininfo.ws_row;
end
else
begin
ScreenWidth:=80;
ScreenHeight:=25;
end;
GetMem(ConsoleBuf,ScreenHeight*ScreenWidth*2);
FillChar(ConsoleBuf^,ScreenHeight*ScreenWidth*2,0);
end;
Procedure CrtExit; Procedure CrtExit;
{ {
@ -1415,6 +1439,9 @@ Procedure CrtExit;
Begin Begin
ttyFlushOutput; ttyFlushOutput;
SetRawMode(False); SetRawMode(False);
{ remove console buf }
if Assigned(ConsoleBuf) then
FreeMem(ConsoleBuf,ScreenHeight*ScreenWidth*2);
ExitProc:=ExitSave; ExitProc:=ExitSave;
End; End;
@ -1433,8 +1460,8 @@ Begin
TextRec(Input).Handle:=StdInputHandle; TextRec(Input).Handle:=StdInputHandle;
{ Are we redirected to a file ? } { Are we redirected to a file ? }
Redir:=not IsAtty(TextRec(Output).Handle); Redir:=not IsAtty(TextRec(Output).Handle);
{Set default Terminal Settings} { Get Size of terminal }
SetRawMode(True); GetConsoleBuf;
{Get Current X&Y or Reset to Home} {Get Current X&Y or Reset to Home}
if Redir then if Redir then
begin begin
@ -1443,6 +1470,9 @@ Begin
end end
else else
begin begin
{ Set default Terminal Settings }
SetRawMode(True);
{ Get current X,Y if not set already }
GetXY(CurrX,CurrY); GetXY(CurrX,CurrY);
if (CurrX=0) then if (CurrX=0) then
begin begin
@ -1456,7 +1486,11 @@ Begin
End. End.
{ {
$Log$ $Log$
Revision 1.8 1998-08-28 11:00:20 peter Revision 1.9 1998-10-15 08:31:53 peter
+ get winsize at startup
+ ConsoleBuf to interface
Revision 1.8 1998/08/28 11:00:20 peter
* fixed #8 writing * fixed #8 writing
Revision 1.7 1998/07/04 11:17:18 peter Revision 1.7 1998/07/04 11:17:18 peter
@ -1477,7 +1511,4 @@ End.
Revision 1.2 1998/04/05 13:56:54 peter Revision 1.2 1998/04/05 13:56:54 peter
- fixed mouse to compile with $i386_att - fixed mouse to compile with $i386_att
+ linux crt supports redirecting (not Esc-codes anymore) + linux crt supports redirecting (not Esc-codes anymore)
Revision 1.1.1.1 1998/03/25 11:18:43 root
* Restored version
} }