Demo Scene Text Fx

[Gigatron]

Hi,

Yesterdat i've played with .ttf font with lazarus fpc and bgra component to make a nice intro under 100 lines of code.

the font is from Digital demo group on Amiga converted to ttf by me included in attachement;

the code source :

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.   BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes;
10.  
11.  
12. type
13.  
14.   { TForm1 }
15.  
16.   TForm1 = class(TForm)
17.     BGRAVirtualScreen1: TBGRAVirtualScreen;
18.     Timer1: TTimer;
19.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
20.     procedure FormCreate(Sender: TObject);
21.     procedure Timer1Timer(Sender: TObject);
22.   private
23.  
24.  
25.   public
26.  
27.   end;
28.  
29. var
30.   Form1: TForm1;
31.   ta,xapp,yapp : double;
32.   x,y,i,j  : integer;
33.  
34.   tx: Array[0..9]  Of String;
35.  
36. implementation
37.  
38. {$R *.lfm}
39.  
40. { TForm1 }
41.  
42. procedure TForm1.FormCreate(Sender: TObject);
43. begin
44.      ta :=0;
45.      xapp :=0;
46.      yapp :=0;
47.      x:=0;
48.      y:=60;
49.      i :=0;
50.      j :=0;
51.  
52.      tx[0] := '***************************';
53.      tx[1] := '*       GIGATRON          *';
54.      tx[2] := '*                         *';
55.      tx[3] := '*    PRESENTS TEXT FX#1   *';
56.      tx[4] := '*                         *';
57.      tx[5] := '*      BGRA COMPONENT     *';
58.      tx[6] := '*-------------------------*';
59.      tx[7] := '*   LAZARUS FPC RULEZ  !!!*';
60.      tx[8] := '*-------------------------*';
61.      tx[9] := '***************************';
62.  
63. end;
64.  
65.  
66. procedure TForm1.Timer1Timer(Sender: TObject);
67. begin
68.     BGRAVirtualScreen1.RedrawBitmap;
69. end;
70.  
71. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
72.  
73. begin
74.  
75.   bitmap.FontName:='AmigaDigital8';
76.   bitmap.FontHeight := 40;
77.   bitmap.FontAntialias := false;
78.  
79.  
80.     for i:=0 to 27 do
81.     begin
82.     for j:=0 to 9 do
83.      begin
84.       ta := ta +0.002;
85.  
86.         xapp := (x + 2)  + 8   * sin(ta-j*0.05);
87.         yApp := (y+i*15) + 4  * sin(tA-j*0.4-i) * 2;
88.  
89.       bitmap.TextOut(i*24+xapp-10, (j*32 + yapp-i*15)+6  , tx[j][i],BGRA(0,0,0));
90.       bitmap.TextOut(i*24+xapp-10,  j*32 + yapp-i*15   ,   tx[j][i],BGRA(255,255,255));
91.      end;
92.     end;
93.  
94.   end;
95.  
96.  
97. end.
98.  

 
This fx is slow for me ..

[lainz]

I like how you create effects with few lines of code.

[Gigatron]

But, it's thanks to you lainz and the best component BGRA ;

So the same fx but with usin open GL, it's smooth and faster than light

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.   BGLVirtualScreen, BGRAOpenGL, BGRABitmap, BGRABitmapTypes;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     BGLVirtualScreen1: TBGLVirtualScreen;
17.     Timer1: TTimer;
18.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
19.     procedure FormCreate(Sender: TObject);
20.     procedure FormShow(Sender: TObject);
21.     procedure Timer1Timer(Sender: TObject);
22.   private
23.         GLFont: IBGLFont;
24.   public
25.  
26.   end;
27.  
28. var
29.   Form1: TForm1;
30.   ta,xapp,yapp : double;
31.   x,y,i,j  : integer;
32.   tx: Array[0..9]  Of String;
33.  
34. implementation
35.  
36. {$R *.lfm}
37.  
38. { TForm1 }
39.  
40. procedure TForm1.FormCreate(Sender: TObject);
41. begin
42.      ta :=0; xapp :=0; yapp :=0; x:=0; y:=60; i :=0; j :=0;
43.  
44.      tx[0] := '***************************';
45.      tx[1] := '*       GIGATRON          *';
46.      tx[2] := '*                         *';
47.      tx[3] := '*    PRESENTS TEXT FX#1   *';
48.      tx[4] := '*                         *';
49.      tx[5] := '*     BGRA COMPONENT GL   *';
50.      tx[6] := '*-------------------------*';
51.      tx[7] := '*   LAZARUS FPC RULEZ  !!!*';
52.      tx[8] := '*-------------------------*';
53.      tx[9] := '***************************';
54. end;
55.  
56. procedure TForm1.FormShow(Sender: TObject);
57. begin
58.      GLFont := BGLFont('AmigaDigital8',40);
59. end;
60.  
61. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;BGLContext: TBGLContext);
62. begin
63.  
64.    for i:=0 to 27 do
65.     begin
66.     for j:=0 to 9 do
67.      begin
68.       ta := ta +0.0004;
69.  
70.         xapp := (x + 2)  + 10   * sin(ta-j*0.005);
71.         yApp := (y+i*15) + 6    * sin(tA-j*0.004-i)*2 ;
72.  
73.       GLFont.TextOut(i*24+xapp, (j*32 + yapp-i*15)+6  , tx[j][i],BGRA(68,85,102));
74.       GLFont.TextOut(i*24+xapp,  j*32 + yapp-i*15   ,   tx[j][i],BGRA(255,255,255));
75.      end;
76.     end;
77.  
78. end;
79.  
80. procedure TForm1.Timer1Timer(Sender: TObject);
81. begin
82.          BGLVirtualScreen1.Repaint;
83. end;
84.  
85. end.
86.  

[KodeZwerg]

