Demo Scene Typewriter
lazarus / 39-Graphics

----------------------------------------------------------------------
Gigatron · 2024-06-06 16:55

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls,  BGRAVirtualScreen,
BGRABitmap,BGRABitmapTypes, BGRAGradientScanner; type   { TForm1 }  
TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;   
Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject;
Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);   
procedure Timer1Timer(Sender: TObject);  private   public   end; var 
Form1: TForm1;  message_bitmap,cursor_bitmap : TBGRABitmap;  message :
Array[0..14] Of String =('                          ',               
                    '     TYPE WRITER DEMO     ',                    
               '                          ',                         
          '    WRITTEN BY GIGATRON   ',                              
     '   SFX BY THE GREAT XTD   ',                                   
 '    LAZARUS FREE PASCAL   ',                                     ' 
      COMPILER         ',                                     '      
                  ',                                     ' CODING IS
THE PASSION OF ',                                     '         CORTEX
          ',                                   
 '--------------------------',                                     ' 
  SEE YOU ON NEXT      ',                                     '      
PRODUCTION         ',                                     '          
              ',                                     '               
         '); // 2 last lines is waiting lines
!!! mess_id,mess_chr,mess_timer,char_pos : integer; i,j :
integer; implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormCreate(Sender: TObject);begin    message_bitmap :=
TBGRABitmap.Create(640,480);    cursor_bitmap  :=
TBGRABitmap.Create('cursor.png');    /// Message init     mess_timer
:=0;     mess_chr := 0; // message Char     mess_id :=0;  // message
line index     char_pos :=0;     i:=0;end; procedure
TForm1.Timer1Timer(Sender: TObject);begin 
BGRAVirtualScreen1.RedrawBitmap;end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);var  grad: TBGRAGradientScanner; begin     // font to
display message !      message_Bitmap.FontName:='AmigaUnitA'; // use
your installed font name eg: 'Arial' or else ;     
message_Bitmap.FontHeight:=44;      grad :=
TBGRAGradientScanner.Create(BGRA(255,255,255),BGRA(0,120,255),
 gtLinear,PointF(0,0),PointF(0,15),True,True);      // Message to
display     inc(mess_timer);     if (mess_timer >= 2) then // wait
timer      begin       message_Bitmap.TextOut(mess_chr*22,char_pos*28,
message[mess_id][mess_chr],grad);       mess_timer :=0;       mess_chr
:= mess_chr + 1;        if mess_chr>=27 then     // if reach last
char        begin         mess_chr :=0;         mess_id := mess_id +1
;         char_pos := char_pos +1; // increment ychar pos * 26       
 if mess_id >=14 then          begin             mess_id  := 14;
//bloque sur la ligne 14 !             mess_chr := 27; //           
 i:= i + 1;           
 message_Bitmap.FillRect(0,0,640,i,BGRA(35,35,35),dmSet); // fill
rectangle fx !            if (i>=480) then // wait i for reset
variables !              begin                 char_pos := 0;        
       mess_id := 0;                 mess_chr :=0;               
 i:=0;               end;             end;          end;        end;  
   Bitmap.StretchPutImage(Rect(0,0,640,480),message_bitmap,dmSet); end
; end.

----------------------------------------------------------------------
domasz · 2024-06-06 17:31

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 · 2024-06-07 16:19

