Demo Scene Bitmap Font Scroller

[TRon]

My question on the fpc compiler side, is there a specific setting to gain speed?

Sure, see commandline options to get a full overview (see option -O).

Lazarus project setting can set some of these options but you can set custom options for a project in case you want to change a setting that is not 'listed' by Lazarus.

But better start fixing the obvious first ? 

PS: because I have seen it a couple of times now I wonder if you perhaps do that on purpose to keep us awake (meaning everything is already in place but you do not seem to make use of it).

[Gigatron]

My question on the fpc compiler side, is there a specific setting to gain speed?

PS: because I have seen it a couple of times now I wonder if you perhaps do that on purpose to keep us awake (meaning everything is already in place but you do not seem to make use of it).

Yes, what I hope is that new programmers who discover Pascal never leave it and that Lazarus FPC becomes as powerful as any programming language using the minimum amount of code. It's true I can use components that exist to do what I want, Amiga demos and the music that goes with them. But the code should be as simple as simple. I don't know if you understood me? If the sinescroll code ran at 60 fps with the basic canvas?

Sorry i used google translator , english is not my native language ;

[KodeZwerg]

If the sinescroll code ran at 60 fps with the basic canvas?

It depends on monitor Hz and used code so there can't be a generic "Yes" answer.

Like TRon already mentioned, take advantage from buffering and just render whats needed to be rendered.
My suggestion, change your "Draw" method that it output a TBitmap instead of accessing the destination canvas, that way you can pump one finished rendering and straight work on the next while the LCL cares about to paint your bitmap on whatever canvas. (simple doublebuffer)

And if you want to make it simple for the interested beginners, that is first of all a really nice doing from your side but I can't say it often enough, name your variables/methods logical for others not for your own doings, make code readable.
Or would you know what that header arguments mean if you have not coded it?

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

1.     constructor Create(font_name: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);

a beginner read:
font_name: cool I enter "Arial"... sad it does not work but why? I entered a font name....
offset: what the heck does that mean? lets find out and try
w, py, fw, fh, sh: cool, a collection of integers
s_speed: okay, this might be something about speed, maybe...
text: hey I remember, that is a property of a TControl, but what does it do here?

if "font_name" mean, tell me a fontfilename, why not call the variable "AFontFilename"?
if "w" means "Width", first rename to "AWidth" and second, the width of what?
and so on, this problematic is like a red line thru all your sources, no offend, just saying.

[Gigatron]

Yes you and @Tron ​​and surely others are right. In fact it's not finished I'm in the process of optimizing the code, I knew the result of the code, but it's starting from scratch... Then gradually adding things to make it simple and optimized.
Thanks for your advices.

[TRon]

It depends on monitor Hz and used code so there can't be a generic "Yes" answer.

I am really out of things for ages but do PC graphics cards have something like (user) syncing these days ? E.g. on the c64, Amiga and many other hardware from those days you could sync with the vertical blank (or similar) and use f.e. an interrupt to sync with frames.

To this day it still makes me laugh when someone shows off his PC rendering 600 fps framerate believing that it is some sort of (important) accomplishment. It has some merits when playing games (same as monitor refresh rate) but also that is only working up to a certain point.

Like TRon already mentioned, take advantage from buffering and just render whats needed to be rendered.

Indeed, because then it becomes more about perception. And perception can be tricked... 

Especially the character-fall fx in the other thread suffers from unnecessary processing because characters at their final destination should not be part of the render loop anymore. It reminds me of an fx that I saw where characters consisted out of particles and text would morph from one sentence into another, character by character... why ? because the little Amiga that could was only able to render so much particles (full color) at the same time.

And if you want to make it simple for the interested beginners, that is first of all a really nice doing from your side but I can't say it often enough, name your variables/methods logical for others not for your own doings, make code readable.

Admittingly my variables also looked similar when writing asm.... And there it is even worse with all the jump(s/tables)... There is/was a reason people started using turbo pascal/c to wrap their asm routines

[KodeZwerg]

It depends on monitor Hz and used code so there can't be a generic "Yes" answer.

I am really out of things for ages but do PC graphics cards have something like (user) syncing these days ? E.g. on the c64, Amiga and many other hardware from those days you could sync with the vertical blank (or similar) and use f.e. an interrupt to sync with frames.

As far as I know can software rendering, like Gigatrons LCL Sinusscroller, only show as many images as the graphic card driver is configured for on Desktop usage. (in many cases 30 or 60 FPS)
Thats the spot where buffering makes a difference. As of right now his code draw to a canvas while it could already prepare the next image etc...

