Recent

Author Topic: Demoscene Square dot flag fx  (Read 5297 times)

Gigatron

  • Jr. Member
  • **
  • Posts: 53
  • Amiga
Demoscene Square dot flag fx
« on: April 13, 2024, 08:42:28 pm »
Hi nice ladies and gentlements

I would like to share a nice fx from Amiga demoscene , dot flag fx from skid row cracktro ;

BGRA component used of course;
https://www.youtube.com/watch?v=h7XvL-wNjNY

Amiga Skid row:
https://www.youtube.com/watch?v=ajAlW2pMVHw

pascal code :
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.   ComCtrls, StdCtrls, BGLVirtualScreen, BGRAOpenGL, BGRABitmap, BGRABitmapTypes,
  10.   uplaysound;
  11.  
  12.  type
  13.  
  14.   { TForm1 }
  15.  
  16.     TForm1 = class(TForm)
  17.     BGLVirtualScreen1: TBGLVirtualScreen;
  18.     Button1: TButton;
  19.     Label1: TLabel;
  20.     playsound1: Tplaysound;
  21.     Timer1: TTimer;
  22.     TrackBar1: TTrackBar;
  23.     TrackBar2: TTrackBar;
  24.     TrackBar3: TTrackBar;
  25.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
  26.     procedure Button1Click(Sender: TObject);
  27.     procedure FormShow(Sender: TObject);
  28.     procedure Timer1Timer(Sender: TObject);
  29.  
  30.  
  31.     private
  32.  
  33.     plasma : IBGLTexture;
  34.  
  35.     public
  36.     var
  37.     ct, tval: integer;
  38.  
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.  
  44.  
  45. implementation
  46.  
  47. {$R *.lfm}
  48.  
  49.  
  50. { TForm1 }
  51.  
  52. procedure TForm1.FormShow(Sender: TObject);
  53. begin
  54.  // plasma := BGLTexture('plasma9.jpg');
  55. end;
  56.  
  57. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;   BGLContext: TBGLContext);
  58. var
  59.    i,j,p,r,x,y :integer;
  60.    rs,sx,sy : double;
  61.    col: TColor;
  62.  
  63. begin
  64.  
  65.   p := 0;
  66.   r := 0;
  67.  
  68.   for i := 0 to 30 do
  69.      begin
  70.          r:=r +1;
  71.     for j:=0 to 20 do
  72.        begin
  73.         p:= p + TrackBar2.Position;
  74.         x:= i * 16  ;
  75.         y:= j * 16  ;
  76.  
  77.         rs := sin((p+r+ct*(PI/180)*TrackBar3.Position)); // speed
  78.         sx :=   (TrackBar1.Position*rs);
  79.         sy :=   (TrackBar1.Position*rs);
  80.  
  81.         sx := abs(sx);
  82.         sy := abs(sy);
  83.  
  84.         x:=   round(x +  (110-sx)/2);
  85.         y:=   round(y +  (60-sy)/2);
  86.         col := RGBToColor( TrackBar2.Position div 2, TrackBar2.Position div 3,TrackBar2.Position div 4);
  87.         BGLContext.Canvas.fillrect(x,y,x+sx,y+sy, col);
  88.       //  BGLContext.Canvas.fillrect(x,y,x+sx-2 ,y+sy-2, RGBToColor(160,160,160));
  89.  
  90.         end;
  91.   end;
  92.  
  93. end;
  94.  
  95. procedure TForm1.Button1Click(Sender: TObject);
  96. begin
  97.   playsound1.Execute;
  98. end;
  99.  
  100. procedure TForm1.Timer1Timer(Sender: TObject);
  101. begin
  102.     ct := ct +1;
  103.     Label1.caption := IntToStr(TrackBar2.Position);
  104.     BGLVirtualScreen1.Repaint;
  105. end;
  106.  
  107. end.
  108.  
  109.  
Enjoy and play !
Sub Quantum Technology ! If your friend are clever you are too !!

TRon

  • Hero Member
  • *****
  • Posts: 2673
Re: Demoscene Square dot flag fx
« Reply #1 on: April 14, 2024, 08:00:28 pm »
Nice, Gigatron !!

One of those routines that can be shaped and molded to do many things. I really should dust of some of my old stuff.

Do note that it took a lot less time with the copper and blitter to realize then what is shown in code here  :P

I took the liberty to get things going with ptcpas and toyed with it (only) a little.

