examples/TextureFromFunction/TextureFromFunction.lpr

   1 program SimpleLoadFromFile;
   2
   3 {$mode objfpc}{$H+}
   4
   5 uses
   6   {$IFDEF UNIX}{$IFDEF UseCThreads}
   7   cthreads,
   8   {$ENDIF}{$ENDIF}
   9   Classes, Windows, SysUtils, dglOpenGL, glBitmap, Helper;
  10
  11 var
  12   oglWindow: TOpenGLWindow;
  13   running: Boolean = true;
  14   tex: TglBitmap2D;
  15
  16 function WindowProc(hWnd: HWND; Msg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
  17 begin
  18   case Msg of
  19     WM_DESTROY: begin
  20       running := false;
  21     end;
  22   end;
  23   result := DefWindowProc(hWnd, Msg, wParam, lParam);
  24 end;
  25
  26 procedure RenderLoop;
  27 begin
  28   tex.Bind();
  29   glColor4f(1, 1, 1, 1);
  30   glBegin(GL_QUADS);
  31     glTexCoord2f(0, 0); glVertex2f(100, 100);
  32     glTexCoord2f(1, 0); glVertex2f(700, 100);
  33     glTexCoord2f(1, 1); glVertex2f(700, 500);
  34     glTexCoord2f(0, 1); glVertex2f(100, 500);
  35   glEnd;
  36   tex.Unbind();
  37 end;
  38
  39 { function to generate texture data }
  40 procedure GenerateTextureFunc1(var FuncRec: TglBitmapFunctionRec);
  41 var
  42   g1, g2, g3, g4: Single;
  43 begin
  44   g1 := (sin(FuncRec.Position.X / 25) + 1) / 2;  // generator function 1: large sinus on x position (0.0 to 1.0)
  45   g2 := (sin(FuncRec.Position.Y / 25) + 1) / 2;  // generator function 2: large sinus on y position (0.0 to 1.0)
  46   g3 := FuncRec.Position.X / FuncRec.Size.X;     // generator function 3: linear fade on x position (0.0 to 1.0)
  47   g4 := FuncRec.Position.Y / FuncRec.Size.Y;     // generator function 4: linear fade on y position (0.0 to 1.0)
  48
  49   FuncRec.Dest.Data.r := Trunc(g1 * FuncRec.Dest.Range.r);
  50   FuncRec.Dest.Data.g := Trunc(g2 * FuncRec.Dest.Range.g);
  51   FuncRec.Dest.Data.b := Trunc(g3 * FuncRec.Dest.Range.b);
  52   FuncRec.Dest.Data.a := Trunc(g4 * FuncRec.Dest.Range.a);
  53 end;
  54
  55 { function to generate texture data }
  56 procedure GenerateTextureFunc2(var FuncRec: TglBitmapFunctionRec);
  57 var
  58   x, y: Single;
  59 begin
  60   x := FuncRec.Position.X / FuncRec.Size.X;
  61   y := FuncRec.Position.Y / FuncRec.Size.Y;
  62   if (x < 0.05) or (x > 0.95) or (y < 0.05) or (y > 0.95) then
  63   begin
  64     FuncRec.Dest.Data := FuncRec.Dest.Range;
  65   end else if (y < 0.333) then begin
  66     FuncRec.Dest.Data := glBitmapRec4ui(0, 0, 0, 0);
  67   end else if (y < 0.666) then begin
  68     FuncRec.Dest.Data := glBitmapRec4ui(FuncRec.Dest.Range.r, 0, 0, 0);
  69   end else begin
  70     FuncRec.Dest.Data := glBitmapRec4ui(FuncRec.Dest.Range.r, FuncRec.Dest.Range.g, 0, 0);
  71   end;
  72 end;
  73
  74 begin
  75   oglWindow := CreateOpenGLWindow('TextureFromFunction', 800, 600, @WindowProc);
  76   try
  77     // create texture use either GenerateTextureFunc1 or GenerateTextureFunc2
  78     tex := TglBitmap2D.Create(
  79       glBitmapSize(512, 512),
  80       tfRGBA8ub4,
  81       @GenerateTextureFunc1
  82       //@GenerateTextureFunc2
  83     );
  84     tex.GenTexture;
  85
  86     while running and ProgressMesages do begin
  87       RenderLoop;
  88       SwapBuffers(oglWindow.DC);
  89     end;
  90   finally
  91     FreeAndNil(tex);
  92     DestroyOpenGLWindow(oglWindow);
  93   end;
  94 end.
  95