Admittingly my variables also looked similar when writing asm.... And there it is even worse with all the jump(s/tables)... There is/was a reason people started using turbo pascal/c to wrap their asm routines

Same here, but such code is not made for a pascal beginner audience, its for my own usage
When I publish something, I always try at least to make method signatures and method/property names sound to something where when I open such project 10 years later I am not needing to study the code to know ahhh "w" is "Width" and so on...
Variables declared within a method is a different story hahaha

In First-Person-Shooters (FPS) the Frames-Per-Second (FPS) does matter, its not a good FPS when running out of FPS *pun intended*
I do still have an outdated but working like a charm 31" cathode-monitor on the attic, when I want "unlimited FPS" its the choice to be.
Same with wired Mouse and Keyboard, but hey, now I am mature, don't play such anymore, so a "slow" monitor and wireless Input devices are okay 

[Gigatron]

Hi, late on the night , the maximum speed i reached is a bit more fps than before ;

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,SinScroller;
9.  
10. type
11.  
12.   { TForm1 }
13.  
14.   TForm1 = class(TForm)
15.     Timer1: TTimer;
16.  
17.     procedure FormCreate(Sender: TObject);
18.     procedure FormDestroy(Sender: TObject);
19.     procedure FormPaint(Sender: TObject);
20.     procedure Timer1Timer(Sender: TObject);
21.   private
22.   public
23.   end;
24.  
25. var
26.   Form1: TForm1;
27.   Scroller: TSineScroller;
28.   s_text : string = ' LAZARUS FPC THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  LAINZ - TRON  -  KODEZWERG  -  GUVA - HUKKA  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM ';
29.  
30. implementation
31.  
32. {$R *.lfm}
33.  
34. { TForm1 }
35.  
36. procedure TForm1.FormCreate(Sender: TObject);
37. begin
38.   DoubleBuffered:=true;
39.   Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,80, 12,  s_text);
40.  end;
41.  
42. procedure TForm1.FormDestroy(Sender: TObject);
43. begin
44.   Scroller.Free;
45. end;
46.  
47. procedure TForm1.FormPaint(Sender: TObject);
48. begin
49.         Scroller.draw;
50. end;
51.  
52. procedure TForm1.Timer1Timer(Sender: TObject);
53.  
54. begin
55.     Repaint;
56. end;
57.  
58. end.
59.  

and the included sinscroller constructor ;

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

1. unit SinScroller;
2.  
3. interface
4.  
5. uses
6.   Classes, SysUtils, Graphics, ExtCtrls;
7.  
8. type
9.   TSineScroller = class
10.   private
11.     offset_char: Char; // First Character in bitmap fonts
12.     pos_y: Integer;
13.     width: Integer;
14.     scroll_text: string;
15.     canvas_ctx: TCanvas;
16.     scroll_speed: Integer;
17.     scroll_pause: Boolean;
18.     scroll_pause_time: Integer;
19.     sx, tx: Integer;
20.     bm : TBitmap;
21.     fonts: TImage;
22.     fonts_width, fonts_height: Integer;
23.     sine_height: Integer;
24.     radians: Double;
25.     font_height_zoom: Double;
26.     function drawFontChar(charek: Char; x: Integer): Integer;
27.  
28.   public
29.     constructor Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);
30.     procedure draw;
31.  
32.   end;
33.  
34.   implementation
35.  
36.  
37. constructor TSineScroller.Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);
38. begin
39.   offset_char := offset;
40.   pos_y := py;
41.   width := w;
42.   scroll_text := text;
43.   canvas_ctx := canvas;
44.   scroll_speed := s_speed;
45.   scroll_pause := False;   // future
46.   scroll_pause_time := 5;
47.   sx := width;
48.   tx := 0;
49.   bm := Tbitmap.Create; // buffer
50.   bm.Width:=width;
51.   bm.Height:=220;
52.   fonts := TImage.Create(nil);
53.   fonts.Picture.LoadFromFile(Bitmap_font_file);
54.   fonts_width := fw;
55.   fonts_height := fh;
56.   sine_height := sh;
57.   radians := 3.14 / 180;
58.   font_height_zoom := 2;
59. end;
60.  
61. function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;
62. var
63.   p, cx, cy, l, m: Integer;
64.   src_Rect,dst_Rect : TRect;
65.   sinTable: array of Double;
66. begin
67.   if (x > width) and (x > 0) then
68.   begin
69.     Result := 0;
70.     Exit;
71.   end;
72.   p := Ord(charek);
73.   cx := (p - Ord(offset_char)) * fonts_width;
74.   cy := 0;
75.   sinTable :=[];
76.   m:=0;
77.   SetLength(sinTable, fonts_width);
78.   // sin table[] calculation
79.   for l := 0 to fonts_width - 1 do sinTable[l] :=  Sin(-1 * (x + tx + l) / 1.4 * radians);
80.   for l := 0 to fonts_width-2  do
81.   begin
82.      if (cx >= 0) and (x + l <= width) then
83.       begin
84.        m := pos_y + Round(sine_height * sinTable[l]);
85.       dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));
86.       src_Rect := Rect(cx + l, cy,  cx + l + 2, cy + fonts_height);
87.       bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)
88.     end;
89.   end;
90.  
91.   Result := 1;
92. end;
93.  
94.   procedure TSineScroller.draw;
95.   var
96.     last_char: Char;
97.     x, i: Integer;
98.     koda: Char;
99.     xLimit: Integer;
100.   begin
101.     if not scroll_pause then
102.       dec(sx, scroll_speed)
103.     else
104.       dec(tx, scroll_speed);
105.  
106.     x := sx;
107.     xLimit := width + fonts_width;
108.  
109.     for i := 1 to Length(scroll_text) do
110.     begin
111.       koda := scroll_text[i];
112.       x := x + fonts_width;
113.       if (x > -fonts_width) and (x < xLimit) then
114.       begin
115.         if drawFontChar(koda, x) = 0 then
116.           Break;
117.         last_char := koda;
118.       end;
119.     end;
120.   if x < 0 then  sx := xLimit;
121.   // final display
122.      canvas_ctx.Draw(0,100,bm);
123.      bm.Canvas.Brush.Color :=clBlack;
124.      bm.Canvas.FillRect(0,0,640,220);
125.   end;
126. end.
127.  

