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

+ support both legacy and enhanced video buffers in Video.ClearScreen

Browse Source 
git-svn-id: branches/unicodekvm@48487 -
This commit is contained in:
nickysn 2021-02-01 06:19:12 +00:00
parent cb6ba25e1b
commit d5283cae7f
1 changed files with 45 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
packages/rtl-console/src/inc/video.inc
View File

@ -360,16 +360,52 @@ begin
end;
end;
Procedure ClearScreen;
begin
procedure ClearScreen;
const
DefaultChar=#32;
// Should this not be the current color ?
FillWord(VideoBuf^,VideoBufSize shr 1,$0720);
If Assigned(CurrentVideoDriver.ClearScreen) then
CurrentVideoDriver.ClearScreen
else
UpdateScreen(True);
FillWord(OldVideoBuf^,VideoBufSize shr 1,$0720);
DefaultAttr=7;
var
I: Integer;
begin
if VideoInitialized then
begin
FillWord(VideoBuf^,VideoBufSize shr 1,(DefaultAttr shl 8) or Ord(DefaultChar));
If Assigned(CurrentVideoDriver.ClearScreen) then
begin
if Assigned(CurrentVideoDriver.InitEnhancedDriver) then
Legacy2Enhanced;
CurrentVideoDriver.ClearScreen;
end
else
UpdateScreen(True);
FillWord(OldVideoBuf^,VideoBufSize shr 1,(DefaultAttr shl 8) or Ord(DefaultChar));
end
else if EnhancedVideoInitialized then
begin
{ todo: optimize }
for I:=0 to Length(EnhancedVideoBuf) do
with EnhancedVideoBuf[I] do
begin
Attribute:=DefaultAttr;
ExtendedGraphemeCluster:=DefaultChar;
end;
If Assigned(CurrentVideoDriver.ClearScreen) then
begin
if Assigned(CurrentVideoDriver.InitDriver) then
Enhanced2Legacy;
CurrentVideoDriver.ClearScreen;
end
else
UpdateScreen(True);
{ todo: optimize }
for I:=0 to Length(EnhancedVideoBuf) do
with OldEnhancedVideoBuf[I] do
begin
Attribute:=DefaultAttr;
ExtendedGraphemeCluster:=DefaultChar;
end;
end;
end;
Procedure SetCursorType (NewType : Word);