paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-21 15:49:26 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ setallpalette hook

Browse Source 
+ setallpalette implemented for standard vga and VESA 2.0+
This commit is contained in:
Jonas Maebe 2000-08-12 12:27:13 +00:00
parent 2eb5a5c148
commit 2f3239d61c
6 changed files with 175 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

68
rtl/go32v2/graph.pp
View File

@ -1749,6 +1749,37 @@ const CrtAddress: word = 0;
end;
{$ENDIF DPMI}
Procedure SetVGARGBAllPalette(const Palette:PaletteType); {$ifndef fpc}far;{$endif fpc}
var
c: byte;
begin
{ wait for vertical retrace start/end}
while (port[$3da] and $8) <> 0 do;
while (port[$3da] and $8) = 0 do;
If MaxColor = 16 Then
begin
for c := 0 to 15 do
begin
{ translate the color number for 16 color mode }
portb[$3c8] := toRealCols16[c];
portb[$3c9] := palette.colors[c].red shr 2;
portb[$3c9] := palette.colors[c].green shr 2;
portb[$3c9] := palette.colors[c].blue shr 2;
end
end
else
begin
portb[$3c8] := 0;
for c := 0 to 255 do
begin
{ no need to set port[$3c8] every time if you set the entries }
{ for successive colornumbers (JM) }
portb[$3c9] := palette.colors[c].red shr 2;
portb[$3c9] := palette.colors[c].green shr 2;
portb[$3c9] := palette.colors[c].blue shr 2;
end
end;
End;
{ VGA is never a direct color mode, so no need to check ... }
@ -1972,6 +2003,7 @@ const CrtAddress: word = 0;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel320;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual320;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive320;
mode.InitMode := {$ifdef fpc}@{$endif}Init320;
@ -1995,6 +2027,7 @@ const CrtAddress: word = 0;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixelX;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualX;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveX;
mode.InitMode := {$ifdef fpc}@{$endif}InitModeX;
@ -2017,6 +2050,7 @@ const CrtAddress: word = 0;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual200;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive200;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x200x16;
@ -2043,6 +2077,7 @@ const CrtAddress: word = 0;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x350x16;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual350;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive350;
mode.HLine := {$ifdef fpc}@{$endif}HLine16;
@ -2067,6 +2102,7 @@ const CrtAddress: word = 0;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixel16;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVGARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVGARGBPalette;
mode.SetAllPalette := {$ifdef fpc}@{$endif}SetVGARGBAllPalette;
mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x16;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisual480;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActive480;
@ -2170,6 +2206,9 @@ const CrtAddress: word = 0;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
{$ifdef fpc}
mode.SetAllPalette := @SetVESARGBAllPalette;
{$endif fpc}
mode.InitMode := {$ifdef fpc}@{$endif}Init640x400x256;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
@ -2198,6 +2237,9 @@ const CrtAddress: word = 0;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
{$ifdef fpc}
mode.SetAllPalette := @SetVESARGBAllPalette;
{$endif fpc}
mode.InitMode := {$ifdef fpc}@{$endif}Init640x480x256;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
@ -2278,6 +2320,9 @@ const CrtAddress: word = 0;
mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
{$ifdef fpc}
mode.SetAllPalette := @SetVESARGBAllPalette;
{$endif fpc}
mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x16;
@ -2306,6 +2351,9 @@ const CrtAddress: word = 0;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
{$ifdef fpc}
mode.SetAllPalette := @SetVESARGBAllPalette;
{$endif fpc}
mode.InitMode := {$ifdef fpc}@{$endif}Init800x600x256;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
@ -2387,6 +2435,9 @@ const CrtAddress: word = 0;
mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
{$ifdef fpc}
mode.SetAllPalette := @SetVESARGBAllPalette;
{$endif fpc}
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x16;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
@ -2414,6 +2465,9 @@ const CrtAddress: word = 0;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA256;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
{$ifdef fpc}
mode.SetAllPalette := @SetVESARGBAllPalette;
{$endif fpc}
mode.InitMode := {$ifdef fpc}@{$endif}Init1024x768x256;
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
@ -2494,6 +2548,9 @@ const CrtAddress: word = 0;
mode.DirectPutPixel:={$ifdef fpc}@{$endif}DirectPutPixVESA16;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
{$ifdef fpc}
mode.SetAllPalette := @SetVESARGBAllPalette;
{$endif fpc}
mode.PutPixel:={$ifdef fpc}@{$endif}PutPixVESA16;
mode.GetPixel:={$ifdef fpc}@{$endif}GetPixVESA16;
mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x16;
@ -2523,6 +2580,9 @@ const CrtAddress: word = 0;
mode.InitMode := {$ifdef fpc}@{$endif}Init1280x1024x256;
mode.SetRGBPalette := {$ifdef fpc}@{$endif}SetVESARGBPalette;
mode.GetRGBPalette := {$ifdef fpc}@{$endif}GetVESARGBPalette;
{$ifdef fpc}
mode.SetAllPalette := @SetVESARGBAllPalette;
{$endif fpc}
mode.SetVisualPage := {$ifdef fpc}@{$endif}SetVisualVESA;
mode.SetActivePage := {$ifdef fpc}@{$endif}SetActiveVESA;
mode.vline := {$ifdef fpc}@{$endif}VLineVESA256;
@ -2593,7 +2653,11 @@ begin
end.
{
$Log$
Revision 1.2 2000-07-13 11:33:40 michael
Revision 1.3 2000-08-12 12:27:13 jonas
+ setallpalette hook
+ setallpalette implemented for standard vga and VESA 2.0+
Revision 1.2 2000/07/13 11:33:40 michael
+ removed logs
}