Minimal modified so it actually use on windows the font that you shared
(also renamed variables to better qualifier names)
(modified for a smoother wave look)

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Windows,
9.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
10.   BGLVirtualScreen, BGRAOpenGL, BGRABitmap, BGRABitmapTypes;
11.  
12. type
13.  
14.   { TForm1 }
15.  
16.   TForm1 = class(TForm)
17.     BGLVirtualScreen1: TBGLVirtualScreen;
18.     Timer1: TTimer;
19.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
20.     procedure FormCreate(Sender: TObject);
21.     procedure FormDestroy(Sender: TObject);
22.     procedure FormShow(Sender: TObject);
23.     procedure Timer1Timer(Sender: TObject);
24.   private
25.     angle,
26.     xPos, yPos : double;
27.     xStart,
28.     yStart: Integer;
29.     Message: array[0..9] of AnsiString;
30.   private
31.      GLFont: IBGLFont;
32.   public
33.  
34.   end;
35.  
36. var
37.   Form1: TForm1;
38.  
39. implementation
40.  
41. {$R *.lfm}
42.  
43. { TForm1 }
44.  
45. procedure TForm1.Timer1Timer(Sender: TObject);
46. begin
47.   BGLVirtualScreen1.Repaint;
48. end;
49.  
50. procedure TForm1.FormCreate(Sender: TObject);
51. begin
52.   angle   := 0;
53.   xPos    := 0;
54.   yPos    := 0;
55.   xStart  := 0;
56.   yStart  := 60;
57.  
58.   Message[0] := '***************************';
59.   Message[1] := '*       GIGATRON          *';
60.   Message[2] := '*                         *';
61.   Message[3] := '*    PRESENTS TEXT FX#1   *';
62.   Message[4] := '*                         *';
63.   Message[5] := '*     BGRA COMPONENT GL   *';
64.   Message[6] := '*-------------------------*';
65.   Message[7] := '*   LAZARUS FPC RULEZ  !!!*';
66.   Message[8] := '*-------------------------*';
67.   Message[9] := '***************************';
68.  
69.   // preset a minimal wanted window size
70.   Self.Width := 710;
71.   Self.Height := 460;
72.  
73.   // adopted your color from screenshot :D
74.   BGLVirtualScreen1.Color := $00776655;
75.  
76.   // adjust timer to your needs
77.   Timer1.Interval := 1;
78.  
79.   // load the font on the fly and make it systemwide public
80.   AddFontResource('AmigaDigital8.ttf');
81.   SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
82. end;
83.  
84. procedure TForm1.FormDestroy(Sender: TObject);
85. begin
86.   // unload the font and make it systemwide public
87.   RemoveFontResource('AmigaDigital8.ttf');
88.   SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
89. end;
90.  
91. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
92.   BGLContext: TBGLContext);
93. var
94.   i, j: Integer;
95. begin
96.   for i := 0 to 27 do
97.     for j := 0 to 9 do
98.       begin
99.         // movement modifier
100.         angle := angle + 0.0004;
101.         // left to right movement
102.         xPos := (xStart + 2) + 10 * Sin(angle - j * 0.005);
103.         // up and down movement
104.         yPos := (yStart + i * 15) + 6 * Cos(angle - j * 0.004 - i) * 2;
105.         // fake shadow character
106.         GLFont.TextOut(i * 24 + xPos, (j * 32 + yPos - i * 15) + 6, Message[j][i], BGRA(68, 85, 102));
107.         // actual text character
108.         GLFont.TextOut(i * 24 + xPos, j * 32 + yPos - i * 15, Message[j][i], BGRA(255, 255, 255));
109.       end;
110. end;
111.  
112. procedure TForm1.FormShow(Sender: TObject);
113. begin
114.   GLFont := BGLFont('AmigaDigital8', 40);
115. end;
116.  
117. end.

Thank you Gigatron for that nice example!

Attached is how it looks without font installed, I am unsure what is used but its not the AmigaDigital8 

[TRon]

This fx is slow for me ..

Yeah, that is way of things. Learn to know the tools and their trade-offs.

So,
- the font can be set to the virtual screen once. However slightly, it helps.
- at a certain point clearing the screen (big surface) at once is cheaper than (re)drawing smaller bits
- in accordance with the above, skip drawing when there is actually nothing to draw (spaces)
- also however slightly it helps, pre-calculation of sin/coords (that has a certain drawback ofc.)
- note that using a timer to actually time frames is .. not smart ... to say the least. It fires every x-th millisecond an is literally wasting all time in between (I know it a timer is a simple pleasure usage and use it myself as well).
- the bigger slowness seem to originate form redrawing of the same thing over and over (opengl caches some important parts hence the speed increase), so pre-draw the glyphs and blit a single glyph at once.

There are many more things that are able to influence speed (or the perception thereof).

The funny part of this is... we are talking about hardware that is around 3-4 decades old (the generation before Amiga was also capable of these same fx) and is able to display such a wavy text without breaking a sweat with enough time to spare to do some actual important stuff. It is a living testimony that relying on cpu grunt alone is not the smartest way to approach these kind of things.

[Guva]

Cool!!!, five minutes to convert. the total is 120 lines in raylib.

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

