Fast Canvas Library V1.052

[Gigatron]

Hi

Now let's try to add road with curves. glcanvas lib updated to v0.039 !

Regards

[Lulu]

I like that!
I always wondered how they managed to do that. Thanks to share 

[Gigatron]

I like that!
I always wondered how they managed to do that. Thanks to share 

Your are welcome @Lulu.

So missing Hills... are added.

Regards

[Gigatron]

Hi

Demo with the new glCanvas V0.040 ... some functions are renamed !!


gldraw2Dtexture with all variations;

Code: Pascal  [Select][+][-]

1. procedure glDrawTexture2D(x, y, w, h: GLfloat; texID: GLuint;
2.                         scaleX: GLfloat = 1.0; scaleY: GLfloat = 1.0;
3.                         rotation: GLfloat = 0.0;
4.                         red: GLfloat = 1.0;
5.                         green: GLfloat = 1.0;
6.                         blue: GLfloat = 1.0;
7.                         alpha: GLfloat = 1.0;
8.                         FlipX: Boolean = False;
9.                         FlipY: Boolean = False);

Have Fun ,

[Gigatron]

Hi

Shadow of the beast is a fantastic game on Amiga 500.. I tried to make a parallax scrolling of level 1(the plain) (50%)  using Vsync command of the glCanvas library V0.041 to obtain a smooth scrolling like blitter on Amiga. The code is very very basic and easy to understand.

glInit(OpenGLControl1);
glEnableVSync(true); // vsync + Procedure Application.onIdle (Mainloop) without Timer.

The gfx are from Titan Shadow Of the beast Page, so try it use left + right arrow to scroll !

https://www.magnodyne.com/Fichiers/sites/sotb/index_fr.html

Project1.zip , sotb.zip(sprites)

Regards

[Gigatron]

Hi

I am not clever than Sega Coders but played with outrun road to make Space harrier floor.
Use L/R/U/D arrows to scroll the screen.

Have Fun

[Gigatron]

Hi

Today i've tested Vsync to stabilize FPS with 10000 sprites, i've got 30FPS with my LabTop PC.
In addition we can load png,jpg textures with glcanvas.

I would like to share the code with you.


Regards GTR

[Gigatron]

Hi

A nice command of glcanvas is glBlitCopy to copy a part of texture to destinationx, y.
Here is a demonstration of this command to make a texture wobble fx, for that we
need sintable contains all X position of each part of logo. So see the code and example
project.

Regards

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   OpenGLContext, glcanvas, gl, Math;
10.  
11. type
12.  
13.   { TForm1 }
14.   TForm1 = class(TForm)
15.     OpenGLControl1: TOpenGLControl;
16.     Timer1: TTimer;
17.     procedure FormCreate(Sender: TObject);
18.     procedure FormDestroy(Sender: TObject);
19.     procedure OpenGLControl1Paint(Sender: TObject);
20.     procedure Timer1Timer(Sender: TObject);
21.   private
22.   public
23.   end;
24.  
25. var
26.   Form1: TForm1;
27.   laz_tex: GLuint;
28.   sintable: array of Integer; // dynamic sintable array !
29.   table_index, logo_w, logo_h : Integer;
30.  
31. implementation
32.  
33. {$R *.lfm}
34.  
35. procedure sinus(amplitude, nb_steps, nb_cycles: Integer);
36. var
37.   totalSteps, i: Integer;
38.   step, a: Single;
39.   value: Integer;
40. begin
41.   totalSteps := nb_steps * nb_cycles;
42.   step := (2 * Pi) / nb_steps;
43.   SetLength(sintable, Length(sintable) + totalSteps);
44.   for i := 0 to totalSteps - 1 do
45.   begin
46.     a := i * step;
47.     value := Round(amplitude * Sin(a));
48.     sintable[High(sintable) - totalSteps + 1 + i] := value;
49.   end;
50. end;
51.  
52. procedure stay(nbTimes: Integer); // number of time to Fill sintable with '0'
53. var
54.   i, len: Integer;
55. begin
56.   len := Length(sintable);
57.   SetLength(sintable, len + nbTimes);
58.   for i := 0 to nbTimes - 1 do
59.     sintable[len + i] := 0;
60. end;
61.  
62. procedure TForm1.FormCreate(Sender: TObject);
63. begin
64.   glInit(OpenGLControl1);
65.   logo_h  := 768; logo_w := 768;
66.   laz_tex := glLoadJPGToTexture('laz.jpg');
67.   sintable := nil;
68.   stay(800);          // fill 0, 800 time sin table  0,0,0,0,0,0,0.......
69.   sinus(200, 320, 4); // amplitude , step, cycle number
70.   stay(400);
71.   sinus(20, 320, 8);
72.   stay(200);
73.   sinus(20, 60, 10);
74. end;
75.  
76. procedure TForm1.OpenGLControl1Paint(Sender: TObject);
77. var
78.   y,c, offset, dstX, dstY,cx,cy: Integer;
79. begin
80.   cx := (OpenGLControl1.Width - logo_h) div 2;
81.   cy := (OpenGLControl1.Height - logo_w) div 2;
82.  
83.   glFillScreen(OpenGLControl1, 0.0, 0.2, 0.4, 1.0);
84.  
85.   for y := 0 to logo_w - 1 do
86.     begin
87.       c := (table_index + y) mod Length(sintable); // c = sintable counter index
88.       offset := sintable[c];
89.       dstX := cx + offset;
90.       dstY := cy + y;
91.       glBlitCopy(laz_tex, 0, y, logo_h, y + 1, dstX, dstY,1.0, bmCopy);
92.     end;
93.  
94.   OpenGLControl1.SwapBuffers;
95. end;
96.  
97. procedure TForm1.Timer1Timer(Sender: TObject);
98. begin
99.   table_index := (table_index + 2) mod Length(sintable);  // +2 sin offset !
100.   OpenGLControl1.Invalidate;
101. end;
102.  
103. procedure TForm1.FormDestroy(Sender: TObject);
104. begin
105.   glClearAllTextures;
106. end;
107.  
108. end.

