old/PAS/!SPbSTU/Boris/Graph/POOL2.PAS

uses Graph,CRT;

CONST
 TeamSize = 4;
 SwimmerRad=4;
 PoolX1   = 30;
 PoolY1   = 50;
 PoolSX   = 500;
 PoolSY   = 200;
var
 Tick      : longint Absolute $0040:$006c;

type
 EDo = (WAITING, SWIM_NEXT, SWIMMING_F, SWIMMING_B, DONE);

 PTeam = ^CTeam;

 CSwimmer = object
  Name    : String[40];
  Team    : PTeam;
  Number  : Integer;
  Speed   : real;
  V0,V1   : real;
  Doing   : EDo;
  Pos     : real;
  Constructor Init(aName:String;aT:PTeam;aNum:integer);
  Procedure SetSpeed(aV0,aV1:real);
  Procedure Frame(aT:Real);
  Procedure Draw(aOrder:integer);
  Procedure Return;
  Procedure   Swim;
 end;

 PSwimmer = ^CSwimmer;
 PWorld   = ^CWorld;

 CTeam = object
  Name      : string[30];
  Number    : integer;
  World     : PWorld;
  TotalDist : real;
  maxDist   : real;
  Swimmers  : array [1..TeamSize] of PSwimmer;
  NextNumber: integer;
  ifDone    : boolean;
  AllTime   : real;
  Constructor Init(aW:PWorld;aName:string;aNum:word);
  Procedure   Draw;
  Procedure   Frame(aTime:real);
  Procedure   SwimNext;
 end;

 TLetter  = record
  Width  : word;
  Height : word;
  Data   : pointer;
  Size   : word;
 end;

 CWorld = object
  Numbers   : array [0..9] of TLetter;
  AllRelay  : array [0..3] of PTeam;
  LWidth    : word;
  LeadTeam,Leader : byte;
  Time,LTime: real;
  BegTick   : longint;
  Play : boolean;
  Table  : array [1..4] of Byte;
  TPos   : word;
  Constructor Init;
  Procedure DrawPool;
  Procedure InitLetters;
  Procedure DrawTime(aTime:real);
  Procedure DrawLeader;
  Procedure Work;
  Procedure FinishTeam(aNum:word);
 end;
 
Procedure CWorld.DrawPool;
var i,j : integer;
begin
  SetFillStyle(SolidFill,White);
  Bar(PoolX1-20,PoolY1-20,PoolX1+PoolSX+20,PoolY1+PoolSY+20);
  SetColor(LightGray);
  Line(PoolX1-20,PoolY1-10,PoolX1+PoolSX+20,PoolY1-10);
  Line(PoolX1-20,PoolY1+PoolSY+10,PoolX1+PoolSX+20,PoolY1+PoolSY+10);

  Line(PoolX1-10,PoolY1-20,PoolX1-10,PoolY1+PoolSY+20);
  Line(PoolX1+PoolSX+10,PoolY1-20,PoolX1+PoolSX+10,PoolY1+PoolSY+20);
  for j := 1 to (PoolSX div 10)+1 do
   begin
    Line(PoolX1-10+j*10,PoolY1-20,PoolX1-10+j*10,PoolY1);
    Line(PoolX1-10+j*10,PoolY1+PoolSY,PoolX1-10+j*10,PoolY1+PoolSY+20);
   end;
  for j := 1 to (PoolSY div 10)+1 do
   begin
    Line(PoolX1-20,PoolY1-10+j*10,PoolX1,PoolY1-10+j*10);
    Line(PoolX1+PoolSX,PoolY1-10+j*10,PoolX1+PoolSX+20,PoolY1-10+j*10);
   end;
  SetFillStyle(SolidFill,LightBlue);
  Bar(PoolX1,PoolY1,PoolX1+PoolSX,PoolY1+PoolSY);
  for i := 1 to 3 do
   for j := 1 to 24 do
    begin
     if odd(i+j) then SetFillStyle(SolidFill,Red) else SetFillStyle(SolidFill,White);
     FillEllipse(PoolX1+j*(PoolSX div 25),PoolY1+i*(PoolSY div 4),3,3);
    end;
