unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, OpenGLContext,
ProTracker.Util, ProTracker.Player, ProTracker_Audio, glCanvas;
type
{ TForm1 }
TForm1 = class(TForm)
OpenGLControl1: TOpenGLControl;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure OpenGLControl1Paint(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
public
end;
var
Form1: TForm1;
tmr, cltmr : Single;
txtPosX : Integer;
demotmr : integer;
line_message :Array of PChar;
totalWidth : Single;
// Textures
fnt, fnt8, fnt82, fnt32, fntx, tex,laztex : TGLTextureID; //gluint replacement !
fnt_w, fnt_h,
fnt8_w, fnt8_h,
fnt32_w, fnt32_h,
tex_w, tex_h,
fntx_w, fntx_h : Integer;
laztex_w,laztex_h : integer;
implementation
{$R *.lfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
glInit(OpenGLControl1);
glEnableVSync(True);
cltmr :=0; tmr := 0;
SetLength(line_message, 1);
line_message[0] := ' *** GIGATRON THE DIGITAL BRAIN PRESENTS - GLCANVAS PRE RELASE VERSION DEMO 6 - SFX BY : THE GREAT XTD ! SEE YOU BYE *** ';
// Chargement des textures
fnt := glLoadPNGToTexture('fonts/chmps30_48.png', fnt_w, fnt_h);
fnt8 := glLoadPNGToTexture('fonts/16/021_16.png', fnt8_w, fnt8_h);
fnt32 := glLoadPNGToTexture('fonts/32/razor1911_32.png', fnt32_w, fnt32_h);
fntx := glLoadPNGToTexture('fonts/32/022_32.png', fntx_w, fntx_h);
tex := glLoadJPGToTexture('gfx/aa512x512.jpg', tex_w, tex_h);
laztex := glLoadPNGToTexture('gfx/gtr5.png', laztex_w, laztex_h);
// module
Module := TPTModule.Create(True, False);
Module.Stop;
Module.LoadFromFile('modules/## syntherella 3 ##.mod');
PT_Audio_SetPaused(False);
Module.SetAmplification(0.6);
Module.SetStereoSeparation(50);
PT_Audio_Init;
Module.Play(0, 0);
end;
procedure TForm1.OpenGLControl1Paint(Sender: TObject);
var
i, ww,hh : integer;
scaleVal : Single;
posX : Integer;
accumX : Single;
begin
ww := OpenGLControl1.Width;
hh := OpenGLControl1.Height;
glFillScreen(OpenGLControl1, 0.0, 0.0, 0.0, 1.0);
if(demotmr>1500) then
glCheckerBoard(0,0,ww,hh,sin(tmr*0.3)*2.0,cos(-tmr*0.2)*3.0,
sin(cltmr *0.1),cos(cltmr*0.15),sin(cltmr*0.20))
else
glCheckerBoard(0,0,ww,hh,sin(tmr*0.2)*4.0,cos(-tmr*0.1)*2.0,
1.0,0.0,0.0);
glTextureCopperShader(laztex,440,0,laztex_w ,laztex_h ,tmr*0.02,64.0,
0.95,1.0,0,
0.0, 0.0, 1.0,
1.0, 1.0, 1.0,
0.5 + abs(sin(tmr*0.1)) * 0.5,
0.5 + abs(sin(tmr*0.2)) * 0.5,
0.5 + abs(cos(tmr*0.1)) * 0.5,
0.0, 0.0, 1.0,1.0,
1.0,1.0,1.0);
accumX := 0;
for i := 0 to Length(line_message[0])-1 do
begin
scaleVal := 5.0 + sin(tmr*0.2 + i * 0.3) * 2.0;
glBitmapFontText(fntx, Round(3200 + accumX) - txtPosX, 400, line_message[0][i],
32, 32, 10, 1.0, 0.0, bmAlpha,
scaleVal,
5.0 + cos(tmr*0.2 + i * 0.3) * 2.0);
accumX := accumX + (32 * scaleVal) + 10;
end;
totalWidth := accumX;
glFilled3DCube(OpenGLControl1,0,30,0,50,0.4,0.4,0.4,1.0,
tmr*6,tmr*8,0.0,1.0,0.0,1.0,
true,0.5 + abs(sin(tmr*0.3)) * 0.5,
0.5 + abs(sin(tmr*0.2)) * 0.5,
0.5 + abs(cos(tmr*0.1)) * 0.5,
4.0);
glScreenReflectShader(OpenGLControl1,0.4,0.004,50.0,tmr*0.2, 10.0);
OpenGLControl1.SwapBuffers;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
inc(demotmr);
if (demotmr>200) then tmr := tmr + 0.2;
cltmr := cltmr + 0.1;
txtPosX := txtPosX + 5;
if txtPosX > Round(3200 + totalWidth) then txtPosX := 0;
OpenGLControl1.Invalidate;
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
if Module <> nil then Module.Stop;
PT_Audio_Close;
if Assigned(Module) then FreeAndNil(Module);
end;
end.
Recent
