galfar.imaginglib/Demos/ObjectPascal/OpenGLDemo/OpenGLDemo.dpr

{
  Vampyre Imaging Library Demo
  OpenGL Demo (ObjectPascal, low level/OpenGL extension, Win32/Linux)
  tested in Delphi 7/10, Free Pascal 2.0.4 (Win32/Linux)
  written by Marek Mauder

  Demo that shows how to create OpenGL textures from files
  and Imaging's images and vice versa. This sample uses SDL to create
  window and process messages. Background and sprite textures are loaded from
  files and rendered. Sprite is mapped on the spinning cube in the
  center of the window. You can change sprite's texture format
  by pressing SPACE key (it cycles trough all TImageFormat values).
  Background texture can be saved to file by pressing S key and sprite texture
  can be saved by pressing D key.

}
program OpenGLDemo;

{$I ImagingOptions.inc}

{$R OpenGLDemo.res}

uses
{$IFDEF MSWINDOWS}
  Windows,
{$ENDIF}
  SysUtils,
  ImagingTypes,
  Imaging,
  ImagingUtility,
  sdl,
  gl,
  glext,
  ImagingOpenGL,
  DemoUtils;

const
  SWindowTitle = 'Vampyre Imaging Library (%s) - OpenGL Demo (format: %s)';
  SWindowIconTitle = 'OpenGL Demo';
  SBackImageFile = 'Tigers.jng';
  SSpriteImageFile = 'Vezyr.png';
  SOutScreenFile = 'GLScreen.png';
  SOutSpriteFile = 'GLSprite.dds';
  SIconFile = 'Icon.bmp';
  DisplayWidth = 640;
  DisplayHeight = 480;
  CubeSize = 200.0;

var
  BackTex: GLuint = 0;
  SpriteTex: GLuint = 0;
  DisplaySurface: PSDL_Surface = nil;
  SpriteImage: TImageData;
  SpriteFormat: TImageFormat = ifA8R8G8B8;
  Event : TSDL_Event;
  Running: Boolean = True;
  Frames: LongInt = 0;
  FPS: LongInt = 0;
  LastTime: LongInt = 0;
  Angle: Single = 0.0;
  TextureCaps: TGLTextureCaps;
{$IFDEF MSWINDOWS}
  WindowHandle: THandle;
{$ENDIF}  

procedure MessageOut(const Msg: string; const Args: array of const);
begin
{$IFDEF MSWINDOWS}
  MessageBox(GetActiveWindow, PChar(Format(Msg, Args)), 'Message',
    MB_ICONINFORMATION or MB_OK);
{$ENDIF}
{$IFDEF UNIX}
  WriteLn(Format(Msg, Args));
{$ENDIF}
end;

procedure MessageOutAndHalt(const Msg: string; const Args: array of const);
begin
{$IFDEF MSWINDOWS}
  MessageBox(GetActiveWindow, PChar(Format(Msg, Args)), 'Error',
    MB_ICONERROR or MB_OK);
{$ENDIF}
{$IFDEF UNIX}
  WriteLn('Error: ');
  MessageOut('  ' + Msg, Args);
  WriteLn('Press RETURN to exit');
  ReadLn;
{$ENDIF}
  SDL_Quit;
  Halt(1);
end;

procedure UpdateCaption;
begin
  SDL_WM_SetCaption(PChar(Format(SWindowTitle + ' FPS: %d',
    [Imaging.GetVersionStr, GetFormatName(SpriteFormat), FPS])), SWindowIconTitle);
end;

procedure CreateSpriteTexture(Format: TImageFormat);
var
  Info: TImageFormatInfo;
begin
  // Delete old texture and create new one in the different format
  glDeleteTextures(1, @SpriteTex);
  SpriteTex := ImagingOpenGL.CreateGLTextureFromImage(SpriteImage,
    256, 256, True, SpriteFormat);
  if SpriteTex = 0 then
    MessageOut('Sprite texture creation failed.', []);
  // Set tex parameters
  glBindTexture(GL_TEXTURE_2D, SpriteTex);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP);
  if TextureCaps.MaxAnisotropy > 0 then
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAX_ANISOTROPY_EXT, TextureCaps.MaxAnisotropy);

  if Imaging.GetImageFormatInfo(SpriteFormat, Info) then
  begin
    if Info.IsFloatingPoint and (Info.BytesPerPixel in [4, 16]) then
    begin
      // Floating point textures (not half float though) should use nearest
      // filter on current hardware. I get 900 fps with nearest filter
      // and only 2 fps with linear filter
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST_MIPMAP_NEAREST);
    end
    else
    begin
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
      glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR);
    end;
  end;  
