Recent

Author Topic: Demo Scene Bitmap Font Scroller  (Read 3801 times)

Gigatron

  • Jr. Member
  • **
  • Posts: 51
  • Amiga
Demo Scene Bitmap Font Scroller
« on: April 23, 2024, 05:56:27 pm »
Hi L&G,

I will try to share a bitmap font scroller using BGRABitmap, you will learn how to scroll text.
Bitmap font from the champs cracktro Amiga;

https://www.youtube.com/watch?v=05C-iyxoqLs

The Result in LP :
https://www.youtube.com/watch?v=puFsvBfmIoA

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.   BGRABitmap, BGRABitmapTypes, BGRAVirtualScreen; uplaysound;
  10.  
  11. const
  12.   ascii : Array [0..58] of integer = (26,37,99,99,99,99,99,41,42,43,99,99,44,99,38,99,27,28,29,30,31,32,33,34,35,36,40,99,99,99,99,39,99,0,1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25);
  13.   cop_col:Array[0..245] of String =('#000066','#000055','#000044','#000033','#000022','#000011','#000011','#000022','#000033',
  14.                                             '#000044','#000055','#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc',
  15.                                             '#0000dd','#0000ee','#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff',
  16.                                             '#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff',
  17.                                             '#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff',
  18.                                             '#8888ff','#7777ff','#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff',
  19.                                             '#0000ee','#0000dd','#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066',
  20.                                             '#000055','#000044','#000033','#000022','#000011','#000022','#000033','#000044','#000055',
  21.                                             '#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee',
  22.                                             '#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff',
  23.                                             '#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff',
  24.                                             '#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff',
  25.                                             '#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd',
  26.                                             '#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044',
  27.                                             '#000033','#000022','#000011','#000011','#000022','#000033','#000044','#000055','#000066',
  28.                                             '#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff',
  29.                                             '#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff',
  30.                                             '#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff',
  31.                                             '#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff',
  32.                                             '#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc',
  33.                                             '#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044','#000033',
  34.                                             '#000022','#000011','#000022','#000033','#000044','#000055','#000066','#000077','#000088',
  35.                                             '#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff','#1111ff','#2222ff',
  36.                                             '#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff',
  37.                                             '#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff',
  38.                                             '#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff','#5555ff','#4444ff',
  39.                                             '#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc','#0000bb','#0000aa',
  40.                                             '#000099','#000088','#000077');
  41.  
  42. var
  43.   CharImage: TBGRABitmap;
  44.   ScrollSpeed: integer = 2;
  45.   ScrollCounter: integer = 1;
  46.   CharWidth : integer = 30;
  47.   CharW     : integer = 30;
  48.   CharHeight :  integer = 48;
  49.   CharsPerLine : integer = 240;
  50.   ScrollText : String = '                  ....       GIGATRON THE LEADER PRESENTS BITMAP FONT SCROLLER DEMO CODED WITH LAZARUS PASCAL GREETINGS TO PUMA, JAGUAR, SERVAL, LYNX, CARACAL, PANTHER, OCELOT, CHEETAH, WILD CAT,  ...  FONT FROM THE CHAMPS CRACKTRO AMIGA IN 1988  RELEASE DATE LATE ON (( 22.04.2024 ))     SEE YOU    .....';
  51.   hexColor: string;
  52.   red, green, blue: Byte;
  53.   j,pause,snd_timer  : integer;
  54.  
  55. type
  56.  
  57.   { TForm1 }
  58.  
  59.   TForm1 = class(TForm)
  60.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  61.     playsound1: Tplaysound;
  62.     Timer1: TTimer;
  63.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  64.     procedure FormCreate(Sender: TObject);
  65.     procedure FormDestroy(Sender: TObject);
  66.     procedure Timer1Timer(Sender: TObject);
  67.   private
  68.  
  69.   public
  70.  
  71.   end;
  72.  
  73.  
  74. var
  75.   Form1: TForm1;
  76.  
  77. implementation
  78.  
  79. {$R *.lfm}
  80.  
  81.  
  82. procedure TForm1.FormCreate(Sender: TObject);
  83. begin
  84.  // playsound1.Execute;        // play once when form created !
  85.   CharImage := TBGRABitmap.Create('font2x.png');
  86.   CharImage.SetSize(30,2226);
  87.   j:=0;
  88.   pause := 0;
  89. end;
  90.  
  91. procedure HexToRGB(hex: string; var r, g, b: Byte);
  92. begin
  93.   r := StrToInt('$' + Copy(hex, 2, 2));
  94.   g := StrToInt('$' + Copy(hex, 4, 2));
  95.   b := StrToInt('$' + Copy(hex, 6, 2));
  96. end;
  97.  
  98. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  99. var
  100.    I,   Chr: Integer;
  101.    CharX, CharY: Integer;
  102.    ScrollOffset: Integer;
  103.  
  104. begin
  105.   Bitmap.Fill(BGRAPixelTransparent);
  106.  
  107.   // raster bars cycle colors
  108.   for i := 0 to 20 do
  109.   begin
  110.        hexColor := cop_col[i+j];
  111.        HexToRGB(hexColor, red, green, blue);
  112.        Bitmap.FillRect(0,242+i*2,640,242+i*2-2,RGBToColor(red,green,blue));
  113.  
  114.   end;
  115.  
  116.      inc(pause);
  117.    if (pause>=1) then
  118.    begin
  119.        inc(j);
  120.        pause := 0;
  121.        if(j>=184) then j:=0;
  122.  
  123.     end;
  124.  
  125.   // Bitmap Scrolling  copy bitmap char with correct ascii code ,  x,y,x1,y1 like Amiga blitter
  126.   ScrollOffset :=  ScrollCounter ;
  127.   for I := 0 to 24 do
  128.     begin
  129.        Chr   := Ord(ScrollText[I]);
  130.        CharX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset  ;
  131.        CharY := ((I - 1) div CharsPerLine) * CharHeight  ;
  132.        Bitmap.PutImagePart(CharX , 240+CharY , CharImage, Rect(0, ascii[Chr-32]*CharHeight , CharW, ascii[Chr-32]*CharHeight+CharHeight), dmDrawWithTransparency);
  133.  
  134.   end;
  135.  
  136.   ScrollCounter := ScrollCounter + ScrollSpeed;
  137.  
  138.   if ScrollCounter >= CharWidth then
  139.      begin
  140.             ScrollCounter := ScrollCounter - CharWidth;
  141.             ScrollText := Copy(ScrollText,2, Length(ScrollText) - 1) + ScrollText[1];
  142.      end;
  143.  
  144.  // play sound every xxx sec
  145.  // inc(snd_timer);
  146.  //  if(snd_timer>500) then
  147.  // begin
  148.  //     snd_timer :=0;
  149.  //     playsound1.Execute;
  150.  
  151.  //  end
  152.  
  153. end;
  154.  
  155. procedure TForm1.Timer1Timer(Sender: TObject);
  156. begin
  157.       BGRAVirtualScreen1.RedrawBitmap;
  158.  
  159. end;
  160.  
  161. procedure TForm1.FormDestroy(Sender: TObject);
  162. // libere tout !!
  163. begin
  164.    //playsound1.Free;
  165.    CharImage.Free;
  166.  
  167. end;
  168.  
  169. end.
  170.  
