Firework

program Happy_New_Year;
uses    WinCrt, Windows, Graph;
const   MaxX= 640;
        MaxY= 475;
        BackFire_Cycle= 500;
        Explosion_Cycle= 1000;
        Max_BackFire= 10;
        Max_BackFire_Particle= 25;
        Max_BackFire_Vel_X= 50;
        BackFire_Vel_Y= -250;
        BackFire_Arc= Pi/3;
        BackFire_Particle_Size= 3;
        Particle_AirResist= 0.8;
        Max_Regular_Explosion= 20;
        Max_Explosion_Particle= 20;
        Chain_Explosion_Cycle= 500;
        Max_Regular_Speed= 400;
        Min_Regular_Speed= 300;
        Cycle= 5000;
type    Unit_Vector= record
                x, y: Real;
        end;
        Type_Position= Unit_Vector;
        Type_Velocity= Unit_Vector;
        Effect_BackFire= record
                PrePos, Pos: Type_Position;
                Vel: Type_Velocity;
                Use: Boolean;
        end;
        Type_Firework_BackFire= record
                Pos: Type_Position;
                Vel: Type_Velocity;
                Use: Boolean;
                Par: array[1..Max_BackFire_Particle]of Effect_BackFire;
                CurTime: LongInt;
                Color: Byte;
        end;
        Effect_Particle= record
                PrePos, Pos: Type_Position;
                Vel: Type_Velocity;
                Color: Byte;
                Size: Byte;
        end;
        Type_Regular_Explosion= record
                Use: Boolean;
                Angle, Arc: Real;
                StartTime: LongInt;
                Vel: Real;
                Chain: Byte;
                Par: array[1..Max_Explosion_Particle]of Effect_Particle;
        end;
var     GraphDriver, GraphMode: Integer;
        Time_Cycle, Explosion_Time_Cycle, BackFire_Time_Cycle, Time: LongInt;
        i: Byte;
        BackFire: array[1..Max_BackFire]of Type_Firework_BackFire;
        Number_BackFire: Byte;
        Regular_Explosion: array[1..Max_Regular_Explosion]of Type_Regular_Explosion;
        Number_Regular_Explosion: Byte;

function Position(Ox, Oy: Real): Type_Position;
begin
        Position.x:= Ox;
        Position.y:= Oy;
end;

operator +(V1, V2: Unit_Vector)V3: Unit_Vector;
begin
        V3.x:= V1.x + V2.x;
        V3.y:= V1.y + V2.y;
end;

operator *(V1: Unit_Vector; Con: Real)V2: Unit_Vector;
begin
        V2.x:= V1.x*Con;
        V2.y:= V1.y*Con;
end;

operator /(V1: Unit_Vector; Con: Real)V2: Unit_Vector;
begin
        V2.x:= V1.x/Con;
        V2.y:= V1.y/Con;
end;

function Distance(Pos1, Pos2: Type_Position): Real;
begin
        Distance:= Sqrt(Sqr(Pos1.x - Pos2.x) + Sqr(Pos1.y - Pos2.y));
end;

function VectorLength(Vec: Unit_Vector): Real;
var     BaseO: Type_Position;
begin
        BaseO.x:= 0;
        BaseO.y:= 0;
        VectorLength:= Distance(BaseO,Vec);
end;

function VectorRotate(V1: Unit_Vector; Alpha: Real): Unit_Vector;
begin
        VectorRotate.x:= V1.x*Cos(Alpha) - V1.y*Sin(Alpha);
        VectorRotate.y:= V1.x*Sin(Alpha) + V1.y*Cos(Alpha);
end;

procedure Draw_Particle(P: Type_Position; Size, Color: Byte);
begin
        SetColor(Color);
        SetFillStyle(SolidFill,Color);
        Bar(Round(P.x)-Size div 2,Round(P.y)-Size div 2,Round(P.x)+Size div 2,Round(P.y)+Size div 2);
end;

function BackFire_OffScreen(Pos: Type_Position): Boolean;
begin
        if (Pos.x < MaxX/8) or (Pos.x > MaxX*10/8) or (Pos.y < -MaxY) or (Pos.y > MaxY + 1) then
                BackFire_OffScreen:= True
        else    BackFire_OffScreen:= False;
end;

procedure New_BackFire;
var     u: Byte;
begin
        Number_BackFire:= Number_BackFire + 1;
        u:= 0;
        while u < Number_BackFire do
        begin   u:= u + 1;
                if not BackFire[u].Use then
                        Break;
        end;
        with BackFire[u] do
        begin   Pos.x:= Random(MaxX);
                Pos.y:= MaxY;
                Vel.x:= Max_BackFire_Vel_X - Random(Max_BackFire_Vel_X*2);
                Vel.y:= BackFire_Vel_Y;
                Use:= True;
                CurTime:= GetTickCount;
                Color:= Random(20);
        end;
end;