end;

Procedure CWorld.InitLetters;
var
 i   : integer;
 pos : word;
 s   : string[4];
begin
  SetTextStyle(SansSerifFont,HorizDir,4);
  SetTextJustify(LeftText,TopText);
  SetColor(Green);
  LWidth := TextWidth('8');
  s[0] := #1;
  pos := 0;
  for i := 0 to 9 do
   begin
     s[1] := chr(i+$30);
     OutTextXY(pos,100,S);
     with numbers[i] do
      begin
       Width := TextWidth(S);
       Height := TextHeight(S);
       Size := ImageSize(pos,100,pos+Width,100+Height);
       GetMem(Data,Size);
       GetImage(pos,100,pos+Width,100+Height,Data^);
       inc(Pos,Width);
      end;
   end;
   ClearDevice;
end;

Procedure CSwimmer.Draw(aOrder:integer);
begin
 SetFillStyle(SolidFill,Number+Team^.Number);
 case Doing of
   SWIM_NEXT:
    FillEllipse(PoolX1+PoolSX+5,PoolY1+round((Team^.Number+0.5)*(PoolSY/4.0)),
                SwimmerRad,SwimmerRad);
   WAITING :
    FillEllipse(PoolX1+PoolSX+25,PoolY1+round((Team^.Number+0.2)*PoolSY/4)+aOrder*8,
                SwimmerRad,SwimmerRad);
   SWIMMING_F:
    FillEllipse(round(PoolX1+PoolSX-SwimmerRad-(PoolSX-2*SwimmerRad)/50.0*Pos),
                PoolY1+round((Team^.Number+0.5)*(PoolSY/4.0)),  SwimmerRad,SwimmerRad);
   SWIMMING_B:
    FillEllipse(round(PoolX1+SwimmerRad+(PoolSX-2*SwimmerRad)/50*(Pos - 50.0)),
                PoolY1+round((Team^.Number+0.5)*(PoolSY/4.0)),  SwimmerRad,SwimmerRad)
 end;
end;

Procedure CWorld.DrawTime(aTime:real);
var
 tt : real;
begin
  tt := aTime - trunc(aTime/60)*60.0;
  PutImage(100,300,Numbers[trunc(aTime/600) mod 10].Data^,XORPut);
  PutImage(100+Lwidth,300,Numbers[trunc(aTime/60) mod 10].Data^,XORPut);
  PutImage(100+2*LWidth,300,Numbers[trunc(tT/10) mod 10].Data^,XORPut);
  PutImage(100+3*LWidth,300,Numbers[trunc(tT) mod 10].Data^,XORPut);
  PutImage(100+4*LWidth,300,Numbers[trunc(tT*10) mod 10].Data^,XORPut);
  PutImage(100+5*LWidth,300,Numbers[round(tT*100) mod 10].Data^,XORPut);
end;

Procedure CWorld.DrawLeader;
begin
 SetFillStyle(SolidFill,Black);
 Bar(400,273,640,349);
 SetColor(LightGreen);
 SetTextStyle(TriplexFont,HorizDir,2);
 SetTextJustify(LeftText,TopText);
 OutTextXY(400,273,AllRelay[LeadTeam]^.Swimmers[Leader]^.Name);
 OutTextXY(400,303,AllRelay[LeadTeam]^.Name);
end;

Procedure CTeam.Draw;
var
 i : byte;
begin
  SetFillStyle(SolidFill,LightBlue);
  Bar(PoolX1,PoolY1+round((Number+0.5)*PoolSY/4 - SwimmerRad*1.1),
      PoolX1+PoolSX,PoolY1+round((Number+0.5)*PoolSY/4 + SwimmerRad*1.1));

  SetFillStyle(SolidFill,Black);
  Bar(PoolX1+PoolSX+21,PoolY1+Number    *PoolSY div 4+10,
      PoolX1+PoolSX+40,PoolY1+(Number+1)*PoolSY div 4);
  SetFillStyle(SolidFill,White);
  Bar(PoolX1+PoolSX+5-SwimmerRad,PoolY1+round((Number+0.5)*(PoolSY/4.0))-SwimmerRad,
      PoolX1+PoolSX+5+SwimmerRad,PoolY1+round((Number+0.5)*(PoolSY/4.0))+SwimmerRad);

  for i := 1 to TeamSize do
   Swimmers[i]^.Draw(i);