[Josh]

hi

just after aquick look,

Do you need the Precision of Double?
Would Single Help speed?

it appears as though the sin table is being calculated for each character,
can this not be done just once when its created, should speed upcalculation. this would stop the alloc of memory on each call, would require the array def to be removed from proc and made/defined as global

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

1.  sinTable: array of Double;
2.  
3. for l := 0 to fonts_width - 1 do sinTable[l] :=  Sin(-1 * (x + tx + l) / 1.4 * radians);

not sure so you may need to check , pixel accuracy is fine but on most monitors you could probaly speed up by incremeting in 2, the for loop

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

1. for l := 0 to fonts_width-2  do
2.   begin
3.      if (cx >= 0) and (x + l <= width) then
4.       begin
5.        m := pos_y + Round(sine_height * sinTable[l]);
6.       dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));
7.       src_Rect := Rect(cx + l, cy,  cx + l + 2, cy + fonts_height);
8.       bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)
9.     end;
10.   end;
11.  
12.  
13. with
14.  
15.   l:=0;
16.   while l<=fonts_width-2  do
17.   begin
18.      if (cx >= 0) and (x + l <= width) then
19.      begin
20.        m := pos_y + Round(sine_height * sinTable[l]);
21.        dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));
22.        src_Rect := Rect(cx + l, cy,  cx + l + 2, cy + fonts_height);
23.        bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)
24.      end;
25.      inc(l,2);
26.   end;
27.  

[Gigatron]

Hi,
Thank you @Josh

I modified the code according to your changes, I did not make the sine table calculated because of the size of the table, each time the VBL passes the calculation must be redone because the program processes in pixels, so that's a large painting. In fact there is a solution but I don't have the time I'm lazy (lazy coder)
Here the 'while' loop speeds up the display 4 pixels shift / Vbl.

Finally, I really like to code with Pascal language ;

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, Spin,
9.   StdCtrls, SinScroller;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     GroupBox1: TGroupBox;
17.     SpinEdit1: TSpinEdit;
18.     SpinEdit2: TSpinEdit;
19.     Timer1: TTimer;
20.  
21.     procedure FormCreate(Sender: TObject);
22.     procedure FormDestroy(Sender: TObject);
23.     procedure FormPaint(Sender: TObject);
24.     procedure SpinEdit1Change(Sender: TObject);
25.     procedure Timer1Timer(Sender: TObject);
26.   private
27.   public
28.   end;
29.  
30. var
31.   Form1: TForm1;
32.   Scroller: TSineScroller;
33.   s_text : string = ' LAZARUS FPC THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  LAINZ - TRON  -  KODEZWERG  -  JOSH  -  GUVA  -  HUKKA  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM ';
34.  
35. implementation
36.  
37. {$R *.lfm}
38.  
39. { TForm1 }
40.  
41. procedure TForm1.FormCreate(Sender: TObject);
42. begin
43.   DoubleBuffered:=true;
44.   Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,80, 12,  s_text);
45.  end;
46.  
47. procedure TForm1.FormDestroy(Sender: TObject);
48. begin
49.   Scroller.Free;
50. end;
51.  
52. procedure TForm1.FormPaint(Sender: TObject);
53. begin
54.         Scroller.draw;
55. end;
56.  
57. procedure TForm1.SpinEdit1Change(Sender: TObject);
58. begin
59.      Scroller.Free;
60.      Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,SpinEdit1.Value, SpinEdit2.Value,  s_text);
61. end;
62.  
63. procedure TForm1.Timer1Timer(Sender: TObject);
64.  
65. begin
66.     Repaint;
67. end;
68.  
69. end.
70.  

