Recent

Author Topic: Demo Scene Cracktro Remakes  (Read 476 times)

Gigatron

  • Full Member
  • ***
  • Posts: 104
  • Amiga Rulez !!
Demo Scene Cracktro Remakes
« on: June 12, 2024, 04:57:20 pm »
Hi,
Just quick coded and converted a cracktro made in the past on javascript but now with Lazarus FPC
with BGRA Component.
This cracktro is 38 years old !!(1986) and the group called Megabyte on Amiga ;
Please look the code and see how it's easy to remake this cracktro ;

original version
https://www.youtube.com/watch?v=X8_cdYCTwF0&t=10s

my version :
https://www.youtube.com/watch?v=yNO-QydTLf0




and 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.   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.    txt_scanner: TWaveScanner;
  34.    procedure DrawNormalScroller;
  35.    function drawFontChar(charek: Char; x: Integer): Integer;
  36.  
  37.  
  38.  
  39.   end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.   bitmap_font,tx_scroll_bitmap,logo,dest_bitmap,copper,gridTop,gridBottom,ball : TBGRABitmap; // images
  44.   charek : char;
  45.   offset: Char;
  46.   charSet: String;
  47.   fonts_width, fonts_height,pos_y: Integer;
  48.   sx, tx, scroll_speed : Integer;
  49.   s_text : string = 'MEGABYTE INC. PROUDLY PRESENTS...     LEADER BOARD          DON"T HIT THE MOUSE BUTTONS YET, BUT TAKE A COMFORTABLE SEAT AND ENJOY OUR BREATHTAKING INTRO.  IT WAS ABOUT TIME THAT SOMEONE STARTED TO USE THE POWERFUL CAPABILITIES OF THIS AWESOME MACHINE.           ABOUT LEADER BOARD: YOU CAN PRESS THE SLASH KEY (/) TO RESTART THE GAME.          FIRST OF ALL, HERE ARE THE ESSENTIAL GREETINGS TO ALL OUR FRIENDS: ADJ, BOB, THE GENERAL (THANKS FOR SENDING US THE ORIGINAL !), MIKE, CCL (HOW"S THE ARMY, ROB...?), INDY, HEADBANGER, ECA, JWO, THE AMIGAMASTERS, DR. F, RABBIT SYSTEMS, GAME WORLD, SOFTRUNNER, BYTEBREAKER AND ALL THE OWNERS OF A GENUINE N.T.S.C. AMIGA.           THE STRANGE BACKGROUND SOUNDS WERE TAKEN FROM PART ONE OF J.M. JARRE"S ALBUM "ZOOLOOK"           SPECIAL THANKS TO W.H.T.T. PRODUCTIONS FOR DEVELOPING THE SOUND SAMPLING DEVICES AND MIDI HARDWARE.          IF YOU LOOK AT THE DISGUSTING TITLE SCREEN OF EA"S "ONE ON ONE", YOU MIGHT BELIEVE THAT SOFT SCROLLING ON THE AMIGA IS AS BAD AS IT IS ON "MSX"...  HOWEVER, WE PROVE THAT IT IS ABSOLUTELY NO PROBLEM !           SORRY ATARI; IMITATING THE AMIGA BALL DEMO IS POSSIBLE, BUT CAN YOU PLAY DIGITIZED MUSIC, SCROLL TWO LINES OF TEXT, MOVE SEVERAL BITPLANES UP"N"DOWN, CYCLE COLORS AND DISPLAY ABOUT 80 COLORS SIMULTANEOUSLY AND ALL THIS NEARLY WITHOUT USING THE 68000...?  BETTER LUCK NEXT TIME, OK ?          BY THE WAY, THE LITTLE BALL IS NOT A SPRITE, BUT A BLITTER IMAGE (IF YOU DON"T KNOW WHAT THE BLITTER IS, YOU REALLY SHOULDN"T HAVE BOUGHT THIS MACHINE...!!??)           A LITTLE UNIMPORTANT NOTE: I THINK I"M GOING TO DEGAUSS MY MONITOR TOMORROW.           FINAL NOTE TO ALL AMIGA OWNERS:           MEGABYTE INCORPORATED; YOUR CHOICE FOR HIGH LEVEL PROGRAMMING AND SECURITY CODE REMOVAL.                                       ';
  50.   // grid
  51.   gr : single;
  52.   // ball
  53.   x,y : single;
  54.   cnt : single;
  55.   dx,dy : integer;
  56.   // copper;
  57.   cpy : single;
  58.  
  59.  
  60.   MyAudio_File: AnsiString;
  61.   WavStream : TMemoryStream;
  62.  
  63. implementation
  64.  
  65. {$R *.lfm}
  66.  
  67. { TForm1 }
  68.  
  69. procedure TForm1.FormCreate(Sender: TObject);
  70. begin
  71.  
  72.      logo        := TBGRABitmap.Create('mbilogo.png');
  73.      dest_bitmap := TBGRABitmap.Create(740,32);
  74.      bitmap_font := TBGRABitmap.Create('mbifnt.png');
  75.      copper      := TBGRABitmap.Create('mbicopper.png');
  76.  
  77.      gridTop     := TBGRABitmap.Create('grid.png');
  78.      gridBottom  := gridTop;
  79.  
  80.      ball        := TBGRABitmap.Create('ball.png');
  81.  
  82.      fonts_width  := 16;
  83.      fonts_height := 32;
  84.      sx := 680;  // start scroll pos x   right
  85.      charek :=' '; // void always !
  86.      offset := ' '; // the first char on s_text = ' ' = space
  87.      scroll_speed := 2;
  88.      pos_y := 0;
  89.  
  90.      txt_scanner := TWaveScanner.Create(dest_bitmap,false,false);
  91.      txt_scanner.Translate(00,290); // scroll text
  92.      // grid
  93.      gr :=0;
  94.      // ball
  95.  
  96.      x  :=210;
  97.      y  :=180;
  98.      dx :=1;
  99.      dy :=1;
  100.      cnt :=0;
  101.      // copper
  102.      cpy :=0;
  103.  
  104.    // audio stream
  105.     MyAudio_File := 'mbi.wav';
  106.     WavStream    := TMemoryStream.Create;
  107.     WavStream.LoadFromFile(MyAudio_File);
  108.     PlaySound(WavStream.Memory, 0, SND_LOOP  or SND_NODEFAULT or SND_ASYNC or SND_MEMORY);
  109.  
  110. end;
  111.  
  112. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
  113. begin
  114.  
  115.        DrawNormalScroller;  // normal text scrolling
  116.  
  117.         // Scroll bitmap font text
  118.  
  119.       // bitmap.StretchPutImage(Rect(0,50,0+740,50+200),copper,dmSet); // Logo
  120.        //bitmap.StretchPutImage(Rect(-40,20,-40+780,20+240),logo,dmDrawWithTransparency); // Logo
  121.  
  122.        bitmap.PutImage(0,Round(gr),gridTop,dmSet);
  123.        bitmap.PutImage(0,335-Round(gr),gridBottom,dmSet);
  124.  
  125.        bitmap.PutImage(0,180-Round(cpy),copper,dmDrawWithTransparency); // copper
  126.        bitmap.PutImage(-55,100,logo,dmDrawWithTransparency); // Logo
  127.  
  128.        bitmap.PutImage(Round(x),round(y-50* abs(sin(cnt))) ,ball,dmSet);
  129.  
  130.        Bitmap.Fill(txt_scanner,dmLinearBlend);
  131.  
  132. end;
  133.  
  134. procedure TForm1.Timer1Timer(Sender: TObject);
  135. begin
  136.     inc(txt_scanner.Time,1);
  137.     // grid
  138.     gr := gr -0.5;
  139.     if (gr<-23) then gr :=0;
  140.     // ball
  141.     cnt := cnt + 0.092;
  142.     x := x + dx;
  143.     y := y + dy;
  144.     if( x<210 ) or (x>620) then dx := -dx;
  145.     if( y<180 ) or (y>30)  then dy := -dy;
  146.     // copper
  147.     cpy := cpy + 0.5;
  148.     if(cpy>36) then cpy :=0;
  149.  
  150.     BGRAVirtualScreen1.RedrawBitmap;
  151. end;
  152.  
  153. function TForm1.drawFontChar(charek: Char; x: Integer): Integer;
  154. var
  155.   p, cx, cy, l, r: Integer;
  156. begin
  157.   if (x > width) and (x > 0) then
  158.   begin
  159.     Result := 0;
  160.     Exit;
  161.   end;
  162.    // 16x16
  163.    p := Ord(charek) ;
  164.    r :=  (p - Ord(offset)) div (bitmap_font.Width div fonts_width); // nb char 40*8
  165.    cx := (p - Ord(offset) -r * (bitmap_font.Width div fonts_width) )  * fonts_width;   // dans ce cas là * 40
  166.    cy := 0 + (r * fonts_height); // 0
  167.  
  168.    // 8x8
  169.    //p := Ord(charek);
  170.    //cx := (p - Ord(offset)  )  * fonts_width;
  171.    //cy :=  0; // 0
  172.  
  173.   for l := 0 to fonts_width-1   do
  174.   begin
  175.     if (cx >= 0) and (x + l <= width) then
  176.     begin
  177.         dest_bitmap.PutImagePart(x + l  , pos_y , bitmap_font, Rect(cx + l, cy, cx + l + 1, cy + fonts_height), dmSet);
  178.     end;
  179.   end;
  180.   Result := 1;
  181. end;
  182.  
  183. procedure TForm1.DrawNormalScroller;
  184. var
  185.   last_char: Char;
  186.   x, i: Integer;
  187.   koda: Char;
  188.   xLimit: Integer;
  189. begin
  190.  
  191.   dec(sx, scroll_speed);
  192.   x := sx;
  193.   xLimit := width + fonts_width;
  194.  
  195.   for i := 1 to Length(s_text) do
  196.   begin
  197.     koda := s_text[i];
  198.     x := x + fonts_width;
  199.    if (x > -fonts_width) and (x < xLimit) then
  200.     begin
  201.       if drawFontChar(koda, x) = 0 then
  202.         Break;
  203.       last_char := koda;
  204.     end;
  205.   end;
  206.   if x < 0 then sx := xLimit;
  207.  
  208. end;
  209.  
  210. { TWaveScanner }
  211.  
  212. function TWaveScanner.GetOffset(X, Y: Single): Single;
  213. begin
  214.   result := 0 * sin((Y + Time) * 30/6 * PI / 180);   // no sinus * 0
  215. end;
  216.  
  217. procedure TWaveScanner.ScanMoveTo(X, Y: Integer);
  218. begin
  219.   inherited ScanMoveTo(X + round(GetOffset(X, Y)), Y);
  220. end;
  221.  
  222. function TWaveScanner.ScanAt(X, Y: Single): TBGRAPixel;
  223. begin
  224.   Result:=inherited ScanAt(X + GetOffset(X, Y), Y);
  225. end;
  226.  
  227. constructor TWaveScanner.Create(ASource: TBGRACustomBitmap;
  228.   ARepeatX,ARepeatY: boolean);
  229. begin
  230.   inherited Create(ASource, ARepeatX, ARepeatY);
  231.   Time := 0;
  232. end;
  233.  
  234. end.
  235.  
  236. // internal usage nothing was destroyed after Exit !!!
  237.  
  238.  



 
« Last Edit: June 12, 2024, 05:04:43 pm by Gigatron »
Sub Quantum Technology ! I Am Sure The Brain Is A Quantum Computer !!

circular

  • Hero Member
  • *****
  • Posts: 4300
    • Personal webpage
Re: Demo Scene Cracktro Remakes
« Reply #1 on: June 14, 2024, 05:19:52 pm »
Well done! Looks identical to the original one!  :)
Conscience is the debugger of the mind

 

TinyPortal © 2005-2018