Code: Pascal  [Select][+][-]
  1. program squaring;
  2.  
  3. {$mode objfpc}{$h+}
  4.  
  5. {.$define draw_tile_as_rectangle}
  6. {$define draw_tile_as_circle}
  7.  
  8. uses
  9.   {$ifdef linux}
  10.   cthreads,
  11.   {$endif}
  12.   classes,
  13.   sysutils, fptimer,
  14.   ptccrt, ptcgraph;
  15.  
  16. {$if sizeof(colortype) = 4}
  17.   {$define FPC_GRAPH_SUPPORTS_TRUECOLOR}
  18. {$endif}
  19.  
  20.  
  21. type
  22.   TEvents = object
  23.     procedure DoTimer(Sender: TObject);
  24.   end;
  25.  
  26. const
  27.   FPS_TO_AIM_FOR   = 50; // 25;
  28.  
  29. const
  30.   TILES_SPEED      =   4;                   // 0..16
  31.   TILES_SQUARESIZE =  32;
  32.   TILES_SKIPDELAY  = 100; // 7;             // 5..255
  33.   TILES_COLCOUNT   =  40;
  34.   TILES_ROWCOUNT   =  10;
  35.   TILES_AMP        = TILES_SQUARESIZE - 2;  // 10..20
  36.  
  37.   // dirty dimensions
  38.   XOFS   = 20;
  39.   YOFS   = 20;
  40.   WIDTH  = TILES_COLCOUNT * TILES_SQUARESIZE;
  41.   HEIGHT = TILES_ROWCOUNT * TILES_SQUARESIZE;
  42.  
  43.  
  44. var
  45.   Events     : TEvents;
  46.   Timer      : TFPTimer;
  47.   framecount : integer = 0;
  48.  
  49.  
  50. procedure Render;
  51. var
  52.   i,j,p,r,x,y : integer;
  53.   rs,sx,sy : double;
  54.   col : Colortype;
  55.   cc : byte;
  56. begin
  57.   p := 0;
  58.   r := 0;
  59.  
  60.   for i := 0 to TILES_COLCOUNT-1 do
  61.   begin
  62.     r := r + 1;
  63.  
  64.     for j := 0 to TILES_ROWCOUNT-1 do
  65.     begin
  66.       p := p + TILES_SKIPDELAY;
  67.       x := i * TILES_SQUARESIZE;
  68.       y := j * TILES_SQUARESIZE;
  69.  
  70.       rs := sin((p+r+framecount*(PI/180)*TILES_SPEED)); // speed
  71.       sx := TILES_AMP*rs;
  72.       sy := TILES_AMP*rs;
  73.  
  74.       sx := abs(sx);
  75.       sy := abs(sy);
  76.  
  77.       x := XOFS + round(x + (TILES_AMP-sx)/2);
  78.       y := YOFS + round(y + (TILES_AMP-sy)/2);
  79.  
  80.       {$ifdef FPC_GRAPH_SUPPORTS_TRUECOLOR}
  81.       cc  := round(sy * 255 / TILES_AMP);
  82.       col := cc shl 16 + cc shl 8 + cc shl 0;
  83.       {$else}
  84.       // TODO:
  85.       // col := index to palette
  86.       {$endif}
  87.  
  88.       {$if defined(draw_tile_as_rectangle)}
  89.       SetColor(col);
  90.       Rectangle(x,y,round(x+sx),round(y+sy));
  91.       {$elseif defined(draw_tile_as_circle)}
  92.       SetColor(col);
  93.       Circle(x + TILES_AMP shr 1, y + TILES_AMP shr 1, round(sx/2));
  94.       {$else}
  95.       SetFillStyle(SolidFill, col);
  96.       Bar(x,y,round(x+sx),round(y+sy));
  97.       {$endif}
  98.     end;
  99.   end;
  100. end;
  101.  
  102.  
  103. procedure TEvents.DoTimer(Sender: TObject);
  104. const
  105.   ActivePage : integer = 1;
  106. begin
  107.   inc(framecount);
  108.  
  109.   // Swap buffers
  110.   ActivePage := 1 - ActivePage;
  111.   SetActivePage(ActivePage);
  112.  
  113.   // Clear buffer and render view
  114.   ClearDevice;
  115.   Render;
  116.  
  117.   // Update view
  118.   SetVisualPage(ActivePage);
  119. end;
  120.  
  121.  
  122. procedure CheckGraphResult;
  123. var
  124.   ErrorCode: Integer;
  125. begin
  126.   ErrorCode := GraphResult;
  127.   if ErrorCode <> grOk then
  128.   begin
  129.     CloseGraph;
  130.     Writeln(ErrorCode, ': ', GraphErrorMsg(ErrorCode));
  131.     Readln;
  132.     Halt(1);
  133.   end;
  134. end;
  135.  
  136.  
  137. procedure GfxModeInfo;
  138. var
  139.   n     : smallint;
  140.   color : RGBRec;
  141. begin
  142.   writeln('BGColor      = ', GetBkColor);
  143.   writeln('FGColor      = ', GetColor);
  144.   writeln('PaletteSize  = ', GetPaletteSize);
  145.   writeln('DirectVideo  = ', GetDirectVideo);
  146.   writeln('DriverName   = ', GetDriverName);
  147.   writeln('maxColor     = ', GetMaxColor);
  148.   writeln('GraphMode    = ', GetGraphMode);
  149.   writeln('ModeName     = ', GetModeName(GetGraphMode));
  150.  
  151.   // info on some random colors
  152.   for n := 0 to 9 do
  153.   begin
  154.     GetRGBPalette(n, color.Red, color.Green, color.Blue);
  155.     writeln('$', color.Red.ToHexString, '.', color.Green.ToHexString, '.', color.Blue.ToHexString);
  156.   end;
  157. end;
  158.  
  159.  
  160. var
  161.   gd, gm: smallint;
  162. begin
  163.   gd := detect;
  164.   gm := 0;
  165.  
  166.   InitGraph(gd,gm,'');
  167.   CheckGraphResult;
  168.  
  169.   {$ifndef FPC_GRAPH_SUPPORTS_TRUECOLOR}
  170.   // TODO: set palette
  171.   SetRGBPalette(1, $FF, $0, $0);
  172.   CheckGraphResult;
  173.   {$endif}
  174.   GfxModeInfo;
  175.  
  176.   writeln('Effect:');
  177.   writeln('PixelWidth  = ', WIDTH);
  178.   writeln('PixelHeight = ', HEIGHT);
  179.   writeln;
  180.  
  181.   Timer := TFPTimer.Create(nil);
  182.   Timer.Enabled        := false;
  183.   Timer.UseTimerThread := true;
  184.   Timer.Interval       := round(1000 / FPS_TO_AIM_FOR);
  185.   Timer.OnTimer        := @Events.DoTimer;
  186.   Timer.Enabled        := true;
  187.  
  188.   // let Timer do its job and wait for user intervention
  189.   repeat
  190.     delay(10);
  191.   until keypressed;
  192.  
  193.   Timer.Free;
  194.  
  195.   CloseGraph;
  196. end.
  197.  