1. program project1;
2. {$mode objfpc}{$H+}
3.  
4. uses
5.   {$IFDEF UNIX}
6.   cthreads,
7.   {$ENDIF}
8.   Classes, SysUtils, CustApp, RayLib, RayMath;
9.  
10. type
11.   PStar = ^TStar;
12.   TStar = record
13.     position : TVector2;
14.     speed    : TVector2;
15.   end;
16.  
17.   { TRayApplication }
18.   TRayApplication = class(TCustomApplication)
19.   protected
20.     procedure DoRun; override;
21.   public
22.     Stars: array [0..400] of TStar;
23.     constructor Create(TheOwner: TComponent); override;
24.     destructor Destroy; override;
25.     procedure UpdateStar(s: PStar);
26.     procedure ResetStar(s: PStar);
27.   end;
28.  
29.   const AppTitle = 'raylib - text fx#1';
30.  
31. var
32.   message : Array[0..9] Of Pchar; MyFont: TFont;
33.   angle, xPos, yPos : double;
34.   xStart, yStart: Integer;
35.  
36. constructor TRayApplication.Create(TheOwner: TComponent);
37. var n,m: integer;
38. begin
39.   inherited Create(TheOwner);
40.   InitWindow(800, 600, AppTitle); // for window settings, look at example - window flags
41.   SetTargetFPS(60); // Set our game to run at 60 frames-per-second
42.   MyFont:= LoadFont('Phased.ttf');
43.   angle   := 0; xPos := 0; yPos    := 0;  xStart  := 80; yStart  := 120;
44.  
45.   message[0] := '***************************';
46.   message[1] := '*       GIGATRON          *';
47.   message[2] := '*                         *';
48.   message[3] := '*    PRESENTS TEXT FX#1   *';
49.   message[4] := '*                         *';
50.   message[5] := '*      120 LINE CODE      *';
51.   message[6] := '*-------------------------*';
52.   message[7] := '*      RAYLIB RULEZ  !!!  *';
53.   message[8] := '*-------------------------*';
54.   message[9] := '***************************';
55.   for n := 0  to 399 do ResetStar(@stars[n]);
56.   for m := 0 to  GetscreenWidth div 2 do
57.   begin
58.    for n:=0 to 399 do UpdateStar(@stars[n]);
59.   end;
60. end;
61.  
62. procedure TRayApplication.DoRun;
63. var i,j,n: integer;
64. begin
65.   while (not WindowShouldClose) do // Detect window close button or ESC key
66.   begin
67.     for n := 0 to 399 do UpdateStar(@stars[n]);
68.     BeginDrawing();
69.     ClearBackground(DARKBLUE);
70.     for i:=0 to 26 do
71.     for j:=0 to 9 do
72.      begin
73.       angle := angle + 0.0004;
74.       // left to right movement
75.       xPos := (xStart + 2) + 10 * Sin(angle - j * 0.005);
76.      // up and down movement
77.      yPos := (yStart + i * 15) + 6 * Cos(angle - j * 0.004 - i) * 2;
78.      DrawTextCodepoint(MyFont,Integer(message[j][i]), Vector2Create(i * 24 + xPos,  (j*32 + yPos - i *15 ) + 3), 40, Black);
79.      DrawTextCodepoint(MyFont,Integer(message[j][i]), Vector2Create(i * 24 + xPos,  (j*32 + yPos - i *15 )), 40, White);
80.      end;
81.     for n := 0 to 399 do
82.     DrawRectangle(round(stars[n].position.x), round(stars[n].position.y), 2, 2, WHITE);
83.     EndDrawing();
84.   end;
85.   Terminate;
86. end;
87.  
88. destructor TRayApplication.Destroy;
89. begin
90.   CloseWindow(); // Close window and OpenGL context
91.   inherited Destroy;
92. end;
93.  
94. procedure TRayApplication.UpdateStar(s: PStar);
95. begin
96.   s^.position := Vector2Add(s^.position, s^.speed);
97.   if ((s^.position.x < 0) or (s^.position.x > GetScreenWidth()) or
98.       (s^.position.y < 0) or (s^.position.y > GetScreenHeight())) then ResetStar(s);
99. end;
100.  
101. procedure TRayApplication.ResetStar(s: PStar);
102. begin
103.   s^.position := Vector2Create(GetScreenWidth()/2.0, GetScreenHeight()/2.0);
104.   while not (abs(s^.speed.x + abs(s^.speed.y)) > 1) do
105.   begin
106.       s^.speed.x := GetRandomValue(-1000, 1000)/100;
107.       s^.speed.y := GetRandomValue(-1000, 1000)/100;
108.   end;
109.   s^.position := Vector2Add(s^.position, Vector2Multiply(s^.speed, Vector2Create( 20.0, 20.0 )));
110. end;
111.  
112. var
113.   Application: TRayApplication;
114. begin
115.   Application:=TRayApplication.Create(nil);
116.   Application.Title:=AppTitle;
117.   Application.Run;
118.   Application.Free;
119. end.
120.                
121.  

[Gigatron]