Ok,
This is an improved version with 2 messages pages ; You can add now
more messages Pages !

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls,  BGRAVirtualScreen,
BGRABitmap,BGRABitmapTypes, BGRAGradientScanner; type   { TForm1 }  
TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;   
Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject;
Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);   
procedure Timer1Timer(Sender: TObject);  private   public   end; var 
Form1: TForm1;  message_bitmap,cursor_bitmap : TBGRABitmap;   message0
: Array[0..15] Of String =('                          ',             
                      '     TYPE WRITER DEMO     ',                  
                 '                          ',                       
            '    WRITTEN BY GIGATRON   ',                            
       '   SFX BY THE GREAT XTD   ',                                 
  '    LAZARUS FREE PASCAL   ',                                     '
       COMPILER         ',                                     '     
                   ',                                     ' CODING IS
THE PASSION OF ',                                     '         CORTEX
          ',                                   
 '--------------------------',                                     ' 
  SEE YOU ON NEXT      ',                                     '      
PRODUCTION         ',                                   
 '--------------------------',                                     ' 
                       ',                                     '      
                  ');   message1 :Array[0..15] Of String
=('***************************',                                   
 '*    GREETINGS LIST !!    *',                                     '*
                        *',                                   
 '*CIRCULAR  LAINZ  TRON    *',                                   
 '*JOSH  KODEZWERG   HUKKA  *',                                     '*
  GUVACODE   RAYSAN5    *',                                   
 '*MATTIAS MARCOV MARTIN-FR *',                                   
 '*PASCALDRAGON BLACK STAR  *',                                   
 '*MIPS PURPLE-LANTERN  XTD *',                                   
 '*CUBIC-CIRCLE  P.M.A  DDC *',                                   
 '*AXE-X TRONIC-DESIGN      *',                                   
 '*CRYSTAL-DUST SUB-SERO    *',                                   
 '*ANNY SUB-QUANTUM NEW-BCX *',                                     '*
 AND THE REST WE FORGOT *',                                   
 '***************************',                                     '
                          ');  //CIRCULAR  -  LAINZ  -  TRON   -  JOSH
 -  KODEZWERG  -  HUKKA  -  GUVACODE  -  RAYSAN5  -  MATTIAS  -
 MARCOV  -  MARTIN-FR  -
 PASCALDRAGON  mess_line,mess_chr,mess_timer,mess_num,char_pos :
integer; i,j : integer; implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormCreate(Sender: TObject);begin    message_bitmap :=
TBGRABitmap.Create(640,480);    cursor_bitmap  :=
TBGRABitmap.Create('cursor.png');     /// Message init     mess_timer
:=0;     mess_chr  := 0; // message Char     mess_line := 0; //
message line index     char_pos  := 0; // char pos in message line   
 mess_num  := 0; // first message is 0     i:= -200;  // start i with
far from bottom to mask message text for wait a bit before clear text
!!end; procedure TForm1.Timer1Timer(Sender: TObject);begin 
BGRAVirtualScreen1.RedrawBitmap;end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);var  grad: TBGRAGradientScanner; begin     // font to
display message !      message_Bitmap.FontName:='AmigaUnitA9';     
message_Bitmap.FontHeight:=44;      grad :=
TBGRAGradientScanner.Create(BGRA(255,255,255),BGRA(130,120,0),
 gtLinear,PointF(0,0),PointF(0,15),True,True);      // Message to
display     inc(mess_timer);     if (mess_timer >= 2) then // wait
timer      begin        // select message num 0 or 1        if
(mess_num = 0) then message_Bitmap.TextOut(mess_chr*22,char_pos*28,mes
sage0[mess_line][mess_chr],grad);        if (mess_num = 1) then messag
e_Bitmap.TextOut(mess_chr*22,char_pos*28,message1[mess_line][mess_chr]
,grad);        mess_timer :=0;       mess_chr := mess_chr + 1;      
 if mess_chr>=28 then     // if reach last char        begin       
 mess_chr :=0;         mess_line := mess_line +1 ;         char_pos :=
char_pos +1; // increment ychar pos * 26         if mess_line >=15
then          begin             mess_line := 15; // lock in line 15 ! 
           mess_chr  := 28; // lock in last char !             i:= i +
2;             message_Bitmap.FillRect(0,0,640,i,BGRA(0,0,0),dmSet);
// fill rectangle fx !            if (i>=480) then // wait i for reset
variables !              begin                 char_pos  := 0;       
        mess_line := 0;                 mess_chr  :=0;               
 // change message                 mess_num := mess_num + 1;         
      if (mess_num>1) then mess_num :=0;                    i:=-200; 
            end;             end;          end;        end;      Bitma
p.StretchPutImage(Rect(0,0,640,480),message_bitmap,dmSet); end; end.

----------------------------------------------------------------------
TRon · 2024-06-07 18:40

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i //
TTypeWriter quick mockup V2 still WiP type   TTextPages = array of
array of string;   { TTypeWriter }   TTypeWriter = class   private   
FMsgBitmap   : TBGRABitmap;    FRenderArea  : TRect;    FTextPages   :
TTextPages;    FPageIndex   : integer;    FLineIndex   : integer;   
FCharIndex   : integer;   public    constructor Create(aRenderArea:
TRect; aTextPages: TTextPages);    destructor Destroy; override;   
procedure Update(alpha: byte);    procedure RenderToBitmap(Bitmap:
TBGRABitmap);  end;  { TTypeWriter } { TTypeWriter } constructor
TTypeWriter.Create(aRenderArea: TRect; aTextPages: TTextPages);begin 
FRenderArea := aRenderArea;  FTextPages := aTextPages;  FMsgBitmap :=
TBGRABitmap.Create(aRenderArea.Width, aRenderArea.Height);   // font
used to display message !  FMsgBitmap.FontName:='AmigaDigital8'; 
FMsgBitmap.FontHeight:=36;   // Message parameters  FPageIndex := 0;
 // page index  FLineIndex := 0;  // line index of current page 
FCharIndex := 0;  // (horizontal/column) character index of current
lineend; destructor TTypeWriter.Destroy;begin  FMsgBitmap.Free; 
inherited Destroy;end; procedure TTypeWriter.Update(alpha: byte);type 
TTypeWriterStatus = (twsTyping, twsViewPage, twsSwapDelay);const  LDT
  : TDateTime = 0.0;  Status : TTypeWriterStatus = twsSwapDelay;var 
grad   : TBGRAGradientScanner;  CDT    : TDateTime;  msb    :
int64;begin  CDT := now;  msb := MilliSecondsBetween(CDT, LDT);   //
TODO:  // - gradient live updating  // - customized render area  // -
additional parameters for customization (fontname, fontsize, gradient 
//   colours etc)   // process delay based on Status  case Status of 
 twsTyping    : if msb > 25 then    // 25 miliseconds typing speed   
 begin        LDT := CDT      end else exit;    twsViewPage  : if msb
> 5000 then  // 5 seconds delay to view text      begin        LDT :=
CDT;        Status := twsSwapDelay;        // clear       
FMsgBitmap.FillRect(0,0,640,480,BGRA(255,192,0,0),dmSet);       
exit;      end else exit;    twsSwapDelay : if msb > 2000 then  // 2
second delay for empty view      begin        LDT := CDT;       
Status := twsTyping;        exit;      end else exit;  end;   Grad :=
TBGRAGradientScanner.Create  (    BGRA(255,255,255),   
BGRA(0,0,200+alpha),    gtLinear,    PointF(0,0),    PointF(0,35),   
True,    True  );   // Message display  begin   
FMsgBitmap.TextOut(FCharIndex*20,FLineIndex*22,
FTextPages[FPageIndex][FLineIndex][succ(FCharIndex)], grad);     //
Next character (index)    inc(FCharIndex);     // when no more chars
left in line    if
FCharIndex>=length(FTextPages[FPageIndex][FLineIndex]) then    begin 
   // next line index      inc(FLineIndex);      // reset character
index      FCharIndex :=0;       // when exceeding the number of lines
of the current page      if FLineIndex >=
Length(FTextPages[FPageIndex]) then      begin        // reset line
index        FLineIndex := 0;         // next page index       
inc(FPageIndex);         // if no pages left then reset to first page
index        if FPageIndex >= Length(FTextPages)          then
FPageIndex := 0;         // switch status to view current typed text 
     Status := twsViewPage;      end;    end;  end; // message
display   grad.free;end; procedure TTypeWriter.RenderToBitmap(Bitmap:
TBGRABitmap);begin  Bitmap.StretchPutImage  (   
Rect(20,90,740,90+520),    FMsgBitmap,    dmDrawWithTransparency  );en
d;  //////////////////////////////////////////////////////////////////
/////////////// usage:////////////////////////////////////////////////
/////////////////////////////// var  TextPages : TTextPages =  (    ( 
    '     CODE : GIGATRON      ',      '                          ', 
   '  FONT : THE LIGHTFORCE   ',      '                          ',  
  'SFX: JOURNEY TROUGH GALAXY',      '         MARK II          ',   
 '                          ',      '  DESIGN : TRONIC-SYSTEM  ',    
'                          ',      '     CONTACT GIGATRON     ',     
'     BP : 3300 68000      ',      '      COLMAR FRANCE       '    ), 
  (      ' TECH INFOS :',      ' 320 LINES OF PASCAL CODE',      '
BGRA COMPONENT',      ' 68000 LIKE TEXT FX CODE',      ' 2 DAYS OF
WORK',      ' FULL 60 FPS',      ' AMD 8 CORES CPU',      ' 64
GIGABYTE OF RAM',      ' FREE PASACAL LAZARUS 3.2',      ' FPC
3.2.2',      ' THX TO THE TEAM LAZARUS',      '       ----------     
  '    ),    (      'TYPEWRITER RTN MODIFIED',      'AND SIMPLIFIED TO
SUPPORT',      'MULTIPLE',      'PAGES + A VARIABLE AMOUNT',      'OF
LINES AND SUPPORT FOR'      'VARIABLE LINE LENGTH''S',      '        
BY TRON       '    )  ); procedure TForm1.FormCreate(Sender:
TObject);begin  TypeWriter := TTypeWriter.Create(bounds(0,0,640,480),
TextPages);end; procedure TForm1.FormDestroy(Sender: TObject);begin 
TypeWriter.Free;end; procedure TForm1.Timer1Timer(Sender:
TObject);begin  TypeWriter.Update(alpha);  
VScreen.RedrawBitmap;end; procedure TForm1.VScreenRedraw(Sender:
TObject; Bitmap: TBGRABitmap);begin 
TypeWriter.RenderToBitmap(Bitmap);end;  
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)