Gigatron

  • Jr. Member
  • **
  • Posts: 53
  • Amiga
Re: Demoscene Square dot flag fx
« Reply #2 on: April 14, 2024, 11:22:15 pm »
Thank you Tron for the code which gives infinite ideas and possibilities.
I'm just giving the code which is similar to the Skid Row cracktro, of course the program is not optimized and made as simply as possible in order to help anyone who would like to code effects :)

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.   ComCtrls, StdCtrls, BGLVirtualScreen, BGRAOpenGL, BGRABitmap, BGRABitmapTypes,
  10.   uplaysound;
  11.  
  12.  type
  13.  
  14.   { TForm1 }
  15.  
  16.     TForm1 = class(TForm)
  17.     BGLVirtualScreen1: TBGLVirtualScreen;
  18.     Button1: TButton;
  19.     Label1: TLabel;
  20.     playsound1: Tplaysound;
  21.     circle_radio: TRadioButton;
  22.     sq_radio: TRadioButton;
  23.     Timer1: TTimer;
  24.     TrackBar1: TTrackBar;
  25.     TrackBar2: TTrackBar;
  26.     TrackBar3: TTrackBar;
  27.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
  28.     procedure Button1Click(Sender: TObject);
  29.     procedure Timer1Timer(Sender: TObject);
  30.  
  31.  
  32.     private
  33.  
  34.     public
  35.     var
  36.     ct, tval: integer;
  37.     shape_type: integer;
  38.  
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.  
  44.  
  45. implementation
  46.  
  47. {$R *.lfm}
  48.  
  49.  
  50. { TForm1 }
  51.  
  52. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;   BGLContext: TBGLContext);
  53. var
  54.    i,j,p,r,x,y :integer;
  55.    rs,sx,sy : double;
  56.  
  57.  
  58. begin
  59.  
  60.   p := 0;
  61.   r := 0;
  62.  
  63.   for i := 0 to 14 do
  64.   begin
  65.         r:=r +1;
  66.     for j:=0 to 11 do
  67.        begin
  68.         p:= p + TrackBar2.Position;
  69.         x:= i * 32  ;
  70.         y:= j * 32  ;
  71.  
  72.         rs := sin((p+r+ct*(PI/180)*TrackBar3.Position)); // speed
  73.         sx :=   (TrackBar1.Position*rs);
  74.         sy :=   (TrackBar1.Position*rs);
  75.  
  76.         sx := abs(sx);
  77.         sy := abs(sy);
  78.  
  79.         x:=   round(x +  (120-sx)/2);
  80.         y:=   round(y +  (54-sy)/2);
  81.  
  82.         if(shape_type=1) then begin
  83.           BGLContext.Canvas.fillrect(x,y,x+sx,y+sy, RGBToColor(0,220,255 ));
  84.           BGLContext.Canvas.fillrect(x+2,y+2,x+sx-2,y+sy-2, RGBToColor(0,110,255 ));
  85.         end;
  86.  
  87.         if(shape_type=2) then begin
  88.          BGLContext.Canvas.Arc(x,y,sx / 3,sy/ 3,0,360, RGBToColor(0,180,255 ),true,RGBToColor(0,110,255 ));
  89.         end;
  90.  
  91.         end;
  92.   end;
  93.  
  94. end;
  95.  
  96. procedure TForm1.Button1Click(Sender: TObject);
  97. begin
  98.   playsound1.Execute;
  99. end;
  100.  
  101. procedure TForm1.Timer1Timer(Sender: TObject);
  102. begin
  103.     ct := ct +1;
  104.     Label1.caption := IntToStr(TrackBar2.Position);
  105.     BGLVirtualScreen1.Repaint;
  106.     if(sq_radio.Checked) then shape_type := 1;
  107.     if(circle_radio.Checked) then shape_type := 2;
  108.  
  109. end;
  110.  
  111. end.
  112.  
  113.  