Minimal modified so it actually use on windows the font that you shared
(also renamed variables to better qualifier names)
(modified for a smoother wave look)

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Windows,
9.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
10.   BGLVirtualScreen, BGRAOpenGL, BGRABitmap, BGRABitmapTypes;
11.  
12. type
13.  
14.   { TForm1 }
15.  
16.   TForm1 = class(TForm)
17.     BGLVirtualScreen1: TBGLVirtualScreen;
18.     Timer1: TTimer;
19.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
20.     procedure FormCreate(Sender: TObject);
21.     procedure FormDestroy(Sender: TObject);
22.     procedure FormShow(Sender: TObject);
23.     procedure Timer1Timer(Sender: TObject);
24.   private
25.     angle,
26.     xPos, yPos : double;
27.     xStart,
28.     yStart: Integer;
29.     Message: array[0..9] of AnsiString;
30.   private
31.      GLFont: IBGLFont;
32.   public
33.  
34.   end;
35.  
36. var
37.   Form1: TForm1;
38.  
39. implementation
40.  
41. {$R *.lfm}
42.  
43. { TForm1 }
44.  
45. procedure TForm1.Timer1Timer(Sender: TObject);
46. begin
47.   BGLVirtualScreen1.Repaint;
48. end;
49.  
50. procedure TForm1.FormCreate(Sender: TObject);
51. begin
52.   angle   := 0;
53.   xPos    := 0;
54.   yPos    := 0;
55.   xStart  := 0;
56.   yStart  := 60;
57.  
58.   Message[0] := '***************************';
59.   Message[1] := '*       GIGATRON          *';
60.   Message[2] := '*                         *';
61.   Message[3] := '*    PRESENTS TEXT FX#1   *';
62.   Message[4] := '*                         *';
63.   Message[5] := '*     BGRA COMPONENT GL   *';
64.   Message[6] := '*-------------------------*';
65.   Message[7] := '*   LAZARUS FPC RULEZ  !!!*';
66.   Message[8] := '*-------------------------*';
67.   Message[9] := '***************************';
68.  
69.   // preset a minimal wanted window size
70.   Self.Width := 710;
71.   Self.Height := 460;
72.  
73.   // adopted your color from screenshot :D
74.   BGLVirtualScreen1.Color := $00776655;
75.  
76.   // adjust timer to your needs
77.   Timer1.Interval := 1;
78.  
79.   // load the font on the fly and make it systemwide public
80.   AddFontResource('AmigaDigital8.ttf');
81.   SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
82. end;
83.  
84. procedure TForm1.FormDestroy(Sender: TObject);
85. begin
86.   // unload the font and make it systemwide public
87.   RemoveFontResource('AmigaDigital8.ttf');
88.   SendMessage(HWND_BROADCAST, WM_FONTCHANGE, 0, 0);
89. end;
90.  
91. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
92.   BGLContext: TBGLContext);
93. var
94.   i, j: Integer;
95. begin
96.   for i := 0 to 27 do
97.     for j := 0 to 9 do
98.       begin
99.         // movement modifier
100.         angle := angle + 0.0004;
101.         // left to right movement
102.         xPos := (xStart + 2) + 10 * Sin(angle - j * 0.005);
103.         // up and down movement
104.         yPos := (yStart + i * 15) + 6 * Cos(angle - j * 0.004 - i) * 2;
105.         // fake shadow character
106.         GLFont.TextOut(i * 24 + xPos, (j * 32 + yPos - i * 15) + 6, Message[j][i], BGRA(68, 85, 102));
107.         // actual text character
108.         GLFont.TextOut(i * 24 + xPos, j * 32 + yPos - i * 15, Message[j][i], BGRA(255, 255, 255));
109.       end;
110. end;
111.  
112. procedure TForm1.FormShow(Sender: TObject);
113. begin
114.   GLFont := BGLFont('AmigaDigital8', 40);
115. end;
116.  
117. end.

Thank you Gigatron for that nice example!

Attached is how it looks without font installed, I am unsure what is used but its not the AmigaDigital8 

Thank you very much for the code , i saved it ;

[Gigatron]

This fx is slow for me ..

Yeah, that is way of things. Learn to know the tools and their trade-offs.

So,
- the font can be set to the virtual screen once. However slightly, it helps.
- at a certain point clearing the screen (big surface) at once is cheaper than (re)drawing smaller bits
- in accordance with the above, skip drawing when there is actually nothing to draw (spaces)
- also however slightly it helps, pre-calculation of sin/coords (that has a certain drawback ofc.)
- note that using a timer to actually time frames is .. not smart ... to say the least. It fires every x-th millisecond an is literally wasting all time in between (I know it a timer is a simple pleasure usage and use it myself as well).
- the bigger slowness seem to originate form redrawing of the same thing over and over (opengl caches some important parts hence the speed increase), so pre-draw the glyphs and blit a single glyph at once.

There are many more things that are able to influence speed (or the perception thereof).

The funny part of this is... we are talking about hardware that is around 3-4 decades old (the generation before Amiga was also capable of these same fx) and is able to display such a wavy text without breaking a sweat with enough time to spare to do some actual important stuff. It is a living testimony that relying on cpu grunt alone is not the smartest way to approach these kind of things.

You explained the situation perfectly
I have not tried to optimize the assembly code to speed up the execution, however I wonder about a sine table precalculated in advance by myself so what is the use of the 8 cores that I have , if it is not capable of calculating values ​​of 27*8 sine in real time. If commodore's i****s weren't *****, we would all be on amiga now. I still have Winuae on PC

[KodeZwerg]

another small update that the wave become a wobble
(and now the "message" could be a dynamic array of ansistring)

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

1. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
2.   BGLContext: TBGLContext);
3. var
4.   Column,
5.   Row: Integer;
6. begin
7.   for Row := Low(Message) to High(Message) do
8.     for Column := Low(Message[Row]) to Length(Message[Row]) do
9.       begin
10.         // movement modifier
11.         angle := angle + 0.0004;
12.         // left to right movement
13.         xPos := (xStart + 2) + 3 * Sin(angle - Row * -2) * 2;
14.         // up and down movement
15.         yPos := (yStart + Column * 15) + 3 * Cos(angle - Row * 0.004 - Column) * 3;
16.         // fake shadow character
17.         GLFont.TextOut(Column * 24 + xPos + 5, (Row * 32 + yPos - Column * 15) + 5, Message[Row][Column], BGRA(1, 1, 1));
18.         // actual text character
19.         GLFont.TextOut(Column * 24 + xPos, Row * 32 + yPos - Column * 15, Message[Row][Column], BGRA(254, 254, 254));
20.       end;
21. end;

all those fixed numbers could become parameters to tweak the mechanism, many variations possible

Nice done @Guva!

[Gigatron]

Very nice mr KodeZwerg;

I am working for another good text fx , my goal is doing that in digital demo;

https://www.youtube.com/watch?v=fcB-v8D3i6s&t=52s

For now just begining slowly and really non optimized code sorry i am lazy ; 245 linesof code is not acceptable will reduce it soon ;

I had to do the same thing in lua, lazy that I am