----------------------------------------------------------------------
Gigatron · 2024-06-07 19:51

@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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls,  BGRAVirtualScreen,
BGRASpriteAnimation, BGRABitmap, BGRABitmapTypes, 
BGRAGradientScanner; type   { TForm1 }   TForm1 = class(TForm)   
BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;   
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);  private   public   end; var  Form1:
TForm1;  message_bitmap,cursor_bitmap : TBGRABitmap;   message0 :
Array[0..15] Of String =('                          ',               
                    '     TYPE WRITER DEMO     ',                    
               '                          ',                         
          '    WRITTEN BY GIGATRON   ',                              
     '   SFX BY THE GREAT XTD   ',                                   
 '    LAZARUS FREE PASCAL   ',                                     ' 
      COMPILER         ',                                     '      
                  ',                                     ' CODING IS
THE PASSION OF ',                                     '         CORTEX
          ',                                   
 '--------------------------',                                     ' 
  SEE YOU ON NEXT      ',                                     '      
PRODUCTION         ',                                   
 '--------------------------',                                     ' 
                       ',                                     '      
                  ');   message1 :Array[0..15] Of String
=('***************************',                                   
 '*    GREETINGS LIST !!    *',                                     '*
                        *',                                   
 '*CIRCULAR  LAINZ  TRON    *',                                   
 '*JOSH  KODEZWERG   HUKKA  *',                                     '*
  GUVACODE   RAYSAN5    *',                                   
 '*MATTIAS MARCOV MARTIN-FR *',                                   
 '*PASCALDRAGON BLACK STAR  *',                                   
 '*MIPS PURPLE-LANTERN  XTD *',                                   
 '*CUBIC-CIRCLE  P.M.A  DDC *',                                   
 '*AXE-X TRONIC-DESIGN      *',                                   
 '*CRYSTAL-DUST SUB-SERO    *',                                   
 '*ANNY SUB-QUANTUM NEW-BCX *',                                     '*
 AND THE REST WE FORGOT *',                                   
 '***************************',                                     '
                          ');  //CIRCULAR  -  LAINZ  -  TRON   -  JOSH
 -  KODEZWERG  -  HUKKA  -  GUVACODE  -  RAYSAN5  -  MATTIAS  -
 MARCOV  -  MARTIN-FR  -
 PASCALDRAGON  mess_line,mess_chr,mess_timer,mess_num,char_ypos :
integer; i,j,sn : integer;  implementation {$R *.lfm} { TForm1
} procedure TForm1.FormCreate(Sender: TObject);begin    message_bitmap
:= TBGRABitmap.Create(640,480);    cursor_bitmap  :=
TBGRABitmap.Create('cursor.png');     /// Message init     mess_timer
:=0;     mess_chr  := 0; // message Char     mess_line := 0; //
message line index     char_ypos  := 0; // char pos in message line  
 mess_num  := 0; // first message is 0     i:= -200;  // start i with
far from bottom to mask message text for wait a bit before clear text
!!     j:= 0;end; procedure TForm1.Timer1Timer(Sender: TObject);begin 
   BGRAVirtualScreen1.RedrawBitmap;end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);var  grad: TBGRAGradientScanner;begin     // font to
display message !      message_Bitmap.FontName:='AmigaUnitA';     
message_Bitmap.FontHeight:=44;      grad :=
TBGRAGradientScanner.Create(BGRA(255,255,255),BGRA(250,60,100),
 gtReflected,PointF(0,0),PointF(0,15),True,True);       // Message to
display     inc(mess_timer);     if (mess_timer >= 2) then // wait
timer      begin        // select message num 0 or 1        if
(mess_num = 0) then message_Bitmap.TextOut(mess_chr*22,char_ypos*28,me
ssage0[mess_line][mess_chr],grad);        if (mess_num = 1) then messa
ge_Bitmap.TextOut(mess_chr*22,char_ypos*28,message1[mess_line][mess_ch
r],grad);        mess_timer :=0;       mess_chr := mess_chr + 1;     
 if mess_chr>=28 then     // if reach last char        begin       
 mess_chr :=0;         mess_line := mess_line +1 ;         char_ypos
:= char_ypos +1; // increment ychar pos * 26         if mess_line >=15
then          begin             mess_line := 15; // lock in line 15 ! 
           mess_chr  := 28; // lock in last char !           
 char_ypos := 14; // lock char ypos for cursor position           
 i:= i + 2;            
 message_Bitmap.FillRect(0,0,640,i,BGRA(0,0,0),dmSet); // fill
rectangle fx !            if (i>=480) then // wait i for reset
variables !              begin                 char_ypos  := 0;      
         mess_line := 0;                 mess_chr  :=0;              
 // change message                 mess_num := mess_num + 1;         
      if (mess_num>1) then mess_num :=0;                    i:=-200; 
            end;             end;          end;        end;    // copy
message bitmap to main screen ;   
Bitmap.StretchPutImage(Rect(0,0,640,480),message_bitmap,dmSet);     //
cursor    Bitmap.PutImagePart(mess_chr*22,char_ypos*28+4,cursor_bitmap
,rect(j*32,0,j*32+32,32),dmSet);     j:= j + 1;     if (j>7) then
j:=0; end; end.

----------------------------------------------------------------------
TRon · 2024-06-10 04:45

Quote from: Gigatron on June 07, 2024, 09:51:40 pm@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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i //
TTypeWriter quick mockup V3 still WiP// cursor added as an after
thought interface type  { TTypeWriter V3}   // TODO: a lot :-)  
TTextPages = array of array of string;   TTypeWriter = class 
 private    FMsgBitmap      : TBGRABitmap;    FRenderSize     :
TSize;    FTextPages      : TTextPages;    FPageIndex      : integer; 
  FLineIndex      : integer;    FCharIndex      : integer;   
FGradient       : TBGRAGradientScanner;    FGradientCount  : integer; 
  FAnimateColours : boolean;   protected    procedure
UpdateGradientColoursAnim;    procedure UpdateText;   public   
constructor Create(aSize: TSize; aTextPages: TTextPages);   
destructor Destroy; override;    procedure Update;    property
 Bitmap: TBGRABitmap read FMsgBitmap;  end;  implementation {
TTypeWriter } constructor TTypeWriter.Create(aSize: TSize; aTextPages:
TTextPages);begin  FRenderSize := aSize;  FTextPages  := aTextPages; 
FMsgBitmap  := TBGRABitmap.Create(FRenderSize.Width,
FRenderSize.Height);   // font used to display message ! 
FMsgBitmap.FontName:='AmigaDigital8';  FMsgBitmap.FontHeight:=36;   //
Message parameters  FPageIndex     := 0;  // page index  FLineIndex  
 := 0;  // line index of current page  FCharIndex     := 0;  //
(horizontal/column) character index of current line  FGradientCount :=
16; // amount of colourpoints in gradient (is it possible to retrieve
that from the gradient itself ?)   FGradient :=
TBGRAGradientScanner.Create  (    BGRA(255,255,255),
BGRA(250,60,100),    gtReflected,    PointF(0,0)      ,
PointF(0,FGradientCount-1),    True,True  );   FAnimateColours :=
true;end; destructor TTypeWriter.Destroy;begin  FGradient.Free; 
FMsgBitmap.Free;  inherited Destroy;end; procedure
TTypeWriter.UpdateText;type  TTypeWriterStatus = (twsTyping,
twsViewPage, twsClearPage, twsEmptyPage);const  TypingDelay      = 25;
  // typing delay in milliseconds  ViewPageTime     = 2000; // Time in
