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

rtl-console/amicommon: added a way to redefine colors externally in the video unit

Browse Source
This commit is contained in:
Karoly Balogh 2024-11-01 16:19:21 +01:00
parent f8b454779f
commit 5acf85a932
1 changed files with 30 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -42,6 +42,8 @@ uses
{$i videoh.inc}
type
TVideoColorMap = array[0..15,0..2] of byte;
{ Amiga specific calls, to help interaction between Keyboard, Mouse and
Video units, and Free Vision }
@ -57,6 +59,8 @@ procedure GotInactiveWindow;
function HasInactiveWindow: boolean;
procedure SetWindowTitle(const winTitle: AnsiString; const screenTitle: AnsiString);
procedure TranslateToCharXY(const X,Y: LongInt; var CX,CY: LongInt);
procedure SetAllColors(const colormap: TVideoColorMap);
var
VideoWindow: PWindow;
@ -920,6 +924,32 @@ begin
end;
{$endif}
procedure SetAllColors(const colormap: TVideoColorMap);
var
counter: longint;
begin
{$if not defined(AMIGA_V1_2_ONLY)}
for Counter := 0 to 15 do
ReleasePen(VideoColorMap, VideoPens[Counter]);
{$endif}
for Counter := 0 to 15 do
begin
{$if defined(AMIGA_V1_2_ONLY)}
VideoPens[Counter] := Counter;
SetRGB4(@(PScreen(VideoWindow^.WScreen)^.ViewPort), Counter, colormap[counter, 0] shr 4, colormap[counter, 1] shr 4, colormap[counter, 2] shr 4);
{$else}
VideoPens[Counter] := ObtainBestPenA(VideoColorMap,
colormap[counter, 0] shl 24, colormap[counter, 1] shl 24, colormap[counter, 2] shl 24, nil);
{$endif}
{$ifdef VIDEODEBUG}
If VideoPens[Counter] = -1 then
WriteLn('errr color[',Counter,'] = ', VideoPens[Counter])
else
WriteLn('good color[',Counter,'] = ', VideoPens[Counter]);
{$endif}
end;
end;
initialization
SetVideoDriver(SysVideoDriver);