* added documentation (in-code and pasdoc generated)

[glBitmap.git] / examples / TextureFromFunction / TextureFromFunction.lpr

diff --git a/examples/TextureFromFunction/TextureFromFunction.lpr b/examples/TextureFromFunction/TextureFromFunction.lpr
new file mode 100644 (file)
index 0000000..f960c25
--- /dev/null
+++ b/examples/TextureFromFunction/TextureFromFunction.lpr
@@ -0,0 +1,95 @@
+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;
+  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
+    // create texture use either GenerateTextureFunc1 or GenerateTextureFunc2
+    tex := TglBitmap2D.Create(
+      glBitmapSize(512, 512),
+      tfRGBA8ub4,
+      @GenerateTextureFunc1
+      //@GenerateTextureFunc2
+    );
+    tex.GenTexture;
+
+    while running and ProgressMesages do begin
+      RenderLoop;
+      SwapBuffers(oglWindow.DC);
+    end;
+  finally
+    FreeAndNil(tex);
+    DestroyOpenGLWindow(oglWindow);
+  end;
+end.
+