[Gigatron]

Hi

An example of roto zoom fx with glTiledTexture2D of glcanvas V0.043 or texture repeat use
dynamic array of sintable.

Rotozoom live example: https://www.youtube.com/watch?v=V9FSx_n_spk

Code: Pascal  [Select][+][-]

1. procedure glTiledTexture2D(x, y, w, h: GLfloat; texID: GLuint;
2.                           patternWidth, patternHeight: GLfloat;
3.                           scaleX: GLfloat = 1.0; scaleY: GLfloat = 1.0;
4.                           rotation: GLfloat = 0.0;
5.                           red: GLfloat = 1.0; green: GLfloat = 1.0;
6.                           blue: GLfloat = 1.0; alpha: GLfloat = 1.0;
7.                           FlipX: Boolean = False; FlipY: Boolean = False);

If you want fullscreen Rotozoom replace TForm1.OpenGLControl1Paint by this code.

Code: Pascal  [Select][+][-]

1. procedure TForm1.OpenGLControl1Paint(Sender: TObject);
2. var
3.   cx, cy: Integer;
4. begin
5.   cx := (OpenGLControl1.Width - 4096) div 2;
6.   cy := (OpenGLControl1.Height - 4096) div 2;
7.   glFillScreen(OpenGLControl1, 0.0, 0.6, 0.8, 1.0);
8.  
9.   glTiledTexture2D(cx, cy, 4096, 4096, hawk_tex,         // big screen size 4096x4096
10.                  Round(256 + sin(sintmr) * 100), // de (256-100) à 256
11.                  Round(256 + sin(sintmr) * 100),
12.                  1.0, 1.0, sintable[tmr], 1.0,1.0,1.0, 1.0, false, false);
13.  
14.   OpenGLControl1.SwapBuffers;
15. end;    

Regards

[Gigatron]

Hi

Photoshop blend shader port from ST author ben : https://www.shadertoy.com/view/XdS3RW
25 blend mode + 25 add Added some mixed functions you can add your blend function in
memo1.text in fragment shader.

You can play blend formula in shadertoy link for your own. eg:

Code: Pascal  [Select][+][-]

1.  
2. vec3 myblend( vec3 s, vec3 d )
3. {
4.         return min(s,d)+1.-length(d);
5. }
6.  
7. vec3 icarus( vec3 s, vec3 d )
8. {
9.         return d*vec3(2.0*s.x + 0.5*s.x+0.2*s.z,
10.                   1.2*d.x + 0.7*d.x+0.0*d.z,
11.                   0.5*s.x + 0.2*s.x+0.4*s.z);
12. }
13.  
14. vec3 laracolor( vec3 s, vec3 d )
15. {
16.         return cos(s*3.14)+sin(d*9.0);
17. }
18.  
19. vec3 icecolor(vec3 s,vec3 d) {
20.        
21.              vec2 resolution = vec2(1280.0, 720.0);
22.              vec2 fragCoord = v_texcoord * resolution;
23.              float wave = 0.5 + 0.5 * sin(10.0 * (length(texture2D(u_texture1, fragCoord/resolution).rgb) + 2.0));
24.              return vec3(wave);
25. }
26.  
27.  

