{******************************************************************************
* OpenGL Widget for simplify interaction betwen                               *
* Kylix 2, Qt Windows & OpenGL                                                *
* Delphi 6 Windows  & OpenGL                                                  *
*           CROSSPLATFORM EDITION                                             *
*                                                                             *
*           Copyright (C) 2002  Artur Baæ   All Rights Reserved.              *
*           Reda Poland                                                       *
*           arturbac@poczta.onet.pl                                           *
*           version 0.5                                                       *
*           Writen with Kylix2 Open Edition & Delphi6 Open Edition            *
*           ------------------------------------------------------------      *
*   Piece of part of windows code is written on the base of source CGLib      *
*   by Tom Nuygen                                                             *
*   writen after 2 days spend on searching for function that will return XID  *
*   of Qt window.                                                             *
*   Solution is simple :                                                      *
*   in Qt unit we can find function QWidget_winId (Handle : QWidget)          *
*   Every Form,Panel has its own Handle for example                           *
*   TForm.handle                                                              *
*   TPanel.childhandle on Kylix2                                              *
*   TPanel.handle on Delphi6                                                  *
*   XID of window is neded for assigning RenderingContext to such form,Panel  *
*   This will allow you to swim in OpenGL ocean with Kylix Qt native          *
*    windows(Forms,Panels) in easy way.                                       *
*   How to use on Windows and Kylix ?                                         *
*   Simple you have to do execaly the SAME for both!!!                        *
*   First Create object inside form class                                     *
*      Public                                                                 *
*       SomeOBj :    GLO : TIGLGraphicContext;                                *
*   Place some TPanel on form                                                 *
*   I form creattion create it and assign Panel as parametr                   *
*       GLO :=TIGLGraphicContext.Create(Panel1);                              *
*       GLO.GLSetup;                                                          *
*       GLO.MakeCurrent;                                                      *
*       ...............                                                       *
*       glpart                                                                *
*       ................                                                      *
*   In FormPaint at end of glCMDS                                             *
*   procedure TForm1.FormPaint(Sender: TObject);                              *
*     GLO.MakeCurrent;                                                        *
*     ................                                                        *
*     glpart                                                                  *
*     ..................                                                      *
*     GLO.SwapActiveBuffers;                                                  *
*   end;                                                                      *
*   I Resize of Form and Resize of Panel                                      *
*   procedure TForm1.Resize(Sender: TObject);                                 *
*   begin                                                                     *
*       GLO.SetViewPort;                                                      *
*       GLO.SwapActiveBuffers;                                                *

*   end;                                                                      *

*   Of course glPart is to do by yourself....                                 *

*   This only unificates for Linux and Windows creation of glcontext          *

*   for apropirate Panel                                                      *

*   You can have thise panels as much you want                                *

*   remember to use MakeCurrent with more than one gl panels                  *

*   Becouse this class have default params                                    *

*       DefaultGLFormat : EnumTIGLFormat = glf_DoubleBuffer                   *

*                                   or glf_DirectRendering                    *
*                                   or glf_DepthBuffer                        *
*                                   or glf_Rgba                               *
*                                   or glf_Overlay                            *
*                                   or glf_NoAlphaChannel                     *
*                                   or glf_NoStereoBuffers                    *
*                                   or glf_NoAccumBuffer                      *
*                                   or glf_NoStencilBuffer;                   *
*   and                                                                       *

*   DefaultTIGLBits : TIGLBits =(cColorBits : 24;                             *

*                               cDepthBits  : 24;                             *
*                               cStencilBits: 0;                              *
*                               );                                            *
*   Yu don't have to set up them                                              *

*   but of course you can in that way                                         *

*   I form creattion create it and assign Panel as parametr                   *

*       GLO :=TIGLGraphicContext.Create(Panel1);                              *
*   Then setup Format and bits                                                *
*       GLO.IGLFormat :=    glf_DoubleBuffer                                  *
*                        or glf_DirectRendering                               *
*                        or glf_DepthBuffer                                   *
*                        or glf_Rgba                                          *
*                        or glf_Overlay                                       *
*                        or glf_AlphaChannel                                  *
*                        or glf_StereoBuffers                                 *
*                        or glf_NoAccumBuffer                                 *
*                        or glf_StencilBuffer;                                *
*       with GLO.bits do begin                                                *
*           cColorBits      :=24;                                             *
*           cDepthBits      :=24;                                             *
*           cStencilBits    :=8;                                              *
*           cAlphaBits      :=1;                                              *
*       end;                                                                  *
*   default values are overwritten !! so if you want to setup                 *
*   one aditional thing you have to setup all default too                     *
*       GLO.GLSetup;                                                          *
*       GLO.MakeCurrent;                                                      *
*       ...............                                                       *
*       glpart                                                                *
*       ................                                                      *
*******************************************************************************}
unit IGLWidget;

