Recent

Author Topic: 2D Starfield with BGRA component  (Read 8370 times)

hukka

  • New Member
  • *
  • Posts: 30
    • Github
Re: 2D Starfield with BGRA component
« Reply #15 on: April 06, 2024, 01:11:36 am »
While we're talking demoscene, here's a screenshot of the first example I made to demonstrate a framework I've been working on for people who just want a 2D framebuffer and native playback of some retro music formats without having to include tons of DLLs.

Gigatron

  • Jr. Member
  • **
  • Posts: 53
  • Amiga
Re: 2D Starfield with BGRA component
« Reply #16 on: April 06, 2024, 01:20:52 am »
Cool... your Propulse Tracker is nice by the way; It will be good if i can include s3m;it;xm;or .mod format to my intro instead of
wav song.


thank you
« Last Edit: April 06, 2024, 01:24:27 am by Gigatron »
Sub Quantum Technology ! If your friend are clever you are too !!

hukka

  • New Member
  • *
  • Posts: 30
    • Github
Re: 2D Starfield with BGRA component
« Reply #17 on: April 06, 2024, 05:31:53 am »
It will be good if i can include s3m;it;xm;or .mod format to my intro instead of wav song.

Currently I have native playback of .mod (pretty much perfect -based on 8bitbubsy's disassembly of the original format), .sid (good for some tunes, not for the more technical ones) and Future Composer (a more obscure Amiga format). I will probably tackle IT at some point as 8bitbubsy has done work towards that recently.

circular

  • Hero Member
  • *****
  • Posts: 4240
    • Personal webpage
Re: 2D Starfield with BGRA component
« Reply #18 on: April 06, 2024, 07:37:09 am »
Great idea to use OpenGL Gigatron.

Here I've added some text as well in the OpenGL version.
Conscience is the debugger of the mind

circular

  • Hero Member
  • *****
  • Posts: 4240
    • Personal webpage
Re: 2D Starfield with BGRA component
« Reply #19 on: April 06, 2024, 07:39:01 am »
While we're talking demoscene, here's a screenshot of the first example I made to demonstrate a framework I've been working on for people who just want a 2D framebuffer and native playback of some retro music formats without having to include tons of DLLs.
Very nice hand-made fonts!  :)
Conscience is the debugger of the mind

TRon

  • Hero Member
  • *****
  • Posts: 2675
Re: 2D Starfield with BGRA component
« Reply #20 on: April 06, 2024, 08:12:57 am »
It will be good if i can include s3m;it;xm;or .mod format to my intro instead of wav song.

