Code:
unit jui_screen;
{$mode objfpc}{$H+}
{$i jui.inc}
interface
uses
sysutils, SDL,
SDL_Video,
u_gl,
JUI_const, JUI_log;
type TVideoMode = record
H : integer;
V : integer;
Bits : integer;
Fullscreen : Boolean;
end;
const
//Constant Video Mode Records, Treeitem.Data pointer asigned to these records
Mode640_16 : TVideoMode = (H:640; V:480; Bits:24; FullScreen:false;);
Mode640_16_FULL : TVideoMode = (H:640; V:480; Bits:24; FullScreen:true;);
Mode640_32 : TVideoMode = (H:640; V:480; Bits:32; FullScreen:false;);
Mode640_32_FULL : TVideoMode = (H:640; V:480; Bits:32; FullScreen:true;);
Mode800_16 : TVideoMode = (H:800; V:600; Bits:24; FullScreen:false;);
Mode800_16_FULL : TVideoMode = (H:800; V:600; Bits:24; FullScreen:true;);
Mode800_32 : TVideoMode = (H:800; V:600; Bits:32; FullScreen:false;);
Mode800_32_FULL : TVideoMode = (H:800; V:600; Bits:32; FullScreen:true;);
Mode1024_16 : TVideoMode = (H:1024; V:768; Bits:24; FullScreen:false;);
Mode1024_16_FULL : TVideoMode = (H:1024; V:768; Bits:24; FullScreen:true;);
Mode1024_32 : TVideoMode = (H:1024; V:768; Bits:32; FullScreen:false;);
Mode1024_32_FULL : TVideoMode = (H:1024; V:768; Bits:32; FullScreen:true;);
Mode1280_32_FULL : TvideoMode = (H:1280; V:1024; Bits:32; Fullscreen:true;);
type TJUIScreen = class
public
Width : integer;
Height : integer;
ProjectionMatrixGL : TGLMatrixd4;
ViewPortGL : TGLVectori4;
constructor create(WinTitle : shortstring; Xres,Yres,BPP : word;FullScreen : Boolean);
destructor destroy;override;
procedure SetOrthographic;
procedure SetOrthographicFlipY;
procedure SetOrthographic(x,y,awidth,aheight:integer);
procedure SetVideomode(Vmode:TVideoMode);
private
Screen : PSDL_Surface;
B_FullScreen : boolean;
error : boolean;
WindowTitle : string; //must be shortstring or string with $H-
WindowBPP : word;
procedure SetWindowTitle(Title:string);
procedure SetupGL; //sets up 2d ortho mode
published
{ Published declarations }
property Caption: string read WindowTitle write SetWindowTitle;
end;
implementation
constructor TJUIScreen.create(WinTitle : shortstring; Xres,Yres,BPP : word;FullScreen : Boolean);
var
I : integer;
NumDrivers : integer;
DriverName : PChar;
begin
NumDrivers := SDL_GetNumVideoDrivers;
for I := 0 to NumDrivers-1 do
begin
DriverName := SDL_GetVideoDriver(I);
JUILOG(self.classname,'SDL Video Driver : '+DriverName);
end;
JUIlog(self.classname,'Creating SDL Window...');
error := false;
Width := Xres;
Height := Yres;
WindowBPP := BPP;
if FullScreen then
screen := SDL_SetVideoMode(Width, Height, WindowBPP, SDL_OPENGL or SDL_ANYFORMAT or SDL_FULLSCREEN) //create the surface
else
screen := SDL_SetVideoMode(Width, Height, WindowBPP, SDL_OPENGL or SDL_ANYFORMAT {or SDL_NOFRAME or SDL_VIDEORESIZE}); //create the surface
if not assigned(screen) then
begin
JUIlog(self.classname,'Couldn''t create a surface: '+SDL_GetError());
error := true;
exit;
end;
SetWindowTitle(WinTitle);
JUIlogdone;
initopengl;
ReadImplementationProperties;
ReadExtensions;
if not error then SetupGL;
end;
destructor TJUIScreen.destroy;
begin
inherited;
end;
procedure TJUIScreen.SetOrthographic;
begin
glViewport( 0, 0, Width, Height );
//glGetIntegerv(GL_VIEWPORT, @viewportGL); //CALLING THIS IS *SLOW*!
glMatrixMode( GL_PROJECTION );
glLoadIdentity;
glOrtho( 1, Width+1, Height+1, 1, -1.0, 1.0 );
glmatrixmode(GL_TEXTURE);
glloadidentity();
glmatrixmode(GL_MODELVIEW);
glloadidentity();
glTranslatef(0.375, 0.375, 0.0);
end;
procedure TJUIScreen.SetOrthographicFlipY;
begin
glViewport( 0, 0, Width, Height );
//glGetIntegerv(GL_VIEWPORT, @viewportGL); //CALLING THIS IS *SLOW*!
glMatrixMode( GL_PROJECTION );
glLoadIdentity;
glOrtho( 1, Width+1, 1, Height+1, -1.0, 1.0 );
glmatrixmode(GL_TEXTURE);
glloadidentity();
glmatrixmode(GL_MODELVIEW);
glloadidentity();
glTranslatef(0.375, 0.375, 0.0);
end;
procedure TJUIScreen.SetOrthographic(x,y,awidth,aheight:integer);
begin
glViewport( x, -y+Height-aheight, awidth, aheight ); // we flip our y coord upside down to match everything else
//glGetIntegerv(GL_VIEWPORT, @viewportGL); //CALLING THIS IS *SLOW*!
glMatrixMode( GL_PROJECTION );
glLoadIdentity;
glOrtho( 1, awidth+1, aheight+1, 1, -1.0, 1.0 );
glmatrixmode(GL_TEXTURE);
glloadidentity();
glmatrixmode(GL_MODELVIEW);
glloadidentity();
glTranslatef(0.375, 0.375, 0.0);
end;
procedure TJUIScreen.SetVideomode(Vmode:TVideoMode); // NOTE THIS DESTROYS AND RECREATES OUR OPENGL CONTEXT, ALL TEXTURES MUST BE RELOADED INCLUDING FONTS
begin
Width := vmode.H;
Height := vmode.V;
WindowBPP := vmode.Bits;
B_Fullscreen := vmode.Fullscreen;
//if we toggle fullscreen we MUST restore the original width and height
if B_Fullscreen then
begin
screen := SDL_SetVideoMode(Width, Height, WindowBPP, SDL_OPENGL or SDL_ANYFORMAT or SDL_FULLSCREEN); //create the surface
JUIlog(classname,'Setting FullScreen Mode - X:'+inttostr(Width) + ' Y:' + inttostr(Height)+' Depth:'+inttostr(WindowBPP));
end else
begin
screen := SDL_SetVideoMode(Width, Height, WindowBPP, SDL_OPENGL or SDL_ANYFORMAT); //create the surface
JUIlog(classname,'Setting windowmode Mode - X:'+inttostr(Width) + ' Y:' + inttostr(Height)+' Depth:'+inttostr(WindowBPP));
end;
SetWindowTitle(WindowTitle);
SetupGL; //this must be called because our window is destroyed and re-created, the context along with it
end;
procedure TJUIScreen.SetWindowTitle(Title:string);
begin
WindowTitle := Title;
SDL_WM_SetCaption(pchar(WindowTitle),pchar(WindowTitle)); //set the window title
end;
procedure TJUIScreen.SetupGL; //this section contains all OpenGL init stuff
var
GlobalAmbient: array[0..3] of glFloat = (0.1, 0.1, 0.1, 1); // Global Ambient
begin
JUIlog(classname,'Setting up OpenGL...');
glEnable(GL_TEXTURE_2D);
glEnable(GL_BLEND);
glBlendFunc (GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glClearColor(0.0, 0.0, 0.0, 1.0);
glClearDepth(1.0);
glEnable(GL_DEPTH_TEST); // Enable Depth Buffer
glDepthFunc(GL_LEQUAL);
glenable(GL_CULL_FACE);
glCullFace(GL_BACK);
glShadeModel(GL_SMOOTH); // Enables Smooth Color Shading
JUIlogdone;
end;
end.
Please forgive the messy commenting, this unit is what I use for JUI. it will give you pixel perfect 2D Orthographic mode in OpenGL. load your texture when you load them as seen here :
Code:
function TJUITextureMan.LoadTGA(FileName : string;TextureID : integer):glint;
var
// Create storage space for the texture
NewTextureID : GLint;
texture : TTGAImage;
x : integer;
done : boolean;
begin
done := false;
if fileexists(filename) then
begin
//this ensures existing textures dont get reloaded
for x := 0 to Available do
if lowercase(Textures[x].filename) = lowercase(Filename) then
begin
done := true;
result := Textures[x].ID;
end;
if not done or reloadingtextures then
begin
texture := TTGAImage.create;
texture.LoadFromFile(FileName);
NewTextureID := GetNewTextureID(filename,TextureID);
glBindTexture(GL_TEXTURE_2D, NewTextureID);
// Generate The Texture
glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MAG_FILTER,GL_NEAREST); // ( NEW )
glTexParameteri(GL_TEXTURE_2D,GL_TEXTURE_MIN_FILTER,GL_NEAREST); // ( NEW )
texture.BGRtoRGB;
glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP );
glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP );
gluBuild2DMipmaps(GL_TEXTURE_2D, GL_RGBA,texture.header.imgspec.width,
texture.header.imgspec.height, GL_RGBA, GL_UNSIGNED_BYTE,
texture.Data);
Result := NewTextureID;
texture.free;
end;
end else result := -1;
end;
All I can say is that it works perfectly for me.
Bookmarks