Recent

Author Topic: Demo Scene Typewriter  (Read 1841 times)

Gigatron

  • Jr. Member
  • **
  • Posts: 78
  • Amiga Rulez !!
Demo Scene Typewriter
« on: June 06, 2024, 06:55:03 pm »
Hi,
I would like to share a nice fx with you called typewriter;
Type writer is used on some Amiga Atari  intros and demo;

The source code is really simple , like always i used BGRA component  the best is !!

Result in YT :

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


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, BGRAGradientScanner;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Timer1: TTimer;
  18.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure Timer1Timer(Sender: TObject);
  21.   private
  22.  
  23.   public
  24.  
  25.   end;
  26.  
  27. var
  28.   Form1: TForm1;
  29.   message_bitmap,cursor_bitmap : TBGRABitmap;
  30.   message : Array[0..14] Of String =('                          ',
  31.                                      '     TYPE WRITER DEMO     ',
  32.                                      '                          ',
  33.                                      '    WRITTEN BY GIGATRON   ',
  34.                                      '   SFX BY THE GREAT XTD   ',
  35.                                      '    LAZARUS FREE PASCAL   ',
  36.                                      '         COMPILER         ',
  37.                                      '                          ',
  38.                                      ' CODING IS THE PASSION OF ',
  39.                                      '         CORTEX           ',
  40.                                      '--------------------------',
  41.                                      '     SEE YOU ON NEXT      ',
  42.                                      '       PRODUCTION         ',
  43.                                      '                          ',
  44.                                      '                          '); // 2 last lines is waiting lines !!!
  45.  mess_id,mess_chr,mess_timer,char_pos : integer;
  46.  i,j : integer;
  47.  
  48. implementation
  49.  
  50. {$R *.lfm}
  51.  
  52. { TForm1 }
  53.  
  54. procedure TForm1.FormCreate(Sender: TObject);
  55. begin
  56.     message_bitmap := TBGRABitmap.Create(640,480);
  57.     cursor_bitmap  := TBGRABitmap.Create('cursor.png');
  58.     /// Message init
  59.      mess_timer :=0;
  60.      mess_chr := 0; // message Char
  61.      mess_id :=0;  // message line index
  62.      char_pos :=0;
  63.      i:=0;
  64. end;
  65.  
  66. procedure TForm1.Timer1Timer(Sender: TObject);
  67. begin
  68.   BGRAVirtualScreen1.RedrawBitmap;
  69. end;
  70.  
  71. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  72. var
  73.   grad: TBGRAGradientScanner;
  74.  
  75. begin
  76.  
  77.     // font to display message !
  78.       message_Bitmap.FontName:='AmigaUnitA'; // use your installed font name eg: 'Arial' or else ;
  79.       message_Bitmap.FontHeight:=44;
  80.       grad := TBGRAGradientScanner.Create(BGRA(255,255,255),BGRA(0,120,255),  gtLinear,PointF(0,0),PointF(0,15),True,True);
  81.  
  82.      // Message to display
  83.      inc(mess_timer);
  84.      if (mess_timer >= 2) then // wait timer
  85.       begin
  86.        message_Bitmap.TextOut(mess_chr*22,char_pos*28,message[mess_id][mess_chr],grad);
  87.        mess_timer :=0;
  88.        mess_chr := mess_chr + 1;
  89.  
  90.        if mess_chr>=27 then     // if reach last char
  91.         begin
  92.          mess_chr :=0;
  93.          mess_id := mess_id +1 ;
  94.          char_pos := char_pos +1; // increment ychar pos * 26
  95.          if mess_id >=14 then
  96.           begin
  97.              mess_id  := 14; //bloque sur la ligne 14 !
  98.              mess_chr := 27; //
  99.              i:= i + 1;
  100.              message_Bitmap.FillRect(0,0,640,i,BGRA(35,35,35),dmSet); // fill rectangle fx !
  101.             if (i>=480) then // wait i for reset variables !
  102.               begin
  103.                  char_pos := 0;
  104.                  mess_id := 0;
  105.                  mess_chr :=0;
  106.                  i:=0;
  107.                end;
  108.  
  109.             end;
  110.           end;
  111.         end;
  112.  
  113.      Bitmap.StretchPutImage(Rect(0,0,640,480),message_bitmap,dmSet);
  114.  
  115. end;
  116.  
  117. end.
  118.  
Sub Quantum Technology ! We are in a micro universe.

domasz

  • Sr. Member
  • ****
  • Posts: 473
Re: Demo Scene Typewriter
« Reply #1 on: June 06, 2024, 07:31:37 pm »
Now you just need to port it to Turbo Rascal and will work on real retro machines, like C-64
https://lemonspawn.com/turbo-rascal-syntax-error-expected-but-begin/

Gigatron

  • Jr. Member
  • **
  • Posts: 78
  • Amiga Rulez !!
