{----------------------------------- XtaC -----------------------------------}
{ File - ROUTINES.PAS                                                            }
{ Created - 20/08/1996, 1:45:00 AM                                           }
{ Programmer - Milton Moura aka XtaC aka U2RDEAD aka Xboy¨                   }
{ Comments - This is, like, my 1st demo... Cewl, Hum?                        }
{----------------------------------- XtaC -----------------------------------}
Unit Routines;

InterFace

Uses Crt, MemGrfx;

Const
	NStars = 100;

Type paltype = array[0..255,0..2] of Byte;

{----------------------------------------------------------------------------}

Type Point = Record
		X, Y, Z: Word;
		Col, Speed: Byte;
	End;

Var
	Stars: Array[0..NStars] of Point;
	I, Sort, back, back2, wt, n, xx, yy, c: Integer;
	Palt : paltype;

{ -------------------------------------------------------------------------- }
Function FileExists(FileName:String):Boolean;
Function Check4Files: String;
Procedure MakeMovingStars;
Procedure MakeB2WSaver;
Procedure MakeStars;
Procedure W2BFade;
Procedure FadeOutOne;
Procedure MakeBlood;
Procedure FadeTo(slow : Word; palt2 : paltype);
Procedure bPal(Var palt : paltype; n,r,g,b : Byte);
Procedure Cycle(s,e, skp : Integer);

{ -------------------------------------------------------------------------- }

Implementation

{ -------------------------------------------------------------------------- }
Function FileExists(FileName:String):Boolean;
	 Var TestFile:File;
	 Begin
		Assign (TestFile, FileName);
		{$I-}
		Reset (TestFile);
		Close (TestFile);
		{$I+}
		If IOResult = 0 Then FileExists := True
		Else FileExists := False;
	 End;

{ -------------------------------------------------------------------------- }
Function Check4Files: String;
Begin
	Check4Files:='ALL';
	If Not FileExists('Palette.Dat') Then Check4Files:='The Palette file ';
	If Not FileExists('Song.Dat') Then Check4Files:='The Music file ';
	If Not FileExists('Demo.Dat') Then Check4Files:='The Intro Screen file ';
End;

{ -------------------------------------------------------------------------- }

Procedure MakeMovingStars;
Var Count: Integer;
Begin
	Count:=0;
	For i:=0 to NStars do Begin
		Stars[i].X := Random(320);
		Stars[i].Y := Random(200);
		Stars[i].Col := wColor[Random(16)];
		Stars[i].Speed := Stars[i].Col;
	End;
	Repeat
		For i:=0 to NStars do
			PutPixel(Stars[i].X, Stars[i].Y, Stars[i].Col, VGA);
		WaitRetrace;
		For i:=0 to NStars do begin
			for Sort:=0 to 3 do begin
				if(Stars[Sort].Col > Sort) then begin
					PutPixel(Stars[i].X, Stars[i].Y, 0, VGA);
					Inc(Stars[i].X, Stars[i].Speed div 15);
					If Stars[i].X > 320 then begin
						Stars[i].Y := Random(200);
						Stars[i].X := 1;
					End;
				End;
			End;
		End;
		Inc(Count);
	Until (EscPressed=True) Or (Count=650);
End;

{ -------------------------------------------------------------------------- }

Procedure MakeB2WSaver;
Var X, Y, Col: word; Vr,color: Integer;
Begin
vr:=random(1000);
repeat
		for x:=0 to 319 do begin
			for y:=0 to 199 do
				PutPixel( Vr*x, y*vr, wColor[col], Vga);
			if (Col > 15) Or (Col < 0) then Col := 0;
			inc(col);
		end;
	WaitRetrace;
	inc(vr);
	until EscPressed=True;
End;

{ -------------------------------------------------------------------------- }

Procedure MakeStars;
Var i: Byte;
Begin
 for i:= 0 to 200 do
	putpixel(random(320),random(200), wColor[random(15)], vga);
End;

{ -------------------------------------------------------------------------- }

Procedure W2BFade;
Begin
  For i:=31 downto 16 do begin
	cls(i,vga);
	delay(10);
  end;
End;

{ -------------------------------------------------------------------------- }

Procedure bPal(Var palt : paltype; n,r,g,b : Byte);
Begin
	palt[n,0]:=r;
	palt[n,1]:=g;
	palt[n,2]:=b;
End;

{----------------------------------------------------------------------------}

Procedure FadeTo(slow : Word; palt2 : paltype);
Var n, i, ii : Byte;
	 palt : paltype;
Begin
	For n:=0 To 255 Do
		getpal(n,palt[n,0],palt[n,1],palt[n,2]);
	For i:=0 To 63 Do Begin
		delay(slow);
		waitretrace;
		ii:=63-i;
		For n:=0 To 255 Do
			pal(n,(palt2[n,0]*i+palt[n,0]*ii) div 63,
				(palt2[n,1]*i+palt[n,1]*ii) div 63,
				(palt2[n,2]*i+palt[n,2]*ii) div 63);
	End;
End;

{----------------------------------------------------------------------------}

Procedure FadeOutOne;
Var n, i : Byte;
	 r,g,b : Byte;
Begin
	For n:=0 To 255 Do Begin
		getpal(n,r,g,b);
		If r>0 Then dec(r);
		If g>0 Then dec(g);
		If b>0 Then dec(b);
		pal(n,r,g,b);
	End;
End;

{----------------------------------------------------------------------------}

Procedure Cycle(s,e, skp : Integer);
Var n,c : Integer;
	 palt2 : paltype;
Begin
	For n:=s To e Do
		getpal(n,palt2[n,0],palt2[n,1],palt2[n,2]);
	If skp>0 Then
		n:=skp+s
	Else
		n:=e+1+skp;
	For c:=s To e Do Begin
		pal(c,palt2[n,0],palt2[n,1],palt2[n,2]);
		inc(n);
		If n>e Then n:=s;
	End;
End;

{----------------------------------------------------------------------------}

Procedure MakeBlood;
Var nn : longint;
	 Ch : Char;
Begin
	{for n:=0 To 255 Do
		Pal(n,0,0,0);
	Cls(0);}
	For xx:=0 To 320 Do Begin
		c:=random(630)+10;
		n:=random(40)+3;
		For yy:=0 To 200 Do Begin
			inc(c,n);
			If c>639 Then
				dec(c,630);
			If getpixel(xx,yy,vga)=1 Then
				putpixel(xx,yy,c div 10,vga)
			Else
				putpixel(xx,yy,c div 10+63,vga);
		End;
	End;
	For n:=0 To 63 Do Begin
		bpal(palt,n+63,n,n div ((n+1)*2),n div ((n+1)*6));
		If n<1 Then
			bpal(palt,n,n*2,n,n div 3)
		Else
			bpal(palt,n,63,n,n div 2*3);
	End;
	waitretrace;
	For n:=0 To 255 Do
		pal(n,63,63,63);
	fadeto(0,palt);
	n:=0;
	Repeat
		WaitRetrace;
		cycle(1,63,-1);
		cycle(64,127,-1);
		If n>0 Then
			fadeoutone;
		If Keypressed Then
			inc(n);
	Until n>64;
	Ch:= Readkey;
	For n:=0 To 63 Do Begin
		bpal(palt,n,n,n,n);
		bpal(palt,n+64,n,0,0);
		bpal(palt,n+128,0,n,0);
		bpal(palt,n+192,0,0,n);
	End;
End;

End.