unit Unit1;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, Forms, Controls, Dialogs,
  LCLType, ExtCtrls,
  Windows, MMSystem,        // timeBeginPeriod を使うために必要
  Graphics, GraphType,
  FPImage, FPReadPNG, IntfGraphics,   // 画像読み込みに必要
  OpenGLContext, GL, glu,   // OpenGLを使うために必要
  GLext;                    // GL_BGRA を記述するために必要

type

  { TForm1 }

  TForm1 = class(TForm)
    OpenGLControl1: TOpenGLControl;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure OpenGLControl1Paint(Sender: TObject);
    procedure OpenGLControl1Resize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    fAngle: double;
    fLastTime: DWORD;
    fTexID: GLuint;
    procedure DrawCube;
    procedure DrawPlane;
    function LoadTexture(const FileName: string): GLuint;
    function LoadTexturePx(const FileName: string): GLuint;
    procedure ResizeGL;
    procedure SetFullscreen;
  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

const
  //TEXTURE_NAME: string = 'texture2.png';
  //TEXTURE_NAME: string = 'TEXTURE';
  TEXTURE_NAME: string = 'TEXTURE2';
  //TEXTURE_NAME: string = 'TEXTURE3';

{ フォームが生成される時の処理 }
procedure TForm1.FormCreate(Sender: TObject);
begin
  // タイマー精度を1msにする。(Windows Only)
  timeBeginPeriod(1);
  fLastTime := timeGetTime;

  fAngle := 0.0;

  // タイマーの時間間隔を設定
  Timer1.Interval := 15;
  Timer1.Enabled := True;

  KeyPreview := True;
end;

{ フォームが表示される時の処理 }
procedure TForm1.FormShow(Sender: TObject);
begin
  // フルスクリーン表示
  //SetFullscreen;
  //OpenGLControl1.Cursor := crNone;

  ResizeGL;

  // これを呼んでおかないとテクスチャが反映されない。ハマった…
  OpenGLControl1.MakeCurrent();

  // テクスチャを読み込み
  fTexID := LoadTexture(TEXTURE_NAME);
  //fTexID := LoadTexturePx(TEXTURE_NAME);
  if fTexID = 0 then
  begin
    ShowMessage('Error: Texture image loading failure.');
    Application.Terminate;
  end;
end;

{ フルスクリーン表示を設定 }
procedure TForm1.SetFullscreen;
begin
  BorderStyle := bsNone;
  WindowState := wsFullScreen;

  //WindowState := wsMaximized;
  //BoundsRect := Screen.Monitors[0].BoundsRect;

  OpenGLControl1.Align := alClient;
end;

{ キーが押された時の処理 }
procedure TForm1.FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState);
begin
  case Key of
    VK_ESCAPE: Application.Terminate;
    VK_R: fAngle := 0.0;
    else
      Application.Terminate;
  end;
end;

{ フォームが破棄される際の処理 }
procedure TForm1.FormDestroy(Sender: TObject);
begin
  // テクスチャを解放
  if fTexID <> 0 then
    glDeleteTextures(1, @fTexID);

  // タイマー精度を元に戻す。(Windows Only)
  timeEndPeriod(1);

  OpenGLControl1.Cursor := crDefault;
end;

{ 一定時間毎に呼ばれる処理。Timer1のOnTimerイベントに割り当て }
procedure TForm1.Timer1Timer(Sender: TObject);
begin
  // TOpenGLControlの再描画を要求
  OpenGLControl1.Invalidate;
end;

{ 板を描画 }
procedure TForm1.DrawPlane;
begin
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, fTexID);

  glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

  //glEnable(GL_ALPHA_TEST);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glEnable(GL_BLEND);
  glColor3f(1.0, 1.0, 1.0);

  glBegin(GL_QUADS);
  glTexCoord2f(0, 0);
  glVertex2f(0, 1);
  glTexCoord2f(1, 0);
  glVertex2f(1, 1);
  glTexCoord2f(1, 1);
  glVertex2f(1, 0);
  glTexCoord2f(0, 1);
  glVertex2f(0, 0);
  glEnd;

  glDisable(GL_TEXTURE_2D);
end;

{ 箱を描画 }
procedure TForm1.DrawCube;
const
  D: double = 0.5;
