unit l_gl;
(*************************************)
(* OpenGL module by XProger          *)
(*************************************)
(* site : http://XProger.mirgames.ru *)
(* mail : XProger@list.ru            *)
(*************************************)
interface

uses
 Windows, OpenGL, err, KOL, JpegObj, TARGA,
 l_math, l_utils;

procedure glGenTextures     (n: GLsizei; textures: PGLuint); stdcall; external opengl32;
procedure glBindTexture     (target: GLenum; texture: GLuint); stdcall; external opengl32;
procedure glDeleteTextures  (N: GLsizei; Textures: PGLuint); stdcall; external opengl32;

procedure glTexSubImage2D   (target: DWORD; level, xoffset, yoffset, width, height: integer; format, _type: DWORD; const pixels: pointer); stdcall; external opengl32;

procedure glNormalPointer     (type_: GLenum; stride: integer; const P: Pointer); stdcall; external opengl32;
procedure glColorPointer      (size: integer; _type: DWORD; stride: integer; const _pointer: pointer); stdcall; external opengl32;
procedure glVertexPointer     (size: integer; _type: DWORD; stride: integer; const _pointer: pointer); stdcall; external opengl32;
procedure glTexCoordPointer   (size: integer; _type: DWORD; stride: integer; const _pointer: pointer); stdcall; external opengl32;
procedure glIndexPointer      (_type: GLenum; stride: GLsizei; const _pointer: pointer); stdcall; external opengl32;
procedure glInterleavedArrays (format: DWORD; stride: integer; const _pointer: pointer); stdcall; external opengl32;
procedure glDrawArrays        (mode: DWORD; first: integer; count: integer); stdcall; external opengl32;

procedure glEnableClientState   (_array: DWORD); stdcall; external opengl32;
procedure glDisableClientState  (_array: DWORD); stdcall; external opengl32;
procedure glDrawElements        (mode: DWORD; count: integer; _type: DWORD; const indices: pointer); stdcall; external opengl32;

const
 GL_CLAMP_TO_EDGE = $812F;
 GL_RGB8          = $8051;
 GL_RGBA8         = $8058;
 GL_BGRA          = $80E1;
 GL_BGR           = $80E0;
 GL_TEXTURE0      = $84C0;
 GL_TEXTURE1      = $84C1;

 GL_NORMAL_ARRAY        = $8075;
 GL_COLOR_ARRAY         = $8076;
 GL_VERTEX_ARRAY        = $8074;
 GL_TEXTURE_COORD_ARRAY = $8078;

type
 TTexture = DWORD;

 TRGB = record
  R, G, B : Byte;
 end;

 TRGBArray = array [0..1] of TRGB;
 PRGB = ^TRGBArray;

var
 wglSwapIntervalEXT       : function (interval: GLint): Boolean; stdcall;
 wglGetSwapIntervalEXT    : function: GLint; stdcall;
 glActiveTextureARB       : procedure (texture: GLuint); stdcall;
 glMultiTexCoord2fvARB    : procedure (target: GLuint; const v: PGLfloat); stdcall;
 glClientActiveTextureARB : procedure (texture: Cardinal); stdcall;
 glDrawRangeElements      : procedure (mode: DWORD; start: DWORD; _end: DWORD; count: integer; _type: DWORD; const indices: pointer); stdcall;

 extension             : string;
 WGL_EXT_swap_control  : boolean;

 Initialized : boolean = false;

 Handle : HWND;
 DC     : HDC;
 RC     : HGLRC;
 isQuit : boolean = false;

 glWidth      : integer = 640;
 glHeight     : integer = 480;
 glBPP        : integer = 16;
 glFreq       : integer = 85;
 glActive     : boolean = true;
 glFullScreen : boolean = true;

 glClamp      : boolean = false;
 glFPS        : DWORD; // а вдруг... ;)
 glTexBuf     : pointer;
 vsync        : boolean = false;

 function glInit: boolean;
 procedure glClose;
 function glDisplay(Width, Height, BPP, Freq: integer): boolean;
 procedure glSwap;
 procedure glSetProj(angle, zNear, zFar: single);
 procedure glSetOrtho(left, top, right, bottom: single);

 function glTex_Create(c, b: integer; Width, Height: integer; Data: pointer): TTexture;
 procedure glTex_Free(ID: TTexture);
 procedure glTex_Enable(ID: TTexture);
 procedure glTex_Disable;
 function glTex_Load(const FileName: string; getbuf: boolean = false): TTexture;

 procedure glBlend(ID: Byte);
 procedure glLight_cfg(ID: integer);
 procedure glLight_Pos(ID: integer; Pos: TVector);
 procedure glLight_Color(ID: integer; R, G, B: single);

 function glFont_Init(Face: PChar; W, H: integer): DWORD;
 procedure glFont_Free(font: DWORD);
 procedure glTextOut(const str: string; X, Y: integer; font: DWORD);

implementation

type
 TManTex = record
  Tex  : TTexture;
  Name : string;
  Ref  : integer;
 end;

var
 cFPS   : DWORD = 0;  // номер текущего кадра за секунду
 tFPS   : integer;    // время с последнего обновления FPS
 CurTex : TTexture;   // Текущая текстура

 TexMan   : array of TManTex;

(*********************)
(*      OpenGL       *)
(*********************)
// Основная часть //
function glInit: boolean;
var
 pfd     : PIXELFORMATDESCRIPTOR;
 iFormat : integer;
begin
Result := false;
DC := GetDC(Handle);

if DC = 0 then Exit;
FillChar(pfd, SizeOf(pfd), 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 := 32;
 cDepthBits := 16;
 iLayerType := PFD_MAIN_PLANE;
 end;

iFormat := ChoosePixelFormat(DC, @pfd);
if iFormat = 0 then
 Exit;

if not SetPixelFormat(DC, iFormat, @pfd) then
 Exit;

RC := wglCreateContext(DC);
if RC = 0 then Exit;
if not wglMakeCurrent(DC, RC) then
 Exit;

glActiveTextureARB       := nil;
glClientActiveTextureARB := nil;
wglSwapIntervalEXT       := wglGetProcAddress('wglSwapIntervalEXT');
wglGetSwapIntervalEXT    := wglGetProcAddress('wglGetSwapIntervalEXT');
glActiveTextureARB       := wglGetProcAddress('glActiveTextureARB');
glMultiTexCoord2fvARB    := wglGetProcAddress('glMultiTexCoord2fvARB');
glClientActiveTextureARB := wglGetProcAddress('glClientActiveTextureARB');
glDrawRangeElements      := wglGetProcAddress('glDrawRangeElements');

extension := glGetString(GL_EXTENSIONS);
WGL_EXT_swap_control := pos('WGL_EXT_swap_control', extension) <> 0;

glDepthFunc(GL_LEQUAL);
glHint(GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST);
glClearColor(0, 0, 0, 0);
glViewPort(0, 0, glWidth, glHeight);
Result := true;
   
glEnable(GL_COLOR_MATERIAL);
glEnable(GL_NORMALIZE);
end;

procedure glClose;
var
 i : integer;
begin
// Чистим менеджер текстур
for i := 0 to Length(TexMan) - 1 do
 glTex_Free(TexMan[i].Tex);
TexMan := nil;
// остальное
ChangeDisplaySettings(devmode(nil^), 0);
wglMakeCurrent(DC, 0);
wglDeleteContext(RC);
ReleaseDC(Handle, DC);
DestroyWindow(Handle);
end;

function glDisplay(Width, Height, BPP, Freq: integer): boolean;
var
 dev  : TDeviceMode;
 res  : DWORD;
 bool : boolean;
begin
Result := false;
FillChar(dev, SizeOf(dev), 0);
dev.dmSize := sizeof(dev);
EnumDisplaySettings(nil, 0, dev);
with dev do
 begin
 dmPelsWidth        := Width;
 dmPelsHeight       := Height;
 dmBitsPerPel       := BPP;
 dmDisplayFrequency := Freq;
 dmFields := DM_BITSPERPEL or
             DM_PELSWIDTH  or
             DM_PELSHEIGHT or
             DM_DISPLAYFREQUENCY;
 res := ChangeDisplaySettings(dev, CDS_TEST or CDS_FULLSCREEN);
 if res = DISP_CHANGE_SUCCESSFUL then
  ChangeDisplaySettings(dev, CDS_FULLSCREEN);
 end;

if res <> DISP_CHANGE_SUCCESSFUL then
 begin
 bool := false;
 if Freq > 0 then
  bool := glDisplay(Width, Height, BPP, 0);
 if not bool then
  begin
  ChangeDisplaySettings(_devicemodeA(nil^), CDS_FULLSCREEN);
  Exit;
  end;
 end;

glWidth  := Width;
glHeight := Height;
glBPP    := BPP;
glFreq   := Freq;
MoveWindow(Handle, 0, 0, glWidth, glHeight, false);
Result := true;
end;

procedure glSwap;
var
 t : integer;
begin
if WGL_EXT_swap_control then
 if wglGetSwapIntervalEXT <> Byte(vsync) then
  wglSwapIntervalEXT(Byte(vsync));
glFlush;
glFinish;
SwapBuffers(DC);
cFPS := cFPS + 1;
t := GetTimer;
if t - tFPS >= 1000 then
 begin
 tFPS  := t;
 glFPS := cFPS;
 cFPS  := 0;
 end;
end;

procedure glSetProj(angle, zNear, zFar: single);
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluPerspective(angle, glWidth/glHeight, zNear, zFar);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;

procedure glSetOrtho(left, top, right, bottom: single);
begin
glMatrixMode(GL_PROJECTION);
glLoadIdentity;
gluOrtho2D(left, right, bottom, top);
glMatrixMode(GL_MODELVIEW);
glLoadIdentity;
end;

// Работа с текстурой
function glTex_Create(c, b: integer; Width, Height: integer; Data: pointer): TTexture;
begin
glGenTextures(1, @Result);
glBindTexture(GL_TEXTURE_2D, Result);
glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

if glClamp then
 begin
 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
 end
else
 begin
 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT);
 glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT);
 end;
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR_MIPMAP_LINEAR);