end;

procedure Initialize;
{$IFDEF MSWINDOWS}
var
  Caption, Icon: PChar;
{$ENDIF}
begin
{$IFDEF MSWINDOWS}
  SDL_WM_GetCaption(Caption, Icon);
  WindowHandle := FindWindow('SDL_app', Caption);
  if WindowHandle <> 0 then
  begin
    // Place window to the center of the screen
    SetWindowPos(WindowHandle, 0, (GetSystemMetrics(SM_CXSCREEN) - DisplayWidth) div 2,
      (GetSystemMetrics(SM_CYSCREEN) - DisplayHeight - 20) div 2, 0, 0, SWP_NOSIZE or SWP_NOZORDER);
  end;
{$ENDIF}
  ImagingOpenGL.GetGLTextureCaps(TextureCaps);
  // Disable some GL states
  glDisable(GL_LIGHTING);
  // Enable some GL states
  glEnable(GL_BLEND);
  glEnable(GL_TEXTURE_2D);
  // Prepare for alpha blending
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  // Set projections and model view transformations
  glViewport(0, 0, DisplayWidth, DisplayHeight);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity;
  glOrtho(0, DisplayWidth, DisplayHeight, 0, -1000.0, 1000.0);

  // Load background texture from file
  BackTex := ImagingOpenGL.LoadGLTextureFromFile(GetDataDir + PathDelim + SBackImageFile);
  // Set tex parameters
  glBindTexture(GL_TEXTURE_2D, BackTex);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  Imaging.InitImage(SpriteImage);
  // Load sprite image from file
  Imaging.LoadImageFromFile(GetDataDir + PathDelim + SSpriteImageFile, SpriteImage);
  // Create sprite texture from image
  CreateSpriteTexture(SpriteFormat);
end;

procedure Present;
begin
  // Clear depth and color buffers
  glClearColor(0.0, 0.8, 1.0, 1.0);
  glClearDepth(1.0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glMatrixMode(GL_MODELVIEW);
  glLoadIdentity;
  // First draw background
  glBindTexture(GL_TEXTURE_2D, BackTex);
  glDisable(GL_DEPTH_TEST);
  glBegin(GL_QUADS);
    glTexCoord2f(0.0, 0.0); glVertex2f(0.0, 0.0);
    glTexCoord2f(1.0, 0.0); glVertex2f(DisplayWidth, 0.0);
    glTexCoord2f(1.0, 1.0); glVertex2f(DisplayWidth, DisplayHeight);
    glTexCoord2f(0.0, 1.0); glVertex2f(0.0, DisplayHeight);
  glEnd;
  // Then draw the spinning cube
  glEnable(GL_DEPTH_TEST);
  glTranslatef(DisplayWidth / 2.0, DisplayHeight / 2.0, 0.0);
  glRotatef(-30.0, 1.0, 0.0, 0.0);
  glRotatef(Angle, 0.0, 1.0, 0.0);
  glTranslatef(-CubeSize / 2.0, -CubeSize / 2.0, -CubeSize / 2.0);
  glBindTexture(GL_TEXTURE_2D, SpriteTex);
  glBegin(GL_QUADS);
    glTexCoord2f(1.0, 0.0); glVertex3f(0.0, 0.0, 0.0);
    glTexCoord2f(0.0, 0.0); glVertex3f(CubeSize, 0.0, 0.0);
    glTexCoord2f(0.0, 1.0); glVertex3f(CubeSize, CubeSize, 0.0);
    glTexCoord2f(1.0, 1.0); glVertex3f(0.0, CubeSize, 0.0);

    glTexCoord2f(0.0, 0.0); glVertex3f(0.0, 0.0, CubeSize);
    glTexCoord2f(1.0, 0.0); glVertex3f(CubeSize, 0.0, CubeSize);
    glTexCoord2f(1.0, 1.0); glVertex3f(CubeSize, CubeSize, CubeSize);
    glTexCoord2f(0.0, 1.0); glVertex3f(0.0, CubeSize, CubeSize);

    glTexCoord2f(0.0, 0.0); glVertex3f(0.0, 0.0, 0.0);
    glTexCoord2f(0.0, 1.0); glVertex3f(0.0, CubeSize, 0.0);
    glTexCoord2f(1.0, 1.0); glVertex3f(0.0, CubeSize, CubeSize);
    glTexCoord2f(1.0, 0.0); glVertex3f(0.0, 0.0, CubeSize);

    glTexCoord2f(1.0, 0.0); glVertex3f(CubeSize, 0.0, 0.0);
    glTexCoord2f(1.0, 1.0); glVertex3f(CubeSize, CubeSize, 0.0);
    glTexCoord2f(0.0, 1.0); glVertex3f(CubeSize, CubeSize, CubeSize);
    glTexCoord2f(0.0, 0.0); glVertex3f(CubeSize, 0.0, CubeSize);
  glEnd;

  Angle := Angle + 0.025;
  SDL_GL_SwapBuffers;
end;

procedure Finalize;
begin
  // Free textures and images
  glDeleteTextures(1, @BackTex);
  glDeleteTextures(1, @SpriteTex);
  Imaging.FreeImage(SpriteImage);
end;

procedure TakeScreenShot;
var
  RenderTarget: Gluint;
begin
  // Setup render target texture
  glGenTextures(1, @RenderTarget);
  glBindTexture(GL_TEXTURE_2D, RenderTarget);
  glTexImage2D(GL_TEXTURE_2D, 0, 3, DisplayWidth, DisplayHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, nil);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
  glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
  // Render all
  Present;
  // Copy framebuffer to texture
  glBindTexture(GL_TEXTURE_2D, RenderTarget);
  glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, DisplayWidth, DisplayHeight, 0);
  // Save texture & delete it
  ImagingOpenGL.SaveGLTextureToFile(SOutScreenFile, RenderTarget);
  glDeleteTextures(1, @RenderTarget);
