term.pas

类似文明的游戏源代码。

        if (xdivider<xSizeSmall) and (ydivider<ySizeSmall) then
          inc(resampled[ir+nx+1,ch],c*(xSizeSmall-xdivider)*(ySizeSmall-ydivider));
        end
      end
    end;

// sharpen resampled icons
SmallImp.Width:=nx; SmallImp.Height:=ny;
for y:=0 to ny-1 do
  begin
  line:=SmallImp.ScanLine[y];
  for x:=0 to nx-1 do
    for ch:=0 to 2 do
      begin
      sum:=0;
      Cnt:=0;
      for dy:=-1 to 1 do
        if ((dy>=0) or (y mod ySizeSmall>0)) and ((dy<=0) or (y mod ySizeSmall<ySizeSmall)) then
          for dx:=-1 to 1 do
            if ((dx>=0) or (x mod xSizeSmall>0)) and ((dx<=0) or (x mod xSizeSmall<xSizeSmall-1)) then
              begin
              inc(sum,resampled[x+dx+nx*(y+dy),ch]);
              inc(Cnt);
              end;
      sum:=((Cnt*Sharpen+800)*resampled[x+nx*y,ch]-sum*Sharpen) div (800*xSizeBig*(ySizeBig-2*cut));
      if sum<0 then sum:=0;
      if sum>255 then sum:=255;
      line[x][ch]:=sum;
      end;
  end;
FreeMem(resampled);
//smallimp.savetofile(homedir+'smallimp.bmp'); //!!!
end;

{*** tribe management procedures ***}

procedure ChooseModelPicture(p,mix,code,Hash,Turn: integer;
  ForceNew,final: boolean);
var
i: integer;
Picture: TModelPictureInfo;
begin
Picture.trix:=p;
Picture.mix:=mix;
if code=74 then
  begin // use correct pictures for slaves
  if Tribe[p].mixSlaves<0 then
    if not TribeOriginal[p] then Tribe[p].mixSlaves:=mix
    else begin i:=mix+p shl 16; Server(cSetSlaveIndex,0,0,i); end;
  if ToldSlavery=1 then Picture.pix:=pixSlaves else Picture.pix:=pixNoSlaves;
  Picture.Hash:=1;
  Picture.GrName:='StdUnits';
  ForceNew:=false;
  end
else
  begin
  Picture.Hash:=Hash;
  Tribe[p].ChooseModelPicture(Picture,code,Turn,ForceNew);
  end;
if final then
  if not TribeOriginal[p] then
    Tribe[p].SetModelPicture(Picture, ForceNew)
  else if ForceNew then
    Server(cSetNewModelPicture+(Length(Picture.GrName)+1+16+3) div 4,0,
      0,Picture)
  else Server(cSetModelPicture+(Length(Picture.GrName)+1+16+3) div 4,0,
    0,Picture)
else with Tribe[p].ModelPicture[mix] do
  begin
  HGr:=LoadGraphicSet(Picture.GrName);
  pix:=Picture.pix;
  end;
end;

procedure InitEnemyModel(const ModelInfo: TModelInfo; final: boolean);
var
code: integer;
begin
with ModelInfo do
  begin
  case Kind of
    mkSelfDeveloped, mkEnemyDeveloped:
      case Domain of {age determination}
        dGround:
          if Attack<Defense*4 then
            begin
            code:=100;
            if MaxUpgrade>=12 then inc(code,6)
            else if (MaxUpgrade>=10) or (Weight>7) then inc(code,5)
            else if MaxUpgrade>=6 then inc(code,4)
            else if MaxUpgrade>=4 then inc(code,3)
            else if MaxUpgrade>=2 then inc(code,2)
            else if MaxUpgrade>=1 then inc(code,1);
            if Speed>=250 then
              if (code>=105) and (Attack<=Defense) then code:=110
              else inc(code,30)
            end
          else
            begin
            code:=170;
            if MaxUpgrade>=12 then inc(code,3)
            else if (MaxUpgrade>=10) or (Weight>7) then inc(code,2)
            else if MaxUpgrade>=4 then inc(code,1)
            end;
        dSea:
          begin
          code:=200;
          if MaxUpgrade>=8 then inc(code,3)
          else if MaxUpgrade>=6 then inc(code,2)
          else if MaxUpgrade>=3 then inc(code,1);
          if Cap and (1 shl (mcSub-mcFirstNonCap))<>0 then code:=240
          else if ATrans_Fuel>0 then code:=220
          else if (code>=202) and (Attack=0) and (TTrans>0) then code:=210;
          end;
        dAir:
          begin
          code:=300;
          if (Bombs>0) or (TTrans>0) then inc(code,10);
          if Speed>850 then inc(code,1)
          end;
        end;
    mkSpecial_TownGuard: code:=41;
    mkSpecial_Boat: code:=64;
    mkSpecial_Carriage: code:=70;
    mkSpecial_SubCabin: code:=71;
    mkSpecial_Glider: code:=73;
    mkSlaves: code:=74;
    mkSettler: if Speed>150 then code:=11 else code:=10;
    mkDiplomat: code:=21;
    mkCaravan: code:=30;