https://tic80.com/play?cart=3659

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.   BGLVirtualScreen, BGRAOpenGL, BGRABitmap, BGRABitmapTypes;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     BGLVirtualScreen1: TBGLVirtualScreen;
17.     Timer1: TTimer;
18.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
19.     procedure FormCreate(Sender: TObject);
20.     procedure FormShow(Sender: TObject);
21.     procedure Timer1Timer(Sender: TObject);
22.     procedure reset;
23.   private
24.         GLFont: IBGLFont;
25.   public
26.  
27.   end;
28.  
29. var
30.   Form1: TForm1;
31.  
32.   x,y,i,j,g_timer,idx  : integer;  // general demo timer
33.   tx: Array[0..12]  Of String;
34.   dest_y :Array[0..12]  Of integer;
35.  
36. implementation
37.  
38. {$R *.lfm}
39.  
40. { TForm1 }
41.  
42. procedure TForm1.FormCreate(Sender: TObject);
43. begin
44.        x:=20; y:=0; i :=0; j :=0;
45.  
46.      tx[0] := '+*************************+';
47.      tx[1] := '*        GIGATRON         *';
48.      tx[2] := '*                         *';
49.      tx[3] := '*    PRESENTS TEXT FX#2   *';
50.      tx[4] := '*                         *';
51.      tx[5] := '*    BGRA COMPONENT GL    *';
52.      tx[6] := '*                         *';
53.      tx[7] := '* @@ LAZARUS FPC RULEZ @@ *';
54.      tx[8] := '*                         *';
55.      tx[9] := '******   *********   ******';
56.      tx[10]:= '*   AMIGA DIGITAL FONT    *';
57.      tx[11]:= '*      BY DOUGHNUT        *';
58.      tx[12]:= '+*************************+';
59.  
60.      for i:=0 to 12 do
61.      begin
62.      dest_y[i] := 800  ;
63.      end;
64.  
65. end;
66.  
67. procedure TForm1.FormShow(Sender: TObject);
68. begin
69.      GLFont := BGLFont('AmigaDigital8',40);
70.      GLFont.SetStepX(-12);
71. end;
72.  
73. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;BGLContext: TBGLContext);
74. begin
75.  
76.     for i:=0 to 1 do
77.     begin
78.       GLFont.TextOut(x, dest_y[0]+6  ,   tx[0],BGRA(68,85,102));
79.       GLFont.TextOut(x, dest_y[0]    ,   tx[0],BGRA(255,255,255));
80.       dest_y[0] := dest_y[0] - 8 ;
81.       if  (dest_y[0]<0) then dest_y[0]:=0;
82.      end;
83.  
84.      if(g_timer>30) then
85.      begin
86.       for i:=0 to 1 do
87.         begin
88.           GLFont.TextOut(x, dest_y[1]+6  ,   tx[1],BGRA(68,85,102));
89.           GLFont.TextOut(x, dest_y[1]    ,   tx[1],BGRA(255,255,255));
90.           dest_y[1] := dest_y[1] - 8 ;
91.           if  (dest_y[1]<32) then dest_y[1]:=32;
92.         end;
93.      end;
94.  
95.  
96.      if(g_timer>60) then
97.      begin
98.         for i:=0 to 1 do
99.         begin
100.           GLFont.TextOut(x, dest_y[2]+6  ,   tx[2],BGRA(68,85,102));
101.           GLFont.TextOut(x, dest_y[2]    ,   tx[2],BGRA(255,255,255));
102.           dest_y[2] := dest_y[2] - 8 ;
103.           if  (dest_y[2]<64) then dest_y[2]:=64;
104.         end;
105.      end;
106.  
107.      if(g_timer>90) then
108.      begin
109.         for i:=0 to 1 do
110.         begin
111.           GLFont.TextOut(x, dest_y[3]+6  ,   tx[3],BGRA(68,85,102));
112.           GLFont.TextOut(x, dest_y[3]    ,   tx[3],BGRA(255,255,255));
113.           dest_y[3] := dest_y[3] - 8 ;
114.           if  (dest_y[3]<96) then dest_y[3]:=96;
115.         end;
116.      end;
117.  
118.  
119.      if(g_timer>120) then
120.      begin
121.        for i:=0 to 1 do
122.         begin
123.           GLFont.TextOut(x, dest_y[4]+6  ,   tx[4],BGRA(68,85,102));
124.           GLFont.TextOut(x, dest_y[4]    ,   tx[4],BGRA(255,255,255));
125.           dest_y[4] := dest_y[4] - 8 ;
126.           if  (dest_y[4]<128) then dest_y[4]:=128;
127.         end;
128.      end;
129.  
130.      if(g_timer>150) then
131.      begin
132.        for i:=0 to 1 do
133.         begin
134.           GLFont.TextOut(x, dest_y[5]+6  ,   tx[5],BGRA(68,85,102));
135.           GLFont.TextOut(x, dest_y[5]    ,   tx[5],BGRA(255,255,255));
136.           dest_y[5] := dest_y[5] - 8 ;
137.           if  (dest_y[5]<160) then dest_y[5]:=160;
138.         end;
139.      end;
140.  
141.      if(g_timer>180) then
142.      begin
143.       for i:=0 to 1 do
144.         begin
145.           GLFont.TextOut(x, dest_y[6]+6  ,   tx[6],BGRA(68,85,102));
146.           GLFont.TextOut(x, dest_y[6]    ,   tx[6],BGRA(255,255,255));
147.           dest_y[6] := dest_y[6] - 8 ;
148.           if  (dest_y[6]<192) then dest_y[6]:=192;
149.         end;
150.      end;
151.  
152.  
153.      if(g_timer>210) then
154.      begin
155.       for i:=0 to 1 do
156.         begin
157.           GLFont.TextOut(x, dest_y[7]+6  ,   tx[7],BGRA(68,85,102));
158.           GLFont.TextOut(x, dest_y[7]    ,   tx[7],BGRA(255,255,255));
159.           dest_y[7] := dest_y[7] - 8 ;
160.           if  (dest_y[7]<224) then dest_y[7]:=224;
161.         end;
162.      end;
163.  
164.      if(g_timer>240) then
165.      begin
166.       for i:=0 to 1 do
167.         begin
168.           GLFont.TextOut(x, dest_y[8]+6  ,   tx[8],BGRA(68,85,102));
169.           GLFont.TextOut(x, dest_y[8]    ,   tx[8],BGRA(255,255,255));
170.           dest_y[8] := dest_y[8] - 8 ;
171.           if  (dest_y[8]<256) then dest_y[8]:=256;
172.         end;
173.      end;
174.      if(g_timer>270) then
175.      begin
176.       for i:=0 to 1 do
177.         begin
178.           GLFont.TextOut(x, dest_y[9]+6  ,   tx[9],BGRA(68,85,102));
179.           GLFont.TextOut(x, dest_y[9]    ,   tx[9],BGRA(255,255,255));
180.           dest_y[9] := dest_y[9] - 8 ;
181.           if  (dest_y[9]<288) then dest_y[9]:=288;
182.         end;
183.      end;
184.  
185.      if(g_timer>300) then
186.      begin
187.       for i:=0 to 1 do
188.         begin
189.           GLFont.TextOut(x, dest_y[10]+6  ,   tx[10],BGRA(68,85,102));
190.           GLFont.TextOut(x, dest_y[10]    ,   tx[10],BGRA(255,255,255));
191.           dest_y[10] := dest_y[10] - 8 ;
192.           if  (dest_y[10]<320) then dest_y[10]:=320;
193.         end;
194.      end;
195.  
196.      if(g_timer>330) then
197.      begin
198.       for i:=0 to 1 do
199.         begin
200.           GLFont.TextOut(x, dest_y[11]+6  ,   tx[11],BGRA(68,85,102));
201.           GLFont.TextOut(x, dest_y[11]    ,   tx[11],BGRA(255,255,255));
202.           dest_y[11] := dest_y[11] - 8 ;
203.           if  (dest_y[11]<352) then dest_y[11]:=352;
204.         end;
205.      end;
206.  
207.      if(g_timer>360) then
208.      begin
209.       for i:=0 to 1 do
210.         begin
211.           GLFont.TextOut(x, dest_y[12]+6  ,   tx[12],BGRA(68,85,102));
212.           GLFont.TextOut(x, dest_y[12]    ,   tx[12],BGRA(255,255,255));
213.           dest_y[12] := dest_y[12] - 8 ;
214.           if  (dest_y[12]<384) then dest_y[12]:=384;
215.         end;
216.      end;
217.  
218. end;
219.  
220. procedure TForm1.Timer1Timer(Sender: TObject);
221. begin
222.          BGLVirtualScreen1.Repaint;
223.          inc(g_timer,1);
224.          if(g_timer>600) then
225.          begin
226.           g_timer :=0;
227.           BGLVirtualScreen1.Invalidate;
228.           reset;
229.          end;
230.  
231. end;
232.  
233. procedure TForm1.reset();
234. var
235.   i :integer;
236. begin
237.     i:=0;
238.     for i:=0 to 12 do
239.      begin
240.      dest_y[i] := 800  ;
241.      end;
242.  
243. end;
244.  
245. end.
246.  
247.  