begin
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, fTexID);

  glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE);

  //glEnable(GL_ALPHA_TEST);
  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
  glEnable(GL_BLEND);
  glColor3f(1.0, 1.0, 1.0);

  glBegin(GL_QUADS);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(-0.5, -0.5, 0.5);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(0.5, -0.5, 0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(0.5, 0.5, 0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(-0.5, 0.5, 0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(-0.5, -0.5, -0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(-0.5, 0.5, -0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(0.5, 0.5, -0.5);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(0.5, -0.5, -0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(-0.5, 0.5, -0.5);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(-0.5, 0.5, 0.5);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(0.5, 0.5, 0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(0.5, 0.5, -0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(-0.5, -0.5, -0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(0.5, -0.5, -0.5);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(0.5, -0.5, 0.5);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(-0.5, -0.5, 0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(0.5, -0.5, -0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(0.5, 0.5, -0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(0.5, 0.5, 0.5);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(0.5, -0.5, 0.5);
  glEnd();

  glBegin(GL_QUADS);
  glTexCoord2f(0.0, 1.0);
  glVertex3f(-0.5, -0.5, -0.5);
  glTexCoord2f(1.0, 1.0);
  glVertex3f(-0.5, -0.5, 0.5);
  glTexCoord2f(1.0, 0.0);
  glVertex3f(-0.5, 0.5, 0.5);
  glTexCoord2f(0.0, 0.0);
  glVertex3f(-0.5, 0.5, -0.5);
  glEnd();

  glDisable(GL_TEXTURE_2D);
end;

{ TOpenGLControlの描画処理 }
procedure TForm1.OpenGLControl1Paint(Sender: TObject);
const
  InitGL: boolean = False;
var
  ct: DWORD;
  dt: double;
begin
  OpenGLControl1.MakeCurrent();

  if not InitGL then
  begin
    // OpenGL関係の初期化
    glDepthFunc(GL_LESS);
    glEnable(GL_DEPTH_TEST);
    //glShadeModel(GL_SMOOTH);
    glShadeModel(GL_FLAT);
    InitGL := True;
  end;

  // 前回からの時間差を取得
  ct := timeGetTime;
  dt := (ct - fLastTime) / 1000.0;  // 秒単位にする
  fLastTime := ct;

  // 角度を変更
  fAngle := fAngle + (90.0 * dt);
  //if fAngle >= 360.0 then
  //  fAngle := fAngle - 360.0;

  // 背景を消去
  glClearColor(0.0, 0.4, 0.2, 1.0);
  glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);

  glLoadIdentity();

  // カメラを少し下げる
  glTranslatef(0.0, 0.0, -2.5);

  // 回転させる
  glRotatef(fAngle * 0.3, 1, 0, 0);
  glRotatef(fAngle, 0, 1, 0);

  // 表裏チェックをしない
  glDisable(GL_CULL_FACE);

  // 透過部分のテスト種類を指定
  glAlphaFunc(GL_GREATER, 0.5);
  glEnable(GL_ALPHA_TEST);

  // 板を描画
  DrawPlane;

  // 立方体を描画
  DrawCube;

  // ダブルバッファ切り替え
  OpenGLControl1.SwapBuffers;
end;

procedure TForm1.OpenGLControl1Resize(Sender: TObject);
begin
  ResizeGL;
end;

procedure TForm1.ResizeGL;
var
  Aspect: double;
begin
  OpenGLControl1.MakeCurrent();

  if OpenGLControl1.Height <= 0 then
    Exit;

  // 透視変換をするように設定
  glViewport(0, 0, OpenGLControl1.Width, OpenGLControl1.Height);
  glMatrixMode(GL_PROJECTION);
  glLoadIdentity();
  Aspect := OpenGLControl1.Width / OpenGLControl1.Height;
  gluPerspective(45.0, Aspect, 0.1, 100.0);
  glMatrixMode(GL_MODELVIEW);
end;

{ テクスチャ画像を読み込み。RGBA32bitにのみ対応 }
function TForm1.LoadTexture(const FileName: string): GLuint;
var
  srcimg: TPortableNetworkGraphic;
  dstimg: TLazIntfImage;
  texid: GLuint;
  rs: TResourceStream;
begin
  texid := 0;
  srcimg := TPortableNetworkGraphic.Create;
  dstimg := TLazIntfImage.Create(0, 0);
  rs := TResourceStream.Create(HINSTANCE, FileName, RT_RCDATA);

  try
    // ファイルから読み込み
    //srcimg.LoadFromFile(FileName);

    // リソースから読み込み
    srcimg.LoadFromStream(rs);

    dstimg.LoadFromBitmap(srcimg.Handle, srcimg.MaskHandle);

    glGenTextures(1, @texid);
    glBindTexture(GL_TEXTURE_2D, texid);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

    if dstimg.DataDescription.Depth = 32 then
    begin
      // RGBA 32bit
      glPixelStorei(GL_UNPACK_ALIGNMENT, 4);
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, dstimg.Width, dstimg.Height,
        0, GL_BGRA, GL_UNSIGNED_BYTE, dstimg.PixelData);
    end
    else if dstimg.DataDescription.Depth = 24 then
    begin
      // RGB 24bit
      glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, dstimg.Width, dstimg.Height,
        0, GL_BGR, GL_UNSIGNED_BYTE, dstimg.PixelData);
    end;

    Result := texid;
  finally
    rs.Free;
    dstimg.Free;
    srcimg.Free;
  end;
end;

{ テクスチャ画像を読み込み。RGBA32bitにのみ対応。TPicture を使う版 }
function TForm1.LoadTexturePx(const FileName: string): GLuint;
var
  px: TPicture;
  texid: GLuint;
  rs: TResourceStream;
begin
  texid := 0;
  px := TPicture.Create;
  rs := TResourceStream.Create(HINSTANCE, FileName, RT_RCDATA);

  try
    // ファイルから読み込み
    //px.LoadFromFile(FileName);

    // リソースから読み込み
    px.LoadFromStream(rs);

    glGenTextures(1, @texid);
    glBindTexture(GL_TEXTURE_2D, texid);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
    glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);

    if px.Bitmap.RawImage.Description.Depth = 32 then
    begin
      // RGBA 32bit
      glPixelStorei(GL_UNPACK_ALIGNMENT, 4);
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, px.Width, px.Height,
        0, GL_BGRA, GL_UNSIGNED_BYTE, px.Bitmap.RawImage.Data);
    end
    else if px.Bitmap.RawImage.Description.Depth = 24 then
    begin
      // RGB 24bit
      glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
      glTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, px.Width, px.Height,
        0, GL_BGRA, GL_UNSIGNED_BYTE, px.Bitmap.RawImage.Data);
    end;

    Result := texid;
  finally
    rs.Free;
    px.Free;
  end;
end;



end.