« Last Edit: April 23, 2024, 06:17:41 pm by Gigatron »
Sub Quantum Technology ! If your friend are clever you are too !!

circular

  • Hero Member
  • *****
  • Posts: 4239
    • Personal webpage
Re: Demo Scene Bitmap Font Scroller
« Reply #1 on: April 24, 2024, 06:53:32 pm »
That's clever to use the font as mask, so you can do any gradient in it.  :)
Conscience is the debugger of the mind

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2222
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demo Scene Bitmap Font Scroller
« Reply #2 on: April 24, 2024, 07:21:14 pm »
That's clever to use the font as mask, so you can do any gradient in it.  :)
I also was looking twice if I misread there something.
Last time I played with BitmapFontScrollers the Bitmap was colored to save some cycles of CPU.
Okay, it was back when I had my first 386 and every little cache and cycle needed to be used clever :D
So a new way of doing such is pretty welcomed  O:-)
(while I become never a fan of pre-initialized values for such, if colored in realtime, color can also be calculated in realtime)
(same with many variable that G uses, it works on his display/setting, but some code snippets are missing the initial values shown, like size for screen/image etc ^_^)
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Gigatron

  • Jr. Member
  • **
  • Posts: 51
  • Amiga
Re: Demo Scene Bitmap Font Scroller
« Reply #3 on: April 25, 2024, 03:14:55 am »
That's clever to use the font as mask, so you can do any gradient in it.  :)
In addition I don't write all the gradient datas :)
Copper of Amiga make this gradient with skip,move and wait command, i am using Winuae to
make screenshot without antialiasing methode and extract the picture of the raster bar or copper bar.
After that i use this code to extract copper datas.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls,
  9.   BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes ;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  17.     Memo1: TMemo;
  18.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  19.     procedure FormCreate(Sender: TObject);
  20.     procedure FormShow(Sender: TObject);
  21.   private
  22.  
  23.   public
  24.  
  25.   end;
  26.  
  27. var
  28.   Form1: TForm1;
  29.   image  : TBGRABitmap;
  30.  
  31. implementation
  32.  
  33. {$R *.lfm}
  34.  
  35. { TForm1 }
  36.  
  37. procedure TForm1.FormCreate(Sender: TObject);
  38. begin
  39.        image := TBGRABitmap.Create('rasters.png'); // 1 pixel en y ; 640 pixel en x
  40. end;
  41.  
  42. procedure TForm1.FormShow(Sender: TObject);
  43. var  x,c : integer;
  44.      p : PBGRAPixel;
  45.      rez,final  : string;
  46. begin
  47.     c:= 0;  // data array counter
  48.     rez := '';  // store raster color data
  49.     final :=''; // final result of color data
  50.     memo1.Text :=''; // clear memo1 text
  51.  
  52.     for x := 0 to image.Width-1 do
  53.     begin
  54.       p := image.GetScanlineAt(x,0);  // scan just x to 639+1
  55.       rez := intToHex(p^.red) + intToHex(p^.green) + intToHex(p^.blue);  // extract r,g,b component ;
  56.       final := final + QuotedStr('#'+rez) +',' ;
  57.       c:= x;
  58.     end;
  59.       SetLength(final,length(final)-1); // remove last char :
  60.       memo1.Text := 'const ' + #13#10;
  61.       memo1.Text := memo1.Text  + 'raster_data :Array[0..'+intToStr(c)+'] of String =('  + final + ');' ;
  62.  
  63. end;
  64.  
  65. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  66. begin
  67.        Bitmap.Canvas2D.drawImage(image,0,0,640-1,160,rfLinear); // stretch a bit ;
  68. end;
  69.  
  70. end.
  71.  

« Last Edit: April 25, 2024, 03:24:39 am by Gigatron »
Sub Quantum Technology ! If your friend are clever you are too !!

TRon

  • Hero Member
  • *****
  • Posts: 2663
Re: Demo Scene Bitmap Font Scroller
« Reply #4 on: April 26, 2024, 02:26:28 am »
That's clever to use the font as mask, so you can do any gradient in it.  :)
Cookie cutting  was such a bliss with the blitter. The copper handled the rest :)

So much grunt required on a 'normal' pc to be able to achieve the same effects...

