📄 uclass.pas
字号:
///修改纪录:2002.8.25， 在球运动之后马上就判断是否进球，改变了以前球和人都运动过之后
/// 再判断的情况。
/// 2002.8.25, 球门大小改变为原来的1/2
/// 2002.9.10, 球门大小改变为原来的350
unit uClass;
interface
uses classes, Dialogs, Math, Sysutils, Windows;
{$DEFINE ROBOT_RANDOM}
const CROBOTNUM = 5; {一个team的robot个数}
CMAXV = 40; {球员最大速度}
CMAXACC = 13; {球员最大加速度}
CRADIUS = 100; {机器人的半径}
CDOORWIDTH = 350; {一侧是350，实际长度是2 * 350}
// CDOORWIDTH = 200; {一侧是200，实际长度是2 * 200}
CPNZWIDTH = 1500; {禁区的宽度}
CPNZLEN = 800; {禁区的长度}
CFLDWIDTH = 2500; {场地宽度}
CFLDLEN = 4000; {场地长度}
{$IFDEF ROBOT_RANDOM}
CMaxError = 0.26; {传球最大误差}
// CMaxError = 0; {传球最大误差}
{$ELSE}
CMaxError = 0; {传球最大误差}
{$ENDIF}
CMINBALLV = 20; {最小球速度}
CMAXBALLV = 200; {最大球速度}
CMATCHTIME = 3000; {初赛、复赛仿真周期}
CDEATHTIME = 1000; {加时赛仿真周期}
CJSTIME = 5000; {决赛仿真周期}
CBALLACC = 0.1; {球的加速度系数k}
CVCANBALL = 120;
CVCANNOTBALL = 240;
CTIMECNT = 5000;
CMINNEARZERO = 0.1; {最小的除数}
RobotsPosition : array[1..CROBOTNUM, 1..2] of integer = ((30,1250),(1000,1250),(1000,100),(1000,2400),(1700,1250));
type
{下面涉及到的坐标全部为绝对坐标}
TCMD = record
ifresetmovement : integer; //如果需要重新设置机器人的移动方向和移动速度此参数置为1，否则置0
TargetX : integer; //目标的X坐标，如果ifresetmovement＝0 则此参数忽略
TargetY : integer; //目标的Y坐标，如果ifresetmovement＝0 则此参数忽略
TargetV : double; //移动的目标速度,如果ifresetmovement＝0 则此参数忽略
Preactiontype : integer; //触球之后的动作类型：0表示不作任何动作,
PreAparam0 : integer; //1：表示以PreAparam0速度把球踢向(PreAparam1, PreAparam2)坐标
PreAparam1 : integer; //2: 表示以PreAparam0速度把球踢向(PreAparam1, PreAparam2)方向
PreAparam2 : integer; //请注意1，2的区别，详情请看http://tianwei.dlut.edu.cn/robocup/
end;
TCMDS = array [0..4] of TCMD;
pCMD = ^TCMDS;
TMatchStat = record
iTeam1Score : integer; //A队得分
iTeam2Score : integer; //B队得分
iTimeTipCnt : integer; //总的时间
iTimeNow : integer; //当前时间
iTimeFromGoal:integer; //距离上次进球的时间
iHMPETB : integer; // How many people effect the ball since the match start.
end;
TRobotState = record
no : integer; {号码}
team : integer; {组号码1,或者2}
x : integer; {当前的x坐标}
y : integer; {当前的y坐标}
vx : double; {速度的x方向映射}
vy : double; {速度的y方向映射}
end;
TRobotStats = array [0..4] of TRobotState;
TBallState = record
x : integer; {当前的x坐标}
y : integer; {当前的y坐标}
vx : double; {速度的x方向映射}
vy : double; {速度的y方向映射}
crn : integer; {控球队员号码}
crt : integer; {控球队号码1 or 2}
end;
PMS = ^TMatchStat;
PTS = ^TRobotStats;
PBS = ^TBallState;
TRobot = class(TObject)
no : integer; {号码}
team : integer; {队号码1,或者2}
x : integer; {当前的x坐标}
y : integer; {当前的y坐标}
acc : double; {当前的加速度}
owner : TObject; {场地}
vx : double; {速度的x方向映射}
vy : double; {速度的y方向映射}
tvx : double; {目标速度X 分量}
tvy : double; {目标速度Y 分量}
targetX : integer; {目标x}
targetY : integer; {目标y}
preaction : integer; {预设动作类型0:清空动作，}
{1：把球以TargetV踢向坐标TargetX, TargetY;}
{2: 把球以TargetV踢向方向DirectX, DirectY;}
param0 : integer; {速度TargetV}
param1 : integer; {preaction 为0时 无意义； }
param2 : integer; {如果preaction不为0,则param1,param2表示TargetX,TargetY, or , DirectX, DirectY}
function getabsolutex : integer;
function getabsolutey : integer;
function tv : Double;
public
procedure move(TargetX, TargetY, TargetV: integer); {以速度TargetV跑向坐标(TargetX, TargetY)}
procedure SetPreAction(ipretype, prm0, prm1, prm2 : integer); {设置预动作指令}
constructor Create(aowner :TObject);
procedure doAction; {做预设动作}
procedure doMove; {做移动}
property posx:integer read x;
property posy:integer read y;
property absolutex : integer read getabsolutex;
property absolutey : integer read getabsolutey;
end;
TBall = class(TObject)
x : integer; {当前的x坐标}
y : integer; {当前的y坐标}
owner : TObject; {场地}
vx : double; {速度的x方向映射}
vy : double; {速度的y方向映射}
function speedmo : double;
public
constructor Create(owner :TObject);
procedure doMove(var bGoal :boolean;var goalteam :integer);
property posx:integer read x;
property posy:integer read y;
property spdx :double read vx;
property spdy :double read vy;
{做移动, 如果移动产生进球， bGoal为true， goalteam为对应的队伍的id}
end;
TMatchField = class(TObject)
robots : array [1..2, 1..CROBOTNUM] of TRobot;
ball : TBall; {球}
preCP : TRobot; {上一个控球的球员}
Scores : array [1..2] of integer; {比分}
firstGoalTeam : integer; {第一个进球的队伍}
lastGoalTeam : integer; {上一个进球的队伍}
crt : integer; {上次触球的队伍（大多数情况是控球的队伍）}
crn : integer; {控球队员号码(大多数情况下是控球的队员)}
iNow : integer; {当前的时间}
iTFG : integer; {Time From Goal}
iHMPETB: integer; {How many player effect the ball}
public
constructor Create();
destructor Destory();
procedure TimeTip; {时间片动作}
procedure InitMatch;
procedure playerEffectball;
procedure setfirstteamaction;
procedure setsecondteamaction;
procedure getMatchState(apms : PMS);
procedure firstgetTeamAState(apts : PTS);
procedure FirstgetTeamBState(apts : PTS);
procedure FirstgetBallState(apbs : PBS);
procedure SecondGetTeamAState(apts: PTS);
procedure SecondGetTeamBState(apts: PTS);
procedure SecondGetBallState(apbs : PBS);
procedure UpdateScores;
end;
function ifinPZ(iteamid, ixiangdux, ixiangduiy :integer):boolean; {是否再禁区内}
procedure ballcrashplayer(playerx,playery, ballx,bally : integer; vx1, vy1 :double; var vx2, vy2:double);
function ifgoal(oldx, oldy, newx, newy :integer):integer;
procedure speedmotospeedxy(yuanx, yuany, targetx, targety : integer; speedmo :double; var vx, vy:double);
procedure speedmotospeedxy2(yuanx, yuany, directx, directy: integer; speedmo :double; var vx, vy:double);
procedure giveballerror(vx, vy :double;var newvx, newvy:double);
function vectorAngle(sx,sy,dx,dy:double):double;
function distancebetween(x0,y0,x1,y1:integer):double;
implementation
uses uMain;
//////////////////////////////////////////////////////////
//// 是否在禁区内
/////////////////////////////////////////////////////////
function ifinPZ(iteamid, ixiangdux, ixiangduiy: integer): boolean;
begin
if iteamid = 1 then
begin
if (ixiangdux < CPNZLEN) and (abs(ixiangduiy - CFLDWIDTH / 2) < CPNZWIDTH /2) then
result := true
else
result := false;
end else
begin
if (ixiangdux > CFLDLEN - CPNZLEN) and( abs(ixiangduiy - CFLDWIDTH / 2) < CPNZWIDTH/2) then
result := true
else
result := false;
end;
end;
/////////////////////////////////////////////
/// 矢量和水平方向的夹角
/////////////////////////////////////////////
function vectorAngle(sx,sy,dx,dy:double):double;
var vx, vy, d, va : double;
begin
if (dx=sx) and (dy=sy) then
begin
result := 0;
end
else
begin
vx := dx-sx;
vy := dy-sy;
d := sqrt(sqr(vx) + sqr(vy));
if d<>0 then
begin
va := arcsin(abs(vy)/d);
if (vx>=0) and (vy>=0) then
result := va
else if (vx>=0) and (vy<=0) then
result := -va
else if (vx<=0) and (vy<=0) then
result := va + PI
else if (vx<=0) and (vy>=0) then
result := PI - va
else result := 0;
end
else
result:=0;
end;
end;
//////////////////////////////////////////////////
/// 给球一个15度的误差
/////////////////////////////////////////////////
procedure giveballerror(vx, vy :double;var newvx, newvy:double);
var
r : double;
aold : double;
randseed : double;
begin
//
r:= sqr(vx) + sqr(vy);
r := sqrt(r);
//
if r<0.01 then
begin
newvx := 0;
newvy := 0;
end else begin
aold := arcsin(abs(vy) / r);
if (vx > 0) and (vy > 0) then
aold := aold
else if (vx > 0) and (vy < 0) then
aold := -aold
else if (vx < 0) and (vy > 0) then
aold := Pi - aold
else aold := aold + Pi;
randseed := random;
////========================================================////
//// randseed := (randseed -0.5) * 2 * CMaxError; ////
//// version: 0.2.1.2 ////
//// 传球的准确程度和目标速度有关 ////
////========================================================////
randseed := (randseed -0.5) * 2 * CMaxError * r / CMAXBALLV;
newvx := r * cos(aold + randseed);
newvy := r * sin(aold + randseed);
end;
end;
procedure speedmotospeedxy(yuanx, yuany, targetx, targety : integer; speedmo :double; var vx, vy:double);
var
yx,yy,tx,ty:double;
begin
yx:=yuanx;
yy:=yuany;
tx:=targetx;
ty:=targety;
if (tx = yx) and (ty = yy) then
begin
vx := 0;
vy := 0;
end else begin
vx:=(sqr(tx - yx)) + (sqr(ty - yy));
vx := speedmo * (tx - yx) / sqrt(vx);
vy:=sqr(tx - yx) + sqr(ty - yy);
vy := speedmo * (ty - yy) / sqrt(vy);
end;
end;
procedure speedmotospeedxy2(yuanx, yuany, directx, directy: integer; speedmo :double; var vx, vy:double);
var
yx,yy,dx,dy:double;
begin
yx:=yuanx;
yy:=yuany;
dx:=directx;
dy:=directy;
if (dx = 0) and (dy = 0) then
begin
vx := 0;
vy := 0;
end else begin
vx:=sqr(dx) + sqr(dy);
vx := speedmo * dx / sqrt(vx);
vy:=sqr(dx) + sqr(dy);
vy := speedmo * dy / sqrt(vy);
end;
end;
function ifgoal(oldx, oldy, newx, newy :integer):integer;
var jy : double;
begin
if (newx = CFLDLEN) then
begin
if (newy > CFLDWIDTH /2 - CDOORWIDTH) and (newy < CFLDWIDTH/2 + CDOORWIDTH) then
result := 1
else result := 0;
end else if (newx = 0) then
begin
if (newy > CFLDWIDTH /2 - CDOORWIDTH) and (newy < CFLDWIDTH/2 + CDOORWIDTH) then
result := 2
else result := 0;
end else
begin
if ((oldx >= 0) and (oldx <= CFLDLEN) and (newx >= CFLDLEN)) then
begin
jy := ((newy - oldy)*(CFLDLEN - oldx))/(newx - oldx) + oldy;
if (jy > CFLDWIDTH /2 - CDOORWIDTH) and ( jy < CFLDWIDTH/2 + CDOORWIDTH) then
result := 1
else result := 0;
end
else if ((oldx >= 0) and (oldx <= CFLDLEN) and (newx <= 0)) then
begin
jy := ((newy - oldy)*(0 - oldx))/(newx - oldx) + oldy;
if (jy > CFLDWIDTH /2 - CDOORWIDTH) and ( jy < CFLDWIDTH/2 + CDOORWIDTH) then
result := 2
else result := 0;
end
else
result := 0;
end;
end;
///////////////////////////////////////
//// zvictor版本，改正了fct版本中的球在人后的bug
///////////////////////////////////////
procedure ballcrashplayer(playerx,playery, ballx,bally : integer; vx1, vy1 :double; var vx2, vy2:double);
var
va : double; //人->球的矢量的角度
vb : double; //球的速度的矢量的角度
vr : double; //结果的矢量的角度
vsm: double; //速度的模
px,py,bx,by:double;
begin
px:=playerx;
py:=playery;
bx:=ballx;
by:=bally;
if (px=bx) and (py=by) then
begin
vx2 := -vx1;
vy2 := -vy1;
end
else
begin
va := vectorAngle(px, py, bx, by);
vb := vectorAngle(bx, by, bx+vx1, by+vy1);
vr := PI - vb + 2*va;
//
vsm:=sqr(vx1) + sqr(vy1);
vsm:= sqrt(vsm);
//
vx2 := vsm * cos(vr);
vy2 := vsm * sin(vr);
end;
end;
{ TMatchField }
constructor TMatchField.Create;
begin
inherited;
{things to do}
ball := TBall.Create(self);
lastGoalTeam := 0;
InitMatch;
end;
destructor TMatchField.Destory;
var i,j : integer;
begin
{things to do}
for i:=1 to 2 do
for j:=1 to CROBOTNUM do
begin
robots[i,j].free;
end;
inherited;
end;
procedure TMatchField.FirstgetBallState(apbs: PBS);
begin
apbs^.x := ball.x;
apbs^.y := ball.y;
apbs^.vx := ball.vx;
apbs^.vy := ball.vy;
apbs^.crn:= crn;
apbs^.crt:= crt;
end;
procedure TMatchField.getMatchState(apms: PMS);
begin
apms^.iTeam1Score := scores[1];
apms^.iTeam2Score := scores[2];
apms^.iTimeTipCnt := CTIMECNT;
apms^.iTimeNow := iNow;
apms^.iTimeFromGoal := iTFG;
apms^.iHMPETB := iHMPETB;
end;
procedure TMatchField.FirstgetTeamAState(apts: PTS);
var i:integer;
begin
for i:=0 to 4 do
begin
apts^[i].no := i+1;
apts^[i].team := 1;
apts^[i].x := robots[1,i+1].x;
apts^[i].y := robots[1,i+1].y;
apts^[i].vx:= robots[1,i+1].vx;
apts^[i].vy:= robots[1,i+1].vy;
end;
end;
procedure TMatchField.FirstgetTeamBState(apts: PTS);
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -