clienttools.pas

类似文明的游戏源代码。

{$INCLUDE switches}

unit ClientTools;

interface

uses
  Protocol;

const
FutureTech=[futResearchTechnology,futProductionTechnology,futArmorTechnology,
  futMissileTechnology];
TerrType_Canalable=[fGrass,fDesert,fPrairie,fTundra,fSwamp,fForest];

type
TImpOrder=array[0..(nImp+4) div 4 *4 -1] of ShortInt;
TEnhancementJobs=array[0..11,0..7] of Byte;

var
Server: TServerCall;
G: TNewGameData;
me: integer;
MyRO: ^TPlayerContext;
MyMap: ^TTileList;
MyUn: ^TUnList;
MyCity: ^TCityList;
MyModel: ^TModelList;

AdvValue: array[0..nAdv-1] of integer;


function dLoc(Loc,dx,dy: integer): integer;
function Distance(Loc0,Loc1: integer): integer;
procedure ItsMeAgain(p: integer);
function GetAge(p: integer): integer;
procedure SumCities(var TaxSum, ScienceSum: integer);
function JobTest(uix,Job: integer): integer;
procedure GetUnitInfo(Loc: integer; var uix: integer; var UnitInfo: TUnitInfo);
procedure GetCityInfo(Loc: integer; var cix: integer; var CityInfo: TCityInfo);
function UnitExhausted(uix: integer): boolean;
function ModelHash(const ModelInfo: TModelInfo): integer;
function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs): integer;
function AutoResearch(FarTech: integer): integer;
procedure AutoBuild(cix: integer; const ImpOrder: TImpOrder);
procedure DebugMessage(Level: integer; Text: string);


implementation

function dLoc(Loc,dx,dy: integer): integer;
var
y0: integer;
begin
y0:=(Loc+G.lx*1024) div G.lx -1024;
result:=(Loc+(dx+y0 and 1+G.lx*1024) shr 1) mod G.lx +G.lx*(y0+dy)
end;

function Distance(Loc0,Loc1: integer): integer;
var
dx,dy: integer;
begin
inc(Loc0,G.lx*1024);
inc(Loc1,G.lx*1024);
dx:=abs(((Loc1 mod G.lx *2 +Loc1 div G.lx and 1)
  -(Loc0 mod G.lx *2 +Loc0 div G.lx and 1)+3*G.lx) mod (2*G.lx) -G.lx);
dy:=abs(Loc1 div G.lx-Loc0 div G.lx);
result:=dx+dy+abs(dx-dy) shr 1;
end;

procedure ItsMeAgain(p: integer);
begin
me:=p;
MyRO:=pointer(G.RO[me]);
MyMap:=pointer(MyRO.Map);
MyUn:=pointer(MyRO.Un);
MyCity:=pointer(MyRO.City);
MyModel:=pointer(MyRO.Model);
end;

function GetAge(p: integer): integer;
var
i: integer;
begin
if p=me then
  begin
  result:=0;
  for i:=1 to 3 do
    if MyRO.Tech[AgePreq[i]]>=tsApplicable then result:=i;
  end
else
  begin
  result:=0;
  for i:=1 to 3 do
    if MyRO.EnemyReport[p].Tech[AgePreq[i]]>=tsApplicable then result:=i;
  end
end;

procedure SumCities(var TaxSum, ScienceSum: integer);
var
i,cix,p1: integer;
CityReport: TCityReport;
begin
TaxSum:=0; ScienceSum:=0;
if MyRO.Government=gAnarchy then exit;
for p1:=0 to nPl-1 do TaxSum:=TaxSum+MyRO.Tribute[p1];
for cix:=0 to MyRO.nCity-1 do if MyCity[cix].Loc>=0 then
  begin
  CityReport.HypoTiles:=-1;
  CityReport.HypoTax:=-1;
  CityReport.HypoLux:=-1;
  Server(sGetCityReport,me,cix,CityReport);
  if (CityReport.Working-CityReport.Happy<=MyCity[cix].Size shr 1) {no disorder}
    and (MyCity[cix].Flags and chCaptured=0) then // not captured
    begin
    inc(TaxSum,CityReport.Tax);
    if (MyCity[cix].Project and (cpImp+cpIndex)=cpImp+imTrGoods)
      and (CityReport.ProdRep>CityReport.Support) then
      inc(TaxSum,CityReport.ProdRep-CityReport.Support);
    if ((MyRO.Government=gLybertarianism)
        or (MyCity[cix].Size>=NeedAqueductSize)
        and (CityReport.FoodRep<CityReport.Eaten+2))
      and (CityReport.FoodRep>CityReport.Eaten) then
      inc(TaxSum,CityReport.FoodRep-CityReport.Eaten);
    for i:=0 to nImp-1 do if MyCity[cix].Built[i]=1 then
      dec(TaxSum,Imp[i].Maint);
    ScienceSum:=ScienceSum+CityReport.Science;
    end
  end;