circular

  • Hero Member
  • *****
  • Posts: 4239
    • Personal webpage
Re: Demo Scene Bitmap Font Scroller
« Reply #5 on: April 26, 2024, 08:34:55 am »
Cookie cutting sounds tasty.  :)

I presume it was to a particular technology?
Conscience is the debugger of the mind

TRon

  • Hero Member
  • *****
  • Posts: 2663
Re: Demo Scene Bitmap Font Scroller
« Reply #6 on: April 26, 2024, 08:52:35 am »
Cookie cutting sounds tasty.  :)
For sure it is but beware of its ability to make you fat(ter)  :D

Quote
I presume it was to a particular technology?
correct. It is a particular usage of the blitter. For an small introduction see "The cookie-cut function" on this page.

For a technical view of the blitter see attachment from the AHRM.

More information about minterm's see this page.
« Last Edit: April 26, 2024, 08:57:02 am by TRon »

Gigatron

  • Jr. Member
  • **
  • Posts: 51
  • Amiga
Re: Demo Scene Bitmap Font Scroller
« Reply #7 on: April 27, 2024, 12:35:51 am »
Hi,

After raster image ripped from an intro on winuae and extracted the colors, i can now display them and play with it
by cycling it on transparent logo or picture ;
the code is easy to understand.

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   BGRAVirtualScreen, BGRABitmap,BGRABitmapTypes;
  10.  
  11. const
  12.  
  13. raster_data :Array[0..639] of String =('#110000','#120000','#150000','#1A0000','#200000','#250000','#290000','#2C0000','#300000','#330000','#370000','#3B0000',
  14. '#3F0000','#430000','#460000','#4A0000','#4E0000','#520000','#560000','#590000','#5D0000','#610000','#650000','#690000','#6C0000','#700000','#750000','#780000',
  15. '#7B0000','#7F0000','#840000','#880000','#8B0000','#8F0000','#930000','#970000','#9B0000','#9E0000','#A20000','#A60000','#AA0000','#AD0000','#B10000','#B50000',
  16. '#BA0000','#BD0000','#C00000','#C40000','#C90000','#CD0000','#D00000','#D30000','#D80000','#DC0000','#DF0000','#E20000','#E60000','#EB0000','#EF0000','#F40000',
  17. '#F80000','#FD0000','#FF0000','#FE0000','#FA0000','#F50000','#F10000','#EC0000','#E70000','#E30000','#E00000','#DD0000','#D90000','#D40000','#D00000','#CD0000',
  18. '#CA0000','#C50000','#C10000','#BE0000','#BB0000','#B60000','#B20000','#AE0000','#AB0000','#A70000','#A30000','#9F0000','#9B0000','#980000','#940000','#900000',
  19. '#8C0000','#890000','#850000','#810000','#7C0000','#790000','#760000','#720000','#6D0000','#690000','#660000','#630000','#5E0000','#5A0000','#570000','#530000',
  20. '#4F0000','#4B0000','#470000','#440000','#400000','#3C0000','#380000','#340000','#310000','#2D0000','#290000','#250000','#210000','#1E0000','#1A0000','#160000',
  21. '#120000','#0E0002','#090005','#050009','#01000E','#000012','#000016','#00001A','#00001E','#000022','#000025','#000029','#00002D','#000031','#000034','#000038',
  22. '#00003C','#000040','#000044','#000047','#00004B','#00004F','#000054','#000057','#00005A','#00005E','#000063','#000066','#00006A','#00006D','#000072','#000076',
  23. '#000079','#00007D','#000081','#000085','#000089','#00008C','#000090','#000094','#000098','#00009B','#00009F','#0000A3','#0000A8','#0000AB','#0000AE','#0000B2',
  24. '#0000B7','#0000BB','#0000BE','#0000C1','#0000C6','#0000CA','#0000CD','#0000D1','#0000D5','#0000D9','#0000DD','#0000E0','#0000E3','#0000E7','#0000EC','#0000F1',
  25. '#0000F5','#0000FA','#0000FE','#0000FF','#0000FD','#0000F8','#0000F4','#0000EF','#0000EA','#0000E5','#0000E2','#0000DF','#0000DC','#0000D7','#0000D3','#0000CF',
  26. '#0000CC','#0000C9','#0000C4','#0000C0','#0000BD','#0000B9','#0000B5','#0000B1','#0000AD','#0000AA','#0000A6','#0000A2','#00009E','#00009A','#000097','#000093',
  27. '#00008E','#00008B','#000088','#000084','#00007F','#00007B','#000078','#000075','#000070','#00006C','#000068','#000065','#000061','#00005D','#000059','#000056',
  28. '#000052','#00004E','#00004A','#000046','#000043','#00003F','#00003B','#000037','#000033','#000030','#00002B','#000127','#000024','#000020','#00001D','#000019',
  29. '#000015','#000011','#00030C','#000608','#000B04','#000F01','#001300','#001700','#001B00','#001F00','#002300','#002601','#002A00','#002E00','#003200','#003500',
  30. '#003900','#003D00','#004200','#004500','#004800','#004C00','#005100','#005500','#005800','#005C00','#006000','#006400','#006700','#006B00','#006F00','#007300',
  31. '#007700','#007A00','#007E00','#008200','#008600','#008A00','#008D00','#009100','#009600','#009900','#009C00','#00A000','#00A500','#00A900','#00AC00','#00AF00',
  32. '#00B400','#00B800','#00BC00','#00BF00','#00C300','#00C700','#00CB00','#00CE00','#00D200','#00D600','#00DB00','#00DE00','#00E100','#00E400','#00E900','#00EE00',
  33. '#00F200','#00F700','#00FB00','#00FF00','#00FF00','#00FB00','#00F700','#00F200','#00EE00','#00E900','#00E400','#00E100','#00DE00','#00DB00','#00D600','#00D200',
  34. '#00CE00','#00CB00','#00C700','#00C300','#00BF00','#00BC00','#00B800','#00B400','#00AF00','#00AC00','#00A900','#00A500','#00A000','#009C00','#009900','#009600',
  35. '#009100','#008D00','#008A00','#008600','#008200','#007E00','#007A00','#007700','#007300','#006F00','#006B00','#006700','#006400','#006000','#005C00','#005800',
  36. '#005500','#005100','#004C00','#004800','#004500','#004200','#003D00','#003900','#003500','#003200','#002F00','#002B00','#012700','#002300','#001F00','#001A00',
  37. '#001600','#001300','#011000','#040E00','#080E00','#0C0F00','#111100','#151400','#191700','#1D1B00','#202000','#242400','#272800','#2B2C00','#303000','#333300',
  38. '#373700','#3B3B00','#3F3F00','#434300','#464600','#4A4A00','#4E4E00','#525200','#565600','#595900','#5D5D00','#616100','#656500','#686800','#6C6C00','#707000',
  39. '#757500','#787800','#7B7B00','#7F7F00','#848400','#888800','#8B8B00','#8E8E00','#939300','#979700','#9A9A00','#9E9E00','#A2A200','#A6A600','#AAAA00','#ADAD00',
  40. '#B1B100','#B5B500','#B9B900','#BDBD00','#C0C000','#C4C400','#C9C900','#CCCC00','#CFCF00','#D3D300','#D7D700','#DCDC00','#DFDF00','#E2E200','#E5E500','#EAEA00',
  41. '#EFEF00','#F4F400','#F8F800','#FDFD00','#FFFF00','#FEFE00','#FAFA00','#F5F500','#F1F100','#ECEC00','#E7E700','#E3E300','#E0E000','#DDDD00','#D9D900','#D5D500',
  42. '#D1D100','#CDCD00','#CACA00','#C6C600','#C1C100','#BEBE00','#BBBB00','#B7B700','#B2B200','#AEAE00','#ABAB00','#A8A800','#A3A300','#9F9F00','#9B9B00','#989800',
  43. '#949400','#909000','#8C8C00','#898900','#858500','#818100','#7D7D00','#797900','#767600','#727200','#6D6D00','#6A6A00','#666600','#636300','#5E5E00','#5A5A00',
  44. '#575700','#545400','#4F4F00','#4B4B00','#474700','#444400','#404000','#3C3C00','#383800','#343400','#313100','#2D2D00','#292900','#252500','#212100','#1D1D00',
  45. '#191900','#151500','#121200','#101001','#0E0E05','#0E0E09','#0F0F0E','#121212','#151516','#18181A','#1D1D1E','#212121','#252525','#292929','#2D2D2D','#313131',
  46. '#343434','#383838','#3C3C3C','#404040','#444444','#474747','#4B4B4B','#4F4F4F','#535353','#575757','#5A5A5A','#5E5E5E','#636363','#666666','#696969','#6D6D6D',
  47. '#727272','#767676','#797979','#7C7C7C','#818181','#858585','#898989','#8C8C8C','#909090','#949494','#989898','#9B9B9B','#9F9F9F','#A3A3A3','#A7A7A7','#ABABAB',
  48. '#AEAEAE','#B2B2B2','#B6B6B6','#BBBBBB','#BEBEBE','#C1C1C1','#C5C5C5','#CACACA','#CDCDCD','#D0D0D0','#D4D4D4','#D9D9D9','#DDDDDD','#E0E0E0','#E3E3E3','#E7E7E7',
  49. '#ECECEC','#F1F1F1','#F5F5F5','#FAFAFA','#FEFEFE','#FFFFFF','#FDFDFD','#F8F8F8','#F4F4F4','#EFEFEF','#EBEBEB','#E6E6E6','#E2E2E2','#DFDFDF','#DCDCDC','#D8D8D8',
  50. '#D3D3D3','#D0D0D0','#CDCDCD','#C9C9C9','#C4C4C4','#C0C0C0','#BDBDBD','#BABABA','#B5B5B5','#B1B1B1','#ADADAD','#AAAAAA','#A6A6A6','#A2A2A2','#9E9E9E','#9B9B9B',
  51. '#979797','#939393','#8F8F8F','#8B8B8B','#888888','#848484','#7F7F7F','#7B7B7B','#787878','#757575','#707070','#6C6C6C','#696969','#656565','#616161','#5D5D5D',
  52. '#595959','#565656','#525252','#4E4E4E','#4A4A4A','#464646','#434343','#3F3F3F','#3B3B3B','#373737','#333333','#303030','#2C2C2C','#282828','#242424','#202020',
  53. '#1C1C1C','#171717','#141414','#111111');
  54.  
  55.  
  56. var
  57.   hexColor: string;
  58.   red, green, blue: Byte;
  59.   j : integer;
  60.   logo : TBGRABitmap;
  61.  
  62.  
  63. type
  64.  
  65.   { TForm1 }
  66.  
  67.   TForm1 = class(TForm)
  68.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  69.     Timer1: TTimer;
  70.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  71.     procedure FormCreate(Sender: TObject);
  72.     procedure Timer1Timer(Sender: TObject);
  73.   private
  74.  
  75.   public
  76.  
  77.   end;
  78.  
  79. var
  80.   Form1: TForm1;
  81.  
  82. implementation
  83.  
  84. {$R *.lfm}
  85.  
  86. { TForm1 }
  87.  
  88. procedure HexToRGB(hex: string; var r, g, b: Byte);   // hexstring color conversion '#ff0000' red 255, green 0 , blue 0
  89. begin
  90.   r := StrToInt('$' + Copy(hex, 2, 2));
  91.   g := StrToInt('$' + Copy(hex, 4, 2));
  92.   b := StrToInt('$' + Copy(hex, 6, 2));
  93. end;
  94.  
  95. procedure TForm1.FormCreate(Sender: TObject);
  96. begin
  97.   j       := 0; // raster color index
  98.   logo    := TBGRABitmap.Create('gtr1.png'); // 640 * 100 pixel
  99. end;
  100.  
  101. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  102. var
  103.   i  : integer;
  104. begin
  105.     // raster bars cycle colors slow down with sleep
  106.   for i := 0 to 639 do
  107.    begin
  108.  
  109.        hexColor := raster_data[j];
  110.        HexToRGB(hexColor, red, green, blue);
  111.        Bitmap.FillRect(i*8,0,i*8+8,100,RGBToColor(red,green,blue));
  112.        j:=j+3;
  113.        if(j>=639) then j:=0;
  114.    end;
  115.        Bitmap.StretchPutImage(rect(0,0,640,100),logo,dmDrawWithTransparency,255);
  116.        sleep(25); // sleep a bit please
  117. end;
  118.  
  119.  
  120. procedure TForm1.Timer1Timer(Sender: TObject);
  121.  
  122. begin
  123.      BGRAVirtualScreen1.RedrawBitmap;
  124.  
  125. end;
  126.  
  127. end.
  128.  