Re: Demo Scene Typewriter
« Reply #2 on: June 07, 2024, 06:19:14 pm »
Ok,
This is an improved version with 2 messages pages ; You can add now more messages Pages !

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, BGRAGradientScanner;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Timer1: TTimer;
  18.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure Timer1Timer(Sender: TObject);
  21.   private
  22.  
  23.   public
  24.  
  25.   end;
  26.  
  27. var
  28.   Form1: TForm1;
  29.   message_bitmap,cursor_bitmap : TBGRABitmap;
  30.  
  31.   message0 : Array[0..15] Of String =('                          ',
  32.                                      '     TYPE WRITER DEMO     ',
  33.                                      '                          ',
  34.                                      '    WRITTEN BY GIGATRON   ',
  35.                                      '   SFX BY THE GREAT XTD   ',
  36.                                      '    LAZARUS FREE PASCAL   ',
  37.                                      '         COMPILER         ',
  38.                                      '                          ',
  39.                                      ' CODING IS THE PASSION OF ',
  40.                                      '         CORTEX           ',
  41.                                      '--------------------------',
  42.                                      '     SEE YOU ON NEXT      ',
  43.                                      '       PRODUCTION         ',
  44.                                      '--------------------------',
  45.                                      '                          ',
  46.                                      '                          ');
  47.  
  48.   message1 :Array[0..15] Of String =('***************************',
  49.                                      '*    GREETINGS LIST !!    *',
  50.                                      '*                         *',
  51.                                      '*CIRCULAR  LAINZ  TRON    *',
  52.                                      '*JOSH  KODEZWERG   HUKKA  *',
  53.                                      '*   GUVACODE   RAYSAN5    *',
  54.                                      '*MATTIAS MARCOV MARTIN-FR *',
  55.                                      '*PASCALDRAGON BLACK STAR  *',
  56.                                      '*MIPS PURPLE-LANTERN  XTD *',
  57.                                      '*CUBIC-CIRCLE  P.M.A  DDC *',
  58.                                      '*AXE-X TRONIC-DESIGN      *',
  59.                                      '*CRYSTAL-DUST SUB-SERO    *',
  60.                                      '*ANNY SUB-QUANTUM NEW-BCX *',
  61.                                      '*  AND THE REST WE FORGOT *',
  62.                                      '***************************',
  63.                                      '                            ');
  64.  
  65.  
  66. //CIRCULAR  -  LAINZ  -  TRON   -  JOSH  -  KODEZWERG  -  HUKKA  -  GUVACODE  -  RAYSAN5  -  MATTIAS  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON
  67.  
  68.  mess_line,mess_chr,mess_timer,mess_num,char_pos : integer;
  69.  i,j : integer;
  70.  
  71. implementation
  72.  
  73. {$R *.lfm}
  74.  
  75. { TForm1 }
  76.  
  77. procedure TForm1.FormCreate(Sender: TObject);
  78. begin
  79.     message_bitmap := TBGRABitmap.Create(640,480);
  80.     cursor_bitmap  := TBGRABitmap.Create('cursor.png');
  81.  
  82.     /// Message init
  83.      mess_timer :=0;
  84.      mess_chr  := 0; // message Char
  85.      mess_line := 0; // message line index
  86.      char_pos  := 0; // char pos in message line
  87.      mess_num  := 0; // first message is 0
  88.      i:= -200;  // start i with far from bottom to mask message text for wait a bit before clear text !!
  89. end;
  90.  
  91. procedure TForm1.Timer1Timer(Sender: TObject);
  92. begin
  93.   BGRAVirtualScreen1.RedrawBitmap;
  94. end;
  95.  
  96. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  97. var
  98.   grad: TBGRAGradientScanner;
  99.  
  100. begin
  101.  
  102.     // font to display message !
  103.       message_Bitmap.FontName:='AmigaUnitA9';
  104.       message_Bitmap.FontHeight:=44;
  105.       grad := TBGRAGradientScanner.Create(BGRA(255,255,255),BGRA(130,120,0),  gtLinear,PointF(0,0),PointF(0,15),True,True);
  106.  
  107.      // Message to display
  108.      inc(mess_timer);
  109.      if (mess_timer >= 2) then // wait timer
  110.       begin
  111.         // select message num 0 or 1
  112.         if (mess_num = 0) then message_Bitmap.TextOut(mess_chr*22,char_pos*28,message0[mess_line][mess_chr],grad);
  113.         if (mess_num = 1) then message_Bitmap.TextOut(mess_chr*22,char_pos*28,message1[mess_line][mess_chr],grad);
  114.  
  115.        mess_timer :=0;
  116.        mess_chr := mess_chr + 1;
  117.  
  118.        if mess_chr>=28 then     // if reach last char
  119.         begin
  120.          mess_chr :=0;
  121.          mess_line := mess_line +1 ;
  122.          char_pos := char_pos +1; // increment ychar pos * 26
  123.          if mess_line >=15 then
  124.           begin
  125.              mess_line := 15; // lock in line 15 !
  126.              mess_chr  := 28; // lock in last char !
  127.              i:= i + 2;
  128.              message_Bitmap.FillRect(0,0,640,i,BGRA(0,0,0),dmSet); // fill rectangle fx !
  129.             if (i>=480) then // wait i for reset variables !
  130.               begin
  131.                  char_pos  := 0;
  132.                  mess_line := 0;
  133.                  mess_chr  :=0;
  134.                  // change message
  135.                  mess_num := mess_num + 1;
  136.  
  137.                 if (mess_num>1) then mess_num :=0;
  138.                     i:=-200;
  139.                end;
  140.  
  141.             end;
  142.           end;
  143.         end;
  144.  
  145.      Bitmap.StretchPutImage(Rect(0,0,640,480),message_bitmap,dmSet);
  146.  
  147. end;
  148.  
  149. end.
  150.  
« Last Edit: June 07, 2024, 06:22:08 pm by Gigatron »
Sub Quantum Technology ! We are in a micro universe.

TRon

  • Hero Member
  • *****
  • Posts: 2801
Re: Demo Scene Typewriter
« Reply #3 on: June 07, 2024, 08:40:21 pm »
Based on the original version from your other thread Gigatron but shows how things could be improved. Do mind it is a quick mockup and a WiP (I lacked the time to continue on it)

