glBitmap/examples/TextureFromFunction/TextureFromFunction.lpr

program SimpleLoadFromFile;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes, Windows, SysUtils, dglOpenGL, glBitmap, Helper;

var
  oglWindow: TOpenGLWindow;
  running: Boolean = true;
  data: TglBitmapData;
  tex: TglBitmap2D;

function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
  case Msg of
    WM_DESTROY: begin
      running := false;
    end;
  end;
  result := DefWindowProc(hWnd, Msg, wParam, lParam);
end;

procedure RenderLoop;
begin
  tex.Bind();
  glColor4f(1, 1, 1, 1);
  glBegin(GL_QUADS);
    glTexCoord2f(0, 0); glVertex2f(100, 100);
    glTexCoord2f(1, 0); glVertex2f(700, 100);
    glTexCoord2f(1, 1); glVertex2f(700, 500);
    glTexCoord2f(0, 1); glVertex2f(100, 500);
  glEnd;
  tex.Unbind();
end;

{ function to generate texture data }
procedure GenerateTextureFunc1(var FuncRec: TglBitmapFunctionRec);
var
  g1, g2, g3, g4: Single;
begin
  g1 := (sin(FuncRec.Position.X / 25) + 1) / 2;  // generator function 1: large sinus on x position (0.0 to 1.0)
  g2 := (sin(FuncRec.Position.Y / 25) + 1) / 2;  // generator function 2: large sinus on y position (0.0 to 1.0)
  g3 := FuncRec.Position.X / FuncRec.Size.X;     // generator function 3: linear fade on x position (0.0 to 1.0)
  g4 := FuncRec.Position.Y / FuncRec.Size.Y;     // generator function 4: linear fade on y position (0.0 to 1.0)

  FuncRec.Dest.Data.r := Trunc(g1 * FuncRec.Dest.Range.r);
  FuncRec.Dest.Data.g := Trunc(g2 * FuncRec.Dest.Range.g);
  FuncRec.Dest.Data.b := Trunc(g3 * FuncRec.Dest.Range.b);
  FuncRec.Dest.Data.a := Trunc(g4 * FuncRec.Dest.Range.a);
end;

{ function to generate texture data }
procedure GenerateTextureFunc2(var FuncRec: TglBitmapFunctionRec);
var
  x, y: Single;
begin
  x := FuncRec.Position.X / FuncRec.Size.X;
  y := FuncRec.Position.Y / FuncRec.Size.Y;
  if (x < 0.05) or (x > 0.95) or (y < 0.05) or (y > 0.95) then
  begin
    FuncRec.Dest.Data := FuncRec.Dest.Range;
  end else if (y < 0.333) then begin
    FuncRec.Dest.Data := glBitmapRec4ui(0, 0, 0, 0);
  end else if (y < 0.666) then begin
    FuncRec.Dest.Data := glBitmapRec4ui(FuncRec.Dest.Range.r, 0, 0, 0);
  end else begin
    FuncRec.Dest.Data := glBitmapRec4ui(FuncRec.Dest.Range.r, FuncRec.Dest.Range.g, 0, 0);
  end;
end;

begin
  oglWindow := CreateOpenGLWindow('TextureFromFunction', 800, 600, @WindowProc);
  try
    tex  := TglBitmap2D.Create;       // create texture object
    data := TglBitmapData.Create;     // create texture data object
    try
      data.LoadFromFunc(              // generate texture data using either GenerateTextureFunc1 or GenerateTextureFunc2
        glBitmapSize(512, 512),
        tfRGBA8ub4,
        @GenerateTextureFunc1
        //@GenerateTextureFunc2
      );
      tex.UploadData(data);           // upload data to video card
    finally
      FreeAndNil(data);               // after upload is done, the data object could be freed to save memory
    end;

    while running and ProgressMesages do begin
      RenderLoop;
      SwapBuffers(oglWindow.DC);
    end;
  finally
    FreeAndNil(tex);
    DestroyOpenGLWindow(oglWindow);
  end;
end.