Sub Quantum Technology ! If your friend are clever you are too !!

circular

  • Hero Member
  • *****
  • Posts: 4239
    • Personal webpage
Re: Demo Scene Bitmap Font Scroller
« Reply #8 on: April 27, 2024, 07:59:50 am »
Very nice indeed with the text outline.

Regarding the gradient of colors, there is a simpler (and more optimized) way to determine them using a bit of math:
Code: Pascal  [Select][+][-]
  1. function GetCopperBarColor(x : integer): TBGRAPixel;
  2. const
  3.   // list of copper bar colors
  4.   Colors: array[0..4] of TColor =
  5.     (clRed, clBlue, clLime, clYellow, clWhite);
  6.   // bar size computed from expected total size
  7.   BarSize = 640 div length(Colors);
  8. var
  9.   numColor: integer;
  10.   lightness: integer;
  11. begin
  12.   // the copper bar base color changes with each bar
  13.   numColor := abs(x) div BarSize mod length(Colors);
  14.   // lightness is the opposite of the distance from the center of the bar
  15.   lightness := BarSize - abs(PositiveMod(x, BarSize)*2 - BarSize);
  16.   // compte color in gradient between copper bar color and black
  17.   result := MergeBGRA(Colors[numColor], lightness, BGRABlack, BarSize - lightness);
  18. end;