The glcanvas v0.044 can now load two textures to make this blend shader.
project1.zip contain demo with trackbar to display all 50 blend mode and you can save screenshot or region of screen in .jpg or .png format, see the example code.
Textures are attached size 512x512 power of 2 in .jpg format .

Have fun;

[Gigatron]

Hi

Late today, added some new commands in glcanvas v0.045;
fix glDrawTexturePerspective added glArc, glRoundedRect,  glDrawShader normal shader + fix animation u_time.

glDrawShader(x, y, w, h: GLfloat; shaderProgram: GLuint;
                       red: GLfloat = 1.0; green: GLfloat = 1.0;
                       blue: GLfloat = 1.0; alpha: GLfloat = 1.0;
                       tm: GLfloat = 0.0);
The last parameter tm is the speed of animation.

Normal shader without texture example with less code and demo of
gamecube boot anim from ST. https://www.shadertoy.com/view/tXdGDH

Regards

Code: Pascal  [Select][+][-]

1. unit Unit1;
2. {$mode objfpc}{$H+}
3. interface
4. uses
5.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
6.   OpenGLContext, glcanvas, gl;
7. type
8.   { TForm1 }
9.   TForm1 = class(TForm)
10.     Memo1: TMemo;
11.     OpenGLControl1: TOpenGLControl;
12.     Timer1: TTimer;
13.     procedure FormCreate(Sender: TObject);
14.     procedure OpenGLControl1Paint(Sender: TObject);
15.     procedure Timer1Timer(Sender: TObject);
16.   private
17.   public
18.   end;
19. var
20.   Form1: TForm1;
21.   shader_program : GLuint;
22.  
23. implementation
24.  
25. {$R *.lfm}
26.  
27. procedure TForm1.FormCreate(Sender: TObject);
28. begin
29.   glInit(OpenGLControl1);
30.   shader_program := glMakeShaderProgram('', Pchar(Memo1.Text));
31.   if shader_program = 0 then raise Exception.Create('Shader Compilation Failed. ');
32. end;
33.  
34. procedure TForm1.OpenGLControl1Paint(Sender: TObject);
35. begin
36.   glFillScreen(OpenGLControl1, 0.0, 0.0, 0.0, 1.0);
37.   glDrawShader(0,0,1920,1280 ,shader_program,1.0,1.0,1.0,1.0,1.0);// u_time = speed of animation
38.   OpenGLControl1.SwapBuffers;
39. end;
40.  
41. procedure TForm1.Timer1Timer(Sender: TObject);
42. begin
43.   OpenGLControl1.Invalidate;
44. end;
45.  
46. end.

[Gigatron]

Hi

Here is another example with textured Shader and glCanvas 0.046
added function  glGetColor(x, y: Integer): TglColor; Get pixel color at x,y with r,g,b,a format.

** I'm going to join the 3T Games group to code some parts of a game with Unity, such as parallax scrolling, and additional codes with the c# language that I master well. So I would be less present on the lazarus forum. I would look here to see if anyone has any questions or issues with these two libraries. Fast Canvas & glCanvas **

Image from Cougar/Sanity Amiga;

Regards