« Last Edit: April 15, 2024, 12:22:38 am by Gigatron »
Sub Quantum Technology ! If your friend are clever you are too !!

circular

  • Hero Member
  • *****
  • Posts: 4239
    • Personal webpage
Re: Demoscene Square dot flag fx
« Reply #3 on: April 15, 2024, 09:00:28 am »
Hi Gigatron,

In the Skid Row demo, it seems to me that it is a gradient.

You can do something similar like this (not tested):

Code: Pascal  [Select][+][-]
  1. uses BGRAGradientScanner;
  2.  
  3. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;   BGLContext: TBGLContext);
  4. var
  5.    i,j,p,r,x,y :integer;
  6.    rs,sx,sy : double;
  7.    grad: TBGRACustomGradient;
  8.  
  9. begin
  10.  
  11.   p := 0;
  12.   r := 0;
  13.   grad := TBGRAMultiGradient.Create([CSSDodgerBlue, CSSBlue, CSSLightGray],
  14.        [0, 0.4, 1], grPad);
  15.  
  16.   for i := 0 to 14 do
  17.   begin
  18.         r:=r +1;
  19.     for j:=0 to 11 do
  20.        begin
  21.         p:= p + TrackBar2.Position;
  22.         x:= i * 32  ;
  23.         y:= j * 32  ;
  24.  
  25.         rs := sin((p+r+ct*(PI/180)*TrackBar3.Position)); // speed
  26.         sx :=   (TrackBar1.Position*rs);
  27.         sy :=   (TrackBar1.Position*rs);
  28.  
  29.         sx := abs(sx);
  30.         sy := abs(sy);
  31.  
  32.         x:=   round(x +  (120-sx)/2);
  33.         y:=   round(y +  (54-sy)/2);
  34.  
  35.         if(shape_type=1) then begin
  36.           BGLContext.Canvas.fillrect(x,y,x+sx,y+sy, grad.GetColorAtF((i+j)/(14+11)));
  37.         end;
  38.  
  39.         if(shape_type=2) then begin
  40.          BGLContext.Canvas.Arc(x,y,sx / 3,sy/ 3,0,360, RGBToColor(0,180,255 ),true,RGBToColor(0,110,255 ));
  41.         end;
  42.  
  43.         end;
  44.   end;
  45.   grad.Free;
  46. end;
Conscience is the debugger of the mind

TRon

  • Hero Member
  • *****
  • Posts: 2673
Re: Demoscene Square dot flag fx
« Reply #4 on: April 15, 2024, 10:04:58 am »
In the Skid Row demo, it seems to me that it is a gradient.
That is indeed correct.

Seems they used the copper for that (hence why the squares have a certain width) to draw the squares from dark (left top) to light (bottom right) though the effect seem to "overlap" a little (seem to be static but could be made to animate as well for extra wow factor).


Gigatron

  • Jr. Member
  • **
  • Posts: 53
  • Amiga
Re: Demoscene Square dot flag fx
« Reply #5 on: April 15, 2024, 08:01:43 pm »
Hi Gigatron,

In the Skid Row demo, it seems to me that it is a gradient.


Hi Circular sure you are right;

Here are the trick used in Skid Row intro;
One is the white square , and it use gradient mask , if i have time i will finish this intro at maximum similar ;

Edit : ** In fact I don't need to do anything, I just tested your example and it works perfectly :)
Thank you very much :)

By the way , you certainly know the Amiga Blitter..
Can you include it in BGRA? We take part of the image and copy it elsewhere, it looks like Drawpart image like in javascript.
BGRABlit(x,y,x1,y1, dx,dy)