Regards
Conscience is the debugger of the mind

Gigatron

  • Jr. Member
  • **
  • Posts: 51
  • Amiga
Re: Demo Scene Bitmap Font Scroller
« Reply #9 on: April 30, 2024, 09:50:15 pm »
Hi, i would like to share another bitmap font scroller project port from javascript with classic canvas not BGRA.
My goal is to port for maximum perfs to BGRA;

main code ;
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.   ClassicScroller;
  10.  
  11. type
  12.  
  13.   { TForm1 }
  14.  
  15.   TForm1 = class(TForm)
  16.     Timer1: TTimer;
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure Timer1Timer(Sender: TObject);
  19.   private
  20.  
  21.   public
  22.  
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.   Canvas: TCanvas;
  28.   Scroller: TClassicScroller;
  29.   Scroller1: TClassicScroller;
  30.   Scroller2: TClassicScroller;
  31.   Scroller3: TClassicScroller;
  32.  
  33.   s_text : string = ' LAZARUS FPC CRACKED BY GIGATRON ON 30.04.2003 THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  TRON  -  KODEZWERG  -  HUKKA  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM SEE YOU ON NEXT PRODUCTION ........          ';
  34.  
  35. implementation
  36.  
  37. {$R *.lfm}
  38.  
  39. { TForm1 }
  40.  
  41. procedure TForm1.FormCreate(Sender: TObject);
  42. begin
  43.   Canvas := Form1.Canvas;
  44.  
  45.     Scroller := TClassicScroller.Create(Canvas,  'tf.png', ' ',          640, 396, 64, 84,0,4, s_text);
  46. //  Scroller1 := TClassicScroller.Create(Canvas, 'flt_font.png', ' ',    640, 280, 34, 32,0,3, s_text);
  47.  // Scroller2 := TClassicScroller.Create(Canvas, 'oracle_font.png', ' ', 640, 180, 32, 32,0,2, s_text);
  48.     Scroller3 := TClassicScroller.Create(Canvas, 'zenith_font.png', ' ', 640,  300, 32, 32,10,3, s_text);
  49.   //  TClassicScroller.Create(canvas , font bitmap, first char font bitmap, width,posy, char_w, char_h,sinus_ratio,speed, text to scroll ;
  50.  
  51. end;
  52.  
  53. procedure TForm1.Timer1Timer(Sender: TObject);
  54. begin
  55.   Canvas.Clear;
  56.   Scroller.Draw;
  57. //  Scroller1.Draw;
  58. //  Scroller2.Draw;
  59.   Scroller3.Draw;
  60. end;
  61.  
  62. end.
  63.  

Classic Scroller function