milliseconds to view text page  ClearUpdateDelay = 50;   // update
clear delay in milliseonds  EmptyPageTime    = 1000; // Time in
milliseconds to view empty page  ClearDistance    = 2;    // how many
lines to clear for each iteration   Status     : TTypeWriterStatus =
twsEmptyPage;  LDT        : TDateTime         = 0.0;  ClearIndex :
integer           = 0;var  CDT    : TDateTime;  msb    : int64;  ch  
 : Char;  doType : boolean = false;begin  CDT := now;  msb :=
MilliSecondsBetween(CDT, LDT);   // process delay based on Status 
case Status of    twsTyping    : if msb > TypingDelay then      begin 
      LDT := CDT;     // update Last DateTime        doType := true; 
   end else exit;    twsViewPage  : if msb > ViewPageTime then     
begin        LDT := CDT;     // update Last DateTime        Status :=
twsClearPage;        exit;      end else exit;    twsClearPage : if
msb > ClearUpdateDelay then      begin        LDT := CDT;     //
update Last DateTime        if ClearIndex < FMsgBitmap.Height then   
   begin          FMsgBitmap.FillRect(Bounds(0,ClearIndex,
FMsgBitmap.Width, ClearDistance),BGRA(0,0,0,0),dmSet); // fill
rectangle fx !          ClearIndex += ClearDistance;        end      
else        begin          status := twsEmptyPage;          ClearIndex
:= 0;        end;        exit;      end else exit;    twsEmptyPage :
if msb > EmptyPageTime then      begin        LDT := CDT;    // update
Last DateTime        Status := twsTyping;         if (FPageIndex = 0)
and (FLineIndex = 0) and (FCharIndex = 0)          then
FAnimateColours := not(FAnimateColours);         exit;      end else
exit;  end;   // when display next character requested  if doType
then  begin    doType := false;     // if there is any character left
in the current line of the current page to be printed    if FCharIndex
< Length(FTextPages[FPageIndex][FLineIndex]) then    begin      //
display only upcase characters      ch :=
Upcase(FTextPages[FPageIndex][FLineIndex][succ(FCharIndex)]);     
FMsgBitmap.TextOut(FCharIndex*22,FLineIndex*28, ch, FGradient);      
// next character (index)      inc(FCharIndex);    end    else // when
no more characters left in line    begin      // next line index     
inc(FLineIndex);       // reset character index      FCharIndex :=0;  
    // when exceeding the number of lines of the current page      if
