unit Frost.GL;

interface

uses
  Windows,
  Messages,
  _Geometry,
  Frost.Forms,
  OpenGl;

const
  COLOR_BIT = 32;          
  DEFAULT_COLOR: TVector3 = (A: (1, 1, 1));

type
TCameraParameters = record
  Left,
  Right,
  Bottom,
  Top,
  ZNear,
  ZFar: Integer;
end;

TMaterial = class
  public
    procedure Use; virtual; abstract;
end;

TDummyMaterial = class (TMaterial)
  private
    FColor: TVector3;
    class var DummyTextureId: Cardinal;
    class var DummyCreated: Boolean;
  public
    constructor Create; overload;
    constructor Create(Color: TVector3); overload;
    procedure Use; override;
    property Color: TVector3 read FColor write FColor;
end;

TColorMaterial = class (TMaterial)
  private
    FColor: TVector4;
  public
    constructor Create(Color: TVector3); overload;
    constructor Create(Color: TVector4); overload;
    procedure Use; override;
end;
 
TTexturedMaterial = class (TMaterial)
  protected
    FTextureId: Cardinal;
  public
    constructor Create(TexId: Cardinal);
    procedure Use; override;
end;

TOpenGL = class
  private
    class var FThis: TOpenGL;
    class var FWindowHandle: THandle;
    FGLHRC: HGLRC; //GL render contest
    FGLHDC: HDC;   //GL render descriptor
    function SetupPixelFormat(Size: Byte): Boolean;
    procedure SetInitialSettings;
    constructor Create(Width, Height: Integer); overload;
  public
    class function Create(Handle: THandle; Width, Height: Integer): TOpenGL; overload;
    class function Point_To_Coord(Point: TVector3): TPoint;
    class function Coord_To_Point(MouseCoords: TPoint; Depth: Single): TVector3; 
    procedure GenerateDummyTexture(var TextureIndex: Cardinal);
    procedure ClearColor(Color: TVector3);
    procedure BeginRender;
    procedure EndRender;
    procedure Resize(Width, Height: Integer);
    procedure Close;
end;

//procedure Change_Resolution(Width, Height: Word);
//procedure Restore_Resolution;    
function GenerateTexture(
    var pData: Pointer; 
    Width, Height: Word;    
    Overlay: Cardinal = GL_MODULATE;
    WrapMode: Cardinal = GL_CLAMP_TO_EDGE
    ): Cardinal;     
procedure SetLight(X, Y, Z: Single); overload;
procedure SetLight(Point: TVector3); overload;
//procedure SetLigth(Point: TVector4); overload;

var
  GL: TOpenGL;

implementation

{$REGION '2d/3d'}
class function TOpenGL.Point_To_Coord(Point: TVector3): TPoint;
var
  X, Y, Z: GLdouble;
  Viewport: TVector4i;
  Projection, Modelview: TMatrix4d;
begin
  glGetIntegerv(GL_VIEWPORT, @Viewport);
  glGetDoublev (GL_PROJECTION_MATRIX, @Projection); 
  glGetDoublev (GL_MODELVIEW_MATRIX, @Modelview);   
  gluProject(
      Point.X, Point.Y, Point.Z,
      ModelView, Projection,
      Viewport, @X, @Y, @Z);
  Result.Vector2i(Round(X), Round(Y));
end;

class function TOpenGL.Coord_To_Point(MouseCoords: TPoint; Depth: Single): TVector3;
Var
  X,Y,Z: PGLdouble;
  Viewport: TVector4i;
  Projection, Modelview: TMatrix4d;
begin
  glGetIntegerv(GL_VIEWPORT,@Viewport);
  glGetDoublev(GL_PROJECTION_MATRIX,@Projection);
  glGetDoublev(GL_MODELVIEW_MATRIX,@Modelview);
  gluUnProject(
      MouseCoords.X, MouseCoords.Y, Depth,
      Modelview, Projection, Viewport,
      X, Y, Z);
  Result.Vector3(X^, Y^, Z^);
end;
{$ENDREGION}

{$REGION 'Clear Color'}
procedure TOpenGL.ClearColor(Color: TVector3);
begin
  glClearColor(Color.R, Color.B, Color.G, 1.0);
end;
{$ENDREGION}

{$REGION 'Light'}
procedure SetLight(X, Y, Z: Single); overload;
var
  p: TVector4f;
begin
  p[0]:= X; p[1]:= Y; p[2]:= Z; p[3]:= 1;
  glLightFV(Gl_LIGHT0,Gl_Position,@p);
end;

procedure SetLight(Point: TVector3); overload;
var
  p: TVector4f;
begin
  p[0]:=Point.X; p[1]:=Point.Y; p[2]:=Point.Z; p[3]:=1;
  glLightFV(Gl_LIGHT0,Gl_Position,@p);
end;

procedure SetLight(Point: TVector4); overload;
begin
  glLightFV(Gl_LIGHT0, Gl_Position, @Point);