procedure Process_BackFire(u: Byte);
var     v: Byte;
begin
        with BackFire[u] do
                if BackFire_OffScreen(Pos) then
                begin   for v:= 1 to Max_BackFire_Particle do
                        begin   Draw_Particle(Par[v].Pos,4*BackFire_Particle_Size,Black);
                                Par[v].Use:= False;
                        end;
                        Use:= False;
                        Number_BackFire:= Number_BackFire - 1;
                end
                else
                begin   Pos:= Pos + Vel*(GetTickCount - Time)/1000;
                        if (GetTickCount - CurTime) >= 20000/VectorLength(Vel) then
                        begin   v:= 0;
                                while v < Max_BackFire_Particle do
                                begin   v:= v + 1;
                                        if not Par[v].Use then
                                                Break;
                                end;
                                Par[v].Pos:= Pos;
                                Par[v].PrePos:= Pos;
                                Par[v].Vel:= VectorRotate(Vel,Pi - BackFire_Arc/2 + Random(Round(BackFire_Arc*1E9))/1E9);
                                Par[v].Use:= True;
                                CurTime:= GetTickCount;
                        end;
                        for v:= 1 to Max_BackFire_Particle do
                                if Par[v].Use then
                                        with Par[v] do
                                        begin   Draw_Particle(PrePos,4*BackFire_Particle_Size,Black);
                                                PrePos:= Pos;
                                                Vel:= Vel*(1 - (GetTickCount-Time)*Particle_AirResist/1000);
                                                if VectorLength(Vel) < VectorLength(BackFire[u].Vel)/2 then
                                                        Use:= False
                                                else
                                                begin   Pos:= Pos + Vel*(GetTickCount - Time)/1000;
                                                        Draw_Particle(Pos,BackFire_Particle_Size,Color);
                                                end;
                                        end;
                end;
end;

procedure New_Regular_Explosion(P: Type_Position; Speed: Real; Ang, Ar: Real; Ch: Byte; Col: Byte; Si: Byte);
var     u, v: Byte;
begin
        for u:= 1 to Max_Regular_Explosion do
                if not Regular_Explosion[u].Use then
                begin   Number_Regular_Explosion:= Number_Regular_Explosion + 1;
                        Break;
                end;
        with Regular_Explosion[u] do
        begin   Use:= True;
                Angle:= Ang;
                Arc:= Ar;
                Chain:= Ch;
                Vel:= Speed;
                StartTime:= GetTickCount;
                for v:= 1 to Max_Explosion_Particle do
                        with Par[v] do
                        begin   Pos:= P;
                                PrePos:= P;
                                Vel:= VectorRotate(Position(Speed,0),Angle - Arc/2 + Arc*v/(Max_Explosion_Particle - 1));
                                Color:= Col;
                                Size:= Si;
                        end;
        end;
end;

procedure New_Chain_Explosion(P: Type_Position; Re: Byte; Max_Size, Min_Size: Byte);
var     v: Byte;
begin
        for v:= 1 to Re do
                New_Regular_Explosion(P,Min_Regular_Speed + Random(Max_Regular_Speed - Min_Regular_Speed),0,Pi*2,Re - 1,Random(20),Min_Size + (Max_Size - Min_Size)*Round((Re - v + 1)/Re));
end;

procedure Process_Regular_Explosion(u: Byte);
var     v: Byte;
begin
        with Regular_Explosion[u] do
        begin   if GetTickCount - StartTime > Chain*Chain_Explosion_Cycle then
                        for v:= 1 to Max_Regular_Explosion do
                                with Par[v] do
                                begin   Draw_Particle(PrePos,2*Size,Black);
                                        PrePos:= Pos;
                                        Vel:= Vel*(1 - (GetTickCount - Time)*Particle_AirResist/1000);
                                        if (VectorLength(Vel) < Regular_Explosion[u].Vel/2) then
                                                Use:= False
                                        else
                                        begin   Pos:= Pos + Vel*(GetTickCount - Time)/1000;
                                                Draw_Particle(Pos,Size,Color);
                                        end;
                                end;
                if not Use then
                begin   Number_Regular_Explosion:= Number_Regular_Explosion - 1;
                        for v:= 1 to Max_Regular_Explosion do
                                with Par[v] do
                                        Draw_Particle(Pos,2*Size,Black);
                end;
        end;

end;

begin
        ShowWindow(GetActiveWindow,0);
        GraphDriver:= VGA;
        GraphMode:= 2;  // Use 2 for 640x475x16 resolution
        //GraphMode:= VGAHi; // Use VGAHi for maximum available resolution
        InitGraph(GraphDriver,GraphMode,'');

        SetBkColor(Black);
        ClearViewPort;

        SetColor(13);
        SetTextStyle(SansSerifFont,HorizDir,3);
        OutTextXY(75,440,'<3 Happy New Year <3');
        Randomize;
        BackFire_Time_Cycle:= GetTickCount;
        Explosion_Time_Cycle:= GetTickCount;
        Time:= GetTickCount;
        Time_Cycle:= GetTickCount;
        repeat  SetColor(13);
                SetTextStyle(SansSerifFont,HorizDir,3);
                OutTextXY(75,440,'<3 Happy New Year <3');
                if (GetTickCount - BackFire_Time_Cycle >= BackFire_Cycle) and (Number_BackFire < Max_BackFire) then
                begin   New_BackFire;
                        BackFire_Time_Cycle:= GettickCount;
                end;
                if (GetTickCount - Explosion_Time_Cycle >= Explosion_Cycle) and (Number_Regular_Explosion < Max_Regular_Explosion) then
                begin   New_Chain_Explosion(Position(Random(MaxX),Random(MaxY)),Random(8) + 1,3,3);
                        Explosion_Time_Cycle:= GetTickCount;
                end;
                for i:= 1 to Max_BackFire do
                        if BackFire[i].Use then
                                Process_BackFire(i);
                for i:= 1 to Max_Regular_Explosion do
                        if Regular_Explosion[i].Use then
                                Process_Regular_Explosion(i);
                Time:= GetTickCount;
        until keypressed;

        CloseGraph;
end.