Demo Scene picture shift
lazarus / 39-Graphics

----------------------------------------------------------------------
Gigatron · 2024-04-28 19:52

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls,  BGRAVirtualScreen, BGRABitmap,
BGRABitmapTypes; type  { TForm1 }  TForm1 = class(TForm)   
BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;   
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure
FormDestroy(Sender: TObject);    procedure Timer1Timer(Sender:
TObject);   private  public  end; var  Form1: TForm1;  Bmp  :
TBGRABitmap;  // picture  fx,demo_timer : integer; implementation {$R
*.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin 
 Bmp := TBGRABitmap.Create('warrior3.jpg');   
BGRAVirtualScreen1.Width := Bmp.Width;    BGRAVirtualScreen1.Height:=
Bmp.Height;    fx := 0;    demo_timer :=0;end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);var i,y : integer;begin     i :=0; y := -4;     for i:=0
to Bmp.Height-1  do      begin       y :=  y + 4;     
 Bitmap.PutImagePart(-bmp.Width+fx ,  y   ,   Bmp,  Rect( 0,  y,
 bmp.Width ,y+2), dmSet);       Bitmap.PutImagePart( bmp.Width-fx ,
 y+2   , Bmp,  Rect( 0,  y+2,  bmp.Width ,y+4), dmSet);     
end;end;procedure TForm1.Timer1Timer(Sender: TObject);begin   
 inc(demo_timer);      if(demo_timer>100) and (demo_timer<1000) then 
  begin        inc(fx);        if(fx>=bmp.Width) then fx :=
bmp.Width;     end;      if(demo_timer>1200) then     begin     
 dec(fx);       if(fx=0) then demo_timer :=0;      end;              
                BGRAVirtualScreen1.RedrawBitmap;end;procedure
TForm1.FormDestroy(Sender: TObject);begin  Bmp.Free;end;end.  * Edit :
The simulation is now perfect

----------------------------------------------------------------------
Gigatron · 2024-06-05 20:45

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls,  BGRAVirtualScreen,
BGRABitmap,BGRABitmapTypes ; type   { TForm1 }   TForm1 =
class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1:
TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);  private   public    w, h: Integer;   
fn, fn2: single;    fAddF, fAddV: single;    fStep: Integer; end; var 
Form1: TForm1;  bmp,bmp_dest : TBGRABitmap; implementation {$R
*.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin 
bmp  := TBGRABitmap.Create('plasma9.jpg');  w   := bmp.Width;  h   :=
bmp.Height;  bmp_dest := TBGRABitmap.Create(w,h);   fn := 0;  fn2 :=
0;  fAddF := 0.05;  fAddV := 0.03;  fStep := 4; end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);var  i: Integer;  sn, sn2, ww : single;begin  sn := fn; 
sn2 := fn2;   for i := 0 to h - 1 do  begin       ww := (cos(fn) + 1)
* 100 + (sin(fn2) + 1) * 200;     
 bmp_dest.PutImagePart(0,i,bmp,Rect(-Round(ww / 2), i, w * 2, i +
fStep),dmSet);       fn := fn + fAddF + fAddV;       fn2 := fn2 +
FAddV;   end;   fn := sn + 0.002;   fn2 := sn2 - 0.03; 
 Bitmap.PutImage(0,0,bmp_dest,dmset);end; procedure
TForm1.Timer1Timer(Sender: TObject);begin   
 BGRAVirtualScreen1.RedrawBitmap;end;end.