Sinscroller unit ;

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

1. unit SinScroller;
2.  
3. interface
4.  
5. uses
6.   Classes, SysUtils, Graphics, ExtCtrls;
7.  
8. type
9.   TSineScroller = class
10.   private
11.     offset_char: Char; // First Character in bitmap fonts
12.     pos_y: Integer;
13.     width: Integer;
14.     scroll_text: string;
15.     canvas_ctx: TCanvas;
16.     scroll_speed: Integer;
17.     scroll_pause: Boolean;
18.     scroll_pause_time: Integer;
19.     sx, tx: Integer;
20.     bm : TBitmap;
21.     fonts: TImage;
22.     fonts_width, fonts_height: Integer;
23.     sine_height: Integer;
24.     radians: Single; // Precision
25.     font_height_zoom: Double;
26.     function drawFontChar(charek: Char; x: Integer): Integer;
27.  
28.   public
29.     constructor Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);
30.     procedure draw;
31.  
32.   end;
33.  
34.   implementation
35.  
36.  
37. constructor TSineScroller.Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);
38. begin
39.   offset_char := offset;
40.   pos_y := py;
41.   width := w;
42.   scroll_text := text;
43.   canvas_ctx := canvas;
44.   scroll_speed := s_speed;
45.   scroll_pause := False;   // future
46.   scroll_pause_time := 5;
47.   sx := width;
48.   tx := 0;
49.   bm := Tbitmap.Create; // buffer
50.   bm.Width:=width;
51.   bm.Height:=220;
52.   fonts := TImage.Create(nil);
53.   fonts.Picture.LoadFromFile(Bitmap_font_file);
54.   fonts_width := fw;
55.   fonts_height := fh;
56.   sine_height := sh;
57.   radians := 3.14 / 180;
58.   font_height_zoom := 2;
59.  
60. end;
61.  
62. function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;
63. var
64.   p, cx, cy, l, m: Integer;
65.   src_Rect,dst_Rect : TRect;
66.   sinTable: array of Single;  // forgot: precsion is Single now;
67. begin
68.   if (x > width) and (x > 0) then
69.   begin
70.     Result := 0;
71.     Exit;
72.   end;
73.   p := Ord(charek);
74.   cx := (p - Ord(offset_char)) * fonts_width;
75.   cy := 0;
76.   sinTable :=[];
77.   m:=0;
78.   SetLength(sinTable, fonts_width);
79.   // sin table[] calculation
80.   for l := 0 to fonts_width - 1  do sinTable[l] :=  Sin(-1 * (x + tx + l) / 1.4 * radians);
81.   l:=0;
82.   while l<=fonts_width-2  do
83.   begin
84.      if (cx >= 0) and (x + l <= width) then
85.      begin
86.        m := pos_y + Round(sine_height * sinTable[l]);
87.        dst_Rect := Rect(x + l, m, x + l + 4, m + Round(fonts_height * font_height_zoom));
88.        src_Rect := Rect(cx + l, cy,  cx + l + 4, cy + fonts_height);
89.        bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)
90.      end;
91.      inc(l,4); // 2
92.   end;
93.  
94.   Result := 1;
95. end;
96.  
97.   procedure TSineScroller.draw;
98.   var
99.     last_char: Char;
100.     x, i: Integer;
101.     koda: Char;
102.     xLimit: Integer;
103.   begin
104.     if not scroll_pause then
105.       dec(sx, scroll_speed)
106.     else
107.       dec(tx, scroll_speed);
108.     x := sx;
109.     xLimit := width + fonts_width;
110.     for i := 1 to Length(scroll_text) do
111.     begin
112.       koda := scroll_text[i];
113.       x := x + fonts_width;
114.       if (x > -fonts_width) and (x < xLimit) then
115.       begin
116.         if drawFontChar(koda, x) = 0 then
117.           Break;
118.         last_char := koda;
119.       end;
120.     end;
121.   if x < 0 then  sx := xLimit;
122.   // final display
123.      canvas_ctx.Draw(0,100,bm);
124.      bm.Canvas.Brush.Color :=clBlack;
125.      bm.Canvas.FillRect(0,0,640,220);
126.   end;
127. end.