Code: Pascal  [Select][+][-]
  1. // TTypeWriter quick mockup V2 still WiP
  2.  
  3. type
  4.  
  5.   TTextPages = array of array of string;
  6.  
  7.   { TTypeWriter }
  8.  
  9.   TTypeWriter = class
  10.    private
  11.     FMsgBitmap   : TBGRABitmap;
  12.     FRenderArea  : TRect;
  13.     FTextPages   : TTextPages;
  14.     FPageIndex   : integer;
  15.     FLineIndex   : integer;
  16.     FCharIndex   : integer;
  17.    public
  18.     constructor Create(aRenderArea: TRect; aTextPages: TTextPages);
  19.     destructor Destroy; override;
  20.     procedure Update(alpha: byte);
  21.     procedure RenderToBitmap(Bitmap: TBGRABitmap);
  22.   end;
  23.  
  24.  
  25. { TTypeWriter }
  26.  
  27. { TTypeWriter }
  28.  
  29. constructor TTypeWriter.Create(aRenderArea: TRect; aTextPages: TTextPages);
  30. begin
  31.   FRenderArea := aRenderArea;
  32.   FTextPages := aTextPages;
  33.   FMsgBitmap := TBGRABitmap.Create(aRenderArea.Width, aRenderArea.Height);
  34.  
  35.   // font used to display message !
  36.   FMsgBitmap.FontName:='AmigaDigital8';
  37.   FMsgBitmap.FontHeight:=36;
  38.  
  39.   // Message parameters
  40.   FPageIndex := 0;  // page index
  41.   FLineIndex := 0;  // line index of current page
  42.   FCharIndex := 0;  // (horizontal/column) character index of current line
  43. end;
  44.  
  45. destructor TTypeWriter.Destroy;
  46. begin
  47.   FMsgBitmap.Free;
  48.   inherited Destroy;
  49. end;
  50.  
  51. procedure TTypeWriter.Update(alpha: byte);
  52. type
  53.   TTypeWriterStatus = (twsTyping, twsViewPage, twsSwapDelay);
  54. const
  55.   LDT    : TDateTime = 0.0;
  56.   Status : TTypeWriterStatus = twsSwapDelay;
  57. var
  58.   grad   : TBGRAGradientScanner;
  59.   CDT    : TDateTime;
  60.   msb    : int64;
  61. begin
  62.   CDT := now;
  63.   msb := MilliSecondsBetween(CDT, LDT);
  64.  
  65.   // TODO:
  66.   // - gradient live updating
  67.   // - customized render area
  68.   // - additional parameters for customization (fontname, fontsize, gradient
  69.   //   colours etc)
  70.  
  71.   // process delay based on Status
  72.   case Status of
  73.     twsTyping    : if msb > 25 then    // 25 miliseconds typing speed
  74.       begin
  75.         LDT := CDT
  76.       end else exit;
  77.     twsViewPage  : if msb > 5000 then  // 5 seconds delay to view text
  78.       begin
  79.         LDT := CDT;
  80.         Status := twsSwapDelay;
  81.         // clear
  82.         FMsgBitmap.FillRect(0,0,640,480,BGRA(255,192,0,0),dmSet);
  83.         exit;
  84.       end else exit;
  85.     twsSwapDelay : if msb > 2000 then  // 2 second delay for empty view
  86.       begin
  87.         LDT := CDT;
  88.         Status := twsTyping;
  89.         exit;
  90.       end else exit;
  91.   end;
  92.  
  93.   Grad := TBGRAGradientScanner.Create
  94.   (
  95.     BGRA(255,255,255),
  96.     BGRA(0,0,200+alpha),
  97.     gtLinear,
  98.     PointF(0,0),
  99.     PointF(0,35),
  100.     True,
  101.     True
  102.   );
  103.  
  104.   // Message display
  105.   begin
  106.     FMsgBitmap.TextOut(FCharIndex*20,FLineIndex*22, FTextPages[FPageIndex][FLineIndex][succ(FCharIndex)], grad);
  107.  
  108.     // Next character (index)
  109.     inc(FCharIndex);
  110.  
  111.     // when no more chars left in line
  112.     if FCharIndex>=length(FTextPages[FPageIndex][FLineIndex]) then
  113.     begin
  114.       // next line index
  115.       inc(FLineIndex);
  116.       // reset character index
  117.       FCharIndex :=0;
  118.  
  119.       // when exceeding the number of lines of the current page
  120.       if FLineIndex >= Length(FTextPages[FPageIndex]) then
  121.       begin
  122.         // reset line index
  123.         FLineIndex := 0;
  124.  
  125.         // next page index
  126.         inc(FPageIndex);
  127.  
  128.         // if no pages left then reset to first page index
  129.         if FPageIndex >= Length(FTextPages)
  130.           then FPageIndex := 0;
  131.  
  132.         // switch status to view current typed text
  133.         Status := twsViewPage;
  134.       end;
  135.     end;
  136.   end; // message display
  137.  
  138.   grad.free;
  139. end;
  140.  
  141. procedure TTypeWriter.RenderToBitmap(Bitmap: TBGRABitmap);
  142. begin
  143.   Bitmap.StretchPutImage
  144.   (
  145.     Rect(20,90,740,90+520),
  146.     FMsgBitmap,
  147.     dmDrawWithTransparency
  148.   );
  149. end;
  150.  
  151.  
  152. ///////////////////////////////////////////////////////////////////////////////
  153. // usage:
  154. ///////////////////////////////////////////////////////////////////////////////
  155.  
  156. var
  157.   TextPages : TTextPages =
  158.   (
  159.     (
  160.       '     CODE : GIGATRON      ',
  161.       '                          ',
  162.       '  FONT : THE LIGHTFORCE   ',
  163.       '                          ',
  164.       'SFX: JOURNEY TROUGH GALAXY',
  165.       '         MARK II          ',
  166.       '                          ',
  167.       '  DESIGN : TRONIC-SYSTEM  ',
  168.       '                          ',
  169.       '     CONTACT GIGATRON     ',
  170.       '     BP : 3300 68000      ',
  171.       '      COLMAR FRANCE       '
  172.     ),
  173.     (
  174.       ' TECH INFOS :',
  175.       ' 320 LINES OF PASCAL CODE',
  176.       ' BGRA COMPONENT',
  177.       ' 68000 LIKE TEXT FX CODE',
  178.       ' 2 DAYS OF WORK',
  179.       ' FULL 60 FPS',
  180.       ' AMD 8 CORES CPU',
  181.       ' 64 GIGABYTE OF RAM',
  182.       ' FREE PASACAL LAZARUS 3.2',
  183.       ' FPC 3.2.2',
  184.       ' THX TO THE TEAM LAZARUS',
  185.       '       ----------         '
  186.     ),
  187.     (
  188.       'TYPEWRITER RTN MODIFIED',
  189.       'AND SIMPLIFIED TO SUPPORT',
  190.       'MULTIPLE',
  191.       'PAGES + A VARIABLE AMOUNT',
  192.       'OF LINES AND SUPPORT FOR'
  193.       'VARIABLE LINE LENGTH''S',
  194.       '         BY TRON       '
  195.     )
  196.   );
  197.  
  198. procedure TForm1.FormCreate(Sender: TObject);
  199. begin
  200.   TypeWriter := TTypeWriter.Create(bounds(0,0,640,480), TextPages);
  201. end;
  202.  
  203. procedure TForm1.FormDestroy(Sender: TObject);
  204. begin
  205.   TypeWriter.Free;
  206. end;
  207.  
  208. procedure TForm1.Timer1Timer(Sender: TObject);
  209. begin
  210.   TypeWriter.Update(alpha);
  211.  
  212.   VScreen.RedrawBitmap;
  213. end;
  214.  
  215. procedure TForm1.VScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
  216. begin
  217.   TypeWriter.RenderToBitmap(Bitmap);
  218. end;
  219.  
  220.  

Have Fun !  :)

edit: updated source-code to V2 with more cleanups, better/more comments and showcase of the new features (actually the hard-coded parts are replaced)
« Last Edit: June 07, 2024, 11:27:47 pm by TRon »

Gigatron

  • Jr. Member
  • **
  • Posts: 78
  • Amiga Rulez !!
