Forum > Graphics

Demoscene The Champs Cracktro

(1/2) > >>

Gigatron:
Hi , late at night i woul like to share one of my new project;

The champs cracktro made wit LP;

In the past i made it with gdscript with Godot ;

https://www.youtube.com/watch?v=8ePm_udSYV4

Code with LP : missing font ... but i am working ;


--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAOpenGL, BGRABitmap,  BGRABitmapTypes; const  StarCount = 400;  MaxSpeed  = 3; type  TStar = record        //  Stars    X, Y, Z: Double;    Speed:   Double;  end;   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScr: TBGLVirtualScreen;    Timer1: TTimer;    procedure BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScrUnloadTextures(Sender: TObject; BGLContext: TBGLContext);    procedure FormCreate(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure Timer1Timer(Sender: TObject);     private     Stars  : array of TStar;    a_logo, bg_copper      : IBGLTexture;    one,nine,eight,eight_2 : IBGLTexture;     private     const cop_col:Array[0..245] of String =('#000066','#000055','#000044','#000033','#000022','#000011','#000011','#000022','#000033',                                            '#000044','#000055','#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc',                                            '#0000dd','#0000ee','#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff',                                            '#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff',                                            '#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff',                                            '#8888ff','#7777ff','#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff',                                            '#0000ee','#0000dd','#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066',                                            '#000055','#000044','#000033','#000022','#000011','#000022','#000033','#000044','#000055',                                            '#000066','#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee',                                            '#0000ff','#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff',                                            '#9999ff','#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff',                                            '#eeffff','#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff',                                            '#6666ff','#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd',                                            '#0000cc','#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044',                                            '#000033','#000022','#000011','#000011','#000022','#000033','#000044','#000055','#000066',                                            '#000077','#000088','#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff',                                            '#1111ff','#2222ff','#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff',                                            '#aaaaff','#bbbbff','#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff',                                            '#eeeeff','#ddddff','#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff',                                            '#5555ff','#4444ff','#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc',                                            '#0000bb','#0000aa','#000099','#000088','#000077','#000066','#000055','#000044','#000033',                                            '#000022','#000011','#000022','#000033','#000044','#000055','#000066','#000077','#000088',                                            '#000099','#0000aa','#0000bb','#0000cc','#0000dd','#0000ee','#0000ff','#1111ff','#2222ff',                                            '#3333ff','#4444ff','#5555ff','#6666ff','#7777ff','#8888ff','#9999ff','#aaaaff','#bbbbff',                                            '#ccccff','#ddddff','#eeeeff','#eeffff','#ffffff','#ffffff','#eeffff','#eeeeff','#ddddff',                                            '#ccccff','#bbbbff','#aaaaff','#9999ff','#8888ff','#7777ff','#6666ff','#5555ff','#4444ff',                                            '#3333ff','#2222ff','#1111ff','#0000ff','#0000ee','#0000dd','#0000cc','#0000bb','#0000aa',                                            '#000099','#000088','#000077');   // Sin table Ripped by Gigatron Winuae Debugger; x first 255 , y after 256 to 512 !!  const sprite_dat : Array[0..511] of integer = (80,80,81,83,86,90,94,99,104,110,116,123,130,137,145,152,159,167,173,180,186,192,197,                                                 202,206,209,212,214,215,216,216,216,214,213,210,208,205,201,197,193,189,185,181,177,                                                 173,169,166,162,160,157,155,153,152,151,151,151,151,152,153,155,156,158,160,162,164,                                                 166,168,170,171,172,173,174,174,174,173,172,170,168,166,163,160,156,152,148,143,139,                                                 134,129,125,120,116,112,108,105,102,100,98,97,97,97,98,100,102,106,109,114,119,125,131,                                                 137,144,151,159,166,174,182,189,196,203,209,215,221,226,230,233,236,238,239,239,238,237,                                                 235,232,228,224,219,214,208,202,195,188,181,174,167,160,154,147,141,135,130,125,121,118,                                                 115,112,111,110,109,109,110,112,113,116,118,121,124,128,131,135,139,142,146,149,152,155,                                                 157,159,161,162,163,163,163,163,162,161,160,158,156,154,152,150,148,146,144,142,141,139,                                                 139,138,138,139,139,141,143,145,148,151,155,159,163,168,173,178,183,188,194,199,204,208,                                                 212,216,220,222,225,226,227,227,227,225,223,221,217,213,208,203,197,190,183,176,169,161,                                                 153,145,138,130,123,116,110,104,99,94,90,87,84,83,82,86,82,79,75,72,68,65,62,60,57,55,54,                                                 53,52,51,51,51,52,53,54,55,57,59,62,64,67,69,72,75,78,81,83,86,89,91,93,95,97,98,99,100,                                                 101,101,102,101,101,101,100,99,98,97,96,95,94,92,91,90,89,88,87,87,86,86,86,86,86,87,88,                                                 88,89,90,92,93,94,96,97,99,100,101,102,103,104,105,105,105,105,105,104,103,102,100,98,96,                                                 94,92,89,86,83,80,77,74,71,68,65,63,60,58,56,54,52,51,50,50,50,50,50,51,53,55,57,59,62,65,                                                 68,71,75,78,82,86,89,93,97,100,103,106,109,111,114,115,117,118,119,119,119,119,119,118,116,                                                 115,113,111,109,107,104,102,99,96,94,91,89,86,84,82,80,79,77,76,75,75,74,74,74,75,75,76,76,                                                 77,78,79,80,81,82,83,84,85,86,87,87,87,87,87,87,86,86,85,84,82,81,80,78,76,75,73,72,70,69,67,                                                 66,65,65,64,64,64,64,65,66,67,68,70,72,74,77,80,83,86,89,92,95,98,102,105,108,111,113,116,118,                                                 120,121,122,123,124,124,123,123,121,120,118,116,114,111,108,105,101,98,94,91);     procedure InitializeStarfield;    procedure UpdateStarfield;   public   end; var  Form1: TForm1;   hexColor: string;  red, green, blue: Byte;  pause : integer;  j: integer;   // sprite  vars   xx,yy,nx,ny,ex,ey,exx,eyy : integer; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormCreate(Sender: TObject);begin  Randomize;  InitializeStarfield;  j:=0;  pause := 0; // sprite var initialisation one,nine,eight * 2  xx :=0;  yy := 256;  nx := 6;  ny := 256+6;  ex := 12;  ey := 256+12;  exx:= 18;  eyy:= 256+18;  end; procedure TForm1.FormShow(Sender: TObject);begin        bg_copper := BGLTexture('bg_copper.png');        a_logo := BGLTexture('champs_logo.png');         one     := BGLTexture('one.png');        nine    := BGLTexture('nine.png');        eight   := BGLTexture('eight.png');        eight_2 := BGLTexture('eight_2.png');  end; procedure TForm1.InitializeStarfield;var  i: Integer;begin  SetLength(Stars, StarCount); // Nombre d'étoiles  for i := 0 to High(Stars) do  begin    Stars[i].X := Random(ClientWidth);    Stars[i].Y := (60+Random(ClientHeight-140));    Stars[i].Speed := Random * 2 + 1; // Vitesse aléatoire  end;end; procedure TForm1.UpdateStarfield;var  i : integer;begin  for i := 0 to High(Stars) do  begin     Stars[i].X := Stars[i].X + Stars[i].Speed*3 ;     if Stars[i].X > ClientWidth then // Réinitialiser la position si l'étoile sort de l'écran    begin      Stars[i].X := 0;      Stars[i].Y := (60+Random(ClientHeight-140));      Stars[i].Speed := Random * 2 + 1;     end;  end;end; procedure HexToRGB(hex: string; var r, g, b: Byte);begin  r := StrToInt('$' + Copy(hex, 2, 2));  g := StrToInt('$' + Copy(hex, 4, 2));  b := StrToInt('$' + Copy(hex, 6, 2));end;  procedure TForm1.BGLVirtualScrRedraw(Sender: TObject; BGLContext: TBGLContext);var  i : integer;  StarPosition: TPoint;  sttype : Int16 ;  col: TColor; begin       // draw logo and update Sf + 2 vertical raster bars  BGLCanvas.StretchPutImage(0,0,640,480, bg_copper);  // stars  for i := 0 to High(Stars) do  begin     StarPosition.X := Round(Stars[i].X );    StarPosition.Y := Round(Stars[i].Y);    sttype := Round(Stars[i].Speed);     col := RGBToColor(50,50,50);    // stars bitplanes colors    case  (sttype)  of      1: col := RGBToColor(50,50,50);      2: col := RGBToColor(238,238,238);      3: col := RGBToColor(100,136,255);      4: col := RGBToColor(125,125,125);      5: col := RGBToColor(150,150,150);      6: col := RGBToColor(175,175,175);      7: col := RGBToColor(200,200,200);      8: col := RGBToColor(254,254,254);     end;      BGLContext.Canvas.Rectangle(StarPosition.X, StarPosition.Y,StarPosition.X+1,StarPosition.Y+1,col);  end;   // raster bars cycle colors with pause like A-Team intro  for i := 0 to 31 do  begin       hexColor := cop_col[i+j];       HexToRGB(hexColor, red, green, blue);       BGLContext.Canvas.FillRect(0,370+i*2,640,370+i*2-4,RGBToColor(red,green,blue));   end;   inc(pause);   if (pause>=3) then   begin       inc(j);       pause := 0;       if(j>=184) then j:=0;     end;   BGLCanvas.PutImage(0,50,a_logo,255);    // champs 1988   // sprites   // sin table ...    BGLCanvas.StretchPutImage(-30+sprite_dat[xx]*2 ,-20+sprite_dat[yy]*2,32,32,eight);   BGLCanvas.StretchPutImage(-30+sprite_dat[nx]*2 ,-20+sprite_dat[ny]*2,32,32,eight);   BGLCanvas.StretchPutImage(-30+sprite_dat[ex]*2 ,-20+sprite_dat[ey]*2,32,32,nine);   BGLCanvas.StretchPutImage(-30+sprite_dat[exx]*2 ,-20+sprite_dat[eyy]*2,32,32,one);     BGLCanvas.StretchPutImage(-10+sprite_dat[xx]*2 ,322,32,32,eight);   BGLCanvas.StretchPutImage(-10+sprite_dat[nx]*2 ,322,32,32,eight);   BGLCanvas.StretchPutImage(-10+sprite_dat[ex]*2 ,322,32,32,nine);   BGLCanvas.StretchPutImage(-10+sprite_dat[exx]*2 ,322,32,32,one);    // limites les boucles      inc(exx);    inc(eyy);    if(exx>=255) then exx :=0;    if(eyy>=511) then eyy :=256;     inc(ex);    inc(ey);    if(ex>=255) then ex :=0;    if(ey>=511) then ey :=256;     inc(nx);    inc(ny);    if(nx>=255) then nx :=0;    if(ny>=511) then ny :=256;     inc(xx);    inc(yy);    if(xx>=255) then xx :=0;    if(yy>=511) then yy :=256;    UpdateStarfield;   end; procedure TForm1.BGLVirtualScrUnloadTextures(Sender: TObject; BGLContext: TBGLContext);begin   bg_copper := nil;  a_logo    := nil;   one       := nil;  nine      := nil;  eight     := nil;  eight_2   := nil; end;   procedure TForm1.Timer1Timer(Sender: TObject);begin   BGLVirtualScr.Repaint;end; end.