end;

begin
  // Initialize SDL
  if (SDL_Init(SDL_INIT_VIDEO) < 0) then
    MessageOutAndHalt('SDL initialization failed: %s', [SDL_GetError]);

  SDL_WM_SetCaption(PChar(Format(SWindowTitle, [Imaging.GetVersionStr,
    GetFormatName(SpriteFormat)])), SWindowIconTitle);
  SDL_WM_SetIcon(SDL_LoadBMP(PChar(GetDataDir + PathDelim + SIconFile)), 0);

  // Set GL attributes using SDL
  SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8);
  SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8);
  SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8);
  SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 24);
  SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 0);
  SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);

  // Initialize video mode
  DisplaySurface := SDL_SetVideoMode(DisplayWidth, DisplayHeight, 32, SDL_OPENGL);
  if DisplaySurface = nil then
    MessageOutAndHalt('SDL SetVideoMode failed: %s', [SDL_GetError]);

  // Initialize surfaces and enter main loop
  Initialize;
  LastTime := SDL_GetTicks;
  while Running do
  begin
    while SDL_PollEvent(@Event) = 1 do
    begin
      case Event.type_ of
        SDL_QUITEV:
          begin
            Running := False;
          end;
        SDL_KEYDOWN:
          begin
            with Event.key.keysym do
              if ((sym = SDLK_F4) and ((modifier and KMOD_ALT) <> 0)) or
                (Event.key.keysym.sym = SDLK_ESCAPE) then
                Running := False;

            // Using S and D keys you can take screen shots and texture
            // shots easily
            // SPACE key can be used to cycle sprite image formats
            case Event.key.keysym.sym of
              SDLK_S: TakeScreenShot;
              SDLK_D: ImagingOpenGL.SaveGLTextureToFile(SOutSpriteFile, SpriteTex);
              SDLK_SPACE:
                begin
                  SpriteFormat := NextFormat(SpriteFormat);
                  CreateSpriteTexture(SpriteFormat);
                  UpdateCaption;
                end;
            end;
          end;
      end;
    end;

    // Calculate FPS
    if LongInt(SDL_GetTicks) - LastTime > 1000 then
    begin
      FPS := Frames;
      UpdateCaption;
      Frames := 0;
      LastTime := SDL_GetTicks;
    end;
    Inc(Frames);

    // Renders background and sprites to the window
    Present;
  end;
  // Frees everything
  Finalize;
  SDL_Quit;

{
  File Notes:

  -- 0.19 Changes/Bug Fixes -----------------------------------
    - screenshots now work in all OSs and ImagingComponents is no longer needed

  -- 0.17 Changes/Bug Fixes -----------------------------------
    - S key now saves screenshot to file
    - anisotropic filtering enabled if supported by hardware
}
end.