Changeset 522
- Timestamp:
- Jan 7, 2024, 10:24:51 PM (12 months ago)
- Location:
- trunk
- Files:
-
- 16 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/AI/StdAI/AI.pas
r486 r522 624 624 begin 625 625 Inc(I); 626 if random(I) = 0 then626 if Random(I) = 0 then 627 627 Result := ad; 628 628 end; … … 1188 1188 begin 1189 1189 if (Data.LastResearchTech = adHorsebackRiding) and (RO.ResearchTech < 0) and 1190 ( random(6) = 0) and (HavePort or (ContinentPresence[0] and not1190 (Random(6) = 0) and (HavePort or (ContinentPresence[0] and not 1191 1191 (1 shl Me or PresenceUnknown) <> 0)) then 1192 1192 begin … … 2109 2109 begin 2110 2110 Inc(BestCount); 2111 if random(BestCount) = 0 then2111 if Random(BestCount) = 0 then 2112 2112 begin 2113 2113 AttackScore := TestScore; … … 2250 2250 begin 2251 2251 Inc(BestCount); 2252 if random(BestCount) = 0 then2252 if Random(BestCount) = 0 then 2253 2253 begin 2254 2254 PatrolScore := TestScore; … … 2406 2406 begin 2407 2407 Inc(Count); 2408 if random(Count) = 0 then2408 if Random(Count) = 0 then 2409 2409 Result := mix; 2410 2410 end; -
trunk/AI/StdAI/Barbarina.pas
r486 r522 762 762 begin 763 763 Inc(BestCount); 764 if random(BestCount) = 0 then764 if Random(BestCount) = 0 then 765 765 begin 766 766 PatrolScore := TestScore; … … 888 888 var 889 889 I, F, uix, Loc1, A, B: Integer; 890 ready, go: Boolean;890 Ready, Go: Boolean; 891 891 TransportPlan: TGroupTransportPlan; 892 892 begin 893 go := False;893 Go := False; 894 894 for F := 0 to maxCOD - 1 do 895 895 if (F < nContinent) and (ContinentPresence[F] and not 896 896 (1 shl Me or PresenceUnknown) <> 0) then 897 go := True; // any enemy island known?898 if not go then897 Go := True; // any enemy island known? 898 if not Go then 899 899 Exit; 900 900 901 901 SeaTransport_BeginInitialize; 902 go := False;902 Go := False; 903 903 for uix := 0 to RO.nUn - 1 do 904 904 if not Moved[uix] then … … 915 915 end; 916 916 end; 917 if go then917 if Go then 918 918 begin 919 go := False;919 Go := False; 920 920 for uix := 0 to RO.nUn - 1 do 921 921 if not Moved[uix] then … … 928 928 end; 929 929 end; 930 if go then930 if Go then 931 931 for Loc1 := 0 to MapSize - 1 do 932 932 if Map[Loc1] and fTerrain >= fGrass then … … 941 941 begin 942 942 Moved[TransportPlan.uixTransport] := True; 943 ready := MyUnit[TransportPlan.uixTransport].Loc = TransportPlan.LoadLoc;944 if not ready then943 Ready := MyUnit[TransportPlan.uixTransport].Loc = TransportPlan.LoadLoc; 944 if not Ready then 945 945 begin 946 946 Unit_MoveEx(TransportPlan.uixTransport, TransportPlan.LoadLoc); 947 ready := MyUnit[TransportPlan.uixTransport].Loc = TransportPlan.LoadLoc;948 end; 949 if ready then947 Ready := MyUnit[TransportPlan.uixTransport].Loc = TransportPlan.LoadLoc; 948 end; 949 if Ready then 950 950 for I := 0 to TransportPlan.nLoad - 1 do 951 951 begin 952 952 Loc_to_ab(TransportPlan.LoadLoc, 953 953 MyUnit[TransportPlan.uixLoad[I]].Loc, A, B); 954 ready := ready and (abs(A) <= 1) and (abs(B) <= 1);955 end; 956 if ready then954 Ready := Ready and (Abs(A) <= 1) and (Abs(B) <= 1); 955 end; 956 if Ready then 957 957 begin 958 958 for I := 0 to TransportPlan.nLoad - 1 do … … 1646 1646 begin 1647 1647 Inc(nPreq); 1648 if random(nPreq) = 0 then1648 if Random(nPreq) = 0 then 1649 1649 ChosenPreq := ad; 1650 1650 end; … … 1736 1736 I := 0; 1737 1737 while (I < nResearchOrder) and (not NeedSeaUnits and (ResearchOrder[I] < 0) or 1738 IsResearched( abs(ResearchOrder[I]))) do1738 IsResearched(Abs(ResearchOrder[I]))) do 1739 1739 Inc(I); 1740 1740 if I >= nResearchOrder then // list done, continue with future tech 1741 1741 begin 1742 if random(2) = 1 then1742 if Random(2) = 1 then 1743 1743 Result := futArtificialIntelligence 1744 1744 else … … 1750 1750 nPreq := 0; 1751 1751 ChosenPreq := -1; 1752 ChoosePreq( abs(ResearchOrder[I]));1752 ChoosePreq(Abs(ResearchOrder[I])); 1753 1753 Assert(nPreq > 0); 1754 1754 Result := ChosenPreq; -
trunk/AI/StdAI/CustomAI.pas
r447 r522 246 246 procedure ab_to_V8(A, B: Integer; var V8: Integer); 247 247 begin 248 Assert(( abs(A) <= 1) and (abs(B) <= 1) and ((A <> 0) or (B <> 0)));248 Assert((Abs(A) <= 1) and (Abs(B) <= 1) and ((A <> 0) or (B <> 0))); 249 249 V8 := ab_v8[2 * B + B + A]; 250 250 end; … … 373 373 begin 374 374 Loc_to_ab(Loc0, Loc1, A, B); 375 dx := abs(A - B); 376 dy := abs(A + B); 377 Result := dx + dy + abs(dx - dy) shr 1; 378 end; 379 375 dx := Abs(A - B); 376 dy := Abs(A + B); 377 Result := dx + dy + Abs(dx - dy) shr 1; 378 end; 380 379 381 380 procedure Init(NewGameData: TNewGameData); … … 392 391 {$ENDIF} 393 392 end; 394 395 393 396 394 constructor TCustomAI.Create(Nation: Integer); … … 410 408 Server(sSetDebugMap, Me, 0, nodata^); 411 409 end; 412 413 410 414 411 procedure TCustomAI.Process(Command: Integer; var Data); … … 495 492 begin 496 493 Inc(Count); 497 if random(Count) = 0 then494 if Random(Count) = 0 then 498 495 NewResearch := ad; 499 496 end; … … 623 620 begin 624 621 Inc(Count); 625 if random(Count) = 0 then622 if Random(Count) = 0 then 626 623 Steal := ad; 627 624 end; … … 1109 1106 end; 1110 1107 1111 1112 1108 // negotiation 1113 1109 function TCustomAI.Nego_CheckMyAction: Integer; … … 1122 1118 end; 1123 1119 1124 1125 1120 initialization 1126 1121 nodata := Pointer(0); -
trunk/AI/StdAI/CustomAI_Reload.pas
r447 r522 5 5 6 6 uses 7 {$IFDEF DEBUG}SysUtils,{$ENDIF} 7 {$IFDEF DEBUG}SysUtils,{$ENDIF}// necessary for debug exceptions 8 8 Protocol; 9 9 10 10 type 11 TNegoTime=(BeginOfTurn, EndOfTurn, EnemyCalled); 12 13 TCustomAI=class 14 public 15 procedure Process(Command: Integer; var Data); 16 17 // overridables 18 constructor Create(Nation: Integer); virtual; 19 destructor Destroy; override; 20 procedure SetDataDefaults; virtual; 21 procedure SetDataRandom; virtual; 22 procedure OnBeforeEnemyAttack(UnitInfo: TUnitInfo; 23 ToLoc, EndHealth, EndHealthDef: Integer); virtual; 24 procedure OnBeforeEnemyCapture(UnitInfo: TUnitInfo; ToLoc: Integer); virtual; 25 procedure OnAfterEnemyAttack; virtual; 26 procedure OnAfterEnemyCapture; virtual; 27 28 protected 29 Me: Integer; // index of the controlled nation 30 RO: ^TPlayerContext; 31 Map: ^TTileList; 32 MyUnit: ^TUnList; 33 MyCity: ^TCityList; 34 MyModel: ^TModelList; 35 36 cixStateImp: array[imPalace..imSpacePort] of Integer; 37 38 // negotiation 39 Opponent: Integer; // nation i'm in negotiation with, -1 indicates no-negotiation mode 40 MyAction, MyLastAction, OppoAction: Integer; 41 MyOffer, MyLastOffer, OppoOffer: TOffer; 42 43 // overridables 44 procedure DoTurn; virtual; 45 procedure DoNegotiation; virtual; 46 function ChooseResearchAdvance: Integer; virtual; 47 function ChooseStealAdvance: Integer; virtual; 48 function ChooseGovernment: Integer; virtual; 49 function WantNegotiation(Nation: Integer; NegoTime: TNegoTime): Boolean; virtual; 50 function OnNegoRejected_CancelTreaty: Boolean; virtual; 51 52 // general functions 53 function IsResearched(Advance: Integer): Boolean; 54 function ResearchCost: Integer; 55 function ChangeAttitude(Nation, Attitude: Integer): Integer; 56 function Revolution: Integer; 57 function ChangeRates(Tax,Lux: Integer): Integer; 58 function PrepareNewModel(Domain: Integer): Integer; 59 function SetNewModelFeature(F, Count: Integer): Integer; 60 function AdvanceResearchable(Advance: Integer): Boolean; 61 function AdvanceStealable(Advance: Integer): Boolean; 62 function DebugMessage(Level: Integer; Text: string): Boolean; 63 function SetDebugMap(var DebugMap): Boolean; 64 65 // unit functions 66 procedure Unit_FindMyDefender(Loc: Integer; var uix: Integer); 67 procedure Unit_FindEnemyDefender(Loc: Integer; var euix: Integer); 68 function Unit_Move(uix,ToLoc: Integer): Integer; 69 function Unit_Step(uix,ToLoc: Integer): Integer; 70 function Unit_Attack(uix,ToLoc: Integer): Integer; 71 function Unit_DoMission(uix,MissionType,ToLoc: Integer): Integer; 72 function Unit_MoveForecast(uix,ToLoc: Integer; var RemainingMovement: Integer): Boolean; 73 function Unit_AttackForecast(uix,ToLoc,AttackMovement: Integer; var RemainingHealth: Integer): Boolean; 74 function Unit_DefenseForecast(euix,ToLoc: Integer; var RemainingHealth: Integer): Boolean; 75 function Unit_Disband(uix: Integer): Integer; 76 function Unit_StartJob(uix,NewJob: Integer): Integer; 77 function Unit_SetHomeHere(uix: Integer): Integer; 78 function Unit_Load(uix: Integer): Integer; 79 function Unit_Unload(uix: Integer): Integer; 80 function Unit_AddToCity(uix: Integer): Integer; 81 82 // city functions 83 procedure City_FindMyCity(Loc: Integer; var cix: Integer); 84 procedure City_FindEnemyCity(Loc: Integer; var ecix: Integer); 85 function City_HasProject(cix: Integer): Boolean; 86 function City_CurrentImprovementProject(cix: Integer): Integer; 87 function City_CurrentUnitProject(cix: Integer): Integer; 88 function City_GetTileInfo(cix,TileLoc: Integer; var TileInfo: TTileInfo): Integer; 89 function City_GetReport(cix: Integer; var Report: TCityReport): Integer; 90 function City_GetHypoReport(cix, HypoTiles, HypoTax, HypoLux: Integer; var Report: TCityReport): Integer; 91 function City_GetAreaInfo(cix: Integer; var AreaInfo: TCityAreaInfo): Integer; 92 function City_StartUnitProduction(cix,mix: Integer): Integer; 93 function City_StartEmigration(cix,mix: Integer; AllowDisbandCity, AsConscripts: Boolean): Integer; 94 function City_StartImprovement(cix,iix: Integer): Integer; 95 function City_Improvable(cix,iix: Integer): Boolean; 96 function City_StopProduction(cix: Integer): Integer; 97 function City_BuyProject(cix: Integer): Integer; 98 function City_SellImprovement(cix,iix: Integer): Integer; 99 function City_RebuildImprovement(cix,iix: Integer): Integer; 100 function City_SetTiles(cix,NewTiles: Integer): Integer; 101 102 // negotiation 103 function Nego_CheckMyAction: Integer; 104 105 private 106 HaveTurned: Boolean; 107 UnwantedNego: set of 0..nPl-1; 108 Contacted: set of 0..nPl-1; 109 procedure StealAdvance; 110 end; 111 112 113 var 114 Server: TServerCall; 115 G: TNewGameData; 116 RWDataSize, MapSize: Integer; 117 decompose24: Cardinal; 118 nodata: Pointer; 11 TNegoTime = (BeginOfTurn, EndOfTurn, EnemyCalled); 12 13 TCustomAI = class 14 public 15 procedure Process(Command: Integer; var Data); 16 17 // overridables 18 constructor Create(Nation: Integer); virtual; 19 destructor Destroy; override; 20 procedure SetDataDefaults; virtual; 21 procedure SetDataRandom; virtual; 22 procedure OnBeforeEnemyAttack(UnitInfo: TUnitInfo; 23 ToLoc, EndHealth, EndHealthDef: Integer); virtual; 24 procedure OnBeforeEnemyCapture(UnitInfo: TUnitInfo; ToLoc: Integer); virtual; 25 procedure OnAfterEnemyAttack; virtual; 26 procedure OnAfterEnemyCapture; virtual; 27 protected 28 Me: Integer; // index of the controlled nation 29 RO: ^TPlayerContext; 30 Map: ^TTileList; 31 MyUnit: ^TUnList; 32 MyCity: ^TCityList; 33 MyModel: ^TModelList; 34 35 cixStateImp: array[imPalace..imSpacePort] of Integer; 36 37 // negotiation 38 Opponent: Integer; // nation i'm in negotiation with, -1 indicates no-negotiation mode 39 MyAction, MyLastAction, OppoAction: Integer; 40 MyOffer, MyLastOffer, OppoOffer: TOffer; 41 42 // overridables 43 procedure DoTurn; virtual; 44 procedure DoNegotiation; virtual; 45 function ChooseResearchAdvance: Integer; virtual; 46 function ChooseStealAdvance: Integer; virtual; 47 function ChooseGovernment: Integer; virtual; 48 function WantNegotiation(Nation: Integer; NegoTime: TNegoTime): Boolean; virtual; 49 function OnNegoRejected_CancelTreaty: Boolean; virtual; 50 51 // general functions 52 function IsResearched(Advance: Integer): Boolean; 53 function ResearchCost: Integer; 54 function ChangeAttitude(Nation, Attitude: Integer): Integer; 55 function Revolution: Integer; 56 function ChangeRates(Tax, Lux: Integer): Integer; 57 function PrepareNewModel(Domain: Integer): Integer; 58 function SetNewModelFeature(F, Count: Integer): Integer; 59 function AdvanceResearchable(Advance: Integer): Boolean; 60 function AdvanceStealable(Advance: Integer): Boolean; 61 function DebugMessage(Level: Integer; Text: string): Boolean; 62 function SetDebugMap(var DebugMap): Boolean; 63 64 // unit functions 65 procedure Unit_FindMyDefender(Loc: Integer; var uix: Integer); 66 procedure Unit_FindEnemyDefender(Loc: Integer; var euix: Integer); 67 function Unit_Move(uix, ToLoc: Integer): Integer; 68 function Unit_Step(uix, ToLoc: Integer): Integer; 69 function Unit_Attack(uix, ToLoc: Integer): Integer; 70 function Unit_DoMission(uix, MissionType, ToLoc: Integer): Integer; 71 function Unit_MoveForecast(uix, ToLoc: Integer; 72 var RemainingMovement: Integer): Boolean; 73 function Unit_AttackForecast(uix, ToLoc, AttackMovement: Integer; 74 var RemainingHealth: Integer): Boolean; 75 function Unit_DefenseForecast(euix, ToLoc: Integer; 76 var RemainingHealth: Integer): Boolean; 77 function Unit_Disband(uix: Integer): Integer; 78 function Unit_StartJob(uix, NewJob: Integer): Integer; 79 function Unit_SetHomeHere(uix: Integer): Integer; 80 function Unit_Load(uix: Integer): Integer; 81 function Unit_Unload(uix: Integer): Integer; 82 function Unit_AddToCity(uix: Integer): Integer; 83 84 // city functions 85 procedure City_FindMyCity(Loc: Integer; var cix: Integer); 86 procedure City_FindEnemyCity(Loc: Integer; var ecix: Integer); 87 function City_HasProject(cix: Integer): Boolean; 88 function City_CurrentImprovementProject(cix: Integer): Integer; 89 function City_CurrentUnitProject(cix: Integer): Integer; 90 function City_GetTileInfo(cix, TileLoc: Integer; var TileInfo: TTileInfo): Integer; 91 function City_GetReport(cix: Integer; var Report: TCityReport): Integer; 92 function City_GetHypoReport(cix, HypoTiles, HypoTax, HypoLux: Integer; 93 var Report: TCityReport): Integer; 94 function City_GetAreaInfo(cix: Integer; var AreaInfo: TCityAreaInfo): Integer; 95 function City_StartUnitProduction(cix, mix: Integer): Integer; 96 function City_StartEmigration(cix, mix: Integer; 97 AllowDisbandCity, AsConscripts: Boolean): Integer; 98 function City_StartImprovement(cix, iix: Integer): Integer; 99 function City_Improvable(cix, iix: Integer): Boolean; 100 function City_StopProduction(cix: Integer): Integer; 101 function City_BuyProject(cix: Integer): Integer; 102 function City_SellImprovement(cix, iix: Integer): Integer; 103 function City_RebuildImprovement(cix, iix: Integer): Integer; 104 function City_SetTiles(cix, NewTiles: Integer): Integer; 105 106 // negotiation 107 function Nego_CheckMyAction: Integer; 108 private 109 HaveTurned: Boolean; 110 UnwantedNego: set of 0..nPl - 1; 111 Contacted: set of 0..nPl - 1; 112 procedure StealAdvance; 113 end; 114 115 var 116 Server: TServerCall; 117 G: TNewGameData; 118 RWDataSize, MapSize: Integer; 119 decompose24: cardinal; 120 nodata: Pointer; 119 121 120 122 const 121 CityOwnTile = 13; // = ab_to_V21(0,0) 122 123 // additional return codes 124 rLocationReached= $00010000; // Unit_Move: move was not interrupted, location reached 125 rMoreTurns= $00020000; // Unit_Move: move was not interrupted, location not reached yet 123 CityOwnTile = 13; // = ab_to_V21(0,0) 124 125 // additional return codes 126 rLocationReached = $00010000; 127 // Unit_Move: move was not interrupted, location reached 128 rMoreTurns = $00020000; 129 // Unit_Move: move was not interrupted, location not reached yet 126 130 127 131 type 128 TVicinity8Loc=array[0..7] of Integer; 129 TVicinity21Loc=array[0..27] of Integer; 130 132 TVicinity8Loc = array[0..7] of Integer; 133 TVicinity21Loc = array[0..27] of Integer; 131 134 132 135 procedure Init(NewGameData: TNewGameData); 133 136 134 procedure ab_to_Loc(Loc0, A,B: Integer; var Loc: Integer);135 procedure Loc_to_ab(Loc0, Loc: Integer; var A,B: Integer);136 procedure ab_to_V8(A, B: Integer; var V8: Integer);137 procedure V8_to_ab(V8: Integer; var A, B: Integer);138 procedure ab_to_V21(A, B: Integer; var V21: Integer);139 procedure V21_to_ab(V21: Integer; var A, B: Integer);137 procedure ab_to_Loc(Loc0, A, B: Integer; var Loc: Integer); 138 procedure Loc_to_ab(Loc0, Loc: Integer; var A, B: Integer); 139 procedure ab_to_V8(A, B: Integer; var V8: Integer); 140 procedure V8_to_ab(V8: Integer; var A, B: Integer); 141 procedure ab_to_V21(A, B: Integer; var V21: Integer); 142 procedure V21_to_ab(V21: Integer; var A, B: Integer); 140 143 procedure V8_to_Loc(Loc0: Integer; var VicinityLoc: TVicinity8Loc); 141 144 procedure V21_to_Loc(Loc0: Integer; var VicinityLoc: TVicinity21Loc); … … 145 148 146 149 const 147 ab_v8: array[-4..4] of Integer = (5,6,7,4,-1,0,3,2,1); 148 v8_a: array[0..7] of Integer = (1,1,0,-1,-1,-1,0,1); 149 v8_b: array[0..7] of Integer = (0,1,1,1,0,-1,-1,-1); 150 151 152 procedure ab_to_Loc(Loc0,A,B: Integer; var Loc: Integer); 150 ab_v8: array[-4..4] of Integer = (5, 6, 7, 4, -1, 0, 3, 2, 1); 151 v8_a: array[0..7] of Integer = (1, 1, 0, -1, -1, -1, 0, 1); 152 v8_b: array[0..7] of Integer = (0, 1, 1, 1, 0, -1, -1, -1); 153 154 procedure ab_to_Loc(Loc0, A, B: Integer; var Loc: Integer); 153 155 {relative location from Loc0} 154 156 var 155 y0: Integer;156 begin 157 Assert((Loc0>=0) and (Loc0<MapSize) and (A-B+G.lx>=0));158 y0:=Cardinal(Loc0)*decompose24 shr 24;159 Loc:=(Loc0+(A-B+y0 and 1+G.lx+G.lx) shr 1) mod G.lx +G.lx*(y0+A+B);160 if Loc>=MapSize then Loc:=-$1000 161 end; 162 163 procedure Loc_to_ab(Loc0, Loc: Integer; var A,B: Integer);157 y0: Integer; 158 begin 159 Assert((Loc0 >= 0) and (Loc0 < MapSize) and (A - B + G.lx >= 0)); 160 y0 := cardinal(Loc0) * decompose24 shr 24; 161 Loc := (Loc0 + (A - B + y0 and 1 + G.lx + G.lx) shr 1) mod G.lx + G.lx * (y0 + A + B); 162 if Loc >= MapSize then Loc := -$1000; 163 end; 164 165 procedure Loc_to_ab(Loc0, Loc: Integer; var A, B: Integer); 164 166 {$IFDEF FPC} // freepascal 165 167 var 166 dx,dy: Integer;167 begin 168 dx:=((Loc mod G.lx *2 +Loc div G.lx and 1)169 -(Loc0 mod G.lx *2 +Loc0 div G.lx and 1)+3*G.lx) mod (2*G.lx) -G.lx;170 dy:=Loc div G.lx-Loc0 div G.lx;171 A:=(dx+dy) div 2;172 B:=(dy-dx) div 2;173 end; 174 {$ELSE} 175 register;168 dx, dy: Integer; 169 begin 170 dx := ((Loc mod G.lx * 2 + Loc div G.lx and 1) 171 -(Loc0 mod G.lx * 2 + Loc0 div G.lx and 1) + 3 * G.lx) mod (2 * G.lx) - G.lx; 172 dy := Loc div G.lx - Loc0 div G.lx; 173 A := (dx + dy) div 2; 174 B := (dy - dx) div 2; 175 end; 176 {$ELSE}// delphi 177 register; 176 178 asm 177 push ebx 178 179 // calculate180 push ecx 181 divByte ptr [G]182 xor ebx,ebx 183 mov bl,ah// ebx:=Loc0 mod G.lx184 mov ecx,eax 185 and ecx,$000000FF // ecx:=Loc0 div G.lx186 mov eax,edx 187 divByte ptr [G]188 xor edx,edx 189 mov dl,ah// edx:=Loc mod G.lx190 and eax,$000000FF // eax:=Loc div G.lx191 sub edx,ebx// edx:=Loc mod G.lx-Loc0 mod G.lx192 mov ebx,eax 193 sub ebx,ecx// ebx:=dy194 and eax,1195 and ecx,1196 add edx,edx 197 add eax,edx 198 sub eax,ecx// eax:=dx, not normalized199 pop ecx 200 201 // normalize202 mov edx,dword ptr [G]203 cmp eax,edx 204 jl@A205 sub eax,edx206 sub eax,edx207 jmp@ok208 @A:209 neg edx 210 cmp eax,edx 211 jnl@ok212 sub eax,edx213 sub eax,edx214 215 // return results216 @ok:217 mov edx,ebx 218 sub edx,eax 219 add eax,ebx 220 sar edx,1 // edx:=b221 mov ebx,[B]222 mov [ebx],edx 223 sar eax,1 // eax:=a224 mov [A],eax 225 226 pop ebx 179 PUSH EBX 180 181 // calculate 182 PUSH ECX 183 DIV Byte ptr [G] 184 XOR EBX,EBX 185 MOV BL,AH // ebx:=Loc0 mod G.lx 186 MOV ECX,EAX 187 AND ECX,$000000FF // ecx:=Loc0 div G.lx 188 MOV EAX,EDX 189 DIV Byte ptr [G] 190 XOR EDX,EDX 191 MOV DL,AH // edx:=Loc mod G.lx 192 AND EAX,$000000FF // eax:=Loc div G.lx 193 SUB EDX,EBX // edx:=Loc mod G.lx-Loc0 mod G.lx 194 MOV EBX,EAX 195 SUB EBX,ECX // ebx:=dy 196 AND EAX,1 197 AND ECX,1 198 ADD EDX,EDX 199 ADD EAX,EDX 200 SUB EAX,ECX // eax:=dx, not normalized 201 POP ECX 202 203 // normalize 204 MOV EDX,dword ptr [G] 205 CMP EAX,EDX 206 JL @A 207 SUB EAX,EDX 208 SUB EAX,EDX 209 JMP @ok 210 @A: 211 NEG EDX 212 CMP EAX,EDX 213 JNL @ok 214 SUB EAX,EDX 215 SUB EAX,EDX 216 217 // return results 218 @ok: 219 MOV EDX,EBX 220 SUB EDX,EAX 221 ADD EAX,EBX 222 SAR EDX,1 // edx:=b 223 MOV EBX,[B] 224 MOV [EBX],EDX 225 SAR EAX,1 // eax:=a 226 MOV [A],EAX 227 228 POP EBX 227 229 end; 228 230 {$ENDIF} 229 231 230 procedure ab_to_V8(A,B: Integer; var V8: Integer); 231 begin 232 Assert((abs(A)<=1) and (abs(B)<=1) and ((A<>0) or (B<>0))); 233 V8:=ab_v8[2*B+B+A]; 234 end; 235 236 procedure V8_to_ab(V8: Integer; var A,B: Integer); 237 begin 238 A:=v8_a[V8]; B:=V8_b[V8]; 239 end; 240 241 procedure ab_to_V21(A,B: Integer; var V21: Integer); 242 begin 243 V21:=(A+B+3) shl 2+(A-B+3) shr 1; 244 end; 245 246 procedure V21_to_ab(V21: Integer; var A,B: Integer); 247 var 248 dx,dy: Integer; 249 begin 250 dy:=V21 shr 2-3; 251 dx:=V21 and 3 shl 1 -3 + (dy+3) and 1; 252 A:=(dx+dy) div 2; 253 B:=(dy-dx) div 2; 232 procedure ab_to_V8(A, B: Integer; var V8: Integer); 233 begin 234 Assert((Abs(A) <= 1) and (Abs(B) <= 1) and ((A <> 0) or (B <> 0))); 235 V8 := ab_v8[2 * B + B + A]; 236 end; 237 238 procedure V8_to_ab(V8: Integer; var A, B: Integer); 239 begin 240 A := v8_a[V8]; 241 B := V8_b[V8]; 242 end; 243 244 procedure ab_to_V21(A, B: Integer; var V21: Integer); 245 begin 246 V21 := (A + B + 3) shl 2 + (A - B + 3) shr 1; 247 end; 248 249 procedure V21_to_ab(V21: Integer; var A, B: Integer); 250 var 251 dx, dy: Integer; 252 begin 253 dy := V21 shr 2 - 3; 254 dx := V21 and 3 shl 1 - 3 + (dy + 3) and 1; 255 A := (dx + dy) div 2; 256 B := (dy - dx) div 2; 254 257 end; 255 258 256 259 procedure V8_to_Loc(Loc0: Integer; var VicinityLoc: TVicinity8Loc); 257 260 var 258 x0,y0,lx: Integer;259 begin 260 lx:=G.lx;261 y0:=Cardinal(Loc0)*decompose24 shr 24;262 x0:=Loc0-y0*lx; // Loc0 mod lx;263 VicinityLoc[1]:=Loc0+lx*2;264 VicinityLoc[3]:=Loc0-1;265 VicinityLoc[5]:=Loc0-lx*2;266 VicinityLoc[7]:=Loc0+1;267 Inc(Loc0,y0 and 1);268 VicinityLoc[0]:=Loc0+lx;269 VicinityLoc[2]:=Loc0+lx-1;270 VicinityLoc[4]:=Loc0-lx-1;271 VicinityLoc[6]:=Loc0-lx;272 273 // world is round!274 if x0<lx-1 then261 x0, y0, lx: Integer; 262 begin 263 lx := G.lx; 264 y0 := cardinal(Loc0) * decompose24 shr 24; 265 x0 := Loc0 - y0 * lx; // Loc0 mod lx; 266 VicinityLoc[1] := Loc0 + lx * 2; 267 VicinityLoc[3] := Loc0 - 1; 268 VicinityLoc[5] := Loc0 - lx * 2; 269 VicinityLoc[7] := Loc0 + 1; 270 Inc(Loc0, y0 and 1); 271 VicinityLoc[0] := Loc0 + lx; 272 VicinityLoc[2] := Loc0 + lx - 1; 273 VicinityLoc[4] := Loc0 - lx - 1; 274 VicinityLoc[6] := Loc0 - lx; 275 276 // world is round! 277 if x0 < lx - 1 then 275 278 begin 276 if x0=0 then279 if x0 = 0 then 277 280 begin 278 Inc(VicinityLoc[3],lx); 279 if y0 and 1=0 then 280 begin 281 Inc(VicinityLoc[2],lx); 282 Inc(VicinityLoc[4],lx); 283 end 281 Inc(VicinityLoc[3], lx); 282 if y0 and 1 = 0 then 283 begin 284 Inc(VicinityLoc[2], lx); 285 Inc(VicinityLoc[4], lx); 286 end; 287 end; 288 end 289 else 290 begin 291 Dec(VicinityLoc[7], lx); 292 if y0 and 1 = 1 then 293 begin 294 Dec(VicinityLoc[0], lx); 295 Dec(VicinityLoc[6], lx); 296 end; 297 end; 298 299 // check south pole 300 case G.ly - y0 of 301 1: 302 begin 303 VicinityLoc[0] := -$1000; 304 VicinityLoc[1] := -$1000; 305 VicinityLoc[2] := -$1000; 306 end; 307 2: VicinityLoc[1] := -$1000; 308 end; 309 end; 310 311 procedure V21_to_Loc(Loc0: Integer; var VicinityLoc: TVicinity21Loc); 312 var 313 dx, dy, bit, y0, xComp, yComp, xComp0, xCompSwitch: Integer; 314 dst: ^Integer; 315 begin 316 y0 := cardinal(Loc0) * decompose24 shr 24; 317 xComp0 := Loc0 - y0 * G.lx - 1; // Loc0 mod G.lx -1 318 xCompSwitch := xComp0 - 1 + y0 and 1; 319 if xComp0 < 0 then Inc(xComp0, G.lx); 320 if xCompSwitch < 0 then Inc(xCompSwitch, G.lx); 321 xCompSwitch := xCompSwitch xor xComp0; 322 yComp := G.lx * (y0 - 3); 323 dst := @VicinityLoc; 324 bit := 1; 325 for dy := 0 to 6 do 326 if yComp < MapSize then 327 begin 328 xComp0 := xComp0 xor xCompSwitch; 329 xComp := xComp0; 330 for dx := 0 to 3 do 331 begin 332 if bit and $67F7F76 <> 0 then dst^ := xComp + yComp 333 else 334 dst^ := -1; 335 Inc(xComp); 336 if xComp >= G.lx then Dec(xComp, G.lx); 337 Inc(dst); 338 bit := bit shl 1; 339 end; 340 Inc(yComp, G.lx); 284 341 end 285 end 286 else 287 begin 288 Dec(VicinityLoc[7],lx); 289 if y0 and 1=1 then 342 else 290 343 begin 291 Dec(VicinityLoc[0],lx); 292 Dec(VicinityLoc[6],lx); 293 end 294 end; 295 296 // check south pole 297 case G.ly-y0 of 298 1: 299 begin 300 VicinityLoc[0]:=-$1000; 301 VicinityLoc[1]:=-$1000; 302 VicinityLoc[2]:=-$1000; 344 for dx := 0 to 3 do 345 begin 346 dst^ := -$1000; 347 Inc(dst); 348 end; 303 349 end; 304 2: VicinityLoc[1]:=-$1000; 305 end 306 end; 307 308 procedure V21_to_Loc(Loc0: Integer; var VicinityLoc: TVicinity21Loc); 309 var 310 dx,dy,bit,y0,xComp,yComp,xComp0,xCompSwitch: Integer; 311 dst: ^Integer; 312 begin 313 y0:=Cardinal(Loc0)*decompose24 shr 24; 314 xComp0:=Loc0-y0*G.lx-1; // Loc0 mod G.lx -1 315 xCompSwitch:=xComp0-1+y0 and 1; 316 if xComp0<0 then Inc(xComp0,G.lx); 317 if xCompSwitch<0 then Inc(xCompSwitch,G.lx); 318 xCompSwitch:=xCompSwitch xor xComp0; 319 yComp:=G.lx*(y0-3); 320 dst:=@VicinityLoc; 321 bit:=1; 322 for dy:=0 to 6 do 323 if yComp<MapSize then 324 begin 325 xComp0:=xComp0 xor xCompSwitch; 326 xComp:=xComp0; 327 for dx:=0 to 3 do 328 begin 329 if bit and $67F7F76<>0 then dst^:=xComp+yComp 330 else dst^:=-1; 331 Inc(xComp); 332 if xComp>=G.lx then Dec(xComp, G.lx); 333 Inc(dst); 334 bit:=bit shl 1; 335 end; 336 Inc(yComp,G.lx); 337 end 338 else 339 begin 340 for dx:=0 to 3 do 341 begin dst^:=-$1000; Inc(dst); end; 342 end 343 end; 344 350 end; 345 351 346 352 procedure Init(NewGameData: TNewGameData); 347 353 {$IFDEF DEBUG}var Loc: Integer;{$ENDIF} 348 354 begin 349 G:=NewGameData;350 MapSize:=G.lx*G.ly;351 decompose24:=(1 shl 24-1) div G.lx +1;355 G := NewGameData; 356 MapSize := G.lx * G.ly; 357 decompose24 := (1 shl 24 - 1) div G.lx + 1; 352 358 {$IFDEF DEBUG}for Loc:=0 to MapSize-1 do Assert(Cardinal(Loc)*decompose24 shr 24=Cardinal(Loc div G.lx));{$ENDIF} 353 359 end; 354 360 355 356 361 constructor TCustomAI.Create(Nation: Integer); 357 362 begin 358 inherited Create;359 Me:=Nation;360 RO:=Pointer(G.RO[Nation]);361 Map:=Pointer(RO.Map);362 MyUnit:=Pointer(RO.Un);363 MyCity:=Pointer(RO.City);364 MyModel:=Pointer(RO.Model);365 Opponent:=-1;363 inherited Create; 364 Me := Nation; 365 RO := Pointer(G.RO[Nation]); 366 Map := Pointer(RO.Map); 367 MyUnit := Pointer(RO.Un); 368 MyCity := Pointer(RO.City); 369 MyModel := Pointer(RO.Model); 370 Opponent := -1; 366 371 end; 367 372 368 373 destructor TCustomAI.Destroy; 369 374 begin 370 Server(sSetDebugMap,Me,0,nodata^); 371 end; 372 375 Server(sSetDebugMap, Me, 0, nodata^); 376 end; 373 377 374 378 procedure TCustomAI.Process(Command: Integer; var Data); 375 379 var 376 Nation,NewResearch,NewGov,count,ad,cix,iix: Integer;377 NegoTime: TNegoTime;378 begin 379 case Command of380 cTurn, cContinue:380 Nation, NewResearch, NewGov, Count, ad, cix, iix: Integer; 381 NegoTime: TNegoTime; 382 begin 383 case Command of 384 cTurn, cContinue: 381 385 begin 382 if RO.Alive and (1 shl Me)=0 then386 if RO.Alive and (1 shl Me) = 0 then 383 387 begin // I'm dead, huhu 384 Server(sTurn,Me,0,nodata^);385 Exit388 Server(sTurn, Me, 0, nodata^); 389 Exit; 386 390 end; 387 if Command=cTurn then388 begin 389 FillChar(cixStateImp, SizeOf(cixStateImp), $FF);390 for cix:=0 to RO.nCity-1 do if MyCity[cix].Loc>=0 then391 for iix:=imPalace to imSpacePort do392 if MyCity[cix].Built[iix]>0 then393 cixStateImp[iix]:=cix;394 if RO.Happened and phChangeGov<>0 then391 if Command = cTurn then 392 begin 393 FillChar(cixStateImp, SizeOf(cixStateImp), $FF); 394 for cix := 0 to RO.nCity - 1 do if MyCity[cix].Loc >= 0 then 395 for iix := imPalace to imSpacePort do 396 if MyCity[cix].Built[iix] > 0 then 397 cixStateImp[iix] := cix; 398 if RO.Happened and phChangeGov <> 0 then 395 399 begin 396 NewGov:=ChooseGovernment;397 if NewGov>gAnarchy then398 Server(sSetGovernment,Me,NewGov,nodata^);400 NewGov := ChooseGovernment; 401 if NewGov > gAnarchy then 402 Server(sSetGovernment, Me, NewGov, nodata^); 399 403 end; 400 HaveTurned:=False;401 Contacted:=[];404 HaveTurned := False; 405 Contacted := []; 402 406 end; 403 if (Command=cContinue) and (MyAction=scContact) then404 begin 405 if OnNegoRejected_CancelTreaty then406 if RO.Treaty[Opponent]>=trPeace then407 if Server(sCancelTreaty,Me,0,nodata^)<rExecuted then408 Assert(False)407 if (Command = cContinue) and (MyAction = scContact) then 408 begin 409 if OnNegoRejected_CancelTreaty then 410 if RO.Treaty[Opponent] >= trPeace then 411 if Server(sCancelTreaty, Me, 0, nodata^) < rExecuted then 412 Assert(False); 409 413 end 410 else UnwantedNego:=[]; 411 Opponent:=-1; 412 repeat 413 if HaveTurned then NegoTime:=EndOfTurn 414 else NegoTime:=BeginOfTurn; 415 if RO.Government<>gAnarchy then 416 for Nation:=0 to nPl-1 do 417 if (Nation<>Me) and (1 shl Nation and RO.Alive<>0) 418 and (RO.Treaty[Nation]>=trNone) 419 and not (Nation in Contacted) and not (Nation in UnwantedNego) 420 and (Server(scContact-sExecute + Nation shl 4, Me, 0, nodata^)>=rExecuted) then 421 if WantNegotiation(Nation, NegoTime) then 422 begin 423 if Server(scContact + Nation shl 4, Me, 0, nodata^)>=rExecuted then 424 begin 425 Include(Contacted, Nation); 426 Opponent:=Nation; 427 MyAction:=scContact; 428 Exit; 429 end; 430 end 431 else Include(UnwantedNego,Nation); 432 if NegoTime=BeginOfTurn then 414 else 415 UnwantedNego := []; 416 Opponent := -1; 417 repeat 418 if HaveTurned then NegoTime := EndOfTurn 419 else 420 NegoTime := BeginOfTurn; 421 if RO.Government <> gAnarchy then 422 for Nation := 0 to nPl - 1 do 423 if (Nation <> Me) and (1 shl Nation and RO.Alive <> 0) and 424 (RO.Treaty[Nation] >= trNone) and not (Nation in Contacted) and not 425 (Nation in UnwantedNego) and 426 (Server(scContact - sExecute + Nation shl 4, Me, 0, nodata^) >= rExecuted) then 427 if WantNegotiation(Nation, NegoTime) then 428 begin 429 if Server(scContact + Nation shl 4, Me, 0, nodata^) >= rExecuted then 430 begin 431 Include(Contacted, Nation); 432 Opponent := Nation; 433 MyAction := scContact; 434 Exit; 435 end; 436 end 437 else 438 Include(UnwantedNego, Nation); 439 if NegoTime = BeginOfTurn then 433 440 begin 434 DoTurn;435 HaveTurned:=True;436 Contacted:=[];437 UnwantedNego:=[];441 DoTurn; 442 HaveTurned := True; 443 Contacted := []; 444 UnwantedNego := []; 438 445 end 439 else Break; 440 until False; 441 if RO.Happened and phTech<>0 then 442 begin 443 NewResearch:=ChooseResearchAdvance; 444 if NewResearch<0 then 446 else 447 Break; 448 until False; 449 if RO.Happened and phTech <> 0 then 450 begin 451 NewResearch := ChooseResearchAdvance; 452 if NewResearch < 0 then 445 453 begin // choose random research 446 count:=0; 447 for ad:=0 to nAdv-1 do if AdvanceResearchable(ad) then 448 begin Inc(count); if random(count)=0 then NewResearch:=ad end 454 Count := 0; 455 for ad := 0 to nAdv - 1 do if AdvanceResearchable(ad) then 456 begin 457 Inc(Count); 458 if Random(Count) = 0 then NewResearch := ad; 459 end; 449 460 end; 450 Server(sSetResearch,Me,NewResearch,nodata^)461 Server(sSetResearch, Me, NewResearch, nodata^); 451 462 end; 452 if (Me=1) and (RO.Turn=800) then453 begin 454 count:=0;455 Server(sReload,Me,0,count)463 if (Me = 1) and (RO.Turn = 800) then 464 begin 465 Count := 0; 466 Server(sReload, Me, 0, Count); 456 467 end 457 else if (RO.Turn>10) and (random(1000)=0) then458 begin 459 count:=RO.Turn-10;460 Server(sReload,Me,0,count)468 else if (RO.Turn > 10) and (Random(1000) = 0) then 469 begin 470 Count := RO.Turn - 10; 471 Server(sReload, Me, 0, Count); 461 472 end 462 else if Server(sTurn,Me,0,nodata^)<rExecuted then463 Assert(False);473 else if Server(sTurn, Me, 0, nodata^) < rExecuted then 474 Assert(False); 464 475 end; 465 scContact:466 if WantNegotiation(Integer(Data), EnemyCalled) then467 begin 468 if Server(scDipStart, Me, 0, nodata^)<rExecuted then469 Assert(False);470 Opponent:=Integer(Data);471 MyAction:=scDipStart;476 scContact: 477 if WantNegotiation(Integer(Data), EnemyCalled) then 478 begin 479 if Server(scDipStart, Me, 0, nodata^) < rExecuted then 480 Assert(False); 481 Opponent := Integer(Data); 482 MyAction := scDipStart; 472 483 end 473 else474 begin 475 if Server(scReject, Me, 0, nodata^)<rExecuted then476 Assert(False);484 else 485 begin 486 if Server(scReject, Me, 0, nodata^) < rExecuted then 487 Assert(False); 477 488 end; 478 scDipStart, scDipNotice, scDipAccept, scDipCancelTreaty, scDipOffer, scDipBreak:489 scDipStart, scDipNotice, scDipAccept, scDipCancelTreaty, scDipOffer, scDipBreak: 479 490 begin 480 OppoAction:=Command; 481 if Command=scDipOffer then OppoOffer:=TOffer(Data); 482 MyLastAction:=MyAction; 483 MyLastOffer:=MyOffer; 484 if (OppoAction=scDipCancelTreaty) or (OppoAction=scDipBreak) then 485 MyAction:=scDipNotice 486 else begin MyAction:=scDipOffer; MyOffer.nDeliver:=0; MyOffer.nCost:=0; end; 487 DoNegotiation; 488 Assert((MyAction=scDipNotice) or (MyAction=scDipAccept) 489 or (MyAction=scDipCancelTreaty) or (MyAction=scDipOffer) 490 or (MyAction=scDipBreak)); 491 if MyAction=scDipOffer then Server(MyAction, Me, 0, MyOffer) 492 else Server(MyAction, Me, 0, nodata^); 491 OppoAction := Command; 492 if Command = scDipOffer then OppoOffer := TOffer(Data); 493 MyLastAction := MyAction; 494 MyLastOffer := MyOffer; 495 if (OppoAction = scDipCancelTreaty) or (OppoAction = scDipBreak) then 496 MyAction := scDipNotice 497 else 498 begin 499 MyAction := scDipOffer; 500 MyOffer.nDeliver := 0; 501 MyOffer.nCost := 0; 502 end; 503 DoNegotiation; 504 Assert((MyAction = scDipNotice) or (MyAction = scDipAccept) or 505 (MyAction = scDipCancelTreaty) or (MyAction = scDipOffer) or (MyAction = scDipBreak)); 506 if MyAction = scDipOffer then Server(MyAction, Me, 0, MyOffer) 507 else 508 Server(MyAction, Me, 0, nodata^); 493 509 end; 494 cShowEndContact:495 Opponent:=-1;510 cShowEndContact: 511 Opponent := -1; 496 512 end; 497 513 end; … … 514 530 end; 515 531 516 procedure TCustomAI.OnBeforeEnemyAttack(UnitInfo: TUnitInfo; ToLoc, EndHealth,517 EndHealthDef: Integer);532 procedure TCustomAI.OnBeforeEnemyAttack(UnitInfo: TUnitInfo; 533 ToLoc, EndHealth, EndHealthDef: Integer); 518 534 begin 519 535 end; … … 533 549 function TCustomAI.ChooseResearchAdvance: Integer; 534 550 begin 535 Result:=-1 551 Result := -1; 536 552 end; 537 553 538 554 function TCustomAI.ChooseStealAdvance: Integer; 539 555 begin 540 Result:=-1 556 Result := -1; 541 557 end; 542 558 543 559 function TCustomAI.ChooseGovernment: Integer; 544 560 begin 545 Result:=gDespotism 561 Result := gDespotism; 546 562 end; 547 563 548 564 function TCustomAI.WantNegotiation(Nation: Integer; NegoTime: TNegoTime): Boolean; 549 565 begin 550 Result:=False;566 Result := False; 551 567 end; 552 568 553 569 function TCustomAI.OnNegoRejected_CancelTreaty: Boolean; 554 570 begin 555 Result:=False; 556 end; 571 Result := False; 572 end; 573 557 574 {$HINTS ON} 558 575 559 576 procedure TCustomAI.StealAdvance; 560 577 var 561 Steal, ad, count: Integer;562 begin 563 Steal:=ChooseStealAdvance;564 if Steal<0 then578 Steal, ad, Count: Integer; 579 begin 580 Steal := ChooseStealAdvance; 581 if Steal < 0 then 565 582 begin // choose random advance 566 count:=0; 567 for ad:=0 to nAdv-1 do if AdvanceStealable(ad) then 568 begin Inc(count); if random(count)=0 then Steal:=ad end 569 end; 570 if Steal>=0 then Server(sStealTech,Me,Steal,nodata^); 571 RO.Happened:=RO.Happened and not phStealTech 583 Count := 0; 584 for ad := 0 to nAdv - 1 do if AdvanceStealable(ad) then 585 begin 586 Inc(Count); 587 if Random(Count) = 0 then Steal := ad; 588 end; 589 end; 590 if Steal >= 0 then Server(sStealTech, Me, Steal, nodata^); 591 RO.Happened := RO.Happened and not phStealTech; 572 592 end; 573 593 574 594 function TCustomAI.IsResearched(Advance: Integer): Boolean; 575 595 begin 576 Result:= RO.Tech[Advance]>=tsApplicable 596 Result := RO.Tech[Advance] >= tsApplicable; 577 597 end; 578 598 579 599 function TCustomAI.ResearchCost: Integer; 580 600 begin 581 Server(sGetTechCost,Me,0,Result) 601 Server(sGetTechCost, Me, 0, Result); 582 602 end; 583 603 584 604 function TCustomAI.ChangeAttitude(Nation, Attitude: Integer): Integer; 585 605 begin 586 Result:=Server(sSetAttitude+Nation shl 4,Me,Attitude,nodata^) 606 Result := Server(sSetAttitude + Nation shl 4, Me, Attitude, nodata^); 587 607 end; 588 608 589 609 function TCustomAI.Revolution: Integer; 590 610 begin 591 Result:=Server(sRevolution,Me,0,nodata^);592 end; 593 594 function TCustomAI.ChangeRates(Tax, Lux: Integer): Integer;595 begin 596 Result:=Server(sSetRates,Me,Tax div 10 and $F+Lux div 10 and $F shl 4,nodata^) 611 Result := Server(sRevolution, Me, 0, nodata^); 612 end; 613 614 function TCustomAI.ChangeRates(Tax, Lux: Integer): Integer; 615 begin 616 Result := Server(sSetRates, Me, Tax div 10 and $F + Lux div 10 and $F shl 4, nodata^); 597 617 end; 598 618 599 619 function TCustomAI.PrepareNewModel(Domain: Integer): Integer; 600 620 begin 601 Result:=Server(sCreateDevModel,Me,Domain,nodata^);621 Result := Server(sCreateDevModel, Me, Domain, nodata^); 602 622 end; 603 623 604 624 function TCustomAI.SetNewModelFeature(F, Count: Integer): Integer; 605 625 begin 606 Result:=Server(sSetDevModelCap+Count shl 4,Me,F,nodata^) 626 Result := Server(sSetDevModelCap + Count shl 4, Me, F, nodata^); 607 627 end; 608 628 609 629 function TCustomAI.AdvanceResearchable(Advance: Integer): Boolean; 610 630 begin 611 Result:= Server(sSetResearch-sExecute,Me,Advance,nodata^)>=rExecuted;631 Result := Server(sSetResearch - sExecute, Me, Advance, nodata^) >= rExecuted; 612 632 end; 613 633 614 634 function TCustomAI.AdvanceStealable(Advance: Integer): Boolean; 615 635 begin 616 Result:= Server(sStealTech-sExecute,Me,Advance,nodata^)>=rExecuted;636 Result := Server(sStealTech - sExecute, Me, Advance, nodata^) >= rExecuted; 617 637 end; 618 638 619 639 function TCustomAI.DebugMessage(Level: Integer; Text: string): Boolean; 620 640 begin 621 Text:=Copy('P'+char(48+Me)+' '+Text,1,254);622 Server(sMessage,Me,Level,PChar(Text)^);623 624 Result:=True;641 Text := Copy('P' + char(48 + Me) + ' ' + Text, 1, 254); 642 Server(sMessage, Me, Level, PChar(Text)^); 643 644 Result := True; 625 645 // always returns true so that it can be used like 626 646 // "assert(DebugMessage(...));" -> not compiled in release build … … 629 649 function TCustomAI.SetDebugMap(var DebugMap): Boolean; 630 650 begin 631 Server(sSetDebugMap, Me, 0, DebugMap);632 633 Result:=True;651 Server(sSetDebugMap, Me, 0, DebugMap); 652 653 Result := True; 634 654 // always returns true so that it can be used like 635 655 // "assert(SetDebugMap(...));" -> not compiled in release build … … 638 658 procedure TCustomAI.Unit_FindMyDefender(Loc: Integer; var uix: Integer); 639 659 begin 640 if Server(sGetDefender,Me,Loc,uix)<rExecuted then uix:=-1 660 if Server(sGetDefender, Me, Loc, uix) < rExecuted then uix := -1; 641 661 end; 642 662 643 663 procedure TCustomAI.Unit_FindEnemyDefender(Loc: Integer; var euix: Integer); 644 664 begin 645 euix:=RO.nEnemyUn-1;646 while (euix>=0) and (RO.EnemyUn[euix].Loc<>Loc) do647 Dec(euix);648 end; 649 650 function TCustomAI.Unit_Move(uix, ToLoc: Integer): Integer;651 var 652 Step: Integer;653 DestinationReached: Boolean;654 Advice: TMoveAdviceData;655 begin 656 Assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0)); // is a unit665 euix := RO.nEnemyUn - 1; 666 while (euix >= 0) and (RO.EnemyUn[euix].Loc <> Loc) do 667 Dec(euix); 668 end; 669 670 function TCustomAI.Unit_Move(uix, ToLoc: Integer): Integer; 671 var 672 Step: Integer; 673 DestinationReached: Boolean; 674 Advice: TMoveAdviceData; 675 begin 676 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0)); // is a unit 657 677 {Loc_to_ab(MyUnit[uix].Loc,ToLoc,a,b); 658 678 Assert((A<>0) or (B<>0)); … … 669 689 else} 670 690 begin // move to non-adjacent tile, find shortest path 671 Advice.ToLoc:=ToLoc;672 Advice.MoreTurns:=9999;673 Advice.MaxHostile_MovementLeft:=100;674 Result:=Server(sGetMoveAdvice,Me,uix,Advice);675 end; 676 if Result=eOk then691 Advice.ToLoc := ToLoc; 692 Advice.MoreTurns := 9999; 693 Advice.MaxHostile_MovementLeft := 100; 694 Result := Server(sGetMoveAdvice, Me, uix, Advice); 695 end; 696 if Result = eOk then 677 697 begin 678 DestinationReached:=False; 679 Step:=0; 680 repeat 681 if Result and (rExecuted or rUnitRemoved)=rExecuted then // check if destination reached 682 if (ToLoc>=0) and (Advice.MoreTurns=0) and (Step=Advice.nStep-1) 683 and ((Map[ToLoc] and (fUnit or fOwned)=fUnit) // attack 684 or (Map[ToLoc] and (fCity or fOwned)=fCity) 685 and ((MyModel[MyUnit[uix].mix].Domain<>dGround) // bombardment 686 or (MyModel[MyUnit[uix].mix].Flags and mdCivil<>0))) then // can't capture 687 begin DestinationReached:=True; Break end // stop next to destination 688 else if Step=Advice.nStep then 689 DestinationReached:=True; // normal move -- stop at destination 690 691 if (Step=Advice.nStep) or (Result<>eOK) and (Result<>eLoaded) then 692 Break; 693 694 Result:=Server(sMoveUnit+(Advice.dx[Step] and 7) shl 4 +(Advice.dy[Step] and 7) shl 7, 695 Me,uix,nodata^); 696 Inc(Step); 697 if RO.Happened and phStealTech<>0 then StealAdvance; 698 until False; 699 if DestinationReached then 700 if Advice.nStep=25 then 701 Result:=Unit_Move(uix,ToLoc) // Shinkansen 702 else if Advice.MoreTurns=0 then 703 Result:=Result or rLocationReached 704 else Result:=Result or rMoreTurns; 698 DestinationReached := False; 699 Step := 0; 700 repeat 701 if Result and (rExecuted or rUnitRemoved) = rExecuted then 702 // check if destination reached 703 if (ToLoc >= 0) and (Advice.MoreTurns = 0) and (Step = Advice.nStep - 1) and 704 ((Map[ToLoc] and (fUnit or fOwned) = fUnit) // attack 705 or (Map[ToLoc] and (fCity or fOwned) = fCity) and 706 ((MyModel[MyUnit[uix].mix].Domain <> dGround) // bombardment 707 or (MyModel[MyUnit[uix].mix].Flags and mdCivil <> 0))) then // can't capture 708 begin 709 DestinationReached := True; 710 Break; 711 end // stop next to destination 712 else if Step = Advice.nStep then 713 DestinationReached := True; // normal move -- stop at destination 714 715 if (Step = Advice.nStep) or (Result <> eOK) and (Result <> eLoaded) then 716 Break; 717 718 Result := Server(sMoveUnit + (Advice.dx[Step] and 7) shl 4 + 719 (Advice.dy[Step] and 7) shl 7, Me, uix, nodata^); 720 Inc(Step); 721 if RO.Happened and phStealTech <> 0 then StealAdvance; 722 until False; 723 if DestinationReached then 724 if Advice.nStep = 25 then 725 Result := Unit_Move(uix, ToLoc) // Shinkansen 726 else if Advice.MoreTurns = 0 then 727 Result := Result or rLocationReached 728 else 729 Result := Result or rMoreTurns; 730 end; 731 end; 732 733 function TCustomAI.Unit_Step(uix, ToLoc: Integer): Integer; 734 var 735 A, B: Integer; 736 begin 737 Loc_to_ab(MyUnit[uix].Loc, ToLoc, A, B); 738 Assert(((A <> 0) or (B <> 0)) and (A >= -1) and (A <= 1) and (B >= -1) and (B <= 1)); 739 Result := Server(sMoveUnit + ((A - B) and 7) shl 4 + ((A + B) and 7) shl 7, Me, uix, nodata^); 740 if RO.Happened and phStealTech <> 0 then StealAdvance; 741 end; 742 743 function TCustomAI.Unit_Attack(uix, ToLoc: Integer): Integer; 744 var 745 A, B: Integer; 746 begin 747 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit 748 and ((Map[ToLoc] and (fUnit or fOwned) = fUnit) // is an attack 749 or (Map[ToLoc] and (fCity or fOwned) = fCity) and 750 (MyModel[MyUnit[uix].mix].Domain <> dGround))); // is a bombardment 751 Loc_to_ab(MyUnit[uix].Loc, ToLoc, A, B); 752 Assert(((A <> 0) or (B <> 0)) and (A >= -1) and (A <= 1) and (B >= -1) and (B <= 1)); 753 // attack to adjacent tile 754 Result := Server(sMoveUnit + (A - B) and 7 shl 4 + (A + B) and 7 shl 7, Me, uix, nodata^); 755 end; 756 757 function TCustomAI.Unit_DoMission(uix, MissionType, ToLoc: Integer): Integer; 758 var 759 A, B: Integer; 760 begin 761 Result := Server(sSetSpyMission + MissionType shl 4, Me, 0, nodata^); 762 if Result >= rExecuted then 763 begin 764 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit 765 and (MyModel[MyUnit[uix].mix].Kind = mkDiplomat)); // is a commando 766 Loc_to_ab(MyUnit[uix].Loc, ToLoc, A, B); 767 Assert(((A <> 0) or (B <> 0)) and (A >= -1) and (A <= 1) and (B >= -1) and (B <= 1)); 768 // city must be adjacent 769 Result := Server(sMoveUnit - sExecute + (A - B) and 7 shl 4 + (A + B) and 7 shl 7, Me, uix, nodata^); 770 if Result = eMissionDone then 771 Result := Server(sMoveUnit + (A - B) and 7 shl 4 + (A + B) and 7 shl 7, Me, uix, nodata^) 772 else if (Result <> eNoTime_Move) and (Result <> eTreaty) and (Result <> eNoTurn) then 773 Result := eInvalid; // not a special commando mission! 774 end; 775 end; 776 777 function TCustomAI.Unit_MoveForecast(uix, ToLoc: Integer; 778 var RemainingMovement: Integer): Boolean; 779 var 780 Advice: TMoveAdviceData; 781 begin 782 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0)); // is a unit 783 Advice.ToLoc := ToLoc; 784 Advice.MoreTurns := 0; 785 Advice.MaxHostile_MovementLeft := 100; 786 if Server(sGetMoveAdvice, Me, uix, Advice) = eOk then 787 begin 788 RemainingMovement := Advice.MaxHostile_MovementLeft; 789 Result := True; 705 790 end 706 end; 707 708 function TCustomAI.Unit_Step(uix,ToLoc: Integer): Integer; 709 var 710 A,B: Integer; 711 begin 712 Loc_to_ab(MyUnit[uix].Loc, ToLoc, A, B); 713 Assert(((A<>0) or (B<>0)) and (A>=-1) and (A<=1) and (B>=-1) and (B<=1)); 714 Result:=Server(sMoveUnit+((A-B) and 7) shl 4 +((A+B) and 7) shl 7, Me, uix, nodata^); 715 if RO.Happened and phStealTech<>0 then StealAdvance; 716 end; 717 718 function TCustomAI.Unit_Attack(uix,ToLoc: Integer): Integer; 719 var 720 A,B: Integer; 721 begin 722 Assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0) // is a unit 723 and ((Map[ToLoc] and (fUnit or fOwned)=fUnit) // is an attack 724 or (Map[ToLoc] and (fCity or fOwned)=fCity) 725 and (MyModel[MyUnit[uix].mix].Domain<>dGround))); // is a bombardment 726 Loc_to_ab(MyUnit[uix].Loc,ToLoc,A,B); 727 Assert(((A<>0) or (B<>0)) and (A>=-1) and (A<=1) and (B>=-1) and (B<=1)); // attack to adjacent tile 728 Result:=Server(sMoveUnit+(A-B) and 7 shl 4 +(A+B) and 7 shl 7,Me,uix,nodata^); 729 end; 730 731 function TCustomAI.Unit_DoMission(uix,MissionType,ToLoc: Integer): Integer; 732 var 733 A,B: Integer; 734 begin 735 Result:=Server(sSetSpyMission + MissionType shl 4,Me,0,nodata^); 736 if Result>=rExecuted then 791 else 737 792 begin 738 Assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0) // is a unit 739 and (MyModel[MyUnit[uix].mix].Kind=mkDiplomat)); // is a commando 740 Loc_to_ab(MyUnit[uix].Loc,ToLoc,A,B); 741 Assert(((A<>0) or (B<>0)) and (A>=-1) and (A<=1) and (B>=-1) and (B<=1)); // city must be adjacent 742 Result:=Server(sMoveUnit-sExecute+(A-B) and 7 shl 4 +(A+B) and 7 shl 7,Me,uix,nodata^); 743 if Result=eMissionDone then 744 Result:=Server(sMoveUnit+(A-B) and 7 shl 4 +(A+B) and 7 shl 7,Me,uix,nodata^) 745 else if (Result<>eNoTime_Move) and (Result<>eTreaty) and (Result<>eNoTurn) then 746 Result:=eInvalid // not a special commando mission! 747 end 748 end; 749 750 function TCustomAI.Unit_MoveForecast(uix,ToLoc: Integer; 751 var RemainingMovement: Integer): Boolean; 752 var 753 Advice: TMoveAdviceData; 754 begin 755 Assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0)); // is a unit 756 Advice.ToLoc:=ToLoc; 757 Advice.MoreTurns:=0; 758 Advice.MaxHostile_MovementLeft:=100; 759 if Server(sGetMoveAdvice,Me,uix,Advice)=eOk then 793 RemainingMovement := -1; 794 Result := False; 795 end; 796 end; 797 798 function TCustomAI.Unit_AttackForecast(uix, ToLoc, AttackMovement: Integer; 799 var RemainingHealth: Integer): Boolean; 800 var 801 BattleForecast: TBattleForecast; 802 begin 803 Assert((uix >= 0) and (uix < RO.nUn) and (MyUnit[uix].Loc >= 0) // is a unit 804 and (Map[ToLoc] and (fUnit or fOwned) = fUnit)); // is an attack 805 RemainingHealth := -$100; 806 Result := False; 807 if AttackMovement >= 0 then with MyUnit[uix] do 808 begin 809 BattleForecast.pAtt := Me; 810 BattleForecast.mixAtt := mix; 811 BattleForecast.HealthAtt := Health; 812 BattleForecast.ExpAtt := Exp; 813 BattleForecast.FlagsAtt := Flags; 814 BattleForecast.Movement := AttackMovement; 815 if Server(sGetBattleForecast, Me, ToLoc, BattleForecast) >= rExecuted then 816 begin 817 if BattleForecast.EndHealthAtt > 0 then 818 RemainingHealth := BattleForecast.EndHealthAtt 819 else 820 RemainingHealth := -BattleForecast.EndHealthDef; 821 Result := True; 822 end; 823 end; 824 end; 825 826 function TCustomAI.Unit_DefenseForecast(euix, ToLoc: Integer; 827 var RemainingHealth: Integer): Boolean; 828 var 829 BattleForecast: TBattleForecast; 830 begin 831 Assert((euix >= 0) and (euix < RO.nEnemyUn) and (RO.EnemyUn[euix].Loc >= 0) // is an enemy unit 832 and (Map[ToLoc] and (fUnit or fOwned) = (fUnit or fOwned))); // is an attack 833 RemainingHealth := $100; 834 Result := False; 835 with RO.EnemyUn[euix] do 760 836 begin 761 RemainingMovement:=Advice.MaxHostile_MovementLeft; 762 Result:=True 763 end 764 else 837 BattleForecast.pAtt := Owner; 838 BattleForecast.mixAtt := mix; 839 BattleForecast.HealthAtt := Health; 840 BattleForecast.ExpAtt := Exp; 841 BattleForecast.FlagsAtt := Flags; 842 BattleForecast.Movement := 100; 843 if Server(sGetBattleForecast, Me, ToLoc, BattleForecast) >= rExecuted then 844 begin 845 if BattleForecast.EndHealthDef > 0 then 846 RemainingHealth := BattleForecast.EndHealthDef 847 else 848 RemainingHealth := -BattleForecast.EndHealthAtt; 849 Result := True; 850 end; 851 end; 852 end; 853 854 function TCustomAI.Unit_Disband(uix: Integer): Integer; 855 begin 856 Result := Server(sRemoveUnit, Me, uix, nodata^); 857 end; 858 859 function TCustomAI.Unit_StartJob(uix, NewJob: Integer): Integer; 860 begin 861 Result := Server(sStartJob + NewJob shl 4, Me, uix, nodata^); 862 end; 863 864 function TCustomAI.Unit_SetHomeHere(uix: Integer): Integer; 865 begin 866 Result := Server(sSetUnitHome, Me, uix, nodata^); 867 end; 868 869 function TCustomAI.Unit_Load(uix: Integer): Integer; 870 begin 871 Result := Server(sLoadUnit, Me, uix, nodata^); 872 end; 873 874 function TCustomAI.Unit_Unload(uix: Integer): Integer; 875 begin 876 Result := Server(sUnloadUnit, Me, uix, nodata^); 877 end; 878 879 function TCustomAI.Unit_AddToCity(uix: Integer): Integer; 880 begin 881 Result := Server(sAddToCity, Me, uix, nodata^); 882 end; 883 884 procedure TCustomAI.City_FindMyCity(Loc: Integer; var cix: Integer); 885 begin 886 if Map[Loc] and (fCity or fOwned) <> fCity or fOwned then 887 cix := -1 888 else 765 889 begin 766 RemainingMovement:=-1; 767 Result:=False 768 end 769 end; 770 771 function TCustomAI.Unit_AttackForecast(uix,ToLoc,AttackMovement: Integer; 772 var RemainingHealth: Integer): Boolean; 773 var 774 BattleForecast: TBattleForecast; 775 begin 776 Assert((uix>=0) and (uix<RO.nUn) and (MyUnit[uix].Loc>=0) // is a unit 777 and (Map[ToLoc] and (fUnit or fOwned)=fUnit)); // is an attack 778 RemainingHealth:=-$100; 779 Result:=False; 780 if AttackMovement>=0 then with MyUnit[uix] do 890 cix := RO.nCity - 1; 891 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 892 Dec(cix); 893 end; 894 end; 895 896 procedure TCustomAI.City_FindEnemyCity(Loc: Integer; var ecix: Integer); 897 begin 898 if Map[Loc] and (fCity or fOwned) <> fCity then 899 ecix := -1 900 else 781 901 begin 782 BattleForecast.pAtt:=Me; 783 BattleForecast.mixAtt:=mix; 784 BattleForecast.HealthAtt:=Health; 785 BattleForecast.ExpAtt:=Exp; 786 BattleForecast.FlagsAtt:=Flags; 787 BattleForecast.Movement:=AttackMovement; 788 if Server(sGetBattleForecast,Me,ToLoc,BattleForecast)>=rExecuted then 789 begin 790 if BattleForecast.EndHealthAtt>0 then 791 RemainingHealth:=BattleForecast.EndHealthAtt 792 else RemainingHealth:=-BattleForecast.EndHealthDef; 793 Result:=True 794 end 795 end 796 end; 797 798 function TCustomAI.Unit_DefenseForecast(euix,ToLoc: Integer; 799 var RemainingHealth: Integer): Boolean; 800 var 801 BattleForecast: TBattleForecast; 802 begin 803 Assert((euix>=0) and (euix<RO.nEnemyUn) and (RO.EnemyUn[euix].Loc>=0) // is an enemy unit 804 and (Map[ToLoc] and (fUnit or fOwned)=(fUnit or fOwned))); // is an attack 805 RemainingHealth:=$100; 806 Result:=False; 807 with RO.EnemyUn[euix] do 902 ecix := RO.nEnemyCity - 1; 903 while (ecix >= 0) and (RO.EnemyCity[ecix].Loc <> Loc) do 904 Dec(ecix); 905 end; 906 end; 907 908 function TCustomAI.City_HasProject(cix: Integer): Boolean; 909 begin 910 Result := MyCity[cix].Project and (cpImp + cpIndex) <> cpImp + imTrGoods; 911 end; 912 913 function TCustomAI.City_CurrentImprovementProject(cix: Integer): Integer; 914 begin 915 if MyCity[cix].Project and cpImp = 0 then Result := -1 916 else 808 917 begin 809 BattleForecast.pAtt:=Owner; 810 BattleForecast.mixAtt:=mix; 811 BattleForecast.HealthAtt:=Health; 812 BattleForecast.ExpAtt:=Exp; 813 BattleForecast.FlagsAtt:=Flags; 814 BattleForecast.Movement:=100; 815 if Server(sGetBattleForecast,Me,ToLoc,BattleForecast)>=rExecuted then 816 begin 817 if BattleForecast.EndHealthDef>0 then 818 RemainingHealth:=BattleForecast.EndHealthDef 819 else RemainingHealth:=-BattleForecast.EndHealthAtt; 820 Result:=True 821 end 822 end 823 end; 824 825 function TCustomAI.Unit_Disband(uix: Integer): Integer; 826 begin 827 Result:=Server(sRemoveUnit,Me,uix,nodata^) 828 end; 829 830 function TCustomAI.Unit_StartJob(uix,NewJob: Integer): Integer; 831 begin 832 Result:=Server(sStartJob+NewJob shl 4,Me,uix,nodata^) 833 end; 834 835 function TCustomAI.Unit_SetHomeHere(uix: Integer): Integer; 836 begin 837 Result:=Server(sSetUnitHome,Me,uix,nodata^) 838 end; 839 840 function TCustomAI.Unit_Load(uix: Integer): Integer; 841 begin 842 Result:=Server(sLoadUnit,Me,uix,nodata^) 843 end; 844 845 function TCustomAI.Unit_Unload(uix: Integer): Integer; 846 begin 847 Result:=Server(sUnloadUnit,Me,uix,nodata^) 848 end; 849 850 function TCustomAI.Unit_AddToCity(uix: Integer): Integer; 851 begin 852 Result:=Server(sAddToCity,Me,uix,nodata^) 853 end; 854 855 856 procedure TCustomAI.City_FindMyCity(Loc: Integer; var cix: Integer); 857 begin 858 if Map[Loc] and (fCity or fOwned)<>fCity or fOwned then 859 cix:=-1 860 else 861 begin 862 cix:=RO.nCity-1; 863 while (cix>=0) and (MyCity[cix].Loc<>Loc) do 864 Dec(cix); 865 end 866 end; 867 868 procedure TCustomAI.City_FindEnemyCity(Loc: Integer; var ecix: Integer); 869 begin 870 if Map[Loc] and (fCity or fOwned)<>fCity then 871 ecix:=-1 872 else 873 begin 874 ecix:=RO.nEnemyCity-1; 875 while (ecix>=0) and (RO.EnemyCity[ecix].Loc<>Loc) do 876 Dec(ecix); 877 end 878 end; 879 880 function TCustomAI.City_HasProject(cix: Integer): Boolean; 881 begin 882 Result:= MyCity[cix].Project and (cpImp+cpIndex)<>cpImp+imTrGoods 883 end; 884 885 function TCustomAI.City_CurrentImprovementProject(cix: Integer): Integer; 886 begin 887 if MyCity[cix].Project and cpImp=0 then Result:=-1 888 else 889 begin 890 Result:=MyCity[cix].Project and cpIndex; 891 if Result=imTrGoods then Result:=-1 892 end 918 Result := MyCity[cix].Project and cpIndex; 919 if Result = imTrGoods then Result := -1; 920 end; 893 921 end; 894 922 895 923 function TCustomAI.City_CurrentUnitProject(cix: Integer): Integer; 896 924 begin 897 if MyCity[cix].Project and cpImp<>0 then Result:=-1 898 else Result:=MyCity[cix].Project and cpIndex; 899 end; 900 901 function TCustomAI.City_GetTileInfo(cix,TileLoc: Integer; var TileInfo: TTileInfo): Integer; 902 begin 903 TileInfo.ExplCity:=cix; 904 Result:=Server(sGetHypoCityTileInfo,Me,TileLoc,TileInfo) 925 if MyCity[cix].Project and cpImp <> 0 then Result := -1 926 else 927 Result := MyCity[cix].Project and cpIndex; 928 end; 929 930 function TCustomAI.City_GetTileInfo(cix, TileLoc: Integer; 931 var TileInfo: TTileInfo): Integer; 932 begin 933 TileInfo.ExplCity := cix; 934 Result := Server(sGetHypoCityTileInfo, Me, TileLoc, TileInfo); 905 935 end; 906 936 907 937 function TCustomAI.City_GetReport(cix: Integer; var Report: TCityReport): Integer; 908 938 begin 909 Report.HypoTiles:=-1;910 Report.HypoTax:=-1;911 Report.HypoLux:=-1;912 Result:=Server(sGetCityReport,Me,cix,Report) 939 Report.HypoTiles := -1; 940 Report.HypoTax := -1; 941 Report.HypoLux := -1; 942 Result := Server(sGetCityReport, Me, cix, Report); 913 943 end; 914 944 … … 916 946 var Report: TCityReport): Integer; 917 947 begin 918 Report.HypoTiles:=HypoTiles;919 Report.HypoTax:=HypoTax;920 Report.HypoLux:=HypoLux;921 Result:=Server(sGetCityReport,Me,cix,Report) 948 Report.HypoTiles := HypoTiles; 949 Report.HypoTax := HypoTax; 950 Report.HypoLux := HypoLux; 951 Result := Server(sGetCityReport, Me, cix, Report); 922 952 end; 923 953 924 954 function TCustomAI.City_GetAreaInfo(cix: Integer; var AreaInfo: TCityAreaInfo): Integer; 925 955 begin 926 Result:=Server(sGetCityAreaInfo,Me,cix,AreaInfo) 927 end; 928 929 function TCustomAI.City_StartUnitProduction(cix, mix: Integer): Integer;930 begin 931 Result:=Server(sSetCityProject,Me,cix,mix) 932 end; 933 934 function TCustomAI.City_StartEmigration(cix, mix: Integer;956 Result := Server(sGetCityAreaInfo, Me, cix, AreaInfo); 957 end; 958 959 function TCustomAI.City_StartUnitProduction(cix, mix: Integer): Integer; 960 begin 961 Result := Server(sSetCityProject, Me, cix, mix); 962 end; 963 964 function TCustomAI.City_StartEmigration(cix, mix: Integer; 935 965 AllowDisbandCity, AsConscripts: Boolean): Integer; 936 966 var 937 NewProject: Integer;938 begin 939 NewProject:=mix;940 if AllowDisbandCity then NewProject:=NewProject or cpDisbandCity;941 if AsConscripts then NewProject:=NewProject or cpConscripts;942 Result:=Server(sSetCityProject,Me,cix,NewProject) 943 end; 944 945 function TCustomAI.City_StartImprovement(cix, iix: Integer): Integer;946 var 947 NewProject: Integer;948 begin 949 NewProject:=iix+cpImp;950 Result:=Server(sSetCityProject,Me,cix,NewProject) 951 end; 952 953 function TCustomAI.City_Improvable(cix, iix: Integer): Boolean;954 var 955 NewProject: Integer;956 begin 957 NewProject:=iix+cpImp;958 Result:= Server(sSetCityProject-sExecute,Me,cix,NewProject)>=rExecuted;967 NewProject: Integer; 968 begin 969 NewProject := mix; 970 if AllowDisbandCity then NewProject := NewProject or cpDisbandCity; 971 if AsConscripts then NewProject := NewProject or cpConscripts; 972 Result := Server(sSetCityProject, Me, cix, NewProject); 973 end; 974 975 function TCustomAI.City_StartImprovement(cix, iix: Integer): Integer; 976 var 977 NewProject: Integer; 978 begin 979 NewProject := iix + cpImp; 980 Result := Server(sSetCityProject, Me, cix, NewProject); 981 end; 982 983 function TCustomAI.City_Improvable(cix, iix: Integer): Boolean; 984 var 985 NewProject: Integer; 986 begin 987 NewProject := iix + cpImp; 988 Result := Server(sSetCityProject - sExecute, Me, cix, NewProject) >= rExecuted; 959 989 end; 960 990 961 991 function TCustomAI.City_StopProduction(cix: Integer): Integer; 962 992 var 963 NewProject: Integer;964 begin 965 NewProject:=imTrGoods+cpImp;966 Result:=Server(sSetCityProject,Me,cix,NewProject) 993 NewProject: Integer; 994 begin 995 NewProject := imTrGoods + cpImp; 996 Result := Server(sSetCityProject, Me, cix, NewProject); 967 997 end; 968 998 969 999 function TCustomAI.City_BuyProject(cix: Integer): Integer; 970 1000 begin 971 Result:=Server(sBuyCityProject,Me,cix,nodata^) 972 end; 973 974 function TCustomAI.City_SellImprovement(cix,iix: Integer): Integer; 975 begin 976 Result:=Server(sSellCityImprovement,Me,cix,iix) 977 end; 978 979 function TCustomAI.City_RebuildImprovement(cix,iix: Integer): Integer; 980 begin 981 Result:=Server(sRebuildCityImprovement,Me,cix,iix) 982 end; 983 984 function TCustomAI.City_SetTiles(cix,NewTiles: Integer): Integer; 985 begin 986 Result:=Server(sSetCityTiles,Me,cix,NewTiles) 987 end; 988 1001 Result := Server(sBuyCityProject, Me, cix, nodata^); 1002 end; 1003 1004 function TCustomAI.City_SellImprovement(cix, iix: Integer): Integer; 1005 begin 1006 Result := Server(sSellCityImprovement, Me, cix, iix); 1007 end; 1008 1009 function TCustomAI.City_RebuildImprovement(cix, iix: Integer): Integer; 1010 begin 1011 Result := Server(sRebuildCityImprovement, Me, cix, iix); 1012 end; 1013 1014 function TCustomAI.City_SetTiles(cix, NewTiles: Integer): Integer; 1015 begin 1016 Result := Server(sSetCityTiles, Me, cix, NewTiles); 1017 end; 989 1018 990 1019 // negotiation 991 1020 function TCustomAI.Nego_CheckMyAction: Integer; 992 1021 begin 993 Assert(Opponent>=0); // only allowed in negotiation mode 994 Assert((MyAction=scDipNotice) or (MyAction=scDipAccept) 995 or (MyAction=scDipCancelTreaty) or (MyAction=scDipOffer) 996 or (MyAction=scDipBreak)); 997 if MyAction=scDipOffer then Result:=Server(MyAction-sExecute, Me, 0, MyOffer) 998 else Result:=Server(MyAction-sExecute, Me, 0, nodata^); 999 end; 1000 1022 Assert(Opponent >= 0); // only allowed in negotiation mode 1023 Assert((MyAction = scDipNotice) or (MyAction = scDipAccept) or 1024 (MyAction = scDipCancelTreaty) or (MyAction = scDipOffer) or (MyAction = scDipBreak)); 1025 if MyAction = scDipOffer then Result := Server(MyAction - sExecute, Me, 0, MyOffer) 1026 else 1027 Result := Server(MyAction - sExecute, Me, 0, nodata^); 1028 end; 1001 1029 1002 1030 initialization 1003 nodata:=Pointer(0);1004 RWDataSize:=0;1031 nodata := Pointer(0); 1032 RWDataSize := 0; 1005 1033 1006 1034 end. 1007 -
trunk/AI/StdAI/ToolAI.pas
r447 r522 420 420 begin 421 421 Inc(BestCount); 422 if random(BestCount) = 0 then422 if Random(BestCount) = 0 then 423 423 begin 424 424 BestScore := TestScore; … … 1129 1129 begin 1130 1130 Loc_to_ab(MyUnit[uix].Loc, MyUnit[uixTransportLoad[tuix]].Loc, A, B); 1131 if ( abs(A) <= 1) and (abs(B) <= 1) then1131 if (Abs(A) <= 1) and (Abs(B) <= 1) then 1132 1132 begin 1133 1133 Assert((A <> 0) or (B <> 0)); … … 1146 1146 begin 1147 1147 Loc_to_ab(TransportPlan.LoadLoc, MyUnit[uixTransportLoad[tuix]].Loc, A, B); 1148 if ( abs(A) <= 1) and (abs(B) <= 1) then1148 if (Abs(A) <= 1) and (Abs(B) <= 1) then 1149 1149 begin 1150 1150 TransportPlan.uixLoad[TransportPlan.nLoad] := uixTransportLoad[tuix]; -
trunk/CityProcessing.pas
r447 r522 665 665 dy := V21 shr 2 - 3; 666 666 dx := V21 and 3 shl 1 - 3 + (dy + 3) and 1; 667 Dist := abs(dx) + abs(dy) + abs(abs(dx) - abs(dy)) shr 1;667 Dist := Abs(dx) + Abs(dy) + Abs(Abs(dx) - Abs(dy)) shr 1; 668 668 if (Resources > Best) or (Resources = Best) and (Dist < BestDist) 669 669 then -
trunk/Database.pas
r451 r522 510 510 begin 511 511 dxdy(Loc0, Loc1, dx, dy); 512 dx := abs(dx);513 dy := abs(dy);514 Result := dx + dy + abs(dx - dy) shr 1;512 dx := Abs(dx); 513 dy := Abs(dy); 514 Result := dx + dy + Abs(dx - dy) shr 1; 515 515 end; 516 516 … … 978 978 ShSwamp = 25; { of grassland } 979 979 MinRivLen = 3; 980 unification = 70;981 hotunification = 50; // min. 25980 Unification = 70; 981 HotUnification = 50; // min. 25 982 982 983 983 Zone: array [0 .. 3, 2 .. 9] of Single = { terrain distribution } … … 1165 1165 CopyFrom[Loc0] := Loc0; 1166 1166 1167 for N := 0 to unification * MapSize div 100 do1167 for N := 0 to Unification * MapSize div 100 do 1168 1168 begin 1169 1169 Y := DelphiRandom(ly); 1170 if abs(Y - (ly shr 1)) > ly div 4 + DelphiRandom(ly * hotunification div 100) then1170 if Abs(Y - (ly shr 1)) > ly div 4 + DelphiRandom(ly * HotUnification div 100) then 1171 1171 if Y < ly shr 1 then 1172 1172 Y := ly shr 1 - Y … … 2792 2792 begin 2793 2793 dxMax := dy and 1; 2794 while abs(dy) + (dxMax + 2) + abs(abs(dy) - (dxMax + 2)) shr 1 <=2794 while Abs(dy) + (dxMax + 2) + Abs(Abs(dy) - (dxMax + 2)) shr 1 <= 2795 2795 CountryRadius do 2796 2796 Inc(dxMax, 2); … … 2904 2904 begin 2905 2905 dxMax := dy and 1; 2906 while abs(dy) + (dxMax + 2) + abs(abs(dy) - (dxMax + 2)) shr 1 <=2906 while Abs(dy) + (dxMax + 2) + Abs(Abs(dy) - (dxMax + 2)) shr 1 <= 2907 2907 CountryRadius do 2908 2908 Inc(dxMax, 2); -
trunk/LocalPlayer/ClientTools.pas
r486 r522 100 100 Inc(Loc0, G.lx * 1024); 101 101 Inc(Loc1, G.lx * 1024); 102 dx := abs(((Loc1 mod G.lx * 2 + Loc1 div G.lx and 1) -102 dx := Abs(((Loc1 mod G.lx * 2 + Loc1 div G.lx and 1) - 103 103 (Loc0 mod G.lx * 2 + Loc0 div G.lx and 1) + 3 * G.lx) mod (2 * G.lx) - G.lx); 104 dy := abs(Loc1 div G.lx - Loc0 div G.lx);105 Result := dx + dy + abs(dx - dy) shr 1;104 dy := Abs(Loc1 div G.lx - Loc0 div G.lx); 105 Result := dx + dy + Abs(dx - dy) shr 1; 106 106 end; 107 107 … … 371 371 for dx := -2 to 2 do 372 372 for dy := -2 to 2 do 373 if abs(dx) + abs(dy) = 2 then373 if Abs(dx) + Abs(dy) = 2 then 374 374 if Server(sMoveUnit - sExecute + dx and 7 shl 4 + dy and 375 375 7 shl 7, Me, uix, nil^) >= rExecuted then -
trunk/LocalPlayer/Diagram.pas
r468 r522 219 219 MoveTo(X, Border); 220 220 LineTo(X, InnerHeight - Border); 221 S := IntToStr( abs(TurnToYear(T * LineStep)));221 S := IntToStr(Abs(TurnToYear(T * LineStep))); 222 222 Textout(X - TextWidth(S) div 2, Border - 16, S); 223 223 end; -
trunk/LocalPlayer/IsoEngine.pas
r506 r522 1372 1372 I: Integer; 1373 1373 begin 1374 FOutput.Canvas.pen.Color := $000000; // $FF shl (8 *random(3));1374 FOutput.Canvas.pen.Color := $000000; // $FF shl (8 * Random(3)); 1375 1375 for I := 0 to nx div 2 do 1376 1376 ClippedLine(I * 2, 0, False); … … 1430 1430 for Y := 0 to ScaleToNative(Height) - 1 do begin 1431 1431 y_n := (ScaleFromNative(Y) + y0 - ym) / yyt; 1432 if abs(y_n) < rShade then begin1432 if Abs(y_n) < rShade then begin 1433 1433 // Darken left and right parts of elipsis 1434 1434 w_n := sqrt(sqr(rShade) - sqr(y_n)); -
trunk/LocalPlayer/Nego.pas
r496 r522 746 746 if InputDlg.ModalResult <> mrOK then 747 747 Exit; 748 val(InputDlg.EditInput.Text, A, I);748 Val(InputDlg.EditInput.Text, A, I); 749 749 if (I <> 0) or (A <= 0) or (A >= MaxMoneyPrice) then 750 750 Exit; … … 776 776 if InputDlg.ModalResult <> mrOK then 777 777 Exit; 778 val(InputDlg.EditInput.Text, A, I);778 Val(InputDlg.EditInput.Text, A, I); 779 779 if (I <> 0) or (A <= 0) then 780 780 Exit; … … 858 858 if InputDlg.ModalResult <> mrOK then 859 859 Exit; 860 val(InputDlg.EditInput.Text, A, I);860 Val(InputDlg.EditInput.Text, A, I); 861 861 if (I <> 0) or (A <= 0) or (A >= MaxMoneyPrice) then 862 862 Exit; … … 878 878 if InputDlg.ModalResult <> mrOK then 879 879 Exit; 880 val(InputDlg.EditInput.Text, A, I);880 Val(InputDlg.EditInput.Text, A, I); 881 881 if (I <> 0) or (A <= 0) then 882 882 Exit; -
trunk/LocalPlayer/Select.pas
r518 r522 8 8 SysUtils, Classes, ButtonB, ButtonBase, Types, 9 9 {$IFDEF DPI}Dpi.Graphics, Dpi.Controls, Dpi.Forms, Dpi.ExtCtrls, Dpi.Menus, 10 System.UITypes{$ELSE}10 Dpi.Common, System.UITypes{$ELSE} 11 11 Graphics, Controls, Forms, ExtCtrls, Menus{$ENDIF}; 12 12 … … 1115 1115 for dx := -2 to 2 do 1116 1116 for dy := -2 to 2 do 1117 if abs(dx) + abs(dy) = 2 then1117 if Abs(dx) + Abs(dy) = 2 then 1118 1118 begin 1119 1119 Loc1 := dLoc(MyCity[cixProject].Loc, dx, dy); -
trunk/LocalPlayer/Term.pas
r517 r522 1573 1573 if Tribe[I] <> nil then 1574 1574 begin 1575 TestColorDistance := abs(Integer(UnusedTribeFiles.Objects[J])1575 TestColorDistance := Abs(Integer(UnusedTribeFiles.Objects[J]) 1576 1576 shr 16 and $FF - Tribe[I].Color shr 16 and $FF) + 1577 1577 Abs(Integer(UnusedTribeFiles.Objects[J]) shr 8 and … … 1658 1658 for I := 0 to nShipPart - 1 do 1659 1659 begin 1660 TestCost := abs(Ship1Change[I]) * Imp[imShipComp + I].Cost;1660 TestCost := Abs(Ship1Change[I]) * Imp[imShipComp + I].Cost; 1661 1661 if TestCost > MostCost then 1662 1662 begin … … 3534 3534 (TButtonC(Components[I]).ButtonIndex <> 1) then 3535 3535 TButtonC(Components[I]).ButtonIndex := 3536 Integer(MapOptionChecked) shr (Components[I].Tag shr 8) and 1 + 2 3536 Integer(MapOptionChecked) shr (Components[I].Tag shr 8) and 1 + 2; 3537 3537 end; 3538 3538 … … 4585 4585 xs := (x0 - xw) * (xxt * 2) + y0 and 1 * xxt - G.lx * (xxt * 2); 4586 4586 // |xs+xl/2-MapWidth/2| -> min 4587 while abs(2 * (xs + G.lx * (xxt * 2)) + xl - MapWidth) <4588 abs(2 * xs + xl - MapWidth) do4587 while Abs(2 * (xs + G.lx * (xxt * 2)) + xl - MapWidth) < 4588 Abs(2 * xs + xl - MapWidth) do 4589 4589 Inc(xs, G.lx * (xxt * 2)); 4590 4590 ys := (y0 - yw) * yyt - yyt; … … 4632 4632 xMap := (x0 - xw) * (xxt * 2) + y0 and 1 * xxt - G.lx * (xxt * 2); 4633 4633 // |xMap+xxt-MapWidth/2| -> min 4634 while abs(2 * (xMap + G.lx * (xxt * 2)) + 2 * xxt - MapWidth) <4635 abs(2 * xMap + 2 * xxt - MapWidth) do4634 while Abs(2 * (xMap + G.lx * (xxt * 2)) + 2 * xxt - MapWidth) < 4635 Abs(2 * xMap + 2 * xxt - MapWidth) do 4636 4636 Inc(xMap, G.lx * (xxt * 2)); 4637 4637 yMap := (y0 - yw) * yyt - yyt; … … 5954 5954 mod (2 * G.lx) - G.lx; 5955 5955 dy := MouseLoc div G.lx - Loc div G.lx; 5956 if abs(dx) + abs(dy) < 3 then5956 if Abs(dx) + Abs(dy) < 3 then 5957 5957 begin 5958 5958 DestinationMarkON := False; … … 6621 6621 // ((xFromLoc-xw1)*2+yFromLoc and 1+1)*xxt+dx*xxt/2-MapWidth/2 -> min 6622 6622 with MainMap do begin 6623 while abs(((xFromLoc - xw1 + G.lx) * 2 + yFromLoc and 1 + 1) * xxt * 2 + dx6624 * xxt - MapWidth) < abs(((xFromLoc - xw1) * 2 + yFromLoc and 1 + 1) * xxt6623 while Abs(((xFromLoc - xw1 + G.lx) * 2 + yFromLoc and 1 + 1) * xxt * 2 + dx 6624 * xxt - MapWidth) < Abs(((xFromLoc - xw1) * 2 + yFromLoc and 1 + 1) * xxt 6625 6625 * 2 + dx * xxt - MapWidth) do 6626 6626 Dec(xw1, G.lx); … … 6651 6651 NoMap.SetOutput(Buffer); 6652 6652 NoMap.SetPaintBounds(0, 0, xRange, yRange); 6653 for Step := 0 to abs(Step1 - Step0) do6653 for Step := 0 to Abs(Step1 - Step0) do 6654 6654 begin 6655 6655 BitBltCanvas(Buffer.Canvas, 0, 0, xRange, yRange, … … 6658 6658 begin 6659 6659 xMoving := xFrom + 6660 Round((Step0 + Step * (Step1 - Step0) div abs(Step1 - Step0)) *6660 Round((Step0 + Step * (Step1 - Step0) div Abs(Step1 - Step0)) * 6661 6661 (xTo - xFrom) / nStep); 6662 6662 yMoving := yFrom + 6663 Round((Step0 + Step * (Step1 - Step0) div abs(Step1 - Step0)) *6663 Round((Step0 + Step * (Step1 - Step0) div Abs(Step1 - Step0)) * 6664 6664 (yTo - yFrom) / nStep); 6665 6665 end … … 6981 6981 x0:=(Loc+(y0 and 1+G.lx*1024) div 2) mod G.lx; 6982 6982 xs:=(x0-xw)*66+y0 and 1*33-G.lx*66; 6983 while abs(2*(xs+G.lx*66)-MapWidth)<abs(2*xs-MapWidth) do6983 while Abs(2*(xs+G.lx*66)-MapWidth)<Abs(2*xs-MapWidth) do 6984 6984 Inc(xs,G.lx*66); 6985 6985 ys:=(y0-yw)*16; -
trunk/Packages/CevoComponents/ScreenTools.pas
r518 r522 87 87 procedure VDarkGradient(Canvas: TCanvas; X, Y, Height, Kind: Integer); 88 88 procedure UnderlinedTitleValue(Canvas: TCanvas; Title, Value: string; X, Y, Width: Integer); 89 procedure NumberBar(Dst: TBitmap; X, Y: Integer; Cap: string; val: Integer;89 procedure NumberBar(Dst: TBitmap; X, Y: Integer; Cap: string; Val: Integer; 90 90 T: TTexture); 91 91 procedure CountBar(Dst: TBitmap; X, Y, W: Integer; Kind: Integer; 92 Cap: string; val: Integer; T: TTexture);92 Cap: string; Val: Integer; T: TTexture); 93 93 procedure PaintProgressBar(Canvas: TCanvas; Kind, X, Y, Pos, Growth, Max: Integer; 94 94 T: TTexture); … … 1397 1397 1398 1398 procedure NumberBar(Dst: TBitmap; X, Y: Integer; Cap: string; 1399 val: Integer; T: TTexture);1399 Val: Integer; T: TTexture); 1400 1400 var 1401 1401 S: string; 1402 1402 begin 1403 if val > 0 then1403 if Val > 0 then 1404 1404 begin 1405 1405 DLine(Dst.Canvas, X - 2, X + 170, Y + 16, T.ColorBevelShade, 1406 1406 T.ColorBevelLight); 1407 1407 LoweredTextOut(Dst.Canvas, -1, T, X - 2, Y, Cap); 1408 S := IntToStr( val);1408 S := IntToStr(Val); 1409 1409 RisedTextOut(Dst.Canvas, X + 170 - BiColorTextWidth(Dst.Canvas, 1410 1410 S), Y, S); … … 1413 1413 1414 1414 procedure CountBar(Dst: TBitmap; X, Y, W: Integer; Kind: Integer; 1415 Cap: string; val: Integer; T: TTexture);1415 Cap: string; Val: Integer; T: TTexture); 1416 1416 var 1417 1417 I, sd, ld, cl, xIcon, yIcon: Integer; 1418 1418 S: string; 1419 1419 begin 1420 // val:=random(40); //!!!1421 if val = 0 then1420 // Val := Random(40); //!!! 1421 if Val = 0 then 1422 1422 Exit; 1423 1423 Assert(Kind >= 0); … … 1433 1433 T.ColorBevelLight); 1434 1434 1435 S := IntToStr( val);1436 if val < 0 then1435 S := IntToStr(Val); 1436 if Val < 0 then 1437 1437 cl := $0000FF 1438 1438 else … … 1442 1442 xIcon + W + 2 - BiColorTextWidth(Dst.Canvas, S), yIcon, S); 1443 1443 1444 if (Kind = 12) and ( val >= 100) then1444 if (Kind = 12) and (Val >= 100) then 1445 1445 begin // science with symbol for 100 1446 val := val div 10;1447 sd := 14 * ( val div 10 + val mod 10 - 1);1446 Val := Val div 10; 1447 sd := 14 * (Val div 10 + Val mod 10 - 1); 1448 1448 if sd = 0 then 1449 1449 sd := 1; … … 1452 1452 else 1453 1453 ld := W - 44; 1454 for I := 0 to val mod 10 - 1 do1454 for I := 0 to Val mod 10 - 1 do 1455 1455 begin 1456 1456 BitBltCanvas(Dst.Canvas, xIcon + 4 + I * (14 * ld div sd), yIcon + 2 + 1, 14, … … 1460 1460 14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15); 1461 1461 end; 1462 for I := 0 to val div 10 - 1 do1462 for I := 0 to Val div 10 - 1 do 1463 1463 begin 1464 BitBltCanvas(Dst.Canvas, xIcon + 4 + ( val mod 10) *1464 BitBltCanvas(Dst.Canvas, xIcon + 4 + (Val mod 10) * 1465 1465 (14 * ld div sd) + I * (14 * ld div sd), yIcon + 3, 14, 14, 1466 1466 HGrSystem.Mask.Canvas, 67 + 7 mod 8 * 15, 1467 1467 70 + 7 div 8 * 15, SRCAND); 1468 Sprite(Dst, HGrSystem, xIcon + 3 + ( val mod 10) *1468 Sprite(Dst, HGrSystem, xIcon + 3 + (Val mod 10) * 1469 1469 (14 * ld div sd) + I * (14 * ld div sd), yIcon + 2, 14, 1470 1470 14, 67 + 7 mod 8 * 15, … … 1474 1474 else 1475 1475 begin 1476 val := abs(val);1477 if val mod 10 = 0 then1478 sd := 14 * ( val div 10 - 1)1476 Val := Abs(Val); 1477 if Val mod 10 = 0 then 1478 sd := 14 * (Val div 10 - 1) 1479 1479 else 1480 sd := 10 * ( val mod 10 - 1) + 14 * (val div 10);1480 sd := 10 * (Val mod 10 - 1) + 14 * (Val div 10); 1481 1481 if sd = 0 then 1482 1482 sd := 1; … … 1485 1485 else 1486 1486 ld := W - 44; 1487 for I := 0 to val div 10 - 1 do1487 for I := 0 to Val div 10 - 1 do 1488 1488 begin 1489 1489 BitBltCanvas(Dst.Canvas, xIcon + 4 + I * (14 * ld div sd), yIcon + 3, 14, 14, … … 1493 1493 14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15); 1494 1494 end; 1495 for I := 0 to val mod 10 - 1 do1495 for I := 0 to Val mod 10 - 1 do 1496 1496 begin 1497 BitBltCanvas(Dst.Canvas, xIcon + 4 + ( val div 10) *1497 BitBltCanvas(Dst.Canvas, xIcon + 4 + (Val div 10) * 1498 1498 (14 * ld div sd) + I * (10 * ld div sd), yIcon + 7, 10, 10, 1499 1499 HGrSystem.Mask.Canvas, 66 + Kind mod 11 * 11, 1500 1500 115 + Kind div 11 * 11, SRCAND); 1501 Sprite(Dst, HGrSystem, xIcon + 3 + ( val div 10) *1501 Sprite(Dst, HGrSystem, xIcon + 3 + (Val div 10) * 1502 1502 (14 * ld div sd) + I * (10 * ld div sd), yIcon + 6, 10, 1503 1503 10, 66 + Kind mod 11 * 11, -
trunk/Packages/DpiControls/Dpi.Common.pas
r520 r522 21 21 function ScrollDC(Canvas: TCanvas; dx: Longint; dy: Longint; const lprcScroll: TRect; 22 22 const lprcClip:TRect; hrgnUpdate: Handle; lprcUpdate: PRect): Boolean; overload; 23 function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; 24 X, Y, cx, cy: Integer; uFlags: UINT): Boolean; 23 25 function ScaleToNative(Value: Integer): Integer; 24 26 function ScaleToNativeDist(Base, Value: Integer): Integer; … … 84 86 end; 85 87 86 function Ceil(const X: Single): Integer; 87 begin 88 if X > High(Integer) then 89 Result := High(Integer) 90 else if X < Low(Integer) then 91 Result := Low(Integer) 92 else begin 93 Result := Trunc(X); 94 if (Result <> X) then begin 95 if (Result > 0) then Inc(Result) else Dec(Result); 96 end; 97 end; 88 function SetWindowPos(hWnd: HWND; hWndInsertAfter: HWND; X, Y, cx, cy: Integer; 89 uFlags: UINT): Boolean; 90 begin 91 LCLIntf.SetWindowPos(hWnd, hWndInsertAfter, ScaleToNative(X), ScaleToNative(Y), 92 ScaleToNative(cx), ScaleToNative(cy), uFlags); 98 93 end; 99 94 … … 110 105 function ScaleFromNative(Value: Integer): Integer; 111 106 begin 112 Result := Floor(Value * 96 / ScreenInfo.Dpi);107 Result := Round(Value * 96 / ScreenInfo.Dpi); 113 108 end; 114 109
Note:
See TracChangeset
for help on using the changeset viewer.