Lulu:
Well done!
This remember me the circuits Copper, Blitter in the Amiga500! (may be other ? I forgot)

KodeZwerg:
Great job!
I hope you add soon a compressed project with those missing images so we can enjoy it as its supposed to be :D

Gigatron:
Hi,

I must just code bitmapfont scroller and it'ok  ;

KodeZwerg:
Another way for a starfield simulation thingy ...
The stars are not moving, they are blinking to simulate you watching stars.
For my taste, less "stars" are better but tested without any problems up to 50k.
Maybe it be useful for upcoming demos/effects.

--- Code: Pascal  [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses  Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,  BGLVirtualScreen, BGRAOpenGL; type  TStar = packed record    X,    Y: Integer;    CurCol: TColor;  end;  TStars = array of TStar; type   { TForm1 }   TForm1 = class(TForm)    BGLVirtualScreen1: TBGLVirtualScreen;    Panel1: TPanel;    Timer1: TTimer;    procedure BGLVirtualScreen1Redraw(Sender: TObject; BGLContext: TBGLContext);    procedure BGLVirtualScreen1Resize(Sender: TObject);    procedure FormShow(Sender: TObject);    procedure Timer1Timer(Sender: TObject);  strict private    FStars: TStars;    FMaxStars: Integer;  private    procedure GenerateStars(const AMaxStars: Integer);  public   end; var  Form1: TForm1; implementation {$R *.lfm} { TForm1 } procedure TForm1.FormShow(Sender: TObject);begin  Randomize;  GenerateStars(300); // adjust the stars, lower is better  Timer1.Interval := 250; // adjust the timer, higher is betterend; procedure TForm1.GenerateStars(const AMaxStars: Integer);var  i: Integer;begin  SetLength(FStars, AMaxStars);  FMaxStars := AMaxStars;  for i := Low(FStars) to High(FStars) do    begin      FStars[i].X := Random(BGLVirtualScreen1.Width);      FStars[i].Y := Random(BGLVirtualScreen1.Height);      FStars[i].CurCol := RGBToColor(                   Round(255 + (16 - 255) * Succ(i)),                   Round(255 + (16 - 255) * Succ(i)),                   Round(255 + (16 - 255) * Succ(i))                 );    end;end; procedure TForm1.Timer1Timer(Sender: TObject);begin  BGLVirtualScreen1.Repaint;end; procedure TForm1.BGLVirtualScreen1Redraw(Sender: TObject;  BGLContext: TBGLContext);var  i: Integer;begin  for i := Low(FStars) to High(FStars) do    BGLContext.Canvas.FillRect(FStars[i].X, FStars[i].Y, FStars[i].X + Succ(Random(2)), FStars[i].Y + Succ(Random(1)), FStars[i].CurCol);end; procedure TForm1.BGLVirtualScreen1Resize(Sender: TObject);begin  GenerateStars(FMaxStars);end; end.

Navigation

[0] Message Index

[#] Next page

Go to full version