----------------------------------------------------------------------
Gigatron · 2024-06-13 22:03

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][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls, Spin,  BGRAVirtualScreen,
BGRABitmap,
BGRABitmapTypes,BGRATransform,BGRAGradientScanner,mmsystem; type 
TWaveScanner = class(TBGRAAffineBitmapTransform)    Time: integer;   
function GetOffset({%H-}X, Y: Single): Single;    { fast integer
scanning (used by PutImage) }    procedure ScanMoveTo(X, Y: Integer);
override;    { slow floating point scanning }    function ScanAt(X, Y:
Single): TBGRAPixel; override;    constructor Create(ASource:
TBGRACustomBitmap; ARepeatX,ARepeatY: boolean);  end;   { TForm1 }  
TForm1 = class(TForm)    BGRAVirtualScreen1: TBGRAVirtualScreen;   
Timer1: TTimer;    procedure BGRAVirtualScreen1Redraw(Sender: TObject;
Bitmap: TBGRABitmap);    procedure FormCreate(Sender: TObject);   
procedure Timer1Timer(Sender: TObject);  private   public     w, h:
Integer;    fn, fn2,zz: single;    fAddF, fAddV: single;    fStep:
Integer;    // bounce var    g    : single;    // gravity    y,vy :
integer;   // ypos , vertical y speed      txt_scanner: TWaveScanner; 
  procedure DrawNormalScroller;    function drawFontChar(charek: Char;
x: Integer): Integer;   end; var  Form1: TForm1;  sn : single; 
claudia,dest,txtbitmap :TBGRABitmap; 
bitmap_font,tx_scroll_bitmap,dest_bitmap : TBGRABitmap; // images
scroll text related  charek : char;  offset: Char;  charSet: String; 
fonts_width, fonts_height,pos_y: Integer;  sx, tx, scroll_speed :
Integer;  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            ';    MyAudio_File:
AnsiString;  WavStream : TMemoryStream;   message : Array[0..10] Of
String =('           GIGATRON      ',                                
   '           PRESENTS      ',                                     '
                       ',                                     '
 VERTICAL PICTURE SHIFT ',                                     '     
    DEMO V1.0     ',                                     '     MADE
WITH LAZARUS   ',                                     'FREE PASCAL
COMPILER V6.0',                                     '                
       ',                                     '-----------------------
 ',                                     '     GO TO SUB-QUANTUM   ', 
                                  '-----------------------
 ');   implementation {$R *.lfm} { TForm1 } procedure
TForm1.FormCreate(Sender: TObject);begin    claudia      :=
TBGRABitmap.Create('claudia.png');    dest         :=
TBGRABitmap.Create(512,512);    txtbitmap    :=
TBGRABitmap.Create(512,512);     w   := claudia.Width;    h   :=
claudia.Height;   fn := 0;  fn2 := 0;  fAddF := 0.05;  fAddV := 0.03; 
fStep := 20;    // audio stream    MyAudio_File := 'cbr.wav';   
WavStream    := TMemoryStream.Create;   
WavStream.LoadFromFile(MyAudio_File);    PlaySound(WavStream.Memory,
0, SND_LOOP  or SND_NODEFAULT or SND_ASYNC or SND_MEMORY);    //
bounce vars init    g := 2.0;   // gravity    y := -1024; // far dest
bitmap  y position at -1024 outside the screen    vy := 0; // vertical
y speed !     dest_bitmap := TBGRABitmap.Create(740,32);   
bitmap_font := TBGRABitmap.Create('fnt16x16.png');    fonts_width  :=
16;    fonts_height := 16;    sx := 1000;  // start scroll pos x  
right    charek :=' '; // void always !    offset := ' '; // the first
char on s_text = ' ' = space    scroll_speed := 2;    pos_y := 0;    
txt_scanner := TWaveScanner.Create(dest_bitmap,false,false);   
txt_scanner.Translate(00,490); // scroll text   end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);var   i: Integer;   sn, sn2, ww : single;begin      sn :=
fn;      sn2 := fn2;      txtbitmap.FontHeight:=40;     
txtbitmap.FontAntialias:=false;     
txtbitmap.FontName:='AmigaParadox';       for i:=0 to High(message)
do      begin     
 txtbitmap.TextOut(4,14+i*42,message[i],BGRA(50,50,50));     
 txtbitmap.TextOut(0,10+i*42,message[i],BGRA(255,250,255));     
end;        for i := 0 to h-1 do       begin        ww := (cos(fn) * 2
)  * 2 + (sin(fn2) * 2) ;         dest.PutImagePart(0, i + Round(ww),
claudia, Rect(0,i,512,i +1),dmSet); // 1 pixel w       
dest.PutImagePart(0, i + Round(ww),txtbitmap,Rect(0,i ,512,i+1
),dmDrawWithTransparency); // 1 pixel w        fn := fn + fAddF +
fAddV;        fn2 := fn2 + FAddV;       end;        fn :=  sn  +
0.010;    // 0.02;       fn2 := sn2 - 0.08;  // 0.03;      
 bitmap.PutImage(90,y ,dest,dmSet);        DrawNormalScroller;     
 Bitmap.Fill(txt_scanner,dmLinearBlend); end; procedure
TForm1.Timer1Timer(Sender: TObject);begin     vy := vy  + Round(g); //
bounce loop !     y  := y +  vy;    if (y > 20 ) then       begin    
 y  := 20 ;       vy := Round(vy *(Frac(-0.80)));      end;    
 BGRAVirtualScreen1.RedrawBitmap; end; function
TForm1.drawFontChar(charek: Char; x: Integer): Integer;var  p, cx, cy,
l, r: Integer;begin  if (x > width) and (x > 0) then  begin    Result
:= 0;    Exit;  end;   // 16x16   p := Ord(charek) ;   r :=  (p -
Ord(offset)) div (bitmap_font.Width div fonts_width); // nb char 40*8 
 cx := (p - Ord(offset) -r * (bitmap_font.Width div fonts_width) )  *
fonts_width;   // dans ce cas là * 40   cy := 0 + (r * fonts_height);
// 0    // 8x8   //p := Ord(charek);   //cx := (p - Ord(offset)  )  *
fonts_width;   //cy :=  0; // 0   for l := 0 to fonts_width-1   do 
begin    if (cx >= 0) and (x + l <= width) then    begin       
dest_bitmap.PutImagePart(x + l  , pos_y , bitmap_font, Rect(cx + l,
cy, cx + l + 1, cy + fonts_height), dmSet);    end;  end;  Result :=
1;end; procedure TForm1.DrawNormalScroller;var  last_char: Char;  x,
i: Integer;  koda: Char;  xLimit: Integer;begin   dec(sx,
scroll_speed);  x := sx;  xLimit := width + fonts_width;   for i := 1
to Length(s_text) do  begin    koda := s_text[i];    x := x +
fonts_width;   if (x > -fonts_width) and (x < xLimit) then    begin  
  if drawFontChar(koda, x) = 0 then        Break;      last_char :=
koda;    end;  end;  if x < 0 then sx := xLimit; end; { TWaveScanner
} function TWaveScanner.GetOffset(X, Y: Single): Single;begin //
result := 0 * sin((Y + Time) * 30/6 * PI / 180);   // no sinus * 0 
result := 0;     // no sinus * 0end; procedure
TWaveScanner.ScanMoveTo(X, Y: Integer);begin  inherited ScanMoveTo(X +
round(GetOffset(X, Y)), Y);end; function TWaveScanner.ScanAt(X, Y:
Single): TBGRAPixel;begin  Result:=inherited ScanAt(X + GetOffset(X,
Y), Y);end; constructor TWaveScanner.Create(ASource:
TBGRACustomBitmap;  ARepeatX,ARepeatY: boolean);begin  inherited
Create(ASource, ARepeatX, ARepeatY);  Time := 0;end; end.

----------------------------------------------------------------------
Gigatron · 2024-06-14 21:29

Hi,
I didn't like the code bouncing from above so for better bounce fx :

Code: Pascal  [Select][+][-]window.onload = function(){var x1 =
document.getElementById("main_content_section"); if (x1) { var x =
document.getElementsByClassName("geshi");for (var i = 0; i unit
Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms,
Controls, Graphics, Dialogs, ExtCtrls,  BGRAVirtualScreen, BGRABitmap,
BGRABitmapTypes; type   { TForm1 }   TForm1 = class(TForm)   
BGRAVirtualScreen1: TBGRAVirtualScreen;    Timer1: TTimer;   
procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);    procedure FormCreate(Sender: TObject);    procedure
Timer1Timer(Sender: TObject);  private   public   end; var  Form1:
TForm1;  claudia :TBGRABitmap; // image  g    : single;    // gravity 
y,vy : integer;   // ypos , vertical y speed implementation {$R
*.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin 
 claudia  := TBGRABitmap.Create('claudia.png');     g := 2.0;   //
gravity     y := -1024; // far claudia y position outside the screen
at - 1024     vy := 0;    // vertical y speed !      end; procedure
TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap:
TBGRABitmap);begin       bitmap.PutImage(90,y,claudia,dmSet); // place
image at x=90,y= -1024 outside the screenend; procedure
TForm1.Timer1Timer(Sender: TObject);begin     vy := vy  + Round(g); //
bounce loop !     y  := y +  vy;    if (y > 20 ) then       begin    
 y  := 20 ;       vy := Round(vy *(Frac(-0.80)));      end;   
BGRAVirtualScreen1.RedrawBitmap;end; end.