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.