paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-19 13:59:29 +02:00
Code Issues Packages Projects Releases Wiki Activity

* rtl-console: on Amiga added a custom screen update call, to do partial screen updates. doing a full update can be very slow on low-end systems (checking the entire screen buffer every time), so software tuned for these can now request partial updates, when the updated already is already known

Browse Source
This commit is contained in:
Karoly Balogh 2021-12-25 16:42:00 +01:00
parent 22cd8d5d62
commit 9894fe8082
1 changed files with 16 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
packages/rtl-console/src/amicommon/video.pp
View File

@ -49,6 +49,7 @@ procedure GotInactiveWindow;
function HasInactiveWindow: boolean;
procedure SetWindowTitle(const winTitle: AnsiString; const screenTitle: AnsiString);
procedure TranslateToCharXY(const X,Y: LongInt; var CX,CY: LongInt);
procedure UpdateScreenPart(const X1,Y1,X2,Y2: Longint; Force: Boolean);
var
VideoWindow: PWindow;
@ -562,13 +563,14 @@ begin
end;
end;
procedure SysUpdateScreen(Force: Boolean);
procedure UpdateScreenPart(const X1,Y1,X2,Y2: Longint; Force: Boolean);
var
SmallForce: Boolean;
Counter, CounterX, CounterY: LongInt;
CounterX, CounterY: LongInt;
LocalRP: PRastPort;
sY, sX: LongInt;
TmpCharData: Word;
BufStartOfs: LongInt;
{$ifdef VideoSpeedTest}
NumChanged: Integer;
t,ta: Double;
@ -612,16 +614,17 @@ begin
if Smallforce then
begin
VBuf:=@VideoBuf^[0];
OldVBuf:=@OldVideoBuf^[0];
BufStartOfs:=y1 * ScreenWidth + x1;
VBuf:=@VideoBuf^[BufStartOfs];
OldVBuf:=@OldVideoBuf^[BufStartOfs];
{$ifdef VideoSpeedTest}
t := now();
{$endif}
sY := videoWindow^.borderTop;
for CounterY := 0 to ScreenHeight - 1 do
sY := videoWindow^.borderTop + Y1 * VideoFontHeight;
for CounterY := Y1 to Y2 do
begin
sX := videoWindow^.borderLeft;
for CounterX := 0 to ScreenWidth - 1 do
sX := videoWindow^.borderLeft + X1 * 8;
for CounterX := X1 to X2 do
begin
if (VBuf^ <> OldVBuf^) or Force then
begin
@ -663,6 +666,10 @@ begin
{$endif}
end;
procedure SysUpdateScreen(Force: Boolean);
begin
UpdateScreenPart(0,0,ScreenWidth-1,ScreenHeight-1,Force);
end;
procedure SysSetCursorPos(NewCursorX, NewCursorY: Word);
begin