unit KM_Hand; {$I KaM_Remake.inc} interface uses Generics.Collections, KM_AI, KM_Units, KM_UnitsCollection, KM_UnitGroup, KM_UnitWarrior, KM_Houses, KM_HouseCollection, KM_HouseInn, KM_HandLogistics, KM_HandLocks, KM_HandStats, KM_GameTypes, KM_FogOfWar, KM_HandConstructions, KM_MessageLog, KM_ResHouses, KM_CommonClasses, KM_CommonTypes, KM_Defaults, KM_Points, KM_HandEntity, KM_HandTypes, KM_CommonClassesExt, KM_ResTypes, KM_ResFonts; type TKMChooseLoc = record Allowed, Placed: Boolean; Resources: array[WARE_MIN..WARE_MAX] of Word; Units: array[CITIZEN_MIN..CITIZEN_MAX] of Byte; end; //Player manages its assets TKMHandCommon = class abstract private fID: TKMHandID; //Index of this hand in gHands fUnits: TKMUnitsCollection; public constructor Create(aHandIndex: TKMHandID); destructor Destroy; override; property ID: TKMHandID read fID; property Units: TKMUnitsCollection read fUnits; function AddUnit(aUnitType: TKMUnitType; const aLoc: TKMPoint): TKMUnit; function RemUnit(const Position: TKMPoint): Boolean; overload; function RemUnit(const Position: TKMPoint; out aUnitType: TKMUnitType): Boolean; overload; function UnitsHitTest(const aLoc: TKMPoint; const UT: TKMUnitType = utAny): TKMUnit; overload; function UnitsHitTest(X, Y: Integer; const UT: TKMUnitType = utAny): TKMUnit; overload; procedure Save(SaveStream: TKMemoryStream); virtual; procedure Load(LoadStream: TKMemoryStream); virtual; procedure SyncLoad; virtual; procedure UpdateState(aTick: Cardinal); virtual; procedure UpdateVisualState; procedure Paint(const aRect: TKMRect; aTickLag: Single); virtual; end; TKMHand = class(TKMHandCommon) private fAI: TKMHandAI; fEnabled: Boolean; fConstructions: TKMHandConstructions; fDeliveries: TKMHandLogistics; fFogOfWar: TKMFogOfWar; //Stores FOW info for current player, which includes fHouses: TKMHousesCollection; fLocks: TKMHandLocks; fRoadsList: TKMPointList; //Used only once to speedup mission loading, then freed fStats: TKMHandStats; fUnitGroups: TKMUnitGroups; fMessageLog: TKMMessageLog; fOwnerNickname: AnsiString; //Multiplayer owner nickname fHandType: TKMHandType; fCanBeHuman: Boolean; fCanBeAITypes: TKMAITypeSet; fFlagColor: Cardinal; fTeam: Integer; fTeamColor: Cardinal; fCenterScreen: TKMPoint; fChooseLocation: TKMChooseLoc; fAlliances: array [0 .. MAX_HANDS - 1] of TKMAllianceType; fShareFOW: array [0 .. MAX_HANDS - 1] of Boolean; fShareBeacons: array [0 .. MAX_HANDS - 1] of Boolean; // Overlays fOverlayText: UnicodeString; //Needed for replays. Not saved since it's translated fOverlayMarkup: AnsiString; fOverlayParams: TKMVarValueList; fOverlayTextSettings: TKMOverlayTextSettings; //House sketch fields, used to GetNextHouseWSameType fHSketch: TKMHouseSketchEdit; fFirstHSketch: TKMHouseSketchEdit; fFoundHSketch: TKMHouseSketchEdit; fOnAllianceChange: TKMEvent; function IsDisabled: Boolean; function GetColorIndex: Byte; function GetAlliances(aIndex: Integer): TKMAllianceType; inline; procedure SetAlliances(aIndex: Integer; aValue: TKMAllianceType); inline; function GetShareFOW(aIndex: Integer): Boolean; procedure SetShareFOW(aIndex: Integer; aValue: Boolean); function GetShareBeacons(aIndex: Integer): Boolean; procedure SetShareBeacons(aIndex: Integer; aValue: Boolean); procedure EntityDestroyed(aEntity: TKMHandEntity); procedure GroupDied(aGroup: TKMUnitGroup); procedure HouseDestroyed(aHouse: TKMHouse; aFrom: TKMHandID); procedure UnitDied(aUnit: TKMUnit); procedure UnitTrained(aUnit: TKMUnit); procedure WarriorWalkedOut(aWarrior: TKMUnitWarrior); function LocHasNoAllyPlans(const aLoc: TKMPoint): Boolean; function GetGameFlagColor: Cardinal; function GetOwnerNicknameU: UnicodeString; procedure ChooseFirstStorehouse(); function GetAI: TKMHandAI; procedure SetFlagColor(const Value: Cardinal); procedure SetOwnerNickname(const aName: AnsiString); function GetDeliveries: TKMHandLogistics; procedure SetHandType(const Value: TKMHandType); procedure SetEnabled(const Value: Boolean); function GetFlagTextColor: Cardinal; public InCinematic: Boolean; //Used for syncing hotkeys in multiplayer saves only. UI keeps local value to avoid GIP delays SelectionHotkeys: array[0..DYNAMIC_HOTKEYS_NUM-1] of Integer; constructor Create(aHandIndex: TKMHandID; aOnAllianceChange: TKMEvent); destructor Destroy; override; property AI: TKMHandAI read GetAI; property Constructions: TKMHandConstructions read fConstructions; property Deliveries: TKMHandLogistics read GetDeliveries; property Houses: TKMHousesCollection read fHouses; property Locks: TKMHandLocks read fLocks; property Stats: TKMHandStats read fStats; property FogOfWar: TKMFogOfWar read fFogOfWar; property UnitGroups: TKMUnitGroups read fUnitGroups; property MessageLog: TKMMessageLog read fMessageLog; property Enabled: Boolean read fEnabled write SetEnabled; property Disabled: Boolean read IsDisabled; procedure SetHandIndex(aNewIndex: TKMHandID); property OwnerNickname: AnsiString read fOwnerNickname write SetOwnerNickname; //MP owner nickname (empty in SP) property OwnerNicknameU: UnicodeString read GetOwnerNicknameU; function CalcOwnerName: UnicodeString; //Universal owner name function OwnerName(aNumberedAIs: Boolean = True; aLocalized: Boolean = True): UnicodeString; //Universal owner name function GetHandOwnerName(aIsHuman, aIsAdvAI: Boolean; aNumberedAIs: Boolean = True; aLocalized: Boolean = True): UnicodeString; function GetOwnerName: UnicodeString; function GetOwnerNameColored: AnsiString; function GetOwnerNameColoredU: UnicodeString; function HasAssets: Boolean; property HandType: TKMHandType read fHandType write SetHandType; //Is it Human or AI property CanBeHuman: Boolean read fCanBeHuman write fCanBeHuman; property CanBeAITypes: TKMAITypeSet read fCanBeAITypes; property FlagColor: Cardinal read fFlagColor write SetFlagColor; property FlagTextColor: Cardinal read GetFlagTextColor; property Team: Integer read fTeam write fTeam; property TeamColor: Cardinal read fTeamColor write fTeamColor; property GameFlagColor: Cardinal read GetGameFlagColor; property FlagColorIndex: Byte read GetColorIndex; property Alliances[aIndex: Integer]: TKMAllianceType read GetAlliances write SetAlliances; property ShareFOW[aIndex: Integer]: Boolean read GetShareFOW write SetShareFOW; property ShareBeacons[aIndex: Integer]: Boolean read GetShareBeacons write SetShareBeacons; property CenterScreen: TKMPoint read fCenterScreen write fCenterScreen; property ChooseLocation: TKMChooseLoc read fChooseLocation write fChooseLocation; property OverlayText: UnicodeString read fOverlayText write fOverlayText; property OverlayTextSettings: TKMOverlayTextSettings read fOverlayTextSettings; property OverlayMarkup: AnsiString read fOverlayMarkup write fOverlayMarkup; property OverlayParams: TKMVarValueList read fOverlayParams; procedure SetOverlayTextWordWrap(aWordWrap: Boolean); procedure SetOverlayTextFont(aFont: TKMFont); procedure AddAIType(aHandAIType: TKMAIType); procedure PostLoadMission; function IsAnimal: Boolean; function IsHuman: Boolean; function IsComputer: Boolean; function IsAdvancedAI: Boolean; function IsClassicAI: Boolean; function CanBeAI: Boolean; procedure AfterMissionInit(aFlattenRoads: Boolean); function AddUnit(aUnitType: TKMUnitType; const aLoc: TKMPoint; aAutoPlace: Boolean = True; aRequiredWalkConnect: Byte = 0; aCheat: Boolean = False): TKMUnit; reintroduce; overload; function AddUnit(aUnitType: TKMUnitType; const aLoc: TKMPointDir; aAutoPlace: Boolean = True; aRequiredWalkConnect: Byte = 0; aCheat: Boolean = False): TKMUnit; reintroduce; overload; function AddUnitGroup(aUnitType: TKMUnitType; const Position: TKMPoint; aDir: TKMDirection; aUnitPerRow, aCount: Word): TKMUnitGroup; function TrainUnit(aUnitType: TKMUnitType; aInHouse: TKMHouse): TKMUnit; function GetNextHouseWSameType(aHouseType: TKMHouseType; aStartFromUID: Integer): TKMHouse; overload; function GetNextHouseWSameType(aHouseType: TKMHouseType; aStartFromUID: Integer; out aHouseSketch: TKMHouseSketchEdit; aSketchTypesSet: TKMHouseSketchTypeSet = [hstHouse]): TKMHouse; overload; function GetNextHouseWSameType(aHouseType: TKMHouseType; aStartFromUID: Integer; out aHouseSketch: TKMHouseSketchEdit; aSketchTypesSet: TKMHouseSketchTypeSet; aVerifySketch: TAnonHouseSketchBoolFn; aVerifySketchBoolParam: Boolean): TKMHouse; overload; function GetNextUnitWSameType(aUnitType: TKMUnitType; aStartFromUID: Integer): TKMUnit; function GetNextGroupWSameType(aUnitType: TKMUnitType; aStartFromUID: Integer): TKMUnitGroup; function CanAddFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType): Boolean; function CanAddFakeFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType): Boolean; function CanRemFakeFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType): Boolean; function CanAddHousePlan(const aLoc: TKMPoint; aHouseType: TKMHouseType): Boolean; function CanAddHousePlanAI(aX, aY: Word; aHouseType: TKMHouseType; aCheckInfluence: Boolean): Boolean; procedure AddFirstStorehouse(aEntrance: TKMPoint); procedure ResetChooseLocation; function NeedToChooseFirstStorehouse: Boolean; function NeedToChooseFirstStorehouseInGame: Boolean; procedure AddRoadToList(const aLoc: TKMPoint); procedure AddRoad(const aLoc: TKMPoint); procedure AddField(const aLoc: TKMPoint; aFieldType: TKMFieldType; aStage: Byte = 0; aKeepOldObject: Boolean = False; aRemoveOverlay: Boolean = True); procedure ToggleFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType; aMakeSound: Boolean); procedure ToggleFakeFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType); function AddHouse(aHouseType: TKMHouseType; PosX, PosY: Word; RelativeEntrace: Boolean): TKMHouse; procedure AddHousePlan(aHouseType: TKMHouseType; const aLoc: TKMPoint); function HasHousePlan(const aLoc: TKMPoint): Boolean; function AddHouseWIP(aHouseType: TKMHouseType; const aLoc: TKMPoint): TKMHouse; function RemGroup(const Position: TKMPoint): Boolean; procedure RemHouse(const Position: TKMPoint; DoSilent: Boolean; IsEditor: Boolean = False); procedure RemHousePlan(const Position: TKMPoint); procedure RemFieldPlan(const Position: TKMPoint; aMakeSound:Boolean); procedure RemFakeFieldPlan(const Position: TKMPoint); function FindInn(Loc: TKMPoint; aUnit: TKMUnit; UnitIsAtHome: Boolean = False): TKMHouseInn; function FindHouse(aType: TKMHouseType; const aPosition: TKMPoint; Index: Byte = 1): TKMHouse; overload; function FindHouse(aType: TKMHouseType; Index: Byte=1): TKMHouse; overload; function FindHousesInRadius(const aLoc: TKMPoint; aSqrRadius: Single; aTypes: TKMHouseTypeSet = HOUSES_VALID; aOnlyCompleted: Boolean = True): TKMHouseArray; function FindCityCenter: TKMPoint; function HitTest(X,Y: Integer): TObject; function HousesHitTest(X, Y: Integer): TKMHouse; function GroupsHitTest(X, Y: Integer): TKMUnitGroup; function ObjectByUID(aUID: Integer): TObject; procedure GetHouseMarks(const aLoc: TKMPoint; aHouseType: TKMHouseType; aList: TKMPointTagList; aIgnoreFOW: Boolean = False); function GetFieldsCount: Integer; procedure GetFieldPlans(aList: TKMPointTagList; const aRect: TKMRect; aIncludeFake: Boolean); procedure GetHousePlans(aList: TKMPointDirList; const aRect: TKMRect); procedure GetPlansTablets(aList: TKMPointTagList; const aRect: TKMRect); function CanDoStatsUpdate(aTick: Cardinal): Boolean; function DoCheckGoals: Boolean; procedure Save(SaveStream: TKMemoryStream); override; procedure Load(LoadStream: TKMemoryStream); override; procedure SyncLoad; override; procedure IncAnimStep; procedure UpdateState(aTick: Cardinal); override; procedure Paint(const aRect: TKMRect; aTickLag: Single); override; function ObjToString(aSeparator: String = ' '): String; end; TKMHandAnimals = class(TKMHandCommon) public function GetFishInWaterBody(aWaterID: Byte; FindHighestCount: Boolean = True): TKMUnitFish; end; function GetStatsUpdatePeriod: Integer; implementation uses Classes, SysUtils, KromUtils, Math, TypInfo, KM_Entity, KM_Cursor, KM_Game, KM_GameParams, KM_Terrain, KM_HandsCollection, KM_Sound, KM_AIFields, KM_MapEdTypes, KM_Resource, KM_ResSound, KM_ResTexts, KM_ResMapElements, KM_ScriptingEvents, KM_ResUnits, KM_CommonUtils, KM_GameSettings, KM_UnitGroupTypes, KM_MapTypes; const TIME_TO_SET_FIRST_STOREHOUSE = 10*60*2; //We give 2 minutes to set first storehouse, otherwise player will be defeated { TKMHandCommon } constructor TKMHandCommon.Create(aHandIndex: TKMHandID); begin inherited Create; fID := aHandIndex; fUnits := TKMUnitsCollection.Create; end; destructor TKMHandCommon.Destroy; begin FreeThenNil(fUnits); inherited; end; function TKMHandCommon.AddUnit(aUnitType: TKMUnitType; const aLoc: TKMPoint): TKMUnit; begin //Animals are autoplaced by default Result := fUnits.AddUnit(fID, aUnitType, KMPointDir(aLoc, dirS), True); end; procedure TKMHandCommon.Paint(const aRect: TKMRect; aTickLag: Single); begin if mlUnits in gGameParams.VisibleLayers then fUnits.Paint(aRect, aTickLag); end; function TKMHandCommon.RemUnit(const Position: TKMPoint): Boolean; var UnitType: TKMUnitType; begin Result := RemUnit(Position, UnitType); end; function TKMHandCommon.RemUnit(const Position: TKMPoint; out aUnitType: TKMUnitType): Boolean; var U: TKMUnit; begin Assert(gGameParams.IsMapEditor); U := fUnits.HitTest(Position.X, Position.Y); Result := U <> nil; if Result then begin aUnitType := U.UnitType; fUnits.RemoveUnit(U); end; end; procedure TKMHandCommon.Save(SaveStream: TKMemoryStream); begin SaveStream.PlaceMarker('HandCommon'); fUnits.Save(SaveStream); end; procedure TKMHandCommon.Load(LoadStream: TKMemoryStream); begin LoadStream.CheckMarker('HandCommon'); fUnits.Load(LoadStream); end; procedure TKMHandCommon.SyncLoad; begin fUnits.SyncLoad; end; function TKMHandCommon.UnitsHitTest(const aLoc: TKMPoint; const UT: TKMUnitType = utAny): TKMUnit; begin Result := UnitsHitTest(aLoc.X, aLoc.Y, UT); end; function TKMHandCommon.UnitsHitTest(X, Y: Integer; const UT: TKMUnitType = utAny): TKMUnit; begin Result := fUnits.HitTest(X, Y, UT); end; procedure TKMHandCommon.UpdateState(aTick: Cardinal); begin fUnits.UpdateState(aTick); end; procedure TKMHandCommon.UpdateVisualState; begin Assert(gGameParams.IsMapEditor); fUnits.UpdateVisualState; end; { TKMHand } constructor TKMHand.Create(aHandIndex: TKMHandID; aOnAllianceChange: TKMEvent); var I: Integer; begin inherited Create(aHandIndex); Enabled := True; fOnAllianceChange := aOnAllianceChange; fAI := TKMHandAI.Create(fID); fFogOfWar := TKMFogOfWar.Create(gTerrain.MapX, gTerrain.MapY, gGameParams.DynamicFOW); fLocks := TKMHandLocks.Create; fStats := TKMHandStats.Create; fRoadsList := TKMPointList.Create; fHouses := TKMHousesCollection.Create; fDeliveries := TKMHandLogistics.Create(fID); fConstructions:= TKMHandConstructions.Create; fUnitGroups := TKMUnitGroups.Create; fMessageLog := TKMMessageLog.Create; fOwnerNickname := ''; fHandType := hndComputer; fCanBeHuman := False; fCanBeAITypes := []; for I := 0 to MAX_HANDS - 1 do begin fShareFOW[I] := True; //Share FOW between allies by default (it only affects allied players) fShareBeacons[I] := True; //Share beacons between allies by default (it only affects allied players) end; for I := 0 to 9 do SelectionHotkeys[I] := -1; //Not set fAlliances[fID] := atAlly; //Others are set to enemy by default fFlagColor := DEFAULT_PLAYERS_COLORS[fID]; //Init with default color, later replaced by Script fTeamColor := fFlagColor; fTeam := NO_TEAM; fOverlayParams := TKMVarValueList.Create; fOverlayTextSettings.WordWrap := False; fOverlayTextSettings.Font := fntMetal; fHSketch := TKMHouseSketchEdit.Create; fFirstHSketch := TKMHouseSketchEdit.Create; fFoundHSketch := TKMHouseSketchEdit.Create; ResetChooseLocation; end; //Destruction order is important as Houses and Units need to access //Stats/Deliveries and other collection in their Destroy/Abandon/Demolish methods destructor TKMHand.Destroy; begin FreeAndNil(fHSketch); FreeAndNil(fFirstHSketch); FreeAndNil(fFoundHSketch); FreeAndNil(fOverlayParams); //Groups freed before units since we need to release pointers they have to units FreeThenNil(fUnitGroups); FreeThenNil(fMessageLog); //Free units inherited; FreeThenNil(fRoadsList); FreeThenNil(fHouses); //Should be freed after Houses and Units, as they write Stats on Destroy FreeThenNil(fLocks); FreeThenNil(fStats); FreeThenNil(fFogOfWar); FreeThenNil(fDeliveries); FreeThenNil(fConstructions); FreeThenNil(fAI); end; procedure TKMHand.ResetChooseLocation; begin if Self = nil then Exit; fChooseLocation.Allowed := False; fChooseLocation.Placed := False; end; function TKMHand.AddUnit(aUnitType: TKMUnitType; const aLoc: TKMPoint; aAutoPlace: Boolean = True; aRequiredWalkConnect: Byte = 0; aCheat: Boolean = False): TKMUnit; begin Result := AddUnit(aUnitType, KMPointDir(aLoc, dirS), aAutoPlace, aRequiredWalkConnect, aCheat); end; //Place unit of aUnitType to aLoc via script //AutoPlace - add unit to nearest available spot if aLoc is already taken (or unwalkable) function TKMHand.AddUnit(aUnitType: TKMUnitType; const aLoc: TKMPointDir; aAutoPlace: Boolean = True; aRequiredWalkConnect: Byte = 0; aCheat: Boolean = False): TKMUnit; var G: TKMUnitGroup; begin Result := fUnits.AddUnit(fID, aUnitType, aLoc, aAutoPlace, aRequiredWalkConnect); //Unit failed to add, that happens if Result = nil then Exit; if gGameParams.IsMapEditor then Exit; Result.OnUnitDied := UnitDied; Result.OnUnitTrained := UnitTrained; //Used for debug Scout placed by a cheat if Result is TKMUnitWarrior then TKMUnitWarrior(Result).OnWarriorWalkOut := WarriorWalkedOut; if Result is TKMUnitWorker then fConstructions.AddWorker(TKMUnitWorker(Result)); if Result is TKMUnitSerf then fDeliveries.AddSerf(TKMUnitSerf(Result)); if not aCheat then fStats.UnitCreated(aUnitType, False) else if Result is TKMUnitWarrior then begin //When we place a cheat Scout we want to rig it immediately //It's simpler to count cheat scouts as initial, rather than trained. //Then we don't need to mess with initial recruits. fStats.UnitCreated(aUnitType, False); G := fUnitGroups.WarriorTrained(TKMUnitWarrior(Result)); Assert(G <> nil, 'It is certain that equipped warrior creates or finds some group to join to'); G.OnGroupDied := GroupDied; //Scripting doesn't care about scouts added this way. //It could cause issues if the scripter assumes the warrior came from the player's barracks. //The event is "OnWarriorEquipped" not "OnWarriorCreated". //fScriptingESA.ProcWarriorEquipped(Result, G); end; end; //Start training unit in School/Barracks //User can cancel the training, so we don't add unit to stats just yet function TKMHand.TrainUnit(aUnitType: TKMUnitType; aInHouse: TKMHouse): TKMUnit; begin Assert(aInHouse <> nil, 'House to train unit in could not be nil'); // Add unit and specify that its made inside house (so there is no need to occupy terrain tile) Result := fUnits.AddUnit(fID, aUnitType, KMPointDir(aInHouse.Entrance, dirS), False, 0, aInHouse); Result.OnUnitDied := UnitDied; Result.OnUnitTrained := UnitTrained; if Result is TKMUnitWarrior then TKMUnitWarrior(Result).OnWarriorWalkOut := WarriorWalkedOut; //Do not add unit to statistic just yet, wait till it's training complete end; procedure TKMHand.UnitTrained(aUnit: TKMUnit); begin if aUnit.UnitType = utBuilder then fConstructions.AddWorker(TKMUnitWorker(aUnit)); if aUnit.UnitType = utSerf then fDeliveries.AddSerf(TKMUnitSerf(aUnit)); //Warriors don't trigger "OnTrained" event, they trigger "WarriorEquipped" in WarriorWalkedOut below if not (aUnit is TKMUnitWarrior) then gScriptEvents.ProcUnitTrained(aUnit); fStats.UnitCreated(aUnit.UnitType, True{, (aUnit.InHouse <> nil) and (aUnit.InHouse.HouseType = htTownHall)}); end; procedure TKMHand.WarriorWalkedOut(aWarrior: TKMUnitWarrior); var G: TKMUnitGroup; H: TKMHouse; HWFP: TKMHouseWFlagPoint; begin // Warrior could be killed before he walked out, f.e. by script OnTick ---> Actions.UnitKill // Then group will be assigned to invalid warrior and never gets removed from game if (aWarrior = nil) or aWarrior.IsDeadOrDying then Exit; G := fUnitGroups.WarriorTrained(aWarrior); Assert(G <> nil, 'It is certain that equipped warrior creates or finds some group to join to'); G.OnGroupDied := GroupDied; if IsComputer then begin if AI.Setup.NewAI then AI.ArmyManagement.WarriorEquipped(G) else AI.General.WarriorEquipped(aWarrior); G := UnitGroups.GetGroupByMember(aWarrior); //AI might assign warrior to different group end else if G.Count = 1 then begin //If player is human and this is the first warrior in the group, send it to the rally point H := HousesHitTest(aWarrior.Position.X, aWarrior.Position.Y-1); if (H is TKMHouseWFlagPoint) then begin HWFP := TKMHouseWFlagPoint(H); HWFP.ValidateFlagPoint; // Validate Flag point first. It will set it to a proper walkable position if HWFP.IsFlagPointSet and G.CanWalkTo(HWFP.FlagPoint, 0) then G.OrderWalk(HWFP.FlagPoint, True, wtokFlagPoint); end; end; gScriptEvents.ProcWarriorEquipped(aWarrior, G); end; function TKMHand.AddUnitGroup(aUnitType: TKMUnitType; const Position: TKMPoint; aDir: TKMDirection; aUnitPerRow, aCount: Word): TKMUnitGroup; var I: Integer; begin Assert(aDir <> dirNA); Result := nil; if aUnitType in [CITIZEN_MIN..CITIZEN_MAX] then for I := 0 to aCount - 1 do AddUnit(aUnitType, Position) else if aUnitType in [WARRIOR_MIN..WARRIOR_MAX] then Result := fUnitGroups.AddGroup(fID, aUnitType, Position.X, Position.Y, aDir, aUnitPerRow, aCount); //Group can be nil if it fails to be placed on terrain (e.g. because of terrain height passability) if Result <> nil then Result.OnGroupDied := GroupDied; //Units will be added to statistic inside the function for some units may not fit on map end; //When adding roads from script we want to batch them all into one list to save time //on WalkConnect and other calculations procedure TKMHand.AddRoadToList(const aLoc: TKMPoint); begin Assert(fRoadsList <> nil); //Sometimes maps can have roads placed outside of map bounds - ignore them //(on 80x80 map Loc range is 1..79, which is not obvious when placing roads manually in script) if gTerrain.TileInMapCoords(aLoc.X, aLoc.Y) then fRoadsList.Add(aLoc); end; function TKMHand.IsHuman: Boolean; begin Result := fHandType = hndHuman; end; function TKMHand.IsAnimal: Boolean; begin Result := fID = HAND_ANIMAL; end; function TKMHand.IsComputer: Boolean; begin Result := fHandType = hndComputer; end; function TKMHand.IsAdvancedAI: Boolean; begin Result := IsComputer and fAI.Setup.NewAI; end; function TKMHand.IsClassicAI: Boolean; begin Result := IsComputer and not fAI.Setup.NewAI; end; function TKMHand.CanBeAI: Boolean; begin Result := (fCanBeAITypes <> []) and (fCanBeAITypes <> [aitNone]); end; //Lay out all roads at once to save time on Terrain lighting/passability recalculations procedure TKMHand.AfterMissionInit(aFlattenRoads: Boolean); begin if (Self = nil) or not Enabled then Exit; Assert(fRoadsList <> nil); gTerrain.SetRoads(fRoadsList, fID, not aFlattenRoads); //If we are flattening roads that will update WalkConnect anyway if aFlattenRoads then gTerrain.FlattenTerrain(fRoadsList); if not gGameParams.IsMapEditor then fAI.AfterMissionInit(fCanBeAITypes); end; function TKMHand.GetNextHouseWSameType(aHouseType: TKMHouseType; aStartFromUID: Integer): TKMHouse; begin Result := GetNextHouseWSameType(aHouseType, aStartFromUID, TKMHouseSketchEdit.DummyHouseSketch); end; function TKMHand.GetNextHouseWSameType(aHouseType: TKMHouseType; aStartFromUID: Integer; out aHouseSketch: TKMHouseSketchEdit; aSketchTypesSet: TKMHouseSketchTypeSet = [hstHouse]): TKMHouse; begin Result := GetNextHouseWSameType(aHouseType, aStartFromUID, aHouseSketch, aSketchTypesSet, nil, False); end; function TKMHand.GetNextHouseWSameType(aHouseType: TKMHouseType; aStartFromUID: Integer; out aHouseSketch: TKMHouseSketchEdit; aSketchTypesSet: TKMHouseSketchTypeSet; aVerifySketch: TAnonHouseSketchBoolFn; aVerifySketchBoolParam: Boolean): TKMHouse; var resultSet: Boolean; procedure FillHSketchByHouse(out aHouseSketchTmp: TKMHouseSketchEdit; aHouse: TKMHouse); begin if not aHouse.IsDestroyed // not destroyed and (aHouse.HouseType = aHouseType) {and (not aConsiderHousePlan or aHouse.IsComplete)} then begin aHouseSketchTmp.Owner := fID; aHouseSketchTmp.SetHouseUID(aHouse.UID); aHouseSketchTmp.SetHouseType(aHouse.HouseType); aHouseSketchTmp.SetPosition(aHouse.Position); end; end; procedure FillHSketchByHPlan(out aHouseSketchTmp: TKMHouseSketchEdit; aHousePlan: TKMHousePlan); begin if not aHousePlan.IsEmpty and (aHousePlan.HouseType = aHouseType) then begin aHouseSketchTmp.Owner := fID; aHouseSketchTmp.SetHouseUID(aHousePlan.UID); aHouseSketchTmp.SetHouseType(aHousePlan.HouseType); aHouseSketchTmp.SetPosition(aHousePlan.Loc); end; end; function GetNextHSketch(aIndex: Integer; out aHouseSketchTmp: TKMHouseSketchEdit): Boolean; var sketch2Verify: TKMHouseSketch; begin aHouseSketchTmp.Clear; sketch2Verify := nil; if (hstHouse in aSketchTypesSet) and (aIndex < fHouses.Count) then begin FillHSketchByHouse(aHouseSketchTmp, fHouses[aIndex]); sketch2Verify := fHouses[aIndex]; end else if (hstHousePlan in aSketchTypesSet) then begin FillHSketchByHPlan(aHouseSketchTmp, fConstructions.HousePlanList.Plans[aIndex - Byte(hstHouse in aSketchTypesSet)*fHouses.Count]); sketch2Verify := aHouseSketchTmp; end; Result := not aHouseSketchTmp.IsEmpty and (not Assigned(aVerifySketch) or aVerifySketch(sketch2Verify, aVerifySketchBoolParam)); end; procedure FillResult(aIndex: Integer; aHSketch: TKMHouseSketchEdit); begin resultSet := True; if aHouseSketch <> nil then aHSketch.CopyTo(aHouseSketch); if aIndex < fHouses.Count then Result := fHouses[aIndex]; end; var found: Boolean; //Flag when we find house sketch (House or HousePlan) with specified Starting UID I, firstHSketchI, foundSketchI, cnt: Integer; begin Result := nil; aHouseSketch.Clear; found := False; resultSet := False; cnt := Byte(hstHouse in aSketchTypesSet)*fHouses.Count + Byte(hstHousePlan in aSketchTypesSet)*fConstructions.HousePlanList.Count; I := 0; firstHSketchI := 0; foundSketchI := 0; fHSketch.Clear; fFirstHSketch.Clear; fFoundHSketch.Clear; while I < cnt do begin try if not GetNextHSketch(I, fHSketch) then Continue; //Just find any first house if (aStartFromUID = 0) then begin FillResult(I, fHSketch); Break; end; //Find first house from specified UID if (fHSketch.UID = aStartFromUID) then begin found := True; // Mark that we found our house fHSketch.CopyTo(fFoundHSketch); foundSketchI := I; end else if found then begin FillResult(I, fHSketch); // Save the next house after Found to Result and Break Break; end else if fFirstHSketch.IsEmpty then begin fHSketch.CopyTo(fFirstHSketch); // Save 1st house in list in case our house is the last one firstHSketchI := I; end; finally Inc(I); end; end; if not resultSet then // Found should be always True here begin if found then begin if fFirstHSketch.IsEmpty then FillResult(foundSketchI, fFoundHSketch) //Could happen, when we have only 1 house with that type... else FillResult(firstHSketchI, fFirstHSketch); end else if not fFirstHSketch.IsEmpty then FillResult(firstHSketchI, fFirstHSketch); end; end; function TKMHand.GetNextUnitWSameType(aUnitType: TKMUnitType; aStartFromUID: Integer): TKMUnit; var I: Integer; U, firstU, lastU: TKMUnit; found: Boolean; begin Result := nil; found := False; firstU := nil; lastU := nil; for I := 0 to fUnits.Count - 1 do begin U := fUnits[I]; if (U = nil) or U.IsDeadOrDying or (U.UnitType <> aUnitType) or not U.Visible then Continue; // Just find any first unit if (aStartFromUID = 0) then Exit(U); lastU := U; if U.UID = aStartFromUID then found := True // Mark that we found our unit else if found then Exit(U) // Save the next unit after Found to Result and Break else if firstU = nil then firstU := U; // Save 1st unit in list in case our unit is the last one end; if found then // Found should be always True here begin if firstU = nil then //Could happen, when we have only 1 unit with that type... Result := lastU else Result := firstU; end; end; function TKMHand.GetNextGroupWSameType(aUnitType: TKMUnitType; aStartFromUID: Integer): TKMUnitGroup; var I: Integer; group, firstG, lastG: TKMUnitGroup; found: Boolean; begin Result := nil; found := False; firstG := nil; lastG := nil; for I := 0 to UnitGroups.Count - 1 do begin group := UnitGroups[I]; if (group = nil) or group.IsDead //check if group is dead or not group.HasUnitType(aUnitType) then // we are interested in groups with the same type only Continue; //Just find any first house if (aStartFromUID = 0) then begin Result := group; Break; end; lastG := group; if group.UID = aStartFromUID then found := True // Mark that we found our group else if found then begin Result := group; // Save the next group after Found to Result and Break Break; end else if firstG = nil then firstG := group; // Save 1st group in list in case our group is the last one end; if (Result = nil) and found then // Found should be always True here begin if firstG = nil then //Could happen, when we have only 1 group with that type... Result := lastG else Result := firstG; end; end; procedure TKMHand.SetHandIndex(aNewIndex: TKMHandID); begin fID := aNewIndex; fUnits.OwnerUpdate(aNewIndex); fHouses.OwnerUpdate(aNewIndex); fAI.OwnerUpdate(aNewIndex); end; procedure TKMHand.SetHandType(const Value: TKMHandType); begin fHandType := Value; end; procedure TKMHand.SetOverlayTextFont(aFont: TKMFont); begin fOverlayTextSettings.Font := aFont; end; procedure TKMHand.SetOverlayTextWordWrap(aWordWrap: Boolean); begin fOverlayTextSettings.WordWrap := aWordWrap; end; procedure TKMHand.SetOwnerNickname(const aName: AnsiString); //MP owner nickname (empty in SP) begin fOwnerNickname := aName; end; procedure TKMHand.AddRoad(const aLoc: TKMPoint); begin gTerrain.SetRoad(aLoc, fID); end; procedure TKMHand.AddField(const aLoc: TKMPoint; aFieldType: TKMFieldType; aStage: Byte = 0; aKeepOldObject: Boolean = False; aRemoveOverlay: Boolean = True); var isFieldSet: Boolean; obj: Word; begin isFieldSet := False; obj := gTerrain.Land^[aLoc.Y,aLoc.X].Obj; //If we have corn/wine object on that tile, set appropriate field/wine stage if (aFieldType = ftCorn) and not gTerrain.TileIsCornField(aLoc) then begin if ObjectIsCorn(obj) then begin gTerrain.SetField(aLoc, fID, aFieldType, obj - 54, True, aKeepOldObject, aRemoveOverlay); isFieldSet := True; end; end else if (aFieldType = ftWine) and not gTerrain.TileIsWineField(aLoc) then begin if ObjectIsWine(obj) then begin gTerrain.SetField(aLoc, fID, aFieldType, obj - 54, True, aKeepOldObject, aRemoveOverlay); isFieldSet := True; end; end; if not isFieldSet then gTerrain.SetField(aLoc, fID, aFieldType, aStage, True, aKeepOldObject, aRemoveOverlay); end; function TKMHand.LocHasNoAllyPlans(const aLoc: TKMPoint): Boolean; var I: Integer; begin Result := True; //Don't allow placing on allies plans either for I := 0 to gHands.Count - 1 do if (I <> fID) and (fAlliances[I] = atAlly) then Result := Result and (gHands[i].fConstructions.FieldworksList.HasField(aLoc) = ftNone) and not gHands[i].fConstructions.HousePlanList.HasPlan(aLoc); end; function TKMHand.GetGameFlagColor: Cardinal; begin Result := fFlagColor; if gGame = nil then Exit; case gGameSettings.PlayersColorMode of pcmAllyEnemy: begin if ID = gMySpectator.HandID then Result := gGameSettings.PlayerColorSelf else if (Alliances[gMySpectator.HandID] = atAlly) then Result := gGameSettings.PlayerColorAlly else Result := gGameSettings.PlayerColorEnemy; end; pcmTeams: Result := fTeamColor; end; end; function TKMHand.GetOwnerNicknameU: UnicodeString; begin Result := UnicodeString(fOwnerNickname); end; function TKMHand.IsDisabled: Boolean; begin Result := not Enabled; end; //See comment on CanAddFakeFieldPlan function TKMHand.CanAddFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType): Boolean; begin Result := gTerrain.CanAddField(aLoc.X, aLoc.Y, aFieldType) and (fConstructions.FieldworksList.HasField(aLoc) = ftNone) and not fConstructions.HousePlanList.HasPlan(aLoc) and LocHasNoAllyPlans(aLoc); end; //This differs from above only in that it uses HasFakeField instead of HasField. //We need it because the user expects to be blocked by fake field plans, but the gameplay should not. //When the result effects the outcome of the game, the above function should be used instead. function TKMHand.CanAddFakeFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType): Boolean; begin Result := gTerrain.CanAddField(aLoc.X, aLoc.Y, aFieldType) and (fConstructions.FieldworksList.HasFakeField(aLoc) = ftNone) and not fConstructions.HousePlanList.HasPlan(aLoc) and LocHasNoAllyPlans(aLoc); end; // Same as for CanAddFakeFieldPlan, but check can we delete plan function TKMHand.CanRemFakeFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType): Boolean; begin Result := (fConstructions.FieldworksList.HasFakeField(aLoc) = aFieldType) and LocHasNoAllyPlans(aLoc); end; function TKMHand.CanAddHousePlan(const aLoc: TKMPoint; aHouseType: TKMHouseType): Boolean; var I, K, J, S, T, Tx, Ty: Integer; HA: TKMHouseArea; begin Result := gTerrain.CanPlaceHouse(aLoc, aHouseType); if not Result then Exit; HA := gRes.Houses[aHouseType].BuildArea; for I := 1 to 4 do for K := 1 to 4 do if HA[I,K] <> 0 then begin Tx := aLoc.X - gRes.Houses[aHouseType].EntranceOffsetX + K - 3; Ty := aLoc.Y + I - 4; //AI ignores FOW (this function is used from scripting) Result := Result and gTerrain.TileInMapCoords(Tx, Ty, 1) and (IsComputer or (NeedToChooseFirstStorehouseInGame and fFogOfWar.CheckTileInitialRevelation(Tx, Ty)) //Use initial revelation for first storehouse or (not NeedToChooseFirstStorehouseInGame and (fFogOfWar.CheckTileRevelation(Tx, Ty) > 0))); //This checks below require Tx;Ty to be within the map so exit immediately if they are not if not Result then exit; //This tile must not contain fields/houses of allied players or self for J := 0 to gHands.Count - 1 do if fAlliances[J] = atAlly then begin Result := Result and (gHands[J].fConstructions.FieldworksList.HasField(KMPoint(Tx,Ty)) = ftNone); //Surrounding tiles must not be a house for S := -1 to 1 do for T := -1 to 1 do Result := Result and not gHands[J].fConstructions.HousePlanList.HasPlan(KMPoint(Tx+S,Ty+T)); end; end; end; function TKMHand.CanAddHousePlanAI(aX, aY: Word; aHouseType: TKMHouseType; aCheckInfluence: Boolean): Boolean; var I, K, J, S, T, Tx, Ty: Integer; HA: TKMHouseArea; enterOff: ShortInt; terOwner: TKMHandID; begin Result := False; //Check if we can place house on terrain, this also makes sure the house is //at least 1 tile away from map border (skip that below) if not gTerrain.CanPlaceHouse(KMPoint(aX, aY), aHouseType) then Exit; //Perform additional cheks for AI HA := gRes.Houses[aHouseType].BuildArea; enterOff := gRes.Houses[aHouseType].EntranceOffsetX; for I := 1 to 4 do for K := 1 to 4 do if HA[I,K] <> 0 then begin Tx := aX + K - 3 - enterOff; Ty := aY + I - 4; //Make sure we don't block existing roads if gTerrain.CheckPassability(KMPoint(Tx, Ty), tpWalkRoad) then Exit; //Check with influence maps if aCheckInfluence and FEAT_AI_GENERATE_INFLUENCE then begin //Check if tile's blocked if (gAIFields.Influences.AvoidBuilding[Ty, Tx] > 0) then Exit; //Check ownership for entrance (good enough since it does not changes that fast) if (HA[I,K] = 2) then begin terOwner := gAIFields.Influences.GetBestOwner(Tx,Ty); if ((terOwner <> fID) and (terOwner <> HAND_NONE)) then Exit; end; end; //Avoid placing houses in choke-points _/house\_ by checking upper corners if not (aHouseType in [htGoldMine, htIronMine]) then if (gTerrain.Land^[Ty-1, Tx - 1].Passability * [tpMakeRoads, tpWalkRoad] = []) or (gTerrain.Land^[Ty-1, Tx + 1].Passability * [tpMakeRoads, tpWalkRoad] = []) then Exit; //Make sure we can add road below house, full width + 1 on each side //Terrain already checked we are 1 tile away from map edge if (I = 4) and not (aHouseType in [htGoldMine, htIronMine]) then if (gTerrain.Land^[Ty+1, Tx - 1].Passability * [tpMakeRoads, tpWalkRoad] = []) or (gTerrain.Land^[Ty+1, Tx ].Passability * [tpMakeRoads, tpWalkRoad] = []) or (gTerrain.Land^[Ty+1, Tx + 1].Passability * [tpMakeRoads, tpWalkRoad] = []) then Exit; //This tile must not contain fields/houseplans of allied players or self for J := 0 to gHands.Count - 1 do if fAlliances[J] = atAlly then begin if (gHands[J].fConstructions.FieldworksList.HasField(KMPoint(Tx,Ty)) <> ftNone) then Exit; //Surrounding tiles must not be a house for S := -1 to 1 do for T := -1 to 1 do if gHands[J].fConstructions.HousePlanList.HasPlan(KMPoint(Tx+S,Ty+T)) then Exit; end; end; Result := True; end; //Due to lag there could be already plans placed by user in previous ticks //Check if Plan can be placed once again, as we might have conflicting commands caused by lag //This is called by GIP when a place field command is processed procedure TKMHand.ToggleFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType; aMakeSound: Boolean); var plan: TKMFieldType; begin Assert(aFieldType in [ftRoad, ftCorn, ftWine], 'Placing wrong FieldType'); plan := fConstructions.FieldworksList.HasField(aLoc); if aFieldType = plan then //Same plan - remove it RemFieldPlan(aLoc,aMakeSound) else if CanAddFieldPlan(aLoc, aFieldType) then begin if aMakeSound and not gGameParams.IsReplayOrSpectate and (ID = gMySpectator.HandID) then gSoundPlayer.Play(sfxPlacemarker); fConstructions.FieldworksList.AddField(aLoc, aFieldType); case aFieldType of ftRoad: gScriptEvents.ProcPlanRoadPlaced(fID, aLoc.X, aLoc.Y); ftCorn: gScriptEvents.ProcPlanFieldPlaced(fID, aLoc.X, aLoc.Y); ftWine: gScriptEvents.ProcPlanWinefieldPlaced(fID, aLoc.X, aLoc.Y); else raise Exception.Create('Unknown aFieldType'); end; end else begin if aMakeSound and not gGameParams.IsReplayOrSpectate and (ID = gMySpectator.HandID) then gSoundPlayer.Play(sfxCantPlace, 4); if plan = ftNone then //If we can't build because there's some other plan, that's ok begin //Can't build here anymore because something changed between click and command processing, so remove any fake plans fConstructions.FieldworksList.RemFakeField(aLoc); fConstructions.FieldworksList.RemFakeDeletedField(aLoc); end; end; end; //This procedure does not effect gameplay, it only changes fake field plans to make it look better for the user //It is called when the user clicks to place a field plan procedure TKMHand.ToggleFakeFieldPlan(const aLoc: TKMPoint; aFieldType: TKMFieldType); var plan: TKMFieldType; begin Assert(aFieldType in [ftRoad, ftCorn, ftWine], 'Placing wrong fake FieldType'); plan := fConstructions.FieldworksList.HasFakeField(aLoc); if aFieldType = plan then //Same plan - remove it begin fConstructions.FieldworksList.RemFakeField(aLoc); //Remove our fake marker which is shown to the user fConstructions.FieldworksList.AddFakeDeletedField(aLoc); //This will hide the real field until it is deleted from game if ID = gMySpectator.HandID then gSoundPlayer.Play(sfxClick); end else if CanAddFakeFieldPlan(aLoc, aFieldType) then begin fConstructions.FieldworksList.AddFakeField(aLoc, aFieldType); if ID = gMySpectator.HandID then gSoundPlayer.Play(sfxPlacemarker); end else if ID = gMySpectator.HandID then gSoundPlayer.Play(sfxCantPlace, 4); end; //Used mainly for testing purposes {procedure TKMHand.AddRoadConnect(LocA,LocB: TKMPoint); var NodeList: TKMPointList; RoadExists: Boolean; I: Integer; begin NodeList := TKMPointList.Create; try RoadExists := fTerrain.PathFinding.Route_Make(LocA, LocB, CanMakeRoads, 0, nil, NodeList); if RoadExists then for I := 1 to NodeList.Count do AddField(NodeList.List[i], ftRoad); finally FreeAndNil(NodeList); end; end;} function TKMHand.AddHouse(aHouseType: TKMHouseType; PosX, PosY: Word; RelativeEntrace: Boolean): TKMHouse; begin Result := fHouses.AddHouse(aHouseType, PosX, PosY, fID, RelativeEntrace); Result.OnDestroyed := HouseDestroyed; end; //Add plan of a house, house is not created until after worker flattens the terrain procedure TKMHand.AddHousePlan(aHouseType: TKMHouseType; const aLoc: TKMPoint); var loc: TKMPoint; begin loc.X := aLoc.X - gRes.Houses[aHouseType].EntranceOffsetX; loc.Y := aLoc.Y; fConstructions.HousePlanList.AddPlan(aHouseType, loc); fStats.HousePlanned(aHouseType); gScriptEvents.EventHousePlanPlaced(fID, loc.X, loc.Y, aHouseType); if (ID = gMySpectator.HandID) and not gGameParams.IsReplayOrSpectate then gSoundPlayer.Play(sfxPlacemarker); end; function TKMHand.HasHousePlan(const aLoc: TKMPoint): Boolean; begin Result := fConstructions.HousePlanList.HasPlan(aLoc); end; function TKMHand.AddHouseWIP(aHouseType: TKMHouseType; const aLoc: TKMPoint): TKMHouse; begin Result := fHouses.AddHouseWIP(aHouseType, aLoc.X, aLoc.Y, fID); Result.OnDestroyed := HouseDestroyed; fStats.HouseStarted(aHouseType); end; //Player wants to remove own house procedure TKMHand.RemHouse(const Position: TKMPoint; DoSilent: Boolean; IsEditor: Boolean = False); var H: TKMHouse; begin //Sound is handled in Demolish H := fHouses.HitTest(Position.X, Position.Y); if H = nil then Exit; //Due to network delays the house might have already been destroyed by now H.Demolish(fID, IsEditor); end; procedure TKMHand.RemHousePlan(const Position: TKMPoint); var hPlan: TKMHousePlan; begin if not fConstructions.HousePlanList.TryGetPlan(Position, hPlan) then //Due to network delays house might not exist now Exit; fConstructions.HousePlanList.RemPlan(Position); fStats.HousePlanRemoved(hPlan.HouseType); gScriptEvents.EventHousePlanRemoved(fID, hPlan.Loc.X, hPlan.Loc.Y, hPlan.HouseType); if (ID = gMySpectator.HandID) and not gGameParams.IsReplayOrSpectate then gSoundPlayer.Play(sfxClick); end; //This is called by the GIP when an erase command is processed procedure TKMHand.RemFieldPlan(const Position: TKMPoint; aMakeSound: Boolean); var fieldType: TKMFieldType; begin fieldType := fConstructions.FieldworksList.HasField(Position); if fieldType = ftNone then Exit; //Can happen due to network delays fConstructions.FieldworksList.RemFieldPlan(Position); case fieldType of ftRoad: gScriptEvents.ProcPlanRoadRemoved(fID, Position.X, Position.Y); ftCorn: gScriptEvents.ProcPlanFieldRemoved(fID, Position.X, Position.Y); ftWine: gScriptEvents.ProcPlanWinefieldRemoved(fID, Position.X, Position.Y); else raise Exception.Create('Unknown fieldType'); end; if aMakeSound and not gGameParams.IsReplayOrSpectate and (ID = gMySpectator.HandID) then gSoundPlayer.Play(sfxClick); end; function TKMHand.RemGroup(const Position: TKMPoint): Boolean; var group: TKMUnitGroup; begin Assert(gGameParams.IsMapEditor); group := fUnitGroups.HitTest(Position.X, Position.Y); Result := group <> nil; if Result then fUnitGroups.RemGroup(group); end; //This is called immediately when the user clicks erase on a field plan. //We know that an erase command is queued and will be processed in some ticks, //so we AddFakeDeletedField which lets the user think the field was removed, //while the game does not know the difference. procedure TKMHand.RemFakeFieldPlan(const Position: TKMPoint); begin fConstructions.FieldworksList.RemFakeField(Position); //Remove our fake marker which is shown to the user fConstructions.FieldworksList.AddFakeDeletedField(Position); //This will hide the real field until it is deleted from game if ID = gMySpectator.HandID then gSoundPlayer.Play(sfxClick); end; function TKMHand.FindHouse(aType: TKMHouseType; const aPosition: TKMPoint; Index: Byte=1): TKMHouse; begin Result := fHouses.FindHouse(aType, aPosition.X, aPosition.Y, Index); end; // Very rough but fast way to find approximate city center function TKMHand.FindCityCenter: TKMPoint; const IMPORTANT_HOUSES: array[0..4] of TKMHouseType = (htStore, htInn, htSchool, htBarracks, htTownhall); var I: Integer; H: TKMHouse; begin for I := 0 to High(IMPORTANT_HOUSES) do begin H := FindHouse(IMPORTANT_HOUSES[I]); if (H <> nil) and not H.IsDestroyed then Exit(H.Entrance); end; // Very rough approach. We suggest there will be at least 1 of the important houses 99.99% of times // Find any house then for I := 0 to fHouses.Count - 1 do begin H := fHouses[I]; if (H <> nil) and not H.IsDestroyed then Exit(H.Entrance); end; end; function TKMHand.FindHouse(aType: TKMHouseType; Index: Byte=1): TKMHouse; begin Result := fHouses.FindHouse(aType, 0, 0, Index); end; function TKMHand.FindHousesInRadius(const aLoc: TKMPoint; aSqrRadius: Single; aTypes: TKMHouseTypeSet = HOUSES_VALID; aOnlyCompleted: Boolean = True): TKMHouseArray; begin Result := fHouses.FindHousesInRadius(aLoc, aSqrRadius, aTypes, aOnlyCompleted); end; function TKMHand.FindInn(Loc: TKMPoint; aUnit: TKMUnit; UnitIsAtHome: Boolean = False): TKMHouseInn; var H: TKMHouseInn; I: Integer; dist, bestMatch: Single; begin //This function will return the best inn for a unit at Loc, base on distance, food available and space available. //Will return nil if no suitable inn is available Result := nil; I := 1; bestMatch := MaxSingle; if UnitIsAtHome then Inc(Loc.Y); //From outside the door of the house H := TKMHouseInn(FindHouse(htInn)); repeat //First make sure that it is valid if (H <> nil) and H.HasFood and H.HasSpace and aUnit.CanWalkTo(Loc, H.PointBelowEntrance, tpWalk, 0) then begin //Take the closest inn out of the ones that are suitable dist := KMLengthSqr(H.Position, Loc); if dist < bestMatch then begin Result := H; bestMatch := dist; end; end; inc(I); H := TKMHouseInn(FindHouse(htInn, I)); until(H = nil); end; //Does the player has any assets (without assets player is harmless) function TKMHand.HasAssets: Boolean; begin if Self = nil then Exit(False); Result := (Houses.Count > 0) or (Units.Count > 0) or (GetFieldsCount > 0) or NeedToChooseFirstStorehouse; //RMG - added ChooseLocation.Allowed option as a valid player end; // usually AIType is added by mission parser procedure TKMHand.AddAIType(aHandAIType: TKMAIType); begin Include(fCanBeAITypes, aHandAIType); AI.CanBeAITypes := fCanBeAITypes; end; procedure TKMHand.PostLoadMission; var I: Integer; begin if (Self = nil) or not Enabled then Exit; for I := 0 to fHouses.Count - 1 do fHouses[I].PostLoadMission; end; function TKMHand.HitTest(X, Y: Integer): TObject; var H: TKMHouse; U: TKMUnit; G: TKMUnitGroup; begin //Houses have priority over units, so you can't select an occupant //Selection priority is as follows: //BuiltHouses > UnitGroups > Units > IncompleteHouses H := HousesHitTest(X,Y); if (H <> nil) and (H.BuildingState in [hbsStone, hbsDone]) then Result := H else begin G := GroupsHitTest(X,Y); if (G <> nil) then Result := G else begin U := UnitsHitTest(X,Y); if (U <> nil) and (not U.IsDeadOrDying) then Result := U else Result := H; //Incomplete house or nil end; end; end; // Some entity was destroyed, but gMySpectator could have pointer to this entity, we have to nil it then procedure TKMHand.EntityDestroyed(aEntity: TKMHandEntity); begin //gMySpectator is nil during loading, when houses can be destroyed at the start if gMySpectator = nil then Exit; if gMySpectator.Selected = aEntity then gMySpectator.Selected := nil; if gMySpectator.LastSelected = aEntity then gMySpectator.NilLastSelected; if gMySpectator.Highlight = aEntity then gMySpectator.Highlight := nil; if gMySpectator.HighlightDebug.Entity = aEntity then gMySpectator.HighlightDebug.Reset; if gMySpectator.HighlightDebug2.Entity = aEntity then gMySpectator.HighlightDebug2.Reset; if gMySpectator.HighlightDebug3.Entity = aEntity then gMySpectator.HighlightDebug3.Reset; if gMySpectator.HighlightRoute.Entity = aEntity then gMySpectator.HighlightRoute.Reset; end; //Which house whas destroyed and by whom procedure TKMHand.HouseDestroyed(aHouse: TKMHouse; aFrom: TKMHandID); begin //Dispose of delivery tasks performed in DeliverQueue unit if aHouse.BuildingState in [hbsWood .. hbsDone] then begin Deliveries.Queue.RemAllOffers(aHouse); Deliveries.Queue.RemDemand(aHouse); end; //Only Done houses are treated as Self-Destruct, Lost, Destroyed if aHouse.BuildingState in [hbsNoGlyph .. hbsStone] then begin fStats.HouseEnded(aHouse.HouseType); // Mark houses BuildEnded only for houses where ready to build if aHouse.IsReadyToBeBuilt then fStats.HouseBuildEnded(aHouse.HouseType); end else begin //We have to consider destroyed closed house as actually opened, otherwise closed houses stats will be corrupted if aHouse.IsClosedForWorker and not gGameParams.IsMapEditor then fStats.HouseClosed(False, aHouse.HouseType); //Distribute honors if aFrom = fID then fStats.HouseSelfDestruct(aHouse.HouseType) else begin Stats.HouseLost(aHouse.HouseType); if aFrom <> HAND_NONE then gHands[aFrom].Stats.HouseDestroyed(aHouse.HouseType); end; end; //Scripting events happen AFTER updating statistics gScriptEvents.ProcHouseDestroyed(aHouse, aFrom); EntityDestroyed(aHouse); end; function TKMHand.HousesHitTest(X, Y: Integer): TKMHouse; begin Result:= fHouses.HitTest(X, Y); end; function TKMHand.GroupsHitTest(X, Y: Integer): TKMUnitGroup; begin Result:= fUnitGroups.HitTest(X, Y); end; function TKMHand.ObjectByUID(aUID: Integer): TObject; var I: Integer; begin Result := nil; for I := 0 to Units.Count - 1 do if aUID = Units[I].UID then begin Result := Units[I]; Exit; end; end; function TKMHand.GetColorIndex: Byte; var I: Integer; begin Result := 3; //3 = Black which can be the default when a non-palette 32 bit color value is used for I := 0 to 255 do if gRes.Palettes.DefaultPalette.Color32(I) = fFlagColor then Result := I; end; function TKMHand.GetDeliveries: TKMHandLogistics; begin if Self = nil then Exit(nil); Result := fDeliveries; end; function TKMHand.CalcOwnerName: UnicodeString; var numberedAIs: Boolean; begin numberedAIs := not gGameParams.IsSingleplayer; //Default names if IsHuman then Result := gResTexts[TX_PLAYER_YOU] else if AI.Setup.NewAI then begin if numberedAIs then Result := Format(gResTexts[TX_ADVANCED_AI_PLAYER_SHORT_X], [fID + 1]) else Result := gResTexts[TX_AI_PLAYER_ADVANCED_SHORT]; end else begin if numberedAIs then Result := Format(gResTexts[TX_CLASSIC_AI_PLAYER_SHORT_X], [fID + 1]) else Result := gResTexts[TX_AI_PLAYER_CLASSIC_SHORT]; end; //Try to take player name from mission text if we are in SP //Do not use names in MP to avoid confusion of AI players with real player nicknames if gGameParams.Mode in [gmSingle, gmCampaign, gmMapEd, gmReplaySingle] then if gGame.TextMission.HasHandNameText(fID) then if IsHuman then Result := gResTexts[TX_PLAYER_YOU] + ' (' + gGame.TextMission.GetHandNameText(fID) + ')' else Result := gGame.TextMission.GetHandNameText(fID); //If this location is controlled by an MP player - show his nik if (fOwnerNickname <> '') and IsHuman then Result := UnicodeString(fOwnerNickname); end; function TKMHand.OwnerName(aNumberedAIs: Boolean = True; aLocalized: Boolean = True): UnicodeString; begin Result := GetHandOwnerName(IsHuman, AI.Setup.NewAI, aNumberedAIs, aLocalized); end; function TKMHand.GetHandOwnerName(aIsHuman, aIsAdvAI: Boolean; aNumberedAIs: Boolean = True; aLocalized: Boolean = True): UnicodeString; function GetText(aId: Word; aLocalized: Boolean): UnicodeString; inline; begin if aLocalized then Result := gResTexts[aId] else Result := gResTexts.DefaultTexts[aId]; end; begin //If this location is controlled by an MP player - show his nik if (fOwnerNickname <> '') and aIsHuman then //we could ask AI to play on ex human loc, so fOwnerNickname will be still some human name Exit(UnicodeString(fOwnerNickname)); //Try to take player name from mission text if we are in SP //Do not use names in MP to avoid confusion of AI players with real player nicknames if (gGameParams.Mode in [gmSingle, gmCampaign, gmMapEd, gmReplaySingle]) and gGame.TextMission.HasHandNameText(fID) then begin if aIsHuman then Result := GetText(TX_PLAYER_YOU, aLocalized) + ' (' + gGame.TextMission.GetHandNameText(fID) + ')' else Result := gGame.TextMission.GetHandNameText(fID); Exit; end; //Default names if aIsHuman then Result := GetText(TX_PLAYER_YOU, aLocalized) else if aIsAdvAI then begin if aNumberedAIs then Result := Format(GetText(TX_ADVANCED_AI_PLAYER_SHORT_X, aLocalized), [fID + 1]) else Result := GetText(TX_AI_PLAYER_ADVANCED_SHORT, aLocalized); end else begin if aNumberedAIs then Result := Format(GetText(TX_CLASSIC_AI_PLAYER_SHORT_X, aLocalized), [fID + 1]) else Result := GetText(TX_AI_PLAYER_CLASSIC_SHORT, aLocalized); end; end; function TKMHand.GetOwnerName: UnicodeString; begin Result := OwnerName(not gGameParams.IsSingleplayer); end; function TKMHand.GetOwnerNameColored: AnsiString; begin Result := WrapColorA(AnsiString(GetOwnerName), FlagColorToTextColor(FlagColor)); end; function TKMHand.GetOwnerNameColoredU: UnicodeString; begin Result := WrapColor(GetOwnerName, FlagColorToTextColor(FlagColor)); end; function TKMHand.GetAI: TKMHandAI; begin if Self = nil then Exit(nil); Result := fAI; end; function TKMHand.GetAlliances(aIndex: Integer): TKMAllianceType; begin Result := fAlliances[aIndex]; end; procedure TKMHand.SetAlliances(aIndex: Integer; aValue: TKMAllianceType); begin if Self = nil then Exit; fAlliances[aIndex] := aValue; gAIFields.Supervisor.UpdateAlliances(); if Assigned(fOnAllianceChange) then fOnAllianceChange; end; procedure TKMHand.SetEnabled(const Value: Boolean); begin fEnabled := Value; end; procedure TKMHand.SetFlagColor(const Value: Cardinal); begin if Self = nil then Exit; fFlagColor := Value; end; function TKMHand.GetShareFOW(aIndex: Integer): Boolean; begin Result := fShareFOW[aIndex]; end; procedure TKMHand.SetShareFOW(aIndex: Integer; aValue: Boolean); begin if Self = nil then Exit; fShareFOW[aIndex] := aValue; end; function TKMHand.GetShareBeacons(aIndex: Integer): Boolean; begin Result := fShareBeacons[aIndex]; end; procedure TKMHand.SetShareBeacons(aIndex: Integer; aValue: Boolean); begin if Self = nil then Exit; fShareBeacons[aIndex] := aValue; end; { See if player owns any Fields/Roads/Walls (has any assets on Terrain) If Player has none and no Units/Houses we can assume it's empty and does not needs to be saved Queried by MapEditor.SaveDAT; Might also be used to show Players strength (or builder/warrior balance) in Tavern } function TKMHand.GetFieldsCount: Integer; var I, K: Integer; begin Result := 0; for I := 1 to gTerrain.MapY do for K := 1 to gTerrain.MapX do if gTerrain.Land^[I,K].TileOwner = fID then Inc(Result); end; function TKMHand.GetFlagTextColor: Cardinal; begin Result := FlagColorToTextColor(fFlagColor); end; procedure TKMHand.GetFieldPlans(aList: TKMPointTagList; const aRect: TKMRect; aIncludeFake: Boolean); var I: TKMHandID; begin //Include self and allies for I := 0 to gHands.Count - 1 do if gHands[fID].Alliances[I] = atAlly then gHands[I].Constructions.FieldworksList.GetFields(aList, aRect, aIncludeFake); end; procedure TKMHand.GetHousePlans(aList: TKMPointDirList; const aRect: TKMRect); var I: TKMHandID; begin //Include self and allies for I := 0 to gHands.Count - 1 do if gHands[fID].Alliances[I] = atAlly then gHands[I].Constructions.HousePlanList.GetOutlines(aList, aRect); end; procedure TKMHand.GetPlansTablets(aList: TKMPointTagList; const aRect: TKMRect); var I: TKMHandID; begin //Include self and allies for I := 0 to gHands.Count - 1 do if gHands[fID].Alliances[I] = atAlly then gHands[I].Constructions.HousePlanList.GetTablets(aList, aRect); end; procedure TKMHand.GetHouseMarks(const aLoc: TKMPoint; aHouseType: TKMHouseType; aList: TKMPointTagList; aIgnoreFOW: Boolean = False); //Replace existing icon with a Block procedure BlockPoint(const aPoint: TKMPoint; aID: Integer); var I: Integer; begin //Remove all existing marks on this tile (entrance can have 2 entries) for I := aList.Count - 1 downto 0 do if KMSamePoint(aList[I], aPoint) then aList.Remove(aPoint); aList.Add(aPoint, aID); end; var I, K, J, S, T: Integer; P2: TKMPoint; allowBuild: Boolean; HA: TKMHouseArea; begin //Get basic Marks gTerrain.GetHouseMarks(aLoc, aHouseType, aList); //Override marks if there are House/FieldPlans (only we know about our plans) and or FogOfWar HA := gRes.Houses[aHouseType].BuildArea; for I := 1 to 4 do for K := 1 to 4 do if (HA[I,K] <> 0) and gTerrain.TileInMapCoords(aLoc.X + K - 3 - gRes.Houses[aHouseType].EntranceOffsetX, aLoc.Y + I - 4, 1) then begin //This can't be done earlier since values can be off-map P2 := KMPoint(aLoc.X + K - 3 - gRes.Houses[aHouseType].EntranceOffsetX, aLoc.Y + I - 4); //Forbid planning on unrevealed areas and fieldplans allowBuild := aIgnoreFOW or (NeedToChooseFirstStorehouseInGame and fFogOfWar.CheckTileInitialRevelation(P2.X, P2.Y)) //Use initial revelation for first storehouse or (not NeedToChooseFirstStorehouseInGame and (fFogOfWar.CheckTileRevelation(P2.X, P2.Y) > 0)); //This tile must not contain fields/houses of allied players or self if allowBuild then for J := 0 to gHands.Count - 1 do if (gHands[fID].Alliances[J] = atAlly) and ((gHands[J].fConstructions.FieldworksList.HasField(P2) <> ftNone) or gHands[J].fConstructions.HousePlanList.HasPlan(P2)) then allowBuild := False; //Check surrounding tiles in +/- 1 range for other houses pressence for S := -1 to 1 do for T := -1 to 1 do if (S <> 0) or (T <> 0) then //This is a surrounding tile, not the actual tile for J := 0 to gHands.Count - 1 do if (gHands[fID].Alliances[J] = atAlly) and gHands[J].fConstructions.HousePlanList.HasPlan(KMPoint(P2.X + S, P2.Y + T)) then begin BlockPoint(KMPoint(P2.X + S, P2.Y + T), TC_BLOCK); //Block surrounding points allowBuild := False; end; //Mark the tile according to previous check results if not allowBuild then if HA[I,K] = 2 then BlockPoint(P2, TC_BLOCK_ENTRANCE) else if aHouseType in [htGoldMine, htIronMine] then BlockPoint(P2, TC_BLOCK_MINE) else BlockPoint(P2, TC_BLOCK); end; end; procedure TKMHand.Save(SaveStream: TKMemoryStream); begin SaveStream.PlaceMarker('Hand'); SaveStream.Write(fEnabled); SaveStream.Write(InCinematic); if not Enabled then Exit; inherited; fAI.Save(SaveStream); fConstructions.Save(SaveStream); fDeliveries.Save(SaveStream); fFogOfWar.Save(SaveStream); fHouses.Save(SaveStream); fLocks.Save(SaveStream); fStats.Save(SaveStream); fUnitGroups.Save(SaveStream); fMessageLog.Save(SaveStream); SaveStream.Write(fID); SaveStream.WriteA(fOwnerNickname); SaveStream.Write(fHandType, SizeOf(fHandType)); SaveStream.Write(fCanBeHuman, SizeOf(fCanBeHuman)); SaveStream.Write(fCanBeAITypes, SizeOf(fCanBeAITypes)); SaveStream.Write(fAlliances, SizeOf(fAlliances)); SaveStream.Write(fShareFOW, SizeOf(fShareFOW)); SaveStream.Write(fShareBeacons, SizeOf(fShareBeacons)); SaveStream.Write(fCenterScreen); SaveStream.Write(fFlagColor); SaveStream.Write(fTeam); SaveStream.Write(SelectionHotkeys, SizeOf(SelectionHotkeys)); SaveStream.Write(fChooseLocation, SizeOf(TKMChooseLoc)); // Overlay SaveStream.WriteA(fOverlayMarkup); SaveStream.Write(fOverlayTextSettings, SizeOf(fOverlayTextSettings)); fOverlayParams.Save(SaveStream); end; procedure TKMHand.Load(LoadStream: TKMemoryStream); begin LoadStream.CheckMarker('Hand'); LoadStream.Read(fEnabled); LoadStream.Read(InCinematic); if not Enabled then Exit; inherited; fAI.Load(LoadStream); fConstructions.Load(LoadStream); fDeliveries.Load(LoadStream); fFogOfWar.Load(LoadStream); fHouses.Load(LoadStream); fLocks.Load(LoadStream); fStats.Load(LoadStream); fUnitGroups.Load(LoadStream); fMessageLog.Load(LoadStream); LoadStream.Read(fID); LoadStream.ReadA(fOwnerNickname); LoadStream.Read(fHandType, SizeOf(fHandType)); LoadStream.Read(fCanBeHuman, SizeOf(fCanBeHuman)); LoadStream.Read(fCanBeAITypes, SizeOf(fCanBeAITypes)); LoadStream.Read(fAlliances, SizeOf(fAlliances)); LoadStream.Read(fShareFOW, SizeOf(fShareFOW)); LoadStream.Read(fShareBeacons, SizeOf(fShareBeacons)); LoadStream.Read(fCenterScreen); LoadStream.Read(fFlagColor); LoadStream.Read(fTeam); LoadStream.Read(SelectionHotkeys, SizeOf(SelectionHotkeys)); LoadStream.Read(fChooseLocation, SizeOf(TKMChooseLoc)); // Overlay LoadStream.ReadA(fOverlayMarkup); LoadStream.Read(fOverlayTextSettings, SizeOf(fOverlayTextSettings)); fOverlayParams.Clear; fOverlayParams.Load(LoadStream); end; procedure TKMHand.SyncLoad; var I: Integer; begin if not Enabled then Exit; inherited; //Assign event handler after load for I := 0 to fUnits.Count - 1 do begin fUnits[I].OnUnitDied := UnitDied; fUnits[I].OnUnitTrained := UnitTrained; if fUnits[I] is TKMUnitWarrior then TKMUnitWarrior(fUnits[I]).OnWarriorWalkOut := WarriorWalkedOut; end; fUnitGroups.SyncLoad; //Assign event handler after load for I := 0 to fUnitGroups.Count - 1 do fUnitGroups[I].OnGroupDied := GroupDied; fHouses.SyncLoad; //Assign event handler after load for I := 0 to fHouses.Count - 1 do fHouses[I].OnDestroyed := HouseDestroyed; fDeliveries.SyncLoad; fConstructions.SyncLoad; fAI.SyncLoad; end; procedure TKMHand.IncAnimStep; begin if not Enabled then Exit; fHouses.IncAnimStep; end; procedure TKMHand.UnitDied(aUnit: TKMUnit); begin Stats.UnitLost(aUnit.UnitType); if aUnit.KilledBy <> HAND_NONE then gHands[aUnit.KilledBy].Stats.UnitKilled(aUnit.UnitType); //Demands: food for soldiers / stone or wood for workers Deliveries.Queue.RemDemand(aUnit); if aUnit is TKMUnitWarrior then AI.General.WarriorDied(TKMUnitWarrior(aUnit)); //Call script event after updating statistics gScriptEvents.ProcUnitDied(aUnit, aUnit.KilledBy); EntityDestroyed(aUnit); end; procedure TKMHand.GroupDied(aGroup: TKMUnitGroup); begin EntityDestroyed(aGroup); end; procedure TKMHand.UpdateState(aTick: Cardinal); begin if not Enabled then Exit; //Player has to place first storehouse at some point or will be defeated if NeedToChooseFirstStorehouse and (aTick > TIME_TO_SET_FIRST_STOREHOUSE) then AI.Defeat; //Update Groups logic before Units fUnitGroups.UpdateState; inherited; fHouses.UpdateState(aTick); fFogOfWar.UpdateState(gGameParams.DynamicFOW); //We might optimize it for AI somehow, to make it work coarse and faster //Distribute AI updates among different Ticks to avoid slowdowns if (aTick mod gHands.Count) = fID then begin fConstructions.UpdateState; fDeliveries.UpdateState(aTick); end; //AI update takes care of it's own interleaving, so run it every tick fAI.UpdateState(aTick, gHands.DoCheckGoals); //if (aTick + Byte(fPlayerIndex)) mod 20 = 0 then //fArmyEval.UpdateState; if CanDoStatsUpdate(aTick) then fStats.UpdateState; if not gGameParams.IsMapEditor //Do not place first storehouse in map editor etc and fChooseLocation.Allowed and not fChooseLocation.Placed then ChooseFirstStorehouse(); end; function TKMHand.NeedToChooseFirstStorehouse: Boolean; begin Result := fChooseLocation.Allowed and not fChooseLocation.Placed; end; function TKMHand.NeedToChooseFirstStorehouseInGame: Boolean; begin Result := not gGameParams.IsMapEditor and NeedToChooseFirstStorehouse; end; procedure TKMHand.ChooseFirstStorehouse(); var I: Integer; entrance: TKMPoint; begin if IsComputer then fChooseLocation.Placed := True // Check if storehouse has been placed else if (Stats.GetHouseTotal(htStore) > 0) then begin for I := 0 to fConstructions.HousePlanList.Count - 1 do with fConstructions.HousePlanList.Plans[I] do if (HouseType = htStore) then begin entrance := KMPointAdd( Loc, KMPoint(gRes.Houses[HouseType].EntranceOffsetX,0) ); RemHousePlan(entrance); if CanAddFieldPlan(KMPoint(entrance.X, entrance.Y+1), ftRoad) then AddFirstStorehouse(entrance); end; end; // Preselect storehouse if not gGameParams.IsReplayOrSpectate and (gMySpectator.HandID = ID) and not fChooseLocation.Placed then begin gCursor.Mode := cmHouses; gCursor.Tag1 := Byte(htStore); end; end; procedure TKMHand.AddFirstStorehouse(aEntrance: TKMPoint); // Place road and return True if it is possible function AddRoad(aPoint: TKMPoint): Boolean; begin Result := CanAddFieldPlan(KMPoint(aPoint.X, aPoint.Y), ftRoad); if Result then begin gTerrain.SetRoad(aPoint, fID); //Terrain under roads is flattened (fields are not) gTerrain.FlattenTerrain(aPoint); if gMapElements[gTerrain.Land^[aPoint.Y,aPoint.X].Obj].WineOrCorn then gTerrain.RemoveObject(aPoint); end; end; var I: Integer; H: TKMHouse; WT: TKMWareType; UT: TKMUnitType; begin // Add Storehouse H := AddHouse(htStore, aEntrance.X, aEntrance.Y, True); // Add Wares for WT := Low(fChooseLocation.Resources) to High(fChooseLocation.Resources) do if H.WareCanAddToIn(WT) OR H.WareCanAddToOut(WT) then begin Stats.WareInitial(WT, fChooseLocation.Resources[WT]); H.WareAddToEitherFromScript(WT, fChooseLocation.Resources[WT]); end; // Add Roads AddRoad( KMPoint(aEntrance.X, aEntrance.Y+1) ); AddRoad( KMPoint(aEntrance.X-1,aEntrance.Y+1) ); AddRoad( KMPoint(aEntrance.X+1,aEntrance.Y+1) ); // Add Units for UT := Low(fChooseLocation.Units) to High(fChooseLocation.Units) do for I := 0 to fChooseLocation.Units[UT] - 1 do AddUnit(UT, KMPoint(aEntrance.X,aEntrance.Y+1)); // Finish action fChooseLocation.Placed := True; gCursor.Mode := cmNone; // Reset cursor end; function TKMHand.CanDoStatsUpdate(aTick: Cardinal): Boolean; begin Result := (aTick mod GetStatsUpdatePeriod = 0) or (aTick = 1); end; function TKMHand.DoCheckGoals: Boolean; begin Result := not fChooseLocation.Allowed or (fChooseLocation.Allowed and fChooseLocation.Placed); end; procedure TKMHand.Paint(const aRect: TKMRect; aTickLag: Single); begin if not Enabled then Exit; inherited; if mlUnits in gGameParams.VisibleLayers then fUnitGroups.Paint(aRect, aTickLag); if mlHouses in gGameParams.VisibleLayers then fHouses.Paint(aRect); if not SKIP_RENDER AND OVERLAY_DEFENCES AND not fAI.Setup.NewAI then if gMySpectator.SelectedHandID = fID then fAI.General.DefencePositions.Paint; if not SKIP_RENDER AND fAI.Setup.NewAI then begin if OVERLAY_AI_BUILD then begin fAI.CityManagement.Builder.Paint(); fAI.CityManagement.Builder.Planner.Paint(); end; if OVERLAY_AI_COMBAT then fAI.ArmyManagement.Paint(); end; end; function TKMHand.ObjToString(aSeparator: String = ' '): String; begin Result := Format('Enabled = %5s%sID = %d%sAI: [%s]%sOwner = %s%sHandType = %s', [BoolToStr(Enabled, True), aSeparator, fID, aSeparator, AI.ObjToString, aSeparator, OwnerName, aSeparator, GetEnumName(TypeInfo(TKMHandType), Integer(fHandType))]); end; { TKMHandAnimals } function TKMHandAnimals.GetFishInWaterBody(aWaterID: Byte; FindHighestCount: Boolean = True): TKMUnitFish; var I, highestGroupCount: Integer; U: TKMUnit; begin Result := nil; if aWaterID = 0 then Exit; //Fish should always be in valid water highestGroupCount := 0; for I := 0 to fUnits.Count - 1 do begin U := fUnits[I]; //Store locally if (U <> nil) and (U.UnitType = utFish) and not U.IsDeadOrDying //Fish are killed when they are caught or become stuck and (gTerrain.Land^[U.Position.Y, U.Position.X].WalkConnect[wcFish] = aWaterID) and (TKMUnitFish(U).FishCount > highestGroupCount) then begin Result := TKMUnitFish(U); //This is for time saving when we don't actually care which group is returned if not FindHighestCount then Exit; highestGroupCount := Result.FishCount; end; end; end; //----------- function GetStatsUpdatePeriod: Integer; begin Result := 1000; case gGameParams.MissionMode of mmBuilding: Result := CHARTS_SAMPLING_FOR_ECONOMY; mmFighting: Result := CHARTS_SAMPLING_FOR_TACTICS; end; end; end.