« Last Edit: April 15, 2024, 08:21:04 pm by Gigatron »
Sub Quantum Technology ! If your friend are clever you are too !!

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2237
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demoscene Square dot flag fx
« Reply #6 on: April 15, 2024, 08:33:09 pm »
You can do something similar like this (not tested):
I have tested it, pretty nice one!
Thanks to Gigatron for inspiration and Circular for extending.
Here is my mini tiny modification so it work with any size of the virtualscreen.
Code: Pascal  [Select][+][-]
  1. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;   BGLContext: TBGLContext);
  2. var
  3.   i, j, p, r, x, y : Integer;
  4.   rs, sx, sy : Double;
  5.   grad: TBGRACustomGradient;
  6.   maxColumn, maxRow: Integer;
  7.   tileSpace: Integer;
  8. begin
  9.   tileSpace := 32;
  10.   maxColumn := BGLVirtualScreen1.Width div tileSpace;
  11.   maxRow := BGLVirtualScreen1.Height div tileSpace;
  12.   p := 0;
  13.   r := 0;
  14.   grad := TBGRAMultiGradient.Create([CSSIndianRed, CSSMidnightBlue, CSSDarkKhaki],
  15.        [0, 0.5, 1], False, False);
  16.   try
  17.     for i := 0 to maxColumn do
  18.       begin
  19.         r := r + 1;
  20.         for j := 0 to maxRow do
  21.           begin
  22.             p := p + TrackBar2.Position;
  23.             x := i * tileSpace;
  24.             y := j * tileSpace;
  25.  
  26.             rs := sin((p + r + ct * (PI / 180) * TrackBar3.Position)); // speed
  27.             sx := TrackBar1.Position * rs;
  28.             sy := TrackBar1.Position * rs;
  29.  
  30.             sx := abs(sx);
  31.             sy := abs(sy);
  32.  
  33.             x :=   round(x + (0 - sx) / 2);
  34.             y :=   round(y + (0 - sy) / 2);
  35.  
  36.             case shape_type of
  37.               2: BGLContext.Canvas.Arc(x, y, sx / 3, sy / 3, 0, 360, grad.GetColorAtF((i + j) / (maxColumn + maxRow)), True, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  38.             else
  39.               BGLContext.Canvas.FillRect(x, y, x + sx, y + sy, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  40.             end;
  41.           end;
  42.       end;
  43.   finally
  44.     grad.Free;
  45.   end;
  46. end;
And i switched to a case statement to choose the effect, it might ease the process to add more different shapes.
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

TRon

  • Hero Member
  • *****
  • Posts: 2673
Re: Demoscene Square dot flag fx
« Reply #7 on: April 15, 2024, 08:34:09 pm »
Ah, I seem to have created the wrong scheme when using
Code: Pascal  [Select][+][-]
  1.     cc := round((j + i) / (TILES_COLCOUNT + TILES_ROWCOUNT) * 256);
  2.     col := cc shl 16 + cc shl 8 + 255;
  3.  
Oh, well  :)

BTW, if you want the fx to be more realistic you can use:
Code: Pascal  [Select][+][-]
  1.   Bar(x,y,x+TILES_SQUARESIZE,y+TILES_SQUARESIZE);
  2.  
« Last Edit: April 15, 2024, 08:35:51 pm by TRon »

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2237
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demoscene Square dot flag fx
« Reply #8 on: April 15, 2024, 10:09:36 pm »
Here as project and to show just code, some more styles added:
Code: Pascal  [Select][+][-]
  1. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;   BGLContext: TBGLContext);
  2. var
  3.   i, j, p, r, x, y : Integer;
  4.   rs, sx, sy : Double;
  5.   grad: TBGRACustomGradient;
  6.   maxColumn, maxRow: Integer;
  7.   tileSpace: Integer;
  8. begin
  9.   tileSpace := SpinEdit1.Value;
  10.   maxColumn := BGLVirtualScreen1.Width div tileSpace;
  11.   maxRow := BGLVirtualScreen1.Height div tileSpace;
  12.   p := 0;
  13.   r := 0;
  14.   grad := TBGRAMultiGradient.Create([CSSIndianRed, CSSMidnightBlue, CSSDarkKhaki],
  15.        [0, 0.5, 1], False, False);
  16.   try
  17.     for i := 0 to maxColumn do
  18.       begin
  19.         r := r + 1;
  20.         for j := 0 to maxRow do
  21.           begin
  22.             p := p + TrackBar2.Position;
  23.             x := i * tileSpace;
  24.             y := j * tileSpace;
  25.  
  26.             rs := Sin((p + r + ct * (PI / 180) * TrackBar3.Position)); // speed
  27.             sx := TrackBar1.Position * rs;
  28.             sy := TrackBar1.Position * rs;
  29.  
  30.             sx := Abs(sx);
  31.             sy := Abs(sy);
  32.  
  33.             x := Round(x + (0 - sx) / 2);
  34.             y := Round(y + (0 - sy) / 2);
  35.  
  36.             case shape_type of
  37.               1: BGLContext.Canvas.FillRect(x, y, x + sx, y + sy, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  38.               2: BGLContext.Canvas.Arc(x, y, sx / 2, sy / 2, 0, 360, grad.GetColorAtF((i + j) / (maxColumn + maxRow)), True, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  39.               3: BGLContext.Canvas.Ellipse(x, y, sx / 2, sy / 2, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  40.               4: BGLContext.Canvas.Pie(x, y, sx / 2, sy / 2, 0, rs, grad.GetColorAtF((i + j) / (maxColumn + maxRow)), grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  41.               5: BGLContext.Canvas.FillRoundRect(x, y, x + i, y + i, sx, sy, grad.GetColorAtF((i + j) / (maxColumn + maxRow)), [], True);
  42.               6: BGLContext.Canvas.Rectangle(x, y, x + i, y + i, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  43.             else
  44.               BGLContext.Canvas.FillRect(x, y, x + sx, y + sy, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  45.             end;
  46.           end;
  47.       end;
  48.   finally
  49.     grad.Free;
  50.   end;
  51. end;
Some images to demonstrate different shapes added aswell
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

Gigatron

  • Jr. Member
  • **
  • Posts: 53
  • Amiga
Re: Demoscene Square dot flag fx
« Reply #9 on: April 15, 2024, 11:09:50 pm »
Thank you all for the code and idea,

Here is the compilation code of circular, Tron, KodeZwerg and me :)

This projet is now finished , it's now near %98 of Skid Row dot flag fx;

Thanks again for the contributors circular, Tron, KodeZwerg !!

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.   ComCtrls, StdCtrls, Spin, BGLVirtualScreen, BGRAOpenGL, BGRABitmap,
  10.   BGRABitmapTypes, uplaysound, BGRACanvas2D;
  11.  
  12.  type
  13.  
  14.   { TForm1 }
  15.  
  16.     TForm1 = class(TForm)
  17.     BGLVirtualScreen1: TBGLVirtualScreen;
  18.     Button1: TButton;
  19.     Label1: TLabel;
  20.     Label2: TLabel;
  21.     playsound1: Tplaysound;
  22.     SpinEdit2: TSpinEdit;
  23.     Timer1: TTimer;
  24.     TrackBar1: TTrackBar;
  25.     TrackBar2: TTrackBar;
  26.     TrackBar3: TTrackBar;
  27.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
  28.     procedure Button1Click(Sender: TObject);
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure Timer1Timer(Sender: TObject);
  31.  
  32.     private
  33.  
  34.     public
  35.     var
  36.     ct, tval: integer;
  37.     shape_type: integer;
  38.  
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.  
  44.  
  45. implementation
  46.  
  47. {$R *.lfm}
  48.  
  49. uses BGRAGradientScanner;
  50.  
  51. { TForm1 }
  52.  
  53. procedure TForm1.FormCreate(Sender: TObject);
  54. begin
  55.  
  56. end;
  57.  
  58.  
  59. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;   BGLContext: TBGLContext);
  60. var
  61.    i,j,p,r,x,y :integer;
  62.    rs,sx,sy : double;
  63.    grad: TBGRACustomGradient;
  64.    tileSpace, maxColumn,  maxRow : Integer;
  65.  
  66. begin
  67.     tileSpace := 32;
  68.    maxColumn := 14;
  69.    maxRow := 11;
  70.  
  71.   p := 0;
  72.   r := 0;
  73.   grad := TBGRAMultiGradient.Create([RGBToColor(0,136,255 ), CSSBlue, RGBToColor(248,248,255 )],
  74.        [0, 0.4, 1], grPad);
  75.   try
  76.   for i := 0 to 14 do
  77.     begin
  78.         r := r + 1;
  79.       for j := 0 to 11 do
  80.        begin
  81.           p:= p + TrackBar2.Position;
  82.           x:= i * 32  ;
  83.           y:= j * 32  ;
  84.  
  85.           rs := sin((p+r+ct*(PI/180)*TrackBar3.Position)); // speed
  86.           sx :=   (TrackBar1.Position*rs);
  87.           sy :=   (TrackBar1.Position*rs);
  88.  
  89.           sx := abs(sx);
  90.           sy := abs(sy);
  91.  
  92.           x:=   round(x +  (56-sx)/2);
  93.           y:=   round(y +  (64-sy)/2);
  94.  
  95.         case shape_type of
  96.               1: BGLContext.Canvas.FillRect(x, y, x + sx, y + sy, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  97.               2: BGLContext.Canvas.Arc(x, y, sx / 2, sy / 2, 0, 360, grad.GetColorAtF((i + j) / (maxColumn + maxRow)), True, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  98.               3: BGLContext.Canvas.Ellipse(x, y, sx / 2, sy / 2, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  99.               4: BGLContext.Canvas.Pie(x, y, sx / 2, sy / 2, 0, rs, grad.GetColorAtF((i + j) / (maxColumn + maxRow)), grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  100.               5: BGLContext.Canvas.FillRoundRect(x, y, x + i, y + i, sx, sy, grad.GetColorAtF((i + j) / (maxColumn + maxRow)), [], True);
  101.               6: BGLContext.Canvas.Rectangle(x, y, x + i, y + i, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  102.             else
  103.               BGLContext.Canvas.FillRect(x, y, x + sx, y + sy, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  104.             end;
  105.        end;
  106.   end;
  107.   finally
  108.   end;
  109.   grad.Free;
  110. end;
  111.  
  112. procedure TForm1.Button1Click(Sender: TObject);
  113. begin
  114.   playsound1.Execute;
  115. end;
  116.  
  117. procedure TForm1.Timer1Timer(Sender: TObject);
  118. begin
  119.     ct := ct +1;
  120.     Label1.caption := IntToStr(TrackBar2.Position);
  121.     shape_type := spinEdit2.Value;
  122.     BGLVirtualScreen1.Repaint;
  123.  
  124. end;
  125.  
  126. end.
  127.  
« Last Edit: April 15, 2024, 11:15:27 pm by Gigatron »
Sub Quantum Technology ! If your friend are clever you are too !!

TRon

  • Hero Member
  • *****
  • Posts: 2673
Re: Demoscene Square dot flag fx
« Reply #10 on: April 16, 2024, 01:10:22 am »
This projet is now finished , it's now near %98 of Skid Row dot flag fx;
I wonder what the 2% is about...  :)

not that I specifically care about that 2% but the fact that the effect does not actually resembles the original from skidrow where the animation goes from outward to inward (not a single particular direction as it is now).

circular

  • Hero Member
  • *****
  • Posts: 4239
    • Personal webpage
Re: Demoscene Square dot flag fx
« Reply #11 on: April 16, 2024, 10:46:58 pm »
Edit : ** In fact I don't need to do anything, I just tested your example and it works perfectly :)
Thank you very much :)
You're very welcome  :)

Quote
By the way , you certainly know the Amiga Blitter..
Can you include it in BGRA? We take part of the image and copy it elsewhere, it looks like Drawpart image like in javascript.
BGRABlit(x,y,x1,y1, dx,dy)
I don't know about Amiga Blitter, but I understand your wish. Would it be with BGLCanvas or with a TBGRABitmap? There is TBGRABitmap.PutImagePart that would do that.

Regards
Conscience is the debugger of the mind

Gigatron

  • Jr. Member
  • **
  • Posts: 53
  • Amiga
Re: Demoscene Square dot flag fx
« Reply #12 on: April 17, 2024, 01:13:29 am »
This projet is now finished , it's now near %98 of Skid Row dot flag fx;
I wonder what the 2% is about...  :)

not that I specifically care about that 2% but the fact that the effect does not actually resembles the original from skidrow where the animation goes from outward to inward (not a single particular direction as it is now).

Yes you are right it's not exactly the same fx, however the original routine on amiga is not include math sinus formula but based on square bob image with copper
gradient; I am lazy to improve this fx to 100% but to achiev it to 99% you can divide part left side and right side and reverse sinus timer to obtain the original fx to 99%.

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.   ComCtrls, StdCtrls, Spin, BGLVirtualScreen, BGRAOpenGL, BGRABitmap,
  10.   BGRABitmapTypes, uplaysound, BGRACanvas2D;
  11.  
  12.  type
  13.  
  14.   { TForm1 }
  15.  
  16.     TForm1 = class(TForm)
  17.     BGLVirtualScreen1: TBGLVirtualScreen;
  18.     Button1: TButton;
  19.     Label1: TLabel;
  20.     Label2: TLabel;
  21.     playsound1: Tplaysound;
  22.     SpinEdit2: TSpinEdit;
  23.     Timer1: TTimer;
  24.     TrackBar1: TTrackBar;
  25.     TrackBar2: TTrackBar;
  26.     TrackBar3: TTrackBar;
  27.     procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);
  28.     procedure Button1Click(Sender: TObject);
  29.     procedure FormCreate(Sender: TObject);
  30.     procedure Timer1Timer(Sender: TObject);
  31.  
  32.     private
  33.  
  34.     public
  35.     var
  36.     ct,ctt, tval: integer;
  37.     shape_type: integer;
  38.  
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.  
  44.  
  45. implementation
  46.  
  47. {$R *.lfm}
  48.  
  49. uses BGRAGradientScanner;
  50.  
  51. { TForm1 }
  52.  
  53. procedure TForm1.FormCreate(Sender: TObject);
  54. begin
  55.  
  56. end;
  57.  
  58.  
  59. procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;   BGLContext: TBGLContext);
  60. var
  61.    i,j,p,r,x,y :integer;         // Right Side
  62.    ii,jj,pp,rr,xx,yy : integer ; // Left Side
  63.    rs,sx,sy : double;            // Right Side
  64.    rss,sxx,syy : double;         // Left Side
  65.    grad: TBGRACustomGradient;
  66.    tileSpace, maxColumn,  maxRow : Integer;
  67.  
  68. begin
  69.    tileSpace := 32;
  70.    maxColumn := 14;
  71.    maxRow := 11;
  72.  
  73.   p := 0;
  74.   r := 0;
  75.   rr :=0;
  76.   pp :=0;
  77.   grad := TBGRAMultiGradient.Create([RGBToColor(0,136,255 ), CSSBlue, RGBToColor(248,248,255 )],
  78.        [0, 0.4, 1], grPad);
  79.   try
  80.   for i := 0 to 14 do
  81.     begin
  82.         r := r + 1;
  83.       for j := 0 to 11 do
  84.        begin
  85.           p:= p + TrackBar2.Position;
  86.           x:= i * 32  ;
  87.           y:= j * 32  ;
  88.           rs :=  sin((p+r+ct*(PI/180)*TrackBar3.Position)); // speed  negate ct to reverse sinus
  89.           sx :=   (TrackBar1.Position*rs);
  90.           sy :=   (TrackBar1.Position*rs);
  91.           sx := abs(sx);
  92.           sy := abs(sy);
  93.           x:=   round(x +  (56-sx)/2);
  94.           y:=   round(y +  (64-sy)/2);
  95.  
  96.         if(j>11-i) then begin
  97.            BGLContext.Canvas.FillRect(x, y, x + sx, y + sy, grad.GetColorAtF((i + j) / (maxColumn + maxRow)));
  98.  
  99.           end;
  100.       end;
  101.     end;
  102.   // double the trouble to the left side patterns ;
  103.    for ii := 0 to 14 do
  104.     begin
  105.         rr := rr + 1;
  106.       for jj := 0 to 11 do
  107.        begin
  108.           pp:= pp + TrackBar2.Position;
  109.           xx:= ii * 32  ;
  110.           yy:= jj * 32  ;
  111.           rss := sin((pp+rr-ctt*(PI/180)*TrackBar3.Position)); // speed  negate ctt to reverse sinus
  112.           sxx :=   (TrackBar1.Position*rss);
  113.           syy :=   (TrackBar1.Position*rss);
  114.           sxx := abs(sxx);
  115.           syy := abs(syy);
  116.           xx:=   round(xx +  (56-sxx)/2);
  117.           yy:=   round(yy +  (64-syy)/2);
  118.  
  119.         if(jj<13-ii) then begin
  120.            BGLContext.Canvas.FillRect(xx, yy, xx + sxx, yy + syy, grad.GetColorAtF((ii + jj) / (maxColumn + maxRow)));
  121.         end;
  122.       end;
  123.     end;
  124.    finally
  125.   end;
  126.   grad.Free;
  127. end;
  128.  
  129. procedure TForm1.Button1Click(Sender: TObject);
  130. begin
  131.   playsound1.Execute;
  132. end;
  133.  
  134. procedure TForm1.Timer1Timer(Sender: TObject);
  135. begin
  136.     ct := ct +1;
  137.     ctt := ctt +1;
  138.     Label1.caption := IntToStr(TrackBar2.Position);
  139.     shape_type := spinEdit2.Value;
  140.     BGLVirtualScreen1.Repaint;
  141.  
  142. end;
  143.  
  144. end.
  145.  
Sub Quantum Technology ! If your friend are clever you are too !!

Gigatron

  • Jr. Member
  • **
  • Posts: 53
  • Amiga
Re: Demoscene Square dot flag fx
« Reply #13 on: April 17, 2024, 01:14:18 am »
Edit : ** In fact I don't need to do anything, I just tested your example and it works perfectly :)
Thank you very much :)
You're very welcome  :)

Quote
By the way , you certainly know the Amiga Blitter..
Can you include it in BGRA? We take part of the image and copy it elsewhere, it looks like Drawpart image like in javascript.
BGRABlit(x,y,x1,y1, dx,dy)
I don't know about Amiga Blitter, but I understand your wish. Would it be with BGLCanvas or with a TBGRABitmap? There is TBGRABitmap.PutImagePart that would do that.

Regards

Thank you , will try it asap to make something great :)
Sub Quantum Technology ! If your friend are clever you are too !!

KodeZwerg

  • Hero Member
  • *****
  • Posts: 2237
  • Fifty shades of code.
    • Delphi & FreePascal
Re: Demoscene Square dot flag fx
« Reply #14 on: April 17, 2024, 03:47:30 am »
Unlocked it more, added labels to write down values :D, added colorbuttons to choose gradient colors on the fly, added a preset box to choose my defaults for each different shapestyle (they mostly look same on any screensize), modified this and that.
Project and a preview attached.
Variable screensize can differ to variable results :D

//edit
re-uploaded with some more presets
« Last Edit: April 17, 2024, 05:24:26 am by KodeZwerg »
« Last Edit: Tomorrow at 31:76:97 xm by KodeZwerg »

 

TinyPortal © 2005-2018