end;
{$ENDREGION}

{$REGION 'Start Settings'}
procedure TOpenGL.SetInitialSettings; //OpenGL ViewPort Resize on Resolution Change
Var p,d: TVector4f;
begin
  glClearColor(0.0,0.0,0.0,0.0);                      //back color
  glEnable(GL_Color_Material);
  glEnable(GL_Depth_Test);                            //Z test
  glEnable(GL_Lighting);                              //enable ligthning
  glEnable(GL_LIGHT0);                                //enable ligth 0  
  glEnable(GL_CULL_FACE);                             //enable culling
  glCullFace(GL_BACK);
  //glenable(GL_Point_Smooth);
  p[0]:=30; p[1]:=30; p[2]:=30; p[3]:=0;
  d[0]:=0; d[1]:=0; d[2]:=0;
  glLightFV(Gl_LIGHT0,Gl_Position,@p);                //light pozition
  glLightFV(GL_LIGHT0,GL_Spot_Direction,@d);
  p[0]:=0.0; p[1]:=0.0; p[2]:=0.0; p[3]:=1;
  glLightFV(Gl_LIGHT0,GL_AMBIENT,@p);                 //set light ambient
  //Settings
  glDepthFunc(GL_LEQUAL);		                          //Z Test type
  glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);  //Perspective
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);  //Blending
end;
{$ENDREGION}

{$REGION 'Resize'}
procedure TOpenGL.Resize(Width, Height: Integer); //OpenGL ViewPort Resize on Resolution Change
begin
  {glViewport(0, 0, Width, Height);
  glMatrixMode(GL_Projection);
  glLoadIdentity();
  gluPerspective(45.0, Width / Height, 0.05, 20.0);
  glOrtho(
        -20, 20,
        -20, 20,
        1, 50);
  gluLookAt(
        0, 0, 1,
        0, 0, 0,
        0, 1, 0);
  glMatrixMode(Gl_ModelView);   }
  glMatrixMode(GL_Projection);
  glViewport(0, 0, Width, Height);
  glLoadIdentity();
  gluPerspective(45.0, Width / Height, 0.05, 200.0);
 glOrtho(
        -10, 10,
        -10, 10,
        0, -20);
//  gluLookAt(
//        0, 0, 1,
//        0, 0, 0,
//        0, 1, 0);
  glMatrixMode(Gl_ModelView);
end;
{$ENDREGION}

{$REGION 'Textures'}
function GenerateTexture(
    var pData: Pointer; 
    Width, Height: Word;    
    Overlay: Cardinal = GL_MODULATE;
    WrapMode: Cardinal = GL_CLAMP_TO_EDGE
    ): Cardinal;       
var
  TextureId: Cardinal;
begin
  if not (Assigned(pData)) then
    begin
      Result:= 0;
      Exit;
    end;
  glGenTextures(1, @TextureId);
  glBindTexture(GL_TEXTURE_2D, TextureId);
  glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, Overlay);
//  GL_MODULATE - TextureId blends with object background
//  GL_DECAL - TextureId does NOT blend with object background
//  GL_BLEND - TextureId does NOT blend with object background
//  GL_REPLACE - TextureId does NOT blend with object background
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_S,WrapMode);
  glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_WRAP_T,WrapMode);
//  GL_REPEAT
//  GL_CLAMP
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); 
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); 
// gluBuild2DMipmaps(GL_TEXTURE_2D, 3, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pData);
  glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, Width, Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, pData);
  Result:= TextureId; 
end;

procedure TOpenGL.GenerateDummyTexture(var TextureIndex: Cardinal);
var
  i, j: Word;   
  ColorBrightness: Byte;     
  TextureBit: array of Byte;
  PTexture: Pointer;
const
  TEXTURE_SIZE = 256;      
  PIXEL_BYTES = 4;
begin
  SetLength(TextureBit, TEXTURE_SIZE * TEXTURE_SIZE * PIXEL_BYTES);
  For i := 0 to TEXTURE_SIZE - 1 do
    For j := 0 to TEXTURE_SIZE - 1 do
      begin
        ColorBrightness:= 255 - 200 * ((trunc(i / 64) + trunc(j / 64)) mod 2);//Cells
        TextureBit[i * 4 + (j) * TEXTURE_SIZE * 4 + 0]:= ColorBrightness;
        TextureBit[i * 4 + (j) * TEXTURE_SIZE * 4 + 1]:= ColorBrightness;
        TextureBit[i * 4 + (j) * TEXTURE_SIZE * 4 + 2]:= ColorBrightness;
        TextureBit[i * 4 + (j) * TEXTURE_SIZE * 4 + 3]:= 255;
      end;
 PTexture := TextureBit;
 TextureIndex := GenerateTexture(PTexture, TEXTURE_SIZE, TEXTURE_SIZE, GL_MODULATE);
// Result:= TextureIndex;
end;
{$ENDREGION}