another small update that the wave become a wobble
(and now the "message" could be a dynamic array of ansistring)

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

1. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;
2.   BGLContext: TBGLContext);
3. var
4.   Column,
5.   Row: Integer;
6. begin
7.   for Row := Low(Message) to High(Message) do
8.     for Column := Low(Message[Row]) to Length(Message[Row]) do
9.       begin
10.         // movement modifier
11.         angle := angle + 0.0004;
12.         // left to right movement
13.         xPos := (xStart + 2) + 3 * Sin(angle - Row * -2) * 2;
14.         // up and down movement
15.         yPos := (yStart + Column * 15) + 3 * Cos(angle - Row * 0.004 - Column) * 3;
16.         // fake shadow character
17.         GLFont.TextOut(Column * 24 + xPos + 5, (Row * 32 + yPos - Column * 15) + 5, Message[Row][Column], BGRA(1, 1, 1));
18.         // actual text character
19.         GLFont.TextOut(Column * 24 + xPos, Row * 32 + yPos - Column * 15, Message[Row][Column], BGRA(254, 254, 254));
20.       end;
21. end;

all those fixed numbers could become parameters to tweak the mechanism, many variations possible

Nice done @Guva!

[KodeZwerg]

I tried to simplify your loops but something I do wrong :-/

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

1. var
2.   Row: Integer;
3.   yOffset: Integer;
4. begin
5.   for Row := Low(tx) to High(tx) do
6.     for yOffset := BGLContext.Canvas.ClipRect.Height downto (Row * 32) do
7.       begin
8.         GLFont.TextOut(x, yOffset, tx[Row], BGRA(68,85,102));
9.         GLFont.TextOut(x, yOffset, tx[Row], BGRA(255,255,255));
10.       end;
11. end;

[Gigatron]