Code: Pascal  [Select][+][-]
  1. unit ClassicScroller;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes, SysUtils, Graphics, ExtCtrls;
  7.  
  8. type
  9.   TClassicScroller = 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; // 3000ms = 3s
  19.     sx: Integer;
  20.     tx: Integer;
  21.     fonts: TImage;
  22.     fonts_width: Integer;
  23.     fonts_height: Integer;
  24.     sin_h       : integer;
  25.  
  26.     font_height_zoom: Integer;
  27.     function Asc(s: Char): Integer;
  28.     function DrawFontChar(charek: Char; x: Integer): Boolean;
  29.   public
  30.     constructor Create(canvas: TCanvas; font_name: String; offset: Char; w, posY, fWidth, fHeight, sHeight: Integer; speed : integer ;sText: String);
  31.     procedure Draw;
  32.  
  33.   end;
  34.  
  35. implementation
  36.  
  37. { TClassicScroller }
  38.  
  39. constructor TClassicScroller.Create(canvas: TCanvas; font_name: String;
  40.   offset: Char; w, posY, fWidth, fHeight, sHeight: Integer; speed: integer ; sText: String);
  41. begin
  42.   offset_char := offset;
  43.   pos_y := posY;
  44.   width := w;
  45.   scroll_text := sText;
  46.   canvas_ctx := canvas;
  47.   scroll_speed := speed;
  48.   scroll_pause := False;
  49.   scroll_pause_time := 3000; // 3000ms = 3s
  50.   sx := width;
  51.   tx := 0;
  52.   fonts := TImage.Create(nil);
  53.   fonts.Picture.LoadFromFile(font_name);
  54.   fonts_width := fWidth;
  55.   fonts_height := fHeight;
  56.   sin_h  :=  sHeight;
  57.   font_height_zoom := 1;
  58. end;
  59.  
  60. function TClassicScroller.Asc(s: Char): Integer;
  61. begin
  62.   Result := Ord(s);
  63. end;
  64.  
  65. function TClassicScroller.DrawFontChar(charek: Char; x: Integer): Boolean;
  66. var
  67.   p, cx, cy: Integer;
  68.   destRect, srcRect: TRect;
  69.  
  70.  
  71. begin
  72.   Result := True;
  73.  
  74.   if (x > width) and (x > 0) then
  75.   begin
  76.     Result := False;
  77.     Exit;
  78.   end;
  79.  
  80.   p := Asc(charek);
  81.   cx := (p - Ord(offset_char)) * fonts_width;
  82.   cy := 0;
  83.  
  84.   if (cx >= 0) and (x <= width) and (x + fonts_width >= 0) then
  85.   begin
  86.  
  87.     destRect := Rect(x, pos_y, x + fonts_width, pos_y + fonts_height);
  88.     srcRect := Rect(cx, cy, cx + fonts_width,cy + fonts_height);
  89.     canvas_ctx.CopyRect(destRect, fonts.Picture.Bitmap.Canvas, srcRect);
  90.   end
  91.   else
  92.     Result := False;
  93. end;
  94.  
  95.  
  96. procedure TClassicScroller.Draw;
  97. var
  98.   car : Char;
  99.   i, x: Integer;
  100.   res: boolean;
  101. begin
  102.   sx := sx - scroll_speed ;
  103.   x := sx;
  104.  
  105.   for i := 1 to Length(scroll_text) do
  106.   begin
  107.     car := scroll_text[i];
  108.     Inc(x, fonts_width);
  109.  
  110.     if (x > -fonts_width) and (x < width + fonts_width) then
  111.     begin
  112.       res := DrawFontChar(car, x);
  113.       if not res then Break;
  114.     end;
  115.  
  116.   end;
  117.  
  118.  
  119.   if x < 0 then
  120.     sx := width + fonts_width;
  121. end;
  122.  
  123.  
  124. end.
  125.  
  126.  

You need to add to form a timer object;

Sub Quantum Technology ! If your friend are clever you are too !!

Gigatron

  • Jr. Member
  • **
  • Posts: 51
  • Amiga
Re: Demo Scene Bitmap Font Scroller
« Reply #10 on: May 03, 2024, 06:46:24 pm »
Hi,
This time i will share a bitmap font with sinus fx for each chars, the font is from paradox, usefull if you want make splash or about
screen; Using the best command of BGRA Component: Bitmap.PutImagePart;