[TRon]

can this not be done just once when its created, should speed upcalculation. this would stop the alloc of memory on each call, would require the array def to be removed from proc and made/defined as global

Yes, that is the better approach but also then things could be improved.

Though these days it does not matter much it is possible to use an integer table (shl to keep/store precision and shr for actual use) but that is assuming a 'normal' sine amplitude. What would be better is storing a complete cycle in a table (adjusted to real y coordinates) and only use an index (adjust with a speed increase/delay). You can then apply mod to roll over the sine table (because the number of entries in the table are known). You can apply different modifiers to the index to achieve different wave effects and/or increase/decrease speed.

If you take it even one step further it is possible to pre-calc the rectangles (both the source and destination, but especially the destination rectangle would probably be the most effective).

No need to bother with graphics you can just toy with the calculations and arrays for a comparison and calculate let's say a million times and time the difference between the different calculations/lookup methods. Jsut know that everything pre calculated does not take time in the actual render loop.

When working with calculations each and every cpu cycle counts and the compiler is usually able to make the best out of it using optimizations but that is not always the case (you would have to output the assembler code in order to see the actual effect of the optimization).

BTW: i have not looked at the actual rectangle draw implementation but ideally, and in this particular case of 2 pixels width (2xrgba =  64 bits) it is possible to write a specialized copy routine in order to 'move' the pixels around, one (vertical) line (of two pixels width) at a time using a modulo modifier. That would be able to speed up things as well but in that case it must be sure that pixels are stored inside the bitmap as 4 bytes (or 3 bytes per pixels ofc as the basics are the same). Without having seen the actual rectangle draw implementation I am ofc not sure but I suspect it would be faster.

In fact there is a solution but I don't have the time I'm lazy (lazy coder)

And that, my friend, is the actual issue   

But seriously, it takes another approach to optimize things to the fullest. and in case everything else fails (or isn't sufficient) there is always the option to pre-render graphics (but I personally consider that defeat).

[Josh]

Hi

I was thinking of something like this

Precalculate the SinTable;

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

1. procedure TSineScroller.PrecomputeSinTable;
2. var
3.   l: Integer;
4. begin
5.   for l := 0 to High(sinTable) do
6.     sinTable[l] := Sin(-l / 1.4 * radians);
7. end;        

modify the code for the source and dest rect

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

1.  
2. add Var tableLength,Index:Integer;// should speed up calc only once.
3.  
4.   m:=0;
5.   tableLength := Length(sinTable);
6.   l:=0;
7.   while l<=fonts_width-2 do
8.   begin
9.     if (cx >= 0) and (x + l <= width) then
10.     begin
11.       index := (x + tx + l + tableLength) mod tableLength;  // make sure index is in range
12.       m := pos_y + Round(sine_height * sinTable[index]);
13.       dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));
14.       src_Rect := Rect(cx + l, cy,  cx + l + 2, cy + fonts_height);
15.       bm.Canvas.CopyRect(dst_Rect,fonts.Picture.Bitmap.Canvas,src_Rect)
16.     end;
17.     inc(l,1);  // increase this to 2 should give a speed boost, but may effect quality
18.   end;          

the in constructor

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

1. SetLength(sinTable, width + fonts_width);
2.   PrecomputeSinTable;              

The above is  only from looking at your code, I have not tried it so may or may not work.

edit added some text

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

1. inc(l,1);  // increase this to 2 should give a speed boost, but may effect quality

[Gigatron]

Ok  many tanks @Josh

This is the latest version of the code, the only other thing left is to triple buffer later 

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