FLineIndex >= Length(FTextPages[FPageIndex]) then      begin        //
reset line index        FLineIndex := 0;         // next page index  
    inc(FPageIndex);         // if no pages left then reset to first
page index        if FPageIndex >= Length(FTextPages) then       
begin          FPageIndex := 0;        end;         // switch status
to view current typed text        Status := twsViewPage;      end;   
end;  end; // next character end; procedure
TTypeWriter.UpdateGradientColoursAnim;const  gindex   : integer = 0;
// gradient index to start with  gspeed             = 1; // gradient
speed (added to gradient index)var  x,y     : integer;  p1      :
PBGRAPixel;  p2      : PDWord absolute p1;  goffset : integer = 0;  g
     : integer;begin  for y := 0 to FMsgBitmap.Height-1 do  begin    g
:= (gindex + y) mod FGradientCount;    p1 := FMsgBitmap.Scanline[y]; 
 for x := 0 to FMsgBitmap.Width-1 do //    for x := (FMsgBitmap.Width
shr 1) to (FMsgBitmap.Width-1) do    begin      if p2[x] <> 0       
then p1[x] := FGradient.ScanAt(0,g);    end;  end; 
FMsgBitmap.InvalidateBitmap; // pixels changed by direct access so
invalidate   gindex := (gindex + gspeed) mod FGradientCount; //
High(FRasterColours);end; procedure TTypeWriter.Update;const 
AnimColoursFrameDelay      = 1;  counter          : integer =
AnimColoursFrameDelay;  cursorFrameindex : integer = 0;  cursorRect  
   : TRect   = (Left :0; Top: 0; Right: 0; Bottom: 0);var  cx,cy:
