unit GLUtil;

interface
uses Graphics, OpenGL, Windows, SysUtils;

procedure ColorToGlu(Color: TColor; var R, G, B: GluByte);
procedure PreparePixelFormat(var DevC: HDC; var Palette: HPALETTE);
procedure CenterMaximalViewport(wW, wH : Single; cW, cH : Integer);
function GCD(A, B : Integer): Integer;

implementation

procedure ColorToGlu(Color: TColor; var R, G, B: GluByte);
begin
  R := Color and $FF;
  G := (Color and $FF00) Shr 8;
  B := (Color and $FF0000) Shr 16;
end;

procedure PreparePixelFormat(var DevC: HDC; var Palette: HPALETTE);
var
  hHeap: THandle;
  nColors, i: Integer;
  lpPalette: PLogPalette;
  byRedMask, byGreenMask, byBlueMask: Byte;
  PFD : TPixelFormatDescriptor;
  ChosenPixelFormat : Integer;
begin
  FillChar(PFD, SizeOf(TPixelFormatDescriptor), 0);

  with PFD do
  begin
    nSize := SizeOf(TPixelFormatDescriptor);
    nVersion := 1;
    dwFlags := PFD_DRAW_TO_WINDOW or
               PFD_SUPPORT_OPENGL or
               PFD_DOUBLEBUFFER;
    iPixelType := PFD_TYPE_RGBA;
    cColorBits := 16;
    cDepthBits:= 32;          // 32-bit depth buffer
    iLayerType:= PFD_MAIN_PLANE;
      { Should be 24, but we must allow for the clunky WKU boxes }
  end;

  ChosenPixelFormat := ChoosePixelFormat(DevC, @PFD);
  if ChosenPixelFormat = 0 then
    Raise Exception.Create('ChoosePixelFormat failed!');

  SetPixelFormat(DevC, ChosenPixelFormat, @PFD);

  { Now check to make sure that the chosen format supports the
    features we really need. }
  DescribePixelFormat(
    DevC,
    ChosenPixelFormat,
    SizeOf(TPixelFormatDescriptor),
    PFD);
  with PFD do
    if ((dwFlags and PFD_DRAW_TO_WINDOW) = 0) or
       ((dwFlags and PFD_SUPPORT_OPENGL) = 0) or
       ((dwFlags and PFD_DOUBLEBUFFER) = 0) or
       (iPixelType <> PFD_TYPE_RGBA) or
       (cColorBits < 16) then
      Raise Exception.Create('Inappropriate Pixel Format chosen.');

  //SetPixelFormat(DevC, ChosenPixelFormat, @PFD);

 {realize the color palette}
  if ((pfd.dwFlags and PFD_NEED_PALETTE) <> 0) then begin
    nColors   := 1 shl pfd.cColorBits;
    hHeap     := GetProcessHeap;
    lpPalette := HeapAlloc(hHeap, 0, sizeof(TLogPalette) + (nColors * sizeof(TPaletteEntry)));

    lpPalette^.palVersion := $300;
    lpPalette^.palNumEntries := nColors;

    byRedMask   := (1 shl pfd.cRedBits) - 1;
    byGreenMask := (1 shl pfd.cGreenBits) - 1;
    byBlueMask  := (1 shl pfd.cBlueBits) - 1;

    for i := 0 to nColors - 1 do begin
      lpPalette^.palPalEntry[i].peRed   := (((i shr pfd.cRedShift)   and byRedMask)   * 255) DIV byRedMask;
      lpPalette^.palPalEntry[i].peGreen := (((i shr pfd.cGreenShift) and byGreenMask) * 255) DIV byGreenMask;
      lpPalette^.palPalEntry[i].peBlue  := (((i shr pfd.cBlueShift)  and byBlueMask)  * 255) DIV byBlueMask;
      lpPalette^.palPalEntry[i].peFlags := 0;
    end;

    Palette := CreatePalette(lpPalette^);
    HeapFree(hHeap, 0, lpPalette);

    if (Palette <> 0) then begin
      SelectPalette(DevC, Palette, False);
      RealizePalette(DevC);
    end;
  end;
end;

procedure CenterMaximalViewport(wW, wH : Single; cW, cH : Integer);
var
  vpH, vpW, vpL, vpT: Integer;
  wRatio: Single;
begin
  wRatio := wW / wH;
  if wRatio <= (cW / cH) then
    begin
      vpW := Round(cH * wRatio);
      vpL := (cW -vpW) div 2;
      glViewport(vpL, 0, vpW, cH);
    end
  else
    begin
      vpH := Round(cW / wRatio);
      vpT := (cH - vpH) div 2;
      glViewport(0, vpT, cW, vpH);
    end;
end;

function GCD(A, B : Integer): Integer;
var
  Rem: Integer;
begin
  while B > 0 do
    begin
      Rem := A mod B;
      A := B;
      B := Rem;
    end;
  Result := A;
end;


end.
 