Re: Demo Scene Typewriter
« Reply #4 on: June 07, 2024, 09:51:40 pm »
@Tron, you are a very good coder!!!
Thank you very much for the code, I would like to share the latest code with the cursor, you understood, if my code execution is
fast, I don't optimize it :). I'm trying to code as simply as possible... I hope so;

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, BGRASpriteAnimation, BGRABitmap, BGRABitmapTypes,
  10.   BGRAGradientScanner;
  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.   public
  25.  
  26.   end;
  27.  
  28. var
  29.   Form1: TForm1;
  30.   message_bitmap,cursor_bitmap : TBGRABitmap;
  31.  
  32.   message0 : Array[0..15] Of String =('                          ',
  33.                                      '     TYPE WRITER DEMO     ',
  34.                                      '                          ',
  35.                                      '    WRITTEN BY GIGATRON   ',
  36.                                      '   SFX BY THE GREAT XTD   ',
  37.                                      '    LAZARUS FREE PASCAL   ',
  38.                                      '         COMPILER         ',
  39.                                      '                          ',
  40.                                      ' CODING IS THE PASSION OF ',
  41.                                      '         CORTEX           ',
  42.                                      '--------------------------',
  43.                                      '     SEE YOU ON NEXT      ',
  44.                                      '       PRODUCTION         ',
  45.                                      '--------------------------',
  46.                                      '                          ',
  47.                                      '                          ');
  48.  
  49.   message1 :Array[0..15] Of String =('***************************',
  50.                                      '*    GREETINGS LIST !!    *',
  51.                                      '*                         *',
  52.                                      '*CIRCULAR  LAINZ  TRON    *',
  53.                                      '*JOSH  KODEZWERG   HUKKA  *',
  54.                                      '*   GUVACODE   RAYSAN5    *',
  55.                                      '*MATTIAS MARCOV MARTIN-FR *',
  56.                                      '*PASCALDRAGON BLACK STAR  *',
  57.                                      '*MIPS PURPLE-LANTERN  XTD *',
  58.                                      '*CUBIC-CIRCLE  P.M.A  DDC *',
  59.                                      '*AXE-X TRONIC-DESIGN      *',
  60.                                      '*CRYSTAL-DUST SUB-SERO    *',
  61.                                      '*ANNY SUB-QUANTUM NEW-BCX *',
  62.                                      '*  AND THE REST WE FORGOT *',
  63.                                      '***************************',
  64.                                      '                            ');
  65.  
  66.  
  67. //CIRCULAR  -  LAINZ  -  TRON   -  JOSH  -  KODEZWERG  -  HUKKA  -  GUVACODE  -  RAYSAN5  -  MATTIAS  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON
  68.  
  69.  mess_line,mess_chr,mess_timer,mess_num,char_ypos : integer;
  70.  i,j,sn : integer;
  71.  
  72.  
  73. implementation
  74.  
  75. {$R *.lfm}
  76.  
  77. { TForm1 }
  78.  
  79. procedure TForm1.FormCreate(Sender: TObject);
  80. begin
  81.     message_bitmap := TBGRABitmap.Create(640,480);
  82.     cursor_bitmap  := TBGRABitmap.Create('cursor.png');
  83.  
  84.     /// Message init
  85.      mess_timer :=0;
  86.      mess_chr  := 0; // message Char
  87.      mess_line := 0; // message line index
  88.      char_ypos  := 0; // char pos in message line
  89.      mess_num  := 0; // first message is 0
  90.      i:= -200;  // start i with far from bottom to mask message text for wait a bit before clear text !!
  91.      j:= 0;
  92. end;
  93.  
  94. procedure TForm1.Timer1Timer(Sender: TObject);
  95. begin
  96.      BGRAVirtualScreen1.RedrawBitmap;
  97. end;
  98.  
  99. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  100. var
  101.   grad: TBGRAGradientScanner;
  102. begin
  103.  
  104.     // font to display message !
  105.       message_Bitmap.FontName:='AmigaUnitA';
  106.       message_Bitmap.FontHeight:=44;
  107.       grad := TBGRAGradientScanner.Create(BGRA(255,255,255),BGRA(250,60,100),  gtReflected,PointF(0,0),PointF(0,15),True,True);
  108.  
  109.  
  110.      // Message to display
  111.      inc(mess_timer);
  112.      if (mess_timer >= 2) then // wait timer
  113.       begin
  114.         // select message num 0 or 1
  115.         if (mess_num = 0) then message_Bitmap.TextOut(mess_chr*22,char_ypos*28,message0[mess_line][mess_chr],grad);
  116.         if (mess_num = 1) then message_Bitmap.TextOut(mess_chr*22,char_ypos*28,message1[mess_line][mess_chr],grad);
  117.  
  118.        mess_timer :=0;
  119.        mess_chr := mess_chr + 1;
  120.  
  121.        if mess_chr>=28 then     // if reach last char
  122.         begin
  123.          mess_chr :=0;
  124.          mess_line := mess_line +1 ;
  125.          char_ypos := char_ypos +1; // increment ychar pos * 26
  126.          if mess_line >=15 then
  127.           begin
  128.              mess_line := 15; // lock in line 15 !
  129.              mess_chr  := 28; // lock in last char !
  130.              char_ypos := 14; // lock char ypos for cursor position
  131.              i:= i + 2;
  132.  
  133.              message_Bitmap.FillRect(0,0,640,i,BGRA(0,0,0),dmSet); // fill rectangle fx !
  134.             if (i>=480) then // wait i for reset variables !
  135.               begin
  136.                  char_ypos  := 0;
  137.                  mess_line := 0;
  138.                  mess_chr  :=0;
  139.                  // change message
  140.                  mess_num := mess_num + 1;
  141.  
  142.                 if (mess_num>1) then mess_num :=0;
  143.                     i:=-200;
  144.                end;
  145.  
  146.             end;
  147.           end;
  148.         end;
  149.     // copy message bitmap to main screen ;
  150.     Bitmap.StretchPutImage(Rect(0,0,640,480),message_bitmap,dmSet);
  151.  
  152.     // cursor
  153.     Bitmap.PutImagePart(mess_chr*22,char_ypos*28+4,cursor_bitmap,rect(j*32,0,j*32+32,32),dmSet);
  154.      j:= j + 1;
  155.      if (j>7) then j:=0;
  156.  
  157. end;
  158.  
  159. end.
  160.  
Sub Quantum Technology ! We are in a micro universe.

TRon

  • Hero Member
  • *****
  • Posts: 2801
Re: Demo Scene Typewriter
« Reply #5 on: June 10, 2024, 06:45:33 am »
@Tron, you are a very good coder!!!
Thank you for the compliment though I consider myself more of a mediocre programmer... sometimes a bit better often a lot worse  :)

I am more impressed by your all-encompassing formula's.. I know it is just math but still...

V3 of the TTextwriter class for BGRABitmap:
- animated gradient colours
- more use of constants and variables (more descriptive)
- better documented
- cursor added as an afterthought (your code had it so therefor my code must have it too  :)  ). The cursor details really should be properly separated from the rest of the code.
- more stuff I did that I forgot