80
rtl/go32v2/vesa.inc
View File

@ -1584,6 +1584,74 @@ end;
{$IFDEF DPMI}
{$ifdef fpc}
Procedure SetVESARGBAllPalette(const Palette:PaletteType);
var
pal: array[0..255] of palrec;
regs: TDPMIRegisters;
c, Ptr: longint;
RealSeg: word;
FunctionNr : byte; { use blankbit or normal RAMDAC programming? }
begin
if DirectColor then
Begin
_GraphResult := grError;
exit;
end;
{ use the set/get palette function }
if VESAInfo.Version >= $0200 then
Begin
{ check if blanking bit must be set when programming }
{ the RAMDAC. }
if (VESAInfo.caps and attrSnowCheck) <> 0 then
FunctionNr := $80
else
FunctionNr := $00;
fillChar(pal,sizeof(pal),0);
{ Convert to vesa format }
for c := 0 to 255 do
begin
pal[c].red := byte(palette.colors[c].red);
pal[c].green := byte(palette.colors[c].green);
pal[c].blue := byte(palette.colors[c].blue);
end;
{ Alllocate real mode buffer }
Ptr:=Global_Dos_Alloc(sizeof(pal));
{get the segment value}
RealSeg := word(Ptr shr 16);
{ setup interrupt registers }
FillChar(regs, sizeof(regs), #0);
{ copy palette values to real mode buffer }
DosMemPut(RealSeg,0,pal,sizeof(pal));
regs.eax := $4F09;
regs.ebx := FunctionNr;
regs.ecx := 256;
regs.edx := 0;
regs.es := RealSeg;
regs.edi := 0; { offset is always zero }
RealIntr($10, regs);
{ free real mode memory }
If not Global_Dos_Free(word(Ptr and $ffff)) then
RunError(216);
if word(regs.eax) <> $004F then
begin
_GraphResult := grError;
exit;
end;
end
else
{ assume it's fully VGA compatible palette-wise. }
Begin
SetVGARGBAllPalette(palette);
end;
setallpalettedefault(palette);
end;
{$endif fpc}
Procedure SetVESARGBPalette(ColorNum, RedValue, GreenValue,
BlueValue : Integer);
var
@ -1605,9 +1673,9 @@ end;
exit;
end;
pal.align := 0;
pal.red := byte(RedValue);
pal.green := byte(GreenValue);
pal.blue := byte(BlueValue);
pal.red := byte(RedValue) shr 2;
pal.green := byte(GreenValue) shr 2;
pal.blue := byte(BlueValue) shr 2;
{ use the set/get palette function }
if VESAInfo.Version >= $0200 then
Begin
@ -2647,7 +2715,11 @@ Const
{
$Log$
Revision 1.4 2000-08-01 06:03:13 jonas
Revision 1.5 2000-08-12 12:27:13 jonas
+ setallpalette hook
+ setallpalette implemented for standard vga and VESA 2.0+
Revision 1.4 2000/08/01 06:03:13 jonas
* set _graphresult to grnotdetected if the vesa setmode interrupt
call returns an error (merged from fixes branch)

13
rtl/inc/graph/graph.inc
View File

@ -1429,6 +1429,8 @@ end;
procedure OutTextXYDefault(x,y : smallint;const TextString : string);forward;
procedure CircleDefault(X, Y: smallint; Radius:Word);forward;
{$i palette.inc}
Procedure DefaultHooks;
{********************************************************}
{ Procedure DefaultHooks() }
@ -1446,8 +1448,8 @@ end;
GetPixel := {$ifdef fpc}@{$endif}GetPixelDefault;
SetRGBPalette := {$ifdef fpc}@{$endif}SetRGBPaletteDefault;
GetRGBPalette := {$ifdef fpc}@{$endif}GetRGBPaletteDefault;
{ optional...}
SetAllPalette := {$ifdef fpc}@{$endif}SetAllPaletteDefault;
SetActivePage := {$ifdef fpc}@{$endif}SetActivePageDefault;
SetVisualPage := {$ifdef fpc}@{$endif}SetVisualPageDefault;
ClearViewPort := {$ifdef fpc}@{$endif}ClearViewportDefault;
@ -1498,7 +1500,6 @@ end;
end;
{$i modes.inc}
{$i palette.inc}
function InstallUserDriver(Name: string; AutoDetectPtr: Pointer): smallint;
begin
@ -2439,12 +2440,14 @@ begin
end;
{
$Log$
Revision 1.3 2000-08-05 18:34:47 peter
Revision 1.4 2000-08-12 12:27:13 jonas
+ setallpalette hook
+ setallpalette implemented for standard vga and VESA 2.0+
Revision 1.3 2000/08/05 18:34:47 peter
* merged setvideostate patch
Revision 1.2 2000/07/13 11:33:46 michael
+ removed logs
Revision 1.1 2000/07/13 06:30:51 michael
+ Initial import
}

11
rtl/inc/graph/graphh.inc
View File

@ -569,6 +569,8 @@ TYPE
procedure(ColorNum: smallint; var
RedValue, GreenValue, BlueValue: smallint);
SetAllPaletteProc = procedure(const Palette:PaletteType);
OutTextXYProc = procedure(x,y : SmallInt;const TextString : string);
CircleProc = procedure(X, Y: smallint; Radius:Word);
@ -606,6 +608,7 @@ TYPE
PutPixel : PutPixelProc;
SetRGBPalette : SetRGBPaletteProc;
GetRGBPalette : GetRGBPaletteProc;
SetAllPalette : SetAllPaletteProc;
{ defaults possible ... }
SetVisualPage : SetVisualPageProc;
SetActivePage : SetActivePageProc;
@ -648,6 +651,7 @@ VAR
SetActivePage : SetActivePageProc;
SetRGBPalette : SetRGBPaletteProc;
GetRGBPalette : GetRGBPaletteProc;
SetAllPalette : SetAllPaletteProc;
OutTextXY : OutTextXYProc;
GraphFreeMemPtr: graphfreememprc;
@ -759,7 +763,6 @@ Function GetDriverName: string;
procedure SetColor(Color: Word);
function GetMaxColor: word;
procedure SetAllPalette(var Palette:PaletteType);
procedure SetPalette(ColorNum: word; Color: shortint);
procedure GetPalette(var Palette: PaletteType);
function GetPaletteSize: smallint;
@ -804,7 +807,11 @@ Function GetDriverName: string;
{
$Log$
Revision 1.3 2000-08-05 18:34:47 peter
Revision 1.4 2000-08-12 12:27:14 jonas
+ setallpalette hook
+ setallpalette implemented for standard vga and VESA 2.0+
Revision 1.3 2000/08/05 18:34:47 peter
* merged setvideostate patch
Revision 1.2 2000/07/13 11:33:47 michael

11
rtl/inc/graph/modes.inc
View File

@ -500,6 +500,9 @@ end;
end;
{ optional hooks. }
if assigned(modeinfo^.SetAllPalette) then
SetAllPalette := modeinfo^.SetAllPalette;
if assigned(modeinfo^.ClearViewPort) then
ClearViewPort := modeinfo^.ClearViewPort;
if assigned(modeinfo^.PutImage) then
@ -589,11 +592,15 @@ end;
{
$Log$
Revision 1.3 2000-08-01 06:03:32 jonas
Revision 1.4 2000-08-12 12:27:14 jonas
+ setallpalette hook
+ setallpalette implemented for standard vga and VESA 2.0+
Revision 1.3 2000/08/01 06:03:32 jonas
* the defaulthooks are reset if setmode() fails at any point (merged
from fixes branch)
Revision 1.2 2000/07/13 11:33:47 michael
+ removed logs
}

10
rtl/inc/graph/palette.inc
View File

@ -277,7 +277,7 @@ CONST
(Red: 0;Green: 0;Blue: 0),
(Red: 0;Green: 0;Blue: 0));
procedure SetAllPalette(var Palette:PaletteType);
procedure SetAllPaletteDefault(const Palette:PaletteType);
var
i: longint;
Size: longint;
@ -383,7 +383,11 @@ CONST
{
$Log$
Revision 1.2 2000-07-13 11:33:47 michael
Revision 1.3 2000-08-12 12:27:14 jonas
+ setallpalette hook
+ setallpalette implemented for standard vga and VESA 2.0+
Revision 1.2 2000/07/13 11:33:47 michael
+ removed logs
}