Main unit;

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   ComCtrls, Spin, OpenGLContext, glcanvas, gl;
10.  
11. type
12.  
13.   { TForm1 }
14.   TForm1 = class(TForm)
15.     Button1: TButton;
16.     Button2: TButton;
17.     FloatSpinEdit1: TFloatSpinEdit;
18.     Memo1: TMemo;
19.     OpenGLControl1: TOpenGLControl;
20.     Timer1: TTimer;
21.     procedure Button1Click(Sender: TObject);
22.     procedure Button2Click(Sender: TObject);
23.     procedure FormCreate(Sender: TObject);
24.     procedure FormDestroy(Sender: TObject);
25.     procedure OpenGLControl1Paint(Sender: TObject);
26.     procedure Timer1Timer(Sender: TObject);
27.   private
28.   public
29.   end;
30.  
31. var
32.   Form1: TForm1;
33.   hawk_tex : GLuint;
34.   hawk_w, hawk_h: integer; // get texture size variables !!
35.   shader_program : GLuint;
36.  
37. implementation
38.  
39. {$R *.lfm}
40.  
41. procedure TForm1.FormCreate(Sender: TObject);
42. begin
43.   glInit(OpenGLControl1);
44.   hawk_tex  := glLoadJPGToTexture('cougar.jpg',hawk_w, hawk_h);// source tex
45.  
46.   shader_program := glMakeShaderProgram('', Pchar(Memo1.Text));
47.   if shader_program = 0 then raise Exception.Create('Shader Compilation Failed. ');
48. end;
49.  
50. procedure TForm1.OpenGLControl1Paint(Sender: TObject);
51. begin
52.   glFillScreen(OpenGLControl1, 0.0, 0.6, 0.8, 1.0);
53.  
54.   glDrawTexturedShader(500,0,1024,960, hawk_tex, 0, shader_program, // 1 texture used !
55.                        1.0,1.0,1.0,1.0,0);// static timer , tm=0 , no animation !
56.  
57.   OpenGLControl1.SwapBuffers;
58. end;
59. // save region of openglcontrol1  with texture position + jpg quality  70%
60. procedure TForm1.Button1Click(Sender: TObject);
61. var
62.   FileName: string;
63. begin
64.   FileName := 'mypic_.jpg';
65.   try
66.     glSaveRegionToJPG( FileName, 500, 0, 1024,960,70); // position of texture x,y,x1,y1
67.     ShowMessage('Picture Saved : ' + FileName);
68.   except
69.     on E: Exception do
70.       ShowMessage('Error : ' + E.Message);
71.   end;
72. end;
73.  
74. procedure TForm1.Button2Click(Sender: TObject);
75. var
76.   FileName: string;
77. begin
78.   FileName := 'mypic_.jpg';
79.   try
80.     glSaveScreenShotJPG( FileName,90);
81.     ShowMessage('Picture Saved : ' + FileName);
82.   except
83.     on E: Exception do
84.       ShowMessage('Error : ' + E.Message);
85.   end;
86. end;
87.  
88. procedure TForm1.Timer1Timer(Sender: TObject);
89. begin
90.   glSetUniformFloat(shader_program, 'intensity',FloatSpinEdit1.value);
91.   OpenGLControl1.Invalidate;
92. end;
93.  
94. procedure TForm1.FormDestroy(Sender: TObject);
95. begin
96.   glClearAllTextures; // free all loaded textures
97. end;
98.  
99. end.

[Gigatron]

Hi

A new version of glCanvas v0.047 with alpha corrections on some commands, added
glPolygon (glpoint : TglPoint array). x,y pos, Tglpoint, r,g,b,a,Filled,Thickness,angle,scalex,y.
glBlitCopy with more gl blendmode and rotation.

Demo example is included in project1.zip.

Have Fun

PS: I am busy with some project so if you want new commands or suggestions please PM me.

[Gigatron]

Hi

Let me introduce a new version of glCanvas v0.048 with some nice effect;

Code: Pascal  [Select][+][-]

1. glMoveToTexture2D(-800, 700, 1600, 700, 3.0, tex_w, tex_h, tex, 0.5, 0.5, 0, 1.0, 1.0, 1.0, 1.0,False, False, true, etLinear);

Move texture from :
x,y to x1,y1, in 3.0 sec, tex_width, tex_height,texture , scaleX,Y, teint r,g,b,a, flipX,Y,AnimLoop,easing type

Assing Movement to texture ;

Code: Pascal  [Select][+][-]

1. glMovementTexture2D(800, 300,   0,300, 10.0, mtLinear,   tex_w, tex_h, texture, tex,0.5,0.5,rot, 1.0,1.0,0.0,1.0);

x,y, radiusX,Y, 10.0 sec, movement type, tex_w,h, scalex,y,rotation,teint r,g,b,a,flipx,y,animloop

Demo is included in project1.zip

Have Fun ;