interface
uses SysUtils,Types, Classes,MiniGL,
{$ifdef linux}
Xlib, Qt,QGraphics, QControls, QForms, QDialogs,QExtCtrls;
{$else}
Windows, Graphics, Controls, Forms, Dialogs,ExtCtrls;
{$endif}
type
    EnumTIGLFormat = Integer;
Const
	glf_DoubleBuffer		= $0001;
	glf_DepthBuffer		    = $0002;
	glf_Rgba			    = $0004;
	glf_AlphaChannel		= $0008;
	glf_AccumBuffer		    = $0010;
	glf_StencilBuffer		= $0020;
	glf_StereoBuffers		= $0040;
	glf_DirectRendering		= $0080;
	glf_Overlay		        = $0100;
	glf_SingleBuffer        = glf_DoubleBuffer  shl 16;
	glf_NoDepthBuffer       = glf_DepthBuffer   shl 16;
	glf_ColorIndex          = glf_Rgba          shl 16;
	glf_NoAlphaChannel      = glf_AlphaChannel  shl 16;
	glf_NoAccumBuffer       = glf_AccumBuffer   shl 16;
	glf_NoStencilBuffer     = glf_StencilBuffer shl 16;
	glf_NoStereoBuffers     = glf_StereoBuffers shl 16;
	glf_IndirectRendering   = glf_DirectRendering shl 16;
	glf_NoOverlay       	= glf_Overlay shl 16;
Const
    DefaultGLFormat : EnumTIGLFormat = glf_DoubleBuffer
                                    or glf_DirectRendering
                                    or glf_DepthBuffer
                                    or glf_Rgba
                                    or glf_Overlay
                                    or glf_NoAlphaChannel
                                    or glf_NoStereoBuffers
                                    or glf_NoAccumBuffer
                                    or glf_NoStencilBuffer;
Type
    TIGLBits = record
        cColorBits: Byte;
        cDepthBits: Byte;
        cStencilBits: Byte;
        cRedBits: Byte;
        cGreenBits: Byte;
        cBlueBits: Byte;
        cAlphaBits: Byte;
        cAccumBits: Byte;
        cAccumRedBits: Byte;
        cAccumGreenBits: Byte;
        cAccumBlueBits: Byte;
        cAccumAlphaBits: Byte;
end;
Const
    DefaultTIGLBits : TIGLBits =(cColorBits : 24;
                                cDepthBits  : 24;
                                cStencilBits: 0;
                                );
Type

TIGLGraphicContext = class (TObject)
    Private
        {$ifdef linux}
            dpy     : PDisplay;
            vi      : PXVisualInfo;
            cx      : integer;
            //cmap  : TColorMap;
            glwin   : XID;
        {$else}
            FDC: HDC;
            FRC: HGLRC;
            FPalette: HPALETTE;
        {$endif}
        glpanel : TPanel;
        setok   : boolean;
    Public
        //Setup this Procedure after creation
        IGLFormat  : EnumTIGLFormat;
        bits    : TIGLBits;
        {$ifdef linux}
            major_glx,
            minor_glx:integer;
        {$endif}
        Constructor Create (panel : TPanel);
        Destructor Destroy;
        Procedure GLSetup;
        {$ifdef linux}
            Procedure XWaitForGL; //Sometimes is better to make sure ...But mostly this is not needed for linux
            Procedure XWaitForX;
        {$endif}
        Procedure MakeCurrent;
        Procedure SwapActiveBuffers;
        Procedure SetViewPort;
End;

Implementation
var
dummy   : integer;

Constructor TIGLGraphicContext.Create(panel :TPanel);
Begin
    IGLFormat  := DefaultGLFormat;
    bits    := DefaultTIGLBits;
    glpanel :=Panel;
End;
Destructor TIGLGraphicContext.Destroy;
Begin
    //Automatic cleanup
    if setok then  begin
    {$ifdef linux}
        glXMakeCurrent(dpy,glwin,cx);// <- on X we have to reference context before destruction
        glXDestroyContext(dpy,cx);
     {$else}
        if FRC <> 0 then begin
            wglMakeCurrent(0, 0); // <- on Win32 we have to dereference context before destruction
            wglDeleteContext(FRC);
        end;
        if FPalette <> 0 then DeleteObject(FPalette);
        ReleaseDC(glpanel.Handle, FDC);
    {$endif}
    end;

End;
Procedure TIGLGraphicContext.SetViewPort;
Begin
    MakeCurrent;
    if setok then
        glViewport(0,0,glpanel.Width,glpanel.Height);
End;
{$ifdef linux}
type
    tattributes = array [0..40] of GLint;
    pattributes =^tattributes;
    plongint    = ^longint;