1. unit SinScroller;
2.  
3. interface
4.  
5. uses
6.   Classes, SysUtils, Graphics, ExtCtrls;
7.  
8. type
9.   TSineScroller = class
10.   private
11.     offset_char: Char; // First Character in bitmap fonts
12.     pos_y: Integer;
13.     width: Integer;
14.     scroll_text: string;
15.     canvas_ctx: TCanvas;
16.     scroll_speed: Integer;
17.     sx: Integer;
18.     bm: TBitmap;
19.     fonts: TImage;
20.     fonts_width, fonts_height: Integer;
21.     sine_height: Integer;
22.     radians: Single;
23.     font_height_zoom: Single;
24.     sinTable: array of Single;
25.  
26.     procedure PrecalculateSinTable;
27.     function drawFontChar(charek: Char; x: Integer): Integer;
28.  
29.   public
30.     constructor Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer; s_speed: integer; text: string);
31.     procedure draw;
32.   end;
33.  
34. implementation
35.  
36. constructor TSineScroller.Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer; s_speed: integer; text: string);
37. begin
38.   offset_char := offset;
39.   pos_y := py;
40.   width := w;
41.   scroll_text := text;
42.   canvas_ctx := canvas;
43.   scroll_speed := s_speed;
44.   sx := width;
45.   bm := TBitmap.Create; // buffer
46.   bm.Width := width;
47.   bm.Height := 220;
48.   fonts := TImage.Create(nil);
49.   fonts.Picture.LoadFromFile(Bitmap_font_file);
50.   fonts_width := fw;
51.   fonts_height := fh;
52.   sine_height := sh;
53.   radians := 0.0174; // PI/180 0.0174444444
54.   font_height_zoom := 2;
55.   SetLength(sinTable, width + fonts_width);
56.   PrecalculateSinTable;
57. end;
58.  
59. procedure TSineScroller.PrecalculateSinTable;
60. var
61.   i: Integer;
62. begin
63.   for i := 0 to High(sinTable) do
64.   begin
65.     sinTable[i] := Sin(-1 * i / 1.4 * radians);
66.   end;
67. end;
68.  
69. function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;
70. var
71.   p, cx, cy, l, m: Integer;
72.   src_Rect, dst_Rect: TRect;
73.   tableLength,Index:Integer;
74. begin
75.  
76.   if (x > width) and (x > 0) then
77.   begin
78.     Result := 0;
79.     Exit;
80.   end;
81.  
82.   p := Ord(charek);
83.   cx := (p - Ord(offset_char)) * fonts_width;
84.   cy := 0;
85.   tableLength := Length(sinTable);
86.   l := 0;
87.  
88.   while l <= fonts_width - 2 do
89.   begin
90.     if (cx >= 0) or (x + l <= width) then
91.     begin
92.       index := (x + l + tableLength) mod tableLength;  // make sure index is in range
93.       m := pos_y + Round(sine_height * sinTable[index]);
94.       dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));
95.       src_Rect := Rect(cx + l, cy, cx + l + 2, cy + fonts_height);
96.       bm.Canvas.CopyRect(dst_Rect, fonts.Picture.Bitmap.Canvas, src_Rect);
97.     end;
98.     Inc(l, 2);
99.   end;
100.  
101.   Result := 1;
102. end;
103.  
104. procedure TSineScroller.draw;
105. var
106.   x, i: Integer;
107.   koda: Char;
108.   xLimit: Integer;
109. begin
110.  
111.   Dec(sx, scroll_speed);
112.  
113.   x := sx;
114.   xLimit := width + fonts_width;
115.   for i := 1 to Length(scroll_text) do
116.   begin
117.     koda := scroll_text[i];
118.     Inc(x, fonts_width);
119.     if (x > -fonts_width) and (x < xLimit) then
120.     begin
121.       if drawFontChar(koda, x) = 0 then
122.         Break;
123.     end;
124.   end;
125.  
126.   if x < 0 then sx := xLimit;
127.   // final display
128.   canvas_ctx.Draw(0, 100, bm);
129.   bm.Canvas.Brush.Color := clBlack;
130.   bm.Canvas.FillRect(Rect(0, 0, bm.Width, bm.Height));
131. end;
132.  
133. end.
134.  

[Josh]

I assume its speeding up?

Another tweek, would be to convert the array to integer should speed the calc up, but as you are aware its the amount of pixel(s) copryect thats the bottleneck

Thats all the tweaks I can think of with the code, I will probably try it out over the weekend, if there was a complete project.zip file to test.

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

1. font_height_zoom: Integer; // does this need to float? if not
2.  
3. font_height_mul_zoom:=fonts_height * font_height_zoom; // you probably want to change name, i chose a long descriptive one
4. sinTable: array of Integer;
5.  
6.  
7. create
8. font_height_mul_zoom:=fonts_height * font_height_zoom;
9. SetLength(sinTable, width + fonts_width);  
10.  
11. procedure TSineScroller.PrecomputeSinTable;
12. var
13.   l: Integer;
14. begin
15.   for l := 0 to High(sinTable) do  sinTable[l] := Round(sine_height * (Sin(-l / 1.4 * radians)));
16. end;  
17.  
18. draw code
19.  
20.       m := pos_y + sinTable[index];
21.       dst_Rect := Rect(x + l, m, x + l + 2, m + font_height_mul_zoom);

     