I like the result and music ;)
Music from Magical Murphy/ Paradise  Amiga intro

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

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, ExtCtrls, BGRABitmap,
  9.   BGRABitmapTypes,  BGRAVirtualScreen,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 FormDestroy(Sender: TObject);
  21.     procedure Timer1Timer(Sender: TObject);
  22.   private
  23.     { private declarations }
  24.     charWidth: Integer;
  25.     charHeight: Integer;
  26.     charsPerLine: Integer;
  27.     charImage: TBGRABitmap;
  28.     scrollText: String;
  29.     charSet: String;
  30.     scrollSpeed: Integer;
  31.     scrollCounter: Integer;
  32.     g_val : Double;
  33.     cnt: Double;
  34.     grad: TBGRAGradientScanner;
  35.  
  36.   public
  37.     { public declarations }
  38.   end;
  39.  
  40. var
  41.   Form1: TForm1;
  42.  
  43. implementation
  44.  
  45. {$R *.lfm}
  46.  
  47. procedure TForm1.FormCreate(Sender: TObject);
  48. begin
  49.   charWidth := 22;
  50.   charHeight := 32;
  51.   charsPerLine := 255;
  52.   charImage := TBGRABitmap.Create('pdxfnt2.png'); // paradox bitmap font
  53.   scrollText := '                                       GIGATRON  - FRANCE -  PRESENTS AMIGA FONT TOOLS FROM TRONIC SYSTEM SOFTWARE INTRO CODED WITH LAZARUS FPC ON 02.05.2024  CONTACT GIGATRON AT BP: 3300 68000 COLMAR FRANCE      '  ;
  54.   charSet := 'ABCDEFGHIJKLMNOPQRSTUVWXYZ:.-+#,0123456789''!/ ';  // charset must contains the same (chars) at charimage bitmap;
  55.   scrollSpeed := 4;
  56.   scrollCounter := 0;
  57.   cnt := 0;
  58.   g_val := 0;
  59.  
  60.   grad := TBGRAGradientScanner.Create(BGRA(255,255,250),BGRA(0,0,255),gtLinear,PointF(0,0),PointF(0,65),True,True);
  61. end;
  62.  
  63. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  64. var
  65.   i, chr, charX : Integer;
  66.   sinVal: Double;
  67.   ScrollOffset: Integer;
  68.  
  69. begin
  70.  
  71.   // le gradient
  72.   bitmap.GradientFill(0,0,640,140,BGRA(0,160,255),BGRA(0,0,255),gtLinear,PointF(0,0),PointF(0,140),  dmSet);
  73.  
  74.    ScrollOffset :=  ScrollCounter ;
  75.   for i := 1 to 32 do
  76.   begin
  77.        chr := Pos(scrollText[i], charSet)-1;
  78.        charX := ((I - 1) mod CharsPerLine) * CharWidth - ScrollOffset;
  79.        //CharY := ((I - 1) div CharsPerLine) * CharHeight  ;
  80.        sinVal := sin((cnt + (i - 1) * 0.25) * 0.2) * 120.0;
  81.        Bitmap.PutImagePart(CharX , 260+round(sinVal) , CharImage, Rect(chr*charWidth, CharHeight , chr*charWidth+22 ,  CharHeight+32),  dmFastBlend);
  82.  
  83.   end;
  84.  
  85.   Inc(ScrollCounter,ScrollSpeed);
  86.  
  87.   if ScrollCounter >= CharWidth then
  88.      begin
  89.             ScrollCounter := ScrollCounter - CharWidth;
  90.             ScrollText := Copy(ScrollText,2, Length(ScrollText) - 1) + ScrollText[1];
  91.      end;
  92.  
  93.   // les 2 lignes
  94.   bitmap.DrawLine(0,410,640,410,BGRA(round(sinVal),255,255),true);
  95.   bitmap.DrawLine(0,140,640,140,BGRA(255,255,round(sinVal)),true);
  96.   // les textes
  97.   bitmap.FontHeight := 100;
  98.   bitmap.FontAntialias := false;
  99.   bitmap.FontStyle := [fsBold];
  100.   bitmap.TextOut(64,0,'GIGATRON',grad);       // draw gradient text
  101.   bitmap.FontHeight := 18;
  102.   bitmap.TextOut(510,100,'FRANCE',BGRA(round(-sinVal),round(sinVal)*2,round(sinVal)));
  103.  
  104. end;
  105.  
  106. procedure TForm1.FormDestroy(Sender: TObject);
  107. begin
  108.   CharImage.Free;
  109. end;
  110.  
  111. procedure TForm1.Timer1Timer(Sender: TObject);
  112. begin
  113.        cnt := cnt + 0.2;
  114.        BGRAVirtualScreen1.RedrawBitmap;
  115. end;
  116.  
  117.  
  118. end.
  119.  
« Last Edit: May 03, 2024, 07:02:40 pm by Gigatron »
Sub Quantum Technology ! If your friend are clever you are too !!

Gigatron

  • Jr. Member
  • **
  • Posts: 51
  • Amiga
Re: Demo Scene Bitmap Font Scroller
« Reply #11 on: May 14, 2024, 07:27:32 pm »
Hi,
Sorry I'm busy with my professional work, but coding with pascal at my spare time;

Amiga demo without Sinus Scroll is unimaginable ;)

Today it's time to share something new with you: Bitmap sinus scroll using no component ; @Tron  the speed result is really
bad on my 8 core and 64GB,  GPU with gtx 1080.

*** I feel like I'm in basic Cpc464 :))))

What you need is default project with form and Timer... with 2 units included Sinscroller;

The base source is from a javascript amiga intro ; font from zenith included ; My goal is to improve it to gain maximum speed !!


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.  
  16.     Timer1: TTimer;
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure Timer1Timer(Sender: TObject);
  19.   private
  20.  
  21.   public
  22.  
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.  
  28.   Canvas: TCanvas;
  29.   Scroller: TSineScroller;
  30.  
  31.   s_text : string = 'LAZARUS_ FPC CRACKED BY GIGATRON ON 14.05.2024 THE PLATINIUM LIGHTREGARDS TO :  CIRCULAR  -  LAINZ - TRON  -  KODEZWERG  -  HUKKA  -  MARCOV  -  MARTIN-FR  -  PASCALDRAGON  AND ALL MEMBERS ON LAZARUS FORUM SEE YOU ON NEXT PRODUCTION ........          ';
  32.  
  33. implementation
  34.  
  35. {$R *.lfm}
  36.  
  37. { TForm1 }
  38.  
  39. procedure TForm1.FormCreate(Sender: TObject);
  40. begin
  41.  
  42.   Scroller := TSineScroller.Create(Canvas, 'zenith_font.png', ' ', 640,  210, 32, 32,100, 8,  s_text);
  43.  
  44. end;
  45.  
  46. procedure TForm1.Timer1Timer(Sender: TObject);
  47. begin
  48.   Canvas.Clear;
  49.   Scroller.Draw;
  50. end;
  51.  
  52. end.
  53.  