Code: Pascal  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
9.   OpenGLContext, glcanvas, gl;
10.  
11. type
12.   { TForm1 }
13.   TForm1 = class(TForm)
14.     OpenGLControl1: TOpenGLControl;
15.     Timer1: TTimer;
16.     procedure FormCreate(Sender: TObject);
17.     procedure FormDestroy(Sender: TObject);
18.     procedure OpenGLControl1Paint(Sender: TObject);
19.     procedure Timer1Timer(Sender: TObject);
20.   private
21.   public
22.   end;
23.  
24. var
25.   Form1: TForm1;
26.   tex: GLuint;
27.   tex_w, tex_h: integer;
28.   rot: single;
29.  
30. implementation
31.  
32. {$R *.lfm}
33.  
34. procedure TForm1.FormCreate(Sender: TObject);
35. begin
36.   glInit(OpenGLControl1);      // initialisation OpenGL
37.   glEnableVSync(true);         // synchro verticale activée
38.   tex := glLoadPNGToTexture('girl7.png', tex_w, tex_h); // exemple de texture
39.   rot := 0.0;
40. end;
41.  
42. procedure TForm1.OpenGLControl1Paint(Sender: TObject);
43. begin
44.   glFillScreen(OpenGLControl1, 0.2, 0.2, 0.2, 1.0);
45.  
46.   glMoveToTexture2D(-800, 700, 1600, 700, 3.0, tex_w, tex_h, tex, 0.5, 0.5, 0, 1.0, 1.0, 1.0, 1.0,False, False, true, etLinear);
47.   glMoveToTexture2D(-800, 600, 1600, 600, 3.0, tex_w, tex_h, tex, 0.5, 0.5, 0, 1.0, 1.0, 1.0, 1.0,False, False, true, etEaseIn);
48.   glMoveToTexture2D(-800, 500, 1600, 500, 3.0, tex_w, tex_h, tex, 0.5, 0.5, 0, 1.0, 1.0, 1.0, 1.0,False, False, true, etEaseOut);
49.   glMoveToTexture2D(-800, 400, 1600, 400, 3.0, tex_w, tex_h, tex, 0.5, 0.5, 0, 1.0, 1.0, 1.0, 1.0,False, False, true, etEaseInOut);
50.   glMoveToTexture2D(-800, 300, 1600, 300, 3.0, tex_w, tex_h, tex, 0.5, 0.5, 0, 1.0, 1.0, 1.0, 1.0,False, False, true, etBounceOut);
51.   glMoveToTexture2D(-800, 200, 1600, 200, 3.0, tex_w, tex_h, tex, 0.5, 0.5, 0, 1.0, 1.0, 1.0, 1.0,False, False, true, etElasticOut);
52.   glMoveToTexture2D(-800, 100, 1600, 100, 3.0, tex_w, tex_h, tex, 0.5, 0.5, 0, 1.0, 1.0, 1.0, 1.0,False, False, true, etBackOut);
53.  
54. //etLinear,etEaseIn,etEaseOut,etEaseInOut,etBounceOut,etElasticOut,etBackOut
55.  
56.   glMovementTexture2D(800, 300,   0,300, 10.0, mtLinear,   tex_w, tex_h, tex,0.5,0.5,rot, 1.0,1.0,0.0,1.0);
57.   glMovementTexture2D(800, 200, 600,200, 10.0, mtSinus,    tex_w, tex_h, tex,0.5,0.5,-rot,0.0,1.0,0.0,1.0);
58.   glMovementTexture2D(800, 200, 600,200, 10.0, mtCircular, tex_w, tex_h, tex,0.5,0.5);
59.   glMovementTexture2D(800, 200, 600,200, 10.0, mtSpiral,   tex_w, tex_h, tex,0.5,0.5);
60.   glMovementTexture2D(800, 200, 600,200, 10.0, mtFigure8,  tex_w, tex_h, tex,0.5,0.5);
61.   glMovementTexture2D(800, 200, 600,200, 10.0, mtZigZag,   tex_w, tex_h, tex,0.5,0.5);
62.   glMovementTexture2D(800, 200, 600,200, 10.0, mtOrbital,   tex_w, tex_h, tex,0.5,0.5);
63.  
64. //mtLinear, mtSinus, mtCircular, mtSpiral, mtFigure8, mtZigZag,mtOrbital
65.  
66.   glDrawText3D(600,200,'GL MOVETO AND MOVEMENT DEMO',4,4,1.0,1.0,1.0,1.0,0.8,0.8,0.8,'Impact',34,[],rot,true);
67.  
68.   OpenGLControl1.SwapBuffers;
69. end;
70.  
71. procedure TForm1.Timer1Timer(Sender: TObject);
72. begin
73.   rot += 1.2;                  // incrémente l'angle
74.   OpenGLControl1.Invalidate;   // redessine
75. end;
76.  
77. procedure TForm1.FormDestroy(Sender: TObject);
78. begin
79.   glClearAllTextures;          // libère toutes les textures
80.   glClearTextCache;
81. end;
82.  
83. end.

[Gigatron]

Hi

The next version status details of the glCanvas V0.049 with some new commands
taken from FastCanvas V1.052. Will upload this version soon, you can see the live result
on my YT Channel;

One version to reach V0.050 the final release;
 
Regards

https://www.youtube.com/watch?v=HiXpe75j-i8