Hi,
Just reduced the code above from 245 lines to 110.

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.   BGLVirtualScreen, BGRAOpenGL, BGRABitmap, BGRABitmapTypes,Math;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     BGLVirtualScreen1: TBGLVirtualScreen;
17.     Timer1: TTimer;
18.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
19.     procedure FormCreate(Sender: TObject);
20.     procedure FormShow(Sender: TObject);
21.     procedure Timer1Timer(Sender: TObject);
22.     procedure reset;
23.   private
24.         GLFont: IBGLFont;
25.   public
26.  
27. end;
28.  
29. var
30.   Form1: TForm1;
31.   x,y,i,j,g_timer,speed  : integer;  // general demo timer
32.   tx: Array[0..12]  Of String;
33.   dest_y :Array[0..12]  Of integer;
34.  
35. implementation
36.  
37. {$R *.lfm}
38.  
39. { TForm1 }
40.  
41. procedure TForm1.FormCreate(Sender: TObject);
42. begin
43.      x:=20; y:=0; i :=0; j :=0; speed := 20; // speed of fx
44.  
45.      tx[0] := '+*************************+';
46.      tx[1] := '*        GIGATRON         *';
47.      tx[2] := '*                         *';
48.      tx[3] := '*    PRESENTS TEXT FX#2   *';
49.      tx[4] := '*                         *';
50.      tx[5] := '*    BGRA COMPONENT GL    *';
51.      tx[6] := '*                         *';
52.      tx[7] := '* @@ LAZARUS FPC RULEZ @@ *';
53.      tx[8] := '*                         *';
54.      tx[9] := '******   *********   ******';
55.      tx[10]:= '*   AMIGA DIGITAL FONT    *';
56.      tx[11]:= '*      BY DOUGHNUT        *';
57.      tx[12]:= '+*************************+';
58.  
59.      for i:=0 to 12 do
60.      begin
61.      dest_y[i] := 800  ; // set ypos for each line
62.      end;
63. end;
64.  
65. procedure TForm1.FormShow(Sender: TObject);
66. begin
67.      GLFont := BGLFont('AmigaDigital8',40);
68.      GLFont.SetStepX(-12);
69. end;
70.  
71. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
72. begin
73.   for j := 0 to  Min((g_timer div speed), High(tx)) do
74.   begin
75.     if g_timer > (j * speed) then
76.     begin
77.       for i := 0 to 1 do
78.       begin
79.         GLFont.TextOut(x, dest_y[j] + 6, tx[j], BGRA(68, 85, 102));
80.         GLFont.TextOut(x, dest_y[j], tx[j], BGRA(255, 255, 255));
81.         dest_y[j] := dest_y[j] - 8;
82.         if dest_y[j] < (j * 32) then dest_y[j] := j * 32;
83.       end;
84.     end;
85.   end;
86. end;
87.  
88. procedure TForm1.Timer1Timer(Sender: TObject);
89. begin
90.          BGLVirtualScreen1.Repaint;
91.          inc(g_timer,1);
92.          if(g_timer>500) then
93.          begin
94.           g_timer :=0;
95.           BGLVirtualScreen1.Invalidate;
96.           reset;
97.          end;
98.   end;
99.  
100. procedure TForm1.reset();
101. begin
102.     i:=0;
103.     for i:=0 to 12 do
104.      begin
105.        dest_y[i] := 800  ;
106.      end;
107. end;
108.  
109. end.
110.  

[Guva]

@Gigatron thanks for the text effects.
that's what I got in the end.
https://www.youtube.com/watch?v=dUnmISyqlEI

Final version
https://www.youtube.com/watch?v=SGmaGI-JNT4

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

