term.pas

类似文明的游戏源代码。

{$INCLUDE switches}

unit Term;

interface

uses
  Protocol,Tribes,PVSB,ClientTools,ScreenTools,BaseWin,ButtonBase,

  Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Menus,ExtCtrls,
  ButtonA,ButtonB, ButtonC;

const
WM_EOT=WM_USER;

type
  TMainScreen = class(TForm)
    Timer1:TTimer;
    GamePopup: TPopupMenu;
    UnitPopup:TPopupMenu;
    mIrrigation:TMenuItem;
    mCity:TMenuItem;
    mRoad:TMenuItem;
    mMine:TMenuItem;
    N4:TMenuItem;
    mPollution:TMenuItem;
    mPillage:TMenuItem;
    mHome:TMenuItem;
    mStay: TMenuItem;
    N7:TMenuItem;
    mDisband:TMenuItem;
    mWait:TMenuItem;
    mNoOrders:TMenuItem;
    MTrans:TMenuItem;
    GameBtn: TButtonB;
    UnitBtn: TButtonB;
    StatBtn: TButtonB;
    EOT: TButtonB;
    mResign: TMenuItem;
    N2: TMenuItem;
    mOptions: TMenuItem;
    mEnMoves: TMenuItem;
    mFullScreen: TMenuItem;
    mWaitTurn: TMenuItem;
    mRep: TMenuItem;
    mFort: TMenuItem;
    mCentre: TMenuItem;
    N1: TMenuItem;
    mAirBase: TMenuItem;
    N5: TMenuItem;
    mCityTypes: TMenuItem;
    mHelp: TMenuItem;
    mCanal: TMenuItem;
    mTest: TMenuItem;
    mLocCodes: TMenuItem;
    mLoad: TMenuItem;
    StatPopup: TPopupMenu;
    mCityStat: TMenuItem;
    mUnitStat: TMenuItem;
    mWonders: TMenuItem;
    mScienceStat: TMenuItem;
    mRR: TMenuItem;
    mClear: TMenuItem;
    mFarm: TMenuItem;
    mAfforest: TMenuItem;
    mRep0: TMenuItem;
    mRep1: TMenuItem;
    mRep2: TMenuItem;
    mRep3: TMenuItem;
    mRep4: TMenuItem;
    mRep5: TMenuItem;
    mRep7: TMenuItem;
    mRep8: TMenuItem;
    mRep9: TMenuItem;
    mRep15: TMenuItem;
    mCancel: TMenuItem;
    mLog: TMenuItem;
    mEUnitStat: TMenuItem;
    mRep10: TMenuItem;
    N9: TMenuItem;
    mEnAttacks: TMenuItem;
    mEnNoMoves: TMenuItem;
    mDiagram: TMenuItem;
    mJump: TMenuItem;
    mNations: TMenuItem;
    mManip: TMenuItem;
    mManip0: TMenuItem;
    mManip1: TMenuItem;
    mManip2: TMenuItem;
    mManip3: TMenuItem;
    mManip4: TMenuItem;
    mManip5: TMenuItem;
    mEnhanceDef: TMenuItem;
    mEnhance: TMenuItem;
    mShips: TMenuItem;
    mMacro: TMenuItem;
    mFarTech: TMenuItem;
    mRun: TMenuItem;
    N10: TMenuItem;
    mRepList: TMenuItem;
    mRepScreens: TMenuItem;
    mRep11: TMenuItem;
    mNames: TMenuItem;
    mManip6: TMenuItem;
    mRep12: TMenuItem;
    mRandomMap: TMenuItem;
    mTechExt: TMenuItem;
    mUnload: TMenuItem;
    mRecover: TMenuItem;
    MapBtn0: TButtonC;
    MapBtn1: TButtonC;
    MapBtn2: TButtonC;
    MapBtn3: TButtonC;
    MapBtn4: TButtonC;
    mEmpire: TMenuItem;
    MapBtn5: TButtonC;
    EditPopup: TPopupMenu;
    mCreateUnit: TMenuItem;
    MapBtn6: TButtonC;
    N3: TMenuItem;
    mDebugMap: TMenuItem;
    mUtilize: TMenuItem;
    mRep6: TMenuItem;
    procedure FormCreate(Sender:TObject);
    procedure FormDestroy(Sender:TObject);
    procedure Timer1Timer(Sender:TObject);
    procedure MapBoxMouseDown(Sender:TObject;Button:TMouseButton;
      Shift:TShiftState;x,y:integer);
    procedure EOTClick(Sender:TObject);
    procedure PanelBoxMouseDown(Sender:TObject;Button:TMouseButton;
      Shift:TShiftState;x,y:integer);
    procedure FormKeyDown(Sender:TObject;var Key:word;
      Shift:TShiftState);
    procedure MenuClick(Sender:TObject);
    procedure FormResize(Sender:TObject);
    procedure PanelBtnClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: boolean);
    procedure Toggle(Sender: TObject);
    procedure PanelBoxMouseMove(Sender: TObject; Shift: TShiftState; x,
      y: integer);
    procedure PanelBoxMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; x, y: integer);
    procedure MapBoxMouseMove(Sender: TObject; Shift: TShiftState; x,
      y: integer);
    procedure mShowClick(Sender: TObject);
    procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; x, y: integer);
    procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x,
      y: integer);
    procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; x, y: integer);
    procedure FormPaint(Sender: TObject);
    procedure mRepClicked(Sender: TObject);
    procedure mLogClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure Radio(Sender: TObject);
    procedure mManipClick(Sender: TObject);
    procedure mNamesClick(Sender: TObject);
    procedure MapBtnClick(Sender: TObject);
    procedure FormKeyUp(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure CreateUnitClick(Sender: TObject);
  public
    procedure CreateParams (var p: TCreateParams); override;
    procedure Client(Command,NewPlayer:integer;var Data);
    procedure CityOpened(Loc: integer);
    procedure CityClosed(Activateuix: integer; AutoTurn: boolean = false);
    function DipCall(Command: integer): integer;
    function OfferCall(var Offer: TOffer): integer;
    procedure UpdateIncome;
  private
    xw,yw,xwd,ywd,xwMini,ywMini,xMini,yMini,ywmax,TroopLoc,TrCnt,TrRow,
      MapWidth,MapHeight,BlinkTime, BrushLoc, EditLoc: integer;
    BrushType: Cardinal;
    trix:array[0..23] of integer;
    Mini,Panel:TBitmap;
    sb:TPVScrollbar;
    Closable,RepaintOnResize,Tracking,TurnComplete: boolean;
    procedure OffscreenPaint;
    procedure MiniPaint;
    procedure MainPaint;
    procedure PanelPaint;
    procedure MarkCity(Loc: integer);
    procedure NextUnit(NearLoc:integer;AutoTurn:boolean);
    procedure Centre(Loc:integer);
    procedure SetTroopLoc(Loc:integer);
    procedure ProcessRect(x0,y0,nx,ny,Options: integer);
    procedure PaintLoc(Loc: integer; Radius: integer = 0);
    procedure SetUnFocus(uix:integer);
    function MoveUnit(dx,dy:integer; Options: integer = 0): integer;
    procedure MoveToLoc(Loc: integer);
    procedure MoveOnScreen(ShowMove: TShowMove; Step0,Step1,nStep: integer;
      Restore: boolean = true);
    procedure FocusOnLoc(Loc:integer; Options: integer = 0);
    function EndTurn(ShowEnemyMoves: boolean): boolean;
    procedure EndNego;
    function IsPanelPixel(x,y: integer): boolean;
    procedure InitPopup(Popup: TPopupMenu);
    procedure SmartInvalidate(Left,Top,Rigth,Bottom: integer);
    procedure OnEraseBkgnd(var m:TMessage); message WM_ERASEBKGND;
    procedure OnScroll(var m:TMessage); message WM_VSCROLL;
    procedure OnEOT(var Msg:TMessage); message WM_EOT;
  end;

var
MainScreen:TMainScreen;

type
TTribeInfo=record
  trix: integer;
  FileName: ShortString;
  end;
TCityNameInfo=record
  ID: integer;
  NewName: ShortString
  end;
TModelNameInfo=record
  mix: integer;
  NewName: ShortString
  end;
TPriceSet=Set of $00..$FF;

const
crImpDrag=2;

nCityType=4;

{client exclusive commands:}
cSetTribe=$9000;cSetNewModelPicture=$9100;cSetModelName=$9110;
cSetModelPicture=$9120;cSetSlaveIndex=$9131;
cSetCityName=$9200;

// city status flags
csTypeMask=$07; csToldDelay=$08;

{unit status flags}
usStay=$01; usWaiting=$02; usGoto=$04; usEnhance=$08; usRecover=$10;
usPersistent=usStay or usGoto or usEnhance or usRecover or integer($FFFF0000);

{model status flags}
msObsolete=$1; msAllowConscripts=$2;

{additional city happened flags}
chTypeDel=$8000;

adNone=$801;

SpecialModelPictureCode: array[0..nSpecialModel-1] of integer=
(10,11,40,41,21,30,{50,51,}64,74,70,71,73);

pixSlaves=0; pixNoSlaves=1; // index of slaves in StdUnits

// icon.bmp properties
xSizeBig=56; ySizeBig=40; xSizeSmall=36; ySizeSmall=20;
SystemIconLines=1; // lines of system icons in icons.bmp before improvements

// map options
moPolitical=0; moCityNames=1; moBorders=2; moFoW=3; moGreatWall=4;
moGrid=5; moBareTerrain=6;

nCityEventPriority=14;
CityEventPriority: array[0..nCityEventPriority-1] of integer=
(chImprovementLost,chUnitLost,chDisorder,chProduction,chOldWonder,
chNoSettlerProd,chPopDecrease,chProductionSabotaged,
chNoGrowthWarning,chPollution,chTypeDel,chFounded,chSiege,chPopIncrease);

type
TPersistentData=record
  FarTech, ToldAge, ToldModels, ToldAlive, ToldBankrupt, ColdWarStart,
    PeaceEvaHappened: integer;
  EnhancementJobs: TEnhancementJobs;
  ImpOrder: array[0..nCityType-1] of TImpOrder;
  ToldShip: array[0..nPl-1] of TShipInfo;
  ToldWonders: array[0..27] of TWonderInfo;
  ToldTech: array[0..nAdv-1] of ShortInt;
  end;

var
MyData: ^TPersistentData;
AdvIcon:array[0..nAdv-1] of integer; {icons displayed with the technologies}
ClientMode,Age,UnFocus,HGrTerrain,CityRepMask,OptionChecked,MapOptionChecked,
  ScienceSum,TaxSum: integer;
ReceivedOffer: TOffer;
InnerTex, OuterTex: TTexture;
Buffer,BigImp,SmallImp: TBitmap;
FullScreen,BlinkON:boolean;
UnusedTribeFiles, TribeNames: tstringlist;
Tribe: array[0..nPl-1] of TTribe;
TribeOriginal: array[0..nPl-1] of boolean;
DipMem: array[0..nPl-1] of record
  pContact, SentCommand, FormerTreaty: integer;
  SentOffer: TOffer;
  DeliveredPrices, ReceivedPrices: TPriceSet;
  end;

function CityName(Founder: integer): string;
procedure InitEnemyModel(const ModelInfo: TModelInfo; final: boolean);
procedure InitMyModel(mix: integer; final: boolean);


implementation

uses
  IsoEngine,CityScreen,Draft,Messg,MessgEx,Select,CityType,Help,UnitStat,
  Diplomacy,Inp,log,Diagram,NatStat,Enhance,

  DePNG, Registry;

{$R *.DFM}
{$R Res1.res}

const
PanelHeight=lymax+17;
MidPanelHeight=77; // should be same as BaseWin.yUnused
LeftPanelWidth=141;
LeftPanelWidth_Editor=46;
overlap=PanelHeight-MidPanelHeight;
yTroop=PanelHeight-MidPanelHeight+6;
xBar=8; yBar=39;
BlinkOnTime=12; BlinkOffTime=6;
MoveTime=300; // {time for moving a unit in ms}
WaitAfterShowMove=32;
FastScrolling=false; // causes problems with overlapping windows

nBrushTypes=26;
BrushTypes: array[0..nBrushTypes-1] of Cardinal=
(fPrefStartPos,fStartPos,
fShore,fGrass,fTundra,fPrairie,fDesert,fSwamp,fForest,fHills,fMountains,fArctic,
fRiver,fRare,fRare or fRare1,fRare or fRare2,fRare or fRare1 or fRare2,
fRoad,fRR,fCanal,tiIrrigation,tiFarm,tiMine,tiFort,tiBase,fPoll);

// MoveUnit options:
muAutoNoWait=$0001; muAutoNext=$0002;

// ProcessRect options:
prPaint=$0001; prAutoBounds=$0002; prInvalidate=$0004;

// FocusOnLoc options:
flRepaintPanel=$0001; flImmUpdate=$0002;

nSaveOption=13;

var
Jump: array[0..nPl-1] of integer;
pTurn,UnStartLoc,GameMode,xTroop,ToldSlavery,AfterMovePaintRadius: integer;
PerfFreq: int64;
GameOK, MapValid, skipped, idle: boolean;

SaveOption: array[0..nSaveOption-1] of integer;
MiniColors: array[0..11,0..1] of TColor;
MainMap: TIsoMap;


procedure InitSmallImp;
const
cut=4;
Sharpen=80;
type
TLine=array[0..99999,0..2] of Byte;
TBuffer=array[0..99999,0..2] of integer;
var
sum,Cnt,dx,dy,nx,ny,ix,iy,ir,x,y,c,ch,xdivider,ydivider: integer;
resampled: ^TBuffer;
line: ^TLine;
begin
nx:=BigImp.Width div xSizeBig *xSizeSmall;
ny:=BigImp.Height div ySizeBig *ySizeSmall;

// resample icons
GetMem(resampled,nx*ny*12);
FillChar(resampled^,nx*ny*12,0);
for ix:=0 to BigImp.Width div xSizeBig-1 do for iy:=0 to BigImp.Height div ySizeBig-1 do
  for y:=0 to ySizeBig-2*cut-1 do
    begin
    ydivider:=(y*ySizeSmall div (ySizeBig-2*cut)+1)*(ySizeBig-2*cut)-y*ySizeSmall;
    if ydivider>ySizeSmall then ydivider:=ySizeSmall;
    line:=BigImp.ScanLine[cut+iy*ySizeBig+y];
    for x:=0 to xSizeBig-1 do
      begin
      ir:=ix*xSizeSmall+iy*nx*ySizeSmall
        +x*xSizeSmall div xSizeBig + y*ySizeSmall div (ySizeBig-2*cut) *nx;
      xdivider:=(x*xSizeSmall div xSizeBig+1)*xSizeBig-x*xSizeSmall;
      if xdivider>xSizeSmall then xdivider:=xSizeSmall;
      for ch:=0 to 2 do
        begin
        c:=line[ix*xSizeBig+x,ch];
        inc(resampled[ir,ch],c*xdivider*ydivider);
        if xdivider<xSizeSmall then
          inc(resampled[ir+1,ch],c*(xSizeSmall-xdivider)*ydivider);
        if ydivider<ySizeSmall then
          inc(resampled[ir+nx,ch],c*xdivider*(ySizeSmall-ydivider));