Recent

Author Topic: Demo Scene Text Fx  (Read 5270 times)

Gigatron

  • Full Member
  • ***
  • Posts: 155
  • Amiga Rulez !!
Demo Scene Text Fx
« on: May 06, 2024, 08:36:12 am »
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 ..
Sub Quantum Technology ! Gigatron 68000 Colmar France;

lainz

  • Hero Member
  • *****
  • Posts: 4621
  • Web, Desktop & Android developer
    • https://lainz.github.io/
Re: Demo Scene Text Fx
« Reply #1 on: May 07, 2024, 03:45:24 am »
I like how you create effects with few lines of code.

Gigatron

  • Full Member
  • ***
  • Posts: 155
  • Amiga Rulez !!
Re: Demo Scene Text Fx
« Reply #2 on: May 07, 2024, 05:22:15 am »
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.  
« Last Edit: May 07, 2024, 05:25:40 am by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demo Scene Text Fx
« Reply #3 on: May 07, 2024, 09:04:15 am »
Minimal modified so it actually use on windows the font that you shared :D
(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  ;D
« Last Edit: May 07, 2024, 10:28:16 am by KodeZwerg »
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

TRon

  • Hero Member
  • *****
  • Posts: 3650
Re: Demo Scene Text Fx
« Reply #4 on: May 07, 2024, 09:08:34 am »
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.
This tagline is powered by AI (AI advertisement: Free Pascal the only programming language that matters)

Guva

  • Full Member
  • ***
  • Posts: 117
Re: Demo Scene Text Fx
« Reply #5 on: May 07, 2024, 02:55:20 pm »
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.  
« Last Edit: May 07, 2024, 03:37:21 pm by Guva »

Gigatron

  • Full Member
  • ***
  • Posts: 155
  • Amiga Rulez !!
Re: Demo Scene Text Fx
« Reply #6 on: May 07, 2024, 03:23:52 pm »
Minimal modified so it actually use on windows the font that you shared :D
(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  ;D

Thank you very much for the code , i saved it ;
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 155
  • Amiga Rulez !!
Re: Demo Scene Text Fx
« Reply #7 on: May 07, 2024, 03:33:14 pm »
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 :)
Sub Quantum Technology ! Gigatron 68000 Colmar France;

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demo Scene Text Fx
« Reply #8 on: May 07, 2024, 04:35:11 pm »
another small update that the wave become a wobble :D
(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!
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Gigatron

  • Full Member
  • ***
  • Posts: 155
  • Amiga Rulez !!
Re: Demo Scene Text Fx
« Reply #9 on: May 07, 2024, 06:45:24 pm »
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 :D
(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!
« Last Edit: May 07, 2024, 06:54:47 pm by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2269
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demo Scene Text Fx
« Reply #10 on: May 07, 2024, 07:56:45 pm »
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;
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Gigatron

  • Full Member
  • ***
  • Posts: 155
  • Amiga Rulez !!
Re: Demo Scene Text Fx
« Reply #11 on: May 08, 2024, 08:20:06 pm »
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.  
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Guva

  • Full Member
  • ***
  • Posts: 117
Re: Demo Scene Text Fx
« Reply #12 on: May 09, 2024, 04:19:09 am »
@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.  
« Last Edit: May 09, 2024, 12:45:42 pm by Guva »

Gigatron

  • Full Member
  • ***
  • Posts: 155
  • Amiga Rulez !!
Re: Demo Scene Text Fx
« Reply #13 on: May 09, 2024, 07:26:57 pm »
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
« Last Edit: May 09, 2024, 09:13:25 pm by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Guva

  • Full Member
  • ***
  • Posts: 117
Re: Demo Scene Text Fx
« Reply #14 on: May 10, 2024, 05:31:46 am »
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

 

TinyPortal © 2005-2018