//    mkScout: code:=50;
    end;
  ChooseModelPicture(Owner,mix,code,ModelHash(ModelInfo),G.RO[me].Turn,false,final);
  end;
end;

procedure InitMyModel(mix: integer; final: boolean);
var
mi: TModelInfo;
begin
MakeModelInfo(me,mix,MyModel[mix],mi);
InitEnemyModel(mi,final);
end;

function CreateTribe(p:integer; FileName:string; Original: boolean): boolean;
begin
if not FileExists (HomeDir+'Tribes\'+FileName+'.tribe.txt') then
  begin result:=false; exit end;

TribeOriginal[p]:=Original;
Tribe[p]:=TTribe.Create(FileName);
with Tribe[p] do
  begin
  if (GameMode=cNewGame) or not Original then
    begin
    Term.ChooseModelPicture(p,0,010,1,0,true,true);
    Term.ChooseModelPicture(p,1,040,1,0,true,true);
    Term.ChooseModelPicture(p,2,041,1,0,true,true);
    Term.ChooseModelPicture(p,-1,017,1,0,true,true);
    end;
  DipMem[p].pContact:=-1;
  end;
result:=true;
end;

function CityName(Founder: integer): string;
begin
if not MainScreen.mNames.Checked then
  result:=Format('%d.%d',[Founder shr 12, Founder and $FFF])
else result:=Tribe[Founder shr 12].GetCityName(Founder and $FFF);
end;

procedure TellNewModels;
begin
with Tribe[me] do while MyData.ToldModels<MyRO.nModel do
  begin {new Unit class available}
  if (ModelPicture[MyData.ToldModels].HGr>0)
    and (MyModel[MyData.ToldModels].Kind<>mkSelfDeveloped) then
    begin // save picture of DevModel
    ModelPicture[MyData.ToldModels+1]:=ModelPicture[MyData.ToldModels];
    ModelName[MyData.ToldModels+1]:=ModelName[MyData.ToldModels];
    ModelPicture[MyData.ToldModels].HGr:=0
    end;
  if ModelPicture[MyData.ToldModels].HGr=0 then
    InitMyModel(MyData.ToldModels,true); {only run if no researched model}
  UnitStatDlg.mix:=MyData.ToldModels;
  UnitStatDlg.Kind:=dkOK;
  UnitStatDlg.ShowModal;
  inc(MyData.ToldModels)
  end;
end;

(*** client function handling ***)

function TMainScreen.DipCall(Command: integer): integer;
var
i: integer;
begin
result:=Server(Command,me,0,nil^);
if result>=rExecuted then
  begin
  if Command and $FF0F=scContact then
    begin
    DipMem[me].pContact:=Command shr 4 and $f;
    NatStatDlg.DialogText[me]:='';
    DipMem[me].DeliveredPrices:=[];
    DipMem[me].ReceivedPrices:=[];
    end;

  DipMem[me].SentCommand:=Command;
  DipMem[me].FormerTreaty:=MyRO.Treaty[DipMem[me].pContact];
  if Command=scDipAccept then
    begin // remember delivered and received prices
    for i:=0 to ReceivedOffer.nDeliver-1 do
      include(DipMem[me].ReceivedPrices,ReceivedOffer.Price[i] shr 24);
    for i:=0 to ReceivedOffer.nCost-1 do
      include(DipMem[me].DeliveredPrices,
        ReceivedOffer.Price[ReceivedOffer.nDeliver+i] shr 24);
    end;
  if G.RO[DipMem[me].pContact]<>nil then
    begin // close windows for next player
    if CityDlg.Visible then
      begin CityDlg.CloseAction:=None; CityDlg.Close; end;
    if NatStatDlg.Visible then NatStatDlg.CloseNow;
    SetUnFocus(-1);
    end;
  end
end;

function TMainScreen.OfferCall(var Offer: TOffer): integer;
begin
result:=Server(scDipOffer,me,0,Offer);
if result>=rExecuted then
  begin
  DipMem[me].SentCommand:=scDipOffer;
  DipMem[me].FormerTreaty:=MyRO.Treaty[DipMem[me].pContact];
  DipMem[me].SentOffer:=Offer;
  if G.RO[DipMem[me].pContact]<>nil then
    begin // close windows for next player
    if CityDlg.Visible then
      begin CityDlg.CloseAction:=None; CityDlg.Close; end;
    if NatStatDlg.Visible then NatStatDlg.CloseNow;
    SetUnFocus(-1);
    end;
  end
end;

procedure TMainScreen.SetUnFocus(uix:integer);
var
uix0: integer;
begin
uix0:=UnFocus;
UnFocus:=uix;
if UnFocus>=0 then UnStartLoc:=MyUn[UnFocus].Loc;
BlinkON:=false;
BlinkTime:=0;
if uix0>=0 then PaintLoc(MyUn[uix0].Loc);
if UnFocus>=0 then PaintLoc(MyUn[UnFocus].Loc);
UnitBtn.Visible:= UnFocus>=0
end;

procedure TMainScreen.UpdateIncome;
begin
SumCities(TaxSum,ScienceSum);
PanelPaint;
if CityDlg.Visible then CityDlg.ShowNow
end;

procedure TMainScreen.Client(Command,NewPlayer:integer;var Data);

  procedure GetTribeList;
  var
  SearchRec: TSearchRec;
  Color: TColor;
  Name: string;
  begin
  UnusedTribeFiles.Clear;
  if FindFirst(HomeDir+'Tribes\*.tribe.txt',faArchive+faReadOnly,SearchRec)=0 then
    repeat
      SearchRec.Name:=Copy(SearchRec.Name,1,Length(SearchRec.Name)-10);
      if GetTribeInfo(SearchRec.Name,Name,Color) then
        UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color));
    until FindNext(SearchRec)<>0;
  FindClose(SearchRec);
  end;

  function ChooseUnusedTribe: integer;
  var
  i,j,ColorDistance, BestColorDistance, TestColorDistance, CountBest: integer;
  begin
  Assert(UnusedTribeFiles.Count>0);
  result:=-1;
  BestColorDistance:=-1;
  for j:=0 to UnusedTribeFiles.Count-1 do
    begin
    ColorDistance:=250; // consider differences more than this infinite
    for i:=0 to nPl-1 do if Tribe[i]<>nil then
      begin
      TestColorDistance:=abs(integer(UnusedTribeFiles.Objects[j]) shr 16 and $FF - Tribe[i].Color shr 16 and $FF)
        +abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and $FF - Tribe[i].Color shr 8 and $FF)*3
        +abs(integer(UnusedTribeFiles.Objects[j]) and $FF - Tribe[i].Color and $FF)*2;
      if TestColorDistance<ColorDistance then
        ColorDistance:=TestColorDistance
      end;
    if ColorDistance>BestColorDistance then
      begin CountBest:=0; BestColorDistance:=ColorDistance end;
    if ColorDistance=BestColorDistance then
      begin inc(CountBest); if random(CountBest)=0 then result:=j end
    end;
  end;

  procedure InitModule;
  var
  x,y,i,j,Domain:integer;
  begin
  {search icons for advances:}
  for i:=0 to nAdv-1 do
    if i in FutureTech then AdvIcon[i]:=96+i-futResearchTechnology
    else
      begin
      AdvIcon[i]:=-1;
      for Domain:=0 to nDomains-1 do
        for j:=0 to nUpgrade-1 do if upgrade[Domain,j].Preq=i then
          if AdvIcon[i]>=0 then AdvIcon[i]:=85
          else AdvIcon[i]:=86+Domain;
      for j:=0 to nFeature-1 do if Feature[j].Preq=i then
        for Domain:=0 to nDomains-1 do
          if 1 shl Domain and Feature[j].Domains<>0 then
            if (AdvIcon[i]>=0) and (AdvIcon[i]<>86+Domain) then AdvIcon[i]:=85
            else AdvIcon[i]:=86+Domain;
      for j:=28 to nImp-1 do if Imp[j].Preq=i then AdvIcon[i]:=j;
      for j:=28 to nImp-1 do
        if (Imp[j].Preq=i) and (Imp[j].Kind<>ikCommon) then AdvIcon[i]:=j;
      for j:=0 to nJob-1 do if i=JobPreq[j] then AdvIcon[i]:=84;
      for j:=0 to 27 do if Imp[j].Preq=i then AdvIcon[i]:=j;
      for j:=2 to nGov-1 do if GovPreq[j]=i then AdvIcon[i]:=imPalace;
      if AdvIcon[i]<0 then AdvIcon[i]:=24+AdvValue[i] div 1000;
      end;
  AdvIcon[adConscription]:=86+dGround;

  UnusedTribeFiles:=tstringlist.Create;
  UnusedTribeFiles.Sorted:=true;
  TribeNames:=tstringlist.Create;

  for x:=0 to 11 do for y:=0 to 1 do
    MiniColors[x,y]:=GrExt[HGrSystem].Data.Canvas.Pixels[66+x,67+y];
  HGrTerrain:=LoadGraphicSet('Terrain');
  IsoEngine.Init;
  MainMap:=TIsoMap.Create;
  MainMap.SetOutput(offscreen);

  HGrStdUnits:=LoadGraphicSet('StdUnits');
  BigImp:=TBitmap.Create;
  if not LoadBitmapFromPNG(BigImp,HomeDir+'Graphics\Icons.png') then
    BigImp.LoadFromFile(HomeDir+'Graphics\Icons.bmp');
  if TrueColor=1 then
    BigImp.PixelFormat:=pf24bit;
  SmallImp:=TBitmap.Create;
  SmallImp.PixelFormat:=pf24bit;
  InitSmallImp;

  CityDlg.CloseBtn.Caption:=Phrases.Lookup('BTN_OK');
  CityDlg.SupportBtn.Hint:=Phrases.Lookup('BTN_SUPPORT');
  CityDlg.BuiltBtn.Hint:=Phrases.Lookup('BTN_BUILT');
  CityDlg.BuyBtn.Hint:=Phrases.Lookup('BTN_BUY');
  SelectDlg.Layer0Btn.Hint:=Phrases.Lookup('BTN_IMPRS');
  SelectDlg.Layer1Btn.Hint:=Phrases.Lookup('BTN_WONDERS');
  SelectDlg.Layer2Btn.Hint:=Phrases.Lookup('BTN_CLASSES');
  UnitStatDlg.OKBtn.Caption:=Phrases.Lookup('BTN_OK');
  DraftDlg.Caption:=Phrases.Lookup('TITLE_DRAFT');
  DraftDlg.OKBtn.Caption:=Phrases.Lookup('BTN_OK');
  DraftDlg.CloseBtn.Caption:=Phrases.Lookup('BTN_CANCEL');
  EnhanceDlg.Caption:=Phrases.Lookup('TITLE_ENHANCE');
  CityTypeDlg.Caption:=Phrases.Lookup('TITLE_CITYTYPES');
  CityTypeDlg.DeleteBtn.Hint:=Phrases.Lookup('BTN_DELETE');
  NatStatDlg.StatBtn.Hint:=Phrases.Lookup('BTN_NATINFO');
  NatStatDlg.DialogBtn.Hint:=Phrases.Lookup('BTN_DIALOG');
  NatStatDlg.BreakBtn.Hint:=Phrases.Lookup('BTN_BREAK');
  NatStatDlg.OfferBtn.Hint:=Phrases.Lookup('BTN_OFFER');
  NatStatDlg.DipCancelTreatyBtn.Hint:=Phrases.Lookup('BTN_CNTREATY');
  NatStatDlg.MilitaryBtn.Hint:=Phrases.Lookup('BTN_MILREPORT');
  NatStatDlg.Left:=Screen.Width-NatStatDlg.Width-8;
  NatStatDlg.Top:=Screen.Height-PanelHeight-NatStatDlg.Height-8;
  MessgExDlg.DeliverBtn.Hint:=Phrases.Lookup('TITLE_OFFERDELIVER');
  MessgExDlg.CostBtn.Hint:=Phrases.Lookup('TITLE_OFFERCOST');

  CreatePVSB(sb,Handle,100-200,122,148-200);
  end;{InitModule}

  procedure InitTurn(p: integer);
  var
  Domain,p1,i,ad,uix,cix,NewResearch,MoveOptions,MoveResult,Loc1,Dist,