Recent

Author Topic: Demo Scene picture shift  (Read 1300 times)

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Demo Scene picture shift
« on: April 28, 2024, 09:52:51 pm »
Hi,

Another nice fx from Amiga demos is shift odd and even line to recompose picture using BGRA Component drawpart (the best function to simulate Amiga Blitter (Block Transfert Chip, in 1984 4mb/sec of memory transfert);
Picture from : Josu Hernaiz

Fx simulate North Star logo at top ;
https://www.youtube.com/watch?v=VFs2qnfrHO8&t=1602s

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. type
  12.   { TForm1 }
  13.   TForm1 = class(TForm)
  14.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  15.     Timer1: TTimer;
  16.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  17.     procedure FormCreate(Sender: TObject);
  18.     procedure FormDestroy(Sender: TObject);
  19.     procedure Timer1Timer(Sender: TObject);
  20.  
  21.   private
  22.   public
  23.   end;
  24.  
  25. var
  26.   Form1: TForm1;
  27.   Bmp  : TBGRABitmap;  // picture
  28.   fx,demo_timer : integer;
  29.  
  30. implementation
  31.  
  32. {$R *.lfm}
  33.  
  34. { TForm1 }
  35.  
  36. procedure TForm1.FormCreate(Sender: TObject);
  37. begin
  38.     Bmp := TBGRABitmap.Create('warrior3.jpg');
  39.     BGRAVirtualScreen1.Width := Bmp.Width;
  40.     BGRAVirtualScreen1.Height:= Bmp.Height;
  41.     fx := 0;
  42.     demo_timer :=0;
  43. end;
  44.  
  45. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  46. var i,y : integer;
  47. begin
  48.      i :=0; y := -4;
  49.      for i:=0 to Bmp.Height-1  do
  50.       begin
  51.        y :=  y + 4;
  52.        Bitmap.PutImagePart(-bmp.Width+fx ,  y   ,   Bmp,  Rect( 0,  y,  bmp.Width ,y+2), dmSet);
  53.        Bitmap.PutImagePart( bmp.Width-fx ,  y+2   , Bmp,  Rect( 0,  y+2,  bmp.Width ,y+4), dmSet);
  54.       end;
  55. end;
  56. procedure TForm1.Timer1Timer(Sender: TObject);
  57. begin
  58.      inc(demo_timer);
  59.  
  60.      if(demo_timer>100) and (demo_timer<1000) then
  61.      begin
  62.         inc(fx);
  63.         if(fx>=bmp.Width) then fx := bmp.Width;
  64.      end;
  65.  
  66.      if(demo_timer>1200) then
  67.      begin
  68.        dec(fx);
  69.        if(fx=0) then demo_timer :=0;
  70.  
  71.      end;                          
  72.      BGRAVirtualScreen1.RedrawBitmap;
  73. end;
  74. procedure TForm1.FormDestroy(Sender: TObject);
  75. begin
  76.   Bmp.Free;
  77. end;
  78. end.
  79.  
  80.  
* Edit :
The simulation is now perfect :)
« Last Edit: April 28, 2024, 10:23:06 pm by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene picture shift
« Reply #1 on: June 05, 2024, 10:45:49 pm »
Ok,
We can make a plasma style movement using BGRA (bmp_dest.PutImagePart(0,i,bmp,Rect(-Round(ww / 2), i, w * 2, i + fStep),dmSet); ) like this :

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. 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 Timer1Timer(Sender: TObject);
  21.   private
  22.  
  23.   public
  24.     w, h: Integer;
  25.     fn, fn2: single;
  26.     fAddF, fAddV: single;
  27.     fStep: Integer;
  28.  end;
  29.  
  30. var
  31.   Form1: TForm1;
  32.   bmp,bmp_dest : TBGRABitmap;
  33.  
  34. implementation
  35.  
  36. {$R *.lfm}
  37.  
  38. { TForm1 }
  39.  
  40. procedure TForm1.FormCreate(Sender: TObject);
  41. begin
  42.   bmp  := TBGRABitmap.Create('plasma9.jpg');
  43.   w   := bmp.Width;
  44.   h   := bmp.Height;
  45.   bmp_dest := TBGRABitmap.Create(w,h);
  46.  
  47.   fn := 0;
  48.   fn2 := 0;
  49.   fAddF := 0.05;
  50.   fAddV := 0.03;
  51.   fStep := 4;
  52.  
  53. end;
  54.  
  55. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  56. var
  57.   i: Integer;
  58.   sn, sn2, ww : single;
  59. begin
  60.   sn := fn;
  61.   sn2 := fn2;
  62.  
  63.   for i := 0 to h - 1 do
  64.   begin
  65.        ww := (cos(fn) + 1) * 100 + (sin(fn2) + 1) * 200;
  66.        bmp_dest.PutImagePart(0,i,bmp,Rect(-Round(ww / 2), i, w * 2, i + fStep),dmSet);
  67.        fn := fn + fAddF + fAddV;
  68.        fn2 := fn2 + FAddV;
  69.    end;
  70.    fn := sn + 0.002;
  71.    fn2 := sn2 - 0.03;
  72.    Bitmap.PutImage(0,0,bmp_dest,dmset);
  73. end;
  74.  
  75. procedure TForm1.Timer1Timer(Sender: TObject);
  76. begin
  77.      BGRAVirtualScreen1.RedrawBitmap;
  78. end;
  79. end.
  80.  
  81.  

Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene picture shift
« Reply #2 on: June 14, 2024, 12:03:54 am »
Hi,