integer;begin  // in order to prevent the colour animation from
applying itself to the  // cursor the (previous) cursor needs to be
removed first  FMsgBitmap.FillRect(cursorRect, BGRA($00,$00,$00,
$00));   UpdateText;  if FAnimateColours then  begin    dec(counter); 
  if counter <= 0 then    begin      counter :=
AnimColoursFrameDelay;      UpdateGradientColoursAnim;    end;  end;  
// update cursor  cursorFrameindex := (cursorFrameindex + 1) mod 7; 
cx := (FCharIndex -1) * 22;  cy := (FLineIndex -1) * 28 + 8;  // + 8
correction (undertermined value)  cursorRect := Bounds  (    cx + 32 -
cursorFrameindex*4 shr 1,    cy + 32 - cursorFrameindex*4 shr 1,   
cursorFrameindex*4,    cursorFrameindex*4  ); 
FMsgBitmap.FillRect(cursorRect, BGRA($FF,$FF,$FF));end;  /////////////
//////////////////////////////////////////////////////////////////// u
sage://///////////////////////////////////////////////////////////////
////////////// var  TextPages : TTextPages =  (    (    '            
            ',    '     TYPE WRITER DEMO     ',    '                 
       ',    '    WRITTEN BY GIGATRON   ',    '   SFX BY THE GREAT XTD
  ',    '    LAZARUS FREE PASCAL   ',    '         COMPILER        
',    '                          ',    ' CODING IS THE PASSION OF ', 
 '         CORTEX           ',    '--------------------------',    ' 
  SEE YOU ON NEXT      ',    '       PRODUCTION         ',   
'--------------------------',    '                          '    ),  
(    '***************************',    '*    GREETINGS LIST !!    *', 
  '*                         *',    '*CIRCULAR  LAINZ  TRON    *',   
'*JOSH  KODEZWERG   HUKKA  *',    '*   GUVACODE   RAYSAN5    *',   
'*MATTIAS MARCOV MARTIN-FR *',    '*PASCALDRAGON BLACK STAR  *',   
'*MIPS PURPLE-LANTERN  XTD *',    '*CUBIC-CIRCLE  P.M.A  DDC *',   
'*AXE-X TRONIC-DESIGN      *',    '*CRYSTAL-DUST SUB-SERO    *',   
'*ANNY SUB-QUANTUM NEW-BCX *',    '*  AND THE REST WE FORGOT *',   
'***************************',    '                           ',    ) 
);  procedure TForm1.FormCreate(Sender: TObject);begin  // VScreen =
TBGRAVirtualScreen;  TypeWriter :=
TTypeWriter.Create(Size(VScreen.Width,VScreen.Height),
TextPages);end; procedure TForm1.FormDestroy(Sender: TObject);begin 
TypeWriter.Free;end; procedure TForm1.TimerTimer(Sender:
TObject);begin  VScreen.RedrawBitmap;end; procedure
TForm1.VScreenRedraw(Sender: TObject; Bitmap: TBGRABitmap);begin  //
Update FX  TypeWriter.Update;   // Render FX 
Bitmap.StretchPutImage(Bitmap.ClipRect, TypeWriter.Bitmap,
dmSet);end; 
Have Fun !

----------------------------------------------------------------------
Gigatron · 2024-06-10 16:34

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls,  BGRAVirtualScreen, BGRABitmap,
BGRABitmapTypes,BGRAGradientScanner,DateUtils,BGRACanvas2D,
mmsystem; type   TTextPages = array of array of string;  { TForm1 }   
TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;   
Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject;
Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);   
procedure Timer1Timer(Sender: TObject);  private    FMsgBitmap      :
TBGRABitmap;    FTextPages      : TTextPages;    FPageIndex      :
integer;    FLineIndex      : integer;    FCharIndex      : integer; 
 FGradient       : TBGRAGradientScanner;    FGradientCount  :
integer;    FAnimateColours : boolean;     protected    procedure
 UpdateGradientColoursAnim;    procedure UpdateText;    procedure