And 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; // 3000ms = 3s
  19.     sx, tx: Integer;
  20.     fonts: TImage;
  21.     fonts_width, fonts_height: Integer;
  22.     sine_height: Integer;
  23.     radians: Double;
  24.     font_height_zoom: Double;
  25.     function Asc(s : Char): Integer;
  26.     function drawFontChar(charek: Char; x: Integer): Integer;
  27.     procedure unpause;
  28.   public
  29.     constructor Create(canvas: TCanvas; font_name: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);
  30.     procedure draw;
  31.   end;
  32.  
  33.   implementation
  34.  
  35. constructor TSineScroller.Create(canvas: TCanvas; font_name: string; offset: Char; w, py, fw, fh, sh: Integer;s_speed: integer; text: string);
  36. begin
  37.   offset_char := offset;
  38.   pos_y := py;
  39.   width := w;
  40.   scroll_text := text;
  41.   canvas_ctx := canvas;
  42.   scroll_speed := s_speed;
  43.   scroll_pause := False;
  44.   scroll_pause_time := 500; // 3000ms = 3s
  45.   sx := width;
  46.   tx := 0;
  47.   fonts := TImage.Create(nil);
  48.   fonts.Picture.LoadFromFile(font_name);
  49.  
  50.   fonts_width := fw;
  51.   fonts_height := fh;
  52.   sine_height := sh;
  53.   radians := PI / 180;
  54.   font_height_zoom := 2;
  55. end;
  56.  
  57. function TSineScroller.Asc(s: Char): Integer;
  58. begin
  59.   Result := Ord(s);
  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. begin
  67.      Result := 1;
  68.   if (x > width) and (x > 0) then
  69.   begin
  70.     Result := 0;
  71.     Exit;
  72.   end;
  73.  
  74.   p := Asc(charek);
  75.   cx := (p - Ord(offset_char)) * fonts_width;
  76.   cy := 0;
  77.  
  78.   for l := 0 to fonts_width - 1 do
  79.   begin
  80.     if (cx >= 0) and (x <= width) and (x + l >= 0) then
  81.     begin
  82.       m := pos_y + Round((sine_height) * Sin(-1 * (x + tx + l) / 1.4 * radians));
  83.  
  84.       dst_Rect := Rect(x + l, m, x + l + 2, m + Round(fonts_height * font_height_zoom));
  85.       src_Rect := Rect(cx + l, cy, cx + l + 2, cy + fonts_height);
  86.       canvas_ctx.CopyRect(dst_Rect, fonts.Picture.Bitmap.Canvas , src_Rect);
  87.  
  88.     end;
  89.   end;
  90.   Result := 1;
  91. end;
  92.  
  93. procedure TSineScroller.draw;
  94. var
  95.   last_char: Char;
  96.   x, i: Integer;
  97.   koda: Char;
  98. begin
  99.   if not scroll_pause then
  100.     sx -= scroll_speed
  101.   else
  102.     tx -= scroll_speed;
  103.  
  104.   x := sx;
  105.   for i := 1 to Length(scroll_text) do
  106.   begin
  107.     koda := scroll_text[i];
  108.     x += fonts_width;
  109.     if (x > -fonts_width) and (x < width + fonts_width) then
  110.     begin
  111.       if drawFontChar(koda, x) = -1 then
  112.         Break;
  113.       last_char := koda;
  114.     end;
  115.   end;
  116.  
  117.   if last_char = '_' then
  118.   begin
  119.     scroll_pause := True;
  120.     Sleep(scroll_pause_time);
  121.     scroll_pause := False;
  122.  
  123.   end;
  124.  
  125.   if x < 0 then
  126.     sx := width + fonts_width;
  127. end;
  128.  
  129. procedure TSineScroller.unpause;
  130. begin
  131.   scroll_pause := False;
  132. end;
  133.  
  134. end.

« Last Edit: May 14, 2024, 08:18:55 pm by Gigatron »
Sub Quantum Technology ! If your friend are clever you are too !!

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2222
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demo Scene Bitmap Font Scroller
« Reply #12 on: May 15, 2024, 01:49:04 pm »
If needed, I can convert one of my classics to FreePascal.
It ain't crosscompile, it used pure Windows API.
It runs smooth and fast (compiled with Delphi) and is pretty resource friendly.
It does not use bitmap font, it use actual screen font to do its job.
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Gigatron

  • Jr. Member
  • **
  • Posts: 51
  • Amiga
Re: Demo Scene Bitmap Font Scroller
« Reply #13 on: May 15, 2024, 03:24:11 pm »
Thanks KodeZwerg

I'm shocked to see that's sinescroller super slow?
My question on the fpc compiler side, is there a specific setting to gain speed?

Regards
Sub Quantum Technology ! If your friend are clever you are too !!

TRon

  • Hero Member
  • *****
  • Posts: 2663
Re: Demo Scene Bitmap Font Scroller
« Reply #14 on: May 15, 2024, 03:25:14 pm »
Amiga demo without Sinus Scroll is unimaginable ;)
Indeed. It was one of the first things I did (besides copper bars) in order to get a better understanding of the copper (and the first gentle experience with the blitter).

Quote
Today it's time to share something new with you: Bitmap sinus scroll using no component ; @Tron  the speed result is really
bad on my 8 core and 64GB,  GPU with gtx 1080.

You might want to change:
Code: Pascal  [Select][+][-]
  1. for i := 1 to Length(scroll_text) do
  2.  
into
Code: Pascal  [Select][+][-]
  1. for i := 1 to HowManyCharactersAreVisibleAtOnceAtGivenScreenWidth do
  2.  
And ofc adjust for that to 'scroll' through the letters as well.

Quote
*** I feel like I'm in basic Cpc464 :))))
But isn't that the challenge ? Work it up till it breaks and then come up with a better solution ?

The Amiga had it easy with its custom hardware. You simply blitted the characters in sight, changed the horizontal start and stop of the plane to match the scrolling of a single char and let the sine get through the made the sinus 'walk through' the vertical start and stop. And ofc it was just a single bitplane. In modern days you need to push around a few more bytes.

If push comes to shove then scroll the characters in a off-screen bitmap (even/odd) and copy the rectangles (opposite even odd) to their respective destination rectangle. If you have the sinus pre-calculated or keep their (verical) positions then you can update the coordinates with a simple move, calculate the newest coordinate (in case not entirely precalculated) to fill in the empty gap.

I still haven't seen you use any double, tripple or quad buffering  ;)

 

TinyPortal © 2005-2018