1
Graphics / Demoscene The Champs Cracktro
« Last post by Gigatron on Today at 02:26:07 am »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 ;
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 ;
- 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.