gluBuild2DMipmaps(GL_TEXTURE_2D, c, Width, Height, b, GL_UNSIGNED_BYTE, Data);
end;

function LoadJPG(const FileName: string; var W, H: integer): PRGB;
var
 jpg  : PJPEG;
 y    : integer;
begin
Result := nil;
 try
 JPG := NewJPEG;
 if jpg.LoadFromFile(FileName) then
  begin
  W := jpg.Width;
  H := jpg.Height;
  GetMem(Result, W*H*3);
  for y := 0 to H - 1 do
   Move(jpg.Bitmap.ScanLine[y]^, Result[H*y], W*3);
  end;
 jpg.Free;
 except
 // Ну с кем не бывает?
  Result := nil;
 end;
end;

function glTex_Load(const FileName: string; getbuf: boolean = false): TTexture;
var
 i, j : integer;
 W, H : integer;
 Data : pointer;
 TGA  : TGA_Header;
 ext  : string;
begin
Result := 0;

for i := 0 to Length(TexMan) - 1 do
 if FileName = TexMan[i].Name then
  begin
  Result := TexMan[i].Tex;
  inc(TexMan[i].Ref);
  Exit;
  end;

ext  := LowerCase(ExtractFileExt(FileName));
Data := nil;
i    := 0;
j    := 0;
try
if ext = '.jpg' then
 begin
 Data := LoadJPG(FileName, W, H);
 if Data = nil then Exit;
 i := GL_BGR;
 j := GL_RGB8;
 end