Code: Pascal  [Select][+][-]
  1. // TTypeWriter quick mockup V3 still WiP
  2. // cursor added as an after thought
  3.  
  4. interface
  5.  
  6. type
  7.   { TTypeWriter V3}
  8.  
  9.   // TODO: a lot :-)
  10.  
  11.   TTextPages = array of array of string;
  12.  
  13.   TTypeWriter = class
  14.    private
  15.     FMsgBitmap      : TBGRABitmap;
  16.     FRenderSize     : TSize;
  17.     FTextPages      : TTextPages;
  18.     FPageIndex      : integer;
  19.     FLineIndex      : integer;
  20.     FCharIndex      : integer;
  21.     FGradient       : TBGRAGradientScanner;
  22.     FGradientCount  : integer;
  23.     FAnimateColours : boolean;
  24.    protected
  25.     procedure UpdateGradientColoursAnim;
  26.     procedure UpdateText;
  27.    public
  28.     constructor Create(aSize: TSize; aTextPages: TTextPages);
  29.     destructor Destroy; override;
  30.     procedure Update;
  31.     property  Bitmap: TBGRABitmap read FMsgBitmap;
  32.   end;
  33.  
  34.  
  35. implementation
  36.  
  37. { TTypeWriter }
  38.  
  39. constructor TTypeWriter.Create(aSize: TSize; aTextPages: TTextPages);
  40. begin
  41.   FRenderSize := aSize;
  42.   FTextPages  := aTextPages;
  43.   FMsgBitmap  := TBGRABitmap.Create(FRenderSize.Width, FRenderSize.Height);
  44.  
  45.   // font used to display message !
  46.   FMsgBitmap.FontName:='AmigaDigital8';
  47.   FMsgBitmap.FontHeight:=36;
  48.  
  49.   // Message parameters
  50.   FPageIndex     := 0;  // page index
  51.   FLineIndex     := 0;  // line index of current page
  52.   FCharIndex     := 0;  // (horizontal/column) character index of current line
  53.   FGradientCount := 16; // amount of colourpoints in gradient (is it possible to retrieve that from the gradient itself ?)
  54.  
  55.   FGradient := TBGRAGradientScanner.Create
  56.   (
  57.     BGRA(255,255,255), BGRA(250,60,100),
  58.     gtReflected,
  59.     PointF(0,0)      , PointF(0,FGradientCount-1),
  60.     True,True
  61.   );
  62.  
  63.   FAnimateColours := true;
  64. end;
  65.  
  66. destructor TTypeWriter.Destroy;
  67. begin
  68.   FGradient.Free;
  69.   FMsgBitmap.Free;
  70.   inherited Destroy;
  71. end;
  72.  
  73. procedure TTypeWriter.UpdateText;
  74. type
  75.   TTypeWriterStatus = (twsTyping, twsViewPage, twsClearPage, twsEmptyPage);
  76. const
  77.   TypingDelay      = 25;   // typing delay in milliseconds
  78.   ViewPageTime     = 2000; // Time in milliseconds to view text page
  79.   ClearUpdateDelay = 50;   // update clear delay in milliseonds
  80.   EmptyPageTime    = 1000; // Time in milliseconds to view empty page
  81.   ClearDistance    = 2;    // how many lines to clear for each iteration
  82.  
  83.   Status     : TTypeWriterStatus = twsEmptyPage;
  84.   LDT        : TDateTime         = 0.0;
  85.   ClearIndex : integer           = 0;
  86. var
  87.   CDT    : TDateTime;
  88.   msb    : int64;
  89.   ch     : Char;
  90.   doType : boolean = false;
  91. begin
  92.   CDT := now;
  93.   msb := MilliSecondsBetween(CDT, LDT);
  94.  
  95.   // process delay based on Status
  96.   case Status of
  97.     twsTyping    : if msb > TypingDelay then
  98.       begin
  99.         LDT := CDT;     // update Last DateTime
  100.         doType := true;
  101.       end else exit;
  102.     twsViewPage  : if msb > ViewPageTime then
  103.       begin
  104.         LDT := CDT;     // update Last DateTime
  105.         Status := twsClearPage;
  106.         exit;
  107.       end else exit;
  108.     twsClearPage : if msb > ClearUpdateDelay then
  109.       begin
  110.         LDT := CDT;     // update Last DateTime
  111.         if ClearIndex < FMsgBitmap.Height then
  112.         begin
  113.           FMsgBitmap.FillRect(Bounds(0,ClearIndex, FMsgBitmap.Width, ClearDistance),BGRA(0,0,0,0),dmSet); // fill rectangle fx !
  114.           ClearIndex += ClearDistance;
  115.         end
  116.         else
  117.         begin
  118.           status := twsEmptyPage;
  119.           ClearIndex := 0;
  120.         end;
  121.         exit;
  122.       end else exit;
  123.     twsEmptyPage : if msb > EmptyPageTime then
  124.       begin
  125.         LDT := CDT;    // update Last DateTime
  126.         Status := twsTyping;
  127.  
  128.         if (FPageIndex = 0) and (FLineIndex = 0) and (FCharIndex = 0)
  129.           then FAnimateColours := not(FAnimateColours);
  130.  
  131.         exit;
  132.       end else exit;
  133.   end;
  134.  
  135.   // when display next character requested
  136.   if doType then
  137.   begin
  138.     doType := false;
  139.  
  140.     // if there is any character left in the current line of the current page to be printed
  141.     if FCharIndex < Length(FTextPages[FPageIndex][FLineIndex]) then
  142.     begin
  143.       // display only upcase characters
  144.       ch := Upcase(FTextPages[FPageIndex][FLineIndex][succ(FCharIndex)]);
  145.       FMsgBitmap.TextOut(FCharIndex*22,FLineIndex*28, ch, FGradient);
  146.  
  147.       // next character (index)
  148.       inc(FCharIndex);
  149.     end
  150.     else // when no more characters left in line
  151.     begin
  152.       // next line index
  153.       inc(FLineIndex);
  154.  
  155.       // reset character index
  156.       FCharIndex :=0;
  157.  
  158.       // when exceeding the number of lines of the current page
  159.       if FLineIndex >= Length(FTextPages[FPageIndex]) then
  160.       begin
  161.         // reset line index
  162.         FLineIndex := 0;
  163.  
  164.         // next page index
  165.         inc(FPageIndex);
  166.  
  167.         // if no pages left then reset to first page index
  168.         if FPageIndex >= Length(FTextPages) then
  169.         begin
  170.           FPageIndex := 0;
  171.         end;
  172.  
  173.         // switch status to view current typed text
  174.         Status := twsViewPage;
  175.       end;
  176.     end;
  177.   end; // next character
  178.  
  179. end;
  180.  
  181. procedure TTypeWriter.UpdateGradientColoursAnim;
  182. const
  183.   gindex   : integer = 0; // gradient index to start with
  184.   gspeed             = 1; // gradient speed (added to gradient index)
  185. var
  186.   x,y     : integer;
  187.   p1      : PBGRAPixel;
  188.   p2      : PDWord absolute p1;
  189.   goffset : integer = 0;
  190.   g       : integer;
  191. begin
  192.   for y := 0 to FMsgBitmap.Height-1 do
  193.   begin
  194.     g := (gindex + y) mod FGradientCount;
  195.     p1 := FMsgBitmap.Scanline[y];
  196.     for x := 0 to FMsgBitmap.Width-1 do //    for x := (FMsgBitmap.Width shr 1) to (FMsgBitmap.Width-1) do
  197.     begin
  198.       if p2[x] <> 0
  199.         then p1[x] := FGradient.ScanAt(0,g);
  200.     end;
  201.   end;
  202.   FMsgBitmap.InvalidateBitmap; // pixels changed by direct access so invalidate
  203.  
  204.   gindex := (gindex + gspeed) mod FGradientCount; // High(FRasterColours);
  205. end;
  206.  
  207. procedure TTypeWriter.Update;
  208. const
  209.   AnimColoursFrameDelay      = 1;
  210.   counter          : integer = AnimColoursFrameDelay;
  211.   cursorFrameindex : integer = 0;
  212.   cursorRect       : TRect   = (Left :0; Top: 0; Right: 0; Bottom: 0);
  213. var
  214.   cx,cy: integer;
  215. begin
  216.   // in order to prevent the colour animation from applying itself to the
  217.   // cursor the (previous) cursor needs to be removed first
  218.   FMsgBitmap.FillRect(cursorRect, BGRA($00,$00,$00, $00));
  219.  
  220.   UpdateText;
  221.   if FAnimateColours then
  222.   begin
  223.     dec(counter);
  224.     if counter <= 0 then
  225.     begin
  226.       counter := AnimColoursFrameDelay;
  227.       UpdateGradientColoursAnim;
  228.     end;
  229.   end;
  230.  
  231.   // update cursor
  232.   cursorFrameindex := (cursorFrameindex + 1) mod 7;
  233.   cx := (FCharIndex -1) * 22;
  234.   cy := (FLineIndex -1) * 28 + 8;  // + 8 correction (undertermined value)
  235.   cursorRect := Bounds
  236.   (
  237.     cx + 32 - cursorFrameindex*4 shr 1,
  238.     cy + 32 - cursorFrameindex*4 shr 1,
  239.     cursorFrameindex*4,
  240.     cursorFrameindex*4
  241.   );
  242.   FMsgBitmap.FillRect(cursorRect, BGRA($FF,$FF,$FF));
  243. end;
  244.  
  245.  
  246. ///////////////////////////////////////////////////////////////////////////////
  247. // usage:
  248. ///////////////////////////////////////////////////////////////////////////////
  249.  
  250. var
  251.   TextPages : TTextPages =
  252.   (
  253.     (
  254.     '                          ',
  255.     '     TYPE WRITER DEMO     ',
  256.     '                          ',
  257.     '    WRITTEN BY GIGATRON   ',
  258.     '   SFX BY THE GREAT XTD   ',
  259.     '    LAZARUS FREE PASCAL   ',
  260.     '         COMPILER         ',
  261.     '                          ',
  262.     ' CODING IS THE PASSION OF ',
  263.     '         CORTEX           ',
  264.     '--------------------------',
  265.     '     SEE YOU ON NEXT      ',
  266.     '       PRODUCTION         ',
  267.     '--------------------------',
  268.     '                          '
  269.     ),
  270.     (
  271.     '***************************',
  272.     '*    GREETINGS LIST !!    *',
  273.     '*                         *',
  274.     '*CIRCULAR  LAINZ  TRON    *',
  275.     '*JOSH  KODEZWERG   HUKKA  *',
  276.     '*   GUVACODE   RAYSAN5    *',
  277.     '*MATTIAS MARCOV MARTIN-FR *',
  278.     '*PASCALDRAGON BLACK STAR  *',
  279.     '*MIPS PURPLE-LANTERN  XTD *',
  280.     '*CUBIC-CIRCLE  P.M.A  DDC *',
  281.     '*AXE-X TRONIC-DESIGN      *',
  282.     '*CRYSTAL-DUST SUB-SERO    *',
  283.     '*ANNY SUB-QUANTUM NEW-BCX *',
  284.     '*  AND THE REST WE FORGOT *',
  285.     '***************************',
  286.     '                           ',
  287.     )
  288.   );
  289.  
  290.  
  291. procedure TForm1.FormCreate(Sender: TObject);
  292. begin
  293.   // VScreen = TBGRAVirtualScreen;
  294.   TypeWriter := TTypeWriter.Create(Size(VScreen.Width,VScreen.Height), TextPages);
  295. end;
  296.  
  297. procedure TForm1.FormDestroy(Sender: TObject);
  298. begin
  299.   TypeWriter.Free;
  300. end;
  301.  
  302. procedure TForm1.TimerTimer(Sender: TObject);
  303. begin
  304.   VScreen.RedrawBitmap;
  305. end;
  306.  
  307. procedure TForm1.VScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);
  308. begin
  309.   // Update FX
  310.   TypeWriter.Update;
  311.  
  312.   // Render FX
  313.   Bitmap.StretchPutImage(Bitmap.ClipRect, TypeWriter.Bitmap, dmSet);
  314. end;
  315.  

