{$X+}
Unit Copper;

Interface

Uses Crt,MemGrfx;

Type
	BarType = Record
					 Col : Array[1..20] of ColType;
					 Pos : Array[1..20] of Byte;
					  UP : Array[1..20] of Boolean;
				 End;

Var
	Pal1 : PalType;
	Bars : Array[1..40] Of BarType;
	NumBars, NumLines : Byte;

Procedure FadeOutBars(NoBars, BarSize : Byte);
Procedure DrawCopper(NoLines,  StartCol, YStart : Byte);
Procedure SetCopperPal(NoBars, BarSize, YStart, ColStart, Space : Byte);
Procedure RotatePal(NoBars, BarSize, YStart, StartCol, NumLines : Byte;
						  Up : Boolean);
Procedure SetUP(NumLines, NumBars, BarSize, YStart, ColStart, Space : Byte);
Procedure DoCopperBars;

Implementation

Procedure FadeOutBars(NoBars, BarSize : Byte);
Var
		F, L : Integer;
	PalFade : PalType;

Begin
	For F := 1 to NoBars do
		For L := 1 to BarSize do
		Begin
			If Bars[F].Col[L].R > 0 Then Dec(Bars[F].Col[L].R);
			If Bars[F].Col[L].G > 0 Then Dec(Bars[F].Col[L].G);
			If Bars[F].Col[L].B > 0 Then Dec(Bars[F].Col[L].B);
		End;
End;

Procedure DrawCopper(NoLines,  StartCol, YStart : Byte);
Var
	Loop : Word;
Begin
	For Loop := YStart to YStart + NoLines do
	Begin
      FillChar(Mem[$a000:Loop*320],320,StartCol+Loop-YStart);
   End;
End;


Procedure SetCopperPal(NoBars, BarSize, YStart, ColStart, Space : Byte);
Var
		Loop : Byte;
	  Loop2 : Word;
		IncR : Byte;
		 RGB : Byte;
	HalfBar : Byte;

Begin
	FillChar(Bars, SizeOf (Bars),0);
	HalfBar := BarSize Div 2;
	IncR := 63 Div HalfBar;
   RGB := 0;
	For Loop := 1 to NoBars do
	Begin
      For Loop2 := 1 to HalfBar do
      Begin
         If RGB = 0 Then
         Bars[Loop].Col[Loop2].R := Loop2 * IncR;
         If RGB = 1 Then
         Bars[Loop].Col[Loop2].G := Loop2 * IncR;
			If RGB = 2 Then
         Bars[Loop].Col[Loop2].B := Loop2 * IncR;

         Bars[Loop].Pos[Loop2] := YStart + (Loop-1) * (BarSize+Space) + Loop2 -1 + ColStart;
			Bars[Loop].UP[Loop2] := True
		End;

		For Loop2 := HalfBar + 1  to BarSize  do
		Begin
			If RGB = 0 Then
			Bars[Loop].Col[Loop2].R := (BarSize - Loop2) * IncR;
			If RGB = 1 Then
         Bars[Loop].Col[Loop2].G := (BarSize - Loop2) * IncR;
			If RGB = 2 Then
         Bars[Loop].Col[Loop2].B := (BarSize - Loop2) * IncR;

         Bars[Loop].Pos[Loop2] := YStart + (Loop-1) * (BarSize+Space) + Loop2 -1 + ColStart;
         Bars[Loop].UP[Loop2] := True
      End;

		RGB := (RGB + 1) Mod 3;
   End;

End;

Procedure RotatePal(NoBars, BarSize, YStart, StartCol, NumLines : Byte;
						  Up : Boolean);

Var
	TPal : PalType;
	TCol : ColType;
	Loop,
	Loop2 : Byte;

Begin
	FillChar(TPal, 768, 0);
	For Loop := 1 to NoBars do
	Begin
		For Loop2 := 1 to BarSize do
		Begin
			TPal[Bars[Loop].Pos[Loop2]] := Bars[Loop].Col[Loop2];
			If Up Then
			Begin
            If Bars[Loop].Pos[Loop2] = StartCol Then
				Bars[Loop].UP[Loop2] := False;
				If Bars[Loop].Pos[Loop2] = NumLines Then
            Bars[Loop].UP[Loop2] := True;

				If Bars[Loop].UP[Loop2] Then
				Dec(Bars[Loop].Pos[Loop2])
				Else
            Inc(Bars[Loop].Pos[Loop2]);

         End;
      End;

   End;
	SetPal(TPal);

End;


Procedure SetUP(NumLines, NumBars, BarSize, YStart, ColStart, Space : Byte);
Begin
	SetMcga;
	DrawCopper(NumLines,ColStart,YStart);
	SetCopperPal(NumBars, BarSize, YStart, ColStart, Space);
End;


Procedure DoCopperBars;
Var
   NumLines,
   NumBars,
   BarSize,
   YStart,
   ColStart,
	Space : Byte;
	Loop : Byte;
	Count: Integer;
Begin
	Count:=0;      NumLines := 200; NumBars := 10;
	BarSize := 20; YStart := 0;     ColStart := 1;
	Space := 20;
	SetUP(NumLines, NumBars, BarSize, YStart, ColStart, Space);
	Repeat
		 RotatePal(NumBars, BarSize,YStart, ColStart, NumLines, True);
		 If KeyPressed Then
		 Begin
			 For Loop := 0 to 63 do
			 Begin
				 RotatePal(NumBars, BarSize,YStart, ColStart, NumLines, True);
				 FadeOutBars(NumBars, BarSize);
			 End;
			 Exit;
		 End;
		 Inc(Count);
	Until (EscPressed=True) Or (Count=650);
End;

End.