We can shift pixels vertically to make nice fx ;
Here is the code with some additions like scrolltext and wavescanner from Circular;
sfx : by maktone
gfx : www

Here is the result of this demo ;

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

** Edit:  The code was replaced with better bounce code, it's now Perfect ! **

Code: Pascal  [Select][+][-]
  1. unit Unit1;
  2.  
  3. {$mode objfpc}{$H+}
  4.  
  5. interface
  6.  
  7. uses
  8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, Spin,
  9.   BGRAVirtualScreen, BGRABitmap, BGRABitmapTypes,BGRATransform,BGRAGradientScanner,mmsystem;
  10.  
  11. type
  12.   TWaveScanner = class(TBGRAAffineBitmapTransform)
  13.     Time: integer;
  14.     function GetOffset({%H-}X, Y: Single): Single;
  15.     { fast integer scanning (used by PutImage) }
  16.     procedure ScanMoveTo(X, Y: Integer); override;
  17.     { slow floating point scanning }
  18.     function ScanAt(X, Y: Single): TBGRAPixel; override;
  19.     constructor Create(ASource: TBGRACustomBitmap; ARepeatX,ARepeatY: boolean);
  20.   end;
  21.  
  22.   { TForm1 }
  23.  
  24.   TForm1 = class(TForm)
  25.     BGRAVirtualScreen1: TBGRAVirtualScreen;
  26.     Timer1: TTimer;
  27.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  28.     procedure FormCreate(Sender: TObject);
  29.     procedure Timer1Timer(Sender: TObject);
  30.   private
  31.  
  32.   public
  33.  
  34.     w, h: Integer;
  35.     fn, fn2,zz: single;
  36.     fAddF, fAddV: single;
  37.     fStep: Integer;
  38.     // bounce var
  39.     g    : single;    // gravity
  40.     y,vy : integer;   // ypos , vertical y speed
  41.  
  42.  
  43.     txt_scanner: TWaveScanner;
  44.     procedure DrawNormalScroller;
  45.     function drawFontChar(charek: Char; x: Integer): Integer;
  46.  
  47.   end;
  48.  
  49. var
  50.   Form1: TForm1;
  51.   sn : single;
  52.   claudia,dest,txtbitmap :TBGRABitmap;
  53.   bitmap_font,tx_scroll_bitmap,dest_bitmap : TBGRABitmap; // images scroll text related
  54.   charek : char;
  55.   offset: Char;
  56.   charSet: String;
  57.   fonts_width, fonts_height,pos_y: Integer;
  58.   sx, tx, scroll_speed : Integer;
  59.   s_text : string = ' GIGATRON FRANCE PROUDLY PRESENTS VERTICAL PICTURE SHIFT DEMO V1.0 CODED ON LAZARUS FPC V 6.0 !!!  THERE IS NO PROCESSOR SPARE TIME TO ADD MORE FX ON THE SCREEN !!! REMEMBER AMIGA WITH 7.09 MHZ !!!  SEE YOU LATER            ';
  60.  
  61.  
  62.   MyAudio_File: AnsiString;
  63.   WavStream : TMemoryStream;
  64.  
  65.   message : Array[0..10] Of String =('           GIGATRON      ',
  66.                                      '           PRESENTS      ',
  67.                                      '                         ',
  68.                                      '  VERTICAL PICTURE SHIFT ',
  69.                                      '           DEMO V1.0     ',
  70.                                      '     MADE WITH LAZARUS   ',
  71.                                      'FREE PASCAL COMPILER V6.0',
  72.                                      '                         ',
  73.                                      '-----------------------  ',
  74.                                      '     GO TO SUB-QUANTUM   ',
  75.                                      '-----------------------  ');
  76.  
  77.  
  78.  
  79. implementation
  80.  
  81. {$R *.lfm}
  82.  
  83. { TForm1 }
  84.  
  85. procedure TForm1.FormCreate(Sender: TObject);
  86. begin
  87.     claudia      := TBGRABitmap.Create('claudia.png');
  88.     dest         := TBGRABitmap.Create(512,512);
  89.     txtbitmap    := TBGRABitmap.Create(512,512);
  90.  
  91.     w   := claudia.Width;
  92.     h   := claudia.Height;
  93.  
  94.   fn := 0;
  95.   fn2 := 0;
  96.   fAddF := 0.05;
  97.   fAddV := 0.03;
  98.   fStep := 20;
  99.  
  100.    // audio stream
  101.     MyAudio_File := 'cbr.wav';
  102.     WavStream    := TMemoryStream.Create;
  103.     WavStream.LoadFromFile(MyAudio_File);
  104.     PlaySound(WavStream.Memory, 0, SND_LOOP  or SND_NODEFAULT or SND_ASYNC or SND_MEMORY);
  105.     // bounce vars init
  106.     g := 2.0;   // gravity
  107.     y := -1024; // far dest bitmap  y position at -1024 outside the screen
  108.     vy := 0; // vertical y speed !
  109.  
  110.     dest_bitmap := TBGRABitmap.Create(740,32);
  111.     bitmap_font := TBGRABitmap.Create('fnt16x16.png');
  112.     fonts_width  := 16;
  113.     fonts_height := 16;
  114.     sx := 1000;  // start scroll pos x   right
  115.     charek :=' '; // void always !
  116.     offset := ' '; // the first char on s_text = ' ' = space
  117.     scroll_speed := 2;
  118.     pos_y := 0;
  119.  
  120.     txt_scanner := TWaveScanner.Create(dest_bitmap,false,false);
  121.     txt_scanner.Translate(00,490); // scroll text
  122.  
  123.  
  124.  
  125. end;
  126.  
  127. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  128. var
  129.    i: Integer;
  130.    sn, sn2, ww : single;
  131. begin
  132.       sn := fn;
  133.       sn2 := fn2;
  134.       txtbitmap.FontHeight:=40;
  135.       txtbitmap.FontAntialias:=false;
  136.       txtbitmap.FontName:='AmigaParadox';
  137.  
  138.       for i:=0 to High(message) do
  139.       begin
  140.        txtbitmap.TextOut(4,14+i*42,message[i],BGRA(50,50,50));
  141.        txtbitmap.TextOut(0,10+i*42,message[i],BGRA(255,250,255));
  142.       end;
  143.  
  144.        for i := 0 to h-1 do
  145.        begin
  146.         ww := (cos(fn) * 2 )  * 2 + (sin(fn2) * 2) ;
  147.  
  148.         dest.PutImagePart(0, i + Round(ww), claudia, Rect(0,i,512,i +1),dmSet); // 1 pixel w
  149.         dest.PutImagePart(0, i + Round(ww),txtbitmap,Rect(0,i ,512,i+1 ),dmDrawWithTransparency); // 1 pixel w
  150.         fn := fn + fAddF + fAddV;
  151.         fn2 := fn2 + FAddV;
  152.        end;
  153.  
  154.        fn :=  sn  + 0.010;    // 0.02;
  155.        fn2 := sn2 - 0.08;  // 0.03;
  156.  
  157.        bitmap.PutImage(90,y ,dest,dmSet);
  158.  
  159.        DrawNormalScroller;
  160.        Bitmap.Fill(txt_scanner,dmLinearBlend);
  161.  
  162. end;
  163.  
  164. procedure TForm1.Timer1Timer(Sender: TObject);
  165. begin
  166.      vy := vy  + Round(g); // bounce loop !
  167.      y  := y +  vy;
  168.     if (y > 20 ) then
  169.        begin
  170.        y  := 20 ;
  171.        vy := Round(vy *(Frac(-0.80)));
  172.       end;
  173.  
  174.      BGRAVirtualScreen1.RedrawBitmap;
  175.  
  176. end;
  177.  
  178. function TForm1.drawFontChar(charek: Char; x: Integer): Integer;
  179. var
  180.   p, cx, cy, l, r: Integer;
  181. begin
  182.   if (x > width) and (x > 0) then
  183.   begin
  184.     Result := 0;
  185.     Exit;
  186.   end;
  187.    // 16x16
  188.    p := Ord(charek) ;
  189.    r :=  (p - Ord(offset)) div (bitmap_font.Width div fonts_width); // nb char 40*8
  190.    cx := (p - Ord(offset) -r * (bitmap_font.Width div fonts_width) )  * fonts_width;   // dans ce cas là * 40
  191.    cy := 0 + (r * fonts_height); // 0
  192.  
  193.    // 8x8
  194.    //p := Ord(charek);
  195.    //cx := (p - Ord(offset)  )  * fonts_width;
  196.    //cy :=  0; // 0
  197.  
  198.   for l := 0 to fonts_width-1   do
  199.   begin
  200.     if (cx >= 0) and (x + l <= width) then
  201.     begin
  202.         dest_bitmap.PutImagePart(x + l  , pos_y , bitmap_font, Rect(cx + l, cy, cx + l + 1, cy + fonts_height), dmSet);
  203.     end;
  204.   end;
  205.   Result := 1;
  206. end;
  207.  
  208. procedure TForm1.DrawNormalScroller;
  209. var
  210.   last_char: Char;
  211.   x, i: Integer;
  212.   koda: Char;
  213.   xLimit: Integer;
  214. begin
  215.  
  216.   dec(sx, scroll_speed);
  217.   x := sx;
  218.   xLimit := width + fonts_width;
  219.  
  220.   for i := 1 to Length(s_text) do
  221.   begin
  222.     koda := s_text[i];
  223.     x := x + fonts_width;
  224.    if (x > -fonts_width) and (x < xLimit) then
  225.     begin
  226.       if drawFontChar(koda, x) = 0 then
  227.         Break;
  228.       last_char := koda;
  229.     end;
  230.   end;
  231.   if x < 0 then sx := xLimit;
  232.  
  233. end;
  234.  
  235. { TWaveScanner }
  236.  
  237. function TWaveScanner.GetOffset(X, Y: Single): Single;
  238. begin
  239.  // result := 0 * sin((Y + Time) * 30/6 * PI / 180);   // no sinus * 0
  240.   result := 0;     // no sinus * 0
  241. end;
  242.  
  243. procedure TWaveScanner.ScanMoveTo(X, Y: Integer);
  244. begin
  245.   inherited ScanMoveTo(X + round(GetOffset(X, Y)), Y);
  246. end;
  247.  
  248. function TWaveScanner.ScanAt(X, Y: Single): TBGRAPixel;
  249. begin
  250.   Result:=inherited ScanAt(X + GetOffset(X, Y), Y);
  251. end;
  252.  
  253. constructor TWaveScanner.Create(ASource: TBGRACustomBitmap;
  254.   ARepeatX,ARepeatY: boolean);
  255. begin
  256.   inherited Create(ASource, ARepeatX, ARepeatY);
  257.   Time := 0;
  258. end;
  259.  
  260. end.
  261.  