Currently I have native playback of .mod (pretty much perfect -based on 8bitbubsy's disassembly of the original format), .sid (good for some tunes, not for the more technical ones) and Future Composer (a more obscure Amiga format). I will probably tackle IT at some point as 8bitbubsy has done work towards that recently.
Tralala from nickysn might perhaps be a good start ?

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2241
  • Fifty shades of code.
    • Delphi & FreePascal
Re: 2D Starfield with BGRA component
« Reply #21 on: April 06, 2024, 02:16:20 pm »
Updated/replaced direction with an angle setting.
It does not work perfect, the angle calculation is based on the current Z value to determine a possible direction, as higher that number is, as more possible it is that my calculation has resulted a good direction. Due to that it can or better it will happen than on odd angles (even angles are 0, 90, 180, 270) the slower stars moving into a different direction than the faster one are flying to. For myself I am fine with it, it gives a little more movement on the screen.
Code: Pascal  [Select][+][-]
  1. unit kz.StarField;
  2.  
  3. (*
  4.   Starfield (ball) simulation class by KodeZwerg in 2024
  5.   Uses slow LCL, not Hardware accelerated, single thread
  6.   Royalty free (c) by KodeZwerg
  7.  
  8.   it supports...
  9.   - double buffered, no flicker
  10.   - random layers to control the speed per star
  11.     as more layers you allow to be used, as faster the top stars fly
  12.   - integrated a grey scaled colormap generation for fast fixed colors or complete random generated
  13.   - full individual scroll direction by angle (0° - 360°)
  14.     angle info:
  15.     0° = Left to right
  16.     90° = Top to Bottom
  17.     180° = Right to left
  18.     270° = Bottom to top
  19.   - random sized stars for values higher than 1
  20.   - background color is adjustable
  21.   - random positioned stars
  22.   Todo:
  23.     add transparency switch so the background become invisible
  24.     maby add Z-Order drawing, currently whats drawn is drawn
  25.  
  26.   Usage:
  27.   1. Create an instance of the class by telling target dimension
  28.   2. Set your preffered options, defaults should be ok
  29.   3. Use a timer to generate/update a Bitmap for your usage by calling "Next"
  30.   additional
  31.   4. Use a resize event to update width/height of class
  32.   optional
  33.   5. draw text or other image data on that image before displaying it
  34. *)
  35.  
  36. {$mode ObjFPC}{$H+}
  37.  
  38. interface
  39.  
  40. uses
  41.   Classes, SysUtils, Graphics;
  42.  
  43. type
  44.  
  45.   { TkzStarField }
  46.  
  47.   TkzStarField = class(TObject)
  48.     strict private
  49.       type
  50.         TOneStar = packed record
  51.           X,
  52.           Y,
  53.           Z,
  54.           Size: Integer;
  55.           Color: TColor;
  56.           directionX,
  57.           directionY: Double;
  58.         end;
  59.         TAllStars = array of TOneStar;
  60.         TColors = array of TColor;
  61.     strict private
  62.       FHeight: Integer;
  63.       FStars: TAllStars;
  64.       FColors: TColors;
  65.       FLayers: Integer;
  66.       FBitmap: TBitmap;
  67.       FMaxStars: Integer;
  68.       FMaxSize: Integer;
  69.       FAngle: Integer;
  70.       FWidth: Integer;
  71.       FHeigth: Integer;
  72.       FRandomColors: Boolean;
  73.       FBackground: TColor;
  74.     strict private
  75.       procedure SetAngle(AValue: Integer);
  76.       procedure SetBackground(const AValue: TColor);
  77.       procedure SetHeight(const AValue: Integer);
  78.       procedure SetLayers(const AValue: Integer);
  79.       procedure SetMaxSize(const AValue: Integer);
  80.       procedure SetRandomColors(const AValue: Boolean);
  81.       procedure SetStars(const AValue: Integer);
  82.       procedure SetWidth(const AValue: Integer);
  83.     public
  84.       constructor Create(const AWidth, AHeigth: Integer);
  85.       destructor Destroy; override;
  86.       function Reinitialize: Boolean;
  87.       function Next: Boolean;
  88.     published
  89.       property Bitmap: TBitmap read FBitmap;
  90.       property Layers: Integer read FLayers write SetLayers default 10;
  91.       property MaxStars: Integer read FMaxStars write SetStars default 100;
  92.       property MaxSize: Integer read FMaxSize write SetMaxSize default 1;
  93.       property Width: Integer read FWidth write SetWidth default 800;
  94.       property Height: Integer read FHeight write SetHeight default 600;
  95.       property RandomColors: Boolean read FRandomColors write SetRandomColors default True;
  96.       property Angle: Integer read FAngle write SetAngle default 0;
  97.       property Background: TColor read FBackground write SetBackground default clBlack;
  98.   end;
  99.  
  100. implementation
  101.  
  102. { TkzStarField }
  103.  
  104. constructor TkzStarField.Create(const AWidth, AHeigth: Integer);
  105. begin
  106.   inherited Create;
  107.   Randomize;
  108.   FBitmap := TBitmap.Create;
  109.   FBitmap.PixelFormat := pf32bit;
  110.   FWidth := AWidth;
  111.   FHeight := AHeigth;
  112.   FLayers := 10;
  113.   FMaxStars := 100;
  114.   FMaxSize := 1;
  115.   FAngle := 0;
  116.   FRandomColors := True;
  117.   FBackground := clBlack;
  118.   Reinitialize;
  119. end;
  120.  
  121. destructor TkzStarField.Destroy;
  122. begin
  123.   FBitmap.Free;
  124.   inherited Destroy;
  125. end;
  126.  
  127. function TkzStarField.Reinitialize: Boolean;
  128. var
  129.   i: Integer;
  130.   radians: Double;
  131. begin
  132.   Result := False;
  133.   SetLength(FStars, FMaxStars);
  134.   SetLength(FColors, FLayers);
  135.   FBitmap.Width := FWidth;
  136.   FBitmap.Height := FHeigth;
  137.   for i := Low(FColors) to High(FColors) do
  138.     begin
  139.       FColors[i] := RGBToColor(
  140.            Round(255 + (16 - 255) * (Succ(i) / FLayers)),
  141.            Round(255 + (16 - 255) * (Succ(i) / FLayers)),
  142.            Round(255 + (16 - 255) * (Succ(i) / FLayers))
  143.          );
  144.     end;
  145.   radians := FAngle * PI / 180;
  146.   for i := Low(FStars) to High(FStars) do
  147.     begin
  148.       FStars[i].X := Succ(Random(FWidth));
  149.       FStars[i].Y := Succ(Random(FHeight));
  150.       FStars[i].Z := Random(FLayers);
  151.       FStars[i].directionX := cos(radians);
  152.       FStars[i].directionY := sin(radians);
  153.       FStars[i].Size := Succ(Random(FMaxSize));
  154.       if FRandomColors then
  155.         FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
  156.       else
  157.         FStars[i].Color := FColors[Random(Length(FColors))];
  158.     end;
  159.   Result := True;
  160. end;
  161.  
  162. function TkzStarField.Next: Boolean;
  163. var
  164.   LBmp: TBitmap;
  165.   i: Integer;
  166. begin
  167.   Result := False;
  168.   LBmp := TBitmap.Create;
  169.   try
  170.     LBmp.PixelFormat := pf32bit;
  171.     LBmp.Width := FWidth;
  172.     LBmp.Height := FHeight;
  173.     LBmp.Canvas.Brush.Color := FBackground;
  174.     LBmp.Canvas.FillRect(Rect(0, 0, LBmp.Width, LBmp.Height));
  175.     for i := Low(FStars) to High(FStars) do
  176.       begin
  177.         LBmp.Canvas.Brush.Color := FStars[i].Color;
  178.         // draw a rectangle (dot) or a circle
  179.         if FStars[i].Size <= 1 then
  180.           LBmp.Canvas.FillRect(Rect(FStars[i].X, FStars[i].Y, Succ(FStars[i].X), Succ(FStars[i].Y)))
  181.         else
  182.           LBmp.Canvas.Ellipse(Rect(FStars[i].X, FStars[i].Y, Succ(FStars[i].X + FStars[i].Size), Succ(FStars[i].Y + FStars[i].Size)));
  183.  
  184.         // move a star
  185.         FStars[i].X += Round(FStars[i].directionX * Succ(FStars[i].Z));
  186.         FStars[i].Y += Round(FStars[i].directionY * Succ(FStars[i].Z));
  187.  
  188.         // check if a star needs to be replaced
  189.         if FStars[i].X < 0 - (FStars[i].Size + FStars[i].Size) then
  190.           begin
  191.             FStars[i].X := LBmp.Width + (FStars[i].Size + FStars[i].Size);
  192.             FStars[i].Size := Succ(Random(FMaxSize));
  193.             FStars[i].Z := Random(FLayers);
  194.             if FRandomColors then
  195.               FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
  196.             else
  197.               FStars[i].Color := FColors[Random(Length(FColors))];
  198.           end;
  199.         if FStars[i].X > LBmp.Width + (FStars[i].Size + FStars[i].Size) then
  200.           begin
  201.             FStars[i].X := 0 - (FStars[i].Size + FStars[i].Size);
  202.             FStars[i].Size := Succ(Random(FMaxSize));
  203.             FStars[i].Z := Random(FLayers);
  204.             if FRandomColors then
  205.               FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
  206.             else
  207.               FStars[i].Color := FColors[Random(Length(FColors))];
  208.           end;
  209.         if FStars[i].Y < 0 - (FStars[i].Size + FStars[i].Size) then
  210.           begin
  211.             FStars[i].Y := LBmp.Height + (FStars[i].Size + FStars[i].Size);
  212.             FStars[i].Size := Succ(Random(FMaxSize));
  213.             FStars[i].Z := Random(FLayers);
  214.             if FRandomColors then
  215.               FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
  216.             else
  217.               FStars[i].Color := FColors[Random(Length(FColors))];
  218.           end;
  219.         if FStars[i].Y > LBmp.Height + (FStars[i].Size + FStars[i].Size) then
  220.           begin
  221.             FStars[i].Y := 0 - (FStars[i].Size + FStars[i].Size);
  222.             FStars[i].Size := Succ(Random(FMaxSize));
  223.             FStars[i].Z := Random(FLayers);
  224.             if FRandomColors then
  225.               FStars[i].Color := RGBToColor(Random(High(Byte)), Random(High(Byte)), Random(High(Byte)))
  226.             else
  227.               FStars[i].Color := FColors[Random(Length(FColors))];
  228.           end;
  229.       end;
  230.     FBitmap.Assign(LBmp);
  231.   finally
  232.     LBmp.Free;
  233.   end;
  234.   Result := True;
  235. end;
  236.  
  237. procedure TkzStarField.SetLayers(const AValue: Integer);
  238. begin
  239.   if ((FLayers = AValue) or (FLayers < 1)) then
  240.     Exit;
  241.   FLayers := AValue;
  242.   Reinitialize;
  243. end;
  244.  
  245. procedure TkzStarField.SetMaxSize(const AValue: Integer);
  246. begin
  247.   if ((AValue < 1) or (FMaxSize = AValue)) then
  248.     Exit;
  249.   FMaxSize := AValue;
  250.   Reinitialize;
  251. end;
  252.  
  253. procedure TkzStarField.SetRandomColors(const AValue: Boolean);
  254. begin
  255.   if FRandomColors = AValue then
  256.     Exit;
  257.   FRandomColors := AValue;
  258. //  Reinitialize;
  259. end;
  260.  
  261. procedure TkzStarField.SetStars(const AValue: Integer);
  262. begin
  263.   if ((AValue < FLayers) or (FMaxStars = AValue)) then
  264.     Exit;
  265.   FMaxStars := AValue;
  266.   Reinitialize;
  267. end;
  268.  
  269. procedure TkzStarField.SetWidth(const AValue: Integer);
  270. begin
  271.   if ((AValue < 1) or (FWidth = AValue)) then
  272.     Exit;
  273.   FWidth := AValue;
  274.   Reinitialize;
  275. end;
  276.  
  277. procedure TkzStarField.SetHeight(const AValue: Integer);
  278. begin
  279.   if ((AValue < 1) or (FHeight = AValue)) then
  280.     Exit;
  281.   FHeight := AValue;
  282.   Reinitialize;
  283. end;
  284.  
  285. procedure TkzStarField.SetAngle(AValue: Integer);
  286. begin
  287.   if ((FAngle < 0) or (FAngle > 360) or (FAngle = AValue)) then
  288.     Exit;
  289.   FAngle := AValue;
  290.   Reinitialize;
  291. end;
  292.  
  293. procedure TkzStarField.SetBackground(const AValue: TColor);
  294. begin
  295.   if FBackground = AValue then
  296.     Exit;
  297.   FBackground := AValue;
  298. //  Reinitialize;
  299. end;
  300.  
  301. end.
I guess from point of features for a starfield or balls, its finished, now I could port to hardware accelerated :D
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

hukka

  • New Member
  • *
  • Posts: 30
    • Github
Re: 2D Starfield with BGRA component
« Reply #22 on: April 07, 2024, 04:37:36 am »
Tralala from nickysn might perhaps be a good start ?

Good call! I already had that project bookmarked but haven't yet had a proper look into it.

Gigatron

  • Jr. Member
  • **
  • Posts: 53
  • Amiga
Re: 2D Starfield with BGRA component
« Reply #23 on: April 07, 2024, 07:01:00 am »
Great idea to use OpenGL Gigatron.

Here I've added some text as well in the OpenGL version.

Greeeaat ... Thank you alot this demo is running at full speed for me ;

I can say the people here are awesome guys and i am happy for this.
Sub Quantum Technology ! If your friend are clever you are too !!

Gigatron

  • Jr. Member
  • **
  • Posts: 53
  • Amiga
Re: 2D Starfield with BGRA component
« Reply #24 on: April 09, 2024, 10:08:44 pm »
Hi,
I'am trying to code a nice intro based on Amiga Style;
progress status;

https://www.youtube.com/watch?v=fP4gw4KdvXg
Second part;
https://www.youtube.com/watch?v=6_PNk7WoM0c

Will update this soon ; (cycling colors was added as new stuff) :

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,
  9.   BGLVirtualScreen, BGRAGraphicControl, BCExpandPanels, BGRAOpenGL, BGRABitmap,
  10.   BGRABitmapTypes;
  11.  
  12. const
  13.   StarCount = 1200;
  14.   MaxSpeed  = 8;
  15.  
  16. type
  17.   TStar = record        //
  18.     X, Y, Z: Double;
  19.     Speed:   Double;
  20.   end;
  21.  
  22.   { TForm1 }
  23.  
  24.   TForm1 = class(TForm)
  25.     BGLVirtualScr: TBGLVirtualScreen;
  26.     Timer1: TTimer;
  27.     procedure BGLVirtualScrLoadTextures(Sender: TObject;
  28.       BGLContext: TBGLContext);
  29.     procedure BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);
  30.     procedure BGLVirtualScrUnloadTextures(Sender: TObject;
  31.       BGLContext: TBGLContext);
  32.     procedure FormCreate(Sender: TObject);
  33.     procedure FormShow(Sender: TObject);
  34.     procedure Timer1Timer(Sender: TObject);
  35.  
  36.   private
  37.     GLFont, GLBigFont: IBGLFont;
  38.     Stars  : array of TStar;
  39.     a_logo : IBGLTexture;
  40.     rr,gg,bb  : Byte;
  41.  
  42.     private
  43.     const cop : Array [0..6] of String = ('#ff0000','#ffff00','#ffffff','#0000ff','#00ffff','#00ff00','#ff00ff');
  44.  
  45.     const rasterz : Array [0..64] of String = ('#004848','#006C6C','#009090','#00B4B4','#00D8D8','#00FFFF','#00D8D8','#00B4B4','#009090','#006C6C','#004848','#000048',
  46.     '#00006C','#000090','#0000B4','#0000D8','#0000FF','#0000D8','#0000B4','#000090','#00006C','#000048','#480048','#6C006C','#900090',
  47.     '#B400B4','#D800D8','#FF00FF','#D800D8','#B400B4','#900090','#6C006C','#480048','#480000','#6C0000','#900000','#B40000','#D80000',
  48.     '#FF0000','#D80000','#B40000','#900000','#6C0000','#480000','#484800','#6C6C00','#909000','#B4B400','#D8D800','#FFFF00','#D8D800',
  49.     '#B4B400','#909000','#6C6C00','#484800','#004800','#006C00','#009000','#00B400','#00D800','#00FF00','#00D800','#00B400','#009000',
  50.     '#006C00');
  51.  
  52.  
  53.     procedure InitializeStarfield;
  54.     procedure UpdateStarfield;
  55.     procedure WavyText(BGLContext: TBGLContext; AFont: IBGLFont; AColor: TBGRAPixel;AText: string; X, Y, AWavePosDeg, AWaveStepDeg, AWaveSize: single);
  56.     procedure Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean);
  57.  
  58.   public
  59.  
  60.   end;
  61.  
  62. var
  63.   Form1: TForm1;
  64.   ct : integer;
  65.  
  66.   hexColor: string;
  67.   red, green, blue: Byte;
  68.   pause : integer;
  69.   j: integer;
  70.   cop_num : integer = 0; // copper bar index color
  71.   vbl_timer :integer = 0;
  72.  
  73.  
  74. implementation
  75.  
  76. {$R *.lfm}
  77.  
  78. uses BGRAUTF8,BGRATextFX,BGRAGradients,BGRAFontGL;
  79.  
  80. { TForm1 }
  81.  
  82. procedure TForm1.FormCreate(Sender: TObject);
  83. begin
  84.   Randomize;
  85.   InitializeStarfield;
  86.  
  87.     j:=0;
  88.     pause := 0;
  89.  
  90. end;
  91.  
  92. procedure TForm1.FormShow(Sender: TObject);
  93. begin
  94.         a_logo := BGLTexture('gtr.png');
  95. end;
  96.  
  97.  
  98.  
  99. procedure TForm1.InitializeStarfield;
  100. var
  101.   i: Integer;
  102. begin
  103.   SetLength(Stars, StarCount); // Nombre d'étoiles
  104.   for i := 0 to High(Stars) do
  105.   begin
  106.     Stars[i].X := Random(ClientWidth);
  107.     Stars[i].Y := (60+Random(ClientHeight-120));
  108.     Stars[i].Speed := Random * 7 + 1; // Vitesse aléatoire
  109.   end;
  110. end;
  111.  
  112. procedure TForm1.UpdateStarfield;
  113. var
  114.   i : integer;
  115. begin
  116.   for i := 0 to High(Stars) do
  117.   begin
  118.  
  119.        Stars[i].X := Stars[i].X - Stars[i].Speed ;
  120.  
  121.     if Stars[i].X < 0 then // Réinitialiser la position si l'étoile sort de l'écran
  122.     begin
  123.       Stars[i].X := ClientWidth;
  124.       Stars[i].Y := (60+Random(ClientHeight-120));
  125.       Stars[i].Speed := Random * 7 + 1;
  126.  
  127.     end;
  128.   end;
  129. end;
  130.  
  131. procedure HexToRGB(hex: string; var r, g, b: Byte);
  132. begin
  133.   r := StrToInt('$' + Copy(hex, 2, 2));
  134.   g := StrToInt('$' + Copy(hex, 4, 2));
  135.   b := StrToInt('$' + Copy(hex, 6, 2));
  136. end;
  137.  
  138.  
  139.  
  140. procedure Tform1.Copperbar(BGLContext: TBGLContext;x1,y1:single;centered: boolean);
  141. begin
  142.   hexColor := cop[cop_num];
  143.   HexToRGB(hexColor, rr,gg,bb);
  144.  
  145.   BGLContext.Canvas.FillRectLinearColor(x1,y1,x1+ClientWidth,y1+16,   RGBToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(rr,gg,bb),RGBToColor(rr,gg,bb),centered);
  146.   BGLContext.Canvas.FillRectLinearColor(x1,y1+32,x1+ClientWidth,y1+16,RGBToColor(0,0,0),RGBToColor(0,0,0),RGBToColor(rr,gg,bb),RGBToColor(rr,gg,bb),centered);
  147. end;
  148.  
  149. // from Circular
  150. procedure Tform1.WavyText(BGLContext: TBGLContext; AFont: IBGLFont; AColor: TBGRAPixel;
  151.   AText: string; X,Y, AWavePosDeg, AWaveStepDeg, AWaveSize: single);
  152. var glyphCursor : TGlyphCursorUtf8;
  153.   glyph: TGlyphUtf8;
  154.   glyphText: string;
  155. begin
  156.   X -= AFont.TextWidth(AText)/2;
  157.   glyphCursor := TGlyphCursorUtf8.New(AText, fbmAuto);
  158.   while not glyphCursor.EndOfString do
  159.   begin
  160.     glyph := glyphCursor.GetNextGlyph;
  161.     if glyph.MirroredGlyphUtf8 <> '' then
  162.       glyphText := glyph.MirroredGlyphUtf8
  163.     else
  164.       glyphText := glyph.GlyphUtf8;
  165.     AFont.TextOut(x,y + AWaveSize*Sin(AWavePosDeg*Pi/180), glyphText, AColor);
  166.     x += AFont.TextWidth(glyphText);
  167.     AWavePosDeg += AWaveStepDeg;
  168.   end;
  169. end;
  170.  
  171. procedure TForm1.BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);
  172. var
  173.   i : integer;
  174.   StarPosition: TPoint;
  175.   sttype : Int16 ;
  176.   col: TColor;
  177.   cl : string;
  178.  
  179. begin
  180.  
  181.   // stars
  182.   for i := 0 to High(Stars) do
  183.   begin
  184.  
  185.     StarPosition.X := Round(Stars[i].X );
  186.     StarPosition.Y := Round(Stars[i].Y);
  187.     sttype := Round(Stars[i].Speed);
  188.  
  189.     col := RGBToColor(50,50,50);
  190.     // bitplanes colors
  191.     case  (sttype)  of
  192.       1: col := RGBToColor(50,50,50);
  193.       2: col := RGBToColor(75,75,75);
  194.       3: col := RGBToColor(100,100,100);
  195.       4: col := RGBToColor(125,125,125);
  196.       5: col := RGBToColor(150,150,150);
  197.       6: col := RGBToColor(175,175,175);
  198.       7: col := RGBToColor(200,200,200);
  199.       8: col := RGBToColor(254,254,254);
  200.  
  201.     end;
  202.       BGLContext.Canvas.Rectangle(StarPosition.X, StarPosition.Y,StarPosition.X+1,StarPosition.Y+1,col);
  203.   end;
  204.   // copper bars
  205.   for i := 0 to 8 do
  206.   begin
  207.        Copperbar(BGLContext,0,240+i*2+80*sin(ct/20+(i/2)), true);
  208.   end;
  209.  
  210.   col := RGBToColor(Random(256), Random(256), Random(256));
  211.   WavyText(BGLContext,GLFont,col,'PRESENTS',150+BGLContext.Width/4+30*sin(ct/10),100,
  212.     180*sin(ct/13), 0, 0);
  213.  
  214.   WavyText(BGLContext,GLBigFont,BGRAWhite,'LAZARUS DEMO ',10+BGLContext.Width/2,410,0, 0, 0);
  215.  
  216.   // raster bars cycle colors with pause like A-Team intro
  217.   for i := 0 to 10 do
  218.   begin
  219.        hexColor := rasterz[i+j];
  220.        HexToRGB(hexColor, red, green, blue);
  221.        BGLContext.Canvas.FillRect(0,i*8,640,i*8-8,RGBToColor(red,green,blue));
  222.  
  223.   end;
  224.  
  225.   inc(pause);
  226.  
  227.    if (pause>=10) then
  228.    begin
  229.        inc(j);
  230.       pause := 0;
  231.        if(j>=63-8) then j:=0;
  232.  
  233.     end;
  234.   // draw logo and update Sf
  235.   BGLCanvas.StretchPutImage(0,0,a_logo.Width,a_logo.Height+2, a_logo);
  236.   UpdateStarfield;
  237.  
  238.   // general demo_timer , increase copper colortable to 7
  239.   inc(vbl_timer);
  240.   if(vbl_timer>200) then
  241.   begin
  242.      vbl_timer := 0;
  243.      cop_num := cop_num +1;
  244.      if(cop_num>6) then cop_num :=0;
  245.  
  246.   end;
  247.  
  248. end;
  249.  
  250. procedure TForm1.BGLVirtualScrUnloadTextures(Sender: TObject;
  251.   BGLContext: TBGLContext);
  252. begin
  253.   GLFont := nil;
  254.   GLBigFont := nil;
  255.   a_logo := nil;
  256. end;
  257.  
  258. procedure TForm1.BGLVirtualScrLoadTextures(Sender: TObject;
  259.   BGLContext: TBGLContext);
  260. var bigRender: TBGRATextEffectFontRenderer;
  261.   shader: TPhongShading;
  262.   bigFont: TBGLRenderedFont;
  263.  
  264. begin
  265.   GLFont := BGLFont('Arial', 40, [fsBold]);
  266.  
  267.   shader := TPhongShading.Create;
  268.   bigRender := TBGRATextEffectFontRenderer.Create(shader, true);
  269.   bigFont  := TBGLRenderedFont.Create(bigRender, true);
  270.   bigFont.Name := 'Arial';
  271.   bigFont.EmHeight := 72;
  272.   bigFont.Color := CSSSkyBlue;
  273.   GLBigFont := bigFont;
  274.  
  275. end;
  276.  
  277. procedure TForm1.Timer1Timer(Sender: TObject);
  278. begin
  279.   ct := ct + 1 ;
  280.   BGLVirtualScr.Repaint;
  281. end;
  282.  
  283. end.
  284.  
« Last Edit: April 10, 2024, 11:39:51 pm by Gigatron »
Sub Quantum Technology ! If your friend are clever you are too !!

 

TinyPortal © 2005-2018