{$REGION 'Begin / End Render'}
procedure TOpenGL.BeginRender;
begin
  glClear(GL_Color_Buffer_Bit xor GL_Depth_Buffer_Bit);  //clear
  glLoadIdentity();     //'zero' projection matrix
end;

procedure TOpenGL.EndRender;
begin
 glFlush();
 SwapBuffers(FGLHDC);
end;
{$ENDREGION}

{$REGION 'Pixel_format'}
function  TOpenGL.SetupPixelFormat(Size: Byte): Boolean;
var
  PFD: PIXELFORMATDESCRIPTOR;
  PPFD: PPIXELFORMATDESCRIPTOR;
  PixelFormat: Integer;
begin
  PPFD := @PFD;
  PPFD.nSize:= sizeof(PIXELFORMATDESCRIPTOR);
  PPFD.nVersion:= 1;
  PPFD.dwFlags:=  PFD_DRAW_TO_WINDOW xor
                  PFD_SUPPORT_OPENGL xor
                  PFD_DOUBLEBUFFER;
  PPFD.dwLayerMask:= PFD_MAIN_PLANE;
  PPFD.iPixelType:= PFD_TYPE_RGBA;
  PPFD.cColorBits:= Size;
  PPFD.cDepthBits:= Size;
  PPFD.cAccumBits:= 0;
  PPFD.cStencilBits:= 0;
  PixelFormat:= ChoosePixelFormat(FGLHDC, PPFD);
  if PixelFormat = 0 then
    begin
      MessageBox(0, 'ChoosePixelFormat failed', 'Error', MB_OK);
      SetupPixelFormat:= False;
      Exit;
    end;
  if SetPixelFormat(FGLHDC, PixelFormat, PPFD)=false then
    begin
      MessageBox(0, 'SetPixelFormat failed', 'Error', MB_OK);
      SetupPixelFormat:= False;
      Exit;
    end;
  SetupPixelFormat:= True;
end;
{$ENDREGION}

{$REGION 'Init/Close'}
constructor TOpenGL.Create(Width, Height: Integer);
begin
  FGLHDC:= GetDC(FWindowHandle);                      //Find Descriptot
  If SetupPixelFormat(COLOR_BIT) = False then
    Exit;
  FGLHRC:= wglCreateContext(FGLHDC);
  wglMakeCurrent(FGLHDC, FGLHRC);                     //set handle

  Resize(Width, Height);                              //set screen size on resolution
  SetInitialSettings;
end;

class function TOpenGL.Create(Handle: THandle; Width, Height: Integer): TOpenGL;
begin
  FWindowHandle:= Handle;
  if FThis = nil then
    FThis:= TOpenGL.Create(Width, Height);
  Result:= FThis;
end;

procedure TOpenGL.Close;
begin
  If FGLHRC <> 0 then                                    //Kill Handle and openGL
    begin
      wglMakeCurrent(FGLHDC, 0);
      wglDeleteContext(FGLHRC);
    end;
  If FGLHDC <> 0 then
    ReleaseDC(FWindowHandle, FGLHDC);
end;
{$ENDREGION}

//DymmyMaterial
{$REGION 'DummyMaterial'}
constructor TDummyMaterial.Create;
begin
  FColor := Vector3(1, 1, 1);
  if not DummyCreated then 
    begin
      GL.GenerateDummyTexture(DummyTextureId);
      DummyCreated:= true;
    end;
end;

constructor TDummyMaterial.Create(Color: TVector3);
begin                      
  FColor := Color;
  if not DummyCreated then 
    begin
      GL.GenerateDummyTexture(DummyTextureId);
      DummyCreated:= true;
    end;
end;

procedure TDummyMaterial.Use;
begin
  glEnable(GL_TEXTURE_2D);     
  glEnable(GL_LIGHTING);    
  glEnable(GL_LIGHT0);      
  glColor3fv(@FColor.A);
  glBindTexture(GL_TEXTURE_2D, DummyTextureId);
end;
{$ENDREGION}

{$REGION 'ColorMaterial'}
constructor TColorMaterial.Create(Color: TVector3);
begin
  FColor.R := Color.R;
  FColor.G := Color.G;
  FColor.B := Color.B;
  FColor.Alpha := 1;
end;

constructor TColorMaterial.Create(Color: TVector4);
begin
  FColor := Color;
end;

procedure TColorMaterial.Use;
begin
  glDisable(GL_TEXTURE_2D);     
  glDisable(GL_LIGHTING);
  glColor4fv(@FColor.A);
end;
{$ENDREGION}

//Material
{$REGION 'Material'}
constructor TTexturedMaterial.Create;
begin
  FTextureId:= TexId;
end;

procedure TTexturedMaterial.Use;
begin
  glEnable(GL_TEXTURE_2D);   
  glEnable(GL_LIGHTING);    
  glEnable(GL_LIGHT0); 
  glColor3f(1, 1, 1);
  glBindTexture(GL_TEXTURE_2D, FTextureId);
end;
{$ENDREGION}
end.
