old/PAS/!SPbSTU/Boris/Graph/pool.pas

uses Graph,CRT;

CONST
 TeamSize = 4;
 PoolX1   = 30;
 PoolY1   = 50;
 PoolSX   = 500;
 PoolSY   = 200;

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

 TSwimmer = record
  Name    : String[40];
  Team    : Integer;
  Number  : Integer;
  Speed   : real;
  V0,V1   : real;
  Doing   : EDo;
  Pos     : real;
 end;

 TTeam = record
  Name      : string[30];
  Number    : integer;
  TotalDist : real;
  Swimmers  : array [1..TeamSize] of TSwimmer;
  NextNumber: integer;
  ifBack    : boolean;
  AllTime   : real;
 end;

 TLetter  = record
  Width  : word;
  Height : word;
  Data   : pointer;
  Size   : word;
 end;
var
 Numbers   : array [0..9] of TLetter;
 AllRelay  : array [0..3] of TTeam;
 LWidth    : word;
 LeadTeam,Leader : byte;
 Time,LTime: real;
 Tick      : longint Absolute $0040:$006c;
 BegTick   : longint;

Procedure 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 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;

CONST
 SwimmerRad  = 4;

Procedure DrawSwimmerOnWay(var aS : TSwimmer);
begin
  SetFillStyle(SolidFill,aS.Number+aS.Team);
  if aS.Pos >= 50.0 then
  FillEllipse(round(PoolX1+SwimmerRad+(PoolSX-2*SwimmerRad)/50*(aS.Pos - 50.0)),
              PoolY1+round((aS.Team+0.5)*(PoolSY/4.0)),  SwimmerRad,SwimmerRad)
  else FillEllipse(round(PoolX1+PoolSX-SwimmerRad-(PoolSX-2*SwimmerRad)/50.0*aS.Pos),
              PoolY1+round((aS.Team+0.5)*(PoolSY/4.0)),  SwimmerRad,SwimmerRad);

end;

Procedure DrawSwimmerNext(var aS : TSwimmer);
begin
  SetFillStyle(SolidFill,aS.Number+aS.Team);
  FillEllipse(PoolX1+PoolSX+5,PoolY1+round((aS.Team+0.5)*(PoolSY/4.0)),
              SwimmerRad,SwimmerRad);
end;

Procedure DrawSwimmerOnWait(var aS : TSwimmer;aOrder:byte);
begin
  SetFillStyle(SolidFill,aS.Number+aS.Team);
  FillEllipse(PoolX1+PoolSX+25,PoolY1+round((aS.Team+0.2)*PoolSY/4)+aOrder*8,
              SwimmerRad,SwimmerRad);
end;

Procedure 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 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 DrawTeam(var aT:TTeam);
var
 i : byte;
begin
  SetFillStyle(SolidFill,LightBlue);
  Bar(PoolX1,PoolY1+round((aT.Number+0.5)*PoolSY/4 - SwimmerRad*1.1),
      PoolX1+PoolSX,PoolY1+round((aT.Number+0.5)*PoolSY/4 + SwimmerRad*1.1));

  SetFillStyle(SolidFill,Black);
  Bar(PoolX1+PoolSX+21,PoolY1+aT.Number    *PoolSY div 4+10,
      PoolX1+PoolSX+40,PoolY1+(aT.Number+1)*PoolSY div 4);
  SetFillStyle(SolidFill,White);
  Bar(PoolX1+PoolSX+5-SwimmerRad,PoolY1+round((aT.Number+0.5)*(PoolSY/4.0))-SwimmerRad,
      PoolX1+PoolSX+5+SwimmerRad,PoolY1+round((aT.Number+0.5)*(PoolSY/4.0))+SwimmerRad);
  for i := 1 to TeamSize do
  begin
   if aT.ifBack and (i=aT.NextNumber) then DrawSwimmerNext(aT.Swimmers[i])
   else
   case aT.Swimmers[i].Doing of
    WAITING : DrawSwimmerOnWait(aT.Swimmers[i],i);
    SWIMMING_F, SWIMMING_B : DrawSwimmerOnWay(aT.Swimmers[i]);
   end;
  end;
end;

var
 maxPos : Real;
 Table  : array [1..4] of Byte;
 TPos   : word;
 Play : boolean;
 grDriver: Integer;
 grMode: Integer;
 ErrCode: Integer;
 i,j : 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 with AllRelay[i] do
  begin
   Number    := i;
   ifBack    := true;
   NextNumber:= 1;
   for j := 1 to TeamSize do with Swimmers[j] do
    begin
     Team    := i;
     Number  := j;
     Speed   := 0;
     V0      := 5; V1 := 8;
     Doing   := WAITING;
     Pos     := 0;
    end;
   AllTime   := 0;
   TotalDist := 0;
  end;
 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);
  DrawTeam(AllRelay[i]);
 end;
 lTime := 0;
 DrawTime(lTime);
 ReadKey;
 SetFillStyle(SolidFill,Black);
 Bar(200,340,400,349);
 Play := true;
 for i := 0 to 3 do with AllRelay[i].Swimmers[1] do
 begin
   AllRelay[i].NextNumber := 2;
   AllRelay[i].ifBack := false;
   Doing := SWIMMING_F;
   Speed := V0 + random*(v1-v0);
 end;
 BegTick := Tick;
 repeat
   maxPos := 0;
   Time := (Tick-BegTick) / 18.2;
   for i := 0 to 3 do with AllRelay[i] do
      for j := 1 to TeamSize do With Swimmers[j] do
         if (Doing = SWIMMING_F) or (Doing = SWIMMING_B) then
          begin
           if Pos+TotalDist > maxPos then
            begin
             Leader:=j;
             LeadTeam := i;
             maxPos := Swimmers[j].Pos+TotalDist;
            end;
            Pos := Pos + Speed*(Time-lTime);
            if (Pos > 50.0) and (Doing = SWIMMING_F) then
            begin
             Doing := SWIMMING_B;
             ifBack := true;
            end;
            if (Doing = SWIMMING_B) and (Pos>=100.0) then
             begin
              ifBack := false;
              if NextNumber <= TeamSize then
               begin
                 Doing := DONE;
                 TotalDist := TotalDist + Pos;
                 with Swimmers[NextNumber] do
                  begin
                   Doing := SWIMMING_F;
                   Speed := V0 + random*(v1-v0);
                   Pos := 0;
                  end;
                 inc(NextNumber);
               end
              else
               begin
                Doing := DONE;
                TotalDist := TotalDist + Pos;
                AllTime := Time;
                Table[TPos] := i;Inc(TPos);
                if TPos=5 then Play :=  False;
               end;
             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 AllRelay[i].NextNumber <= (TeamSize+1) then
     DrawTeam(AllRelay[i]);
   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.