Procedure addattr(_pidx : plongint; _attributes : pattributes;attr1,attr2 : GLint);
var
    idx : longint;
Begin

    if attr2=-1 then begin
        Inc(_pidx^);
        _attributes^[_pidx^] :=attr1;
    end
    else begin
        Inc(_pidx^);
        _attributes^[_pidx^] :=attr1;
        Inc(_pidx^);
        _attributes^[_pidx^] :=attr2;
    end;
End;
Procedure TIGLGraphicContext.XWaitForGL;
Begin
    glXWaitGL;
End;
Procedure TIGLGraphicContext.XWaitForX;
Begin
    glXWaitX;
End;
{$endif}
Procedure TIGLGraphicContext.GLSetup;
{******************************************************************************************************************
        Kylix2 Linux specific part
*******************************************************************************************************************}
{$ifdef linux}
var
    attributes : tattributes;
    idx : integer;
Begin
    //Mybe better willbe
    //extern Display * glXGetCurrentDisplay (void);
    // but result schuld eb the same
    dpy:=PDisplay(Application.Display);
    if dpy=nil then begin
        Application.MessageBox('could not open display (XOpenDisplay)','Fatal error',[smbOK],smsCritical);
        halt(1);
    end;
    if not glXQueryVersion(dpy,major_glx,minor_glx) then begin
        Application.MessageBox('sorry OpenGL is not suported for this computer','Fatal error',[smbOK],smsCritical);
        halt(1);
    end;
    idx:=-1;
    if (IGLFormat and (glf_DirectRendering or glf_IndirectRendering))= glf_DirectRendering then
        addattr(@idx,@attributes,GLX_USE_GL,-1);

    if (IGLFormat and (glf_DoubleBuffer or  glf_SingleBuffer)) = glf_DoubleBuffer then
        addattr(@idx,@attributes,GLX_DOUBLEBUFFER,-1);

    if (IGLFormat and (glf_StereoBuffers or glf_NoStereoBuffers))= glf_StereoBuffers then
        addattr(@idx,@attributes,GLX_STEREO,-1);

    if (IGLFormat and (glf_Rgba or glf_ColorIndex))=glf_Rgba then begin
        addattr(@idx,@attributes,GLX_RGBA,-1);
        addattr(@idx,@attributes,GLX_BUFFER_SIZE,bits.cColorBits);
    end
    else
        addattr(@idx,@attributes,GLX_BUFFER_SIZE,bits.cColorBits);

    if (IGLFormat and (glf_DepthBuffer or glf_NoDepthBuffer))=glf_DepthBuffer then
        addattr(@idx,@attributes,GLX_DEPTH_SIZE,bits.cDepthBits);

    if (IGLFormat and (glf_StencilBuffer or glf_NoStencilBuffer))= glf_StencilBuffer then
        addattr(@idx,@attributes,GLX_STENCIL_SIZE,bits.cStencilBits);

{    if (IGLFormat and (glf_Overlay or glf_NoOverlay))= glf_Overlay then

        iLayerType   := PFD_MAIN_PLANE
    else
        iLayerType   :=   PFD_OVERLAY_PLANE;
}
    if (IGLFormat and (glf_AlphaChannel or glf_NoAlphaChannel))= glf_AlphaChannel then
        addattr(@idx,@attributes,GLX_ALPHA_SIZE,bits.cAlphaBits);

    if (IGLFormat and ( glf_AccumBuffer or glf_NoAccumBuffer))= glf_AccumBuffer then begin
        addattr(@idx,@attributes,GLX_ACCUM_RED_SIZE  ,bits.cAccumRedBits);
        addattr(@idx,@attributes,GLX_ACCUM_GREEN_SIZE,bits.cAccumGreenBits);
        addattr(@idx,@attributes,GLX_ACCUM_BLUE_SIZE ,bits.cAccumBlueBits);
        addattr(@idx,@attributes,GLX_ACCUM_ALPHA_SIZE,bits.cAccumAlphaBits);
    end;
    addattr(@idx,@attributes,0,0);

    vi:=glXChooseVisual(dpy, XDefaultScreen(dpy), attributes);
    if (vi=nil) then begin
        Application.MessageBox('could not get visual for your recuirements','Fatal error',[smbOK],smsCritical);
        halt(1);
    end;
    cx := glXCreateContext(dpy, vi,  None, True);
    if (cx = 0) then begin
        Application.MessageBox('could not create rendering context','Fatal error',[smbOK],smsCritical);
        Halt(1);
    end;
    // cmap:=XCreateColormap(dpy, XRootWindow(dpy, vi.screen),vi.visual, AllocNone);
    {THIS GETS X WINDOW ID , SPECIFIC NUMBER}
    {on linux Tpanel.childhandle on windows TPanel.handle......}
    glwin := QWidget_winId (glPanel.ChildHandle);
    // XSetWindowColormap(dpy,glwin,cmap);