[TRon]

I did not make the sine table calculated because of the size of the table, each time the VBL passes the calculation must be redone because the program processes in pixels, so that's a large painting. In fact there is a solution but I don't have the time I'm lazy (lazy coder)

Just calculate a complete wave and use offsets as I mentioned in one of my previous posts.

But anyhows, the following is imho good for measurements (note that the code still calculated the sine when rendering).

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

1. function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;
2. const
3.   pixel_modulo = 8;  // make this multiples of 2, thus 1, 2, 4, 8, 16 and 32
4. var
5.   p, cx, cy, l, m: Integer;
6.   src_Rect,dst_Rect : TRect;
7. begin
8.   Result := 1;
9.   if (x > width) and (x > 0) then
10.   begin
11.     Result := 0;
12.     Exit;
13.   end;
14.  
15.   p := Asc(charek);
16.   cx := (p - Ord(offset_char)) * fonts_width;
17.   cy := 0;
18.  
19.   l := 0;
20.   while l < fonts_width - 1 do
21.   begin
22.     if (cx >= 0) and (x <= width) and (x + l >= 0) then
23.     begin
24.       m := pos_y + Round((sine_height) * Sin(-1 * (x + tx + l) / 1.4 * radians));
25.  
26.       dst_Rect := Rect( x + l, m,   x + l + pixel_modulo, m  + Round(fonts_height * font_height_zoom));
27.       src_Rect := Rect(cx + l, cy, cx + l + pixel_modulo, cy + fonts_height);
28.  
29.       canvas_ctx.CopyRect(dst_Rect, fonts.Picture.Bitmap.Canvas , src_Rect);
30.     end;
31.     inc(l, pixel_modulo);
32.   end;
33.  
34.   Result := 1;
35. end;
36.  

And that results to attached picture. I admit it is still poor result for simply pushing around 160k of bytes.

[Gigatron]

Many Thanks @Tron & @Josh

I think it's done on 95% optimized ; I will make some addition in future..

** Don't forget, alone you don't go fast with others you exceed the speed of light **

Final code :

Unit :

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

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
9.   StdCtrls, SinScroller;
10.  
11. type
12.  
13.   { TForm1 }
14.  
15.   TForm1 = class(TForm)
16.     GroupBox1: TGroupBox;
17.     SpinEdit1: TSpinEdit;
18.     SpinEdit2: TSpinEdit;
19.     Timer1: TTimer;
20.     procedure FormCreate(Sender: TObject);
21.     procedure FormDestroy(Sender: TObject);
22.     procedure FormPaint(Sender: TObject);
23.     procedure SpinEdit1Change(Sender: TObject);
24.     procedure Timer1Timer(Sender: TObject);
25.   private
26.   public
27.   end;
28.  
29. var
30.   Form1: TForm1;
31.   Scroller: TSineScroller;
32.   s_text : string = ' LAZARUS PASCAL FPC 4.0.0 DYNAMIC COMPILER THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR    LAINZ  TRON    KODEZWERG    JOSH    GUVA    HUKKA    MARCOV    MARTIN-FR    PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM        ';
33.  
34. implementation
35.  
36. {$R *.lfm}
37.  
38. { TForm1 }
39.  
40. procedure TForm1.FormCreate(Sender: TObject);
41. begin
42.  // DoubleBuffered:=true;
43.   Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,80, 12,  s_text);
44.  end;
45.  
46. procedure TForm1.FormDestroy(Sender: TObject);
47. begin
48.     Scroller.Free;
49. end;
50.  
51. procedure TForm1.FormPaint(Sender: TObject);
52. begin
53.      Scroller.draw;
54. end;
55.  
56. procedure TForm1.SpinEdit1Change(Sender: TObject);
57. begin
58.      Scroller.Free;
59.      Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640, 80, 32, 32,SpinEdit1.Value, SpinEdit2.Value,  s_text);
60. end;
61.  
62. procedure TForm1.Timer1Timer(Sender: TObject);
63. begin
64.       Repaint;
65. end;
66.  
67. end.
68.  

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