Have Fun !

Gigatron

  • Jr. Member
  • **
  • Posts: 78
  • Amiga Rulez !!
Re: Demo Scene Typewriter
« Reply #6 on: June 10, 2024, 06:34:53 pm »
Oh !! Great and many thanks ;

Just uploaded the result to YT : look very nice ;
 
https://www.youtube.com/watch?v=JNJT_5FkYDE

Thx again @Tron !!

And the final code included with your Work !

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,BGRAGradientScanner,DateUtils,BGRACanvas2D, mmsystem;
  10.  
  11. type
  12.  
  13.   TTextPages = array of array of string;
  14.   { TForm1 }
  15.  
  16.  
  17.   TForm1 = class(TForm)
  18.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  19.     Timer1: TTimer;
  20.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  21.     procedure FormCreate(Sender: TObject);
  22.     procedure Timer1Timer(Sender: TObject);
  23.   private
  24.     FMsgBitmap      : TBGRABitmap;
  25.     FTextPages      : TTextPages;
  26.     FPageIndex      : integer;
  27.     FLineIndex      : integer;
  28.     FCharIndex      : integer;
  29.     FGradient       : TBGRAGradientScanner;
  30.     FGradientCount  : integer;
  31.     FAnimateColours : boolean;
  32.  
  33.     protected
  34.     procedure  UpdateGradientColoursAnim;
  35.     procedure UpdateText;
  36.     procedure Update;
  37.     procedure drawStar(ctx: TBGRACanvas2D;cx, cy, spikes : integer; outerRadius, innerRadius, rotation : single;style : TBGRAPixel);
  38.  
  39.   public
  40.     MyAudio_File: AnsiString;
  41.     WavStream : TMemoryStream;
  42.   end;
  43.  
  44.  var
  45.   Form1: TForm1;
  46.   rt : single;
  47.   x_pos,y_pos : integer;
  48.  
  49.   var
  50.   pages : TTextPages =
  51.   (
  52.     (
  53.     '       TYPE WRITER DEMO     ',
  54.     '      WRITTEN BY GIGATRON   ',
  55.     '  IMPROVED BY THE GREAT TRON',
  56.     '                            ',
  57.     '    SFX BY DIRK / LENGEND   ',
  58.     '      LAZARUS FREE PASCAL   ',
  59.     '           COMPILER         ',
  60.     '                            ',
  61.     '   CODING IS THE PASSION OF ',
  62.     '           CORTEX           ',
  63.     '  --------------------------',
  64.     '       SEE YOU ON NEXT      ',
  65.     '         PRODUCTION         ',
  66.     '  --------------------------',
  67.     '                            '
  68.     ),
  69.     (
  70.     ' **************************',
  71.     ' *    GREETINGS LIST !!   *',
  72.     ' *                        *',
  73.     ' *CIRCULAR  LAINZ  TRON   *',
  74.     ' *JOSH  KODEZWERG   HUKKA *',
  75.     ' *   GUVACODE   RAYSAN5   *',
  76.     ' *MATTIAS MARCOV MARTIN-FR*',
  77.     ' *PASCALDRAGON BLACK STAR *',
  78.     ' *MIPS PURPLE-LANTERN DIRK*',
  79.     ' *CUBIC-CIRCLE  P.M.A  DDC*',
  80.     ' *AXE-X TRONIC-DESIGN     *',
  81.     ' *CRYSTAL-DUST SUB-SERO   *',
  82.     ' *ANNY SUB-QUANTUM NEW-BCX*',
  83.     ' *  AND THE REST WE FORGOT*',
  84.     ' **************************',
  85.     '                            '
  86.     )
  87.   );
  88.  
  89.  
  90. implementation
  91.  
  92. {$R *.lfm}
  93.  
  94. { TForm1 }
  95.  
  96.  
  97. procedure TForm1.FormCreate(Sender: TObject);
  98. begin
  99.  
  100.   FTextPages  := pages;
  101.   FMsgBitmap  := TBGRABitmap.Create(640, 480);
  102.  
  103.   // font used to display message !
  104.   FMsgBitmap.FontName:='AmigaDigital8';
  105.   FMsgBitmap.FontHeight:=36;
  106.  
  107.   // Message parameters
  108.   FPageIndex     := 0;  // page index
  109.   FLineIndex     := 0;  // line index of current page
  110.   FCharIndex     := 0;  // (horizontal/column) character index of current line
  111.   FGradientCount := 32; // amount of colourpoints in gradient (is it possible to retrieve that from the gradient itself ?)
  112.  
  113.   FGradient := TBGRAGradientScanner.Create
  114.   (
  115.     BGRA(255,255,255), BGRA(0,60,255),
  116.     gtReflected,
  117.     PointF(0,0)      , PointF(0,FGradientCount-1),
  118.     True,True
  119.   );
  120.  
  121.   FAnimateColours := true;
  122.  
  123.   rt := 0.0;
  124.   x_pos :=100;
  125.   y_pos :=20;
  126.  
  127.     // audio stream
  128.     MyAudio_File := 'wanderingmind.wav';
  129.     WavStream    := TMemoryStream.Create;
  130.     WavStream.LoadFromFile(MyAudio_File);
  131.     PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or SND_MEMORY);
  132.  
  133.  
  134. end;
  135.  
  136. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  137. var
  138.   ctx: TBGRACanvas2D;
  139. begin
  140.   ctx := Bitmap.Canvas2D;
  141.   //   les etoiles !
  142.   drawStar(ctx, x_pos+220,y_pos+225, 7, 110.0, 170.0, rt*1.0,BGRA(77,88,99));
  143.   drawStar(ctx, x_pos+200,y_pos+210, 7, 110.0, 170.0, rt*1.3,BGRA(44,55,66));
  144.   drawStar(ctx, x_pos+210,y_pos+220, 7, 110.0, 170.0, rt*1.6,BGRA(66,77,88));
  145.   Bitmap.StretchPutImage(Bitmap.ClipRect, FMsgBitmap, dmDrawWithTransparency);
  146.   UpdateGradientColoursAnim;
  147.   update;
  148.  
  149. end;
  150.  
  151. procedure TForm1.Timer1Timer(Sender: TObject);
  152. begin
  153.        rt := rt + 0.02; // stars rotation
  154.        BGRAVirtualScreen1.RedrawBitmap;
  155. end;
  156.  
  157. procedure TForm1.UpdateText;
  158. type
  159.   TTypeWriterStatus = (twsTyping, twsViewPage, twsClearPage, twsEmptyPage);
  160. const
  161.   TypingDelay      = 50;   // typing delay in milliseconds
  162.   ViewPageTime     = 3000; // Time in milliseconds to view text page
  163.   ClearUpdateDelay = 50;   // update clear delay in milliseonds
  164.   EmptyPageTime    = 1000; // Time in milliseconds to view empty page
  165.   ClearDistance    = 2;    // how many lines to clear for each iteration
  166.  
  167.   Status     : TTypeWriterStatus = twsEmptyPage;
  168.   LDT        : TDateTime         = 0.0;
  169.   ClearIndex : integer           = 0;
  170. var
  171.   CDT    : TDateTime;
  172.   msb    : int64;
  173.   ch     : Char;
  174.   doType : boolean = false;
  175. begin
  176.   CDT := now;
  177.   msb := MilliSecondsBetween(CDT, LDT);
  178.  
  179.   // process delay based on Status
  180.   case Status of
  181.     twsTyping    : if msb > TypingDelay then
  182.       begin
  183.         LDT := CDT;     // update Last DateTime
  184.         doType := true;
  185.       end else exit;
  186.     twsViewPage  : if msb > ViewPageTime then
  187.       begin
  188.         LDT := CDT;     // update Last DateTime
  189.         Status := twsClearPage;
  190.         exit;
  191.       end else exit;
  192.     twsClearPage : if msb > ClearUpdateDelay then
  193.       begin
  194.         LDT := CDT;     // update Last DateTime
  195.         if ClearIndex < FMsgBitmap.Height then
  196.         begin
  197.           FMsgBitmap.FillRect(Bounds(0,ClearIndex, FMsgBitmap.Width, ClearDistance),BGRA(0,0,0,0),dmSet); // fill rectangle fx !
  198.           ClearIndex += ClearDistance;
  199.         end
  200.         else
  201.         begin
  202.           status := twsEmptyPage;
  203.           ClearIndex := 0;
  204.         end;
  205.         exit;
  206.       end else exit;
  207.     twsEmptyPage : if msb > EmptyPageTime then
  208.       begin
  209.         LDT := CDT;    // update Last DateTime
  210.         Status := twsTyping;
  211.  
  212.         if (FPageIndex = 0) and (FLineIndex = 0) and (FCharIndex = 0)
  213.           then FAnimateColours := not(FAnimateColours);
  214.  
  215.         exit;
  216.       end else exit;
  217.   end;
  218.  
  219.   // when display next character requested
  220.   if doType then
  221.   begin
  222.     doType := false;
  223.  
  224.     // if there is any character left in the current line of the current page to be printed
  225.     if FCharIndex < Length(FTextPages[FPageIndex][FLineIndex]) then
  226.     begin
  227.       // display only upcase characters
  228.       ch := Upcase(FTextPages[FPageIndex][FLineIndex][succ(FCharIndex)]);
  229.       FMsgBitmap.TextOut(FCharIndex*22,FLineIndex*28, ch, FGradient);
  230.  
  231.       // next character (index)
  232.       inc(FCharIndex);
  233.     end
  234.     else // when no more characters left in line
  235.     begin
  236.       // next line index
  237.       inc(FLineIndex);
  238.  
  239.       // reset character index
  240.       FCharIndex :=0;
  241.  
  242.       // when exceeding the number of lines of the current page
  243.       if FLineIndex >= Length(FTextPages[FPageIndex]) then
  244.       begin
  245.         // reset line index
  246.         FLineIndex := 0;
  247.  
  248.         // next page index
  249.         inc(FPageIndex);
  250.  
  251.         // if no pages left then reset to first page index
  252.         if FPageIndex >= Length(FTextPages) then
  253.         begin
  254.           FPageIndex := 0;
  255.         end;
  256.  
  257.         // switch status to view current typed text
  258.         Status := twsViewPage;
  259.       end;
  260.     end;
  261.   end; // next character
  262.  
  263. end;
  264. procedure  TForm1.UpdateGradientColoursAnim;
  265. const
  266.   gindex   : integer = 0; // gradient index to start with
  267.   gspeed             = 1; // gradient speed (added to gradient index)
  268. var
  269.   x,y     : integer;
  270.   p1      : PBGRAPixel;
  271.   p2      : PDWord absolute p1;
  272.   goffset : integer = 0;
  273.   g       : integer;
  274. begin
  275.   for y := 0 to FMsgBitmap.Height-1 do
  276.   begin
  277.     g := (gindex + y) mod FGradientCount;
  278.     p1 := FMsgBitmap.Scanline[y];
  279.     for x := 0 to FMsgBitmap.Width-1 do //    for x := (FMsgBitmap.Width shr 1) to (FMsgBitmap.Width-1) do
  280.     begin
  281.       if p2[x] <> 0
  282.         then p1[x] := FGradient.ScanAt(0,g);
  283.     end;
  284.   end;
  285.   FMsgBitmap.InvalidateBitmap; // pixels changed by direct access so invalidate
  286.  
  287.   gindex := (gindex + gspeed) mod FGradientCount; // High(FRasterColours);
  288. end;
  289. procedure TForm1.Update;
  290. const
  291.   AnimColoursFrameDelay      = 1;
  292.   counter          : integer = AnimColoursFrameDelay;
  293.   cursorFrameindex : integer = 0;
  294.   cursorRect       : TRect   = (Left :0; Top: 0; Right: 0; Bottom: 0);
  295. var
  296.   cx,cy: integer;
  297. begin
  298.   // in order to prevent the colour animation from applying itself to the
  299.   // cursor the (previous) cursor needs to be removed first
  300.   FMsgBitmap.FillRect(cursorRect, BGRA($00,$00,$00, $00));
  301.  
  302.    UpdateText;
  303.   if FAnimateColours then
  304.   begin
  305.     dec(counter);
  306.     if counter <= 0 then
  307.     begin
  308.       counter := AnimColoursFrameDelay;
  309.        UpdateGradientColoursAnim;
  310.     end;
  311.   end;
  312.  
  313.   // update cursor
  314.   cursorFrameindex := (cursorFrameindex + 1) mod 7;
  315.   cx := (FCharIndex -1) * 22;
  316.   cy := (FLineIndex -1) * 28 + 12;  // + 8 correction (undertermined value)
  317.   cursorRect := Bounds
  318.   (
  319.     cx + 32 - cursorFrameindex*4 shr 1,
  320.     cy + 32 - cursorFrameindex*4 shr 1,
  321.     cursorFrameindex*4,
  322.     cursorFrameindex*4
  323.   );
  324.   FMsgBitmap.FillRect(cursorRect, BGRA($FF,$FF,$FF));
  325. end;
  326.  
  327. procedure TForm1.DrawStar(ctx: TBGRACanvas2D; cx, cy, spikes: Integer; outerRadius, innerRadius, rotation: single;style : TBGRAPixel);
  328. var
  329.   rot, step, x, y: single;
  330.   i: Integer;
  331. begin
  332.   rot := Pi / 2 * 3 + rotation;
  333.   step := Pi / spikes;
  334.  
  335.   ctx.BeginPath;
  336.   x := cx + cos(rot) * outerRadius;
  337.   y := cy + sin(rot) * outerRadius;
  338.   ctx.MoveTo(x, y);
  339.  
  340.   for i := 0 to spikes - 1 do
  341.   begin
  342.     x := cx + cos(rot) * outerRadius;
  343.     y := cy + sin(rot) * outerRadius;
  344.     ctx.LineTo(x, y);
  345.     rot := rot + step;
  346.     x := cx + cos(rot) * innerRadius;
  347.     y := cy + sin(rot) * innerRadius;
  348.     ctx.LineTo(x, y);
  349.     rot := rot + step;
  350.   end;
  351.  
  352.   x := cx + cos(rot) * outerRadius;
  353.   y := cy + sin(rot) * outerRadius;
  354.   ctx.LineTo(x, y);
  355.   ctx.ClosePath;
  356.  
  357.   ctx.LineWidth := 50;
  358.   ctx.strokeStyle(style);
  359.   ctx.Stroke;
  360.   ctx.fillStyle ('rgba(0,0,0,0)');;
  361.   ctx.Fill;
  362. end;
  363.  
  364. end.
  365.  
« Last Edit: June 10, 2024, 06:54:35 pm by Gigatron »
Sub Quantum Technology ! We are in a micro universe.

TRon

  • Hero Member
  • *****
  • Posts: 2801
Re: Demo Scene Typewriter
« Reply #7 on: June 11, 2024, 07:03:59 am »
Oh !! Great and many thanks ;
You're more than welcome. Thank you for the examples  8-)

Quote
Just uploaded the result to YT : look very nice ;
Sweet ! Thank you.

The hick-ups in the animation of the stars is that:
- because of an error in the rendering code
- timing related issues
- recording related issues
?

BTW: How on earth do you determine the actual rectangles dimensions for the characters ? Just trial and error ?


PS: I've attached a picture of the typewriter combined with your plasma routine from one of your other threads though I am not happy with the code so won't publish just yet.
« Last Edit: June 11, 2024, 07:51:29 am by TRon »

 

TinyPortal © 2005-2018