Update;    procedure drawStar(ctx: TBGRACanvas2D;cx, cy, spikes :
integer; outerRadius, innerRadius, rotation : single;style :
TBGRAPixel);   public    MyAudio_File: AnsiString;    WavStream :
TMemoryStream;  end;  var  Form1: TForm1;  rt : single;  x_pos,y_pos :
integer;   var  pages : TTextPages =  (    (    '       TYPE WRITER
DEMO     ',    '      WRITTEN BY GIGATRON   ',    '  IMPROVED BY THE
GREAT TRON',    '                            ',    '    SFX BY DIRK /
LENGEND   ',    '      LAZARUS FREE PASCAL   ',    '          
COMPILER         ',    '                            ',    '   CODING
IS THE PASSION OF ',    '           CORTEX           ',    '
 --------------------------',    '       SEE YOU ON NEXT      ',    '
       PRODUCTION         ',    '  --------------------------',    ' 
                         '    ),    (    '
**************************',    ' *    GREETINGS LIST !!   *',    ' *
                      *',    ' *CIRCULAR  LAINZ  TRON   *',    ' *JOSH
 KODEZWERG   HUKKA *',    ' *   GUVACODE   RAYSAN5   *',    ' *MATTIAS
MARCOV MARTIN-FR*',    ' *PASCALDRAGON BLACK STAR *',    ' *MIPS
PURPLE-LANTERN DIRK*',    ' *CUBIC-CIRCLE  P.M.A  DDC*',    ' *AXE-X
TRONIC-DESIGN     *',    ' *CRYSTAL-DUST SUB-SERO   *',    ' *ANNY
SUB-QUANTUM NEW-BCX*',    ' *  AND THE REST WE FORGOT*',    '
**************************',    '                            '    ) 
);  implementation {$R *.lfm} { TForm1 }  procedure
TForm1.FormCreate(Sender: TObject);begin   FTextPages  := pages; 
FMsgBitmap  := TBGRABitmap.Create(640, 480);   // font used to display
message !  FMsgBitmap.FontName:='AmigaDigital8'; 
FMsgBitmap.FontHeight:=36;   // Message parameters  FPageIndex     :=
0;  // page index  FLineIndex     := 0;  // line index of current
page  FCharIndex     := 0;  // (horizontal/column) character index of
current line  FGradientCount := 32; // amount of colourpoints in
gradient (is it possible to retrieve that from the gradient itself
?)   FGradient := TBGRAGradientScanner.Create  (    BGRA(255,255,255),
BGRA(0,60,255),    gtReflected,    PointF(0,0)      ,
PointF(0,FGradientCount-1),    True,True  );   FAnimateColours :=
true;   rt := 0.0;  x_pos :=100;  y_pos :=20;     // audio stream   
MyAudio_File := 'wanderingmind.wav';    WavStream    :=
TMemoryStream.Create;    WavStream.LoadFromFile(MyAudio_File);   
PlaySound(WavStream.Memory, 0, SND_NODEFAULT or SND_ASYNC or
SND_MEMORY);  end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender:
TObject; Bitmap: TBGRABitmap);var  ctx: TBGRACanvas2D;begin  ctx :=
Bitmap.Canvas2D;  //   les etoiles !  drawStar(ctx,
x_pos+220,y_pos+225, 7, 110.0, 170.0, rt*1.0,BGRA(77,88,99)); 
drawStar(ctx, x_pos+200,y_pos+210, 7, 110.0, 170.0,
rt*1.3,BGRA(44,55,66));  drawStar(ctx, x_pos+210,y_pos+220, 7, 110.0,
170.0, rt*1.6,BGRA(66,77,88)); 
Bitmap.StretchPutImage(Bitmap.ClipRect, FMsgBitmap,
dmDrawWithTransparency);  UpdateGradientColoursAnim; 
update; end; procedure TForm1.Timer1Timer(Sender: TObject);begin     
 rt := rt + 0.02; // stars rotation     
 BGRAVirtualScreen1.RedrawBitmap;end; procedure
TForm1.UpdateText;type  TTypeWriterStatus = (twsTyping, twsViewPage,
twsClearPage, twsEmptyPage);const  TypingDelay      = 50;   // typing
delay in milliseconds  ViewPageTime     = 3000; // Time in
milliseconds to view text page  ClearUpdateDelay = 50;   // update
clear delay in milliseonds  EmptyPageTime    = 1000; // Time in
milliseconds to view empty page  ClearDistance    = 2;    // how many
lines to clear for each iteration   Status     : TTypeWriterStatus =
twsEmptyPage;  LDT        : TDateTime         = 0.0;  ClearIndex :
integer           = 0;var  CDT    : TDateTime;  msb    : int64;  ch  
 : Char;  doType : boolean = false;begin  CDT := now;  msb :=
MilliSecondsBetween(CDT, LDT);   // process delay based on Status 
case Status of    twsTyping    : if msb > TypingDelay then      begin 
      LDT := CDT;     // update Last DateTime        doType := true; 
   end else exit;    twsViewPage  : if msb > ViewPageTime then     