« Last Edit: June 14, 2024, 11:42:13 pm by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

Gigatron

  • Full Member
  • ***
  • Posts: 154
  • Amiga Rulez !!
Re: Demo Scene picture shift
« Reply #3 on: June 14, 2024, 11:29:09 pm »
Hi,
I didn't like the code bouncing from above so for better bounce fx :

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. 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 Timer1Timer(Sender: TObject);
  21.   private
  22.  
  23.   public
  24.  
  25.   end;
  26.  
  27. var
  28.   Form1: TForm1;
  29.   claudia :TBGRABitmap; // image
  30.   g    : single;    // gravity
  31.   y,vy : integer;   // ypos , vertical y speed
  32.  
  33. implementation
  34.  
  35. {$R *.lfm}
  36.  
  37. { TForm1 }
  38.  
  39. procedure TForm1.FormCreate(Sender: TObject);
  40. begin
  41.     claudia  := TBGRABitmap.Create('claudia.png');
  42.      g := 2.0;   // gravity
  43.      y := -1024; // far claudia y position outside the screen at - 1024
  44.     vy := 0;    // vertical y speed !      
  45. end;
  46.  
  47. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  48. begin
  49.        bitmap.PutImage(90,y,claudia,dmSet); // place image at x=90,y= -1024 outside the screen
  50. end;
  51.  
  52. procedure TForm1.Timer1Timer(Sender: TObject);
  53. begin
  54.      vy := vy  + Round(g); // bounce loop !
  55.      y  := y +  vy;
  56.     if (y > 20 ) then
  57.        begin
  58.        y  := 20 ;
  59.        vy := Round(vy *(Frac(-0.80)));
  60.       end;
  61.     BGRAVirtualScreen1.RedrawBitmap;
  62. end;
  63.  
  64. end.
  65.  
« Last Edit: June 14, 2024, 11:41:36 pm by Gigatron »
Sub Quantum Technology ! Gigatron 68000 Colmar France;

 

TinyPortal © 2005-2018