1. unit SinScroller;
2.  
3. interface
4.  
5. uses
6.   Classes, SysUtils, Graphics, ExtCtrls;
7.  
8. type
9.   TSineScroller = class
10.   private
11.     offset_char: Char; // First Character in bitmap fonts
12.     pos_y: Integer;
13.     width: Integer;
14.     scroll_text: string;
15.     canvas_ctx: TCanvas;
16.     scroll_speed: Integer;
17.     sx: Integer;
18.     bm: TBitmap;
19.     fonts: TImage;
20.     fonts_width, fonts_height: Integer;
21.     sine_height: Integer;
22.     radians: Single;
23.     font_height_zoom: Integer;
24.     sinTable: array of Single;
25.     tableLength : integer;
26.  
27.     procedure PrecalculateSinTable;
28.     function drawFontChar(charek: Char; x: Integer): Integer;
29.  
30.   public
31.     constructor Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer; s_speed: integer; text: string);
32.     procedure draw;
33.   end;
34.  
35. implementation
36.  
37. constructor TSineScroller.Create(canvas: TCanvas; Bitmap_font_file: string; offset: Char; w, py, fw, fh, sh: Integer; s_speed: integer; text: string);
38. begin
39.   offset_char := offset;
40.   pos_y := py;
41.   width := w;
42.   scroll_text := text;
43.   canvas_ctx := canvas;
44.   scroll_speed := s_speed;
45.   sx := width;
46.   fonts := TImage.Create(nil);
47.   fonts.Picture.LoadFromFile(Bitmap_font_file);
48.   fonts_width := fw;
49.   fonts_height := fh;
50.   sine_height := sh;
51.   bm := TBitmap.Create; // buffer
52.   bm.Width := width;
53.   bm.Height := 220;
54.  
55.   radians := 0.0174; // PI/180 0.0174444444
56.   font_height_zoom := 2;
57.   SetLength(sinTable, width + fonts_width);
58.   tableLength := Length(sinTable);
59.   PrecalculateSinTable;
60. end;
61.  
62. procedure TSineScroller.PrecalculateSinTable;
63. var
64.   i: Integer;
65. begin
66.   for i := 0 to High(sinTable) do
67.   begin
68.     sinTable[i] := Sin(-1 * i / 1.4 * radians);    // float single precision
69.    // sinTable[i] := Round(sine_height * (Sin(-i / 1.4 * radians)));   // int
70.   end;
71. end;
72.  
73. function TSineScroller.drawFontChar(charek: Char; x: Integer): Integer;
74. const
75.   pixel_modulo = 4;  // make this multiples of 2, thus 1, 2, 4, 8, 16 and 32
76. var
77.   p, cx, cy, l, m: Integer;
78.   src_Rect,dst_Rect : TRect;
79. begin
80.   Result := 1;
81.   if (x > width) and (x > 0) then
82.   begin
83.     Result := 0;
84.     Exit;
85.   end;
86.  
87.   p := Ord(charek);
88.   cx := (p - Ord(offset_char)) * fonts_width;
89.   cy := 0;
90.  
91.   l := 0;
92.   while l < fonts_width - 2 do
93.   begin
94.       m := pos_y + Round((sine_height) * Sin(-1 * (x +  l) / 1.4 * radians));
95.       dst_Rect := Rect( x + l, m,   x + l + pixel_modulo, m  + Round(fonts_height * font_height_zoom));
96.       src_Rect := Rect(cx + l, cy, cx + l + pixel_modulo, cy + fonts_height);
97.     if (cx >= 0) and (x <= width) and (x + l >= 0) then
98.     begin
99.  
100.       if(p<>32) then bm.Canvas.CopyRect(dst_Rect, fonts.Picture.Bitmap.Canvas , src_Rect);   // bypass Space char (32) !
101.     end;
102.     inc(l, pixel_modulo);
103.   end;
104.  
105.   Result := 1;
106. end;
107.  
108. procedure TSineScroller.draw;
109. var
110.   x, i: Integer;
111.   koda: Char;
112.   xLimit: Integer;
113. begin
114.  
115.   Dec(sx, scroll_speed);
116.  
117.   x := sx;
118.   xLimit := width + fonts_width;
119.   for i := 1 to Length(scroll_text) do
120.   begin
121.     koda := scroll_text[i];
122.     Inc(x, fonts_width);
123.     if (x > -fonts_width) and (x < xLimit) then
124.     begin
125.       if drawFontChar(koda, x) = 0 then
126.         Break;
127.     end;
128.   end;
129.  
130.   if x < 0 then sx := xLimit;
131.   // final display
132.   canvas_ctx.Draw(0, 100, bm);
133.   bm.Canvas.Brush.Color := clBlack;
134.   bm.Canvas.FillRect(Rect(0, 0, bm.Width, bm.Height));
135. end;
136.  
137. end.
138.