end;

Constructor CSwimmer.Init;          
begin
 Name := aName;
 Number:= aNum;
 Team := aT;
 Speed   := 0;
 Doing   := WAITING;
 Pos     := 0;
end;

Procedure CSwimmer.Frame(aT:real);
begin
 Pos := Pos + Speed*aT;
 if (Pos >= 50.0) and (Doing = SWIMMING_F) then
 begin
  Doing := SWIMMING_B;
  Team^.Swimmers[Team^.NextNumber]^.Doing := SWIM_NEXT;
 end;
end;

Procedure CSwimmer.Return;
begin
  Doing := DONE;
  Pos := 0;
end;

Procedure CSwimmer.Swim;
begin
 Doing := SWIMMING_F;
 Speed := V0 + random*(v1-v0);
 Pos := 0;
end;

Constructor CTeam.Init(aW:PWorld;aName:string;aNum:word);
var
 j : byte;
begin
  Name := aName;
  Number := aNum;
  World := aW;
  AllTime:=0;
  ifDone := false;
  TotalDist:=0;
  NextNumber:= 1;
  for j := 1 to TeamSize do 
   begin
    New(Swimmers[j],Init('',@self,j));
    Swimmers[j]^.SetSpeed(5, 8);
   end;
end;

Procedure CTeam.SwimNext;
begin
  if NextNumber > TeamSize then Exit;
  Swimmers[NextNumber]^.Swim;
  Inc(NextNumber);
end;

Procedure CWorld.FinishTeam(aNum:word);
begin
  Table[TPos] := aNum;
  Inc(TPos);
  if TPos = 5 then Play := false;
end;

Procedure CTeam.Frame(aTime:real);
var
 i : byte;
begin
  for i := 1 to TeamSize do if Swimmers[i]^.Doing in [SWIMMING_F,SWIMMING_B] then
   begin
    Swimmers[i]^.Frame(aTime);
    MaxDist := Swimmers[i]^.Pos;
    if MaxDist >= 100.0 then
      begin
        TotalDist := TotalDist + MaxDist;
        if NextNumber <= TeamSize then
          begin
            Swimmers[i]^.Return;
            SwimNext;
          end
        else
         begin
           Swimmers[i]^.Return;
           AllTime := World^.Time;
           ifDone := true;
           World^.FinishTeam(Number);
         end;
      end;
   end;
   MaxDist := MaxDist + TotalDist;
end;

Procedure CSwimmer.SetSpeed;
begin
   V0:=aV0;v1:=aV1;
end;

Constructor CWorld.Init;
var
 grDriver: Integer;
 grMode: Integer;
 ErrCode: Integer;
 i : byte;
