+ setallpalette hook

  + setallpalette implemented for standard vga and VESA 2.0+

rtl/go32v2/graph.pp

@@ -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
- 
+
 }

rtl/go32v2/vesa.inc

@@ -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)
 

rtl/inc/graph/graph.inc

@@ -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
 }

rtl/inc/graph/graphh.inc

@@ -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

rtl/inc/graph/modes.inc

@@ -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
- 
+
 }

rtl/inc/graph/palette.inc

@@ -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
- 
+
 }