begin        LDT := CDT;     // update Last DateTime        Status :=
twsClearPage;        exit;      end else exit;    twsClearPage : if
msb > ClearUpdateDelay then      begin        LDT := CDT;     //
update Last DateTime        if ClearIndex < FMsgBitmap.Height then   
   begin          FMsgBitmap.FillRect(Bounds(0,ClearIndex,
FMsgBitmap.Width, ClearDistance),BGRA(0,0,0,0),dmSet); // fill
rectangle fx !          ClearIndex += ClearDistance;        end      
else        begin          status := twsEmptyPage;          ClearIndex
:= 0;        end;        exit;      end else exit;    twsEmptyPage :
if msb > EmptyPageTime then      begin        LDT := CDT;    // update
Last DateTime        Status := twsTyping;         if (FPageIndex = 0)
and (FLineIndex = 0) and (FCharIndex = 0)          then
FAnimateColours := not(FAnimateColours);         exit;      end else
exit;  end;   // when display next character requested  if doType
then  begin    doType := false;     // if there is any character left
in the current line of the current page to be printed    if FCharIndex
< Length(FTextPages[FPageIndex][FLineIndex]) then    begin      //
display only upcase characters      ch :=
Upcase(FTextPages[FPageIndex][FLineIndex][succ(FCharIndex)]);     
FMsgBitmap.TextOut(FCharIndex*22,FLineIndex*28, ch, FGradient);      
// next character (index)      inc(FCharIndex);    end    else // when
no more characters left in line    begin      // next line index     
inc(FLineIndex);       // reset character index      FCharIndex :=0;  
    // when exceeding the number of lines of the current page      if
FLineIndex >= Length(FTextPages[FPageIndex]) then      begin        //
reset line index        FLineIndex := 0;         // next page index  
    inc(FPageIndex);         // if no pages left then reset to first
page index        if FPageIndex >= Length(FTextPages) then       
begin          FPageIndex := 0;        end;         // switch status
to view current typed text        Status := twsViewPage;      end;   
end;  end; // next character end;procedure
 TForm1.UpdateGradientColoursAnim;const  gindex   : integer = 0; //
gradient index to start with  gspeed             = 1; // gradient
speed (added to gradient index)var  x,y     : integer;  p1      :
PBGRAPixel;  p2      : PDWord absolute p1;  goffset : integer = 0;  g
     : integer;begin  for y := 0 to FMsgBitmap.Height-1 do  begin    g
:= (gindex + y) mod FGradientCount;    p1 := FMsgBitmap.Scanline[y]; 
 for x := 0 to FMsgBitmap.Width-1 do //    for x := (FMsgBitmap.Width
shr 1) to (FMsgBitmap.Width-1) do    begin      if p2[x] <> 0       
then p1[x] := FGradient.ScanAt(0,g);    end;  end; 
FMsgBitmap.InvalidateBitmap; // pixels changed by direct access so
invalidate   gindex := (gindex + gspeed) mod FGradientCount; //
High(FRasterColours);end;procedure TForm1.Update;const 
AnimColoursFrameDelay      = 1;  counter          : integer =
AnimColoursFrameDelay;  cursorFrameindex : integer = 0;  cursorRect  
   : TRect   = (Left :0; Top: 0; Right: 0; Bottom: 0);var  cx,cy:
integer;begin  // in order to prevent the colour animation from
applying itself to the  // cursor the (previous) cursor needs to be
removed first  FMsgBitmap.FillRect(cursorRect, BGRA($00,$00,$00,
$00));    UpdateText;  if FAnimateColours then  begin   
dec(counter);    if counter <= 0 then    begin      counter :=
AnimColoursFrameDelay;       UpdateGradientColoursAnim;    end; 
end;   // update cursor  cursorFrameindex := (cursorFrameindex + 1)
mod 7;  cx := (FCharIndex -1) * 22;  cy := (FLineIndex -1) * 28 + 12;
 // + 8 correction (undertermined value)  cursorRect := Bounds  (   
cx + 32 - cursorFrameindex*4 shr 1,    cy + 32 - cursorFrameindex*4
shr 1,    cursorFrameindex*4,    cursorFrameindex*4  ); 
FMsgBitmap.FillRect(cursorRect, BGRA($FF,$FF,$FF));end; procedure
TForm1.DrawStar(ctx: TBGRACanvas2D; cx, cy, spikes: Integer;
outerRadius, innerRadius, rotation: single;style : TBGRAPixel);var 
rot, step, x, y: single;  i: Integer;begin  rot := Pi / 2 * 3 +
rotation;  step := Pi / spikes;   ctx.BeginPath;  x := cx + cos(rot) *
outerRadius;  y := cy + sin(rot) * outerRadius;  ctx.MoveTo(x, y);  
for i := 0 to spikes - 1 do  begin    x := cx + cos(rot) *
outerRadius;    y := cy + sin(rot) * outerRadius;    ctx.LineTo(x,
y);    rot := rot + step;    x := cx + cos(rot) * innerRadius;    y :=
cy + sin(rot) * innerRadius;    ctx.LineTo(x, y);    rot := rot +
step;  end;   x := cx + cos(rot) * outerRadius;  y := cy + sin(rot) *
outerRadius;  ctx.LineTo(x, y);  ctx.ClosePath;   ctx.LineWidth :=
50;  ctx.strokeStyle(style);  ctx.Stroke;  ctx.fillStyle
('rgba(0,0,0,0)');;  ctx.Fill;end; end.

----------------------------------------------------------------------
TRon · 2024-06-11 05:03

Quote from: Gigatron on June 10, 2024, 06:34:53 pmOh !! Great and many
thanks ;
You're more than welcome. Thank you for the examples 

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