else
 if ext = '.tga' then
  begin
  TGA := LoadTGA(FileName);
  W := TGA.Width;
  H := TGA.Height;
  if TGA.BPP = 24 then
   begin
   i := GL_BGR;
   j := GL_RGB8;
   end
  else
   begin
   i := GL_BGRA;
   j := GL_RGBA8;
   end;
  Data := TGA.Data;
  end;
except
 Exit;
end;

if Data = nil then Exit;

Result := glTex_Create(j, i, W, H, Data);
if getbuf then
 glTexBuf := Data
else
 FreeMem(Data);
i := Length(TexMan);
SetLength(TexMan, i + 1);
TexMan[i].Tex  := Result;
TexMan[i].Name := FileName;
TexMan[i].Ref  := 1;
end;

procedure glTex_Free(ID: TTexture);
var
 i, j : integer;
begin
if ID > 0 then
 begin
 j := -1;
 for i := 0 to Length(TexMan) - 1 do
  if TexMan[i].Tex = ID then
   begin
   j := i;
   dec(TexMan[i].Ref);
   break;
   end;

 if j < 0 then
  begin
  glDeleteTextures(1, @ID);
 // ID := 0;
  end
 else
  if TexMan[j].Ref <= 0 then
   begin
   for i := j to Length(TexMan) - 2 do
    TexMan[i] := TexMan[i + 1];
   SetLength(TexMan, Length(TexMan) - 1);
   glDeleteTextures(1, @ID);
  // ID := 0;
   end;
 end;
