mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 02:19:22 +01:00
1598 lines
42 KiB
ObjectPascal
1598 lines
42 KiB
ObjectPascal
{
|
|
This file is part of the Free Pascal Integrated Development Environment
|
|
Copyright (c) 1998 by Berczi Gabor
|
|
|
|
User screen support routines
|
|
|
|
See the file COPYING.FPC, included in this distribution,
|
|
for details about the copyright.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
|
|
|
|
**********************************************************************}
|
|
{$i globdir.inc}
|
|
unit FPUsrScr;
|
|
|
|
interface
|
|
|
|
uses
|
|
{$ifdef Windows}
|
|
windows,
|
|
{$endif Windows}
|
|
{$ifdef Unix}
|
|
baseunix,
|
|
termio,
|
|
{$ifdef linux}
|
|
linuxvcs,
|
|
{$endif}
|
|
{$endif}
|
|
video,Objects;
|
|
|
|
type
|
|
|
|
PScreen = ^TScreen;
|
|
TScreen = object(TObject)
|
|
function GetWidth: integer; virtual;
|
|
function GetHeight: integer; virtual;
|
|
procedure GetLine(Line: integer; var Text, Attr: string); virtual;
|
|
procedure GetCursorPos(var P: TPoint); virtual;
|
|
{ remember the initial video screen }
|
|
procedure Capture; virtual;
|
|
{ restore the initial video mode }
|
|
procedure Restore; virtual;
|
|
{ move up or down if supported by OS }
|
|
function Scroll(i : integer) : integer; virtual;
|
|
{ is moving supported by OS }
|
|
function CanScroll : boolean; virtual;
|
|
{ saves the current IDE screen }
|
|
procedure SaveIDEScreen; virtual;
|
|
{ saves the current console screen }
|
|
procedure SaveConsoleScreen; virtual;
|
|
{ restores the saved console screen }
|
|
procedure SwitchToConsoleScreen; virtual;
|
|
{ restores the saved IDE screen }
|
|
procedure SwitchBackToIDEScreen; virtual;
|
|
end;
|
|
|
|
{$IFDEF netwlibc}
|
|
PNWLScreen = ^TNWLScreen;
|
|
TNWLScreen = object(TScreen)
|
|
function GetWidth: integer; virtual;
|
|
function GetHeight: integer; virtual;
|
|
procedure GetLine(Line: integer; var Text, Attr: string); virtual;
|
|
procedure GetCursorPos(var P: TPoint); virtual;
|
|
{ remember the initial video screen }
|
|
procedure Capture; virtual;
|
|
{ restore the initial video mode }
|
|
procedure Restore; virtual;
|
|
{ saves the current IDE screen }
|
|
procedure SaveIDEScreen; virtual;
|
|
{ saves the current console screen }
|
|
procedure SaveConsoleScreen; virtual;
|
|
{ restores the saved console screen }
|
|
procedure SwitchToConsoleScreen; virtual;
|
|
{ restores the saved IDE screen }
|
|
procedure SwitchBackToIDEScreen; virtual;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF AMIGA}
|
|
{$DEFINE AMIGASCREEN}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF MORPHOS}
|
|
{$DEFINE AMIGASCREEN}
|
|
{$ENDIF}
|
|
|
|
{$IFDEF AMIGASCREEN}
|
|
PAmigaScreen = ^TAmigaScreen;
|
|
TAmigaScreen = object(TScreen)
|
|
function GetWidth: integer; virtual;
|
|
function GetHeight: integer; virtual;
|
|
procedure GetLine(Line: integer; var Text, Attr: string); virtual;
|
|
procedure GetCursorPos(var P: TPoint); virtual;
|
|
{ remember the initial video screen }
|
|
procedure Capture; virtual;
|
|
{ restore the initial video mode }
|
|
procedure Restore; virtual;
|
|
{ saves the current IDE screen }
|
|
procedure SaveIDEScreen; virtual;
|
|
{ saves the current console screen }
|
|
procedure SaveConsoleScreen; virtual;
|
|
{ restores the saved console screen }
|
|
procedure SwitchToConsoleScreen; virtual;
|
|
{ restores the saved IDE screen }
|
|
procedure SwitchBackToIDEScreen; virtual;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$IFDEF OS2}
|
|
POS2Screen = ^TOS2Screen;
|
|
TOS2Screen = object(TScreen)
|
|
constructor Init;
|
|
destructor Done; virtual;
|
|
public
|
|
function GetWidth: integer; virtual;
|
|
function GetHeight: integer; virtual;
|
|
procedure GetLine(Line: integer; var Text, Attr: string); virtual;
|
|
procedure GetCursorPos(var P: TPoint); virtual;
|
|
{ remember the initial video screen }
|
|
procedure Capture; virtual;
|
|
{ restore the initial video mode }
|
|
procedure Restore; virtual;
|
|
{ move up or down if supported by OS }
|
|
function Scroll(i : integer) : integer; virtual;
|
|
{ saves the current IDE screen }
|
|
procedure SaveIDEScreen; virtual;
|
|
{ saves the current console screen }
|
|
procedure SaveConsoleScreen; virtual;
|
|
{ restores the saved console screen }
|
|
procedure SwitchToConsoleScreen; virtual;
|
|
{ restores the saved IDE screen }
|
|
procedure SwitchBackToIDEScreen; virtual;
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{$ifdef DOS}
|
|
TDOSVideoInfo = record
|
|
Mode : word;
|
|
ScreenSize: word;
|
|
Page : byte;
|
|
Rows,Cols : integer;
|
|
CurPos : TPoint;
|
|
CurShapeT : integer;
|
|
CurShapeB : integer;
|
|
StateSize : word;
|
|
StateBuf : pointer;
|
|
end;
|
|
|
|
PDOSScreen = ^TDOSScreen;
|
|
TDOSScreen = object(TScreen)
|
|
constructor Init;
|
|
destructor Done; virtual;
|
|
public
|
|
function GetWidth: integer; virtual;
|
|
function GetHeight: integer; virtual;
|
|
procedure GetLine(Line: integer; var Text, Attr: string); virtual;
|
|
procedure GetCursorPos(var P: TPoint); virtual;
|
|
procedure Capture; virtual;
|
|
procedure Restore; virtual;
|
|
procedure SaveIDEScreen; virtual;
|
|
procedure SaveConsoleScreen; virtual;
|
|
procedure SwitchToConsoleScreen; virtual;
|
|
procedure SwitchBackToIDEScreen; virtual;
|
|
procedure FreeGraphBuffer;
|
|
private
|
|
LastTextConsoleVideoInfo,
|
|
ConsoleVideoInfo : TDOSVideoInfo;
|
|
VBufferSize : longint;
|
|
VIDEBufferSize : longint;
|
|
VBuffer : PByteArray;
|
|
VIDEBuffer : PByteArray;
|
|
IDEVideoInfo : TDOSVideoInfo;
|
|
ctrl_c_state : boolean;
|
|
{$ifdef USE_GRAPH_SWITCH}
|
|
GraphImageSize : longint;
|
|
GraphDriverName,
|
|
GraphModeName : string;
|
|
GraphXres,GraphYres : longint;
|
|
GraphBuffer : pointer;
|
|
ConsoleGraphDriver, ConsoleGraphMode : word;
|
|
{$endif USE_GRAPH_SWITCH}
|
|
function GetLineStartOfs(Line: integer): word;
|
|
procedure GetBuffer(Size: word);
|
|
procedure FreeBuffer;
|
|
procedure GetVideoMode(var MI: TDOSVideoInfo);
|
|
procedure SetVideoMode(MI: TDOSVideoInfo);
|
|
end;
|
|
{$endif}
|
|
|
|
{$ifdef Unix}
|
|
|
|
TConsoleType = (ttyNetwork,ttyLinux,ttyFreeBSD,ttyNetBSD);
|
|
|
|
PLinuxScreen = ^TLinuxScreen;
|
|
TLinuxScreen = object(TScreen)
|
|
constructor Init;
|
|
destructor Done; virtual;
|
|
public
|
|
function GetWidth: integer; virtual;
|
|
function GetHeight: integer; virtual;
|
|
procedure GetLine(Line: integer; var Text, Attr: string); virtual;
|
|
procedure GetCursorPos(var P: TPoint); virtual;
|
|
procedure Capture; virtual;
|
|
procedure Restore; virtual;
|
|
procedure SaveIDEScreen; virtual;
|
|
procedure SaveConsoleScreen; virtual;
|
|
procedure SwitchToConsoleScreen; virtual;
|
|
procedure SwitchBackToIDEScreen; virtual;
|
|
private
|
|
IdeScreen: PByteArray;
|
|
IdeSize : longint;
|
|
IsXterm : boolean;
|
|
Console : TConsoleType;
|
|
TTyfd : longint;
|
|
ConsVideoBuf : PByteArray;
|
|
ConsHeight, ConsWidth,
|
|
ConsCursorX, ConsCursorY : byte;
|
|
ConsVideoBufSize : longint;
|
|
ConsTio : termios;
|
|
ConsTioValid : boolean;
|
|
end;
|
|
{$endif}
|
|
|
|
{$ifdef Windows}
|
|
PWindowsScreen = ^TWindowsScreen;
|
|
TWindowsScreen = object(TScreen)
|
|
constructor Init;
|
|
destructor Done; virtual;
|
|
public
|
|
function GetWidth: integer; virtual;
|
|
function GetHeight: integer; virtual;
|
|
procedure GetLine(Line: integer; var Text, Attr: string); virtual;
|
|
procedure GetCursorPos(var P: TPoint); virtual;
|
|
function CanScroll : boolean; virtual;
|
|
function Scroll(i : integer) : integer; virtual;
|
|
procedure Capture; virtual;
|
|
procedure Restore; virtual;
|
|
procedure SaveIDEScreen; virtual;
|
|
procedure SaveConsoleScreen; virtual;
|
|
procedure SwitchToConsoleScreen; virtual;
|
|
procedure SwitchBackToIDEScreen; virtual;
|
|
private
|
|
DosScreenBufferHandle,
|
|
IDEScreenBufferHandle,
|
|
StartScreenBufferHandle,
|
|
DummyScreenBufferHandle,
|
|
NewScreenBufferHandle : THandle;
|
|
IDEActive : boolean;
|
|
ConsoleMode,IdeMode : Dword;
|
|
IdeScreenMode : TVideoMode;
|
|
procedure BufferCopy(src,dest : THandle);
|
|
{$ifdef debug}
|
|
procedure Complain(St : string);
|
|
Procedure SetConsoleMode(FH : Handle;Mode : DWord);
|
|
{$endif debug}
|
|
end;
|
|
{$endif}
|
|
|
|
procedure InitUserScreen;
|
|
procedure DoneUserScreen;
|
|
|
|
const UserScreen : PScreen = nil;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Dos,WUtils
|
|
{$ifdef GO32V2}
|
|
,Dpmiexcp, Go32
|
|
{$endif}
|
|
,Drivers,App
|
|
{$ifdef USE_GRAPH_SWITCH}
|
|
,Graph,VESA
|
|
{$else not USE_GRAPH_SWITCH}
|
|
{$ifdef VESA}
|
|
,VESA
|
|
{$endif VESA}
|
|
{$endif not USE_GRAPH_SWITCH}
|
|
;
|
|
|
|
function TScreen.GetWidth: integer;
|
|
begin
|
|
Getwidth:=0;
|
|
Abstract;
|
|
end;
|
|
|
|
function TScreen.GetHeight: integer;
|
|
begin
|
|
Getheight:=0;
|
|
Abstract;
|
|
end;
|
|
|
|
procedure TScreen.GetLine(Line: integer; var Text, Attr: string);
|
|
begin
|
|
Abstract;
|
|
end;
|
|
|
|
procedure TScreen.GetCursorPos(var P: TPoint);
|
|
begin
|
|
Abstract;
|
|
end;
|
|
|
|
procedure TScreen.Capture;
|
|
begin
|
|
Abstract;
|
|
end;
|
|
|
|
procedure TScreen.Restore;
|
|
begin
|
|
Abstract;
|
|
end;
|
|
|
|
procedure TScreen.SwitchToConsoleScreen;
|
|
begin
|
|
Abstract;
|
|
end;
|
|
|
|
procedure TScreen.SwitchBackToIDEScreen;
|
|
begin
|
|
Abstract;
|
|
end;
|
|
|
|
procedure TScreen.SaveIDEScreen;
|
|
begin
|
|
Abstract;
|
|
end;
|
|
|
|
function TScreen.Scroll(i : integer) : integer;
|
|
begin
|
|
Scroll:=0;
|
|
end;
|
|
|
|
function TScreen.CanScroll : boolean;
|
|
begin
|
|
CanScroll:=false;
|
|
end;
|
|
|
|
procedure TScreen.SaveConsoleScreen;
|
|
begin
|
|
Abstract;
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
TDOSScreen
|
|
****************************************************************************}
|
|
|
|
{$ifdef DOS}
|
|
|
|
constructor TDOSScreen.Init;
|
|
begin
|
|
inherited Init;
|
|
FillChar(LastTextConsoleVideoInfo,Sizeof(TDOSVideoInfo),#0);
|
|
Capture;
|
|
{ get the current ctrl-C state }
|
|
Ctrl_c_state:=djgpp_set_ctrl_c(false);
|
|
djgpp_set_ctrl_c(Ctrl_c_state);
|
|
end;
|
|
|
|
|
|
destructor TDOSScreen.Done;
|
|
begin
|
|
FreeBuffer;
|
|
if assigned(VIDEBuffer) then
|
|
FreeMem(VIDEBuffer,VIDEBufferSize);
|
|
inherited Done;
|
|
end;
|
|
|
|
|
|
function TDOSScreen.GetWidth: integer;
|
|
begin
|
|
GetWidth:=ConsoleVideoInfo.Cols;
|
|
end;
|
|
|
|
|
|
function TDOSScreen.GetHeight: integer;
|
|
begin
|
|
GetHeight:=ConsoleVideoInfo.Rows;
|
|
end;
|
|
|
|
|
|
procedure TDOSScreen.GetLine(Line: integer; var Text, Attr: string);
|
|
var
|
|
X: integer;
|
|
W: word;
|
|
begin
|
|
Text:=''; Attr:='';
|
|
if (Line<GetHeight) and
|
|
{$ifdef USE_GRAPH_SWITCH}
|
|
not assigned(GraphBuffer) and
|
|
{$endif USE_GRAPH_SWITCH}
|
|
assigned(VBuffer) then
|
|
begin
|
|
W:=GetLineStartOfs(Line);
|
|
for X:=0 to GetWidth-1 do
|
|
begin
|
|
{Text:=Text+chr(VBuffer^[W+X*2]);
|
|
Attr:=Attr+chr(VBuffer^[W+X*2+1]);}
|
|
System.Insert(chr(VBuffer^[W+X*2]),Text,Length(Text)+1);
|
|
System.Insert(chr(VBuffer^[W+X*2+1]),Attr,Length(Attr)+1);
|
|
end;
|
|
{$ifdef USE_GRAPH_SWITCH}
|
|
end
|
|
else if assigned(GraphBuffer) then
|
|
begin
|
|
if (Line=0) then
|
|
Text:='Console in graph mode, use Alt+F5'
|
|
else if (Line=1) then
|
|
Text:='Graph driver: '+GraphDriverName
|
|
else if (Line=2) then
|
|
Text:='Graph mode: '+GraphModeName+' ('+
|
|
IntToStr(GraphXres+1)+'x'+IntToStr(GraphYres+1)+')';
|
|
Attr:=CharStr(chr($0F),Length(Text));
|
|
end;
|
|
{$else not USE_GRAPH_SWITCH}
|
|
end;
|
|
{$endif USE_GRAPH_SWITCH}
|
|
end;
|
|
|
|
|
|
procedure TDOSScreen.GetCursorPos(var P: TPoint);
|
|
begin
|
|
P:=ConsoleVideoInfo.CurPos;
|
|
end;
|
|
|
|
|
|
procedure TDOSScreen.Capture;
|
|
begin
|
|
SaveConsoleScreen;
|
|
end;
|
|
|
|
procedure TDOSScreen.FreeGraphBuffer;
|
|
begin
|
|
{ We don't want to restore the last user screen if
|
|
it was a grpahic screen, for example if we
|
|
leave in the middle of the debugging of a
|
|
graphic program, so we first
|
|
dispose the graphic buffer, thus
|
|
SwitchToConsoleScreen will restore the
|
|
last used text mode }
|
|
if LastTextConsoleVideoInfo.Mode<>0 then
|
|
begin
|
|
ConsoleVideoInfo:=LastTextConsoleVideoInfo;
|
|
{$ifdef USE_GRAPH_SWITCH}
|
|
if assigned(GraphBuffer) then
|
|
begin
|
|
FreeMem(GraphBuffer,GraphImageSize);
|
|
GraphBuffer:=nil;
|
|
GraphImageSize:=0;
|
|
end;
|
|
{$endif USE_GRAPH_SWITCH}
|
|
end;
|
|
end;
|
|
|
|
procedure TDosScreen.Restore;
|
|
begin
|
|
FreeGraphBuffer;
|
|
SwitchToConsoleScreen;
|
|
end;
|
|
|
|
procedure TDosScreen.SaveIDEScreen;
|
|
var
|
|
VSeg,SOfs: word;
|
|
begin
|
|
GetVideoMode(IDEVideoInfo);
|
|
{ First keep a copy of IDE screen }
|
|
if ConsoleVideoInfo.Mode=7 then
|
|
VSeg:=SegB000
|
|
else
|
|
VSeg:=SegB800;
|
|
SOfs:=MemW[Seg0040:$4e];
|
|
if not assigned(VIDEBuffer) or (VIDEBufferSize<>IDEVideoInfo.ScreenSize) then
|
|
begin
|
|
if assigned(VIDEBuffer) then
|
|
FreeMem(VIDEBuffer,VIDEBufferSize);
|
|
GetMem(VIDEBuffer,IDEVideoInfo.ScreenSize);
|
|
VIDEBufferSize:=IDEVideoInfo.ScreenSize;
|
|
end;
|
|
DosmemGet(VSeg,SOfs,VIDEBuffer^,IDEVideoInfo.ScreenSize);
|
|
end;
|
|
|
|
procedure TDosScreen.SaveConsoleScreen;
|
|
var
|
|
VSeg,SOfs: word;
|
|
{$ifdef USE_GRAPH_SWITCH}
|
|
saved : boolean;
|
|
GraphDriver,GraphMode : integer;
|
|
{$endif USE_GRAPH_SWITCH}
|
|
begin
|
|
GetVideoMode(ConsoleVideoInfo);
|
|
{$ifdef USE_GRAPH_SWITCH}
|
|
saved:=false;
|
|
if assigned(GraphBuffer) then
|
|
begin
|
|
FreeMem(GraphBuffer,GraphImageSize);
|
|
GraphBuffer:=nil;
|
|
GraphImageSize:=0;
|
|
end;
|
|
if (ConsoleVideoInfo.Mode>= $100) or
|
|
(ConsoleVideoInfo.Mode=$13) or
|
|
(ConsoleVideoInfo.Mode=$12) or
|
|
(ConsoleVideoInfo.Mode=$10) or
|
|
(ConsoleVideoInfo.Mode=$E) then
|
|
begin
|
|
if VesaSetMode(ConsoleVideoInfo.Mode or $8000) then
|
|
begin
|
|
Graph.DontClearGraphMemory:=true;
|
|
if ConsoleVideoInfo.Mode>=$100 then
|
|
begin
|
|
GraphDriver:=Graph.Vesa;
|
|
GraphMode:=ConsoleVideoInfo.Mode and $fff;
|
|
end
|
|
else
|
|
begin
|
|
GraphDriver:=Graph.VGA;
|
|
case ConsoleVideoInfo.Mode of
|
|
$E : GraphMode:=VGALo;
|
|
$10 : GraphMode:=VGAMed;
|
|
$12 : GraphMode:=VGAHi;
|
|
$13 : begin
|
|
GraphDriver:=Graph.LowRes;
|
|
GraphMode:=0;
|
|
end;
|
|
end;
|
|
end;
|
|
Graph.InitGraph(GraphDriver,GraphMode,'');
|
|
if graphresult=grOk then
|
|
begin
|
|
ConsoleGraphDriver:=GraphDriver;
|
|
GraphDriverName:=GetDriverName;
|
|
GraphModeName:=GetModeName(GraphMode);
|
|
ConsoleGraphMode:=GraphMode;
|
|
Graph.DontClearGraphMemory:=false;
|
|
GraphXres:=Graph.GetmaxX;
|
|
GraphYres:=Graph.GetmaxY;
|
|
GraphImageSize:=ImageSize(0,0,GraphXres,GraphYres);
|
|
GetMem(GraphBuffer,GraphImageSize);
|
|
FillChar(GraphBuffer^,GraphImageSize,#0);
|
|
GetImage(0,0,GraphXres,GraphYres,GraphBuffer^);
|
|
ConsoleVideoInfo.Rows:=GraphYres div 8;
|
|
ConsoleVideoInfo.Cols:=GraphXres div 8;
|
|
{FreeBuffer;}
|
|
saved:=true;
|
|
end
|
|
{$ifdef DEBUG}
|
|
else
|
|
Writeln(stderr,'Error in InitGraph ',Graphdriver, ' ',Graphmode)
|
|
{$endif DEBUG}
|
|
;
|
|
end;
|
|
end;
|
|
{ mode < $100 so use standard Save code }
|
|
if not saved then
|
|
{$endif USE_GRAPH_SWITCH}
|
|
begin
|
|
LastTextConsoleVideoInfo:=ConsoleVideoInfo;
|
|
GetBuffer(ConsoleVideoInfo.ScreenSize);
|
|
if ConsoleVideoInfo.Mode=7 then
|
|
VSeg:=SegB000
|
|
else
|
|
VSeg:=SegB800;
|
|
SOfs:=MemW[Seg0040:$4e];
|
|
DosmemGet(VSeg,SOfs,VBuffer^,ConsoleVideoInfo.ScreenSize);
|
|
end;
|
|
end;
|
|
|
|
procedure TDOSScreen.SwitchToConsoleScreen;
|
|
var
|
|
VSeg,SOfs: word;
|
|
{$ifdef USE_GRAPH_SWITCH}
|
|
restored : boolean;
|
|
GraphDriver,GraphMode : integer;
|
|
{$endif USE_GRAPH_SWITCH}
|
|
begin
|
|
SetVideoMode(ConsoleVideoInfo);
|
|
{$ifdef USE_GRAPH_SWITCH}
|
|
restored:=false;
|
|
if assigned(GraphBuffer) then
|
|
begin
|
|
if VesaSetMode(ConsoleVideoInfo.Mode) then
|
|
begin
|
|
if ConsoleVideoInfo.Mode>=$100 then
|
|
begin
|
|
GraphDriver:=Graph.Vesa;
|
|
GraphMode:=ConsoleVideoInfo.Mode and $fff;
|
|
end
|
|
else
|
|
begin
|
|
GraphDriver:=Graph.VGA;
|
|
case ConsoleVideoInfo.Mode of
|
|
$E : GraphMode:=VGALo;
|
|
$10 : GraphMode:=VGAMed;
|
|
$12 : GraphMode:=VGAHi;
|
|
$13 : begin
|
|
GraphDriver:=Graph.LowRes;
|
|
GraphMode:=0;
|
|
end;
|
|
end;
|
|
end;
|
|
if (ConsoleGraphDriver<>GraphDriver) or
|
|
(ConsoleGraphMode<>GraphMode) then
|
|
Graph.InitGraph(GraphDriver,GraphMode,'');
|
|
if graphresult=grOk then
|
|
begin
|
|
PutImage(0,0,GraphBuffer^,CopyPut);
|
|
FreeMem(GraphBuffer,GraphImageSize);
|
|
GraphBuffer:=nil;
|
|
GraphImageSize:=0;
|
|
restored:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
{ mode < $100 so use standard Save code }
|
|
if not restored then
|
|
{$endif USE_GRAPH_SWITCH}
|
|
begin
|
|
if ConsoleVideoInfo.Mode=7 then
|
|
VSeg:=SegB000
|
|
else
|
|
VSeg:=SegB800;
|
|
SOfs:=MemW[Seg0040:$4e];
|
|
DosmemPut(VSeg,SOfs,VBuffer^,ConsoleVideoInfo.ScreenSize);
|
|
djgpp_set_ctrl_c(Ctrl_c_state);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDOSScreen.SwitchBackToIDEScreen;
|
|
var
|
|
VSeg,SOfs: word;
|
|
begin
|
|
SetVideoMode(IDEVideoInfo);
|
|
if ConsoleVideoInfo.Mode=7 then
|
|
VSeg:=SegB000
|
|
else
|
|
VSeg:=SegB800;
|
|
SOfs:=MemW[Seg0040:$4e];
|
|
if assigned(VIDEBuffer) then
|
|
DosmemPut(VSeg,SOfs,VIDEBuffer^,IDEVideoInfo.ScreenSize);
|
|
Ctrl_c_state := djgpp_set_ctrl_c(false);
|
|
{ Its difficult to know
|
|
the state of the mouse
|
|
so simply show it always
|
|
fixes bug 2253 PM }
|
|
ShowMouse;
|
|
end;
|
|
|
|
|
|
function TDOSScreen.GetLineStartOfs(Line: integer): word;
|
|
begin
|
|
GetLineStartOfs:=(ConsoleVideoInfo.Cols*Line)*2;
|
|
end;
|
|
|
|
|
|
procedure TDOSScreen.GetBuffer(Size: word);
|
|
begin
|
|
if (VBuffer<>nil) and (VBufferSize=Size) then Exit;
|
|
if VBuffer<>nil then FreeBuffer;
|
|
VBufferSize:=Size;
|
|
GetMem(VBuffer,VBufferSize);
|
|
end;
|
|
|
|
|
|
procedure TDOSScreen.FreeBuffer;
|
|
begin
|
|
if (VBuffer<>nil) and (VBufferSize>0) then FreeMem(VBuffer,VBufferSize);
|
|
VBuffer:=nil;
|
|
end;
|
|
|
|
|
|
procedure TDOSScreen.GetVideoMode(var MI: TDOSVideoInfo);
|
|
var
|
|
r: registers;
|
|
begin
|
|
if (MI.StateSize>0) and (MI.StateBuf<>nil) then
|
|
begin FreeMem(MI.StateBuf,MI.StateSize); MI.StateBuf:=nil; end;
|
|
|
|
MI.ScreenSize:=MemW[Seg0040:$4c];
|
|
r.ah:=$0f;
|
|
intr($10,r);
|
|
MI.Mode:=r.al;
|
|
MI.Page:=r.bh;
|
|
MI.Cols:=r.ah;
|
|
{$ifdef VESA}
|
|
VESAGetMode(MI.Mode);
|
|
MI.Mode:=MI.Mode and $fff;
|
|
{$endif}
|
|
MI.Rows:=MI.ScreenSize div (MI.Cols*2);
|
|
if MI.Rows=51 then MI.Rows:=50;
|
|
r.ah:=$03;
|
|
r.bh:=MI.Page;
|
|
intr($10,r);
|
|
with MI do
|
|
begin
|
|
CurPos.X:=r.dl; CurPos.Y:=r.dh;
|
|
CurShapeT:=r.ch; CurShapeB:=r.cl;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TDOSScreen.SetVideoMode(MI: TDOSVideoInfo);
|
|
var r: registers;
|
|
CM: TDOSVideoInfo;
|
|
begin
|
|
FillChar(CM,sizeof(CM),0);
|
|
GetVideoMode(CM);
|
|
|
|
if (CM.Mode<>MI.Mode) or (CM.Cols<>MI.Cols) or (CM.Rows<>MI.Rows) then
|
|
begin
|
|
{$ifdef VESA}
|
|
if MI.Mode>=$100 then
|
|
VESASetMode(MI.Mode)
|
|
else
|
|
{$endif}
|
|
begin
|
|
r.ah:=$00; r.al:=MI.Mode; intr($10,r);
|
|
end;
|
|
if (MI.Mode=3) and (MI.Cols=80) and (MI.Rows=50) then
|
|
begin
|
|
r.ax:=$1112; r.bx:=$0;
|
|
intr($10,r);
|
|
end;
|
|
end;
|
|
r.ah:=$05; r.al:=MI.Page; intr($10,r);
|
|
r.ah:=$02; r.bh:=MI.Page; r.dl:=MI.CurPos.X; r.dh:=MI.CurPos.Y; intr($10,r);
|
|
r.ah:=$01; r.ch:=MI.CurShapeT; r.cl:=MI.CurShapeB; intr($10,r);
|
|
end;
|
|
|
|
{$endif}
|
|
|
|
|
|
{****************************************************************************
|
|
TLinuxScreen
|
|
****************************************************************************}
|
|
|
|
{$ifdef Unix}
|
|
|
|
constructor TLinuxScreen.Init;
|
|
var
|
|
ThisTTY: string[30];
|
|
FName: string;
|
|
WS: packed record
|
|
ws_row, ws_col, ws_xpixel, ws_ypixel: Word;
|
|
end;
|
|
begin
|
|
inherited Init;
|
|
IdeScreen := nil;
|
|
TTYFd:=-1;
|
|
IsXterm:=getenv('TERM')='xterm';
|
|
ThisTTY:=TTYName(stdinputhandle);
|
|
if Not IsXterm and (IsATTY(stdinputhandle)<>-1) then
|
|
begin
|
|
Console:=TTyNetwork; {Default: Network or other vtxxx tty}
|
|
if ((Copy(ThisTTY, 1, 8) = '/dev/tty') and (ThisTTY[9]<>'p')) or (Copy(ThisTTY,1,8)='/dev/vc/') Then
|
|
begin
|
|
Case ThisTTY[9] of
|
|
'0'..'9' :
|
|
begin { running Linux on native console or native-emulation }
|
|
{$ifdef linux}
|
|
FName:='/dev/vcsa' + ThisTTY[9];
|
|
TTYFd:=fpOpen(FName, &666, O_RdWr); { open console }
|
|
if TTYFd = -1 then
|
|
begin
|
|
if try_grab_vcsa then
|
|
TTYFd:=fpOpen(FName, &666, O_RdWr); { try again }
|
|
end;
|
|
If TTYFd <>-1 Then
|
|
Console:=ttyLinux;
|
|
{$endif}
|
|
end;
|
|
'v' : { check for (Free?)BSD native}
|
|
If (ThisTTY[10]>='0') and (ThisTTY[10]<='9') Then
|
|
Console:=ttyFreeBSD; {TTYFd ?}
|
|
end;
|
|
end;
|
|
If Copy(GetEnv('TERM'),1,6)='cons25' Then
|
|
Console:=ttyFreeBSD;
|
|
fpioctl(stdinputhandle, TIOCGWINSZ, @WS);
|
|
if WS.ws_Col=0 then
|
|
WS.ws_Col:=80;
|
|
if WS.ws_Row=0 then
|
|
WS.ws_Row:=25;
|
|
ConsWidth:=WS.ws_Col;
|
|
ConsHeight:=WS.ws_row;
|
|
end;
|
|
Capture;
|
|
end;
|
|
|
|
|
|
destructor TLinuxScreen.Done;
|
|
begin
|
|
if assigned(IdeScreen) then
|
|
freemem(IdeScreen,IdeSize);
|
|
if assigned(ConsVideoBuf) then
|
|
freemem(ConsVideoBuf,ConsVideoBufSize);
|
|
inherited Done;
|
|
end;
|
|
|
|
|
|
function TLinuxScreen.GetWidth: integer;
|
|
begin
|
|
GetWidth:=ConsWidth;
|
|
end;
|
|
|
|
|
|
function TLinuxScreen.GetHeight: integer;
|
|
begin
|
|
GetHeight:=ConsHeight;
|
|
end;
|
|
|
|
|
|
procedure TLinuxScreen.GetLine(Line: integer; var Text, Attr: string);
|
|
var
|
|
X, W : longint;
|
|
begin
|
|
Text:='';
|
|
Attr:='';
|
|
if (TtyFd<>-1) and assigned(ConsVideoBuf) then
|
|
begin
|
|
if Line<GetHeight then
|
|
begin
|
|
W:=(ConsWidth*Line)*Sizeof(word);
|
|
for X:=0 to GetWidth-1 do
|
|
begin
|
|
{Text:=Text+chr(VBuffer^[W+X*2]);
|
|
Attr:=Attr+chr(VBuffer^[W+X*2+1]);}
|
|
System.Insert(chr(ConsVideoBuf^[W+X*2]),Text,Length(Text)+1);
|
|
System.Insert(chr(ConsVideoBuf^[W+X*2+1]),Attr,Length(Attr)+1);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure TLinuxScreen.GetCursorPos(var P: TPoint);
|
|
begin
|
|
P.X:=ConsCursorX+1;
|
|
P.Y:=ConsCursorY+1;
|
|
end;
|
|
|
|
|
|
procedure TLinuxScreen.Capture;
|
|
begin
|
|
SaveConsoleScreen;
|
|
end;
|
|
|
|
procedure TLinuxScreen.Restore;
|
|
begin
|
|
SwitchToConsoleScreen;
|
|
end;
|
|
|
|
procedure TLinuxScreen.SaveIDEScreen;
|
|
begin
|
|
if assigned(IdeScreen) then
|
|
freemem(IdeScreen,IdeSize);
|
|
getmem(IdeScreen,videobufsize);
|
|
IdeSize:=videobufsize;
|
|
move(videobuf^,IdeScreen^,videobufsize);
|
|
end;
|
|
|
|
procedure TLinuxScreen.SaveConsoleScreen;
|
|
var
|
|
NewSize : longint;
|
|
begin
|
|
if IsXTerm then
|
|
write(#27'7'#27'[?47h')
|
|
else if (TTYfd<>-1) then
|
|
begin
|
|
fpLSeek(TTYFd, 0, Seek_Set);
|
|
fpread(TTYFd,ConsHeight,sizeof(byte));
|
|
fpread(TTYFd,ConsWidth,sizeof(byte));
|
|
fpread(TTYFd,ConsCursorX,sizeof(byte));
|
|
fpread(TTYFd,ConsCursorY,sizeof(byte));
|
|
NewSize:=ConsWidth*ConsHeight*sizeof(word);
|
|
if (NewSize<>ConsVideoBufSize) and
|
|
assigned(ConsVideoBuf) then
|
|
Begin
|
|
FreeMem(ConsVideoBuf,ConsVideoBufSize);
|
|
ConsVideoBuf:=nil;
|
|
End;
|
|
If not assigned(ConsVideoBuf) then
|
|
GetMem(ConsVideoBuf,NewSize);
|
|
ConsVideoBufSize:=NewSize;
|
|
fpread(TTYFd,ConsVideoBuf^,ConsVideoBufSize);
|
|
end
|
|
else
|
|
begin
|
|
ConsWidth:=80;
|
|
ConsHeight:=25;
|
|
ConsCursorX:=0;
|
|
ConsCursorY:=0;
|
|
ConsVideoBuf:=nil;
|
|
end;
|
|
ConsTioValid:=(TCGetAttr(1,ConsTio)<>-1);
|
|
end;
|
|
|
|
|
|
procedure TLinuxScreen.SwitchToConsoleScreen;
|
|
begin
|
|
if IsXterm then
|
|
begin
|
|
write(#27'[0m');
|
|
write(#27'[?47l'#27'8'#27'[m');
|
|
end
|
|
else if (TTyfd<>-1) then
|
|
begin
|
|
fplSeek(TTYFd, 2, Seek_Set);
|
|
fpwrite(TTYFd, ConsCursorX, sizeof(byte));
|
|
fpwrite(TTYFd, ConsCursorY, sizeof(byte));
|
|
fpwrite(TTYFd, ConsVideoBuf^,ConsVideoBufSize);
|
|
{ FreeMem(ConsVideoBuf,ConsVideoBufSize);
|
|
ConsVideoBuf:=nil; }
|
|
end;
|
|
If ConsTioValid then
|
|
TCSetAttr(1,TCSANOW,ConsTio);
|
|
end;
|
|
|
|
procedure TLinuxScreen.SwitchBackToIDEScreen;
|
|
begin
|
|
if IdeScreen = nil then
|
|
exit;
|
|
move(IdeScreen^,videobuf^,videobufsize);
|
|
freemem(IdeScreen,IdeSize);
|
|
IdeScreen := nil;
|
|
end;
|
|
|
|
{$endif}
|
|
|
|
{****************************************************************************
|
|
TWindowsScreen
|
|
****************************************************************************}
|
|
|
|
{$ifdef Windows}
|
|
|
|
{ Seems to be missing in windows unit PM }
|
|
const
|
|
ENABLE_INSERT_MODE = $20;
|
|
ENABLE_QUICK_EDIT_MODE = $40;
|
|
ENABLE_EXTENDED_FLAGS = $80;
|
|
ENABLE_AUTO_POSITION = $100;
|
|
|
|
|
|
|
|
procedure UpdateFileHandles;
|
|
begin
|
|
{StdInputHandle:=longint(GetStdHandle(STD_INPUT_HANDLE));}
|
|
StdOutputHandle:=longint(GetStdHandle(cardinal(STD_OUTPUT_HANDLE)));
|
|
{StdErrorHandle:=longint(GetStdHandle(STD_ERROR_HANDLE));}
|
|
TextRec(Output).Handle:=StdOutputHandle;
|
|
TextRec(StdOut).Handle:=StdOutputHandle;
|
|
{TextRec(StdErr).Handle:=StdErrorHandle;}
|
|
end;
|
|
|
|
constructor TWindowsScreen.Init;
|
|
var
|
|
SecurityAttr : Security_attributes;
|
|
BigWin : Coord;
|
|
res : longbool;
|
|
Error : dword;
|
|
ConsoleScreenBufferInfo : Console_screen_buffer_info;
|
|
begin
|
|
inherited Init;
|
|
{if GetConsoleOutputCP<>437 then
|
|
res:=SetConsoleOutputCP(437);}
|
|
SecurityAttr.nLength:=SizeOf(Security_attributes);
|
|
SecurityAttr.lpSecurityDescriptor:=nil;
|
|
SecurityAttr.bInheritHandle:=true;
|
|
NewScreenBufferHandle:=CreateConsoleScreenBuffer(
|
|
GENERIC_READ or GENERIC_WRITE,
|
|
FILE_SHARE_READ or FILE_SHARE_WRITE,SecurityAttr,
|
|
CONSOLE_TEXTMODE_BUFFER,nil);
|
|
DummyScreenBufferHandle:=CreateConsoleScreenBuffer(
|
|
GENERIC_READ or GENERIC_WRITE,
|
|
FILE_SHARE_READ or FILE_SHARE_WRITE,SecurityAttr,
|
|
CONSOLE_TEXTMODE_BUFFER,nil);
|
|
StartScreenBufferHandle:=GetStdHandle(cardinal(STD_OUTPUT_HANDLE));
|
|
GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode);
|
|
IdeMode:=ConsoleMode;
|
|
{$ifdef debug}
|
|
Complain('Starting ConsoleMode is $'+hexstr(ConsoleMode,8));
|
|
{define Windowsbigwin}
|
|
{$endif debug}
|
|
{$ifdef Windowsbigwin}
|
|
GetConsoleScreenBufferInfo(StartScreenBufferHandle,
|
|
@ConsoleScreenBufferInfo);
|
|
BigWin.X:=ConsoleScreenBufferInfo.dwSize.X;
|
|
BigWin.Y:=ConsoleScreenBufferInfo.srwindow.bottom-ConsoleScreenBufferInfo.srwindow.top; // mants 15779 was 200
|
|
{ Try to allow to store more info }
|
|
res:=SetConsoleScreenBufferSize(NewScreenBufferHandle,BigWin);
|
|
if not res then
|
|
error:=GetLastError;
|
|
res:=SetConsoleScreenBufferSize(StartScreenBufferHandle,BigWin);
|
|
if not res then
|
|
error:=GetLastError;
|
|
{$endif Windowsbigwin}
|
|
GetConsoleScreenBufferInfo(StartScreenBufferHandle,
|
|
@ConsoleScreenBufferInfo);
|
|
{ make sure that the IDE Screen Handle has the maximum display size
|
|
this removes the scroll bars if it is maximized }
|
|
|
|
BigWin.X:=ConsoleScreenBufferInfo.dwSize.X;
|
|
BigWin.Y:=ConsoleScreenBufferInfo.srwindow.bottom-ConsoleScreenBufferInfo.srwindow.top;
|
|
res:=SetConsoleScreenBufferSize(NewScreenBufferHandle,
|
|
BigWin);
|
|
// mants 15779 : was
|
|
// res:=SetConsoleScreenBufferSize(NewScreenBufferHandle,
|
|
// ConsoleScreenBufferInfo.dwMaximumWindowSize);
|
|
if not res then
|
|
error:=GetLastError;
|
|
IDEScreenBufferHandle:=NewScreenBufferHandle;
|
|
DosScreenBufferHandle:=StartScreenBufferHandle;
|
|
Capture;
|
|
IdeScreenMode.row:=0;
|
|
SwitchBackToIDEScreen;
|
|
end;
|
|
|
|
destructor TWindowsScreen.Done;
|
|
begin
|
|
{ copy the Dos buffer content into the original ScreenBuffer
|
|
which remains the startup std_output_handle PM }
|
|
{if StartScreenBufferHandle=IDEScreenBufferHandle then}
|
|
BufferCopy(DosScreenBufferHandle,IDEScreenBufferHandle);
|
|
SetConsoleActiveScreenBuffer(StartScreenBufferHandle);
|
|
SetStdHandle(cardinal(Std_Output_Handle),StartScreenBufferHandle);
|
|
UpdateFileHandles;
|
|
CloseHandle(NewScreenBufferHandle);
|
|
CloseHandle(DummyScreenBufferHandle);
|
|
inherited Done;
|
|
end;
|
|
|
|
function TWindowsScreen.GetWidth: integer;
|
|
var
|
|
ConsoleScreenBufferInfo : Console_screen_buffer_info;
|
|
begin
|
|
GetConsoleScreenBufferInfo(DosScreenBufferHandle,
|
|
@ConsoleScreenBufferInfo);
|
|
GetWidth:=ConsoleScreenBufferInfo.dwSize.X;
|
|
end;
|
|
|
|
function TWindowsScreen.GetHeight: integer;
|
|
var
|
|
ConsoleScreenBufferInfo : Console_screen_buffer_info;
|
|
begin
|
|
GetConsoleScreenBufferInfo(DosScreenBufferHandle,
|
|
@ConsoleScreenBufferInfo);
|
|
GetHeight:=ConsoleScreenBufferInfo.dwSize.Y;
|
|
end;
|
|
|
|
function TWindowsScreen.CanScroll : boolean;
|
|
var
|
|
ConsoleScreenBufferInfo : Console_screen_buffer_info;
|
|
BufferLines : longint;
|
|
WindowLines : longint;
|
|
begin
|
|
GetConsoleScreenBufferInfo(DosScreenBufferHandle,
|
|
@ConsoleScreenBufferInfo);
|
|
WindowLines:=ConsoleScreenBufferInfo.srWindow.Bottom-
|
|
ConsoleScreenBufferInfo.srWindow.Top;
|
|
BufferLines:= ConsoleScreenBufferInfo.dwSize.Y-1;
|
|
CanScroll:=(BufferLines>WindowLines);
|
|
end;
|
|
|
|
function TWindowsScreen.Scroll(i : integer) : integer;
|
|
var
|
|
ConsoleScreenBufferInfo : Console_screen_buffer_info;
|
|
ConsoleWindow : Small_rect;
|
|
begin
|
|
GetConsoleScreenBufferInfo(DosScreenBufferHandle,
|
|
@ConsoleScreenBufferInfo);
|
|
if (ConsoleScreenBufferInfo.srWindow.Top + i < 0) then
|
|
i:= -ConsoleScreenBufferInfo.srWindow.Top;
|
|
if (ConsoleScreenBufferInfo.srWindow.Bottom + i > ConsoleScreenBufferInfo.dwSize.Y) then
|
|
i:= ConsoleScreenBufferInfo.dwSize.Y - ConsoleScreenBufferInfo.srWindow.Bottom;
|
|
if i<>0 then
|
|
begin
|
|
ConsoleWindow.Left:=ConsoleScreenBufferInfo.srWindow.Left;
|
|
ConsoleWindow.Right:=ConsoleScreenBufferInfo.srWindow.Right;
|
|
ConsoleWindow.Top:=ConsoleScreenBufferInfo.srWindow.Top+i;
|
|
ConsoleWindow.Bottom:=ConsoleScreenBufferInfo.srWindow.Bottom+i;
|
|
SetConsoleWindowInfo(DosScreenBufferHandle,true,ConsoleWindow);
|
|
Scroll:=i;
|
|
end
|
|
else
|
|
Scroll:=0;
|
|
end;
|
|
|
|
procedure TWindowsScreen.GetLine(Line: integer; var Text, Attr: string);
|
|
type
|
|
CharInfoArray = Array [0..255] of Char_Info;
|
|
var
|
|
LineBuf : ^CharInfoArray;
|
|
BufSize,BufCoord : Coord;
|
|
i,LineSize : longint;
|
|
WriteRegion : SMALL_RECT;
|
|
begin
|
|
GetMem(LineBuf,SizeOf(CharInfoArray));
|
|
LineSize:=ScreenWidth;
|
|
If LineSize>256 then
|
|
LineSize:=256;
|
|
BufSize.X:=LineSize;
|
|
BufSize.Y:=1;
|
|
BufCoord.X:=0;
|
|
BufCoord.Y:=0;
|
|
with WriteRegion do
|
|
begin
|
|
Top :=Line;
|
|
Left :=0;
|
|
Bottom := Line+1;
|
|
Right := LineSize-1;
|
|
end;
|
|
ReadConsoleOutput(DosScreenBufferHandle, PChar_info(LineBuf),
|
|
BufSize, BufCoord, @WriteRegion);
|
|
for i:=1 to LineSize do
|
|
begin
|
|
Text[i]:=LineBuf^[i-1].AsciiChar;
|
|
Attr[i]:=char(byte(LineBuf^[i-1].Attributes));
|
|
end;
|
|
FreeMem(LineBuf,SizeOf(CharInfoArray));
|
|
Text[0]:=char(byte(LineSize));
|
|
Attr[0]:=char(byte(LineSize));
|
|
end;
|
|
|
|
|
|
procedure TWindowsScreen.GetCursorPos(var P: TPoint);
|
|
var
|
|
ConsoleScreenBufferInfo : Console_screen_buffer_info;
|
|
begin
|
|
GetConsoleScreenBufferInfo(DosScreenBufferHandle,
|
|
@ConsoleScreenBufferInfo);
|
|
P.X:=ConsoleScreenBufferInfo.dwCursorPosition.X;
|
|
P.Y:=ConsoleScreenBufferInfo.dwCursorPosition.Y;
|
|
end;
|
|
|
|
procedure TWindowsScreen.BufferCopy(Src, Dest : THandle);
|
|
type
|
|
CharInfoArray = Array [0..256*255-1] of Char_Info;
|
|
var
|
|
LineBuf : ^CharInfoArray;
|
|
BufSize,BufCoord : Coord;
|
|
Error, LineSize,
|
|
Part, OnePartY: longint;
|
|
res : boolean;
|
|
WriteRegion : SMALL_RECT;
|
|
ConsoleScreenBufferInfo : Console_screen_buffer_info;
|
|
DestConsoleScreenBufferInfo : Console_screen_buffer_info;
|
|
begin
|
|
GetConsoleScreenBufferInfo(Src,
|
|
@ConsoleScreenBufferInfo);
|
|
GetConsoleScreenBufferInfo(Dest,
|
|
@DestConsoleScreenBufferInfo);
|
|
GetMem(LineBuf,SizeOf(CharInfoArray));
|
|
FillChar(LineBuf^,SizeOf(CharInfoArray),#0);
|
|
|
|
LineSize:=ConsoleScreenBufferInfo.dwSize.X;
|
|
If LineSize>256 then
|
|
LineSize:=256;
|
|
BufSize.X:=LineSize;
|
|
BufSize.Y:=ConsoleScreenBufferInfo.dwSize.Y;
|
|
BufCoord.X:=0;
|
|
BufCoord.Y:=0;
|
|
with WriteRegion do
|
|
begin
|
|
Top :=0;
|
|
Left :=0;
|
|
Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
|
|
Right := LineSize-1;
|
|
end;
|
|
if BufSize.X*BufSize.Y*Sizeof(CHAR_INFO) >= $8000 then
|
|
begin
|
|
OnePartY := ($8000 -1) div (BufSize.X * SizeOf(Char_Info) );
|
|
BufSize.Y:=OnePartY;
|
|
Part:=0;
|
|
while ((Part+1)*OnePartY < ConsoleScreenBufferInfo.dwSize.Y) do
|
|
begin
|
|
WriteRegion.Top := Part*OnePartY;
|
|
WriteRegion.Bottom := (Part+1)*OnePartY-1;
|
|
res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
|
|
BufSize, BufCoord, @WriteRegion);
|
|
if not res then
|
|
Error:=GetLastError;
|
|
res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
|
|
BufSize, BufCoord, @WriteRegion);
|
|
if not res then
|
|
Error:=GetLastError;
|
|
Inc(Part);
|
|
end;
|
|
BufSize.Y:=ConsoleScreenBufferInfo.dwSize.Y - Part*OnePartY;
|
|
WriteRegion.Top := Part*OnePartY;
|
|
WriteRegion.Bottom := ConsoleScreenBufferInfo.dwSize.Y-1;
|
|
res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
|
|
BufSize, BufCoord, @WriteRegion);
|
|
if not res then
|
|
Error:=GetLastError;
|
|
res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
|
|
BufSize, BufCoord, @WriteRegion);
|
|
if not res then
|
|
Error:=GetLastError;
|
|
end
|
|
else
|
|
begin
|
|
res:=ReadConsoleOutput(Src, PChar_info(LineBuf),
|
|
BufSize, BufCoord, @WriteRegion);
|
|
if not res then
|
|
Error:=GetLastError;
|
|
res:=WriteConsoleOutput(Dest, PChar_info(LineBuf),
|
|
BufSize, BufCoord, @WriteRegion);
|
|
if not res then
|
|
Error:=GetLastError;
|
|
end;
|
|
FreeMem(LineBuf,SizeOf(CharInfoArray));
|
|
SetConsoleCursorPosition(Dest, ConsoleScreenBufferInfo.dwCursorPosition);
|
|
end;
|
|
|
|
procedure TWindowsScreen.Capture;
|
|
begin
|
|
{if StartScreenBufferHandle=IdeScreenBufferHandle then
|
|
BufferCopy(IDEScreenBufferHandle,DosScreenBufferHandle)
|
|
else
|
|
BufferCopy(DosScreenBufferHandle,IDEScreenBufferHandle);}
|
|
SaveConsoleScreen;
|
|
end;
|
|
|
|
procedure TWindowsScreen.Restore;
|
|
begin
|
|
SwitchToConsoleScreen;
|
|
end;
|
|
|
|
{ dummy for Windows as the Buffer screen
|
|
do hold all the info }
|
|
procedure TWindowsScreen.SaveIDEScreen;
|
|
var
|
|
NowIdeMode : Dword;
|
|
begin
|
|
IdeScreenMode:=ScreenMode;
|
|
GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @NowIdeMode);
|
|
{$ifdef debug}
|
|
Complain('IDE ConsoleMode is $'+hexstr(NowIdeMode,8));
|
|
if NowIdeMode<>IdeMode then
|
|
Complain('is not equal to IDEMode $'+hexstr(IdeMode,8));
|
|
{$endif debug}
|
|
IdeMode:=NowIdeMode;
|
|
{ set the dummy buffer as active already now PM }
|
|
SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle);
|
|
UpdateFileHandles;
|
|
end;
|
|
|
|
{ dummy for Windows as the Buffer screen
|
|
do hold all the info }
|
|
procedure TWindowsScreen.SaveConsoleScreen;
|
|
begin
|
|
GetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), @ConsoleMode);
|
|
{$ifdef debug}
|
|
Complain('ConsoleMode now is $'+hexstr(ConsoleMode,8));
|
|
{$endif debug}
|
|
{ set the dummy buffer as active already now PM }
|
|
SetStdHandle(cardinal(Std_Output_Handle),DummyScreenBufferHandle);
|
|
UpdateFileHandles;
|
|
end;
|
|
|
|
procedure TWindowsScreen.SwitchToConsoleScreen;
|
|
begin
|
|
SetConsoleActiveScreenBuffer(DosScreenBufferHandle);
|
|
SetStdHandle(cardinal(Std_Output_Handle),DosScreenBufferHandle);
|
|
SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), ConsoleMode);
|
|
UpdateFileHandles;
|
|
IDEActive:=false;
|
|
end;
|
|
|
|
procedure TWindowsScreen.SwitchBackToIDEScreen;
|
|
var
|
|
ConsoleScreenBufferInfo : Console_screen_buffer_info;
|
|
WindowPos : Small_rect;
|
|
res : boolean;
|
|
error : longint;
|
|
begin
|
|
SetStdHandle(cardinal(Std_Output_Handle),IDEScreenBufferHandle);
|
|
UpdateFileHandles;
|
|
GetConsoleScreenBufferInfo(IDEScreenBufferHandle,
|
|
@ConsoleScreenBufferInfo);
|
|
SetConsoleActiveScreenBuffer(IDEScreenBufferHandle);
|
|
{ Needed to force InitSystemMsg to use the right console handle }
|
|
DoneEvents;
|
|
InitEvents;
|
|
IdeMode:=({IdeMode or }ENABLE_MOUSE_INPUT or
|
|
ENABLE_WINDOW_INPUT or
|
|
ENABLE_EXTENDED_FLAGS)
|
|
and not (ENABLE_PROCESSED_INPUT or
|
|
ENABLE_LINE_INPUT or
|
|
ENABLE_ECHO_INPUT or
|
|
ENABLE_INSERT_MODE or
|
|
ENABLE_QUICK_EDIT_MODE);
|
|
SetConsoleMode(GetStdHandle(cardinal(Std_Input_Handle)), IdeMode);
|
|
WindowPos.left:=0;
|
|
WindowPos.right:=ConsoleScreenBufferInfo.srWindow.right
|
|
-ConsoleScreenBufferInfo.srWindow.left;
|
|
WindowPos.top:=0;
|
|
WindowPos.bottom:=ConsoleScreenBufferInfo.srWindow.bottom
|
|
-ConsoleScreenBufferInfo.srWindow.top;
|
|
with ConsoleScreenBufferInfo.dwMaximumWindowSize do
|
|
begin
|
|
if WindowPos.Right<X-1 then
|
|
WindowPos.right:=X-1;
|
|
if WindowPos.Bottom<Y-1 then
|
|
WindowPos.Bottom:=Y-1;
|
|
end;
|
|
res:=SetConsoleWindowInfo(IDEScreenBufferHandle,true,WindowPos);
|
|
if not res then
|
|
error:=GetLastError;
|
|
{$ifdef DEBUG}
|
|
IdeScreenMode.row:=WindowPos.bottom+1;
|
|
IdeScreenMode.col:=WindowPos.right+1;
|
|
{$endif DEBUG}
|
|
{ needed to force the correct size for videobuf }
|
|
if Assigned(Application) and (IdeScreenMode.row<>0)then
|
|
Application^.SetScreenVideoMode(IdeScreenMode);
|
|
IDEActive:=true;
|
|
end;
|
|
|
|
{$ifdef debug}
|
|
|
|
procedure TWindowsScreen.Complain(St : string);
|
|
begin
|
|
if IDEActive then
|
|
DebugMessage('',St,0,0)
|
|
else
|
|
Writeln(stderr,St);
|
|
end;
|
|
|
|
procedure TWindowsScreen.SetConsoleMode(FH : Handle;Mode: DWord);
|
|
var
|
|
Test: DWord;
|
|
begin
|
|
If not Windows.SetConsoleMode(FH,Mode) then
|
|
begin
|
|
Complain('SetConsoleMode call failed GetLastError='+IntToStr(GetLastError));
|
|
end
|
|
else
|
|
begin
|
|
if not GetConsoleMode(FH,Test) then
|
|
begin
|
|
Complain('GetConsoleMode call failed GetLastError='+IntToStr(GetLastError));
|
|
end
|
|
else if (Test<>Mode) then
|
|
begin
|
|
Complain('GetConsoleMode result '+IntToStr(Test)+' <> '+
|
|
IntToStr(Mode));
|
|
end;
|
|
end;
|
|
end;
|
|
{$endif DEBUG}
|
|
|
|
{$endif}
|
|
|
|
{****************************************************************************
|
|
TOS2Screen
|
|
****************************************************************************}
|
|
|
|
|
|
{$ifdef OS2}
|
|
function TOS2Screen.GetWidth: integer;
|
|
begin
|
|
GetWidth:=80;
|
|
end;
|
|
|
|
function TOS2Screen.GetHeight: integer;
|
|
begin
|
|
GetHeight:=25;
|
|
end;
|
|
|
|
procedure TOS2Screen.GetLine(Line: integer; var Text, Attr: string);
|
|
begin
|
|
Text:=' ';
|
|
Attr:=' ';
|
|
end;
|
|
|
|
procedure TOS2Screen.GetCursorPos(var P: TPoint);
|
|
begin
|
|
P.X:=1;
|
|
P.Y:=1;
|
|
end;
|
|
|
|
{ remember the initial video screen }
|
|
procedure TOS2Screen.Capture;
|
|
begin
|
|
end;
|
|
|
|
{ restore the initial video mode }
|
|
procedure TOS2Screen.Restore;
|
|
begin
|
|
end;
|
|
|
|
{ move up or down if supported by OS }
|
|
function TOS2Screen.Scroll(i : integer) : integer;
|
|
begin
|
|
end;
|
|
|
|
{ saves the current IDE screen }
|
|
procedure TOS2Screen.SaveIDEScreen;
|
|
begin
|
|
end;
|
|
|
|
{ saves the current console screen }
|
|
procedure TOS2Screen.SaveConsoleScreen;
|
|
begin
|
|
end;
|
|
|
|
{ restores the saved console screen }
|
|
procedure TOS2Screen.SwitchToConsoleScreen;
|
|
begin
|
|
end;
|
|
|
|
{ restores the saved IDE screen }
|
|
procedure TOS2Screen.SwitchBackToIDEScreen;
|
|
begin
|
|
end;
|
|
|
|
constructor TOS2Screen.Init;
|
|
begin
|
|
end;
|
|
|
|
destructor TOS2Screen.Done;
|
|
begin
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
|
|
{****************************************************************************
|
|
TNWLScreen
|
|
****************************************************************************}
|
|
|
|
|
|
{$ifdef netwlibc}
|
|
function TNWLScreen.GetWidth: integer;
|
|
begin
|
|
GetWidth:=80;
|
|
end;
|
|
|
|
function TNWLScreen.GetHeight: integer;
|
|
begin
|
|
GetHeight:=25;
|
|
end;
|
|
|
|
procedure TNWLScreen.GetLine(Line: integer; var Text, Attr: string);
|
|
begin
|
|
Text:=' ';
|
|
Attr:=' ';
|
|
end;
|
|
|
|
procedure TNWLScreen.GetCursorPos(var P: TPoint);
|
|
begin
|
|
P.X:=1;
|
|
P.Y:=1;
|
|
end;
|
|
|
|
{ remember the initial video screen }
|
|
procedure TNWLScreen.Capture;
|
|
begin
|
|
end;
|
|
|
|
{ restore the initial video mode }
|
|
procedure TNWLScreen.Restore;
|
|
begin
|
|
end;
|
|
|
|
{ saves the current IDE screen }
|
|
procedure TNWLScreen.SaveIDEScreen;
|
|
begin
|
|
end;
|
|
|
|
{ saves the current console screen }
|
|
procedure TNWLScreen.SaveConsoleScreen;
|
|
begin
|
|
end;
|
|
|
|
{ restores the saved console screen }
|
|
procedure TNWLScreen.SwitchToConsoleScreen;
|
|
begin
|
|
end;
|
|
|
|
{ restores the saved IDE screen }
|
|
procedure TNWLScreen.SwitchBackToIDEScreen;
|
|
begin
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
|
|
{****************************************************************************
|
|
TAmigaScreen
|
|
****************************************************************************}
|
|
|
|
|
|
{$IFDEF AMIGASCREEN}
|
|
function TAmigaScreen.GetWidth: integer;
|
|
begin
|
|
GetWidth:=80;
|
|
end;
|
|
|
|
function TAmigaScreen.GetHeight: integer;
|
|
begin
|
|
GetHeight:=25;
|
|
end;
|
|
|
|
procedure TAmigaScreen.GetLine(Line: integer; var Text, Attr: string);
|
|
begin
|
|
Text:=' ';
|
|
Attr:=' ';
|
|
end;
|
|
|
|
procedure TAmigaScreen.GetCursorPos(var P: TPoint);
|
|
begin
|
|
P.X:=1;
|
|
P.Y:=1;
|
|
end;
|
|
|
|
{ remember the initial video screen }
|
|
procedure TAmigaScreen.Capture;
|
|
begin
|
|
end;
|
|
|
|
{ restore the initial video mode }
|
|
procedure TAmigaScreen.Restore;
|
|
begin
|
|
end;
|
|
|
|
{ saves the current IDE screen }
|
|
procedure TAmigaScreen.SaveIDEScreen;
|
|
begin
|
|
end;
|
|
|
|
{ saves the current console screen }
|
|
procedure TAmigaScreen.SaveConsoleScreen;
|
|
begin
|
|
end;
|
|
|
|
{ restores the saved console screen }
|
|
procedure TAmigaScreen.SwitchToConsoleScreen;
|
|
begin
|
|
end;
|
|
|
|
{ restores the saved IDE screen }
|
|
procedure TAmigaScreen.SwitchBackToIDEScreen;
|
|
begin
|
|
end;
|
|
|
|
{$ENDIF}
|
|
|
|
|
|
{****************************************************************************
|
|
Initialize
|
|
****************************************************************************}
|
|
|
|
procedure InitUserScreen;
|
|
begin
|
|
{$ifdef DOS}
|
|
UserScreen:=New(PDOSScreen, Init);
|
|
{$else}
|
|
{$ifdef Unix}
|
|
UserScreen:=New(PLinuxScreen, Init);
|
|
{$else}
|
|
|
|
{$ifdef Windows}
|
|
UserScreen:=New(PWindowsScreen, Init);
|
|
{$else}
|
|
{$ifdef OS2}
|
|
UserScreen:=New(POS2Screen, Init);
|
|
{$else}
|
|
{$ifdef netwlibc}
|
|
UserScreen:=New(PNWLScreen, Init);
|
|
{$else}
|
|
{$ifdef AMIGASCREEN}
|
|
UserScreen:=nil; //New(PAmigaScreen, Init);
|
|
{$else}
|
|
UserScreen:=New(PScreen, Init);
|
|
{$endif AMIGASCREEN}
|
|
{$endif netwlibc}
|
|
{$endif OS2}
|
|
{$endif Windows}
|
|
{$endif Unix}
|
|
{$endif Dos}
|
|
end;
|
|
|
|
|
|
procedure DoneUserScreen;
|
|
begin
|
|
if UserScreen<>nil then
|
|
begin
|
|
UserScreen^.Restore;
|
|
Dispose(UserScreen, Done);
|
|
UserScreen:=nil;
|
|
end;
|
|
end;
|
|
|
|
end.
|