begin
 grDriver := VGA;
 grMode := VGAMed;
 InitGraph(grDriver, grMode,' ');
 ErrCode := GraphResult;
 if ErrCode <> grOk then
  begin
   Writeln('Graphics error:', GraphErrorMsg(ErrCode));
   Halt(1);
  end;
 InitLetters;
 DrawPool;
 TPos := 1;

 for i := 0 to 3 do 
   New(AllRelay[i],Init(@Self,'',i));

 Allrelay[0]^.Name := 'Team RUS';
 AllRelay[0]^.Swimmers[1]^.Name := 'Ivanov I';
 AllRelay[0]^.Swimmers[2]^.Name := 'Petrov P';
 AllRelay[0]^.Swimmers[3]^.Name := 'Sidorov A';
 AllRelay[0]^.Swimmers[4]^.Name := 'Vatulin B';

 Allrelay[1]^.Name := 'Team FRA';
 AllRelay[1]^.Swimmers[1]^.Name := 'Jaquot J-M';
 AllRelay[1]^.Swimmers[2]^.Name := 'Sevuit B';
 AllRelay[1]^.Swimmers[3]^.Name := 'Beliniu S';
 AllRelay[1]^.Swimmers[4]^.Name := 'Moneu G';

 AllRelay[2]^.Name := 'Team GB';
 AllRelay[2]^.Swimmers[1]^.Name := 'Johnson Jr';
 AllRelay[2]^.Swimmers[2]^.Name := 'Smith B';
 AllRelay[2]^.Swimmers[3]^.Name := 'Debian K';
 AllRelay[2]^.Swimmers[4]^.Name := 'Vesson R';

 Allrelay[3]^.Name := 'Team USA';
 AllRelay[3]^.Swimmers[1]^.Name := 'Stivenson A';
 AllRelay[3]^.Swimmers[2]^.Name := 'Brewing B';
 AllRelay[3]^.Swimmers[3]^.Name := 'Robertini F';
 AllRelay[3]^.Swimmers[4]^.Name := 'Stpanson L';

 SetTextStyle(SansSerifFont,HorizDir,4);
 SetTextJustify(CenterText,TopText);
 SetColor(Green);
 OutTextXY(100+LWidth*2-3,300-3,':');
 OutTextXY(100+LWidth*4-2,300,'.');
 SetTextStyle(SansSerifFont,HorizDir,2);
 SetColor(Red);
 SetTextJustify(RightText,TopText);
 OutTextXY(190,275,'Time:');
 OutTextXY(370,270,'Leader:');
 OutTextXY(370,300,'Lead team:');

 Randomize;

 SetTextJustify(LeftText, Centertext);
 SetTextStyle(DefaultFont,HorizDir,1);
 OutTextXY(200,345,'Press any key to start');
 for i := 0 to 3 do with AllRelay[i]^ do
 begin
  SetColor(Magenta);
  OutTextXY(PoolX1+PoolSX+25,PoolY1+i*(PoolSY div 4)+5,Name);
  Draw;
 end;
end;

Procedure CWorld.Work;
var
 maxPos : Real;
 i,j : byte;
begin
 lTime := 0;
 DrawTime(lTime);
 ReadKey;
 SetFillStyle(SolidFill,Black);
 Bar(200,340,400,349);
 Play := true;

 for i := 0 to 3 do Allrelay[i]^.SwimNext;

 BegTick := Tick;
 repeat
   maxPos := 0;
   Time := (Tick-BegTick) / 18.2;
   for i := 0 to 3 do with AllRelay[i]^ do if not ifDone then
   begin
     Frame(Time-lTime);
     if maxDist > maxPos then
      begin
       Leader:=NextNumber-1;
       LeadTeam := i;
       maxPos := maxDist;
      end;
   end;
   SetColor(Green);
   repeat until (Port[$03DA] and 8) <> 8;
   repeat until (Port[$03DA] and 8) =  8;
   for i := 0 to 3 do if not AllRelay[i]^.ifDone then
     AllRelay[i]^.Draw;
   repeat until (Port[$03DA] and 8) <> 8;
   repeat until (Port[$03DA] and 8) =  8;
   DrawLeader;
   DrawTime(lTime);
   DrawTime(Time);
   lTime := Time;
 until not play;

 SetColor(LightRed);
 SetFillStyle(SolidFill,Black);
 Bar(100,130,400,220);
 SetTextStyle(SansSerifFont,HorizDir,2);
 SetTextJustify(RightText,TopText);
 OutTextXY(250,130,'First place:');
 OutTextXY(250,150,'Second place:');
 OutTextXY(250,170,'Third place:');
 OutTextXY(250,190,'Fourth place:');
 SetTextJustify(LeftText,TopText);
 SetColor(LightGreen);
 OutTextXY(252,130,AllRelay[Table[1]]^.Name);
 OutTextXY(252,150,AllRelay[Table[2]]^.Name);
 OutTextXY(252,170,AllRelay[Table[3]]^.Name);
 OutTextXY(252,190,AllRelay[Table[4]]^.Name);
 ReadKey;
 CloseGraph;
End;

var
 Wrld : PWorld;
begin
  New(Wrld,Init);
  Wrld^.Work;
  Dispose(Wrld);
end.