{$endif}
{******************************************************************************************
        Windows specific part. Part of this code below is based on Tom Nuygens cgWindow
*******************************************************************************************}
{$ifdef win32}
var
  hHeap: Integer;
  nColors, i: Integer;
  lpPalette: PLogPalette;
  byRedMask, byGreenMask, byBlueMask: Byte;
  nPixelFormat: Integer;
  pfd: TPixelFormatDescriptor;
Begin
    FDC := GetDC(GLPanel.Handle);


  FillChar(pfd, SizeOf(pfd), 0);
  with pfd do
  begin
    nSize        := SizeOf(TPixelFormatDescriptor);           // Size of this structure
    nVersion     := 1;                                        // Version number
    dwFlags      := PFD_DRAW_TO_WINDOW ;

    if (IGLFormat and (glf_DirectRendering or glf_IndirectRendering))= glf_DirectRendering then
        dwFlags:=dwFlags or PFD_SUPPORT_OPENGL
    else
        dwFlags:=dwFlags or PFD_SUPPORT_GDI;

    if (IGLFormat and (glf_DoubleBuffer or  glf_SingleBuffer)) = glf_DoubleBuffer then
        dwFlags:=dwFlags or PFD_DOUBLEBUFFER;

    if (IGLFormat and (glf_StereoBuffers or glf_NoStereoBuffers))= glf_StereoBuffers then
        dwFlags:=dwFlags or PFD_STEREO;

    if (IGLFormat and (glf_Rgba or glf_ColorIndex))=glf_Rgba then begin
        iPixelType := PFD_TYPE_RGBA;
        cColorBits   := bits.cColorBits;
    end
    else
        iPixelType :=PFD_TYPE_COLORINDEX;

    if (IGLFormat and (glf_DepthBuffer or glf_NoDepthBuffer))=glf_DepthBuffer then
        cDepthBits   := bits.cDepthBits
    else
        cDepthBits   :=0;

    if (IGLFormat and (glf_StencilBuffer or glf_NoStencilBuffer))= glf_StencilBuffer then
        cStencilBits := bits.cStencilBits
    else
        cStencilBits := 0;

    if (IGLFormat and (glf_Overlay or glf_NoOverlay))= glf_Overlay then
        iLayerType   := PFD_OVERLAY_PLANE
    else
        iLayerType   := PFD_MAIN_PLANE;

    if (IGLFormat and (glf_AlphaChannel or glf_NoAlphaChannel))= glf_AlphaChannel then
        cAlphaBits:=bits.cAlphaBits
    else
        cAlphaBits:=0;

    if (IGLFormat and ( glf_AccumBuffer or glf_NoAccumBuffer))= glf_AccumBuffer then begin
        cAccumBits :=bits.cAccumBits;
        cAccumRedBits:= bits.cAccumRedBits;
        cAccumGreenBits:= bits.cAccumGreenBits;
        cAccumBlueBits:= bits.cAccumBlueBits;
        cAccumAlphaBits:= bits.cAlphaBits;
    end
    else begin
        cAccumBits :=0;
        cAccumRedBits:= 0;
        cAccumGreenBits:= 0;
        cAccumBlueBits:= 0;
        cAccumAlphaBits:= 0;
    end;

  end;

  nPixelFormat := ChoosePixelFormat(FDC, @pfd);
  SetPixelFormat(FDC, nPixelFormat, @pfd);

  DescribePixelFormat(FDC, nPixelFormat, SizeOf(TPixelFormatDescriptor), pfd);

  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;

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

    if FPalette <> 0 then
    begin
      SelectPalette(FDC, FPalette, FALSE);
      RealizePalette(FDC);
    end;
  end;

  FRC := wglCreateContext(FDC);
{$endif}
    MakeCurrent;
    //This will guard us from drawing to no initialized glpanel....
    setok:=true;
End;
Procedure TIGLGraphicContext.MakeCurrent;
Begin
    if setok then
    {$ifdef win32}
        // Make DC the current OpenGL rendering context.
        if (FDC <> 0) and (FRC <> 0) then
                wglMakeCurrent(FDC, FRC);
    {$else}
        //Map rendering context to panel with XID and make it active
        if (dpy <> nil) and (cx <> 0) and (glwin <> 0)then
            glXMakeCurrent(dpy, glwin, cx);
    {$endif}
End;
Procedure TIGLGraphicContext.SwapActiveBuffers;
Begin
    MakeCurrent;
    if setok then
        {$ifdef win32}
        SwapBuffers(FDC);
        {$else}
        glXSwapBuffers(dpy, glwin);
        {$endif}
End;
end.