end;

function JobTest(uix,Job: integer): integer;
begin
result:=Server(sStartJob+Job shl 4-sExecute,me,uix,nil^);
end;

procedure GetUnitInfo(Loc: integer; var uix: integer; var UnitInfo: TUnitInfo);
var
i,Cnt: integer;
begin
if MyMap[Loc] and fOwned<>0 then
  begin
  Server(sGetDefender,me,Loc,uix);
  Cnt:=0;
  for i:=0 to MyRO.nUn-1 do
    if MyUn[i].Loc=Loc then inc(Cnt);
  MakeUnitInfo(me,MyUn[uix],UnitInfo);
  if Cnt>1 then UnitInfo.Flags:=UnitInfo.Flags or unMulti;
  end
else
  begin
  uix:=MyRO.nEnemyUn-1;
  while (uix>=0) and (MyRO.EnemyUn[uix].Loc<>Loc) do dec(uix);
  UnitInfo:=MyRO.EnemyUn[uix];
  end
end;{GetUnitInfo}

procedure GetCityInfo(Loc: integer; var cix: integer; var CityInfo: TCityInfo);
begin
if MyMap[Loc] and fOwned<>0 then
  begin
  CityInfo.Loc:=Loc;
  cix:=MyRO.nCity-1;
  while (cix>=0) and (MyCity[cix].Loc<>Loc) do dec(cix);
  with CityInfo do
    begin
    Owner:=me;
    ID:=MyCity[cix].ID;
    Size:=MyCity[cix].Size;
    Flags:=0;
    if MyCity[cix].Built[imPalace]>0 then inc(Flags,ciCapital);
    if (MyCity[cix].Built[imWalls]>0)
      or (MyMap[MyCity[cix].Loc] and fGrWall<>0) then inc(Flags,ciWalled);
    if MyCity[cix].Built[imCoastalFort]>0 then inc(Flags,ciCoastalFort);
    if MyCity[cix].Built[imMissileBat]>0 then inc(Flags,ciMissileBat);
    end
  end
else
  begin
  cix:=MyRO.nEnemyCity-1;
  while (cix>=0) and (MyRO.EnemyCity[cix].Loc<>Loc) do dec(cix);
  CityInfo:=MyRO.EnemyCity[cix];
  end
end;

function UnitExhausted(uix: integer): boolean;
// check if another move of this unit is still possible
var
dx, dy: integer;
begin
result:=true;
if MyUn[uix].Movement>0 then
  if (MyUn[uix].Movement>=100) or ((MyModel[MyUn[uix].mix].Kind=mkCaravan)
    and (MyMap[MyUn[uix].Loc] and fCity<>0)) then
    result:=false
  else for dx:=-2 to 2 do for dy:=-2 to 2 do if abs(dx)+abs(dy)=2 then
    if Server(sMoveUnit-sExecute+dx and 7 shl 4+dy and 7 shl 7,me,uix,nil^)>=rExecuted then
      result:=false;
end;

function ModelHash(const ModelInfo: TModelInfo): integer;
begin
with ModelInfo do
  begin
  result:=Attack+Defense*7+Speed div 50*49+(Bombs+TTrans*7+ATrans_Fuel*49) shl 12;
  result:=integer(int64(result+1)*(Cap+1)*2+1);
  end
end;