end;

procedure glTex_Enable(ID: TTexture);
begin
if CurTex <> ID then
 begin
 if CurTex = 0 then
  glEnable(GL_TEXTURE_2D);
 glBindTexture(GL_TEXTURE_2D, ID);
 CurTex := ID;
 end;
end;

procedure glTex_Disable;
begin
glDisable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, 0);
CurTex := 0;
end;

// Прочие функции //
procedure glBlend(ID: Byte);
begin
if ID = 0 then
 glDisable(GL_BLEND)
else
 begin
 glEnable(GL_BLEND);
  case ID of
   1 : glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
   2 : glBlendFunc(GL_SRC_ALPHA, GL_ONE);
   3 : glBlendFunc(GL_ZERO, GL_SRC_COLOR);
  end;
 end;
end;

procedure glLight_cfg(ID: integer);
const
 light_position : array [0..3] of single = (1, 1, 1, 0);
 white_light    : array [0..3] of single = (1, 1, 1, 1);
begin
glLightfv(ID, GL_POSITION, @light_position);
glLightfv(ID, GL_DIFFUSE,  @white_light);
glLightfv(ID, GL_SPECULAR, @white_light);
end;

procedure glLight_Pos(ID: integer; Pos: TVector);
var
 p : array [0..3] of single;
begin
p[0] := Pos.X;
p[1] := Pos.Y;
p[2] := Pos.Z;
p[3] := 1;
glLightfv(ID, GL_POSITION, @p);
end;

procedure glLight_Color(ID: integer; R, G, B: single);
var
 c : array [0..3] of single;
begin
c[0] := R;
c[1] := G;
c[2] := B;
c[3] := 1;
glLightfv(ID, GL_DIFFUSE,  @c);
glLightfv(ID, GL_SPECULAR, @c);
end;

// TEXT //
function glFont_Init(Face: PChar; W, H: integer): DWORD;
var
 font : HFONT;
begin
Result := glGenLists(256);
font := CreateFont(W, H, 0, 0, 0, 0, 0, 0, RUSSIAN_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,
                   ANTIALIASED_QUALITY, FW_BOLD or FF_DONTCARE or DEFAULT_PITCH, Face);
SelectObject(DC, font);
wglUseFontBitmaps(DC, 0, 256, Result);
DeleteObject(font);
end;

procedure glFont_Free(font: DWORD);
begin
glDeleteLists(font, 256);
end;

procedure glTextOut(const str: string; X, Y: integer; font: DWORD);
begin                             
glRasterPos2f(X, Y);
glListBase(font);
glCallLists(Length(str), GL_UNSIGNED_BYTE, PChar(str));
end;

end.

