|
- 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.
|