1. program project1;
2. {$mode objfpc}{$H+}
3. uses {$IFDEF UNIX}cthreads,{$ENDIF} Classes, SysUtils, CustApp, RayLib, RayMath, Math;
4.  
5. const AppTitle = 'raylib - text fx#1';
6. type
7.   { TRayApplication }
8.   TRayApplication = class(TCustomApplication)
9.   protected
10.     message : Array[0..9] Of Pchar;
11.     MyFont: TFont;
12.     Texture: TTexture2D;
13.     Shader: TShader;
14.     line_message :Array of PChar;
15.     angle, line_angle, xPos, LineXpos, yPos, LineYpos, FreqX, FreqY,
16.     AmpX, AmpY, SpeedX, SpeedY, Seconds : Single;
17.     xStart, yStart, lineXstart, LineYstart, SecondsLoc, FreqXLoc,
18.     FreqYLoc, AmpXLoc, AmpYLoc, SpeedXLoc, SpeedYLoc: Integer;
19.     ScreenSize: array [0..1] of Single;
20.     LineColor: TColorB;
21.     procedure DoRun; override;
22.   public
23.     constructor Create(TheOwner: TComponent); override;
24.     destructor Destroy; override;
25.   end;
26.  
27. var  alpha: byte;
28. constructor TRayApplication.Create(TheOwner: TComponent);
29. begin
30.   inherited Create(TheOwner);
31.   InitWindow(800, 450, AppTitle); // for window settings, look at example - window flags
32.  
33.   MyFont:= LoadFont('Phased.ttf');
34.   angle   := 0; xPos := 0; yPos    := 0;  xStart  := 80; yStart  := 40;
35.   LinexStart  := 800; LineyStart  := 380;  LineXPos := 800;
36.  
37.   message[0] := '                           ';
38.   message[1] := '        GIGATRON           ';
39.   message[2] := '                           ';
40.   message[3] := '     PRESENTS TEXT FX#1    ';
41.   message[4] := '                           ';
42.   message[5] := '       150 LINE CODE       ';
43.   message[6] := ' ------------------------- ';
44.   message[7] := '       RAYLIB RULEZ  !!!   ';
45.   message[8] := ' ------------------------- ';
46.   message[9] := '                           ';
47.  
48.   SetLength(line_message, 1);
49.   line_message[0] := TextToUpper('raylib is a simple and easy-to-use library to enjoy videogames programming. Thanks to Ramon Santamarina and the raylib community for a great product');
50.   // Load texture texture to apply shaders
51.   Texture := LoadTexture('space.png');
52.   // Load shader and setup location points and values
53.   Shader := LoadShader(nil, GetAppDir('wave.fs'));
54.  
55.   secondsLoc := GetShaderLocation(shader, 'seconds');
56.   freqXLoc := GetShaderLocation(shader, 'freqX');
57.   freqYLoc := GetShaderLocation(shader, 'freqY');
58.   ampXLoc := GetShaderLocation(shader, 'ampX');
59.   ampYLoc := GetShaderLocation(shader, 'ampY');
60.   speedXLoc := GetShaderLocation(shader, 'speedX');
61.   speedYLoc := GetShaderLocation(shader, 'speedY');
62.  
63.   // Shader uniform values that can be updated at any time
64.   freqX := 25.0;  freqY := 25.0;  ampX := 5.0;  ampY := 5.0;  speedX := 8.0;  speedY := 8.0;
65.   ScreenSize[0] := GetScreenWidth();  ScreenSize[1] := GetScreenHeight();
66.   SetShaderValue(shader, GetShaderLocation(shader, 'size'), @screenSize, SHADER_UNIFORM_VEC2);
67.   SetShaderValue(shader, freqXLoc, @freqX, SHADER_UNIFORM_FLOAT);
68.   SetShaderValue(shader, freqYLoc, @freqY, SHADER_UNIFORM_FLOAT);
69.   SetShaderValue(shader, ampXLoc, @ampX, SHADER_UNIFORM_FLOAT);
70.   SetShaderValue(shader, ampYLoc, @ampY, SHADER_UNIFORM_FLOAT);
71.   SetShaderValue(shader, speedXLoc, @speedX, SHADER_UNIFORM_FLOAT);
72.   SetShaderValue(shader, speedYLoc, @speedY, SHADER_UNIFORM_FLOAT);
73.   Seconds := 0.0;
74.   SetTargetFPS(60); // Set our game to run at 60 frames-per-second
75. end;
76.  
77. procedure TRayApplication.DoRun;
78. var i,j,n: integer; cp: integer;
79. begin
80.   while (not WindowShouldClose) do // Detect window close button or ESC key
81.   begin
82.    // update
83.    seconds += GetFrameTime();
84.    SetShaderValue(shader, secondsLoc, @seconds, SHADER_UNIFORM_FLOAT);
85.    if alpha <> 255 then Inc(Alpha);
86.    // draw
87.     BeginDrawing();
88.     ClearBackground(WHITE);
89.     BeginShaderMode(Shader);
90.       DrawTexture(Texture, 0, 0, WHITE);
91.       DrawTexture(Texture, Texture.Width, 0, WHITE);
92.     EndShaderMode();
93.     for i:=0 to 26 do
94.     for j:=0 to 9 do
95.      begin
96.        angle := angle + 0.0004;
97.        // left to right movement
98.        xPos := (xStart + 2) + 10 * Sin(angle - j * 0.005);
99.        // up and down movement
100.        yPos := (yStart + i * 15) + 4 * Cos(angle - j * 0.004 - i) * 2;
101.        DrawTextCodepoint(MyFont,Integer(message[j][i]), Vector2Create(i * 24 + xPos,  (j*32 + yPos - i *15 ) + 3), 30, ColorCreate(0,0,0,Alpha));
102.  
103.        case j mod 7 of
104.        0: LineColor := ColorCreate(0,158,47, alpha) ;
105.        1: LineColor := ColorCreate(255,109,194,Alpha);
106.        2: LineColor := ColorCreate(0,121,241,Alpha);
107.        3: LineColor := ColorCreate(253,249,0,Alpha);
108.        4: LineColor := ColorCreate(102,191,255,Alpha);
109.        5: LineColor := ColorCreate(255,161,0,Alpha);
110.        6: LineColor := ColorCreate(230,41,55,Alpha);
111.        end;
112.        DrawTextCodepoint(MyFont,Integer(message[j][i]), Vector2Create(i * 24 + xPos,  (j*32 + yPos - i *15 )), 30, LineColor);
113.      end;
114.  
115.     for  i := 0 to  Length(line_message[0])-1 do
116.     begin
117.      line_angle := line_angle + 0.0007;
118.      if LinexPos < -Length(line_message[0]) * 32  then LinexPos := 800;
119.      LinexPos := LineXPos - 0.01;
120.      LineyPos := (LineyStart + i * 15) + 10 * Cos(line_angle - 0 * 0.004 - i) * 2;
121.      DrawTextCodepoint(MyFont,Integer(line_message[0][i]), Vector2Create(i * 24 + LinexPos,  (0*32 + LineYPos - i *15 ) + 3), 50, Black);
122.      case i mod 7 of
123.      0: LineColor := LIME;   1: LineColor := PINK;
124.      2: LineColor := BLUE;   3: LineColor := YELLOW;
125.      4: LineColor := SKYBLUE; 5: LineColor := ORANGE; 6: LineColor := RED;
126.      end;
127.      DrawTextCodepoint(MyFont,Integer(line_message[0][i]), Vector2Create(i * 24 + LinexPos,  (0*32 + LineYPos - i *15 ) ), 50, LineColor);
128.     end;
129.     EndDrawing();
130.   end;
131.   Terminate;
132. end;
133.  
134. destructor TRayApplication.Destroy;
135. begin
136.   CloseWindow(); // Close window and OpenGL context
137.   inherited Destroy;
138. end;
139.  
140. var
141.   Application: TRayApplication;
142. begin
143.   Application:=TRayApplication.Create(nil);
144.   Application.Title:=AppTitle;
145.   Application.Run;
146.   Application.Free;
147. end.
148.  
149.  

[Gigatron]

Nice work @Guva, i don't know Raylib but the demo is amazing amiga style

And of course, I got curious and looked at Raylib; A little knowledge of glsl fragment shaders; Tested a shader like the space harrier ground plus the tshr music

Thanks @Guva

So what is the result ?

https://www.youtube.com/watch?v=_kvWH1NNN_8

[Guva]

So what is the result ?

Oh, it looks really cool!!!

This video needs to be added in #madewithinraylib on discord channel

https://discord.gg/raylib