function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs): integer;
{ return values:
eJobDone - all applicable jobs done
eOK - enhancement not complete
eDied - job done and died (thurst) }
var
stage, NextJob, Tile: integer;
Done: Set of jNone..jTrans;
begin
Done:=[];
Tile:=MyMap[MyUn[uix].Loc];
if Tile and fRoad<>0 then include(Done,jRoad);
if Tile and fRR<>0 then include(Done,jRR);
if (Tile and fTerImp=tiIrrigation) or (Tile and fTerImp=tiFarm) then
  include(Done,jIrr);
if Tile and fTerImp=tiFarm then include(Done,jFarm);
if Tile and fTerImp=tiMine then include(Done,jMine);
if Tile and fPoll=0 then include(Done,jPoll);

if MyUn[uix].Job=jNone then result:=eJobDone
else result:=eOK;
while (result<>eOK) and (result<>eDied) do
  begin
  stage:=-1;
  repeat
    if stage=-1 then NextJob:=jPoll
    else NextJob:=Jobs[Tile and fTerrain,stage];
    if (NextJob=jNone) or not (NextJob in Done) then Break;
    inc(stage);
  until stage=5;
  if (stage=5) or (NextJob=jNone) then
    begin result:=eJobDone; Break; end; // tile enhancement complete
  result:=Server(sStartJob+NextJob shl 4,me,uix,nil^);
  include(Done,NextJob)
  end;
end;

function AutoResearch(FarTech: integer): integer;
var
ad: integer;
known: array[0..nAdv-1] of integer;

  procedure MarkPreqs(i: integer);
  begin
  known[i]:=1;
  if MyRO.Tech[i]<tsSeen then
    begin
    if (AdvPreq[i,0]>=0) then MarkPreqs(AdvPreq[i,0]);
    if (AdvPreq[i,1]>=0) then MarkPreqs(AdvPreq[i,1]);
    end
  end;

begin
if Server(sSetResearch-sExecute,me,FarTech,nil^)>=rExecuted then
  result:=FarTech
else
  begin
  FillChar(known,SizeOf(known),0);
  MarkPreqs(FarTech);
  result:=-1;
  for ad:=0 to nAdv-1 do
    if (known[ad]>0) and (MyRO.Tech[ad]<tsApplicable)
      and ((result<0) or (AdvValue[ad]>AdvValue[result]))
      and (Server(sSetResearch-sExecute,me,ad,nil^)>=rExecuted) then
      result:=ad;
  end;
end;

procedure AutoBuild(cix: integer; const ImpOrder: TImpOrder);
var
i,NewProject: integer;
begin
if (MyCity[cix].Project and (cpImp+cpIndex)=cpImp+imTrGoods)
  or (MyCity[cix].Flags and chProduction<>0) then
  begin
  i:=0;
  repeat
    while (ImpOrder[i]>=0) and (MyCity[cix].Built[ImpOrder[i]]>0) do inc(i);
    if ImpOrder[i]<0 then Break;
    assert(i<nImp);
    NewProject:=cpImp+ImpOrder[i];
    if Server(sSetCityProject,me,cix,NewProject)>=rExecuted then Break;
    inc(i);
  until false
  end
end;

procedure CalculateAdvValues;
var
i,j: integer;
known: array[0..nAdv-1] of integer;

  procedure MarkPreqs(i: integer);
  begin
  if known[i]=0 then
    begin
    known[i]:=1;
    if (i<>adScience) and (i<>adMassProduction) then
      begin
      if (AdvPreq[i,0]>=0) then MarkPreqs(AdvPreq[i,0]);
      if (AdvPreq[i,1]>=0) then MarkPreqs(AdvPreq[i,1]);
      end
    end
  end;

begin
FillChar(AdvValue,SizeOf(AdvValue),0);
for i:=0 to nAdv-1 do
  begin
  FillChar(known,SizeOf(known),0);
  MarkPreqs(i);
  for j:=0 to nAdv-1 do if known[j]>0 then inc(AdvValue[i]);
  if i in FutureTech then inc(AdvValue[i],3000)
  else if known[adMassProduction]>0 then inc(AdvValue[i],2000)
  else if known[adScience]>0 then inc(AdvValue[i],1000)
  end;
end;

procedure DebugMessage(Level: integer; Text: string);
begin
Server(sMessage,me,Level,pchar(Text)^)
end;


initialization
assert(nImp<128);
CalculateAdvValues;

end.