- Timestamp:
- Jan 7, 2017, 11:32:14 AM (8 years ago)
- Location:
- trunk
- Files:
-
- 62 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/Back.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Back; 4 3 … … 24 23 25 24 uses 26 Directories,ScreenTools,Start;25 Directories, ScreenTools, Start; 27 26 28 27 {$R *.DFM} … … 30 29 procedure TBackground.FormCreate(Sender: TObject); 31 30 begin 32 img:=nil;31 img := nil; 33 32 end; 34 33 35 34 procedure TBackground.FormShow(Sender: TObject); 36 35 begin 37 img:=nil;38 if FullScreen then36 img := nil; 37 if FullScreen then 39 38 begin 40 if FileExists(HomeDir+'Graphics\Background.bmp')41 or FileExists(HomeDir+'Graphics\Background.png') then39 if FileExists(HomeDir + 'Graphics\Background.bmp') or 40 FileExists(HomeDir + 'Graphics\Background.png') then 42 41 begin 43 img:=TBitmap.Create;44 LoadGraphicFile(img, HomeDir+'Graphics\Background');42 img := TBitmap.Create; 43 LoadGraphicFile(img, HomeDir + 'Graphics\Background'); 45 44 end 46 45 end 47 else46 else 48 47 begin 49 WindowState:=wsNormal;50 Width:=StartDlg.Width+16;51 Height:=StartDlg.Height+16;52 Left:=StartDlg.Left-8;53 Top:=StartDlg.Top-8;48 WindowState := wsNormal; 49 Width := StartDlg.Width + 16; 50 Height := StartDlg.Height + 16; 51 Left := StartDlg.Left - 8; 52 Top := StartDlg.Top - 8; 54 53 end 55 54 end; … … 57 56 procedure TBackground.FormPaint(Sender: TObject); 58 57 begin 59 if img<>nil then 60 BitBlt(Canvas.Handle, 61 Screen.Width-img.Width-(Screen.Width-800)*3 div 8, 62 (Screen.Height-600) div 3, 63 img.Width,img.Height, 64 img.Canvas.Handle,0,0,SRCCOPY); 58 if img <> nil then 59 BitBlt(Canvas.Handle, Screen.Width - img.Width - (Screen.Width - 800) * 60 3 div 8, (Screen.Height - 600) div 3, img.Width, img.Height, 61 img.Canvas.Handle, 0, 0, SRCCOPY); 65 62 end; 66 63 67 64 procedure TBackground.FormClose(Sender: TObject; var Action: TCloseAction); 68 65 begin 69 if img<>nil then begin img.Free; img:=nil end; 66 if img <> nil then 67 begin 68 img.Free; 69 img := nil 70 end; 70 71 end; 71 72 72 73 end. 73 -
trunk/CityProcessing.pas
r2 r6 5 5 6 6 uses 7 Protocol, Database;7 Protocol, Database; 8 8 9 9 // Reporting 10 procedure GetCityAreaInfo(p,Loc: integer; var CityAreaInfo: TCityAreaInfo); 11 function CanCityGrow(p,cix: integer): boolean; 12 function GetCityReport(p,cix: integer; var CityReport: TCityReport): integer; 13 function GetCityReportNew(p,cix: integer; var CityReportNew: TCityReportNew): integer; 10 procedure GetCityAreaInfo(p, Loc: integer; var CityAreaInfo: TCityAreaInfo); 11 function CanCityGrow(p, cix: integer): boolean; 12 function GetCityReport(p, cix: integer; var CityReport: TCityReport): integer; 13 function GetCityReportNew(p, cix: integer; 14 var CityReportNew: TCityReportNew): integer; 14 15 15 16 // Internal Tile Picking 16 function AddBestCityTile(p, cix: integer): boolean;17 procedure CityGrowth(p, cix: integer);18 procedure CityShrink(p, cix: integer);19 procedure Pollute(p, cix: integer);17 function AddBestCityTile(p, cix: integer): boolean; 18 procedure CityGrowth(p, cix: integer); 19 procedure CityShrink(p, cix: integer); 20 procedure Pollute(p, cix: integer); 20 21 21 22 // Turn Processing 22 procedure PayCityMaintenance(p, cix: integer);23 procedure CollectCityResources(p, cix: integer);24 function CityTurn(p, cix: integer): boolean;23 procedure PayCityMaintenance(p, cix: integer); 24 procedure CollectCityResources(p, cix: integer); 25 function CityTurn(p, cix: integer): boolean; 25 26 26 27 // Tile Access 27 function SetCityTiles(p, cix, NewTiles: integer; TestOnly: boolean = false): integer; 28 function SetCityTiles(p, cix, NewTiles: integer; 29 TestOnly: boolean = false): integer; 28 30 procedure GetCityTileAdvice(p, cix: integer; var Advice: TCityTileAdviceData); 29 31 … … 32 34 procedure ReleaseGame; 33 35 34 35 36 implementation 36 37 37 38 type 38 TTradeProcessing=record 39 TaxBonus,LuxBonus,ScienceBonus,FutResBonus,ScienceDoubling,HappyBase: integer; 40 RelCorr: single; 41 FlexibleLuxury: boolean; 39 TTradeProcessing = record 40 TaxBonus, LuxBonus, ScienceBonus, FutResBonus, ScienceDoubling, 41 HappyBase: integer; 42 RelCorr: single; 43 FlexibleLuxury: boolean; 42 44 end; 43 45 44 TProdProcessing=record45 ProdBonus,PollBonus,FutProdBonus,PollThreshold: integer;46 TProdProcessing = record 47 ProdBonus, PollBonus, FutProdBonus, PollThreshold: integer; 46 48 end; 47 49 48 PCityReportEx=^TCityReportEx; 49 TCityReportEx=record 50 BaseHappiness,BaseControl,Material: integer; 50 PCityReportEx = ^TCityReportEx; 51 52 TCityReportEx = record 53 BaseHappiness, BaseControl, Material: integer; 54 ProdProcessing: TProdProcessing; 55 TradeProcessing: TTradeProcessing; 56 end; 57 58 var 59 MaxDist: integer; 60 61 { 62 Reporting 63 ____________________________________________________________________ 64 } 65 procedure GetCityAreaInfo(p, Loc: integer; var CityAreaInfo: TCityAreaInfo); 66 var 67 V21, Loc1, p1: integer; 68 Radius: TVicinity21Loc; 69 begin 70 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap = 0); {$ENDIF} 71 with CityAreaInfo do 72 begin 73 V21_to_Loc(Loc, Radius); 74 for V21 := 0 to 26 do 75 begin 76 Loc1 := Radius[V21]; 77 if (Loc1 < 0) or (Loc1 >= MapSize) then 78 Available[V21] := faInvalid 79 else 80 begin 81 p1 := RealMap[Loc1] shr 27; 82 if (p1 < nPl) and (p1 <> p) and (RW[p].Treaty[p1] >= trPeace) then 83 Available[V21] := faTreaty 84 else if (ZoCMap[Loc1] > 0) and (Occupant[Loc1] <> p) and 85 (RW[p].Treaty[Occupant[Loc1]] < trAlliance) then 86 Available[V21] := faSiege 87 else if (UsedByCity[Loc1] <> -1) and (UsedByCity[Loc1] <> Loc) then 88 Available[V21] := faNotAvailable 89 else 90 Available[V21] := faAvailable 91 end 92 end; 93 end 94 end; 95 96 function CanCityGrow(p, cix: integer): boolean; 97 begin 98 with RW[p].City[cix] do 99 result := (Size < MaxCitySize) and 100 ((Size < NeedAqueductSize) or (Built[imAqueduct] = 1) and 101 (Size < NeedSewerSize) or (Built[imSewer] = 1)); 102 end; 103 104 procedure DetermineCityProdProcessing(p, cix: integer; 105 var ProdProcessing: TProdProcessing); 106 begin 107 with RW[p].City[cix], ProdProcessing do 108 begin 109 ProdBonus := 0; 110 PollBonus := 0; 111 if Built[imFactory] = 1 then 112 inc(ProdBonus); 113 if Built[imMfgPlant] = 1 then 114 inc(ProdBonus); 115 if (Built[imPower] = 1) or (Built[imHydro] = 1) or (Built[imNuclear] = 1) or 116 (GWonder[woHoover].EffectiveOwner = p) then 117 ProdBonus := ProdBonus * 2; 118 if Built[imFactory] = 1 then 119 inc(PollBonus); 120 if Built[imMfgPlant] = 1 then 121 inc(PollBonus); 122 if (Built[imFactory] + Built[imMfgPlant] > 0) then 123 if (Built[imHydro] > 0) or (GWonder[woHoover].EffectiveOwner = p) then 124 dec(PollBonus) 125 else if (Built[imNuclear] = 0) and (Built[imPower] = 1) then 126 inc(PollBonus); 127 if (RW[p].Government <= gDespotism) or (Built[imRecycling] = 1) then 128 PollBonus := -2; // no pollution 129 PollThreshold := Size; 130 FutProdBonus := 0; 131 if RW[p].Tech[futProductionTechnology] > 0 then 132 begin // future tech benefits 133 if Built[imFactory] = 1 then 134 inc(FutProdBonus, FactoryFutureBonus * RW[p].Tech 135 [futProductionTechnology]); 136 if Built[imMfgPlant] = 1 then 137 inc(FutProdBonus, MfgPlantFutureBonus * RW[p].Tech 138 [futProductionTechnology]); 139 end; 140 end; 141 end; 142 143 procedure BoostProd(BaseProd: integer; ProdProcessing: TProdProcessing; 144 var Prod, Poll: integer); 145 begin 146 Poll := BaseProd * (2 + ProdProcessing.PollBonus) shr 1; 147 if Poll <= ProdProcessing.PollThreshold then 148 Poll := 0 149 else 150 dec(Poll, ProdProcessing.PollThreshold); 151 if ProdProcessing.FutProdBonus > 0 then 152 Prod := BaseProd * (100 + ProdProcessing.ProdBonus * 50 + 153 ProdProcessing.FutProdBonus) div 100 154 else 155 Prod := BaseProd * (2 + ProdProcessing.ProdBonus) shr 1; 156 end; 157 158 procedure DetermineCityTradeProcessing(p, cix, HappinessBeforeLux: integer; 159 var TradeProcessing: TTradeProcessing); 160 var 161 i, Dist: integer; 162 begin 163 with RW[p].City[cix], TradeProcessing do 164 begin 165 TaxBonus := 0; 166 ScienceBonus := 0; 167 if Built[imMarket] = 1 then 168 inc(TaxBonus, 2); 169 if Built[imBank] = 1 then 170 begin 171 inc(TaxBonus, 3); 172 if RW[p].NatBuilt[imStockEx] = 1 then 173 inc(TaxBonus, 3); 174 end; 175 LuxBonus := TaxBonus; 176 if Built[imLibrary] = 1 then 177 inc(ScienceBonus, 2); 178 if Built[imUniversity] = 1 then 179 inc(ScienceBonus, 3); 180 if Built[imResLab] = 1 then 181 inc(ScienceBonus, 3); 182 ScienceDoubling := 0; 183 if Built[imNatObs] > 0 then 184 inc(ScienceDoubling); 185 if RW[p].Government = gFundamentalism then 186 dec(ScienceDoubling) 187 else if (GWonder[woNewton].EffectiveOwner = p) and 188 (RW[p].Government = gMonarchy) then 189 inc(ScienceDoubling); 190 FlexibleLuxury := ((ServerVersion[p] >= $0100F1) and 191 (GWonder[woLiberty].EffectiveOwner = p) or (ServerVersion[p] < $0100F1) 192 and (GWonder[woMich].EffectiveOwner = p)) and 193 (RW[p].Government <> gAnarchy); 194 FutResBonus := 0; 195 if RW[p].Tech[futResearchTechnology] > 0 then 196 begin // future tech benefits 197 if Built[imUniversity] = 1 then 198 inc(FutResBonus, UniversityFutureBonus * RW[p].Tech 199 [futResearchTechnology]); 200 if Built[imResLab] = 1 then 201 inc(FutResBonus, ResLabFutureBonus * RW[p].Tech[futResearchTechnology]); 202 end; 203 if (RW[p].NatBuilt[imPalace] > 0) or (ServerVersion[p] < $010000) then 204 begin // calculate corruption 205 Dist := MaxDist; 206 for i := 0 to RW[p].nCity - 1 do 207 if (RW[p].City[i].Loc >= 0) and (RW[p].City[i].Built[imPalace] = 1) then 208 Dist := Distance(Loc, RW[p].City[i].Loc); 209 if (Dist = 0) or (CorrLevel[RW[p].Government] = 0) then 210 RelCorr := 0.0 211 else 212 begin 213 RelCorr := Dist / MaxDist; 214 if CorrLevel[RW[p].Government] > 1 then 215 RelCorr := Exp(ln(RelCorr) / CorrLevel[RW[p].Government]); 216 if Built[imCourt] = 1 then 217 RelCorr := RelCorr / 2; 218 // !!! floating point calculation always deterministic??? 219 end 220 end 221 else if Built[imCourt] = 1 then 222 RelCorr := 0.5 223 else 224 RelCorr := 1.0; 225 HappyBase := Size + HappinessBeforeLux; 226 end 227 end; 228 229 procedure SplitTrade(Trade, TaxRate, LuxRate, Working: integer; 230 TradeProcessing: TTradeProcessing; var Corruption, Tax, Lux, 231 Science: integer); 232 var 233 plus: integer; 234 begin 235 Corruption := Trunc(Trade * TradeProcessing.RelCorr); 236 Tax := (TaxRate * (Trade - Corruption) + 50) div 100; 237 if TradeProcessing.FlexibleLuxury then 238 begin 239 plus := Working * 2 - TradeProcessing.HappyBase; 240 // required additional luxury 241 if plus > 0 then 242 begin 243 Lux := (4 * plus + 3 + TradeProcessing.LuxBonus) 244 div (4 + TradeProcessing.LuxBonus); 245 if Lux > Trade - Corruption then 246 Lux := Trade - Corruption; 247 if Tax > Trade - Corruption - Lux then 248 Tax := Trade - Corruption - Lux; 249 end 250 else 251 Lux := 0; 252 end 253 else if (LuxRate = 0) or (TaxRate = 100) then 254 Lux := 0 255 else 256 Lux := (LuxRate * (Trade - Corruption) + 49) div 100; 257 Science := Trade - Corruption - Lux - Tax; 258 Tax := Tax * (4 + TradeProcessing.TaxBonus) shr 2; 259 Lux := Lux * (4 + TradeProcessing.LuxBonus) shr 2; 260 if TradeProcessing.FutResBonus > 0 then 261 Science := Science * (100 + TradeProcessing.ScienceBonus * 25 + 262 TradeProcessing.FutResBonus) div 100 263 else 264 Science := Science * (4 + TradeProcessing.ScienceBonus) shr 2; 265 Science := Science shl 2 shr (2 - TradeProcessing.ScienceDoubling); 266 end; 267 268 function GetProjectCost(p, cix: integer): integer; 269 var 270 i: integer; 271 begin 272 with RW[p].City[cix] do 273 begin 274 if Project and cpImp = 0 then 275 begin 276 result := RW[p].Model[Project and cpIndex].Cost; { unit project } 277 if Project and cpConscripts <> 0 then 278 begin 279 i := RW[p].Model[Project and cpIndex].MCost; 280 result := result - 3 * i; 281 if result <= 0 then 282 result := i 283 end 284 else if RW[p].Model[Project and cpIndex].Cap[mcLine] > 0 then 285 if Project0 and (not cpAuto or cpRepeat) = Project and not cpAuto or cpRepeat 286 then 287 result := result shr 1 288 else 289 result := result * 2 290 end 291 else 292 begin { improvement project } 293 result := Imp[Project and cpIndex].Cost; 294 if (Project and cpIndex < 28) and (GWonder[woColossus].EffectiveOwner = p) 295 then 296 result := result * ColossusEffect div 100; 297 end; 298 result := result * BuildCostMod[Difficulty[p]] div 12; 299 end 300 end; 301 302 function GetSmallCityReport(p, cix: integer; var CityReport: TCityReport; 303 PCityReportEx: PCityReportEx = nil): integer; 304 var 305 i, uix, V21, Loc1, ForcedSupport, BaseHappiness, Control: integer; 51 306 ProdProcessing: TProdProcessing; 52 307 TradeProcessing: TTradeProcessing; 308 Radius: TVicinity21Loc; 309 UnitReport: TUnitReport; 310 RareOK: array [0 .. 3] of integer; 311 TileInfo: TTileInfo; 312 begin 313 with RW[p].City[cix], CityReport do 314 begin 315 if HypoTiles <= 0 then 316 HypoTiles := Tiles; 317 if HypoTax < 0 then 318 HypoTax := RW[p].TaxRate; 319 if HypoLux < 0 then 320 HypoLux := RW[p].LuxRate; 321 322 if (Flags and chCaptured <> 0) or (RW[p].Government = gAnarchy) then 323 begin 324 Working := 0; 325 for V21 := 1 to 26 do 326 if HypoTiles and (1 shl V21) <> 0 then 327 inc(Working); // for backward compatibility 328 329 if RW[p].Government = gFundamentalism then 330 begin 331 Happy := Size; 332 Control := Size 333 end // !!! old bug, kept for compatibility 334 else 335 begin 336 Happy := 0; 337 Control := 0 338 end; 339 340 BaseHappiness := BasicHappy * 2; 341 Support := 0; 342 Deployed := 0; 343 Eaten := Size * 2; 344 FoodRep := Size * 2; 345 ProdRep := 0; 346 Trade := 0; 347 PollRep := 0; 348 Corruption := 0; 349 Tax := 0; 350 Lux := 0; 351 Science := 0; 352 353 if PCityReportEx <> nil then 354 begin 355 PCityReportEx.Material := ProdRep; 356 PCityReportEx.BaseHappiness := BaseHappiness; 357 PCityReportEx.BaseControl := Control; 358 end; 359 end 360 else // not captured, no anarchy 361 begin 362 Control := 0; 363 BaseHappiness := BasicHappy * 2; 364 Happy := BasicHappy; 365 if (Built[imColosseum] > 0) then 366 begin 367 if (Happy < (Size + 1) shr 1) then 368 Happy := (Size + 1) shr 1; 369 if Size > 4 then 370 BaseHappiness := Size; 371 end; 372 for i := 0 to 27 do 373 if Built[i] = 1 then 374 begin 375 inc(Happy); 376 inc(BaseHappiness, 2) 377 end; 378 if Built[imTemple] = 1 then 379 begin 380 inc(Happy); 381 inc(BaseHappiness, 2) 382 end; 383 if Built[imCathedral] = 1 then 384 begin 385 inc(Happy, 2); 386 inc(BaseHappiness, 4); 387 if GWonder[woBach].EffectiveOwner = p then 388 begin 389 inc(Happy); 390 inc(BaseHappiness, 2) 391 end; 392 end; 393 if Built[imTheater] > 0 then 394 begin 395 inc(Happy, 2); 396 inc(BaseHappiness, 4) 397 end; 398 399 // calculate unit support 400 {$IFOPT O-}assert(InvalidTreatyMap = 0); {$ENDIF} 401 Support := 0; 402 ForcedSupport := 0; 403 Eaten := Size * 2; 404 Deployed := 0; 405 for uix := 0 to RW[p].nUn - 1 do 406 with RW[p].Un[uix] do 407 if (Loc >= 0) and (Home = cix) then 408 begin 409 GetUnitReport(p, uix, UnitReport); 410 inc(Eaten, UnitReport.FoodSupport); 411 if UnitReport.ReportFlags and urfAlwaysSupport <> 0 then 412 inc(ForcedSupport, UnitReport.ProdSupport) 413 else 414 inc(Support, UnitReport.ProdSupport); 415 if UnitReport.ReportFlags and urfDeployed <> 0 then 416 inc(Deployed); 417 end; 418 if Deployed >= Happy then 419 Happy := 0 420 else 421 dec(Happy, Deployed); 422 dec(Support, Size * SupportFree[RW[p].Government] shr 1); 423 if Support < 0 then 424 Support := 0; 425 inc(Support, ForcedSupport); 426 427 { control } 428 case RW[p].Government of 429 gDespotism: 430 for uix := 0 to RW[p].nUn - 1 do 431 if (RW[p].Un[uix].Loc = Loc) and 432 (RW[p].Model[RW[p].Un[uix].mix].Kind = mkSpecial_TownGuard) then 433 begin 434 inc(Happy); 435 inc(Control, 2) 436 end; 437 gFundamentalism: 438 begin 439 BaseHappiness := 0; // done by control 440 Happy := Size; 441 Control := Size 442 end; 443 end; 444 445 // collect processing parameters 446 DetermineCityProdProcessing(p, cix, ProdProcessing); 447 DetermineCityTradeProcessing(p, cix, BaseHappiness + Control - 2 * 448 Deployed, TradeProcessing); 449 450 // collect resources 451 Working := 0; 452 FoodRep := 0; 453 ProdRep := 0; 454 Trade := 0; 455 FillChar(RareOK, SizeOf(RareOK), 0); 456 V21_to_Loc(Loc, Radius); 457 for V21 := 1 to 26 do 458 if HypoTiles and (1 shl V21) <> 0 then 459 begin { sum resources of exploited tiles } 460 Loc1 := Radius[V21]; 461 if (Loc1 < 0) or (Loc1 >= MapSize) then 462 // HypoTiles go beyond map border! 463 begin 464 result := eInvalid; 465 exit 466 end; 467 GetTileInfo(p, cix, Loc1, TileInfo); 468 inc(FoodRep, TileInfo.Food); 469 inc(ProdRep, TileInfo.Prod); 470 inc(Trade, TileInfo.Trade); 471 if (RealMap[Loc1] and fModern <> 0) and 472 (RW[p].Tech[adMassProduction] >= tsApplicable) then 473 inc(RareOK[RealMap[Loc1] shr 25 and 3]); 474 inc(Working) 475 end; 476 if Built[imAlgae] = 1 then 477 inc(FoodRep, 12); 478 479 if PCityReportEx <> nil then 480 begin 481 PCityReportEx.Material := ProdRep; 482 PCityReportEx.BaseHappiness := BaseHappiness; 483 PCityReportEx.BaseControl := Control; 484 PCityReportEx.ProdProcessing := ProdProcessing; 485 PCityReportEx.TradeProcessing := TradeProcessing; 486 end; 487 488 BoostProd(ProdRep, ProdProcessing, ProdRep, PollRep); 489 SplitTrade(Trade, HypoTax, HypoLux, Working, TradeProcessing, Corruption, 490 Tax, Lux, Science); 491 Happy := Happy + (Lux + Size and 1) shr 1; 492 // new style disorder requires 1 lux less for cities with odd size 493 494 // check if rare resource available 495 if (GTestFlags and tfNoRareNeed = 0) and (ProdRep > Support) and 496 (Project and cpImp <> 0) and ((Project and cpIndex = imShipComp) and 497 (RareOK[1] = 0) or (Project and cpIndex = imShipPow) and (RareOK[2] = 0) 498 or (Project and cpIndex = imShipHab) and (RareOK[3] = 0)) then 499 ProdRep := Support; 500 end; 53 501 end; 54 55 var 56 MaxDist: integer; 502 result := eOk; 503 end; { GetSmallCityReport } 504 505 function GetCityReport(p, cix: integer; var CityReport: TCityReport): integer; 506 begin 507 result := GetSmallCityReport(p, cix, CityReport); 508 CityReport.Storage := StorageSize[Difficulty[p]]; 509 CityReport.ProdCost := GetProjectCost(p, cix); 510 end; 511 512 function GetCityReportNew(p, cix: integer; 513 var CityReportNew: TCityReportNew): integer; 514 var 515 CityReport: TCityReport; 516 CityReportEx: TCityReportEx; 517 begin 518 with CityReportNew do 519 begin 520 CityReport.HypoTiles := HypoTiles; 521 CityReport.HypoTax := HypoTaxRate; 522 CityReport.HypoLux := HypoLuxuryRate; 523 result := GetSmallCityReport(p, cix, CityReport, @CityReportEx); 524 FoodSupport := CityReport.Eaten - 2 * RW[p].City[cix].Size; 525 MaterialSupport := CityReport.Support; 526 ProjectCost := GetProjectCost(p, cix); 527 Storage := StorageSize[Difficulty[p]]; 528 Deployed := CityReport.Deployed; 529 Morale := CityReportEx.BaseHappiness; 530 CollectedControl := CityReportEx.BaseControl + 531 (RW[p].City[cix].Size - CityReport.Working) * 2; 532 CollectedFood := CityReport.FoodRep; 533 CollectedMaterial := CityReportEx.Material; 534 CollectedTrade := CityReport.Trade; 535 Working := CityReport.Working; 536 Production := CityReport.ProdRep - CityReport.Support; 537 AddPollution := CityReport.PollRep; 538 Corruption := CityReport.Corruption; 539 Tax := CityReport.Tax; 540 Science := CityReport.Science; 541 Luxury := CityReport.Lux; 542 FoodSurplus := CityReport.FoodRep - CityReport.Eaten; 543 HappinessBalance := Morale + Luxury + CollectedControl - RW[p].City[cix] 544 .Size - 2 * Deployed; 545 end; 546 end; 57 547 58 548 { 59 Reporting60 ____________________________________________________________________549 Internal Tile Picking 550 ____________________________________________________________________ 61 551 } 62 procedure GetCityAreaInfo(p,Loc: integer; var CityAreaInfo: TCityAreaInfo); 63 var 64 V21, Loc1, p1: integer; 65 Radius: TVicinity21Loc; 66 begin 67 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap=0);{$ENDIF} 68 with CityAreaInfo do 552 procedure NextBest(p, cix: integer; var SelectedLoc, SelectedV21: integer); 553 { best tile unused but available by city cix } 554 var 555 Resources, Most, Loc1, p1, V21: integer; 556 TileInfo: TTileInfo; 557 Radius: TVicinity21Loc; 558 begin 559 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap = 0); {$ENDIF} 560 Most := 0; 561 SelectedLoc := -1; 562 SelectedV21 := -1; 563 with RW[p].City[cix] do 69 564 begin 70 V21_to_Loc(Loc,Radius); 71 for V21:=0 to 26 do 72 begin 73 Loc1:=Radius[V21]; 74 if (Loc1<0) or (Loc1>=MapSize) then Available[V21]:=faInvalid 75 else 76 begin 77 p1:=RealMap[Loc1] shr 27; 78 if (p1<nPl) and (p1<>p) and (RW[p].Treaty[p1]>=trPeace) then 79 Available[V21]:=faTreaty 80 else if (ZoCMap[Loc1]>0) and (Occupant[Loc1]<>p) 81 and (RW[p].Treaty[Occupant[Loc1]]<trAlliance) then 82 Available[V21]:=faSiege 83 else if (UsedByCity[Loc1]<>-1) and (UsedByCity[Loc1]<>Loc) then 84 Available[V21]:=faNotAvailable 85 else Available[V21]:=faAvailable 86 end 87 end; 88 end 89 end; 90 91 function CanCityGrow(p,cix: integer): boolean; 92 begin 93 with RW[p].City[cix] do 94 result:= (Size<MaxCitySize) and ((Size<NeedAqueductSize) 95 or (Built[imAqueduct]=1) and (Size<NeedSewerSize) 96 or (Built[imSewer]=1)); 97 end; 98 99 procedure DetermineCityProdProcessing(p,cix: integer; 100 var ProdProcessing: TProdProcessing); 101 begin 102 with RW[p].City[cix],ProdProcessing do 103 begin 104 ProdBonus:=0; 105 PollBonus:=0; 106 if Built[imFactory]=1 then 107 inc(ProdBonus); 108 if Built[imMfgPlant]=1 then 109 inc(ProdBonus); 110 if (Built[imPower]=1) or (Built[imHydro]=1) 111 or (Built[imNuclear]=1) or (GWonder[woHoover].EffectiveOwner=p) then 112 ProdBonus:=ProdBonus*2; 113 if Built[imFactory]=1 then 114 inc(PollBonus); 115 if Built[imMfgPlant]=1 then 116 inc(PollBonus); 117 if (Built[imFactory]+Built[imMfgPlant]>0) then 118 if (Built[imHydro]>0) 119 or (GWonder[woHoover].EffectiveOwner=p) then 120 dec(PollBonus) 121 else if (Built[imNuclear]=0) and (Built[imPower]=1) then 122 inc(PollBonus); 123 if (RW[p].Government<=gDespotism) or (Built[imRecycling]=1) then 124 PollBonus:=-2; // no pollution 125 PollThreshold:=Size; 126 FutProdBonus:=0; 127 if RW[p].Tech[futProductionTechnology]>0 then 128 begin // future tech benefits 129 if Built[imFactory]=1 then 130 inc(FutProdBonus,FactoryFutureBonus*RW[p].Tech[futProductionTechnology]); 131 if Built[imMfgPlant]=1 then 132 inc(FutProdBonus,MfgPlantFutureBonus*RW[p].Tech[futProductionTechnology]); 133 end; 134 end; 135 end; 136 137 procedure BoostProd(BaseProd: integer; ProdProcessing: TProdProcessing; 138 var Prod,Poll: integer); 139 begin 140 Poll:=BaseProd*(2+ProdProcessing.PollBonus) shr 1; 141 if Poll<=ProdProcessing.PollThreshold then 142 Poll:=0 143 else dec(Poll,ProdProcessing.PollThreshold); 144 if ProdProcessing.FutProdBonus>0 then 145 Prod:=BaseProd*(100+ProdProcessing.ProdBonus*50+ProdProcessing.FutProdBonus) div 100 146 else Prod:=BaseProd*(2+ProdProcessing.ProdBonus) shr 1; 147 end; 148 149 procedure DetermineCityTradeProcessing(p,cix,HappinessBeforeLux: integer; 150 var TradeProcessing: TTradeProcessing); 151 var 152 i,Dist: integer; 153 begin 154 with RW[p].City[cix],TradeProcessing do 155 begin 156 TaxBonus:=0; 157 ScienceBonus:=0; 158 if Built[imMarket]=1 then 159 inc(TaxBonus,2); 160 if Built[imBank]=1 then 161 begin 162 inc(TaxBonus,3); 163 if RW[p].NatBuilt[imStockEx]=1 then 164 inc(TaxBonus,3); 165 end; 166 LuxBonus:=TaxBonus; 167 if Built[imLibrary]=1 then 168 inc(ScienceBonus,2); 169 if Built[imUniversity]=1 then 170 inc(ScienceBonus,3); 171 if Built[imResLab]=1 then 172 inc(ScienceBonus,3); 173 ScienceDoubling:=0; 174 if Built[imNatObs]>0 then 175 inc(ScienceDoubling); 176 if RW[p].Government=gFundamentalism then 177 dec(ScienceDoubling) 178 else if (GWonder[woNewton].EffectiveOwner=p) and (RW[p].Government=gMonarchy) then 179 inc(ScienceDoubling); 180 FlexibleLuxury:= 181 ((ServerVersion[p]>=$0100F1) and (GWonder[woLiberty].EffectiveOwner=p) 182 or (ServerVersion[p]<$0100F1) and (GWonder[woMich].EffectiveOwner=p)) 183 and (RW[p].Government<>gAnarchy); 184 FutResBonus:=0; 185 if RW[p].Tech[futResearchTechnology]>0 then 186 begin // future tech benefits 187 if Built[imUniversity]=1 then 188 inc(FutResBonus,UniversityFutureBonus*RW[p].Tech[futResearchTechnology]); 189 if Built[imResLab]=1 then 190 inc(FutResBonus,ResLabFutureBonus*RW[p].Tech[futResearchTechnology]); 191 end; 192 if (RW[p].NatBuilt[imPalace]>0) or (ServerVersion[p]<$010000) then 193 begin // calculate corruption 194 Dist:=MaxDist; 195 for i:=0 to RW[p].nCity-1 do 196 if (RW[p].City[i].Loc>=0) and (RW[p].City[i].Built[imPalace]=1) then 197 Dist:=Distance(Loc,RW[p].City[i].Loc); 198 if (Dist=0) or (CorrLevel[RW[p].Government]=0) then 199 RelCorr:=0.0 200 else 201 begin 202 RelCorr:=Dist/MaxDist; 203 if CorrLevel[RW[p].Government]>1 then 204 RelCorr:= 205 Exp(ln(RelCorr)/CorrLevel[RW[p].Government]); 206 if Built[imCourt]=1 then 207 RelCorr:=RelCorr/2; 208 // !!! floating point calculation always deterministic??? 209 end 210 end 211 else if Built[imCourt]=1 then 212 RelCorr:=0.5 213 else RelCorr:=1.0; 214 HappyBase:=Size+HappinessBeforeLux; 215 end 216 end; 217 218 procedure SplitTrade(Trade,TaxRate,LuxRate,Working: integer; 219 TradeProcessing :TTradeProcessing; var Corruption,Tax,Lux,Science: integer); 220 var 221 plus: integer; 222 begin 223 Corruption:=Trunc(Trade*TradeProcessing.RelCorr); 224 Tax:=(TaxRate*(Trade-Corruption)+50) div 100; 225 if TradeProcessing.FlexibleLuxury then 226 begin 227 plus:=Working*2-TradeProcessing.HappyBase; // required additional luxury 228 if plus>0 then 229 begin 230 Lux:=(4*plus +3+TradeProcessing.LuxBonus) div (4+TradeProcessing.LuxBonus); 231 if Lux>Trade-Corruption then Lux:=Trade-Corruption; 232 if Tax>Trade-Corruption-Lux then Tax:=Trade-Corruption-Lux; 233 end 234 else Lux:=0; 235 end 236 else if (LuxRate=0) or (TaxRate=100) then Lux:=0 237 else Lux:=(LuxRate*(Trade-Corruption)+49) div 100; 238 Science:=Trade-Corruption-Lux-Tax; 239 Tax:=Tax*(4+TradeProcessing.TaxBonus) shr 2; 240 Lux:=Lux*(4+TradeProcessing.LuxBonus) shr 2; 241 if TradeProcessing.FutResBonus>0 then 242 Science:=Science*(100+TradeProcessing.ScienceBonus*25+TradeProcessing.FutResBonus) div 100 243 else Science:=Science*(4+TradeProcessing.ScienceBonus) shr 2; 244 Science:=Science shl 2 shr (2-TradeProcessing.ScienceDoubling); 245 end; 246 247 function GetProjectCost(p,cix: integer): integer; 248 var 249 i: integer; 250 begin 251 with RW[p].City[cix] do 252 begin 253 if Project and cpImp=0 then 254 begin 255 result:=RW[p].Model[Project and cpIndex].Cost; {unit project} 256 if Project and cpConscripts<>0 then 257 begin 258 i:=RW[p].Model[Project and cpIndex].MCost; 259 result:=result-3*i; 260 if result<=0 then result:=i 261 end 262 else if RW[p].Model[Project and cpIndex].Cap[mcLine]>0 then 263 if Project0 and (not cpAuto or cpRepeat)=Project and not cpAuto or cpRepeat then 264 result:=result shr 1 265 else result:=result*2 266 end 267 else 268 begin {improvement project} 269 result:=Imp[Project and cpIndex].Cost; 270 if (Project and cpIndex<28) and (GWonder[woColossus].EffectiveOwner=p) then 271 result:=result*ColossusEffect div 100; 272 end; 273 result:=result*BuildCostMod[Difficulty[p]] div 12; 274 end 275 end; 276 277 function GetSmallCityReport(p,cix: integer; var CityReport: TCityReport; 278 pCityReportEx: PCityReportEx = nil): integer; 279 var 280 i,uix,V21,Loc1,ForcedSupport,BaseHappiness,Control: integer; 281 ProdProcessing: TProdProcessing; 282 TradeProcessing: TTradeProcessing; 283 Radius: TVicinity21Loc; 284 UnitReport: TUnitReport; 285 RareOK: array[0..3] of integer; 286 TileInfo:TTileInfo; 287 begin 288 with RW[p].City[cix], CityReport do 289 begin 290 if HypoTiles<=0 then HypoTiles:=Tiles; 291 if HypoTax<0 then HypoTax:=RW[p].TaxRate; 292 if HypoLux<0 then HypoLux:=RW[p].LuxRate; 293 294 if (Flags and chCaptured<>0) or (RW[p].Government=gAnarchy) then 295 begin 296 Working:=0; 297 for V21:=1 to 26 do if HypoTiles and (1 shl V21)<>0 then 298 inc(Working); // for backward compatibility 299 300 if RW[p].Government=gFundamentalism then 301 begin Happy:=Size; Control:=Size end // !!! old bug, kept for compatibility 302 else begin Happy:=0; Control:=0 end; 303 304 BaseHappiness:=BasicHappy*2; 305 Support:=0; 306 Deployed:=0; 307 Eaten:=Size*2; 308 FoodRep:=Size*2; 309 ProdRep:=0; 310 Trade:=0; 311 PollRep:=0; 312 Corruption:=0; 313 Tax:=0; 314 Lux:=0; 315 Science:=0; 316 317 if pCityReportEx<>nil then 318 begin 319 pCityReportEx.Material:=ProdRep; 320 pCityReportEx.BaseHappiness:=BaseHappiness; 321 pCityReportEx.BaseControl:=Control; 322 end; 323 end 324 else // not captured, no anarchy 325 begin 326 Control:=0; 327 BaseHappiness:=BasicHappy*2; 328 Happy:=BasicHappy; 329 if (Built[imColosseum]>0) then 330 begin 331 if (Happy<(Size+1) shr 1) then 332 Happy:=(Size+1) shr 1; 333 if Size>4 then 334 BaseHappiness:=Size; 335 end; 336 for i:=0 to 27 do if Built[i]=1 then 337 begin inc(Happy); inc(BaseHappiness,2) end; 338 if Built[imTemple]=1 then 339 begin inc(Happy); inc(BaseHappiness,2) end; 340 if Built[imCathedral]=1 then 341 begin 342 inc(Happy,2); inc(BaseHappiness,4); 343 if GWonder[woBach].EffectiveOwner=p then 344 begin inc(Happy); inc(BaseHappiness,2) end; 345 end; 346 if Built[imTheater]>0 then 347 begin inc(Happy,2); inc(BaseHappiness,4) end; 348 349 // calculate unit support 350 {$IFOPT O-}assert(InvalidTreatyMap=0);{$ENDIF} 351 Support:=0; ForcedSupport:=0; Eaten:=Size*2; Deployed:=0; 352 for uix:=0 to RW[p].nUn-1 do with RW[p].Un[uix] do 353 if (Loc>=0) and (Home=cix) then 565 V21_to_Loc(Loc, Radius); 566 for V21 := 1 to 26 do 567 begin 568 Loc1 := Radius[V21]; 569 if (Loc1 >= 0) and (Loc1 < MapSize) and (UsedByCity[Loc1] = -1) then 570 begin 571 p1 := RealMap[Loc1] shr 27; 572 if ((p1 = nPl) or (p1 = p) or (RW[p].Treaty[p1] < trPeace)) and 573 ((ZoCMap[Loc1] = 0) or (Occupant[Loc1] = p) or 574 (RW[p].Treaty[Occupant[Loc1]] = trAlliance)) then 354 575 begin 355 GetUnitReport(p,uix,UnitReport); 356 inc(Eaten,UnitReport.FoodSupport); 357 if UnitReport.ReportFlags and urfAlwaysSupport<>0 then 358 inc(ForcedSupport, UnitReport.ProdSupport) 359 else inc(Support, UnitReport.ProdSupport); 360 if UnitReport.ReportFlags and urfDeployed<>0 then 361 inc(Deployed); 362 end; 363 if Deployed>=Happy then Happy:=0 else dec(Happy,Deployed); 364 dec(Support,Size*SupportFree[RW[p].Government] shr 1); 365 if Support<0 then Support:=0; 366 inc(Support,ForcedSupport); 367 368 {control} 369 case RW[p].Government of 370 gDespotism: 371 for uix:=0 to RW[p].nUn-1 do 372 if (RW[p].Un[uix].Loc=Loc) 373 and (RW[p].Model[RW[p].Un[uix].mix].Kind=mkSpecial_TownGuard) then 374 begin inc(Happy); inc(Control,2) end; 375 gFundamentalism: 376 begin 377 BaseHappiness:=0; // done by control 378 Happy:=Size; 379 Control:=Size 380 end; 381 end; 382 383 // collect processing parameters 384 DetermineCityProdProcessing(p, cix, ProdProcessing); 385 DetermineCityTradeProcessing(p, cix, BaseHappiness+Control-2*Deployed, TradeProcessing); 386 387 // collect resources 388 Working:=0; 389 FoodRep:=0;ProdRep:=0;Trade:=0; 390 FillChar(RareOK,SizeOf(RareOK),0); 391 V21_to_Loc(Loc,Radius); 392 for V21:=1 to 26 do if HypoTiles and (1 shl V21)<>0 then 393 begin {sum resources of exploited tiles} 394 Loc1:=Radius[V21]; 395 if (Loc1<0) or (Loc1>=MapSize) then // HypoTiles go beyond map border! 396 begin result:=eInvalid; exit end; 397 GetTileInfo(p,cix,Loc1,TileInfo); 398 inc(FoodRep,TileInfo.Food); 399 inc(ProdRep,TileInfo.Prod); 400 inc(Trade,TileInfo.Trade); 401 if (RealMap[Loc1] and fModern<>0) and (RW[p].Tech[adMassProduction]>=tsApplicable) then 402 inc(RareOK[RealMap[Loc1] shr 25 and 3]); 403 inc(Working) 404 end; 405 if Built[imAlgae]=1 then 406 inc(FoodRep,12); 407 408 if pCityReportEx<>nil then 409 begin 410 pCityReportEx.Material:=ProdRep; 411 pCityReportEx.BaseHappiness:=BaseHappiness; 412 pCityReportEx.BaseControl:=Control; 413 pCityReportEx.ProdProcessing:=ProdProcessing; 414 pCityReportEx.TradeProcessing:=TradeProcessing; 415 end; 416 417 BoostProd(ProdRep,ProdProcessing,ProdRep,PollRep); 418 SplitTrade(Trade,HypoTax,HypoLux,Working,TradeProcessing, 419 Corruption,Tax,Lux,Science); 420 Happy:=Happy+(Lux+Size and 1) shr 1; 421 //new style disorder requires 1 lux less for cities with odd size 422 423 // check if rare resource available 424 if (GTestFlags and tfNoRareNeed=0) and (ProdRep>Support) 425 and (Project and cpImp<>0) 426 and ((Project and cpIndex=imShipComp) and (RareOK[1]=0) 427 or (Project and cpIndex=imShipPow) and (RareOK[2]=0) 428 or (Project and cpIndex=imShipHab) and (RareOK[3]=0)) then 429 ProdRep:=Support; 430 end; 431 end; 432 result:=eOk; 433 end; {GetSmallCityReport} 434 435 function GetCityReport(p,cix: integer; var CityReport: TCityReport): integer; 436 begin 437 result:=GetSmallCityReport(p,cix,CityReport); 438 CityReport.Storage:=StorageSize[Difficulty[p]]; 439 CityReport.ProdCost:=GetProjectCost(p,cix); 440 end; 441 442 function GetCityReportNew(p,cix: integer; var CityReportNew: TCityReportNew): integer; 443 var 444 CityReport: TCityReport; 445 CityReportEx: TCityReportEx; 446 begin 447 with CityReportNew do 448 begin 449 CityReport.HypoTiles:=HypoTiles; 450 CityReport.HypoTax:=HypoTaxRate; 451 CityReport.HypoLux:=HypoLuxuryRate; 452 result:=GetSmallCityReport(p,cix,CityReport,@CityReportEx); 453 FoodSupport:=CityReport.Eaten-2*RW[p].City[cix].Size; 454 MaterialSupport:=CityReport.Support; 455 ProjectCost:=GetProjectCost(p,cix); 456 Storage:=StorageSize[Difficulty[p]]; 457 Deployed:=CityReport.Deployed; 458 Morale:=CityReportEx.BaseHappiness; 459 CollectedControl:=CityReportEx.BaseControl+(RW[p].City[cix].Size-CityReport.Working)*2; 460 CollectedFood:=CityReport.FoodRep; 461 CollectedMaterial:=CityReportEx.Material; 462 CollectedTrade:=CityReport.Trade; 463 Working:=CityReport.Working; 464 Production:=CityReport.ProdRep-CityReport.Support; 465 AddPollution:=CityReport.PollRep; 466 Corruption:=CityReport.Corruption; 467 Tax:=CityReport.Tax; 468 Science:=CityReport.Science; 469 Luxury:=CityReport.Lux; 470 FoodSurplus:=CityReport.FoodRep-CityReport.Eaten; 471 HappinessBalance:=Morale+Luxury+CollectedControl 472 -RW[p].City[cix].Size-2*Deployed; 473 end; 474 end; 475 476 { 477 Internal Tile Picking 478 ____________________________________________________________________ 479 } 480 procedure NextBest(p,cix:integer; var SelectedLoc, SelectedV21: integer); 481 {best tile unused but available by city cix} 482 var 483 Resources,Most,Loc1,p1,V21:integer; 484 TileInfo:TTileInfo; 485 Radius: TVicinity21Loc; 486 begin 487 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap=0);{$ENDIF} 488 Most:=0; 489 SelectedLoc:=-1; 490 SelectedV21:=-1; 491 with RW[p].City[cix] do 492 begin 493 V21_to_Loc(Loc,Radius); 494 for V21:=1 to 26 do 495 begin 496 Loc1:=Radius[V21]; 497 if (Loc1>=0) and (Loc1<MapSize) and (UsedByCity[Loc1]=-1) then 498 begin 499 p1:=RealMap[Loc1] shr 27; 500 if ((p1=nPl) or (p1=p) or (RW[p].Treaty[p1]<trPeace)) 501 and ((ZoCMap[Loc1]=0) or (Occupant[Loc1]=p) 502 or (RW[p].Treaty[Occupant[Loc1]]=trAlliance)) then 503 begin 504 GetTileInfo(p,cix,Loc1,TileInfo); 505 Resources:=TileInfo.Food shl 16+TileInfo.Prod shl 8+TileInfo.Trade; 506 {priority: 1.food - 2.prod - 3.trade} 507 if Resources>Most then 576 GetTileInfo(p, cix, Loc1, TileInfo); 577 Resources := TileInfo.Food shl 16 + TileInfo.Prod shl 8 + 578 TileInfo.Trade; 579 { priority: 1.food - 2.prod - 3.trade } 580 if Resources > Most then 508 581 begin 509 SelectedLoc:=Loc1;510 SelectedV21:=V21;511 Most:=Resources582 SelectedLoc := Loc1; 583 SelectedV21 := V21; 584 Most := Resources 512 585 end 513 586 end … … 517 590 end; 518 591 519 procedure NextWorst(p, cix:integer; var SelectedLoc, SelectedV21: integer);520 { worst tile used by city cix}521 var 522 Resources,Least,Loc1,V21:integer;523 Radius: TVicinity21Loc;524 TileInfo:TTileInfo;525 begin 526 Least:=MaxInt;527 SelectedLoc:=-1;528 SelectedV21:=-1;529 with RW[p].City[cix] do592 procedure NextWorst(p, cix: integer; var SelectedLoc, SelectedV21: integer); 593 { worst tile used by city cix } 594 var 595 Resources, Least, Loc1, V21: integer; 596 Radius: TVicinity21Loc; 597 TileInfo: TTileInfo; 598 begin 599 Least := MaxInt; 600 SelectedLoc := -1; 601 SelectedV21 := -1; 602 with RW[p].City[cix] do 530 603 begin 531 V21_to_Loc(Loc,Radius); 532 for V21:=1 to 26 do if V21<>CityOwnTile then 533 begin 534 Loc1:=Radius[V21]; 535 if (Loc1>=0) and (Loc1<MapSize) and (1 shl V21 and Tiles<>0) then 536 begin 537 GetTileInfo(p,cix,Loc1,TileInfo); 538 Resources:=TileInfo.Food shl 16+TileInfo.Prod shl 8+TileInfo.Trade; 539 {priority: 1.food - 2.prod - 3.trade} 540 if Resources<Least then 604 V21_to_Loc(Loc, Radius); 605 for V21 := 1 to 26 do 606 if V21 <> CityOwnTile then 607 begin 608 Loc1 := Radius[V21]; 609 if (Loc1 >= 0) and (Loc1 < MapSize) and (1 shl V21 and Tiles <> 0) then 541 610 begin 542 SelectedLoc:=Loc1; 543 SelectedV21:=V21; 544 Least:=Resources 545 end 546 end; 547 end 611 GetTileInfo(p, cix, Loc1, TileInfo); 612 Resources := TileInfo.Food shl 16 + TileInfo.Prod shl 8 + 613 TileInfo.Trade; 614 { priority: 1.food - 2.prod - 3.trade } 615 if Resources < Least then 616 begin 617 SelectedLoc := Loc1; 618 SelectedV21 := V21; 619 Least := Resources 620 end 621 end; 622 end 548 623 end 549 624 end; 550 625 551 function NextPoll(p, cix:integer):integer;552 var 553 Resources,Best,dx,dy,Loc1,Dist,BestDist,V21,pTerr:integer;554 Radius: TVicinity21Loc;555 TileInfo:TTileInfo;556 begin 557 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap =0);{$ENDIF}558 Best:=0;559 result:=-1;560 with RW[p].City[cix] do626 function NextPoll(p, cix: integer): integer; 627 var 628 Resources, Best, dx, dy, Loc1, Dist, BestDist, V21, pTerr: integer; 629 Radius: TVicinity21Loc; 630 TileInfo: TTileInfo; 631 begin 632 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap = 0); {$ENDIF} 633 Best := 0; 634 result := -1; 635 with RW[p].City[cix] do 561 636 begin 562 V21_to_Loc(Loc,Radius); 563 for V21:=1 to 26 do if V21<>CityOwnTile then 564 begin 565 Loc1:=Radius[V21]; 566 if (Loc1>=0) and (Loc1<MapSize) 567 and (RealMap[Loc1] and fTerrain>=fGrass) 568 and (RealMap[Loc1] and (fPoll or fDeadLands or fCity)=0) then 569 begin 570 pTerr:=RealMap[Loc1] shr 27; 571 if (pTerr=nPl) or (pTerr=p) or (RW[p].Treaty[pTerr]<trPeace) then 637 V21_to_Loc(Loc, Radius); 638 for V21 := 1 to 26 do 639 if V21 <> CityOwnTile then 640 begin 641 Loc1 := Radius[V21]; 642 if (Loc1 >= 0) and (Loc1 < MapSize) and 643 (RealMap[Loc1] and fTerrain >= fGrass) and 644 (RealMap[Loc1] and (fPoll or fDeadLands or fCity) = 0) then 572 645 begin 573 GetTileInfo(p,cix,Loc1,TileInfo); 574 Resources:=TileInfo.Prod shl 16+TileInfo.Trade shl 8+TileInfo.Food; 575 {priority: 1.prod - 2.trade - 3.food} 576 dy:=V21 shr 2-3; 577 dx:=V21 and 3 shl 1 -3 + (dy+3) and 1; 578 Dist:=abs(dx)+abs(dy)+abs(abs(dx)-abs(dy)) shr 1; 579 if (Resources>Best) or (Resources=Best) and (Dist<BestDist) then 646 pTerr := RealMap[Loc1] shr 27; 647 if (pTerr = nPl) or (pTerr = p) or (RW[p].Treaty[pTerr] < trPeace) 648 then 580 649 begin 581 result:=Loc1; 582 Best:=Resources; 583 BestDist:=Dist 584 end 585 end 586 end 587 end; 588 end 589 end; 590 591 function AddBestCityTile(p,cix: integer): boolean; 592 var 593 TileLoc,V21: integer; 594 begin 595 NextBest(p,cix,TileLoc,V21); 596 result:= TileLoc>=0; 597 if result then with RW[p].City[cix] do 598 begin 599 assert(1 shl V21 and Tiles=0); 600 Tiles:=Tiles or (1 shl V21); 601 UsedByCity[TileLoc]:=Loc 602 end 603 end; 604 605 procedure CityGrowth(p,cix: integer); 606 var 607 TileLoc,V21: integer; 608 AltCityReport:TCityReport; 609 begin 610 with RW[p].City[cix] do 611 begin 612 inc(Size); 613 NextBest(p,cix,TileLoc,V21); 614 if TileLoc>=0 then 615 begin {test whether exploitation of tile would lead to disorder} 616 AltCityReport.HypoTiles:=Tiles+1 shl V21; 617 AltCityReport.HypoTax:=-1; 618 AltCityReport.HypoLux:=-1; 619 GetSmallCityReport(p,cix,AltCityReport); 620 if AltCityReport.Working-AltCityReport.Happy<=Size shr 1 then // !!! change to new style disorder 621 begin {no disorder -- exploit tile} 622 assert(1 shl V21 and Tiles=0); 623 Tiles:=Tiles or (1 shl V21); 624 UsedByCity[TileLoc]:=Loc 625 end 626 end; 627 end 628 end; 629 630 procedure CityShrink(p,cix: integer); 631 var 632 TileLoc, V21, Working: integer; 633 AltCityReport:TCityReport; 634 begin 635 with RW[p].City[cix] do 636 begin 637 Working:=0; 638 for V21:=1 to 26 do if Tiles and (1 shl V21)<>0 then inc(Working); 639 dec(Size); 640 if Food>StorageSize[Difficulty[p]] then Food:=StorageSize[Difficulty[p]]; 641 NextWorst(p,cix,TileLoc,V21); 642 if Working>Size then 643 begin {all citizens were working -- worst tile no longer exploited} 644 assert(1 shl V21 and Tiles<>0); 645 Tiles:=Tiles and not (1 shl V21); 646 UsedByCity[TileLoc]:=-1 647 end 648 else {test whether exploitation of tile would lead to disorder} 649 begin 650 AltCityReport.HypoTiles:=-1; 651 AltCityReport.HypoTax:=-1; 652 AltCityReport.HypoLux:=-1; 653 GetSmallCityReport(p,cix,AltCityReport); 654 if AltCityReport.Working-AltCityReport.Happy>Size shr 1 then // !!! change to new style disorder 655 begin {disorder -- don't exploit tile} 656 assert(1 shl V21 and Tiles<>0); 657 Tiles:=Tiles and not (1 shl V21); 658 UsedByCity[TileLoc]:=-1 659 end 660 end; 661 end 662 end; 663 664 procedure Pollute(p,cix: integer); 665 var 666 PollutionLoc: integer; 667 begin 668 with RW[p].City[cix] do 669 begin 670 Pollution:=Pollution-MaxPollution; 671 PollutionLoc:=NextPoll(p,cix); 672 if PollutionLoc>=0 then 673 begin 674 inc(Flags,chPollution); 675 RealMap[PollutionLoc]:=RealMap[PollutionLoc] or fPoll; 676 end 677 end; 678 end; 679 680 { 681 Turn Processing 682 ____________________________________________________________________ 683 } 684 procedure PayCityMaintenance(p,cix: integer); 685 var 686 i: integer; 687 begin 688 with RW[p],City[cix] do 689 for i:=28 to nImp-1 do 690 if (Built[i]>0) 691 and (Project0 and (cpImp or cpIndex)<>(cpImp or i)) then // don't pay maintenance when just completed 692 begin 693 dec(Money,Imp[i].Maint); 694 if Money<0 then 695 begin {out of money - sell improvement} 696 inc(Money,Imp[i].Cost*BuildCostMod[Difficulty[p]] div 12); 697 Built[i]:=0; 698 if Imp[i].Kind<>ikCommon then 699 begin 700 assert(i<>imSpacePort); // never sell automatically! (solution: no maintenance) 701 NatBuilt[i]:=0; 702 if i=imGrWall then GrWallContinent[p]:=-1; 703 end; 704 inc(Flags,chImprovementLost) 705 end 706 end; 707 end; 708 709 procedure CollectCityResources(p,cix: integer); 710 var 711 CityStorage,CityProjectCost: integer; 712 CityReport: TCityReportNew; 713 Disorder: boolean; 714 begin 715 with RW[p],City[cix],CityReport do 716 if Flags and chCaptured<>0 then 717 begin 718 Flags:=Flags and not chDisorder; 719 dec(Flags,$10000); 720 if Flags and chCaptured=0 then 721 Flags:=Flags or chAfterCapture; 722 end 723 else if Government=gAnarchy then 724 Flags:=Flags and not chDisorder 725 else 726 begin 727 HypoTiles:=-1; 728 HypoTaxRate:=-1; 729 HypoLuxuryRate:=-1; 730 GetCityReportNew(p,cix,CityReport); 731 CityStorage:=StorageSize[Difficulty[p]]; 732 CityProjectCost:=GetProjectCost(p,cix); 733 734 Disorder:= (HappinessBalance<0); 735 if Disorder and (Flags and chDisorder<>0) then 736 CollectedMaterial:=0; // second turn disorder 737 if Disorder then 738 Flags:=Flags or chDisorder 739 else Flags:=Flags and not chDisorder; 740 741 if not Disorder 742 and ((Government=gFuture) 743 or (Size>=NeedAqueductSize) and (FoodSurplus<2)) and (FoodSurplus>0) then 744 inc(Money,FoodSurplus) 745 else if not (Disorder and (FoodSurplus>0)) then 746 begin {calculate new food storage} 747 Food:=Food+FoodSurplus; 748 if ((GTestFlags and tfImmGrow<>0) 749 or (Food>=CityStorage) and (Food-FoodSurplus<CityStorage)) // only warn once 750 and (Size<MaxCitySize) 751 and (Project and (cpImp+cpIndex)<>cpImp+imAqueduct) 752 and (Project and (cpImp+cpIndex)<>cpImp+imSewer) 753 and not CanCityGrow(p,cix) then 754 inc(Flags,chNoGrowthWarning); 755 end; 756 757 if Prod>CityProjectCost then 758 begin inc(Money,Prod-CityProjectCost); Prod:=CityProjectCost end; 759 if Production<0 then 760 Flags:=Flags or chUnitLost 761 else if not Disorder and (Flags and chProductionSabotaged=0) then 762 if Project and (cpImp+cpIndex)=cpImp+imTrGoods then 763 inc(Money,Production) 764 else inc(Prod,Production); 765 766 if not Disorder then 767 begin 768 {sum research points and taxes} 769 inc(Research,Science); 770 inc(Money,Tax); 771 Pollution:=Pollution+AddPollution; 772 end; 773 end; 774 end; 775 776 function CityTurn(p,cix: integer): boolean; 777 // return value: whether city keeps existing 778 var 779 i,uix,cix2,p1,SizeMod,CityStorage,CityProjectCost,NewImp,Det,TestDet: integer; 780 LackOfMaterial, CheckGrow, DoProd, IsActive: boolean; 781 begin 782 with RW[p],City[cix] do 783 begin 784 SizeMod:=0; 785 CityStorage:=StorageSize[Difficulty[p]]; 786 CityProjectCost:=GetProjectCost(p,cix); 787 788 LackOfMaterial:= Flags and chUnitLost<>0; 789 Flags:=Flags and not chUnitLost; 790 791 IsActive:= (Government<>gAnarchy) and (Flags and chCaptured=0); 792 CheckGrow:=(Flags and chDisorder=0) and IsActive 793 and (Government<>gFuture); 794 if CheckGrow and (GTestFlags and tfImmGrow<>0) then {fast growth} 795 begin 796 if CanCityGrow(p,cix) then inc(SizeMod) 797 end 798 else if CheckGrow and (Food>=CityStorage) then {normal growth} 799 begin 800 if CanCityGrow(p,cix) then 801 begin 802 if Built[imGranary]=1 then dec(Food,CityStorage shr 1) 803 else dec(Food,CityStorage); 804 inc(SizeMod) 805 end 806 end 807 else if Food<0 then {famine} 808 begin 809 Food:=0; 810 // check if settlers or conscripts there to disband 811 uix:=-1; 812 for i:=0 to nUn-1 do 813 if (Un[i].Loc>=0) and (Un[i].Home=cix) 814 and ((Model[Un[i].mix].Kind=mkSettler) 815 {and (GWonder[woFreeSettlers].EffectiveOwner<>p)} 816 or (Un[i].Flags and unConscripts<>0)) 817 and ((uix=-1) or (Model[Un[i].mix].Cost<Model[Un[uix].mix].Cost) 818 or (Model[Un[i].mix].Cost=Model[Un[uix].mix].Cost) 819 and (Un[i].Exp<Un[uix].Exp)) then 820 uix:=i; 821 822 if uix>=0 then 823 begin RemoveUnit_UpdateMap(p,uix); inc(Flags,chUnitLost); end 824 else begin dec(SizeMod); inc(Flags,chPopDecrease) end 825 end; 826 if Food>CityStorage then Food:=CityStorage; 827 828 if LackOfMaterial then 829 begin 830 if Flags and chUnitLost=0 then 831 begin {one unit lost} 832 uix:=-1; 833 Det:=MaxInt; 834 for i:=0 to nUn-1 do if (Un[i].Loc>=0) and (Un[i].Home=cix) then 835 with Model[Un[i].mix] do 836 begin 837 if Kind=mkSpecial_TownGuard then 838 TestDet:=Un[i].Health+Un[i].Exp shl 8 // disband townguards first 839 else 650 GetTileInfo(p, cix, Loc1, TileInfo); 651 Resources := TileInfo.Prod shl 16 + TileInfo.Trade shl 8 + 652 TileInfo.Food; 653 { priority: 1.prod - 2.trade - 3.food } 654 dy := V21 shr 2 - 3; 655 dx := V21 and 3 shl 1 - 3 + (dy + 3) and 1; 656 Dist := abs(dx) + abs(dy) + abs(abs(dx) - abs(dy)) shr 1; 657 if (Resources > Best) or (Resources = Best) and (Dist < BestDist) 658 then 840 659 begin 841 TestDet:=Un[i].Health+Un[i].Exp shl 8+Cost shl 16; // value of unit 842 if Flags and mdDoubleSupport<>0 then 843 TestDet:=TestDet shr 1; // double support, tend to disband first 844 end; 845 if TestDet<Det then 846 begin uix:=i; Det:=TestDet end; 847 end; 848 if uix>=0 then 849 begin 850 RemoveUnit_UpdateMap(p,uix); 851 inc(Flags,chUnitLost); 852 end 853 end 854 end; 855 856 if GTestFlags and tfImmImprove<>0 then Prod:=CityProjectCost; 857 DoProd:= (Project and (cpImp+cpIndex)<>cpImp+imTrGoods) 858 and (Prod>=CityProjectCost); 859 860 // check if wonder already built 861 if (Project and cpImp<>0) and (Project and cpIndex<28) 862 and (GWonder[Project and cpIndex].CityID<>-1) then 863 begin inc(Flags,chOldWonder); DoProd:=false; end; 864 865 // check if producing settlers would disband city 866 if DoProd and (Project and (cpImp or cpDisbandCity)=0) 867 and ((Size+SizeMod-2<2) and (Model[Project and cpIndex].Kind=mkSettler) 868 or (Size+SizeMod-1<2) and ((Model[Project and cpIndex].Kind=mkSlaves) 869 or (Project and cpConscripts<>0))) then 870 begin inc(Flags,chNoSettlerProd); DoProd:=false; end; 871 872 if DoProd then 873 begin {project complete} 874 dec(Prod,CityProjectCost); 875 if Project and cpImp=0 then {produce unit} 876 begin 877 if nUn<numax then 878 begin 879 CreateUnit(p,Project and cpIndex); 880 Un[nUn-1].Loc:=Loc; 881 with Un[nUn-1] do 882 begin 883 Home:=cix; 884 if (Model[mix].Domain<dSea) and (Built[imElite]=1) then 885 Exp:=ExpCost*(nExp-1){elite} 886 else if (Model[mix].Domain<dSea) and (Built[imBarracks]=1) 887 or (Model[mix].Domain=dSea) and (Built[imDockyard]=1) 888 or (Model[mix].Domain=dAir) and (Built[imAirport]=1) then 889 Exp:=ExpCost*2;{vet} 890 if Project and cpConscripts<>0 then Flags:=Flags or unConscripts 891 end; 892 PlaceUnit(p,nUn-1); 893 UpdateUnitMap(Loc); 894 if Model[Project and cpIndex].Kind=mkSettler then 895 dec(SizeMod,2) {settler produced - city shrink} 896 else if (Model[Project and cpIndex].Kind=mkSlaves) 897 or (Project and cpConscripts<>0) then 898 dec(SizeMod); {slaves/conscripts produced - city shrink} 899 end; 900 Project0:=Project or cpRepeat or cpCompleted; 901 end 902 else if Imp[Project and cpIndex].Kind=ikShipPart then 903 begin {produce ship parts} 904 inc(GShip[p].Parts[Project and cpIndex-imShipComp]); 905 Project0:=Project or cpCompleted; 906 end 907 else {produce improvement} 908 begin 909 NewImp:=Project and cpIndex; 910 inc(Money,Prod);{change rest to money} 911 Project0:=Project or cpCompleted; 912 Project:=cpImp+imTrGoods; 913 Prod:=0; 914 915 if Imp[NewImp].Kind in [ikNatLocal,ikNatGlobal] then 916 begin // nat. project 917 for i:=0 to nCity-1 do 918 if (City[i].Loc>=0) and (City[i].Built[NewImp]=1) then 919 begin {allowed only once} 920 inc(Money,Imp[NewImp].Cost 921 *BuildCostMod[Difficulty[p]] div 12); 922 City[i].Built[NewImp]:=0; 923 end; 924 NatBuilt[NewImp]:=1; 925 926 // immediate nat. project effects 927 case NewImp of 928 imGrWall: GrWallContinent[p]:=Continent[Loc]; 929 end; 930 end; 931 932 if NewImp<28 then 933 begin // wonder 934 GWonder[NewImp].CityID:=ID; 935 GWonder[NewImp].EffectiveOwner:=p; 936 CheckExpiration(NewImp); 937 938 // immediate wonder effects 939 case NewImp of 940 woEiffel: 941 begin // reactivate wonders 942 for i:=0 to 27 do if Imp[i].Expiration>=0 then 943 for cix2:=0 to nCity-1 do 944 if (City[cix2].Loc>=0) and (City[cix2].Built[i]=1) then 945 GWonder[i].EffectiveOwner:=p 946 end; 947 woLighthouse: CheckSpecialModels(p,preLighthouse); 948 woLeo: 949 begin 950 inc(Research, 951 TechBaseCost(nTech[p],Difficulty[p]) 952 +TechBaseCost(nTech[p]+2,Difficulty[p])); 953 CheckSpecialModels(p,preLeo); 954 end; 955 woPyramids: CheckSpecialModels(p,preBuilder); 956 woMir: 957 begin 958 for p1:=0 to nPl-1 do 959 if (p1<>p) and (1 shl p1 and GAlive<>0) then 960 begin 961 if RW[p].Treaty[p1]=trNoContact then 962 IntroduceEnemy(p,p1); 963 GiveCivilReport(p, p1); 964 GiveMilReport(p, p1) 965 end; 966 end 967 end; 968 end; 969 970 for i:=0 to nImpReplacement-1 do // sell obsolete buildings 971 if (ImpReplacement[i].NewImp=NewImp) 972 and (Built[ImpReplacement[i].OldImp]>0) then 973 begin 974 inc(RW[p].Money, Imp[ImpReplacement[i].OldImp].Cost 975 *BuildCostMod[Difficulty[p]] div 12); 976 Built[ImpReplacement[i].OldImp]:=0; 977 end; 978 979 if NewImp in [imPower,imHydro,imNuclear] then 980 for i:=0 to nImp-1 do 981 if (i<>NewImp) and (i in [imPower,imHydro,imNuclear]) 982 and (Built[i]>0) then 983 begin // sell obsolete power plant 984 inc(RW[p].Money, Imp[i].Cost*BuildCostMod[Difficulty[p]] div 12); 985 Built[i]:=0; 986 end; 987 988 Built[NewImp]:=1; 989 end; 990 Prod0:=Prod; 991 inc(Flags,chProduction) 992 end 993 else 994 begin 995 Project0:=Project0 and not cpCompleted; 996 if Project0 and not cpAuto<>Project and not cpAuto then 997 Project0:=Project; 998 Prod0:=Prod; 999 end; 1000 1001 if SizeMod>0 then 1002 begin 1003 CityGrowth(p,cix); 1004 inc(Flags,chPopIncrease); 1005 end; 1006 result:= Size+SizeMod>=2; 1007 if result then 1008 while SizeMod<0 do 1009 begin CityShrink(p,cix); inc(SizeMod) end; 1010 end 1011 end; //CityTurn 1012 1013 { 1014 Tile Access 1015 ____________________________________________________________________ 1016 } 1017 function SetCityTiles(p, cix, NewTiles: integer; TestOnly: boolean = false): integer; 1018 var 1019 V21,Working,ChangeTiles,AddTiles,Loc1: integer; 1020 CityAreaInfo: TCityAreaInfo; 1021 Radius: TVicinity21Loc; 1022 begin 1023 with RW[p].City[cix] do 1024 begin 1025 ChangeTiles:=NewTiles xor integer(Tiles); 1026 AddTiles:=NewTiles and not Tiles; 1027 if Mode=moPlaying then 1028 begin // do all checks 1029 if NewTiles and not $67F7F76<>0 then 1030 begin result:=eInvalid; exit end; // invalid tile index included 1031 if NewTiles and (1 shl 13)=0 then 1032 begin result:=eViolation; exit end; // city tile must be exploited 1033 if ChangeTiles=0 then 1034 begin result:=eNotChanged; exit end; 1035 if AddTiles<>0 then 1036 begin 1037 // check if new tiles possible 1038 GetCityAreaInfo(p, Loc, CityAreaInfo); 1039 for V21:=1 to 26 do if AddTiles and (1 shl V21)<>0 then 1040 if CityAreaInfo.Available[V21]<>faAvailable then 1041 begin result:=eTileNotAvailable; exit end; 1042 // not more tiles than inhabitants 1043 Working:=0; 1044 for V21:=1 to 26 do if NewTiles and (1 shl V21)<>0 then inc(Working); 1045 if Working>Size then 1046 begin result:=eNoWorkerAvailable; exit end; 1047 end; 1048 end; 1049 result:=eOK; 1050 if not TestOnly then 1051 begin 1052 V21_to_Loc(Loc,Radius); 1053 for V21:=1 to 26 do if ChangeTiles and (1 shl V21)<>0 then 1054 begin 1055 Loc1:=Radius[V21]; 1056 assert((Loc1>=0) and (Loc1<MapSize)); 1057 if NewTiles and (1 shl V21)<>0 then UsedByCity[Loc1]:=Loc // employ tile 1058 else if UsedByCity[Loc1]<>Loc then 1059 assert(Mode<moPlaying) 1060 // should only happen during loading, because of wrong sSetCityTiles command order 1061 else UsedByCity[Loc1]:=-1 // unemploy tile 1062 end; 1063 Tiles:=NewTiles 1064 end 1065 end; 1066 end; 1067 1068 procedure GetCityTileAdvice(p, cix: integer; var Advice: TCityTileAdviceData); 1069 const 1070 oFood=0; oProd=1; oTax=2; oScience=3; 1071 type 1072 TTileData=record 1073 Food,Prod,Trade,SubValue,V21: integer; 1074 end; 1075 var 1076 i,V21,Loc1,nHierarchy,iH,iT,iH_Switch,MinWorking,MaxWorking, 1077 WantedProd,MinFood,MinProd,count,Take,MaxTake,AreaSize,FormulaCode, 1078 NeedRare, RareTiles,cix1,dx,dy,BestTiles,ProdBeforeBoost,TestTiles, 1079 SubPlus,SuperPlus: integer; 1080 SuperValue,BestSuperValue,SubValue,BestSubValue: integer; 1081 Value,BestValue,ValuePlus: extended; 1082 ValueFormula_Weight: array[oFood..oScience] of extended; 1083 ValueFormula_Multiply: array[oFood..oScience] of boolean; 1084 Output: array[oFood..oScience] of integer; 1085 TileInfo, BaseTileInfo: TTileInfo; 1086 Radius, Radius1: TVicinity21Loc; 1087 TestReport: TCityReport; 1088 CityReportEx: TCityReportEx; 1089 CityAreaInfo: TCityAreaInfo; 1090 Hierarchy: array[0..20,0..31] of TTileData; 1091 nTile,nSelection: array[0..20] of integer; 1092 SubCriterion: array[0..27] of integer; 1093 FoodWasted, FoodToTax, ProdToTax, RareOk, NeedStep2, IsBest: boolean; 1094 begin 1095 if (RW[p].Government=gAnarchy) or (RW[p].City[cix].Flags and chCaptured<>0) then 1096 begin 1097 Fillchar(Advice.CityReport, sizeof(Advice.CityReport), 0); 1098 Advice.Tiles:=1 shl CityOwnTile; 1099 Advice.CityReport.HypoTiles:=1 shl CityOwnTile; 1100 exit; 1101 end; 1102 1103 for i:=oFood to oScience do 1104 begin //decode evaluation formula from weights parameter 1105 FormulaCode:=Advice.ResourceWeights shr (24-8*i) and $FF; 1106 ValueFormula_Multiply[i]:= FormulaCode and $80<>0; 1107 if FormulaCode and $40<>0 then 1108 ValueFormula_Weight[i]:=(FormulaCode and $0F) 1109 *(1 shl (FormulaCode and $30 shr 4))/16 1110 else ValueFormula_Weight[i]:=(FormulaCode and $0F) 1111 *(1 shl (FormulaCode and $30 shr 4)); 1112 end; 1113 1114 TestReport.HypoTiles:=1 shl CityOwnTile; 1115 TestReport.HypoTax:=-1; 1116 TestReport.HypoLux:=-1; 1117 GetSmallCityReport(p,cix,TestReport,@CityReportEx); 1118 with RW[p].City[cix] do 1119 begin 1120 V21_to_Loc(Loc,Radius); 1121 FoodToTax:= RW[p].Government=gFuture; 1122 ProdToTax:= Project and (cpImp+cpIndex)=cpImp+imTrGoods; 1123 FoodWasted:=not FoodToTax and (Food=StorageSize[Difficulty[p]]) 1124 and not CanCityGrow(p,cix); 1125 1126 // sub criteria 1127 for V21:=1 to 26 do 1128 begin 1129 Loc1:=Radius[V21]; 1130 if Loc1>=0 then 1131 SubCriterion[V21]:=3360-(Distance(Loc,Loc1)-1)*32-V21 xor $15; 1132 end; 1133 for cix1:=0 to RW[p].nCity-1 do if cix1<>cix then 1134 begin 1135 Loc1:=RW[p].City[cix1].Loc; 1136 if Loc1>=0 then 1137 begin 1138 if Distance(Loc,Loc1)<=10 then 1139 begin // cities overlap -- prefer tiles outside common range 1140 V21_to_Loc(Loc1,Radius1); 1141 for V21:=1 to 26 do 1142 begin 1143 Loc1:=Radius1[V21]; 1144 if (Loc1>=0) and (Loc1<MapSize) and (Distance(Loc,Loc1)<=5) then 1145 begin 1146 dxdy(Loc,Loc1,dx,dy); 1147 dec(SubCriterion[(dy+3) shl 2+(dx+3) shr 1],160); 660 result := Loc1; 661 Best := Resources; 662 BestDist := Dist 1148 663 end 1149 664 end 1150 665 end 666 end; 667 end 668 end; 669 670 function AddBestCityTile(p, cix: integer): boolean; 671 var 672 TileLoc, V21: integer; 673 begin 674 NextBest(p, cix, TileLoc, V21); 675 result := TileLoc >= 0; 676 if result then 677 with RW[p].City[cix] do 678 begin 679 assert(1 shl V21 and Tiles = 0); 680 Tiles := Tiles or (1 shl V21); 681 UsedByCity[TileLoc] := Loc 682 end 683 end; 684 685 procedure CityGrowth(p, cix: integer); 686 var 687 TileLoc, V21: integer; 688 AltCityReport: TCityReport; 689 begin 690 with RW[p].City[cix] do 691 begin 692 inc(Size); 693 NextBest(p, cix, TileLoc, V21); 694 if TileLoc >= 0 then 695 begin { test whether exploitation of tile would lead to disorder } 696 AltCityReport.HypoTiles := Tiles + 1 shl V21; 697 AltCityReport.HypoTax := -1; 698 AltCityReport.HypoLux := -1; 699 GetSmallCityReport(p, cix, AltCityReport); 700 if AltCityReport.Working - AltCityReport.Happy <= Size shr 1 then 701 // !!! change to new style disorder 702 begin { no disorder -- exploit tile } 703 assert(1 shl V21 and Tiles = 0); 704 Tiles := Tiles or (1 shl V21); 705 UsedByCity[TileLoc] := Loc 1151 706 end 1152 707 end; 1153 1154 GetCityAreaInfo(p,Loc,CityAreaInfo); 1155 AreaSize:=0; 1156 for V21:=1 to 26 do 1157 if CityAreaInfo.Available[V21]=faAvailable then 1158 inc(AreaSize); 1159 1160 if RW[p].Government=gFundamentalism then 1161 begin 1162 MinWorking:=Size; 1163 MaxWorking:=Size; 708 end 709 end; 710 711 procedure CityShrink(p, cix: integer); 712 var 713 TileLoc, V21, Working: integer; 714 AltCityReport: TCityReport; 715 begin 716 with RW[p].City[cix] do 717 begin 718 Working := 0; 719 for V21 := 1 to 26 do 720 if Tiles and (1 shl V21) <> 0 then 721 inc(Working); 722 dec(Size); 723 if Food > StorageSize[Difficulty[p]] then 724 Food := StorageSize[Difficulty[p]]; 725 NextWorst(p, cix, TileLoc, V21); 726 if Working > Size then 727 begin { all citizens were working -- worst tile no longer exploited } 728 assert(1 shl V21 and Tiles <> 0); 729 Tiles := Tiles and not(1 shl V21); 730 UsedByCity[TileLoc] := -1 1164 731 end 1165 else 1166 begin 1167 MinWorking:=CityReportEx.TradeProcessing.HappyBase shr 1; 1168 if MinWorking>Size then 1169 MinWorking:=Size; 1170 if (RW[p].LuxRate=0) 1171 and not CityReportEx.TradeProcessing.FlexibleLuxury then 1172 MaxWorking:=MinWorking 1173 else MaxWorking:=Size; 1174 end; 1175 if MaxWorking>AreaSize then 1176 begin 1177 MaxWorking:=AreaSize; 1178 if MinWorking>AreaSize then 1179 MinWorking:=AreaSize; 1180 end; 1181 if TestReport.Support=0 then 1182 WantedProd:=0 1183 else WantedProd:=1+(TestReport.Support*100-1) 1184 div (100+CityReportEx.ProdProcessing.ProdBonus*50+CityReportEx.ProdProcessing.FutProdBonus); 1185 1186 // consider resources for ship parts 1187 NeedRare:=0; 1188 if (GTestFlags and tfNoRareNeed=0) and (Project and cpImp<>0) then 1189 case Project and cpIndex of 1190 imShipComp: NeedRare:=fCobalt; 1191 imShipPow: NeedRare:=fUranium; 1192 imShipHab: NeedRare:=fMercury; 1193 end; 1194 if NeedRare>0 then 1195 begin 1196 RareTiles:=0; 1197 for V21:=1 to 26 do 1198 begin 1199 Loc1:=Radius[V21]; 1200 if (Loc1>=0) and (Loc1<MapSize) and (RealMap[Loc1] and fModern=cardinal(NeedRare)) then 1201 RareTiles:=RareTiles or (1 shl V21); 732 else { test whether exploitation of tile would lead to disorder } 733 begin 734 AltCityReport.HypoTiles := -1; 735 AltCityReport.HypoTax := -1; 736 AltCityReport.HypoLux := -1; 737 GetSmallCityReport(p, cix, AltCityReport); 738 if AltCityReport.Working - AltCityReport.Happy > Size shr 1 then 739 // !!! change to new style disorder 740 begin { disorder -- don't exploit tile } 741 assert(1 shl V21 and Tiles <> 0); 742 Tiles := Tiles and not(1 shl V21); 743 UsedByCity[TileLoc] := -1 1202 744 end 1203 745 end; 1204 1205 // step 1: sort tiles to hierarchies 1206 nHierarchy:=0; 1207 for V21:=1 to 26 do // non-rare tiles 1208 if (CityAreaInfo.Available[V21]=faAvailable) 1209 and ((NeedRare=0) or (1 shl V21 and RareTiles=0)) then 1210 begin 1211 Loc1:=Radius[V21]; 1212 assert((Loc1>=0) and (Loc1<MapSize)); 1213 GetTileInfo(p,cix,Loc1,TileInfo); 1214 if V21=CityOwnTile then 1215 BaseTileInfo:=TileInfo 746 end 747 end; 748 749 procedure Pollute(p, cix: integer); 750 var 751 PollutionLoc: integer; 752 begin 753 with RW[p].City[cix] do 754 begin 755 Pollution := Pollution - MaxPollution; 756 PollutionLoc := NextPoll(p, cix); 757 if PollutionLoc >= 0 then 758 begin 759 inc(Flags, chPollution); 760 RealMap[PollutionLoc] := RealMap[PollutionLoc] or fPoll; 761 end 762 end; 763 end; 764 765 { 766 Turn Processing 767 ____________________________________________________________________ 768 } 769 procedure PayCityMaintenance(p, cix: integer); 770 var 771 i: integer; 772 begin 773 with RW[p], City[cix] do 774 for i := 28 to nImp - 1 do 775 if (Built[i] > 0) and (Project0 and (cpImp or cpIndex) <> (cpImp or i)) 776 then // don't pay maintenance when just completed 777 begin 778 dec(Money, Imp[i].Maint); 779 if Money < 0 then 780 begin { out of money - sell improvement } 781 inc(Money, Imp[i].Cost * BuildCostMod[Difficulty[p]] div 12); 782 Built[i] := 0; 783 if Imp[i].Kind <> ikCommon then 784 begin 785 assert(i <> imSpacePort); 786 // never sell automatically! (solution: no maintenance) 787 NatBuilt[i] := 0; 788 if i = imGrWall then 789 GrWallContinent[p] := -1; 790 end; 791 inc(Flags, chImprovementLost) 792 end 793 end; 794 end; 795 796 procedure CollectCityResources(p, cix: integer); 797 var 798 CityStorage, CityProjectCost: integer; 799 CityReport: TCityReportNew; 800 Disorder: boolean; 801 begin 802 with RW[p], City[cix], CityReport do 803 if Flags and chCaptured <> 0 then 804 begin 805 Flags := Flags and not chDisorder; 806 dec(Flags, $10000); 807 if Flags and chCaptured = 0 then 808 Flags := Flags or chAfterCapture; 809 end 810 else if Government = gAnarchy then 811 Flags := Flags and not chDisorder 812 else 813 begin 814 HypoTiles := -1; 815 HypoTaxRate := -1; 816 HypoLuxuryRate := -1; 817 GetCityReportNew(p, cix, CityReport); 818 CityStorage := StorageSize[Difficulty[p]]; 819 CityProjectCost := GetProjectCost(p, cix); 820 821 Disorder := (HappinessBalance < 0); 822 if Disorder and (Flags and chDisorder <> 0) then 823 CollectedMaterial := 0; // second turn disorder 824 if Disorder then 825 Flags := Flags or chDisorder 1216 826 else 1217 begin 1218 iH:=0; 1219 while iH<nHierarchy do 1220 begin 1221 iT:=0; 1222 while (iT<nTile[iH]) 1223 and (TileInfo.Food<=Hierarchy[iH,iT].Food) 1224 and (TileInfo.Prod<=Hierarchy[iH,iT].Prod) 1225 and (TileInfo.Trade<=Hierarchy[iH,iT].Trade) 1226 and not ((TileInfo.Food=Hierarchy[iH,iT].Food) 1227 and (TileInfo.Prod=Hierarchy[iH,iT].Prod) 1228 and (TileInfo.Trade=Hierarchy[iH,iT].Trade) 1229 and (SubCriterion[V21]>=SubCriterion[Hierarchy[iH,iT].V21])) do 1230 inc(iT); 1231 if (iT=nTile[iH]) // new worst tile in this hierarchy 1232 or ((TileInfo.Food>=Hierarchy[iH,iT].Food) // new middle tile in this hierarchy 1233 and (TileInfo.Prod>=Hierarchy[iH,iT].Prod) 1234 and (TileInfo.Trade>=Hierarchy[iH,iT].Trade)) then 1235 break; // insert position found! 1236 inc(iH); 1237 end; 1238 if iH=nHierarchy then 1239 begin // need to start new hierarchy 1240 nTile[iH]:=0; 1241 inc(nHierarchy); 1242 iT:=0; 1243 end; 1244 move(Hierarchy[iH,iT], Hierarchy[iH,iT+1], (nTile[iH]-iT)*sizeof(TTileData)); 1245 inc(nTile[iH]); 1246 Hierarchy[iH,iT].V21:=V21; 1247 Hierarchy[iH,iT].Food:=TileInfo.Food; 1248 Hierarchy[iH,iT].Prod:=TileInfo.Prod; 1249 Hierarchy[iH,iT].Trade:=TileInfo.Trade; 1250 Hierarchy[iH,iT].SubValue:=SubCriterion[V21]; 1251 end 1252 end; 1253 if NeedRare<>0 then 1254 begin // rare tiles need own hierarchy 1255 iH:=nHierarchy; 1256 for V21:=1 to 26 do 1257 if (CityAreaInfo.Available[V21]=faAvailable) 1258 and (1 shl V21 and RareTiles<>0) then 1259 begin 1260 Loc1:=Radius[V21]; 1261 assert((V21<>CityOwnTile) and (Loc1>=0) and (Loc1<MapSize)); 1262 GetTileInfo(p,cix,Loc1,TileInfo); 1263 if iH=nHierarchy then 1264 begin // need to start new hierarchy 1265 nTile[iH]:=0; 1266 inc(nHierarchy); 1267 iT:=0; 1268 end 1269 else iT:=nTile[iH]; 1270 inc(nTile[iH]); 1271 Hierarchy[iH,iT].V21:=V21; 1272 Hierarchy[iH,iT].Food:=TileInfo.Food; // = 0 1273 Hierarchy[iH,iT].Prod:=TileInfo.Prod; // = 1 1274 Hierarchy[iH,iT].Trade:=TileInfo.Trade; // = 0 1275 Hierarchy[iH,iT].SubValue:=SubCriterion[V21]; 1276 end; 1277 end; 1278 if Built[imAlgae]>0 then 1279 inc(BaseTileInfo.Food,12); 1280 1281 // step 2: summarize resources 1282 for iH:=0 to nHierarchy-1 do 1283 begin 1284 move(Hierarchy[iH,0], Hierarchy[iH,1], nTile[iH]*sizeof(TTileData)); 1285 Hierarchy[iH,0].Food:=0; 1286 Hierarchy[iH,0].Prod:=0; 1287 Hierarchy[iH,0].Trade:=0; 1288 Hierarchy[iH,0].SubValue:=0; 1289 Hierarchy[iH,0].V21:=0; 1290 for iT:=1 to nTile[iH] do 1291 begin 1292 inc(Hierarchy[iH,iT].Food, Hierarchy[iH,iT-1].Food); 1293 inc(Hierarchy[iH,iT].Prod, Hierarchy[iH,iT-1].Prod); 1294 inc(Hierarchy[iH,iT].Trade, Hierarchy[iH,iT-1].Trade); 1295 inc(Hierarchy[iH,iT].SubValue, Hierarchy[iH,iT-1].SubValue); 1296 Hierarchy[iH,iT].V21:=1 shl Hierarchy[iH,iT].V21+Hierarchy[iH,iT-1].V21; 1297 end; 1298 end; 1299 1300 // step 3: try all combinations 1301 BestValue:=0.0; 1302 BestSuperValue:=0; 1303 BestSubValue:=0; 1304 BestTiles:=0; 1305 fillchar(nSelection, sizeof(nSelection),0); 1306 TestReport.FoodRep:=BaseTileInfo.Food; 1307 ProdBeforeBoost:=BaseTileInfo.Prod; 1308 TestReport.Trade:=BaseTileInfo.Trade; 1309 TestReport.Working:=1; 1310 MinFood:=0; 1311 MinProd:=0; 1312 iH_Switch:=nHierarchy; 1313 count:=0; 1314 repeat 1315 // ensure minima 1316 iH:=0; 1317 while (TestReport.Working<MaxWorking) and (iH<iH_Switch) 1318 and ((TestReport.Working<MinWorking) or (TestReport.FoodRep<TestReport.Eaten) 1319 or (ProdBeforeBoost<WantedProd)) do 1320 begin 1321 assert(nSelection[iH]=0); 1322 Take:=MinWorking-TestReport.Working; 1323 if Take>nTile[iH] then 1324 Take:=nTile[iH] 827 Flags := Flags and not chDisorder; 828 829 if not Disorder and ((Government = gFuture) or (Size >= NeedAqueductSize) 830 and (FoodSurplus < 2)) and (FoodSurplus > 0) then 831 inc(Money, FoodSurplus) 832 else if not(Disorder and (FoodSurplus > 0)) then 833 begin { calculate new food storage } 834 Food := Food + FoodSurplus; 835 if ((GTestFlags and tfImmGrow <> 0) or (Food >= CityStorage) and 836 (Food - FoodSurplus < CityStorage)) // only warn once 837 and (Size < MaxCitySize) and 838 (Project and (cpImp + cpIndex) <> cpImp + imAqueduct) and 839 (Project and (cpImp + cpIndex) <> cpImp + imSewer) and 840 not CanCityGrow(p, cix) then 841 inc(Flags, chNoGrowthWarning); 842 end; 843 844 if Prod > CityProjectCost then 845 begin 846 inc(Money, Prod - CityProjectCost); 847 Prod := CityProjectCost 848 end; 849 if Production < 0 then 850 Flags := Flags or chUnitLost 851 else if not Disorder and (Flags and chProductionSabotaged = 0) then 852 if Project and (cpImp + cpIndex) = cpImp + imTrGoods then 853 inc(Money, Production) 854 else 855 inc(Prod, Production); 856 857 if not Disorder then 858 begin 859 { sum research points and taxes } 860 inc(Research, Science); 861 inc(Money, Tax); 862 Pollution := Pollution + AddPollution; 863 end; 864 end; 865 end; 866 867 function CityTurn(p, cix: integer): boolean; 868 // return value: whether city keeps existing 869 var 870 i, uix, cix2, p1, SizeMod, CityStorage, CityProjectCost, NewImp, Det, 871 TestDet: integer; 872 LackOfMaterial, CheckGrow, DoProd, IsActive: boolean; 873 begin 874 with RW[p], City[cix] do 875 begin 876 SizeMod := 0; 877 CityStorage := StorageSize[Difficulty[p]]; 878 CityProjectCost := GetProjectCost(p, cix); 879 880 LackOfMaterial := Flags and chUnitLost <> 0; 881 Flags := Flags and not chUnitLost; 882 883 IsActive := (Government <> gAnarchy) and (Flags and chCaptured = 0); 884 CheckGrow := (Flags and chDisorder = 0) and IsActive and 885 (Government <> gFuture); 886 if CheckGrow and (GTestFlags and tfImmGrow <> 0) then { fast growth } 887 begin 888 if CanCityGrow(p, cix) then 889 inc(SizeMod) 890 end 891 else if CheckGrow and (Food >= CityStorage) then { normal growth } 892 begin 893 if CanCityGrow(p, cix) then 894 begin 895 if Built[imGranary] = 1 then 896 dec(Food, CityStorage shr 1) 897 else 898 dec(Food, CityStorage); 899 inc(SizeMod) 900 end 901 end 902 else if Food < 0 then { famine } 903 begin 904 Food := 0; 905 // check if settlers or conscripts there to disband 906 uix := -1; 907 for i := 0 to nUn - 1 do 908 if (Un[i].Loc >= 0) and (Un[i].Home = cix) and 909 ((Model[Un[i].mix].Kind = mkSettler) 910 { and (GWonder[woFreeSettlers].EffectiveOwner<>p) } 911 or (Un[i].Flags and unConscripts <> 0)) and 912 ((uix = -1) or (Model[Un[i].mix].Cost < Model[Un[uix].mix].Cost) or 913 (Model[Un[i].mix].Cost = Model[Un[uix].mix].Cost) and 914 (Un[i].Exp < Un[uix].Exp)) then 915 uix := i; 916 917 if uix >= 0 then 918 begin 919 RemoveUnit_UpdateMap(p, uix); 920 inc(Flags, chUnitLost); 921 end 1325 922 else 1326 begin 1327 if Take<0 then 1328 Take:=0; 1329 MaxTake:=nTile[iH]; 1330 if TestReport.Working+MaxTake>MaxWorking then 1331 MaxTake:=MaxWorking-TestReport.Working; 1332 while (Take<MaxTake) and (TestReport.FoodRep+Hierarchy[iH,Take].Food<MinFood) do 1333 inc(Take); 1334 while (Take<MaxTake) and (ProdBeforeBoost+Hierarchy[iH,Take].Prod<MinProd) do 1335 inc(Take); 1336 end; 1337 nSelection[iH]:=Take; 1338 inc(TestReport.Working, Take); 1339 with Hierarchy[iH,Take] do 1340 begin 1341 inc(TestReport.FoodRep,Food); 1342 inc(ProdBeforeBoost,Prod); 1343 inc(TestReport.Trade,Trade); 1344 end; 1345 inc(iH); 1346 end; 1347 1348 assert((TestReport.Working>=MinWorking) and (TestReport.Working<=MaxWorking)); 1349 if (TestReport.FoodRep>=MinFood) and (ProdBeforeBoost>=MinProd) then 1350 begin 1351 SplitTrade(TestReport.Trade,RW[p].TaxRate,RW[p].LuxRate,TestReport.Working, 1352 CityReportEx.TradeProcessing, TestReport.Corruption, TestReport.Tax, 1353 TestReport.Lux, TestReport.Science); 1354 1355 if CityReportEx.BaseHappiness+CityReportEx.BaseControl+TestReport.Lux 1356 +2*(Size-TestReport.Working)-2*TestReport.Deployed>=Size then 1357 begin // city is not in disorder -- evaluate combination 1358 inc(count); 1359 if (MinProd<WantedProd) and (ProdBeforeBoost>MinProd) then 1360 begin // no combination reached wanted prod yet 1361 MinProd:=ProdBeforeBoost; 1362 if MinProd>WantedProd then 1363 MinProd:=WantedProd 1364 end; 1365 if MinProd=WantedProd then // do not care for food before prod is ensured 1366 if (MinFood<TestReport.Eaten) and (TestReport.FoodRep>MinFood) then 1367 begin // no combination reached wanted food yet 1368 MinFood:=TestReport.FoodRep; 1369 if MinFood>TestReport.Eaten then 1370 MinFood:=TestReport.Eaten 1371 end; 1372 BoostProd(ProdBeforeBoost, CityReportEx.ProdProcessing, 1373 TestReport.ProdRep, TestReport.PollRep); 1374 SuperValue:=0; 1375 1376 // super-criterion A: unit support granted? 1377 if TestReport.ProdRep>=TestReport.Support then 1378 SuperValue:=SuperValue or 1 shl 30; 1379 1380 // super-criterion B: food demand granted? 1381 if TestReport.FoodRep>=TestReport.Eaten then 1382 SuperValue:=SuperValue or 63 shl 24 1383 else if TestReport.FoodRep>TestReport.Eaten-63 then 1384 SuperValue:=SuperValue or (63-(TestReport.Eaten-TestReport.FoodRep)) shl 24; 1385 1386 SuperPlus:=SuperValue-BestSuperValue; 1387 if SuperPlus>=0 then 1388 begin 1389 Output[oTax]:=TestReport.Tax; 1390 Output[oScience]:=TestReport.Science; 1391 1392 if TestReport.FoodRep<TestReport.Eaten then 1393 Output[oFood]:=TestReport.FoodRep 1394 // appreciate what we have, combination will have bad supervalue anyway 1395 else if FoodWasted then 1396 Output[oFood]:=0 1397 else 923 begin 924 dec(SizeMod); 925 inc(Flags, chPopDecrease) 926 end 927 end; 928 if Food > CityStorage then 929 Food := CityStorage; 930 931 if LackOfMaterial then 932 begin 933 if Flags and chUnitLost = 0 then 934 begin { one unit lost } 935 uix := -1; 936 Det := MaxInt; 937 for i := 0 to nUn - 1 do 938 if (Un[i].Loc >= 0) and (Un[i].Home = cix) then 939 with Model[Un[i].mix] do 1398 940 begin 1399 Output[oFood]:=TestReport.FoodRep-TestReport.Eaten; 1400 if FoodToTax or (Size>=NeedAqueductSize) and (Output[oFood]=1) then 941 if Kind = mkSpecial_TownGuard then 942 TestDet := Un[i].Health + Un[i].Exp shl 8 943 // disband townguards first 944 else 1401 945 begin 1402 inc(Output[oTax],Output[oFood]); 1403 Output[oFood]:=0; 946 TestDet := Un[i].Health + Un[i].Exp shl 8 + Cost shl 16; 947 // value of unit 948 if Flags and mdDoubleSupport <> 0 then 949 TestDet := TestDet shr 1; 950 // double support, tend to disband first 951 end; 952 if TestDet < Det then 953 begin 954 uix := i; 955 Det := TestDet 1404 956 end; 1405 957 end; 1406 1407 if TestReport.ProdRep<TestReport.Support then 1408 Output[oProd]:=TestReport.ProdRep 1409 // appreciate what we have, combination will have bad supervalue anyway 958 if uix >= 0 then 959 begin 960 RemoveUnit_UpdateMap(p, uix); 961 inc(Flags, chUnitLost); 962 end 963 end 964 end; 965 966 if GTestFlags and tfImmImprove <> 0 then 967 Prod := CityProjectCost; 968 DoProd := (Project and (cpImp + cpIndex) <> cpImp + imTrGoods) and 969 (Prod >= CityProjectCost); 970 971 // check if wonder already built 972 if (Project and cpImp <> 0) and (Project and cpIndex < 28) and 973 (GWonder[Project and cpIndex].CityID <> -1) then 974 begin 975 inc(Flags, chOldWonder); 976 DoProd := false; 977 end; 978 979 // check if producing settlers would disband city 980 if DoProd and (Project and (cpImp or cpDisbandCity) = 0) and 981 ((Size + SizeMod - 2 < 2) and 982 (Model[Project and cpIndex].Kind = mkSettler) or (Size + SizeMod - 1 < 2) 983 and ((Model[Project and cpIndex].Kind = mkSlaves) or 984 (Project and cpConscripts <> 0))) then 985 begin 986 inc(Flags, chNoSettlerProd); 987 DoProd := false; 988 end; 989 990 if DoProd then 991 begin { project complete } 992 dec(Prod, CityProjectCost); 993 if Project and cpImp = 0 then { produce unit } 994 begin 995 if nUn < numax then 996 begin 997 CreateUnit(p, Project and cpIndex); 998 Un[nUn - 1].Loc := Loc; 999 with Un[nUn - 1] do 1000 begin 1001 Home := cix; 1002 if (Model[mix].Domain < dSea) and (Built[imElite] = 1) then 1003 Exp := ExpCost * (nExp - 1) { elite } 1004 else if (Model[mix].Domain < dSea) and (Built[imBarracks] = 1) or 1005 (Model[mix].Domain = dSea) and (Built[imDockyard] = 1) or 1006 (Model[mix].Domain = dAir) and (Built[imAirport] = 1) then 1007 Exp := ExpCost * 2; { vet } 1008 if Project and cpConscripts <> 0 then 1009 Flags := Flags or unConscripts 1010 end; 1011 PlaceUnit(p, nUn - 1); 1012 UpdateUnitMap(Loc); 1013 if Model[Project and cpIndex].Kind = mkSettler then 1014 dec(SizeMod, 2) { settler produced - city shrink } 1015 else if (Model[Project and cpIndex].Kind = mkSlaves) or 1016 (Project and cpConscripts <> 0) then 1017 dec(SizeMod); { slaves/conscripts produced - city shrink } 1018 end; 1019 Project0 := Project or cpRepeat or cpCompleted; 1020 end 1021 else if Imp[Project and cpIndex].Kind = ikShipPart then 1022 begin { produce ship parts } 1023 inc(GShip[p].Parts[Project and cpIndex - imShipComp]); 1024 Project0 := Project or cpCompleted; 1025 end 1026 else { produce improvement } 1027 begin 1028 NewImp := Project and cpIndex; 1029 inc(Money, Prod); { change rest to money } 1030 Project0 := Project or cpCompleted; 1031 Project := cpImp + imTrGoods; 1032 Prod := 0; 1033 1034 if Imp[NewImp].Kind in [ikNatLocal, ikNatGlobal] then 1035 begin // nat. project 1036 for i := 0 to nCity - 1 do 1037 if (City[i].Loc >= 0) and (City[i].Built[NewImp] = 1) then 1038 begin { allowed only once } 1039 inc(Money, Imp[NewImp].Cost * BuildCostMod[Difficulty[p]] div 12); 1040 City[i].Built[NewImp] := 0; 1041 end; 1042 NatBuilt[NewImp] := 1; 1043 1044 // immediate nat. project effects 1045 case NewImp of 1046 imGrWall: 1047 GrWallContinent[p] := Continent[Loc]; 1048 end; 1049 end; 1050 1051 if NewImp < 28 then 1052 begin // wonder 1053 GWonder[NewImp].CityID := ID; 1054 GWonder[NewImp].EffectiveOwner := p; 1055 CheckExpiration(NewImp); 1056 1057 // immediate wonder effects 1058 case NewImp of 1059 woEiffel: 1060 begin // reactivate wonders 1061 for i := 0 to 27 do 1062 if Imp[i].Expiration >= 0 then 1063 for cix2 := 0 to nCity - 1 do 1064 if (City[cix2].Loc >= 0) and (City[cix2].Built[i] = 1) 1065 then 1066 GWonder[i].EffectiveOwner := p 1067 end; 1068 woLighthouse: 1069 CheckSpecialModels(p, preLighthouse); 1070 woLeo: 1071 begin 1072 inc(Research, TechBaseCost(nTech[p], Difficulty[p]) + 1073 TechBaseCost(nTech[p] + 2, Difficulty[p])); 1074 CheckSpecialModels(p, preLeo); 1075 end; 1076 woPyramids: 1077 CheckSpecialModels(p, preBuilder); 1078 woMir: 1079 begin 1080 for p1 := 0 to nPl - 1 do 1081 if (p1 <> p) and (1 shl p1 and GAlive <> 0) then 1082 begin 1083 if RW[p].Treaty[p1] = trNoContact then 1084 IntroduceEnemy(p, p1); 1085 GiveCivilReport(p, p1); 1086 GiveMilReport(p, p1) 1087 end; 1088 end 1089 end; 1090 end; 1091 1092 for i := 0 to nImpReplacement - 1 do // sell obsolete buildings 1093 if (ImpReplacement[i].NewImp = NewImp) and 1094 (Built[ImpReplacement[i].OldImp] > 0) then 1095 begin 1096 inc(RW[p].Money, Imp[ImpReplacement[i].OldImp].Cost * BuildCostMod 1097 [Difficulty[p]] div 12); 1098 Built[ImpReplacement[i].OldImp] := 0; 1099 end; 1100 1101 if NewImp in [imPower, imHydro, imNuclear] then 1102 for i := 0 to nImp - 1 do 1103 if (i <> NewImp) and (i in [imPower, imHydro, imNuclear]) and 1104 (Built[i] > 0) then 1105 begin // sell obsolete power plant 1106 inc(RW[p].Money, Imp[i].Cost * BuildCostMod[Difficulty[p] 1107 ] div 12); 1108 Built[i] := 0; 1109 end; 1110 1111 Built[NewImp] := 1; 1112 end; 1113 Prod0 := Prod; 1114 inc(Flags, chProduction) 1115 end 1116 else 1117 begin 1118 Project0 := Project0 and not cpCompleted; 1119 if Project0 and not cpAuto <> Project and not cpAuto then 1120 Project0 := Project; 1121 Prod0 := Prod; 1122 end; 1123 1124 if SizeMod > 0 then 1125 begin 1126 CityGrowth(p, cix); 1127 inc(Flags, chPopIncrease); 1128 end; 1129 result := Size + SizeMod >= 2; 1130 if result then 1131 while SizeMod < 0 do 1132 begin 1133 CityShrink(p, cix); 1134 inc(SizeMod) 1135 end; 1136 end 1137 end; // CityTurn 1138 1139 { 1140 Tile Access 1141 ____________________________________________________________________ 1142 } 1143 function SetCityTiles(p, cix, NewTiles: integer; 1144 TestOnly: boolean = false): integer; 1145 var 1146 V21, Working, ChangeTiles, AddTiles, Loc1: integer; 1147 CityAreaInfo: TCityAreaInfo; 1148 Radius: TVicinity21Loc; 1149 begin 1150 with RW[p].City[cix] do 1151 begin 1152 ChangeTiles := NewTiles xor integer(Tiles); 1153 AddTiles := NewTiles and not Tiles; 1154 if Mode = moPlaying then 1155 begin // do all checks 1156 if NewTiles and not $67F7F76 <> 0 then 1157 begin 1158 result := eInvalid; 1159 exit 1160 end; // invalid tile index included 1161 if NewTiles and (1 shl 13) = 0 then 1162 begin 1163 result := eViolation; 1164 exit 1165 end; // city tile must be exploited 1166 if ChangeTiles = 0 then 1167 begin 1168 result := eNotChanged; 1169 exit 1170 end; 1171 if AddTiles <> 0 then 1172 begin 1173 // check if new tiles possible 1174 GetCityAreaInfo(p, Loc, CityAreaInfo); 1175 for V21 := 1 to 26 do 1176 if AddTiles and (1 shl V21) <> 0 then 1177 if CityAreaInfo.Available[V21] <> faAvailable then 1178 begin 1179 result := eTileNotAvailable; 1180 exit 1181 end; 1182 // not more tiles than inhabitants 1183 Working := 0; 1184 for V21 := 1 to 26 do 1185 if NewTiles and (1 shl V21) <> 0 then 1186 inc(Working); 1187 if Working > Size then 1188 begin 1189 result := eNoWorkerAvailable; 1190 exit 1191 end; 1192 end; 1193 end; 1194 result := eOk; 1195 if not TestOnly then 1196 begin 1197 V21_to_Loc(Loc, Radius); 1198 for V21 := 1 to 26 do 1199 if ChangeTiles and (1 shl V21) <> 0 then 1200 begin 1201 Loc1 := Radius[V21]; 1202 assert((Loc1 >= 0) and (Loc1 < MapSize)); 1203 if NewTiles and (1 shl V21) <> 0 then 1204 UsedByCity[Loc1] := Loc // employ tile 1205 else if UsedByCity[Loc1] <> Loc then 1206 assert(Mode < moPlaying) 1207 // should only happen during loading, because of wrong sSetCityTiles command order 1410 1208 else 1209 UsedByCity[Loc1] := -1 // unemploy tile 1210 end; 1211 Tiles := NewTiles 1212 end 1213 end; 1214 end; 1215 1216 procedure GetCityTileAdvice(p, cix: integer; var Advice: TCityTileAdviceData); 1217 const 1218 oFood = 0; 1219 oProd = 1; 1220 oTax = 2; 1221 oScience = 3; 1222 type 1223 TTileData = record 1224 Food, Prod, Trade, SubValue, V21: integer; 1225 end; 1226 var 1227 i, V21, Loc1, nHierarchy, iH, iT, iH_Switch, MinWorking, MaxWorking, 1228 WantedProd, MinFood, MinProd, count, Take, MaxTake, AreaSize, FormulaCode, 1229 NeedRare, RareTiles, cix1, dx, dy, BestTiles, ProdBeforeBoost, TestTiles, 1230 SubPlus, SuperPlus: integer; 1231 SuperValue, BestSuperValue, SubValue, BestSubValue: integer; 1232 Value, BestValue, ValuePlus: extended; 1233 ValueFormula_Weight: array [oFood .. oScience] of extended; 1234 ValueFormula_Multiply: array [oFood .. oScience] of boolean; 1235 Output: array [oFood .. oScience] of integer; 1236 TileInfo, BaseTileInfo: TTileInfo; 1237 Radius, Radius1: TVicinity21Loc; 1238 TestReport: TCityReport; 1239 CityReportEx: TCityReportEx; 1240 CityAreaInfo: TCityAreaInfo; 1241 Hierarchy: array [0 .. 20, 0 .. 31] of TTileData; 1242 nTile, nSelection: array [0 .. 20] of integer; 1243 SubCriterion: array [0 .. 27] of integer; 1244 FoodWasted, FoodToTax, ProdToTax, RareOK, NeedStep2, IsBest: boolean; 1245 begin 1246 if (RW[p].Government = gAnarchy) or (RW[p].City[cix].Flags and chCaptured <> 0) 1247 then 1248 begin 1249 FillChar(Advice.CityReport, SizeOf(Advice.CityReport), 0); 1250 Advice.Tiles := 1 shl CityOwnTile; 1251 Advice.CityReport.HypoTiles := 1 shl CityOwnTile; 1252 exit; 1253 end; 1254 1255 for i := oFood to oScience do 1256 begin // decode evaluation formula from weights parameter 1257 FormulaCode := Advice.ResourceWeights shr (24 - 8 * i) and $FF; 1258 ValueFormula_Multiply[i] := FormulaCode and $80 <> 0; 1259 if FormulaCode and $40 <> 0 then 1260 ValueFormula_Weight[i] := (FormulaCode and $0F) * 1261 (1 shl (FormulaCode and $30 shr 4)) / 16 1262 else 1263 ValueFormula_Weight[i] := (FormulaCode and $0F) * 1264 (1 shl (FormulaCode and $30 shr 4)); 1265 end; 1266 1267 TestReport.HypoTiles := 1 shl CityOwnTile; 1268 TestReport.HypoTax := -1; 1269 TestReport.HypoLux := -1; 1270 GetSmallCityReport(p, cix, TestReport, @CityReportEx); 1271 with RW[p].City[cix] do 1272 begin 1273 V21_to_Loc(Loc, Radius); 1274 FoodToTax := RW[p].Government = gFuture; 1275 ProdToTax := Project and (cpImp + cpIndex) = cpImp + imTrGoods; 1276 FoodWasted := not FoodToTax and (Food = StorageSize[Difficulty[p]]) and 1277 not CanCityGrow(p, cix); 1278 1279 // sub criteria 1280 for V21 := 1 to 26 do 1281 begin 1282 Loc1 := Radius[V21]; 1283 if Loc1 >= 0 then 1284 SubCriterion[V21] := 3360 - (Distance(Loc, Loc1) - 1) * 32 - 1285 V21 xor $15; 1286 end; 1287 for cix1 := 0 to RW[p].nCity - 1 do 1288 if cix1 <> cix then 1289 begin 1290 Loc1 := RW[p].City[cix1].Loc; 1291 if Loc1 >= 0 then 1292 begin 1293 if Distance(Loc, Loc1) <= 10 then 1294 begin // cities overlap -- prefer tiles outside common range 1295 V21_to_Loc(Loc1, Radius1); 1296 for V21 := 1 to 26 do 1411 1297 begin 1412 if NeedRare>0 then 1298 Loc1 := Radius1[V21]; 1299 if (Loc1 >= 0) and (Loc1 < MapSize) and (Distance(Loc, Loc1) <= 5) 1300 then 1413 1301 begin 1414 RareOk:=false; 1415 for iH:=0 to nHierarchy-1 do 1416 if Hierarchy[iH,nSelection[iH]].V21 and RareTiles<>0 then 1417 RareOk:=true; 1418 if not RareOk then 1419 TestReport.ProdRep:=TestReport.Support; 1420 end; 1421 Output[oProd]:=TestReport.ProdRep-TestReport.Support; 1422 if ProdToTax then 1302 dxdy(Loc, Loc1, dx, dy); 1303 dec(SubCriterion[(dy + 3) shl 2 + (dx + 3) shr 1], 160); 1304 end 1305 end 1306 end 1307 end 1308 end; 1309 1310 GetCityAreaInfo(p, Loc, CityAreaInfo); 1311 AreaSize := 0; 1312 for V21 := 1 to 26 do 1313 if CityAreaInfo.Available[V21] = faAvailable then 1314 inc(AreaSize); 1315 1316 if RW[p].Government = gFundamentalism then 1317 begin 1318 MinWorking := Size; 1319 MaxWorking := Size; 1320 end 1321 else 1322 begin 1323 MinWorking := CityReportEx.TradeProcessing.HappyBase shr 1; 1324 if MinWorking > Size then 1325 MinWorking := Size; 1326 if (RW[p].LuxRate = 0) and not CityReportEx.TradeProcessing.FlexibleLuxury 1327 then 1328 MaxWorking := MinWorking 1329 else 1330 MaxWorking := Size; 1331 end; 1332 if MaxWorking > AreaSize then 1333 begin 1334 MaxWorking := AreaSize; 1335 if MinWorking > AreaSize then 1336 MinWorking := AreaSize; 1337 end; 1338 if TestReport.Support = 0 then 1339 WantedProd := 0 1340 else 1341 WantedProd := 1 + (TestReport.Support * 100 - 1) 1342 div (100 + CityReportEx.ProdProcessing.ProdBonus * 50 + 1343 CityReportEx.ProdProcessing.FutProdBonus); 1344 1345 // consider resources for ship parts 1346 NeedRare := 0; 1347 if (GTestFlags and tfNoRareNeed = 0) and (Project and cpImp <> 0) then 1348 case Project and cpIndex of 1349 imShipComp: 1350 NeedRare := fCobalt; 1351 imShipPow: 1352 NeedRare := fUranium; 1353 imShipHab: 1354 NeedRare := fMercury; 1355 end; 1356 if NeedRare > 0 then 1357 begin 1358 RareTiles := 0; 1359 for V21 := 1 to 26 do 1360 begin 1361 Loc1 := Radius[V21]; 1362 if (Loc1 >= 0) and (Loc1 < MapSize) and 1363 (RealMap[Loc1] and fModern = cardinal(NeedRare)) then 1364 RareTiles := RareTiles or (1 shl V21); 1365 end 1366 end; 1367 1368 // step 1: sort tiles to hierarchies 1369 nHierarchy := 0; 1370 for V21 := 1 to 26 do // non-rare tiles 1371 if (CityAreaInfo.Available[V21] = faAvailable) and 1372 ((NeedRare = 0) or (1 shl V21 and RareTiles = 0)) then 1373 begin 1374 Loc1 := Radius[V21]; 1375 assert((Loc1 >= 0) and (Loc1 < MapSize)); 1376 GetTileInfo(p, cix, Loc1, TileInfo); 1377 if V21 = CityOwnTile then 1378 BaseTileInfo := TileInfo 1379 else 1380 begin 1381 iH := 0; 1382 while iH < nHierarchy do 1383 begin 1384 iT := 0; 1385 while (iT < nTile[iH]) and (TileInfo.Food <= Hierarchy[iH, iT].Food) 1386 and (TileInfo.Prod <= Hierarchy[iH, iT].Prod) and 1387 (TileInfo.Trade <= Hierarchy[iH, iT].Trade) and 1388 not((TileInfo.Food = Hierarchy[iH, iT].Food) and 1389 (TileInfo.Prod = Hierarchy[iH, iT].Prod) and 1390 (TileInfo.Trade = Hierarchy[iH, iT].Trade) and 1391 (SubCriterion[V21] >= SubCriterion[Hierarchy[iH, iT].V21])) do 1392 inc(iT); 1393 if (iT = nTile[iH]) // new worst tile in this hierarchy 1394 or ((TileInfo.Food >= Hierarchy[iH, iT].Food) 1395 // new middle tile in this hierarchy 1396 and (TileInfo.Prod >= Hierarchy[iH, iT].Prod) and 1397 (TileInfo.Trade >= Hierarchy[iH, iT].Trade)) then 1398 break; // insert position found! 1399 inc(iH); 1400 end; 1401 if iH = nHierarchy then 1402 begin // need to start new hierarchy 1403 nTile[iH] := 0; 1404 inc(nHierarchy); 1405 iT := 0; 1406 end; 1407 move(Hierarchy[iH, iT], Hierarchy[iH, iT + 1], 1408 (nTile[iH] - iT) * SizeOf(TTileData)); 1409 inc(nTile[iH]); 1410 Hierarchy[iH, iT].V21 := V21; 1411 Hierarchy[iH, iT].Food := TileInfo.Food; 1412 Hierarchy[iH, iT].Prod := TileInfo.Prod; 1413 Hierarchy[iH, iT].Trade := TileInfo.Trade; 1414 Hierarchy[iH, iT].SubValue := SubCriterion[V21]; 1415 end 1416 end; 1417 if NeedRare <> 0 then 1418 begin // rare tiles need own hierarchy 1419 iH := nHierarchy; 1420 for V21 := 1 to 26 do 1421 if (CityAreaInfo.Available[V21] = faAvailable) and 1422 (1 shl V21 and RareTiles <> 0) then 1423 begin 1424 Loc1 := Radius[V21]; 1425 assert((V21 <> CityOwnTile) and (Loc1 >= 0) and (Loc1 < MapSize)); 1426 GetTileInfo(p, cix, Loc1, TileInfo); 1427 if iH = nHierarchy then 1428 begin // need to start new hierarchy 1429 nTile[iH] := 0; 1430 inc(nHierarchy); 1431 iT := 0; 1432 end 1433 else 1434 iT := nTile[iH]; 1435 inc(nTile[iH]); 1436 Hierarchy[iH, iT].V21 := V21; 1437 Hierarchy[iH, iT].Food := TileInfo.Food; // = 0 1438 Hierarchy[iH, iT].Prod := TileInfo.Prod; // = 1 1439 Hierarchy[iH, iT].Trade := TileInfo.Trade; // = 0 1440 Hierarchy[iH, iT].SubValue := SubCriterion[V21]; 1441 end; 1442 end; 1443 if Built[imAlgae] > 0 then 1444 inc(BaseTileInfo.Food, 12); 1445 1446 // step 2: summarize resources 1447 for iH := 0 to nHierarchy - 1 do 1448 begin 1449 move(Hierarchy[iH, 0], Hierarchy[iH, 1], nTile[iH] * SizeOf(TTileData)); 1450 Hierarchy[iH, 0].Food := 0; 1451 Hierarchy[iH, 0].Prod := 0; 1452 Hierarchy[iH, 0].Trade := 0; 1453 Hierarchy[iH, 0].SubValue := 0; 1454 Hierarchy[iH, 0].V21 := 0; 1455 for iT := 1 to nTile[iH] do 1456 begin 1457 inc(Hierarchy[iH, iT].Food, Hierarchy[iH, iT - 1].Food); 1458 inc(Hierarchy[iH, iT].Prod, Hierarchy[iH, iT - 1].Prod); 1459 inc(Hierarchy[iH, iT].Trade, Hierarchy[iH, iT - 1].Trade); 1460 inc(Hierarchy[iH, iT].SubValue, Hierarchy[iH, iT - 1].SubValue); 1461 Hierarchy[iH, iT].V21 := 1 shl Hierarchy[iH, iT].V21 + 1462 Hierarchy[iH, iT - 1].V21; 1463 end; 1464 end; 1465 1466 // step 3: try all combinations 1467 BestValue := 0.0; 1468 BestSuperValue := 0; 1469 BestSubValue := 0; 1470 BestTiles := 0; 1471 FillChar(nSelection, SizeOf(nSelection), 0); 1472 TestReport.FoodRep := BaseTileInfo.Food; 1473 ProdBeforeBoost := BaseTileInfo.Prod; 1474 TestReport.Trade := BaseTileInfo.Trade; 1475 TestReport.Working := 1; 1476 MinFood := 0; 1477 MinProd := 0; 1478 iH_Switch := nHierarchy; 1479 count := 0; 1480 repeat 1481 // ensure minima 1482 iH := 0; 1483 while (TestReport.Working < MaxWorking) and (iH < iH_Switch) and 1484 ((TestReport.Working < MinWorking) or 1485 (TestReport.FoodRep < TestReport.Eaten) or 1486 (ProdBeforeBoost < WantedProd)) do 1487 begin 1488 assert(nSelection[iH] = 0); 1489 Take := MinWorking - TestReport.Working; 1490 if Take > nTile[iH] then 1491 Take := nTile[iH] 1492 else 1493 begin 1494 if Take < 0 then 1495 Take := 0; 1496 MaxTake := nTile[iH]; 1497 if TestReport.Working + MaxTake > MaxWorking then 1498 MaxTake := MaxWorking - TestReport.Working; 1499 while (Take < MaxTake) and 1500 (TestReport.FoodRep + Hierarchy[iH, Take].Food < MinFood) do 1501 inc(Take); 1502 while (Take < MaxTake) and 1503 (ProdBeforeBoost + Hierarchy[iH, Take].Prod < MinProd) do 1504 inc(Take); 1505 end; 1506 nSelection[iH] := Take; 1507 inc(TestReport.Working, Take); 1508 with Hierarchy[iH, Take] do 1509 begin 1510 inc(TestReport.FoodRep, Food); 1511 inc(ProdBeforeBoost, Prod); 1512 inc(TestReport.Trade, Trade); 1513 end; 1514 inc(iH); 1515 end; 1516 1517 assert((TestReport.Working >= MinWorking) and 1518 (TestReport.Working <= MaxWorking)); 1519 if (TestReport.FoodRep >= MinFood) and (ProdBeforeBoost >= MinProd) then 1520 begin 1521 SplitTrade(TestReport.Trade, RW[p].TaxRate, RW[p].LuxRate, 1522 TestReport.Working, CityReportEx.TradeProcessing, 1523 TestReport.Corruption, TestReport.Tax, TestReport.Lux, 1524 TestReport.Science); 1525 1526 if CityReportEx.BaseHappiness + CityReportEx.BaseControl + 1527 TestReport.Lux + 2 * (Size - TestReport.Working) - 2 * 1528 TestReport.Deployed >= Size then 1529 begin // city is not in disorder -- evaluate combination 1530 inc(count); 1531 if (MinProd < WantedProd) and (ProdBeforeBoost > MinProd) then 1532 begin // no combination reached wanted prod yet 1533 MinProd := ProdBeforeBoost; 1534 if MinProd > WantedProd then 1535 MinProd := WantedProd 1536 end; 1537 if MinProd = WantedProd then 1538 // do not care for food before prod is ensured 1539 if (MinFood < TestReport.Eaten) and (TestReport.FoodRep > MinFood) 1540 then 1541 begin // no combination reached wanted food yet 1542 MinFood := TestReport.FoodRep; 1543 if MinFood > TestReport.Eaten then 1544 MinFood := TestReport.Eaten 1545 end; 1546 BoostProd(ProdBeforeBoost, CityReportEx.ProdProcessing, 1547 TestReport.ProdRep, TestReport.PollRep); 1548 SuperValue := 0; 1549 1550 // super-criterion A: unit support granted? 1551 if TestReport.ProdRep >= TestReport.Support then 1552 SuperValue := SuperValue or 1 shl 30; 1553 1554 // super-criterion B: food demand granted? 1555 if TestReport.FoodRep >= TestReport.Eaten then 1556 SuperValue := SuperValue or 63 shl 24 1557 else if TestReport.FoodRep > TestReport.Eaten - 63 then 1558 SuperValue := SuperValue or 1559 (63 - (TestReport.Eaten - TestReport.FoodRep)) shl 24; 1560 1561 SuperPlus := SuperValue - BestSuperValue; 1562 if SuperPlus >= 0 then 1563 begin 1564 Output[oTax] := TestReport.Tax; 1565 Output[oScience] := TestReport.Science; 1566 1567 if TestReport.FoodRep < TestReport.Eaten then 1568 Output[oFood] := TestReport.FoodRep 1569 // appreciate what we have, combination will have bad supervalue anyway 1570 else if FoodWasted then 1571 Output[oFood] := 0 1572 else 1573 begin 1574 Output[oFood] := TestReport.FoodRep - TestReport.Eaten; 1575 if FoodToTax or (Size >= NeedAqueductSize) and (Output[oFood] = 1) 1576 then 1423 1577 begin 1424 inc(Output[oTax],Output[oProd]);1425 Output[oProd]:=0;1578 inc(Output[oTax], Output[oFood]); 1579 Output[oFood] := 0; 1426 1580 end; 1427 1581 end; 1428 1582 1429 NeedStep2:=false; 1430 Value:=0; 1431 for i:=oFood to oScience do 1432 if ValueFormula_Multiply[i] then 1433 NeedStep2:=true 1434 else Value:=Value+ValueFormula_Weight[i]*Output[i]; 1435 if NeedStep2 then 1583 if TestReport.ProdRep < TestReport.Support then 1584 Output[oProd] := TestReport.ProdRep 1585 // appreciate what we have, combination will have bad supervalue anyway 1586 else 1436 1587 begin 1437 if Value>0 then 1438 Value:=ln(Value)+123; 1439 for i:=oFood to oScience do 1440 if ValueFormula_Multiply[i] and (Output[i]>0) then 1441 Value:=Value+ValueFormula_Weight[i]*(ln(Output[i])+123); 1588 if NeedRare > 0 then 1589 begin 1590 RareOK := false; 1591 for iH := 0 to nHierarchy - 1 do 1592 if Hierarchy[iH, nSelection[iH]].V21 and RareTiles <> 0 then 1593 RareOK := true; 1594 if not RareOK then 1595 TestReport.ProdRep := TestReport.Support; 1596 end; 1597 Output[oProd] := TestReport.ProdRep - TestReport.Support; 1598 if ProdToTax then 1599 begin 1600 inc(Output[oTax], Output[oProd]); 1601 Output[oProd] := 0; 1602 end; 1442 1603 end; 1443 1604 1444 ValuePlus:=Value-BestValue; 1445 if (SuperPlus>0) or (ValuePlus>=0.0) then 1605 NeedStep2 := false; 1606 Value := 0; 1607 for i := oFood to oScience do 1608 if ValueFormula_Multiply[i] then 1609 NeedStep2 := true 1610 else 1611 Value := Value + ValueFormula_Weight[i] * Output[i]; 1612 if NeedStep2 then 1446 1613 begin 1447 SubValue:=(TestReport.FoodRep+ProdBeforeBoost+TestReport.Trade) shl 18; 1448 TestTiles:=1 shl CityOwnTile; 1449 for iH:=0 to nHierarchy-1 do 1614 if Value > 0 then 1615 Value := ln(Value) + 123; 1616 for i := oFood to oScience do 1617 if ValueFormula_Multiply[i] and (Output[i] > 0) then 1618 Value := Value + ValueFormula_Weight[i] * 1619 (ln(Output[i]) + 123); 1620 end; 1621 1622 ValuePlus := Value - BestValue; 1623 if (SuperPlus > 0) or (ValuePlus >= 0.0) then 1624 begin 1625 SubValue := (TestReport.FoodRep + ProdBeforeBoost + 1626 TestReport.Trade) shl 18; 1627 TestTiles := 1 shl CityOwnTile; 1628 for iH := 0 to nHierarchy - 1 do 1450 1629 begin 1451 inc(TestTiles, Hierarchy[iH,nSelection[iH]].V21);1452 inc(SubValue, Hierarchy[iH,nSelection[iH]].SubValue);1630 inc(TestTiles, Hierarchy[iH, nSelection[iH]].V21); 1631 inc(SubValue, Hierarchy[iH, nSelection[iH]].SubValue); 1453 1632 end; 1454 IsBest:=true;1455 if (SuperPlus=0) and (ValuePlus=0.0) then1633 IsBest := true; 1634 if (SuperPlus = 0) and (ValuePlus = 0.0) then 1456 1635 begin 1457 SubPlus:=SubValue-BestSubValue;1458 if SubPlus<0 then1459 IsBest:=false1460 else if SubPlus=0 then1636 SubPlus := SubValue - BestSubValue; 1637 if SubPlus < 0 then 1638 IsBest := false 1639 else if SubPlus = 0 then 1461 1640 begin 1462 assert(TestTiles<>BestTiles);1463 IsBest:= TestTiles>BestTiles1641 assert(TestTiles <> BestTiles); 1642 IsBest := TestTiles > BestTiles 1464 1643 end 1465 1644 end; 1466 if IsBest then1645 if IsBest then 1467 1646 begin 1468 BestSuperValue:=SuperValue; 1469 BestValue:=Value; 1470 BestSubValue:=SubValue; 1471 BestTiles:=TestTiles; 1472 TestReport.Happy:=(CityReportEx.TradeProcessing.HappyBase-Size) div 2 1473 +TestReport.Lux shr 1; 1474 Advice.CityReport:=TestReport; 1647 BestSuperValue := SuperValue; 1648 BestValue := Value; 1649 BestSubValue := SubValue; 1650 BestTiles := TestTiles; 1651 TestReport.Happy := 1652 (CityReportEx.TradeProcessing.HappyBase - Size) div 2 + 1653 TestReport.Lux shr 1; 1654 Advice.CityReport := TestReport; 1475 1655 end 1476 1656 end // if (SuperPlus>0) or (ValuePlus>=0.0) … … 1479 1659 end; 1480 1660 1481 // calculate next combination1482 iH_Switch:=0;1483 repeat1484 with Hierarchy[iH_Switch,nSelection[iH_Switch]] do1661 // calculate next combination 1662 iH_Switch := 0; 1663 repeat 1664 with Hierarchy[iH_Switch, nSelection[iH_Switch]] do 1485 1665 begin 1486 dec(TestReport.FoodRep,Food);1487 dec(ProdBeforeBoost,Prod);1488 dec(TestReport.Trade,Trade);1666 dec(TestReport.FoodRep, Food); 1667 dec(ProdBeforeBoost, Prod); 1668 dec(TestReport.Trade, Trade); 1489 1669 end; 1490 inc(nSelection[iH_Switch]); 1491 inc(TestReport.Working); 1492 if (nSelection[iH_Switch]<=nTile[iH_Switch]) and (TestReport.Working<=MaxWorking) then 1670 inc(nSelection[iH_Switch]); 1671 inc(TestReport.Working); 1672 if (nSelection[iH_Switch] <= nTile[iH_Switch]) and 1673 (TestReport.Working <= MaxWorking) then 1493 1674 begin 1494 with Hierarchy[iH_Switch,nSelection[iH_Switch]] do1675 with Hierarchy[iH_Switch, nSelection[iH_Switch]] do 1495 1676 begin 1496 inc(TestReport.FoodRep,Food);1497 inc(ProdBeforeBoost,Prod);1498 inc(TestReport.Trade,Trade);1677 inc(TestReport.FoodRep, Food); 1678 inc(ProdBeforeBoost, Prod); 1679 inc(TestReport.Trade, Trade); 1499 1680 end; 1500 break;1681 break; 1501 1682 end; 1502 dec(TestReport.Working,nSelection[iH_Switch]);1503 nSelection[iH_Switch]:=0;1504 inc(iH_Switch);1505 until iH_Switch=nHierarchy;1506 until iH_Switch=nHierarchy; // everything tested -- done1683 dec(TestReport.Working, nSelection[iH_Switch]); 1684 nSelection[iH_Switch] := 0; 1685 inc(iH_Switch); 1686 until iH_Switch = nHierarchy; 1687 until iH_Switch = nHierarchy; // everything tested -- done 1507 1688 end; 1508 assert(BestSuperValue>0); // advice should always be possible1509 Advice.Tiles:=BestTiles;1510 Advice.CityReport.HypoTiles:=BestTiles;1689 assert(BestSuperValue > 0); // advice should always be possible 1690 Advice.Tiles := BestTiles; 1691 Advice.CityReport.HypoTiles := BestTiles; 1511 1692 end; // GetCityTileAdvice 1512 1693 1513 1694 { 1514 1515 ____________________________________________________________________1695 Start/End Game 1696 ____________________________________________________________________ 1516 1697 } 1517 1698 procedure InitGame; 1518 1699 var 1519 p,i,mixTownGuard: integer; 1520 begin 1521 MaxDist:=Distance(0,MapSize-lx shr 1); 1522 for p:=0 to nPl-1 do if (1 shl p and GAlive<>0) then with RW[p] do 1523 begin // initialize capital 1524 mixTownGuard:=0; 1525 while Model[mixTownGuard].Kind<>mkSpecial_TownGuard do 1526 inc(mixTownGuard); 1527 with City[0] do 1528 begin 1529 Built[imPalace]:=1; 1530 Size:=4; 1531 for i:=2 to Size do 1532 AddBestCityTile(p,0); 1533 Project:=mixTownGuard; 1534 end; 1535 NatBuilt[imPalace]:=1; 1536 end; 1700 p, i, mixTownGuard: integer; 1701 begin 1702 MaxDist := Distance(0, MapSize - lx shr 1); 1703 for p := 0 to nPl - 1 do 1704 if (1 shl p and GAlive <> 0) then 1705 with RW[p] do 1706 begin // initialize capital 1707 mixTownGuard := 0; 1708 while Model[mixTownGuard].Kind <> mkSpecial_TownGuard do 1709 inc(mixTownGuard); 1710 with City[0] do 1711 begin 1712 Built[imPalace] := 1; 1713 Size := 4; 1714 for i := 2 to Size do 1715 AddBestCityTile(p, 0); 1716 Project := mixTownGuard; 1717 end; 1718 NatBuilt[imPalace] := 1; 1719 end; 1537 1720 end; 1538 1721 … … 1542 1725 1543 1726 end. 1544 -
trunk/CmdList.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit CmdList; 4 3 … … 6 5 7 6 uses 8 Classes;7 Classes; 9 8 10 9 const 11 MaxDataSize=1024;10 MaxDataSize = 1024; 12 11 13 12 type 14 TLogData=array[0..999999999] of Byte;15 16 TCmdListState=record17 nLog, {used size of LogData in bytes}18 LoadPos, {position in LogData when loading a game}19 LastMovingUnit: integer;20 MoveCode, LoadMoveCode: Cardinal;13 TLogData = array [0 .. 999999999] of Byte; 14 15 TCmdListState = record 16 nLog, { used size of LogData in bytes } 17 LoadPos, { position in LogData when loading a game } 18 LastMovingUnit: integer; 19 MoveCode, LoadMoveCode: Cardinal; 21 20 end; 22 21 23 TCmdList=class 24 constructor Create; 25 destructor Destroy; override; 26 procedure Get(var Command, Player, Subject: integer; var Data: pointer); 27 procedure GetDataChanges(Data: pointer; DataSize: integer); 28 procedure Put(Command, Player, Subject: integer; Data: pointer); 29 procedure PutDataChanges(Command, Player: integer; OldData, NewData: pointer; DataSize: integer); 30 procedure LoadFromFile(const f: TFileStream); 31 procedure SaveToFile(const f: TFileStream); 32 procedure AppendToFile(const f: TFileStream; const OldState: TCmdListState); 33 procedure Cut; 34 function Progress: integer; 35 private 36 LogAlloc: integer; {allocated size of LogData in bytes} 37 LogData: ^TLogData; 38 FState: TCmdListState; 39 procedure PutData(Data: pointer; Length: integer); 40 procedure CompleteMoveCode; 41 public 42 property State: TCmdListState read FState write FState; 22 TCmdList = class 23 constructor Create; 24 destructor Destroy; override; 25 procedure Get(var Command, Player, Subject: integer; var Data: pointer); 26 procedure GetDataChanges(Data: pointer; DataSize: integer); 27 procedure Put(Command, Player, Subject: integer; Data: pointer); 28 procedure PutDataChanges(Command, Player: integer; 29 OldData, NewData: pointer; DataSize: integer); 30 procedure LoadFromFile(const f: TFileStream); 31 procedure SaveToFile(const f: TFileStream); 32 procedure AppendToFile(const f: TFileStream; const OldState: TCmdListState); 33 procedure Cut; 34 function Progress: integer; 35 private 36 LogAlloc: integer; { allocated size of LogData in bytes } 37 LogData: ^TLogData; 38 FState: TCmdListState; 39 procedure PutData(Data: pointer; Length: integer); 40 procedure CompleteMoveCode; 41 public 42 property State: TCmdListState read FState write FState; 43 43 end; 44 44 … … 46 46 47 47 uses 48 Protocol;48 Protocol; 49 49 50 50 const 51 LogGrow=1 shl 18;51 LogGrow = 1 shl 18; 52 52 53 53 type 54 TData=array[0..MaxDataSize-1] of Cardinal;55 PData=^TData;54 TData = array [0 .. MaxDataSize - 1] of Cardinal; 55 PData = ^TData; 56 56 57 57 constructor TCmdList.Create; 58 58 begin 59 inherited Create;60 FState.nLog:=0;61 LogAlloc:=0;62 LogData:=nil;63 FState.LastMovingUnit:=-1;64 FState.MoveCode:=0;65 FState.LoadMoveCode:=0;59 inherited Create; 60 FState.nLog := 0; 61 LogAlloc := 0; 62 LogData := nil; 63 FState.LastMovingUnit := -1; 64 FState.MoveCode := 0; 65 FState.LoadMoveCode := 0; 66 66 end; 67 67 68 68 destructor TCmdList.Destroy; 69 69 begin 70 ReallocMem(LogData, 0); 71 inherited Destroy; 72 end; 73 74 procedure TCmdList.Get(var Command, Player, Subject: integer; var Data: pointer); 70 ReallocMem(LogData, 0); 71 inherited Destroy; 72 end; 73 74 procedure TCmdList.Get(var Command, Player, Subject: integer; 75 var Data: pointer); 75 76 var 76 DirCode, code: Cardinal;77 begin 78 if FState.LoadMoveCode>0 then79 begin 80 Player:=-1;81 if FState.LoadMoveCode and 1=1 then77 DirCode, code: Cardinal; 78 begin 79 if FState.LoadMoveCode > 0 then 80 begin 81 Player := -1; 82 if FState.LoadMoveCode and 1 = 1 then 82 83 begin // FM 83 DirCode:=FState.LoadMoveCode shr 1 and 7; 84 Subject:=FState.LastMovingUnit; 85 FState.LoadMoveCode:=FState.LoadMoveCode shr 4; 86 end 84 DirCode := FState.LoadMoveCode shr 1 and 7; 85 Subject := FState.LastMovingUnit; 86 FState.LoadMoveCode := FState.LoadMoveCode shr 4; 87 end 88 else 89 begin // M 90 DirCode := FState.LoadMoveCode shr 3 and 7; 91 Subject := FState.LoadMoveCode shr 6 and $FFF; 92 FState.LoadMoveCode := FState.LoadMoveCode shr 18; 93 FState.LastMovingUnit := Subject 94 end; 95 case DirCode of 96 0: 97 Command := sMoveUnit + $090; 98 1: 99 Command := sMoveUnit + $0F0; 100 2: 101 Command := sMoveUnit + $390; 102 3: 103 Command := sMoveUnit + $3F0; 104 4: 105 Command := sMoveUnit + $020; 106 5: 107 Command := sMoveUnit + $060; 108 6: 109 Command := sMoveUnit + $100; 110 7: 111 Command := sMoveUnit + $300; 112 end; 113 Data := nil; 114 end 87 115 else 88 begin // M 89 DirCode:=FState.LoadMoveCode shr 3 and 7; 90 Subject:=FState.LoadMoveCode shr 6 and $FFF; 91 FState.LoadMoveCode:=FState.LoadMoveCode shr 18; 92 FState.LastMovingUnit:=Subject 93 end; 94 case DirCode of 95 0: Command:=sMoveUnit+$090; 96 1: Command:=sMoveUnit+$0F0; 97 2: Command:=sMoveUnit+$390; 98 3: Command:=sMoveUnit+$3F0; 99 4: Command:=sMoveUnit+$020; 100 5: Command:=sMoveUnit+$060; 101 6: Command:=sMoveUnit+$100; 102 7: Command:=sMoveUnit+$300; 103 end; 104 Data:=nil; 105 end 106 else 107 begin 108 code:=Cardinal((@LogData[FState.LoadPos])^); 109 if code and 3=0 then 116 begin 117 code := Cardinal((@LogData[FState.LoadPos])^); 118 if code and 3 = 0 then 110 119 begin // non-clientex command 111 Command:=code shr 2 and $3FFF +sExecute;112 Player:=code shr 16 and $f;113 Subject:=code shr 20 and $FFF;114 inc(FState.LoadPos,4);115 end 116 else if code and 7=2 then120 Command := code shr 2 and $3FFF + sExecute; 121 Player := code shr 16 and $F; 122 Subject := code shr 20 and $FFF; 123 inc(FState.LoadPos, 4); 124 end 125 else if code and 7 = 2 then 117 126 begin // clientex command 118 Command:=code shr 3 and $FFFF;119 Player:=code shr 19 and $f;120 Subject:=0;121 inc(FState.LoadPos,3);122 end 123 else127 Command := code shr 3 and $FFFF; 128 Player := code shr 19 and $F; 129 Subject := 0; 130 inc(FState.LoadPos, 3); 131 end 132 else 124 133 begin // move command shortcut 125 if (code and 1=1) and (code and (7 shl 4)<>6 shl 4) then 126 begin FState.LoadMoveCode:=code and $FF; inc(FState.LoadPos) end 127 else begin FState.LoadMoveCode:=code and $FFFFFF; inc(FState.LoadPos,3); end; 128 Get(Command, Player, Subject, Data); 129 exit; 130 end; 131 132 if Command and $f=0 then Data:=nil 133 else 134 begin 135 Data:=@LogData[FState.LoadPos]; 136 inc(FState.LoadPos,Command and $f *4); 134 if (code and 1 = 1) and (code and (7 shl 4) <> 6 shl 4) then 135 begin 136 FState.LoadMoveCode := code and $FF; 137 inc(FState.LoadPos) 138 end 139 else 140 begin 141 FState.LoadMoveCode := code and $FFFFFF; 142 inc(FState.LoadPos, 3); 143 end; 144 Get(Command, Player, Subject, Data); 145 exit; 146 end; 147 148 if Command and $F = 0 then 149 Data := nil 150 else 151 begin 152 Data := @LogData[FState.LoadPos]; 153 inc(FState.LoadPos, Command and $F * 4); 137 154 end 138 155 end … … 141 158 procedure TCmdList.GetDataChanges(Data: pointer; DataSize: integer); 142 159 var 143 b0, b1: integer; 144 Map0, Map1: Cardinal; 145 begin 146 Map0:=Cardinal((@LogData[FState.LoadPos])^); 147 inc(FState.LoadPos,4); 148 b0:=0; 149 while Map0>0 do 150 begin 151 if Map0 and 1<>0 then 152 begin 153 Map1:=Cardinal((@LogData[FState.LoadPos])^); 154 inc(FState.LoadPos,4); 155 for b1:=0 to 31 do if 1 shl b1 and Map1<>0 then 156 begin 157 if b0*32+b1<DataSize then 158 PData(Data)[b0*32+b1]:=Cardinal((@LogData[FState.LoadPos])^); 159 inc(FState.LoadPos,4); 160 end; 161 end; 162 inc(b0); 163 Map0:=Map0 shr 1; 160 b0, b1: integer; 161 Map0, Map1: Cardinal; 162 begin 163 Map0 := Cardinal((@LogData[FState.LoadPos])^); 164 inc(FState.LoadPos, 4); 165 b0 := 0; 166 while Map0 > 0 do 167 begin 168 if Map0 and 1 <> 0 then 169 begin 170 Map1 := Cardinal((@LogData[FState.LoadPos])^); 171 inc(FState.LoadPos, 4); 172 for b1 := 0 to 31 do 173 if 1 shl b1 and Map1 <> 0 then 174 begin 175 if b0 * 32 + b1 < DataSize then 176 PData(Data)[b0 * 32 + b1] := Cardinal((@LogData[FState.LoadPos])^); 177 inc(FState.LoadPos, 4); 178 end; 179 end; 180 inc(b0); 181 Map0 := Map0 shr 1; 164 182 end 165 183 end; … … 167 185 procedure TCmdList.Put(Command, Player, Subject: integer; Data: pointer); 168 186 var 169 DirCode, code: Cardinal;170 begin 171 if Command and $FC00=sMoveUnit then187 DirCode, code: Cardinal; 188 begin 189 if Command and $FC00 = sMoveUnit then 172 190 begin // move command shortcut 173 case Command of 174 sMoveUnit+$090: DirCode:=0; 175 sMoveUnit+$0F0: DirCode:=1; 176 sMoveUnit+$390: DirCode:=2; 177 sMoveUnit+$3F0: DirCode:=3; 178 sMoveUnit+$020: DirCode:=4; 179 sMoveUnit+$060: DirCode:=5; 180 sMoveUnit+$100: DirCode:=6; 181 sMoveUnit+$300: DirCode:=7; 182 end; 183 if Subject=FState.LastMovingUnit then code:=1+DirCode shl 1 184 else code:=6+DirCode shl 3+Cardinal(Subject) shl 6; 185 if FState.MoveCode=0 then FState.MoveCode:=code 186 else if FState.MoveCode and 1=1 then 191 case Command of 192 sMoveUnit + $090: 193 DirCode := 0; 194 sMoveUnit + $0F0: 195 DirCode := 1; 196 sMoveUnit + $390: 197 DirCode := 2; 198 sMoveUnit + $3F0: 199 DirCode := 3; 200 sMoveUnit + $020: 201 DirCode := 4; 202 sMoveUnit + $060: 203 DirCode := 5; 204 sMoveUnit + $100: 205 DirCode := 6; 206 sMoveUnit + $300: 207 DirCode := 7; 208 end; 209 if Subject = FState.LastMovingUnit then 210 code := 1 + DirCode shl 1 211 else 212 code := 6 + DirCode shl 3 + Cardinal(Subject) shl 6; 213 if FState.MoveCode = 0 then 214 FState.MoveCode := code 215 else if FState.MoveCode and 1 = 1 then 187 216 begin // FM + this 188 FState.MoveCode:=FState.MoveCode+code shl 4; 189 if code and 1=1 then PutData(@FState.MoveCode, 1) // FM + FM 190 else PutData(@FState.MoveCode, 3); // FM + M 191 FState.MoveCode:=0; 192 end 193 else if code and 1=1 then 217 FState.MoveCode := FState.MoveCode + code shl 4; 218 if code and 1 = 1 then 219 PutData(@FState.MoveCode, 1) // FM + FM 220 else 221 PutData(@FState.MoveCode, 3); // FM + M 222 FState.MoveCode := 0; 223 end 224 else if code and 1 = 1 then 194 225 begin // M + FM 195 FState.MoveCode:=FState.MoveCode+code shl 18;196 PutData(@FState.MoveCode, 3);197 FState.MoveCode:=0;198 end 199 else // M + M200 begin 201 PutData(@FState.MoveCode, 3);202 FState.MoveCode:=code203 end; 204 FState.LastMovingUnit:=Subject;226 FState.MoveCode := FState.MoveCode + code shl 18; 227 PutData(@FState.MoveCode, 3); 228 FState.MoveCode := 0; 229 end 230 else // M + M 231 begin 232 PutData(@FState.MoveCode, 3); 233 FState.MoveCode := code 234 end; 235 FState.LastMovingUnit := Subject; 205 236 end 206 else 207 begin 237 else 238 begin 239 CompleteMoveCode; 240 if Command >= cClientEx then 241 begin 242 code := 2 + Command shl 3 + Player shl 19; 243 PutData(@code, 3); 244 end 245 else 246 begin 247 code := Cardinal(Command - sExecute) shl 2 + Cardinal(Player) shl 16 + 248 Cardinal(Subject) shl 20; 249 PutData(@code, 4); 250 end; 251 end; 252 if Command and $F <> 0 then 253 PutData(Data, Command and $F * 4); 254 end; 255 256 procedure TCmdList.PutDataChanges(Command, Player: integer; 257 OldData, NewData: pointer; DataSize: integer); 258 var 259 MapPos, LogPos, b0, b1, RowEnd: integer; 260 Map0, Map1, code: Cardinal; 261 begin 262 if DataSize <= 0 then 263 exit; 264 if DataSize > MaxDataSize then 265 DataSize := MaxDataSize; 208 266 CompleteMoveCode; 209 if Command>=cClientEx then 210 begin 211 code:=2+Command shl 3+Player shl 19; 212 PutData(@code, 3); 213 end 214 else 215 begin 216 code:=Cardinal(Command-sExecute) shl 2+Cardinal(Player) shl 16 217 +Cardinal(Subject) shl 20; 218 PutData(@code, 4); 267 MapPos := FState.nLog + 8; 268 LogPos := MapPos + 4; 269 Map0 := 0; 270 for b0 := 0 to (DataSize - 1) div 32 do 271 begin 272 if LogPos + 4 * 32 > LogAlloc then 273 begin 274 inc(LogAlloc, LogGrow); 275 ReallocMem(LogData, LogAlloc); 276 end; 277 Map0 := Map0 shr 1; 278 Map1 := 0; 279 RowEnd := DataSize - 1; 280 if RowEnd > b0 * 32 + 31 then 281 RowEnd := b0 * 32 + 31; 282 for b1 := b0 * 32 to RowEnd do 283 begin 284 Map1 := Map1 shr 1; 285 if PData(NewData)[b1] <> PData(OldData)[b1] then 286 begin 287 Cardinal((@LogData[LogPos])^) := PData(NewData)[b1]; 288 inc(LogPos, 4); 289 inc(Map1, $80000000); 290 end; 291 end; 292 if Map1 > 0 then 293 begin 294 Map1 := Map1 shr (b0 * 32 + 31 - RowEnd); 295 Cardinal((@LogData[MapPos])^) := Map1; 296 MapPos := LogPos; 297 inc(LogPos, 4); 298 inc(Map0, $80000000); 219 299 end; 220 300 end; 221 if Command and $f<>0 then PutData(Data, Command and $f *4); 222 end; 223 224 procedure TCmdList.PutDataChanges(Command, Player: integer; OldData, 225 NewData: pointer; DataSize: integer); 226 var 227 MapPos, LogPos, b0, b1, RowEnd: integer; 228 Map0, Map1, code: Cardinal; 229 begin 230 if DataSize<=0 then exit; 231 if DataSize>MaxDataSize then DataSize:=MaxDataSize; 232 CompleteMoveCode; 233 MapPos:=FState.nLog+8; 234 LogPos:=MapPos+4; 235 Map0:=0; 236 for b0:=0 to (DataSize-1) div 32 do 237 begin 238 if LogPos+4*32>LogAlloc then 239 begin 301 if Map0 = 0 then 302 exit; // no changes 303 304 Map0 := Map0 shr (31 - (DataSize - 1) div 32); 305 Cardinal((@LogData[FState.nLog + 4])^) := Map0; 306 code := Cardinal(Command - sExecute) shl 2 + Cardinal(Player) shl 16; 307 Cardinal((@LogData[FState.nLog])^) := code; 308 FState.nLog := MapPos 309 end; 310 311 procedure TCmdList.PutData(Data: pointer; Length: integer); 312 begin 313 if FState.nLog + Length > LogAlloc then 314 begin 240 315 inc(LogAlloc, LogGrow); 241 316 ReallocMem(LogData, LogAlloc); 242 end;243 Map0:=Map0 shr 1;244 Map1:=0;245 RowEnd:=DataSize-1;246 if RowEnd>b0*32+31 then RowEnd:=b0*32+31;247 for b1:=b0*32 to RowEnd do248 begin249 Map1:=Map1 shr 1;250 if PData(NewData)[b1]<>PData(OldData)[b1] then251 begin252 Cardinal((@LogData[LogPos])^):=PData(NewData)[b1];253 inc(LogPos,4);254 inc(Map1,$80000000);255 end;256 end;257 if Map1>0 then258 begin259 Map1:=Map1 shr (b0*32+31-RowEnd);260 Cardinal((@LogData[MapPos])^):=Map1;261 MapPos:=LogPos;262 inc(LogPos,4);263 inc(Map0,$80000000);264 end;265 317 end; 266 if Map0=0 then exit; // no changes 267 268 Map0:=Map0 shr (31-(DataSize-1) div 32); 269 Cardinal((@LogData[FState.nLog+4])^):=Map0; 270 code:=Cardinal(Command-sExecute) shl 2+Cardinal(Player) shl 16; 271 Cardinal((@LogData[FState.nLog])^):=code; 272 FState.nLog:=MapPos 273 end; 274 275 procedure TCmdList.PutData(Data: pointer; Length: integer); 276 begin 277 if FState.nLog+Length>LogAlloc then 278 begin 279 inc(LogAlloc, LogGrow); 318 move(Data^, LogData[FState.nLog], Length); 319 inc(FState.nLog, Length); 320 end; 321 322 procedure TCmdList.CompleteMoveCode; 323 begin 324 if FState.MoveCode > 0 then 325 begin 326 if FState.MoveCode and 1 = 1 then 327 PutData(@FState.MoveCode, 1) // Single FM 328 else 329 PutData(@FState.MoveCode, 3); // Single M 330 FState.MoveCode := 0; 331 end 332 end; 333 334 procedure TCmdList.LoadFromFile(const f: TFileStream); 335 begin 336 f.read(FState.nLog, 4); 337 LogData := nil; 338 LogAlloc := ((FState.nLog + 2) div LogGrow + 1) * LogGrow; 280 339 ReallocMem(LogData, LogAlloc); 281 end; 282 move(Data^, LogData[FState.nLog], Length); 283 inc(FState.nLog, Length); 284 end; 285 286 procedure TCmdList.CompleteMoveCode; 287 begin 288 if FState.MoveCode>0 then 289 begin 290 if FState.MoveCode and 1=1 then PutData(@FState.MoveCode, 1) // Single FM 291 else PutData(@FState.MoveCode, 3); // Single M 292 FState.MoveCode:=0; 293 end 294 end; 295 296 procedure TCmdList.LoadFromFile(const f: TFileStream); 297 begin 298 f.read(FState.nLog, 4); 299 LogData:=nil; 300 LogAlloc:=((FState.nLog+2) div LogGrow +1)*LogGrow; 301 ReallocMem(LogData, LogAlloc); 302 f.read(LogData^, FState.nLog); 303 FState.LoadPos:=0; 340 f.read(LogData^, FState.nLog); 341 FState.LoadPos := 0; 304 342 end; 305 343 306 344 procedure TCmdList.SaveToFile(const f: TFileStream); 307 345 begin 308 CompleteMoveCode; 309 f.write(FState.nLog, 4); 310 f.write(LogData^, FState.nLog) 311 end; 312 313 procedure TCmdList.AppendToFile(const f: TFileStream; const OldState: TCmdListState); 314 begin 315 CompleteMoveCode; 316 f.write(FState.nLog, 4); 317 f.Position:=f.Position+OldState.nLog; 318 f.write(LogData[OldState.nLog], FState.nLog-OldState.nLog) 346 CompleteMoveCode; 347 f.write(FState.nLog, 4); 348 f.write(LogData^, FState.nLog) 349 end; 350 351 procedure TCmdList.AppendToFile(const f: TFileStream; 352 const OldState: TCmdListState); 353 begin 354 CompleteMoveCode; 355 f.write(FState.nLog, 4); 356 f.Position := f.Position + OldState.nLog; 357 f.write(LogData[OldState.nLog], FState.nLog - OldState.nLog) 319 358 end; 320 359 321 360 procedure TCmdList.Cut; 322 361 begin 323 FState.nLog:=FState.LoadPos;362 FState.nLog := FState.LoadPos; 324 363 end; 325 364 326 365 function TCmdList.Progress: integer; 327 366 begin 328 if (FState.LoadPos=FState.nLog) and (FState.LoadMoveCode=0) then 329 result:=1000 // loading complete 330 else if FState.nLog>1 shl 20 then 331 result:=(FState.LoadPos shr 8)*999 div (FState.nLog shr 8) 332 else result:=FState.LoadPos*999 div FState.nLog 333 end; 334 335 {Format Specification: 336 337 Non-ClientEx-Command: 367 if (FState.LoadPos = FState.nLog) and (FState.LoadMoveCode = 0) then 368 result := 1000 // loading complete 369 else if FState.nLog > 1 shl 20 then 370 result := (FState.LoadPos shr 8) * 999 div (FState.nLog shr 8) 371 else 372 result := FState.LoadPos * 999 div FState.nLog 373 end; 374 375 { Format Specification: 376 377 Non-ClientEx-Command: 338 378 Byte3 Byte2 Byte1 Byte0 339 379 ssssssss sssspppp cccccccc cccccc00 340 380 (c = Command-sExecute, p = Player, s = Subject) 341 381 342 ClientEx-Command:382 ClientEx-Command: 343 383 Byte2 Byte1 Byte0 344 384 0ppppccc cccccccc ccccc010 345 385 (c = Command, p = Player) 346 386 347 Single Move:387 Single Move: 348 388 Byte2 Byte1 Byte0 349 389 000000ss ssssssss ssaaa110 350 390 (a = Direction, s = Subject) 351 391 352 Move + Follow Move:392 Move + Follow Move: 353 393 Byte2 Byte1 Byte0 354 394 00bbb1ss ssssssss ssaaa110 355 395 (a = Direction 1, s = Subject 1, b = Direction 2) 356 396 357 Follow Move + Move:397 Follow Move + Move: 358 398 Byte2 Byte1 Byte0 359 399 00ssssss ssssssbb b110aaa1 360 400 (a = Direction 1, b = Direction 2, s = Subject 2) 361 401 362 Single Follow Move:402 Single Follow Move: 363 403 Byte0 364 404 0000aaa1 365 405 (a = Direction) 366 406 367 Double Follow Move:407 Double Follow Move: 368 408 Byte0 369 409 bbb1aaa1 … … 372 412 373 413 end. 374 -
trunk/Database.pas
r2 r6 1 1 {$INCLUDE switches} 2 // {$DEFINE TEXTLOG}3 // {$DEFINE LOADPERF}2 // {$DEFINE TEXTLOG} 3 // {$DEFINE LOADPERF} 4 4 unit Database; 5 5 … … 7 7 8 8 uses 9 Protocol,CmdList;9 Protocol, CmdList; 10 10 11 11 const 12 // additional test flags 13 FastContact=false; {extra small world with railroad everywhere} 14 15 neumax=4096; 16 necmax=1024; 17 nemmax=1024; 18 19 lNoObserve=0; lObserveUnhidden=1; lObserveAll=2; lObserveSuper=3; //observe levels 20 21 TerrType_Canalable=[fGrass,fDesert,fPrairie,fTundra,fSwamp,fForest,fHills]; 22 23 nStartUn=1; 24 StartUn: array[0..nStartUn-1] of integer=(0); //mix of start units 25 26 CityOwnTile=13; 27 28 var 29 GAlive, {players alive; bitset of 1 shl p} 30 GWatching, 31 GInitialized, 32 GAI, 33 RND, {world map randseed} 34 lx,ly, 35 MapSize, // = lx*ly 36 LandMass, 37 {$IFOPT O-}InvalidTreatyMap,{$ENDIF} 38 SaveMapCenterLoc, 39 PeaceEnded, 40 GTurn, {current turn} 41 GTestFlags: integer; 42 Mode: (moLoading_Fast, moLoading, moMovie, moPlaying); 43 GWonder: array[0..27] of TWonderInfo; 44 ServerVersion: array[0..nPl-1] of integer; 45 ProcessClientData: array[0..nPl-1] of boolean; 46 CL: TCmdList; 47 {$IFDEF TEXTLOG}CmdInfo: string; TextLog: TextFile;{$ENDIF} 48 {$IFDEF LOADPERF}time_total,time_total0,time_x0,time_x1,time_a,time_b,time_c: int64;{$ENDIF} 49 50 // map data 51 RealMap: array[0..lxmax*lymax-1] of Cardinal; 52 Continent:array[0..lxmax*lymax-1] of integer; {continent id for each tile} 53 Occupant:array[0..lxmax*lymax-1] of ShortInt; {occupying player for each tile} 54 ZoCMap:array[0..lxmax*lymax-1] of ShortInt; 55 ObserveLevel:array[0..lxmax*lymax-1] of Cardinal; 56 {Observe Level of player p in bits 2*p and 2*p+1} 57 UsedByCity:array[0..lxmax*lymax-1] of integer; {location of exploiting city for 58 each tile, =-1 if not exploited} 59 60 // player data 61 RW: array[0..nPl-1] of TPlayerContext;{player data} 62 Difficulty: array[0..nPl-1] of integer; 63 GShip: array[0..nPl-1] of TShipInfo; 64 ResourceMask: array[0..nPl-1] of Cardinal; 65 Founded: array[0..nPl-1] of integer; {number of cities founded} 66 TerritoryCount: array[0..nPl] of integer; 67 LastValidStat, 68 Researched, 69 Discovered, // number of tiles discovered 70 GrWallContinent: array[0..nPl-1] of integer; 71 RWemix: array[0..nPl-1, 0..nPl-1, 0..nmmax-1] of SmallInt; 12 // additional test flags 13 FastContact = false; { extra small world with railroad everywhere } 14 15 neumax = 4096; 16 necmax = 1024; 17 nemmax = 1024; 18 19 lNoObserve = 0; 20 lObserveUnhidden = 1; 21 lObserveAll = 2; 22 lObserveSuper = 3; // observe levels 23 24 TerrType_Canalable = [fGrass, fDesert, fPrairie, fTundra, fSwamp, 25 fForest, fHills]; 26 27 nStartUn = 1; 28 StartUn: array [0 .. nStartUn - 1] of integer = (0); // mix of start units 29 30 CityOwnTile = 13; 31 32 var 33 GAlive, { players alive; bitset of 1 shl p } 34 GWatching, GInitialized, GAI, RND, { world map randseed } 35 lx, ly, MapSize, // = lx*ly 36 LandMass, 37 {$IFOPT O-}InvalidTreatyMap, {$ENDIF} 38 SaveMapCenterLoc, PeaceEnded, GTurn, { current turn } 39 GTestFlags: integer; 40 Mode: (moLoading_Fast, moLoading, moMovie, moPlaying); 41 GWonder: array [0 .. 27] of TWonderInfo; 42 ServerVersion: array [0 .. nPl - 1] of integer; 43 ProcessClientData: array [0 .. nPl - 1] of boolean; 44 CL: TCmdList; 45 {$IFDEF TEXTLOG}CmdInfo: string; 46 TextLog: TextFile; {$ENDIF} 47 {$IFDEF LOADPERF}time_total, time_total0, time_x0, time_x1, time_a, time_b, time_c: int64; {$ENDIF} 48 // map data 49 RealMap: array [0 .. lxmax * lymax - 1] of Cardinal; 50 Continent: array [0 .. lxmax * lymax - 1] of integer; 51 { continent id for each tile } 52 Occupant: array [0 .. lxmax * lymax - 1] of ShortInt; 53 { occupying player for each tile } 54 ZoCMap: array [0 .. lxmax * lymax - 1] of ShortInt; 55 ObserveLevel: array [0 .. lxmax * lymax - 1] of Cardinal; 56 { Observe Level of player p in bits 2*p and 2*p+1 } 57 UsedByCity: array [0 .. lxmax * lymax - 1] of integer; 58 { location of exploiting city for 59 each tile, =-1 if not exploited } 60 61 // player data 62 RW: array [0 .. nPl - 1] of TPlayerContext; { player data } 63 Difficulty: array [0 .. nPl - 1] of integer; 64 GShip: array [0 .. nPl - 1] of TShipInfo; 65 ResourceMask: array [0 .. nPl - 1] of Cardinal; 66 Founded: array [0 .. nPl - 1] of integer; { number of cities founded } 67 TerritoryCount: array [0 .. nPl] of integer; 68 LastValidStat, Researched, Discovered, // number of tiles discovered 69 GrWallContinent: array [0 .. nPl - 1] of integer; 70 RWemix: array [0 .. nPl - 1, 0 .. nPl - 1, 0 .. nmmax - 1] of SmallInt; 72 71 // [p1,p2,mix] -> index of p2's model mix in p1's enemy model list 73 Destroyed: array[0..nPl-1, 0..nPl-1, 0..nmmax-1] of SmallInt;72 Destroyed: array [0 .. nPl - 1, 0 .. nPl - 1, 0 .. nmmax - 1] of SmallInt; 74 73 // [p1,p2,mix] -> number of p2's units with model mix that p1 has destroyed 75 nTech: array[0..nPl-1] of integer; {number of known techs}76 //NewContact: array[0..nPl-1,0..nPl-1] of boolean;74 nTech: array [0 .. nPl - 1] of integer; { number of known techs } 75 // NewContact: array[0..nPl-1,0..nPl-1] of boolean; 77 76 78 77 type 79 TVicinity8Loc=array[0..7] of integer;80 TVicinity21Loc=array[0..27] of integer;78 TVicinity8Loc = array [0 .. 7] of integer; 79 TVicinity21Loc = array [0 .. 27] of integer; 81 80 82 81 procedure MaskD(var x; Count, Mask: Cardinal); 83 procedure IntServer(Command, Player,Subject:integer;var Data);82 procedure IntServer(Command, Player, Subject: integer; var Data); 84 83 procedure CompactLists(p: integer); 85 84 procedure ClearTestFlags(ClearFlags: integer); 86 procedure SetTestFlags(p, SetFlags: integer);85 procedure SetTestFlags(p, SetFlags: integer); 87 86 88 87 // Tech Related Functions 89 function TechBaseCost(nTech, diff: integer): integer;88 function TechBaseCost(nTech, diff: integer): integer; 90 89 function TechCost(p: integer): integer; 91 90 procedure CalculateModel(var m: TModel); 92 procedure CheckSpecialModels(p, pre: integer);91 procedure CheckSpecialModels(p, pre: integer); 93 92 procedure EnableDevModel(p: integer); 94 procedure SeeTech(p, ad: integer);95 procedure DiscoverTech(p, ad: integer);93 procedure SeeTech(p, ad: integer); 94 procedure DiscoverTech(p, ad: integer); 96 95 procedure CheckExpiration(Wonder: integer); 97 96 98 97 // Location Navigation 99 function dLoc(Loc, dx,dy: integer): integer;100 procedure dxdy(Loc0, Loc1: integer; var dx,dy: integer);101 function Distance(Loc0, Loc1: integer): integer;98 function dLoc(Loc, dx, dy: integer): integer; 99 procedure dxdy(Loc0, Loc1: integer; var dx, dy: integer); 100 function Distance(Loc0, Loc1: integer): integer; 102 101 procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc); 103 102 procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc); … … 118 117 // Map Revealing 119 118 function GetTileInfo(p, cix, Loc: integer; var Info: TTileInfo): integer; 120 procedure Strongest(Loc: integer;var uix,Strength,Bonus,Cnt:integer);119 procedure Strongest(Loc: integer; var uix, Strength, Bonus, Cnt: integer); 121 120 function UnitSpeed(p, mix, Health: integer): integer; 122 procedure GetUnitReport(p,uix: integer; var UnitReport: TUnitReport); 123 procedure SearchCity(Loc: integer; var p,cix: integer); 124 procedure TellAboutModel(p,taOwner,tamix: integer); 125 function emixSafe(p,taOwner,tamix: integer): integer; 126 function Discover9(Loc,p,Level: integer; TellAllied, EnableContact: boolean): boolean; 127 function Discover21(Loc,p,AdjacentLevel: integer; TellAllied, EnableContact: boolean): boolean; 121 procedure GetUnitReport(p, uix: integer; var UnitReport: TUnitReport); 122 procedure SearchCity(Loc: integer; var p, cix: integer); 123 procedure TellAboutModel(p, taOwner, tamix: integer); 124 function emixSafe(p, taOwner, tamix: integer): integer; 125 function Discover9(Loc, p, Level: integer; 126 TellAllied, EnableContact: boolean): boolean; 127 function Discover21(Loc, p, AdjacentLevel: integer; 128 TellAllied, EnableContact: boolean): boolean; 128 129 procedure DiscoverAll(p, Level: integer); 129 130 procedure DiscoverViewAreas(p: integer); 130 function GetUnitStack(p, Loc: integer): integer;131 function GetUnitStack(p, Loc: integer): integer; 131 132 procedure UpdateUnitMap(Loc: integer; CityChange: boolean = false); 132 procedure RecalcV8ZoC(p, Loc: integer);133 procedure RecalcV8ZoC(p, Loc: integer); 133 134 procedure RecalcMapZoC(p: integer); 134 135 procedure RecalcPeaceMap(p: integer); … … 136 137 // Territory Calculation 137 138 procedure CheckBorders(OriginLoc: integer; PlayerLosingCity: integer = -1); 138 procedure LogCheckBorders(p, cix: integer; PlayerLosingCity: integer = -1);139 procedure LogCheckBorders(p, cix: integer; PlayerLosingCity: integer = -1); 139 140 140 141 // Map Processing 141 procedure CreateUnit(p, mix: integer);142 procedure FreeUnit(p, uix: integer);143 procedure PlaceUnit(p, uix: integer);144 procedure RemoveUnit(p, uix: integer; Enemy: integer = -1);145 procedure RemoveUnit_UpdateMap(p, uix: integer);146 procedure RemoveAllUnits(p, Loc: integer; Enemy: integer = -1);147 procedure RemoveDomainUnits(d, p,Loc: integer);148 procedure FoundCity(p, FoundLoc: integer);149 procedure DestroyCity(p, cix: integer; SaveUnits: boolean);150 procedure ChangeCityOwner(pOld, cixOld,pNew: integer);151 procedure CompleteJob(p, Loc,Job: integer);142 procedure CreateUnit(p, mix: integer); 143 procedure FreeUnit(p, uix: integer); 144 procedure PlaceUnit(p, uix: integer); 145 procedure RemoveUnit(p, uix: integer; Enemy: integer = -1); 146 procedure RemoveUnit_UpdateMap(p, uix: integer); 147 procedure RemoveAllUnits(p, Loc: integer; Enemy: integer = -1); 148 procedure RemoveDomainUnits(d, p, Loc: integer); 149 procedure FoundCity(p, FoundLoc: integer); 150 procedure DestroyCity(p, cix: integer; SaveUnits: boolean); 151 procedure ChangeCityOwner(pOld, cixOld, pNew: integer); 152 procedure CompleteJob(p, Loc, Job: integer); 152 153 153 154 // Diplomacy 154 procedure IntroduceEnemy(p1, p2: integer);155 procedure IntroduceEnemy(p1, p2: integer); 155 156 procedure GiveCivilReport(p, pAbout: integer); 156 157 procedure GiveMilReport(p, pAbout: integer); … … 158 159 function PayPrice(pSender, pTarget, Price: integer; execute: boolean): boolean; 159 160 procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean = true); 160 function DoSpyMission(p,pCity,cix,Mission: integer): Cardinal; 161 161 function DoSpyMission(p, pCity, cix, Mission: integer): Cardinal; 162 162 163 163 implementation 164 164 165 165 uses 166 {$IFDEF LOADPERF}SysUtils, Windows,{$ENDIF} 167 {$IFDEF TEXTLOG}SysUtils,{$ENDIF} 168 IPQ; 169 170 var 171 UnBuilt: array[0..nPl-1] of integer; {number of units built} 172 166 {$IFDEF LOADPERF}SysUtils, Windows, {$ENDIF} 167 {$IFDEF TEXTLOG}SysUtils, {$ENDIF} 168 IPQ; 169 170 var 171 UnBuilt: array [0 .. nPl - 1] of integer; { number of units built } 173 172 174 173 procedure MaskD(var x; Count, Mask: Cardinal); Register; 175 174 asm 176 sub eax,4175 sub eax,4 177 176 @r: and [eax+edx*4],ecx 178 179 177 dec edx 178 jnz @r 180 179 end; 181 180 182 181 procedure CompactLists(p: integer); 183 182 var 184 uix,uix1,cix: integer; 185 {$IFOPT O-}V21: integer; Radius: TVicinity21Loc;{$ENDIF} 186 begin 187 with RW[p] do 188 begin 189 // compact unit list 190 uix:=0; 191 while uix<nUn do 192 if Un[uix].Loc<0 then 193 begin 194 dec(nUn); 195 Un[uix]:=Un[nUn]; {replace removed unit by last} 196 if (Un[uix].TroopLoad>0) or (Un[uix].AirLoad>0) then 197 for uix1:=0 to nUn-1 do 198 if Un[uix1].Master=nUn then Un[uix1].Master:=uix; 199 // index of last unit changes 183 uix, uix1, cix: integer; 184 {$IFOPT O-}V21: integer; 185 Radius: TVicinity21Loc; {$ENDIF} 186 begin 187 with RW[p] do 188 begin 189 // compact unit list 190 uix := 0; 191 while uix < nUn do 192 if Un[uix].Loc < 0 then 193 begin 194 dec(nUn); 195 Un[uix] := Un[nUn]; { replace removed unit by last } 196 if (Un[uix].TroopLoad > 0) or (Un[uix].AirLoad > 0) then 197 for uix1 := 0 to nUn - 1 do 198 if Un[uix1].Master = nUn then 199 Un[uix1].Master := uix; 200 // index of last unit changes 200 201 end 201 else inc(uix); 202 203 // compact city list 204 cix:=0; 205 while cix<nCity do 206 if City[cix].Loc<0 then 207 begin 208 dec(nCity); 209 City[cix]:=City[nCity]; {replace city by last} 210 for uix1:=0 to nUn-1 do 211 if Un[uix1].Home=nCity then Un[uix1].Home:=cix; 212 {index of last city changes} 202 else 203 inc(uix); 204 205 // compact city list 206 cix := 0; 207 while cix < nCity do 208 if City[cix].Loc < 0 then 209 begin 210 dec(nCity); 211 City[cix] := City[nCity]; { replace city by last } 212 for uix1 := 0 to nUn - 1 do 213 if Un[uix1].Home = nCity then 214 Un[uix1].Home := cix; 215 { index of last city changes } 213 216 end 214 else inc(cix); 215 216 // compact enemy city list 217 cix:=0; 218 while cix<nEnemyCity do 219 if EnemyCity[cix].Loc<0 then 220 begin 221 dec(nEnemyCity); 222 EnemyCity[cix]:=EnemyCity[nEnemyCity]; {replace city by last} 217 else 218 inc(cix); 219 220 // compact enemy city list 221 cix := 0; 222 while cix < nEnemyCity do 223 if EnemyCity[cix].Loc < 0 then 224 begin 225 dec(nEnemyCity); 226 EnemyCity[cix] := EnemyCity[nEnemyCity]; { replace city by last } 223 227 end 224 else inc(cix); 228 else 229 inc(cix); 225 230 226 231 {$IFOPT O-} 227 for cix:=0 to nCity-1 do with City[cix] do 228 begin 229 V21_to_Loc(Loc,Radius); 230 for V21:=1 to 26 do if Tiles and (1 shl V21)<>0 then 231 assert(UsedByCity[Radius[V21]]=Loc); 232 for cix := 0 to nCity - 1 do 233 with City[cix] do 234 begin 235 V21_to_Loc(Loc, Radius); 236 for V21 := 1 to 26 do 237 if Tiles and (1 shl V21) <> 0 then 238 assert(UsedByCity[Radius[V21]] = Loc); 239 end 240 {$ENDIF} 241 end; 242 end; // CompactLists 243 244 { 245 Tech Related Functions 246 ____________________________________________________________________ 247 } 248 function TechBaseCost(nTech, diff: integer): integer; 249 var 250 c0: single; 251 begin 252 c0 := TechFormula_M[diff] * (nTech + 4) * 253 exp((nTech + 4) / TechFormula_D[diff]); 254 if c0 >= $10000000 then 255 result := $10000000 256 else 257 result := trunc(c0) 258 end; 259 260 function TechCost(p: integer): integer; 261 begin 262 with RW[p] do 263 begin 264 result := TechBaseCost(nTech[p], Difficulty[p]); 265 if ResearchTech >= 0 then 266 if (ResearchTech = adMilitary) or (Tech[ResearchTech] = tsSeen) then 267 result := result shr 1 268 else if ResearchTech in FutureTech then 269 if Government = gFuture then 270 result := result * 2 271 else 272 result := result * 4; 273 end 274 end; 275 276 procedure SetModelFlags(var m: TModel); 277 begin 278 m.Flags := 0; 279 if (m.Domain = dGround) and (m.Kind <> mkDiplomat) then 280 m.Flags := m.Flags or mdZOC; 281 if (m.Kind = mkDiplomat) or (m.Attack + m.Cap[mcBombs] = 0) then 282 m.Flags := m.Flags or mdCivil; 283 if (m.Cap[mcOver] > 0) or (m.Domain = dSea) and (m.Weight >= 6) then 284 m.Flags := m.Flags or mdDoubleSupport; 285 end; 286 287 procedure CalculateModel(var m: TModel); 288 { calculate attack, defense, cost... of a model by features } 289 var 290 i: integer; 291 begin 292 with m do 293 begin 294 Attack := (Cap[mcOffense] + Cap[mcOver]) * MStrength; 295 Defense := (Cap[mcDefense] + Cap[mcOver]) * MStrength; 296 case Domain of 297 dGround: 298 Speed := 150 + Cap[mcMob] * 50; 299 dSea: 300 begin 301 Speed := 350 + 200 * Cap[mcNP] + 200 * Cap[mcTurbines]; 302 if Cap[mcNP] = 0 then 303 inc(Speed, 100 * Cap[mcSE]); 304 end; 305 dAir: 306 Speed := 850 + 400 * Cap[mcJet]; 307 end; 308 Cost := 0; 309 for i := 0 to nFeature - 1 do 310 if 1 shl Domain and Feature[i].Domains <> 0 then 311 inc(Cost, Cap[i] * Feature[i].Cost); 312 Cost := Cost * MCost; 313 Weight := 0; 314 for i := 0 to nFeature - 1 do 315 if 1 shl Domain and Feature[i].Domains <> 0 then 316 if (Domain = dGround) and (i = mcDefense) then 317 inc(Weight, Cap[i] * 2) 318 else 319 inc(Weight, Cap[i] * Feature[i].Weight); 320 end; 321 SetModelFlags(m); 322 end; 323 324 procedure CheckSpecialModels(p, pre: integer); 325 var 326 i, mix1: integer; 327 HasAlready: boolean; 328 begin 329 for i := 0 to nSpecialModel - 330 1 do { check whether new special model available } 331 if (SpecialModelPreq[i] = pre) and (RW[p].nModel < nmmax) then 332 begin 333 HasAlready := false; 334 for mix1 := 0 to RW[p].nModel - 1 do 335 if (RW[p].Model[mix1].Kind = SpecialModel[i].Kind) and 336 (RW[p].Model[mix1].Attack = SpecialModel[i].Attack) and 337 (RW[p].Model[mix1].Speed = SpecialModel[i].Speed) then 338 HasAlready := true; 339 if not HasAlready then 340 begin 341 RW[p].Model[RW[p].nModel] := SpecialModel[i]; 342 SetModelFlags(RW[p].Model[RW[p].nModel]); 343 with RW[p].Model[RW[p].nModel] do 344 begin 345 Status := 0; 346 SavedStatus := 0; 347 IntroTurn := GTurn; 348 Built := 0; 349 Lost := 0; 350 ID := p shl 12 + RW[p].nModel; 351 if (Kind = mkSpecial_Boat) and (ServerVersion[p] < $000EF0) then 352 Speed := 350; // old longboat 353 end; 354 inc(RW[p].nModel); 355 end 356 end; 357 end; 358 359 procedure EnableDevModel(p: integer); 360 begin 361 with RW[p] do 362 if nModel < nmmax then 363 begin 364 Model[nModel] := DevModel; 365 with Model[nModel] do 366 begin 367 Status := 0; 368 SavedStatus := 0; 369 IntroTurn := GTurn; 370 Built := 0; 371 Lost := 0; 372 ID := p shl 12 + nModel 373 end; 374 inc(nModel); 375 inc(Researched[p]) 232 376 end 233 {$ENDIF} 234 end; 235 end; // CompactLists 236 237 { 238 Tech Related Functions 239 ____________________________________________________________________ 240 } 241 function TechBaseCost(nTech,diff: integer): integer; 242 var 243 c0: single; 244 begin 245 c0:=TechFormula_M[diff]*(nTech+4)*exp((nTech+4)/TechFormula_D[diff]); 246 if c0>=$10000000 then result:=$10000000 247 else result:=trunc(c0) 248 end; 249 250 function TechCost(p: integer): integer; 251 begin 252 with RW[p] do 253 begin 254 result:=TechBaseCost(nTech[p],Difficulty[p]); 255 if ResearchTech>=0 then 256 if (ResearchTech=adMilitary) or (Tech[ResearchTech]=tsSeen) then 257 result:=result shr 1 258 else if ResearchTech in FutureTech then 259 if Government=gFuture then 260 result:=result*2 261 else result:=result*4; 377 end; 378 379 procedure SeeTech(p, ad: integer); 380 begin 381 {$IFDEF TEXTLOG}CmdInfo := CmdInfo + Format(' P%d:A%d', [p, ad]); {$ENDIF} 382 RW[p].Tech[ad] := tsSeen; 383 // inc(nTech[p]); 384 inc(Researched[p]) 385 end; 386 387 procedure FreeSlaves; 388 var 389 p1, uix: integer; 390 begin 391 for p1 := 0 to nPl - 1 do 392 if (GAlive and (1 shl p1) <> 0) then 393 for uix := 0 to RW[p1].nUn - 1 do 394 if RW[p1].Model[RW[p1].Un[uix].mix].Kind = mkSlaves then 395 RW[p1].Un[uix].Job := jNone 396 end; 397 398 procedure DiscoverTech(p, ad: integer); 399 400 procedure TellAboutKeyTech(p, Source: integer); 401 var 402 i, p1: integer; 403 begin 404 for i := 1 to 3 do 405 if ad = AgePreq[i] then 406 for p1 := 0 to nPl - 1 do 407 if (p1 <> p) and ((GAlive or GWatching) and (1 shl p1) <> 0) then 408 RW[p1].EnemyReport[p].Tech[ad] := Source; 409 end; 410 411 var 412 i: integer; 413 begin 414 if ad in FutureTech then 415 begin 416 if RW[p].Tech[ad] < tsApplicable then 417 RW[p].Tech[ad] := 1 418 else 419 inc(RW[p].Tech[ad]); 420 if ad <> futResearchTechnology then 421 inc(nTech[p], 2); 422 inc(Researched[p], 8); 423 exit; 424 end; 425 426 if RW[p].Tech[ad] = tsSeen then 427 begin 428 inc(nTech[p]); 429 inc(Researched[p]); 262 430 end 263 end; 264 265 procedure SetModelFlags(var m: TModel); 266 begin 267 m.Flags:=0; 268 if (m.Domain=dGround) and (m.Kind<>mkDiplomat) then 269 m.Flags:=m.Flags or mdZOC; 270 if (m.Kind=mkDiplomat) or (m.Attack+m.Cap[mcBombs]=0) then 271 m.Flags:=m.Flags or mdCivil; 272 if (m.Cap[mcOver]>0) or (m.Domain=dSea) and (m.Weight>=6) then 273 m.Flags:=m.Flags or mdDoubleSupport; 274 end; 275 276 procedure CalculateModel(var m: TModel); 277 {calculate attack, defense, cost... of a model by features} 278 var 279 i: integer; 280 begin 281 with m do 282 begin 283 Attack:=(Cap[mcOffense]+Cap[mcOver])*MStrength; 284 Defense:=(Cap[mcDefense]+Cap[mcOver])*MStrength; 285 case Domain of 286 dGround: Speed:=150+Cap[mcMob]*50; 287 dSea: 288 begin 289 Speed:=350+200*Cap[mcNP]+200*Cap[mcTurbines]; 290 if Cap[mcNP]=0 then 291 inc(Speed,100*Cap[mcSE]); 292 end; 293 dAir: Speed:=850+400*Cap[mcJet]; 294 end; 295 Cost:=0; 296 for i:=0 to nFeature-1 do 297 if 1 shl Domain and Feature[i].Domains<>0 then 298 inc(Cost,Cap[i]*Feature[i].Cost); 299 Cost:=Cost*MCost; 300 Weight:=0; 301 for i:=0 to nFeature-1 do 302 if 1 shl Domain and Feature[i].Domains<>0 then 303 if (Domain=dGround) and (i=mcDefense) then inc(Weight,Cap[i]*2) 304 else inc(Weight,Cap[i]*Feature[i].Weight); 305 end; 306 SetModelFlags(m); 307 end; 308 309 procedure CheckSpecialModels(p,pre: integer); 310 var 311 i,mix1: integer; 312 HasAlready: boolean; 313 begin 314 for i:=0 to nSpecialModel-1 do {check whether new special model available} 315 if (SpecialModelPreq[i]=pre) and (RW[p].nModel<nmmax) then 316 begin 317 HasAlready:=false; 318 for mix1:=0 to RW[p].nModel-1 do 319 if (RW[p].Model[mix1].Kind=SpecialModel[i].Kind) 320 and (RW[p].Model[mix1].Attack=SpecialModel[i].Attack) 321 and (RW[p].Model[mix1].Speed=SpecialModel[i].Speed) then 322 HasAlready:=true; 323 if not HasAlready then 324 begin 325 RW[p].Model[RW[p].nModel]:=SpecialModel[i]; 326 SetModelFlags(RW[p].Model[RW[p].nModel]); 327 with RW[p].Model[RW[p].nModel] do 328 begin 329 Status:=0; 330 SavedStatus:=0; 331 IntroTurn:=GTurn; 332 Built:=0; 333 Lost:=0; 334 ID:=p shl 12+RW[p].nModel; 335 if (Kind=mkSpecial_Boat) and (ServerVersion[p]<$000EF0) then 336 Speed:=350; // old longboat 337 end; 338 inc(RW[p].nModel); 339 end 340 end; 341 end; 342 343 procedure EnableDevModel(p: integer); 344 begin 345 with RW[p] do if nModel<nmmax then 346 begin 347 Model[nModel]:=DevModel; 348 with Model[nModel] do 349 begin 350 Status:=0; 351 SavedStatus:=0; 352 IntroTurn:=GTurn; 353 Built:=0; 354 Lost:=0; 355 ID:=p shl 12+nModel 356 end; 357 inc(nModel); 358 inc(Researched[p]) 359 end 360 end; 361 362 procedure SeeTech(p,ad: integer); 363 begin 364 {$IFDEF TEXTLOG}CmdInfo:=CmdInfo+Format(' P%d:A%d', [p,ad]);{$ENDIF} 365 RW[p].Tech[ad]:=tsSeen; 366 //inc(nTech[p]); 367 inc(Researched[p]) 368 end; 369 370 procedure FreeSlaves; 371 var 372 p1,uix: integer; 373 begin 374 for p1:=0 to nPl-1 do if (GAlive and (1 shl p1)<>0) then 375 for uix:=0 to RW[p1].nUn-1 do 376 if RW[p1].Model[RW[p1].Un[uix].mix].Kind=mkSlaves then 377 RW[p1].Un[uix].Job:=jNone 378 end; 379 380 procedure DiscoverTech(p,ad: integer); 381 382 procedure TellAboutKeyTech(p,Source: integer); 383 var 384 i,p1: integer; 385 begin 386 for i:=1 to 3 do if ad=AgePreq[i] then 387 for p1:=0 to nPl-1 do if (p1<>p) and ((GAlive or GWatching) and (1 shl p1)<>0) then 388 RW[p1].EnemyReport[p].Tech[ad]:=Source; 389 end; 390 391 var 392 i: integer; 393 begin 394 if ad in FutureTech then 395 begin 396 if RW[p].Tech[ad]<tsApplicable then RW[p].Tech[ad]:=1 397 else inc(RW[p].Tech[ad]); 398 if ad<>futResearchTechnology then inc(nTech[p],2); 399 inc(Researched[p],8); 400 exit; 401 end; 402 403 if RW[p].Tech[ad]=tsSeen then 404 begin inc(nTech[p]); inc(Researched[p]); end 405 else begin inc(nTech[p],2); inc(Researched[p],2); end; 406 RW[p].Tech[ad]:=tsResearched; 407 TellAboutKeyTech(p,tsResearched); 408 CheckSpecialModels(p,ad); 409 if ad=adScience then 410 ResourceMask[p]:=ResourceMask[p] or fSpecial2; 411 if ad=adMassProduction then 412 ResourceMask[p]:=ResourceMask[p] or fModern; 413 414 for i:=0 to 27 do {check whether wonders expired} 415 if (GWonder[i].EffectiveOwner<>GWonder[woEiffel].EffectiveOwner) 416 and (Imp[i].Expiration=ad) then 417 begin 418 GWonder[i].EffectiveOwner:=-1; 419 if i=woPyramids then FreeSlaves; 431 else 432 begin 433 inc(nTech[p], 2); 434 inc(Researched[p], 2); 435 end; 436 RW[p].Tech[ad] := tsResearched; 437 TellAboutKeyTech(p, tsResearched); 438 CheckSpecialModels(p, ad); 439 if ad = adScience then 440 ResourceMask[p] := ResourceMask[p] or fSpecial2; 441 if ad = adMassProduction then 442 ResourceMask[p] := ResourceMask[p] or fModern; 443 444 for i := 0 to 27 do { check whether wonders expired } 445 if (GWonder[i].EffectiveOwner <> GWonder[woEiffel].EffectiveOwner) and 446 (Imp[i].Expiration = ad) then 447 begin 448 GWonder[i].EffectiveOwner := -1; 449 if i = woPyramids then 450 FreeSlaves; 420 451 end; 421 452 end; … … 424 455 // GWonder[Wonder].EffectiveOwner must be set before! 425 456 var 426 p: integer; 427 begin 428 if (Imp[Wonder].Expiration>=0) 429 and (GWonder[woEiffel].EffectiveOwner<>GWonder[Wonder].EffectiveOwner) then 430 for p:=0 to nPl-1 do // check if already expired 431 if (1 shl p and GAlive<>0) and (RW[p].Tech[Imp[Wonder].Expiration]>=tsApplicable) then 432 begin 433 GWonder[Wonder].EffectiveOwner:=-1; 434 if Wonder=woPyramids then FreeSlaves 457 p: integer; 458 begin 459 if (Imp[Wonder].Expiration >= 0) and 460 (GWonder[woEiffel].EffectiveOwner <> GWonder[Wonder].EffectiveOwner) then 461 for p := 0 to nPl - 1 do // check if already expired 462 if (1 shl p and GAlive <> 0) and 463 (RW[p].Tech[Imp[Wonder].Expiration] >= tsApplicable) then 464 begin 465 GWonder[Wonder].EffectiveOwner := -1; 466 if Wonder = woPyramids then 467 FreeSlaves 435 468 end 436 469 end; 437 470 438 471 { 439 440 ____________________________________________________________________472 Location Navigation 473 ____________________________________________________________________ 441 474 } 442 function dLoc(Loc,dx,dy: integer): integer; 443 {relative location, dx in hor and dy in ver direction from Loc} 444 var 445 y0: integer; 446 begin 447 assert((Loc>=0) and (Loc<MapSize) and (dx+lx>=0)); 448 y0:=Loc div lx; 449 result:=(Loc+(dx+y0 and 1+lx+lx) shr 1) mod lx +lx*(y0+dy); 450 if (result<0) or (result>=MapSize) then result:=-1; 451 end; 452 453 procedure dxdy(Loc0,Loc1: integer; var dx,dy: integer); 454 begin 455 dx:=((Loc1 mod lx *2 +Loc1 div lx and 1) 456 -(Loc0 mod lx *2 +Loc0 div lx and 1)+3*lx) mod (2*lx) -lx; 457 dy:=Loc1 div lx-Loc0 div lx; 458 end; 459 460 function Distance(Loc0,Loc1: integer): integer; 461 var 462 dx,dy: integer; 463 begin 464 dxdy(Loc0,Loc1,dx,dy); 465 dx:=abs(dx); 466 dy:=abs(dy); 467 result:=dx+dy+abs(dx-dy) shr 1; 475 function dLoc(Loc, dx, dy: integer): integer; 476 { relative location, dx in hor and dy in ver direction from Loc } 477 var 478 y0: integer; 479 begin 480 assert((Loc >= 0) and (Loc < MapSize) and (dx + lx >= 0)); 481 y0 := Loc div lx; 482 result := (Loc + (dx + y0 and 1 + lx + lx) shr 1) mod lx + lx * (y0 + dy); 483 if (result < 0) or (result >= MapSize) then 484 result := -1; 485 end; 486 487 procedure dxdy(Loc0, Loc1: integer; var dx, dy: integer); 488 begin 489 dx := ((Loc1 mod lx * 2 + Loc1 div lx and 1) - 490 (Loc0 mod lx * 2 + Loc0 div lx and 1) + 3 * lx) mod (2 * lx) - lx; 491 dy := Loc1 div lx - Loc0 div lx; 492 end; 493 494 function Distance(Loc0, Loc1: integer): integer; 495 var 496 dx, dy: integer; 497 begin 498 dxdy(Loc0, Loc1, dx, dy); 499 dx := abs(dx); 500 dy := abs(dy); 501 result := dx + dy + abs(dx - dy) shr 1; 468 502 end; 469 503 470 504 procedure V8_to_Loc(Loc0: integer; var VicinityLoc: TVicinity8Loc); 471 505 var 472 x0,y0,lx0: integer;473 begin 474 lx0:=lx; // put in register!475 y0:=Loc0 div lx0;476 x0:=Loc0-y0*lx0; // Loc0 mod lx;477 y0:=y0 and 1;478 VicinityLoc[1]:=Loc0+lx0*2;479 VicinityLoc[3]:=Loc0-1;480 VicinityLoc[5]:=Loc0-lx0*2;481 VicinityLoc[7]:=Loc0+1;482 inc(Loc0,y0);483 VicinityLoc[0]:=Loc0+lx0;484 VicinityLoc[2]:=Loc0+lx0-1;485 VicinityLoc[4]:=Loc0-lx0-1;486 VicinityLoc[6]:=Loc0-lx0;487 488 // world is round!489 if x0<lx0-1 then490 begin 491 if x0=0 then492 begin 493 inc(VicinityLoc[3],lx0);494 if y0=0 then495 begin 496 inc(VicinityLoc[2],lx0);497 inc(VicinityLoc[4],lx0);506 x0, y0, lx0: integer; 507 begin 508 lx0 := lx; // put in register! 509 y0 := Loc0 div lx0; 510 x0 := Loc0 - y0 * lx0; // Loc0 mod lx; 511 y0 := y0 and 1; 512 VicinityLoc[1] := Loc0 + lx0 * 2; 513 VicinityLoc[3] := Loc0 - 1; 514 VicinityLoc[5] := Loc0 - lx0 * 2; 515 VicinityLoc[7] := Loc0 + 1; 516 inc(Loc0, y0); 517 VicinityLoc[0] := Loc0 + lx0; 518 VicinityLoc[2] := Loc0 + lx0 - 1; 519 VicinityLoc[4] := Loc0 - lx0 - 1; 520 VicinityLoc[6] := Loc0 - lx0; 521 522 // world is round! 523 if x0 < lx0 - 1 then 524 begin 525 if x0 = 0 then 526 begin 527 inc(VicinityLoc[3], lx0); 528 if y0 = 0 then 529 begin 530 inc(VicinityLoc[2], lx0); 531 inc(VicinityLoc[4], lx0); 498 532 end 499 533 end 500 534 end 501 else502 begin 503 dec(VicinityLoc[7],lx0);504 if y0=1 then505 begin 506 dec(VicinityLoc[0],lx0);507 dec(VicinityLoc[6],lx0);535 else 536 begin 537 dec(VicinityLoc[7], lx0); 538 if y0 = 1 then 539 begin 540 dec(VicinityLoc[0], lx0); 541 dec(VicinityLoc[6], lx0); 508 542 end 509 543 end; … … 512 546 procedure V21_to_Loc(Loc0: integer; var VicinityLoc: TVicinity21Loc); 513 547 var 514 dx,dy,bit,y0,xComp,yComp,xComp0,xCompSwitch: integer; 515 dst: ^integer; 516 begin 517 y0:=Loc0 div lx; 518 xComp0:=Loc0-y0*lx-1; // Loc0 mod lx -1 519 xCompSwitch:=xComp0-1+y0 and 1; 520 if xComp0<0 then inc(xComp0,lx); 521 if xCompSwitch<0 then inc(xCompSwitch,lx); 522 xCompSwitch:=xCompSwitch xor xComp0; 523 yComp:=lx*(y0-3); 524 dst:=@VicinityLoc; 525 bit:=1; 526 for dy:=0 to 6 do 527 begin 528 xComp0:=xComp0 xor xCompSwitch; 529 xComp:=xComp0; 530 for dx:=0 to 3 do 531 begin 532 if bit and $67F7F76<>0 then dst^:=xComp+yComp 533 else dst^:=-1; 534 inc(xComp); 535 if xComp>=lx then dec(xComp, lx); 536 inc(dst); 537 bit:=bit shl 1; 538 end; 539 inc(yComp,lx); 540 end; 541 end; 542 548 dx, dy, bit, y0, xComp, yComp, xComp0, xCompSwitch: integer; 549 dst: ^integer; 550 begin 551 y0 := Loc0 div lx; 552 xComp0 := Loc0 - y0 * lx - 1; // Loc0 mod lx -1 553 xCompSwitch := xComp0 - 1 + y0 and 1; 554 if xComp0 < 0 then 555 inc(xComp0, lx); 556 if xCompSwitch < 0 then 557 inc(xCompSwitch, lx); 558 xCompSwitch := xCompSwitch xor xComp0; 559 yComp := lx * (y0 - 3); 560 dst := @VicinityLoc; 561 bit := 1; 562 for dy := 0 to 6 do 563 begin 564 xComp0 := xComp0 xor xCompSwitch; 565 xComp := xComp0; 566 for dx := 0 to 3 do 567 begin 568 if bit and $67F7F76 <> 0 then 569 dst^ := xComp + yComp 570 else 571 dst^ := -1; 572 inc(xComp); 573 if xComp >= lx then 574 dec(xComp, lx); 575 inc(dst); 576 bit := bit shl 1; 577 end; 578 inc(yComp, lx); 579 end; 580 end; 543 581 544 582 { 545 546 ____________________________________________________________________583 Map Creation 584 ____________________________________________________________________ 547 585 } 548 586 var 549 primitive: integer;550 StartLoc, StartLoc2: array[0..nPl-1] of integer; {starting coordinates}551 Elevation: array[0..lxmax*lymax-1] of Byte; {map elevation}552 ElCount: array[Byte] of integer; {count of elevation occurance}587 primitive: integer; 588 StartLoc, StartLoc2: array [0 .. nPl - 1] of integer; { starting coordinates } 589 Elevation: array [0 .. lxmax * lymax - 1] of Byte; { map elevation } 590 ElCount: array [Byte] of integer; { count of elevation occurance } 553 591 554 592 procedure CalculatePrimitive; 555 593 var 556 i,j: integer; 557 begin 558 primitive:=1; 559 i:=2; 560 while i*i<=MapSize+1 do // test whether prime 561 begin if (MapSize+1) mod i=0 then primitive:=0; inc(i) end; 562 563 if primitive>0 then 564 repeat 565 inc(primitive); 566 i:=1; 567 j:=0; 568 repeat inc(j); i:=i*primitive mod (MapSize+1) until (i=1) or (j=MapSize+1); 569 until j=MapSize; 594 i, j: integer; 595 begin 596 primitive := 1; 597 i := 2; 598 while i * i <= MapSize + 1 do // test whether prime 599 begin 600 if (MapSize + 1) mod i = 0 then 601 primitive := 0; 602 inc(i) 603 end; 604 605 if primitive > 0 then 606 repeat 607 inc(primitive); 608 i := 1; 609 j := 0; 610 repeat 611 inc(j); 612 i := i * primitive mod (MapSize + 1) 613 until (i = 1) or (j = MapSize + 1); 614 until j = MapSize; 570 615 end; 571 616 572 617 function MapGeneratorAvailable: boolean; 573 618 begin 574 result:=(primitive>0) and (lx>=20) and (ly>=40)619 result := (primitive > 0) and (lx >= 20) and (ly >= 40) 575 620 end; 576 621 577 622 procedure CreateElevation; 578 623 const 579 d=64;580 Smooth=0.049;{causes low amplitude of short waves}581 Detail=0.095;{causes short period of short waves}582 Merge=5;{elevation merging range at the connection line of the583 round world,in relation to lx}584 585 var 586 sa,ca,f1,f2:array[1..d] of single;587 imerge,x,y:integer;588 v,maxv:single;589 590 function Value(x, y:integer):single;{elevation formula}624 d = 64; 625 Smooth = 0.049; { causes low amplitude of short waves } 626 Detail = 0.095; { causes short period of short waves } 627 Merge = 5; { elevation merging range at the connection line of the 628 round world,in relation to lx } 629 630 var 631 sa, ca, f1, f2: array [1 .. d] of single; 632 imerge, x, y: integer; 633 v, maxv: single; 634 635 function Value(x, y: integer): single; { elevation formula } 591 636 var 592 i:integer; 593 begin 594 result:=0; 595 for i:=1 to d do result:=result+sin(f1[i]*((x*2+y and 1)*sa[i]+y*1.5*ca[i])) 596 *f2[i]; 597 {x values effectively multiplied with 2 to get 2 horizantal periods 598 of the prime waves} 599 end; 600 601 begin 602 for x:=1 to d do {prepare formula parameters} 603 begin 604 {$IFNDEF SCR}if x=1 then v:=pi/2 {first wave goes horizontal} 605 else{$ENDIF} v:=Random*2*pi; 606 sa[x]:=sin(v)/lx; 607 ca[x]:=cos(v)/ly; 608 f1[x]:=2*pi*Exp(Detail*(x-1)); 609 f2[x]:=Exp(-x*Smooth) 610 end; 611 612 imerge:=2*lx div Merge; 613 FillChar(ElCount,SizeOf(ElCount),0); 614 maxv:=0; 615 for x:=0 to lx-1 do for y:=0 to ly-1 do 616 begin 617 v:=Value(x,y); 618 if x*2<imerge then v:=(x*2*v+(imerge-x*2)*Value(x+lx,y))/imerge; 619 v:=v-sqr(sqr(2*y/ly-1));{soft cut at poles} 620 if v>maxv then maxv:=v; 621 622 if v<-4 then Elevation[x+lx*y]:=0 623 else if v>8.75 then Elevation[x+lx*y]:=255 624 else Elevation[x+lx*y]:=Round((v+4)*20); 625 inc(ElCount[Elevation[x+lx*y]]) 626 end; 637 i: integer; 638 begin 639 result := 0; 640 for i := 1 to d do 641 result := result + sin(f1[i] * ((x * 2 + y and 1) * sa[i] + y * 1.5 * 642 ca[i])) * f2[i]; 643 { x values effectively multiplied with 2 to get 2 horizantal periods 644 of the prime waves } 645 end; 646 647 begin 648 for x := 1 to d do { prepare formula parameters } 649 begin 650 {$IFNDEF SCR} if x = 1 then 651 v := pi / 2 { first wave goes horizontal } 652 else {$ENDIF} v := Random * 2 * pi; 653 sa[x] := sin(v) / lx; 654 ca[x] := cos(v) / ly; 655 f1[x] := 2 * pi * exp(Detail * (x - 1)); 656 f2[x] := exp(-x * Smooth) 657 end; 658 659 imerge := 2 * lx div Merge; 660 FillChar(ElCount, SizeOf(ElCount), 0); 661 maxv := 0; 662 for x := 0 to lx - 1 do 663 for y := 0 to ly - 1 do 664 begin 665 v := Value(x, y); 666 if x * 2 < imerge then 667 v := (x * 2 * v + (imerge - x * 2) * Value(x + lx, y)) / imerge; 668 v := v - sqr(sqr(2 * y / ly - 1)); { soft cut at poles } 669 if v > maxv then 670 maxv := v; 671 672 if v < -4 then 673 Elevation[x + lx * y] := 0 674 else if v > 8.75 then 675 Elevation[x + lx * y] := 255 676 else 677 Elevation[x + lx * y] := Round((v + 4) * 20); 678 inc(ElCount[Elevation[x + lx * y]]) 679 end; 627 680 end; 628 681 629 682 procedure FindContinents; 630 683 631 procedure ReplaceCont(a, b,Stop:integer);632 { replace continent name a by b}684 procedure ReplaceCont(a, b, Stop: integer); 685 { replace continent name a by b } 633 686 // make sure always continent[loc]<=loc 634 687 var 635 i: integer; 636 begin 637 if a<b then begin i:=a; a:=b; b:=i end; 638 if a>b then 639 for i:=a to Stop do if Continent[i]=a then Continent[i]:=b 640 end; 641 642 var 643 x,y,Loc,Wrong:integer; 644 begin 645 for y:=1 to ly-2 do for x:=0 to lx-1 do 646 begin 647 Loc:=x+lx*y; 648 Continent[Loc]:=-1; 649 if RealMap[Loc] and fTerrain>=fGrass then 650 begin 651 if (y-2>=1) and (RealMap[Loc-2*lx] and fTerrain>=fGrass) then 652 Continent[Loc]:=Continent[Loc-2*lx]; 653 if (x-1+y and 1>=0) and (y-1>=1) 654 and (RealMap[Loc-1+y and 1-lx] and fTerrain>=fGrass) then 655 Continent[Loc]:=Continent[Loc-1+y and 1-lx]; 656 if (x+y and 1<lx) and (y-1>=1) 657 and (RealMap[Loc+y and 1-lx] and fTerrain>=fGrass) then 658 Continent[Loc]:=Continent[Loc+y and 1-lx]; 659 if (x-1>=0) and (RealMap[Loc-1] and fTerrain>=fGrass) then 660 if Continent[Loc]=-1 then Continent[Loc]:=Continent[Loc-1] 661 else ReplaceCont(Continent[Loc-1],Continent[Loc],Loc); 662 if Continent[Loc]=-1 then Continent[Loc]:=Loc 663 end 664 end; 665 666 {connect continents due to round earth} 667 for y:=1 to ly-2 do if RealMap[lx*y] and fTerrain>=fGrass then 668 begin 669 Wrong:=-1; 670 if RealMap[lx-1+lx*y] and fTerrain>=fGrass then Wrong:=Continent[lx-1+lx*y]; 671 if (y and 1=0) and (y-1>=1) and (RealMap[lx-1+lx*(y-1)] and fTerrain>=fGrass) then 672 Wrong:=Continent[lx-1+lx*(y-1)]; 673 if (y and 1=0) and (y+1<ly-1) 674 and (RealMap[lx-1+lx*(y+1)] and fTerrain>=fGrass) then 675 Wrong:=Continent[lx-1+lx*(y+1)]; 676 if Wrong>=0 then ReplaceCont(Wrong,Continent[lx*y],MapSize-1) 677 end; 688 i: integer; 689 begin 690 if a < b then 691 begin 692 i := a; 693 a := b; 694 b := i 695 end; 696 if a > b then 697 for i := a to Stop do 698 if Continent[i] = a then 699 Continent[i] := b 700 end; 701 702 var 703 x, y, Loc, Wrong: integer; 704 begin 705 for y := 1 to ly - 2 do 706 for x := 0 to lx - 1 do 707 begin 708 Loc := x + lx * y; 709 Continent[Loc] := -1; 710 if RealMap[Loc] and fTerrain >= fGrass then 711 begin 712 if (y - 2 >= 1) and (RealMap[Loc - 2 * lx] and fTerrain >= fGrass) then 713 Continent[Loc] := Continent[Loc - 2 * lx]; 714 if (x - 1 + y and 1 >= 0) and (y - 1 >= 1) and 715 (RealMap[Loc - 1 + y and 1 - lx] and fTerrain >= fGrass) then 716 Continent[Loc] := Continent[Loc - 1 + y and 1 - lx]; 717 if (x + y and 1 < lx) and (y - 1 >= 1) and 718 (RealMap[Loc + y and 1 - lx] and fTerrain >= fGrass) then 719 Continent[Loc] := Continent[Loc + y and 1 - lx]; 720 if (x - 1 >= 0) and (RealMap[Loc - 1] and fTerrain >= fGrass) then 721 if Continent[Loc] = -1 then 722 Continent[Loc] := Continent[Loc - 1] 723 else 724 ReplaceCont(Continent[Loc - 1], Continent[Loc], Loc); 725 if Continent[Loc] = -1 then 726 Continent[Loc] := Loc 727 end 728 end; 729 730 { connect continents due to round earth } 731 for y := 1 to ly - 2 do 732 if RealMap[lx * y] and fTerrain >= fGrass then 733 begin 734 Wrong := -1; 735 if RealMap[lx - 1 + lx * y] and fTerrain >= fGrass then 736 Wrong := Continent[lx - 1 + lx * y]; 737 if (y and 1 = 0) and (y - 1 >= 1) and 738 (RealMap[lx - 1 + lx * (y - 1)] and fTerrain >= fGrass) then 739 Wrong := Continent[lx - 1 + lx * (y - 1)]; 740 if (y and 1 = 0) and (y + 1 < ly - 1) and 741 (RealMap[lx - 1 + lx * (y + 1)] and fTerrain >= fGrass) then 742 Wrong := Continent[lx - 1 + lx * (y + 1)]; 743 if Wrong >= 0 then 744 ReplaceCont(Wrong, Continent[lx * y], MapSize - 1) 745 end; 678 746 end; 679 747 … … 682 750 // must be done after FindContinents 683 751 var 684 i,j,Cnt,x,y,dx,dy,Loc0,Loc1,xworst,yworst,totalrare,RareMaxWater,RareType, 685 iBest,jbest,MinDist,xBlock,yBlock,V8: integer; 686 AreaCount, RareByArea, RareAdjacent: array[0..7,0..4] of integer; 687 RareLoc: array[0..11] of integer; 688 Dist: array[0..11,0..11] of integer; 689 Adjacent: TVicinity8Loc; 690 begin 691 RareMaxWater:=0; 692 repeat 693 FillChar(AreaCount, SizeOf(AreaCount), 0); 694 for y:=1 to ly-2 do 695 begin 696 yBlock:=y*5 div ly; 697 if yBlock=(y+1)*5 div ly then for x:=0 to lx-1 do 698 begin 699 xBlock:=x*8 div lx; 700 if xBlock=(x+1)*8 div lx then 701 begin 702 Loc0:=x+lx*y; 703 if RealMap[Loc0] and fTerrain>=fGrass then 752 i, j, Cnt, x, y, dx, dy, Loc0, Loc1, xworst, yworst, totalrare, RareMaxWater, 753 RareType, iBest, jbest, MinDist, xBlock, yBlock, V8: integer; 754 AreaCount, RareByArea, RareAdjacent: array [0 .. 7, 0 .. 4] of integer; 755 RareLoc: array [0 .. 11] of integer; 756 Dist: array [0 .. 11, 0 .. 11] of integer; 757 Adjacent: TVicinity8Loc; 758 begin 759 RareMaxWater := 0; 760 repeat 761 FillChar(AreaCount, SizeOf(AreaCount), 0); 762 for y := 1 to ly - 2 do 763 begin 764 yBlock := y * 5 div ly; 765 if yBlock = (y + 1) * 5 div ly then 766 for x := 0 to lx - 1 do 767 begin 768 xBlock := x * 8 div lx; 769 if xBlock = (x + 1) * 8 div lx then 704 770 begin 705 Cnt:=0; 706 V8_to_Loc(Loc0,Adjacent); 707 for V8:=0 to 7 do 771 Loc0 := x + lx * y; 772 if RealMap[Loc0] and fTerrain >= fGrass then 708 773 begin 709 Loc1:=Adjacent[V8]; 710 if (Loc1>=0) and (Loc1<MapSize) 711 and (RealMap[Loc1] and fTerrain<fGrass) then 712 inc(Cnt); // count adjacent water 774 Cnt := 0; 775 V8_to_Loc(Loc0, Adjacent); 776 for V8 := 0 to 7 do 777 begin 778 Loc1 := Adjacent[V8]; 779 if (Loc1 >= 0) and (Loc1 < MapSize) and 780 (RealMap[Loc1] and fTerrain < fGrass) then 781 inc(Cnt); // count adjacent water 782 end; 783 if Cnt <= RareMaxWater then // inner land 784 begin 785 inc(AreaCount[xBlock, yBlock]); 786 if Random(AreaCount[xBlock, yBlock]) = 0 then 787 RareByArea[xBlock, yBlock] := Loc0 788 end 713 789 end; 714 if Cnt<=RareMaxWater then // inner land 790 end; 791 end 792 end; 793 totalrare := 0; 794 for x := 0 to 7 do 795 for y := 0 to 4 do 796 if AreaCount[x, y] > 0 then 797 inc(totalrare); 798 inc(RareMaxWater); 799 until totalrare >= 12; 800 801 while totalrare > 12 do 802 begin // remove rarebyarea resources too close to each other 803 FillChar(RareAdjacent, SizeOf(RareAdjacent), 0); 804 for x := 0 to 7 do 805 for y := 0 to 4 do 806 if AreaCount[x, y] > 0 then 807 begin 808 if (AreaCount[(x + 1) mod 8, y] > 0) and 809 (Continent[RareByArea[x, y]] = Continent 810 [RareByArea[(x + 1) mod 8, y]]) then 811 begin 812 inc(RareAdjacent[x, y]); 813 inc(RareAdjacent[(x + 1) mod 8, y]); 814 end; 815 if y < 4 then 816 begin 817 if (AreaCount[x, y + 1] > 0) and 818 (Continent[RareByArea[x, y]] = Continent[RareByArea[x, y + 1]]) 819 then 715 820 begin 716 inc(AreaCount[xBlock,yBlock]); 717 if Random(AreaCount[xBlock,yBlock])=0 then 718 RareByArea[xBlock,yBlock]:=Loc0 821 inc(RareAdjacent[x, y]); 822 inc(RareAdjacent[x, y + 1]); 823 end; 824 if (AreaCount[(x + 1) mod 8, y + 1] > 0) and 825 (Continent[RareByArea[x, y]] = Continent[RareByArea[(x + 1) mod 8, 826 y + 1]]) then 827 begin 828 inc(RareAdjacent[x, y]); 829 inc(RareAdjacent[(x + 1) mod 8, y + 1]); 830 end; 831 if (AreaCount[(x + 7) mod 8, y + 1] > 0) and 832 (Continent[RareByArea[x, y]] = Continent[RareByArea[(x + 7) mod 8, 833 y + 1]]) then 834 begin 835 inc(RareAdjacent[x, y]); 836 inc(RareAdjacent[(x + 7) mod 8, y + 1]); 837 end; 838 end 839 end; 840 xworst := 0; 841 yworst := 0; 842 Cnt := 0; 843 for x := 0 to 7 do 844 for y := 0 to 4 do 845 if AreaCount[x, y] > 0 then 846 begin 847 if (Cnt = 0) or (RareAdjacent[x, y] > RareAdjacent[xworst, yworst]) 848 then 849 begin 850 xworst := x; 851 yworst := y; 852 Cnt := 1 853 end 854 else if (RareAdjacent[x, y] = RareAdjacent[xworst, yworst]) then 855 begin 856 inc(Cnt); 857 if Random(Cnt) = 0 then 858 begin 859 xworst := x; 860 yworst := y; 719 861 end 720 862 end; 721 863 end; 722 end 723 end; 724 totalrare:=0; 725 for x:=0 to 7 do for y:=0 to 4 do if AreaCount[x,y]>0 then 726 inc(totalrare); 727 inc(RareMaxWater); 728 until totalrare>=12; 729 730 while totalrare>12 do 731 begin // remove rarebyarea resources too close to each other 732 FillChar(RareAdjacent,SizeOf(RareAdjacent),0); 733 for x:=0 to 7 do for y:=0 to 4 do if AreaCount[x,y]>0 then 734 begin 735 if (AreaCount[(x+1) mod 8,y]>0) 736 and (Continent[RareByArea[x,y]]=Continent[RareByArea[(x+1) mod 8,y]]) then 737 begin 738 inc(RareAdjacent[x,y]); 739 inc(RareAdjacent[(x+1) mod 8,y]); 740 end; 741 if y<4 then 742 begin 743 if (AreaCount[x,y+1]>0) 744 and (Continent[RareByArea[x,y]]=Continent[RareByArea[x,y+1]]) then 745 begin 746 inc(RareAdjacent[x,y]); 747 inc(RareAdjacent[x,y+1]); 748 end; 749 if (AreaCount[(x+1) mod 8,y+1]>0) 750 and (Continent[RareByArea[x,y]]=Continent[RareByArea[(x+1) mod 8,y+1]]) then 751 begin 752 inc(RareAdjacent[x,y]); 753 inc(RareAdjacent[(x+1) mod 8,y+1]); 754 end; 755 if (AreaCount[(x+7) mod 8,y+1]>0) 756 and (Continent[RareByArea[x,y]]=Continent[RareByArea[(x+7) mod 8,y+1]]) then 757 begin 758 inc(RareAdjacent[x,y]); 759 inc(RareAdjacent[(x+7) mod 8,y+1]); 760 end; 761 end 762 end; 763 xworst:=0; yworst:=0; 764 Cnt:=0; 765 for x:=0 to 7 do for y:=0 to 4 do if AreaCount[x,y]>0 then 766 begin 767 if (Cnt=0) or (RareAdjacent[x,y]>RareAdjacent[xworst,yworst]) then 768 begin xworst:=x; yworst:=y; Cnt:=1 end 769 else if (RareAdjacent[x,y]=RareAdjacent[xworst,yworst]) then 770 begin 771 inc(Cnt); 772 if Random(Cnt)=0 then begin xworst:=x; yworst:=y; end 773 end; 774 end; 775 AreaCount[xworst,yworst]:=0; 776 dec(totalrare) 777 end; 778 779 Cnt:=0; 780 for x:=0 to 7 do for y:=0 to 4 do if AreaCount[x,y]>0 then 781 begin RareLoc[Cnt]:=RareByArea[x,y]; inc(Cnt) end; 782 for i:=0 to 11 do 783 begin 784 RealMap[RareLoc[i]]:=RealMap[RareLoc[i]] 785 and not (fTerrain or fSpecial) or (fDesert or fDeadLands); 786 for dy:=-1 to 1 do for dx:=-1 to 1 do if (dx+dy) and 1=0 then 787 begin 788 Loc1:=dLoc(RareLoc[i],dx,dy); 789 if (Loc1>=0) and (RealMap[Loc1] and fTerrain=fMountains) then 790 RealMap[Loc1]:=RealMap[Loc1] and not fTerrain or fHills; 791 end 792 end; 793 for i:=0 to 11 do for j:=0 to 11 do 794 Dist[i,j]:=Distance(RareLoc[i],RareLoc[j]); 795 796 MinDist:=Distance(0,MapSize-lx shr 1) shr 1; 797 for RareType:=1 to 3 do 798 begin 799 Cnt:=0; 800 for i:=0 to 11 do if RareLoc[i]>=0 then 801 for j:=0 to 11 do if RareLoc[j]>=0 then 802 if (Cnt>0) and (Dist[iBest,jbest]>=MinDist) then 803 begin 804 if Dist[i,j]>=MinDist then 805 begin 806 inc(Cnt); 807 if Random(Cnt)=0 then 808 begin iBest:=i; jbest:=j end 809 end 864 AreaCount[xworst, yworst] := 0; 865 dec(totalrare) 866 end; 867 868 Cnt := 0; 869 for x := 0 to 7 do 870 for y := 0 to 4 do 871 if AreaCount[x, y] > 0 then 872 begin 873 RareLoc[Cnt] := RareByArea[x, y]; 874 inc(Cnt) 875 end; 876 for i := 0 to 11 do 877 begin 878 RealMap[RareLoc[i]] := RealMap[RareLoc[i]] and not(fTerrain or fSpecial) or 879 (fDesert or fDeadLands); 880 for dy := -1 to 1 do 881 for dx := -1 to 1 do 882 if (dx + dy) and 1 = 0 then 883 begin 884 Loc1 := dLoc(RareLoc[i], dx, dy); 885 if (Loc1 >= 0) and (RealMap[Loc1] and fTerrain = fMountains) then 886 RealMap[Loc1] := RealMap[Loc1] and not fTerrain or fHills; 810 887 end 811 else if (Cnt=0) or (Dist[i,j]>Dist[iBest,jbest]) then 812 begin iBest:=i; jbest:=j; Cnt:=1; end; 813 RealMap[RareLoc[iBest]]:=RealMap[RareLoc[iBest]] or Cardinal(RareType) shl 25; 814 RealMap[RareLoc[jbest]]:=RealMap[RareLoc[jbest]] or Cardinal(RareType) shl 25; 815 RareLoc[iBest]:=-1; 816 RareLoc[jbest]:=-1; 888 end; 889 for i := 0 to 11 do 890 for j := 0 to 11 do 891 Dist[i, j] := Distance(RareLoc[i], RareLoc[j]); 892 893 MinDist := Distance(0, MapSize - lx shr 1) shr 1; 894 for RareType := 1 to 3 do 895 begin 896 Cnt := 0; 897 for i := 0 to 11 do 898 if RareLoc[i] >= 0 then 899 for j := 0 to 11 do 900 if RareLoc[j] >= 0 then 901 if (Cnt > 0) and (Dist[iBest, jbest] >= MinDist) then 902 begin 903 if Dist[i, j] >= MinDist then 904 begin 905 inc(Cnt); 906 if Random(Cnt) = 0 then 907 begin 908 iBest := i; 909 jbest := j 910 end 911 end 912 end 913 else if (Cnt = 0) or (Dist[i, j] > Dist[iBest, jbest]) then 914 begin 915 iBest := i; 916 jbest := j; 917 Cnt := 1; 918 end; 919 RealMap[RareLoc[iBest]] := RealMap[RareLoc[iBest]] or 920 Cardinal(RareType) shl 25; 921 RealMap[RareLoc[jbest]] := RealMap[RareLoc[jbest]] or 922 Cardinal(RareType) shl 25; 923 RareLoc[iBest] := -1; 924 RareLoc[jbest] := -1; 817 925 end; 818 926 end; // RarePositions … … 820 928 function CheckShore(Loc: integer): boolean; 821 929 var 822 Loc1,OldTile,V21: integer;823 Radius: TVicinity21Loc;824 begin 825 result:=false;826 OldTile:=RealMap[Loc];827 if OldTile and fTerrain<fGrass then828 begin 829 RealMap[Loc]:=RealMap[Loc] and not fTerrain or fOcean;830 V21_to_Loc(Loc,Radius);831 for V21:=1 to 26 do832 begin 833 Loc1:=Radius[V21];834 if (Loc1>=0) and (Loc1<MapSize)835 and (RealMap[Loc1] and fTerrain>=fGrass)836 and (RealMap[Loc1] and fTerrain<>fArctic) then837 RealMap[Loc]:=RealMap[Loc] and not fTerrain or fShore;838 end; 839 if (RealMap[Loc] xor Cardinal(OldTile)) and fTerrain<>0 then840 result:=true930 Loc1, OldTile, V21: integer; 931 Radius: TVicinity21Loc; 932 begin 933 result := false; 934 OldTile := RealMap[Loc]; 935 if OldTile and fTerrain < fGrass then 936 begin 937 RealMap[Loc] := RealMap[Loc] and not fTerrain or fOcean; 938 V21_to_Loc(Loc, Radius); 939 for V21 := 1 to 26 do 940 begin 941 Loc1 := Radius[V21]; 942 if (Loc1 >= 0) and (Loc1 < MapSize) and 943 (RealMap[Loc1] and fTerrain >= fGrass) and 944 (RealMap[Loc1] and fTerrain <> fArctic) then 945 RealMap[Loc] := RealMap[Loc] and not fTerrain or fShore; 946 end; 947 if (RealMap[Loc] xor Cardinal(OldTile)) and fTerrain <> 0 then 948 result := true 841 949 end; 842 950 end; … … 844 952 function ActualSpecialTile(Loc: integer): Cardinal; 845 953 begin 846 result:=SpecialTile(Loc, RealMap[Loc] and fTerrain, lx);954 result := SpecialTile(Loc, RealMap[Loc] and fTerrain, lx); 847 955 end; 848 956 849 957 procedure CreateMap(preview: boolean); 850 958 const 851 ShHiHills=6; {of land} 852 ShMountains=6; {of land} 853 ShRandHills=12; {of land} 854 ShTestRiver=40; 855 ShSwamp=25; {of grassland} 856 MinRivLen=3; 857 unification=70; 858 hotunification=50; // min. 25 859 860 Zone:array[0..3,2..9] of single= {terrain distribution} 861 ((0.25,0, 0, 0.4 ,0,0,0,0.35), 862 (0.55,0, 0.1 ,0, 0,0,0,0.35), 863 (0.4, 0, 0.35,0, 0,0,0,0.25), 864 (0, 0.7, 0, 0, 0,0,0,0.3)); 865 {Grs Dst Pra Tun - - - For} 866 867 function RndLow(y:integer):Cardinal; 868 {random lowland appropriate to climate} 959 ShHiHills = 6; { of land } 960 ShMountains = 6; { of land } 961 ShRandHills = 12; { of land } 962 ShTestRiver = 40; 963 ShSwamp = 25; { of grassland } 964 MinRivLen = 3; 965 unification = 70; 966 hotunification = 50; // min. 25 967 968 Zone: array [0 .. 3, 2 .. 9] of single = { terrain distribution } 969 ((0.25, 0, 0, 0.4, 0, 0, 0, 0.35), (0.55, 0, 0.1, 0, 0, 0, 0, 0.35), 970 (0.4, 0, 0.35, 0, 0, 0, 0, 0.25), (0, 0.7, 0, 0, 0, 0, 0, 0.3)); 971 { Grs Dst Pra Tun - - - For } 972 973 function RndLow(y: integer): Cardinal; 974 { random lowland appropriate to climate } 869 975 var 870 z0,i:integer; 871 p,p0,ZPlus:single; 872 begin 873 if ly-1-y>y then begin z0:=6*y div ly;ZPlus:=6*y/ly -z0 end 874 else begin z0:=6*(ly-1-y) div ly;ZPlus:=6*(ly-1-y)/ly -z0 end; 875 p0:=1; 876 for i:=2 to 9 do 877 begin 878 p:=Zone[z0,i]*(1-ZPlus)+Zone[z0+1,i]*ZPlus; 879 {weight between zones z0 and z0+1} 880 if Random*p0<p then begin RndLow:=i;Break end; 881 p0:=p0-p 976 z0, i: integer; 977 p, p0, ZPlus: single; 978 begin 979 if ly - 1 - y > y then 980 begin 981 z0 := 6 * y div ly; 982 ZPlus := 6 * y / ly - z0 983 end 984 else 985 begin 986 z0 := 6 * (ly - 1 - y) div ly; 987 ZPlus := 6 * (ly - 1 - y) / ly - z0 988 end; 989 p0 := 1; 990 for i := 2 to 9 do 991 begin 992 p := Zone[z0, i] * (1 - ZPlus) + Zone[z0 + 1, i] * ZPlus; 993 { weight between zones z0 and z0+1 } 994 if Random * p0 < p then 995 begin 996 RndLow := i; 997 Break 998 end; 999 p0 := p0 - p 882 1000 end; 883 1001 end; 884 1002 885 1003 function RunRiver(Loc0: integer): integer; 886 { runs river from start point Loc0; return value: length}1004 { runs river from start point Loc0; return value: length } 887 1005 var 888 Dir,T,Loc,Loc1,Cost: integer;889 Q: TIPQ;890 From: array[0..lxmax*lymax-1] of integer;891 Time: array[0..lxmax*lymax-1] of integer;892 OneTileLake: boolean;893 begin 894 FillChar(Time,SizeOf(Time),255); {-1}895 Q:=TIPQ.Create(MapSize);896 Q.Put(Loc0,0);897 while Q.Get(Loc,T) and (RealMap[Loc] and fRiver=0) do898 begin 899 if (RealMap[Loc] and fTerrain<fGrass) then900 begin 901 OneTileLake:=true;902 for Dir:=0 to 3 do903 begin 904 Loc1:=dLoc(Loc,Dir and 1 *2 -1,Dir shr 1 *2 -1);905 if (Loc1>=0) and (RealMap[Loc1] and fTerrain<fGrass) then906 OneTileLake:=false;1006 Dir, T, Loc, Loc1, Cost: integer; 1007 Q: TIPQ; 1008 From: array [0 .. lxmax * lymax - 1] of integer; 1009 Time: array [0 .. lxmax * lymax - 1] of integer; 1010 OneTileLake: boolean; 1011 begin 1012 FillChar(Time, SizeOf(Time), 255); { -1 } 1013 Q := TIPQ.Create(MapSize); 1014 Q.Put(Loc0, 0); 1015 while Q.Get(Loc, T) and (RealMap[Loc] and fRiver = 0) do 1016 begin 1017 if (RealMap[Loc] and fTerrain < fGrass) then 1018 begin 1019 OneTileLake := true; 1020 for Dir := 0 to 3 do 1021 begin 1022 Loc1 := dLoc(Loc, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1023 if (Loc1 >= 0) and (RealMap[Loc1] and fTerrain < fGrass) then 1024 OneTileLake := false; 907 1025 end; 908 if not OneTileLake then Break; 909 end; 910 Time[Loc]:=T; 911 for Dir:=0 to 3 do 912 begin 913 Loc1:=dLoc(Loc,Dir and 1 *2 -1,Dir shr 1 *2 -1); 914 if (Loc1>=lx) and (Loc1<lx*(ly-1)) and (Time[Loc1]<0) then 915 begin 916 if RealMap[Loc1] and fRiver=0 then 1026 if not OneTileLake then 1027 Break; 1028 end; 1029 Time[Loc] := T; 1030 for Dir := 0 to 3 do 1031 begin 1032 Loc1 := dLoc(Loc, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1033 if (Loc1 >= lx) and (Loc1 < lx * (ly - 1)) and (Time[Loc1] < 0) then 1034 begin 1035 if RealMap[Loc1] and fRiver = 0 then 917 1036 begin 918 Cost:=Elevation[Loc1]-Elevation[Loc]; 919 if Cost<0 then Cost:=0; 1037 Cost := Elevation[Loc1] - Elevation[Loc]; 1038 if Cost < 0 then 1039 Cost := 0; 920 1040 end 921 else Cost:=0; 922 if Q.Put(Loc1,T+Cost shl 8+1) then From[Loc1]:=Loc 1041 else 1042 Cost := 0; 1043 if Q.Put(Loc1, T + Cost shl 8 + 1) then 1044 From[Loc1] := Loc 923 1045 end 924 1046 end 925 1047 end; 926 Loc1:=Loc; 927 result:=0; 928 while Loc<>Loc0 do begin Loc:=From[Loc]; inc(result); end; 929 if (result>1) and ((result>=MinRivLen) or (RealMap[Loc1] and fTerrain>=fGrass)) then 930 begin 931 Loc:=Loc1; 932 while Loc<>Loc0 do 933 begin 934 Loc:=From[Loc]; 935 if RealMap[Loc] and fTerrain in [fHills,fMountains] then 936 RealMap[Loc]:=fGrass or fRiver 937 else if RealMap[Loc] and fTerrain>=fGrass then 938 RealMap[Loc]:=RealMap[Loc] or fRiver; 1048 Loc1 := Loc; 1049 result := 0; 1050 while Loc <> Loc0 do 1051 begin 1052 Loc := From[Loc]; 1053 inc(result); 1054 end; 1055 if (result > 1) and ((result >= MinRivLen) or 1056 (RealMap[Loc1] and fTerrain >= fGrass)) then 1057 begin 1058 Loc := Loc1; 1059 while Loc <> Loc0 do 1060 begin 1061 Loc := From[Loc]; 1062 if RealMap[Loc] and fTerrain in [fHills, fMountains] then 1063 RealMap[Loc] := fGrass or fRiver 1064 else if RealMap[Loc] and fTerrain >= fGrass then 1065 RealMap[Loc] := RealMap[Loc] or fRiver; 939 1066 end 940 1067 end 941 else result:=0; 942 Q.Free 943 end; 944 945 var 946 x,y,n,Dir,plus,Count,Loc0,Loc1,bLand,bHills,bMountains,V8: integer; 947 CopyFrom: array[0..lxmax*lymax-1] of integer; 948 Adjacent: TVicinity8Loc; 949 950 begin 951 FillChar(RealMap,MapSize*4,0); 952 plus:=0; 953 bMountains:=256; 954 while plus<MapSize*LandMass*ShMountains div 10000 do 955 begin dec(bMountains);inc(plus,ElCount[bMountains]) end; 956 Count:=plus; 957 plus:=0; 958 bHills:=bMountains; 959 while plus<MapSize*LandMass*ShHiHills div 10000 do 960 begin dec(bHills);inc(plus,ElCount[bHills]) end; 961 inc(Count,plus); 962 bLand:=bHills; 963 while Count<MapSize*LandMass div 100 do 964 begin dec(bLand);inc(Count,ElCount[bLand]) end; 965 966 for Loc0:=lx to lx*(ly-1)-1 do 967 if Elevation[Loc0]>=bMountains then RealMap[Loc0]:=fMountains 968 else if Elevation[Loc0]>=bHills then RealMap[Loc0]:=fHills 969 else if Elevation[Loc0]>=bLand then RealMap[Loc0]:=fGrass; 970 971 // remove one-tile islands 972 for Loc0:=0 to MapSize-1 do 973 if RealMap[Loc0]>=fGrass then 974 begin 975 Count:=0; 976 V8_to_Loc(Loc0,Adjacent); 977 for V8:=0 to 7 do 978 begin 979 Loc1:=Adjacent[V8]; 980 if (Loc1<0) or (Loc1>=MapSize) 981 or (RealMap[Loc1] and fTerrain<fGrass) 982 or (RealMap[Loc1] and fTerrain=fArctic) then 983 inc(Count); // count adjacent water 984 end; 985 if Count=8 then RealMap[Loc0]:=fOcean 986 end; 987 988 if not preview then 989 begin 990 plus:=36*56*20*ShTestRiver div (LandMass*100); 991 if plus>MapSize then plus:=MapSize; 992 Loc0:=Random(MapSize); 993 for n:=0 to plus-1 do 994 begin 995 if (RealMap[Loc0] and fTerrain>=fGrass) and (Loc0>=lx) and (Loc0<MapSize-lx) then 996 RunRiver(Loc0); 997 Loc0:=(Loc0+1)*primitive mod (MapSize+1) -1; 998 end; 999 end; 1000 1001 for Loc0:=0 to MapSize-1 do 1002 if (RealMap[Loc0]=fGrass) and (Random(100)<ShRandHills) then 1003 RealMap[Loc0]:=RealMap[Loc0] or fHills; 1004 1005 // make terrain types coherent 1006 for Loc0:=0 to MapSize-1 do CopyFrom[Loc0]:=Loc0; 1007 1008 for n:=0 to unification*MapSize div 100 do 1009 begin 1010 y:=Random(ly); 1011 if abs(y-(ly shr 1))>ly div 4+Random(ly*hotunification div 100) then 1012 if y<ly shr 1 then y:=ly shr 1-y 1013 else y:=3*ly shr 1-y; 1014 Loc0:=lx*y+Random(lx); 1015 if RealMap[Loc0] and fTerrain=fGrass then 1016 begin 1017 Dir:=Random(4); 1018 Loc1:=dLoc(Loc0,Dir and 1 *2 -1,Dir shr 1 *2 -1); 1019 if (Loc1>=0) and (RealMap[Loc1] and fTerrain=fGrass) then 1020 begin 1021 while CopyFrom[Loc0]<>Loc0 do Loc0:=CopyFrom[Loc0]; 1022 while CopyFrom[Loc1]<>Loc1 do Loc1:=CopyFrom[Loc1]; 1023 if Loc1<Loc0 then CopyFrom[Loc0]:=Loc1 1024 else CopyFrom[Loc1]:=Loc0; 1025 end; 1026 end; 1027 end; 1028 1029 for Loc0:=0 to MapSize-1 do 1030 if (RealMap[Loc0] and fTerrain=fGrass) and (CopyFrom[Loc0]=Loc0) then 1031 RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or RndLow(Loc0 div lx); 1032 1033 for Loc0:=0 to MapSize-1 do 1034 if RealMap[Loc0] and fTerrain=fGrass then 1035 begin 1036 Loc1:=Loc0; 1037 while CopyFrom[Loc1]<>Loc1 do Loc1:=CopyFrom[Loc1]; 1038 RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or RealMap[Loc1] and fTerrain 1039 end; 1040 1041 for Loc0:=0 to MapSize-1 do 1042 if RealMap[Loc0] and fTerrain=fGrass then 1068 else 1069 result := 0; 1070 Q.Free 1071 end; 1072 1073 var 1074 x, y, n, Dir, plus, Count, Loc0, Loc1, bLand, bHills, bMountains, V8: integer; 1075 CopyFrom: array [0 .. lxmax * lymax - 1] of integer; 1076 Adjacent: TVicinity8Loc; 1077 1078 begin 1079 FillChar(RealMap, MapSize * 4, 0); 1080 plus := 0; 1081 bMountains := 256; 1082 while plus < MapSize * LandMass * ShMountains div 10000 do 1083 begin 1084 dec(bMountains); 1085 inc(plus, ElCount[bMountains]) 1086 end; 1087 Count := plus; 1088 plus := 0; 1089 bHills := bMountains; 1090 while plus < MapSize * LandMass * ShHiHills div 10000 do 1091 begin 1092 dec(bHills); 1093 inc(plus, ElCount[bHills]) 1094 end; 1095 inc(Count, plus); 1096 bLand := bHills; 1097 while Count < MapSize * LandMass div 100 do 1098 begin 1099 dec(bLand); 1100 inc(Count, ElCount[bLand]) 1101 end; 1102 1103 for Loc0 := lx to lx * (ly - 1) - 1 do 1104 if Elevation[Loc0] >= bMountains then 1105 RealMap[Loc0] := fMountains 1106 else if Elevation[Loc0] >= bHills then 1107 RealMap[Loc0] := fHills 1108 else if Elevation[Loc0] >= bLand then 1109 RealMap[Loc0] := fGrass; 1110 1111 // remove one-tile islands 1112 for Loc0 := 0 to MapSize - 1 do 1113 if RealMap[Loc0] >= fGrass then 1114 begin 1115 Count := 0; 1116 V8_to_Loc(Loc0, Adjacent); 1117 for V8 := 0 to 7 do 1118 begin 1119 Loc1 := Adjacent[V8]; 1120 if (Loc1 < 0) or (Loc1 >= MapSize) or 1121 (RealMap[Loc1] and fTerrain < fGrass) or 1122 (RealMap[Loc1] and fTerrain = fArctic) then 1123 inc(Count); // count adjacent water 1124 end; 1125 if Count = 8 then 1126 RealMap[Loc0] := fOcean 1127 end; 1128 1129 if not preview then 1130 begin 1131 plus := 36 * 56 * 20 * ShTestRiver div (LandMass * 100); 1132 if plus > MapSize then 1133 plus := MapSize; 1134 Loc0 := Random(MapSize); 1135 for n := 0 to plus - 1 do 1136 begin 1137 if (RealMap[Loc0] and fTerrain >= fGrass) and (Loc0 >= lx) and 1138 (Loc0 < MapSize - lx) then 1139 RunRiver(Loc0); 1140 Loc0 := (Loc0 + 1) * primitive mod (MapSize + 1) - 1; 1141 end; 1142 end; 1143 1144 for Loc0 := 0 to MapSize - 1 do 1145 if (RealMap[Loc0] = fGrass) and (Random(100) < ShRandHills) then 1146 RealMap[Loc0] := RealMap[Loc0] or fHills; 1147 1148 // make terrain types coherent 1149 for Loc0 := 0 to MapSize - 1 do 1150 CopyFrom[Loc0] := Loc0; 1151 1152 for n := 0 to unification * MapSize div 100 do 1153 begin 1154 y := Random(ly); 1155 if abs(y - (ly shr 1)) > ly div 4 + Random(ly * hotunification div 100) then 1156 if y < ly shr 1 then 1157 y := ly shr 1 - y 1158 else 1159 y := 3 * ly shr 1 - y; 1160 Loc0 := lx * y + Random(lx); 1161 if RealMap[Loc0] and fTerrain = fGrass then 1162 begin 1163 Dir := Random(4); 1164 Loc1 := dLoc(Loc0, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1165 if (Loc1 >= 0) and (RealMap[Loc1] and fTerrain = fGrass) then 1166 begin 1167 while CopyFrom[Loc0] <> Loc0 do 1168 Loc0 := CopyFrom[Loc0]; 1169 while CopyFrom[Loc1] <> Loc1 do 1170 Loc1 := CopyFrom[Loc1]; 1171 if Loc1 < Loc0 then 1172 CopyFrom[Loc0] := Loc1 1173 else 1174 CopyFrom[Loc1] := Loc0; 1175 end; 1176 end; 1177 end; 1178 1179 for Loc0 := 0 to MapSize - 1 do 1180 if (RealMap[Loc0] and fTerrain = fGrass) and (CopyFrom[Loc0] = Loc0) then 1181 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or RndLow(Loc0 div lx); 1182 1183 for Loc0 := 0 to MapSize - 1 do 1184 if RealMap[Loc0] and fTerrain = fGrass then 1185 begin 1186 Loc1 := Loc0; 1187 while CopyFrom[Loc1] <> Loc1 do 1188 Loc1 := CopyFrom[Loc1]; 1189 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or 1190 RealMap[Loc1] and fTerrain 1191 end; 1192 1193 for Loc0 := 0 to MapSize - 1 do 1194 if RealMap[Loc0] and fTerrain = fGrass then 1043 1195 begin // change grassland to swamp 1044 if Random(100)<ShSwamp then 1045 RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or fSwamp; 1046 end; 1047 1048 for Loc0:=0 to MapSize-1 do // change desert to prairie 1 1049 if RealMap[Loc0] and fTerrain=fDesert then 1050 begin 1051 if RealMap[Loc0] and fRiver<>0 then Count:=5 1052 else 1053 begin 1054 Count:=0; 1055 for Dir:=0 to 3 do 1056 begin 1057 Loc1:=dLoc(Loc0,Dir and 1 *2 -1,Dir shr 1 *2 -1); 1058 if Loc1>=0 then 1059 if RealMap[Loc1] and fTerrain<fGrass then inc(Count,2) 1196 if Random(100) < ShSwamp then 1197 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or fSwamp; 1198 end; 1199 1200 for Loc0 := 0 to MapSize - 1 do // change desert to prairie 1 1201 if RealMap[Loc0] and fTerrain = fDesert then 1202 begin 1203 if RealMap[Loc0] and fRiver <> 0 then 1204 Count := 5 1205 else 1206 begin 1207 Count := 0; 1208 for Dir := 0 to 3 do 1209 begin 1210 Loc1 := dLoc(Loc0, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1211 if Loc1 >= 0 then 1212 if RealMap[Loc1] and fTerrain < fGrass then 1213 inc(Count, 2) 1060 1214 end; 1061 1215 end; 1062 if Count>=4 then RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or fPrairie 1063 end; 1064 1065 for Loc0:=0 to MapSize-1 do // change desert to prairie 2 1066 if RealMap[Loc0] and fTerrain=fDesert then 1067 begin 1068 Count:=0; 1069 for Dir:=0 to 3 do 1070 begin 1071 Loc1:=dLoc(Loc0,Dir and 1 *2 -1,Dir shr 1 *2 -1); 1072 if Loc1>=0 then 1073 if RealMap[Loc1] and fTerrain<>fDesert then inc(Count) 1074 end; 1075 if Count>=4 then RealMap[Loc0]:=RealMap[Loc0] and not fTerrain or fPrairie 1076 end; 1077 1078 for Loc0:=0 to MapSize-1 do CheckShore(Loc0); // change ocean to shore 1079 for x:=0 to lx-1 do 1080 begin 1081 RealMap[x+lx*0]:=fArctic; 1082 if RealMap[x+lx*1]>=fGrass then 1083 RealMap[x+lx*1]:=RealMap[x+lx*1] and not fTerrain or fTundra; 1084 if RealMap[x+lx*(ly-2)]>=fGrass then 1085 RealMap[x+lx*(ly-2)]:=RealMap[x+lx*(ly-2)] and not fTerrain or fTundra; 1086 RealMap[x+lx*(ly-1)]:=fArctic 1087 end; 1088 1089 for Loc0:=0 to MapSize-1 do //define special terrain tiles 1090 RealMap[Loc0]:=RealMap[Loc0] or ActualSpecialTile(Loc0) shl 5 or ($F shl 27); 1091 1092 if not preview then 1093 begin FindContinents; RarePositions; end; 1216 if Count >= 4 then 1217 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or fPrairie 1218 end; 1219 1220 for Loc0 := 0 to MapSize - 1 do // change desert to prairie 2 1221 if RealMap[Loc0] and fTerrain = fDesert then 1222 begin 1223 Count := 0; 1224 for Dir := 0 to 3 do 1225 begin 1226 Loc1 := dLoc(Loc0, Dir and 1 * 2 - 1, Dir shr 1 * 2 - 1); 1227 if Loc1 >= 0 then 1228 if RealMap[Loc1] and fTerrain <> fDesert then 1229 inc(Count) 1230 end; 1231 if Count >= 4 then 1232 RealMap[Loc0] := RealMap[Loc0] and not fTerrain or fPrairie 1233 end; 1234 1235 for Loc0 := 0 to MapSize - 1 do 1236 CheckShore(Loc0); // change ocean to shore 1237 for x := 0 to lx - 1 do 1238 begin 1239 RealMap[x + lx * 0] := fArctic; 1240 if RealMap[x + lx * 1] >= fGrass then 1241 RealMap[x + lx * 1] := RealMap[x + lx * 1] and not fTerrain or fTundra; 1242 if RealMap[x + lx * (ly - 2)] >= fGrass then 1243 RealMap[x + lx * (ly - 2)] := RealMap[x + lx * (ly - 2)] and 1244 not fTerrain or fTundra; 1245 RealMap[x + lx * (ly - 1)] := fArctic 1246 end; 1247 1248 for Loc0 := 0 to MapSize - 1 do // define special terrain tiles 1249 RealMap[Loc0] := RealMap[Loc0] or ActualSpecialTile(Loc0) shl 5 or 1250 ($F shl 27); 1251 1252 if not preview then 1253 begin 1254 FindContinents; 1255 RarePositions; 1256 end; 1094 1257 end; 1095 1258 … … 1099 1262 1100 1263 var 1101 CountGood:(cgBest,cgFlat,cgLand);1264 CountGood: (cgBest, cgFlat, cgLand); 1102 1265 1103 1266 function IsGoodTile(Loc: integer): boolean; 1104 1267 var 1105 xLoc,yLoc: integer; 1106 begin 1107 xLoc:=Loc mod lx; yLoc:=Loc div lx; 1108 if RealMap[Loc] and fDeadLands<>0 then result:=false 1109 else 1110 case CountGood of 1111 cgBest: 1112 result:=(RealMap[Loc] and fTerrain in [fGrass,fPrairie,fTundra,fSwamp,fForest]) 1113 and Odd((lymax+xLoc-yLoc shr 1) shr 1+xLoc+(yLoc+1) shr 1); 1114 cgFlat: 1115 result:=(RealMap[Loc] and fTerrain in [fGrass,fPrairie,fTundra,fSwamp,fForest]); 1116 cgLand: 1117 result:= RealMap[Loc] and fTerrain>=fGrass; 1268 xLoc, yLoc: integer; 1269 begin 1270 xLoc := Loc mod lx; 1271 yLoc := Loc div lx; 1272 if RealMap[Loc] and fDeadLands <> 0 then 1273 result := false 1274 else 1275 case CountGood of 1276 cgBest: 1277 result := (RealMap[Loc] and fTerrain in [fGrass, fPrairie, fTundra, 1278 fSwamp, fForest]) and Odd((lymax + xLoc - yLoc shr 1) shr 1 + xLoc + 1279 (yLoc + 1) shr 1); 1280 cgFlat: 1281 result := (RealMap[Loc] and fTerrain in [fGrass, fPrairie, fTundra, 1282 fSwamp, fForest]); 1283 cgLand: 1284 result := RealMap[Loc] and fTerrain >= fGrass; 1118 1285 end; 1119 1286 end; 1120 1287 1121 1288 const 1122 MaxCityLoc=64; 1123 1124 var 1125 p1,p2,nAlive,c,Loc,Loc1,CntGood,CntGoodGrass,MinDist,Tries,i,j,n,nsc,TestLoc, 1126 V21,V8,BestDist,TestDist,MinGood,nIrrLoc,xLoc,yLoc,qx,qy,FineDistSQR, 1127 nRest:integer; 1128 ccount:array[0..lxmax*lymax-1] of word; 1129 sc,StartLoc0,sccount: array[1..nPl] of integer; 1130 TestStartLoc: array[0..nPl-1] of integer; 1131 CityLoc: array[1..nPl,0..MaxCityLoc-1] of integer; 1132 nCityLoc: array[1..nPl] of integer; 1133 RestLoc: array[0..MaxCityLoc-1] of integer; 1134 IrrLoc: array[0..20] of integer; 1135 Radius: TVicinity21Loc; 1136 Adjacent: TVicinity8Loc; 1137 ok: boolean; 1138 1139 begin 1140 nAlive:=0; 1141 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then inc(nAlive); 1142 if nAlive=0 then exit; 1143 1144 {count good tiles} 1145 FillChar(ccount,MapSize*2,0); 1146 for Loc:=0 to MapSize-1 do 1147 if RealMap[Loc] and fTerrain=fGrass then 1148 if ActualSpecialTile(Loc)=1 then inc(ccount[Continent[Loc]],3) 1149 else inc(ccount[Continent[Loc]],2) 1150 else if RealMap[Loc] and fTerrain in [fPrairie,fSwamp,fForest,fHills] then 1151 inc(ccount[Continent[Loc]]); 1152 1153 Loc:=0;while ccount[Loc]>0 do inc(Loc); 1154 for i:=1 to nAlive do begin sc[i]:=Loc; sccount[i]:=1 end; 1155 {init with zero size start continents, then search bigger ones} 1156 for Loc:=0 to MapSize-1 do if ccount[Loc]>0 then 1157 begin // search biggest continents 1158 p1:=nAlive+1; 1159 while (p1>1) and (ccount[Loc]>ccount[sc[p1-1]]) do 1160 begin if p1<nAlive+1 then sc[p1]:=sc[p1-1]; dec(p1) end; 1161 if p1<nAlive+1 then sc[p1]:=Loc; 1162 end; 1163 nsc:=nAlive; 1164 repeat 1165 c:=1; // search least crowded continent after smallest 1166 for i:=2 to nsc-1 do 1167 if ccount[sc[i]]*(2*sccount[c]+1)>ccount[sc[c]]*(2*sccount[i]+1) then 1168 c:=i; 1169 if ccount[sc[nsc]]*(2*sccount[c]+1)>ccount[sc[c]] then 1170 Break; // even least crowded continent is more crowded than smallest 1171 inc(sccount[c]); 1172 dec(nsc) 1173 until sccount[nsc]>1; 1174 1175 MinGood:=7; 1176 CountGood:=cgBest; 1177 repeat 1178 dec(MinGood); 1179 if (MinGood=3) and (CountGood<cgLand) then // too demanding! 1180 begin inc(CountGood); MinGood:=6 end; 1181 FillChar(nCityLoc,SizeOf(nCityLoc),0); 1182 Loc:=Random(MapSize); 1183 for i:=0 to MapSize-1 do 1184 begin 1185 if ((Loc>=4*lx) and (Loc<MapSize-4*lx) or (CountGood>=cgLand)) 1186 and IsGoodTile(Loc) then 1187 begin 1188 c:=nsc; 1189 while (c>0) and (Continent[Loc]<>sc[c]) do dec(c); 1190 if (c>0) and (nCityLoc[c]<MaxCityLoc) then 1191 begin 1192 CntGood:=1; 1193 V21_to_Loc(Loc,Radius); 1194 for V21:=1 to 26 do if V21<>CityOwnTile then 1289 MaxCityLoc = 64; 1290 1291 var 1292 p1, p2, nAlive, c, Loc, Loc1, CntGood, CntGoodGrass, MinDist, Tries, i, j, n, 1293 nsc, TestLoc, V21, V8, BestDist, TestDist, MinGood, nIrrLoc, xLoc, yLoc, qx, 1294 qy, FineDistSQR, nRest: integer; 1295 ccount: array [0 .. lxmax * lymax - 1] of word; 1296 sc, StartLoc0, sccount: array [1 .. nPl] of integer; 1297 TestStartLoc: array [0 .. nPl - 1] of integer; 1298 CityLoc: array [1 .. nPl, 0 .. MaxCityLoc - 1] of integer; 1299 nCityLoc: array [1 .. nPl] of integer; 1300 RestLoc: array [0 .. MaxCityLoc - 1] of integer; 1301 IrrLoc: array [0 .. 20] of integer; 1302 Radius: TVicinity21Loc; 1303 Adjacent: TVicinity8Loc; 1304 ok: boolean; 1305 1306 begin 1307 nAlive := 0; 1308 for p1 := 0 to nPl - 1 do 1309 if 1 shl p1 and GAlive <> 0 then 1310 inc(nAlive); 1311 if nAlive = 0 then 1312 exit; 1313 1314 { count good tiles } 1315 FillChar(ccount, MapSize * 2, 0); 1316 for Loc := 0 to MapSize - 1 do 1317 if RealMap[Loc] and fTerrain = fGrass then 1318 if ActualSpecialTile(Loc) = 1 then 1319 inc(ccount[Continent[Loc]], 3) 1320 else 1321 inc(ccount[Continent[Loc]], 2) 1322 else if RealMap[Loc] and fTerrain in [fPrairie, fSwamp, fForest, fHills] 1323 then 1324 inc(ccount[Continent[Loc]]); 1325 1326 Loc := 0; 1327 while ccount[Loc] > 0 do 1328 inc(Loc); 1329 for i := 1 to nAlive do 1330 begin 1331 sc[i] := Loc; 1332 sccount[i] := 1 1333 end; 1334 { init with zero size start continents, then search bigger ones } 1335 for Loc := 0 to MapSize - 1 do 1336 if ccount[Loc] > 0 then 1337 begin // search biggest continents 1338 p1 := nAlive + 1; 1339 while (p1 > 1) and (ccount[Loc] > ccount[sc[p1 - 1]]) do 1340 begin 1341 if p1 < nAlive + 1 then 1342 sc[p1] := sc[p1 - 1]; 1343 dec(p1) 1344 end; 1345 if p1 < nAlive + 1 then 1346 sc[p1] := Loc; 1347 end; 1348 nsc := nAlive; 1349 repeat 1350 c := 1; // search least crowded continent after smallest 1351 for i := 2 to nsc - 1 do 1352 if ccount[sc[i]] * (2 * sccount[c] + 1) > ccount[sc[c]] * 1353 (2 * sccount[i] + 1) then 1354 c := i; 1355 if ccount[sc[nsc]] * (2 * sccount[c] + 1) > ccount[sc[c]] then 1356 Break; // even least crowded continent is more crowded than smallest 1357 inc(sccount[c]); 1358 dec(nsc) 1359 until sccount[nsc] > 1; 1360 1361 MinGood := 7; 1362 CountGood := cgBest; 1363 repeat 1364 dec(MinGood); 1365 if (MinGood = 3) and (CountGood < cgLand) then // too demanding! 1366 begin 1367 inc(CountGood); 1368 MinGood := 6 1369 end; 1370 FillChar(nCityLoc, SizeOf(nCityLoc), 0); 1371 Loc := Random(MapSize); 1372 for i := 0 to MapSize - 1 do 1373 begin 1374 if ((Loc >= 4 * lx) and (Loc < MapSize - 4 * lx) or (CountGood >= cgLand)) 1375 and IsGoodTile(Loc) then 1376 begin 1377 c := nsc; 1378 while (c > 0) and (Continent[Loc] <> sc[c]) do 1379 dec(c); 1380 if (c > 0) and (nCityLoc[c] < MaxCityLoc) then 1381 begin 1382 CntGood := 1; 1383 V21_to_Loc(Loc, Radius); 1384 for V21 := 1 to 26 do 1385 if V21 <> CityOwnTile then 1386 begin 1387 Loc1 := Radius[V21]; 1388 if (Loc1 >= 0) and (Loc1 < MapSize) and IsGoodTile(Loc1) then 1389 inc(CntGood) 1390 end; 1391 if CntGood >= MinGood then 1195 1392 begin 1196 Loc1:=Radius[V21]; 1197 if (Loc1>=0) and (Loc1<MapSize) and IsGoodTile(Loc1) then 1198 inc(CntGood) 1199 end; 1200 if CntGood>=MinGood then 1201 begin 1202 CityLoc[c,nCityLoc[c]]:=Loc; 1203 inc(nCityLoc[c]) 1393 CityLoc[c, nCityLoc[c]] := Loc; 1394 inc(nCityLoc[c]) 1204 1395 end 1205 1396 end 1206 1397 end; 1207 Loc:=(Loc+1)*primitive mod (MapSize+1) -1; 1208 end; 1209 1210 ok:=true; 1211 for c:=1 to nsc do 1212 if nCityLoc[c]<sccount[c]*(8-MinGood) div (7-MinGood) then ok:=false; 1213 until ok; 1214 1215 FineDistSQR:=MapSize*LandMass*9 div (nAlive*100); 1216 p1:=1; 1217 for c:=1 to nsc do 1398 Loc := (Loc + 1) * primitive mod (MapSize + 1) - 1; 1399 end; 1400 1401 ok := true; 1402 for c := 1 to nsc do 1403 if nCityLoc[c] < sccount[c] * (8 - MinGood) div (7 - MinGood) then 1404 ok := false; 1405 until ok; 1406 1407 FineDistSQR := MapSize * LandMass * 9 div (nAlive * 100); 1408 p1 := 1; 1409 for c := 1 to nsc do 1218 1410 begin // for all start continents 1219 if sccount[c]=1 then StartLoc0[p1]:=CityLoc[c,Random(nCityLoc[c])] 1220 else 1221 begin 1222 BestDist:=0; 1223 n:=1 shl sccount[c] *32; // number of tries to find good distribution 1224 if n>1 shl 12 then n:=1 shl 12; 1225 while (n>0) and (BestDist*BestDist<FineDistSQR) do 1226 begin 1227 MinDist:=MaxInt; 1228 nRest:=nCityLoc[c]; 1229 for i:=0 to nRest-1 do RestLoc[i]:=CityLoc[c,i]; 1230 for i:=0 to sccount[c]-1 do 1231 begin 1232 if nRest=0 then break; 1233 j:=Random(nRest); 1234 TestStartLoc[i]:=RestLoc[j]; 1235 RestLoc[j]:=RestLoc[nRest-1]; 1236 dec(nRest); 1237 for j:=0 to i-1 do 1411 if sccount[c] = 1 then 1412 StartLoc0[p1] := CityLoc[c, Random(nCityLoc[c])] 1413 else 1414 begin 1415 BestDist := 0; 1416 n := 1 shl sccount[c] * 32; // number of tries to find good distribution 1417 if n > 1 shl 12 then 1418 n := 1 shl 12; 1419 while (n > 0) and (BestDist * BestDist < FineDistSQR) do 1420 begin 1421 MinDist := MaxInt; 1422 nRest := nCityLoc[c]; 1423 for i := 0 to nRest - 1 do 1424 RestLoc[i] := CityLoc[c, i]; 1425 for i := 0 to sccount[c] - 1 do 1426 begin 1427 if nRest = 0 then 1428 Break; 1429 j := Random(nRest); 1430 TestStartLoc[i] := RestLoc[j]; 1431 RestLoc[j] := RestLoc[nRest - 1]; 1432 dec(nRest); 1433 for j := 0 to i - 1 do 1238 1434 begin 1239 TestDist:=Distance(TestStartLoc[i],TestStartLoc[j]); 1240 if TestDist<MinDist then MinDist:=TestDist 1435 TestDist := Distance(TestStartLoc[i], TestStartLoc[j]); 1436 if TestDist < MinDist then 1437 MinDist := TestDist 1241 1438 end; 1242 if i=sccount[c]-1 then1439 if i = sccount[c] - 1 then 1243 1440 begin 1244 assert(MinDist>BestDist); 1245 BestDist:=MinDist; 1246 for j:=0 to sccount[c]-1 do StartLoc0[p1+j]:=TestStartLoc[j]; 1441 assert(MinDist > BestDist); 1442 BestDist := MinDist; 1443 for j := 0 to sccount[c] - 1 do 1444 StartLoc0[p1 + j] := TestStartLoc[j]; 1247 1445 end 1248 else if BestDist>0 then1446 else if BestDist > 0 then 1249 1447 begin 1250 j:=0;1251 while j<nRest do1448 j := 0; 1449 while j < nRest do 1252 1450 begin // remove all locs from rest which have too little distance to this one 1253 TestDist:=Distance(TestStartLoc[i],RestLoc[j]); 1254 if TestDist<=BestDist then 1255 begin RestLoc[j]:=RestLoc[nRest-1]; dec(nRest); end 1256 else inc(j); 1451 TestDist := Distance(TestStartLoc[i], RestLoc[j]); 1452 if TestDist <= BestDist then 1453 begin 1454 RestLoc[j] := RestLoc[nRest - 1]; 1455 dec(nRest); 1456 end 1457 else 1458 inc(j); 1257 1459 end; 1258 1460 end; 1259 1461 end; 1260 dec(n) 1261 end; 1262 end; 1263 p1:=p1+sccount[c] 1264 end; 1265 1266 // make start locs fertile 1267 for p1:=1 to nAlive do 1268 begin 1269 RealMap[StartLoc0[p1]]:=RealMap[StartLoc0[p1]] and not (fTerrain or fSpecial) 1270 or fGrass or fSpecial1; 1271 CntGood:=1; 1272 CntGoodGrass:=1; 1273 V21_to_Loc(StartLoc0[p1],Radius); 1274 for V21:=1 to 26 do if V21<>CityOwnTile then 1275 begin 1276 Loc1:=Radius[V21]; 1277 if (Loc1>=0) and (Loc1<MapSize) and IsGoodTile(Loc1) then 1278 if RealMap[Loc1] and fTerrain=fGrass then inc(CntGoodGrass) 1279 else inc(CntGood); 1280 end; 1281 for V21:=1 to 26 do if V21<>CityOwnTile then 1282 begin 1283 Loc1:=Radius[V21]; 1284 if (Loc1>=0) and (Loc1<MapSize) and (RealMap[Loc1] and fDeadLands=0) then 1285 if IsGoodTile(Loc1) and (random(CntGood)<MinGood-CntGoodGrass+1) then 1286 begin 1287 RealMap[Loc1]:=RealMap[Loc1] and not (fTerrain or fSpecial) or fGrass; 1288 RealMap[Loc1]:=RealMap[Loc1] or ActualSpecialTile(Loc1) shl 5; 1462 dec(n) 1463 end; 1464 end; 1465 p1 := p1 + sccount[c] 1466 end; 1467 1468 // make start locs fertile 1469 for p1 := 1 to nAlive do 1470 begin 1471 RealMap[StartLoc0[p1]] := RealMap[StartLoc0[p1]] and 1472 not(fTerrain or fSpecial) or fGrass or fSpecial1; 1473 CntGood := 1; 1474 CntGoodGrass := 1; 1475 V21_to_Loc(StartLoc0[p1], Radius); 1476 for V21 := 1 to 26 do 1477 if V21 <> CityOwnTile then 1478 begin 1479 Loc1 := Radius[V21]; 1480 if (Loc1 >= 0) and (Loc1 < MapSize) and IsGoodTile(Loc1) then 1481 if RealMap[Loc1] and fTerrain = fGrass then 1482 inc(CntGoodGrass) 1483 else 1484 inc(CntGood); 1485 end; 1486 for V21 := 1 to 26 do 1487 if V21 <> CityOwnTile then 1488 begin 1489 Loc1 := Radius[V21]; 1490 if (Loc1 >= 0) and (Loc1 < MapSize) and 1491 (RealMap[Loc1] and fDeadLands = 0) then 1492 if IsGoodTile(Loc1) and (Random(CntGood) < MinGood - CntGoodGrass + 1) 1493 then 1494 begin 1495 RealMap[Loc1] := RealMap[Loc1] and not(fTerrain or fSpecial) 1496 or fGrass; 1497 RealMap[Loc1] := RealMap[Loc1] or ActualSpecialTile(Loc1) shl 5; 1498 end 1499 else if RealMap[Loc1] and fTerrain = fDesert then 1500 RealMap[Loc1] := RealMap[Loc1] and not fTerrain or fPrairie 1501 else if (RealMap[Loc1] and fTerrain in [fPrairie, fTundra, fSwamp]) 1502 and (Random(2) = 0) then 1503 RealMap[Loc1] := RealMap[Loc1] and not fTerrain or fForest; 1504 end; 1505 1506 // first irrigation 1507 nIrrLoc := 0; 1508 for V21 := 1 to 26 do 1509 if V21 <> CityOwnTile then 1510 begin 1511 Loc1 := Radius[V21]; 1512 if (Loc1 >= 0) and (Loc1 < MapSize) and 1513 (RealMap[Loc1] and (fTerrain or fSpecial) = fGrass or fSpecial1) then 1514 begin 1515 IrrLoc[nIrrLoc] := Loc1; 1516 inc(nIrrLoc); 1517 end; 1518 end; 1519 i := 2; 1520 if i > nIrrLoc then 1521 i := nIrrLoc; 1522 while i > 0 do 1523 begin 1524 j := Random(nIrrLoc); 1525 RealMap[IrrLoc[j]] := RealMap[IrrLoc[j]] or tiIrrigation; 1526 IrrLoc[j] := IrrLoc[nIrrLoc - 1]; 1527 dec(nIrrLoc); 1528 dec(i) 1529 end; 1530 end; 1531 1532 StartLoc[0] := 0; 1533 for p1 := 0 to nPl - 1 do 1534 if 1 shl p1 and GAlive <> 0 then 1535 begin 1536 repeat 1537 i := Random(nAlive) + 1 1538 until StartLoc0[i] >= 0; 1539 StartLoc[p1] := StartLoc0[i]; 1540 StartLoc0[i] := -1 1541 end; 1542 SaveMapCenterLoc := StartLoc[0]; 1543 1544 // second unit starting position 1545 for p1 := 0 to nPl - 1 do 1546 if 1 shl p1 and GAlive <> 0 then 1547 begin 1548 StartLoc2[p1] := StartLoc[p1]; 1549 V8_to_Loc(StartLoc[p1], Adjacent); 1550 for V8 := 0 to 7 do 1551 begin 1552 Loc1 := Adjacent[V8]; 1553 for p2 := 0 to nPl - 1 do 1554 if (1 shl p2 and GAlive <> 0) and (StartLoc[p2] = Loc1) then 1555 Loc1 := -1; 1556 for p2 := 0 to p1 - 1 do 1557 if (1 shl p2 and GAlive <> 0) and (StartLoc2[p2] = Loc1) then 1558 Loc1 := -1; 1559 if (Loc1 < 0) or (Loc1 >= MapSize) or 1560 (RealMap[Loc1] and fTerrain in [fOcean, fShore, fDesert, fArctic, 1561 fMountains]) or (RealMap[Loc1] and fDeadLands <> 0) then 1562 TestDist := -1 1563 else if RealMap[Loc1] and fTerrain = fGrass then 1564 TestDist := 2 1565 else if Terrain[RealMap[Loc1] and fTerrain].IrrEff > 0 then 1566 TestDist := 1 1567 else 1568 TestDist := 0; 1569 if (StartLoc2[p1] = StartLoc[p1]) or (TestDist > BestDist) then 1570 begin 1571 StartLoc2[p1] := Loc1; 1572 BestDist := TestDist; 1573 n := 1; 1289 1574 end 1290 else if RealMap[Loc1] and fTerrain=fDesert then 1291 RealMap[Loc1]:=RealMap[Loc1] and not fTerrain or fPrairie 1292 else if (RealMap[Loc1] and fTerrain in [fPrairie,fTundra,fSwamp]) 1293 and (random(2)=0) then 1294 RealMap[Loc1]:=RealMap[Loc1] and not fTerrain or fForest; 1295 end; 1296 1297 // first irrigation 1298 nIrrLoc:=0; 1299 for V21:=1 to 26 do if V21<>CityOwnTile then 1300 begin 1301 Loc1:=Radius[V21]; 1302 if (Loc1>=0) and (Loc1<MapSize) 1303 and (RealMap[Loc1] and (fTerrain or fSpecial)=fGrass or fSpecial1) then 1304 begin 1305 IrrLoc[nIrrLoc]:=Loc1; 1306 inc(nIrrLoc); 1307 end; 1308 end; 1309 i:=2; 1310 if i>nIrrLoc then i:=nIrrLoc; 1311 while i>0 do 1312 begin 1313 j:=random(nIrrLoc); 1314 RealMap[IrrLoc[j]]:=RealMap[IrrLoc[j]] or tiIrrigation; 1315 IrrLoc[j]:=IrrLoc[nIrrLoc-1]; 1316 dec(nIrrLoc); 1317 dec(i) 1318 end; 1319 end; 1320 1321 StartLoc[0]:=0; 1322 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 1323 begin 1324 repeat i:=Random(nAlive)+1 until StartLoc0[i]>=0; 1325 StartLoc[p1]:=StartLoc0[i]; 1326 StartLoc0[i]:=-1 1327 end; 1328 SaveMapCenterLoc:=StartLoc[0]; 1329 1330 // second unit starting position 1331 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 1332 begin 1333 StartLoc2[p1]:=StartLoc[p1]; 1334 V8_to_Loc(StartLoc[p1],Adjacent); 1335 for V8:=0 to 7 do 1336 begin 1337 Loc1:=Adjacent[V8]; 1338 for p2:=0 to nPl-1 do 1339 if (1 shl p2 and GAlive<>0) and (StartLoc[p2]=Loc1) then Loc1:=-1; 1340 for p2:=0 to p1-1 do 1341 if (1 shl p2 and GAlive<>0) and (StartLoc2[p2]=Loc1) then Loc1:=-1; 1342 if (Loc1<0) or (Loc1>=MapSize) 1343 or (RealMap[Loc1] and fTerrain in [fOcean, fShore, fDesert, fArctic, fMountains]) 1344 or (RealMap[Loc1] and fDeadLands<>0) then 1345 TestDist:=-1 1346 else if RealMap[Loc1] and fTerrain=fGrass then TestDist:=2 1347 else if Terrain[RealMap[Loc1] and fTerrain].IrrEff>0 then TestDist:=1 1348 else TestDist:=0; 1349 if (StartLoc2[p1]=StartLoc[p1]) or (TestDist>BestDist) then 1350 begin StartLoc2[p1]:=Loc1; BestDist:=TestDist; n:=1; end 1351 else if TestDist=BestDist then 1352 begin inc(n); if random(n)=0 then StartLoc2[p1]:=Loc1; end; 1353 end 1354 end; 1355 end; {StartPositions} 1575 else if TestDist = BestDist then 1576 begin 1577 inc(n); 1578 if Random(n) = 0 then 1579 StartLoc2[p1] := Loc1; 1580 end; 1581 end 1582 end; 1583 end; { StartPositions } 1356 1584 1357 1585 procedure PredefinedStartPositions(Human: integer); 1358 1586 // use predefined nation start positions 1359 1587 var 1360 i,p1,Loc1,nAlive,nStartLoc0,nPrefStartLoc0,imax: integer; 1361 StartLoc0: array[0..lxmax*lymax-1] of integer; 1362 ishuman: boolean; 1363 begin 1364 nAlive:=0; 1365 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then inc(nAlive); 1366 if nAlive=0 then exit; 1367 1368 // calculate starting positions 1369 nStartLoc0:=0; 1370 nPrefStartLoc0:=0; 1371 for Loc1:=0 to MapSize-1 do 1372 if RealMap[Loc1] and fPrefStartPos<>0 then 1373 begin 1374 StartLoc0[nStartLoc0]:=StartLoc0[nPrefStartLoc0]; 1375 StartLoc0[nPrefStartLoc0]:=Loc1; 1376 inc(nPrefStartLoc0); 1377 inc(nStartLoc0); 1378 RealMap[Loc1]:=RealMap[Loc1] and not fPrefStartPos; 1588 i, p1, Loc1, nAlive, nStartLoc0, nPrefStartLoc0, imax: integer; 1589 StartLoc0: array [0 .. lxmax * lymax - 1] of integer; 1590 ishuman: boolean; 1591 begin 1592 nAlive := 0; 1593 for p1 := 0 to nPl - 1 do 1594 if 1 shl p1 and GAlive <> 0 then 1595 inc(nAlive); 1596 if nAlive = 0 then 1597 exit; 1598 1599 // calculate starting positions 1600 nStartLoc0 := 0; 1601 nPrefStartLoc0 := 0; 1602 for Loc1 := 0 to MapSize - 1 do 1603 if RealMap[Loc1] and fPrefStartPos <> 0 then 1604 begin 1605 StartLoc0[nStartLoc0] := StartLoc0[nPrefStartLoc0]; 1606 StartLoc0[nPrefStartLoc0] := Loc1; 1607 inc(nPrefStartLoc0); 1608 inc(nStartLoc0); 1609 RealMap[Loc1] := RealMap[Loc1] and not fPrefStartPos; 1379 1610 end 1380 else if RealMap[Loc1] and fStartPos<>0 then 1381 begin 1382 StartLoc0[nStartLoc0]:=Loc1; 1383 inc(nStartLoc0); 1384 RealMap[Loc1]:=RealMap[Loc1] and not fStartPos; 1385 end; 1386 assert(nStartLoc0>=nAlive); 1387 1388 StartLoc[0]:=0; 1389 for ishuman:=true downto false do for p1:=0 to nPl-1 do 1390 if (1 shl p1 and GAlive<>0) and ((1 shl p1 and Human<>0)=ishuman) then 1391 begin 1392 dec(nStartLoc0); 1393 imax:=nStartLoc0; 1394 if nPrefStartLoc0>0 then 1395 begin 1396 dec(nPrefStartLoc0); 1397 imax:=nPrefStartLoc0; 1398 end; 1399 i:=Random(imax+1); 1400 StartLoc[p1]:=StartLoc0[i]; 1401 StartLoc2[p1]:=StartLoc0[i]; 1402 StartLoc0[i]:=StartLoc0[imax]; 1403 StartLoc0[imax]:=StartLoc0[nStartLoc0]; 1404 end; 1405 SaveMapCenterLoc:=StartLoc[0]; 1406 end; {PredefinedStartPositions} 1611 else if RealMap[Loc1] and fStartPos <> 0 then 1612 begin 1613 StartLoc0[nStartLoc0] := Loc1; 1614 inc(nStartLoc0); 1615 RealMap[Loc1] := RealMap[Loc1] and not fStartPos; 1616 end; 1617 assert(nStartLoc0 >= nAlive); 1618 1619 StartLoc[0] := 0; 1620 for ishuman := true downto false do 1621 for p1 := 0 to nPl - 1 do 1622 if (1 shl p1 and GAlive <> 0) and ((1 shl p1 and Human <> 0) = ishuman) 1623 then 1624 begin 1625 dec(nStartLoc0); 1626 imax := nStartLoc0; 1627 if nPrefStartLoc0 > 0 then 1628 begin 1629 dec(nPrefStartLoc0); 1630 imax := nPrefStartLoc0; 1631 end; 1632 i := Random(imax + 1); 1633 StartLoc[p1] := StartLoc0[i]; 1634 StartLoc2[p1] := StartLoc0[i]; 1635 StartLoc0[i] := StartLoc0[imax]; 1636 StartLoc0[imax] := StartLoc0[nStartLoc0]; 1637 end; 1638 SaveMapCenterLoc := StartLoc[0]; 1639 end; { PredefinedStartPositions } 1407 1640 1408 1641 procedure InitGame; 1409 1642 var 1410 i, p, p1, uix, Loc1: integer; 1411 begin 1412 if FastContact then {Railroad everywhere} 1413 for Loc1:=0 to MapSize-1 do 1414 if RealMap[Loc1] and fTerrain>=fGrass then RealMap[Loc1]:=RealMap[Loc1] or fRR; 1415 1416 {!!!for Loc1:=0 to MapSize-1 do 1417 if RealMap[Loc1] and fterrain>=fGrass then 1643 i, p, p1, uix, Loc1: integer; 1644 begin 1645 if FastContact then { Railroad everywhere } 1646 for Loc1 := 0 to MapSize - 1 do 1647 if RealMap[Loc1] and fTerrain >= fGrass then 1648 RealMap[Loc1] := RealMap[Loc1] or fRR; 1649 1650 { !!!for Loc1:=0 to MapSize-1 do 1651 if RealMap[Loc1] and fterrain>=fGrass then 1418 1652 if random(3)=0 then RealMap[Loc1]:=RealMap[Loc1] or fRoad 1419 1653 else if random(3)=0 then RealMap[Loc1]:=RealMap[Loc1] or fRR; 1420 {random Road and Railroad} 1421 {!!!for Loc1:=0 to MapSize-1 do 1422 if (RealMap[Loc1] and fterrain>=fGrass) and (random(20)=0) then 1423 RealMap[Loc1]:=RealMap[Loc1] or fPoll;} 1424 1425 FillChar(Occupant,MapSize,-1); 1426 FillChar(ZoCMap,MapSize,0); 1427 FillChar(ObserveLevel,MapSize*4,0); 1428 FillChar(UsedByCity,MapSize*4,-1); 1429 GTestFlags:=0; 1430 GInitialized:=GAlive or GWatching; 1431 for p:=0 to nPl-1 do if 1 shl p and GInitialized<>0 then with RW[p] do 1432 begin 1433 Researched[p]:=0; 1434 Discovered[p]:=0; 1435 TerritoryCount[p]:=0; 1436 nTech[p]:=0; 1437 if Difficulty[p]=0 then ResourceMask[p]:=$FFFFFFFF 1438 else ResourceMask[p]:=$FFFFFFFF and not (fSpecial2 or fModern); 1439 GrWallContinent[p]:=-1; 1440 1441 GetMem(Map,4*MapSize); 1442 GetMem(MapObservedLast,2*MapSize); 1443 FillChar(MapObservedLast^,2*MapSize,-1); 1444 GetMem(Territory,MapSize); 1445 FillChar(Territory^,MapSize,$FF); 1446 GetMem(Un,numax*SizeOf(TUn)); 1447 GetMem(Model,(nmmax+1)*SizeOf(TModel)); // draft needs one model behind last 1448 GetMem(City,ncmax*SizeOf(TCity)); 1449 GetMem(EnemyUn,neumax*SizeOf(TUnitInfo)); 1450 GetMem(EnemyCity,necmax*SizeOf(TCityInfo)); 1451 GetMem(EnemyModel,nemmax*SizeOf(TModelInfo)); 1452 for p1:=0 to nPl-1 do 1453 begin 1454 if 1 shl p1 and GInitialized<>0 then 1455 begin 1456 FillChar(RWemix[p,p1],SizeOf(RWemix[p,p1]),255); {-1} 1457 FillChar(Destroyed[p,p1],SizeOf(Destroyed[p,p1]),0); 1458 end; 1459 Attitude[p1]:=atNeutral; 1460 Treaty[p1]:=trNoContact; 1461 LastCancelTreaty[p1]:=-CancelTreatyTurns-1; 1462 EvaStart[p1]:=-PeaceEvaTurns-1; 1463 Tribute[p1]:=0; 1464 TributePaid[p1]:=0; 1465 if (p1<>p) and (1 shl p1 and GAlive<>0) then 1466 begin // initialize enemy report 1467 GetMem(EnemyReport[p1],SizeOf(TEnemyReport)-2*(INFIN+1-nmmax)); 1468 FillChar(EnemyReport[p1].Tech,nAdv,tsNA); 1469 EnemyReport[p1].TurnOfContact:=-1; 1470 EnemyReport[p1].TurnOfCivilReport:=-1; 1471 EnemyReport[p1].TurnOfMilReport:=-1; 1472 EnemyReport[p1].Attitude:=atNeutral; 1473 EnemyReport[p1].Government:=gDespotism; 1474 if 1 shl p and GAlive=0 then Treaty[p1]:=trNone // supervisor 1475 end 1476 else EnemyReport[p1]:=nil; 1477 end; 1478 TestFlags:=GTestFlags; 1479 Credibility:=InitialCredibility; 1480 MaxCredibility:=100; 1481 nUn:=0; 1482 nModel:=0; 1483 nCity:=0; 1484 nEnemyUn:=0; 1485 nEnemyCity:=0; 1486 nEnemyModel:=0; 1487 for Loc1:=0 to MapSize-1 do Map[Loc1]:=fUNKNOWN; 1488 FillChar(Tech,nAdv,tsNA); 1489 FillChar(NatBuilt,SizeOf(NatBuilt),0); 1490 end; 1491 1492 // create initial models and units 1493 for p:=0 to nPl-1 do if (1 shl p and GAlive<>0) then with RW[p] do 1494 begin 1495 nModel:=0; 1496 for i:=0 to nSpecialModel-1 do if SpecialModelPreq[i]=preNone then 1497 begin 1498 Model[nModel]:=SpecialModel[i]; 1499 Model[nModel].Status:=0; 1500 Model[nModel].IntroTurn:=0; 1501 Model[nModel].Built:=0; 1502 Model[nModel].Lost:=0; 1503 Model[nModel].ID:=p shl 12+nModel; 1504 SetModelFlags(Model[nModel]); 1505 inc(nModel) 1506 end; 1507 nUn:=0; 1508 UnBuilt[p]:=0; 1509 for uix:=0 to nStartUn-1 do 1510 begin 1511 CreateUnit(p, StartUn[uix]); 1512 dec(Model[StartUn[uix]].Built); 1513 Un[uix].Loc:=StartLoc2[p]; 1514 PlaceUnit(p,uix); 1515 end; 1516 FoundCity(p,StartLoc[p]); // capital 1517 Founded[p]:=1; 1518 with City[0] do 1519 begin 1520 ID:=p shl 12; 1521 Flags:=chFounded; 1522 end; 1523 end; 1524 1525 TerritoryCount[nPl]:=MapSize; 1526 //fillchar(NewContact, sizeof(NewContact), false); 1654 {random Road and Railroad } 1655 { !!!for Loc1:=0 to MapSize-1 do 1656 if (RealMap[Loc1] and fterrain>=fGrass) and (random(20)=0) then 1657 RealMap[Loc1]:=RealMap[Loc1] or fPoll; } 1658 1659 FillChar(Occupant, MapSize, -1); 1660 FillChar(ZoCMap, MapSize, 0); 1661 FillChar(ObserveLevel, MapSize * 4, 0); 1662 FillChar(UsedByCity, MapSize * 4, -1); 1663 GTestFlags := 0; 1664 GInitialized := GAlive or GWatching; 1665 for p := 0 to nPl - 1 do 1666 if 1 shl p and GInitialized <> 0 then 1667 with RW[p] do 1668 begin 1669 Researched[p] := 0; 1670 Discovered[p] := 0; 1671 TerritoryCount[p] := 0; 1672 nTech[p] := 0; 1673 if Difficulty[p] = 0 then 1674 ResourceMask[p] := $FFFFFFFF 1675 else 1676 ResourceMask[p] := $FFFFFFFF and not(fSpecial2 or fModern); 1677 GrWallContinent[p] := -1; 1678 1679 GetMem(Map, 4 * MapSize); 1680 GetMem(MapObservedLast, 2 * MapSize); 1681 FillChar(MapObservedLast^, 2 * MapSize, -1); 1682 GetMem(Territory, MapSize); 1683 FillChar(Territory^, MapSize, $FF); 1684 GetMem(Un, numax * SizeOf(TUn)); 1685 GetMem(Model, (nmmax + 1) * SizeOf(TModel)); 1686 // draft needs one model behind last 1687 GetMem(City, ncmax * SizeOf(TCity)); 1688 GetMem(EnemyUn, neumax * SizeOf(TUnitInfo)); 1689 GetMem(EnemyCity, necmax * SizeOf(TCityInfo)); 1690 GetMem(EnemyModel, nemmax * SizeOf(TModelInfo)); 1691 for p1 := 0 to nPl - 1 do 1692 begin 1693 if 1 shl p1 and GInitialized <> 0 then 1694 begin 1695 FillChar(RWemix[p, p1], SizeOf(RWemix[p, p1]), 255); { -1 } 1696 FillChar(Destroyed[p, p1], SizeOf(Destroyed[p, p1]), 0); 1697 end; 1698 Attitude[p1] := atNeutral; 1699 Treaty[p1] := trNoContact; 1700 LastCancelTreaty[p1] := -CancelTreatyTurns - 1; 1701 EvaStart[p1] := -PeaceEvaTurns - 1; 1702 Tribute[p1] := 0; 1703 TributePaid[p1] := 0; 1704 if (p1 <> p) and (1 shl p1 and GAlive <> 0) then 1705 begin // initialize enemy report 1706 GetMem(EnemyReport[p1], SizeOf(TEnemyReport) - 2 * 1707 (INFIN + 1 - nmmax)); 1708 FillChar(EnemyReport[p1].Tech, nAdv, tsNA); 1709 EnemyReport[p1].TurnOfContact := -1; 1710 EnemyReport[p1].TurnOfCivilReport := -1; 1711 EnemyReport[p1].TurnOfMilReport := -1; 1712 EnemyReport[p1].Attitude := atNeutral; 1713 EnemyReport[p1].Government := gDespotism; 1714 if 1 shl p and GAlive = 0 then 1715 Treaty[p1] := trNone // supervisor 1716 end 1717 else 1718 EnemyReport[p1] := nil; 1719 end; 1720 TestFlags := GTestFlags; 1721 Credibility := InitialCredibility; 1722 MaxCredibility := 100; 1723 nUn := 0; 1724 nModel := 0; 1725 nCity := 0; 1726 nEnemyUn := 0; 1727 nEnemyCity := 0; 1728 nEnemyModel := 0; 1729 for Loc1 := 0 to MapSize - 1 do 1730 Map[Loc1] := fUNKNOWN; 1731 FillChar(Tech, nAdv, tsNA); 1732 FillChar(NatBuilt, SizeOf(NatBuilt), 0); 1733 end; 1734 1735 // create initial models and units 1736 for p := 0 to nPl - 1 do 1737 if (1 shl p and GAlive <> 0) then 1738 with RW[p] do 1739 begin 1740 nModel := 0; 1741 for i := 0 to nSpecialModel - 1 do 1742 if SpecialModelPreq[i] = preNone then 1743 begin 1744 Model[nModel] := SpecialModel[i]; 1745 Model[nModel].Status := 0; 1746 Model[nModel].IntroTurn := 0; 1747 Model[nModel].Built := 0; 1748 Model[nModel].Lost := 0; 1749 Model[nModel].ID := p shl 12 + nModel; 1750 SetModelFlags(Model[nModel]); 1751 inc(nModel) 1752 end; 1753 nUn := 0; 1754 UnBuilt[p] := 0; 1755 for uix := 0 to nStartUn - 1 do 1756 begin 1757 CreateUnit(p, StartUn[uix]); 1758 dec(Model[StartUn[uix]].Built); 1759 Un[uix].Loc := StartLoc2[p]; 1760 PlaceUnit(p, uix); 1761 end; 1762 FoundCity(p, StartLoc[p]); // capital 1763 Founded[p] := 1; 1764 with City[0] do 1765 begin 1766 ID := p shl 12; 1767 Flags := chFounded; 1768 end; 1769 end; 1770 1771 TerritoryCount[nPl] := MapSize; 1772 // fillchar(NewContact, sizeof(NewContact), false); 1527 1773 end; // InitGame 1528 1774 1529 1775 procedure InitRandomGame; 1530 1776 begin 1531 RandSeed:=RND;1532 CalculatePrimitive;1533 CreateElevation;1534 CreateMap(false);1535 StartPositions;1536 InitGame;1537 end; { InitRandomGame}1777 RandSeed := RND; 1778 CalculatePrimitive; 1779 CreateElevation; 1780 CreateMap(false); 1781 StartPositions; 1782 InitGame; 1783 end; { InitRandomGame } 1538 1784 1539 1785 procedure InitMapGame(Human: integer); 1540 1786 begin 1541 RandSeed:=RND;1542 FindContinents;1543 PredefinedStartPositions(Human);1544 InitGame;1545 end; { InitMapGame}1787 RandSeed := RND; 1788 FindContinents; 1789 PredefinedStartPositions(Human); 1790 InitGame; 1791 end; { InitMapGame } 1546 1792 1547 1793 procedure ReleaseGame; 1548 1794 var 1549 p1,p2: integer; 1550 begin 1551 for p1:=0 to nPl-1 do if 1 shl p1 and GInitialized<>0 then 1552 begin 1553 for p2:=0 to nPl-1 do 1554 if RW[p1].EnemyReport[p2]<>nil then 1555 FreeMem(RW[p1].EnemyReport[p2]); 1556 FreeMem(RW[p1].EnemyUn); 1557 FreeMem(RW[p1].EnemyCity); 1558 FreeMem(RW[p1].EnemyModel); 1559 FreeMem(RW[p1].Un); 1560 FreeMem(RW[p1].City); 1561 FreeMem(RW[p1].Model); 1562 FreeMem(RW[p1].Territory); 1563 FreeMem(RW[p1].MapObservedLast); 1564 FreeMem(RW[p1].Map); 1565 end 1795 p1, p2: integer; 1796 begin 1797 for p1 := 0 to nPl - 1 do 1798 if 1 shl p1 and GInitialized <> 0 then 1799 begin 1800 for p2 := 0 to nPl - 1 do 1801 if RW[p1].EnemyReport[p2] <> nil then 1802 FreeMem(RW[p1].EnemyReport[p2]); 1803 FreeMem(RW[p1].EnemyUn); 1804 FreeMem(RW[p1].EnemyCity); 1805 FreeMem(RW[p1].EnemyModel); 1806 FreeMem(RW[p1].Un); 1807 FreeMem(RW[p1].City); 1808 FreeMem(RW[p1].Model); 1809 FreeMem(RW[p1].Territory); 1810 FreeMem(RW[p1].MapObservedLast); 1811 FreeMem(RW[p1].Map); 1812 end 1566 1813 end; 1567 1814 1568 1815 procedure InitMapEditor; 1569 1816 var 1570 p1: integer; 1571 begin 1572 CalculatePrimitive; 1573 FillChar(Occupant,MapSize,-1); 1574 FillChar(ObserveLevel,MapSize*4,0); 1575 with RW[0] do 1576 begin 1577 ResourceMask[0]:=$FFFFFFFF; 1578 GetMem(Map,4*MapSize); 1579 GetMem(MapObservedLast,2*MapSize); 1580 FillChar(MapObservedLast^,2*MapSize,-1); 1581 GetMem(Territory,MapSize); 1582 FillChar(Territory^,MapSize,$FF); 1583 Un:=nil; 1584 Model:=nil; 1585 City:=nil; 1586 EnemyUn:=nil; 1587 EnemyCity:=nil; 1588 EnemyModel:=nil; 1589 for p1:=0 to nPl-1 do EnemyReport[p1]:=nil; 1590 nUn:=0; 1591 nModel:=0; 1592 nCity:=0; 1593 nEnemyUn:=0; 1594 nEnemyCity:=0; 1595 nEnemyModel:=0; 1817 p1: integer; 1818 begin 1819 CalculatePrimitive; 1820 FillChar(Occupant, MapSize, -1); 1821 FillChar(ObserveLevel, MapSize * 4, 0); 1822 with RW[0] do 1823 begin 1824 ResourceMask[0] := $FFFFFFFF; 1825 GetMem(Map, 4 * MapSize); 1826 GetMem(MapObservedLast, 2 * MapSize); 1827 FillChar(MapObservedLast^, 2 * MapSize, -1); 1828 GetMem(Territory, MapSize); 1829 FillChar(Territory^, MapSize, $FF); 1830 Un := nil; 1831 Model := nil; 1832 City := nil; 1833 EnemyUn := nil; 1834 EnemyCity := nil; 1835 EnemyModel := nil; 1836 for p1 := 0 to nPl - 1 do 1837 EnemyReport[p1] := nil; 1838 nUn := 0; 1839 nModel := 0; 1840 nCity := 0; 1841 nEnemyUn := 0; 1842 nEnemyCity := 0; 1843 nEnemyModel := 0; 1596 1844 end; 1597 1845 end; … … 1599 1847 procedure ReleaseMapEditor; 1600 1848 begin 1601 FreeMem(RW[0].Territory);1602 FreeMem(RW[0].MapObservedLast);1603 FreeMem(RW[0].Map);1849 FreeMem(RW[0].Territory); 1850 FreeMem(RW[0].MapObservedLast); 1851 FreeMem(RW[0].Map); 1604 1852 end; 1605 1853 1606 1854 procedure EditTile(Loc, NewTile: integer); 1607 1855 var 1608 Loc1,V21: integer; 1609 Radius: TVicinity21Loc; 1610 begin 1611 if NewTile and fDeadLands<>0 then 1612 NewTile:=NewTile and (fDeadLands or fModern or fRiver) or fDesert; 1613 case NewTile and fTerrain of 1614 fOcean, fShore: NewTile:=NewTile and (fTerrain or fSpecial); 1615 fMountains,fArctic: NewTile:=NewTile and not fRiver; 1616 end; 1617 with Terrain[NewTile and fTerrain] do 1618 if (ClearTerrain>=0) or (AfforestTerrain>=0) or (TransTerrain>=0) then 1619 NewTile:=NewTile or fSpecial; // only automatic special resources for transformable tiles 1620 if NewTile and fRR<>0 then NewTile:=NewTile and not fRoad; 1621 if not ((NewTile and fTerrain) in TerrType_Canalable) then 1622 NewTile:=NewTile and not fCanal; 1623 if Terrain[NewTile and fTerrain].IrrEff=0 then 1624 begin 1625 NewTile:=NewTile and not (fPrefStartPos or fStartPos); 1626 if (NewTile and fTerImp=tiIrrigation) or (NewTile and fTerImp=tiFarm) then 1627 NewTile:=NewTile and not fTerImp 1628 end; 1629 if (Terrain[NewTile and fTerrain].MineEff=0) 1630 and (NewTile and fTerImp=tiMine) then 1631 NewTile:=NewTile and not fTerImp; 1632 1633 RealMap[Loc]:=NewTile; 1634 if NewTile and fSpecial=fSpecial then // standard special resource distribution 1635 RealMap[Loc]:=RealMap[Loc] and not fSpecial or ActualSpecialTile(Loc) shl 5; 1636 1637 // automatic shore tiles 1638 V21_to_Loc(Loc,Radius); 1639 for V21:=1 to 26 do 1640 begin 1641 Loc1:=Radius[V21]; 1642 if (Loc1>=0) and (Loc1<MapSize) then 1643 begin 1644 if CheckShore(Loc1) then 1645 RealMap[Loc1]:=RealMap[Loc1] and not fSpecial or ActualSpecialTile(Loc1) shl 5; 1646 RealMap[Loc1]:=RealMap[Loc1] or ($F shl 27); 1647 RW[0].Map[Loc1]:=RealMap[Loc1] and $07FFFFFF or fObserved; 1856 Loc1, V21: integer; 1857 Radius: TVicinity21Loc; 1858 begin 1859 if NewTile and fDeadLands <> 0 then 1860 NewTile := NewTile and (fDeadLands or fModern or fRiver) or fDesert; 1861 case NewTile and fTerrain of 1862 fOcean, fShore: 1863 NewTile := NewTile and (fTerrain or fSpecial); 1864 fMountains, fArctic: 1865 NewTile := NewTile and not fRiver; 1866 end; 1867 with Terrain[NewTile and fTerrain] do 1868 if (ClearTerrain >= 0) or (AfforestTerrain >= 0) or (TransTerrain >= 0) then 1869 NewTile := NewTile or fSpecial; 1870 // only automatic special resources for transformable tiles 1871 if NewTile and fRR <> 0 then 1872 NewTile := NewTile and not fRoad; 1873 if not((NewTile and fTerrain) in TerrType_Canalable) then 1874 NewTile := NewTile and not fCanal; 1875 if Terrain[NewTile and fTerrain].IrrEff = 0 then 1876 begin 1877 NewTile := NewTile and not(fPrefStartPos or fStartPos); 1878 if (NewTile and fTerImp = tiIrrigation) or (NewTile and fTerImp = tiFarm) 1879 then 1880 NewTile := NewTile and not fTerImp 1881 end; 1882 if (Terrain[NewTile and fTerrain].MineEff = 0) and 1883 (NewTile and fTerImp = tiMine) then 1884 NewTile := NewTile and not fTerImp; 1885 1886 RealMap[Loc] := NewTile; 1887 if NewTile and fSpecial = fSpecial then 1888 // standard special resource distribution 1889 RealMap[Loc] := RealMap[Loc] and not fSpecial or 1890 ActualSpecialTile(Loc) shl 5; 1891 1892 // automatic shore tiles 1893 V21_to_Loc(Loc, Radius); 1894 for V21 := 1 to 26 do 1895 begin 1896 Loc1 := Radius[V21]; 1897 if (Loc1 >= 0) and (Loc1 < MapSize) then 1898 begin 1899 if CheckShore(Loc1) then 1900 RealMap[Loc1] := RealMap[Loc1] and not fSpecial or 1901 ActualSpecialTile(Loc1) shl 5; 1902 RealMap[Loc1] := RealMap[Loc1] or ($F shl 27); 1903 RW[0].Map[Loc1] := RealMap[Loc1] and $07FFFFFF or fObserved; 1648 1904 end 1649 1905 end; 1650 //RealMap[Loc]:=RealMap[Loc] and not fSpecial;1651 //RW[0].Map[Loc]:=RealMap[Loc] or fObserved;1906 // RealMap[Loc]:=RealMap[Loc] and not fSpecial; 1907 // RW[0].Map[Loc]:=RealMap[Loc] or fObserved; 1652 1908 end; 1653 1909 1654 1910 { 1655 1656 ____________________________________________________________________1911 Map Revealing 1912 ____________________________________________________________________ 1657 1913 } 1658 1914 function GetTileInfo(p, cix, Loc: integer; var Info: TTileInfo): integer; … … 1661 1917 // cix=-2 - don't search city, don't calculate city benefits, just government of player p 1662 1918 var 1663 p0,Tile,special: integer; 1664 begin 1665 with Info do 1666 begin 1667 p0:=p; 1668 if cix>=0 then Tile:=RealMap[Loc] 1669 else 1670 begin 1671 Tile:=RW[p].Map[Loc]; 1672 if Tile and fTerrain=fUNKNOWN then begin result:=eNoPreq; exit end; 1673 end; 1674 1675 if (cix=-1) and (UsedByCity[Loc]>=0) then 1919 p0, Tile, special: integer; 1920 begin 1921 with Info do 1922 begin 1923 p0 := p; 1924 if cix >= 0 then 1925 Tile := RealMap[Loc] 1926 else 1927 begin 1928 Tile := RW[p].Map[Loc]; 1929 if Tile and fTerrain = fUNKNOWN then 1930 begin 1931 result := eNoPreq; 1932 exit 1933 end; 1934 end; 1935 1936 if (cix = -1) and (UsedByCity[Loc] >= 0) then 1676 1937 begin // search exploiting player and city 1677 SearchCity(UsedByCity[Loc],p,cix); 1678 if not ((p=p0) or (ObserveLevel[UsedByCity[Loc]] shr (2*p0) and 3=lObserveSuper)) then 1679 cix:=-1 1680 end; 1681 if cix=-1 then begin result:=eInvalid; exit end; // no city found here 1682 1683 special:=Tile and fSpecial and ResourceMask[p] shr 5; 1684 with Terrain[Tile and fTerrain] do 1685 begin 1686 Food:=FoodRes[special]; 1687 Prod:=ProdRes[special]; 1688 Trade:=TradeRes[special]; 1689 if (special>0) and (Tile and fTerrain<>fGrass) 1690 and (RW[p].NatBuilt[imSpacePort]>0) then 1938 SearchCity(UsedByCity[Loc], p, cix); 1939 if not((p = p0) or (ObserveLevel[UsedByCity[Loc]] shr (2 * p0) and 1940 3 = lObserveSuper)) then 1941 cix := -1 1942 end; 1943 if cix = -1 then 1944 begin 1945 result := eInvalid; 1946 exit 1947 end; // no city found here 1948 1949 special := Tile and fSpecial and ResourceMask[p] shr 5; 1950 with Terrain[Tile and fTerrain] do 1951 begin 1952 Food := FoodRes[special]; 1953 Prod := ProdRes[special]; 1954 Trade := TradeRes[special]; 1955 if (special > 0) and (Tile and fTerrain <> fGrass) and 1956 (RW[p].NatBuilt[imSpacePort] > 0) then 1691 1957 begin // GeoSat effect 1692 Food:=2*Food-FoodRes[0]; 1693 Prod:=2*Prod-ProdRes[0]; 1694 Trade:=2*Trade-TradeRes[0]; 1695 end; 1696 1697 if (Tile and fTerImp=tiIrrigation) or (Tile and fTerImp=tiFarm) 1698 or (Tile and fCity<>0) then 1699 inc(Food,IrrEff); {irrigation effect} 1700 if Tile and fTerImp=tiMine then inc(Prod,MineEff); {mining effect} 1701 if (Tile and fRiver<>0) and (RW[p].Tech[adMapMaking]>=tsApplicable) then 1702 inc(Trade); {river effect} 1703 if (Tile and (fRoad or fRR)<>0) and (MoveCost=1) 1704 and (RW[p].Tech[adWheel]>=tsApplicable) then 1705 inc(Trade); {road effect} 1706 if (Tile and (fRR or fCity)<>0) and (RW[p].Tech[adRailroad]>=tsApplicable) then 1707 inc(Prod,Prod shr 1); {railroad effect} 1708 1709 ExplCity:=-1; 1710 if (cix>=0) and (p=p0) then ExplCity:=cix; 1711 if cix>=0 then 1712 if Tile and fTerrain>=fGrass then 1713 begin 1714 if ((Tile and fTerImp=tiFarm) or (Tile and fCity<>0)) 1715 and (RW[p].City[cix].Built[imSupermarket]>0) then 1716 inc(Food,Food shr 1); {farmland effect} 1717 if (Tile and (fRoad or fRR)<>0) and (MoveCost=1) 1718 and (RW[p].City[cix].Built[imHighways]>0) then 1719 inc(Trade,1); {superhighway effect} 1958 Food := 2 * Food - FoodRes[0]; 1959 Prod := 2 * Prod - ProdRes[0]; 1960 Trade := 2 * Trade - TradeRes[0]; 1961 end; 1962 1963 if (Tile and fTerImp = tiIrrigation) or (Tile and fTerImp = tiFarm) or 1964 (Tile and fCity <> 0) then 1965 inc(Food, IrrEff); { irrigation effect } 1966 if Tile and fTerImp = tiMine then 1967 inc(Prod, MineEff); { mining effect } 1968 if (Tile and fRiver <> 0) and (RW[p].Tech[adMapMaking] >= tsApplicable) 1969 then 1970 inc(Trade); { river effect } 1971 if (Tile and (fRoad or fRR) <> 0) and (MoveCost = 1) and 1972 (RW[p].Tech[adWheel] >= tsApplicable) then 1973 inc(Trade); { road effect } 1974 if (Tile and (fRR or fCity) <> 0) and 1975 (RW[p].Tech[adRailroad] >= tsApplicable) then 1976 inc(Prod, Prod shr 1); { railroad effect } 1977 1978 ExplCity := -1; 1979 if (cix >= 0) and (p = p0) then 1980 ExplCity := cix; 1981 if cix >= 0 then 1982 if Tile and fTerrain >= fGrass then 1983 begin 1984 if ((Tile and fTerImp = tiFarm) or (Tile and fCity <> 0)) and 1985 (RW[p].City[cix].Built[imSupermarket] > 0) then 1986 inc(Food, Food shr 1); { farmland effect } 1987 if (Tile and (fRoad or fRR) <> 0) and (MoveCost = 1) and 1988 (RW[p].City[cix].Built[imHighways] > 0) then 1989 inc(Trade, 1); { superhighway effect } 1720 1990 end 1721 else 1722 begin 1723 if RW[p].City[cix].Built[imHarbor]>0 then inc(Food); {harbour effect} 1724 if RW[p].City[cix].Built[imPlatform]>0 then inc(Prod); {oil platform effect} 1725 if GWonder[woLighthouse].EffectiveOwner=p then inc(Prod); 1991 else 1992 begin 1993 if RW[p].City[cix].Built[imHarbor] > 0 then 1994 inc(Food); { harbour effect } 1995 if RW[p].City[cix].Built[imPlatform] > 0 then 1996 inc(Prod); { oil platform effect } 1997 if GWonder[woLighthouse].EffectiveOwner = p then 1998 inc(Prod); 1726 1999 end; 1727 2000 end; 1728 2001 1729 {good government influence} 1730 if (RW[p].Government in [gRepublic,gDemocracy,gFuture]) and (Trade>0) then 1731 inc(Trade); 1732 if (RW[p].Government=gCommunism) and (Prod>1) then 1733 inc(Prod); 1734 1735 if RW[p].Government in [gAnarchy,gDespotism] then 1736 begin {bad government influence} 1737 if Food>3 then Food:=3; 1738 if Prod>2 then Prod:=2; 1739 if Trade>2 then Trade:=2; 1740 end; 1741 1742 if Tile and (fTerrain or fPoll)>fPoll then 1743 begin {pollution - decrease ressources} 1744 dec(Food,Food shr 1); 1745 dec(Prod,Prod shr 1); 1746 dec(Trade,Trade shr 1); 1747 end; 1748 1749 if Tile and fCity<>0 then Trade:=0 1750 else if (cix>=0) 1751 and (RW[p].City[cix].Built[imCourt]+RW[p].City[cix].Built[imPalace]=0) then 1752 if RW[p].City[cix].Built[imTownHall]=0 then Trade:=0 1753 else if Trade>3 then Trade:=3; 1754 end; 1755 result:=eOK; 1756 end; {GetTileInfo} 1757 1758 procedure Strongest(Loc:integer;var uix,Strength,Bonus,Cnt:integer); 1759 {find strongest defender at Loc} 1760 var 1761 Defender,uix1,Det,Cost,TestStrength,TestBonus,TestDet,TestCost,Domain: integer; 1762 PUn: ^TUn; 1763 PModel: ^TModel; 1764 begin 1765 Defender:=Occupant[Loc]; 1766 Cnt:=0; 1767 Det:=-1; 1768 for uix1:=0 to RW[Defender].nUn-1 do 1769 begin 1770 PUn:=@RW[Defender].Un[uix1]; 1771 PModel:=@RW[Defender].Model[PUn.mix]; 1772 if PModel.Kind=mkSpecial_Glider then Domain:=dGround 1773 else Domain:=PModel.Domain; 1774 if PUn.Loc=Loc then 1775 begin 1776 inc(Cnt); 1777 if PUn.Master<0 then 1778 begin 1779 if Domain<dSea then 1780 begin 1781 TestBonus:=Terrain[RealMap[Loc] and fTerrain].Defense; 1782 if RealMap[Loc] and fTerImp=tiFort then inc(TestBonus,4); 1783 if PUn.Flags and unFortified<>0 then inc(TestBonus,2); 1784 if (PModel.Kind=mkSpecial_TownGuard) and (RealMap[Loc] and fCity<>0) then 1785 inc(TestBonus,4); 2002 { good government influence } 2003 if (RW[p].Government in [gRepublic, gDemocracy, gFuture]) and (Trade > 0) 2004 then 2005 inc(Trade); 2006 if (RW[p].Government = gCommunism) and (Prod > 1) then 2007 inc(Prod); 2008 2009 if RW[p].Government in [gAnarchy, gDespotism] then 2010 begin { bad government influence } 2011 if Food > 3 then 2012 Food := 3; 2013 if Prod > 2 then 2014 Prod := 2; 2015 if Trade > 2 then 2016 Trade := 2; 2017 end; 2018 2019 if Tile and (fTerrain or fPoll) > fPoll then 2020 begin { pollution - decrease ressources } 2021 dec(Food, Food shr 1); 2022 dec(Prod, Prod shr 1); 2023 dec(Trade, Trade shr 1); 2024 end; 2025 2026 if Tile and fCity <> 0 then 2027 Trade := 0 2028 else if (cix >= 0) and (RW[p].City[cix].Built[imCourt] + RW[p].City[cix] 2029 .Built[imPalace] = 0) then 2030 if RW[p].City[cix].Built[imTownHall] = 0 then 2031 Trade := 0 2032 else if Trade > 3 then 2033 Trade := 3; 2034 end; 2035 result := eOK; 2036 end; { GetTileInfo } 2037 2038 procedure Strongest(Loc: integer; var uix, Strength, Bonus, Cnt: integer); 2039 { find strongest defender at Loc } 2040 var 2041 Defender, uix1, Det, Cost, TestStrength, TestBonus, TestDet, TestCost, 2042 Domain: integer; 2043 PUn: ^TUn; 2044 PModel: ^TModel; 2045 begin 2046 Defender := Occupant[Loc]; 2047 Cnt := 0; 2048 Det := -1; 2049 for uix1 := 0 to RW[Defender].nUn - 1 do 2050 begin 2051 PUn := @RW[Defender].Un[uix1]; 2052 PModel := @RW[Defender].Model[PUn.mix]; 2053 if PModel.Kind = mkSpecial_Glider then 2054 Domain := dGround 2055 else 2056 Domain := PModel.Domain; 2057 if PUn.Loc = Loc then 2058 begin 2059 inc(Cnt); 2060 if PUn.Master < 0 then 2061 begin 2062 if Domain < dSea then 2063 begin 2064 TestBonus := Terrain[RealMap[Loc] and fTerrain].Defense; 2065 if RealMap[Loc] and fTerImp = tiFort then 2066 inc(TestBonus, 4); 2067 if PUn.Flags and unFortified <> 0 then 2068 inc(TestBonus, 2); 2069 if (PModel.Kind = mkSpecial_TownGuard) and 2070 (RealMap[Loc] and fCity <> 0) then 2071 inc(TestBonus, 4); 1786 2072 end 1787 else TestBonus:=4; 1788 inc(TestBonus,PUn.Exp div ExpCost); 1789 TestStrength:=PModel.Defense*TestBonus*PUn.Health; 1790 if (Domain=dAir) and ((RealMap[Loc] and fCity<>0) 1791 or (RealMap[Loc] and fTerImp=tiBase)) then 1792 TestStrength:=0; 1793 if (Domain=dSea) and (RealMap[Loc] and fTerrain>=fGrass) then 1794 TestStrength:=TestStrength shr 1; 1795 TestDet:=TestStrength; 1796 if PModel.Cap[mcStealth]>0 then 1797 else if PModel.Cap[mcSub]>0 then inc(TestDet,1 shl 28) 1798 else if (Domain=dGround) and (PModel.Cap[mcFanatic]>0) 1799 and not (RW[Defender].Government in [gRepublic,gDemocracy,gFuture]) then 1800 inc(TestDet,4 shl 28) // fanatic ground units always defend 1801 else if PModel.Flags and mdZOC<>0 then 1802 inc(TestDet,3 shl 28) 1803 else inc(TestDet,2 shl 28); 1804 TestCost:=RW[Defender].Model[PUn.mix].Cost; 1805 if (TestDet>Det) or (TestDet=Det) and (TestCost<Cost) then 1806 begin 1807 uix:=uix1; 1808 Strength:=TestStrength; 1809 Bonus:=TestBonus; 1810 Det:=TestDet; 1811 Cost:=TestCost; 2073 else 2074 TestBonus := 4; 2075 inc(TestBonus, PUn.exp div ExpCost); 2076 TestStrength := PModel.Defense * TestBonus * PUn.Health; 2077 if (Domain = dAir) and ((RealMap[Loc] and fCity <> 0) or 2078 (RealMap[Loc] and fTerImp = tiBase)) then 2079 TestStrength := 0; 2080 if (Domain = dSea) and (RealMap[Loc] and fTerrain >= fGrass) then 2081 TestStrength := TestStrength shr 1; 2082 TestDet := TestStrength; 2083 if PModel.Cap[mcStealth] > 0 then 2084 else if PModel.Cap[mcSub] > 0 then 2085 inc(TestDet, 1 shl 28) 2086 else if (Domain = dGround) and (PModel.Cap[mcFanatic] > 0) and 2087 not(RW[Defender].Government in [gRepublic, gDemocracy, gFuture]) then 2088 inc(TestDet, 4 shl 28) // fanatic ground units always defend 2089 else if PModel.Flags and mdZOC <> 0 then 2090 inc(TestDet, 3 shl 28) 2091 else 2092 inc(TestDet, 2 shl 28); 2093 TestCost := RW[Defender].Model[PUn.mix].Cost; 2094 if (TestDet > Det) or (TestDet = Det) and (TestCost < Cost) then 2095 begin 2096 uix := uix1; 2097 Strength := TestStrength; 2098 Bonus := TestBonus; 2099 Det := TestDet; 2100 Cost := TestCost; 1812 2101 end 1813 2102 end … … 1818 2107 function UnitSpeed(p, mix, Health: integer): integer; 1819 2108 begin 1820 with RW[p].Model[mix] do 1821 begin 1822 result:=Speed; 1823 if Domain=dSea then 1824 begin 1825 if GWonder[woMagellan].EffectiveOwner=p then inc(result,200); 1826 if Health<100 then 1827 result:=((result-250)*Health div 5000)*50+250; 2109 with RW[p].Model[mix] do 2110 begin 2111 result := Speed; 2112 if Domain = dSea then 2113 begin 2114 if GWonder[woMagellan].EffectiveOwner = p then 2115 inc(result, 200); 2116 if Health < 100 then 2117 result := ((result - 250) * Health div 5000) * 50 + 250; 1828 2118 end 1829 2119 end 1830 2120 end; 1831 2121 1832 procedure GetUnitReport(p,uix: integer; var UnitReport: TUnitReport); 1833 var 1834 TerrOwner: integer; 1835 PModel: ^TModel; 1836 begin 1837 UnitReport.FoodSupport:=0; 1838 UnitReport.ProdSupport:=0; 1839 UnitReport.ReportFlags:=0; 1840 if RW[p].Government<>gAnarchy then with RW[p].Un[uix] do 1841 begin 1842 PModel:=@RW[p].Model[mix]; 1843 if (PModel.Kind=mkSettler) {and (GWonder[woFreeSettlers].EffectiveOwner<>p)} then 1844 UnitReport.FoodSupport:=SettlerFood[RW[p].Government] 1845 else if Flags and unConscripts<>0 then UnitReport.FoodSupport:=1; 1846 1847 if RW[p].Government<>gFundamentalism then 1848 begin 1849 if GTestFlags and tfImmImprove=0 then 1850 begin 1851 if PModel.Flags and mdDoubleSupport<>0 then 1852 UnitReport.ProdSupport:=2 1853 else UnitReport.ProdSupport:=1; 1854 if PModel.Kind=mkSpecial_TownGuard then 1855 UnitReport.ReportFlags:=UnitReport.ReportFlags or urfAlwaysSupport; 1856 end; 1857 if PModel.Flags and mdCivil=0 then 1858 begin 1859 TerrOwner:=RealMap[Loc] shr 27; 1860 case RW[p].Government of 1861 gRepublic, gFuture: 1862 if (TerrOwner<>p) and (TerrOwner<nPl) 1863 and (RW[p].Treaty[TerrOwner]<trAlliance) then 1864 UnitReport.ReportFlags:=UnitReport.ReportFlags or urfDeployed; 1865 gDemocracy: 1866 if (TerrOwner>=nPl) or (TerrOwner<>p) 1867 and (RW[p].Treaty[TerrOwner]<trAlliance) then 1868 UnitReport.ReportFlags:=UnitReport.ReportFlags or urfDeployed; 2122 procedure GetUnitReport(p, uix: integer; var UnitReport: TUnitReport); 2123 var 2124 TerrOwner: integer; 2125 PModel: ^TModel; 2126 begin 2127 UnitReport.FoodSupport := 0; 2128 UnitReport.ProdSupport := 0; 2129 UnitReport.ReportFlags := 0; 2130 if RW[p].Government <> gAnarchy then 2131 with RW[p].Un[uix] do 2132 begin 2133 PModel := @RW[p].Model[mix]; 2134 if (PModel.Kind = mkSettler) 2135 { and (GWonder[woFreeSettlers].EffectiveOwner<>p) } then 2136 UnitReport.FoodSupport := SettlerFood[RW[p].Government] 2137 else if Flags and unConscripts <> 0 then 2138 UnitReport.FoodSupport := 1; 2139 2140 if RW[p].Government <> gFundamentalism then 2141 begin 2142 if GTestFlags and tfImmImprove = 0 then 2143 begin 2144 if PModel.Flags and mdDoubleSupport <> 0 then 2145 UnitReport.ProdSupport := 2 2146 else 2147 UnitReport.ProdSupport := 1; 2148 if PModel.Kind = mkSpecial_TownGuard then 2149 UnitReport.ReportFlags := UnitReport.ReportFlags or 2150 urfAlwaysSupport; 1869 2151 end; 1870 end 1871 end; 1872 end; 1873 end; 1874 1875 procedure SearchCity(Loc: integer; var p,cix: integer); 2152 if PModel.Flags and mdCivil = 0 then 2153 begin 2154 TerrOwner := RealMap[Loc] shr 27; 2155 case RW[p].Government of 2156 gRepublic, gFuture: 2157 if (TerrOwner <> p) and (TerrOwner < nPl) and 2158 (RW[p].Treaty[TerrOwner] < trAlliance) then 2159 UnitReport.ReportFlags := UnitReport.ReportFlags or urfDeployed; 2160 gDemocracy: 2161 if (TerrOwner >= nPl) or (TerrOwner <> p) and 2162 (RW[p].Treaty[TerrOwner] < trAlliance) then 2163 UnitReport.ReportFlags := UnitReport.ReportFlags or urfDeployed; 2164 end; 2165 end 2166 end; 2167 end; 2168 end; 2169 2170 procedure SearchCity(Loc: integer; var p, cix: integer); 1876 2171 // set p to supposed owner before call 1877 2172 var 1878 i: integer; 1879 begin 1880 if RealMap[Loc]<nPl shl 27 then p:=RealMap[Loc] shr 27; 1881 for i:=0 to nPl-1 do 1882 begin 1883 if 1 shl p and GAlive<>0 then with RW[p] do 1884 begin 1885 cix:=nCity-1; 1886 while (cix>=0) and (City[cix].Loc<>Loc) do dec(cix); 1887 if cix>=0 then exit; 1888 end; 1889 assert(i<nPl-1); 1890 p:=(p+1) mod nPl; 2173 i: integer; 2174 begin 2175 if RealMap[Loc] < nPl shl 27 then 2176 p := RealMap[Loc] shr 27; 2177 for i := 0 to nPl - 1 do 2178 begin 2179 if 1 shl p and GAlive <> 0 then 2180 with RW[p] do 2181 begin 2182 cix := nCity - 1; 2183 while (cix >= 0) and (City[cix].Loc <> Loc) do 2184 dec(cix); 2185 if cix >= 0 then 2186 exit; 2187 end; 2188 assert(i < nPl - 1); 2189 p := (p + 1) mod nPl; 1891 2190 end; 1892 2191 end; … … 1894 2193 procedure MakeCityInfo(p, cix: integer; var ci: TCityInfo); 1895 2194 begin 1896 assert((p>=0) and (p<nPl)); 1897 assert((cix>=0) and (cix<RW[p].nCity)); 1898 with RW[p].City[cix] do 1899 begin 1900 ci.Loc:=Loc; 1901 ci.ID:=ID; 1902 ci.Owner:=p; 1903 ci.Size:=Size; 1904 ci.Flags:=0; 1905 if Built[imPalace]>0 then inc(ci.Flags,ciCapital); 1906 if (Built[imWalls]>0) or (Continent[Loc]=GrWallContinent[p]) then 1907 inc(ci.Flags,ciWalled); 1908 if Built[imCoastalFort]>0 then inc(ci.Flags,ciCoastalFort); 1909 if Built[imMissileBat]>0 then inc(ci.Flags,ciMissileBat); 1910 if Built[imBunker]>0 then inc(ci.Flags,ciBunker); 1911 if Built[imSpacePort]>0 then inc(ci.Flags,ciSpacePort); 1912 end; 1913 end; 1914 1915 procedure TellAboutModel(p,taOwner,tamix: integer); 1916 var 1917 i: integer; 1918 begin 1919 if (p=taOwner) or (Mode<moPlaying) then exit; 1920 i:=0; 1921 while (i<RW[p].nEnemyModel) 1922 and ((RW[p].EnemyModel[i].Owner<>taOwner) 1923 or (RW[p].EnemyModel[i].mix<>tamix)) do inc(i); 1924 if i=RW[p].nEnemyModel then 1925 IntServer(sIntTellAboutModel+p shl 4,taOwner,tamix,nil^); 1926 end; 1927 1928 function emixSafe(p,taOwner,tamix: integer): integer; 1929 begin 1930 result:=RWemix[p,taOwner,tamix]; 1931 if result<0 then 2195 assert((p >= 0) and (p < nPl)); 2196 assert((cix >= 0) and (cix < RW[p].nCity)); 2197 with RW[p].City[cix] do 2198 begin 2199 ci.Loc := Loc; 2200 ci.ID := ID; 2201 ci.Owner := p; 2202 ci.Size := Size; 2203 ci.Flags := 0; 2204 if Built[imPalace] > 0 then 2205 inc(ci.Flags, ciCapital); 2206 if (Built[imWalls] > 0) or (Continent[Loc] = GrWallContinent[p]) then 2207 inc(ci.Flags, ciWalled); 2208 if Built[imCoastalFort] > 0 then 2209 inc(ci.Flags, ciCoastalFort); 2210 if Built[imMissileBat] > 0 then 2211 inc(ci.Flags, ciMissileBat); 2212 if Built[imBunker] > 0 then 2213 inc(ci.Flags, ciBunker); 2214 if Built[imSpacePort] > 0 then 2215 inc(ci.Flags, ciSpacePort); 2216 end; 2217 end; 2218 2219 procedure TellAboutModel(p, taOwner, tamix: integer); 2220 var 2221 i: integer; 2222 begin 2223 if (p = taOwner) or (Mode < moPlaying) then 2224 exit; 2225 i := 0; 2226 while (i < RW[p].nEnemyModel) and ((RW[p].EnemyModel[i].Owner <> taOwner) or 2227 (RW[p].EnemyModel[i].mix <> tamix)) do 2228 inc(i); 2229 if i = RW[p].nEnemyModel then 2230 IntServer(sIntTellAboutModel + p shl 4, taOwner, tamix, nil^); 2231 end; 2232 2233 function emixSafe(p, taOwner, tamix: integer): integer; 2234 begin 2235 result := RWemix[p, taOwner, tamix]; 2236 if result < 0 then 1932 2237 begin // sIntTellAboutModel comes too late 1933 assert(Mode=moMovie);1934 result:=$FFFF;1935 end; 1936 end; 1937 1938 procedure IntroduceEnemy(p1, p2: integer);1939 begin 1940 RW[p1].Treaty[p2]:=trNone;1941 RW[p2].Treaty[p1]:=trNone;1942 end; 1943 1944 function DiscoverTile(Loc, p, pTell, Level: integer; 1945 EnableContact: boolean;euix: integer = -2): boolean;2238 assert(Mode = moMovie); 2239 result := $FFFF; 2240 end; 2241 end; 2242 2243 procedure IntroduceEnemy(p1, p2: integer); 2244 begin 2245 RW[p1].Treaty[p2] := trNone; 2246 RW[p2].Treaty[p1] := trNone; 2247 end; 2248 2249 function DiscoverTile(Loc, p, pTell, Level: integer; EnableContact: boolean; 2250 euix: integer = -2): boolean; 1946 2251 // euix = -2: full discover 1947 2252 // euix = -1: unit and city only, append units in EnemyUn 1948 2253 // euix >= 0: unit and city only, replace EnemyUn[euix] 1949 2254 1950 procedure SetContact(p1,p2: integer); 1951 begin 1952 if (Mode<moPlaying) or (p1=p2) or (RW[p1].Treaty[p2]>trNoContact) then exit; 1953 IntServer(sIntTellAboutNation,p1,p2,nil^); 1954 // NewContact[p1,p2]:=true 1955 end; 1956 1957 var 1958 i,uix,cix,TerrOwner,TerrOwnerTreaty,Strength,Bonus,Cnt,pFoundCity, 1959 cixFoundCity,MinLevel,Loc1,V8: integer; 1960 Tile,AddFlags: Cardinal; 1961 Adjacent: TVicinity8Loc; 1962 unx: ^TUn; 1963 mox: ^TModel; 1964 begin 1965 result:=false; 1966 with RW[pTell] do 1967 begin 1968 Tile:=RealMap[Loc] and ResourceMask[pTell]; 1969 if Mode=moLoading_Fast then AddFlags:=0 // don't discover units 1970 else 1971 begin 1972 AddFlags:=Map[Loc] and fInEnemyZoC // always preserve this flag! 1973 or fObserved; 1974 if Level=lObserveSuper then 1975 AddFlags:=AddFlags or fSpiedOut; 1976 if (GrWallContinent[pTell]>=0) and (Continent[Loc]=GrWallContinent[pTell]) then 1977 AddFlags:=AddFlags or fGrWall; 1978 if (Mode=moPlaying) and ((Tile and (nPl shl 27)<>nPl shl 27) and (pTell=p)) then 2255 procedure SetContact(p1, p2: integer); 2256 begin 2257 if (Mode < moPlaying) or (p1 = p2) or (RW[p1].Treaty[p2] > trNoContact) then 2258 exit; 2259 IntServer(sIntTellAboutNation, p1, p2, nil^); 2260 // NewContact[p1,p2]:=true 2261 end; 2262 2263 var 2264 i, uix, cix, TerrOwner, TerrOwnerTreaty, Strength, Bonus, Cnt, pFoundCity, 2265 cixFoundCity, MinLevel, Loc1, V8: integer; 2266 Tile, AddFlags: Cardinal; 2267 Adjacent: TVicinity8Loc; 2268 unx: ^TUn; 2269 mox: ^TModel; 2270 begin 2271 result := false; 2272 with RW[pTell] do 2273 begin 2274 Tile := RealMap[Loc] and ResourceMask[pTell]; 2275 if Mode = moLoading_Fast then 2276 AddFlags := 0 // don't discover units 2277 else 2278 begin 2279 AddFlags := Map[Loc] and fInEnemyZoC // always preserve this flag! 2280 or fObserved; 2281 if Level = lObserveSuper then 2282 AddFlags := AddFlags or fSpiedOut; 2283 if (GrWallContinent[pTell] >= 0) and 2284 (Continent[Loc] = GrWallContinent[pTell]) then 2285 AddFlags := AddFlags or fGrWall; 2286 if (Mode = moPlaying) and ((Tile and (nPl shl 27) <> nPl shl 27) and 2287 (pTell = p)) then 1979 2288 begin // set fPeace flag? 1980 TerrOwner:=Tile shr 27;1981 if TerrOwner<>pTell then1982 begin 1983 TerrOwnerTreaty:=RW[pTell].Treaty[TerrOwner];1984 if 1 shl TerrOwnerTreaty1985 and (1 shl trPeace or 1 shl TrFriendlyContact)<>0 then1986 AddFlags:=AddFlags or fPeace;2289 TerrOwner := Tile shr 27; 2290 if TerrOwner <> pTell then 2291 begin 2292 TerrOwnerTreaty := RW[pTell].Treaty[TerrOwner]; 2293 if 1 shl TerrOwnerTreaty and 2294 (1 shl trPeace or 1 shl TrFriendlyContact) <> 0 then 2295 AddFlags := AddFlags or fPeace; 1987 2296 end 1988 2297 end; 1989 2298 1990 if Occupant[Loc]>=0 then 1991 if Occupant[Loc]=pTell then 1992 begin 1993 AddFlags:=AddFlags or (fOwned or fUnit); 1994 if ZoCMap[Loc]>0 then AddFlags:=AddFlags or fOwnZoCUnit; 1995 // Level:=lObserveSuper // always see own units 2299 if Occupant[Loc] >= 0 then 2300 if Occupant[Loc] = pTell then 2301 begin 2302 AddFlags := AddFlags or (fOwned or fUnit); 2303 if ZoCMap[Loc] > 0 then 2304 AddFlags := AddFlags or fOwnZoCUnit; 2305 // Level:=lObserveSuper // always see own units 1996 2306 end 1997 else if Map[Loc] and fUnit<>0 then 1998 AddFlags:=AddFlags or fUnit 1999 else 2000 begin 2001 Strongest(Loc,uix,Strength,Bonus,Cnt); 2002 unx:=@RW[Occupant[Loc]].Un[uix]; 2003 mox:=@RW[Occupant[Loc]].Model[unx.mix]; 2004 assert((ZoCMap[Loc]<>0)=(mox.Flags and mdZOC<>0)); 2005 if (mox.Cap[mcStealth]>0) and (Tile and fCity=0) 2006 and (Tile and fTerImp<>tiBase) then 2007 MinLevel:=lObserveSuper 2008 else if (mox.Cap[mcSub]>0) and (Tile and fTerrain<fGrass) then 2009 MinLevel:=lObserveAll 2010 else MinLevel:=lObserveUnhidden; 2011 if Level>=MinLevel then 2307 else if Map[Loc] and fUnit <> 0 then 2308 AddFlags := AddFlags or fUnit 2309 else 2310 begin 2311 Strongest(Loc, uix, Strength, Bonus, Cnt); 2312 unx := @RW[Occupant[Loc]].Un[uix]; 2313 mox := @RW[Occupant[Loc]].Model[unx.mix]; 2314 assert((ZoCMap[Loc] <> 0) = (mox.Flags and mdZOC <> 0)); 2315 if (mox.Cap[mcStealth] > 0) and (Tile and fCity = 0) and 2316 (Tile and fTerImp <> tiBase) then 2317 MinLevel := lObserveSuper 2318 else if (mox.Cap[mcSub] > 0) and (Tile and fTerrain < fGrass) then 2319 MinLevel := lObserveAll 2320 else 2321 MinLevel := lObserveUnhidden; 2322 if Level >= MinLevel then 2012 2323 begin 2013 AddFlags:=AddFlags or fUnit; 2014 if euix>=0 then uix:=euix 2015 else 2324 AddFlags := AddFlags or fUnit; 2325 if euix >= 0 then 2326 uix := euix 2327 else 2016 2328 begin 2017 uix:=nEnemyUn;2018 inc(nEnemyUn);2019 assert(nEnemyUn<neumax);2329 uix := nEnemyUn; 2330 inc(nEnemyUn); 2331 assert(nEnemyUn < neumax); 2020 2332 end; 2021 MakeUnitInfo(Occupant[Loc],unx^,EnemyUn[uix]);2022 if Cnt>1 then2023 EnemyUn[uix].Flags:=EnemyUn[uix].Flags or unMulti;2024 if (mox.Flags and mdZOC<>0) and (pTell=p)2025 and (Treaty[Occupant[Loc]]<trAlliance) then2333 MakeUnitInfo(Occupant[Loc], unx^, EnemyUn[uix]); 2334 if Cnt > 1 then 2335 EnemyUn[uix].Flags := EnemyUn[uix].Flags or unMulti; 2336 if (mox.Flags and mdZOC <> 0) and (pTell = p) and 2337 (Treaty[Occupant[Loc]] < trAlliance) then 2026 2338 begin // set fInEnemyZoC flags of surrounding tiles 2027 V8_to_Loc(Loc,Adjacent);2028 for V8:=0 to 7 do2339 V8_to_Loc(Loc, Adjacent); 2340 for V8 := 0 to 7 do 2029 2341 begin 2030 Loc1:=Adjacent[V8];2031 if (Loc1>=0) and (Loc1<MapSize) then2032 Map[Loc1]:=Map[Loc1] or fInEnemyZoC2342 Loc1 := Adjacent[V8]; 2343 if (Loc1 >= 0) and (Loc1 < MapSize) then 2344 Map[Loc1] := Map[Loc1] or fInEnemyZoC 2033 2345 end 2034 2346 end; 2035 if EnableContact and (mox.Domain=dGround) then2036 SetContact(pTell,Occupant[Loc]);2037 if Mode>=moMovie then2347 if EnableContact and (mox.Domain = dGround) then 2348 SetContact(pTell, Occupant[Loc]); 2349 if Mode >= moMovie then 2038 2350 begin 2039 TellAboutModel(pTell,Occupant[Loc],unx.mix);2040 EnemyUn[uix].emix:=emixSafe(pTell,Occupant[Loc],unx.mix);2351 TellAboutModel(pTell, Occupant[Loc], unx.mix); 2352 EnemyUn[uix].emix := emixSafe(pTell, Occupant[Loc], unx.mix); 2041 2353 end; 2042 //Level:=lObserveSuper; // don't discover unit twice2043 if (pTell=p)2044 and ((Tile and fCity=0) or (1 shl pTell and GAI<>0)) then2045 result:=true;2354 // Level:=lObserveSuper; // don't discover unit twice 2355 if (pTell = p) and 2356 ((Tile and fCity = 0) or (1 shl pTell and GAI <> 0)) then 2357 result := true; 2046 2358 end 2047 else AddFlags:=AddFlags or Map[Loc] and (fStealthUnit or fHiddenUnit) 2359 else 2360 AddFlags := AddFlags or Map[Loc] and (fStealthUnit or fHiddenUnit) 2048 2361 end 2049 2362 end; // if Mode>moLoading_Fast 2050 2363 2051 if Tile and fCity<>0 then 2052 if ObserveLevel[Loc] shr (2*pTell) and 3>0 then 2053 AddFlags:=AddFlags or Map[Loc] and fOwned 2054 else 2055 begin 2056 pFoundCity:=Tile shr 27; 2057 if pFoundCity=pTell then AddFlags:=AddFlags or fOwned 2364 if Tile and fCity <> 0 then 2365 if ObserveLevel[Loc] shr (2 * pTell) and 3 > 0 then 2366 AddFlags := AddFlags or Map[Loc] and fOwned 2058 2367 else 2059 begin 2060 if EnableContact then SetContact(pTell,pFoundCity); 2061 cixFoundCity:=RW[pFoundCity].nCity-1; 2062 while (cixFoundCity>=0) 2063 and (RW[pFoundCity].City[cixFoundCity].Loc<>Loc) do 2064 dec(cixFoundCity); 2065 assert(cixFoundCity>=0); 2066 i:=0; 2067 while (i<nEnemyCity) and (EnemyCity[i].Loc<>Loc) do 2068 inc(i); 2069 if i=nEnemyCity then 2368 begin 2369 pFoundCity := Tile shr 27; 2370 if pFoundCity = pTell then 2371 AddFlags := AddFlags or fOwned 2372 else 2373 begin 2374 if EnableContact then 2375 SetContact(pTell, pFoundCity); 2376 cixFoundCity := RW[pFoundCity].nCity - 1; 2377 while (cixFoundCity >= 0) and 2378 (RW[pFoundCity].City[cixFoundCity].Loc <> Loc) do 2379 dec(cixFoundCity); 2380 assert(cixFoundCity >= 0); 2381 i := 0; 2382 while (i < nEnemyCity) and (EnemyCity[i].Loc <> Loc) do 2383 inc(i); 2384 if i = nEnemyCity then 2070 2385 begin 2071 inc(nEnemyCity); 2072 assert(nEnemyCity<necmax); 2073 EnemyCity[i].Status:=0; 2074 EnemyCity[i].SavedStatus:=0; 2075 if pTell=p then result:=true; 2386 inc(nEnemyCity); 2387 assert(nEnemyCity < necmax); 2388 EnemyCity[i].Status := 0; 2389 EnemyCity[i].SavedStatus := 0; 2390 if pTell = p then 2391 result := true; 2076 2392 end; 2077 MakeCityInfo(pFoundCity,cixFoundCity,EnemyCity[i]);2393 MakeCityInfo(pFoundCity, cixFoundCity, EnemyCity[i]); 2078 2394 end; 2079 2395 end 2080 else if Map[Loc] and fCity<>0 then // remove enemycity 2081 for cix:=0 to nEnemyCity-1 do 2082 if EnemyCity[cix].Loc=Loc then 2083 EnemyCity[cix].Loc:=-1; 2084 2085 if Map[Loc] and fTerrain=fUNKNOWN then inc(Discovered[pTell]); 2086 if euix>=-1 then 2087 Map[Loc]:=Map[Loc] and not (fUnit or fCity or fOwned or fOwnZoCUnit) 2088 or (Tile and $07FFFFFF or AddFlags) and (fUnit or fCity or fOwned or fOwnZoCUnit) 2089 else 2090 begin 2091 Map[Loc]:=Tile and $07FFFFFF or AddFlags; 2092 if Tile and $78000000=$78000000 then Territory[Loc]:=-1 2093 else Territory[Loc]:=Tile shr 27; 2094 MapObservedLast[Loc]:=GTurn 2095 end; 2096 ObserveLevel[Loc]:=ObserveLevel[Loc] and not (3 shl (2*pTell)) 2097 or Cardinal(Level) shl (2*pTell); 2396 else if Map[Loc] and fCity <> 0 then // remove enemycity 2397 for cix := 0 to nEnemyCity - 1 do 2398 if EnemyCity[cix].Loc = Loc then 2399 EnemyCity[cix].Loc := -1; 2400 2401 if Map[Loc] and fTerrain = fUNKNOWN then 2402 inc(Discovered[pTell]); 2403 if euix >= -1 then 2404 Map[Loc] := Map[Loc] and not(fUnit or fCity or fOwned or fOwnZoCUnit) or 2405 (Tile and $07FFFFFF or AddFlags) and 2406 (fUnit or fCity or fOwned or fOwnZoCUnit) 2407 else 2408 begin 2409 Map[Loc] := Tile and $07FFFFFF or AddFlags; 2410 if Tile and $78000000 = $78000000 then 2411 Territory[Loc] := -1 2412 else 2413 Territory[Loc] := Tile shr 27; 2414 MapObservedLast[Loc] := GTurn 2415 end; 2416 ObserveLevel[Loc] := ObserveLevel[Loc] and not(3 shl (2 * pTell)) or 2417 Cardinal(Level) shl (2 * pTell); 2098 2418 end 2099 2419 end; // DiscoverTile 2100 2420 2101 function Discover9(Loc,p,Level: integer; TellAllied, EnableContact: boolean): boolean; 2102 var 2103 V9,Loc1,pTell,OldLevel: integer; 2104 Radius: TVicinity8Loc; 2105 begin 2106 assert((Mode>moLoading_Fast) or (RW[p].nEnemyUn=0)); 2107 result:=false; 2108 V8_to_Loc(Loc,Radius); 2109 for V9:=0 to 8 do 2110 begin 2111 if V9=8 then Loc1:=Loc 2112 else Loc1:=Radius[V9]; 2113 if (Loc1>=0) and (Loc1<MapSize) then 2114 if TellAllied then 2115 begin 2116 for pTell:=0 to nPl-1 do 2117 if (pTell=p) or (1 shl pTell and GAlive<>0) 2118 and (RW[p].Treaty[pTell]=trAlliance) then 2421 function Discover9(Loc, p, Level: integer; 2422 TellAllied, EnableContact: boolean): boolean; 2423 var 2424 V9, Loc1, pTell, OldLevel: integer; 2425 Radius: TVicinity8Loc; 2426 begin 2427 assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0)); 2428 result := false; 2429 V8_to_Loc(Loc, Radius); 2430 for V9 := 0 to 8 do 2431 begin 2432 if V9 = 8 then 2433 Loc1 := Loc 2434 else 2435 Loc1 := Radius[V9]; 2436 if (Loc1 >= 0) and (Loc1 < MapSize) then 2437 if TellAllied then 2438 begin 2439 for pTell := 0 to nPl - 1 do 2440 if (pTell = p) or (1 shl pTell and GAlive <> 0) and 2441 (RW[p].Treaty[pTell] = trAlliance) then 2119 2442 begin 2120 OldLevel:=ObserveLevel[Loc1] shr (2*pTell) and 3; 2121 if Level>OldLevel then 2122 result:=DiscoverTile(Loc1,p,pTell,Level,EnableContact) or result; 2443 OldLevel := ObserveLevel[Loc1] shr (2 * pTell) and 3; 2444 if Level > OldLevel then 2445 result := DiscoverTile(Loc1, p, pTell, Level, EnableContact) 2446 or result; 2123 2447 end 2124 2448 end 2125 else2126 begin 2127 OldLevel:=ObserveLevel[Loc1] shr (2*p) and 3;2128 if Level>OldLevel then2129 result:=DiscoverTile(Loc1,p,p,Level,EnableContact) or result;2449 else 2450 begin 2451 OldLevel := ObserveLevel[Loc1] shr (2 * p) and 3; 2452 if Level > OldLevel then 2453 result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result; 2130 2454 end 2131 2455 end; 2132 2456 end; 2133 2457 2134 function Discover21(Loc,p,AdjacentLevel: integer; TellAllied, EnableContact: boolean): boolean; 2135 var 2136 V21,Loc1,pTell,Level,OldLevel,AdjacentFlags: integer; 2137 Radius: TVicinity21Loc; 2138 begin 2139 assert((Mode>moLoading_Fast) or (RW[p].nEnemyUn=0)); 2140 result:=false; 2141 AdjacentFlags:=$00267620 shr 1; 2142 V21_to_Loc(Loc,Radius); 2143 for V21:=1 to 26 do 2144 begin 2145 Loc1:=Radius[V21]; 2146 if (Loc1>=0) and (Loc1<MapSize) then 2147 begin 2148 if AdjacentFlags and 1<>0 then Level:=AdjacentLevel 2149 else Level:=lObserveUnhidden; 2150 if TellAllied then 2151 begin 2152 for pTell:=0 to nPl-1 do 2153 if (pTell=p) or (1 shl pTell and GAlive<>0) 2154 and (RW[p].Treaty[pTell]=trAlliance) then 2458 function Discover21(Loc, p, AdjacentLevel: integer; 2459 TellAllied, EnableContact: boolean): boolean; 2460 var 2461 V21, Loc1, pTell, Level, OldLevel, AdjacentFlags: integer; 2462 Radius: TVicinity21Loc; 2463 begin 2464 assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0)); 2465 result := false; 2466 AdjacentFlags := $00267620 shr 1; 2467 V21_to_Loc(Loc, Radius); 2468 for V21 := 1 to 26 do 2469 begin 2470 Loc1 := Radius[V21]; 2471 if (Loc1 >= 0) and (Loc1 < MapSize) then 2472 begin 2473 if AdjacentFlags and 1 <> 0 then 2474 Level := AdjacentLevel 2475 else 2476 Level := lObserveUnhidden; 2477 if TellAllied then 2478 begin 2479 for pTell := 0 to nPl - 1 do 2480 if (pTell = p) or (1 shl pTell and GAlive <> 0) and 2481 (RW[p].Treaty[pTell] = trAlliance) then 2155 2482 begin 2156 OldLevel:=ObserveLevel[Loc1] shr (2*pTell) and 3; 2157 if Level>OldLevel then 2158 result:=DiscoverTile(Loc1,p,pTell,Level,EnableContact) or result; 2483 OldLevel := ObserveLevel[Loc1] shr (2 * pTell) and 3; 2484 if Level > OldLevel then 2485 result := DiscoverTile(Loc1, p, pTell, Level, EnableContact) 2486 or result; 2159 2487 end 2160 2488 end 2161 else2162 begin 2163 OldLevel:=ObserveLevel[Loc1] shr (2*p) and 3;2164 if Level>OldLevel then2165 result:=DiscoverTile(Loc1,p,p,Level,EnableContact) or result;2489 else 2490 begin 2491 OldLevel := ObserveLevel[Loc1] shr (2 * p) and 3; 2492 if Level > OldLevel then 2493 result := DiscoverTile(Loc1, p, p, Level, EnableContact) or result; 2166 2494 end 2167 2495 end; 2168 AdjacentFlags:=AdjacentFlags shr 1;2496 AdjacentFlags := AdjacentFlags shr 1; 2169 2497 end; 2170 2498 end; 2171 2499 2172 2500 procedure DiscoverAll(p, Level: integer); 2173 { player p discovers complete playground (for supervisor)}2174 var 2175 Loc, OldLevel: integer;2176 begin 2177 assert((Mode>moLoading_Fast) or (RW[p].nEnemyUn=0));2178 for Loc:=0 to MapSize-1 do2179 begin 2180 OldLevel:=ObserveLevel[Loc] shr (2*p) and 3;2181 if Level>OldLevel then2182 DiscoverTile(Loc,p,p,Level,false);2501 { player p discovers complete playground (for supervisor) } 2502 var 2503 Loc, OldLevel: integer; 2504 begin 2505 assert((Mode > moLoading_Fast) or (RW[p].nEnemyUn = 0)); 2506 for Loc := 0 to MapSize - 1 do 2507 begin 2508 OldLevel := ObserveLevel[Loc] shr (2 * p) and 3; 2509 if Level > OldLevel then 2510 DiscoverTile(Loc, p, p, Level, false); 2183 2511 end; 2184 2512 end; … … 2186 2514 procedure DiscoverViewAreas(p: integer); 2187 2515 var 2188 pTell, uix, cix, ecix, Loc, RealOwner: integer;2189 PModel: ^TModel;2516 pTell, uix, cix, ecix, Loc, RealOwner: integer; 2517 PModel: ^TModel; 2190 2518 begin // discover unit and city view areas 2191 for pTell:=0 to nPl-1 do 2192 if (pTell=p) or (RW[p].Treaty[pTell]=trAlliance) then 2193 begin 2194 for uix:=0 to RW[pTell].nUn-1 do with RW[pTell].Un[uix] do 2195 if (Loc>=0) and (master<0) and (RealMap[Loc] and fCity=0) then 2196 begin 2197 PModel:=@RW[pTell].Model[mix]; 2198 if (PModel.Kind=mkDiplomat) or (PModel.Cap[mcSpy]>0) then 2199 Discover21(Loc,p,lObserveSuper,false,true) 2200 else if (PModel.Cap[mcRadar]+PModel.Cap[mcCarrier]>0) 2201 or (PModel.Domain=dAir) then 2202 Discover21(Loc,p,lObserveAll,false,false) 2203 else if (RealMap[Loc] and fTerrain=fMountains) 2204 or (RealMap[Loc] and fTerImp=tiFort) 2205 or (RealMap[Loc] and fTerImp=tiBase) 2206 or (PModel.Cap[mcAcademy]>0) then 2207 Discover21(Loc,p,lObserveUnhidden,false,PModel.Domain=dGround) 2208 else Discover9(Loc,p,lObserveUnhidden,false,PModel.Domain=dGround); 2209 end; 2210 for cix:=0 to RW[pTell].nCity-1 do if RW[pTell].City[cix].Loc>=0 then 2211 Discover21(RW[pTell].City[cix].Loc,p,lObserveUnhidden,false,true); 2212 for ecix:=0 to RW[pTell].nEnemyCity-1 do 2519 for pTell := 0 to nPl - 1 do 2520 if (pTell = p) or (RW[p].Treaty[pTell] = trAlliance) then 2521 begin 2522 for uix := 0 to RW[pTell].nUn - 1 do 2523 with RW[pTell].Un[uix] do 2524 if (Loc >= 0) and (Master < 0) and (RealMap[Loc] and fCity = 0) then 2525 begin 2526 PModel := @RW[pTell].Model[mix]; 2527 if (PModel.Kind = mkDiplomat) or (PModel.Cap[mcSpy] > 0) then 2528 Discover21(Loc, p, lObserveSuper, false, true) 2529 else if (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] > 0) or 2530 (PModel.Domain = dAir) then 2531 Discover21(Loc, p, lObserveAll, false, false) 2532 else if (RealMap[Loc] and fTerrain = fMountains) or 2533 (RealMap[Loc] and fTerImp = tiFort) or 2534 (RealMap[Loc] and fTerImp = tiBase) or (PModel.Cap[mcAcademy] > 0) 2535 then 2536 Discover21(Loc, p, lObserveUnhidden, false, 2537 PModel.Domain = dGround) 2538 else 2539 Discover9(Loc, p, lObserveUnhidden, false, 2540 PModel.Domain = dGround); 2541 end; 2542 for cix := 0 to RW[pTell].nCity - 1 do 2543 if RW[pTell].City[cix].Loc >= 0 then 2544 Discover21(RW[pTell].City[cix].Loc, p, lObserveUnhidden, false, true); 2545 for ecix := 0 to RW[pTell].nEnemyCity - 1 do 2213 2546 begin // players know territory, so no use in hiding city owner 2214 Loc:=RW[pTell].EnemyCity[ecix].Loc;2215 if Loc>=0 then2216 begin 2217 RealOwner:=(RealMap[Loc] shr 27) and $F;2218 if RealOwner<nPl then2219 RW[pTell].EnemyCity[ecix].owner:=RealOwner2220 else2547 Loc := RW[pTell].EnemyCity[ecix].Loc; 2548 if Loc >= 0 then 2549 begin 2550 RealOwner := (RealMap[Loc] shr 27) and $F; 2551 if RealOwner < nPl then 2552 RW[pTell].EnemyCity[ecix].Owner := RealOwner 2553 else 2221 2554 begin 2222 RW[pTell].EnemyCity[ecix].Loc:=-1;2223 RW[pTell].Map[Loc]:=RW[pTell].Map[Loc] and not fCity2555 RW[pTell].EnemyCity[ecix].Loc := -1; 2556 RW[pTell].Map[Loc] := RW[pTell].Map[Loc] and not fCity 2224 2557 end 2225 2558 end … … 2228 2561 end; 2229 2562 2230 function GetUnitStack(p,Loc: integer): integer; 2231 var 2232 uix: integer; 2233 unx: ^TUn; 2234 begin 2235 result:=0; 2236 if Occupant[Loc]<0 then exit; 2237 for uix:=0 to RW[Occupant[Loc]].nUn-1 do 2238 begin 2239 unx:=@RW[Occupant[Loc]].Un[uix]; 2240 if unx.Loc=Loc then 2241 begin 2242 MakeUnitInfo(Occupant[Loc],unx^,RW[p].EnemyUn[RW[p].nEnemyUn+result]); 2243 TellAboutModel(p,Occupant[Loc],unx.mix); 2244 RW[p].EnemyUn[RW[p].nEnemyUn+result].emix:=RWemix[p,Occupant[Loc],unx.mix]; 2245 inc(result); 2563 function GetUnitStack(p, Loc: integer): integer; 2564 var 2565 uix: integer; 2566 unx: ^TUn; 2567 begin 2568 result := 0; 2569 if Occupant[Loc] < 0 then 2570 exit; 2571 for uix := 0 to RW[Occupant[Loc]].nUn - 1 do 2572 begin 2573 unx := @RW[Occupant[Loc]].Un[uix]; 2574 if unx.Loc = Loc then 2575 begin 2576 MakeUnitInfo(Occupant[Loc], unx^, RW[p].EnemyUn[RW[p].nEnemyUn + result]); 2577 TellAboutModel(p, Occupant[Loc], unx.mix); 2578 RW[p].EnemyUn[RW[p].nEnemyUn + result].emix := 2579 RWemix[p, Occupant[Loc], unx.mix]; 2580 inc(result); 2246 2581 end 2247 2582 end … … 2251 2586 // update maps and enemy units of all players after unit change 2252 2587 var 2253 p, euix, OldLevel: integer; 2254 AddFlags, ClearFlags: Cardinal; 2255 begin 2256 if (Mode=moLoading_Fast) and not CityChange then exit; 2257 for p:=0 to nPl-1 do if 1 shl p and (GAlive or GWatching)<>0 then 2258 begin 2259 OldLevel:=ObserveLevel[Loc] shr (2*p) and 3; 2260 if OldLevel>lNoObserve then 2261 begin 2262 if RW[p].Map[Loc] and (fUnit or fOwned)=fUnit then 2263 begin 2264 // replace unit located here in EnemyUn 2265 // do not just set loc:=-1 because total number would be unlimited 2266 euix:=RW[p].nEnemyUn-1; 2267 while euix>=0 do 2268 begin 2269 if RW[p].EnemyUn[euix].Loc=Loc then 2270 begin RW[p].EnemyUn[euix].Loc:=-1; Break; end; 2271 dec(euix); 2588 p, euix, OldLevel: integer; 2589 AddFlags, ClearFlags: Cardinal; 2590 begin 2591 if (Mode = moLoading_Fast) and not CityChange then 2592 exit; 2593 for p := 0 to nPl - 1 do 2594 if 1 shl p and (GAlive or GWatching) <> 0 then 2595 begin 2596 OldLevel := ObserveLevel[Loc] shr (2 * p) and 3; 2597 if OldLevel > lNoObserve then 2598 begin 2599 if RW[p].Map[Loc] and (fUnit or fOwned) = fUnit then 2600 begin 2601 // replace unit located here in EnemyUn 2602 // do not just set loc:=-1 because total number would be unlimited 2603 euix := RW[p].nEnemyUn - 1; 2604 while euix >= 0 do 2605 begin 2606 if RW[p].EnemyUn[euix].Loc = Loc then 2607 begin 2608 RW[p].EnemyUn[euix].Loc := -1; 2609 Break; 2610 end; 2611 dec(euix); 2612 end; 2613 RW[p].Map[Loc] := RW[p].Map[Loc] and not fUnit 2614 end 2615 else 2616 begin // look for empty slot in EnemyUn 2617 euix := RW[p].nEnemyUn - 1; 2618 while (euix >= 0) and (RW[p].EnemyUn[euix].Loc >= 0) do 2619 dec(euix); 2272 2620 end; 2273 RW[p].Map[Loc]:=RW[p].Map[Loc] and not fUnit 2274 end 2275 else 2276 begin // look for empty slot in EnemyUn 2277 euix:=RW[p].nEnemyUn-1; 2278 while (euix>=0) and (RW[p].EnemyUn[euix].Loc>=0) do dec(euix); 2279 end; 2280 if (Occupant[Loc]<0) and not CityChange then 2281 begin // calling DiscoverTile not necessary, only clear map flags 2282 ClearFlags:=fUnit or fHiddenUnit or fStealthUnit or fOwnZoCUnit; 2283 if RealMap[Loc] and fCity=0 then 2284 ClearFlags:=ClearFlags or fOwned; 2285 RW[p].Map[Loc]:=RW[p].Map[Loc] and not ClearFlags; 2286 end 2287 else if (Occupant[Loc]<>p) or CityChange then 2288 begin // city or enemy unit update necessary, call DiscoverTile 2289 ObserveLevel[Loc]:=ObserveLevel[Loc] and not (3 shl (2*p)); 2290 DiscoverTile(Loc, p, p, OldLevel, false, euix); 2291 end 2292 else {if (Occupant[Loc]=p) and not CityChange then} 2293 begin // calling DiscoverTile not necessary, only set map flags 2294 ClearFlags:=0; 2295 AddFlags:=fUnit or fOwned; 2296 if ZoCMap[Loc]>0 then AddFlags:=AddFlags or fOwnZoCUnit 2297 else ClearFlags:=ClearFlags or fOwnZoCUnit; 2298 RW[p].Map[Loc]:=RW[p].Map[Loc] and not ClearFlags or AddFlags; 2299 end 2300 end 2301 end 2302 end; 2303 2304 procedure RecalcV8ZoC(p,Loc: integer); 2305 // recalculate fInEnemyZoC flags around single tile 2306 var 2307 v8,V8V8,Loc1,Loc2,p1,ObserveMask: integer; 2308 Tile1: ^Cardinal; 2309 Adjacent,AdjacentAdjacent: TVicinity8Loc; 2310 begin 2311 if Mode=moLoading_Fast then exit; 2312 ObserveMask:=3 shl (2*p); 2313 V8_to_Loc(Loc,Adjacent); 2314 for V8:=0 to 7 do 2315 begin 2316 Loc1:=Adjacent[V8]; 2317 if (Loc1>=0) and (Loc1<MapSize) then 2318 begin 2319 Tile1:=@RW[p].Map[Loc1]; 2320 Tile1^:=Tile1^ and not fInEnemyZoC; 2321 V8_to_Loc(Loc1,AdjacentAdjacent); 2322 for V8V8:=0 to 7 do 2323 begin 2324 Loc2:=AdjacentAdjacent[V8V8]; 2325 if (Loc2>=0) and (Loc2<MapSize) and (ZoCMap[Loc2]>0) 2326 and (ObserveLevel[Loc2] and ObserveMask<>0) then 2327 begin 2328 p1:=Occupant[Loc2]; 2329 assert(p1<>nPl); 2330 if (p1<>p) and (RW[p].Treaty[p1]<trAlliance) then 2331 begin Tile1^:=Tile1^ or fInEnemyZoC; break end 2621 if (Occupant[Loc] < 0) and not CityChange then 2622 begin // calling DiscoverTile not necessary, only clear map flags 2623 ClearFlags := fUnit or fHiddenUnit or fStealthUnit or fOwnZoCUnit; 2624 if RealMap[Loc] and fCity = 0 then 2625 ClearFlags := ClearFlags or fOwned; 2626 RW[p].Map[Loc] := RW[p].Map[Loc] and not ClearFlags; 2332 2627 end 2333 end; 2334 end 2335 end 2336 end; 2337 2338 procedure RecalcMapZoC(p: integer); 2339 // recalculate fInEnemyZoC flags for the whole map 2340 var 2341 Loc,Loc1,V8,p1,ObserveMask: integer; 2342 Adjacent: TVicinity8Loc; 2343 begin 2344 if Mode=moLoading_Fast then exit; 2345 MaskD(RW[p].Map^,MapSize,not Cardinal(fInEnemyZoC)); 2346 ObserveMask:=3 shl (2*p); 2347 for Loc:=0 to MapSize-1 do 2348 if (ZoCMap[Loc]>0) and (ObserveLevel[Loc] and ObserveMask<>0) then 2349 begin 2350 p1:=Occupant[Loc]; 2351 assert(p1<>nPl); 2352 if (p1<>p) and (RW[p].Treaty[p1]<trAlliance) then 2353 begin // this non-allied enemy ZoC unit is known to this player -- set flags! 2354 V8_to_Loc(Loc,Adjacent); 2355 for V8:=0 to 7 do 2356 begin 2357 Loc1:=Adjacent[V8]; 2358 if (Loc1>=0) and (Loc1<MapSize) then 2359 RW[p].Map[Loc1]:=RW[p].Map[Loc1] or fInEnemyZoC 2628 else if (Occupant[Loc] <> p) or CityChange then 2629 begin // city or enemy unit update necessary, call DiscoverTile 2630 ObserveLevel[Loc] := ObserveLevel[Loc] and not(3 shl (2 * p)); 2631 DiscoverTile(Loc, p, p, OldLevel, false, euix); 2632 end 2633 else { if (Occupant[Loc]=p) and not CityChange then } 2634 begin // calling DiscoverTile not necessary, only set map flags 2635 ClearFlags := 0; 2636 AddFlags := fUnit or fOwned; 2637 if ZoCMap[Loc] > 0 then 2638 AddFlags := AddFlags or fOwnZoCUnit 2639 else 2640 ClearFlags := ClearFlags or fOwnZoCUnit; 2641 RW[p].Map[Loc] := RW[p].Map[Loc] and not ClearFlags or AddFlags; 2360 2642 end 2361 2643 end … … 2363 2645 end; 2364 2646 2647 procedure RecalcV8ZoC(p, Loc: integer); 2648 // recalculate fInEnemyZoC flags around single tile 2649 var 2650 V8, V8V8, Loc1, Loc2, p1, ObserveMask: integer; 2651 Tile1: ^Cardinal; 2652 Adjacent, AdjacentAdjacent: TVicinity8Loc; 2653 begin 2654 if Mode = moLoading_Fast then 2655 exit; 2656 ObserveMask := 3 shl (2 * p); 2657 V8_to_Loc(Loc, Adjacent); 2658 for V8 := 0 to 7 do 2659 begin 2660 Loc1 := Adjacent[V8]; 2661 if (Loc1 >= 0) and (Loc1 < MapSize) then 2662 begin 2663 Tile1 := @RW[p].Map[Loc1]; 2664 Tile1^ := Tile1^ and not fInEnemyZoC; 2665 V8_to_Loc(Loc1, AdjacentAdjacent); 2666 for V8V8 := 0 to 7 do 2667 begin 2668 Loc2 := AdjacentAdjacent[V8V8]; 2669 if (Loc2 >= 0) and (Loc2 < MapSize) and (ZoCMap[Loc2] > 0) and 2670 (ObserveLevel[Loc2] and ObserveMask <> 0) then 2671 begin 2672 p1 := Occupant[Loc2]; 2673 assert(p1 <> nPl); 2674 if (p1 <> p) and (RW[p].Treaty[p1] < trAlliance) then 2675 begin 2676 Tile1^ := Tile1^ or fInEnemyZoC; 2677 Break 2678 end 2679 end 2680 end; 2681 end 2682 end 2683 end; 2684 2685 procedure RecalcMapZoC(p: integer); 2686 // recalculate fInEnemyZoC flags for the whole map 2687 var 2688 Loc, Loc1, V8, p1, ObserveMask: integer; 2689 Adjacent: TVicinity8Loc; 2690 begin 2691 if Mode = moLoading_Fast then 2692 exit; 2693 MaskD(RW[p].Map^, MapSize, not Cardinal(fInEnemyZoC)); 2694 ObserveMask := 3 shl (2 * p); 2695 for Loc := 0 to MapSize - 1 do 2696 if (ZoCMap[Loc] > 0) and (ObserveLevel[Loc] and ObserveMask <> 0) then 2697 begin 2698 p1 := Occupant[Loc]; 2699 assert(p1 <> nPl); 2700 if (p1 <> p) and (RW[p].Treaty[p1] < trAlliance) then 2701 begin // this non-allied enemy ZoC unit is known to this player -- set flags! 2702 V8_to_Loc(Loc, Adjacent); 2703 for V8 := 0 to 7 do 2704 begin 2705 Loc1 := Adjacent[V8]; 2706 if (Loc1 >= 0) and (Loc1 < MapSize) then 2707 RW[p].Map[Loc1] := RW[p].Map[Loc1] or fInEnemyZoC 2708 end 2709 end 2710 end 2711 end; 2712 2365 2713 procedure RecalcPeaceMap(p: integer); 2366 2714 // recalculate fPeace flags for the whole map 2367 2715 var 2368 Loc,p1: integer;2369 PeacePlayer: array[-1..nPl-1] of boolean;2370 begin 2371 if Mode<>moPlaying then exit; 2372 MaskD(RW[p].Map^,MapSize,not Cardinal(fPeace));2373 for p1:=-1 to nPl-1 do 2374 PeacePlayer[p1]:= (p1>=0) and (p1<>p) and (1 shl p1 and GAlive<>0)2375 and (RW[p].Treaty[p1] in [trPeace,trFriendlyContact]);2376 for Loc:=0 to MapSize-1 do 2377 if PeacePlayer[RW[p].Territory[Loc]] then2378 RW[p].Map[Loc]:=RW[p].Map[Loc] or fPeace2379 end; 2380 2716 Loc, p1: integer; 2717 PeacePlayer: array [-1 .. nPl - 1] of boolean; 2718 begin 2719 if Mode <> moPlaying then 2720 exit; 2721 MaskD(RW[p].Map^, MapSize, not Cardinal(fPeace)); 2722 for p1 := -1 to nPl - 1 do 2723 PeacePlayer[p1] := (p1 >= 0) and (p1 <> p) and (1 shl p1 and GAlive <> 0) 2724 and (RW[p].Treaty[p1] in [trPeace, TrFriendlyContact]); 2725 for Loc := 0 to MapSize - 1 do 2726 if PeacePlayer[RW[p].Territory[Loc]] then 2727 RW[p].Map[Loc] := RW[p].Map[Loc] or fPeace 2728 end; 2381 2729 2382 2730 { 2383 2384 ____________________________________________________________________2731 Territory Calculation 2732 ____________________________________________________________________ 2385 2733 } 2386 2734 var 2387 BorderChanges: array[0..sIntExpandTerritory and $F-1] of Cardinal;2735 BorderChanges: array [0 .. sIntExpandTerritory and $F - 1] of Cardinal; 2388 2736 2389 2737 procedure ChangeTerritory(Loc, p: integer); 2390 2738 var 2391 p1: integer; 2392 begin 2393 assert(p>=0); // no player's territory indicated by p=nPl 2394 dec(TerritoryCount[RealMap[Loc] shr 27]); 2395 inc(TerritoryCount[p]); 2396 RealMap[Loc]:=RealMap[Loc] and not ($F shl 27) or Cardinal(p) shl 27; 2397 if p=$F then p:=-1; 2398 for p1:=0 to nPl-1 do if 1 shl p1 and (GAlive or GWatching)<>0 then 2399 if RW[p1].Map[Loc] and fTerrain<>fUNKNOWN then 2400 begin 2401 RW[p1].Territory[Loc]:=p; 2402 if (p<nPl) and (p<>p1) and (1 shl p and GAlive<>0) 2403 and (RW[p1].Treaty[p] in [trPeace,trFriendlyContact]) then 2404 RW[p1].Map[Loc]:=RW[p1].Map[Loc] or fPeace 2405 else RW[p1].Map[Loc]:=RW[p1].Map[Loc] and not fPeace; 2406 end 2739 p1: integer; 2740 begin 2741 assert(p >= 0); // no player's territory indicated by p=nPl 2742 dec(TerritoryCount[RealMap[Loc] shr 27]); 2743 inc(TerritoryCount[p]); 2744 RealMap[Loc] := RealMap[Loc] and not($F shl 27) or Cardinal(p) shl 27; 2745 if p = $F then 2746 p := -1; 2747 for p1 := 0 to nPl - 1 do 2748 if 1 shl p1 and (GAlive or GWatching) <> 0 then 2749 if RW[p1].Map[Loc] and fTerrain <> fUNKNOWN then 2750 begin 2751 RW[p1].Territory[Loc] := p; 2752 if (p < nPl) and (p <> p1) and (1 shl p and GAlive <> 0) and 2753 (RW[p1].Treaty[p] in [trPeace, TrFriendlyContact]) then 2754 RW[p1].Map[Loc] := RW[p1].Map[Loc] or fPeace 2755 else 2756 RW[p1].Map[Loc] := RW[p1].Map[Loc] and not fPeace; 2757 end 2407 2758 end; 2408 2759 2409 2760 procedure ExpandTerritory(OriginLoc: integer); 2410 2761 var 2411 i,dx,dy,dxMax,dyMax,Loc,NewOwner: integer; 2412 begin 2413 i:=0; 2414 dyMax:=0; 2415 while (dyMax+1)+(dyMax+1) shr 1<=CountryRadius do 2416 inc(dyMax); 2417 for dy:=-dyMax to dyMax do 2418 begin 2419 dxMax:=dy and 1; 2420 while abs(dy)+(dxMax+2)+abs(abs(dy)-(dxMax+2)) shr 1<=CountryRadius do 2421 inc(dxMax,2); 2422 for dx:=-dxMax to dxMax do if (dy+dx) and 1=0 then 2423 begin 2424 NewOwner:=BorderChanges[i div 8] shr (i mod 8 *4) and $F; 2425 Loc:=dLoc(OriginLoc,dx,dy); 2426 if (Loc>=0) and (Cardinal(NewOwner)<>RealMap[Loc] shr 27) then 2427 ChangeTerritory(Loc,NewOwner); 2428 inc(i); 2429 end 2762 i, dx, dy, dxMax, dyMax, Loc, NewOwner: integer; 2763 begin 2764 i := 0; 2765 dyMax := 0; 2766 while (dyMax + 1) + (dyMax + 1) shr 1 <= CountryRadius do 2767 inc(dyMax); 2768 for dy := -dyMax to dyMax do 2769 begin 2770 dxMax := dy and 1; 2771 while abs(dy) + (dxMax + 2) + abs(abs(dy) - (dxMax + 2)) shr 1 <= 2772 CountryRadius do 2773 inc(dxMax, 2); 2774 for dx := -dxMax to dxMax do 2775 if (dy + dx) and 1 = 0 then 2776 begin 2777 NewOwner := BorderChanges[i div 8] shr (i mod 8 * 4) and $F; 2778 Loc := dLoc(OriginLoc, dx, dy); 2779 if (Loc >= 0) and (Cardinal(NewOwner) <> RealMap[Loc] shr 27) then 2780 ChangeTerritory(Loc, NewOwner); 2781 inc(i); 2782 end 2430 2783 end 2431 2784 end; … … 2433 2786 procedure CheckBorders(OriginLoc, PlayerLosingCity: integer); 2434 2787 // OriginLoc: only changes in CountryRadius around this location possible, 2435 // 2788 // -1 for complete map, -2 for double-check (no more changes allowed) 2436 2789 // PlayerLosingCity: do nothing but remove tiles no longer in reach from this 2437 // player's territory, -1 for full border recalculation 2438 var 2439 i,r,Loc,Loc1,dx,dy,p1,p2,cix,NewDist,dxMax,dyMax,OldOwner,V8, 2440 NewOwner: integer; 2441 Adjacent: TVicinity8Loc; 2442 AtPeace: array[0..nPl,0..nPl] of boolean; 2443 Country, FormerCountry, {to who's country a tile belongs} 2444 Dist, FormerDist, StolenDist: array[0..lxmax*lymax-1] of ShortInt; 2445 begin 2446 if PlayerLosingCity>=0 then 2447 begin 2448 for Loc:=0 to MapSize-1 do StolenDist[Loc]:=CountryRadius+1; 2449 for cix:=0 to RW[PlayerLosingCity].nCity-1 do 2450 if RW[PlayerLosingCity].City[cix].Loc>=0 then 2451 StolenDist[RW[PlayerLosingCity].City[cix].Loc]:=0; 2452 2453 for r:=1 to CountryRadius shr 1 do 2454 begin 2455 move(StolenDist,FormerDist,MapSize); 2456 for Loc:=0 to MapSize-1 do 2457 if (FormerDist[Loc]<=CountryRadius-2) // use same conditions as below! 2458 and ((1 shl (RealMap[Loc] and fTerrain)) 2459 and (1 shl fShore+1 shl fMountains+1 shl fArctic)=0) then 2460 begin 2461 V8_to_Loc(Loc,Adjacent); 2462 for V8:=0 to 7 do 2790 // player's territory, -1 for full border recalculation 2791 var 2792 i, r, Loc, Loc1, dx, dy, p1, p2, cix, NewDist, dxMax, dyMax, OldOwner, V8, 2793 NewOwner: integer; 2794 Adjacent: TVicinity8Loc; 2795 AtPeace: array [0 .. nPl, 0 .. nPl] of boolean; 2796 Country, FormerCountry, { to who's country a tile belongs } 2797 Dist, FormerDist, StolenDist: array [0 .. lxmax * lymax - 1] of ShortInt; 2798 begin 2799 if PlayerLosingCity >= 0 then 2800 begin 2801 for Loc := 0 to MapSize - 1 do 2802 StolenDist[Loc] := CountryRadius + 1; 2803 for cix := 0 to RW[PlayerLosingCity].nCity - 1 do 2804 if RW[PlayerLosingCity].City[cix].Loc >= 0 then 2805 StolenDist[RW[PlayerLosingCity].City[cix].Loc] := 0; 2806 2807 for r := 1 to CountryRadius shr 1 do 2808 begin 2809 move(StolenDist, FormerDist, MapSize); 2810 for Loc := 0 to MapSize - 1 do 2811 if (FormerDist[Loc] <= CountryRadius - 2) 2812 // use same conditions as below! 2813 and ((1 shl (RealMap[Loc] and fTerrain)) and 2814 (1 shl fShore + 1 shl fMountains + 1 shl fArctic) = 0) then 2815 begin 2816 V8_to_Loc(Loc, Adjacent); 2817 for V8 := 0 to 7 do 2463 2818 begin 2464 Loc1:=Adjacent[V8]; 2465 NewDist:=FormerDist[Loc]+2+V8 and 1; 2466 if (Loc1>=0) and (Loc1<MapSize) and (NewDist<StolenDist[Loc1]) then 2467 StolenDist[Loc1]:=NewDist; 2819 Loc1 := Adjacent[V8]; 2820 NewDist := FormerDist[Loc] + 2 + V8 and 1; 2821 if (Loc1 >= 0) and (Loc1 < MapSize) and (NewDist < StolenDist[Loc1]) 2822 then 2823 StolenDist[Loc1] := NewDist; 2468 2824 end 2469 2825 end … … 2471 2827 end; 2472 2828 2473 FillChar(Country,MapSize,-1); 2474 for Loc:=0 to MapSize-1 do Dist[Loc]:=CountryRadius+1; 2475 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 2476 for cix:=0 to RW[p1].nCity-1 do if RW[p1].City[cix].Loc>=0 then 2477 begin 2478 Country[RW[p1].City[cix].Loc]:=p1; 2479 Dist[RW[p1].City[cix].Loc]:=0; 2480 end; 2481 2482 for r:=1 to CountryRadius shr 1 do 2483 begin 2484 move(Country,FormerCountry,MapSize); 2485 move(Dist,FormerDist,MapSize); 2486 for Loc:=0 to MapSize-1 do 2487 if (FormerDist[Loc]<=CountryRadius-2) // use same conditions as above! 2488 and ((1 shl (RealMap[Loc] and fTerrain)) 2489 and (1 shl fShore+1 shl fMountains+1 shl fArctic)=0) then 2490 begin 2491 assert(FormerCountry[Loc]>=0); 2492 V8_to_Loc(Loc,Adjacent); 2493 for V8:=0 to 7 do 2494 begin 2495 Loc1:=Adjacent[V8]; 2496 NewDist:=FormerDist[Loc]+2+V8 and 1; 2497 if (Loc1>=0) and (Loc1<MapSize) and (NewDist<Dist[Loc1]) then 2829 FillChar(Country, MapSize, -1); 2830 for Loc := 0 to MapSize - 1 do 2831 Dist[Loc] := CountryRadius + 1; 2832 for p1 := 0 to nPl - 1 do 2833 if 1 shl p1 and GAlive <> 0 then 2834 for cix := 0 to RW[p1].nCity - 1 do 2835 if RW[p1].City[cix].Loc >= 0 then 2836 begin 2837 Country[RW[p1].City[cix].Loc] := p1; 2838 Dist[RW[p1].City[cix].Loc] := 0; 2839 end; 2840 2841 for r := 1 to CountryRadius shr 1 do 2842 begin 2843 move(Country, FormerCountry, MapSize); 2844 move(Dist, FormerDist, MapSize); 2845 for Loc := 0 to MapSize - 1 do 2846 if (FormerDist[Loc] <= CountryRadius - 2) // use same conditions as above! 2847 and ((1 shl (RealMap[Loc] and fTerrain)) and 2848 (1 shl fShore + 1 shl fMountains + 1 shl fArctic) = 0) then 2849 begin 2850 assert(FormerCountry[Loc] >= 0); 2851 V8_to_Loc(Loc, Adjacent); 2852 for V8 := 0 to 7 do 2853 begin 2854 Loc1 := Adjacent[V8]; 2855 NewDist := FormerDist[Loc] + 2 + V8 and 1; 2856 if (Loc1 >= 0) and (Loc1 < MapSize) and (NewDist < Dist[Loc1]) then 2498 2857 begin 2499 Country[Loc1]:=FormerCountry[Loc];2500 Dist[Loc1]:=NewDist;2858 Country[Loc1] := FormerCountry[Loc]; 2859 Dist[Loc1] := NewDist; 2501 2860 end 2502 2861 end … … 2504 2863 end; 2505 2864 2506 FillChar(AtPeace, sizeof(AtPeace), false); 2507 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 2508 for p2:=0 to nPl-1 do 2509 if (p2<>p1) and (1 shl p2 and GAlive<>0) and (RW[p1].Treaty[p2]>=trPeace) then 2510 AtPeace[p1,p2]:=true; 2511 2512 if OriginLoc>=0 then 2865 FillChar(AtPeace, SizeOf(AtPeace), false); 2866 for p1 := 0 to nPl - 1 do 2867 if 1 shl p1 and GAlive <> 0 then 2868 for p2 := 0 to nPl - 1 do 2869 if (p2 <> p1) and (1 shl p2 and GAlive <> 0) and 2870 (RW[p1].Treaty[p2] >= trPeace) then 2871 AtPeace[p1, p2] := true; 2872 2873 if OriginLoc >= 0 then 2513 2874 begin // update area only 2514 i:=0; 2515 fillchar(BorderChanges, sizeof(BorderChanges), 0); 2516 dyMax:=0; 2517 while (dyMax+1)+(dyMax+1) shr 1<=CountryRadius do 2518 inc(dyMax); 2519 for dy:=-dyMax to dyMax do 2520 begin 2521 dxMax:=dy and 1; 2522 while abs(dy)+(dxMax+2)+abs(abs(dy)-(dxMax+2)) shr 1<=CountryRadius do 2523 inc(dxMax,2); 2524 for dx:=-dxMax to dxMax do if (dy+dx) and 1=0 then 2525 begin 2526 Loc:=dLoc(OriginLoc,dx,dy); 2527 if Loc>=0 then 2528 begin 2529 OldOwner:=RealMap[Loc] shr 27; 2530 NewOwner:=Country[Loc] and $f; 2531 if NewOwner<>OldOwner then 2532 if AtPeace[NewOwner,OldOwner] 2533 and not ((OldOwner=PlayerLosingCity) and (StolenDist[Loc]>CountryRadius)) then 2534 NewOwner:=OldOwner // peace fixes borders 2535 else ChangeTerritory(Loc,NewOwner); 2536 inc(BorderChanges[i div 8],NewOwner shl (i mod 8 *4)); 2537 end; 2538 inc(i); 2539 end 2875 i := 0; 2876 FillChar(BorderChanges, SizeOf(BorderChanges), 0); 2877 dyMax := 0; 2878 while (dyMax + 1) + (dyMax + 1) shr 1 <= CountryRadius do 2879 inc(dyMax); 2880 for dy := -dyMax to dyMax do 2881 begin 2882 dxMax := dy and 1; 2883 while abs(dy) + (dxMax + 2) + abs(abs(dy) - (dxMax + 2)) shr 1 <= 2884 CountryRadius do 2885 inc(dxMax, 2); 2886 for dx := -dxMax to dxMax do 2887 if (dy + dx) and 1 = 0 then 2888 begin 2889 Loc := dLoc(OriginLoc, dx, dy); 2890 if Loc >= 0 then 2891 begin 2892 OldOwner := RealMap[Loc] shr 27; 2893 NewOwner := Country[Loc] and $F; 2894 if NewOwner <> OldOwner then 2895 if AtPeace[NewOwner, OldOwner] and 2896 not((OldOwner = PlayerLosingCity) and 2897 (StolenDist[Loc] > CountryRadius)) then 2898 NewOwner := OldOwner // peace fixes borders 2899 else 2900 ChangeTerritory(Loc, NewOwner); 2901 inc(BorderChanges[i div 8], NewOwner shl (i mod 8 * 4)); 2902 end; 2903 inc(i); 2904 end 2540 2905 end 2541 2906 end 2542 else for Loc:=0 to MapSize-1 do // update complete map 2543 begin 2544 OldOwner:=RealMap[Loc] shr 27; 2545 NewOwner:=Country[Loc] and $f; 2546 if (NewOwner<>OldOwner) 2547 and (not AtPeace[NewOwner,OldOwner] 2548 or ((OldOwner=PlayerLosingCity) and (StolenDist[Loc]>CountryRadius))) then 2549 begin 2550 assert(OriginLoc<>-2); // test if border saving works 2551 ChangeTerritory(Loc,NewOwner); 2552 end; 2553 end; 2554 2555 {$IFOPT O-}if OriginLoc<>-2 then CheckBorders(-2);{$ENDIF} //check: single pass should do! 2556 end; //CheckBorders 2557 2558 procedure LogCheckBorders(p,cix,PlayerLosingCity: integer); 2559 begin 2560 CheckBorders(RW[p].City[cix].Loc,PlayerLosingCity); 2561 IntServer(sIntExpandTerritory,p,cix,BorderChanges); 2907 else 2908 for Loc := 0 to MapSize - 1 do // update complete map 2909 begin 2910 OldOwner := RealMap[Loc] shr 27; 2911 NewOwner := Country[Loc] and $F; 2912 if (NewOwner <> OldOwner) and (not AtPeace[NewOwner, OldOwner] or 2913 ((OldOwner = PlayerLosingCity) and (StolenDist[Loc] > CountryRadius))) 2914 then 2915 begin 2916 assert(OriginLoc <> -2); // test if border saving works 2917 ChangeTerritory(Loc, NewOwner); 2918 end; 2919 end; 2920 2921 {$IFOPT O-} if OriginLoc <> -2 then 2922 CheckBorders(-2); {$ENDIF} // check: single pass should do! 2923 end; // CheckBorders 2924 2925 procedure LogCheckBorders(p, cix, PlayerLosingCity: integer); 2926 begin 2927 CheckBorders(RW[p].City[cix].Loc, PlayerLosingCity); 2928 IntServer(sIntExpandTerritory, p, cix, BorderChanges); 2562 2929 end; 2563 2930 2564 2931 { 2565 2566 ____________________________________________________________________2932 Map Processing 2933 ____________________________________________________________________ 2567 2934 } 2568 2935 2569 procedure CreateUnit(p,mix: integer); 2570 begin 2571 with RW[p] do 2572 begin 2573 Un[nUn].mix:=mix; 2574 with Un[nUn] do 2575 begin 2576 ID:=UnBuilt[p]; 2577 inc(UnBuilt[p]); 2578 Status:=0; 2579 SavedStatus:=0; 2580 inc(Model[mix].Built); 2581 Home:=-1; 2582 Health:=100; 2583 Flags:=0; 2584 Movement:=0; 2585 if Model[mix].Domain=dAir then 2586 begin 2587 Fuel:=Model[mix].Cap[mcFuel]; 2588 Flags:=Flags or unBombsLoaded 2589 end; 2590 Job:=jNone; 2591 Exp:=ExpCost shr 1; 2592 TroopLoad:=0; AirLoad:=0; Master:=-1; 2593 end; 2594 inc(nUn); 2936 procedure CreateUnit(p, mix: integer); 2937 begin 2938 with RW[p] do 2939 begin 2940 Un[nUn].mix := mix; 2941 with Un[nUn] do 2942 begin 2943 ID := UnBuilt[p]; 2944 inc(UnBuilt[p]); 2945 Status := 0; 2946 SavedStatus := 0; 2947 inc(Model[mix].Built); 2948 Home := -1; 2949 Health := 100; 2950 Flags := 0; 2951 Movement := 0; 2952 if Model[mix].Domain = dAir then 2953 begin 2954 Fuel := Model[mix].Cap[mcFuel]; 2955 Flags := Flags or unBombsLoaded 2956 end; 2957 Job := jNone; 2958 exp := ExpCost shr 1; 2959 TroopLoad := 0; 2960 AirLoad := 0; 2961 Master := -1; 2962 end; 2963 inc(nUn); 2595 2964 end 2596 2965 end; 2597 2966 2598 procedure FreeUnit(p, uix: integer);2967 procedure FreeUnit(p, uix: integer); 2599 2968 // loc or master should be set after call 2600 2969 // implementation is critical for loading performance, change carefully 2601 2970 var 2602 Loc0, uix1: integer; 2603 Occ, ZoC: boolean; 2604 begin 2605 with RW[p].Un[uix] do 2606 begin 2607 Job:=jNone; 2608 Flags:=Flags and not (unFortified or unMountainDelay); 2609 Loc0:=Loc 2610 end; 2611 if Occupant[Loc0]>=0 then 2612 begin 2613 assert(Occupant[Loc0]=p); 2614 Occ:=false; 2615 ZoC:=false; 2616 for uix1:=0 to RW[p].nUn-1 do with RW[p].Un[uix1] do 2617 if (Loc=Loc0) and (Master<0) and (uix1<>uix) then 2618 begin 2619 Occ:=true; 2620 if RW[p].Model[mix].Flags and mdZOC<>0 then 2621 begin ZoC:=true; Break end 2622 end; 2623 if not Occ then Occupant[Loc0]:=-1; 2624 if not ZoC then ZoCMap[Loc0]:=0; 2625 end; 2626 end; 2627 2628 procedure PlaceUnit(p,uix: integer); 2629 begin 2630 with RW[p].Un[uix] do 2631 begin 2632 Occupant[Loc]:=p; 2633 if RW[p].Model[mix].Flags and mdZOC<>0 then ZoCMap[Loc]:=1; 2971 Loc0, uix1: integer; 2972 Occ, ZoC: boolean; 2973 begin 2974 with RW[p].Un[uix] do 2975 begin 2976 Job := jNone; 2977 Flags := Flags and not(unFortified or unMountainDelay); 2978 Loc0 := Loc 2979 end; 2980 if Occupant[Loc0] >= 0 then 2981 begin 2982 assert(Occupant[Loc0] = p); 2983 Occ := false; 2984 ZoC := false; 2985 for uix1 := 0 to RW[p].nUn - 1 do 2986 with RW[p].Un[uix1] do 2987 if (Loc = Loc0) and (Master < 0) and (uix1 <> uix) then 2988 begin 2989 Occ := true; 2990 if RW[p].Model[mix].Flags and mdZOC <> 0 then 2991 begin 2992 ZoC := true; 2993 Break 2994 end 2995 end; 2996 if not Occ then 2997 Occupant[Loc0] := -1; 2998 if not ZoC then 2999 ZoCMap[Loc0] := 0; 3000 end; 3001 end; 3002 3003 procedure PlaceUnit(p, uix: integer); 3004 begin 3005 with RW[p].Un[uix] do 3006 begin 3007 Occupant[Loc] := p; 3008 if RW[p].Model[mix].Flags and mdZOC <> 0 then 3009 ZoCMap[Loc] := 1; 2634 3010 end 2635 3011 end; … … 2637 3013 procedure CountLost(p, mix, Enemy: integer); 2638 3014 begin 2639 inc(RW[p].Model[mix].Lost);2640 TellAboutModel(Enemy,p,mix);2641 inc(Destroyed[Enemy,p,mix]);2642 end; 2643 2644 procedure RemoveUnit(p, uix: integer; Enemy: integer = -1);3015 inc(RW[p].Model[mix].Lost); 3016 TellAboutModel(Enemy, p, mix); 3017 inc(Destroyed[Enemy, p, mix]); 3018 end; 3019 3020 procedure RemoveUnit(p, uix: integer; Enemy: integer = -1); 2645 3021 // use enemy only from inside sMoveUnit if attack 2646 3022 var 2647 uix1: integer; 2648 begin 2649 with RW[p].Un[uix] do 2650 begin 2651 assert((Loc>=0) or (RW[p].Model[mix].Kind=mkDiplomat)); // already freed when spy mission 2652 if Loc>=0 then 2653 FreeUnit(p,uix); 2654 if Master>=0 then 2655 if RW[p].Model[mix].Domain=dAir then dec(RW[p].Un[Master].AirLoad) 2656 else dec(RW[p].Un[Master].TroopLoad); 2657 if (TroopLoad>0) or (AirLoad>0) then 2658 for uix1:=0 to RW[p].nUn-1 do 2659 if (RW[p].Un[uix1].Loc>=0) and (RW[p].Un[uix1].Master=uix) then 2660 {unit mastered by removed unit -- remove too} 2661 begin 2662 RW[p].Un[uix1].Loc:=-1; 2663 if Enemy>=0 then CountLost(p,RW[p].Un[uix1].mix,Enemy); 3023 uix1: integer; 3024 begin 3025 with RW[p].Un[uix] do 3026 begin 3027 assert((Loc >= 0) or (RW[p].Model[mix].Kind = mkDiplomat)); 3028 // already freed when spy mission 3029 if Loc >= 0 then 3030 FreeUnit(p, uix); 3031 if Master >= 0 then 3032 if RW[p].Model[mix].Domain = dAir then 3033 dec(RW[p].Un[Master].AirLoad) 3034 else 3035 dec(RW[p].Un[Master].TroopLoad); 3036 if (TroopLoad > 0) or (AirLoad > 0) then 3037 for uix1 := 0 to RW[p].nUn - 1 do 3038 if (RW[p].Un[uix1].Loc >= 0) and (RW[p].Un[uix1].Master = uix) then 3039 { unit mastered by removed unit -- remove too } 3040 begin 3041 RW[p].Un[uix1].Loc := -1; 3042 if Enemy >= 0 then 3043 CountLost(p, RW[p].Un[uix1].mix, Enemy); 2664 3044 end; 2665 Loc:=-1; 2666 if Enemy>=0 then CountLost(p,mix,Enemy); 3045 Loc := -1; 3046 if Enemy >= 0 then 3047 CountLost(p, mix, Enemy); 2667 3048 end 2668 end;{RemoveUnit} 2669 2670 procedure RemoveUnit_UpdateMap(p,uix: integer); 2671 var 2672 Loc0: integer; 2673 begin 2674 Loc0:=RW[p].Un[uix].Loc; 2675 RemoveUnit(p,uix); 2676 if Mode>moLoading_Fast then UpdateUnitMap(Loc0); 2677 end; 2678 2679 procedure RemoveAllUnits(p,Loc: integer; Enemy: integer = -1); 2680 var 2681 uix: integer; 2682 begin 2683 for uix:=0 to RW[p].nUn-1 do 2684 if RW[p].Un[uix].Loc=Loc then 2685 begin 2686 if Enemy>=0 then CountLost(p,RW[p].Un[uix].mix,Enemy); 2687 RW[p].Un[uix].Loc:=-1 2688 end; 2689 Occupant[Loc]:=-1; 2690 ZoCMap[Loc]:=0; 2691 end; 2692 2693 procedure RemoveDomainUnits(d,p,Loc: integer); 2694 var 2695 uix: integer; 2696 begin 2697 for uix:=0 to RW[p].nUn-1 do 2698 if (RW[p].Model[RW[p].Un[uix].mix].Domain=d) and (RW[p].Un[uix].Loc=Loc) then 2699 RemoveUnit(p,uix); 2700 end; 2701 2702 procedure FoundCity(p,FoundLoc: integer); 2703 var 2704 p1,cix1,V21,dx,dy: integer; 2705 begin 2706 if RW[p].nCity=ncmax then exit; 2707 inc(RW[p].nCity); 2708 with RW[p].City[RW[p].nCity-1] do 2709 begin 2710 Size:=2; 2711 Status:=0; 2712 SavedStatus:=0; 2713 FillChar(Built,SizeOf(Built),0); 2714 Food:=0; 2715 Project:=cpImp+imTrGoods; 2716 Prod:=0; 2717 Project0:=Project; 2718 Prod0:=0; 2719 Pollution:=0; 2720 N1:=0; 2721 Loc:=FoundLoc; 2722 if UsedByCity[FoundLoc]>=0 then 2723 begin {central tile is exploited - toggle in exploiting city} 2724 p1:=p; 2725 SearchCity(UsedByCity[FoundLoc],p1,cix1); 2726 dxdy(UsedByCity[FoundLoc],FoundLoc,dx,dy); 2727 V21:=(dy+3) shl 2+(dx+3) shr 1; 2728 RW[p1].City[cix1].Tiles:=RW[p1].City[cix1].Tiles and not (1 shl V21); 2729 end; 2730 Tiles:=1 shl 13; {exploit central tile} 2731 UsedByCity[FoundLoc]:=FoundLoc; 2732 RealMap[FoundLoc]:=RealMap[FoundLoc] 2733 and (fTerrain or fSpecial or fRiver or nPl shl 27) or fCity; 2734 2735 ChangeTerritory(Loc,p) 2736 end; 2737 end; {FoundCity} 2738 2739 procedure StealCity(p,cix: integer; SaveUnits: boolean); 2740 var 2741 i,j,uix1,cix1,nearest: integer; 2742 begin 2743 for i:=0 to 27 do 2744 if RW[p].City[cix].Built[i]=1 then 2745 begin 2746 GWonder[i].EffectiveOwner:=-1; 2747 if i=woPyramids then FreeSlaves; 2748 if i=woEiffel then // deactivate expired wonders 2749 for j:=0 to 27 do if GWonder[j].EffectiveOwner=p then 2750 CheckExpiration(j); 2751 end; 2752 for i:=28 to nImp-1 do 2753 if (Imp[i].Kind<>ikCommon) and (RW[p].City[cix].Built[i]>0) then 2754 begin {destroy national projects} 2755 RW[p].NatBuilt[i]:=0; 2756 if i=imGrWall then GrWallContinent[p]:=-1; 2757 end; 2758 2759 for uix1:=0 to RW[p].nUn-1 do with RW[p].Un[uix1] do 2760 if (Loc>=0) and (Home=cix) then 2761 if SaveUnits then 2762 begin // support units by nearest other city 2763 nearest:=-1; 2764 for cix1:=0 to RW[p].nCity-1 do 2765 if (cix1<>cix) and (RW[p].City[cix1].Loc>=0) 2766 and ((nearest<0) or (Distance(RW[p].City[cix1].Loc,Loc) 2767 <Distance(RW[p].City[nearest].Loc,Loc))) then 2768 nearest:=cix1; 2769 Home:=nearest 3049 end; { RemoveUnit } 3050 3051 procedure RemoveUnit_UpdateMap(p, uix: integer); 3052 var 3053 Loc0: integer; 3054 begin 3055 Loc0 := RW[p].Un[uix].Loc; 3056 RemoveUnit(p, uix); 3057 if Mode > moLoading_Fast then 3058 UpdateUnitMap(Loc0); 3059 end; 3060 3061 procedure RemoveAllUnits(p, Loc: integer; Enemy: integer = -1); 3062 var 3063 uix: integer; 3064 begin 3065 for uix := 0 to RW[p].nUn - 1 do 3066 if RW[p].Un[uix].Loc = Loc then 3067 begin 3068 if Enemy >= 0 then 3069 CountLost(p, RW[p].Un[uix].mix, Enemy); 3070 RW[p].Un[uix].Loc := -1 3071 end; 3072 Occupant[Loc] := -1; 3073 ZoCMap[Loc] := 0; 3074 end; 3075 3076 procedure RemoveDomainUnits(d, p, Loc: integer); 3077 var 3078 uix: integer; 3079 begin 3080 for uix := 0 to RW[p].nUn - 1 do 3081 if (RW[p].Model[RW[p].Un[uix].mix].Domain = d) and (RW[p].Un[uix].Loc = Loc) 3082 then 3083 RemoveUnit(p, uix); 3084 end; 3085 3086 procedure FoundCity(p, FoundLoc: integer); 3087 var 3088 p1, cix1, V21, dx, dy: integer; 3089 begin 3090 if RW[p].nCity = ncmax then 3091 exit; 3092 inc(RW[p].nCity); 3093 with RW[p].City[RW[p].nCity - 1] do 3094 begin 3095 Size := 2; 3096 Status := 0; 3097 SavedStatus := 0; 3098 FillChar(Built, SizeOf(Built), 0); 3099 Food := 0; 3100 Project := cpImp + imTrGoods; 3101 Prod := 0; 3102 Project0 := Project; 3103 Prod0 := 0; 3104 Pollution := 0; 3105 N1 := 0; 3106 Loc := FoundLoc; 3107 if UsedByCity[FoundLoc] >= 0 then 3108 begin { central tile is exploited - toggle in exploiting city } 3109 p1 := p; 3110 SearchCity(UsedByCity[FoundLoc], p1, cix1); 3111 dxdy(UsedByCity[FoundLoc], FoundLoc, dx, dy); 3112 V21 := (dy + 3) shl 2 + (dx + 3) shr 1; 3113 RW[p1].City[cix1].Tiles := RW[p1].City[cix1].Tiles and not(1 shl V21); 3114 end; 3115 Tiles := 1 shl 13; { exploit central tile } 3116 UsedByCity[FoundLoc] := FoundLoc; 3117 RealMap[FoundLoc] := RealMap[FoundLoc] and 3118 (fTerrain or fSpecial or fRiver or nPl shl 27) or fCity; 3119 3120 ChangeTerritory(Loc, p) 3121 end; 3122 end; { FoundCity } 3123 3124 procedure StealCity(p, cix: integer; SaveUnits: boolean); 3125 var 3126 i, j, uix1, cix1, nearest: integer; 3127 begin 3128 for i := 0 to 27 do 3129 if RW[p].City[cix].Built[i] = 1 then 3130 begin 3131 GWonder[i].EffectiveOwner := -1; 3132 if i = woPyramids then 3133 FreeSlaves; 3134 if i = woEiffel then // deactivate expired wonders 3135 for j := 0 to 27 do 3136 if GWonder[j].EffectiveOwner = p then 3137 CheckExpiration(j); 3138 end; 3139 for i := 28 to nImp - 1 do 3140 if (Imp[i].Kind <> ikCommon) and (RW[p].City[cix].Built[i] > 0) then 3141 begin { destroy national projects } 3142 RW[p].NatBuilt[i] := 0; 3143 if i = imGrWall then 3144 GrWallContinent[p] := -1; 3145 end; 3146 3147 for uix1 := 0 to RW[p].nUn - 1 do 3148 with RW[p].Un[uix1] do 3149 if (Loc >= 0) and (Home = cix) then 3150 if SaveUnits then 3151 begin // support units by nearest other city 3152 nearest := -1; 3153 for cix1 := 0 to RW[p].nCity - 1 do 3154 if (cix1 <> cix) and (RW[p].City[cix1].Loc >= 0) and 3155 ((nearest < 0) or (Distance(RW[p].City[cix1].Loc, Loc) < 3156 Distance(RW[p].City[nearest].Loc, Loc))) then 3157 nearest := cix1; 3158 Home := nearest 3159 end 3160 else 3161 RemoveUnit(p, uix1); // destroy supported units 3162 end; // StealCity 3163 3164 procedure DestroyCity(p, cix: integer; SaveUnits: boolean); 3165 var 3166 i, V21: integer; 3167 Radius: TVicinity21Loc; 3168 begin 3169 StealCity(p, cix, SaveUnits); 3170 with RW[p].City[cix] do 3171 begin 3172 for i := 0 to 27 do 3173 if Built[i] > 0 then 3174 GWonder[i].CityID := -2; // wonder destroyed 3175 V21_to_Loc(Loc, Radius); 3176 for V21 := 1 to 26 do 3177 if 1 shl V21 and Tiles <> 0 then 3178 UsedByCity[Radius[V21]] := -1; 3179 RealMap[Loc] := RealMap[Loc] and not fCity; 3180 Loc := -1 3181 end 3182 end; // DestroyCity 3183 3184 procedure ChangeCityOwner(pOld, cixOld, pNew: integer); 3185 var 3186 i, j, cix1, Loc1, V21: integer; 3187 Radius: TVicinity21Loc; 3188 begin 3189 inc(RW[pNew].nCity); 3190 RW[pNew].City[RW[pNew].nCity - 1] := RW[pOld].City[cixOld]; 3191 StealCity(pOld, cixOld, false); 3192 RW[pOld].City[cixOld].Loc := -1; 3193 with RW[pNew].City[(RW[pNew].nCity - 1)] do 3194 begin 3195 Food := 0; 3196 Project := cpImp + imTrGoods; 3197 Prod := 0; 3198 Project0 := Project; 3199 Prod0 := 0; 3200 Status := 0; 3201 SavedStatus := 0; 3202 N1 := 0; 3203 3204 // check for siege 3205 V21_to_Loc(Loc, Radius); 3206 for V21 := 1 to 26 do 3207 if Tiles and (1 shl V21) and not(1 shl CityOwnTile) <> 0 then 3208 begin 3209 Loc1 := Radius[V21]; 3210 assert((Loc1 >= 0) and (Loc1 < MapSize) and (UsedByCity[Loc1] = Loc)); 3211 if (ZoCMap[Loc1] > 0) and (Occupant[Loc1] <> pNew) and 3212 (RW[pNew].Treaty[Occupant[Loc1]] < trAlliance) then 3213 begin // tile can't remain exploited 3214 Tiles := Tiles and not(1 shl V21); 3215 UsedByCity[Loc1] := -1; 3216 end; 3217 // don't check for siege by peace territory here, because territory 3218 // might not be up to date -- done in turn beginning anyway 3219 end; 3220 Built[imTownHall] := 0; 3221 Built[imCourt] := 0; 3222 for i := 28 to nImp - 1 do 3223 if Imp[i].Kind <> ikCommon then 3224 Built[i] := 0; { destroy national projects } 3225 for i := 0 to 27 do 3226 if Built[i] = 1 then 3227 begin // new wonder owner! 3228 GWonder[i].EffectiveOwner := pNew; 3229 if i = woEiffel then // reactivate expired wonders 3230 begin 3231 for j := 0 to 27 do 3232 if Imp[j].Expiration >= 0 then 3233 for cix1 := 0 to (RW[pNew].nCity - 1) do 3234 if RW[pNew].City[cix1].Built[j] = 1 then 3235 GWonder[j].EffectiveOwner := pNew 3236 end 3237 else 3238 CheckExpiration(i); 3239 case i of 3240 woLighthouse: 3241 CheckSpecialModels(pNew, preLighthouse); 3242 woLeo: 3243 CheckSpecialModels(pNew, preLeo); 3244 woPyramids: 3245 CheckSpecialModels(pNew, preBuilder); 3246 end; 3247 end; 3248 3249 // remove city from enemy cities 3250 // not done by Discover, because fCity still set! 3251 cix1 := RW[pNew].nEnemyCity - 1; 3252 while (cix1 >= 0) and (RW[pNew].EnemyCity[cix1].Loc <> Loc) do 3253 dec(cix1); 3254 assert(cix1 >= 0); 3255 RW[pNew].EnemyCity[cix1].Loc := -1; 3256 3257 ChangeTerritory(Loc, pNew); 3258 end; 3259 end; // ChangeCityOwner 3260 3261 procedure CompleteJob(p, Loc, Job: integer); 3262 var 3263 ChangedTerrain, p1: integer; 3264 begin 3265 assert(Job <> jCity); 3266 ChangedTerrain := -1; 3267 case Job of 3268 jRoad: 3269 RealMap[Loc] := RealMap[Loc] or fRoad; 3270 jRR: 3271 RealMap[Loc] := RealMap[Loc] and not fRoad or fRR; 3272 jClear: 3273 begin 3274 ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].ClearTerrain; 3275 RealMap[Loc] := RealMap[Loc] and not fTerrain or 3276 Cardinal(ChangedTerrain); 3277 RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or 3278 ActualSpecialTile(Loc) shl 5; 3279 end; 3280 jIrr: 3281 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiIrrigation; 3282 jFarm: 3283 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiFarm; 3284 jAfforest: 3285 begin 3286 ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].AfforestTerrain; 3287 RealMap[Loc] := RealMap[Loc] and not fTerrain or 3288 Cardinal(ChangedTerrain); 3289 RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or 3290 ActualSpecialTile(Loc) shl 5; 3291 end; 3292 jMine: 3293 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiMine; 3294 jFort: 3295 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiFort; 3296 jCanal: 3297 RealMap[Loc] := RealMap[Loc] or fCanal; 3298 jTrans: 3299 begin 3300 ChangedTerrain := Terrain[RealMap[Loc] and fTerrain].TransTerrain; 3301 RealMap[Loc] := RealMap[Loc] and not fTerrain or 3302 Cardinal(ChangedTerrain); 3303 RealMap[Loc] := RealMap[Loc] and not(3 shl 5) or 3304 ActualSpecialTile(Loc) shl 5; 3305 if not(RealMap[Loc] and fTerrain in TerrType_Canalable) then 3306 begin 3307 RemoveDomainUnits(dSea, p, Loc); 3308 RealMap[Loc] := RealMap[Loc] and not fCanal; 3309 end; 3310 end; 3311 jPoll: 3312 RealMap[Loc] := RealMap[Loc] and not fPoll; 3313 jBase: 3314 RealMap[Loc] := RealMap[Loc] and not fTerImp or tiBase; 3315 jPillage: 3316 if RealMap[Loc] and fTerImp <> 0 then 3317 begin 3318 if RealMap[Loc] and fTerImp = tiBase then 3319 RemoveDomainUnits(dAir, p, Loc); 3320 RealMap[Loc] := RealMap[Loc] and not fTerImp 2770 3321 end 2771 else RemoveUnit(p,uix1); // destroy supported units 2772 end; //StealCity 2773 2774 procedure DestroyCity(p,cix: integer; SaveUnits: boolean); 2775 var 2776 i,V21: integer; 2777 Radius: TVicinity21Loc; 2778 begin 2779 StealCity(p,cix,SaveUnits); 2780 with RW[p].City[cix] do 2781 begin 2782 for i:=0 to 27 do 2783 if Built[i]>0 then GWonder[i].CityID:=-2; // wonder destroyed 2784 V21_to_Loc(Loc,Radius); 2785 for V21:=1 to 26 do if 1 shl V21 and Tiles<>0 then 2786 UsedByCity[Radius[V21]]:=-1; 2787 RealMap[Loc]:=RealMap[Loc] and not fCity; 2788 Loc:=-1 2789 end 2790 end; //DestroyCity 2791 2792 procedure ChangeCityOwner(pOld,cixOld,pNew: integer); 2793 var 2794 i,j,cix1,Loc1,V21: integer; 2795 Radius: TVicinity21Loc; 2796 begin 2797 inc(RW[pNew].nCity); 2798 RW[pNew].City[RW[pNew].nCity-1]:=RW[pOld].City[cixOld]; 2799 StealCity(pOld,cixOld,false); 2800 RW[pOld].City[cixOld].Loc:=-1; 2801 with RW[pNew].City[(RW[pNew].nCity-1)] do 2802 begin 2803 Food:=0; 2804 Project:=cpImp+imTrGoods; 2805 Prod:=0; 2806 Project0:=Project; 2807 Prod0:=0; 2808 Status:=0; 2809 SavedStatus:=0; 2810 N1:=0; 2811 2812 // check for siege 2813 V21_to_Loc(Loc,Radius); 2814 for V21:=1 to 26 do if Tiles and (1 shl V21) and not (1 shl CityOwnTile)<>0 then 2815 begin 2816 Loc1:=Radius[V21]; 2817 assert((Loc1>=0) and (Loc1<MapSize) and (UsedByCity[Loc1]=Loc)); 2818 if (ZoCMap[Loc1]>0) and (Occupant[Loc1]<>pNew) 2819 and (RW[pNew].Treaty[Occupant[Loc1]]<trAlliance) then 2820 begin // tile can't remain exploited 2821 Tiles:=Tiles and not (1 shl V21); 2822 UsedByCity[Loc1]:=-1; 2823 end; 2824 // don't check for siege by peace territory here, because territory 2825 // might not be up to date -- done in turn beginning anyway 2826 end; 2827 Built[imTownHall]:=0; 2828 Built[imCourt]:=0; 2829 for i:=28 to nImp-1 do if Imp[i].Kind<>ikCommon then 2830 Built[i]:=0; {destroy national projects} 2831 for i:=0 to 27 do 2832 if Built[i]=1 then 2833 begin // new wonder owner! 2834 GWonder[i].EffectiveOwner:=pNew; 2835 if i=woEiffel then // reactivate expired wonders 2836 begin 2837 for j:=0 to 27 do if Imp[j].Expiration>=0 then 2838 for cix1:=0 to (RW[pNew].nCity-1) do 2839 if RW[pNew].City[cix1].Built[j]=1 then 2840 GWonder[j].EffectiveOwner:=pNew 2841 end 2842 else CheckExpiration(i); 2843 case i of 2844 woLighthouse: CheckSpecialModels(pNew,preLighthouse); 2845 woLeo: CheckSpecialModels(pNew,preLeo); 2846 woPyramids: CheckSpecialModels(pNew,preBuilder); 2847 end; 2848 end; 2849 2850 // remove city from enemy cities 2851 // not done by Discover, because fCity still set! 2852 cix1:=RW[pNew].nEnemyCity-1; 2853 while (cix1>=0) and (RW[pNew].EnemyCity[cix1].Loc<>Loc) do dec(cix1); 2854 assert(cix1>=0); 2855 RW[pNew].EnemyCity[cix1].Loc:=-1; 2856 2857 ChangeTerritory(Loc,pNew); 2858 end; 2859 end; //ChangeCityOwner 2860 2861 procedure CompleteJob(p,Loc,Job: integer); 2862 var 2863 ChangedTerrain,p1: integer; 2864 begin 2865 assert(Job<>jCity); 2866 ChangedTerrain:=-1; 2867 case Job of 2868 jRoad: 2869 RealMap[Loc]:=RealMap[Loc] or fRoad; 2870 jRR: 2871 RealMap[Loc]:=RealMap[Loc] and not fRoad or fRR; 2872 jClear: 2873 begin 2874 ChangedTerrain:=Terrain[RealMap[Loc] and fTerrain].ClearTerrain; 2875 RealMap[Loc]:=RealMap[Loc] and not fTerrain or Cardinal(ChangedTerrain); 2876 RealMap[Loc]:=RealMap[Loc] and not (3 shl 5) or ActualSpecialTile(Loc) shl 5; 2877 end; 2878 jIrr: 2879 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiIrrigation; 2880 jFarm: 2881 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiFarm; 2882 jAfforest: 2883 begin 2884 ChangedTerrain:=Terrain[RealMap[Loc] and fTerrain].AfforestTerrain; 2885 RealMap[Loc]:=RealMap[Loc] and not fTerrain or Cardinal(ChangedTerrain); 2886 RealMap[Loc]:=RealMap[Loc] and not (3 shl 5) or ActualSpecialTile(Loc) shl 5; 2887 end; 2888 jMine: 2889 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiMine; 2890 jFort: 2891 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiFort; 2892 jCanal: 2893 RealMap[Loc]:=RealMap[Loc] or fCanal; 2894 jTrans: 2895 begin 2896 ChangedTerrain:=Terrain[RealMap[Loc] and fTerrain].TransTerrain; 2897 RealMap[Loc]:=RealMap[Loc] and not fTerrain or Cardinal(ChangedTerrain); 2898 RealMap[Loc]:=RealMap[Loc] and not (3 shl 5) or ActualSpecialTile(Loc) shl 5; 2899 if not (RealMap[Loc] and fTerrain in TerrType_Canalable) then 2900 begin 2901 RemoveDomainUnits(dSea,p,Loc); 2902 RealMap[Loc]:=RealMap[Loc] and not fCanal; 2903 end; 2904 end; 2905 jPoll: 2906 RealMap[Loc]:=RealMap[Loc] and not fPoll; 2907 jBase: 2908 RealMap[Loc]:=RealMap[Loc] and not fTerImp or tiBase; 2909 jPillage: 2910 if RealMap[Loc] and fTerImp<>0 then 2911 begin 2912 if RealMap[Loc] and fTerImp=tiBase then 2913 RemoveDomainUnits(dAir,p,Loc); 2914 RealMap[Loc]:=RealMap[Loc] and not fTerImp 3322 else if RealMap[Loc] and fCanal <> 0 then 3323 begin 3324 RemoveDomainUnits(dSea, p, Loc); 3325 RealMap[Loc] := RealMap[Loc] and not fCanal 2915 3326 end 2916 else if RealMap[Loc] and fCanal<>0 then 2917 begin 2918 RemoveDomainUnits(dSea,p,Loc); 2919 RealMap[Loc]:=RealMap[Loc] and not fCanal 2920 end 2921 else if RealMap[Loc] and fRR<>0 then 2922 RealMap[Loc]:=RealMap[Loc] and not fRR or fRoad 2923 else if RealMap[Loc] and fRoad<>0 then 2924 RealMap[Loc]:=RealMap[Loc] and not fRoad; 2925 end; 2926 if ChangedTerrain>=0 then 3327 else if RealMap[Loc] and fRR <> 0 then 3328 RealMap[Loc] := RealMap[Loc] and not fRR or fRoad 3329 else if RealMap[Loc] and fRoad <> 0 then 3330 RealMap[Loc] := RealMap[Loc] and not fRoad; 3331 end; 3332 if ChangedTerrain >= 0 then 2927 3333 begin // remove terrain improvements if not possible on new terrain 2928 if ((RealMap[Loc] and fTerImp=tiIrrigation) 2929 or (RealMap[Loc] and fTerImp=tiFarm)) 2930 and ((Terrain[ChangedTerrain].IrrClearWork=0) 2931 or (Terrain[ChangedTerrain].ClearTerrain>=0)) then 2932 RealMap[Loc]:=RealMap[Loc] and not fTerImp; 2933 if (RealMap[Loc] and fTerImp=tiMine) 2934 and ((Terrain[ChangedTerrain].MineAfforestWork=0) 2935 or (Terrain[ChangedTerrain].AfforestTerrain>=0)) then 2936 RealMap[Loc]:=RealMap[Loc] and not fTerImp; 2937 end; 2938 2939 // update map of all observing players 2940 if Mode>moLoading_Fast then 2941 for p1:=0 to nPl-1 do 2942 if (1 shl p1 and (GAlive or GWatching)<>0) 2943 and (ObserveLevel[Loc] shr (2*p1) and 3>lNoObserve) then 2944 RW[p1].Map[Loc]:=RW[p1].Map[Loc] 2945 and not (fTerrain or fSpecial or fTerImp or fRoad or fRR or fCanal or fPoll) 2946 or RealMap[Loc] and (fTerrain or fSpecial or fTerImp or fRoad or fRR or fCanal or fPoll); 2947 end; //CompleteJob 3334 if ((RealMap[Loc] and fTerImp = tiIrrigation) or 3335 (RealMap[Loc] and fTerImp = tiFarm)) and 3336 ((Terrain[ChangedTerrain].IrrClearWork = 0) or 3337 (Terrain[ChangedTerrain].ClearTerrain >= 0)) then 3338 RealMap[Loc] := RealMap[Loc] and not fTerImp; 3339 if (RealMap[Loc] and fTerImp = tiMine) and 3340 ((Terrain[ChangedTerrain].MineAfforestWork = 0) or 3341 (Terrain[ChangedTerrain].AfforestTerrain >= 0)) then 3342 RealMap[Loc] := RealMap[Loc] and not fTerImp; 3343 end; 3344 3345 // update map of all observing players 3346 if Mode > moLoading_Fast then 3347 for p1 := 0 to nPl - 1 do 3348 if (1 shl p1 and (GAlive or GWatching) <> 0) and 3349 (ObserveLevel[Loc] shr (2 * p1) and 3 > lNoObserve) then 3350 RW[p1].Map[Loc] := RW[p1].Map[Loc] and 3351 not(fTerrain or fSpecial or fTerImp or fRoad or fRR or fCanal or 3352 fPoll) or RealMap[Loc] and (fTerrain or fSpecial or fTerImp or 3353 fRoad or fRR or fCanal or fPoll); 3354 end; // CompleteJob 2948 3355 2949 3356 { 2950 2951 ____________________________________________________________________3357 Diplomacy 3358 ____________________________________________________________________ 2952 3359 } 2953 3360 procedure GiveCivilReport(p, pAbout: integer); 2954 3361 begin 2955 with RW[p].EnemyReport[pAbout]^ do2956 begin 2957 // general info2958 TurnOfCivilReport:=LastValidStat[pAbout];2959 move(RW[pAbout].Treaty, Treaty, SizeOf(Treaty));2960 Government:=RW[pAbout].Government;2961 Money:=RW[pAbout].Money;2962 2963 // tech info2964 ResearchTech:=RW[pAbout].ResearchTech;2965 ResearchDone:=RW[pAbout].Research*100 div TechCost(pAbout);2966 if ResearchDone>100 then2967 ResearchDone:=100;2968 move(RW[pAbout].Tech, Tech, nAdv);3362 with RW[p].EnemyReport[pAbout]^ do 3363 begin 3364 // general info 3365 TurnOfCivilReport := LastValidStat[pAbout]; 3366 move(RW[pAbout].Treaty, Treaty, SizeOf(Treaty)); 3367 Government := RW[pAbout].Government; 3368 Money := RW[pAbout].Money; 3369 3370 // tech info 3371 ResearchTech := RW[pAbout].ResearchTech; 3372 ResearchDone := RW[pAbout].Research * 100 div TechCost(pAbout); 3373 if ResearchDone > 100 then 3374 ResearchDone := 100; 3375 move(RW[pAbout].Tech, Tech, nAdv); 2969 3376 end; 2970 3377 end; … … 2972 3379 procedure GiveMilReport(p, pAbout: integer); 2973 3380 var 2974 uix,mix: integer; 2975 begin 2976 with RW[p].EnemyReport[pAbout]^ do 2977 begin 2978 TurnOfMilReport:=LastValidStat[pAbout]; 2979 nModelCounted:=RW[pAbout].nModel; 2980 for mix:=0 to RW[pAbout].nModel-1 do 2981 begin TellAboutModel(p,pAbout,mix); UnCount[mix]:=0 end; 2982 for uix:=0 to RW[pAbout].nUn-1 do 2983 if RW[pAbout].Un[uix].Loc>=0 then inc(UnCount[RW[pAbout].Un[uix].mix]); 3381 uix, mix: integer; 3382 begin 3383 with RW[p].EnemyReport[pAbout]^ do 3384 begin 3385 TurnOfMilReport := LastValidStat[pAbout]; 3386 nModelCounted := RW[pAbout].nModel; 3387 for mix := 0 to RW[pAbout].nModel - 1 do 3388 begin 3389 TellAboutModel(p, pAbout, mix); 3390 UnCount[mix] := 0 3391 end; 3392 for uix := 0 to RW[pAbout].nUn - 1 do 3393 if RW[pAbout].Un[uix].Loc >= 0 then 3394 inc(UnCount[RW[pAbout].Un[uix].mix]); 2984 3395 end 2985 3396 end; … … 2987 3398 procedure ShowPrice(pSender, pTarget, Price: integer); 2988 3399 begin 2989 case Price and opMask of2990 opTech: // + advance2991 with RW[pTarget].EnemyReport[pSender]^ do2992 if Tech[Price-opTech]<tsApplicable then2993 Tech[Price-opTech]:=tsApplicable;2994 opModel: // + model index2995 TellAboutModel(pTarget,pSender,Price-opModel);2996 {opCity: // + city ID2997 begin2998 end;}3400 case Price and opMask of 3401 opTech: // + advance 3402 with RW[pTarget].EnemyReport[pSender]^ do 3403 if Tech[Price - opTech] < tsApplicable then 3404 Tech[Price - opTech] := tsApplicable; 3405 opModel: // + model index 3406 TellAboutModel(pTarget, pSender, Price - opModel); 3407 { opCity: // + city ID 3408 begin 3409 end; } 2999 3410 end 3000 3411 end; … … 3002 3413 function CopyCivilReport(pSender, pTarget, pAbout: integer): boolean; 3003 3414 var 3004 i: integer;3005 rSender, rTarget: ^TEnemyReport;3415 i: integer; 3416 rSender, rTarget: ^TEnemyReport; 3006 3417 begin // copy third nation civil report 3007 result:=false;3008 if RW[pTarget].Treaty[pAbout]=trNoContact then3009 IntroduceEnemy(pTarget, pAbout);3010 rSender:=pointer(RW[pSender].EnemyReport[pAbout]);3011 rTarget:=pointer(RW[pTarget].EnemyReport[pAbout]);3012 if rSender.TurnOfCivilReport>rTarget.TurnOfCivilReport then3418 result := false; 3419 if RW[pTarget].Treaty[pAbout] = trNoContact then 3420 IntroduceEnemy(pTarget, pAbout); 3421 rSender := pointer(RW[pSender].EnemyReport[pAbout]); 3422 rTarget := pointer(RW[pTarget].EnemyReport[pAbout]); 3423 if rSender.TurnOfCivilReport > rTarget.TurnOfCivilReport then 3013 3424 begin // only if newer than current information 3014 rTarget.TurnOfCivilReport:=rSender.TurnOfCivilReport;3015 rTarget.Treaty:=rSender.Treaty;3016 rTarget.Government:=rSender.Government;3017 rTarget.Money:=rSender.Money;3018 rTarget.ResearchTech:=rSender.ResearchTech;3019 rTarget.ResearchDone:=rSender.ResearchDone;3020 result:=true3021 end; 3022 for i:=0 to nAdv-1 do3023 if rTarget.Tech[i]<rSender.Tech[i] then3024 begin 3025 rTarget.Tech[i]:=rSender.Tech[i];3026 result:=true3425 rTarget.TurnOfCivilReport := rSender.TurnOfCivilReport; 3426 rTarget.Treaty := rSender.Treaty; 3427 rTarget.Government := rSender.Government; 3428 rTarget.Money := rSender.Money; 3429 rTarget.ResearchTech := rSender.ResearchTech; 3430 rTarget.ResearchDone := rSender.ResearchDone; 3431 result := true 3432 end; 3433 for i := 0 to nAdv - 1 do 3434 if rTarget.Tech[i] < rSender.Tech[i] then 3435 begin 3436 rTarget.Tech[i] := rSender.Tech[i]; 3437 result := true 3027 3438 end 3028 3439 end; … … 3030 3441 function CopyMilReport(pSender, pTarget, pAbout: integer): boolean; 3031 3442 var 3032 mix: integer;3033 rSender, rTarget: ^TEnemyReport;3443 mix: integer; 3444 rSender, rTarget: ^TEnemyReport; 3034 3445 begin // copy third nation military report 3035 result:=false;3036 if RW[pTarget].Treaty[pAbout]=trNoContact then3037 IntroduceEnemy(pTarget, pAbout);3038 rSender:=pointer(RW[pSender].EnemyReport[pAbout]);3039 rTarget:=pointer(RW[pTarget].EnemyReport[pAbout]);3040 if rSender.TurnOfMilReport>rTarget.TurnOfMilReport then3446 result := false; 3447 if RW[pTarget].Treaty[pAbout] = trNoContact then 3448 IntroduceEnemy(pTarget, pAbout); 3449 rSender := pointer(RW[pSender].EnemyReport[pAbout]); 3450 rTarget := pointer(RW[pTarget].EnemyReport[pAbout]); 3451 if rSender.TurnOfMilReport > rTarget.TurnOfMilReport then 3041 3452 begin // only if newer than current information 3042 rTarget.TurnOfMilReport:=rSender.TurnOfMilReport;3043 rTarget.nModelCounted:=rSender.nModelCounted;3044 move(rSender.UnCount, rTarget.UnCount, 2*rSender.nModelCounted);3045 for mix:=0 to rTarget.nModelCounted-1 do3046 TellAboutModel(pTarget,pAbout,mix);3047 result:=true3453 rTarget.TurnOfMilReport := rSender.TurnOfMilReport; 3454 rTarget.nModelCounted := rSender.nModelCounted; 3455 move(rSender.UnCount, rTarget.UnCount, 2 * rSender.nModelCounted); 3456 for mix := 0 to rTarget.nModelCounted - 1 do 3457 TellAboutModel(pTarget, pAbout, mix); 3458 result := true 3048 3459 end 3049 3460 end; 3050 3461 3051 procedure CopyModel(pSender,pTarget,mix: integer); 3052 var 3053 i: integer; 3054 miSender, miTarget: TModelInfo; 3055 ok: boolean; 3056 begin 3057 // only if target doesn't already have a model like this 3058 ok:= RW[pTarget].nModel<nmmax; 3059 MakeModelInfo(pSender,mix,RW[pSender].Model[mix],miSender); 3060 for i:=0 to RW[pTarget].nModel-1 do 3061 begin 3062 MakeModelInfo(pTarget,i,RW[pTarget].Model[i],miTarget); 3063 if IsSameModel(miSender,miTarget) then ok:=false 3064 end; 3065 if ok then 3066 begin 3067 RW[pTarget].Model[RW[pTarget].nModel]:=RW[pSender].Model[mix]; 3068 with RW[pTarget].Model[RW[pTarget].nModel] do 3069 begin 3070 IntroTurn:=GTurn; 3071 if Kind=mkSelfDeveloped then Kind:=mkEnemyDeveloped; 3072 Status:=0; 3073 SavedStatus:=0; 3074 Built:=0; 3075 Lost:=0; 3076 end; 3077 inc(RW[pTarget].nModel); 3078 inc(Researched[pTarget]); 3079 TellAboutModel(pSender,pTarget,RW[pTarget].nModel-1); 3462 procedure CopyModel(pSender, pTarget, mix: integer); 3463 var 3464 i: integer; 3465 miSender, miTarget: TModelInfo; 3466 ok: boolean; 3467 begin 3468 // only if target doesn't already have a model like this 3469 ok := RW[pTarget].nModel < nmmax; 3470 MakeModelInfo(pSender, mix, RW[pSender].Model[mix], miSender); 3471 for i := 0 to RW[pTarget].nModel - 1 do 3472 begin 3473 MakeModelInfo(pTarget, i, RW[pTarget].Model[i], miTarget); 3474 if IsSameModel(miSender, miTarget) then 3475 ok := false 3476 end; 3477 if ok then 3478 begin 3479 RW[pTarget].Model[RW[pTarget].nModel] := RW[pSender].Model[mix]; 3480 with RW[pTarget].Model[RW[pTarget].nModel] do 3481 begin 3482 IntroTurn := GTurn; 3483 if Kind = mkSelfDeveloped then 3484 Kind := mkEnemyDeveloped; 3485 Status := 0; 3486 SavedStatus := 0; 3487 Built := 0; 3488 Lost := 0; 3489 end; 3490 inc(RW[pTarget].nModel); 3491 inc(Researched[pTarget]); 3492 TellAboutModel(pSender, pTarget, RW[pTarget].nModel - 1); 3080 3493 end 3081 3494 end; … … 3083 3496 procedure CopyMap(pSender, pTarget: integer); 3084 3497 var 3085 Loc,i,cix:integer; 3086 Tile: Cardinal; 3087 begin 3088 for Loc:=0 to MapSize-1 do 3089 if (RW[pSender].MapObservedLast[Loc]>RW[pTarget].MapObservedLast[Loc]) then 3090 begin 3091 Tile:=RW[pSender].Map[Loc]; 3092 if Tile and fCity<>0 then 3093 begin 3094 i:=0; 3095 while (i<RW[pTarget].nEnemyCity) and (RW[pTarget].EnemyCity[i].Loc<>Loc) do 3096 inc(i); 3097 if i=RW[pTarget].nEnemyCity then 3098 begin 3099 inc(RW[pTarget].nEnemyCity); 3100 assert(RW[pTarget].nEnemyCity<necmax); 3101 RW[pTarget].EnemyCity[i].Status:=0; 3102 RW[pTarget].EnemyCity[i].SavedStatus:=0; 3498 Loc, i, cix: integer; 3499 Tile: Cardinal; 3500 begin 3501 for Loc := 0 to MapSize - 1 do 3502 if (RW[pSender].MapObservedLast[Loc] > RW[pTarget].MapObservedLast[Loc]) 3503 then 3504 begin 3505 Tile := RW[pSender].Map[Loc]; 3506 if Tile and fCity <> 0 then 3507 begin 3508 i := 0; 3509 while (i < RW[pTarget].nEnemyCity) and 3510 (RW[pTarget].EnemyCity[i].Loc <> Loc) do 3511 inc(i); 3512 if i = RW[pTarget].nEnemyCity then 3513 begin 3514 inc(RW[pTarget].nEnemyCity); 3515 assert(RW[pTarget].nEnemyCity < necmax); 3516 RW[pTarget].EnemyCity[i].Status := 0; 3517 RW[pTarget].EnemyCity[i].SavedStatus := 0; 3103 3518 end; 3104 if Tile and fOwned<>0 then3519 if Tile and fOwned <> 0 then 3105 3520 begin // city owned by sender -- create new info 3106 cix:=RW[pSender].nCity-1; 3107 while (cix>=0) and (RW[pSender].City[cix].Loc<>Loc) do dec(cix); 3108 MakeCityInfo(pSender, cix, RW[pTarget].EnemyCity[i]); 3521 cix := RW[pSender].nCity - 1; 3522 while (cix >= 0) and (RW[pSender].City[cix].Loc <> Loc) do 3523 dec(cix); 3524 MakeCityInfo(pSender, cix, RW[pTarget].EnemyCity[i]); 3109 3525 end 3110 else // city not owned by sender -- copy old info 3111 begin 3112 cix:=RW[pSender].nEnemyCity-1; 3113 while (cix>=0) and (RW[pSender].EnemyCity[cix].Loc<>Loc) do dec(cix); 3114 RW[pTarget].EnemyCity[i]:=RW[pSender].EnemyCity[cix]; 3526 else // city not owned by sender -- copy old info 3527 begin 3528 cix := RW[pSender].nEnemyCity - 1; 3529 while (cix >= 0) and (RW[pSender].EnemyCity[cix].Loc <> Loc) do 3530 dec(cix); 3531 RW[pTarget].EnemyCity[i] := RW[pSender].EnemyCity[cix]; 3115 3532 end; 3116 3533 end 3117 else if RW[pTarget].Map[Loc] and fCity<>0 then // remove enemycity 3118 for cix:=0 to RW[pTarget].nEnemyCity-1 do 3119 if RW[pTarget].EnemyCity[cix].Loc=Loc then 3120 RW[pTarget].EnemyCity[cix].Loc:=-1; 3121 3122 Tile:=Tile and (not (fSpecial or fModern) or ResourceMask[pTarget]); 3123 Tile:=Tile or (RW[pTarget].Map[Loc] and fModern); 3124 if (Tile and fTerrain=RW[pTarget].Map[Loc] and fTerrain) then 3125 Tile:=Tile or (RW[pTarget].Map[Loc] and fSpecial); 3126 3127 if RW[pTarget].Map[Loc] and fTerrain=fUNKNOWN then inc(Discovered[pTarget]); 3128 RW[pTarget].Map[Loc]:=RW[pTarget].Map[Loc] and fInEnemyZoC // always preserve this flag! 3129 or Tile and not (fUnit or fHiddenUnit or fStealthUnit 3130 or fObserved or fSpiedOut or fOwned or fInEnemyZoC or fOwnZoCUnit 3131 or fPeace or fGrWall); 3132 if RW[pSender].Territory[Loc]<>RW[pTarget].Territory[Loc] then 3133 begin 3134 RW[pTarget].Territory[Loc]:=RW[pSender].Territory[Loc]; 3135 {if RW[pTarget].BorderHelper<>nil then 3136 RW[pTarget].BorderHelper[Loc]:=0;} 3137 end; 3138 RW[pTarget].Territory[Loc]:=RW[pSender].Territory[Loc]; 3139 RW[pTarget].MapObservedLast[Loc]:=RW[pSender].MapObservedLast[Loc]; 3534 else if RW[pTarget].Map[Loc] and fCity <> 0 then // remove enemycity 3535 for cix := 0 to RW[pTarget].nEnemyCity - 1 do 3536 if RW[pTarget].EnemyCity[cix].Loc = Loc then 3537 RW[pTarget].EnemyCity[cix].Loc := -1; 3538 3539 Tile := Tile and (not(fSpecial or fModern) or ResourceMask[pTarget]); 3540 Tile := Tile or (RW[pTarget].Map[Loc] and fModern); 3541 if (Tile and fTerrain = RW[pTarget].Map[Loc] and fTerrain) then 3542 Tile := Tile or (RW[pTarget].Map[Loc] and fSpecial); 3543 3544 if RW[pTarget].Map[Loc] and fTerrain = fUNKNOWN then 3545 inc(Discovered[pTarget]); 3546 RW[pTarget].Map[Loc] := RW[pTarget].Map[Loc] and fInEnemyZoC 3547 // always preserve this flag! 3548 or Tile and not(fUnit or fHiddenUnit or fStealthUnit or fObserved or 3549 fSpiedOut or fOwned or fInEnemyZoC or fOwnZoCUnit or fPeace or fGrWall); 3550 if RW[pSender].Territory[Loc] <> RW[pTarget].Territory[Loc] then 3551 begin 3552 RW[pTarget].Territory[Loc] := RW[pSender].Territory[Loc]; 3553 { if RW[pTarget].BorderHelper<>nil then 3554 RW[pTarget].BorderHelper[Loc]:=0; } 3555 end; 3556 RW[pTarget].Territory[Loc] := RW[pSender].Territory[Loc]; 3557 RW[pTarget].MapObservedLast[Loc] := RW[pSender].MapObservedLast[Loc]; 3140 3558 end; 3141 3559 end; … … 3143 3561 function PayPrice(pSender, pTarget, Price: integer; execute: boolean): boolean; 3144 3562 var 3145 pSubject,i,n,NewTreaty: integer; 3146 begin 3147 result:=true; 3148 case Price and opMask of 3149 opCivilReport: // + turn + concerned player shl 16 3150 begin 3151 pSubject:=Price shr 16 and $f; 3152 if pTarget=pSubject then result:=false 3153 else if pSender=pSubject then 3154 begin 3155 if execute then GiveCivilReport(pTarget,pSender) 3156 end 3157 else if RW[pSender].EnemyReport[pSubject].TurnOfCivilReport<0 then 3158 result:=false 3159 else if execute then CopyCivilReport(pSender, pTarget, pSubject); 3160 end; 3161 opMilReport: // + turn + concerned player shl 16 3162 begin 3163 pSubject:=Price shr 16 and $f; 3164 if pTarget=pSubject then result:=false 3165 else if pSender=pSubject then 3166 begin 3167 if execute then GiveMilReport(pTarget,pSender) 3168 end 3169 else if RW[pSender].EnemyReport[pSubject].TurnOfMilReport<0 then 3170 result:=false 3171 else if execute then CopyMilReport(pSender, pTarget, pSubject) 3172 end; 3173 opMap: 3174 if execute then 3175 begin 3176 CopyMap(pSender, pTarget); 3177 RecalcPeaceMap(pTarget); 3178 end; 3179 opTreaty..opTreaty+trAlliance: // + nation treaty 3180 begin 3181 if Price-opTreaty=RW[pSender].Treaty[pTarget]-1 then 3182 begin // agreed treaty end 3183 if execute then CancelTreaty(pSender,pTarget,false) 3184 end 3185 else 3186 begin 3187 NewTreaty:=-1; 3188 if Price-opTreaty=RW[pSender].Treaty[pTarget]+1 then 3189 NewTreaty:=Price-opTreaty 3190 else if (RW[pSender].Treaty[pTarget]=trNone) and (Price-opTreaty=trPeace) then 3191 NewTreaty:=trPeace; 3192 if NewTreaty<0 then result:=false 3193 else if execute then 3194 begin 3195 assert(NewTreaty>RW[pSender].Treaty[pTarget]); 3196 RW[pSender].Treaty[pTarget]:=NewTreaty; 3197 RW[pTarget].Treaty[pSender]:=NewTreaty; 3198 if NewTreaty>=trFriendlyContact then 3563 pSubject, i, n, NewTreaty: integer; 3564 begin 3565 result := true; 3566 case Price and opMask of 3567 opCivilReport: // + turn + concerned player shl 16 3568 begin 3569 pSubject := Price shr 16 and $F; 3570 if pTarget = pSubject then 3571 result := false 3572 else if pSender = pSubject then 3573 begin 3574 if execute then 3575 GiveCivilReport(pTarget, pSender) 3576 end 3577 else if RW[pSender].EnemyReport[pSubject].TurnOfCivilReport < 0 then 3578 result := false 3579 else if execute then 3580 CopyCivilReport(pSender, pTarget, pSubject); 3581 end; 3582 opMilReport: // + turn + concerned player shl 16 3583 begin 3584 pSubject := Price shr 16 and $F; 3585 if pTarget = pSubject then 3586 result := false 3587 else if pSender = pSubject then 3588 begin 3589 if execute then 3590 GiveMilReport(pTarget, pSender) 3591 end 3592 else if RW[pSender].EnemyReport[pSubject].TurnOfMilReport < 0 then 3593 result := false 3594 else if execute then 3595 CopyMilReport(pSender, pTarget, pSubject) 3596 end; 3597 opMap: 3598 if execute then 3599 begin 3600 CopyMap(pSender, pTarget); 3601 RecalcPeaceMap(pTarget); 3602 end; 3603 opTreaty .. opTreaty + trAlliance: // + nation treaty 3604 begin 3605 if Price - opTreaty = RW[pSender].Treaty[pTarget] - 1 then 3606 begin // agreed treaty end 3607 if execute then 3608 CancelTreaty(pSender, pTarget, false) 3609 end 3610 else 3611 begin 3612 NewTreaty := -1; 3613 if Price - opTreaty = RW[pSender].Treaty[pTarget] + 1 then 3614 NewTreaty := Price - opTreaty 3615 else if (RW[pSender].Treaty[pTarget] = trNone) and 3616 (Price - opTreaty = trPeace) then 3617 NewTreaty := trPeace; 3618 if NewTreaty < 0 then 3619 result := false 3620 else if execute then 3199 3621 begin 3200 GiveCivilReport(pTarget, pSender); 3201 GiveCivilReport(pSender, pTarget); 3202 end; 3203 if NewTreaty=trAlliance then 3622 assert(NewTreaty > RW[pSender].Treaty[pTarget]); 3623 RW[pSender].Treaty[pTarget] := NewTreaty; 3624 RW[pTarget].Treaty[pSender] := NewTreaty; 3625 if NewTreaty >= TrFriendlyContact then 3626 begin 3627 GiveCivilReport(pTarget, pSender); 3628 GiveCivilReport(pSender, pTarget); 3629 end; 3630 if NewTreaty = trAlliance then 3631 begin 3632 GiveMilReport(pTarget, pSender); 3633 GiveMilReport(pSender, pTarget); 3634 CopyMap(pSender, pTarget); 3635 CopyMap(pTarget, pSender); 3636 RecalcMapZoC(pSender); 3637 RecalcMapZoC(pTarget); 3638 end; 3639 if not(NewTreaty in [trPeace, TrFriendlyContact]) then 3640 begin 3641 RW[pSender].EvaStart[pTarget] := -PeaceEvaTurns - 1; 3642 RW[pTarget].EvaStart[pSender] := -PeaceEvaTurns - 1; 3643 end; 3644 RecalcPeaceMap(pSender); 3645 RecalcPeaceMap(pTarget); 3646 end 3647 end 3648 end; 3649 opShipParts: // + number + part type shl 16 3650 begin 3651 n := Price and $FFFF; // number 3652 i := Price shr 16 and $F; // type 3653 if (i < nShipPart) and (GShip[pSender].Parts[i] >= n) then 3654 begin 3655 if execute then 3204 3656 begin 3205 GiveMilReport(pTarget, pSender); 3206 GiveMilReport(pSender, pTarget); 3207 CopyMap(pSender, pTarget); 3208 CopyMap(pTarget, pSender); 3209 RecalcMapZoC(pSender); 3210 RecalcMapZoC(pTarget); 3211 end; 3212 if not (NewTreaty in [trPeace,trFriendlyContact]) then 3213 begin 3214 RW[pSender].EvaStart[pTarget]:=-PeaceEvaTurns-1; 3215 RW[pTarget].EvaStart[pSender]:=-PeaceEvaTurns-1; 3216 end; 3217 RecalcPeaceMap(pSender); 3218 RecalcPeaceMap(pTarget); 3657 dec(GShip[pSender].Parts[i], n); 3658 RW[pSender].Ship[pSender].Parts[i] := GShip[pSender].Parts[i]; 3659 RW[pTarget].Ship[pSender].Parts[i] := GShip[pSender].Parts[i]; 3660 if RW[pTarget].NatBuilt[imSpacePort] > 0 then 3661 begin // space ship control requires space port 3662 inc(GShip[pTarget].Parts[i], n); 3663 RW[pSender].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i]; 3664 RW[pTarget].Ship[pTarget].Parts[i] := GShip[pTarget].Parts[i]; 3665 end 3666 end 3667 end 3668 else 3669 result := false; 3670 end; 3671 opMoney: // + value 3672 if (Price - opMoney <= MaxMoneyPrice) and 3673 (RW[pSender].Money >= Price - opMoney) then 3674 begin 3675 if execute then 3676 begin 3677 dec(RW[pSender].Money, Price - opMoney); 3678 inc(RW[pTarget].Money, Price - opMoney); 3219 3679 end 3220 3680 end 3221 end; 3222 opShipParts: // + number + part type shl 16 3223 begin 3224 n:=Price and $FFFF; // number 3225 i:=Price shr 16 and $f; // type 3226 if (i<nShipPart) and (GShip[pSender].Parts[i]>=n) then 3227 begin 3681 else 3682 result := false; 3683 opTribute: // + value 3228 3684 if execute then 3229 begin 3230 dec(GShip[pSender].Parts[i],n); 3231 RW[pSender].Ship[pSender].Parts[i]:=GShip[pSender].Parts[i]; 3232 RW[pTarget].Ship[pSender].Parts[i]:=GShip[pSender].Parts[i]; 3233 if RW[pTarget].NatBuilt[imSpacePort]>0 then 3234 begin // space ship control requires space port 3235 inc(GShip[pTarget].Parts[i],n); 3236 RW[pSender].Ship[pTarget].Parts[i]:=GShip[pTarget].Parts[i]; 3237 RW[pTarget].Ship[pTarget].Parts[i]:=GShip[pTarget].Parts[i]; 3238 end 3685 begin 3686 end; 3687 opTech: // + advance 3688 if RW[pSender].Tech[Price - opTech] >= tsApplicable then 3689 begin 3690 if execute and (RW[pTarget].Tech[Price - opTech] = tsNA) then 3691 begin 3692 SeeTech(pTarget, Price - opTech); 3693 RW[pSender].EnemyReport[pTarget].Tech[Price - opTech] := tsSeen; 3239 3694 end 3240 3695 end 3241 else result:=false; 3242 end; 3243 opMoney: // + value 3244 if (Price-opMoney<=MaxMoneyPrice) and (RW[pSender].Money>=Price-opMoney) then 3245 begin 3696 else 3697 result := false; 3698 opAllTech: 3246 3699 if execute then 3247 begin 3248 dec(RW[pSender].Money,Price-opMoney); 3249 inc(RW[pTarget].Money,Price-opMoney); 3700 for i := 0 to nAdv - 1 do 3701 if (RW[pSender].Tech[i] >= tsApplicable) and 3702 (RW[pTarget].Tech[i] = tsNA) then 3703 begin 3704 SeeTech(pTarget, i); 3705 RW[pSender].EnemyReport[pTarget].Tech[i] := tsSeen; 3706 RW[pTarget].EnemyReport[pSender].Tech[i] := tsApplicable; 3707 end; 3708 opModel: // + model index 3709 if Price - opModel < RW[pSender].nModel then 3710 begin 3711 if execute then 3712 CopyModel(pSender, pTarget, Price - opModel) 3713 end 3714 else 3715 result := false; 3716 opAllModel: 3717 if execute then 3718 for i := 0 to RW[pSender].nModel - 1 do 3719 begin 3720 TellAboutModel(pTarget, pSender, i); 3721 CopyModel(pSender, pTarget, i); 3722 end; 3723 { opCity: // + city ID 3724 begin 3725 result:=false 3726 end; } 3727 end 3728 end; 3729 3730 procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean); 3731 // side effect: PeaceEnded := bitarray of players with which peace treaty was canceled 3732 var 3733 p1, OldTreaty: integer; 3734 begin 3735 OldTreaty := RW[p].Treaty[pWith]; 3736 PeaceEnded := 0; 3737 if OldTreaty >= trPeace then 3738 RW[p].LastCancelTreaty[pWith] := GTurn; 3739 if DecreaseCredibility then 3740 begin 3741 case OldTreaty of 3742 trPeace: 3743 begin 3744 RW[p].Credibility := RW[p].Credibility shr 1; 3745 if RW[p].MaxCredibility > 0 then 3746 dec(RW[p].MaxCredibility, 10); 3747 if RW[p].Credibility > RW[p].MaxCredibility then 3748 RW[p].Credibility := RW[p].MaxCredibility; 3749 end; 3750 trAlliance: 3751 RW[p].Credibility := RW[p].Credibility * 3 div 4; 3752 end; 3753 RW[pWith].EnemyReport[p].Credibility := RW[p].Credibility; 3754 end; 3755 3756 if OldTreaty = trPeace then 3757 begin 3758 for p1 := 0 to nPl - 1 do 3759 if (p1 = pWith) or DecreaseCredibility and (p1 <> p) and 3760 (RW[pWith].Treaty[p1] = trAlliance) and (RW[p].Treaty[p1] >= trPeace) 3761 then 3762 begin 3763 RW[p].Treaty[p1] := trNone; 3764 RW[p1].Treaty[p] := trNone; 3765 RW[p].EvaStart[p1] := -PeaceEvaTurns - 1; 3766 RW[p1].EvaStart[p] := -PeaceEvaTurns - 1; 3767 inc(PeaceEnded, 1 shl p1); 3768 end; 3769 CheckBorders(-1); 3770 if (Mode > moLoading_Fast) and (PeaceEnded > 0) then 3771 RecalcMapZoC(p); 3772 end 3773 else 3774 begin 3775 RW[p].Treaty[pWith] := OldTreaty - 1; 3776 RW[pWith].Treaty[p] := OldTreaty - 1; 3777 if OldTreaty = TrFriendlyContact then 3778 begin // necessary for loading 3779 GiveCivilReport(p, pWith); 3780 GiveCivilReport(pWith, p); 3781 end 3782 else if OldTreaty = trAlliance then 3783 begin // necessary for loading 3784 GiveMilReport(p, pWith); 3785 GiveMilReport(pWith, p); 3786 end; 3787 if (Mode > moLoading_Fast) and (OldTreaty = trAlliance) then 3788 begin 3789 RecalcMapZoC(p); 3790 RecalcMapZoC(pWith); 3791 end 3792 end; 3793 if OldTreaty in [trPeace, trAlliance] then 3794 begin 3795 RecalcPeaceMap(p); 3796 RecalcPeaceMap(pWith); 3797 end 3798 end; 3799 3800 function DoSpyMission(p, pCity, cix, Mission: integer): Cardinal; 3801 var 3802 p1: integer; 3803 begin 3804 result := 0; 3805 case Mission of 3806 smSabotageProd: 3807 RW[pCity].City[cix].Flags := RW[pCity].City[cix].Flags or 3808 chProductionSabotaged; 3809 smStealMap: 3810 begin 3811 CopyMap(pCity, p); 3812 RecalcPeaceMap(p); 3813 end; 3814 smStealCivilReport: 3815 begin 3816 if RW[p].Treaty[pCity] = trNoContact then 3817 IntroduceEnemy(p, pCity); 3818 GiveCivilReport(p, pCity); 3819 end; 3820 smStealMilReport: 3821 begin 3822 if RW[p].Treaty[pCity] = trNoContact then 3823 IntroduceEnemy(p, pCity); 3824 GiveMilReport(p, pCity); 3825 end; 3826 smStealForeignReports: 3827 begin 3828 for p1 := 0 to nPl - 1 do 3829 if (p1 <> p) and (p1 <> pCity) and (RW[pCity].EnemyReport[p1] <> nil) 3830 then 3831 begin 3832 if RW[pCity].EnemyReport[p1].TurnOfCivilReport >= 0 then 3833 if CopyCivilReport(pCity, p, p1) then 3834 result := result or (1 shl (2 * p1)); 3835 if RW[pCity].EnemyReport[p1].TurnOfMilReport >= 0 then 3836 if CopyMilReport(pCity, p, p1) then 3837 result := result or (2 shl (2 * p1)); 3838 end 3839 end; 3840 end; 3841 end; 3842 3843 { 3844 Test Flags 3845 ____________________________________________________________________ 3846 } 3847 procedure ClearTestFlags(ClearFlags: integer); 3848 var 3849 p1: integer; 3850 begin 3851 GTestFlags := GTestFlags and (not ClearFlags or tfTested or tfAllTechs or 3852 tfAllContact); 3853 for p1 := 0 to nPl - 1 do 3854 if 1 shl p1 and (GAlive or GWatching) <> 0 then 3855 RW[p1].TestFlags := GTestFlags; 3856 end; 3857 3858 procedure SetTestFlags(p, SetFlags: integer); 3859 var 3860 i, p1, p2, MoreFlags: integer; 3861 begin 3862 MoreFlags := SetFlags and not GTestFlags; 3863 GTestFlags := GTestFlags or (SetFlags and $7FF); 3864 for p1 := 0 to nPl - 1 do 3865 if 1 shl p1 and (GAlive or GWatching) <> 0 then 3866 RW[p1].TestFlags := GTestFlags; 3867 3868 if MoreFlags and (tfUncover or tfAllContact) <> 0 then 3869 for p1 := 0 to nPl - 2 do 3870 if 1 shl p1 and GAlive <> 0 then 3871 for p2 := p1 + 1 to nPl - 1 do 3872 if 1 shl p2 and GAlive <> 0 then 3873 begin // make p1 and p2 know each other 3874 if RW[p1].Treaty[p2] = trNoContact then 3875 IntroduceEnemy(p1, p2) 3876 end; 3877 3878 if MoreFlags and tfAllTechs <> 0 then 3879 for p1 := 0 to nPl - 1 do 3880 begin 3881 ResourceMask[p1] := $FFFFFFFF; 3882 if 1 shl p1 and GAlive <> 0 then 3883 begin 3884 for i := 0 to nAdv - 1 do // give all techs to player p1 3885 if not(i in FutureTech) and (RW[p1].Tech[i] < tsApplicable) then 3886 begin 3887 RW[p1].Tech[i] := tsCheat; 3888 CheckSpecialModels(p1, i); 3889 end; 3890 for p2 := 0 to nPl - 1 do 3891 if (p2 <> p1) and (1 shl p2 and (GAlive or GWatching) <> 0) then 3892 for i := 1 to 3 do 3893 if RW[p2].EnemyReport[p1].Tech[AgePreq[i]] < tsApplicable then 3894 RW[p2].EnemyReport[p1].Tech[AgePreq[i]] := tsCheat; 3895 end 3896 end; 3897 3898 if MoreFlags and tfUncover <> 0 then 3899 begin 3900 DiscoverAll(p, lObserveSuper); 3901 for p1 := 0 to nPl - 1 do 3902 if 1 shl p1 and GAlive <> 0 then 3903 begin 3904 ResourceMask[p1] := $FFFFFFFF; 3905 if p1 <> p then 3906 begin 3907 GiveCivilReport(p, p1); 3908 GiveMilReport(p, p1); 3250 3909 end 3251 3910 end 3252 else result:=false;3253 opTribute: // + value3254 if execute then3255 begin3256 end;3257 opTech: // + advance3258 if RW[pSender].Tech[Price-opTech]>=tsApplicable then3259 begin3260 if execute and (RW[pTarget].Tech[Price-opTech]=tsNA) then3261 begin3262 SeeTech(pTarget,Price-opTech);3263 RW[pSender].EnemyReport[pTarget].Tech[Price-opTech]:=tsSeen;3264 end3265 end3266 else result:=false;3267 opAllTech:3268 if execute then for i:=0 to nAdv-1 do3269 if (RW[pSender].Tech[i]>=tsApplicable) and (RW[pTarget].Tech[i]=tsNA) then3270 begin3271 SeeTech(pTarget,i);3272 RW[pSender].EnemyReport[pTarget].Tech[i]:=tsSeen;3273 RW[pTarget].EnemyReport[pSender].Tech[i]:=tsApplicable;3274 end;3275 opModel: // + model index3276 if Price-opModel<RW[pSender].nModel then3277 begin3278 if execute then CopyModel(pSender,pTarget,Price-opModel)3279 end3280 else result:=false;3281 opAllModel:3282 if execute then for i:=0 to RW[pSender].nModel-1 do3283 begin3284 TellAboutModel(pTarget,pSender,i);3285 CopyModel(pSender,pTarget,i);3286 end;3287 { opCity: // + city ID3288 begin3289 result:=false3290 end;}3291 end3292 end;3293 3294 procedure CancelTreaty(p, pWith: integer; DecreaseCredibility: boolean);3295 // side effect: PeaceEnded := bitarray of players with which peace treaty was canceled3296 var3297 p1,OldTreaty: integer;3298 begin3299 OldTreaty:=RW[p].Treaty[pWith];3300 PeaceEnded:=0;3301 if OldTreaty>=trPeace then3302 RW[p].LastCancelTreaty[pWith]:=GTurn;3303 if DecreaseCredibility then3304 begin3305 case OldTreaty of3306 trPeace:3307 begin3308 RW[p].Credibility:=RW[p].Credibility shr 1;3309 if RW[p].MaxCredibility>0 then3310 dec(RW[p].MaxCredibility,10);3311 if RW[p].Credibility>RW[p].MaxCredibility then3312 RW[p].Credibility:=RW[p].MaxCredibility;3313 end;3314 trAlliance:3315 RW[p].Credibility:=RW[p].Credibility*3 div 4;3316 end;3317 RW[pWith].EnemyReport[p].Credibility:=RW[p].Credibility;3318 end;3319 3320 if OldTreaty=trPeace then3321 begin3322 for p1:=0 to nPl-1 do3323 if (p1=pWith)3324 or DecreaseCredibility and (p1<>p)3325 and (RW[pWith].Treaty[p1]=trAlliance)3326 and (RW[p].Treaty[p1]>=trPeace) then3327 begin3328 RW[p].Treaty[p1]:=trNone;3329 RW[p1].Treaty[p]:=trNone;3330 RW[p].EvaStart[p1]:=-PeaceEvaTurns-1;3331 RW[p1].EvaStart[p]:=-PeaceEvaTurns-1;3332 inc(PeaceEnded,1 shl p1);3333 end;3334 CheckBorders(-1);3335 if (Mode>moLoading_Fast) and (PeaceEnded>0) then3336 RecalcMapZoC(p);3337 end3338 else3339 begin3340 RW[p].Treaty[pWith]:=OldTreaty-1;3341 RW[pWith].Treaty[p]:=OldTreaty-1;3342 if OldTreaty=trFriendlyContact then3343 begin // necessary for loading3344 GiveCivilReport(p, pWith);3345 GiveCivilReport(pWith, p);3346 end3347 else if OldTreaty=trAlliance then3348 begin // necessary for loading3349 GiveMilReport(p, pWith);3350 GiveMilReport(pWith, p);3351 end;3352 if (Mode>moLoading_Fast) and (OldTreaty=trAlliance) then3353 begin3354 RecalcMapZoC(p);3355 RecalcMapZoC(pWith);3356 end3357 end;3358 if OldTreaty in [trPeace,trAlliance] then3359 begin3360 RecalcPeaceMap(p);3361 RecalcPeaceMap(pWith);3362 end3363 end;3364 3365 function DoSpyMission(p,pCity,cix,Mission: integer): Cardinal;3366 var3367 p1: integer;3368 begin3369 result:=0;3370 case Mission of3371 smSabotageProd: RW[pCity].City[cix].Flags:=3372 RW[pCity].City[cix].Flags or chProductionSabotaged;3373 smStealMap:3374 begin3375 CopyMap(pCity,p);3376 RecalcPeaceMap(p);3377 end;3378 smStealCivilReport:3379 begin3380 if RW[p].Treaty[pCity]=trNoContact then IntroduceEnemy(p,pCity);3381 GiveCivilReport(p,pCity);3382 end;3383 smStealMilReport:3384 begin3385 if RW[p].Treaty[pCity]=trNoContact then IntroduceEnemy(p,pCity);3386 GiveMilReport(p,pCity);3387 end;3388 smStealForeignReports:3389 begin3390 for p1:=0 to nPl-1 do if (p1<>p) and (p1<>pCity)3391 and (RW[pCity].EnemyReport[p1]<>nil) then3392 begin3393 if RW[pCity].EnemyReport[p1].TurnOfCivilReport>=0 then3394 if CopyCivilReport(pCity,p,p1) then3395 result:=result or (1 shl (2*p1));3396 if RW[pCity].EnemyReport[p1].TurnOfMilReport>=0 then3397 if CopyMilReport(pCity,p,p1) then3398 result:=result or (2 shl (2*p1));3399 end3400 end;3401 3911 end; 3402 3912 end; 3403 3913 3404 3914 { 3405 Test Flags3406 ____________________________________________________________________3915 Internal Command Processing 3916 ____________________________________________________________________ 3407 3917 } 3408 procedure ClearTestFlags(ClearFlags: integer); 3409 var 3410 p1: integer; 3411 begin 3412 GTestFlags:=GTestFlags and (not ClearFlags or tfTested or tfAllTechs or tfAllContact); 3413 for p1:=0 to nPl-1 do if 1 shl p1 and (GAlive or GWatching)<>0 then 3414 RW[p1].TestFlags:=GTestFlags; 3415 end; 3416 3417 procedure SetTestFlags(p,SetFlags: integer); 3418 var 3419 i,p1,p2,MoreFlags: integer; 3420 begin 3421 MoreFlags:=SetFlags and not GTestFlags; 3422 GTestFlags:=GTestFlags or (SetFlags and $7FF); 3423 for p1:=0 to nPl-1 do if 1 shl p1 and (GAlive or GWatching)<>0 then 3424 RW[p1].TestFlags:=GTestFlags; 3425 3426 if MoreFlags and (tfUncover or tfAllContact)<>0 then 3427 for p1:=0 to nPl-2 do 3428 if 1 shl p1 and GAlive<>0 then 3429 for p2:=p1+1 to nPl-1 do if 1 shl p2 and GAlive<>0 then 3430 begin // make p1 and p2 know each other 3431 if RW[p1].Treaty[p2]=trNoContact then 3432 IntroduceEnemy(p1,p2) 3433 end; 3434 3435 if MoreFlags and tfAllTechs<>0 then 3436 for p1:=0 to nPl-1 do 3437 begin 3438 ResourceMask[p1]:=$FFFFFFFF; 3439 if 1 shl p1 and GAlive<>0 then 3440 begin 3441 for i:=0 to nAdv-1 do // give all techs to player p1 3442 if not (i in FutureTech) and (RW[p1].Tech[i]<tsApplicable) then 3443 begin 3444 RW[p1].Tech[i]:=tsCheat; 3445 CheckSpecialModels(p1,i); 3446 end; 3447 for p2:=0 to nPl-1 do if (p2<>p1) and (1 shl p2 and (GAlive or GWatching)<>0) then 3448 for i:=1 to 3 do 3449 if RW[p2].EnemyReport[p1].Tech[AgePreq[i]]<tsApplicable then 3450 RW[p2].EnemyReport[p1].Tech[AgePreq[i]]:=tsCheat; 3451 end 3452 end; 3453 3454 if MoreFlags and tfUncover<>0 then 3455 begin 3456 DiscoverAll(p,lObserveSuper); 3457 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 3458 begin 3459 ResourceMask[p1]:=$FFFFFFFF; 3460 if p1<>p then 3461 begin 3462 GiveCivilReport(p, p1); 3463 GiveMilReport(p, p1); 3464 end 3465 end 3466 end; 3467 end; 3468 3469 { 3470 Internal Command Processing 3471 ____________________________________________________________________ 3472 } 3473 procedure IntServer(Command,Player,Subject:integer;var Data); 3474 var 3475 i,p1: integer; 3476 3477 begin 3478 if Mode=moPlaying then 3479 CL.Put(Command, Player, Subject, @Data); 3480 3481 case Command of 3482 3483 sIntTellAboutNation: 3484 begin 3485 {$IFDEF TEXTLOG}CmdInfo:=Format('IntTellAboutNation P%d+P%d', [Player,Subject]);{$ENDIF} 3486 assert((Player>=0) and (Player<nPl) and (Subject>=0) and (Subject<nPl)); 3487 IntroduceEnemy(Player,Subject); 3488 end; 3489 3490 sIntHaveContact: 3491 begin 3492 {$IFDEF TEXTLOG}CmdInfo:=Format('IntHaveContact P%d+P%d', [Player,Subject]);{$ENDIF} 3493 assert(RW[Player].Treaty[Subject]>trNoContact); 3494 RW[Player].EnemyReport[Subject].TurnOfContact:=GTurn; 3495 RW[Subject].EnemyReport[Player].TurnOfContact:=GTurn; 3496 end; 3497 3498 sIntCancelTreaty: 3499 begin 3500 {$IFDEF TEXTLOG}CmdInfo:=Format('IntCancelTreaty P%d with P%d', [Player,Subject]);{$ENDIF} 3501 CancelTreaty(Player,Subject); 3502 end; 3503 3504 (* sIntChoosePeace: 3505 begin 3506 {$IFDEF TEXTLOG}CmdInfo:=Format('IntChoosePeace P%d+P%d', [Player,Subject]);{$ENDIF} 3507 RW[Player].Treaty[Subject]:=trPeace; 3508 RW[Subject].Treaty[Player]:=trPeace; 3509 end;*) 3510 3511 sIntTellAboutModel..sIntTellAboutModel+(nPl-1) shl 4: 3512 begin 3513 p1:=(Command-sIntTellAboutModel) shr 4; // told player 3514 {$IFDEF TEXTLOG}CmdInfo:=Format('IntTellAboutModel P%d about P%d Mod%d', [p1,Player,Subject]);{$ENDIF} 3515 assert((Player>=0) and (Player<nPl)); 3516 assert((Subject>=0) and (Subject<RW[Player].nModel)); 3517 MakeModelInfo(Player,Subject,RW[Player].Model[Subject], 3518 RW[p1].EnemyModel[RW[p1].nEnemyModel]); 3519 RWemix[p1,Player,Subject]:=RW[p1].nEnemyModel; 3520 inc(RW[p1].nEnemyModel); 3521 assert(RW[p1].nEnemyModel<nemmax); 3522 end; 3523 3524 sIntDiscoverZOC: 3525 begin 3526 {$IFDEF TEXTLOG}CmdInfo:=Format('IntDiscoverZOC P%d Loc%d', [Player,integer(data)]);{$ENDIF} 3527 Discover9(integer(Data),Player,lObserveUnhidden,true,false); 3528 end; 3529 3530 sIntExpandTerritory: 3531 if Mode<moPlaying then 3532 begin 3533 {$IFDEF TEXTLOG}CmdInfo:=Format('IntExpandTerritory P%d Loc%d', [Player,RW[Player].City[Subject].Loc]);{$ENDIF} 3534 move(Data,BorderChanges,sizeof(BorderChanges)); 3535 ExpandTerritory(RW[Player].City[Subject].Loc); 3536 end; 3537 3538 sIntBuyMaterial: 3539 with RW[Player].City[Subject] do 3540 begin 3541 {$IFDEF TEXTLOG}CmdInfo:=Format('IntBuyMaterial P%d Loc%d Cost%d', [Player,Loc,integer(Data)]);{$ENDIF} 3542 dec(RW[Player].Money,integer(Data)); 3543 if (GWonder[woMich].EffectiveOwner=Player) and (Project and cpImp<>0) then 3544 inc(Prod,integer(Data) div 2) 3545 else inc(Prod,integer(Data) div 4); 3546 if Project0 and not cpAuto<>Project and not cpAuto then 3547 Project0:=Project; 3548 Prod0:=Prod; 3549 end; 3550 3551 sIntPayPrices..sIntPayPrices+12: 3552 begin 3553 {$IFDEF TEXTLOG}CmdInfo:=Format('IntPayPrices P%d+P%d', [Player,Subject]);{$ENDIF} 3554 for i:=0 to TOffer(Data).nDeliver-1 do 3555 PayPrice(Player,Subject,TOffer(Data).Price[i],true); 3556 for i:=0 to TOffer(Data).nCost-1 do 3557 PayPrice(Subject,Player,TOffer(Data).Price[TOffer(Data).nDeliver+i],true); 3558 for i:=0 to TOffer(Data).nDeliver+TOffer(Data).nCost-1 do 3559 if TOffer(Data).Price[i]=opTreaty+trAlliance then 3560 begin // add view area of allied player 3561 DiscoverViewAreas(Player); 3562 DiscoverViewAreas(Subject); 3563 break 3564 end 3565 end; 3566 3567 sIntSetDevModel: 3568 if Mode<moPlaying then 3569 move(Data, RW[Player].DevModel.Kind, sIntSetDevModel and $F *4); 3570 3571 sIntSetModelStatus: if ProcessClientData[Player] then 3572 begin 3573 {$IFDEF TEXTLOG}CmdInfo:=Format('IntSetModelStatus P%d', [Player]);{$ENDIF} 3574 RW[Player].Model[Subject].Status:=integer(Data); 3575 end; 3576 3577 sIntSetUnitStatus: if ProcessClientData[Player] then 3578 begin 3579 {$IFDEF TEXTLOG}CmdInfo:=Format('IntSetUnitStatus P%d', [Player]);{$ENDIF} 3580 RW[Player].Un[Subject].Status:=integer(Data); 3581 end; 3582 3583 sIntSetCityStatus: if ProcessClientData[Player] then 3584 begin 3585 {$IFDEF TEXTLOG}CmdInfo:=Format('IntSetCityStatus P%d', [Player]);{$ENDIF} 3586 RW[Player].City[Subject].Status:=integer(Data); 3587 end; 3588 3589 sIntSetECityStatus: if ProcessClientData[Player] then 3590 begin 3591 {$IFDEF TEXTLOG}CmdInfo:=Format('IntSetECityStatus P%d', [Player]);{$ENDIF} 3592 RW[Player].EnemyCity[Subject].Status:=integer(Data); 3593 end; 3594 3595 end;{case command} 3596 end;{IntServer} 3918 procedure IntServer(Command, Player, Subject: integer; var Data); 3919 var 3920 i, p1: integer; 3921 3922 begin 3923 if Mode = moPlaying then 3924 CL.Put(Command, Player, Subject, @Data); 3925 3926 case Command of 3927 3928 sIntTellAboutNation: 3929 begin 3930 {$IFDEF TEXTLOG}CmdInfo := Format('IntTellAboutNation P%d+P%d', [Player, Subject]); {$ENDIF} 3931 assert((Player >= 0) and (Player < nPl) and (Subject >= 0) and 3932 (Subject < nPl)); 3933 IntroduceEnemy(Player, Subject); 3934 end; 3935 3936 sIntHaveContact: 3937 begin 3938 {$IFDEF TEXTLOG}CmdInfo := Format('IntHaveContact P%d+P%d', [Player, Subject]); {$ENDIF} 3939 assert(RW[Player].Treaty[Subject] > trNoContact); 3940 RW[Player].EnemyReport[Subject].TurnOfContact := GTurn; 3941 RW[Subject].EnemyReport[Player].TurnOfContact := GTurn; 3942 end; 3943 3944 sIntCancelTreaty: 3945 begin 3946 {$IFDEF TEXTLOG}CmdInfo := Format('IntCancelTreaty P%d with P%d', [Player, Subject]); {$ENDIF} 3947 CancelTreaty(Player, Subject); 3948 end; 3949 3950 (* sIntChoosePeace: 3951 begin 3952 {$IFDEF TEXTLOG}CmdInfo:=Format('IntChoosePeace P%d+P%d', [Player,Subject]);{$ENDIF} 3953 RW[Player].Treaty[Subject]:=trPeace; 3954 RW[Subject].Treaty[Player]:=trPeace; 3955 end; *) 3956 3957 sIntTellAboutModel .. sIntTellAboutModel + (nPl - 1) shl 4: 3958 begin 3959 p1 := (Command - sIntTellAboutModel) shr 4; // told player 3960 {$IFDEF TEXTLOG}CmdInfo := Format('IntTellAboutModel P%d about P%d Mod%d', [p1, Player, Subject]); {$ENDIF} 3961 assert((Player >= 0) and (Player < nPl)); 3962 assert((Subject >= 0) and (Subject < RW[Player].nModel)); 3963 MakeModelInfo(Player, Subject, RW[Player].Model[Subject], 3964 RW[p1].EnemyModel[RW[p1].nEnemyModel]); 3965 RWemix[p1, Player, Subject] := RW[p1].nEnemyModel; 3966 inc(RW[p1].nEnemyModel); 3967 assert(RW[p1].nEnemyModel < nemmax); 3968 end; 3969 3970 sIntDiscoverZOC: 3971 begin 3972 {$IFDEF TEXTLOG}CmdInfo := Format('IntDiscoverZOC P%d Loc%d', [Player, integer(Data)]); {$ENDIF} 3973 Discover9(integer(Data), Player, lObserveUnhidden, true, false); 3974 end; 3975 3976 sIntExpandTerritory: 3977 if Mode < moPlaying then 3978 begin 3979 {$IFDEF TEXTLOG}CmdInfo := Format('IntExpandTerritory P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF} 3980 move(Data, BorderChanges, SizeOf(BorderChanges)); 3981 ExpandTerritory(RW[Player].City[Subject].Loc); 3982 end; 3983 3984 sIntBuyMaterial: 3985 with RW[Player].City[Subject] do 3986 begin 3987 {$IFDEF TEXTLOG}CmdInfo := Format('IntBuyMaterial P%d Loc%d Cost%d', [Player, Loc, integer(Data)]); {$ENDIF} 3988 dec(RW[Player].Money, integer(Data)); 3989 if (GWonder[woMich].EffectiveOwner = Player) and (Project and cpImp <> 0) 3990 then 3991 inc(Prod, integer(Data) div 2) 3992 else 3993 inc(Prod, integer(Data) div 4); 3994 if Project0 and not cpAuto <> Project and not cpAuto then 3995 Project0 := Project; 3996 Prod0 := Prod; 3997 end; 3998 3999 sIntPayPrices .. sIntPayPrices + 12: 4000 begin 4001 {$IFDEF TEXTLOG}CmdInfo := Format('IntPayPrices P%d+P%d', [Player, Subject]); {$ENDIF} 4002 for i := 0 to TOffer(Data).nDeliver - 1 do 4003 PayPrice(Player, Subject, TOffer(Data).Price[i], true); 4004 for i := 0 to TOffer(Data).nCost - 1 do 4005 PayPrice(Subject, Player, TOffer(Data).Price[TOffer(Data).nDeliver 4006 + i], true); 4007 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do 4008 if TOffer(Data).Price[i] = opTreaty + trAlliance then 4009 begin // add view area of allied player 4010 DiscoverViewAreas(Player); 4011 DiscoverViewAreas(Subject); 4012 Break 4013 end 4014 end; 4015 4016 sIntSetDevModel: 4017 if Mode < moPlaying then 4018 move(Data, RW[Player].DevModel.Kind, sIntSetDevModel and $F * 4); 4019 4020 sIntSetModelStatus: 4021 if ProcessClientData[Player] then 4022 begin 4023 {$IFDEF TEXTLOG}CmdInfo := Format('IntSetModelStatus P%d', [Player]); 4024 {$ENDIF} 4025 RW[Player].Model[Subject].Status := integer(Data); 4026 end; 4027 4028 sIntSetUnitStatus: 4029 if ProcessClientData[Player] then 4030 begin 4031 {$IFDEF TEXTLOG}CmdInfo := Format('IntSetUnitStatus P%d', [Player]); 4032 {$ENDIF} 4033 RW[Player].Un[Subject].Status := integer(Data); 4034 end; 4035 4036 sIntSetCityStatus: 4037 if ProcessClientData[Player] then 4038 begin 4039 {$IFDEF TEXTLOG}CmdInfo := Format('IntSetCityStatus P%d', [Player]); 4040 {$ENDIF} 4041 RW[Player].City[Subject].Status := integer(Data); 4042 end; 4043 4044 sIntSetECityStatus: 4045 if ProcessClientData[Player] then 4046 begin 4047 {$IFDEF TEXTLOG}CmdInfo := Format('IntSetECityStatus P%d', [Player]); 4048 {$ENDIF} 4049 RW[Player].EnemyCity[Subject].Status := integer(Data); 4050 end; 4051 4052 end; { case command } 4053 end; { IntServer } 3597 4054 3598 4055 end. 3599 -
trunk/Direct.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Direct; 4 3 … … 11 10 12 11 const 13 WM_GO = WM_USER;14 WM_CHANGECLIENT = WM_USER+1; // hand over control to other client15 WM_NEXTPLAYER = WM_USER+2; // active player's turn ended, next player16 WM_AIEXCEPTION = WM_USER+3;12 WM_GO = WM_USER; 13 WM_CHANGECLIENT = WM_USER + 1; // hand over control to other client 14 WM_NEXTPLAYER = WM_USER + 2; // active player's turn ended, next player 15 WM_AIEXCEPTION = WM_USER + 3; 17 16 18 17 type … … 30 29 procedure SetInfo(x: string); 31 30 procedure SetState(x: integer); 32 procedure OnGo(var m: TMessage); message WM_GO;33 procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT;34 procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER;35 procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION;31 procedure OnGo(var m: TMessage); message WM_GO; 32 procedure OnChangeClient(var m: TMessage); message WM_CHANGECLIENT; 33 procedure OnNextPlayer(var m: TMessage); message WM_NEXTPLAYER; 34 procedure OnAIException(var Msg: TMessage); message WM_AIEXCEPTION; 36 35 end; 37 36 … … 42 41 43 42 uses 44 ScreenTools,Protocol,GameServer,Start,LocalPlayer,NoTerm,Back,ShellAPI;43 ScreenTools, Protocol, GameServer, Start, LocalPlayer, NoTerm, Back, ShellAPI; 45 44 46 45 {$R *.DFM} … … 48 47 procedure Notify(ID: integer); 49 48 begin 50 DirectDlg.DlgNotify(ID);49 DirectDlg.DlgNotify(ID); 51 50 end; 52 51 53 52 procedure TDirectDlg.DlgNotify(ID: integer); 54 53 var 55 hMem: Cardinal; 56 p: pointer; 57 s: string; 58 begin 59 case ID of 60 ntInitLocalHuman: 54 hMem: Cardinal; 55 p: pointer; 56 s: string; 57 begin 58 case ID of 59 ntInitLocalHuman: 60 begin 61 SetMainTextureByAge(-1); 62 State := -1; 63 Info := Phrases.Lookup('BUSY_MODLH'); 64 Show; 65 Invalidate; 66 Update; 67 end; 68 ntInitModule .. ntInitModule + maxBrain - 1: 69 if visible then 70 begin 71 s := Format(Phrases.Lookup('BUSY_MOD'), 72 [Brain[ID - ntInitModule].Name]); 73 while BiColorTextWidth(Canvas, s) + 64 > ClientWidth do 74 Delete(s, Length(s), 1); 75 SetInfo(s); 76 end; 77 ntCreateWorld: 78 if visible then 79 SetInfo(Phrases.Lookup('BUSY_START')); 80 ntInitPlayers: 81 if visible then 82 SetInfo(Phrases.Lookup('BUSY_INIT')); 83 ntDeactivationMissing .. ntDeactivationMissing + nPl - 1: 84 SimpleMessage(Format(Phrases.Lookup('MISSDEACT'), 85 [ID - ntDeactivationMissing])); 86 ntSetAIName .. ntSetAIName + nPl - 1: 87 LocalPlayer.SetAIName(ID - ntSetAIName, NotifyMessage); 88 ntException .. ntException + maxBrain - 1: 89 PostMessage(Handle, WM_AIEXCEPTION, ID - ntException, 0); 90 ntLoadBegin: 91 begin 92 Info := Phrases.Lookup('BUSY_LOAD'); 93 SetState(0); 94 end; 95 ntLoadState .. ntLoadState + 128: 96 SetState(ID - ntLoadState); 97 ntDLLError .. ntDLLError + 128: 98 SimpleMessage(Format(Phrases.Lookup('DLLERROR'), 99 [Brain[ID - ntDLLError].FileName])); 100 ntAIError: 101 SimpleMessage(Format(Phrases.Lookup('AIERROR'), [NotifyMessage])); 102 ntClientError .. ntClientError + 128: 103 SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'), 104 [Brain[ID - ntClientError].FileName])); 105 ntEndInfo: 106 begin 107 Hide; 108 background.Update 109 end; 110 ntLoadError: 111 begin 112 if OpenClipboard(Handle) then 113 begin // copy file path to clipboard 114 NotifyMessage := NotifyMessage + #0; 115 hMem := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, 116 Length(NotifyMessage)); 117 p := GlobalLock(hMem); 118 if p <> nil then 119 move(NotifyMessage[1], p^, Length(NotifyMessage)); 120 GlobalUnlock(hMem); 121 SetClipboardData(CF_TEXT, hMem); 122 CloseClipboard; 123 end; 124 with MessgDlg do 125 begin 126 MessgText := Phrases.Lookup('LOADERROR'); 127 Kind := mkYesNo; 128 ShowModal; 129 if ModalResult = mrOK then 130 ShellExecute(Handle, 'open', 131 'http://c-evo.org/_sg/contact/cevobug.html', '', '', 132 SW_SHOWNORMAL); 133 end 134 end; 135 ntStartDone: 136 if not Quick then 137 begin 138 StartDlg.Hide; 139 background.Update 140 end; 141 ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps: 142 if Quick then 143 Close 144 else 145 begin 146 if ID = ntStartGoRefresh then 147 StartDlg.UpdateFormerGames 148 else if ID = ntStartGoRefreshMaps then 149 StartDlg.UpdateMaps; 150 StartDlg.Show; 151 end; 152 ntChangeClient: 153 PostMessage(Handle, WM_CHANGECLIENT, 0, 0); 154 ntNextPlayer: 155 PostMessage(Handle, WM_NEXTPLAYER, 0, 0); 156 ntDeinitModule .. ntDeinitModule + maxBrain - 1: 157 begin 158 Info := Format(Phrases2.Lookup('BUSY_DEINIT'), 159 [Brain[ID - ntDeinitModule].Name]); 160 while BiColorTextWidth(Canvas, Info) + 64 > ClientWidth do 161 Delete(Info, Length(Info), 1); 162 SetMainTextureByAge(-1); 163 State := -1; 164 Show; 165 Invalidate; 166 Update; 167 end; 168 ntBackOn: 169 begin 170 background.Show; 171 background.Update; 172 sleep(50); // prevent flickering 173 end; 174 ntBackOff: 175 background.Close; 176 end; 177 end; 178 179 procedure TDirectDlg.FormCreate(Sender: TObject); 180 begin 181 Gone := false; 182 State := -1; 183 Info := ''; 184 GameServer.Init(Notify); 185 Brain[bixNoTerm].Client := NoTerm.Client; 186 Brain[bixSuper_Virtual].Client := nil; 187 Brain[bixTerm].Client := LocalPlayer.Client; 188 Brain[bixNoTerm].Name := Phrases.Lookup('AIT'); 189 Brain[bixSuper_Virtual].Name := Phrases.Lookup('SUPER'); 190 Brain[bixTerm].Name := Phrases.Lookup('HUMAN'); 191 Brain[bixRandom].Name := Phrases.Lookup('RANDOMAI'); 192 Canvas.Font.Assign(UniFont[ftNormal]); 193 Canvas.Brush.Style := bsClear; 194 end; 195 196 procedure TDirectDlg.FormShow(Sender: TObject); 197 begin 198 if not Gone then 199 begin 200 PostMessage(Handle, WM_GO, 0, 0); 201 Gone := true 202 end 203 end; 204 205 procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction); 206 begin 207 GameServer.Done; 208 end; 209 210 procedure TDirectDlg.OnGo(var m: TMessage); 211 var 212 i: integer; 213 s: string; 214 begin 215 Hide; 216 if nBrain = 3 then 217 begin 218 Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0); 219 Close; 220 exit 221 end; 222 Quick := false; 223 if ParamCount > 0 then 224 begin 225 s := ParamStr(1); 226 if (s[1] = '-') or (s[1] = '/') then 227 begin // special mode 228 Delete(s, 1, 1); 229 for i := 1 to Length(s) do 230 if s[i] in ['a' .. 'z'] then 231 dec(s[i], 32); 232 if s = 'MAN' then 233 begin 234 Quick := true; 235 DirectHelp(cHelpOnly); 236 Close 237 end; 238 end 239 else if (FileExists(ParamStr(1))) then 61 240 begin 62 SetMainTextureByAge(-1); 63 State:=-1; 64 Info:=Phrases.Lookup('BUSY_MODLH'); 65 Show; Invalidate; Update; 66 end; 67 ntInitModule..ntInitModule+maxBrain-1: 68 if visible then 69 begin 70 s:=Format(Phrases.Lookup('BUSY_MOD'),[Brain[ID-ntInitModule].Name]); 71 while BiColorTextWidth(Canvas,s)+64>ClientWidth do Delete(s,Length(s),1); 72 SetInfo(s); 73 end; 74 ntCreateWorld: 75 if visible then SetInfo(Phrases.Lookup('BUSY_START')); 76 ntInitPlayers: 77 if visible then SetInfo(Phrases.Lookup('BUSY_INIT')); 78 ntDeactivationMissing..ntDeactivationMissing+nPl-1: 79 SimpleMessage(Format(Phrases.Lookup('MISSDEACT'),[ID-ntDeactivationMissing])); 80 ntSetAIName..ntSetAIName+nPl-1: 81 LocalPlayer.SetAIName(ID-ntSetAIName, NotifyMessage); 82 ntException..ntException+maxBrain-1: 83 PostMessage(Handle,WM_AIEXCEPTION,ID-ntException,0); 84 ntLoadBegin: 85 begin Info:=Phrases.Lookup('BUSY_LOAD'); SetState(0); end; 86 ntLoadState..ntLoadState+128: 87 SetState(ID-ntLoadState); 88 ntDLLError..ntDLLError+128: 89 SimpleMessage(Format(Phrases.Lookup('DLLERROR'),[Brain[ID-ntDLLError].FileName])); 90 ntAIError: 91 SimpleMessage(Format(Phrases.Lookup('AIERROR'),[NotifyMessage])); 92 ntClientError..ntClientError+128: 93 SimpleMessage(Format(Phrases.Lookup('CLIENTERROR'),[Brain[ID-ntClientError].FileName])); 94 ntEndInfo: 95 begin Hide; background.update end; 96 ntLoadError: 97 begin 98 if OpenClipboard(Handle) then 99 begin // copy file path to clipboard 100 NotifyMessage:=NotifyMessage+#0; 101 hMem:=GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, Length(NotifyMessage)); 102 p:=GlobalLock(hMem); 103 if p<>nil then 104 move(NotifyMessage[1],p^,Length(NotifyMessage)); 105 GlobalUnlock(hMem); 106 SetClipboardData(CF_TEXT, hMem); 107 CloseClipboard; 108 end; 109 with MessgDlg do 110 begin 111 MessgText:=Phrases.Lookup('LOADERROR'); 112 Kind:=mkYesNo; 113 ShowModal; 114 if ModalResult=mrOK then 115 ShellExecute(Handle,'open','http://c-evo.org/_sg/contact/cevobug.html', 116 '','',SW_SHOWNORMAL); 117 end 118 end; 119 ntStartDone: 120 if not Quick then 121 begin StartDlg.Hide; background.Update end; 122 ntStartGo, ntStartGoRefresh, ntStartGoRefreshMaps: 123 if Quick then Close 124 else 125 begin 126 if ID=ntStartGoRefresh then 127 StartDlg.UpdateFormerGames 128 else if ID=ntStartGoRefreshMaps then 129 StartDlg.UpdateMaps; 130 StartDlg.Show; 131 end; 132 ntChangeClient: 133 PostMessage(Handle,WM_CHANGECLIENT,0,0); 134 ntNextPlayer: 135 PostMessage(Handle,WM_NEXTPLAYER,0,0); 136 ntDeinitModule..ntDeinitModule+maxBrain-1: 137 begin 138 Info:=Format(Phrases2.Lookup('BUSY_DEINIT'), 139 [Brain[ID-ntDeinitModule].Name]); 140 while BiColorTextWidth(Canvas,Info)+64>ClientWidth do 141 Delete(Info,Length(Info),1); 142 SetMainTextureByAge(-1); 143 State:=-1; 144 Show; 145 Invalidate; 146 Update; 147 end; 148 ntBackOn: 149 begin 150 background.Show; 151 background.update; 152 sleep(50); // prevent flickering 153 end; 154 ntBackOff: 155 background.Close; 156 end; 157 end; 158 159 procedure TDirectDlg.FormCreate(Sender: TObject); 160 begin 161 Gone:=false; 162 State:=-1; 163 Info:=''; 164 GameServer.Init(Notify); 165 Brain[bixNoTerm].Client:=NoTerm.Client; 166 Brain[bixSuper_Virtual].Client:=nil; 167 Brain[bixTerm].Client:=LocalPlayer.Client; 168 Brain[bixNoTerm].Name:=Phrases.Lookup('AIT'); 169 Brain[bixSuper_Virtual].Name:=Phrases.Lookup('SUPER'); 170 Brain[bixTerm].Name:=Phrases.Lookup('HUMAN'); 171 Brain[bixRandom].name:=Phrases.Lookup('RANDOMAI'); 172 Canvas.Font.Assign(UniFont[ftNormal]); 173 Canvas.Brush.Style:=bsClear; 174 end; 175 176 procedure TDirectDlg.FormShow(Sender: TObject); 177 begin 178 if not Gone then 179 begin PostMessage(Handle,WM_GO,0,0); Gone:=true end 180 end; 181 182 procedure TDirectDlg.FormClose(Sender: TObject; var Action: TCloseAction); 183 begin 184 GameServer.Done; 185 end; 186 187 procedure TDirectDlg.OnGo(var m:TMessage); 188 var 189 i: integer; 190 s: string; 191 begin 192 Hide; 193 if nBrain=3 then 194 begin 195 Application.MessageBox(PChar(Phrases.Lookup('NOAI')), 'C-evo', 0); 196 close; 197 exit 198 end; 199 Quick:=false; 200 if ParamCount>0 then 201 begin 202 s:=ParamStr(1); 203 if (s[1]='-') or (s[1]='/') then 204 begin // special mode 205 Delete(s,1,1); 206 for i:=1 to Length(s) do if s[i] in ['a'..'z'] then dec(s[i],32); 207 if s='MAN' then 208 begin Quick:=true; DirectHelp(cHelpOnly); Close end; 209 end 210 else if (FileExists(ParamStr(1))) then 211 begin 212 Quick:=true; 213 if not LoadGame(ExtractFilePath(ParamStr(1)),ExtractFileName(ParamStr(1)),-1,false) then 214 begin 215 SimpleMessage(Phrases.Lookup('LOADERR')); 216 Close 241 Quick := true; 242 if not LoadGame(ExtractFilePath(ParamStr(1)), ExtractFileName(ParamStr(1) 243 ), -1, false) then 244 begin 245 SimpleMessage(Phrases.Lookup('LOADERR')); 246 Close 217 247 end 218 248 end 219 249 end; 220 if not Quick then 221 begin background.Show; StartDlg.Show end 222 end; 223 224 procedure TDirectDlg.OnChangeClient(var m:TMessage); 225 begin 226 ChangeClient; 227 end; 228 229 procedure TDirectDlg.OnNextPlayer(var m:TMessage); 230 begin 231 NextPlayer; 232 end; 233 234 procedure TDirectDlg.OnAIException(var Msg:TMessage); 235 begin 236 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'), 237 [Brain[Msg.WParam].Name])), 'C-evo', 0); 250 if not Quick then 251 begin 252 background.Show; 253 StartDlg.Show 254 end 255 end; 256 257 procedure TDirectDlg.OnChangeClient(var m: TMessage); 258 begin 259 ChangeClient; 260 end; 261 262 procedure TDirectDlg.OnNextPlayer(var m: TMessage); 263 begin 264 NextPlayer; 265 end; 266 267 procedure TDirectDlg.OnAIException(var Msg: TMessage); 268 begin 269 Application.MessageBox(PChar(Format(Phrases.Lookup('AIEXCEPTION'), 270 [Brain[Msg.WParam].Name])), 'C-evo', 0); 238 271 end; 239 272 240 273 procedure TDirectDlg.FormPaint(Sender: TObject); 241 274 begin 242 PaintBackground(self,3,3,ClientWidth-6,ClientHeight-6); 243 Frame(Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 244 Frame(Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight, 245 MainTexture.clBevelShade); 246 Frame(Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight, 247 MainTexture.clBevelShade); 248 if State>=0 then 249 RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,Info)) div 2,16,Info) 250 else RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,Info)) div 2, 251 (ClientHeight-Canvas.TextHeight(Info)) div 2,Info); 252 if State>=0 then 253 PaintProgressBar(Canvas,3,ClientWidth div 2 -64,40,State,0,128,MainTexture); 275 PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6); 276 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 277 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 278 MainTexture.clBevelLight, MainTexture.clBevelShade); 279 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 280 MainTexture.clBevelLight, MainTexture.clBevelShade); 281 if State >= 0 then 282 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) 283 div 2, 16, Info) 284 else 285 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Info)) div 2, 286 (ClientHeight - Canvas.TextHeight(Info)) div 2, Info); 287 if State >= 0 then 288 PaintProgressBar(Canvas, 3, ClientWidth div 2 - 64, 40, State, 0, 128, 289 MainTexture); 254 290 end; 255 291 256 292 procedure TDirectDlg.SetInfo(x: string); 257 293 begin 258 Info:=x;259 Invalidate;260 Update;294 Info := x; 295 Invalidate; 296 Update; 261 297 end; 262 298 263 299 procedure TDirectDlg.SetState(x: integer); 264 300 begin 265 if (x<0)<>(State<0) then 266 begin State:=x; Invalidate; Update end 267 else if x<>State then 268 begin 269 State:=x; 270 PaintProgressBar(Canvas,6,ClientWidth div 2 -64,40,State,128-State,128,MainTexture); 301 if (x < 0) <> (State < 0) then 302 begin 303 State := x; 304 Invalidate; 305 Update 271 306 end 307 else if x <> State then 308 begin 309 State := x; 310 PaintProgressBar(Canvas, 6, ClientWidth div 2 - 64, 40, State, 128 - State, 311 128, MainTexture); 312 end 272 313 end; 273 314 274 315 end. 275 -
trunk/Directories.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Directories; 4 3 … … 6 5 7 6 var 8 HomeDir, DataDir: string;7 HomeDir, DataDir: string; 9 8 10 9 function LocalizedFilePath(path: string): string; 11 12 10 13 11 implementation 14 12 15 13 uses 16 ShlObj,Windows,SysUtils;14 ShlObj, Windows, SysUtils; 17 15 18 16 function GetSpecialDirectory(const CSIDL: integer): string; 19 17 var 20 RecPath: PChar;18 RecPath: PChar; 21 19 begin 22 RecPath:=StrAlloc(MAX_PATH); 23 try 24 FillChar(RecPath^, MAX_PATH, 0); 25 if SHGetSpecialFolderPath(0, RecPath, CSIDL, false) then 26 result:=RecPath 27 else result:=''; 28 finally 29 StrDispose(RecPath); 20 RecPath := StrAlloc(MAX_PATH); 21 try 22 FillChar(RecPath^, MAX_PATH, 0); 23 if SHGetSpecialFolderPath(0, RecPath, CSIDL, false) then 24 result := RecPath 25 else 26 result := ''; 27 finally 28 StrDispose(RecPath); 30 29 end 31 30 end; … … 33 32 function DirectoryExists(path: string): boolean; 34 33 var 35 f: TSearchRec;34 f: TSearchRec; 36 35 begin 37 result:=FindFirst(path,faDirectory,f)=0;36 result := FindFirst(path, faDirectory, f) = 0; 38 37 end; 39 38 40 39 function LocalizedFilePath(path: string): string; 41 40 begin 42 result:=DataDir+'Localization\'+path;43 if not FileExists(result) then44 result:=HomeDir+path41 result := DataDir + 'Localization\' + path; 42 if not FileExists(result) then 43 result := HomeDir + path 45 44 end; 46 45 47 48 46 var 49 AppDataDir: string;50 src,dst: TSearchRec;47 AppDataDir: string; 48 src, dst: TSearchRec; 51 49 52 50 initialization 53 HomeDir:=ExtractFilePath(ParamStr(0));54 51 52 HomeDir := ExtractFilePath(ParamStr(0)); 55 53 56 AppDataDir :=GetSpecialDirectory(CSIDL_APPDATA);57 if AppDataDir ='' then58 DataDir :=HomeDir54 AppDataDir := GetSpecialDirectory(CSIDL_APPDATA); 55 if AppDataDir = '' then 56 DataDir := HomeDir 59 57 else 60 61 if not DirectoryExists(AppDataDir +'\C-evo') then62 CreateDir(AppDataDir +'\C-evo');63 DataDir :=AppDataDir+'\C-evo\';64 65 if not DirectoryExists(DataDir +'Saved') then66 CreateDir(DataDir +'Saved');67 if not DirectoryExists(DataDir +'Maps') then68 CreateDir(DataDir +'Maps');58 begin 59 if not DirectoryExists(AppDataDir + '\C-evo') then 60 CreateDir(AppDataDir + '\C-evo'); 61 DataDir := AppDataDir + '\C-evo\'; 62 end; 63 if not DirectoryExists(DataDir + 'Saved') then 64 CreateDir(DataDir + 'Saved'); 65 if not DirectoryExists(DataDir + 'Maps') then 66 CreateDir(DataDir + 'Maps'); 69 67 70 68 // copy appdata if not done yet 71 if FindFirst(HomeDir +'AppData\Saved\*.cevo',$21,src)=0 then69 if FindFirst(HomeDir + 'AppData\Saved\*.cevo', $21, src) = 0 then 72 70 repeat 73 if (FindFirst(DataDir+'Saved\'+src.Name,$21,dst)<>0) 74 or (dst.Time<src.Time) then 75 CopyFile(PChar(HomeDir+'AppData\Saved\'+src.Name), 76 PChar(DataDir+'Saved\'+src.Name),false); 77 until FindNext(src)<>0; 71 if (FindFirst(DataDir + 'Saved\' + src.Name, $21, dst) <> 0) or 72 (dst.Time < src.Time) then 73 CopyFile(PChar(HomeDir + 'AppData\Saved\' + src.Name), 74 PChar(DataDir + 'Saved\' + src.Name), false); 75 until FindNext(src) <> 0; 76 78 77 end. -
trunk/GameServer.pas
r2 r6 1 1 {$INCLUDE switches} 2 // {$DEFINE TEXTLOG}3 // {$DEFINE LOADPERF}2 // {$DEFINE TEXTLOG} 3 // {$DEFINE LOADPERF} 4 4 unit GameServer; 5 5 … … 7 7 8 8 uses 9 Protocol, Database;9 Protocol, Database; 10 10 11 11 const 12 Version=$010200; 13 FirstAICompatibleVersion=$000D00; 14 FirstBookCompatibleVersion=$010103; 15 16 // notifications 17 ntCreateWorld=0; ntInitModule=$100; ntInitLocalHuman=$1FF; 18 ntDLLError=$200; ntAIError=$2FF; 19 ntClientError=$300; 20 ntInitPlayers=$400; ntDeactivationMissing=$410; 21 ntSetAIName=$420; 22 ntException=$500; 23 ntLoadBegin=$600; ntLoadState=$601; 24 ntEndInfo=$6FC; ntBackOn=$6FD; ntBackOff=$6FE; ntLoadError=$6FF; 25 ntStartDone=$700; ntStartGo=$701; ntStartGoRefresh=$702; 26 ntStartGoRefreshMaps=$703; 27 ntChangeClient=$800; ntNextPlayer=$810; 28 ntDeinitModule=$900; 29 30 // module flags 31 fMultiple=$10000000; fDotNet=$20000000; fUsed=$40000000; 32 33 // save map tile flags 34 smOwned=$20; smUnit=$40; smCity=$80; 35 36 maxBrain=255; 37 bixNoTerm=0; bixSuper_Virtual=1; bixTerm=2; bixRandom=3; bixFirstAI=4; 12 Version = $010200; 13 FirstAICompatibleVersion = $000D00; 14 FirstBookCompatibleVersion = $010103; 15 16 // notifications 17 ntCreateWorld = 0; 18 ntInitModule = $100; 19 ntInitLocalHuman = $1FF; 20 ntDLLError = $200; 21 ntAIError = $2FF; 22 ntClientError = $300; 23 ntInitPlayers = $400; 24 ntDeactivationMissing = $410; 25 ntSetAIName = $420; 26 ntException = $500; 27 ntLoadBegin = $600; 28 ntLoadState = $601; 29 ntEndInfo = $6FC; 30 ntBackOn = $6FD; 31 ntBackOff = $6FE; 32 ntLoadError = $6FF; 33 ntStartDone = $700; 34 ntStartGo = $701; 35 ntStartGoRefresh = $702; 36 ntStartGoRefreshMaps = $703; 37 ntChangeClient = $800; 38 ntNextPlayer = $810; 39 ntDeinitModule = $900; 40 41 // module flags 42 fMultiple = $10000000; 43 fDotNet = $20000000; 44 fUsed = $40000000; 45 46 // save map tile flags 47 smOwned = $20; 48 smUnit = $40; 49 smCity = $80; 50 51 maxBrain = 255; 52 bixNoTerm = 0; 53 bixSuper_Virtual = 1; 54 bixTerm = 2; 55 bixRandom = 3; 56 bixFirstAI = 4; 38 57 39 58 type 40 TNotifyFunction = procedure(ID: integer); 41 42 TBrainInfo= record 43 FileName, DLLName, Name, Credits: string; {filename and full name} 44 hm, {module handle} 45 Flags, 46 ServerVersion, 47 DataVersion, DataSize: integer; 48 Client: TClientCall; {client function address} 49 Initialized: boolean; 59 TNotifyFunction = procedure(ID: integer); 60 61 TBrainInfo = record 62 FileName, DLLName, Name, Credits: string; { filename and full name } 63 hm, { module handle } 64 Flags, ServerVersion, DataVersion, DataSize: integer; 65 Client: TClientCall; { client function address } 66 Initialized: boolean; 50 67 end; 51 68 52 69 var 53 // PARAMETERS 54 bixView: array[0..nPl-1]of integer; {brain index of the players} 55 Difficulty: array[0..nPl-1]of integer absolute Database.Difficulty; {difficulty} 56 57 // READ ONLY 58 DotNetClient: TClientCall; 59 bixBeginner, // AI to use for beginner level 60 nBrain: integer; {number of brains available} 61 Brain: array[-1..maxBrain-1] of TBrainInfo; {available brains} 62 NotifyMessage: string; 70 // PARAMETERS 71 bixView: array [0 .. nPl - 1] of integer; { brain index of the players } 72 Difficulty: array [0 .. nPl - 1] of integer absolute Database.Difficulty; 73 { difficulty } 74 75 // READ ONLY 76 DotNetClient: TClientCall; 77 bixBeginner, // AI to use for beginner level 78 nBrain: integer; { number of brains available } 79 Brain: array [-1 .. maxBrain - 1] of TBrainInfo; { available brains } 80 NotifyMessage: string; 63 81 64 82 procedure Init(NotifyFunction: TNotifyFunction); 65 83 procedure Done; 66 84 67 procedure StartNewGame(const Path, FileName, Map: string; Newlx, Newly, 68 NewLandMass, NewMaxTurn: integer); 69 function LoadGame(const Path, FileName: string; Turn: integer; MovieMode: boolean): boolean; 85 procedure StartNewGame(const Path, FileName, Map: string; 86 Newlx, Newly, NewLandMass, NewMaxTurn: integer); 87 function LoadGame(const Path, FileName: string; Turn: integer; 88 MovieMode: boolean): boolean; 70 89 procedure EditMap(const Map: string; Newlx, Newly, NewLandMass: integer); 71 90 procedure DirectHelp(Command: integer); … … 75 94 function PreviewMap(lm: integer): pointer; 76 95 77 78 96 implementation 79 97 80 98 uses 81 Directories, CityProcessing, UnitProcessing, CmdList, 82 83 Windows,Classes,SysUtils; 84 99 Directories, CityProcessing, UnitProcessing, CmdList, 100 101 Windows, Classes, SysUtils; 85 102 86 103 var 87 MaxTurn, 88 LoadTurn, {turn where to stop loading} 89 nLogOpened, {nLog of opened book} 90 {$IFOPT O-}nHandoverStack,{$ENDIF} 91 LastEndClientCommand, 92 pContacted, // player contacted for negotiation 93 pDipActive, // player who's to speak in a negotiation 94 pTurn, {player who's turn it is} 95 GWinner, 96 GColdWarStart, 97 GStealFrom, 98 SpyMission, 99 ZOCTile, 100 CCCommand, 101 CCPlayer: integer; 102 DebugMap: array[0..nPl-1] of pointer; 103 ExeInfo: TSearchRec; 104 Stat: array[0..nStat-1, 0..nPl-1] of ^TChart; 105 AutoSaveState: TCmdListState; 106 MapField: ^Cardinal; // predefined map 107 LastOffer: TOffer; 108 CCData: array[0..14] of integer; 109 DevModelTurn, {turn of last call to sResetModel} 110 bix, {brain index of the players} 111 OriginalDataVersion: array[0..nPl-1] of integer; 112 SavedTiles{, SavedResourceWeights}: array[0..ncmax-1] of cardinal; 113 SavedData: array[0..nPl-1] of pointer; 114 LogFileName, SavePath, {name of file for saving the current game} 115 MapFileName, // name of map to use, empty for random 116 AICredits: string; 117 AIInfo: array[0..nPl-1] of string; 118 Notify: TNotifyFunction; 119 PerfFreq, LastClientTime: int64; 120 {$IFOPT O-}HandoverStack: array[0..31] of Cardinal;{$ENDIF} 121 AutoSaveExists, 122 LoadOK, WinOnAlone, PreviewElevation, MovieStopped: boolean; 104 MaxTurn, LoadTurn, { turn where to stop loading } 105 nLogOpened, { nLog of opened book } 106 {$IFOPT O-}nHandoverStack, {$ENDIF} 107 LastEndClientCommand, pContacted, // player contacted for negotiation 108 pDipActive, // player who's to speak in a negotiation 109 pTurn, { player who's turn it is } 110 GWinner, GColdWarStart, GStealFrom, SpyMission, ZOCTile, CCCommand, 111 CCPlayer: integer; 112 DebugMap: array [0 .. nPl - 1] of pointer; 113 ExeInfo: TSearchRec; 114 Stat: array [0 .. nStat - 1, 0 .. nPl - 1] of ^TChart; 115 AutoSaveState: TCmdListState; 116 MapField: ^Cardinal; // predefined map 117 LastOffer: TOffer; 118 CCData: array [0 .. 14] of integer; 119 DevModelTurn, { turn of last call to sResetModel } 120 bix, { brain index of the players } 121 OriginalDataVersion: array [0 .. nPl - 1] of integer; 122 SavedTiles { , SavedResourceWeights } : array [0 .. ncmax - 1] of Cardinal; 123 SavedData: array [0 .. nPl - 1] of pointer; 124 LogFileName, SavePath, { name of file for saving the current game } 125 MapFileName, // name of map to use, empty for random 126 AICredits: string; 127 AIInfo: array [0 .. nPl - 1] of string; 128 Notify: TNotifyFunction; 129 PerfFreq, LastClientTime: int64; 130 {$IFOPT O-}HandoverStack: array [0 .. 31] of Cardinal; {$ENDIF} 131 AutoSaveExists, LoadOK, WinOnAlone, PreviewElevation, MovieStopped: boolean; 123 132 124 133 const 125 PreviewRND=41601260; {randseed for preview map}126 127 function Server(Command, Player,Subject:integer;var Data): integer; stdcall; forward;128 129 130 procedure CallPlayer(Command, p: integer; var Data);134 PreviewRND = 41601260; { randseed for preview map } 135 136 function Server(Command, Player, Subject: integer; var Data): integer; 137 stdcall; forward; 138 139 procedure CallPlayer(Command, p: integer; var Data); 131 140 begin 132 if ((Mode<>moMovie) or (p=0)) then141 if ((Mode <> moMovie) or (p = 0)) then 133 142 begin 134 135 HandoverStack[nHandoverStack]:=p;136 HandoverStack[nHandoverStack+1]:=Command;137 inc(nHandoverStack,2);138 Brain[bix[p]].Client(Command,p,Data);139 dec(nHandoverStack,2);140 141 try142 Brain[bix[p]].Client(Command,p,Data);143 except144 Notify(ntException+bix[p]);143 {$IFOPT O-} 144 HandoverStack[nHandoverStack] := p; 145 HandoverStack[nHandoverStack + 1] := Command; 146 inc(nHandoverStack, 2); 147 Brain[bix[p]].Client(Command, p, Data); 148 dec(nHandoverStack, 2); 149 {$ELSE} 150 try 151 Brain[bix[p]].Client(Command, p, Data); 152 except 153 Notify(ntException + bix[p]); 145 154 end; 146 155 {$ENDIF} 147 156 end 148 157 end; 149 158 150 procedure CallClient(bix, Command: integer; var Data);159 procedure CallClient(bix, Command: integer; var Data); 151 160 begin 152 if ((Mode<>moMovie) or (bix=GameServer.bix[0])) then161 if ((Mode <> moMovie) or (bix = GameServer.bix[0])) then 153 162 begin 154 155 HandoverStack[nHandoverStack]:=bix;156 HandoverStack[nHandoverStack+1]:=Command;157 inc(nHandoverStack,2);158 Brain[bix].Client(Command,-1,Data);159 dec(nHandoverStack,2);160 161 try162 Brain[bix].Client(Command,-1,Data);163 except164 Notify(ntException+bix);163 {$IFOPT O-} 164 HandoverStack[nHandoverStack] := bix; 165 HandoverStack[nHandoverStack + 1] := Command; 166 inc(nHandoverStack, 2); 167 Brain[bix].Client(Command, -1, Data); 168 dec(nHandoverStack, 2); 169 {$ELSE} 170 try 171 Brain[bix].Client(Command, -1, Data); 172 except 173 Notify(ntException + bix); 165 174 end; 166 175 {$ENDIF} 167 176 end 168 177 end; … … 170 179 procedure Init(NotifyFunction: TNotifyFunction); 171 180 var 172 i: integer;173 f: TSearchRec;174 T: TextFile;175 s: string;181 i: integer; 182 f: TSearchRec; 183 T: TextFile; 184 s: string; 176 185 177 186 begin 178 Notify:=NotifyFunction;179 PreviewElevation:=false;180 181 {get available brains}182 Brain[bixNoTerm].FileName:=':AIT';183 Brain[bixNoTerm].Flags:=0;184 Brain[bixNoTerm].Initialized:=false;185 Brain[bixSuper_Virtual].FileName:=':Supervisor';186 Brain[bixSuper_Virtual].Flags:=0;187 Brain[bixSuper_Virtual].Initialized:=false;188 Brain[bixTerm].FileName:=':StdIntf';189 Brain[bixTerm].Flags:=fMultiple;190 Brain[bixTerm].Initialized:=false;191 Brain[bixTerm].ServerVersion:=Version;192 Brain[bixRandom].FileName:=':Random';193 Brain[bixRandom].Flags:=fMultiple;194 Brain[bixRandom].Initialized:=false;195 nBrain:=bixFirstAI;196 bixBeginner:=bixFirstAI;197 if FindFirst(HomeDir+'*.ai.txt',$21,f)=0 then198 repeat199 with Brain[nBrain] do200 begin 201 FileName:=Copy(f.Name,1,Length(f.Name)-7);202 DLLName:=HomeDir+FileName;203 Name:=Copy(f.Name,1,Length(f.Name)-7);204 Credits:='';205 Flags:=fMultiple;206 Client:=nil;207 Initialized:=false;208 ServerVersion:=0;209 AssignFile(T,HomeDir+f.Name);210 Reset(T);211 while not EOF(T) do187 Notify := NotifyFunction; 188 PreviewElevation := false; 189 190 { get available brains } 191 Brain[bixNoTerm].FileName := ':AIT'; 192 Brain[bixNoTerm].Flags := 0; 193 Brain[bixNoTerm].Initialized := false; 194 Brain[bixSuper_Virtual].FileName := ':Supervisor'; 195 Brain[bixSuper_Virtual].Flags := 0; 196 Brain[bixSuper_Virtual].Initialized := false; 197 Brain[bixTerm].FileName := ':StdIntf'; 198 Brain[bixTerm].Flags := fMultiple; 199 Brain[bixTerm].Initialized := false; 200 Brain[bixTerm].ServerVersion := Version; 201 Brain[bixRandom].FileName := ':Random'; 202 Brain[bixRandom].Flags := fMultiple; 203 Brain[bixRandom].Initialized := false; 204 nBrain := bixFirstAI; 205 bixBeginner := bixFirstAI; 206 if FindFirst(HomeDir + '*.ai.txt', $21, f) = 0 then 207 repeat 208 with Brain[nBrain] do 209 begin 210 FileName := Copy(f.Name, 1, Length(f.Name) - 7); 211 DLLName := HomeDir + FileName; 212 Name := Copy(f.Name, 1, Length(f.Name) - 7); 213 Credits := ''; 214 Flags := fMultiple; 215 Client := nil; 216 Initialized := false; 217 ServerVersion := 0; 218 AssignFile(T, HomeDir + f.Name); 219 Reset(T); 220 while not EOF(T) do 212 221 begin 213 ReadLn(T,s); 214 s:=trim(s); 215 if Copy(s,1,5)='#NAME' then Name:=Copy(s,7,255) 216 else if Copy(s,1,10)='#.NET' then 217 Flags:=Flags or fDotNet 218 else if Copy(s,1,9)='#BEGINNER' then 219 bixBeginner:=nBrain 220 else if Copy(s,1,5)='#PATH' then 221 DLLName:=HomeDir+trim(Copy(s,7,255)) 222 else if Copy(s,1,12)='#GAMEVERSION' then 223 for i:=13 to Length(s) do 224 case s[i] of 225 '0'..'9': ServerVersion:=ServerVersion and $FFFF00 226 +ServerVersion and $FF *10+ord(s[i])-48; 227 '.': ServerVersion:=ServerVersion shl 8; 222 ReadLn(T, s); 223 s := trim(s); 224 if Copy(s, 1, 5) = '#NAME' then 225 Name := Copy(s, 7, 255) 226 else if Copy(s, 1, 10) = '#.NET' then 227 Flags := Flags or fDotNet 228 else if Copy(s, 1, 9) = '#BEGINNER' then 229 bixBeginner := nBrain 230 else if Copy(s, 1, 5) = '#PATH' then 231 DLLName := HomeDir + trim(Copy(s, 7, 255)) 232 else if Copy(s, 1, 12) = '#GAMEVERSION' then 233 for i := 13 to Length(s) do 234 case s[i] of 235 '0' .. '9': 236 ServerVersion := ServerVersion and $FFFF00 + ServerVersion and 237 $FF * 10 + ord(s[i]) - 48; 238 '.': 239 ServerVersion := ServerVersion shl 8; 228 240 end 229 else if Copy(s,1,8)='#CREDITS' then230 Credits:=Copy(s,10,255)241 else if Copy(s, 1, 8) = '#CREDITS' then 242 Credits := Copy(s, 10, 255) 231 243 end; 232 CloseFile(T);233 end; 234 if (Brain[nBrain].ServerVersion>=FirstAICompatibleVersion)235 and (Brain[nBrain].ServerVersion<=Version)236 and ((Brain[nBrain].Flags and fDotNet=0) or (@DotNetClient<>nil)) then237 inc(nBrain);238 until FindNext(f)<>0;244 CloseFile(T); 245 end; 246 if (Brain[nBrain].ServerVersion >= FirstAICompatibleVersion) and 247 (Brain[nBrain].ServerVersion <= Version) and 248 ((Brain[nBrain].Flags and fDotNet = 0) or (@DotNetClient <> nil)) then 249 inc(nBrain); 250 until FindNext(f) <> 0; 239 251 end; 240 252 241 253 procedure Done; 242 254 var 243 i: integer;255 i: integer; 244 256 begin 245 for i:=0 to nBrain-1 do if Brain[i].Initialized then 246 begin 247 CallClient(i, cReleaseModule, nil^); 248 if (i>=bixFirstAI) and (Brain[i].Flags and fDotNet=0) then 249 FreeLibrary(Brain[i].hm); 250 end; 257 for i := 0 to nBrain - 1 do 258 if Brain[i].Initialized then 259 begin 260 CallClient(i, cReleaseModule, nil^); 261 if (i >= bixFirstAI) and (Brain[i].Flags and fDotNet = 0) then 262 FreeLibrary(Brain[i].hm); 263 end; 251 264 end; 252 265 253 266 function PreviewMap(lm: integer): pointer; 254 267 begin 255 lx:=lxmax; ly:=lymax; MapSize:=lx*ly; 256 LandMass:=lm; 257 RandSeed:=PreviewRND; 258 if not PreviewElevation then 268 lx := lxmax; 269 ly := lymax; 270 MapSize := lx * ly; 271 LandMass := lm; 272 RandSeed := PreviewRND; 273 if not PreviewElevation then 259 274 begin 260 CreateElevation;261 PreviewElevation:=true;275 CreateElevation; 276 PreviewElevation := true; 262 277 end; 263 CreateMap(true);264 result:=@RealMap;278 CreateMap(true); 279 result := @RealMap; 265 280 end; 266 281 … … 268 283 DataSize: integer); 269 284 begin 270 CCCommand:=Command; 271 CCPlayer:=Player; 272 if DataSize>0 then move(Data,CCData,DataSize); 273 Notify(ntChangeClient); 285 CCCommand := Command; 286 CCPlayer := Player; 287 if DataSize > 0 then 288 move(Data, CCData, DataSize); 289 Notify(ntChangeClient); 274 290 end; 275 291 276 292 procedure PutMessage(Level: integer; Text: string); 277 293 begin 278 Brain[bix[0]].Client(cDebugMessage,Level,pchar(Text)^);294 Brain[bix[0]].Client(cDebugMessage, Level, pchar(Text)^); 279 295 end; 280 296 281 297 procedure ForceClientDeactivation; 282 298 var 283 NullOffer: TOffer;299 NullOffer: TOffer; 284 300 begin 285 if pDipActive<0 then Server(sTurn,pTurn,0,nil^) // no nego mode 286 else case LastEndClientCommand of // nego mode 287 scContact: Server(scReject,pDipActive,0,nil^); 288 scDipCancelTreaty, scDipBreak: Server(scDipNotice,pDipActive,0,nil^); 301 if pDipActive < 0 then 302 Server(sTurn, pTurn, 0, nil^) // no nego mode 289 303 else 290 begin // make null offer 291 NullOffer.nDeliver:=0; 292 NullOffer.nCost:=0; 293 Server(scDipOffer,pDipActive,0,NullOffer); 304 case LastEndClientCommand of // nego mode 305 scContact: 306 Server(scReject, pDipActive, 0, nil^); 307 scDipCancelTreaty, scDipBreak: 308 Server(scDipNotice, pDipActive, 0, nil^); 309 else 310 begin // make null offer 311 NullOffer.nDeliver := 0; 312 NullOffer.nCost := 0; 313 Server(scDipOffer, pDipActive, 0, NullOffer); 314 end 315 end 316 end; 317 318 procedure ChangeClient; 319 // hand over control to other client (as specified by CC...) 320 var 321 p: integer; 322 T: int64; 323 begin 324 QueryPerformanceCounter(T); 325 PutMessage(1 shl 16 + 2, Format('CLIENT: took %.1f ms', 326 [{$IFDEF VER100}(T.LowPart - LastClientTime.LowPart) 327 {$ELSE}(T - LastClientTime){$ENDIF} * 1000.0 / PerfFreq])); 328 LastClientTime := T; 329 PutMessage(1 shl 16 + 2, Format('CLIENT: calling %d (%s)', 330 [CCPlayer, Brain[bix[CCPlayer]].Name])); 331 if CCCommand = cTurn then 332 for p := 0 to nPl - 1 do 333 if (p <> CCPlayer) and (1 shl p and GWatching <> 0) then 334 CallPlayer(cShowTurnChange, p, CCPlayer); 335 336 p := CCPlayer; 337 CCPlayer := -1; 338 CallPlayer(CCCommand, p, CCData); 339 if (Mode = moPlaying) and (Brain[bix[p]].Flags and aiThreaded = 0) and 340 (CCPlayer < 0) then 341 begin 342 Notify(ntDeactivationMissing + p); 343 ForceClientDeactivation; 344 end 345 end; 346 347 procedure Inform(p: integer); 348 var 349 i, p1: integer; 350 begin 351 RW[p].Turn := GTurn; 352 if (GTurn = MaxTurn) and (p = pTurn) and (p = 0) then 353 RW[p].Happened := RW[p].Happened or phTimeUp; 354 if (GWinner > 0) and (p = pTurn) and (p = 0) then 355 RW[p].Happened := RW[p].Happened or phShipComplete; 356 RW[p].Alive := GAlive; 357 move(GWonder, RW[p].Wonder, SizeOf(GWonder)); 358 move(GShip, RW[p].Ship, SizeOf(GShip)); 359 for p1 := 0 to nPl - 1 do 360 if (p1 <> p) and (bix[p1] >= 0) and (Difficulty[p1] > 0) then 361 RW[p].EnemyReport[p1].Credibility := RW[p1].Credibility; 362 for p1 := 0 to nPl - 1 do 363 if (p1 <> p) and (1 shl p1 and GAlive <> 0) then 364 begin 365 if (GTestFlags and tfUncover <> 0) or (Difficulty[p] = 0) or 366 (RW[p].Treaty[p1] >= trFriendlyContact) then 367 GiveCivilReport(p, p1); 368 if (GTestFlags and tfUncover <> 0) or (Difficulty[p] = 0) or 369 (RW[p].Treaty[p1] = trAlliance) then 370 GiveMilReport(p, p1) 371 end; 372 for i := 0 to RW[p].nEnemyModel - 1 do 373 with RW[p].EnemyModel[i] do 374 Lost := Destroyed[p, Owner, mix]; 375 end; 376 377 procedure LogChanges; 378 var 379 p, ix: integer; 380 begin 381 for p := 0 to nPl - 1 do 382 if (1 shl p and GWatching <> 0) and ProcessClientData[p] then 383 begin 384 // log unit status changes 385 for ix := 0 to RW[p].nUn - 1 do 386 with RW[p].Un[ix] do 387 if (Loc >= 0) and (SavedStatus <> Status) then 388 begin 389 CL.Put(sIntSetUnitStatus, p, ix, @Status); 390 SavedStatus := Status 391 end; 392 // log city status changes 393 for ix := 0 to RW[p].nCity - 1 do 394 with RW[p].City[ix] do 395 if (Loc >= 0) and (SavedStatus <> Status) then 396 begin 397 CL.Put(sIntSetCityStatus, p, ix, @Status); 398 SavedStatus := Status 399 end; 400 // log model status changes 401 for ix := 0 to RW[p].nModel - 1 do 402 with RW[p].Model[ix] do 403 if SavedStatus <> Status then 404 begin 405 CL.Put(sIntSetModelStatus, p, ix, @Status); 406 SavedStatus := Status 407 end; 408 // log enemy city status changes 409 for ix := 0 to RW[p].nEnemyCity - 1 do 410 with RW[p].EnemyCity[ix] do 411 if (Loc >= 0) and (SavedStatus <> Status) then 412 begin 413 CL.Put(sIntSetECityStatus, p, ix, @Status); 414 SavedStatus := Status 415 end; 416 // log data changes 417 if Brain[bix[p]].DataSize > 0 then 418 begin 419 CL.PutDataChanges(sIntDataChange, p, SavedData[p], RW[p].Data, 420 Brain[bix[p]].DataSize); 421 move(RW[p].Data^, SavedData[p]^, Brain[bix[p]].DataSize * 4); 422 end 423 end; 424 end; 425 426 procedure NoLogChanges; 427 var 428 p, ix: integer; 429 begin 430 for p := 0 to nPl - 1 do 431 if (1 shl p and GWatching <> 0) and ProcessClientData[p] then 432 begin 433 for ix := 0 to RW[p].nUn - 1 do 434 with RW[p].Un[ix] do 435 SavedStatus := Status; 436 for ix := 0 to RW[p].nCity - 1 do 437 with RW[p].City[ix] do 438 SavedStatus := Status; 439 for ix := 0 to RW[p].nModel - 1 do 440 with RW[p].Model[ix] do 441 SavedStatus := Status; 442 for ix := 0 to RW[p].nEnemyCity - 1 do 443 with RW[p].EnemyCity[ix] do 444 SavedStatus := Status; 445 if Brain[bix[p]].DataSize > 0 then 446 move(RW[p].Data^, SavedData[p]^, Brain[bix[p]].DataSize * 4); 447 end; 448 end; 449 450 function HasChanges(p: integer): boolean; 451 type 452 TDWordList = array [0 .. INFIN] of Cardinal; 453 PDWortList = ^TDWordList; 454 var 455 ix: integer; 456 begin 457 result := false; 458 for ix := 0 to RW[p].nUn - 1 do 459 with RW[p].Un[ix] do 460 if (Loc >= 0) and (SavedStatus <> Status) then 461 result := true; 462 for ix := 0 to RW[p].nCity - 1 do 463 with RW[p].City[ix] do 464 if (Loc >= 0) and (SavedStatus <> Status) then 465 result := true; 466 for ix := 0 to RW[p].nModel - 1 do 467 with RW[p].Model[ix] do 468 if SavedStatus <> Status then 469 result := true; 470 for ix := 0 to RW[p].nEnemyCity - 1 do 471 with RW[p].EnemyCity[ix] do 472 if (Loc >= 0) and (SavedStatus <> Status) then 473 result := true; 474 if RW[p].Data <> nil then 475 for ix := 0 to Brain[bix[p]].DataSize - 1 do 476 if PDWortList(SavedData[p])[ix] <> PDWortList(RW[p].Data)[ix] then 477 result := true 478 end; 479 480 procedure InitBrain(bix: integer); 481 var 482 InitModuleData: TInitModuleData; 483 begin 484 assert(bix <> bixSuper_Virtual); 485 with Brain[bix] do 486 begin 487 if Initialized then 488 exit; 489 if bix >= bixFirstAI then 490 begin { get client function } 491 Notify(ntInitModule + bix); 492 if Flags and fDotNet > 0 then 493 Client := DotNetClient 494 else 495 begin 496 hm := LoadLibrary(pchar(DLLName)); 497 if hm = 0 then 498 begin 499 Client := nil; 500 Notify(ntDLLError + bix); 501 end 502 else 503 begin 504 Client := GetProcAddress(hm, 'client'); 505 if @Client = nil then 506 Notify(ntClientError + bix); 507 end 508 end 509 end; 510 if @Client <> nil then 511 begin 512 Initialized := true; 513 InitModuleData.Server := @Server; 514 InitModuleData.DataVersion := 0; 515 InitModuleData.DataSize := 0; 516 InitModuleData.Flags := 0; 517 CallClient(bix, cInitModule, InitModuleData); 518 DataVersion := InitModuleData.DataVersion; 519 DataSize := (InitModuleData.DataSize + 3) div 4; 520 if DataSize > MaxDataSize then 521 DataSize := 0; 522 Flags := Flags or InitModuleData.Flags; 294 523 end 295 524 end 296 525 end; 297 526 298 procedure ChangeClient; 299 //hand over control to other client (as specified by CC...) 527 procedure SaveMap(FileName: string); 300 528 var 301 p: integer; 302 T: int64; 529 i: integer; 530 MapFile: TFileStream; 531 s: string[255]; 303 532 begin 304 QueryPerformanceCounter(T); 305 PutMessage(1 shl 16+2, Format('CLIENT: took %.1f ms', 306 [{$IFDEF VER100}(T.LowPart-LastClientTime.LowPart) 307 {$ELSE}(T-LastClientTime){$ENDIF}*1000.0/PerfFreq])); 308 LastClientTime:=T; 309 PutMessage(1 shl 16+2, Format('CLIENT: calling %d (%s)', 310 [CCPlayer,Brain[bix[CCPlayer]].Name])); 311 if CCCommand=cTurn then 312 for p:=0 to nPl-1 do if (p<>CCPlayer) and (1 shl p and GWatching<>0) then 313 CallPlayer(cShowTurnChange,p,CCPlayer); 314 315 p:=CCPlayer; 316 CCPlayer:=-1; 317 CallPlayer(CCCommand,p,CCData); 318 if (Mode=moPlaying) and (Brain[bix[p]].Flags and aiThreaded=0) and (CCPlayer<0) then 533 MapFile := TFileStream.Create(DataDir + 'Maps\' + FileName, 534 fmCreate or fmShareExclusive); 535 MapFile.Position := 0; 536 s := 'cEvoMap'#0; 537 MapFile.write(s[1], 8); { file id } 538 i := 0; 539 MapFile.write(i, 4); { format id } 540 MapFile.write(MaxTurn, 4); 541 MapFile.write(lx, 4); 542 MapFile.write(ly, 4); 543 MapFile.write(RealMap, MapSize * 4); 544 MapFile.Free; 545 end; 546 547 function LoadMap(FileName: string): boolean; 548 var 549 i, Loc1: integer; 550 MapFile: TFileStream; 551 s: string[255]; 552 begin 553 result := false; 554 MapFile := nil; 555 try 556 MapFile := TFileStream.Create(DataDir + 'Maps\' + FileName, 557 fmOpenRead or fmShareExclusive); 558 MapFile.Position := 0; 559 MapFile.read(s[1], 8); { file id } 560 MapFile.read(i, 4); { format id } 561 if i = 0 then 562 begin 563 MapFile.read(i, 4); // MaxTurn 564 MapFile.read(lx, 4); 565 MapFile.read(ly, 4); 566 ly := ly and not 1; 567 if lx > lxmax then 568 lx := lxmax; 569 if ly > lymax then 570 ly := lymax; 571 MapSize := lx * ly; 572 MapFile.read(RealMap, MapSize * 4); 573 for Loc1 := 0 to MapSize - 1 do 574 begin 575 RealMap[Loc1] := RealMap[Loc1] and 576 ($7F01FFFF or fPrefStartPos or fStartPos) or ($F shl 27); 577 if RealMap[Loc1] and (fTerrain or fSpecial) = fSwamp or fSpecial2 then 578 RealMap[Loc1] := RealMap[Loc1] and not(fTerrain or fSpecial) or 579 (fSwamp or fSpecial1); 580 if (RealMap[Loc1] and fDeadLands <> 0) and 581 (RealMap[Loc1] and fTerrain <> fArctic) then 582 RealMap[Loc1] := RealMap[Loc1] and not(fTerrain or fSpecial) 583 or fDesert; 584 end; 585 result := true; 586 end; 587 MapFile.Free; 588 except 589 if MapFile <> nil then 590 MapFile.Free; 591 end; 592 end; 593 594 procedure SaveGame(FileName: string; auto: boolean); 595 var 596 x, y, i, zero, Tile, nLocal: integer; 597 LogFile: TFileStream; 598 s: string[255]; 599 SaveMap: array [0 .. lxmax * lymax - 1] of Byte; 600 begin 601 nLocal := 0; 602 for i := 0 to nPl - 1 do 603 if bix[i] = bixTerm then 604 inc(nLocal); 605 if Difficulty[0] = 0 then 606 nLocal := 0; 607 if nLocal <= 1 then 608 for y := 0 to ly - 1 do 609 for x := 0 to lx - 1 do 610 begin 611 Tile := RW[0].Map[(x + SaveMapCenterLoc + lx shr 1) mod lx + lx * y]; 612 SaveMap[x + lx * y] := Tile and fTerrain + Tile and 613 (fCity or fUnit or fOwned) shr 16; 614 end; 615 616 if auto and AutoSaveExists then // append to existing file 617 LogFile := TFileStream.Create(SavePath + FileName, fmOpenReadWrite or 618 fmShareExclusive) 619 else // create new file 620 LogFile := TFileStream.Create(SavePath + FileName, 621 fmCreate or fmShareExclusive); 622 623 zero := 0; 624 LogFile.Position := 0; 625 s := 'cEvoBook'; 626 LogFile.write(s[1], 8); { file id } 627 i := Version; 628 LogFile.write(i, 4); { c-evo version } 629 LogFile.write(ExeInfo.Time, 4); 630 LogFile.write(lx, 4); 631 LogFile.write(ly, 4); 632 LogFile.write(LandMass, 4); 633 if LandMass = 0 then 634 LogFile.write(MapField^, MapSize * 4); 635 636 LogFile.write(MaxTurn, 4); 637 LogFile.write(RND, 4); 638 LogFile.write(GTurn, 4); 639 if nLocal > 1 then // multiplayer game -- no quick view 319 640 begin 320 Notify(ntDeactivationMissing+p); 321 ForceClientDeactivation; 641 i := $80; 642 LogFile.write(i, 4); 643 end 644 else 645 LogFile.write(SaveMap, ((MapSize - 1) div 4 + 1) * 4); 646 for i := 0 to nPl - 1 do 647 if bix[i] < 0 then 648 LogFile.write(zero, 4) 649 else 650 begin 651 if bixView[i] >= bixRandom then 652 s := Brain[bix[i]].FileName 653 else 654 s := Brain[bixView[i]].FileName; 655 move(zero, s[Length(s) + 1], 4); 656 LogFile.write(s, (Length(s) div 4 + 1) * 4); 657 LogFile.write(OriginalDataVersion[i], 4); 658 s := ''; { behavior } 659 move(zero, s[Length(s) + 1], 4); 660 LogFile.write(s, (Length(s) div 4 + 1) * 4); 661 LogFile.write(Difficulty[i], 4); 662 end; 663 664 if auto and AutoSaveExists then 665 CL.AppendToFile(LogFile, AutoSaveState) 666 else 667 CL.SaveToFile(LogFile); 668 LogFile.Free; 669 if auto then 670 begin 671 AutoSaveState := CL.State; 672 AutoSaveExists := true 322 673 end 323 674 end; 324 675 325 procedure Inform(p: integer);676 procedure StartGame; 326 677 var 327 i,p1: integer; 678 i, p, p1, Human, nAlive, bixUni: integer; 679 Game: TNewGameData; 680 // GameEx: TNewGameExData; 681 Path: shortstring; 682 BrainUsed: Set of 0 .. 254; { used brains } 328 683 begin 329 RW[p].Turn:=GTurn; 330 if (GTurn=MaxTurn) and (p=pTurn) and (p=0) then 331 RW[p].Happened:=RW[p].Happened or phTimeUp; 332 if (GWinner>0) and (p=pTurn) and (p=0) then 333 RW[p].Happened:=RW[p].Happened or phShipComplete; 334 RW[p].Alive:=GAlive; 335 move(GWonder,RW[p].Wonder,SizeOf(GWonder)); 336 move(GShip,RW[p].Ship,SizeOf(GShip)); 337 for p1:=0 to nPl-1 do 338 if (p1<>p) and (bix[p1]>=0) and (Difficulty[p1]>0) then 339 RW[p].EnemyReport[p1].Credibility:=RW[p1].Credibility; 340 for p1:=0 to nPl-1 do 341 if (p1<>p) and (1 shl p1 and GAlive<>0) then 684 for p1 := 0 to nPl - 1 do 685 begin 686 if bixView[p1] = bixSuper_Virtual then 687 bix[p1] := bixTerm // supervisor and local human use same module 688 else if bixView[p1] = bixRandom then 689 if nBrain <= bixFirstAI then 690 bix[p1] := -1 691 else 692 bix[p1] := bixFirstAI + random(nBrain - bixFirstAI) 693 else 694 bix[p1] := bixView[p1]; 695 if bixView[p1] < 0 then 696 Difficulty[p1] := -1; 697 end; 698 699 if bix[0] <> bixNoTerm then 700 Notify(ntInitLocalHuman); 701 BrainUsed := []; 702 for p := 0 to nPl - 1 do 703 if (bix[p] >= 0) and ((Mode <> moMovie) or (p = 0)) then 704 begin { initiate selected control module } 705 AIInfo[p] := Brain[bix[p]].Name + #0; 706 InitBrain(bix[p]); 707 if Mode = moPlaying then 708 begin // new game, this data version is original 709 OriginalDataVersion[p] := Brain[bix[p]].DataVersion; 710 ProcessClientData[p] := true; 711 end 712 else // loading game, compare with data version read from file 713 ProcessClientData[p] := ProcessClientData[p] and 714 (OriginalDataVersion[p] = Brain[bix[p]].DataVersion); 715 if @Brain[bix[p]].Client = nil then // client function not found 716 if bix[0] = bixNoTerm then 717 bix[p] := -1 718 else 719 begin 720 bix[p] := bixTerm; 721 OriginalDataVersion[p] := -1; 722 ProcessClientData[p] := false; 723 end; 724 if bix[p] >= 0 then 725 include(BrainUsed, bix[p]) 726 end; 727 728 Notify(ntCreateWorld); 729 nAlive := 0; 730 GAlive := 0; 731 if Mode = moMovie then 732 GWatching := 1 733 else 734 GWatching := 0; 735 GAI := 0; 736 for p1 := 0 to nPl - 1 do 737 if bix[p1] >= 0 then 342 738 begin 343 if (GTestFlags and tfUncover<>0) or (Difficulty[p]=0) 344 or (RW[p].Treaty[p1]>=trFriendlyContact) then 345 GiveCivilReport(p, p1); 346 if (GTestFlags and tfUncover<>0) or (Difficulty[p]=0) 347 or (RW[p].Treaty[p1]=trAlliance) then 348 GiveMilReport(p, p1) 739 if Mode <> moMovie then 740 inc(GWatching, 1 shl p1); 741 if bix[p1] >= bixFirstAI then 742 inc(GAI, 1 shl p1); 743 if Difficulty[p1] > 0 then 744 begin 745 inc(GAlive, 1 shl p1); 746 inc(nAlive); 747 end; 748 ServerVersion[p1] := Brain[bix[p1]].ServerVersion; 349 749 end; 350 for i:=0 to RW[p].nEnemyModel-1 do with RW[p].EnemyModel[i] do 351 Lost:=Destroyed[p,Owner,mix]; 750 WinOnAlone := (bix[0] = bixNoTerm) and (nAlive > 1); 751 GWinner := 0; 752 GColdWarStart := -ColdWarTurns - 1; 753 uixSelectedTransport := -1; 754 SpyMission := smSabotageProd; 755 for p1 := 0 to nPl - 1 do 756 DebugMap[p1] := nil; 757 758 GTurn := 0; 759 for i := 0 to 27 do 760 with GWonder[i] do 761 begin 762 CityID := -1; 763 EffectiveOwner := -1 764 end; 765 FillChar(GShip, SizeOf(GShip), 0); 766 767 for p := 0 to nPl - 1 do 768 if 1 shl p and (GAlive or GWatching) <> 0 then 769 with RW[p] do 770 begin 771 Government := gDespotism; 772 Money := StartMoney; 773 TaxRate := 30; 774 LuxRate := 0; 775 Research := 0; 776 ResearchTech := -2; 777 AnarchyStart := -AnarchyTurns - 1; 778 Happened := 0; 779 LastValidStat[p] := -1; 780 Worked[p] := 0; 781 Founded[p] := 0; 782 DevModelTurn[p] := -1; 783 OracleIncome := 0; 784 785 if Brain[bix[p]].DataSize > 0 then 786 begin 787 GetMem(SavedData[p], Brain[bix[p]].DataSize * 4); 788 GetMem(Data, Brain[bix[p]].DataSize * 4); 789 FillChar(SavedData[p]^, Brain[bix[p]].DataSize * 4, 0); 790 FillChar(Data^, Brain[bix[p]].DataSize * 4, 0); 791 end 792 else 793 begin 794 Data := nil; 795 SavedData[p] := nil 796 end; 797 nBattleHistory := 0; 798 BattleHistory := nil; 799 { if bix[p]=bixTerm then 800 begin 801 GetMem(BorderHelper,MapSize); 802 FillChar(BorderHelper^,MapSize,0); 803 end 804 else } BorderHelper := nil; 805 for i := 0 to nStat - 1 do 806 GetMem(Stat[i, p], 4 * (MaxTurn + 1)); 807 if Brain[bix[p]].Flags and fDotNet <> 0 then 808 begin 809 GetMem(RW[p].DefaultDebugMap, MapSize * 4); 810 FillChar(RW[p].DefaultDebugMap^, MapSize * 4, 0); 811 DebugMap[p] := RW[p].DefaultDebugMap; 812 end 813 else 814 RW[p].DefaultDebugMap := nil; 815 816 { !!!for i:=0 to nShipPart-1 do GShip[p].Parts[i]:=random((3-i)*2);{ } 817 end; 818 819 if LandMass > 0 then 820 begin // random map 821 InitRandomGame; 822 PreviewElevation := false; 823 MapField := nil; 824 end 825 else 826 begin // predefined map 827 if Mode = moPlaying then 828 LoadMap(MapFileName); // new game -- load map from file 829 GetMem(MapField, MapSize * 4); 830 move(RealMap, MapField^, MapSize * 4); 831 Human := 0; 832 for p1 := 0 to nPl - 1 do 833 if bix[p1] = bixTerm then 834 inc(Human, 1 shl p1); 835 InitMapGame(Human); 836 end; 837 CityProcessing.InitGame; 838 UnitProcessing.InitGame; 839 for p := 0 to nPl - 1 do 840 if 1 shl p and (GAlive or GWatching) <> 0 then 841 Inform(p); 842 843 pTurn := -1; 844 if bix[0] <> bixNoTerm then 845 Notify(ntInitLocalHuman); 846 Game.lx := lx; 847 Game.ly := ly; 848 Game.LandMass := LandMass; 849 Game.MaxTurn := MaxTurn; 850 move(Difficulty, Game.Difficulty, SizeOf(Difficulty)); 851 // GameEx.lx:=lx; GameEx.ly:=ly; GameEx.LandMass:=LandMass; 852 // GameEx.MaxTurn:=MaxTurn; GameEx.RND:=RND; 853 // move(Difficulty,GameEx.Difficulty,SizeOf(Difficulty)); 854 AICredits := ''; 855 for i := 0 to nBrain - 1 do 856 if Brain[i].Initialized then 857 if i in BrainUsed then 858 begin 859 if i >= bixFirstAI then 860 Notify(ntInitPlayers); 861 for p := 0 to nPl - 1 do 862 begin 863 if bix[p] = i then 864 Game.RO[p] := @RW[p] 865 else 866 Game.RO[p] := nil; 867 if (i = bixTerm) and (Difficulty[0] = 0) and (bix[p] >= 0) then 868 Game.SuperVisorRO[p] := @RW[p] 869 else 870 Game.SuperVisorRO[p] := nil; 871 end; 872 if Brain[i].Flags and fDotNet > 0 then 873 begin 874 Path := Brain[i].DLLName; 875 move(Path[1], Game.AssemblyPath, Length(Path)); 876 Game.AssemblyPath[Length(Path)] := #0; 877 end 878 else 879 Game.AssemblyPath[0] := #0; 880 case Mode of 881 moLoading, moLoading_Fast: 882 CallClient(i, cLoadGame, Game); 883 moMovie: 884 CallClient(i, cMovie, Game); 885 moPlaying: 886 CallClient(i, cNewGame, Game); 887 end; 888 if (i >= bixFirstAI) and (Brain[i].Credits <> '') then 889 if AICredits = '' then 890 AICredits := Brain[i].Credits 891 else 892 AICredits := AICredits + '\' + Brain[i].Credits 893 end 894 else 895 begin { module no longer used -- unload } 896 CallClient(i, cReleaseModule, nil^); 897 if i >= bixFirstAI then 898 begin 899 if Brain[i].Flags and fDotNet = 0 then 900 FreeLibrary(Brain[i].hm); 901 Brain[i].Client := nil; 902 end; 903 Brain[i].Initialized := false; 904 end; 905 AICredits := AICredits + #0; 906 907 if bix[0] <> bixNoTerm then 908 begin 909 // uni ai? 910 bixUni := -1; 911 for p1 := 0 to nPl - 1 do 912 if bix[p1] >= bixFirstAI then 913 if bixUni = -1 then 914 bixUni := bix[p1] 915 else if bixUni <> bix[p1] then 916 bixUni := -2; 917 for p1 := 0 to nPl - 1 do 918 if bix[p1] >= bixFirstAI then 919 begin 920 if bixUni = -2 then 921 NotifyMessage := Brain[bix[p1]].FileName 922 else 923 NotifyMessage := ''; 924 Notify(ntSetAIName + p1); 925 end 926 end; 927 928 CheckBorders(-1); 929 {$IFOPT O-}InvalidTreatyMap := 0; {$ENDIF} 930 AutoSaveExists := false; 931 pDipActive := -1; 932 pTurn := 0; 933 934 if Mode >= moMovie then 935 Notify(ntEndInfo); 936 end; { StartGame } 937 938 procedure EndGame; 939 var 940 i, p1: integer; 941 begin 942 if LandMass = 0 then 943 FreeMem(MapField); 944 for p1 := 0 to nPl - 1 do 945 if bix[p1] >= 0 then 946 begin 947 for i := 0 to nStat - 1 do 948 FreeMem(Stat[i, p1]); 949 if RW[p1].BattleHistory <> nil then 950 FreeMem(RW[p1].BattleHistory); 951 { if RW[p1].BorderHelper<>nil then FreeMem(RW[p1].BorderHelper); } 952 FreeMem(RW[p1].Data); 953 FreeMem(SavedData[p1]); 954 if RW[p1].DefaultDebugMap <> nil then 955 FreeMem(RW[p1].DefaultDebugMap); 956 end; 957 UnitProcessing.ReleaseGame; 958 CityProcessing.ReleaseGame; 959 Database.ReleaseGame; 960 CL.Free; 352 961 end; 353 962 354 procedure LogChanges;963 procedure GenerateStat(p: integer); 355 964 var 356 p,ix: integer;965 cix, uix: integer; 357 966 begin 358 for p:=0 to nPl-1 do 359 if (1 shl p and GWatching<>0) and ProcessClientData[p] then967 if Difficulty[p] > 0 then 968 with RW[p] do 360 969 begin 361 // log unit status changes 362 for ix:=0 to RW[p].nUn-1 do with RW[p].Un[ix] do 363 if (Loc>=0) and (SavedStatus<>Status) then 364 begin 365 CL.Put(sIntSetUnitStatus, p, ix, @Status); 366 SavedStatus:=Status 367 end; 368 // log city status changes 369 for ix:=0 to RW[p].nCity-1 do with RW[p].City[ix] do 370 if (Loc>=0) and (SavedStatus<>Status) then 371 begin 372 CL.Put(sIntSetCityStatus, p, ix, @Status); 373 SavedStatus:=Status 374 end; 375 // log model status changes 376 for ix:=0 to RW[p].nModel-1 do with RW[p].Model[ix] do 377 if SavedStatus<>Status then 378 begin 379 CL.Put(sIntSetModelStatus, p, ix, @Status); 380 SavedStatus:=Status 381 end; 382 // log enemy city status changes 383 for ix:=0 to RW[p].nEnemyCity-1 do with RW[p].EnemyCity[ix] do 384 if (Loc>=0) and (SavedStatus<>Status) then 385 begin 386 CL.Put(sIntSetECityStatus, p, ix, @Status); 387 SavedStatus:=Status 388 end; 389 // log data changes 390 if Brain[bix[p]].DataSize>0 then 391 begin 392 CL.PutDataChanges(sIntDataChange, p, SavedData[p], RW[p].Data, 393 Brain[bix[p]].DataSize); 394 move(RW[p].Data^,SavedData[p]^,Brain[bix[p]].DataSize*4); 395 end 970 Stat[stPop, p, GTurn] := 0; 971 for cix := 0 to nCity - 1 do 972 if City[cix].Loc >= 0 then 973 inc(Stat[stPop, p, GTurn], City[cix].Size); 974 Stat[stScience, p, GTurn] := Researched[p] * 50; 975 if (RW[p].ResearchTech >= 0) and (RW[p].ResearchTech <> adMilitary) then 976 inc(Stat[stScience, p, GTurn], Research * 100 div TechBaseCost(nTech[p], 977 Difficulty[p])); 978 Stat[stMil, p, GTurn] := 0; 979 for uix := 0 to nUn - 1 do 980 if Un[uix].Loc >= 0 then 981 with Model[Un[uix].mix] do 982 begin 983 if (Kind <= mkEnemyDeveloped) and (Un[uix].mix <> 1) then 984 inc(Stat[stMil, p, GTurn], Weight * MStrength * 985 Un[uix].Health div 100) 986 else if Domain = dGround then 987 inc(Stat[stMil, p, GTurn], (Attack + 2 * Defense) * 988 Un[uix].Health div 100) 989 else 990 inc(Stat[stMil, p, GTurn], (Attack + Defense) * 991 Un[uix].Health div 100); 992 case Kind of 993 mkSlaves: 994 inc(Stat[stPop, p, GTurn]); 995 mkSettler: 996 inc(Stat[stPop, p, GTurn], 2); 997 end; 998 end; 999 Stat[stMil, p, GTurn] := Stat[stMil, p, GTurn] div 16; 1000 Stat[stExplore, p, GTurn] := Discovered[p]; 1001 Stat[stTerritory, p, GTurn] := TerritoryCount[p]; 1002 Stat[stWork, p, GTurn] := Worked[p]; 1003 LastValidStat[p] := GTurn; 396 1004 end; 397 1005 end; 398 1006 399 procedure NoLogChanges;1007 procedure LogCityTileChanges; 400 1008 var 401 p,ix: integer;1009 cix: integer; 402 1010 begin 403 for p:=0 to nPl-1 do 404 if (1 shl p and GWatching<>0) and ProcessClientData[p] then 1011 for cix := 0 to RW[pTurn].nCity - 1 do 1012 with RW[pTurn].City[cix] do 1013 if Loc >= 0 then 1014 begin 1015 { if SavedResourceWeights[cix]<>ResourceWeights then 1016 begin // log city resource weight changes 1017 CL.Put(sSetCityResourceWeights, pTurn, cix, @ResourceWeights); 1018 SavedResourceWeights[cix]:=ResourceWeights; 1019 end; } 1020 if SavedTiles[cix] <> Tiles then 1021 begin // log city tile changes 1022 CL.Put(sSetCityTiles, pTurn, cix, @Tiles); 1023 SavedTiles[cix] := Tiles; 1024 end; 1025 end; 1026 end; 1027 1028 procedure NoLogCityTileChanges; 1029 var 1030 cix: integer; 1031 begin 1032 for cix := 0 to RW[pTurn].nCity - 1 do 1033 with RW[pTurn].City[cix] do 1034 if Loc >= 0 then 1035 begin 1036 // SavedResourceWeights[cix]:=ResourceWeights; 1037 SavedTiles[cix] := Tiles; 1038 end; 1039 end; 1040 1041 function HasCityTileChanges: boolean; 1042 var 1043 cix: integer; 1044 begin 1045 result := false; 1046 for cix := 0 to RW[pTurn].nCity - 1 do 1047 with RW[pTurn].City[cix] do 1048 if Loc >= 0 then 1049 begin 1050 // if SavedResourceWeights[cix]<>ResourceWeights then result:=true; 1051 if SavedTiles[cix] <> Tiles then 1052 result := true; 1053 end; 1054 end; 1055 1056 procedure BeforeTurn0; 1057 var 1058 p1, uix: integer; 1059 begin 1060 for uix := 0 to RW[pTurn].nUn - 1 do { init movement points for first turn } 1061 with RW[pTurn].Un[uix] do 1062 Movement := RW[pTurn].Model[mix].Speed; 1063 1064 if Difficulty[pTurn] > 0 then 1065 DiscoverViewAreas(pTurn) 1066 else { supervisor } 1067 begin 1068 DiscoverAll(pTurn, lObserveSuper); 1069 for p1 := 1 to nPl - 1 do 1070 if 1 shl p1 and GAlive <> 0 then 1071 begin 1072 GiveCivilReport(pTurn, p1); 1073 GiveMilReport(pTurn, p1) 1074 end; 1075 end; 1076 // CheckContact; 1077 end; 1078 1079 function LoadGame(const Path, FileName: string; Turn: integer; 1080 MovieMode: boolean): boolean; 1081 var 1082 i, j, ix, d, p1, Command, Subject: integer; 1083 {$IFDEF TEXTLOG}LoadPos0: integer; {$ENDIF} 1084 Data: pointer; 1085 LogFile: TFileStream; 1086 FormerCLState: TCmdListState; 1087 s: string[255]; 1088 SaveMap: array [0 .. lxmax * lymax - 1] of Byte; 1089 started, StatRequest: boolean; 1090 begin 1091 SavePath := Path; 1092 LogFileName := FileName; 1093 LoadTurn := Turn; 1094 LogFile := TFileStream.Create(SavePath + LogFileName, fmOpenRead or 1095 fmShareExclusive); 1096 LogFile.Position := 0; 1097 LogFile.read(s[1], 8); { file id } 1098 LogFile.read(i, 4); { c-evo version } 1099 LogFile.read(j, 4); { exe time } 1100 1101 if (i >= FirstBookCompatibleVersion) and (i <= Version) then 1102 begin 1103 result := true; 1104 LogFile.read(lx, 4); 1105 LogFile.read(ly, 4); 1106 MapSize := lx * ly; 1107 LogFile.read(LandMass, 4); 1108 if LandMass = 0 then 1109 LogFile.read(RealMap, MapSize * 4); // use predefined map 1110 LogFile.read(MaxTurn, 4); 1111 LogFile.read(RND, 4); 1112 LogFile.read(GTurn, 4); 1113 LogFile.read(SaveMap, 4); 1114 if SaveMap[0] <> $80 then 1115 LogFile.read(SaveMap[4], ((MapSize - 1) div 4 + 1) * 4 - 4); 1116 for p1 := 0 to nPl - 1 do 405 1117 begin 406 for ix:=0 to RW[p].nUn-1 do with RW[p].Un[ix] do 407 SavedStatus:=Status; 408 for ix:=0 to RW[p].nCity-1 do with RW[p].City[ix] do 409 SavedStatus:=Status; 410 for ix:=0 to RW[p].nModel-1 do with RW[p].Model[ix] do 411 SavedStatus:=Status; 412 for ix:=0 to RW[p].nEnemyCity-1 do with RW[p].EnemyCity[ix] do 413 SavedStatus:=Status; 414 if Brain[bix[p]].DataSize>0 then 415 move(RW[p].Data^,SavedData[p]^,Brain[bix[p]].DataSize*4); 1118 LogFile.read(s[0], 4); 1119 if s[0] = #0 then 1120 bixView[p1] := -1 1121 else 1122 begin 1123 LogFile.read(s[4], Byte(s[0]) div 4 * 4); 1124 LogFile.read(OriginalDataVersion[p1], 4); 1125 LogFile.read(d, 4); { behavior } 1126 LogFile.read(Difficulty[p1], 4); 1127 j := nBrain - 1; 1128 while (j >= 0) and (AnsiCompareFileName(Brain[j].FileName, s) <> 0) do 1129 dec(j); 1130 if j < 0 then 1131 begin // ai not found -- replace by local player 1132 ProcessClientData[p1] := false; 1133 NotifyMessage := s; 1134 Notify(ntAIError); 1135 j := bixTerm; 1136 end 1137 else 1138 ProcessClientData[p1] := true; 1139 if j = bixNoTerm then 1140 j := bixSuper_Virtual; 1141 // crashed tournament -- load as supervisor 1142 bixView[p1] := j; 1143 end; 416 1144 end; 417 end; 418 419 function HasChanges(p: integer): boolean; 420 type 421 TDWordList= array[0..INFIN] of Cardinal; 422 PDWortList=^TDWordList; 1145 end 1146 else 1147 result := false; 1148 1149 if result then 1150 begin 1151 CL := TCmdList.Create; 1152 CL.LoadFromFile(LogFile); 1153 end; 1154 LogFile.Free; 1155 if not result then 1156 exit; 1157 1158 Notify(ntStartDone); 1159 if LoadTurn < 0 then 1160 LoadTurn := GTurn; 1161 if MovieMode then 1162 Mode := moMovie 1163 else if LoadTurn = 0 then 1164 Mode := moLoading 1165 else 1166 Mode := moLoading_Fast; 1167 {$IFDEF TEXTLOG}AssignFile(TextLog, SavePath + LogFileName + '.txt'); 1168 Rewrite(TextLog); {$ENDIF} 1169 LoadOK := true; 1170 StartGame; 1171 if MovieMode then 1172 begin 1173 Brain[bix[0]].Client(cShowGame, 0, nil^); 1174 Notify(ntBackOff); 1175 end 1176 else 1177 Notify(ntLoadBegin); 1178 1179 started := false; 1180 StatRequest := false; 1181 MovieStopped := false; 1182 {$IFDEF LOADPERF}QueryPerformanceCounter(time_total0); 1183 time_a := 0; 1184 time_b := 0; 1185 time_c := 0; {$ENDIF} 1186 while not MovieStopped and (CL.Progress < 1000) do 1187 begin 1188 FormerCLState := CL.State; 1189 CL.Get(Command, p1, Subject, Data); 1190 if p1 < 0 then 1191 p1 := pTurn; 1192 if StatRequest and (Command and (sctMask or sExecute) <> sctInternal or 1193 sExecute) then 1194 begin 1195 GenerateStat(pTurn); 1196 StatRequest := false 1197 end; 1198 // complete all internal commands following an sTurn before generating statistics 1199 if (Command = sTurn) and not started then 1200 begin 1201 {$IFDEF TEXTLOG}WriteLn(TextLog, '---Turn 0 P0---'); {$ENDIF} 1202 for p1 := 0 to nPl - 1 do 1203 if (bix[p1] >= 0) and ((Mode <> moMovie) or (p1 = 0)) then 1204 CallPlayer(cReplay, p1, nil^); 1205 BeforeTurn0; 1206 if MovieMode then 1207 begin 1208 Inform(pTurn); 1209 CallPlayer(cMovieTurn, 0, nil^); 1210 end; 1211 StatRequest := true; 1212 started := true; 1213 end 1214 else if (Command = sTurn) and (pTurn = 0) and (GTurn = LoadTurn) then 1215 begin 1216 assert(CL.State.LoadPos = FormerCLState.LoadPos + 4); // size of sTurn 1217 CL.State := FormerCLState; 1218 CL.Cut; 1219 Break; 1220 end 1221 else if Command = sIntDataChange then 1222 begin 1223 {$IFDEF TEXTLOG}LoadPos0 := CL.State.LoadPos; {$ENDIF} 1224 if ProcessClientData[p1] then 1225 CL.GetDataChanges(RW[p1].Data, Brain[bix[p1]].DataSize) 1226 else 1227 CL.GetDataChanges(nil, 0); 1228 {$IFDEF TEXTLOG}WriteLn(TextLog, Format('Data Changes P%d (%d Bytes)', [p1, CL.State.LoadPos - LoadPos0])); {$ENDIF} 1229 end 1230 else 1231 begin 1232 {$IFDEF TEXTLOG}CmdInfo := Format('Command %x', [Command]); {$ENDIF} 1233 if Command and (sctMask or sExecute) = sctInternal or sExecute then 1234 IntServer(Command, p1, Subject, Data^) // internal command 1235 else 1236 begin 1237 StatRequest := Command = sTurn; 1238 Server(Command, p1, Subject, Data^); 1239 end; 1240 {$IFDEF TEXTLOG}WriteLn(TextLog, CmdInfo); {$ENDIF} 1241 end; 1242 if not MovieMode then 1243 Notify(ntLoadState + CL.Progress * 128 div 1000); 1244 end; 1245 1246 if MovieMode then 1247 begin 1248 Notify(ntBackOn); 1249 Brain[bix[0]].Client(cBreakGame, -1, nil^); 1250 EndGame; 1251 Notify(ntStartGo); 1252 result := false; 1253 exit; 1254 end; 1255 1256 if StatRequest then 1257 GenerateStat(pTurn); 1258 assert(started); 1259 {$IFDEF TEXTLOG}CloseFile(TextLog); {$ENDIF} 1260 {$IFDEF LOADPERF}QueryPerformanceCounter(time_total); { time in s is: (time_total-time_total0)/PerfFreq }{$ENDIF} 1261 NoLogChanges; 1262 NoLogCityTileChanges; 1263 if LogFileName[1] = '~' then 1264 begin 1265 Delete(LogFileName, 1, 1); 1266 nLogOpened := -1 1267 end 1268 else 1269 nLogOpened := CL.State.nLog; 1270 1271 Mode := moPlaying; 1272 LastEndClientCommand := -1; 1273 if (GTestFlags and tfUncover <> 0) or (Difficulty[pTurn] = 0) then 1274 DiscoverAll(pTurn, lObserveSuper) { supervisor - all tiles visible } 1275 else 1276 DiscoverViewAreas(pTurn); 1277 1278 for p1 := 0 to nPl - 1 do 1279 if 1 shl p1 and (GAlive or GWatching) <> 0 then 1280 begin 1281 RecalcPeaceMap(p1); 1282 for ix := 0 to RW[p1].nEnemyUn - 1 do 1283 with RW[p1].EnemyUn[ix] do 1284 emix := RWemix[p1, Owner, mix]; 1285 Inform(p1); 1286 end; 1287 {$IFOPT O-}CheckBorders(-2); {$ENDIF} // for testing only 1288 Notify(ntEndInfo); 1289 if not LoadOK then 1290 begin 1291 NotifyMessage := SavePath + LogFileName; 1292 Notify(ntLoadError); 1293 end; 1294 Brain[bix[0]].Client(cShowGame, 0, nil^); 1295 Notify(ntBackOff); 1296 Inform(pTurn); 1297 ChangeClientWhenDone(cResume, 0, nil^, 0); 1298 end; // LoadGame 1299 1300 procedure InsertTerritoryUpdateCommands; 423 1301 var 424 ix: integer; 1302 p1, Command, Subject: integer; 1303 Data: pointer; 1304 FormerCLState: TCmdListState; 425 1305 begin 426 result:=false; 427 for ix:=0 to RW[p].nUn-1 do with RW[p].Un[ix] do 428 if (Loc>=0) and (SavedStatus<>Status) then result:=true; 429 for ix:=0 to RW[p].nCity-1 do with RW[p].City[ix] do 430 if (Loc>=0) and (SavedStatus<>Status) then result:=true; 431 for ix:=0 to RW[p].nModel-1 do with RW[p].Model[ix] do 432 if SavedStatus<>Status then result:=true; 433 for ix:=0 to RW[p].nEnemyCity-1 do with RW[p].EnemyCity[ix] do 434 if (Loc>=0) and (SavedStatus<>Status) then result:=true; 435 if RW[p].Data<>nil then for ix:=0 to Brain[bix[p]].DataSize-1 do 436 if PDWortList(SavedData[p])[ix]<>PDWortList(RW[p].Data)[ix] then result:=true 437 end; 438 439 procedure InitBrain(bix: integer); 440 var 441 InitModuleData: TInitModuleData; 442 begin 443 assert(bix<>bixSuper_Virtual); 444 with Brain[bix] do 1306 while CL.Progress < 1000 do 445 1307 begin 446 if Initialized then exit; 447 if bix>=bixFirstAI then 448 begin {get client function} 449 Notify(ntInitModule+bix); 450 if Flags and fDotNet>0 then 451 Client:=DotNetClient 1308 FormerCLState := CL.State; 1309 CL.Get(Command, p1, Subject, Data); 1310 if (Command = sIntExpandTerritory) and (p1 = pTurn) then 1311 begin 1312 IntServer(Command, p1, Subject, Data^); 1313 {$IFDEF TEXTLOG}WriteLn(TextLog, 'AfterTurn - ExpandTerritory'); {$ENDIF} 1314 end 452 1315 else 453 begin454 hm:=LoadLibrary(pchar(DLLName));455 if hm=0 then456 begin457 Client:=nil;458 Notify(ntDLLError+bix);459 end460 else461 begin462 Client:=GetProcAddress(hm,'client');463 if @Client=nil then Notify(ntClientError+bix);464 end465 end466 end;467 if @Client<>nil then468 1316 begin 469 Initialized:=true; 470 InitModuleData.Server:=@Server; 471 InitModuleData.DataVersion:=0; 472 InitModuleData.DataSize:=0; 473 InitModuleData.Flags:=0; 474 CallClient(bix, cInitModule, InitModuleData); 475 DataVersion:=InitModuleData.DataVersion; 476 DataSize:=(InitModuleData.DataSize+3) div 4; 477 if DataSize>MaxDataSize then DataSize:=0; 478 Flags:=Flags or InitModuleData.Flags; 479 end 480 end 481 end; 482 483 procedure SaveMap(FileName: string); 484 var 485 i: integer; 486 MapFile: TFileStream; 487 s: string[255]; 488 begin 489 MapFile:=TFileStream.Create(DataDir+'Maps\'+FileName, fmCreate or fmShareExclusive); 490 MapFile.Position:=0; 491 s:='cEvoMap'#0; MapFile.write(s[1],8); {file id} 492 i:=0; MapFile.write(i,4); {format id} 493 MapFile.write(MaxTurn,4); 494 MapFile.write(lx,4); 495 MapFile.write(ly,4); 496 MapFile.write(RealMap,MapSize*4); 497 MapFile.Free; 498 end; 499 500 function LoadMap(FileName: string): boolean; 501 var 502 i,Loc1: integer; 503 MapFile: TFileStream; 504 s: string[255]; 505 begin 506 result:=false; 507 MapFile:=nil; 508 try 509 MapFile:=TFileStream.Create(DataDir+'Maps\'+FileName, fmOpenRead or fmShareExclusive); 510 MapFile.Position:=0; 511 MapFile.read(s[1],8); {file id} 512 MapFile.read(i,4); {format id} 513 if i=0 then 514 begin 515 MapFile.read(i,4); //MaxTurn 516 MapFile.read(lx,4); 517 MapFile.read(ly,4); 518 ly:=ly and not 1; 519 if lx>lxmax then lx:=lxmax; 520 if ly>lymax then ly:=lymax; 521 MapSize:=lx*ly; 522 MapFile.read(RealMap,MapSize*4); 523 for Loc1:=0 to MapSize-1 do 524 begin 525 RealMap[Loc1]:=RealMap[Loc1] and ($7F01FFFF or fPrefStartPos or fStartPos) 526 or ($F shl 27); 527 if RealMap[Loc1] and (fTerrain or fSpecial)=fSwamp or fSpecial2 then 528 RealMap[Loc1]:=RealMap[Loc1] and not (fTerrain or fSpecial) or (fSwamp or fSpecial1); 529 if (RealMap[Loc1] and fDeadLands<>0) and (RealMap[Loc1] and fTerrain<>fArctic) then 530 RealMap[Loc1]:=RealMap[Loc1] and not (fTerrain or fSpecial) or fDesert; 531 end; 532 result:=true; 533 end; 534 MapFile.Free; 535 except 536 if MapFile<>nil then MapFile.Free; 537 end; 538 end; 539 540 procedure SaveGame(FileName: string; auto: boolean); 541 var 542 x,y,i,zero,Tile,nLocal: integer; 543 LogFile: TFileStream; 544 s: string[255]; 545 SaveMap: array[0..lxmax*lymax-1] of Byte; 546 begin 547 nLocal:=0; 548 for i:=0 to nPl-1 do if bix[i]=bixTerm then inc(nLocal); 549 if Difficulty[0]=0 then nLocal:=0; 550 if nLocal<=1 then for y:=0 to ly-1 do for x:=0 to lx-1 do 551 begin 552 Tile:=RW[0].Map[(x+SaveMapCenterLoc+lx shr 1) mod lx +lx*y]; 553 SaveMap[x+lx*y]:=Tile and fTerrain + Tile and (fCity or fUnit or fOwned) shr 16; 554 end; 555 556 if auto and AutoSaveExists then // append to existing file 557 LogFile:=TFileStream.Create(SavePath+FileName, 558 fmOpenReadWrite or fmShareExclusive) 559 else // create new file 560 LogFile:=TFileStream.Create(SavePath+FileName, fmCreate or fmShareExclusive); 561 562 zero:=0; 563 LogFile.Position:=0; 564 s:='cEvoBook'; LogFile.write(s[1],8); {file id} 565 i:=Version; LogFile.write(i,4); {c-evo version} 566 LogFile.write(ExeInfo.Time,4); 567 LogFile.write(lx,4); 568 LogFile.write(ly,4); 569 LogFile.write(LandMass,4); 570 if LandMass=0 then 571 LogFile.write(MapField^,MapSize*4); 572 573 LogFile.write(MaxTurn,4); 574 LogFile.write(RND,4); 575 LogFile.write(GTurn,4); 576 if nLocal>1 then // multiplayer game -- no quick view 577 begin i:=$80; LogFile.write(i,4); end 578 else LogFile.write(SaveMap,((MapSize-1) div 4+1)*4); 579 for i:=0 to nPl-1 do 580 if bix[i]<0 then LogFile.write(zero,4) 581 else 582 begin 583 if bixView[i]>=bixRandom then s:=Brain[bix[i]].FileName 584 else s:=Brain[bixView[i]].FileName; 585 move(zero,s[Length(s)+1],4); 586 LogFile.write(s,(Length(s) div 4+1)*4); 587 LogFile.write(OriginalDataVersion[i],4); 588 s:=''; {behavior} move(zero,s[Length(s)+1],4); 589 LogFile.write(s,(Length(s) div 4+1)*4); 590 LogFile.write(Difficulty[i],4); 591 end; 592 593 if auto and AutoSaveExists then CL.AppendToFile(LogFile, AutoSaveState) 594 else CL.SaveToFile(LogFile); 595 LogFile.Free; 596 if auto then 597 begin AutoSaveState:=CL.State; AutoSaveExists:=true end 598 end; 599 600 procedure StartGame; 601 var 602 i,p,p1,Human,nAlive,bixUni: integer; 603 Game: TNewGameData; 604 //GameEx: TNewGameExData; 605 path: shortstring; 606 BrainUsed: Set of 0..254; {used brains} 607 begin 608 for p1:=0 to nPl-1 do 609 begin 610 if bixView[p1]=bixSuper_Virtual then bix[p1]:=bixTerm // supervisor and local human use same module 611 else if bixView[p1]=bixRandom then 612 if nBrain<=bixFirstAI then bix[p1]:=-1 613 else bix[p1]:=bixFirstAI+random(nBrain-bixFirstAI) 614 else bix[p1]:=bixView[p1]; 615 if bixView[p1]<0 then Difficulty[p1]:=-1; 616 end; 617 618 if bix[0]<>bixNoTerm then Notify(ntInitLocalHuman); 619 BrainUsed:=[]; 620 for p:=0 to nPl-1 do 621 if (bix[p]>=0) and ((Mode<>moMovie) or (p=0)) then 622 begin {initiate selected control module} 623 AIInfo[p]:=Brain[bix[p]].Name+#0; 624 InitBrain(bix[p]); 625 if Mode=moPlaying then 626 begin // new game, this data version is original 627 OriginalDataVersion[p]:=Brain[bix[p]].DataVersion; 628 ProcessClientData[p]:=true; 629 end 630 else // loading game, compare with data version read from file 631 ProcessClientData[p]:=ProcessClientData[p] 632 and (OriginalDataVersion[p]=Brain[bix[p]].DataVersion); 633 if @Brain[bix[p]].Client=nil then // client function not found 634 if bix[0]=bixNoTerm then 635 bix[p]:=-1 636 else 637 begin 638 bix[p]:=bixTerm; 639 OriginalDataVersion[p]:=-1; 640 ProcessClientData[p]:=false; 641 end; 642 if bix[p]>=0 then include(BrainUsed,bix[p]) 643 end; 644 645 Notify(ntCreateWorld); 646 nAlive:=0; 647 GAlive:=0; 648 if Mode=moMovie then GWatching:=1 649 else GWatching:=0; 650 GAI:=0; 651 for p1:=0 to nPl-1 do if bix[p1]>=0 then 652 begin 653 if Mode<>moMovie then inc(GWatching,1 shl p1); 654 if bix[p1]>=bixFirstAI then inc(GAI,1 shl p1); 655 if Difficulty[p1]>0 then 656 begin inc(GAlive,1 shl p1); inc(nAlive); end; 657 ServerVersion[p1]:=Brain[bix[p1]].ServerVersion; 658 end; 659 WinOnAlone:= (bix[0]=bixNoTerm) and (nAlive>1); 660 GWinner:=0; 661 GColdWarStart:=-ColdWarTurns-1; 662 uixSelectedTransport:=-1; 663 SpyMission:=smSabotageProd; 664 for p1:=0 to nPl-1 do 665 DebugMap[p1]:=nil; 666 667 GTurn:=0; 668 for i:=0 to 27 do with GWonder[i] do 669 begin CityID:=-1; EffectiveOwner:=-1 end; 670 FillChar(GShip,SizeOf(GShip),0); 671 672 for p:=0 to nPl-1 do if 1 shl p and (GAlive or GWatching)<>0 then with RW[p] do 673 begin 674 Government:=gDespotism; 675 Money:=StartMoney; 676 TaxRate:=30; 677 LuxRate:=0; 678 Research:=0; 679 ResearchTech:=-2; 680 AnarchyStart:=-AnarchyTurns-1; 681 Happened:=0; 682 LastValidStat[p]:=-1; 683 Worked[p]:=0; 684 Founded[p]:=0; 685 DevModelTurn[p]:=-1; 686 OracleIncome:=0; 687 688 if Brain[bix[p]].DataSize>0 then 689 begin 690 GetMem(SavedData[p], Brain[bix[p]].DataSize*4); 691 GetMem(Data, Brain[bix[p]].DataSize*4); 692 FillChar(SavedData[p]^,Brain[bix[p]].DataSize*4,0); 693 FillChar(Data^,Brain[bix[p]].DataSize*4,0); 694 end 695 else begin Data:=nil; SavedData[p]:=nil end; 696 nBattleHistory:=0; 697 BattleHistory:=nil; 698 {if bix[p]=bixTerm then 699 begin 700 GetMem(BorderHelper,MapSize); 701 FillChar(BorderHelper^,MapSize,0); 702 end 703 else} BorderHelper:=nil; 704 for i:=0 to nStat-1 do GetMem(Stat[i,p],4*(MaxTurn+1)); 705 if Brain[bix[p]].Flags and fDotNet<>0 then 706 begin 707 GetMem(RW[p].DefaultDebugMap, MapSize*4); 708 FillChar(RW[p].DefaultDebugMap^, MapSize*4, 0); 709 DebugMap[p]:=RW[p].DefaultDebugMap; 710 end 711 else RW[p].DefaultDebugMap:=nil; 712 713 {!!!for i:=0 to nShipPart-1 do GShip[p].Parts[i]:=random((3-i)*2);{} 714 end; 715 716 if LandMass>0 then 717 begin // random map 718 InitRandomGame; 719 PreviewElevation:=false; 720 MapField:=nil; 721 end 722 else 723 begin // predefined map 724 if Mode=moPlaying then 725 LoadMap(MapFileName); // new game -- load map from file 726 GetMem(MapField,MapSize*4); 727 move(RealMap,MapField^,MapSize*4); 728 Human:=0; 729 for p1:=0 to nPl-1 do if bix[p1]=bixTerm then inc(Human,1 shl p1); 730 InitMapGame(Human); 731 end; 732 CityProcessing.InitGame; 733 UnitProcessing.InitGame; 734 for p:=0 to nPl-1 do if 1 shl p and (GAlive or GWatching)<>0 then 735 Inform(p); 736 737 pTurn:=-1; 738 if bix[0]<>bixNoTerm then 739 Notify(ntInitLocalHuman); 740 Game.lx:=lx; Game.ly:=ly; Game.LandMass:=LandMass; Game.MaxTurn:=MaxTurn; 741 move(Difficulty,Game.Difficulty,SizeOf(Difficulty)); 742 //GameEx.lx:=lx; GameEx.ly:=ly; GameEx.LandMass:=LandMass; 743 //GameEx.MaxTurn:=MaxTurn; GameEx.RND:=RND; 744 //move(Difficulty,GameEx.Difficulty,SizeOf(Difficulty)); 745 AICredits:=''; 746 for i:=0 to nBrain-1 do if Brain[i].Initialized then 747 if i in BrainUsed then 748 begin 749 if i>=bixFirstAI then 750 Notify(ntInitPlayers); 751 for p:=0 to nPl-1 do 752 begin 753 if bix[p]=i then 754 Game.RO[p]:=@RW[p] 755 else Game.RO[p]:=nil; 756 if (i=bixTerm) and (Difficulty[0]=0) and (bix[p]>=0) then 757 Game.SuperVisorRO[p]:=@RW[p] 758 else Game.SuperVisorRO[p]:=nil; 759 end; 760 if Brain[i].Flags and fDotNet>0 then 761 begin 762 path:=Brain[i].DLLName; 763 move(path[1], Game.AssemblyPath, Length(path)); 764 Game.AssemblyPath[Length(path)]:=#0; 765 end 766 else Game.AssemblyPath[0]:=#0; 767 case Mode of 768 moLoading, moLoading_Fast: CallClient(i, cLoadGame, Game); 769 moMovie: CallClient(i, cMovie, Game); 770 moPlaying: CallClient(i, cNewGame, Game); 771 end; 772 if (i>=bixFirstAI) and (Brain[i].Credits<>'') then 773 if AICredits='' then AICredits:=Brain[i].Credits 774 else AICredits:=AICredits+'\'+Brain[i].Credits 775 end 776 else 777 begin {module no longer used -- unload} 778 CallClient(i, cReleaseModule, nil^); 779 if i>=bixFirstAI then 780 begin 781 if Brain[i].Flags and fDotNet=0 then 782 FreeLibrary(Brain[i].hm); 783 Brain[i].Client:=nil; 784 end; 785 Brain[i].Initialized:=false; 786 end; 787 AICredits:=AICredits+#0; 788 789 if bix[0]<>bixNoTerm then 790 begin 791 // uni ai? 792 bixUni:=-1; 793 for p1:=0 to nPl-1 do if bix[p1]>=bixFirstAI then 794 if bixUni=-1 then bixUni:=bix[p1] 795 else if bixUni<>bix[p1] then bixUni:=-2; 796 for p1:=0 to nPl-1 do if bix[p1]>=bixFirstAI then 797 begin 798 if bixUni=-2 then NotifyMessage:=Brain[bix[p1]].FileName 799 else NotifyMessage:=''; 800 Notify(ntSetAIName+p1); 1317 CL.State := FormerCLState; 1318 Break 801 1319 end 802 1320 end; 803 804 CheckBorders(-1); 805 {$IFOPT O-}InvalidTreatyMap:=0;{$ENDIF} 806 AutoSaveExists:=false; 807 pDipActive:=-1; 808 pTurn:=0; 809 810 if Mode>=moMovie then 1321 {$IFOPT O-}InvalidTreatyMap := 0; {$ENDIF} 1322 end; 1323 1324 procedure StartNewGame(const Path, FileName, Map: string; 1325 Newlx, Newly, NewLandMass, NewMaxTurn: integer); 1326 var 1327 p: integer; 1328 begin 1329 Notify(ntStartDone); 1330 SavePath := Path; 1331 LogFileName := FileName; 1332 MapFileName := Map; 1333 if FastContact then 1334 begin 1335 lx := 24; 1336 ly := 42; 1337 end 1338 else 1339 begin 1340 lx := Newlx; 1341 ly := Newly 1342 end; 1343 MapSize := lx * ly; 1344 if MapFileName <> '' then 1345 LandMass := 0 1346 else 1347 LandMass := NewLandMass; 1348 MaxTurn := NewMaxTurn; 1349 Randomize; 1350 RND := RandSeed; 1351 Mode := moPlaying; 1352 CL := TCmdList.Create; 1353 StartGame; 1354 NoLogChanges; 1355 for p := 0 to nPl - 1 do 1356 if bix[p] >= 0 then 1357 CallPlayer(cGetReady, p, nil^); 1358 LogChanges; 1359 CL.Put(sTurn, 0, 0, nil); 1360 BeforeTurn0; 1361 NoLogCityTileChanges; 1362 GenerateStat(pTurn); 1363 nLogOpened := -1; 1364 LastEndClientCommand := -1; 1365 Brain[bix[0]].Client(cShowGame, 0, nil^); 1366 Notify(ntBackOff); 1367 Inform(pTurn); 1368 ChangeClientWhenDone(cTurn, 0, nil^, 0) 1369 end; 1370 1371 procedure DirectHelp(Command: integer); 1372 begin 1373 InitBrain(bixTerm); 1374 Brain[bixTerm].Client(Command, -1, nil^); 1375 AICredits := #0; 1376 end; 1377 1378 procedure EditMap(const Map: string; Newlx, Newly, NewLandMass: integer); 1379 var 1380 p1, Loc1: integer; 1381 Game: TNewGameData; 1382 begin 1383 Notify(ntStartDone); 1384 Notify(ntInitLocalHuman); 1385 MapFileName := Map; 1386 lx := Newlx; 1387 ly := Newly; 1388 MapSize := lx * ly; 1389 LandMass := NewLandMass; 1390 bix[0] := bixTerm; 1391 Difficulty[0] := 0; 1392 InitBrain(bixTerm); 1393 1394 Randomize; 1395 GAlive := 0; 1396 GWatching := 1; 1397 if not LoadMap(MapFileName) then 1398 for Loc1 := 0 to MapSize - 1 do 1399 RealMap[Loc1] := fOcean or ($F shl 27); 1400 CL := nil; 1401 InitMapEditor; 1402 RW[0].Data := nil; 1403 RW[0].BorderHelper := nil; 1404 RW[0].Alive := 0; 1405 Game.lx := lx; 1406 Game.ly := ly; 1407 Game.RO[0] := @RW[0]; 1408 Game.Difficulty[0] := 0; 1409 for p1 := 1 to nPl - 1 do 1410 begin 1411 Game.RO[p1] := nil; 1412 Game.Difficulty[p1] := -1 1413 end; 1414 Brain[bixTerm].Client(cNewMap, -1, Game); 1415 1416 DiscoverAll(0, lObserveSuper); 811 1417 Notify(ntEndInfo); 812 end;{StartGame} 813 814 procedure EndGame; 1418 Brain[bix[0]].Client(cShowGame, 0, nil^); 1419 Notify(ntBackOff); 1420 ChangeClientWhenDone(cEditMap, 0, nil^, 0) 1421 end; 1422 1423 procedure DestroySpacePort_TellPlayers(p, pCapturer: integer); 815 1424 var 816 i,p1: integer; 1425 cix, i, p1: integer; 1426 ShowShipChange: TShowShipChange; 817 1427 begin 818 if LandMass=0 then FreeMem(MapField); 819 for p1:=0 to nPl-1 do if bix[p1]>=0 then 1428 // stop ship part production 1429 for cix := 0 to RW[p].nCity - 1 do 1430 with RW[p].City[cix] do 1431 if (Loc >= 0) and (Project and cpImp <> 0) and 1432 ((Project and cpIndex = woMIR) or 1433 (Imp[Project and cpIndex].Kind = ikShipPart)) then 1434 begin 1435 inc(RW[p].Money, Prod0); 1436 Prod := 0; 1437 Prod0 := 0; 1438 Project := cpImp + imTrGoods; 1439 Project0 := cpImp + imTrGoods 1440 end; 1441 1442 // destroy ship 1443 with GShip[p] do 1444 if Parts[0] + Parts[1] + Parts[2] > 0 then 1445 begin 1446 for i := 0 to nShipPart - 1 do 1447 begin 1448 ShowShipChange.Ship1Change[i] := -Parts[i]; 1449 if pCapturer >= 0 then 1450 begin 1451 ShowShipChange.Ship2Change[i] := Parts[i]; 1452 inc(GShip[pCapturer].Parts[i], Parts[i]); 1453 end; 1454 Parts[i] := 0; 1455 end; 1456 if Mode >= moMovie then 1457 begin 1458 if pCapturer >= 0 then 1459 ShowShipChange.Reason := scrCapture 1460 else 1461 ShowShipChange.Reason := scrDestruction; 1462 ShowShipChange.Ship1Owner := p; 1463 ShowShipChange.Ship2Owner := pCapturer; 1464 for p1 := 0 to nPl - 1 do 1465 if 1 shl p1 and (GAlive or GWatching) <> 0 then 1466 begin 1467 move(GShip, RW[p1].Ship, SizeOf(GShip)); 1468 if 1 shl p1 and GWatching <> 0 then 1469 CallPlayer(cShowShipChange, p1, ShowShipChange); 1470 end; 1471 end 1472 end 1473 end; 1474 1475 procedure DestroyCity_TellPlayers(p, cix: integer; SaveUnits: boolean); 1476 begin 1477 if RW[p].City[cix].built[imSpacePort] > 0 then 1478 DestroySpacePort_TellPlayers(p, -1); 1479 DestroyCity(p, cix, SaveUnits); 1480 end; 1481 1482 procedure ChangeCityOwner_TellPlayers(pOld, cixOld, pNew: integer); 1483 begin 1484 if RW[pOld].City[cixOld].built[imSpacePort] > 0 then 1485 if RW[pNew].NatBuilt[imSpacePort] > 0 then 1486 DestroySpacePort_TellPlayers(pOld, pNew) 1487 else 1488 DestroySpacePort_TellPlayers(pOld, -1); 1489 ChangeCityOwner(pOld, cixOld, pNew); 1490 end; 1491 1492 procedure CheckWin(p: integer); 1493 var 1494 i: integer; 1495 ShipComplete: boolean; 1496 begin 1497 ShipComplete := true; 1498 for i := 0 to nShipPart - 1 do 1499 if GShip[p].Parts[i] < ShipNeed[i] then 1500 ShipComplete := false; 1501 if ShipComplete then 1502 GWinner := GWinner or 1 shl p; // game won! 1503 end; 1504 1505 procedure BeforeTurn; 1506 var 1507 i, p1, uix, cix, V21, Loc1, Cost, Job0, nAlive, nAppliers, ad, OldLoc, 1508 SiegedTiles, nUpdateLoc: integer; 1509 UpdateLoc: array [0 .. numax - 1] of integer; 1510 Radius: TVicinity21Loc; 1511 ShowShipChange: TShowShipChange; 1512 TribeExtinct, JobDone, MirBuilt: boolean; 1513 begin 1514 {$IFOPT O-}assert(1 shl pTurn and InvalidTreatyMap = 0); {$ENDIF} 1515 assert(1 shl pTurn and (GAlive or GWatching) <> 0); 1516 if (1 shl pTurn and GAlive = 0) and (Difficulty[pTurn] > 0) then 1517 exit; 1518 1519 if (GWonder[woGrLibrary].EffectiveOwner = pTurn) and (GWinner = 0) then 1520 begin // check great library effect 1521 nAlive := 0; 1522 for p1 := 0 to nPl - 1 do 1523 if 1 shl p1 and GAlive <> 0 then 1524 inc(nAlive); 1525 for ad := 0 to nAdv - 5 do 1526 if RW[pTurn].Tech[ad] < tsSeen then 1527 begin 1528 nAppliers := 0; 1529 for p1 := 0 to nPl - 1 do 1530 if (p1 <> pTurn) and (1 shl p1 and GAlive <> 0) and 1531 (RW[p1].Tech[ad] >= tsApplicable) then 1532 inc(nAppliers); 1533 if nAppliers * 2 > nAlive then 1534 begin 1535 SeeTech(pTurn, ad); 1536 inc(nTech[pTurn]); 1537 if Mode >= moMovie then 1538 CallPlayer(cShowGreatLibTech, pTurn, ad); 1539 // do not call CallPlayer(pTurn) while map is invalid 1540 end; 1541 end; 1542 end; 1543 1544 MaskD(ObserveLevel, MapSize, not Cardinal(3 shl (2 * pTurn))); 1545 if Mode > moLoading_Fast then 1546 MaskD(RW[pTurn].Map^, MapSize, not Cardinal(fUnit or fHiddenUnit or 1547 fStealthUnit or fObserved or fSpiedOut or fOwned or fOwnZoCUnit or 1548 fInEnemyZoC)); 1549 RW[pTurn].nEnemyUn := 0; 1550 1551 MirBuilt := false; 1552 if (Difficulty[pTurn] > 0) and (GWinner = 0) then 1553 with RW[pTurn] do 1554 begin 1555 if nCity > 0 then 1556 for p1 := 0 to nPl - 1 do 1557 if GTurn = EvaStart[p1] + PeaceEvaTurns then 1558 begin // peace contract -- remove all units from p1's territory 1559 Loc1 := City[0].Loc; // search destination for homeless units 1560 for cix := 1 to nCity - 1 do 1561 if (City[cix].Loc >= 0) and 1562 ((Loc1 < 0) or (City[cix].built[imPalace] > 0)) then 1563 Loc1 := City[cix].Loc; 1564 for uix := 0 to nUn - 1 do 1565 with Un[uix] do 1566 if (Loc >= 0) and (Model[mix].Kind <> mkDiplomat) and 1567 ((Home >= 0) or (Loc1 >= 0)) and 1568 (RealMap[Loc] shr 27 = Cardinal(p1)) then 1569 begin 1570 OldLoc := Loc; 1571 if Master >= 0 then 1572 begin // transport unload 1573 if Model[mix].Domain = dAir then 1574 dec(Un[Master].AirLoad) 1575 else 1576 dec(Un[Master].TroopLoad); 1577 Master := -1; 1578 end 1579 else 1580 FreeUnit(pTurn, uix); 1581 1582 if Home >= 0 then 1583 Loc := City[Home].Loc 1584 else 1585 Loc := Loc1; 1586 PlaceUnit(pTurn, uix); 1587 UpdateUnitMap(OldLoc); 1588 UpdateUnitMap(Loc); 1589 Flags := Flags or unWithdrawn; 1590 Happened := Happened or phPeaceEvacuation; 1591 end 1592 end; 1593 1594 if Mode >= moMovie then 1595 FillChar(ShowShipChange, SizeOf(ShowShipChange), 0); 1596 TribeExtinct := true; 1597 nUpdateLoc := 0; 1598 for cix := 0 to nCity - 1 do 1599 with City[cix] do 1600 if Loc >= 0 then 1601 begin { next turn for all cities - city loop 1 } 1602 // if ServerVersion[pTurn]>=$000EF0 then 1603 // Flags:=Flags and (chFounded or chCaptured or chProductionSabotaged or chDisorder) 1604 // else Flags:=Flags and (chCaptured or chProductionSabotaged or chDisorder); 1605 // check for siege 1606 SiegedTiles := 0; 1607 V21_to_Loc(Loc, Radius); 1608 for V21 := 1 to 26 do 1609 if Tiles and (1 shl V21) and not(1 shl CityOwnTile) <> 0 then 1610 begin 1611 Loc1 := Radius[V21]; 1612 assert((Loc1 >= 0) and (Loc1 < MapSize) and 1613 (UsedByCity[Loc1] = Loc)); 1614 p1 := RealMap[Loc1] shr 27; 1615 if (RealMap[Loc1] and fCity <> 0) or (p1 < nPl) and 1616 (p1 <> pTurn) and (RW[pTurn].Treaty[p1] >= trPeace) or 1617 (ZoCMap[Loc1] > 0) and (Occupant[Loc1] <> pTurn) and 1618 (Treaty[Occupant[Loc1]] < trPeace) then 1619 begin 1620 Tiles := Tiles and not(1 shl V21); 1621 UsedByCity[Loc1] := -1; 1622 Flags := Flags or chSiege; 1623 inc(SiegedTiles); 1624 end; 1625 end; 1626 while SiegedTiles > 0 do // replace sieged tiles 1627 begin 1628 if not AddBestCityTile(pTurn, cix) then 1629 Break; 1630 dec(SiegedTiles); 1631 end; 1632 1633 if Flags and chFounded = 0 then 1634 begin 1635 // CollectCityResources(pTurn,cix); // old style 1636 1637 if CityTurn(pTurn, cix) then 1638 TribeExtinct := false 1639 else 1640 begin // city is erased 1641 RemoveDomainUnits(dSea, pTurn, Loc); 1642 RemoveDomainUnits(dAir, pTurn, Loc); 1643 Map[Loc] := Map[Loc] and not fCity; // !!! do this in inner core 1644 UpdateLoc[nUpdateLoc] := Loc; 1645 inc(nUpdateLoc); 1646 DestroyCity_TellPlayers(pTurn, cix, true); 1647 end; 1648 1649 if (Flags and chProduction <> 0) and (Project0 and cpImp <> 0) 1650 then 1651 begin 1652 if Project0 and cpIndex = woMIR then // MIR completed 1653 MirBuilt := true 1654 else if Project0 and cpIndex = woManhattan then 1655 GColdWarStart := GTurn 1656 else if Imp[Project0 and cpIndex].Kind = ikShipPart 1657 then { ship parts produced } 1658 inc(ShowShipChange.Ship1Change[Project0 and cpIndex - 1659 imShipComp]); 1660 end 1661 end 1662 end; { city loop 1 } 1663 if nUpdateLoc > 0 then 1664 begin 1665 CheckBorders(-1, pTurn); 1666 for i := 0 to nUpdateLoc - 1 do 1667 UpdateUnitMap(UpdateLoc[i], true); 1668 if Mode >= moMovie then 1669 for p1 := 0 to nPl - 1 do 1670 if (1 shl p1 and GWatching <> 0) and (p1 <> pTurn) then 1671 for i := 0 to nUpdateLoc - 1 do 1672 if ObserveLevel[UpdateLoc[i]] shr (2 * p1) and 3 >= lObserveUnhidden 1673 then 1674 CallPlayer(cShowCityChanged, p1, UpdateLoc[i]); 1675 end; 1676 1677 for uix := 0 to nUn - 1 do 1678 with Un[uix] do 1679 if Loc >= 0 then 1680 begin // unit loop 2 1681 if Health < 100 then 1682 Recover(pTurn, uix); 1683 1684 if Flags and unMountainDelay <> 0 then 1685 begin 1686 Movement := 0; 1687 Flags := Flags and not unMountainDelay 1688 end 1689 else 1690 Movement := UnitSpeed(pTurn, mix, Health); { refresh movement } 1691 1692 assert(Loc >= 0); 1693 if Model[mix].Kind <> mkDiplomat then 1694 begin // check treaty violation 1695 p1 := RealMap[Loc] shr 27; 1696 if (p1 < nPl) and (p1 <> pTurn) and (Treaty[p1] >= trPeace) then 1697 begin 1698 if (Job in [jCity, jPillage, jClear, jAfforest, jTrans]) or 1699 (Job in [jIrr, jMine, jFort, jBase]) and 1700 (RealMap[Loc] and fTerImp <> 0) then 1701 Job := jNone; 1702 if (GTurn > EvaStart[p1] + PeaceEvaTurns) and 1703 (Treaty[p1] <> trAlliance) then 1704 begin 1705 EvaStart[p1] := GTurn; 1706 Happened := Happened or phPeaceViolation; 1707 if Mode >= moMovie then 1708 CallPlayer(cShowPeaceViolation, p1, pTurn); 1709 end; 1710 end; 1711 end; 1712 1713 if ServerVersion[pTurn] >= $000EF0 then 1714 begin 1715 if (Health <= 0) or TribeExtinct then 1716 RemoveUnit_UpdateMap(pTurn, uix); 1717 end 1718 end; 1719 1720 if ServerVersion[pTurn] < $000EF0 then 1721 for uix := 0 to nUn - 1 do 1722 with Un[uix] do 1723 if Loc >= 0 then 1724 begin // unit loop 3 1725 Loc1 := Loc; 1726 Job0 := Job; 1727 if Job <> jNone then 1728 JobDone := Work(pTurn, uix); 1729 { settlers do terrain improvement jobs } 1730 if (Health <= 0) or TribeExtinct then 1731 RemoveUnit_UpdateMap(pTurn, uix); 1732 1733 if (Job0 = jCity) and JobDone then // new city 1734 begin 1735 AddBestCityTile(pTurn, RW[pTurn].nCity - 1); 1736 UpdateUnitMap(Loc1, true); 1737 if Mode >= moMovie then // tell enemies 1738 for p1 := 0 to nPl - 1 do 1739 if (1 shl p1 and GWatching <> 0) and (p1 <> pTurn) and 1740 (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then 1741 CallPlayer(cShowCityChanged, p1, Loc1); 1742 end 1743 end; 1744 1745 { pollution - city loop 3 } 1746 for cix := 0 to nCity - 1 do 1747 with City[cix] do 1748 if (Loc >= 0) and (Pollution >= MaxPollution) then 1749 Pollute(pTurn, cix); 1750 1751 CompactLists(pTurn); 1752 if (nUn = 0) and (nCity = 0) then 1753 begin // nation made extinct 1754 Happened := Happened or phExtinct; 1755 GAlive := GAlive and not(1 shl pTurn); 1756 Stat[stPop, pTurn, GTurn] := 0; 1757 Stat[stMil, pTurn, GTurn] := 0; 1758 Stat[stScience, pTurn, GTurn] := 0; 1759 Stat[stExplore, pTurn, GTurn] := 0; 1760 Stat[stTerritory, pTurn, GTurn] := 0; 1761 Stat[stWork, pTurn, GTurn] := 0; 1762 for p1 := 0 to nPl - 1 do 1763 if 1 shl p1 and (GAlive or GWatching) <> 0 then 1764 begin 1765 if p1 <> pTurn then 1766 begin 1767 GiveCivilReport(p1, pTurn); 1768 if (GTestFlags and tfUncover <> 0) or (Difficulty[p1] = 0) or 1769 (RW[p1].Treaty[pTurn] = trAlliance) then 1770 GiveMilReport(p1, pTurn); 1771 end; 1772 with RW[p1] do 1773 begin 1774 Alive := GAlive; 1775 for Loc1 := 0 to MapSize - 1 do 1776 if Territory[Loc1] = pTurn then 1777 // remove territory of extinct nation from player maps 1778 begin 1779 Territory[Loc1] := -1; 1780 Map[Loc1] := Map[Loc1] and not fPeace 1781 end 1782 end; 1783 end; 1784 exit 1785 end; 1786 1787 // check research 1788 Cost := TechCost(pTurn); 1789 if GTestFlags and tfImmAdvance <> 0 then 1790 Research := Cost; 1791 if (Happened and phTech = 0) and (Research >= Cost) then 1792 begin 1793 if ResearchTech = adMilitary then 1794 EnableDevModel(pTurn) { new Unit class initiated } 1795 else if ResearchTech >= 0 then 1796 DiscoverTech(pTurn, ResearchTech); 1797 1798 dec(Research, Cost); 1799 Happened := Happened or phTech; 1800 ResearchTech := -1 1801 end 1802 else if (ResearchTech = -2) and (nCity > 0) then 1803 begin 1804 Happened := Happened or phTech; 1805 ResearchTech := -1 1806 end; 1807 1808 if Credibility < MaxCredibility then 1809 for p1 := 0 to nPl - 1 do 1810 if (p1 <> pTurn) and (1 shl p1 and GAlive <> 0) and 1811 (Treaty[p1] >= trPeace) then 1812 begin 1813 inc(Credibility); 1814 Break 1815 end; 1816 1817 if GWinner = 0 then 1818 CheckWin(pTurn); 1819 if (Mode >= moMovie) and (GWinner = 0) and 1820 ((ShowShipChange.Ship1Change[0] > 0) or 1821 (ShowShipChange.Ship1Change[1] > 0) or 1822 (ShowShipChange.Ship1Change[2] > 0)) then 1823 begin 1824 ShowShipChange.Reason := scrProduction; 1825 ShowShipChange.Ship1Owner := pTurn; 1826 ShowShipChange.Ship2Owner := -1; 1827 for p1 := 0 to nPl - 1 do 1828 if (p1 <> pTurn) and (1 shl p1 and (GAlive or GWatching) <> 0) then 1829 begin 1830 move(GShip, RW[p1].Ship, SizeOf(GShip)); 1831 if 1 shl p1 and GWatching <> 0 then 1832 CallPlayer(cShowShipChange, p1, ShowShipChange); 1833 end 1834 end; 1835 if WinOnAlone and (GAlive and not(1 shl pTurn or 1) = 0) then 1836 GWinner := 1 shl pTurn; // break if only one nation left 1837 1838 if GTurn = AnarchyStart + AnarchyTurns then 1839 begin 1840 AnarchyStart := -AnarchyTurns - 1; 1841 Government := gDespotism; 1842 for p1 := 0 to nPl - 1 do 1843 if (p1 <> pTurn) and ((GAlive or GWatching) and (1 shl p1) <> 0) then 1844 RW[p1].EnemyReport[pTurn].Government := gDespotism; 1845 inc(Happened, phChangeGov) 1846 end; 1847 end; // if Difficulty[pTurn]>0 1848 1849 if (pTurn = 0) and (GWinner > 0) then 1850 begin // game over, give world map and all reports to player 0 1851 DiscoverAll(pTurn, lObserveSuper); 1852 for p1 := 1 to nPl - 1 do 1853 if 1 shl p1 and GAlive <> 0 then 1854 begin 1855 if RW[pTurn].Treaty[p1] < trNone then 1856 begin 1857 RW[pTurn].Treaty[p1] := trNone; 1858 RW[p1].Treaty[pTurn] := trNone; 1859 end; 1860 GiveCivilReport(pTurn, p1); 1861 GiveMilReport(pTurn, p1); 1862 end; 1863 end 1864 else 820 1865 begin 821 for i:=0 to nStat-1 do FreeMem(Stat[i,p1]); 822 if RW[p1].BattleHistory<>nil then FreeMem(RW[p1].BattleHistory); 823 {if RW[p1].BorderHelper<>nil then FreeMem(RW[p1].BorderHelper);} 824 FreeMem(RW[p1].Data); 825 FreeMem(SavedData[p1]); 826 if RW[p1].DefaultDebugMap<>nil then 827 FreeMem(RW[p1].DefaultDebugMap); 828 end; 829 UnitProcessing.ReleaseGame; 830 CityProcessing.ReleaseGame; 831 Database.ReleaseGame; 832 CL.Free; 833 end; 834 835 procedure GenerateStat(p: integer); 836 var 837 cix,uix: integer; 838 begin 839 if Difficulty[p]>0 then with RW[p] do 840 begin 841 Stat[stPop,p,GTurn]:=0; 842 for cix:=0 to nCity-1 do if City[cix].Loc>=0 then 843 inc(Stat[stPop,p,GTurn],City[cix].Size); 844 Stat[stScience,p,GTurn]:=Researched[p]*50; 845 if (RW[p].ResearchTech>=0) and (RW[p].ResearchTech<>adMilitary) then 846 inc(Stat[stScience,p,GTurn], 847 Research*100 div TechBaseCost(nTech[p],Difficulty[p])); 848 Stat[stMil,p,GTurn]:=0; 849 for uix:=0 to nUn-1 do if Un[uix].Loc>=0 then 850 with Model[Un[uix].mix] do 851 begin 852 if (Kind<=mkEnemyDeveloped) and (Un[uix].mix<>1) then 853 inc(Stat[stMil,p,GTurn],Weight*MStrength*Un[uix].Health div 100) 854 else if Domain=dGround then inc(Stat[stMil,p,GTurn],(Attack+2*Defense)*Un[uix].Health div 100) 855 else inc(Stat[stMil,p,GTurn],(Attack+Defense)*Un[uix].Health div 100); 856 case Kind of 857 mkSlaves: inc(Stat[stPop,p,GTurn]); 858 mkSettler: inc(Stat[stPop,p,GTurn],2); 859 end; 860 end; 861 Stat[stMil,p,GTurn]:=Stat[stMil,p,GTurn] div 16; 862 Stat[stExplore,p,GTurn]:=Discovered[p]; 863 Stat[stTerritory,p,GTurn]:=TerritoryCount[p]; 864 Stat[stWork,p,GTurn]:=Worked[p]; 865 LastValidStat[p]:=GTurn; 866 end; 867 end; 868 869 procedure LogCityTileChanges; 870 var 871 cix: integer; 872 begin 873 for cix:=0 to RW[pTurn].nCity-1 do 874 with RW[pTurn].City[cix] do if Loc>=0 then 1866 // show observed areas 1867 if (GTestFlags and tfUncover <> 0) or (Difficulty[pTurn] = 0) 1868 then { supervisor - all tiles visible } 875 1869 begin 876 { if SavedResourceWeights[cix]<>ResourceWeights then 877 begin // log city resource weight changes 878 CL.Put(sSetCityResourceWeights, pTurn, cix, @ResourceWeights); 879 SavedResourceWeights[cix]:=ResourceWeights; 880 end;} 881 if SavedTiles[cix]<>Tiles then 882 begin // log city tile changes 883 CL.Put(sSetCityTiles, pTurn, cix, @Tiles); 884 SavedTiles[cix]:=Tiles; 885 end; 886 end; 887 end; 888 889 procedure NoLogCityTileChanges; 890 var 891 cix: integer; 892 begin 893 for cix:=0 to RW[pTurn].nCity-1 do 894 with RW[pTurn].City[cix] do if Loc>=0 then 1870 if (bix[pTurn] <> bixNoTerm) and 1871 ((Difficulty[pTurn] > 0) or (Mode > moLoading_Fast)) then 1872 DiscoverAll(pTurn, lObserveSuper) 1873 end 1874 else 895 1875 begin 896 // SavedResourceWeights[cix]:=ResourceWeights; 897 SavedTiles[cix]:=Tiles; 898 end; 899 end; 900 901 function HasCityTileChanges: boolean; 902 var 903 cix: integer; 904 begin 905 result:=false; 906 for cix:=0 to RW[pTurn].nCity-1 do 907 with RW[pTurn].City[cix] do if Loc>=0 then 908 begin 909 // if SavedResourceWeights[cix]<>ResourceWeights then result:=true; 910 if SavedTiles[cix]<>Tiles then result:=true; 911 end; 912 end; 913 914 procedure BeforeTurn0; 915 var 916 p1,uix: integer; 917 begin 918 for uix:=0 to RW[pTurn].nUn-1 do {init movement points for first turn} 919 with RW[pTurn].Un[uix] do Movement:=RW[pTurn].Model[mix].Speed; 920 921 if Difficulty[pTurn]>0 then 922 DiscoverViewAreas(pTurn) 923 else {supervisor} 924 begin 925 DiscoverAll(pTurn,lObserveSuper); 926 for p1:=1 to nPl-1 do 927 if 1 shl p1 and GAlive<>0 then 928 begin 929 GiveCivilReport(pTurn, p1); 930 GiveMilReport(pTurn, p1) 931 end; 932 end; 933 //CheckContact; 934 end; 935 936 function LoadGame(const Path, FileName: string; Turn: integer; MovieMode: boolean): boolean; 937 var 938 i,j,ix,d,p1,Command,Subject: integer; 939 {$IFDEF TEXTLOG}LoadPos0: integer;{$ENDIF} 940 Data: pointer; 941 LogFile: TFileStream; 942 FormerCLState: TCmdListState; 943 s: string[255]; 944 SaveMap: array[0..lxmax*lymax-1] of Byte; 945 started,StatRequest: boolean; 946 begin 947 SavePath:=Path; 948 LogFileName:=FileName; 949 LoadTurn:=Turn; 950 LogFile:=TFileStream.Create(SavePath+LogFileName,fmOpenRead or fmShareExclusive); 951 LogFile.Position:=0; 952 LogFile.read(s[1],8); {file id} 953 LogFile.read(i,4); {c-evo version} 954 LogFile.read(j,4); {exe time} 955 956 if (i>=FirstBookCompatibleVersion) and (i<=Version) then 957 begin 958 result:=true; 959 LogFile.read(lx,4); 960 LogFile.read(ly,4); 961 MapSize:=lx*ly; 962 LogFile.read(LandMass,4); 963 if LandMass=0 then 964 LogFile.read(RealMap,MapSize*4); // use predefined map 965 LogFile.read(MaxTurn,4); 966 LogFile.read(RND,4); 967 LogFile.read(GTurn,4); 968 LogFile.read(SaveMap,4); 969 if SaveMap[0]<>$80 then 970 LogFile.read(SaveMap[4],((MapSize-1) div 4+1)*4-4); 971 for p1:=0 to nPl-1 do 972 begin 973 LogFile.read(s[0],4); 974 if s[0]=#0 then bixView[p1]:=-1 975 else 976 begin 977 LogFile.read(s[4],Byte(s[0]) div 4 *4); 978 LogFile.read(OriginalDataVersion[p1],4); 979 LogFile.read(d,4);{behavior} 980 LogFile.read(Difficulty[p1],4); 981 j:=nBrain-1; 982 while (j>=0) and (AnsiCompareFileName(Brain[j].FileName,s)<>0) do 983 dec(j); 984 if j<0 then 985 begin // ai not found -- replace by local player 986 ProcessClientData[p1]:=false; 987 NotifyMessage:=s; 988 Notify(ntAIError); 989 j:=bixTerm; 990 end 991 else ProcessClientData[p1]:=true; 992 if j=bixNoTerm then j:=bixSuper_Virtual; 993 // crashed tournament -- load as supervisor 994 bixView[p1]:=j; 995 end; 996 end; 997 end 998 else result:=false; 999 1000 if result then 1001 begin 1002 CL:=TCmdList.Create; 1003 CL.LoadFromFile(LogFile); 1004 end; 1005 LogFile.Free; 1006 if not result then exit; 1007 1008 Notify(ntStartDone); 1009 if LoadTurn<0 then LoadTurn:=GTurn; 1010 if MovieMode then Mode:=moMovie 1011 else if LoadTurn=0 then Mode:=moLoading 1012 else Mode:=moLoading_Fast; 1013 {$IFDEF TEXTLOG}AssignFile(TextLog,SavePath+LogFileName+'.txt');Rewrite(TextLog);{$ENDIF} 1014 LoadOK:=true; 1015 StartGame; 1016 if MovieMode then 1017 begin 1018 Brain[bix[0]].Client(cShowGame,0,nil^); 1019 Notify(ntBackOff); 1020 end 1021 else Notify(ntLoadBegin); 1022 1023 started:=false; 1024 StatRequest:=false; 1025 MovieStopped:=false; 1026 {$IFDEF LOADPERF}QueryPerformanceCounter(time_total0); time_a:=0; time_b:=0; time_c:=0;{$ENDIF} 1027 while not MovieStopped and (CL.Progress<1000) do 1028 begin 1029 FormerCLState:=CL.State; 1030 CL.Get(Command, p1, Subject, Data); 1031 if p1<0 then p1:=pTurn; 1032 if StatRequest 1033 and (Command and (sctMask or sExecute)<>sctInternal or sExecute) then 1034 begin GenerateStat(pTurn); StatRequest:=false end; 1035 // complete all internal commands following an sTurn before generating statistics 1036 if (Command=sTurn) and not started then 1037 begin 1038 {$IFDEF TEXTLOG}WriteLn(TextLog,'---Turn 0 P0---');{$ENDIF} 1039 for p1:=0 to nPl-1 do 1040 if (bix[p1]>=0) and ((Mode<>moMovie) or (p1=0)) then 1041 CallPlayer(cReplay,p1,nil^); 1042 BeforeTurn0; 1043 if MovieMode then 1044 begin 1045 Inform(pTurn); 1046 CallPlayer(cMovieTurn,0,nil^); 1047 end; 1048 StatRequest:=true; 1049 started:=true; 1050 end 1051 else if (Command=sTurn) and (pTurn=0) and (GTurn=LoadTurn) then 1052 begin 1053 assert(CL.State.LoadPos=FormerCLState.LoadPos+4); // size of sTurn 1054 CL.State:=FormerCLState; 1055 CL.Cut; 1056 Break; 1057 end 1058 else if Command=sIntDataChange then 1059 begin 1060 {$IFDEF TEXTLOG}LoadPos0:=CL.State.LoadPos;{$ENDIF} 1061 if ProcessClientData[p1] then 1062 CL.GetDataChanges(RW[p1].Data, Brain[bix[p1]].DataSize) 1063 else CL.GetDataChanges(nil, 0); 1064 {$IFDEF TEXTLOG}WriteLn(TextLog,Format('Data Changes P%d (%d Bytes)', [p1,CL.State.LoadPos-LoadPos0]));{$ENDIF} 1065 end 1066 else 1067 begin 1068 {$IFDEF TEXTLOG}CmdInfo:=Format('Command %x',[Command]);{$ENDIF} 1069 if Command and (sctMask or sExecute)=sctInternal or sExecute then 1070 IntServer(Command, p1, Subject, Data^) // internal command 1071 else 1072 begin 1073 StatRequest:= Command=sTurn; 1074 Server(Command, p1, Subject, Data^); 1075 end; 1076 {$IFDEF TEXTLOG}WriteLn(TextLog,CmdInfo);{$ENDIF} 1077 end; 1078 if not MovieMode then Notify(ntLoadState+CL.Progress*128 div 1000); 1079 end; 1080 1081 if MovieMode then 1082 begin 1083 Notify(ntBackOn); 1084 Brain[bix[0]].Client(cBreakGame,-1,nil^); 1085 EndGame; 1086 Notify(ntStartGo); 1087 result:=false; 1088 exit; 1089 end; 1090 1091 if StatRequest then GenerateStat(pTurn); 1092 assert(started); 1093 {$IFDEF TEXTLOG}CloseFile(TextLog);{$ENDIF} 1094 {$IFDEF LOADPERF}QueryPerformanceCounter(time_total);{time in s is: (time_total-time_total0)/PerfFreq}{$ENDIF} 1095 NoLogChanges; 1096 NoLogCityTileChanges; 1097 if LogFileName[1]='~' then 1098 begin Delete(LogFileName,1,1); nLogOpened:=-1 end 1099 else nLogOpened:=CL.State.nLog; 1100 1101 Mode:=moPlaying; 1102 LastEndClientCommand:=-1; 1103 if (GTestFlags and tfUncover<>0) or (Difficulty[pTurn]=0) then 1104 DiscoverAll(pTurn,lObserveSuper) {supervisor - all tiles visible} 1105 else DiscoverViewAreas(pTurn); 1106 1107 for p1:=0 to nPl-1 do if 1 shl p1 and (GAlive or GWatching)<>0 then 1108 begin 1109 RecalcPeaceMap(p1); 1110 for ix:=0 to RW[p1].nEnemyUn-1 do with RW[p1].EnemyUn[ix] do 1111 emix:=RWemix[p1,Owner,mix]; 1112 Inform(p1); 1113 end; 1114 {$IFOPT O-}CheckBorders(-2);{$ENDIF} // for testing only 1115 Notify(ntEndInfo); 1116 if not LoadOK then 1117 begin NotifyMessage:=SavePath+LogFileName; Notify(ntLoadError); end; 1118 Brain[bix[0]].Client(cShowGame,0,nil^); 1119 Notify(ntBackOff); 1120 Inform(pTurn); 1121 ChangeClientWhenDone(cResume,0,nil^,0); 1122 end; //LoadGame 1123 1124 procedure InsertTerritoryUpdateCommands; 1125 var 1126 p1,Command,Subject: integer; 1127 Data: pointer; 1128 FormerCLState: TCmdListState; 1129 begin 1130 while CL.Progress<1000 do 1131 begin 1132 FormerCLState:=CL.State; 1133 CL.Get(Command, p1, Subject, Data); 1134 if (Command=sIntExpandTerritory) and (p1=pTurn) then 1135 begin 1136 IntServer(Command, p1, Subject, Data^); 1137 {$IFDEF TEXTLOG}WriteLn(TextLog,'AfterTurn - ExpandTerritory');{$ENDIF} 1138 end 1139 else 1140 begin 1141 CL.State:=FormerCLState; 1142 break 1876 DiscoverViewAreas(pTurn); 1877 if MirBuilt then 1878 DiscoverAll(pTurn, lObserveUnhidden) 1143 1879 end 1144 1880 end; 1145 {$IFOPT O-}InvalidTreatyMap:=0;{$ENDIF} 1881 // CheckContact; 1882 end; { BeforeTurn } 1883 1884 procedure AfterTurn; 1885 var 1886 cix, uix, p1, Loc1, Job0: integer; 1887 JobDone: boolean; 1888 begin 1889 with RW[pTurn] do 1890 begin 1891 for cix := 0 to nCity - 1 do 1892 if City[cix].Loc >= 0 then 1893 begin 1894 // City[cix].Flags:=City[cix].Flags and not chProductionSabotaged; 1895 City[cix].Flags := City[cix].Flags and (chCaptured or chDisorder); 1896 CollectCityResources(pTurn, cix); // new style 1897 end; 1898 1899 inc(Money, OracleIncome); 1900 OracleIncome := 0; 1901 if GWonder[woOracle].EffectiveOwner = pTurn then 1902 begin 1903 for p1 := 0 to nPl - 1 do 1904 if (1 shl p1 and GAlive <> 0) and 1905 ((p1 = pTurn) or (RW[pTurn].Treaty[p1] > trNoContact)) then 1906 for cix := 0 to RW[p1].nCity - 1 do 1907 if (RW[p1].City[cix].Loc >= 0) and 1908 (RW[p1].City[cix].built[imTemple] > 0) then 1909 inc(OracleIncome); 1910 end; 1911 1912 if (GTestFlags and tfImmImprove = 0) and (Government <> gAnarchy) then 1913 for cix := 0 to nCity - 1 do 1914 if (City[cix].Loc >= 0) and (City[cix].Flags and chCaptured = 0) then 1915 PayCityMaintenance(pTurn, cix); 1916 1917 if ServerVersion[pTurn] >= $000EF0 then 1918 begin // let settlers work 1919 for cix := 0 to nCity - 1 do 1920 City[cix].Flags := City[cix].Flags and not chFounded; 1921 for uix := 0 to nUn - 1 do 1922 with Un[uix] do 1923 if Loc >= 0 then 1924 begin 1925 Loc1 := Loc; 1926 Job0 := Job; 1927 if Job <> jNone then 1928 JobDone := Work(pTurn, uix); 1929 { settlers do terrain improvement jobs } 1930 if Health <= 0 then 1931 RemoveUnit_UpdateMap(pTurn, uix); 1932 1933 if (Job0 = jCity) and JobDone then // new city 1934 begin 1935 AddBestCityTile(pTurn, RW[pTurn].nCity - 1); 1936 UpdateUnitMap(Loc1, true); 1937 if Mode >= moMovie then // tell enemies 1938 for p1 := 0 to nPl - 1 do 1939 if (1 shl p1 and GWatching <> 0) and (p1 <> pTurn) and 1940 (ObserveLevel[Loc1] and (3 shl (2 * p1)) > 0) then 1941 CallPlayer(cShowCityChanged, p1, Loc1); 1942 end 1943 end; 1944 end; 1945 1946 for uix := 0 to nUn - 1 do 1947 with Un[uix] do 1948 if Loc >= 0 then 1949 begin { next turn for all units } 1950 if Model[mix].Domain = dAir then 1951 if (Master >= 0) or (RealMap[Loc] and fCity <> 0) or 1952 (RealMap[Loc] and fTerImp = tiBase) then 1953 begin 1954 Fuel := Model[mix].Cap[mcFuel]; 1955 Flags := Flags or unBombsLoaded 1956 end 1957 else if Model[mix].Kind = mkSpecial_Glider then { glider } 1958 begin 1959 if RealMap[Loc] and fTerrain < fGrass then 1960 begin 1961 RemoveUnit_UpdateMap(pTurn, uix); // unit lost 1962 Happened := Happened or phGliderLost 1963 end 1964 end 1965 else 1966 begin 1967 dec(Fuel); 1968 if Fuel < 0 then 1969 begin 1970 RemoveUnit_UpdateMap(pTurn, uix); // unit lost 1971 Happened := Happened or phPlaneLost 1972 end 1973 end 1974 else if (Master < 0) and (Movement > 0) then // check HostileDamage 1975 begin 1976 Health := Health - HostileDamage(pTurn, mix, Loc, Movement); 1977 if Health < 0 then 1978 RemoveUnit_UpdateMap(pTurn, uix); 1979 end 1980 end; { unit loop 1 } 1981 1982 for uix := 0 to nUn - 1 do 1983 with Un[uix] do 1984 begin 1985 Flags := Flags and not unWithdrawn; 1986 if (Loc >= 0) and (Model[mix].Domain = dGround) and (Master < 0) and 1987 ((integer(Movement) = Model[mix].Speed) or 1988 (Model[mix].Cap[mcAcademy] > 0) and (Movement * 2 >= Model[mix].Speed)) 1989 then 1990 Flags := Flags or unFortified; // fortify unmoved units 1991 end; 1992 1993 if (GTestFlags and tfUncover = 0) and (Difficulty[pTurn] > 0) then 1994 begin // restrict view area to current positions 1995 MaskD(ObserveLevel, MapSize, not Cardinal(3 shl (2 * pTurn))); 1996 if Mode > moLoading_Fast then 1997 MaskD(RW[pTurn].Map^, MapSize, not Cardinal(fUnit or fHiddenUnit or 1998 fStealthUnit or fObserved or fSpiedOut or fOwned or fOwnZoCUnit or 1999 fInEnemyZoC)); 2000 RW[pTurn].nEnemyUn := 0; 2001 DiscoverViewAreas(pTurn); 2002 end; 2003 2004 if GWinner = 0 then 2005 for p1 := 0 to nPl - 1 do 2006 if 1 shl p1 and GAlive <> 0 then 2007 CheckWin(p1); 2008 end; 2009 end; // Afterturn 2010 2011 procedure NextPlayer; 2012 begin 2013 if GTurn = 0 then 2014 BeforeTurn0 2015 else 2016 BeforeTurn; 2017 NoLogCityTileChanges; 2018 GenerateStat(pTurn); 2019 Inform(pTurn); 2020 ChangeClient; 1146 2021 end; 1147 2022 1148 procedure StartNewGame(const Path, FileName, Map: string; Newlx, Newly, 1149 NewLandMass, NewMaxTurn: integer);2023 function ExecuteMove(p, uix, ToLoc: integer; var MoveInfo: TMoveInfo; 2024 ShowMove: TShowMove): integer; 1150 2025 var 1151 p: integer; 2026 i, p1, FromLoc, uix1, nUpdateLoc: integer; 2027 MinLevel, MissionResult: Cardinal; 2028 PModel: ^TModel; 2029 UpdateLoc: array [0 .. numax - 1] of integer; 2030 SeeFrom, SeeTo, ExtDiscover: boolean; 1152 2031 begin 1153 Notify(ntStartDone); 1154 SavePath:=Path; 1155 LogFileName:=FileName; 1156 MapFileName:=Map; 1157 if FastContact then begin lx:=24; ly:=42; end 1158 else begin lx:=Newlx; ly:=Newly end; 1159 MapSize:=lx*ly; 1160 if MapFileName<>'' then LandMass:=0 1161 else LandMass:=NewLandMass; 1162 MaxTurn:=NewMaxTurn; 1163 Randomize; 1164 RND:=RandSeed; 1165 Mode:=moPlaying; 1166 CL:=TCmdList.Create; 1167 StartGame; 1168 NoLogChanges; 1169 for p:=0 to nPl-1 do if bix[p]>=0 then 1170 CallPlayer(cGetReady,p,nil^); 1171 LogChanges; 1172 CL.Put(sTurn, 0, 0, nil); 1173 BeforeTurn0; 1174 NoLogCityTileChanges; 1175 GenerateStat(pTurn); 1176 nLogOpened:=-1; 1177 LastEndClientCommand:=-1; 1178 Brain[bix[0]].Client(cShowGame,0,nil^); 1179 Notify(ntBackOff); 1180 Inform(pTurn); 1181 ChangeClientWhenDone(cTurn,0,nil^,0) 1182 end; 1183 1184 procedure DirectHelp(Command: integer); 1185 begin 1186 InitBrain(bixTerm); 1187 Brain[bixTerm].Client(Command,-1,nil^); 1188 AICredits:=#0; 1189 end; 1190 1191 procedure EditMap(const Map: string; Newlx, Newly, NewLandMass: integer); 1192 var 1193 p1,Loc1: integer; 1194 Game: TNewGameData; 1195 begin 1196 Notify(ntStartDone); 1197 Notify(ntInitLocalHuman); 1198 MapFileName:=Map; 1199 lx:=Newlx; 1200 ly:=Newly; 1201 MapSize:=lx*ly; 1202 LandMass:=NewLandMass; 1203 bix[0]:=bixTerm; 1204 Difficulty[0]:=0; 1205 InitBrain(bixTerm); 1206 1207 Randomize; 1208 GAlive:=0; 1209 GWatching:=1; 1210 if not LoadMap(MapFileName) then 1211 for Loc1:=0 to MapSize-1 do RealMap[Loc1]:=fOcean or ($F shl 27); 1212 CL:=nil; 1213 InitMapEditor; 1214 RW[0].Data:=nil; 1215 RW[0].BorderHelper:=nil; 1216 RW[0].Alive:=0; 1217 Game.lx:=lx; Game.ly:=ly; 1218 Game.RO[0]:=@RW[0]; 1219 Game.Difficulty[0]:=0; 1220 for p1:=1 to nPl-1 do begin Game.RO[p1]:=nil; Game.Difficulty[p1]:=-1 end; 1221 Brain[bixTerm].Client(cNewMap,-1,Game); 1222 1223 DiscoverAll(0,lObserveSuper); 1224 Notify(ntEndInfo); 1225 Brain[bix[0]].Client(cShowGame,0,nil^); 1226 Notify(ntBackOff); 1227 ChangeClientWhenDone(cEditMap,0,nil^,0) 1228 end; 1229 1230 procedure DestroySpacePort_TellPlayers(p,pCapturer: integer); 1231 var 1232 cix,i,p1: integer; 1233 ShowShipChange: TShowShipChange; 1234 begin 1235 // stop ship part production 1236 for cix:=0 to RW[p].nCity-1 do with RW[p].City[cix] do 1237 if (Loc>=0) and (Project and cpImp<>0) 1238 and ((Project and cpIndex=woMIR) 1239 or (Imp[Project and cpIndex].Kind=ikShipPart)) then 2032 result := 0; 2033 with RW[p], Un[uix] do 2034 begin 2035 PModel := @Model[mix]; 2036 FromLoc := Loc; 2037 2038 if Master < 0 then 2039 FreeUnit(p, uix); 2040 if (MoveInfo.MoveType in [mtMove, mtCapture]) and MoveInfo.MountainDelay 2041 then 1240 2042 begin 1241 inc(RW[p].Money,Prod0); 1242 Prod:=0; 1243 Prod0:=0; 1244 Project:=cpImp+imTrGoods; 1245 Project0:=cpImp+imTrGoods 2043 Flags := Flags or unMountainDelay; 1246 2044 end; 1247 1248 // destroy ship 1249 with GShip[p] do if Parts[0]+Parts[1]+Parts[2]>0 then 1250 begin 1251 for i:=0 to nShipPart-1 do 2045 Loc := -2; 2046 if TroopLoad + AirLoad > 0 then 2047 for i := 0 to nUn - 1 do 2048 if (Un[i].Loc >= 0) and (Un[i].Master = uix) then 2049 Un[i].Loc := -2; 2050 UpdateUnitMap(FromLoc); 2051 2052 if Mode >= moMovie then { show move in interface modules } 1252 2053 begin 1253 ShowShipChange.Ship1Change[i]:=-Parts[i]; 1254 if pCapturer>=0 then 1255 begin 1256 ShowShipChange.Ship2Change[i]:=Parts[i]; 1257 inc(GShip[pCapturer].Parts[i], Parts[i]); 1258 end; 1259 Parts[i]:=0; 2054 ShowMove.EndHealth := MoveInfo.EndHealth; 2055 ShowMove.EndHealthDef := -1; 2056 if Master >= 0 then 2057 if Model[Un[Master].mix].Domain = dAir then 2058 ShowMove.Flags := ShowMove.Flags or umPlaneUnloading 2059 else 2060 ShowMove.Flags := ShowMove.Flags or umShipUnloading; 2061 if MoveInfo.ToMaster >= 0 then 2062 if Model[Un[MoveInfo.ToMaster].mix].Domain = dAir then 2063 ShowMove.Flags := ShowMove.Flags or umPlaneLoading 2064 else 2065 ShowMove.Flags := ShowMove.Flags or umShipLoading; 2066 for p1 := 0 to nPl - 1 do 2067 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1] = bixTerm)) 2068 then 2069 begin 2070 if PModel.Cap[mcStealth] > 0 then 2071 MinLevel := lObserveSuper 2072 else if PModel.Cap[mcSub] > 0 then 2073 MinLevel := lObserveAll 2074 else 2075 MinLevel := lObserveUnhidden; 2076 SeeFrom := (p1 = p) or (ObserveLevel[FromLoc] shr (2 * p1) and 2077 3 >= MinLevel); 2078 SeeTo := (p1 = p) or (ObserveLevel[ToLoc] shr (2 * p1) and 2079 3 >= MinLevel); 2080 if SeeFrom and SeeTo then 2081 begin 2082 TellAboutModel(p1, p, mix); 2083 if p1 = p then 2084 ShowMove.emix := -1 2085 else 2086 ShowMove.emix := emixSafe(p1, p, mix); 2087 if MoveInfo.MoveType = mtCapture then 2088 CallPlayer(cShowCapturing, p1, ShowMove) 2089 else 2090 CallPlayer(cShowMoving, p1, ShowMove); 2091 end 2092 else if SeeFrom then 2093 CallPlayer(cShowUnitChanged, p1, FromLoc); 2094 end; 1260 2095 end; 1261 if Mode>=moMovie then 2096 2097 if MoveInfo.MoveType <> mtSpyMission then 2098 Loc := ToLoc; 2099 if TroopLoad + AirLoad > 0 then 2100 for i := 0 to nUn - 1 do 2101 if Un[i].Loc = -2 then 2102 Un[i].Loc := ToLoc; 2103 2104 ExtDiscover := false; 2105 nUpdateLoc := 0; 2106 if MoveInfo.MoveType = mtCapture then 1262 2107 begin 1263 if pCapturer>=0 then ShowShipChange.Reason:=scrCapture 1264 else ShowShipChange.Reason:=scrDestruction; 1265 ShowShipChange.Ship1Owner:=p; 1266 ShowShipChange.Ship2Owner:=pCapturer; 1267 for p1:=0 to nPl-1 do if 1 shl p1 and (GAlive or GWatching)<>0 then 1268 begin 1269 move(GShip,RW[p1].Ship,SizeOf(GShip)); 1270 if 1 shl p1 and GWatching<>0 then 1271 CallPlayer(cShowShipChange,p1,ShowShipChange); 1272 end; 1273 end 1274 end 1275 end; 1276 1277 procedure DestroyCity_TellPlayers(p,cix: integer; SaveUnits: boolean); 1278 begin 1279 if RW[p].City[cix].built[imSpacePort]>0 then 1280 DestroySpacePort_TellPlayers(p,-1); 1281 DestroyCity(p,cix,SaveUnits); 1282 end; 1283 1284 procedure ChangeCityOwner_TellPlayers(pOld,cixOld,pNew: integer); 1285 begin 1286 if RW[pOld].City[cixOld].built[imSpacePort]>0 then 1287 if RW[pNew].NatBuilt[imSpacePort]>0 then 1288 DestroySpacePort_TellPlayers(pOld,pNew) 1289 else DestroySpacePort_TellPlayers(pOld,-1); 1290 ChangeCityOwner(pOld,cixOld,pNew); 1291 end; 1292 1293 procedure CheckWin(p: integer); 1294 var 1295 i: integer; 1296 ShipComplete: boolean; 1297 begin 1298 ShipComplete:=true; 1299 for i:=0 to nShipPart-1 do 1300 if GShip[p].Parts[i]<ShipNeed[i] then ShipComplete:=false; 1301 if ShipComplete then GWinner:=GWinner or 1 shl p; // game won! 1302 end; 1303 1304 procedure BeforeTurn; 1305 var 1306 i,p1,uix,cix,V21,Loc1,Cost,Job0,nAlive,nAppliers,ad, 1307 OldLoc,SiegedTiles,nUpdateLoc: integer; 1308 UpdateLoc: array[0..numax-1] of integer; 1309 Radius: TVicinity21Loc; 1310 ShowShipChange: TShowShipChange; 1311 TribeExtinct, JobDone, MirBuilt: boolean; 1312 begin 1313 {$IFOPT O-}assert(1 shl pTurn and InvalidTreatyMap=0);{$ENDIF} 1314 assert(1 shl pTurn and (GAlive or GWatching)<>0); 1315 if (1 shl pTurn and GAlive=0) and (Difficulty[pTurn]>0) then 1316 exit; 1317 1318 if (GWonder[woGrLibrary].EffectiveOwner=pTurn) and (GWinner=0) then 1319 begin // check great library effect 1320 nAlive:=0; 1321 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then inc(nAlive); 1322 for ad:=0 to nAdv-5 do if RW[pTurn].Tech[ad]<tsSeen then 1323 begin 1324 nAppliers:=0; 1325 for p1:=0 to nPl-1 do 1326 if (p1<>pTurn) and (1 shl p1 and GAlive<>0) 1327 and (RW[p1].Tech[ad]>=tsApplicable) then 1328 inc(nAppliers); 1329 if nAppliers*2>nAlive then 1330 begin 1331 SeeTech(pTurn,ad); 1332 inc(nTech[pTurn]); 1333 if Mode>=moMovie then 1334 CallPlayer(cShowGreatLibTech,pTurn,ad); 1335 // do not call CallPlayer(pTurn) while map is invalid 1336 end; 1337 end; 1338 end; 1339 1340 MaskD(ObserveLevel,MapSize,not Cardinal(3 shl (2*pTurn))); 1341 if Mode>moLoading_Fast then 1342 MaskD(RW[pTurn].Map^,MapSize,not Cardinal(fUnit or fHiddenUnit or fStealthUnit 1343 or fObserved or fSpiedOut or fOwned or fOwnZoCUnit or fInEnemyZoC)); 1344 RW[pTurn].nEnemyUn:=0; 1345 1346 MirBuilt:=false; 1347 if (Difficulty[pTurn]>0) and (GWinner=0) then with RW[pTurn] do 1348 begin 1349 if nCity>0 then for p1:=0 to nPl-1 do 1350 if GTurn=EvaStart[p1]+PeaceEvaTurns then 1351 begin // peace contract -- remove all units from p1's territory 1352 Loc1:=City[0].Loc; // search destination for homeless units 1353 for cix:=1 to nCity-1 do 1354 if (City[cix].Loc>=0) and ((Loc1<0) or (City[cix].Built[imPalace]>0)) then 1355 Loc1:=City[cix].Loc; 1356 for uix:=0 to nUn-1 do with Un[uix] do 1357 if (Loc>=0) and (Model[mix].Kind<>mkDiplomat) 1358 and ((Home>=0) or (Loc1>=0)) 1359 and (RealMap[Loc] shr 27=Cardinal(p1)) then 2108 assert(Occupant[ToLoc] < 0); 2109 for uix1 := 0 to RW[MoveInfo.Defender].nUn - 1 do 2110 with RW[MoveInfo.Defender].Un[uix1] do 2111 if (Loc >= 0) and (Home = MoveInfo.Dcix) then 1360 2112 begin 1361 OldLoc:=Loc; 1362 if Master>=0 then 1363 begin // transport unload 1364 if Model[mix].Domain=dAir then dec(Un[Master].AirLoad) 1365 else dec(Un[Master].TroopLoad); 1366 Master:=-1; 1367 end 1368 else FreeUnit(pTurn,uix); 1369 1370 if Home>=0 then Loc:=City[Home].Loc 1371 else Loc:=Loc1; 1372 PlaceUnit(pTurn,uix); 1373 UpdateUnitMap(OldLoc); 1374 UpdateUnitMap(Loc); 1375 Flags:=Flags or unWithdrawn; 1376 Happened:=Happened or phPeaceEvacuation; 1377 end 1378 end; 1379 1380 if Mode>=moMovie then 1381 fillchar(ShowShipChange,sizeof(ShowShipChange),0); 1382 TribeExtinct:=true; 1383 nUpdateLoc:=0; 1384 for cix:=0 to nCity-1 do with City[cix] do if Loc>=0 then 1385 begin {next turn for all cities - city loop 1} 1386 // if ServerVersion[pTurn]>=$000EF0 then 1387 // Flags:=Flags and (chFounded or chCaptured or chProductionSabotaged or chDisorder) 1388 // else Flags:=Flags and (chCaptured or chProductionSabotaged or chDisorder); 1389 // check for siege 1390 SiegedTiles:=0; 1391 V21_to_Loc(Loc,Radius); 1392 for V21:=1 to 26 do if Tiles and (1 shl V21) and not (1 shl CityOwnTile)<>0 then 1393 begin 1394 Loc1:=Radius[V21]; 1395 assert((Loc1>=0) and (Loc1<MapSize) and (UsedByCity[Loc1]=Loc)); 1396 p1:=RealMap[Loc1] shr 27; 1397 if (RealMap[Loc1] and fCity<>0) 1398 or (p1<nPl) and (p1<>pTurn) and (RW[pTurn].Treaty[p1]>=trPeace) 1399 or (ZoCMap[Loc1]>0) and (Occupant[Loc1]<>pTurn) 1400 and (Treaty[Occupant[Loc1]]<trPeace) then 2113 UpdateLoc[nUpdateLoc] := Loc; 2114 inc(nUpdateLoc) 2115 end; 2116 // unit will be removed -- remember position and update for all players 2117 2118 if (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size > 2) and (nCity < ncmax) 2119 then 2120 begin // city captured 2121 ChangeCityOwner_TellPlayers(MoveInfo.Defender, MoveInfo.Dcix, p); 2122 City[nCity - 1].Flags := CaptureTurns shl 16; 2123 CityShrink(p, nCity - 1); 2124 if Mode = moPlaying then 2125 with RW[p].City[nCity - 1] do 2126 begin 2127 // SavedResourceWeights[nCity-1]:=ResourceWeights; 2128 SavedTiles[nCity - 1] := Tiles; 2129 end; 2130 ExtDiscover := true; 2131 2132 // Temple of Zeus effect 2133 if GWonder[woZeus].EffectiveOwner = p then 1401 2134 begin 1402 Tiles:=Tiles and not (1 shl V21); 1403 UsedByCity[Loc1]:=-1; 1404 Flags:=Flags or chSiege; 1405 inc(SiegedTiles); 1406 end; 1407 end; 1408 while SiegedTiles>0 do // replace sieged tiles 1409 begin 1410 if not AddBestCityTile(pTurn,cix) then break; 1411 dec(SiegedTiles); 1412 end; 1413 1414 if Flags and chFounded=0 then 1415 begin 1416 // CollectCityResources(pTurn,cix); // old style 1417 1418 if CityTurn(pTurn,cix) then 1419 TribeExtinct:=false 1420 else 1421 begin // city is erased 1422 RemoveDomainUnits(dSea,pTurn,Loc); 1423 RemoveDomainUnits(dAir,pTurn,Loc); 1424 Map[Loc]:=Map[Loc] and not fCity; // !!! do this in inner core 1425 UpdateLoc[nUpdateLoc]:=Loc; 1426 inc(nUpdateLoc); 1427 DestroyCity_TellPlayers(pTurn,cix,true); 1428 end; 1429 1430 if (Flags and chProduction<>0) and (Project0 and cpImp<>0) then 1431 begin 1432 if Project0 and cpIndex=woMir then // MIR completed 1433 MirBuilt:=true 1434 else if Project0 and cpIndex=woManhattan then 1435 GColdWarStart:=GTurn 1436 else if Imp[Project0 and cpIndex].Kind=ikShipPart then {ship parts produced} 1437 inc(ShowShipChange.Ship1Change[Project0 and cpIndex-imShipComp]); 1438 end 1439 end 1440 end;{city loop 1} 1441 if nUpdateLoc>0 then 1442 begin 1443 CheckBorders(-1,pTurn); 1444 for i:=0 to nUpdateLoc-1 do UpdateUnitMap(UpdateLoc[i],true); 1445 if Mode>=moMovie then 1446 for p1:=0 to nPl-1 do 1447 if (1 shl p1 and GWatching<>0) and (p1<>pTurn) then 1448 for i:=0 to nUpdateLoc-1 do 1449 if ObserveLevel[UpdateLoc[i]] shr (2*p1) and 3>=lObserveUnhidden then 1450 CallPlayer(cShowCityChanged,p1,UpdateLoc[i]); 1451 end; 1452 1453 for uix:=0 to nUn-1 do with Un[uix] do if Loc>=0 then 1454 begin // unit loop 2 1455 if Health<100 then Recover(pTurn,uix); 1456 1457 if Flags and unMountainDelay<>0 then 1458 begin 1459 Movement:=0; 1460 Flags:=Flags and not unMountainDelay 1461 end 1462 else Movement:=UnitSpeed(pTurn,mix,Health); {refresh movement} 1463 1464 assert(Loc>=0); 1465 if Model[mix].Kind<>mkDiplomat then 1466 begin // check treaty violation 1467 p1:=RealMap[Loc] shr 27; 1468 if (p1<nPl) and (p1<>pTurn) and (Treaty[p1]>=trPeace) then 1469 begin 1470 if (Job in [jCity,jPillage,jClear,jAfforest,jTrans]) 1471 or (Job in [jIrr,jMine,jFort,jBase]) and (RealMap[Loc] and fTerImp<>0) then 1472 Job:=jNone; 1473 if (GTurn>EvaStart[p1]+PeaceEvaTurns) and (Treaty[p1]<>trAlliance) then 1474 begin 1475 EvaStart[p1]:=GTurn; 1476 Happened:=Happened or phPeaceViolation; 1477 if Mode>=moMovie then 1478 CallPlayer(cShowPeaceViolation,p1,pTurn); 1479 end; 1480 end; 1481 end; 1482 1483 if ServerVersion[pTurn]>=$000EF0 then 1484 begin 1485 if (Health<=0) or TribeExtinct then RemoveUnit_UpdateMap(pTurn,uix); 1486 end 1487 end; 1488 1489 if ServerVersion[pTurn]<$000EF0 then 1490 for uix:=0 to nUn-1 do with Un[uix] do if Loc>=0 then 1491 begin // unit loop 3 1492 Loc1:=Loc; 1493 Job0:=Job; 1494 if Job<>jNone then JobDone:=Work(pTurn,uix); 1495 {settlers do terrain improvement jobs} 1496 if (Health<=0) or TribeExtinct then RemoveUnit_UpdateMap(pTurn,uix); 1497 1498 if (Job0=jCity) and JobDone then // new city 1499 begin 1500 AddBestCityTile(pTurn,RW[pTurn].nCity-1); 1501 UpdateUnitMap(Loc1,true); 1502 if Mode>=moMovie then // tell enemies 1503 for p1:=0 to nPl-1 do 1504 if (1 shl p1 and GWatching<>0) and (p1<>pTurn) 1505 and (ObserveLevel[Loc1] and (3 shl (2*p1))>0) then 1506 CallPlayer(cShowCityChanged,p1,Loc1); 1507 end 1508 end; 1509 1510 {pollution - city loop 3} 1511 for cix:=0 to nCity-1 do with City[cix] do 1512 if (Loc>=0) and (Pollution>=MaxPollution) then 1513 Pollute(pTurn,cix); 1514 1515 CompactLists(pTurn); 1516 if (nUn=0) and (nCity=0) then 1517 begin // nation made extinct 1518 Happened:=Happened or phExtinct; 1519 GAlive:=GAlive and not (1 shl pTurn); 1520 Stat[stPop,pTurn,GTurn]:=0; 1521 Stat[stMil,pTurn,GTurn]:=0; 1522 Stat[stScience,pTurn,GTurn]:=0; 1523 Stat[stExplore,pTurn,GTurn]:=0; 1524 Stat[stTerritory,pTurn,GTurn]:=0; 1525 Stat[stWork,pTurn,GTurn]:=0; 1526 for p1:=0 to nPl-1 do if 1 shl p1 and (GAlive or GWatching)<>0 then 1527 begin 1528 if p1<>pTurn then 1529 begin 1530 GiveCivilReport(p1, pTurn); 1531 if (GTestFlags and tfUncover<>0) or (Difficulty[p1]=0) 1532 or (RW[p1].Treaty[pTurn]=trAlliance) then 1533 GiveMilReport(p1, pTurn); 1534 end; 1535 with RW[p1] do 1536 begin 1537 Alive:=GAlive; 1538 for Loc1:=0 to MapSize-1 do 1539 if Territory[Loc1]=pTurn then // remove territory of extinct nation from player maps 2135 GiveCivilReport(p, MoveInfo.Defender); 2136 for i := 0 to nAdv - 1 do 2137 if not(i in FutureTech) and (RW[p].Tech[i] < tsSeen) and 2138 (RW[MoveInfo.Defender].Tech[i] >= tsApplicable) then 1540 2139 begin 1541 Territory[Loc1]:=-1; 1542 Map[Loc1]:=Map[Loc1] and not fPeace 2140 Happened := Happened or phStealTech; 2141 GStealFrom := MoveInfo.Defender; 2142 Break 1543 2143 end 1544 2144 end; 1545 end; 1546 exit 1547 end; 1548 1549 // check research 1550 Cost:=TechCost(pTurn); 1551 if GTestFlags and tfImmAdvance<>0 then Research:=Cost; 1552 if (Happened and phTech=0) and (Research>=Cost) then 1553 begin 1554 if ResearchTech=adMilitary then EnableDevModel(pTurn) {new Unit class initiated} 1555 else if ResearchTech>=0 then 1556 DiscoverTech(pTurn,ResearchTech); 1557 1558 dec(Research,Cost); 1559 Happened:=Happened or phTech; 1560 ResearchTech:=-1 1561 end 1562 else if (ResearchTech=-2) and (nCity>0) then 1563 begin 1564 Happened:=Happened or phTech; 1565 ResearchTech:=-1 1566 end; 1567 1568 if Credibility<MaxCredibility then 1569 for p1:=0 to nPl-1 do 1570 if (p1<>pTurn) and (1 shl p1 and GAlive<>0) 1571 and (Treaty[p1]>=trPeace) then 1572 begin inc(Credibility); Break end; 1573 1574 if GWinner=0 then CheckWin(pTurn); 1575 if (Mode>=moMovie) and (GWinner=0) and ((ShowShipChange.Ship1Change[0]>0) 1576 or (ShowShipChange.Ship1Change[1]>0) or (ShowShipChange.Ship1Change[2]>0)) then 1577 begin 1578 ShowShipChange.Reason:=scrProduction; 1579 ShowShipChange.Ship1Owner:=pTurn; 1580 ShowShipChange.Ship2Owner:=-1; 1581 for p1:=0 to nPl-1 do 1582 if (p1<>pTurn) and (1 shl p1 and (GAlive or GWatching)<>0) then 1583 begin 1584 move(GShip,RW[p1].Ship,SizeOf(GShip)); 1585 if 1 shl p1 and GWatching<>0 then 1586 CallPlayer(cShowShipChange,p1,ShowShipChange); 1587 end 1588 end; 1589 if WinOnAlone and (GAlive and not (1 shl pTurn or 1)=0) then 1590 GWinner:=1 shl pTurn; // break if only one nation left 1591 1592 if GTurn=AnarchyStart+AnarchyTurns then 1593 begin 1594 AnarchyStart:=-AnarchyTurns-1; 1595 Government:=gDespotism; 1596 for p1:=0 to nPl-1 do if (p1<>pTurn) and ((GAlive or GWatching) and (1 shl p1)<>0) then 1597 RW[p1].EnemyReport[pTurn].Government:=gDespotism; 1598 inc(Happened,phChangeGov) 1599 end; 1600 end; // if Difficulty[pTurn]>0 1601 1602 if (pTurn=0) and (GWinner>0) then 1603 begin // game over, give world map and all reports to player 0 1604 DiscoverAll(pTurn,lObserveSuper); 1605 for p1:=1 to nPl-1 do if 1 shl p1 and GAlive<>0 then 1606 begin 1607 if RW[pTurn].Treaty[p1]<trNone then 1608 begin 1609 RW[pTurn].Treaty[p1]:=trNone; 1610 RW[p1].Treaty[pTurn]:=trNone; 1611 end; 1612 GiveCivilReport(pTurn,p1); 1613 GiveMilReport(pTurn,p1); 1614 end; 1615 end 1616 else 1617 begin 1618 // show observed areas 1619 if (GTestFlags and tfUncover<>0) or (Difficulty[pTurn]=0) then {supervisor - all tiles visible} 1620 begin 1621 if (bix[pTurn]<>bixNoTerm) 1622 and ((Difficulty[pTurn]>0) or (Mode>moLoading_Fast)) then 1623 DiscoverAll(pTurn,lObserveSuper) 1624 end 1625 else 1626 begin 1627 DiscoverViewAreas(pTurn); 1628 if MirBuilt then 1629 DiscoverAll(pTurn,lObserveUnhidden) 1630 end 1631 end; 1632 //CheckContact; 1633 end; {BeforeTurn} 1634 1635 procedure AfterTurn; 1636 var 1637 cix,uix,p1,Loc1,Job0: integer; 1638 JobDone: boolean; 1639 begin 1640 with RW[pTurn] do 1641 begin 1642 for cix:=0 to nCity-1 do if City[cix].Loc>=0 then 1643 begin 1644 // City[cix].Flags:=City[cix].Flags and not chProductionSabotaged; 1645 City[cix].Flags:=City[cix].Flags and (chCaptured or chDisorder); 1646 CollectCityResources(pTurn,cix); // new style 1647 end; 1648 1649 inc(Money,OracleIncome); 1650 OracleIncome:=0; 1651 if GWonder[woOracle].EffectiveOwner=pTurn then 1652 begin 1653 for p1:=0 to nPl-1 do 1654 if (1 shl p1 and GAlive<>0) 1655 and ((p1=pTurn) or (RW[pTurn].Treaty[p1]>trNoContact)) then 1656 for cix:=0 to RW[p1].nCity-1 do 1657 if (RW[p1].City[cix].Loc>=0) and (RW[p1].City[cix].Built[imTemple]>0) then 1658 inc(OracleIncome); 1659 end; 1660 1661 if (GTestFlags and tfImmImprove=0) and (Government<>gAnarchy) then 1662 for cix:=0 to nCity-1 do 1663 if (City[cix].Loc>=0) and (City[cix].Flags and chCaptured=0) then 1664 PayCityMaintenance(pTurn,cix); 1665 1666 if ServerVersion[pTurn]>=$000EF0 then 1667 begin // let settlers work 1668 for cix:=0 to nCity-1 do 1669 City[cix].Flags:=City[cix].Flags and not chFounded; 1670 for uix:=0 to nUn-1 do with Un[uix] do if Loc>=0 then 1671 begin 1672 Loc1:=Loc; 1673 Job0:=Job; 1674 if Job<>jNone then JobDone:=Work(pTurn,uix); 1675 {settlers do terrain improvement jobs} 1676 if Health<=0 then RemoveUnit_UpdateMap(pTurn,uix); 1677 1678 if (Job0=jCity) and JobDone then // new city 1679 begin 1680 AddBestCityTile(pTurn,RW[pTurn].nCity-1); 1681 UpdateUnitMap(Loc1,true); 1682 if Mode>=moMovie then // tell enemies 1683 for p1:=0 to nPl-1 do 1684 if (1 shl p1 and GWatching<>0) and (p1<>pTurn) 1685 and (ObserveLevel[Loc1] and (3 shl (2*p1))>0) then 1686 CallPlayer(cShowCityChanged,p1,Loc1); 1687 end 1688 end; 1689 end; 1690 1691 for uix:=0 to nUn-1 do with Un[uix] do if Loc>=0 then 1692 begin {next turn for all units} 1693 if Model[mix].Domain=dAir then 1694 if (Master>=0) or (RealMap[Loc] and fCity<>0) 1695 or (RealMap[Loc] and fTerImp=tiBase) then 1696 begin 1697 Fuel:=Model[mix].Cap[mcFuel]; 1698 Flags:=Flags or unBombsLoaded 1699 end 1700 else if Model[mix].Kind=mkSpecial_Glider then {glider} 1701 begin 1702 if RealMap[Loc] and fTerrain<fGrass then 1703 begin 1704 RemoveUnit_UpdateMap(pTurn,uix); // unit lost 1705 Happened:=Happened or phGliderLost 1706 end 1707 end 1708 else 1709 begin 1710 dec(Fuel); 1711 if Fuel<0 then 1712 begin 1713 RemoveUnit_UpdateMap(pTurn,uix); // unit lost 1714 Happened:=Happened or phPlaneLost 1715 end 1716 end 1717 else if (Master<0) and (Movement>0) then // check HostileDamage 1718 begin 1719 Health:=Health-HostileDamage(pTurn,mix,Loc,Movement); 1720 if Health<0 then RemoveUnit_UpdateMap(pTurn,uix); 1721 end 1722 end; {unit loop 1} 1723 1724 for uix:=0 to nUn-1 do with Un[uix] do 1725 begin 1726 Flags:=Flags and not unWithdrawn; 1727 if (Loc>=0) and (Model[mix].Domain=dGround) and (Master<0) 1728 and ((integer(Movement)=Model[mix].Speed) 1729 or (Model[mix].Cap[mcAcademy]>0) and (Movement*2>=Model[mix].Speed)) then 1730 Flags:=Flags or unFortified; // fortify unmoved units 1731 end; 1732 1733 if (GTestFlags and tfUncover=0) and (Difficulty[pTurn]>0) then 1734 begin // restrict view area to current positions 1735 MaskD(ObserveLevel,MapSize,not Cardinal(3 shl (2*pTurn))); 1736 if Mode>moLoading_Fast then 1737 MaskD(RW[pTurn].Map^,MapSize,not Cardinal(fUnit or fHiddenUnit or fStealthUnit 1738 or fObserved or fSpiedOut or fOwned or fOwnZoCUnit or fInEnemyZoC)); 1739 RW[pTurn].nEnemyUn:=0; 1740 DiscoverViewAreas(pTurn); 1741 end; 1742 1743 if GWinner=0 then 1744 for p1:=0 to nPl-1 do if 1 shl p1 and GAlive<>0 then 1745 CheckWin(p1); 1746 end; 1747 end; //Afterturn 1748 1749 procedure NextPlayer; 1750 begin 1751 if GTurn=0 then BeforeTurn0 1752 else BeforeTurn; 1753 NoLogCityTileChanges; 1754 GenerateStat(pTurn); 1755 Inform(pTurn); 1756 ChangeClient; 1757 end; 1758 1759 function ExecuteMove(p,uix,ToLoc: integer; 1760 var MoveInfo: TMoveInfo; ShowMove: TShowMove): integer; 1761 var 1762 i,p1,FromLoc,uix1,nUpdateLoc: integer; 1763 MinLevel, MissionResult: Cardinal; 1764 PModel: ^TModel; 1765 UpdateLoc: array[0..numax-1] of integer; 1766 SeeFrom,SeeTo,ExtDiscover: boolean; 1767 begin 1768 result:=0; 1769 with RW[p],Un[uix] do 1770 begin 1771 PModel:=@Model[mix]; 1772 FromLoc:=Loc; 1773 1774 if Master<0 then 1775 FreeUnit(p,uix); 1776 if (MoveInfo.MoveType in [mtMove,mtCapture]) and MoveInfo.MountainDelay then 1777 begin Flags:=Flags or unMountainDelay; end; 1778 Loc:=-2; 1779 if TroopLoad+AirLoad>0 then 1780 for i:=0 to nUn-1 do 1781 if (Un[i].Loc>=0) and (Un[i].Master=uix) then 1782 Un[i].Loc:=-2; 1783 UpdateUnitMap(FromLoc); 1784 1785 if Mode>=moMovie then {show move in interface modules} 1786 begin 1787 ShowMove.EndHealth:=MoveInfo.EndHealth; 1788 ShowMove.EndHealthDef:=-1; 1789 if Master>=0 then 1790 if Model[Un[Master].mix].Domain=dAir then 1791 ShowMove.Flags:=ShowMove.Flags or umPlaneUnloading 1792 else ShowMove.Flags:=ShowMove.Flags or umShipUnloading; 1793 if MoveInfo.ToMaster>=0 then 1794 if Model[Un[MoveInfo.ToMaster].mix].Domain=dAir then 1795 ShowMove.Flags:=ShowMove.Flags or umPlaneLoading 1796 else ShowMove.Flags:=ShowMove.Flags or umShipLoading; 1797 for p1:=0 to nPl-1 do 1798 if (1 shl p1 and GWatching<>0) 1799 and ((p1<>p) or (bix[p1]=bixTerm)) then 1800 begin 1801 if PModel.Cap[mcStealth]>0 then MinLevel:=lObserveSuper 1802 else if PModel.Cap[mcSub]>0 then MinLevel:=lObserveAll 1803 else MinLevel:=lObserveUnhidden; 1804 SeeFrom:= (p1=p) or (ObserveLevel[FromLoc] shr (2*p1) and 3>=MinLevel); 1805 SeeTo:= (p1=p) or (ObserveLevel[ToLoc] shr (2*p1) and 3>=MinLevel); 1806 if SeeFrom and SeeTo then 1807 begin 1808 TellAboutModel(p1,p,mix); 1809 if p1=p then ShowMove.emix:=-1 1810 else ShowMove.emix:=emixSafe(p1,p,mix); 1811 if MoveInfo.MoveType=mtCapture then CallPlayer(cShowCapturing,p1,ShowMove) 1812 else CallPlayer(cShowMoving,p1,ShowMove); 1813 end 1814 else if SeeFrom then 1815 CallPlayer(cShowUnitChanged,p1,FromLoc); 1816 end; 1817 end; 1818 1819 if MoveInfo.MoveType<>mtSpyMission then 1820 Loc:=ToLoc; 1821 if TroopLoad+AirLoad>0 then 1822 for i:=0 to nUn-1 do 1823 if Un[i].Loc=-2 then Un[i].Loc:=ToLoc; 1824 1825 ExtDiscover:=false; 1826 nUpdateLoc:=0; 1827 if MoveInfo.MoveType=mtCapture then 1828 begin 1829 assert(Occupant[ToLoc]<0); 1830 for uix1:=0 to RW[MoveInfo.Defender].nUn-1 do with RW[MoveInfo.Defender].Un[uix1] do 1831 if (Loc>=0) and (Home=MoveInfo.Dcix) then 1832 begin UpdateLoc[nUpdateLoc]:=Loc; inc(nUpdateLoc) end; 1833 // unit will be removed -- remember position and update for all players 1834 1835 if (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size>2) and (nCity<ncmax) then 1836 begin // city captured 1837 ChangeCityOwner_TellPlayers(MoveInfo.Defender,MoveInfo.Dcix,p); 1838 City[nCity-1].Flags:=CaptureTurns shl 16; 1839 CityShrink(p,nCity-1); 1840 if Mode=moPlaying then with RW[p].City[nCity-1] do 1841 begin 1842 // SavedResourceWeights[nCity-1]:=ResourceWeights; 1843 SavedTiles[nCity-1]:=Tiles; 1844 end; 1845 ExtDiscover:=true; 1846 1847 // Temple of Zeus effect 1848 if GWonder[woZeus].EffectiveOwner=p then 1849 begin 1850 GiveCivilReport(p,MoveInfo.Defender); 1851 for i:=0 to nAdv-1 do 1852 if not (i in FutureTech) and (RW[p].Tech[i]<tsSeen) 1853 and (RW[MoveInfo.Defender].Tech[i]>=tsApplicable) then 1854 begin 1855 Happened:=Happened or phStealTech; 1856 GStealFrom:=MoveInfo.Defender; 1857 Break 1858 end 1859 end; 1860 if Mode=moPlaying then LogCheckBorders(p,nCity-1,MoveInfo.Defender); 1861 {$IFOPT O-}if Mode<moPlaying then InvalidTreatyMap:=not(1 shl p);{$ENDIF} 2145 if Mode = moPlaying then 2146 LogCheckBorders(p, nCity - 1, MoveInfo.Defender); 2147 {$IFOPT O-} if Mode < moPlaying then 2148 InvalidTreatyMap := not(1 shl p); {$ENDIF} 1862 2149 // territory should not be considered for the rest of the command 1863 2150 // execution, because during loading a game it's incorrect before 1864 2151 // subsequent sIntExpandTerritory is processed 1865 2152 end 1866 else // city destroyed1867 begin 1868 DestroyCity_TellPlayers(MoveInfo.Defender,MoveInfo.Dcix,false);1869 CheckBorders(ToLoc,MoveInfo.Defender);1870 end; 1871 RecalcPeaceMap(p);1872 if Mode>=moMovie then1873 move(GWonder,Wonder,SizeOf(GWonder));1874 end; { if MoveInfo.MoveType=mtCapture}1875 1876 if MoveInfo.MoveType=mtSpyMission then2153 else // city destroyed 2154 begin 2155 DestroyCity_TellPlayers(MoveInfo.Defender, MoveInfo.Dcix, false); 2156 CheckBorders(ToLoc, MoveInfo.Defender); 2157 end; 2158 RecalcPeaceMap(p); 2159 if Mode >= moMovie then 2160 move(GWonder, Wonder, SizeOf(GWonder)); 2161 end; { if MoveInfo.MoveType=mtCapture } 2162 2163 if MoveInfo.MoveType = mtSpyMission then 1877 2164 begin 1878 MissionResult:=DoSpyMission(p,MoveInfo.Defender,MoveInfo.Dcix,SpyMission); 1879 if (Mode=moPlaying) and (SpyMission=smStealForeignReports) then 1880 CallPlayer(cShowMissionResult,p,MissionResult); 2165 MissionResult := DoSpyMission(p, MoveInfo.Defender, MoveInfo.Dcix, 2166 SpyMission); 2167 if (Mode = moPlaying) and (SpyMission = smStealForeignReports) then 2168 CallPlayer(cShowMissionResult, p, MissionResult); 1881 2169 end; 1882 2170 1883 Health:=MoveInfo.EndHealth;1884 dec(Movement,MoveInfo.Cost);1885 // transport unload1886 if Master>=0 then2171 Health := MoveInfo.EndHealth; 2172 dec(Movement, MoveInfo.Cost); 2173 // transport unload 2174 if Master >= 0 then 1887 2175 begin 1888 if PModel.Domain=dAir then dec(Un[Master].AirLoad) 2176 if PModel.Domain = dAir then 2177 dec(Un[Master].AirLoad) 2178 else 2179 begin 2180 dec(Un[Master].TroopLoad); 2181 assert(Movement <= 0); 2182 end; 2183 Master := -1; 2184 end; 2185 2186 if (Health <= 0) or (MoveInfo.MoveType = mtSpyMission) then 2187 RemoveUnit(p, uix) // spy mission or victim of HostileDamage 1889 2188 else 1890 begin 1891 dec(Un[Master].TroopLoad); 1892 assert(Movement<=0); 1893 end; 1894 Master:=-1; 2189 begin // transport load 2190 Master := MoveInfo.ToMaster; 2191 if MoveInfo.ToMaster >= 0 then 2192 begin 2193 if PModel.Domain = dAir then 2194 inc(Un[MoveInfo.ToMaster].AirLoad) 2195 else 2196 inc(Un[MoveInfo.ToMaster].TroopLoad); 2197 end 2198 else 2199 PlaceUnit(p, uix); 1895 2200 end; 1896 2201 1897 if (Health<=0) or (MoveInfo.MoveType=mtSpyMission) then 1898 RemoveUnit(p,uix) // spy mission or victim of HostileDamage 1899 else 1900 begin // transport load 1901 Master:=MoveInfo.ToMaster; 1902 if MoveInfo.ToMaster>=0 then 1903 begin 1904 if PModel.Domain=dAir then inc(Un[MoveInfo.ToMaster].AirLoad) 1905 else inc(Un[MoveInfo.ToMaster].TroopLoad); 2202 if (MoveInfo.MoveType = mtCapture) and (nUpdateLoc > 0) then 2203 RecalcMapZoC(p); 2204 UpdateUnitMap(ToLoc, MoveInfo.MoveType = mtCapture); 2205 for i := 0 to nUpdateLoc - 1 do 2206 UpdateUnitMap(UpdateLoc[i]); 2207 // tell about lost units of defender 2208 2209 if (MoveInfo.MoveType <> mtSpyMission) and (Master < 0) then 2210 begin 2211 if (PModel.Kind = mkDiplomat) or (PModel.Domain = dAir) or 2212 (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] + PModel.Cap[mcAcademy] > 2213 0) or (RealMap[ToLoc] and fTerrain = fMountains) or 2214 (RealMap[ToLoc] and fTerImp = tiFort) or 2215 (RealMap[ToLoc] and fTerImp = tiBase) then 2216 ExtDiscover := true; 2217 if (PModel.Kind = mkDiplomat) or (PModel.Cap[mcSpy] > 0) then 2218 i := lObserveSuper 2219 else if (PModel.Domain = dAir) or 2220 (PModel.Cap[mcRadar] + PModel.Cap[mcCarrier] > 0) then 2221 i := lObserveAll 2222 else 2223 i := lObserveUnhidden; 2224 if ExtDiscover then 2225 begin 2226 if Discover21(ToLoc, p, i, true, PModel.Domain = dGround) then 2227 result := result or rEnemySpotted; 1906 2228 end 1907 else PlaceUnit(p,uix); 2229 else 2230 begin 2231 if Discover9(ToLoc, p, i, true, PModel.Domain = dGround) then 2232 result := result or rEnemySpotted; 2233 end; 1908 2234 end; 1909 2235 1910 if (MoveInfo.MoveType=mtCapture) and (nUpdateLoc>0) then 1911 RecalcMapZoC(p); 1912 UpdateUnitMap(ToLoc,MoveInfo.MoveType=mtCapture); 1913 for i:=0 to nUpdateLoc-1 do UpdateUnitMap(UpdateLoc[i]); 1914 // tell about lost units of defender 1915 1916 if (MoveInfo.MoveType<>mtSpyMission) and (Master<0) then 1917 begin 1918 if (PModel.Kind=mkDiplomat) or (PModel.Domain=dAir) 1919 or (PModel.Cap[mcRadar]+PModel.Cap[mcCarrier]+PModel.Cap[mcAcademy]>0) 1920 or (RealMap[ToLoc] and fTerrain=fMountains) 1921 or (RealMap[ToLoc] and fTerImp=tiFort) 1922 or (RealMap[ToLoc] and fTerImp=tiBase) then 1923 ExtDiscover:=true; 1924 if (PModel.Kind=mkDiplomat) or (PModel.Cap[mcSpy]>0) then 1925 i:=lObserveSuper 1926 else if (PModel.Domain=dAir) 1927 or (PModel.Cap[mcRadar]+PModel.Cap[mcCarrier]>0) then 1928 i:=lObserveAll 1929 else i:=lObserveUnhidden; 1930 if ExtDiscover then 1931 begin 1932 if Discover21(ToLoc,p,i,true, PModel.Domain=dGround) then 1933 result:=result or rEnemySpotted; 1934 end 1935 else 1936 begin 1937 if Discover9(ToLoc,p,i,true, PModel.Domain=dGround) then 1938 result:=result or rEnemySpotted; 1939 end; 1940 end; 1941 1942 if Mode>=moMovie then {show after-move in interface modules} 1943 for p1:=0 to nPl-1 do 1944 if (1 shl p1 and GWatching<>0) 1945 and ((p1<>p) or (bix[p1]=bixTerm)) then 2236 if Mode >= moMovie then { show after-move in interface modules } 2237 for p1 := 0 to nPl - 1 do 2238 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1] = bixTerm)) 2239 then 1946 2240 begin 1947 if PModel.Cap[mcStealth]>0 then MinLevel:=lObserveSuper 1948 else if PModel.Cap[mcSub]>0 then MinLevel:=lObserveAll 1949 else MinLevel:=lObserveUnhidden; 1950 SeeFrom:= (p1=p) or (ObserveLevel[FromLoc] shr (2*p1) and 3>=MinLevel); 1951 SeeTo:= (p1=p) or (ObserveLevel[ToLoc] shr (2*p1) and 3>=MinLevel); 1952 if SeeTo and (MoveInfo.MoveType=mtCapture) then 1953 CallPlayer(cShowCityChanged,p1,ToLoc); 1954 if SeeFrom and SeeTo then 1955 CallPlayer(cShowAfterMove,p1,ToLoc) 1956 else if (MoveInfo.MoveType<>mtSpyMission) and SeeTo then 1957 CallPlayer(cShowUnitChanged,p1,ToLoc); 1958 for i:=0 to nUpdateLoc-1 do 1959 if ObserveLevel[UpdateLoc[i]] shr (2*p1) and 3>=lObserveUnhidden then 1960 CallPlayer(cShowUnitChanged,p1,UpdateLoc[i]); 2241 if PModel.Cap[mcStealth] > 0 then 2242 MinLevel := lObserveSuper 2243 else if PModel.Cap[mcSub] > 0 then 2244 MinLevel := lObserveAll 2245 else 2246 MinLevel := lObserveUnhidden; 2247 SeeFrom := (p1 = p) or (ObserveLevel[FromLoc] shr (2 * p1) and 2248 3 >= MinLevel); 2249 SeeTo := (p1 = p) or (ObserveLevel[ToLoc] shr (2 * p1) and 2250 3 >= MinLevel); 2251 if SeeTo and (MoveInfo.MoveType = mtCapture) then 2252 CallPlayer(cShowCityChanged, p1, ToLoc); 2253 if SeeFrom and SeeTo then 2254 CallPlayer(cShowAfterMove, p1, ToLoc) 2255 else if (MoveInfo.MoveType <> mtSpyMission) and SeeTo then 2256 CallPlayer(cShowUnitChanged, p1, ToLoc); 2257 for i := 0 to nUpdateLoc - 1 do 2258 if ObserveLevel[UpdateLoc[i]] shr (2 * p1) and 3 >= lObserveUnhidden 2259 then 2260 CallPlayer(cShowUnitChanged, p1, UpdateLoc[i]); 1961 2261 end; 1962 2262 end; 1963 2263 end; // ExecuteMove 1964 2264 1965 function ExecuteAttack(p, uix,ToLoc: integer;1966 var MoveInfo: TMoveInfo;ShowMove: TShowMove): integer;1967 1968 procedure WriteBattleHistory(ToLoc, FromLoc, Attacker, Defender, 1969 mix Attacker, mixDefender: integer; AttackerLost, DefenderLost: boolean);2265 function ExecuteAttack(p, uix, ToLoc: integer; var MoveInfo: TMoveInfo; 2266 ShowMove: TShowMove): integer; 2267 2268 procedure WriteBattleHistory(ToLoc, FromLoc, Attacker, Defender, mixAttacker, 2269 mixDefender: integer; AttackerLost, DefenderLost: boolean); 1970 2270 var 1971 AttackerBattle, DefenderBattle: ^TBattle;2271 AttackerBattle, DefenderBattle: ^TBattle; 1972 2272 begin 1973 with RW[Attacker] do2273 with RW[Attacker] do 1974 2274 begin 1975 if nBattleHistory=0 then1976 ReallocMem(BattleHistory, 16*SizeOf(TBattle))1977 else if (nBattleHistory>=16)1978 and (nBattleHistory and (nBattleHistory-1)=0) then1979 ReallocMem(BattleHistory, nBattleHistory*(2*SizeOf(TBattle)));1980 AttackerBattle:=@BattleHistory[nBattleHistory];1981 inc(nBattleHistory);2275 if nBattleHistory = 0 then 2276 ReallocMem(BattleHistory, 16 * SizeOf(TBattle)) 2277 else if (nBattleHistory >= 16) and 2278 (nBattleHistory and (nBattleHistory - 1) = 0) then 2279 ReallocMem(BattleHistory, nBattleHistory * (2 * SizeOf(TBattle))); 2280 AttackerBattle := @BattleHistory[nBattleHistory]; 2281 inc(nBattleHistory); 1982 2282 end; 1983 with RW[Defender] do2283 with RW[Defender] do 1984 2284 begin 1985 if nBattleHistory=0 then1986 ReallocMem(BattleHistory, 16*SizeOf(TBattle))1987 else if (nBattleHistory>=16)1988 and (nBattleHistory and (nBattleHistory-1)=0) then1989 ReallocMem(BattleHistory, nBattleHistory*(2*SizeOf(TBattle)));1990 DefenderBattle:=@BattleHistory[nBattleHistory];1991 inc(nBattleHistory);2285 if nBattleHistory = 0 then 2286 ReallocMem(BattleHistory, 16 * SizeOf(TBattle)) 2287 else if (nBattleHistory >= 16) and 2288 (nBattleHistory and (nBattleHistory - 1) = 0) then 2289 ReallocMem(BattleHistory, nBattleHistory * (2 * SizeOf(TBattle))); 2290 DefenderBattle := @BattleHistory[nBattleHistory]; 2291 inc(nBattleHistory); 1992 2292 end; 1993 AttackerBattle.Enemy:=Defender;1994 AttackerBattle.Flags:=0;1995 AttackerBattle.Turn:=GTurn;1996 AttackerBattle.mix:=mixAttacker;1997 AttackerBattle.mixEnemy:=mixDefender;1998 AttackerBattle.ToLoc:=ToLoc;1999 AttackerBattle.FromLoc:=FromLoc;2000 DefenderBattle.Enemy:=Attacker;2001 DefenderBattle.Flags:=bhEnemyAttack;2002 DefenderBattle.Turn:=GTurn;2003 DefenderBattle.mix:=mixDefender;2004 DefenderBattle.mixEnemy:=mixAttacker;2005 DefenderBattle.ToLoc:=ToLoc;2006 DefenderBattle.FromLoc:=FromLoc;2007 if AttackerLost then2293 AttackerBattle.Enemy := Defender; 2294 AttackerBattle.Flags := 0; 2295 AttackerBattle.Turn := GTurn; 2296 AttackerBattle.mix := mixAttacker; 2297 AttackerBattle.mixEnemy := mixDefender; 2298 AttackerBattle.ToLoc := ToLoc; 2299 AttackerBattle.FromLoc := FromLoc; 2300 DefenderBattle.Enemy := Attacker; 2301 DefenderBattle.Flags := bhEnemyAttack; 2302 DefenderBattle.Turn := GTurn; 2303 DefenderBattle.mix := mixDefender; 2304 DefenderBattle.mixEnemy := mixAttacker; 2305 DefenderBattle.ToLoc := ToLoc; 2306 DefenderBattle.FromLoc := FromLoc; 2307 if AttackerLost then 2008 2308 begin 2009 AttackerBattle.Flags:=AttackerBattle.Flags or bhMyUnitLost;2010 DefenderBattle.Flags:=DefenderBattle.Flags or bhEnemyUnitLost;2309 AttackerBattle.Flags := AttackerBattle.Flags or bhMyUnitLost; 2310 DefenderBattle.Flags := DefenderBattle.Flags or bhEnemyUnitLost; 2011 2311 end; 2012 if DefenderLost then2312 if DefenderLost then 2013 2313 begin 2014 AttackerBattle.Flags:=AttackerBattle.Flags or bhEnemyUnitLost;2015 DefenderBattle.Flags:=DefenderBattle.Flags or bhMyUnitLost;2314 AttackerBattle.Flags := AttackerBattle.Flags or bhEnemyUnitLost; 2315 DefenderBattle.Flags := DefenderBattle.Flags or bhMyUnitLost; 2016 2316 end; 2017 2317 end; 2018 2318 2019 2319 var 2020 i,p1,FromLoc,uix1,nUpdateLoc,ExpGain, ExpelToLoc,cix1: integer;2021 PModel: ^TModel;2022 UpdateLoc: array[0..numax-1] of integer;2023 LoseCityPop,CityDestroyed,SeeFrom,SeeTo,ZoCDefenderDestroyed: boolean;2320 i, p1, FromLoc, uix1, nUpdateLoc, ExpGain, ExpelToLoc, cix1: integer; 2321 PModel: ^TModel; 2322 UpdateLoc: array [0 .. numax - 1] of integer; 2323 LoseCityPop, CityDestroyed, SeeFrom, SeeTo, ZoCDefenderDestroyed: boolean; 2024 2324 begin 2025 result:=0;2026 with RW[p].Un[uix] do2325 result := 0; 2326 with RW[p].Un[uix] do 2027 2327 begin 2028 PModel:=@RW[p].Model[mix];2029 FromLoc:=Loc;2030 2031 ShowMove.EndHealth:=MoveInfo.EndHealth;2032 ShowMove.EndHealthDef:=MoveInfo.EndHealthDef;2033 if MoveInfo.MoveType=mtAttack then2034 WriteBattleHistory(ToLoc, FromLoc, p, MoveInfo.Defender, mix,2035 RW[MoveInfo.Defender].Un[MoveInfo.Duix].mix,2036 MoveInfo.EndHealth<=0, MoveInfo.EndHealthDef<=0);2037 2038 {if RW[p].Treaty[MoveInfo.Defender]=trCeaseFire then2039 begin2040 if Mode>=moMovie then2328 PModel := @RW[p].Model[mix]; 2329 FromLoc := Loc; 2330 2331 ShowMove.EndHealth := MoveInfo.EndHealth; 2332 ShowMove.EndHealthDef := MoveInfo.EndHealthDef; 2333 if MoveInfo.MoveType = mtAttack then 2334 WriteBattleHistory(ToLoc, FromLoc, p, MoveInfo.Defender, mix, 2335 RW[MoveInfo.Defender].Un[MoveInfo.Duix].mix, MoveInfo.EndHealth <= 0, 2336 MoveInfo.EndHealthDef <= 0); 2337 2338 { if RW[p].Treaty[MoveInfo.Defender]=trCeaseFire then 2339 begin 2340 if Mode>=moMovie then 2041 2341 CallPlayer(cShowCancelTreaty,MoveInfo.Defender,p); 2042 CancelTreaty(p,MoveInfo.Defender)2043 end;}2044 if Mode>=moMovie then {show attack in interface modules}2045 for p1:=0 to nPl-1 do2046 if (1 shl p1 and GWatching<>0)2047 and ((p1<>p) or (bix[p1]=bixTerm))then2342 CancelTreaty(p,MoveInfo.Defender) 2343 end; } 2344 if Mode >= moMovie then { show attack in interface modules } 2345 for p1 := 0 to nPl - 1 do 2346 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1] = bixTerm)) 2347 then 2048 2348 begin 2049 SeeFrom:= ObserveLevel[FromLoc] shr (2*p1) and 3>=lObserveUnhidden; 2050 SeeTo:= ObserveLevel[ToLoc] shr (2*p1) and 3>=lObserveUnhidden; 2051 if SeeFrom and SeeTo then 2349 SeeFrom := ObserveLevel[FromLoc] shr (2 * p1) and 2350 3 >= lObserveUnhidden; 2351 SeeTo := ObserveLevel[ToLoc] shr (2 * p1) and 3 >= lObserveUnhidden; 2352 if SeeFrom and SeeTo then 2052 2353 begin 2053 TellAboutModel(p1,p,mix); 2054 if p1=p then ShowMove.emix:=-1 2055 else ShowMove.emix:=emixSafe(p1,p,mix); 2056 CallPlayer(cShowAttacking,p1,ShowMove); 2354 TellAboutModel(p1, p, mix); 2355 if p1 = p then 2356 ShowMove.emix := -1 2357 else 2358 ShowMove.emix := emixSafe(p1, p, mix); 2359 CallPlayer(cShowAttacking, p1, ShowMove); 2057 2360 end; 2058 2361 end; 2059 2362 2060 LoseCityPop:=false; 2061 if (RealMap[ToLoc] and fCity<>0) and 2062 ((MoveInfo.MoveType=mtAttack) and (MoveInfo.EndHealthDef<=0) 2063 or (MoveInfo.MoveType=mtBombard) and (BombardmentDestroysCity or (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size>2))) then 2064 case PModel.Domain of 2065 dGround: LoseCityPop:= (PModel.Cap[mcArtillery]>0) 2066 or (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Built[imWalls]=0) 2067 and (Continent[ToLoc]<>GrWallContinent[MoveInfo.Defender]); 2068 dSea: LoseCityPop:= RW[MoveInfo.Defender].City[MoveInfo.Dcix].Built[imCoastalFort]=0; 2069 dAir: LoseCityPop:= RW[MoveInfo.Defender].City[MoveInfo.Dcix].Built[imMissileBat]=0; 2070 end; 2071 CityDestroyed:=LoseCityPop and (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size<=2); 2072 2073 if MoveInfo.MoveType=mtBombard then 2363 LoseCityPop := false; 2364 if (RealMap[ToLoc] and fCity <> 0) and 2365 ((MoveInfo.MoveType = mtAttack) and (MoveInfo.EndHealthDef <= 0) or 2366 (MoveInfo.MoveType = mtBombard) and (BombardmentDestroysCity or 2367 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size > 2))) then 2368 case PModel.Domain of 2369 dGround: 2370 LoseCityPop := (PModel.Cap[mcArtillery] > 0) or 2371 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].built[imWalls] = 0) and 2372 (Continent[ToLoc] <> GrWallContinent[MoveInfo.Defender]); 2373 dSea: 2374 LoseCityPop := RW[MoveInfo.Defender].City[MoveInfo.Dcix].built 2375 [imCoastalFort] = 0; 2376 dAir: 2377 LoseCityPop := RW[MoveInfo.Defender].City[MoveInfo.Dcix].built 2378 [imMissileBat] = 0; 2379 end; 2380 CityDestroyed := LoseCityPop and 2381 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size <= 2); 2382 2383 if MoveInfo.MoveType = mtBombard then 2074 2384 begin 2075 assert(Movement>=100); 2076 if PModel.Attack=0 then Flags:=Flags and not unBombsLoaded; 2077 dec(Movement,100) 2385 assert(Movement >= 100); 2386 if PModel.Attack = 0 then 2387 Flags := Flags and not unBombsLoaded; 2388 dec(Movement, 100) 2078 2389 end 2079 else if MoveInfo.MoveType=mtExpel then2390 else if MoveInfo.MoveType = mtExpel then 2080 2391 begin 2081 assert(Movement>=100);2082 Job:=jNone;2083 Flags:=Flags and not unFortified;2084 dec(Movement,100)2392 assert(Movement >= 100); 2393 Job := jNone; 2394 Flags := Flags and not unFortified; 2395 dec(Movement, 100) 2085 2396 end 2086 else2397 else 2087 2398 begin 2088 assert(MoveInfo.MoveType=mtAttack); 2089 if MoveInfo.EndHealth=0 then 2090 RemoveUnit(p,uix,MoveInfo.Defender) // destroy attacker 2399 assert(MoveInfo.MoveType = mtAttack); 2400 if MoveInfo.EndHealth = 0 then 2401 RemoveUnit(p, uix, MoveInfo.Defender) // destroy attacker 2402 else 2403 begin // update attacker 2404 ExpGain := (Health - MoveInfo.EndHealth + 1) shr 1; 2405 if Exp + ExpGain > (nExp - 1) * ExpCost then 2406 Exp := (nExp - 1) * ExpCost 2407 else 2408 inc(Exp, ExpGain); 2409 Health := MoveInfo.EndHealth; 2410 Job := jNone; 2411 if RW[MoveInfo.Defender].Model[RW[MoveInfo.Defender].Un[MoveInfo.Duix] 2412 .mix].Domain < dAir then 2413 Flags := Flags and not unBombsLoaded; 2414 Flags := Flags and not unFortified; 2415 if Movement > 100 then 2416 dec(Movement, 100) 2417 else 2418 Movement := 0; 2419 end; 2420 end; 2421 2422 ZoCDefenderDestroyed := false; 2423 nUpdateLoc := 0; 2424 if MoveInfo.MoveType = mtExpel then 2425 with RW[MoveInfo.Defender], Un[MoveInfo.Duix] do 2426 begin // expel friendly unit 2427 if Home >= 0 then 2428 ExpelToLoc := City[Home].Loc 2429 else 2430 begin 2431 ExpelToLoc := City[0].Loc; // search destination for homeless units 2432 for cix1 := 1 to nCity - 1 do 2433 if (City[cix1].Loc >= 0) and 2434 ((ExpelToLoc < 0) or (City[cix1].built[imPalace] > 0)) then 2435 ExpelToLoc := City[cix1].Loc; 2436 end; 2437 if ExpelToLoc >= 0 then 2438 begin 2439 FreeUnit(MoveInfo.Defender, MoveInfo.Duix); 2440 Loc := ExpelToLoc; 2441 PlaceUnit(MoveInfo.Defender, MoveInfo.Duix); 2442 UpdateLoc[nUpdateLoc] := Loc; 2443 inc(nUpdateLoc); 2444 Flags := Flags or unWithdrawn; 2445 end 2446 end 2447 else if (MoveInfo.MoveType = mtAttack) and (MoveInfo.EndHealthDef > 0) then 2448 with RW[MoveInfo.Defender].Un[MoveInfo.Duix] do 2449 begin // update defender 2450 ExpGain := (Health - MoveInfo.EndHealthDef + 1) shr 1; 2451 if Exp + ExpGain > (nExp - 1) * ExpCost then 2452 Exp := (nExp - 1) * ExpCost 2453 else 2454 inc(Exp, ExpGain); 2455 Health := MoveInfo.EndHealthDef; 2456 end 2091 2457 else 2092 begin // update attacker2093 ExpGain:=(Health-MoveInfo.EndHealth+1) shr 1;2094 if Exp+ExpGain>(nExp-1)*ExpCost then Exp:=(nExp-1)*ExpCost2095 else inc(Exp,ExpGain);2096 Health:=MoveInfo.EndHealth;2097 Job:=jNone;2098 if RW[MoveInfo.Defender].Model[RW[MoveInfo.Defender].Un[MoveInfo.Duix].mix].Domain<dAir then2099 Flags:=Flags and not unBombsLoaded;2100 Flags:=Flags and not unFortified;2101 if Movement>100 then dec(Movement,100)2102 else Movement:=0;2103 end;2104 end;2105 2106 ZoCDefenderDestroyed:=false;2107 nUpdateLoc:=0;2108 if MoveInfo.MoveType=mtExpel then with RW[MoveInfo.Defender],Un[MoveInfo.Duix] do2109 begin // expel friendly unit2110 if Home>=0 then ExpelToLoc:=City[Home].Loc2111 else2112 begin2113 ExpelToLoc:=City[0].Loc; // search destination for homeless units2114 for cix1:=1 to nCity-1 do2115 if (City[cix1].Loc>=0) and ((ExpelToLoc<0) or (City[cix1].Built[imPalace]>0)) then2116 ExpelToLoc:=City[cix1].Loc;2117 end;2118 if ExpelToLoc>=0 then2119 begin2120 FreeUnit(MoveInfo.Defender,MoveInfo.Duix);2121 Loc:=ExpelToLoc;2122 PlaceUnit(MoveInfo.Defender,MoveInfo.Duix);2123 UpdateLoc[nUpdateLoc]:=Loc;2124 inc(nUpdateLoc);2125 Flags:=Flags or unWithdrawn;2126 end2127 end2128 else if (MoveInfo.MoveType=mtAttack) and (MoveInfo.EndHealthDef>0) then2129 with RW[MoveInfo.Defender].Un[MoveInfo.Duix] do2130 begin // update defender2131 ExpGain:=(Health-MoveInfo.EndHealthDef+1) shr 1;2132 if Exp+ExpGain>(nExp-1)*ExpCost then Exp:=(nExp-1)*ExpCost2133 else inc(Exp,ExpGain);2134 Health:=MoveInfo.EndHealthDef;2135 end2136 else2137 2458 begin // destroy defenders 2138 if MoveInfo.MoveType<>mtBombard then 2139 begin 2140 ZoCDefenderDestroyed:=RW[MoveInfo.Defender].Model[RW[MoveInfo.Defender].Un[MoveInfo.Duix].mix].Flags and mdZOC<>0; 2141 if ((RealMap[ToLoc] and fCity=0) 2142 and (RealMap[ToLoc] and fTerImp<>tiBase) 2143 and (RealMap[ToLoc] and fTerImp<>tiFort)) 2144 or LoseCityPop and (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size=2) then 2145 RemoveAllUnits(MoveInfo.Defender,ToLoc,p) {no city, base or fortress} 2146 else RemoveUnit(MoveInfo.Defender,MoveInfo.Duix,p); 2147 end; 2148 2149 if LoseCityPop then // city defender defeated -- shrink city 2150 if not CityDestroyed then 2151 CityShrink(MoveInfo.Defender,MoveInfo.Dcix) 2152 else 2459 if MoveInfo.MoveType <> mtBombard then 2460 begin 2461 ZoCDefenderDestroyed := RW[MoveInfo.Defender].Model 2462 [RW[MoveInfo.Defender].Un[MoveInfo.Duix].mix].Flags and mdZOC <> 0; 2463 if ((RealMap[ToLoc] and fCity = 0) and 2464 (RealMap[ToLoc] and fTerImp <> tiBase) and 2465 (RealMap[ToLoc] and fTerImp <> tiFort)) or LoseCityPop and 2466 (RW[MoveInfo.Defender].City[MoveInfo.Dcix].Size = 2) then 2467 RemoveAllUnits(MoveInfo.Defender, ToLoc, p) 2468 { no city, base or fortress } 2469 else 2470 RemoveUnit(MoveInfo.Defender, MoveInfo.Duix, p); 2471 end; 2472 2473 if LoseCityPop then // city defender defeated -- shrink city 2474 if not CityDestroyed then 2475 CityShrink(MoveInfo.Defender, MoveInfo.Dcix) 2476 else 2153 2477 begin 2154 for uix1:=0 to RW[MoveInfo.Defender].nUn-1 do with RW[MoveInfo.Defender].Un[uix1] do 2155 if (Loc>=0) and (Home=MoveInfo.Dcix) then 2156 begin UpdateLoc[nUpdateLoc]:=Loc; inc(nUpdateLoc) end; 2157 // unit will be removed -- remember position and update for all players 2158 DestroyCity_TellPlayers(MoveInfo.Defender,MoveInfo.Dcix,false); 2159 CheckBorders(ToLoc,MoveInfo.Defender); 2160 RecalcPeaceMap(p); 2478 for uix1 := 0 to RW[MoveInfo.Defender].nUn - 1 do 2479 with RW[MoveInfo.Defender].Un[uix1] do 2480 if (Loc >= 0) and (Home = MoveInfo.Dcix) then 2481 begin 2482 UpdateLoc[nUpdateLoc] := Loc; 2483 inc(nUpdateLoc) 2484 end; 2485 // unit will be removed -- remember position and update for all players 2486 DestroyCity_TellPlayers(MoveInfo.Defender, MoveInfo.Dcix, false); 2487 CheckBorders(ToLoc, MoveInfo.Defender); 2488 RecalcPeaceMap(p); 2161 2489 end; 2162 2490 end; 2163 2491 2164 if CityDestroyed and (nUpdateLoc>0) then 2165 RecalcMapZoC(p) 2166 else if ZoCDefenderDestroyed then 2167 RecalcV8ZoC(p,ToLoc); 2168 UpdateUnitMap(FromLoc); 2169 UpdateUnitMap(ToLoc,LoseCityPop); 2170 for i:=0 to nUpdateLoc-1 do UpdateUnitMap(UpdateLoc[i]); 2492 if CityDestroyed and (nUpdateLoc > 0) then 2493 RecalcMapZoC(p) 2494 else if ZoCDefenderDestroyed then 2495 RecalcV8ZoC(p, ToLoc); 2496 UpdateUnitMap(FromLoc); 2497 UpdateUnitMap(ToLoc, LoseCityPop); 2498 for i := 0 to nUpdateLoc - 1 do 2499 UpdateUnitMap(UpdateLoc[i]); 2171 2500 // tell about lost units of defender 2172 2501 2173 if Mode>=moMovie then2502 if Mode >= moMovie then 2174 2503 begin 2175 for i:=0 to RW[p].nEnemyModel-1 do with RW[p].EnemyModel[i] do 2176 Lost:=Destroyed[p,Owner,mix]; 2177 for p1:=0 to nPl-1 do {show after-attack in interface modules} 2178 if (1 shl p1 and GWatching<>0) 2179 and ((p1<>p) or (bix[p1]=bixTerm)) then 2504 for i := 0 to RW[p].nEnemyModel - 1 do 2505 with RW[p].EnemyModel[i] do 2506 Lost := Destroyed[p, Owner, mix]; 2507 for p1 := 0 to nPl - 1 do { show after-attack in interface modules } 2508 if (1 shl p1 and GWatching <> 0) and ((p1 <> p) or (bix[p1] = bixTerm)) 2509 then 2180 2510 begin 2181 SeeFrom:= ObserveLevel[FromLoc] shr (2*p1) and 3>=lObserveUnhidden; 2182 SeeTo:= ObserveLevel[ToLoc] shr (2*p1) and 3>=lObserveUnhidden; 2183 if SeeTo and CityDestroyed then 2184 CallPlayer(cShowCityChanged,p1,ToLoc); // city was destroyed 2185 if SeeFrom and SeeTo then 2511 SeeFrom := ObserveLevel[FromLoc] shr (2 * p1) and 2512 3 >= lObserveUnhidden; 2513 SeeTo := ObserveLevel[ToLoc] shr (2 * p1) and 3 >= lObserveUnhidden; 2514 if SeeTo and CityDestroyed then 2515 CallPlayer(cShowCityChanged, p1, ToLoc); // city was destroyed 2516 if SeeFrom and SeeTo then 2186 2517 begin 2187 CallPlayer(cShowAfterAttack,p1,ToLoc);2188 CallPlayer(cShowAfterAttack,p1,FromLoc);2518 CallPlayer(cShowAfterAttack, p1, ToLoc); 2519 CallPlayer(cShowAfterAttack, p1, FromLoc); 2189 2520 end 2190 else2521 else 2191 2522 begin 2192 if SeeTo then2193 CallPlayer(cShowUnitChanged,p1,ToLoc);2194 if SeeFrom then2195 CallPlayer(cShowUnitChanged,p1,FromLoc);2523 if SeeTo then 2524 CallPlayer(cShowUnitChanged, p1, ToLoc); 2525 if SeeFrom then 2526 CallPlayer(cShowUnitChanged, p1, FromLoc); 2196 2527 end; 2197 if SeeTo and (MoveInfo.MoveType=mtExpel) and (ExpelToLoc>=0) then2198 CallPlayer(cShowUnitChanged,p1,ExpelToLoc);2528 if SeeTo and (MoveInfo.MoveType = mtExpel) and (ExpelToLoc >= 0) then 2529 CallPlayer(cShowUnitChanged, p1, ExpelToLoc); 2199 2530 end; 2200 2531 end … … 2202 2533 end; // ExecuteAttack 2203 2534 2204 function MoveUnit(p, uix,dx,dy: integer; TestOnly: boolean): integer;2535 function MoveUnit(p, uix, dx, dy: integer; TestOnly: boolean): integer; 2205 2536 var 2206 ToLoc: integer;2207 MoveInfo: TMoveInfo;2208 ShowMove: TShowMove;2537 ToLoc: integer; 2538 MoveInfo: TMoveInfo; 2539 ShowMove: TShowMove; 2209 2540 begin 2210 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap =0);{$ENDIF}2211 with RW[p].Un[uix] do2541 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap = 0); {$ENDIF} 2542 with RW[p].Un[uix] do 2212 2543 begin 2213 ToLoc:=dLoc(Loc,dx,dy); 2214 if (ToLoc<0) or (ToLoc>=MapSize) then 2215 begin result:=eInvalid; exit end; 2216 result:=CalculateMove(p,uix,ToLoc,3-dy and 1,TestOnly,MoveInfo); 2217 if result=eZOC_EnemySpotted then 2218 ZOCTile:=ToLoc; 2219 if (result>=rExecuted) and not TestOnly then 2544 ToLoc := dLoc(Loc, dx, dy); 2545 if (ToLoc < 0) or (ToLoc >= MapSize) then 2220 2546 begin 2221 ShowMove.dx:=dx; 2222 ShowMove.dy:=dy; 2223 ShowMove.FromLoc:=Loc; 2224 ShowMove.mix:=mix; 2225 ShowMove.Health:=Health; 2226 ShowMove.Fuel:=Fuel; 2227 ShowMove.Exp:=Exp; 2228 ShowMove.Load:=TroopLoad+AirLoad; 2229 ShowMove.Owner:=p; 2230 if (TroopLoad>0) or (AirLoad>0) then 2231 ShowMove.Flags:=unMulti 2232 else ShowMove.Flags:=0; 2233 case MoveInfo.MoveType of 2234 mtCapture: ShowMove.Flags:=ShowMove.Flags or umCapturing; 2235 mtSpyMission: ShowMove.Flags:=ShowMove.Flags or umSpyMission; 2236 mtBombard: ShowMove.Flags:=ShowMove.Flags or umBombarding; 2237 mtExpel: ShowMove.Flags:=ShowMove.Flags or umExpelling; 2238 end; 2239 case MoveInfo.MoveType of 2240 mtMove,mtCapture,mtSpyMission: 2241 result:=ExecuteMove(p,uix,ToLoc,MoveInfo,ShowMove) or result; 2242 mtAttack,mtBombard,mtExpel: 2243 result:=ExecuteAttack(p,uix,ToLoc,MoveInfo,ShowMove) or result 2547 result := eInvalid; 2548 exit 2549 end; 2550 result := CalculateMove(p, uix, ToLoc, 3 - dy and 1, TestOnly, MoveInfo); 2551 if result = eZOC_EnemySpotted then 2552 ZOCTile := ToLoc; 2553 if (result >= rExecuted) and not TestOnly then 2554 begin 2555 ShowMove.dx := dx; 2556 ShowMove.dy := dy; 2557 ShowMove.FromLoc := Loc; 2558 ShowMove.mix := mix; 2559 ShowMove.Health := Health; 2560 ShowMove.Fuel := Fuel; 2561 ShowMove.Exp := Exp; 2562 ShowMove.Load := TroopLoad + AirLoad; 2563 ShowMove.Owner := p; 2564 if (TroopLoad > 0) or (AirLoad > 0) then 2565 ShowMove.Flags := unMulti 2566 else 2567 ShowMove.Flags := 0; 2568 case MoveInfo.MoveType of 2569 mtCapture: 2570 ShowMove.Flags := ShowMove.Flags or umCapturing; 2571 mtSpyMission: 2572 ShowMove.Flags := ShowMove.Flags or umSpyMission; 2573 mtBombard: 2574 ShowMove.Flags := ShowMove.Flags or umBombarding; 2575 mtExpel: 2576 ShowMove.Flags := ShowMove.Flags or umExpelling; 2577 end; 2578 case MoveInfo.MoveType of 2579 mtMove, mtCapture, mtSpyMission: 2580 result := ExecuteMove(p, uix, ToLoc, MoveInfo, ShowMove) or result; 2581 mtAttack, mtBombard, mtExpel: 2582 result := ExecuteAttack(p, uix, ToLoc, MoveInfo, ShowMove) or result 2244 2583 end; 2245 2584 end 2246 2585 end; // with 2247 end; { MoveUnit}2248 2249 function Server(Command, Player,Subject:integer;var Data): integer; stdcall;2586 end; { MoveUnit } 2587 2588 function Server(Command, Player, Subject: integer; var Data): integer; stdcall; 2250 2589 2251 2590 function CountPrice(const Offer: TOffer; PriceType: integer): integer; 2252 2591 var 2253 i: integer;2592 i: integer; 2254 2593 begin 2255 result:=0; 2256 for i:=0 to Offer.nDeliver+Offer.nCost-1 do 2257 if Offer.Price[i] and $FFFF0000=Cardinal(PriceType) then inc(result); 2594 result := 0; 2595 for i := 0 to Offer.nDeliver + Offer.nCost - 1 do 2596 if Offer.Price[i] and $FFFF0000 = Cardinal(PriceType) then 2597 inc(result); 2258 2598 end; 2259 2599 2260 { 2600 { procedure UpdateBorderHelper; 2261 2601 var 2262 2602 x, y, Loc, Loc1, dx, dy, ObserveMask: integer; … … 2264 2604 ObserveMask:=3 shl (2*pTurn); 2265 2605 for x:=0 to lx-1 do for y:=0 to ly shr 1-1 do 2266 begin 2267 Loc:=lx*(y*2)+x; 2268 if ObserveLevel[Loc] and ObserveMask<>0 then 2269 begin 2270 for dy:=0 to 1 do for dx:=0 to 1 do 2606 begin 2607 Loc:=lx*(y*2)+x; 2608 if ObserveLevel[Loc] and ObserveMask<>0 then 2609 begin 2610 for dy:=0 to 1 do for dx:=0 to 1 do 2611 begin 2612 Loc1:=(Loc+dx-1+lx) mod lx +lx*((y+dy)*2-1); 2613 if (Loc1>=0) and (Loc1<MapSize) 2614 and (ObserveLevel[Loc1] and ObserveMask<>0) then 2615 if RealMap[Loc1] and $78000000=RealMap[Loc] and $78000000 then 2616 begin 2617 RW[pTurn].BorderHelper[Loc]:=RW[pTurn].BorderHelper[Loc] and not (1 shl (dy*2+dx)); 2618 RW[pTurn].BorderHelper[Loc1]:=RW[pTurn].BorderHelper[Loc1] and not (8 shr (dy*2+dx)) 2619 end 2620 else 2621 begin 2622 RW[pTurn].BorderHelper[Loc]:=RW[pTurn].BorderHelper[Loc] or (1 shl (dy*2+dx)); 2623 RW[pTurn].BorderHelper[Loc1]:=RW[pTurn].BorderHelper[Loc1] or (8 shr (dy*2+dx)); 2624 end 2625 end 2626 end 2627 end 2628 end; } 2629 2630 const 2631 ptSelect = 0; 2632 ptTrGoods = 1; 2633 ptUn = 2; 2634 ptCaravan = 3; 2635 ptImp = 4; 2636 ptWonder = 6; 2637 ptShip = 7; 2638 ptInvalid = 8; 2639 2640 function ProjectType(Project: integer): integer; 2641 begin 2642 if Project and cpCompleted <> 0 then 2643 result := ptSelect 2644 else if Project and (cpImp + cpIndex) = cpImp + imTrGoods then 2645 result := ptTrGoods 2646 else if Project and cpImp = 0 then 2647 if RW[Player].Model[Project and cpIndex].Kind = mkCaravan then 2648 result := ptCaravan 2649 else 2650 result := ptUn 2651 else if Project and cpIndex >= nImp then 2652 result := ptInvalid 2653 else if Imp[Project and cpIndex].Kind = ikWonder then 2654 result := ptWonder 2655 else if Imp[Project and cpIndex].Kind = ikShipPart then 2656 result := ptShip 2657 else 2658 result := ptImp 2659 end; 2660 2661 const 2662 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0); 2663 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2); 2664 2665 var 2666 d, i, j, p1, p2, pt0, pt1, uix1, cix1, Loc0, Loc1, dx, dy, NewCap, MinCap, 2667 MaxCap, CapWeight, Cost, NextProd, Preq, TotalFood, TotalProd, CheckSum, 2668 StopTurn, FutureMCost, NewProject, OldImp, mix, V8, V21, AStr, DStr, 2669 ABaseDamage, DBaseDamage: integer; 2670 CityReport, AltCityReport: TCityReport; 2671 FormerCLState: TCmdListState; 2672 EndTime: int64; 2673 Adjacent: TVicinity8Loc; 2674 Radius: TVicinity21Loc; 2675 ShowShipChange: TShowShipChange; 2676 ShowNegoData: TShowNegoData; 2677 logged, ok, HasShipChanged, AllHumansDead, OfferFullySupported: boolean; 2678 2679 begin { >>>server } 2680 if Command = sTurn then 2681 begin 2682 p2 := -1; 2683 for p1 := 0 to nPl - 1 do 2684 if (p1 <> Player) and (1 shl p1 and GWatching <> 0) then 2685 CallPlayer(cShowTurnChange, p1, p2); 2686 end; 2687 2688 assert(MapSize = lx * ly); 2689 assert(Command and (sctMask or sExecute) <> sctInternal or sExecute); 2690 // not for internal commands 2691 if (Command < 0) or (Command >= $10000) then 2692 begin 2693 result := eUnknown; 2694 exit 2695 end; 2696 2697 if (Player < 0) or (Player >= nPl) or 2698 ((Command and (sctMask or sExecute) <> sctInfo) and 2699 ((Subject < 0) or (Subject >= $1000))) then 2700 begin 2701 result := eInvalid; 2702 exit 2703 end; 2704 2705 if (1 shl Player and (GAlive or GWatching) = 0) and 2706 not((Command = sTurn) or (Command = sBreak) or (Command = sResign) or 2707 (Command = sGetAIInfo) or (Command = sGetAICredits) or 2708 (Command = sGetVersion) or (Command and $FF0F = sGetChart)) then 2709 begin 2710 PutMessage(1 shl 16 + 1, Format('NOT Alive: %d', [Player])); 2711 result := eNoTurn; 2712 exit 2713 end; 2714 2715 result := eOK; 2716 2717 // check if command allowed now 2718 if (Mode = moPlaying) and not((Command >= cClientEx) or (Command = sMessage) 2719 or (Command = sSetDebugMap) or (Command = sGetDebugMap) or 2720 (Command = sGetAIInfo) or (Command = sGetAICredits) or 2721 (Command = sGetVersion) or (Command = sGetTechCost) or 2722 (Command = sGetDefender) or (Command = sGetUnitReport) or 2723 (Command = sGetCityReport) or (Command = sGetCityTileInfo) or 2724 (Command = sGetCity) or (Command = sGetEnemyCityReport) or 2725 (Command = sGetEnemyCityAreaInfo) or (Command = sGetCityReportNew) or 2726 (Command and $FF0F = sGetChart) or (Command and $FF0F = sSetAttitude)) 2727 // commands always allowed 2728 and not((Player = pTurn) and (Command < $1000)) 2729 // info request always allowed for pTurn 2730 and ((pDipActive < 0) and (Player <> pTurn) // not his turn 2731 or (pDipActive >= 0) and (Player <> pDipActive) 2732 // not active in negotiation mode 2733 or (pDipActive >= 0) and (Command and sctMask <> sctEndClient)) then 2734 // no nego command 2735 begin 2736 PutMessage(1 shl 16 + 1, Format('No Turn: %d calls %x', 2737 [Player, Command shr 4])); 2738 result := eNoTurn; 2739 exit 2740 end; 2741 2742 // do not use EXIT hereafter! 2743 2744 {$IFOPT O-} 2745 HandoverStack[nHandoverStack] := Player + $1000; 2746 HandoverStack[nHandoverStack + 1] := Command; 2747 inc(nHandoverStack, 2); 2748 2749 InvalidTreatyMap := 0; 2750 // new command, sIntExpandTerritory of previous command was processed 2751 {$ENDIF} 2752 if (Mode = moPlaying) and (Command >= sExecute) and 2753 ((Command and sctMask <> sctEndClient) or (Command = sTurn)) and 2754 (Command and sctMask <> sctModel) and (Command <> sCancelTreaty) and 2755 (Command <> sSetCityTiles) and (Command <> sBuyCityProject) and 2756 ((Command < cClientEx) or ProcessClientData[Player]) then 2757 begin { log command } 2758 FormerCLState := CL.State; 2759 CL.Put(Command, Player, Subject, @Data); 2760 logged := true; 2761 end 2762 else 2763 logged := false; 2764 2765 case Command of 2766 2767 { 2768 Info Request Commands 2769 ____________________________________________________________________ 2770 } 2771 sMessage: 2772 Brain[bix[0]].Client(cDebugMessage, Subject, Data); 2773 2774 sSetDebugMap: 2775 DebugMap[Player] := @Data; 2776 2777 sGetDebugMap: 2778 pointer(Data) := DebugMap[Subject]; 2779 2780 { sChangeSuperView: 2781 if Difficulty[Player]=0 then 2782 begin 2783 for i:=0 to nBrain-1 do if Brain[i].Initialized then 2784 CallClient(i, cShowSuperView, Subject) 2785 end 2786 else result:=eInvalid; } 2787 2788 sRefreshDebugMap: 2789 Brain[bix[0]].Client(cRefreshDebugMap, -1, Player); 2790 2791 sGetChart .. sGetChart + (nStat - 1) shl 4: 2792 if (Subject >= 0) and (Subject < nPl) and (bix[Subject] >= 0) then 2793 begin 2794 StopTurn := 0; 2795 if (Difficulty[Player] = 0) or (GTestFlags and tfUncover <> 0) 2796 // supervisor 2797 or (Subject = Player) // own chart 2798 or (GWinner > 0) // game end chart 2799 or (1 shl Subject and GAlive = 0) then // chart of extinct nation 2800 if Subject > Player then 2801 StopTurn := GTurn 2802 else 2803 StopTurn := GTurn + 1 2804 else if RW[Player].Treaty[Subject] > trNoContact then 2805 if Command shr 4 and $F = stMil then 2806 StopTurn := RW[Player].EnemyReport[Subject].TurnOfMilReport + 1 2807 else 2808 StopTurn := RW[Player].EnemyReport[Subject].TurnOfCivilReport + 1; 2809 move(Stat[Command shr 4 and $F, Subject]^, Data, 2810 StopTurn * SizeOf(integer)); 2811 FillChar(TChart(Data)[StopTurn], (GTurn - StopTurn) * 2812 SizeOf(integer), 0); 2813 end 2814 else 2815 result := eInvalid; 2816 2817 sGetTechCost: 2818 integer(Data) := TechCost(Player); 2819 2820 sGetAIInfo: 2821 if AIInfo[Subject] = '' then 2822 pchar(Data) := nil 2823 else 2824 pchar(Data) := @AIInfo[Subject][1]; 2825 2826 sGetAICredits: 2827 if AICredits = '' then 2828 pchar(Data) := nil 2829 else 2830 pchar(Data) := @AICredits[1]; 2831 2832 sGetVersion: 2833 integer(Data) := Version; 2834 2835 sGetGameChanged: 2836 if Player <> 0 then 2837 result := eInvalid 2838 else if (CL <> nil) and (CL.State.nLog = nLogOpened) and 2839 (CL.State.MoveCode = 0) and not HasCityTileChanges and 2840 not HasChanges(Player) then 2841 result := eNotChanged; 2842 2843 sGetTileInfo: 2844 if (Subject >= 0) and (Subject < MapSize) then 2845 result := GetTileInfo(Player, -2, Subject, TTileInfo(Data)) 2846 else 2847 result := eInvalid; 2848 2849 sGetCityTileInfo: 2850 if (Subject >= 0) and (Subject < MapSize) then 2851 result := GetTileInfo(Player, -1, Subject, TTileInfo(Data)) 2852 else 2853 result := eInvalid; 2854 2855 sGetHypoCityTileInfo: 2856 if (Subject >= 0) and (Subject < MapSize) then 2857 begin 2858 if (TTileInfo(Data).ExplCity < 0) or 2859 (TTileInfo(Data).ExplCity >= RW[Player].nCity) then 2860 result := eInvalid 2861 else if ObserveLevel[Subject] shr (Player * 2) and 3 = 0 then 2862 result := eNoPreq 2863 else 2864 result := GetTileInfo(Player, TTileInfo(Data).ExplCity, Subject, 2865 TTileInfo(Data)) 2866 end 2867 else 2868 result := eInvalid; 2869 2870 sGetJobProgress: 2871 if (Subject >= 0) and (Subject < MapSize) then 2872 begin 2873 if ObserveLevel[Subject] shr (Player * 2) and 3 = 0 then 2874 result := eNoPreq 2875 else 2876 result := GetJobProgress(Player, Subject, TJobProgressData(Data)) 2877 end 2878 else 2879 result := eInvalid; 2880 2881 sGetModels: 2882 if (GTestFlags and tfUncover <> 0) or (Difficulty[Player] = 0) 2883 then { supervisor only command } 2884 begin 2885 for p1 := 0 to nPl - 1 do 2886 if (p1 <> Player) and (1 shl p1 and GAlive <> 0) then 2887 for mix := 0 to RW[p1].nModel - 1 do 2888 TellAboutModel(Player, p1, mix); 2889 end 2890 else 2891 result := eInvalid; 2892 2893 sGetUnits: 2894 if (Subject >= 0) and (Subject < MapSize) and 2895 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) then 2896 integer(Data) := GetUnitStack(Player, Subject) 2897 else 2898 result := eNoPreq; 2899 2900 sGetDefender: 2901 if (Subject >= 0) and (Subject < MapSize) and (Occupant[Subject] = Player) 2902 then 2903 Strongest(Subject, integer(Data), d, i, j) 2904 else 2905 result := eInvalid; 2906 2907 sGetBattleForecast, sGetBattleForecastEx: 2908 if (Subject >= 0) and (Subject < MapSize) and 2909 (ObserveLevel[Subject] and (3 shl (Player * 2)) > 0) then 2910 with TBattleForecast(Data) do 2911 if (1 shl pAtt and GAlive <> 0) and (mixAtt >= 0) and 2912 (mixAtt < RW[pAtt].nModel) and 2913 ((pAtt = Player) or (RWemix[Player, pAtt, mixAtt] >= 0)) then 2914 begin 2915 result := GetBattleForecast(Subject, TBattleForecast(Data), uix1, 2916 cix1, AStr, DStr, ABaseDamage, DBaseDamage); 2917 if Command = sGetBattleForecastEx then 2918 begin 2919 TBattleForecastEx(Data).AStr := (AStr + 200) div 400; 2920 TBattleForecastEx(Data).DStr := (DStr + 200) div 400; 2921 TBattleForecastEx(Data).ABaseDamage := ABaseDamage; 2922 TBattleForecastEx(Data).DBaseDamage := DBaseDamage; 2923 end; 2924 if result = eOK then 2925 result := eInvalid // no enemy unit there! 2926 end 2927 else 2928 result := eInvalid 2929 else 2930 result := eInvalid; 2931 2932 sGetUnitReport: 2933 if (Subject < 0) or (Subject >= RW[Player].nUn) or 2934 (RW[Player].Un[Subject].Loc < 0) then 2935 result := eInvalid 2936 else 2937 GetUnitReport(Player, Subject, TUnitReport(Data)); 2938 2939 sGetMoveAdvice: 2940 if (Subject < 0) or (Subject >= RW[Player].nUn) or 2941 (RW[Player].Un[Subject].Loc < 0) then 2942 result := eInvalid 2943 else 2944 result := GetMoveAdvice(Player, Subject, TMoveAdviceData(Data)); 2945 2946 sGetPlaneReturn: 2947 if (Subject < 0) or (Subject >= RW[Player].nUn) or 2948 (RW[Player].Un[Subject].Loc < 0) or 2949 (RW[Player].Model[RW[Player].Un[Subject].mix].Domain <> dAir) then 2950 result := eInvalid 2951 else 2952 begin 2953 if CanPlaneReturn(Player, Subject, TPlaneReturnData(Data)) then 2954 result := eOK 2955 else 2956 result := eNoWay 2957 end; 2958 2959 sGetCity: 2960 if (Subject >= 0) and (Subject < MapSize) and 2961 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and 2962 (RealMap[Subject] and fCity <> 0) then 2963 with TGetCityData(Data) do 2271 2964 begin 2272 Loc1:=(Loc+dx-1+lx) mod lx +lx*((y+dy)*2-1); 2273 if (Loc1>=0) and (Loc1<MapSize) 2274 and (ObserveLevel[Loc1] and ObserveMask<>0) then 2275 if RealMap[Loc1] and $78000000=RealMap[Loc] and $78000000 then 2965 Owner := Player; 2966 SearchCity(Subject, Owner, cix1); 2967 c := RW[Owner].City[cix1]; 2968 if (Owner <> Player) and (c.Project and cpImp = 0) then 2969 TellAboutModel(Player, Owner, c.Project and cpIndex); 2970 end 2971 else 2972 result := eInvalid; 2973 2974 sGetCityReport: 2975 if (Subject < 0) or (Subject >= RW[Player].nCity) or 2976 (RW[Player].City[Subject].Loc < 0) then 2977 result := eInvalid 2978 else 2979 result := GetCityReport(Player, Subject, TCityReport(Data)); 2980 2981 sGetCityReportNew: 2982 if (Subject < 0) or (Subject >= RW[Player].nCity) or 2983 (RW[Player].City[Subject].Loc < 0) then 2984 result := eInvalid 2985 else 2986 GetCityReportNew(Player, Subject, TCityReportNew(Data)); 2987 2988 sGetCityAreaInfo: 2989 if (Subject < 0) or (Subject >= RW[Player].nCity) or 2990 (RW[Player].City[Subject].Loc < 0) then 2991 result := eInvalid 2992 else 2993 GetCityAreaInfo(Player, RW[Player].City[Subject].Loc, 2994 TCityAreaInfo(Data)); 2995 2996 sGetEnemyCityReport: 2997 if (Subject >= 0) and (Subject < MapSize) and 2998 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and 2999 (RealMap[Subject] and fCity <> 0) then 3000 begin 3001 p1 := Occupant[Subject]; 3002 if p1 < 0 then 3003 p1 := 1; 3004 SearchCity(Subject, p1, cix1); 3005 TCityReport(Data).HypoTiles := -1; 3006 TCityReport(Data).HypoTax := -1; 3007 TCityReport(Data).HypoLux := -1; 3008 GetCityReport(p1, cix1, TCityReport(Data)) 3009 end 3010 else 3011 result := eInvalid; 3012 3013 sGetEnemyCityReportNew: 3014 if (Subject >= 0) and (Subject < MapSize) and 3015 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and 3016 (RealMap[Subject] and fCity <> 0) then 3017 begin 3018 p1 := Occupant[Subject]; 3019 if p1 < 0 then 3020 p1 := 1; 3021 SearchCity(Subject, p1, cix1); 3022 TCityReport(Data).HypoTiles := -1; 3023 TCityReport(Data).HypoTax := -1; 3024 TCityReport(Data).HypoLux := -1; 3025 GetCityReportNew(p1, cix1, TCityReportNew(Data)); 3026 end 3027 else 3028 result := eInvalid; 3029 3030 sGetEnemyCityAreaInfo: 3031 if (Subject >= 0) and (Subject < MapSize) and 3032 (ObserveLevel[Subject] shr (Player * 2) and 3 = lObserveSuper) and 3033 (RealMap[Subject] and fCity <> 0) then 3034 begin 3035 p1 := Occupant[Subject]; 3036 if p1 < 0 then 3037 p1 := 1; 3038 SearchCity(Subject, p1, cix1); 3039 GetCityAreaInfo(p1, Subject, TCityAreaInfo(Data)) 3040 end 3041 else 3042 result := eInvalid; 3043 3044 sGetCityTileAdvice: 3045 if (Subject < 0) or (Subject >= RW[Player].nCity) or 3046 (RW[Player].City[Subject].Loc < 0) then 3047 result := eInvalid 3048 else 3049 GetCityTileAdvice(Player, Subject, TCityTileAdviceData(Data)); 3050 3051 { 3052 Map Editor Commands 3053 ____________________________________________________________________ 3054 } 3055 sEditTile: 3056 if Player = 0 then 3057 with TEditTileData(Data) do 3058 EditTile(Loc, NewTile) 3059 else 3060 result := eInvalid; 3061 3062 sRandomMap: 3063 if (Player = 0) and MapGeneratorAvailable then 3064 begin 3065 CreateElevation; 3066 PreviewElevation := false; 3067 CreateMap(false); 3068 FillChar(ObserveLevel, MapSize * 4, 0); 3069 DiscoverAll(Player, lObserveSuper); 3070 end 3071 else 3072 result := eInvalid; 3073 3074 sMapGeneratorRequest: 3075 if not MapGeneratorAvailable then 3076 result := eInvalid; 3077 3078 { 3079 Client Deactivation Commands 3080 ____________________________________________________________________ 3081 } 3082 sTurn, sTurn - sExecute: 3083 begin 3084 AllHumansDead := true; 3085 for p1 := 0 to nPl - 1 do 3086 if (1 shl p1 and GAlive <> 0) and (bix[p1] = bixTerm) then 3087 AllHumansDead := false; 3088 if (pDipActive >= 0) // still in negotiation mode 3089 or (pTurn = 0) and ((GWinner > 0) or (GTurn = MaxTurn) or 3090 (Difficulty[0] > 0) and AllHumansDead) then // game end reached 3091 result := eViolation 3092 else if Command >= sExecute then 3093 begin 3094 if Mode = moPlaying then 3095 begin 3096 CL.State := FormerCLState; 3097 LogCityTileChanges; 3098 {$IFNDEF SCR} 3099 if pTurn = 0 then 2276 3100 begin 2277 RW[pTurn].BorderHelper[Loc]:=RW[pTurn].BorderHelper[Loc] and not (1 shl (dy*2+dx));2278 RW[pTurn].BorderHelper[Loc1]:=RW[pTurn].BorderHelper[Loc1] and not (8 shr (dy*2+dx))3101 LogChanges; 3102 SaveGame('~' + LogFileName, true); 2279 3103 end 3104 {$ENDIF} 3105 end 3106 else if (Mode = moMovie) and (pTurn = 0) then 3107 CallPlayer(cMovieEndTurn, 0, nil^); 3108 GWatching := GWatching and GAlive or 1; 3109 RW[pTurn].Happened := 0; 3110 uixSelectedTransport := -1; 3111 SpyMission := smSabotageProd; 3112 if 1 shl pTurn and GAlive <> 0 then 3113 begin 3114 // calculate checksum 3115 TotalFood := 0; 3116 TotalProd := 0; 3117 for i := 0 to RW[pTurn].nCity - 1 do 3118 if RW[pTurn].City[i].Loc >= 0 then 3119 begin 3120 inc(TotalFood, RW[pTurn].City[i].Food); 3121 inc(TotalProd, RW[pTurn].City[i].Prod); 3122 end; 3123 CheckSum := TotalFood and 7 + TotalProd and 7 shl 3 + 3124 RW[pTurn].Money and 7 shl 6 + Worked[pTurn] div 100 and 7 shl 9; 3125 end 2280 3126 else 3127 CheckSum := 0; 3128 3129 if Mode < moPlaying then // check checksum 3130 begin 3131 if CheckSum <> Subject then 3132 LoadOK := false 3133 end 3134 else // save checksum 3135 CL.Put(Command, Player, CheckSum, @Data); 3136 {$IFDEF TEXTLOG} 3137 CmdInfo := ''; 3138 if CheckSum and 7 <> Subject and 7 then 3139 CmdInfo := Format('***ERROR (Food %d) ', 3140 [(CheckSum and 7 - Subject and 7 + 12) mod 8 - 4]) + CmdInfo; 3141 if CheckSum shr 3 and 7 <> Subject shr 3 and 7 then 3142 CmdInfo := '***ERROR (Prod) ' + CmdInfo; 3143 if CheckSum shr 6 and 7 <> Subject shr 6 and 7 then 3144 CmdInfo := '***ERROR (Research) ' + CmdInfo; 3145 if CheckSum shr 9 and 7 <> Subject shr 9 and 7 then 3146 CmdInfo := '***ERROR (Work) ' + CmdInfo; 3147 {$ENDIF} 3148 if 1 shl pTurn and GAlive <> 0 then 3149 begin 3150 AfterTurn; 3151 if Mode < moPlaying then 3152 InsertTerritoryUpdateCommands; 3153 // if bix[pTurn]=bixTerm then UpdateBorderHelper; 3154 end; 3155 3156 repeat 3157 pTurn := (pTurn + 1) mod nPl; 3158 if pTurn = 0 then 3159 inc(GTurn); 3160 if (bix[pTurn] >= 0) and ((1 shl pTurn) and GAlive = 0) then 3161 begin // already made extinct -- continue statistics 3162 Stat[stExplore, pTurn, GTurn] := 0; 3163 Stat[stPop, pTurn, GTurn] := 0; 3164 Stat[stTerritory, pTurn, GTurn] := 0; 3165 Stat[stScience, pTurn, GTurn] := 0; 3166 Stat[stWork, pTurn, GTurn] := 0; 3167 Stat[stMil, pTurn, GTurn] := 0; 3168 end; 3169 until (pTurn = 0) or ((1 shl pTurn and (GAlive or GWatching) <> 0) and 3170 (GWinner = 0)); 3171 if (Mode = moLoading_Fast) and 3172 ((GTurn = LoadTurn) or (GTurn = LoadTurn - 1) and (pTurn > 0)) then 3173 Mode := moLoading; 3174 if Mode = moPlaying then 3175 begin 3176 CCCommand := cTurn; 3177 CCPlayer := pTurn; 3178 Notify(ntNextPlayer) 3179 end 3180 else 3181 begin 3182 if GTurn = 0 then 3183 BeforeTurn0 3184 else 3185 BeforeTurn; 3186 if (Mode = moMovie) and (pTurn = 0) then 2281 3187 begin 2282 RW[pTurn].BorderHelper[Loc]:=RW[pTurn].BorderHelper[Loc] or (1 shl (dy*2+dx)); 2283 RW[pTurn].BorderHelper[Loc1]:=RW[pTurn].BorderHelper[Loc1] or (8 shr (dy*2+dx)); 2284 end 3188 Inform(pTurn); 3189 CallPlayer(cMovieTurn, 0, nil^); 3190 end; 3191 end; 3192 {$IFDEF TEXTLOG}CmdInfo := CmdInfo + Format('---Turn %d P%d---', [GTurn, pTurn]); {$ENDIF} 3193 end; 3194 end; // sTurn 3195 3196 sBreak, sResign, sNextRound, sReload: 3197 if Mode = moMovie then 3198 MovieStopped := true 3199 else 3200 begin 3201 if Command = sReload then 3202 begin 3203 ok := (Difficulty[0] = 0) and (bix[0] <> bixNoTerm) and 3204 (integer(Data) >= 0) and (integer(Data) < GTurn); 3205 for p1 := 1 to nPl - 1 do 3206 if bix[p1] = bixTerm then 3207 ok := false; 3208 // allow reload in AI-only games only 3209 end 3210 else 3211 ok := Player = 0; 3212 if ok then 3213 begin 3214 if (Command = sBreak) or (Command = sResign) then 3215 Notify(ntBackOn); 3216 for i := 0 to nBrain - 1 do 3217 if Brain[i].Initialized then 3218 begin 3219 if i >= bixFirstAI then 3220 Notify(ntDeinitModule + i); 3221 CallClient(i, cBreakGame, nil^); 3222 end; 3223 Notify(ntEndInfo); 3224 if (Command = sBreak) or (Command = sReload) then 3225 begin 3226 LogCityTileChanges; 3227 LogChanges; 3228 SaveGame(LogFileName, false); 3229 end; 3230 DeleteFile(SavePath + '~' + LogFileName); 3231 EndGame; 3232 case Command of 3233 sBreak: 3234 Notify(ntStartGoRefresh); 3235 sResign: 3236 Notify(ntStartGo); 3237 sNextRound: 3238 StartNewGame(SavePath, LogFileName, MapFileName, lx, ly, 3239 LandMass, MaxTurn); 3240 sReload: 3241 LoadGame(SavePath, LogFileName, integer(Data), false); 3242 end 3243 end 3244 else 3245 result := eInvalid; 3246 end; 3247 3248 sAbandonMap, sSaveMap: 3249 if Player = 0 then 3250 begin 3251 if Command = sSaveMap then 3252 SaveMap(MapFileName); 3253 Notify(ntBackOn); 3254 Brain[bixTerm].Client(cBreakGame, -1, nil^); 3255 ReleaseMapEditor; 3256 if Command = sSaveMap then 3257 Notify(ntStartGoRefreshMaps) 3258 else 3259 Notify(ntStartGo) 3260 end 3261 else 3262 result := eInvalid; 3263 3264 scContact .. scContact + (nPl - 1) shl 4, scContact - sExecute .. scContact 3265 - sExecute + (nPl - 1) shl 4: 3266 if (pDipActive >= 0) or (1 shl (Command shr 4 and $F) and GAlive = 0) then 3267 result := eInvalid 3268 else if GWinner > 0 then 3269 result := eViolation // game end reached 3270 else if RW[Player].Treaty[Command shr 4 and $F] = trNoContact then 3271 result := eNoPreq 3272 else if GTurn < GColdWarStart + ColdWarTurns then 3273 result := eColdWar 3274 else if RW[Player].Government = gAnarchy then 3275 result := eAnarchy 3276 else if RW[Command shr 4 and $F].Government = gAnarchy then 3277 begin 3278 result := eAnarchy; 3279 LastEndClientCommand := scReject; // enable cancel treaty 3280 pContacted := Command shr 4 and $F; 3281 end 3282 else if Command >= sExecute then 3283 begin // contact request 3284 pContacted := Command shr 4 and $F; 3285 pDipActive := pContacted; 3286 assert(Mode = moPlaying); 3287 Inform(pDipActive); 3288 ChangeClientWhenDone(scContact, pDipActive, pTurn, 4); 3289 end; 3290 3291 scReject, scReject - sExecute: 3292 if LastEndClientCommand and $FF0F = scContact then 3293 begin 3294 if Command >= sExecute then 3295 begin // contact requested and not accepted yet 3296 pDipActive := -1; 3297 assert(Mode = moPlaying); 3298 ChangeClientWhenDone(cContinue, pTurn, nil^, 0); 2285 3299 end 2286 3300 end 2287 end 2288 end;} 2289 2290 const 2291 ptSelect=0; ptTrGoods=1; ptUn=2; ptCaravan=3; ptImp=4; ptWonder=6; 2292 ptShip=7; ptInvalid=8; 2293 2294 function ProjectType(Project: integer): integer; 2295 begin 2296 if Project and cpCompleted<>0 then result:=ptSelect 2297 else if Project and (cpImp+cpIndex)=cpImp+imTrGoods then result:=ptTrGoods 2298 else if Project and cpImp=0 then 2299 if RW[Player].Model[Project and cpIndex].Kind=mkCaravan then result:=ptCaravan 2300 else result:=ptUn 2301 else if Project and cpIndex>=nImp then result:=ptInvalid 2302 else if Imp[Project and cpIndex].Kind=ikWonder then result:=ptWonder 2303 else if Imp[Project and cpIndex].Kind=ikShipPart then result:=ptShip 2304 else result:=ptImp 2305 end; 2306 2307 const 2308 Dirx: array[0..7] of integer=(1,2,1,0,-1,-2,-1,0); 2309 Diry: array[0..7] of integer=(-1,0,1,2,1,0,-1,-2); 2310 2311 var 2312 d,i,j,p1,p2,pt0,pt1,uix1,cix1,Loc0,Loc1,dx,dy,NewCap,MinCap,MaxCap, 2313 CapWeight,Cost,NextProd,Preq,TotalFood,TotalProd,CheckSum,StopTurn, 2314 FutureMCost,NewProject,OldImp,mix,V8,V21,AStr,DStr,ABaseDamage,DBaseDamage: integer; 2315 CityReport,AltCityReport:TCityReport; 2316 FormerCLState: TCmdListState; 2317 EndTime: int64; 2318 Adjacent: TVicinity8Loc; 2319 Radius: TVicinity21Loc; 2320 ShowShipChange: TShowShipChange; 2321 ShowNegoData: TShowNegoData; 2322 logged,ok,HasShipChanged,AllHumansDead,OfferFullySupported:boolean; 2323 2324 begin {>>>server} 2325 if Command=sTurn then 2326 begin 2327 p2:=-1; 2328 for p1:=0 to nPl-1 do if (p1<>Player) and (1 shl p1 and GWatching<>0) then 2329 CallPlayer(cShowTurnChange,p1,p2); 2330 end; 2331 2332 assert(MapSize=lx*ly); 2333 assert(Command and (sctMask or sExecute)<>sctInternal or sExecute); // not for internal commands 2334 if (Command<0) or (Command>=$10000) then 2335 begin result:=eUnknown; exit end; 2336 2337 if (Player<0) or (Player>=nPl) 2338 or ((Command and (sctMask or sExecute)<>sctInfo) 2339 and ((Subject<0) or (Subject>=$1000))) then 2340 begin result:=eInvalid; exit end; 2341 2342 if (1 shl Player and (GAlive or GWatching)=0) and 2343 not ((Command=sTurn) or (Command=sBreak) or (Command=sResign) 2344 or (Command=sGetAIInfo) or (Command=sGetAICredits) or (Command=sGetVersion) 2345 or (Command and $FF0F=sGetChart)) then 2346 begin 2347 PutMessage(1 shl 16+1, Format('NOT Alive: %d',[Player])); 2348 result:=eNoTurn; 2349 exit 2350 end; 2351 2352 result:=eOK; 2353 2354 // check if command allowed now 2355 if (Mode=moPlaying) 2356 and not ((Command>=cClientEx) or (Command=sMessage) or (Command=sSetDebugMap) 2357 or (Command=sGetDebugMap) 2358 or (Command=sGetAIInfo) or (Command=sGetAICredits) or (Command=sGetVersion) 2359 or (Command=sGetTechCost) or (Command=sGetDefender) 2360 or (Command=sGetUnitReport) 2361 or (Command=sGetCityReport) or (Command=sGetCityTileInfo) 2362 or (Command=sGetCity) or (Command=sGetEnemyCityReport) 2363 or (Command=sGetEnemyCityAreaInfo) or (Command=sGetCityReportNew) 2364 or (Command and $FF0F=sGetChart) or (Command and $FF0F=sSetAttitude)) 2365 // commands always allowed 2366 and not ((Player=pTurn) and (Command<$1000)) 2367 // info request always allowed for pTurn 2368 and ((pDipActive<0) and (Player<>pTurn) // not his turn 2369 or (pDipActive>=0) and (Player<>pDipActive) // not active in negotiation mode 2370 or (pDipActive>=0) and (Command and sctMask<>sctEndClient)) then // no nego command 2371 begin 2372 PutMessage(1 shl 16+1, Format('No Turn: %d calls %x', 2373 [Player,Command shr 4])); 2374 result:=eNoTurn; 2375 exit 2376 end; 2377 2378 // do not use EXIT hereafter! 2379 2380 {$IFOPT O-} 2381 HandoverStack[nHandoverStack]:=Player+$1000; 2382 HandoverStack[nHandoverStack+1]:=Command; 2383 inc(nHandoverStack,2); 2384 2385 InvalidTreatyMap:=0; // new command, sIntExpandTerritory of previous command was processed 2386 {$ENDIF} 2387 2388 if (Mode=moPlaying) and (Command>=sExecute) 2389 and ((Command and sctMask<>sctEndClient) or (Command=sTurn)) 2390 and (Command and sctMask<>sctModel) and (Command<>sCancelTreaty) 2391 and (Command<>sSetCityTiles) and (Command<>sBuyCityProject) 2392 and ((Command<cClientEx) or ProcessClientData[Player]) then 2393 begin {log command} 2394 FormerCLState:=CL.State; 2395 CL.Put(Command, Player, Subject, @Data); 2396 logged:=true; 2397 end 2398 else logged:=false; 2399 2400 case Command of 2401 2402 { 2403 Info Request Commands 2404 ____________________________________________________________________ 2405 } 2406 sMessage: 2407 Brain[bix[0]].Client(cDebugMessage,Subject,Data); 2408 2409 sSetDebugMap: 2410 DebugMap[Player]:=@Data; 2411 2412 sGetDebugMap: 2413 pointer(Data):=DebugMap[Subject]; 2414 2415 {sChangeSuperView: 2416 if Difficulty[Player]=0 then 2417 begin 2418 for i:=0 to nBrain-1 do if Brain[i].Initialized then 2419 CallClient(i, cShowSuperView, Subject) 2420 end 2421 else result:=eInvalid;} 2422 2423 sRefreshDebugMap: 2424 Brain[bix[0]].Client(cRefreshDebugMap,-1,Player); 2425 2426 sGetChart..sGetChart+(nStat-1) shl 4: 2427 if (Subject>=0) and (Subject<nPl) and (bix[Subject]>=0) then 2428 begin 2429 StopTurn:=0; 2430 if (Difficulty[Player]=0) or (GTestFlags and tfUncover<>0) // supervisor 2431 or (Subject=Player) // own chart 2432 or (GWinner>0) // game end chart 2433 or (1 shl Subject and GAlive=0) then // chart of extinct nation 2434 if Subject>Player then StopTurn:=GTurn 2435 else StopTurn:=GTurn+1 2436 else if RW[Player].Treaty[Subject]>trNoContact then 2437 if Command shr 4 and $f=stMil then 2438 StopTurn:=RW[Player].EnemyReport[Subject].TurnOfMilReport+1 2439 else StopTurn:=RW[Player].EnemyReport[Subject].TurnOfCivilReport+1; 2440 move(Stat[Command shr 4 and $f, Subject]^, Data, StopTurn*SizeOf(integer)); 2441 FillChar(TChart(Data)[StopTurn],(GTurn-StopTurn)*SizeOf(integer),0); 2442 end 2443 else result:=eInvalid; 2444 2445 sGetTechCost: 2446 integer(Data):=TechCost(Player); 2447 2448 sGetAIInfo: 2449 if AIInfo[Subject]='' then pchar(Data):=nil 2450 else pchar(Data):=@AIInfo[Subject][1]; 2451 2452 sGetAICredits: 2453 if AICredits='' then pchar(Data):=nil 2454 else pchar(Data):=@AICredits[1]; 2455 2456 sGetVersion: 2457 integer(Data):=Version; 2458 2459 sGetGameChanged: 2460 if Player<>0 then result:=eInvalid 2461 else if (CL<>nil) and (CL.state.nLog=nLogOpened) and (CL.state.MoveCode=0) 2462 and not HasCityTileChanges and not HasChanges(Player) then 2463 result:=eNotChanged; 2464 2465 sGetTileInfo: 2466 if (Subject>=0) and (Subject<MapSize) then 2467 result:=GetTileInfo(Player,-2,Subject,TTileInfo(Data)) 2468 else result:=eInvalid; 2469 2470 sGetCityTileInfo: 2471 if (Subject>=0) and (Subject<MapSize) then 2472 result:=GetTileInfo(Player,-1,Subject,TTileInfo(Data)) 2473 else result:=eInvalid; 2474 2475 sGetHypoCityTileInfo: 2476 if (Subject>=0) and (Subject<MapSize) then 2477 begin 2478 if (TTileInfo(Data).ExplCity<0) or (TTileInfo(Data).ExplCity>=RW[Player].nCity) then 2479 result:=eInvalid 2480 else if ObserveLevel[Subject] shr (Player*2) and 3=0 then 2481 result:=eNoPreq 2482 else result:=GetTileInfo(Player,TTileInfo(Data).ExplCity,Subject,TTileInfo(Data)) 2483 end 2484 else result:=eInvalid; 2485 2486 sGetJobProgress: 2487 if (Subject>=0) and (Subject<MapSize) then 2488 begin 2489 if ObserveLevel[Subject] shr (Player*2) and 3=0 then 2490 result:=eNoPreq 2491 else result:=GetJobProgress(Player,Subject,TJobProgressData(Data)) 2492 end 2493 else result:=eInvalid; 2494 2495 sGetModels: 2496 if (GTestFlags and tfUncover<>0) or (Difficulty[Player]=0) then {supervisor only command} 2497 begin 2498 for p1:=0 to nPl-1 do if (p1<>Player) and (1 shl p1 and GAlive<>0) then 2499 for mix:=0 to RW[p1].nModel-1 do 2500 TellAboutModel(Player,p1,mix); 2501 end 2502 else result:=eInvalid; 2503 2504 sGetUnits: 2505 if (Subject>=0) and (Subject<MapSize) 2506 and (ObserveLevel[Subject] shr (Player*2) and 3=lObserveSuper) then 2507 integer(Data):=GetUnitStack(Player,Subject) 2508 else result:=eNoPreq; 2509 2510 sGetDefender: 2511 if (Subject>=0) and (Subject<MapSize) and (Occupant[Subject]=Player) then 2512 Strongest(Subject,integer(Data),d,i,j) 2513 else result:=eInvalid; 2514 2515 sGetBattleForecast,sGetBattleForecastEx: 2516 if (Subject>=0) and (Subject<MapSize) 2517 and (ObserveLevel[Subject] and (3 shl (Player*2))>0) then 2518 with TBattleForecast(Data) do 2519 if (1 shl pAtt and GAlive<>0) 2520 and (mixAtt>=0) and (mixAtt<RW[pAtt].nModel) 2521 and ((pAtt=Player) or (RWemix[Player,pAtt,mixAtt]>=0)) then 2522 begin 2523 result:=GetBattleForecast(Subject,TBattleForecast(Data),uix1,cix1, 2524 AStr,DStr,ABaseDamage,DBaseDamage); 2525 if Command=sGetBattleForecastEx then 2526 begin 2527 TBattleForecastEx(Data).AStr:=(AStr+200) div 400; 2528 TBattleForecastEx(Data).DStr:=(DStr+200) div 400; 2529 TBattleForecastEx(Data).ABaseDamage:=ABaseDamage; 2530 TBattleForecastEx(Data).DBaseDamage:=DBaseDamage; 2531 end; 2532 if result=eOk then 2533 result:=eInvalid // no enemy unit there! 2534 end 2535 else result:=eInvalid 2536 else result:=eInvalid; 2537 2538 sGetUnitReport: 2539 if (Subject<0) or (Subject>=RW[Player].nUn) 2540 or (RW[Player].Un[Subject].Loc<0) then 2541 result:=eInvalid 2542 else GetUnitReport(Player, Subject, TUnitReport(Data)); 2543 2544 sGetMoveAdvice: 2545 if (Subject<0) or (Subject>=RW[Player].nUn) 2546 or (RW[Player].Un[Subject].Loc<0) then 2547 result:=eInvalid 2548 else result:=GetMoveAdvice(Player,Subject, TMoveAdviceData(Data)); 2549 2550 sGetPlaneReturn: 2551 if (Subject<0) or (Subject>=RW[Player].nUn) 2552 or (RW[Player].Un[Subject].Loc<0) 2553 or (RW[Player].Model[RW[Player].Un[Subject].mix].Domain<>dAir) then 2554 result:=eInvalid 2555 else 2556 begin 2557 if CanPlaneReturn(Player,Subject, TPlaneReturnData(Data)) then result:=eOK 2558 else result:=eNoWay 2559 end; 2560 2561 sGetCity: 2562 if (Subject>=0) and (Subject<MapSize) 2563 and (ObserveLevel[Subject] shr (Player*2) and 3=lObserveSuper) 2564 and (RealMap[Subject] and fCity<>0) then 2565 with TGetCityData(Data) do 2566 begin 2567 Owner:=Player; 2568 SearchCity(Subject,Owner,cix1); 2569 c:=RW[Owner].City[cix1]; 2570 if (Owner<>Player) and (c.Project and cpImp=0) then 2571 TellAboutModel(Player,Owner,c.Project and cpIndex); 2572 end 2573 else result:=eInvalid; 2574 2575 sGetCityReport: 2576 if (Subject<0) or (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 2577 result:=eInvalid 2578 else result:=GetCityReport(Player,Subject,TCityReport(Data)); 2579 2580 sGetCityReportNew: 2581 if (Subject<0) or (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 2582 result:=eInvalid 2583 else GetCityReportNew(Player,Subject,TCityReportNew(Data)); 2584 2585 sGetCityAreaInfo: 2586 if (Subject<0) or (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 2587 result:=eInvalid 2588 else GetCityAreaInfo(Player, RW[Player].City[Subject].Loc, 2589 TCityAreaInfo(Data)); 2590 2591 sGetEnemyCityReport: 2592 if (Subject>=0) and (Subject<MapSize) 2593 and (ObserveLevel[Subject] shr (Player*2) and 3=lObserveSuper) 2594 and (RealMap[Subject] and fCity<>0) then 2595 begin 2596 p1:=Occupant[Subject]; 2597 if p1<0 then p1:=1; 2598 SearchCity(Subject,p1,cix1); 2599 TCityReport(Data).HypoTiles:=-1; 2600 TCityReport(Data).HypoTax:=-1; 2601 TCityReport(Data).HypoLux:=-1; 2602 GetCityReport(p1,cix1,TCityReport(Data)) 2603 end 2604 else result:=eInvalid; 2605 2606 sGetEnemyCityReportNew: 2607 if (Subject>=0) and (Subject<MapSize) 2608 and (ObserveLevel[Subject] shr (Player*2) and 3=lObserveSuper) 2609 and (RealMap[Subject] and fCity<>0) then 2610 begin 2611 p1:=Occupant[Subject]; 2612 if p1<0 then p1:=1; 2613 SearchCity(Subject,p1,cix1); 2614 TCityReport(Data).HypoTiles:=-1; 2615 TCityReport(Data).HypoTax:=-1; 2616 TCityReport(Data).HypoLux:=-1; 2617 GetCityReportNew(p1,cix1,TCityReportNew(Data)); 2618 end 2619 else result:=eInvalid; 2620 2621 sGetEnemyCityAreaInfo: 2622 if (Subject>=0) and (Subject<MapSize) 2623 and (ObserveLevel[Subject] shr (Player*2) and 3=lObserveSuper) 2624 and (RealMap[Subject] and fCity<>0) then 2625 begin 2626 p1:=Occupant[Subject]; 2627 if p1<0 then p1:=1; 2628 SearchCity(Subject,p1,cix1); 2629 GetCityAreaInfo(p1,Subject,TCityAreaInfo(Data)) 2630 end 2631 else result:=eInvalid; 2632 2633 sGetCityTileAdvice: 2634 if (Subject<0) or (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 2635 result:=eInvalid 2636 else GetCityTileAdvice(Player, Subject, TCityTileAdviceData(Data)); 2637 2638 { 2639 Map Editor Commands 2640 ____________________________________________________________________ 2641 } 2642 sEditTile: 2643 if Player=0 then with TEditTileData(Data) do EditTile(Loc, NewTile) 2644 else result:=eInvalid; 2645 2646 sRandomMap: 2647 if (Player=0) and MapGeneratorAvailable then 2648 begin 2649 CreateElevation; 2650 PreviewElevation:=false; 2651 CreateMap(false); 2652 FillChar(ObserveLevel,MapSize*4,0); 2653 DiscoverAll(Player,lObserveSuper); 2654 end 2655 else result:=eInvalid; 2656 2657 sMapGeneratorRequest: 2658 if not MapGeneratorAvailable then result:=eInvalid; 2659 2660 { 2661 Client Deactivation Commands 2662 ____________________________________________________________________ 2663 } 2664 sTurn, sTurn-sExecute: 2665 begin 2666 AllHumansDead:=true; 2667 for p1:=0 to nPl-1 do 2668 if (1 shl p1 and GAlive<>0) and (bix[p1]=bixTerm) then 2669 AllHumansDead:=false; 2670 if (pDipActive>=0) // still in negotiation mode 2671 or (pTurn=0) and ((GWinner>0) or (GTurn=MaxTurn) 2672 or (Difficulty[0]>0) and AllHumansDead) then // game end reached 2673 result:=eViolation 2674 else if Command>=sExecute then 2675 begin 2676 if Mode=moPlaying then 2677 begin 2678 CL.State:=FormerCLState; 2679 LogCityTileChanges; 2680 {$IFNDEF SCR} 2681 if pTurn=0 then 2682 begin LogChanges; SaveGame('~'+LogFileName,true); end 2683 {$ENDIF} 2684 end 2685 else if (Mode=moMovie) and (pTurn=0) then 2686 CallPlayer(cMovieEndTurn,0,nil^); 2687 GWatching:=GWatching and GAlive or 1; 2688 RW[pTurn].Happened:=0; 2689 uixSelectedTransport:=-1; 2690 SpyMission:=smSabotageProd; 2691 if 1 shl pTurn and GAlive<>0 then 2692 begin 2693 // calculate checksum 2694 TotalFood:=0; 2695 TotalProd:=0; 2696 for i:=0 to RW[pTurn].nCity-1 do if RW[pTurn].City[i].Loc>=0 then 2697 begin 2698 inc(TotalFood,RW[pTurn].City[i].Food); 2699 inc(TotalProd,RW[pTurn].City[i].Prod); 2700 end; 2701 CheckSum:=TotalFood and 7 + TotalProd and 7 shl 3 2702 + RW[pTurn].Money and 7 shl 6 2703 + Worked[pTurn] div 100 and 7 shl 9; 2704 end 2705 else CheckSum:=0; 2706 2707 if Mode<moPlaying then // check checksum 2708 begin 2709 if CheckSum<>Subject then 2710 LoadOK:=false 2711 end 2712 else // save checksum 2713 CL.Put(Command, Player, CheckSum, @Data); 2714 {$IFDEF TEXTLOG} 2715 CmdInfo:=''; 2716 if CheckSum and 7<>Subject and 7 then CmdInfo:=Format('***ERROR (Food %d) ',[(CheckSum and 7-Subject and 7+12) mod 8 -4])+CmdInfo; 2717 if CheckSum shr 3 and 7<>Subject shr 3 and 7 then CmdInfo:='***ERROR (Prod) '+CmdInfo; 2718 if CheckSum shr 6 and 7<>Subject shr 6 and 7 then CmdInfo:='***ERROR (Research) '+CmdInfo; 2719 if CheckSum shr 9 and 7<>Subject shr 9 and 7 then CmdInfo:='***ERROR (Work) '+CmdInfo; 2720 {$ENDIF} 2721 2722 if 1 shl pTurn and GAlive<>0 then 2723 begin 2724 AfterTurn; 2725 if Mode<moPlaying then 2726 InsertTerritoryUpdateCommands; 2727 //if bix[pTurn]=bixTerm then UpdateBorderHelper; 2728 end; 2729 2730 repeat 2731 pTurn:=(pTurn+1) mod nPl; 2732 if pTurn=0 then inc(GTurn); 2733 if (bix[pTurn]>=0) and ((1 shl pTurn) and GAlive=0) then 2734 begin // already made extinct -- continue statistics 2735 Stat[stExplore,pTurn,GTurn]:=0; 2736 Stat[stPop,pTurn,GTurn]:=0; 2737 Stat[stTerritory,pTurn,GTurn]:=0; 2738 Stat[stScience,pTurn,GTurn]:=0; 2739 Stat[stWork,pTurn,GTurn]:=0; 2740 Stat[stMil,pTurn,GTurn]:=0; 2741 end; 2742 until (pTurn=0) or ((1 shl pTurn and (GAlive or GWatching)<>0) and (GWinner=0)); 2743 if (Mode=moLoading_Fast) and ((GTurn=LoadTurn) or (GTurn=LoadTurn-1) and (pTurn>0)) then 2744 Mode:=moLoading; 2745 if Mode=moPlaying then 2746 begin 2747 CCCommand:=cTurn; CCPlayer:=pTurn; 2748 Notify(ntNextPlayer) 2749 end 2750 else 2751 begin 2752 if GTurn=0 then BeforeTurn0 2753 else BeforeTurn; 2754 if (Mode=moMovie) and (pTurn=0) then 2755 begin 2756 Inform(pTurn); 2757 CallPlayer(cMovieTurn,0,nil^); 2758 end; 2759 end; 2760 {$IFDEF TEXTLOG}CmdInfo:=CmdInfo+Format('---Turn %d P%d---', [GTurn,pTurn]);{$ENDIF} 2761 end; 2762 end; // sTurn 2763 2764 sBreak, sResign, sNextRound, sReload: 2765 if Mode=moMovie then 2766 MovieStopped:=true 2767 else 2768 begin 2769 if Command=sReload then 2770 begin 2771 ok:= (Difficulty[0]=0) and (bix[0]<>bixNoTerm) 2772 and (integer(Data)>=0) and (integer(Data)<GTurn); 2773 for p1:=1 to nPl-1 do if bix[p1]=bixTerm then ok:=false; 2774 // allow reload in AI-only games only 2775 end 2776 else ok:= Player=0; 2777 if ok then 2778 begin 2779 if (Command=sBreak) or (Command=sResign) then Notify(ntBackOn); 2780 for i:=0 to nBrain-1 do if Brain[i].Initialized then 2781 begin 2782 if i>=bixFirstAI then 2783 Notify(ntDeinitModule+i); 2784 CallClient(i, cBreakGame, nil^); 2785 end; 2786 Notify(ntEndInfo); 2787 if (Command=sBreak) or (Command=sReload) then 2788 begin 2789 LogCityTileChanges; 2790 LogChanges; 2791 SaveGame(LogFileName,false); 2792 end; 2793 DeleteFile(SavePath+'~'+LogFileName); 2794 EndGame; 2795 case Command of 2796 sBreak: Notify(ntStartGoRefresh); 2797 sResign: Notify(ntStartGo); 2798 sNextRound: StartNewGame(SavePath, LogFileName, MapFileName, lx, ly, LandMass, 2799 MaxTurn); 2800 sReload: LoadGame(SavePath,LogFileName,integer(Data),false); 2801 end 2802 end 2803 else result:=eInvalid; 2804 end; 2805 2806 sAbandonMap, sSaveMap: 2807 if Player=0 then 2808 begin 2809 if Command=sSaveMap then SaveMap(MapFileName); 2810 Notify(ntBackOn); 2811 Brain[bixTerm].Client(cBreakGame,-1,nil^); 2812 ReleaseMapEditor; 2813 if Command=sSaveMap then Notify(ntStartGoRefreshMaps) 2814 else Notify(ntStartGo) 2815 end 2816 else result:=eInvalid; 2817 2818 scContact..scContact+(nPl-1) shl 4, 2819 scContact-sExecute..scContact-sExecute+(nPl-1) shl 4: 2820 if (pDipActive>=0) or (1 shl (Command shr 4 and $f) and GAlive=0) then 2821 result:=eInvalid 2822 else if GWinner>0 then result:=eViolation // game end reached 2823 else if RW[Player].Treaty[Command shr 4 and $f]=trNoContact then 2824 result:=eNoPreq 2825 else if GTurn<GColdWarStart+ColdWarTurns then result:=eColdWar 2826 else if RW[Player].Government=gAnarchy then 2827 result:=eAnarchy 2828 else if RW[Command shr 4 and $f].Government=gAnarchy then 2829 begin 2830 result:=eAnarchy; 2831 LastEndClientCommand:=scReject; //enable cancel treaty 2832 pContacted:=Command shr 4 and $f; 2833 end 2834 else if Command>=sExecute then 2835 begin // contact request 2836 pContacted:=Command shr 4 and $f; 2837 pDipActive:=pContacted; 2838 assert(Mode=moPlaying); 2839 Inform(pDipActive); 2840 ChangeClientWhenDone(scContact,pDipActive,pTurn,4); 2841 end; 2842 2843 scReject, scReject-sExecute: 2844 if LastEndClientCommand and $FF0F=scContact then 2845 begin 2846 if Command>=sExecute then 2847 begin // contact requested and not accepted yet 2848 pDipActive:=-1; 2849 assert(Mode=moPlaying); 2850 ChangeClientWhenDone(cContinue,pTurn,nil^,0); 3301 else 3302 result := eInvalid; 3303 3304 scDipStart, scDipStart - sExecute: 3305 if LastEndClientCommand and $FF0F = scContact then 3306 begin 3307 if Command >= sExecute then 3308 begin // accept contact 3309 pContacted := pDipActive; 3310 RW[pContacted].EnemyReport[pTurn].Credibility := 3311 RW[pTurn].Credibility; 3312 pDipActive := pTurn; 3313 assert(Mode = moPlaying); 3314 IntServer(sIntHaveContact, pTurn, pContacted, nil^); 3315 ChangeClientWhenDone(scDipStart, pDipActive, nil^, 0); 2851 3316 end 2852 3317 end 2853 else result:=eInvalid; 2854 2855 scDipStart, scDipStart-sExecute: 2856 if LastEndClientCommand and $FF0F=scContact then 2857 begin 2858 if Command>=sExecute then 2859 begin // accept contact 2860 pContacted:=pDipActive; 2861 RW[pContacted].EnemyReport[pTurn].Credibility:=RW[pTurn].Credibility; 2862 pDipActive:=pTurn; 2863 assert(Mode=moPlaying); 2864 IntServer(sIntHaveContact,pTurn,pContacted,nil^); 2865 ChangeClientWhenDone(scDipStart,pDipActive,nil^,0); 2866 end 2867 end 2868 else result:=eInvalid; 2869 2870 scDipNotice, scDipAccept, scDipCancelTreaty, scDipBreak, 2871 scDipNotice-sExecute, scDipAccept-sExecute, scDipCancelTreaty-sExecute, 2872 scDipBreak-sExecute: 2873 if pDipActive>=0 then 2874 begin 2875 assert(Mode=moPlaying); 2876 if pDipActive=pTurn then p1:=pContacted 2877 else p1:=pTurn; 2878 if (Command and not sExecute=scDipBreak and not sExecute) 2879 and (LastEndClientCommand<>scDipBreak) then // ok 2880 else if (Command and not sExecute=scDipNotice and not sExecute) 2881 and ((LastEndClientCommand=scDipCancelTreaty) 2882 or (LastEndClientCommand=scDipBreak)) then // ok 2883 else if (Command and not sExecute=scDipAccept and not sExecute) 2884 and (LastEndClientCommand=scDipOffer) then with LastOffer do 3318 else 3319 result := eInvalid; 3320 3321 scDipNotice, scDipAccept, scDipCancelTreaty, scDipBreak, 3322 scDipNotice - sExecute, scDipAccept - sExecute, 3323 scDipCancelTreaty - sExecute, scDipBreak - sExecute: 3324 if pDipActive >= 0 then 3325 begin 3326 assert(Mode = moPlaying); 3327 if pDipActive = pTurn then 3328 p1 := pContacted 3329 else 3330 p1 := pTurn; 3331 if (Command and not sExecute = scDipBreak and not sExecute) and 3332 (LastEndClientCommand <> scDipBreak) then // ok 3333 else if (Command and not sExecute = scDipNotice and not sExecute) and 3334 ((LastEndClientCommand = scDipCancelTreaty) or 3335 (LastEndClientCommand = scDipBreak)) then // ok 3336 else if (Command and not sExecute = scDipAccept and not sExecute) and 3337 (LastEndClientCommand = scDipOffer) then 3338 with LastOffer do 3339 begin 3340 // check if offer can be accepted 3341 if nDeliver + nCost = 0 then 3342 result := eOfferNotAcceptable; 3343 for i := 0 to nDeliver + nCost - 1 do 3344 if Price[i] = opChoose then 3345 result := eOfferNotAcceptable; 3346 for i := 0 to nCost - 1 do 3347 if not PayPrice(pDipActive, p1, Price[nDeliver + i], false) then 3348 result := eOfferNotAcceptable; 3349 if (Command >= sExecute) and (result >= rExecuted) then 3350 begin 3351 IntServer(sIntPayPrices + nDeliver + nCost, p1, pDipActive, 3352 LastOffer); 3353 // CheckContact; 3354 3355 // tell other players about ship part trades 3356 HasShipChanged := false; 3357 FillChar(ShowShipChange, SizeOf(ShowShipChange), 0); 3358 for i := 0 to nDeliver + nCost - 1 do 3359 if Price[i] and opMask = opShipParts then 3360 begin 3361 HasShipChanged := true; 3362 if i >= nDeliver then 3363 begin // p1 has demanded from pDipActive 3364 ShowShipChange.Ship1Change[Price[i] shr 16 and 3] := 3365 +integer(Price[i] and $FFFF); 3366 ShowShipChange.Ship2Change[Price[i] shr 16 and 3] := 3367 -integer(Price[i] and $FFFF); 3368 end 3369 else 3370 begin // p1 has delivered to pDipActive 3371 ShowShipChange.Ship1Change[Price[i] shr 16 and 3] := 3372 -integer(Price[i] and $FFFF); 3373 ShowShipChange.Ship2Change[Price[i] shr 16 and 3] := 3374 +integer(Price[i] and $FFFF); 3375 end 3376 end; 3377 if HasShipChanged then 3378 begin 3379 ShowShipChange.Reason := scrTrade; 3380 ShowShipChange.Ship1Owner := p1; 3381 ShowShipChange.Ship2Owner := pDipActive; 3382 for p2 := 0 to nPl - 1 do 3383 if (p2 <> p1) and (p2 <> pDipActive) and 3384 (1 shl p2 and (GAlive or GWatching) <> 0) then 3385 begin 3386 move(GShip, RW[p2].Ship, SizeOf(GShip)); 3387 if 1 shl p2 and GWatching <> 0 then 3388 CallPlayer(cShowShipChange, p2, ShowShipChange); 3389 end 3390 end 3391 end; 3392 end 3393 else if (Command and not sExecute = scDipCancelTreaty and not sExecute) 3394 and (RW[pDipActive].Treaty[p1] >= trPeace) then 2885 3395 begin 2886 // check if offer can be accepted 2887 if nDeliver+nCost=0 then result:=eOfferNotAcceptable; 2888 for i:=0 to nDeliver+nCost-1 do 2889 if Price[i]=opChoose then result:=eOfferNotAcceptable; 2890 for i:=0 to nCost-1 do 2891 if not PayPrice(pDipActive,p1,Price[nDeliver+i],false) then 2892 result:=eOfferNotAcceptable; 2893 if (Command>=sExecute) and (result>=rExecuted) then 3396 if (ServerVersion[pDipActive] >= $010100) and 3397 (GTurn < RW[pDipActive].LastCancelTreaty[p1] + CancelTreatyTurns) 3398 then 3399 result := eCancelTreatyRush 3400 else if Command >= sExecute then 2894 3401 begin 2895 IntServer(sIntPayPrices+nDeliver+nCost,p1,pDipActive,LastOffer); 2896 // CheckContact; 2897 2898 // tell other players about ship part trades 2899 HasShipChanged:=false; 2900 fillchar(ShowShipChange,sizeof(ShowShipChange),0); 2901 for i:=0 to nDeliver+nCost-1 do 2902 if Price[i] and opMask=opShipParts then 3402 IntServer(sIntCancelTreaty, pDipActive, p1, nil^); 3403 for p2 := 0 to nPl - 1 do 3404 if (p2 <> p1) and (1 shl p2 and PeaceEnded <> 0) then 2903 3405 begin 2904 HasShipChanged:=true; 2905 if i>=nDeliver then 2906 begin // p1 has demanded from pDipActive 2907 ShowShipChange.Ship1Change[Price[i] shr 16 and 3]:=+integer(Price[i] and $FFFF); 2908 ShowShipChange.Ship2Change[Price[i] shr 16 and 3]:=-integer(Price[i] and $FFFF); 2909 end 2910 else 2911 begin // p1 has delivered to pDipActive 2912 ShowShipChange.Ship1Change[Price[i] shr 16 and 3]:=-integer(Price[i] and $FFFF); 2913 ShowShipChange.Ship2Change[Price[i] shr 16 and 3]:=+integer(Price[i] and $FFFF); 2914 end 3406 i := p1 shl 4 + pDipActive; 3407 CallPlayer(cShowSupportAllianceAgainst, p2, i); 2915 3408 end; 2916 if HasShipChanged then 2917 begin 2918 ShowShipChange.Reason:=scrTrade; 2919 ShowShipChange.Ship1Owner:=p1; 2920 ShowShipChange.Ship2Owner:=pDipActive; 2921 for p2:=0 to nPl-1 do 2922 if (p2<>p1) and (p2<>pDipActive) and (1 shl p2 and (GAlive or GWatching)<>0) then 2923 begin 2924 move(GShip,RW[p2].Ship,SizeOf(GShip)); 2925 if 1 shl p2 and GWatching<>0 then 2926 CallPlayer(cShowShipChange,p2,ShowShipChange); 2927 end 2928 end 2929 end; 2930 end 2931 else if (Command and not sExecute=scDipCancelTreaty and not sExecute) 2932 and (RW[pDipActive].Treaty[p1]>=trPeace) then 2933 begin 2934 if (ServerVersion[pDipActive]>=$010100) 2935 and (GTurn<RW[pDipActive].LastCancelTreaty[p1]+CancelTreatyTurns) then 2936 result:=eCancelTreatyRush 2937 else if Command>=sExecute then 2938 begin 2939 IntServer(sIntCancelTreaty,pDipActive,p1,nil^); 2940 for p2:=0 to nPl-1 do 2941 if (p2<>p1) and (1 shl p2 and PeaceEnded<>0) then 3409 for p2 := 0 to nPl - 1 do 3410 if (p2 <> p1) and (1 shl p2 and PeaceEnded <> 0) then 2942 3411 begin 2943 i:=p1 shl 4+pDipActive; 2944 CallPlayer(cShowSupportAllianceAgainst,p2,i); 2945 end; 2946 for p2:=0 to nPl-1 do 2947 if (p2<>p1) and (1 shl p2 and PeaceEnded<>0) then 2948 begin 2949 i:=p2; 2950 CallPlayer(cShowCancelTreatyByAlliance,pDipActive,i); 3412 i := p2; 3413 CallPlayer(cShowCancelTreatyByAlliance, pDipActive, i); 2951 3414 end; 2952 3415 end 2953 3416 end 2954 else result:=eInvalid; 2955 if (Command>=sExecute) and (result>=rExecuted) then 2956 if LastEndClientCommand=scDipBreak then 3417 else 3418 result := eInvalid; 3419 if (Command >= sExecute) and (result >= rExecuted) then 3420 if LastEndClientCommand = scDipBreak then 2957 3421 begin // break negotiation 2958 pDipActive:=-1;2959 CallPlayer(cShowEndContact,pContacted,nil^);2960 ChangeClientWhenDone(cContinue,pTurn,nil^,0);3422 pDipActive := -1; 3423 CallPlayer(cShowEndContact, pContacted, nil^); 3424 ChangeClientWhenDone(cContinue, pTurn, nil^, 0); 2961 3425 end 2962 else3426 else 2963 3427 begin 2964 if (GTestFlags and tfUncover<>0) or (Difficulty[0]=0) then2965 with ShowNegoData do3428 if (GTestFlags and tfUncover <> 0) or (Difficulty[0] = 0) then 3429 with ShowNegoData do 2966 3430 begin // display negotiation in log window 2967 pSender:=pDipActive;2968 pTarget:=p1;2969 Action:=Command;2970 Brain[bix[0]].Client(cShowNego,1 shl 16+3,ShowNegoData);3431 pSender := pDipActive; 3432 pTarget := p1; 3433 Action := Command; 3434 Brain[bix[0]].Client(cShowNego, 1 shl 16 + 3, ShowNegoData); 2971 3435 end; 2972 pDipActive:=p1;2973 ChangeClientWhenDone(Command,pDipActive,nil^,0);3436 pDipActive := p1; 3437 ChangeClientWhenDone(Command, pDipActive, nil^, 0); 2974 3438 end 2975 3439 end 2976 else result:=eInvalid; 2977 2978 scDipOffer, scDipOffer-sExecute: 2979 if (pDipActive>=0) and (LastEndClientCommand<>scDipCancelTreaty) 2980 and (LastEndClientCommand<>scDipBreak) then 2981 if (LastEndClientCommand=scDipOffer) and (LastOffer.nDeliver+LastOffer.nCost 2982 +TOffer(Data).nDeliver+TOffer(Data).nCost=0) then 3440 else 3441 result := eInvalid; 3442 3443 scDipOffer, scDipOffer - sExecute: 3444 if (pDipActive >= 0) and (LastEndClientCommand <> scDipCancelTreaty) and 3445 (LastEndClientCommand <> scDipBreak) then 3446 if (LastEndClientCommand = scDipOffer) and 3447 (LastOffer.nDeliver + LastOffer.nCost + TOffer(Data).nDeliver + 3448 TOffer(Data).nCost = 0) then 2983 3449 begin 2984 if Command>=sExecute then3450 if Command >= sExecute then 2985 3451 begin // agreed discussion end 2986 pDipActive:=-1;2987 CallPlayer(cShowEndContact,pContacted,nil^);2988 assert(Mode=moPlaying);2989 ChangeClientWhenDone(cContinue,pTurn,nil^,0);3452 pDipActive := -1; 3453 CallPlayer(cShowEndContact, pContacted, nil^); 3454 assert(Mode = moPlaying); 3455 ChangeClientWhenDone(cContinue, pTurn, nil^, 0); 2990 3456 end 2991 3457 end 2992 else3458 else 2993 3459 begin 2994 // check if offer can be made 2995 if pDipActive=pTurn then p1:=pContacted 2996 else p1:=pTurn; 2997 if RW[pDipActive].Treaty[p1]<trPeace then 3460 // check if offer can be made 3461 if pDipActive = pTurn then 3462 p1 := pContacted 3463 else 3464 p1 := pTurn; 3465 if RW[pDipActive].Treaty[p1] < trPeace then 2998 3466 begin // no tribute allowed! 2999 for i:=0 to TOffer(Data).nDeliver+TOffer(Data).nCost-1 do 3000 if (TOffer(Data).Price[i] and opMask=opTribute) then result:=eInvalidOffer; 3001 for i:=0 to TOffer(Data).nDeliver+TOffer(Data).nCost-1 do 3002 if (TOffer(Data).Price[i]=opTreaty+trPeace) then result:=eOK; 3467 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do 3468 if (TOffer(Data).Price[i] and opMask = opTribute) then 3469 result := eInvalidOffer; 3470 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do 3471 if (TOffer(Data).Price[i] = opTreaty + trPeace) then 3472 result := eOK; 3003 3473 end; 3004 for i:=0 to TOffer(Data).nDeliver-1 do 3005 if (TOffer(Data).Price[i]<>opChoose) 3006 and not PayPrice(pDipActive,p1,TOffer(Data).Price[i],false) then 3007 result:=eInvalidOffer; 3008 if CountPrice(TOffer(Data),opTreaty)>1 then 3009 result:=eInvalidOffer; 3010 for i:=0 to nShipPart-1 do 3011 if CountPrice(TOffer(Data),opShipParts+i shl 16)>1 then 3012 result:=eInvalidOffer; 3013 if CountPrice(TOffer(Data),opMoney)>1 then 3014 result:=eInvalidOffer; 3015 if CountPrice(TOffer(Data),opTribute)>1 then 3016 result:=eInvalidOffer; 3017 case CountPrice(TOffer(Data),opChoose) of 3018 0:; 3019 1: 3020 if (TOffer(Data).nCost=0) or (TOffer(Data).nDeliver=0) then 3021 result:=eInvalidOffer; 3022 else result:=eInvalidOffer; 3474 for i := 0 to TOffer(Data).nDeliver - 1 do 3475 if (TOffer(Data).Price[i] <> opChoose) and 3476 not PayPrice(pDipActive, p1, TOffer(Data).Price[i], false) then 3477 result := eInvalidOffer; 3478 if CountPrice(TOffer(Data), opTreaty) > 1 then 3479 result := eInvalidOffer; 3480 for i := 0 to nShipPart - 1 do 3481 if CountPrice(TOffer(Data), opShipParts + i shl 16) > 1 then 3482 result := eInvalidOffer; 3483 if CountPrice(TOffer(Data), opMoney) > 1 then 3484 result := eInvalidOffer; 3485 if CountPrice(TOffer(Data), opTribute) > 1 then 3486 result := eInvalidOffer; 3487 case CountPrice(TOffer(Data), opChoose) of 3488 0: 3489 ; 3490 1: 3491 if (TOffer(Data).nCost = 0) or (TOffer(Data).nDeliver = 0) then 3492 result := eInvalidOffer; 3493 else 3494 result := eInvalidOffer; 3023 3495 end; 3024 3496 3025 // !!! check here if cost can be demanded3026 3027 if (Command>=sExecute) and (result>=rExecuted) then3497 // !!! check here if cost can be demanded 3498 3499 if (Command >= sExecute) and (result >= rExecuted) then 3028 3500 begin 3029 OfferFullySupported:= (TOffer(Data).nDeliver<=2)3030 and (TOffer(Data).nCost<=2); // >2 no more allowed3031 for i:=0 to TOffer(Data).nDeliver+TOffer(Data).nCost-1 do3501 OfferFullySupported := (TOffer(Data).nDeliver <= 2) and 3502 (TOffer(Data).nCost <= 2); // >2 no more allowed 3503 for i := 0 to TOffer(Data).nDeliver + TOffer(Data).nCost - 1 do 3032 3504 begin 3033 if TOffer(Data).Price[i] and opMask=opTribute then 3034 OfferFullySupported:=false; // tribute no more part of the game 3035 if (TOffer(Data).Price[i] and opMask=opTreaty) 3036 and (TOffer(Data).Price[i]-opTreaty<=RW[pDipActive].Treaty[p1]) then 3037 OfferFullySupported:=false; // agreed treaty end no more part of the game 3038 if TOffer(Data).Price[i]=opTreaty+trCeaseFire then 3039 OfferFullySupported:=false; // ceasefire no more part of the game 3505 if TOffer(Data).Price[i] and opMask = opTribute then 3506 OfferFullySupported := false; 3507 // tribute no more part of the game 3508 if (TOffer(Data).Price[i] and opMask = opTreaty) and 3509 (TOffer(Data).Price[i] - opTreaty <= RW[pDipActive].Treaty[p1]) 3510 then 3511 OfferFullySupported := false; 3512 // agreed treaty end no more part of the game 3513 if TOffer(Data).Price[i] = opTreaty + trCeaseFire then 3514 OfferFullySupported := false; 3515 // ceasefire no more part of the game 3040 3516 end; 3041 if not OfferFullySupported then3517 if not OfferFullySupported then 3042 3518 begin 3043 // some elements have been removed from the game - 3044 // automatically respond will null-offer 3045 LastOffer.nDeliver:=0; 3046 LastOffer.nCost:=0; 3047 ChangeClientWhenDone(scDipOffer,pDipActive,LastOffer,SizeOf(LastOffer)); 3519 // some elements have been removed from the game - 3520 // automatically respond will null-offer 3521 LastOffer.nDeliver := 0; 3522 LastOffer.nCost := 0; 3523 ChangeClientWhenDone(scDipOffer, pDipActive, LastOffer, 3524 SizeOf(LastOffer)); 3048 3525 end 3049 else3526 else 3050 3527 begin 3051 if (GTestFlags and tfUncover<>0) or (Difficulty[0]=0) then3052 with ShowNegoData do3528 if (GTestFlags and tfUncover <> 0) or (Difficulty[0] = 0) then 3529 with ShowNegoData do 3053 3530 begin // display negotiation in log window 3054 pSender:=pDipActive;3055 pTarget:=p1;3056 Action:=Command;3057 Offer:=TOffer(Data);3058 Brain[bix[0]].Client(cShowNego,1 shl 16+3,ShowNegoData);3531 pSender := pDipActive; 3532 pTarget := p1; 3533 Action := Command; 3534 Offer := TOffer(Data); 3535 Brain[bix[0]].Client(cShowNego, 1 shl 16 + 3, ShowNegoData); 3059 3536 end; 3060 LastOffer:=TOffer(Data); 3061 // show offered things to receiver 3062 for i:=0 to LastOffer.nDeliver-1 do 3063 ShowPrice(pDipActive,p1,LastOffer.Price[i]); 3064 pDipActive:=p1; 3065 assert(Mode=moPlaying); 3066 ChangeClientWhenDone(scDipOffer,pDipActive,LastOffer,SizeOf(LastOffer)); 3537 LastOffer := TOffer(Data); 3538 // show offered things to receiver 3539 for i := 0 to LastOffer.nDeliver - 1 do 3540 ShowPrice(pDipActive, p1, LastOffer.Price[i]); 3541 pDipActive := p1; 3542 assert(Mode = moPlaying); 3543 ChangeClientWhenDone(scDipOffer, pDipActive, LastOffer, 3544 SizeOf(LastOffer)); 3067 3545 end 3068 3546 end 3069 3547 end 3070 else result:=eInvalid; 3071 3072 { 3073 General Commands 3074 ____________________________________________________________________ 3075 } 3076 sClearTestFlag: 3077 if Player=0 then 3078 begin 3079 {$IFDEF TEXTLOG}CmdInfo:=Format('ClearTestFlag %x', [Subject]);{$ENDIF} 3080 ClearTestFlags(Subject); 3548 else 3549 result := eInvalid; 3550 3551 { 3552 General Commands 3553 ____________________________________________________________________ 3554 } 3555 sClearTestFlag: 3556 if Player = 0 then 3557 begin 3558 {$IFDEF TEXTLOG}CmdInfo := Format('ClearTestFlag %x', [Subject]); {$ENDIF} 3559 ClearTestFlags(Subject); 3081 3560 end 3082 else result:=eInvalid; 3083 3084 sSetTestFlag: 3085 if Player=0 then 3086 begin 3087 {$IFDEF TEXTLOG}CmdInfo:=Format('SetTestFlag %x', [Subject]);{$ENDIF} 3088 SetTestFlags(Player,Subject); 3089 // CheckContact; 3561 else 3562 result := eInvalid; 3563 3564 sSetTestFlag: 3565 if Player = 0 then 3566 begin 3567 {$IFDEF TEXTLOG}CmdInfo := Format('SetTestFlag %x', [Subject]); {$ENDIF} 3568 SetTestFlags(Player, Subject); 3569 // CheckContact; 3090 3570 end 3091 else result:=eInvalid; 3092 3093 sSetGovernment, sSetGovernment-sExecute: 3094 begin 3095 {$IFDEF TEXTLOG}CmdInfo:=Format('SetGovernment P%d: %d', [Player,Subject]);{$ENDIF} 3096 if RW[Player].Happened and phChangeGov=0 then result:=eViolation 3097 else if RW[Player].Government=Subject then result:=eNotChanged 3098 else if (Subject>=nGov) then result:=eInvalid 3099 else if (Subject>=gMonarchy) 3100 and (RW[Player].Tech[GovPreq[Subject]]<tsApplicable) then 3101 result:=eNoPreq 3102 else if Command>=sExecute then 3103 begin 3104 RW[Player].Government:=Subject; 3105 for p1:=0 to nPl-1 do if (p1<>Player) and ((GAlive or GWatching) and (1 shl p1)<>0) then 3106 RW[p1].EnemyReport[Player].Government:=Subject; 3107 end 3108 end; 3109 3110 sSetRates, sSetRates-sExecute: 3111 begin 3112 {$IFDEF TEXTLOG}CmdInfo:=Format('SetRates P%d: %d/%d', [Player,Subject and $f *10,Subject shr 4 *10]);{$ENDIF} 3113 if Subject and $f+Subject shr 4>10 then result:=eInvalid 3114 else if (RW[Player].TaxRate=Subject and $f *10) 3115 and (RW[Player].LuxRate=Subject shr 4 *10) then 3116 result:=eNotChanged 3117 else if Command>=sExecute then 3118 begin 3119 RW[Player].TaxRate:=Subject and $f *10; 3120 RW[Player].LuxRate:=Subject shr 4 *10; 3121 end 3122 end; 3123 3124 sRevolution: 3125 begin 3126 {$IFDEF TEXTLOG}CmdInfo:=Format('Revolution P%d', [Player]);{$ENDIF} 3127 if RW[Player].Government=gAnarchy then result:=eInvalid 3128 else 3129 begin 3130 RW[Player].Government:=gAnarchy; 3131 for p1:=0 to nPl-1 do if (p1<>Player) and ((GAlive or GWatching) and (1 shl p1)<>0) then 3132 RW[p1].EnemyReport[Player].Government:=gAnarchy; 3133 RW[Player].AnarchyStart:=GTurn; 3134 end; 3135 end; 3136 3137 sSetResearch, sSetResearch-sExecute: with RW[Player] do 3138 begin 3139 {$IFDEF TEXTLOG}CmdInfo:=Format('SetResearch P%d: %d', [Player,Subject]);{$ENDIF} 3140 if (Happened and phTech<>0) 3141 and ((Subject<nAdv) or (Subject=adMilitary)) then 3142 begin 3143 if (Mode=moPlaying) and (Subject=adMilitary) 3144 and (DevModelTurn[Player]<>GTurn) then 3145 result:=eNoModel 3146 else if Subject<>adMilitary then 3571 else 3572 result := eInvalid; 3573 3574 sSetGovernment, sSetGovernment - sExecute: 3575 begin 3576 {$IFDEF TEXTLOG}CmdInfo := Format('SetGovernment P%d: %d', [Player, Subject]); {$ENDIF} 3577 if RW[Player].Happened and phChangeGov = 0 then 3578 result := eViolation 3579 else if RW[Player].Government = Subject then 3580 result := eNotChanged 3581 else if (Subject >= nGov) then 3582 result := eInvalid 3583 else if (Subject >= gMonarchy) and 3584 (RW[Player].Tech[GovPreq[Subject]] < tsApplicable) then 3585 result := eNoPreq 3586 else if Command >= sExecute then 3147 3587 begin 3148 if Subject=futComputingTechnology then 3588 RW[Player].Government := Subject; 3589 for p1 := 0 to nPl - 1 do 3590 if (p1 <> Player) and ((GAlive or GWatching) and (1 shl p1) <> 0) 3591 then 3592 RW[p1].EnemyReport[Player].Government := Subject; 3593 end 3594 end; 3595 3596 sSetRates, sSetRates - sExecute: 3597 begin 3598 {$IFDEF TEXTLOG}CmdInfo := Format('SetRates P%d: %d/%d', [Player, Subject and $F * 10, Subject shr 4 * 10]); {$ENDIF} 3599 if Subject and $F + Subject shr 4 > 10 then 3600 result := eInvalid 3601 else if (RW[Player].TaxRate = Subject and $F * 10) and 3602 (RW[Player].LuxRate = Subject shr 4 * 10) then 3603 result := eNotChanged 3604 else if Command >= sExecute then 3605 begin 3606 RW[Player].TaxRate := Subject and $F * 10; 3607 RW[Player].LuxRate := Subject shr 4 * 10; 3608 end 3609 end; 3610 3611 sRevolution: 3612 begin 3613 {$IFDEF TEXTLOG}CmdInfo := Format('Revolution P%d', [Player]); {$ENDIF} 3614 if RW[Player].Government = gAnarchy then 3615 result := eInvalid 3616 else 3617 begin 3618 RW[Player].Government := gAnarchy; 3619 for p1 := 0 to nPl - 1 do 3620 if (p1 <> Player) and ((GAlive or GWatching) and (1 shl p1) <> 0) 3621 then 3622 RW[p1].EnemyReport[Player].Government := gAnarchy; 3623 RW[Player].AnarchyStart := GTurn; 3624 end; 3625 end; 3626 3627 sSetResearch, sSetResearch - sExecute: 3628 with RW[Player] do 3629 begin 3630 {$IFDEF TEXTLOG}CmdInfo := Format('SetResearch P%d: %d', [Player, Subject]); 3631 {$ENDIF} 3632 if (Happened and phTech <> 0) and 3633 ((Subject < nAdv) or (Subject = adMilitary)) then 3634 begin 3635 if (Mode = moPlaying) and (Subject = adMilitary) and 3636 (DevModelTurn[Player] <> GTurn) then 3637 result := eNoModel 3638 else if Subject <> adMilitary then 3149 3639 begin 3150 if Tech[Subject]>=MaxFutureTech_Computing then result:=eInvalid 3640 if Subject = futComputingTechnology then 3641 begin 3642 if Tech[Subject] >= MaxFutureTech_Computing then 3643 result := eInvalid 3644 end 3645 else if Subject in FutureTech then 3646 begin 3647 if Tech[Subject] >= MaxFutureTech then 3648 result := eInvalid 3649 end 3650 else if Tech[Subject] >= tsApplicable then 3651 result := eInvalid; // already discovered 3652 if Tech[Subject] <> tsSeen then // look if preqs met 3653 if AdvPreq[Subject, 2] <> preNone then 3654 begin // 2 of 3 required 3655 i := 0; 3656 for j := 0 to 2 do 3657 if Tech[AdvPreq[Subject, j]] >= tsApplicable then 3658 inc(i); 3659 if i < 2 then 3660 result := eNoPreq 3661 end 3662 else if (AdvPreq[Subject, 0] <> preNone) and 3663 (Tech[AdvPreq[Subject, 0]] < tsApplicable) or 3664 (AdvPreq[Subject, 1] <> preNone) and 3665 (Tech[AdvPreq[Subject, 1]] < tsApplicable) then 3666 result := eNoPreq 3667 end; 3668 if (result = eOK) and (Command >= sExecute) then 3669 begin 3670 if (Mode = moPlaying) and (Subject = adMilitary) then 3671 IntServer(sIntSetDevModel, Player, 0, DevModel.Kind); 3672 // save DevModel, because sctModel commands are not logged 3673 ResearchTech := Subject; 3151 3674 end 3152 else if Subject in FutureTech then 3675 end 3676 else 3677 result := eViolation; 3678 end; 3679 3680 sStealTech, sStealTech - sExecute: 3681 begin 3682 {$IFDEF TEXTLOG}CmdInfo := Format('StealTech P%d: %d', [Player, Subject]); 3683 {$ENDIF} 3684 if RW[Player].Happened and phStealTech = 0 then 3685 result := eInvalid 3686 else if (Subject >= nAdv) or (Subject in FutureTech) or 3687 (RW[Player].Tech[Subject] >= tsSeen) or 3688 (RW[GStealFrom].Tech[Subject] < tsApplicable) then 3689 result := eInvalid 3690 else if Command >= sExecute then 3691 begin 3692 SeeTech(Player, Subject); 3693 dec(RW[Player].Happened, phStealTech); 3694 end 3695 end; 3696 3697 sSetAttitude .. sSetAttitude + (nPl - 1) shl 4, 3698 sSetAttitude - sExecute .. sSetAttitude - sExecute + (nPl - 1) shl 4: 3699 begin 3700 p1 := Command shr 4 and $F; 3701 {$IFDEF TEXTLOG}CmdInfo := Format('SetAttitude P%d to P%d: %d', [Player, p1, Subject]); {$ENDIF} 3702 if (Subject >= nAttitude) or (p1 >= nPl) or 3703 (RW[Player].EnemyReport[p1] = nil) then 3704 result := eInvalid 3705 else if RW[Player].Treaty[p1] = trNoContact then 3706 result := eNoPreq 3707 else if RW[Player].Attitude[p1] = Subject then 3708 result := eNotChanged 3709 else if Command >= sExecute then 3710 begin 3711 RW[Player].Attitude[p1] := Subject; 3712 RW[p1].EnemyReport[Player].Attitude := Subject; 3713 end 3714 end; 3715 3716 sCancelTreaty, sCancelTreaty - sExecute: 3717 if (LastEndClientCommand <> scReject) or 3718 (RW[Player].Treaty[pContacted] < trPeace) then 3719 result := eInvalid 3720 else if (ServerVersion[Player] >= $010100) and 3721 (GTurn < RW[Player].LastCancelTreaty[pContacted] + CancelTreatyTurns) 3722 then 3723 result := eCancelTreatyRush 3724 else if Command >= sExecute then 3725 begin 3726 CallPlayer(cShowCancelTreaty, pContacted, Player); 3727 IntServer(sIntCancelTreaty, Player, pContacted, nil^); 3728 for p2 := 0 to nPl - 1 do 3729 if (p2 <> pContacted) and (1 shl p2 and PeaceEnded <> 0) then 3153 3730 begin 3154 if Tech[Subject]>=MaxFutureTech then result:=eInvalid 3731 i := pContacted shl 4 + Player; 3732 CallPlayer(cShowSupportAllianceAgainst, p2, i); 3733 end; 3734 for p2 := 0 to nPl - 1 do 3735 if (p2 <> pContacted) and (1 shl p2 and PeaceEnded <> 0) then 3736 begin 3737 i := p2; 3738 CallPlayer(cShowCancelTreatyByAlliance, Player, i); 3739 end; 3740 LastEndClientCommand := sTurn; 3741 end; 3742 3743 { 3744 Model Related Commands 3745 ____________________________________________________________________ 3746 } 3747 sCreateDevModel, sCreateDevModel - sExecute: 3748 begin 3749 {$IFDEF TEXTLOG}CmdInfo := Format('CreateDevModel P%d', [Player]); {$ENDIF} 3750 if Subject >= 4 then 3751 result := eInvalid 3752 else if (upgrade[Subject, 0].Preq <> preNone) and 3753 (RW[Player].Tech[upgrade[Subject, 0].Preq] < tsApplicable) then 3754 result := eNoPreq 3755 else if Command >= sExecute then 3756 begin 3757 with RW[Player].DevModel do 3758 begin 3759 Domain := Subject; 3760 MStrength := 0; 3761 MTrans := 0; 3762 MCost := 0; 3763 Upgrades := 0; 3764 FutureMCost := 0; 3765 for i := 0 to nUpgrade - 1 do 3766 with upgrade[Domain, i] do 3767 if (Preq = preNone) or (Preq >= 0) and 3768 ((RW[Player].Tech[Preq] >= tsApplicable) or 3769 (Preq in FutureTech) and (RW[Player].Tech[Preq] >= 0)) then 3770 begin 3771 if Preq in FutureTech then 3772 begin 3773 j := RW[Player].Tech[Preq]; 3774 inc(FutureMCost, j * Cost); 3775 end 3776 else 3777 begin 3778 j := 1; 3779 if Cost > MCost then 3780 MCost := Cost; 3781 end; 3782 inc(Upgrades, 1 shl i); 3783 inc(MStrength, j * Strength); 3784 inc(MTrans, j * Trans); 3785 end; 3786 inc(MCost, FutureMCost); 3787 FillChar(Cap, SizeOf(Cap), 0); 3788 Cap[mcOffense] := 2; 3789 Cap[mcDefense] := 1; 3790 for i := 0 to nFeature - 1 do 3791 with Feature[i] do 3792 if (1 shl Domain and Domains <> 0) and 3793 ((Preq = preNone) or (Preq = preSun) and 3794 (GWonder[woSun].EffectiveOwner = Player) or (Preq >= 0) and 3795 (RW[Player].Tech[Preq] >= tsApplicable)) and (i in AutoFeature) 3796 then 3797 Cap[i] := 1; 3798 MaxWeight := 5; 3799 if (WeightPreq7[Domain] <> preNA) and 3800 (RW[Player].Tech[WeightPreq7[Domain]] >= tsApplicable) then 3801 MaxWeight := 7; 3802 if (WeightPreq10[Domain] <> preNA) and 3803 (RW[Player].Tech[WeightPreq10[Domain]] >= tsApplicable) then 3804 if Domain = dSea then 3805 MaxWeight := 9 3806 else 3807 MaxWeight := 10; 3808 end; 3809 CalculateModel(RW[Player].DevModel); 3810 DevModelTurn[Player] := GTurn; 3811 end 3812 end; 3813 3814 sSetDevModelCap .. sSetDevModelCap + $3F0, 3815 sSetDevModelCap - sExecute .. sSetDevModelCap - sExecute + $3F0: 3816 begin 3817 {$IFDEF TEXTLOG}CmdInfo := Format('SetDevModelCap P%d', [Player]); {$ENDIF} 3818 if Subject >= nFeature then 3819 result := eInvalid 3820 else if DevModelTurn[Player] = GTurn then 3821 begin 3822 NewCap := Command shr 4 and $3F; { new value } 3823 with RW[Player].DevModel do 3824 if 1 shl Domain and Feature[Subject].Domains = 0 then 3825 result := eDomainMismatch 3826 else if not((Feature[Subject].Preq = preNone) or 3827 (Feature[Subject].Preq = preSun) and 3828 (GWonder[woSun].EffectiveOwner = Player) or 3829 (Feature[Subject].Preq >= 0) and 3830 (RW[Player].Tech[Feature[Subject].Preq] >= tsApplicable)) then 3831 result := eNoPreq 3832 else 3833 begin 3834 if (Subject in AutoFeature) or (Subject = mcDefense) then 3835 MinCap := 1 3836 else 3837 MinCap := 0; { MinCap - minimum use of feature } 3838 if Subject >= mcFirstNonCap then 3839 MaxCap := 1 3840 else if Subject = mcDefense then 3841 begin 3842 if Domain = dGround then 3843 MaxCap := 2 3844 else 3845 MaxCap := 3; 3846 if RW[Player].Tech[adSteel] >= tsApplicable then 3847 inc(MaxCap) 3848 end 3849 else 3850 MaxCap := 8; { MaxCap - maximum use of this feature } 3851 if (Domain = dGround) and (Subject = mcDefense) then 3852 CapWeight := 2 3853 else 3854 CapWeight := Feature[Subject].Weight; 3855 if (NewCap < MinCap) or (NewCap > MaxCap) or 3856 (Weight + (NewCap - Cap[Subject]) * CapWeight > MaxWeight) then 3857 result := eViolation 3858 else if Command >= sExecute then 3859 begin 3860 Cap[Subject] := NewCap; 3861 3862 // mutual feature exclusion 3863 case Subject of 3864 mcSub: 3865 begin 3866 if ServerVersion[Player] >= $010103 then 3867 Cap[mcSeaTrans] := 0; 3868 Cap[mcArtillery] := 0; 3869 Cap[mcCarrier] := 0; 3870 if Cap[mcDefense] > 2 then 3871 Cap[mcDefense] := 2 3872 end; 3873 mcSeaTrans: 3874 begin 3875 if ServerVersion[Player] >= $010103 then 3876 Cap[mcSub] := 0; 3877 end; 3878 mcCarrier: 3879 Cap[mcSub] := 0; 3880 mcArtillery: 3881 Cap[mcSub] := 0; 3882 mcAlpine: 3883 begin 3884 Cap[mcOver] := 0; 3885 Cap[mcMob] := 0; 3886 end; 3887 mcOver: 3888 Cap[mcAlpine] := 0; 3889 mcMob: 3890 begin 3891 Cap[mcAlpine] := 0; 3892 end; 3893 end; 3894 3895 CalculateModel(RW[Player].DevModel); 3896 end 3897 end; 3898 end 3899 else 3900 result := eNoModel; 3901 end; 3902 3903 { 3904 Unit Related Commands 3905 ____________________________________________________________________ 3906 } 3907 sRemoveUnit, sRemoveUnit - sExecute: 3908 begin 3909 {$IFDEF TEXTLOG}CmdInfo := Format('RemoveUnit P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF} 3910 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then 3911 result := eInvalid 3912 else 3913 begin 3914 result := eRemoved; 3915 Loc0 := RW[Player].Un[Subject].Loc; 3916 if RealMap[Loc0] and fCity <> 0 then { check utilize } 3917 begin 3918 SearchCity(Loc0, Player, cix1); 3919 with RW[Player].City[cix1] do 3920 begin 3921 if (RW[Player].Model[RW[Player].Un[Subject].mix].Kind = mkCaravan) 3922 and ((Project and cpImp = 0) or 3923 (Imp[Project and cpIndex].Kind <> ikShipPart)) or 3924 (Project and cpImp = 0) and 3925 (RW[Player].Model[Project and cpIndex].Kind <> mkCaravan) then 3926 result := eUtilized; 3927 if Command >= sExecute then 3928 begin 3929 if result = eUtilized then 3930 begin 3931 with RW[Player].Un[Subject] do 3932 begin 3933 Cost := integer(RW[Player].Model[mix].Cost) * Health * 3934 BuildCostMod[Difficulty[Player]] div 1200; 3935 if RW[Player].Model[mix].Cap[mcLine] > 0 then 3936 Cost := Cost div 2; 3937 end; 3938 if Project and (cpImp + cpIndex) = cpImp + imTrGoods then 3939 inc(RW[Player].Money, Cost) 3940 else 3941 begin 3942 inc(Prod, Cost * 2 div 3); 3943 Project0 := Project0 and not cpCompleted; 3944 if Project0 and not cpAuto <> Project and not cpAuto then 3945 Project0 := Project; 3946 Prod0 := Prod; 3947 end 3948 end; 3949 RemoveUnit_UpdateMap(Player, Subject); 3950 end; 3951 end; 3155 3952 end 3156 else if Tech[Subject]>=tsApplicable then 3157 result:=eInvalid; // already discovered 3158 if Tech[Subject]<>tsSeen then // look if preqs met 3159 if AdvPreq[Subject,2]<>preNone then 3160 begin // 2 of 3 required 3161 i:=0; 3162 for j:=0 to 2 do 3163 if Tech[AdvPreq[Subject,j]]>=tsApplicable then inc(i); 3164 if i<2 then result:=eNoPreq 3165 end 3166 else if (AdvPreq[Subject,0]<>preNone) 3167 and (Tech[AdvPreq[Subject,0]]<tsApplicable) 3168 or (AdvPreq[Subject,1]<>preNone) 3169 and (Tech[AdvPreq[Subject,1]]<tsApplicable) then 3170 result:=eNoPreq 3953 else if Command >= sExecute then 3954 RemoveUnit_UpdateMap(Player, Subject); 3955 end 3956 end; 3957 3958 sSetUnitHome, sSetUnitHome - sExecute: 3959 begin 3960 {$IFDEF TEXTLOG}CmdInfo := Format('SetUnitHome P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF} 3961 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then 3962 result := eInvalid 3963 else 3964 begin 3965 Loc0 := RW[Player].Un[Subject].Loc; 3966 if RealMap[Loc0] and fCity = 0 then 3967 result := eInvalid 3968 else 3969 begin 3970 SearchCity(Loc0, Player, cix1); 3971 if RW[Player].City[cix1].Flags and chCaptured <> 0 then 3972 result := eViolation 3973 else if Command >= sExecute then 3974 RW[Player].Un[Subject].Home := cix1 3975 end 3976 end 3977 end; 3978 3979 sSetSpyMission .. sSetSpyMission + (nSpyMission - 1) shl 4, 3980 sSetSpyMission - sExecute .. sSetSpyMission - sExecute + 3981 (nSpyMission - 1) shl 4: 3982 if Command >= sExecute then 3983 SpyMission := Command shr 4 and $F; 3984 3985 sLoadUnit, sLoadUnit - sExecute: 3986 begin 3987 {$IFDEF TEXTLOG}CmdInfo := Format('LoadUnit P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF} 3988 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then 3989 result := eInvalid 3990 else 3991 result := LoadUnit(Player, Subject, Command < sExecute); 3992 end; 3993 3994 sUnloadUnit, sUnloadUnit - sExecute: 3995 begin 3996 {$IFDEF TEXTLOG}CmdInfo := Format('UnloadUnit P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF} 3997 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then 3998 result := eInvalid 3999 else 4000 result := UnloadUnit(Player, Subject, Command < sExecute) 4001 end; 4002 4003 sSelectTransport, sSelectTransport - sExecute: 4004 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then 4005 result := eInvalid 4006 else 4007 with RW[Player].Model[RW[Player].Un[Subject].mix] do 4008 begin 4009 if Cap[mcSeaTrans] + Cap[mcAirTrans] + Cap[mcCarrier] = 0 then 4010 result := eInvalid 4011 else if Command >= sExecute then 4012 uixSelectedTransport := Subject; 3171 4013 end; 3172 if (result=eOK) and (Command>=sExecute) then 4014 4015 sCreateUnit .. sCreateUnit + (nPl - 1) shl 4, 4016 sCreateUnit - sExecute .. sCreateUnit - sExecute + (nPl - 1) shl 4: 4017 if (GTestFlags and tfUncover <> 0) or (Difficulty[Player] = 0) 4018 then { supervisor only command } 4019 begin 4020 p1 := Command shr 4 and $F; 4021 Loc1 := integer(Data); 4022 if (Occupant[Loc1] >= 0) and (p1 <> Occupant[Loc1]) or 4023 (RealMap[Loc1] and fCity <> 0) and 4024 (RealMap[Loc1] shr 27 <> Cardinal(p1)) or 4025 (RW[p1].Model[Subject].Domain < dAir) and 4026 ((RW[p1].Model[Subject].Domain = dSea) <> (RealMap[integer(Data)] and 4027 fTerrain < fGrass)) then 4028 result := eViolation 4029 else if Command >= sExecute then 3173 4030 begin 3174 if (Mode=moPlaying) and (Subject=adMilitary) then3175 IntServer(sIntSetDevModel,Player,0,DevModel.Kind);3176 // save DevModel, because sctModel commands are not logged3177 ResearchTech:=Subject;4031 CreateUnit(p1, Subject); 4032 RW[p1].Un[RW[p1].nUn - 1].Loc := integer(Data); 4033 PlaceUnit(p1, RW[p1].nUn - 1); 4034 UpdateUnitMap(integer(Data)); 3178 4035 end 3179 4036 end 3180 else result:=eViolation; 3181 end; 3182 3183 sStealTech, sStealTech-sExecute: 3184 begin 3185 {$IFDEF TEXTLOG}CmdInfo:=Format('StealTech P%d: %d', [Player,Subject]);{$ENDIF} 3186 if RW[Player].Happened and phStealTech=0 then result:=eInvalid 3187 else if (Subject>=nAdv) or (Subject in FutureTech) 3188 or (RW[Player].Tech[Subject]>=tsSeen) 3189 or (RW[GStealFrom].Tech[Subject]<tsApplicable) then 3190 result:=eInvalid 3191 else if Command>=sExecute then 3192 begin 3193 SeeTech(Player,Subject); 3194 dec(RW[Player].Happened,phStealTech); 3195 end 3196 end; 3197 3198 sSetAttitude..sSetAttitude+(nPl-1) shl 4, 3199 sSetAttitude-sExecute..sSetAttitude-sExecute+(nPl-1) shl 4: 3200 begin 3201 p1:=Command shr 4 and $f; 3202 {$IFDEF TEXTLOG}CmdInfo:=Format('SetAttitude P%d to P%d: %d', [Player,p1,Subject]);{$ENDIF} 3203 if (Subject>=nAttitude) or (p1>=nPl) 3204 or (RW[Player].EnemyReport[p1]=nil) then 3205 result:=eInvalid 3206 else if RW[Player].Treaty[p1]=trNoContact then 3207 result:=eNoPreq 3208 else if RW[Player].Attitude[p1]=Subject then 3209 result:=eNotChanged 3210 else if Command>=sExecute then 3211 begin 3212 RW[Player].Attitude[p1]:=Subject; 3213 RW[p1].EnemyReport[Player].Attitude:=Subject; 3214 end 3215 end; 3216 3217 sCancelTreaty, sCancelTreaty-sExecute: 3218 if (LastEndClientCommand<>scReject) 3219 or (RW[Player].Treaty[pContacted]<trPeace) then 3220 result:=eInvalid 3221 else if (ServerVersion[Player]>=$010100) 3222 and (GTurn<RW[Player].LastCancelTreaty[pContacted]+CancelTreatyTurns) then 3223 result:=eCancelTreatyRush 3224 else if Command>=sExecute then 3225 begin 3226 CallPlayer(cShowCancelTreaty,pContacted,Player); 3227 IntServer(sIntCancelTreaty,Player,pContacted,nil^); 3228 for p2:=0 to nPl-1 do 3229 if (p2<>pContacted) and (1 shl p2 and PeaceEnded<>0) then 4037 else 4038 result := eInvalid; 4039 4040 sMoveUnit + (0 + 6 * 8) * 16, sMoveUnit + (1 + 7 * 8) * 16, 4041 sMoveUnit + (2 + 0 * 8) * 16, sMoveUnit + (1 + 1 * 8) * 16, 4042 sMoveUnit + (0 + 2 * 8) * 16, sMoveUnit + (7 + 1 * 8) * 16, 4043 sMoveUnit + (6 + 0 * 8) * 16, sMoveUnit + (7 + 7 * 8) * 16, 4044 sMoveUnit - sExecute + (0 + 6 * 8) * 16, sMoveUnit - sExecute + 4045 (1 + 7 * 8) * 16, sMoveUnit - sExecute + (2 + 0 * 8) * 16, 4046 sMoveUnit - sExecute + (1 + 1 * 8) * 16, sMoveUnit - sExecute + 4047 (0 + 2 * 8) * 16, sMoveUnit - sExecute + (7 + 1 * 8) * 16, 4048 sMoveUnit - sExecute + (6 + 0 * 8) * 16, sMoveUnit - sExecute + 4049 (7 + 7 * 8) * 16: 4050 begin 4051 dx := (Command shr 4 + 4) and 7 - 4; 4052 dy := (Command shr 7 + 4) and 7 - 4; 4053 {$IFDEF TEXTLOG}CmdInfo := Format('MoveUnit P%d I%d Mod%d Loc%d (%d,%d)', [Player, Subject, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc, dx, dy]); {$ENDIF} 4054 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then 4055 result := eInvalid 4056 else 4057 result := MoveUnit(Player, Subject, dx, dy, Command < sExecute); 4058 end; 4059 4060 { 4061 Settlers Related Commands 4062 ____________________________________________________________________ 4063 } 4064 sAddToCity, sAddToCity - sExecute: 4065 begin 4066 {$IFDEF TEXTLOG}CmdInfo := Format('AddToCity P%d Mod%d Loc%d', [Player, RW[Player].Un[Subject].mix, RW[Player].Un[Subject].Loc]); {$ENDIF} 4067 if (Subject >= RW[Player].nUn) or (RW[Player].Un[Subject].Loc < 0) then 4068 result := eInvalid 4069 else if not(RW[Player].Model[RW[Player].Un[Subject].mix].Kind 4070 in [mkSettler, mkSlaves]) and 4071 (RW[Player].Un[Subject].Flags and unConscripts = 0) then 4072 result := eViolation 4073 else 4074 begin 4075 Loc0 := RW[Player].Un[Subject].Loc; 4076 if RealMap[Loc0] and fCity = 0 then 4077 result := eInvalid 4078 else 3230 4079 begin 3231 i:=pContacted shl 4+Player; 3232 CallPlayer(cShowSupportAllianceAgainst,p2,i); 4080 SearchCity(Loc0, Player, cix1); 4081 with RW[Player].City[cix1] do 4082 if not CanCityGrow(Player, cix1) then 4083 result := eMaxSize 4084 else if Command >= sExecute then 4085 begin { add to city } 4086 if Mode = moPlaying then 4087 SavedTiles[cix1] := 0; // save in every case 4088 if CanCityGrow(Player, cix1) then 4089 CityGrowth(Player, cix1); 4090 if (RW[Player].Model[RW[Player].Un[Subject].mix] 4091 .Kind = mkSettler) and CanCityGrow(Player, cix1) then 4092 CityGrowth(Player, cix1); 4093 RemoveUnit_UpdateMap(Player, Subject); 4094 end 4095 end 4096 end 4097 end; 4098 4099 sStartJob .. sStartJob + $3F0, sStartJob - sExecute .. sStartJob + $3F0 4100 - sExecute: 4101 begin 4102 Loc0 := RW[Player].Un[Subject].Loc; 4103 i := Command shr 4 and $3F; // new job 4104 {$IFDEF TEXTLOG}CmdInfo := Format('StartJob P%d Mod%d Loc%d: %d', [Player, RW[Player].Un[Subject].mix, Loc0, i]); {$ENDIF} 4105 if (Subject >= RW[Player].nUn) or (Loc0 < 0) then 4106 result := eInvalid 4107 else if i >= nJob then 4108 result := eInvalid 4109 else 4110 begin 4111 result := StartJob(Player, Subject, i, Command < sExecute); 4112 if result = eCity then 4113 begin // new city 4114 cix1 := RW[Player].nCity - 1; 4115 AddBestCityTile(Player, cix1); 4116 if Mode = moPlaying then 4117 with RW[Player].City[cix1] do 4118 begin 4119 // SavedResourceWeights[cix1]:=ResourceWeights; 4120 SavedTiles[cix1] := 0; // save in every case 4121 end; 4122 if Mode >= moMovie then { show new city in interface modules } 4123 for p1 := 0 to nPl - 1 do 4124 if (1 shl p1 and GWatching <> 0) and (p1 <> Player) and 4125 (ObserveLevel[Loc0] and (3 shl (2 * p1)) > 0) then 4126 CallPlayer(cShowCityChanged, p1, Loc0); 4127 end 4128 end; 4129 end; 4130 4131 { 4132 City Related Commands 4133 ____________________________________________________________________ 4134 } 4135 sSetCityProject, sSetCityProject - sExecute: 4136 begin 4137 NewProject := integer(Data) and not cpAuto; 4138 {$IFDEF TEXTLOG}CmdInfo := Format('SetCityProject P%d Loc%d: %d', [Player, RW[Player].City[Subject].Loc, NewProject]); {$ENDIF} 4139 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0) 4140 then 4141 result := eInvalid 4142 else 4143 with RW[Player].City[Subject] do 4144 begin 4145 if NewProject = Project then 4146 result := eNotChanged 4147 else 4148 begin 4149 pt0 := ProjectType(Project0); 4150 pt1 := ProjectType(NewProject); 4151 if NewProject and cpImp = 0 then 4152 begin 4153 if NewProject and cpIndex >= RW[Player].nModel then 4154 result := eInvalid 4155 else if (NewProject and cpConscripts <> 0) and 4156 not((RW[Player].Tech[adConscription] >= tsApplicable) and 4157 (RW[Player].Model[NewProject and cpIndex].Domain = dGround) 4158 and (RW[Player].Model[NewProject and cpIndex].Kind < mkScout)) 4159 then 4160 result := eViolation 4161 // else if (RW[Player].Model[NewProject and cpIndex].Kind=mkSlaves) 4162 // and (GWonder[woPyramids].EffectiveOwner<>Player) then 4163 // result:=eNoPreq 4164 end 4165 else if NewProject and cpIndex >= nImp then 4166 result := eInvalid 4167 else 4168 begin 4169 Preq := Imp[NewProject and cpIndex].Preq; 4170 for i := 0 to nImpReplacement - 1 do 4171 if (ImpReplacement[i].OldImp = NewProject and cpIndex) and 4172 (built[ImpReplacement[i].NewImp] > 0) then 4173 result := eObsolete; 4174 if result = eObsolete then 4175 else if Preq = preNA then 4176 result := eInvalid 4177 else if (Preq >= 0) and (RW[Player].Tech[Preq] < tsApplicable) 4178 then 4179 result := eNoPreq 4180 else if built[NewProject and cpIndex] > 0 then 4181 result := eInvalid 4182 else if (NewProject and cpIndex < 28) and 4183 (GWonder[NewProject and cpIndex].CityID <> -1) then 4184 result := eViolation // wonder already exists 4185 else if (NewProject and cpIndex = imSpacePort) and 4186 (RW[Player].NatBuilt[imSpacePort] > 0) then 4187 result := eViolation // space port already exists 4188 else if (NewProject = cpImp + imBank) and (built[imMarket] = 0) 4189 or (NewProject = cpImp + imUniversity) and 4190 (built[imLibrary] = 0) or (NewProject = cpImp + imResLab) and 4191 (built[imUniversity] = 0) or (NewProject = cpImp + imMfgPlant) 4192 and (built[imFactory] = 0) then 4193 result := eNoPreq; 4194 case NewProject - cpImp of 4195 woLighthouse, woMagellan, imCoastalFort, imHarbor, imPlatform: 4196 begin { city at ocean? } 4197 Preq := 0; 4198 V8_to_Loc(Loc, Adjacent); 4199 for V8 := 0 to 7 do 4200 begin 4201 Loc1 := Adjacent[V8]; 4202 if (Loc1 >= 0) and (Loc1 < MapSize) and 4203 (RealMap[Loc1] and fTerrain = fShore) then 4204 inc(Preq); 4205 end; 4206 if Preq = 0 then 4207 result := eNoPreq; 4208 end; 4209 woHoover, imHydro: 4210 begin { city at river or mountains? } 4211 Preq := 0; 4212 V8_to_Loc(Loc, Adjacent); 4213 for V8 := 0 to 7 do 4214 begin 4215 Loc1 := Adjacent[V8]; 4216 if (Loc1 >= 0) and (Loc1 < MapSize) and 4217 ((RealMap[Loc1] and fTerrain = fMountains) or 4218 (RealMap[Loc1] and fRiver <> 0)) then 4219 inc(Preq); 4220 end; 4221 if Preq = 0 then 4222 result := eNoPreq; 4223 end; 4224 woMIR, imShipComp, imShipPow, imShipHab: 4225 if RW[Player].NatBuilt[imSpacePort] = 0 then 4226 result := eNoPreq; 4227 end; 4228 if (GTestFlags and tfNoRareNeed = 0) and 4229 (Imp[NewProject and cpIndex].Kind = ikShipPart) then 4230 if RW[Player].Tech[adMassProduction] < tsApplicable then 4231 result := eNoPreq 4232 else 4233 begin // check for rare resources 4234 if NewProject and cpIndex = imShipComp then 4235 j := 1 4236 else if NewProject and cpIndex = imShipPow then 4237 j := 2 4238 else { if NewProject and cpIndex=imShipHab then } 4239 j := 3; 4240 // j = rare resource required 4241 Preq := 0; 4242 V21_to_Loc(Loc, Radius); 4243 for V21 := 1 to 26 do 4244 begin 4245 Loc1 := Radius[V21]; 4246 if (Loc1 >= 0) and (Loc1 < MapSize) and 4247 (RealMap[Loc1] shr 25 and 3 = Cardinal(j)) then 4248 inc(Preq); 4249 end; 4250 if Preq = 0 then 4251 result := eNoPreq; 4252 end 4253 end; 4254 4255 if (Command >= sExecute) and (result >= rExecuted) then 4256 begin 4257 if pt0 <> ptSelect then 4258 if NewProject and (cpImp or cpIndex) = Project0 and 4259 (cpImp or cpIndex) then 4260 Prod := Prod0 4261 else if (pt1 = ptTrGoods) or (pt1 = ptShip) or (pt1 <> pt0) 4262 and (pt0 <> ptCaravan) then 4263 begin 4264 inc(RW[Player].Money, Prod0); 4265 Prod := 0; 4266 Prod0 := 0; 4267 Project0 := cpImp + imTrGoods 4268 end 4269 else 4270 Prod := Prod0 * 2 div 3; 4271 Project := NewProject 4272 end 4273 end 4274 end 4275 end; 4276 4277 sBuyCityProject, sBuyCityProject - sExecute: 4278 begin 4279 {$IFDEF TEXTLOG}CmdInfo := Format('BuyCityProject P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF} 4280 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0) 4281 then 4282 result := eInvalid 4283 else 4284 with RW[Player].City[Subject] do 4285 if (RW[Player].Government = gAnarchy) or (Flags and chCaptured <> 0) 4286 then 4287 result := eOutOfControl 4288 else if (Project and cpImp <> 0) and 4289 ((Project and cpIndex = imTrGoods) or 4290 (Imp[Project and cpIndex].Kind = ikShipPart)) then 4291 result := eInvalid // don't buy colony ship 4292 else 4293 begin 4294 CityReport.HypoTiles := -1; 4295 CityReport.HypoTax := -1; 4296 CityReport.HypoLux := -1; 4297 GetCityReport(Player, Subject, CityReport); 4298 Cost := CityReport.ProdCost; 4299 NextProd := CityReport.ProdRep - CityReport.Support; 4300 if (CityReport.Working - CityReport.Happy > Size shr 1) or 4301 (NextProd < 0) then // !!! change to new style disorder 4302 NextProd := 0; 4303 Cost := Cost - Prod - NextProd; 4304 if (GWonder[woMich].EffectiveOwner = Player) and 4305 (Project and cpImp <> 0) then 4306 Cost := Cost * 2 4307 else 4308 Cost := Cost * 4; 4309 if Cost <= 0 then 4310 result := eNotChanged 4311 else if Cost > RW[Player].Money then 4312 result := eViolation 4313 else if Command >= sExecute then 4314 IntServer(sIntBuyMaterial, Player, Subject, Cost); 4315 // need to save material/cost because city tiles are not correct 4316 // when loading 4317 end; 4318 end; 4319 4320 sSellCityProject, sSellCityProject - sExecute: 4321 begin 4322 {$IFDEF TEXTLOG}CmdInfo := Format('SellCityProject P%d Loc%d', [Player, RW[Player].City[Subject].Loc]); {$ENDIF} 4323 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0) 4324 then 4325 result := eInvalid 4326 else if Command >= sExecute then 4327 with RW[Player].City[Subject] do 4328 begin 4329 inc(RW[Player].Money, Prod0); 4330 Prod := 0; 4331 Prod0 := 0; 3233 4332 end; 3234 for p2:=0 to nPl-1 do 3235 if (p2<>pContacted) and (1 shl p2 and PeaceEnded<>0) then 3236 begin 3237 i:=p2; 3238 CallPlayer(cShowCancelTreatyByAlliance,Player,i); 3239 end; 3240 LastEndClientCommand:=sTurn; 3241 end; 3242 3243 { 3244 Model Related Commands 3245 ____________________________________________________________________ 3246 } 3247 sCreateDevModel, sCreateDevModel-sExecute: 3248 begin 3249 {$IFDEF TEXTLOG}CmdInfo:=Format('CreateDevModel P%d', [Player]);{$ENDIF} 3250 if Subject>=4 then result:=eInvalid 3251 else if (upgrade[Subject,0].Preq<>preNone) 3252 and (RW[Player].Tech[upgrade[Subject,0].Preq]<tsApplicable) then 3253 result:=eNoPreq 3254 else if Command>=sExecute then 3255 begin 3256 with RW[Player].DevModel do 3257 begin 3258 Domain:=Subject; 3259 MStrength:=0; MTrans:=0; MCost:=0; Upgrades:=0; 3260 FutureMCost:=0; 3261 for i:=0 to nUpgrade-1 do with upgrade[Domain,i] do 3262 if (Preq=preNone) 3263 or (Preq>=0) and ((RW[Player].Tech[Preq]>=tsApplicable) 3264 or (Preq in FutureTech) and (RW[Player].Tech[Preq]>=0)) then 4333 end; 4334 4335 sSellCityImprovement, sSellCityImprovement - sExecute: 4336 begin 4337 {$IFDEF TEXTLOG}CmdInfo := Format('SellCityImprovement P%d Loc%d: %d', [Player, RW[Player].City[Subject].Loc, integer(Data)]); {$ENDIF} 4338 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0) 4339 then 4340 result := eInvalid 4341 else 4342 with RW[Player].City[Subject] do 4343 if built[integer(Data)] = 0 then 4344 result := eInvalid 4345 else if (RW[Player].Government = gAnarchy) or 4346 (Flags and chCaptured <> 0) then 4347 result := eOutOfControl 4348 else if Flags and chImprovementSold <> 0 then 4349 result := eOnlyOnce 4350 else if Command >= sExecute then 3265 4351 begin 3266 if Preq in FutureTech then 4352 inc(RW[Player].Money, Imp[integer(Data)].Cost * BuildCostMod 4353 [Difficulty[Player]] div 12); 4354 built[integer(Data)] := 0; 4355 if Imp[integer(Data)].Kind in [ikNatLocal, ikNatGlobal] then 3267 4356 begin 3268 j:=RW[Player].Tech[Preq]; 3269 inc(FutureMCost,j*Cost); 3270 end 3271 else 3272 begin 3273 j:=1; 3274 if Cost>MCost then MCost:=Cost; 3275 end; 3276 inc(Upgrades,1 shl i); 3277 inc(MStrength,j*Strength); 3278 inc(MTrans,j*Trans); 3279 end; 3280 inc(MCost,FutureMCost); 3281 FillChar(Cap,SizeOf(Cap),0); 3282 Cap[mcOffense]:=2; 3283 Cap[mcDefense]:=1; 3284 for i:=0 to nFeature-1 do with Feature[i] do 3285 if (1 shl Domain and Domains<>0) and ((Preq=preNone) 3286 or (Preq=preSun) and (GWonder[woSun].EffectiveOwner=Player) 3287 or (Preq>=0) and (RW[Player].Tech[Preq]>=tsApplicable)) 3288 and (i in AutoFeature) then Cap[i]:=1; 3289 MaxWeight:=5; 3290 if (WeightPreq7[Domain]<>preNA) 3291 and (RW[Player].Tech[WeightPreq7[Domain]]>=tsApplicable) then 3292 MaxWeight:=7; 3293 if (WeightPreq10[Domain]<>preNA) 3294 and (RW[Player].Tech[WeightPreq10[Domain]]>=tsApplicable) then 3295 if Domain=dSea then MaxWeight:=9 3296 else MaxWeight:=10; 3297 end; 3298 CalculateModel(RW[Player].DevModel); 3299 DevModelTurn[Player]:=GTurn; 3300 end 3301 end; 3302 3303 sSetDevModelCap..sSetDevModelCap+$3F0, 3304 sSetDevModelCap-sExecute..sSetDevModelCap-sExecute+$3F0: 3305 begin 3306 {$IFDEF TEXTLOG}CmdInfo:=Format('SetDevModelCap P%d', [Player]);{$ENDIF} 3307 if Subject>=nFeature then result:=eInvalid 3308 else if DevModelTurn[Player]=GTurn then 3309 begin 3310 NewCap:=Command shr 4 and $3F; {new value} 3311 with RW[Player].DevModel do 3312 if 1 shl Domain and Feature[Subject].Domains=0 then 3313 result:=eDomainMismatch 3314 else if not ((Feature[Subject].Preq=preNone) 3315 or (Feature[Subject].Preq=preSun) 3316 and (GWonder[woSun].EffectiveOwner=Player) 3317 or (Feature[Subject].Preq>=0) 3318 and (RW[Player].Tech[Feature[Subject].Preq]>=tsApplicable)) then 3319 result:=eNoPreq 3320 else 3321 begin 3322 if (Subject in AutoFeature) or (Subject=mcDefense) then MinCap:=1 3323 else MinCap:=0; {MinCap - minimum use of feature} 3324 if Subject>=mcFirstNonCap then MaxCap:=1 3325 else if Subject=mcDefense then 3326 begin 3327 if Domain=dGround then MaxCap:=2 3328 else MaxCap:=3; 3329 if RW[Player].Tech[adSteel]>=tsApplicable then inc(MaxCap) 3330 end 3331 else MaxCap:=8; {MaxCap - maximum use of this feature} 3332 if (Domain=dGround) and (Subject=mcDefense) then CapWeight:=2 3333 else CapWeight:=Feature[Subject].Weight; 3334 if (NewCap<MinCap) or (NewCap>MaxCap) 3335 or (Weight+(NewCap-Cap[Subject])*CapWeight>MaxWeight) then 3336 result:=eViolation 3337 else if Command>=sExecute then 3338 begin 3339 Cap[Subject]:=NewCap; 3340 3341 // mutual feature exclusion 3342 case Subject of 3343 mcSub: 3344 begin 3345 if ServerVersion[Player]>=$010103 then 3346 Cap[mcSeaTrans]:=0; 3347 Cap[mcArtillery]:=0; 3348 Cap[mcCarrier]:=0; 3349 if Cap[mcDefense]>2 then Cap[mcDefense]:=2 3350 end; 3351 mcSeaTrans: 3352 begin 3353 if ServerVersion[Player]>=$010103 then 3354 Cap[mcSub]:=0; 3355 end; 3356 mcCarrier: Cap[mcSub]:=0; 3357 mcArtillery: Cap[mcSub]:=0; 3358 mcAlpine: 3359 begin Cap[mcOver]:=0; Cap[mcMob]:=0; end; 3360 mcOver: Cap[mcAlpine]:=0; 3361 mcMob: begin Cap[mcAlpine]:=0; end; 3362 end; 3363 3364 CalculateModel(RW[Player].DevModel); 3365 end 3366 end; 3367 end 3368 else result:=eNoModel; 3369 end; 3370 3371 { 3372 Unit Related Commands 3373 ____________________________________________________________________ 3374 } 3375 sRemoveUnit,sRemoveUnit-sExecute: 3376 begin 3377 {$IFDEF TEXTLOG}CmdInfo:=Format('RemoveUnit P%d Mod%d Loc%d', [Player,RW[Player].Un[Subject].mix,RW[Player].Un[Subject].Loc]);{$ENDIF} 3378 if (Subject>=RW[Player].nUn) or (RW[Player].Un[Subject].Loc<0) then 3379 result:=eInvalid 3380 else 3381 begin 3382 result:=eRemoved; 3383 Loc0:=RW[Player].Un[Subject].Loc; 3384 if RealMap[Loc0] and fCity<>0 then {check utilize} 3385 begin 3386 SearchCity(Loc0,Player,cix1); 3387 with RW[Player].City[cix1] do 3388 begin 3389 if (RW[Player].Model[RW[Player].Un[Subject].mix].Kind=mkCaravan) 3390 and ((Project and cpImp=0) or (Imp[Project and cpIndex].Kind<>ikShipPart)) 3391 or (Project and cpImp=0) and (RW[Player].Model[Project 3392 and cpIndex].Kind<>mkCaravan) then 3393 result:=eUtilized; 3394 if Command>=sExecute then 3395 begin 3396 if result=eUtilized then 3397 begin 3398 with RW[Player].Un[Subject] do 3399 begin 3400 Cost:=integer(RW[Player].Model[mix].Cost)*Health 3401 *BuildCostMod[Difficulty[Player]] div 1200; 3402 if RW[Player].Model[mix].Cap[mcLine]>0 then 3403 Cost:=Cost div 2; 3404 end; 3405 if Project and (cpImp+cpIndex)=cpImp+imTrGoods then 3406 inc(RW[Player].Money,Cost) 3407 else 3408 begin 3409 inc(Prod,Cost*2 div 3); 3410 Project0:=Project0 and not cpCompleted; 3411 if Project0 and not cpAuto<>Project and not cpAuto then 3412 Project0:=Project; 3413 Prod0:=Prod; 4357 RW[Player].NatBuilt[integer(Data)] := 0; 4358 case integer(Data) of 4359 imGrWall: 4360 GrWallContinent[Player] := -1; 4361 imSpacePort: 4362 DestroySpacePort_TellPlayers(Player, -1); 3414 4363 end 3415 4364 end; 3416 RemoveUnit_UpdateMap(Player,Subject); 3417 end; 3418 end; 4365 inc(Flags, chImprovementSold); 4366 end 4367 end; 4368 4369 sRebuildCityImprovement, sRebuildCityImprovement - sExecute: 4370 begin 4371 OldImp := integer(Data); 4372 {$IFDEF TEXTLOG}CmdInfo := Format('RebuildCityImprovement P%d Loc%d: %d', [Player, RW[Player].City[Subject].Loc, OldImp]); {$ENDIF} 4373 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0) 4374 then 4375 result := eInvalid 4376 else 4377 begin 4378 if (OldImp < 0) or (OldImp >= nImp) or 4379 not(Imp[OldImp].Kind in [ikCommon, ikNatLocal, ikNatGlobal]) then 4380 result := eInvalid 4381 else 4382 with RW[Player].City[Subject] do 4383 if (built[OldImp] = 0) or (Project and cpImp = 0) or 4384 not(Imp[Project and cpIndex].Kind in [ikCommon, ikNatLocal, 4385 ikNatGlobal]) then 4386 result := eInvalid 4387 else if (RW[Player].Government = gAnarchy) or 4388 (Flags and chCaptured <> 0) then 4389 result := eOutOfControl 4390 else if Flags and chImprovementSold <> 0 then 4391 result := eOnlyOnce 4392 else if Command >= sExecute then 4393 begin 4394 inc(Prod, Imp[OldImp].Cost * BuildCostMod[Difficulty[Player]] 4395 div 12 * 2 div 3); 4396 Project0 := Project0 and not cpCompleted; 4397 if Project0 and not cpAuto <> Project and not cpAuto then 4398 Project0 := Project; 4399 Prod0 := Prod; 4400 built[OldImp] := 0; 4401 if Imp[OldImp].Kind in [ikNatLocal, ikNatGlobal] then 4402 begin // nat. project lost 4403 RW[Player].NatBuilt[OldImp] := 0; 4404 case OldImp of 4405 imGrWall: 4406 GrWallContinent[Player] := -1; 4407 imSpacePort: 4408 DestroySpacePort_TellPlayers(Player, -1); 4409 end 4410 end; 4411 inc(Flags, chImprovementSold); 4412 end 3419 4413 end 3420 else if Command>=sExecute then 3421 RemoveUnit_UpdateMap(Player,Subject); 3422 end 4414 end; 4415 4416 sSetCityTiles, sSetCityTiles - sExecute: 4417 begin 4418 {$IFDEF TEXTLOG}CmdInfo := Format('SetCityTiles P%d Loc%d: %x', [Player, RW[Player].City[Subject].Loc, integer(Data)]); {$ENDIF} 4419 if (Subject >= RW[Player].nCity) or (RW[Player].City[Subject].Loc < 0) 4420 then 4421 result := eInvalid 4422 else 4423 result := SetCityTiles(Player, Subject, integer(Data), 4424 Command < sExecute); 4425 end; 4426 4427 { 4428 Client Exclusive Commands 4429 ____________________________________________________________________ 4430 } 4431 else 4432 if Command >= cClientEx then 4433 begin 4434 {$IFDEF TEXTLOG}CmdInfo := Format('ClientEx%x P%d', [Command, Player]); 4435 {$ENDIF} 4436 if ProcessClientData[Player] or (Mode = moPlaying) then 4437 CallPlayer(Command, Player, Data) 4438 end 4439 else 4440 result := eUnknown; 4441 end; { case command } 4442 4443 // do not log invalid and non-relevant commands 4444 if result = eZOC_EnemySpotted then 4445 begin 4446 assert(Mode = moPlaying); 4447 CL.State := FormerCLState; 4448 IntServer(sIntDiscoverZOC, Player, 0, ZOCTile); 4449 end 4450 else if result and rEffective = 0 then 4451 if Mode < moPlaying then 4452 begin 4453 {$IFDEF TEXTLOG}CmdInfo := Format('***ERROR (%x) ', [result]) + CmdInfo; 4454 {$ENDIF} 4455 LoadOK := false; 4456 end 4457 else 4458 begin 4459 if logged then 4460 CL.State := FormerCLState; 4461 if (result < rExecuted) and (Command >= sExecute) then 4462 PutMessage(1 shl 16 + 1, Format('INVALID: %d calls %x (%d)', 4463 [Player, Command, Subject])); 3423 4464 end; 3424 4465 3425 sSetUnitHome,sSetUnitHome-sExecute: 3426 begin 3427 {$IFDEF TEXTLOG}CmdInfo:=Format('SetUnitHome P%d Mod%d Loc%d', [Player,RW[Player].Un[Subject].mix,RW[Player].Un[Subject].Loc]);{$ENDIF} 3428 if (Subject>=RW[Player].nUn) or (RW[Player].Un[Subject].Loc<0) then 3429 result:=eInvalid 3430 else 3431 begin 3432 Loc0:=RW[Player].Un[Subject].Loc; 3433 if RealMap[Loc0] and fCity=0 then result:=eInvalid 3434 else 3435 begin 3436 SearchCity(Loc0,Player,cix1); 3437 if RW[Player].City[cix1].Flags and chCaptured<>0 then 3438 result:=eViolation 3439 else if Command>=sExecute then 3440 RW[Player].Un[Subject].Home:=cix1 3441 end 3442 end 3443 end; 3444 3445 sSetSpyMission..sSetSpyMission+(nSpyMission-1) shl 4, 3446 sSetSpyMission-sExecute..sSetSpyMission-sExecute+(nSpyMission-1) shl 4: 3447 if Command>=sExecute then 3448 SpyMission:=Command shr 4 and $F; 3449 3450 sLoadUnit,sLoadUnit-sExecute: 3451 begin 3452 {$IFDEF TEXTLOG}CmdInfo:=Format('LoadUnit P%d Mod%d Loc%d', [Player,RW[Player].Un[Subject].mix,RW[Player].Un[Subject].Loc]);{$ENDIF} 3453 if (Subject>=RW[Player].nUn) or (RW[Player].Un[Subject].Loc<0) then 3454 result:=eInvalid 3455 else result:=LoadUnit(Player,Subject,Command<sExecute); 3456 end; 3457 3458 sUnloadUnit,sUnloadUnit-sExecute: 3459 begin 3460 {$IFDEF TEXTLOG}CmdInfo:=Format('UnloadUnit P%d Mod%d Loc%d', [Player,RW[Player].Un[Subject].mix,RW[Player].Un[Subject].Loc]);{$ENDIF} 3461 if (Subject>=RW[Player].nUn) or (RW[Player].Un[Subject].Loc<0) then 3462 result:=eInvalid 3463 else result:=UnloadUnit(Player,Subject,Command<sExecute) 3464 end; 3465 3466 sSelectTransport,sSelectTransport-sExecute: 3467 if (Subject>=RW[Player].nUn) or (RW[Player].Un[Subject].Loc<0) then 3468 result:=eInvalid 3469 else with RW[Player].Model[RW[Player].Un[Subject].mix] do 3470 begin 3471 if Cap[mcSeaTrans]+Cap[mcAirTrans]+Cap[mcCarrier]=0 then 3472 result:=eInvalid 3473 else if Command>=sExecute then 3474 uixSelectedTransport:=Subject; 3475 end; 3476 3477 sCreateUnit..sCreateUnit+(nPl-1) shl 4, 3478 sCreateUnit-sExecute..sCreateUnit-sExecute+(nPl-1) shl 4: 3479 if (GTestFlags and tfUncover<>0) or (Difficulty[Player]=0) then {supervisor only command} 3480 begin 3481 p1:=Command shr 4 and $f; 3482 Loc1:=integer(Data); 3483 if (Occupant[Loc1]>=0) and (p1<>Occupant[Loc1]) 3484 or (RealMap[Loc1] and fCity<>0) and (RealMap[Loc1] shr 27<>Cardinal(p1)) 3485 or (RW[p1].Model[Subject].Domain<dAir) 3486 and ((RW[p1].Model[Subject].Domain=dSea) 3487 <>(RealMap[integer(Data)] and fTerrain<fGrass)) then 3488 result:=eViolation 3489 else if Command>=sExecute then 3490 begin 3491 CreateUnit(p1,Subject); 3492 RW[p1].Un[RW[p1].nUn-1].Loc:=integer(Data); 3493 PlaceUnit(p1,RW[p1].nUn-1); 3494 UpdateUnitMap(integer(Data)); 3495 end 3496 end 3497 else result:=eInvalid; 3498 3499 sMoveUnit+(0+6*8)*16,sMoveUnit+(1+7*8)*16, 3500 sMoveUnit+(2+0*8)*16,sMoveUnit+(1+1*8)*16, 3501 sMoveUnit+(0+2*8)*16,sMoveUnit+(7+1*8)*16, 3502 sMoveUnit+(6+0*8)*16,sMoveUnit+(7+7*8)*16, 3503 sMoveUnit-sExecute+(0+6*8)*16,sMoveUnit-sExecute+(1+7*8)*16, 3504 sMoveUnit-sExecute+(2+0*8)*16,sMoveUnit-sExecute+(1+1*8)*16, 3505 sMoveUnit-sExecute+(0+2*8)*16,sMoveUnit-sExecute+(7+1*8)*16, 3506 sMoveUnit-sExecute+(6+0*8)*16,sMoveUnit-sExecute+(7+7*8)*16: 3507 begin 3508 dx:=(Command shr 4 +4) and 7-4; dy:=(Command shr 7 +4) and 7-4; 3509 {$IFDEF TEXTLOG}CmdInfo:=Format('MoveUnit P%d I%d Mod%d Loc%d (%d,%d)', [Player,Subject,RW[Player].Un[Subject].mix,RW[Player].Un[Subject].Loc,dx,dy]);{$ENDIF} 3510 if (Subject>=RW[Player].nUn) or (RW[Player].Un[Subject].Loc<0) then 3511 result:=eInvalid 3512 else result:=MoveUnit(Player,Subject,dx,dy,Command<sExecute); 3513 end; 3514 3515 { 3516 Settlers Related Commands 3517 ____________________________________________________________________ 3518 } 3519 sAddToCity, sAddToCity-sExecute: 3520 begin 3521 {$IFDEF TEXTLOG}CmdInfo:=Format('AddToCity P%d Mod%d Loc%d', [Player,RW[Player].Un[Subject].mix,RW[Player].Un[Subject].Loc]);{$ENDIF} 3522 if (Subject>=RW[Player].nUn) or (RW[Player].Un[Subject].Loc<0) then 3523 result:=eInvalid 3524 else if not (RW[Player].Model[RW[Player].Un[Subject].mix].Kind in [mkSettler,mkSlaves]) 3525 and (RW[Player].Un[Subject].Flags and unConscripts=0) then 3526 result:=eViolation 3527 else 3528 begin 3529 Loc0:=RW[Player].Un[Subject].Loc; 3530 if RealMap[Loc0] and fCity=0 then result:=eInvalid 3531 else 3532 begin 3533 SearchCity(Loc0,Player,cix1); 3534 with RW[Player].City[cix1] do 3535 if not CanCityGrow(Player,cix1) then 3536 result:=eMaxSize 3537 else if Command>=sExecute then 3538 begin {add to city} 3539 if Mode=moPlaying then 3540 SavedTiles[cix1]:=0; // save in every case 3541 if CanCityGrow(Player,cix1) then 3542 CityGrowth(Player,cix1); 3543 if (RW[Player].Model[RW[Player].Un[Subject].mix].Kind=mkSettler) 3544 and CanCityGrow(Player,cix1) then 3545 CityGrowth(Player,cix1); 3546 RemoveUnit_UpdateMap(Player,Subject); 3547 end 3548 end 3549 end 3550 end; 3551 3552 sStartJob..sStartJob+$3F0, sStartJob-sExecute..sStartJob+$3F0-sExecute: 3553 begin 3554 Loc0:=RW[Player].Un[Subject].Loc; 3555 i:=Command shr 4 and $3F; // new job 3556 {$IFDEF TEXTLOG}CmdInfo:=Format('StartJob P%d Mod%d Loc%d: %d', [Player,RW[Player].Un[Subject].mix,Loc0,i]);{$ENDIF} 3557 if (Subject>=RW[Player].nUn) or (Loc0<0) then 3558 result:=eInvalid 3559 else if i>=nJob then result:=eInvalid 3560 else 3561 begin 3562 result:=StartJob(Player,Subject,i,Command<sExecute); 3563 if result=eCity then 3564 begin // new city 3565 cix1:=RW[Player].nCity-1; 3566 AddBestCityTile(Player,cix1); 3567 if Mode=moPlaying then with RW[Player].City[cix1] do 3568 begin 3569 // SavedResourceWeights[cix1]:=ResourceWeights; 3570 SavedTiles[cix1]:=0; // save in every case 3571 end; 3572 if Mode>=moMovie then {show new city in interface modules} 3573 for p1:=0 to nPl-1 do 3574 if (1 shl p1 and GWatching<>0) and (p1<>Player) 3575 and (ObserveLevel[Loc0] and (3 shl (2*p1))>0) then 3576 CallPlayer(cShowCityChanged,p1,Loc0); 3577 end 3578 end; 3579 end; 3580 3581 { 3582 City Related Commands 3583 ____________________________________________________________________ 3584 } 3585 sSetCityProject,sSetCityProject-sExecute: 3586 begin 3587 NewProject:=integer(Data) and not cpAuto; 3588 {$IFDEF TEXTLOG}CmdInfo:=Format('SetCityProject P%d Loc%d: %d', [Player,RW[Player].City[Subject].Loc,NewProject]);{$ENDIF} 3589 if (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 3590 result:=eInvalid 3591 else with RW[Player].City[Subject] do 3592 begin 3593 if NewProject=Project then result:=eNotChanged 3594 else 3595 begin 3596 pt0:=ProjectType(Project0); 3597 pt1:=ProjectType(NewProject); 3598 if NewProject and cpImp=0 then 3599 begin 3600 if NewProject and cpIndex>=RW[Player].nModel then 3601 result:=eInvalid 3602 else if (NewProject and cpConscripts<>0) 3603 and not ((RW[Player].Tech[adConscription]>=tsApplicable) 3604 and (RW[Player].Model[NewProject and cpIndex].Domain=dGround) 3605 and (RW[Player].Model[NewProject and cpIndex].Kind<mkScout)) then 3606 result:=eViolation 3607 // else if (RW[Player].Model[NewProject and cpIndex].Kind=mkSlaves) 3608 // and (GWonder[woPyramids].EffectiveOwner<>Player) then 3609 // result:=eNoPreq 3610 end 3611 else if NewProject and cpIndex>=nImp then 3612 result:=eInvalid 3613 else 3614 begin 3615 Preq:=Imp[NewProject and cpIndex].Preq; 3616 for i:=0 to nImpReplacement-1 do 3617 if (ImpReplacement[i].OldImp=NewProject and cpIndex) 3618 and (Built[ImpReplacement[i].NewImp]>0) then 3619 result:=eObsolete; 3620 if result=eObsolete then 3621 else if Preq=preNA then result:=eInvalid 3622 else if (Preq>=0) and (RW[Player].Tech[Preq]<tsApplicable) then 3623 result:=eNoPreq 3624 else if Built[NewProject and cpIndex]>0 then result:=eInvalid 3625 else if (NewProject and cpIndex<28) 3626 and (GWonder[NewProject and cpIndex].CityID<>-1) then 3627 result:=eViolation // wonder already exists 3628 else if (NewProject and cpIndex=imSpacePort) 3629 and (RW[Player].NatBuilt[imSpacePort]>0) then 3630 result:=eViolation // space port already exists 3631 else if (NewProject=cpImp+imBank) and (Built[imMarket]=0) 3632 or (NewProject=cpImp+imUniversity) and (Built[imLibrary]=0) 3633 or (NewProject=cpImp+imResLab) and (Built[imUniversity]=0) 3634 or (NewProject=cpImp+imMfgPlant) and (Built[imFactory]=0) then 3635 result:=eNoPreq; 3636 case NewProject-cpImp of 3637 woLighthouse,woMagellan,imCoastalFort,imHarbor,imPlatform: 3638 begin {city at ocean?} 3639 Preq:=0; 3640 V8_to_Loc(Loc,Adjacent); 3641 for V8:=0 to 7 do 3642 begin 3643 Loc1:=Adjacent[V8]; 3644 if (Loc1>=0) and (Loc1<MapSize) 3645 and (RealMap[Loc1] and fTerrain=fShore) then 3646 inc(Preq); 3647 end; 3648 if Preq=0 then result:=eNoPreq; 3649 end; 3650 woHoover,imHydro: 3651 begin {city at river or mountains?} 3652 Preq:=0; 3653 V8_to_Loc(Loc,Adjacent); 3654 for V8:=0 to 7 do 3655 begin 3656 Loc1:=Adjacent[V8]; 3657 if (Loc1>=0) and (Loc1<MapSize) 3658 and ((RealMap[Loc1] and fTerrain=fMountains) 3659 or (RealMap[Loc1] and fRiver<>0)) then inc(Preq); 3660 end; 3661 if Preq=0 then result:=eNoPreq; 3662 end; 3663 woMIR,imShipComp,imShipPow,imShipHab: 3664 if RW[Player].NatBuilt[imSpacePort]=0 then result:=eNoPreq; 3665 end; 3666 if (GTestFlags and tfNoRareNeed=0) 3667 and (Imp[NewProject and cpIndex].Kind=ikShipPart) then 3668 if RW[Player].Tech[adMassProduction]<tsApplicable then result:=eNoPreq 3669 else 3670 begin // check for rare resources 3671 if NewProject and cpIndex=imShipComp then j:=1 3672 else if NewProject and cpIndex=imShipPow then j:=2 3673 else {if NewProject and cpIndex=imShipHab then} j:=3; 3674 // j = rare resource required 3675 Preq:=0; 3676 V21_to_Loc(Loc,Radius); 3677 for V21:=1 to 26 do 3678 begin 3679 Loc1:=Radius[V21]; 3680 if (Loc1>=0) and (Loc1<MapSize) 3681 and (RealMap[Loc1] shr 25 and 3=Cardinal(j)) then 3682 inc(Preq); 3683 end; 3684 if Preq=0 then result:=eNoPreq; 3685 end 3686 end; 3687 3688 if (Command>=sExecute) and (result>=rExecuted) then 3689 begin 3690 if pt0<>ptSelect then 3691 if NewProject and (cpImp or cpIndex)=Project0 and (cpImp or cpIndex) then 3692 Prod:=Prod0 3693 else if (pt1=ptTrGoods) or (pt1=ptShip) or (pt1<>pt0) and (pt0<>ptCaravan) then 3694 begin 3695 inc(RW[Player].Money,Prod0); 3696 Prod:=0; 3697 Prod0:=0; 3698 Project0:=cpImp+imTrGoods 3699 end 3700 else Prod:=Prod0*2 div 3; 3701 Project:=NewProject 3702 end 3703 end 3704 end 3705 end; 3706 3707 sBuyCityProject,sBuyCityProject-sExecute: 3708 begin 3709 {$IFDEF TEXTLOG}CmdInfo:=Format('BuyCityProject P%d Loc%d', [Player,RW[Player].City[Subject].Loc]);{$ENDIF} 3710 if (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 3711 result:=eInvalid 3712 else with RW[Player].City[Subject] do 3713 if (RW[Player].Government=gAnarchy) or (Flags and chCaptured<>0) then 3714 result:=eOutOfControl 3715 else if (Project and cpImp<>0) and ((Project and cpIndex=imTrGoods) 3716 or (Imp[Project and cpIndex].Kind=ikShipPart)) then 3717 result:=eInvalid // don't buy colony ship 3718 else 3719 begin 3720 CityReport.HypoTiles:=-1; 3721 CityReport.HypoTax:=-1; 3722 CityReport.HypoLux:=-1; 3723 GetCityReport(Player,Subject,CityReport); 3724 Cost:=CityReport.ProdCost; 3725 NextProd:=CityReport.ProdRep-CityReport.Support; 3726 if (CityReport.Working-CityReport.Happy>Size shr 1) or (NextProd<0) then // !!! change to new style disorder 3727 NextProd:=0; 3728 Cost:=Cost-Prod-NextProd; 3729 if (GWonder[woMich].EffectiveOwner=Player) and (Project and cpImp<>0) then 3730 Cost:=Cost*2 3731 else Cost:=Cost*4; 3732 if Cost<=0 then result:=eNotChanged 3733 else if Cost>RW[Player].Money then result:=eViolation 3734 else if Command>=sExecute then 3735 IntServer(sIntBuyMaterial, Player, Subject, Cost); 3736 // need to save material/cost because city tiles are not correct 3737 // when loading 3738 end; 3739 end; 3740 3741 sSellCityProject,sSellCityProject-sExecute: 3742 begin 3743 {$IFDEF TEXTLOG}CmdInfo:=Format('SellCityProject P%d Loc%d', [Player,RW[Player].City[Subject].Loc]);{$ENDIF} 3744 if (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 3745 result:=eInvalid 3746 else if Command>=sExecute then 3747 with RW[Player].City[Subject] do 3748 begin inc(RW[Player].Money,Prod0); Prod:=0; Prod0:=0; end; 3749 end; 3750 3751 sSellCityImprovement,sSellCityImprovement-sExecute: 3752 begin 3753 {$IFDEF TEXTLOG}CmdInfo:=Format('SellCityImprovement P%d Loc%d: %d', [Player,RW[Player].City[Subject].Loc,integer(Data)]);{$ENDIF} 3754 if (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 3755 result:=eInvalid 3756 else with RW[Player].City[Subject] do 3757 if Built[integer(Data)]=0 then result:=eInvalid 3758 else if (RW[Player].Government=gAnarchy) or (Flags and chCaptured<>0) then 3759 result:=eOutOfControl 3760 else if Flags and chImprovementSold<>0 then result:=eOnlyOnce 3761 else if Command>=sExecute then 3762 begin 3763 inc(RW[Player].Money, 3764 Imp[integer(Data)].Cost*BuildCostMod[Difficulty[Player]] div 12); 3765 Built[integer(Data)]:=0; 3766 if Imp[integer(Data)].Kind in [ikNatLocal,ikNatGlobal] then 3767 begin 3768 RW[Player].NatBuilt[integer(Data)]:=0; 3769 case integer(Data) of 3770 imGrWall: GrWallContinent[Player]:=-1; 3771 imSpacePort: DestroySpacePort_TellPlayers(Player,-1); 3772 end 3773 end; 3774 inc(Flags,chImprovementSold); 3775 end 3776 end; 3777 3778 sRebuildCityImprovement,sRebuildCityImprovement-sExecute: 3779 begin 3780 OldImp:=integer(Data); 3781 {$IFDEF TEXTLOG}CmdInfo:=Format('RebuildCityImprovement P%d Loc%d: %d', [Player,RW[Player].City[Subject].Loc,OldImp]);{$ENDIF} 3782 if (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 3783 result:=eInvalid 3784 else 3785 begin 3786 if (OldImp<0) or (OldImp>=nImp) 3787 or not (Imp[OldImp].Kind in [ikCommon,ikNatLocal,ikNatGlobal]) then 3788 result:=eInvalid 3789 else with RW[Player].City[Subject] do 3790 if (Built[OldImp]=0) or (Project and cpImp=0) 3791 or not (Imp[Project and cpIndex].Kind in [ikCommon,ikNatLocal,ikNatGlobal]) then 3792 result:=eInvalid 3793 else if (RW[Player].Government=gAnarchy) or (Flags and chCaptured<>0) then 3794 result:=eOutOfControl 3795 else if Flags and chImprovementSold<>0 then result:=eOnlyOnce 3796 else if Command>=sExecute then 3797 begin 3798 inc(Prod,Imp[OldImp].Cost 3799 *BuildCostMod[Difficulty[Player]] div 12 *2 div 3); 3800 Project0:=Project0 and not cpCompleted; 3801 if Project0 and not cpAuto<>Project and not cpAuto then 3802 Project0:=Project; 3803 Prod0:=Prod; 3804 Built[OldImp]:=0; 3805 if Imp[OldImp].Kind in [ikNatLocal,ikNatGlobal] then 3806 begin // nat. project lost 3807 RW[Player].NatBuilt[OldImp]:=0; 3808 case OldImp of 3809 imGrWall: GrWallContinent[Player]:=-1; 3810 imSpacePort: DestroySpacePort_TellPlayers(Player,-1); 3811 end 3812 end; 3813 inc(Flags,chImprovementSold); 3814 end 3815 end 3816 end; 3817 3818 sSetCityTiles, sSetCityTiles-sExecute: 3819 begin 3820 {$IFDEF TEXTLOG}CmdInfo:=Format('SetCityTiles P%d Loc%d: %x', [Player,RW[Player].City[Subject].Loc,integer(data)]);{$ENDIF} 3821 if (Subject>=RW[Player].nCity) or (RW[Player].City[Subject].Loc<0) then 3822 result:=eInvalid 3823 else result:=SetCityTiles(Player, Subject, integer(Data), Command<sExecute); 3824 end; 3825 3826 { 3827 Client Exclusive Commands 3828 ____________________________________________________________________ 3829 } 3830 else 3831 if Command>=cClientEx then 3832 begin 3833 {$IFDEF TEXTLOG}CmdInfo:=Format('ClientEx%x P%d', [Command,Player]);{$ENDIF} 3834 if ProcessClientData[Player] or (Mode=moPlaying) then 3835 CallPlayer(Command,Player,Data) 3836 end 3837 else result:=eUnknown; 3838 end;{case command} 3839 3840 // do not log invalid and non-relevant commands 3841 if result=eZOC_EnemySpotted then 3842 begin 3843 assert(Mode=moPlaying); 3844 CL.State:=FormerCLState; 3845 IntServer(sIntDiscoverZOC,Player,0,ZOCTile); 3846 end 3847 else if result and rEffective=0 then 3848 if Mode<moPlaying then 3849 begin 3850 {$IFDEF TEXTLOG}CmdInfo:=Format('***ERROR (%x) ',[result])+CmdInfo;{$ENDIF} 3851 LoadOK:=false; 3852 end 3853 else 3854 begin 3855 if logged then CL.State:=FormerCLState; 3856 if (result<rExecuted) and (Command>=sExecute) then 3857 PutMessage(1 shl 16+1, Format('INVALID: %d calls %x (%d)', 3858 [Player,Command,Subject])); 3859 end; 3860 3861 if (Command and (cClientEx or sExecute or sctMask)=sExecute or sctEndClient) 3862 and (result>=rExecuted) then LastEndClientCommand:=Command; 3863 {$IFOPT O-}dec(nHandoverStack,2);{$ENDIF} 3864 end;{<<<server} 3865 4466 if (Command and (cClientEx or sExecute or sctMask) = sExecute or sctEndClient) 4467 and (result >= rExecuted) then 4468 LastEndClientCommand := Command; 4469 {$IFOPT O-}dec(nHandoverStack, 2); {$ENDIF} 4470 end; { <<<server } 3866 4471 3867 4472 initialization 4473 3868 4474 QueryPerformanceFrequency(PerfFreq); 3869 FindFirst(ParamStr(0), $21,ExeInfo);3870 3871 {$IFOPT O-}nHandoverStack :=0;{$ENDIF}4475 FindFirst(ParamStr(0), $21, ExeInfo); 4476 4477 {$IFOPT O-}nHandoverStack := 0; {$ENDIF} 3872 4478 3873 4479 end. 3874 -
trunk/Inp.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Inp; 4 3 … … 6 5 7 6 uses 8 ScreenTools, Messg,7 ScreenTools, Messg, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 36 35 procedure TInputDlg.FormCreate(Sender: TObject); 37 36 begin 38 Canvas.Font.Assign(UniFont[ftNormal]);39 Canvas.Brush.Style:=bsClear;40 TitleHeight:=ClientHeight;41 InitButtons();42 Center:=true37 Canvas.Font.Assign(UniFont[ftNormal]); 38 Canvas.Brush.Style := bsClear; 39 TitleHeight := ClientHeight; 40 InitButtons(); 41 Center := true 43 42 end; 44 43 45 44 procedure TInputDlg.FormPaint(Sender: TObject); 46 45 begin 47 PaintBackground(self,3,3,ClientWidth-6,ClientHeight-6); 48 Frame(Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 49 Frame(Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight, 50 MainTexture.clBevelShade); 51 Frame(Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight, 52 MainTexture.clBevelShade); 53 EditFrame(Canvas,EInput.BoundsRect,MainTexture); 54 BtnFrame(Canvas,OKBtn.BoundsRect,MainTexture); 55 RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,Caption)) div 2,9,Caption); 56 {Corner(canvas,1,1,0,MainTexture); 57 Corner(canvas,ClientWidth-9,1,1,MainTexture); 58 Corner(canvas,1,ClientHeight-9,2,MainTexture); 59 Corner(canvas,ClientWidth-9,ClientHeight-9,3,MainTexture);} 46 PaintBackground(self, 3, 3, ClientWidth - 6, ClientHeight - 6); 47 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 48 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 49 MainTexture.clBevelLight, MainTexture.clBevelShade); 50 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 51 MainTexture.clBevelLight, MainTexture.clBevelShade); 52 EditFrame(Canvas, EInput.BoundsRect, MainTexture); 53 BtnFrame(Canvas, OKBtn.BoundsRect, MainTexture); 54 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Caption)) div 2, 55 9, Caption); 56 { Corner(canvas,1,1,0,MainTexture); 57 Corner(canvas,ClientWidth-9,1,1,MainTexture); 58 Corner(canvas,1,ClientHeight-9,2,MainTexture); 59 Corner(canvas,ClientWidth-9,ClientHeight-9,3,MainTexture); } 60 60 end; 61 61 62 62 procedure TInputDlg.OKBtnClick(Sender: TObject); 63 63 begin 64 if EInput.Text='' then ModalResult:=mrCancel 65 else ModalResult:=mrOK 64 if EInput.Text = '' then 65 ModalResult := mrCancel 66 else 67 ModalResult := mrOK 66 68 end; 67 69 68 70 procedure TInputDlg.EInputKeyPress(Sender: TObject; var Key: Char); 69 71 begin 70 if (Key=#13) and (EInput.Text<>'') then begin Key:=#0 ; ModalResult:=mrOK end 71 else if Key=#27 then begin Key:=#0; ModalResult:=mrCancel end 72 if (Key = #13) and (EInput.Text <> '') then 73 begin 74 Key := #0; 75 ModalResult := mrOK 76 end 77 else if Key = #27 then 78 begin 79 Key := #0; 80 ModalResult := mrCancel 81 end 72 82 end; 73 83 74 84 procedure TInputDlg.FormShow(Sender: TObject); 75 85 begin 76 OKBtn.Caption:=Phrases.Lookup('BTN_OK'); 77 EInput.Font.Color:=MainTexture.clMark; 78 EInput.SelStart:=0; 79 EInput.SelLength:=Length(EInput.Text); 80 if Center then CenterToRect(Rect(0,0,Screen.Width,Screen.Height)); 86 OKBtn.Caption := Phrases.Lookup('BTN_OK'); 87 EInput.Font.Color := MainTexture.clMark; 88 EInput.SelStart := 0; 89 EInput.SelLength := Length(EInput.Text); 90 if Center then 91 CenterToRect(Rect(0, 0, Screen.Width, Screen.Height)); 81 92 end; 82 93 83 94 procedure TInputDlg.FormClose(Sender: TObject; var Action: TCloseAction); 84 95 begin 85 Center:=true96 Center := true 86 97 end; 87 98 88 99 procedure TInputDlg.CenterToRect(Rect: TRect); 89 100 begin 90 Center:=false;91 Left:=Rect.Left+(Rect.Right-Rect.Left-Width) div 2;92 Top:=Rect.Top+(Rect.Bottom-Rect.Top-Height) div 2;101 Center := false; 102 Left := Rect.Left + (Rect.Right - Rect.Left - Width) div 2; 103 Top := Rect.Top + (Rect.Bottom - Rect.Top - Height) div 2; 93 104 end; 94 105 95 106 end. 96 -
trunk/Integrated.dpr
r2 r6 1 1 {$INCLUDE switches} 2 3 2 program cevo; 4 3 … … 13 12 CityProcessing in 'CityProcessing.pas', 14 13 UnitProcessing in 'UnitProcessing.pas', 15 Direct in 'Direct.pas' {DirectDlg} ,14 Direct in 'Direct.pas' {DirectDlg} , 16 15 ScreenTools in 'ScreenTools.pas', 17 Start in 'Start.pas' {StartDlg} ,18 Messg in 'Messg.pas' {MessgDlg} ,19 Inp in 'Inp.pas' {InputDlg} ,20 Back in 'Back.pas' {Background} ,21 Log in 'Log.pas' {LogDlg} ,16 Start in 'Start.pas' {StartDlg} , 17 Messg in 'Messg.pas' {MessgDlg} , 18 Inp in 'Inp.pas' {InputDlg} , 19 Back in 'Back.pas' {Background} , 20 Log in 'Log.pas' {LogDlg} , 22 21 PVSB in 'LocalPlayer\PVSB.pas', 23 22 LocalPlayer in 'LocalPlayer\LocalPlayer.pas', … … 26 25 Tribes in 'LocalPlayer\Tribes.pas', 27 26 IsoEngine in 'LocalPlayer\IsoEngine.pas', 28 Term in 'LocalPlayer\Term.pas' {MainScreen} ,29 MessgEx in 'LocalPlayer\MessgEx.pas' {MessgExDlg} ,27 Term in 'LocalPlayer\Term.pas' {MainScreen} , 28 MessgEx in 'LocalPlayer\MessgEx.pas' {MessgExDlg} , 30 29 BaseWin in 'LocalPlayer\BaseWin.pas', 31 Help in 'LocalPlayer\Help.pas' {HelpDlg} ,32 Select in 'LocalPlayer\Select.pas' {ListDlg} ,33 CityScreen in 'LocalPlayer\CityScreen.pas' {CityDlg} ,34 UnitStat in 'LocalPlayer\UnitStat.pas' {UnitStatDlg} ,35 Draft in 'LocalPlayer\Draft.pas' {DraftDlg} ,36 NatStat in 'LocalPlayer\NatStat.pas' {NatStatDlg} ,37 Diagram in 'LocalPlayer\Diagram.pas' {DiaDlg} ,38 Wonders in 'LocalPlayer\Wonders.pas' {WonderDlg} ,39 Nego in 'LocalPlayer\Nego.pas' {NegoDlg} ,40 CityType in 'LocalPlayer\CityType.pas' {CityTypeDlg} ,41 Enhance in 'LocalPlayer\Enhance.pas' {EnhanceDlg} ,42 NoTerm in 'NoTerm.pas' {NoTermDlg} ,43 Sound in 'Sound.pas' {SoundPlayer} ,44 Battle in 'LocalPlayer\Battle.pas' {BattleDlg} ,45 Rates in 'LocalPlayer\Rates.pas' {RatesDlg} ,30 Help in 'LocalPlayer\Help.pas' {HelpDlg} , 31 Select in 'LocalPlayer\Select.pas' {ListDlg} , 32 CityScreen in 'LocalPlayer\CityScreen.pas' {CityDlg} , 33 UnitStat in 'LocalPlayer\UnitStat.pas' {UnitStatDlg} , 34 Draft in 'LocalPlayer\Draft.pas' {DraftDlg} , 35 NatStat in 'LocalPlayer\NatStat.pas' {NatStatDlg} , 36 Diagram in 'LocalPlayer\Diagram.pas' {DiaDlg} , 37 Wonders in 'LocalPlayer\Wonders.pas' {WonderDlg} , 38 Nego in 'LocalPlayer\Nego.pas' {NegoDlg} , 39 CityType in 'LocalPlayer\CityType.pas' {CityTypeDlg} , 40 Enhance in 'LocalPlayer\Enhance.pas' {EnhanceDlg} , 41 NoTerm in 'NoTerm.pas' {NoTermDlg} , 42 Sound in 'Sound.pas' {SoundPlayer} , 43 Battle in 'LocalPlayer\Battle.pas' {BattleDlg} , 44 Rates in 'LocalPlayer\Rates.pas' {RatesDlg} , 46 45 TechTree in 'LocalPlayer\TechTree.pas' {TechTreeDlg}; 47 46 … … 49 48 50 49 begin 51 DotNetClient :=nil;50 DotNetClient := nil; 52 51 Application.Initialize; 53 52 Application.Title := 'C-evo'; … … 59 58 Application.CreateForm(TLogDlg, LogDlg); 60 59 Application.Run; 60 61 61 end. 62 -
trunk/Integrated.dproj
r3 r6 230 230 <Platform value="Win32">True</Platform> 231 231 </Platforms> 232 <Deployment Version="2"> 233 <DeployFile LocalName="Win32\Debug\Integrated.exe" Configuration="Debug" Class="ProjectOutput"> 234 <Platform Name="Win32"> 235 <RemoteName>Integrated.exe</RemoteName> 236 <Overwrite>true</Overwrite> 237 </Platform> 238 </DeployFile> 239 <DeployClass Name="DependencyModule"> 240 <Platform Name="Win32"> 241 <Operation>0</Operation> 242 <Extensions>.dll;.bpl</Extensions> 243 </Platform> 244 <Platform Name="iOSDevice64"> 245 <Operation>1</Operation> 246 <Extensions>.dylib</Extensions> 247 </Platform> 248 <Platform Name="OSX32"> 249 <RemoteDir>Contents\MacOS</RemoteDir> 250 <Operation>1</Operation> 251 <Extensions>.dylib</Extensions> 252 </Platform> 253 <Platform Name="iOSDevice32"> 254 <Operation>1</Operation> 255 <Extensions>.dylib</Extensions> 256 </Platform> 257 <Platform Name="iOSSimulator"> 258 <Operation>1</Operation> 259 <Extensions>.dylib</Extensions> 260 </Platform> 261 </DeployClass> 262 <DeployClass Name="ProjectOSXResource"> 263 <Platform Name="OSX32"> 264 <RemoteDir>Contents\Resources</RemoteDir> 265 <Operation>1</Operation> 266 </Platform> 267 </DeployClass> 268 <DeployClass Name="AndroidClassesDexFile"> 269 <Platform Name="Android"> 270 <RemoteDir>classes</RemoteDir> 271 <Operation>1</Operation> 272 </Platform> 273 </DeployClass> 274 <DeployClass Name="AdditionalDebugSymbols"> 275 <Platform Name="Win32"> 276 <RemoteDir>Contents\MacOS</RemoteDir> 277 <Operation>0</Operation> 278 </Platform> 279 <Platform Name="iOSSimulator"> 280 <Operation>1</Operation> 281 </Platform> 282 <Platform Name="OSX32"> 283 <RemoteDir>Contents\MacOS</RemoteDir> 284 <Operation>1</Operation> 285 </Platform> 286 </DeployClass> 287 <DeployClass Name="iPad_Launch768"> 288 <Platform Name="iOSSimulator"> 289 <Operation>1</Operation> 290 </Platform> 291 <Platform Name="iOSDevice64"> 292 <Operation>1</Operation> 293 </Platform> 294 <Platform Name="iOSDevice32"> 295 <Operation>1</Operation> 296 </Platform> 297 </DeployClass> 298 <DeployClass Name="Android_LauncherIcon144"> 299 <Platform Name="Android"> 300 <RemoteDir>res\drawable-xxhdpi</RemoteDir> 301 <Operation>1</Operation> 302 </Platform> 303 </DeployClass> 304 <DeployClass Name="AndroidLibnativeMipsFile"> 305 <Platform Name="Android"> 306 <RemoteDir>library\lib\mips</RemoteDir> 307 <Operation>1</Operation> 308 </Platform> 309 </DeployClass> 310 <DeployClass Required="true" Name="ProjectOutput"> 311 <Platform Name="Win32"> 312 <Operation>0</Operation> 313 </Platform> 314 <Platform Name="iOSDevice64"> 315 <Operation>1</Operation> 316 </Platform> 317 <Platform Name="OSX32"> 318 <RemoteDir>Contents\MacOS</RemoteDir> 319 <Operation>1</Operation> 320 </Platform> 321 <Platform Name="iOSDevice32"> 322 <Operation>1</Operation> 323 </Platform> 324 <Platform Name="Android"> 325 <RemoteDir>library\lib\armeabi-v7a</RemoteDir> 326 <Operation>1</Operation> 327 </Platform> 328 <Platform Name="iOSSimulator"> 329 <Operation>1</Operation> 330 </Platform> 331 </DeployClass> 332 <DeployClass Name="DependencyFramework"> 333 <Platform Name="Win32"> 334 <Operation>0</Operation> 335 </Platform> 336 <Platform Name="OSX32"> 337 <RemoteDir>Contents\MacOS</RemoteDir> 338 <Operation>1</Operation> 339 <Extensions>.framework</Extensions> 340 </Platform> 341 </DeployClass> 342 <DeployClass Name="iPhone_Launch640"> 343 <Platform Name="iOSSimulator"> 344 <Operation>1</Operation> 345 </Platform> 346 <Platform Name="iOSDevice64"> 347 <Operation>1</Operation> 348 </Platform> 349 <Platform Name="iOSDevice32"> 350 <Operation>1</Operation> 351 </Platform> 352 </DeployClass> 353 <DeployClass Name="iPad_Launch1024"> 354 <Platform Name="iOSSimulator"> 355 <Operation>1</Operation> 356 </Platform> 357 <Platform Name="iOSDevice64"> 358 <Operation>1</Operation> 359 </Platform> 360 <Platform Name="iOSDevice32"> 361 <Operation>1</Operation> 362 </Platform> 363 </DeployClass> 364 <DeployClass Name="ProjectiOSDeviceDebug"> 365 <Platform Name="iOSDevice64"> 366 <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir> 367 <Operation>1</Operation> 368 </Platform> 369 <Platform Name="iOSDevice32"> 370 <RemoteDir>..\$(PROJECTNAME).app.dSYM\Contents\Resources\DWARF</RemoteDir> 371 <Operation>1</Operation> 372 </Platform> 373 </DeployClass> 374 <DeployClass Name="AndroidLibnativeX86File"> 375 <Platform Name="Android"> 376 <RemoteDir>library\lib\x86</RemoteDir> 377 <Operation>1</Operation> 378 </Platform> 379 </DeployClass> 380 <DeployClass Name="iPhone_Launch320"> 381 <Platform Name="iOSSimulator"> 382 <Operation>1</Operation> 383 </Platform> 384 <Platform Name="iOSDevice64"> 385 <Operation>1</Operation> 386 </Platform> 387 <Platform Name="iOSDevice32"> 388 <Operation>1</Operation> 389 </Platform> 390 </DeployClass> 391 <DeployClass Name="ProjectiOSInfoPList"> 392 <Platform Name="iOSSimulator"> 393 <Operation>1</Operation> 394 </Platform> 395 <Platform Name="iOSDevice64"> 396 <Operation>1</Operation> 397 </Platform> 398 <Platform Name="iOSDevice32"> 399 <Operation>1</Operation> 400 </Platform> 401 </DeployClass> 402 <DeployClass Name="AndroidLibnativeArmeabiFile"> 403 <Platform Name="Android"> 404 <RemoteDir>library\lib\armeabi</RemoteDir> 405 <Operation>1</Operation> 406 </Platform> 407 </DeployClass> 408 <DeployClass Name="DebugSymbols"> 409 <Platform Name="Win32"> 410 <Operation>0</Operation> 411 </Platform> 412 <Platform Name="iOSSimulator"> 413 <Operation>1</Operation> 414 </Platform> 415 <Platform Name="OSX32"> 416 <RemoteDir>Contents\MacOS</RemoteDir> 417 <Operation>1</Operation> 418 </Platform> 419 </DeployClass> 420 <DeployClass Name="iPad_Launch1536"> 421 <Platform Name="iOSSimulator"> 422 <Operation>1</Operation> 423 </Platform> 424 <Platform Name="iOSDevice64"> 425 <Operation>1</Operation> 426 </Platform> 427 <Platform Name="iOSDevice32"> 428 <Operation>1</Operation> 429 </Platform> 430 </DeployClass> 431 <DeployClass Name="Android_SplashImage470"> 432 <Platform Name="Android"> 433 <RemoteDir>res\drawable-normal</RemoteDir> 434 <Operation>1</Operation> 435 </Platform> 436 </DeployClass> 437 <DeployClass Name="Android_LauncherIcon96"> 438 <Platform Name="Android"> 439 <RemoteDir>res\drawable-xhdpi</RemoteDir> 440 <Operation>1</Operation> 441 </Platform> 442 </DeployClass> 443 <DeployClass Name="Android_SplashImage640"> 444 <Platform Name="Android"> 445 <RemoteDir>res\drawable-large</RemoteDir> 446 <Operation>1</Operation> 447 </Platform> 448 </DeployClass> 449 <DeployClass Name="iPhone_Launch640x1136"> 450 <Platform Name="iOSSimulator"> 451 <Operation>1</Operation> 452 </Platform> 453 <Platform Name="iOSDevice64"> 454 <Operation>1</Operation> 455 </Platform> 456 <Platform Name="iOSDevice32"> 457 <Operation>1</Operation> 458 </Platform> 459 </DeployClass> 460 <DeployClass Name="ProjectiOSEntitlements"> 461 <Platform Name="iOSDevice64"> 462 <RemoteDir>../</RemoteDir> 463 <Operation>1</Operation> 464 </Platform> 465 <Platform Name="iOSDevice32"> 466 <RemoteDir>../</RemoteDir> 467 <Operation>1</Operation> 468 </Platform> 469 </DeployClass> 470 <DeployClass Name="Android_LauncherIcon72"> 471 <Platform Name="Android"> 472 <RemoteDir>res\drawable-hdpi</RemoteDir> 473 <Operation>1</Operation> 474 </Platform> 475 </DeployClass> 476 <DeployClass Name="AndroidGDBServer"> 477 <Platform Name="Android"> 478 <RemoteDir>library\lib\armeabi-v7a</RemoteDir> 479 <Operation>1</Operation> 480 </Platform> 481 </DeployClass> 482 <DeployClass Name="ProjectOSXInfoPList"> 483 <Platform Name="OSX32"> 484 <RemoteDir>Contents</RemoteDir> 485 <Operation>1</Operation> 486 </Platform> 487 </DeployClass> 488 <DeployClass Name="ProjectOSXEntitlements"> 489 <Platform Name="OSX32"> 490 <RemoteDir>../</RemoteDir> 491 <Operation>1</Operation> 492 </Platform> 493 </DeployClass> 494 <DeployClass Name="iPad_Launch2048"> 495 <Platform Name="iOSSimulator"> 496 <Operation>1</Operation> 497 </Platform> 498 <Platform Name="iOSDevice64"> 499 <Operation>1</Operation> 500 </Platform> 501 <Platform Name="iOSDevice32"> 502 <Operation>1</Operation> 503 </Platform> 504 </DeployClass> 505 <DeployClass Name="AndroidSplashStyles"> 506 <Platform Name="Android"> 507 <RemoteDir>res\values</RemoteDir> 508 <Operation>1</Operation> 509 </Platform> 510 </DeployClass> 511 <DeployClass Name="Android_SplashImage426"> 512 <Platform Name="Android"> 513 <RemoteDir>res\drawable-small</RemoteDir> 514 <Operation>1</Operation> 515 </Platform> 516 </DeployClass> 517 <DeployClass Name="AndroidSplashImageDef"> 518 <Platform Name="Android"> 519 <RemoteDir>res\drawable</RemoteDir> 520 <Operation>1</Operation> 521 </Platform> 522 </DeployClass> 523 <DeployClass Name="ProjectiOSResource"> 524 <Platform Name="iOSSimulator"> 525 <Operation>1</Operation> 526 </Platform> 527 <Platform Name="iOSDevice64"> 528 <Operation>1</Operation> 529 </Platform> 530 <Platform Name="iOSDevice32"> 531 <Operation>1</Operation> 532 </Platform> 533 </DeployClass> 534 <DeployClass Name="ProjectAndroidManifest"> 535 <Platform Name="Android"> 536 <Operation>1</Operation> 537 </Platform> 538 </DeployClass> 539 <DeployClass Name="Android_DefaultAppIcon"> 540 <Platform Name="Android"> 541 <RemoteDir>res\drawable</RemoteDir> 542 <Operation>1</Operation> 543 </Platform> 544 </DeployClass> 545 <DeployClass Name="File"> 546 <Platform Name="Win32"> 547 <Operation>0</Operation> 548 </Platform> 549 <Platform Name="iOSDevice64"> 550 <Operation>0</Operation> 551 </Platform> 552 <Platform Name="OSX32"> 553 <RemoteDir>Contents\Resources\StartUp\</RemoteDir> 554 <Operation>0</Operation> 555 </Platform> 556 <Platform Name="iOSDevice32"> 557 <Operation>0</Operation> 558 </Platform> 559 <Platform Name="Android"> 560 <Operation>0</Operation> 561 </Platform> 562 <Platform Name="iOSSimulator"> 563 <Operation>0</Operation> 564 </Platform> 565 </DeployClass> 566 <DeployClass Name="AndroidServiceOutput"> 567 <Platform Name="Android"> 568 <RemoteDir>library\lib\armeabi-v7a</RemoteDir> 569 <Operation>1</Operation> 570 </Platform> 571 </DeployClass> 572 <DeployClass Required="true" Name="DependencyPackage"> 573 <Platform Name="Win32"> 574 <Operation>0</Operation> 575 <Extensions>.bpl</Extensions> 576 </Platform> 577 <Platform Name="iOSDevice64"> 578 <Operation>1</Operation> 579 <Extensions>.dylib</Extensions> 580 </Platform> 581 <Platform Name="OSX32"> 582 <RemoteDir>Contents\MacOS</RemoteDir> 583 <Operation>1</Operation> 584 <Extensions>.dylib</Extensions> 585 </Platform> 586 <Platform Name="iOSDevice32"> 587 <Operation>1</Operation> 588 <Extensions>.dylib</Extensions> 589 </Platform> 590 <Platform Name="iOSSimulator"> 591 <Operation>1</Operation> 592 <Extensions>.dylib</Extensions> 593 </Platform> 594 </DeployClass> 595 <DeployClass Name="Android_LauncherIcon48"> 596 <Platform Name="Android"> 597 <RemoteDir>res\drawable-mdpi</RemoteDir> 598 <Operation>1</Operation> 599 </Platform> 600 </DeployClass> 601 <DeployClass Name="Android_SplashImage960"> 602 <Platform Name="Android"> 603 <RemoteDir>res\drawable-xlarge</RemoteDir> 604 <Operation>1</Operation> 605 </Platform> 606 </DeployClass> 607 <DeployClass Name="Android_LauncherIcon36"> 608 <Platform Name="Android"> 609 <RemoteDir>res\drawable-ldpi</RemoteDir> 610 <Operation>1</Operation> 611 </Platform> 612 </DeployClass> 613 <DeployClass Name="ProjectiOSDeviceResourceRules"> 614 <Platform Name="iOSDevice64"> 615 <Operation>1</Operation> 616 </Platform> 617 <Platform Name="iOSDevice32"> 618 <Operation>1</Operation> 619 </Platform> 620 </DeployClass> 621 <ProjectRoot Platform="iOSDevice64" Name="$(PROJECTNAME).app"/> 622 <ProjectRoot Platform="Win64" Name="$(PROJECTNAME)"/> 623 <ProjectRoot Platform="iOSDevice32" Name="$(PROJECTNAME).app"/> 624 <ProjectRoot Platform="Win32" Name="$(PROJECTNAME)"/> 625 <ProjectRoot Platform="OSX32" Name="$(PROJECTNAME).app"/> 626 <ProjectRoot Platform="Android" Name="$(PROJECTNAME)"/> 627 <ProjectRoot Platform="iOSSimulator" Name="$(PROJECTNAME).app"/> 628 </Deployment> 232 629 </BorlandProject> 233 630 <ProjectFileVersion>12</ProjectFileVersion> … … 235 632 <Import Project="$(BDS)\Bin\CodeGear.Delphi.Targets" Condition="Exists('$(BDS)\Bin\CodeGear.Delphi.Targets')"/> 236 633 <Import Project="$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj" Condition="Exists('$(APPDATA)\Embarcadero\$(BDSAPPDATABASEDIR)\$(PRODUCTVERSION)\UserTools.proj')"/> 634 <Import Project="$(MSBuildProjectName).deployproj" Condition="Exists('$(MSBuildProjectName).deployproj')"/> 237 635 </Project> -
trunk/LocalPlayer/BaseWin.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit BaseWin; 4 3 … … 6 5 7 6 uses 8 ScreenTools, Messg,9 10 Windows, Messages,SysUtils,Classes,Graphics,Controls,Forms;7 ScreenTools, Messg, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms; 11 10 12 11 type … … 16 15 constructor Create(AOwner: TComponent); override; 17 16 procedure FormClose(Sender: TObject; var Action: TCloseAction); 18 procedure FormPaint(Sender:TObject); 19 procedure FormKeyDown(Sender: TObject; var Key: Word; 20 Shift: TShiftState); 17 procedure FormPaint(Sender: TObject); 18 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 21 19 procedure FormDeactivate(Sender: TObject); 22 20 procedure SmartUpdateContent(ImmUpdate: boolean = false); 23 21 procedure StayOnTop_Workaround; 24 22 protected 25 FWindowMode, ModalFrameIndent: integer;23 FWindowMode, ModalFrameIndent: integer; 26 24 HelpContext: string; 27 25 procedure ShowNewContent(NewMode: integer; forceclose: boolean = false); 28 procedure MarkUsedOffscreen(xMax, yMax: integer);26 procedure MarkUsedOffscreen(xMax, yMax: integer); 29 27 procedure OffscreenPaint; virtual; 30 28 procedure VPaint; virtual; … … 33 31 end; 34 32 35 36 33 TFramedDlg = class(TBufferedDrawDlg) 37 34 public 38 35 constructor Create(AOwner: TComponent); override; 39 procedure FormCreate(Sender: TObject);36 procedure FormCreate(Sender: TObject); 40 37 procedure SmartInvalidate; override; 41 38 protected … … 44 41 procedure InitWindowRegion; 45 42 procedure VPaint; override; 46 procedure FillOffscreen(Left,Top,Width,Height: integer); 47 end; 48 43 procedure FillOffscreen(Left, Top, Width, Height: integer); 44 end; 49 45 50 46 const 51 // window modes 52 wmNone=0; wmModal=$1; wmPersistent=$2; wmSubmodal=$3; 53 54 55 yUnused=161; 56 NarrowFrame=11; WideFrame=36; SideFrame=9; 47 // window modes 48 wmNone = 0; 49 wmModal = $1; 50 wmPersistent = $2; 51 wmSubmodal = $3; 52 53 yUnused = 161; 54 NarrowFrame = 11; 55 WideFrame = 36; 56 SideFrame = 9; 57 57 58 58 var 59 UsedOffscreenWidth, UsedOffscreenHeight: integer;60 Offscreen: TBitmap;61 OffscreenUser: TForm;59 UsedOffscreenWidth, UsedOffscreenHeight: integer; 60 Offscreen: TBitmap; 61 OffscreenUser: TForm; 62 62 63 63 procedure CreateOffscreen; 64 64 65 66 65 implementation 67 66 68 67 uses 69 Term, Help, ButtonBase, Area; 70 68 Term, Help, ButtonBase, Area; 71 69 72 70 constructor TBufferedDrawDlg.Create; 73 71 begin 74 OnClose:=FormClose;75 OnPaint:=FormPaint;76 OnKeyDown:=FormKeyDown;77 OnDeactivate:=FormDeactivate;78 inherited;79 FWindowMode:=wmNone;80 HelpContext:='CONCEPTS';81 TitleHeight:=WideFrame;82 ModalFrameIndent:=45;83 UserLeft:=(Screen.Width-Width) div 2;84 UserTop:=(Screen.Height-Height) div 2;72 OnClose := FormClose; 73 OnPaint := FormPaint; 74 OnKeyDown := FormKeyDown; 75 OnDeactivate := FormDeactivate; 76 inherited; 77 FWindowMode := wmNone; 78 HelpContext := 'CONCEPTS'; 79 TitleHeight := WideFrame; 80 ModalFrameIndent := 45; 81 UserLeft := (Screen.Width - Width) div 2; 82 UserTop := (Screen.Height - Height) div 2; 85 83 end; 86 84 87 85 procedure TBufferedDrawDlg.FormClose(Sender: TObject; var Action: TCloseAction); 88 86 begin 89 if FWindowMode=wmPersistent then 90 begin UserLeft:=Left; UserTop:=Top end; 91 if OffscreenUser=self then OffscreenUser:=nil; 92 end; 93 94 procedure TBufferedDrawDlg.FormPaint(Sender:TObject); 95 begin 96 if OffscreenUser<>self then OffscreenPaint; 97 VPaint 87 if FWindowMode = wmPersistent then 88 begin 89 UserLeft := Left; 90 UserTop := Top 91 end; 92 if OffscreenUser = self then 93 OffscreenUser := nil; 94 end; 95 96 procedure TBufferedDrawDlg.FormPaint(Sender: TObject); 97 begin 98 if OffscreenUser <> self then 99 OffscreenPaint; 100 VPaint 98 101 end; 99 102 … … 101 104 Shift: TShiftState); 102 105 begin 103 if Key=VK_ESCAPE then 104 begin 105 if fsModal in FormState then ModalResult:=mrCancel 106 end 107 else if Key=VK_RETURN then 108 begin 109 if fsModal in FormState then ModalResult:=mrOK 110 end 111 else if Key=VK_F1 then 112 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, HelpDlg.TextIndex(HelpContext)) 113 else if FWindowMode=wmPersistent then 114 MainScreen.FormKeyDown(Sender, Key, Shift); 106 if Key = VK_ESCAPE then 107 begin 108 if fsModal in FormState then 109 ModalResult := mrCancel 110 end 111 else if Key = VK_RETURN then 112 begin 113 if fsModal in FormState then 114 ModalResult := mrOK 115 end 116 else if Key = VK_F1 then 117 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, 118 HelpDlg.TextIndex(HelpContext)) 119 else if FWindowMode = wmPersistent then 120 MainScreen.FormKeyDown(Sender, Key, Shift); 115 121 end; 116 122 117 123 procedure TBufferedDrawDlg.FormDeactivate(Sender: TObject); 118 124 begin 119 if FWindowMode=wmSubmodal then Close 125 if FWindowMode = wmSubmodal then 126 Close 120 127 end; 121 128 122 129 procedure TBufferedDrawDlg.OffscreenPaint; 123 130 begin 124 if (OffscreenUser<>nil) and (OffscreenUser<>self) then125 OffscreenUser.Update; // complete working with old owner to prevent rebound126 OffscreenUser:=self;131 if (OffscreenUser <> nil) and (OffscreenUser <> self) then 132 OffscreenUser.Update; // complete working with old owner to prevent rebound 133 OffscreenUser := self; 127 134 end; 128 135 129 136 procedure TBufferedDrawDlg.VPaint; 130 137 begin 131 BitBlt(Canvas.Handle, 0, 0, ClientWidth, 132 ClientHeight, offscreen.Canvas. Handle, 0, 0, SRCCOPY); 133 end; 134 135 procedure TBufferedDrawDlg.ShowNewContent(NewMode: integer; forceclose: boolean); 136 begin 137 if Visible then 138 begin 139 assert((NewMode=wmModal) or (FWindowMode<>wmModal)); // don't make modal window non-modal 140 if (NewMode=wmModal) and (forceclose or (FWindowMode<>wmModal)) then 138 BitBlt(Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 139 Offscreen.Canvas.Handle, 0, 0, SRCCOPY); 140 end; 141 142 procedure TBufferedDrawDlg.ShowNewContent(NewMode: integer; 143 forceclose: boolean); 144 begin 145 if Visible then 146 begin 147 assert((NewMode = wmModal) or (FWindowMode <> wmModal)); 148 // don't make modal window non-modal 149 if (NewMode = wmModal) and (forceclose or (FWindowMode <> wmModal)) then 141 150 begin // make modal 142 UserLeft:=Left;143 UserTop:=Top;144 Visible:=false;145 FWindowMode:=NewMode;146 ShowModal;151 UserLeft := Left; 152 UserTop := Top; 153 Visible := false; 154 FWindowMode := NewMode; 155 ShowModal; 147 156 end 148 else if forceclose then157 else if forceclose then 149 158 begin // make modal 150 Visible:=false;151 FWindowMode:=NewMode;152 Left:=UserLeft;153 Top:=UserTop;154 Show;159 Visible := false; 160 FWindowMode := NewMode; 161 Left := UserLeft; 162 Top := UserTop; 163 Show; 155 164 end 156 else157 begin 158 FWindowMode:=NewMode;159 if @OnShow<>nil then160 OnShow(nil);161 Invalidate;162 BringToFront165 else 166 begin 167 FWindowMode := NewMode; 168 if @OnShow <> nil then 169 OnShow(nil); 170 Invalidate; 171 BringToFront 163 172 end 164 173 end 165 else 166 begin 167 FWindowMode:=NewMode; 168 Left:=UserLeft; 169 Top:=UserTop; 170 if FWindowMode=wmModal then ShowModal 171 else Show 174 else 175 begin 176 FWindowMode := NewMode; 177 Left := UserLeft; 178 Top := UserTop; 179 if FWindowMode = wmModal then 180 ShowModal 181 else 182 Show 172 183 end 173 184 end; … … 175 186 procedure TBufferedDrawDlg.SmartUpdateContent(ImmUpdate: boolean); 176 187 begin 177 if Visible then 178 begin 179 OffscreenPaint; 180 SmartInvalidate; 181 if ImmUpdate then Update 182 end 183 end; 184 185 procedure TBufferedDrawDlg.MarkUsedOffscreen(xMax,yMax: integer); 186 begin 187 if xMax>UsedOffscreenWidth then UsedOffscreenWidth:=xMax; 188 if yMax>UsedOffscreenHeight then UsedOffscreenHeight:=yMax; 188 if Visible then 189 begin 190 OffscreenPaint; 191 SmartInvalidate; 192 if ImmUpdate then 193 Update 194 end 195 end; 196 197 procedure TBufferedDrawDlg.MarkUsedOffscreen(xMax, yMax: integer); 198 begin 199 if xMax > UsedOffscreenWidth then 200 UsedOffscreenWidth := xMax; 201 if yMax > UsedOffscreenHeight then 202 UsedOffscreenHeight := yMax; 189 203 end; 190 204 … … 193 207 // after application lost focus, so show all stayontop-windows in first turn 194 208 var 195 SaveOnShow, SaveOnPaint: TNotifyEvent; 196 begin 197 Top:=Screen.Height; 198 SaveOnShow:=OnShow; 199 OnShow:=nil; 200 SaveOnPaint:=OnPaint; 201 OnPaint:=nil; 202 FWindowMode:=wmNone; 203 Show; 204 Hide; 205 OnShow:=SaveOnShow; 206 OnPaint:=SaveOnPaint; 207 end; 208 209 SaveOnShow, SaveOnPaint: TNotifyEvent; 210 begin 211 Top := Screen.Height; 212 SaveOnShow := OnShow; 213 OnShow := nil; 214 SaveOnPaint := OnPaint; 215 OnPaint := nil; 216 FWindowMode := wmNone; 217 Show; 218 Hide; 219 OnShow := SaveOnShow; 220 OnPaint := SaveOnPaint; 221 end; 209 222 210 223 constructor TFramedDlg.Create; 211 224 begin 212 OnCreate:=FormCreate; 213 inherited; 214 end; 215 216 procedure TFramedDlg.FormCreate(Sender:TObject); 217 begin 218 CaptionLeft:=0; CaptionRight:=$FFFF; 219 WideBottom:=false; 220 FullCaption:=true; 221 TexOverride:=false; 222 ModalIndication:=true; 223 Canvas.Brush.Style:=bsClear; 224 InnerWidth:=ClientWidth-2*SideFrame; 225 InnerHeight:=ClientHeight-TitleHeight-NarrowFrame; 225 OnCreate := FormCreate; 226 inherited; 227 end; 228 229 procedure TFramedDlg.FormCreate(Sender: TObject); 230 begin 231 CaptionLeft := 0; 232 CaptionRight := $FFFF; 233 WideBottom := false; 234 FullCaption := true; 235 TexOverride := false; 236 ModalIndication := true; 237 Canvas.Brush.Style := bsClear; 238 InnerWidth := ClientWidth - 2 * SideFrame; 239 InnerHeight := ClientHeight - TitleHeight - NarrowFrame; 226 240 end; 227 241 228 242 procedure TFramedDlg.SmartInvalidate; 229 243 var 230 i,BottomFrame: integer; 231 r0,r1: HRgn; 232 begin 233 if WideBottom then BottomFrame:=WideFrame else BottomFrame:=NarrowFrame; 234 r0:=CreateRectRgn(SideFrame,TitleHeight,ClientWidth-SideFrame, 235 ClientHeight-BottomFrame); 236 for i:=0 to ControlCount-1 do 237 if not (Controls[i] is TArea) and Controls[i].Visible then 238 begin 239 with Controls[i].BoundsRect do 240 r1:=CreateRectRgn(Left,Top,Right,Bottom); 241 CombineRgn(r0,r0,r1,RGN_DIFF); 242 DeleteObject(r1); 244 i, BottomFrame: integer; 245 r0, r1: HRgn; 246 begin 247 if WideBottom then 248 BottomFrame := WideFrame 249 else 250 BottomFrame := NarrowFrame; 251 r0 := CreateRectRgn(SideFrame, TitleHeight, ClientWidth - SideFrame, 252 ClientHeight - BottomFrame); 253 for i := 0 to ControlCount - 1 do 254 if not(Controls[i] is TArea) and Controls[i].Visible then 255 begin 256 with Controls[i].BoundsRect do 257 r1 := CreateRectRgn(Left, Top, Right, Bottom); 258 CombineRgn(r0, r0, r1, RGN_DIFF); 259 DeleteObject(r1); 243 260 end; 244 InvalidateRgn(Handle,r0,false);245 DeleteObject(r0);261 InvalidateRgn(Handle, r0, false); 262 DeleteObject(r0); 246 263 end; 247 264 248 265 procedure TFramedDlg.VPaint; 249 266 250 procedure CornerFrame(x0,y0,x1,y1: integer); 251 begin 252 Frame(Canvas,x0+1,y0+1,x1-2,y1-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 253 Frame(Canvas,x0+2,y0+2,x1-3,y1-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 254 Corner(Canvas,x0+1,y0+1,0,MainTexture); 255 Corner(Canvas,x1-9,y0+1,1,MainTexture); 256 Corner(Canvas,x0+1,y1-9,2,MainTexture); 257 Corner(Canvas,x1-9,y1-9,3,MainTexture); 267 procedure CornerFrame(x0, y0, x1, y1: integer); 268 begin 269 Frame(Canvas, x0 + 1, y0 + 1, x1 - 2, y1 - 2, MainTexture.clBevelLight, 270 MainTexture.clBevelShade); 271 Frame(Canvas, x0 + 2, y0 + 2, x1 - 3, y1 - 3, MainTexture.clBevelLight, 272 MainTexture.clBevelShade); 273 Corner(Canvas, x0 + 1, y0 + 1, 0, MainTexture); 274 Corner(Canvas, x1 - 9, y0 + 1, 1, MainTexture); 275 Corner(Canvas, x0 + 1, y1 - 9, 2, MainTexture); 276 Corner(Canvas, x1 - 9, y1 - 9, 3, MainTexture); 258 277 end; 259 278 260 279 var 261 i,l,FrameTop,FrameBottom,InnerBottom,Cut,xTexOffset,yTexOffset: integer; 262 R: TRect; 263 begin 264 if not TexOverride then 265 begin 266 if (FWindowMode=wmModal) and ModalIndication then MainTexture:=MainTexture 267 else MainTexture:=MainTexture; 268 MainTexture:=MainTexture 269 end; 270 Canvas.Font.Assign(UniFont[ftCaption]); 271 l:=BiColorTextWidth(Canvas,Caption); 272 Cut:=(ClientWidth-l) div 2; 273 xTexOffset:=(wMaintexture-ClientWidth) div 2; 274 yTexOffset:=(hMaintexture-ClientHeight) div 2; 275 if WideBottom then InnerBottom:=ClientHeight-WideFrame 276 else InnerBottom:=ClientHeight-NarrowFrame; 277 if FullCaption then begin FrameTop:=0; FrameBottom:=ClientHeight end 278 else 279 begin 280 FrameTop:=TitleHeight-NarrowFrame; 281 if WideBottom then FrameBottom:=ClientHeight-(WideFrame-NarrowFrame) 282 else FrameBottom:=ClientHeight 283 end; 284 Fill(Canvas,3,InnerBottom+1,ClientWidth-6,ClientHeight-InnerBottom-4, 285 xTexOffset,yTexOffset); 286 Fill(Canvas,3,TitleHeight-2,SideFrame-3,InnerBottom-TitleHeight+4, 287 xTexOffset,yTexOffset); 288 Fill(Canvas,ClientWidth-SideFrame,TitleHeight-2,SideFrame-3, 289 InnerBottom-TitleHeight+4,xTexOffset,yTexOffset); 290 Frame(Canvas,0,FrameTop,ClientWidth-1,FrameBottom-1,0,0); 291 Frame(Canvas,SideFrame-1,TitleHeight-1,ClientWidth-SideFrame, 292 InnerBottom,MainTexture.clBevelShade,MainTexture.clBevelLight); 293 //RFrame(Canvas,SideFrame-2,TitleHeight-2,ClientWidth-SideFrame+1, 294 // InnerBottom+1,MainTexture.clBevelShade,MainTexture.clBevelLight); 295 if FullCaption then 296 begin 297 if (FWindowMode<>wmModal) or not ModalIndication then 298 begin 299 Fill(Canvas,3,3+FrameTop,ClientWidth-6,TitleHeight-FrameTop-4, 300 xTexOffset,yTexOffset); 301 CornerFrame(0,FrameTop,ClientWidth,FrameBottom); 280 i, l, FrameTop, FrameBottom, InnerBottom, Cut, xTexOffset, 281 yTexOffset: integer; 282 R: TRect; 283 begin 284 if not TexOverride then 285 begin 286 if (FWindowMode = wmModal) and ModalIndication then 287 MainTexture := MainTexture 288 else 289 MainTexture := MainTexture; 290 MainTexture := MainTexture 291 end; 292 Canvas.Font.Assign(UniFont[ftCaption]); 293 l := BiColorTextWidth(Canvas, Caption); 294 Cut := (ClientWidth - l) div 2; 295 xTexOffset := (wMaintexture - ClientWidth) div 2; 296 yTexOffset := (hMaintexture - ClientHeight) div 2; 297 if WideBottom then 298 InnerBottom := ClientHeight - WideFrame 299 else 300 InnerBottom := ClientHeight - NarrowFrame; 301 if FullCaption then 302 begin 303 FrameTop := 0; 304 FrameBottom := ClientHeight 305 end 306 else 307 begin 308 FrameTop := TitleHeight - NarrowFrame; 309 if WideBottom then 310 FrameBottom := ClientHeight - (WideFrame - NarrowFrame) 311 else 312 FrameBottom := ClientHeight 313 end; 314 Fill(Canvas, 3, InnerBottom + 1, ClientWidth - 6, ClientHeight - InnerBottom - 315 4, xTexOffset, yTexOffset); 316 Fill(Canvas, 3, TitleHeight - 2, SideFrame - 3, InnerBottom - TitleHeight + 4, 317 xTexOffset, yTexOffset); 318 Fill(Canvas, ClientWidth - SideFrame, TitleHeight - 2, SideFrame - 3, 319 InnerBottom - TitleHeight + 4, xTexOffset, yTexOffset); 320 Frame(Canvas, 0, FrameTop, ClientWidth - 1, FrameBottom - 1, 0, 0); 321 Frame(Canvas, SideFrame - 1, TitleHeight - 1, ClientWidth - SideFrame, 322 InnerBottom, MainTexture.clBevelShade, MainTexture.clBevelLight); 323 // RFrame(Canvas,SideFrame-2,TitleHeight-2,ClientWidth-SideFrame+1, 324 // InnerBottom+1,MainTexture.clBevelShade,MainTexture.clBevelLight); 325 if FullCaption then 326 begin 327 if (FWindowMode <> wmModal) or not ModalIndication then 328 begin 329 Fill(Canvas, 3, 3 + FrameTop, ClientWidth - 6, TitleHeight - FrameTop - 4, 330 xTexOffset, yTexOffset); 331 CornerFrame(0, FrameTop, ClientWidth, FrameBottom); 302 332 end 303 else with Canvas do 304 begin 305 Fill(Canvas,3+ModalFrameIndent,3+FrameTop,ClientWidth-6-2*ModalFrameIndent, 306 TitleHeight-FrameTop-4,xTexOffset,yTexOffset); 307 Fill(Canvas,ClientWidth-3-ModalFrameIndent,3+FrameTop,ModalFrameIndent, 308 TitleHeight-FrameTop-4,xTexOffset,yTexOffset); 309 Fill(Canvas,3,3+FrameTop,ModalFrameIndent,TitleHeight-FrameTop-4, 310 xTexOffset,yTexOffset); 311 CornerFrame(0,FrameTop,ClientWidth,FrameBottom); 312 Pen.Color:=MainTexture.clBevelShade; 313 MoveTo(3+ModalFrameIndent,2); LineTo(3+ModalFrameIndent,TitleHeight); 314 Pen.Color:=MainTexture.clBevelShade; 315 MoveTo(4+ModalFrameIndent,TitleHeight-1); 316 LineTo(ClientWidth-4-ModalFrameIndent,TitleHeight-1); 317 LineTo(ClientWidth-4-ModalFrameIndent,1); 318 Pen.Color:=MainTexture.clBevelLight; 319 MoveTo(ClientWidth-5-ModalFrameIndent,2); 320 LineTo(4+ModalFrameIndent,2); 321 LineTo(4+ModalFrameIndent,TitleHeight); 322 MoveTo(ClientWidth-4-ModalFrameIndent,1); 323 LineTo(3+ModalFrameIndent,1); 324 Pen.Color:=MainTexture.clBevelLight; 325 MoveTo(ClientWidth-3-ModalFrameIndent,3); LineTo(ClientWidth-3-ModalFrameIndent,TitleHeight); 326 end 327 end 328 else 329 begin 330 Fill(Canvas,3,3+FrameTop,ClientWidth-6,TitleHeight-FrameTop-4, 331 xTexOffset,yTexOffset); 332 CornerFrame(0,FrameTop,ClientWidth,FrameBottom); 333 334 Frame(Canvas,CaptionLeft,0,ClientWidth-CaptionLeft-1,FrameTop,0,0); 335 Fill(Canvas,CaptionLeft+3,3,ClientWidth-2*(CaptionLeft)-6,TitleHeight-4, 336 xTexOffset,yTexOffset); 337 338 Frame(Canvas,CaptionLeft+1,0+1, 339 ClientWidth-CaptionLeft-2,TitleHeight-1,MainTexture.clBevelLight,MainTexture.clBevelShade); 340 Frame(Canvas,CaptionLeft+2,0+2, 341 ClientWidth-CaptionLeft-3,TitleHeight-1,MainTexture.clBevelLight,MainTexture.clBevelShade); 342 Corner(Canvas,CaptionLeft+1,0+1,0,MainTexture); 343 Corner(Canvas,ClientWidth-CaptionLeft-9,0+1,1,MainTexture); 344 345 with Canvas do 346 begin 347 Pen.Color:=MainTexture.clBevelShade; 348 MoveTo(CaptionLeft+1,FrameTop+2); 349 LineTo(CaptionLeft+1,TitleHeight); 350 Pen.Color:=MainTexture.clBevelLight; 351 MoveTo(ClientWidth-CaptionLeft-2,FrameTop+2); 352 LineTo(ClientWidth-CaptionLeft-2,TitleHeight); 333 else 334 with Canvas do 335 begin 336 Fill(Canvas, 3 + ModalFrameIndent, 3 + FrameTop, 337 ClientWidth - 6 - 2 * ModalFrameIndent, TitleHeight - FrameTop - 4, 338 xTexOffset, yTexOffset); 339 Fill(Canvas, ClientWidth - 3 - ModalFrameIndent, 3 + FrameTop, 340 ModalFrameIndent, TitleHeight - FrameTop - 4, xTexOffset, yTexOffset); 341 Fill(Canvas, 3, 3 + FrameTop, ModalFrameIndent, TitleHeight - FrameTop - 342 4, xTexOffset, yTexOffset); 343 CornerFrame(0, FrameTop, ClientWidth, FrameBottom); 344 Pen.Color := MainTexture.clBevelShade; 345 MoveTo(3 + ModalFrameIndent, 2); 346 LineTo(3 + ModalFrameIndent, TitleHeight); 347 Pen.Color := MainTexture.clBevelShade; 348 MoveTo(4 + ModalFrameIndent, TitleHeight - 1); 349 LineTo(ClientWidth - 4 - ModalFrameIndent, TitleHeight - 1); 350 LineTo(ClientWidth - 4 - ModalFrameIndent, 1); 351 Pen.Color := MainTexture.clBevelLight; 352 MoveTo(ClientWidth - 5 - ModalFrameIndent, 2); 353 LineTo(4 + ModalFrameIndent, 2); 354 LineTo(4 + ModalFrameIndent, TitleHeight); 355 MoveTo(ClientWidth - 4 - ModalFrameIndent, 1); 356 LineTo(3 + ModalFrameIndent, 1); 357 Pen.Color := MainTexture.clBevelLight; 358 MoveTo(ClientWidth - 3 - ModalFrameIndent, 3); 359 LineTo(ClientWidth - 3 - ModalFrameIndent, TitleHeight); 360 end 361 end 362 else 363 begin 364 Fill(Canvas, 3, 3 + FrameTop, ClientWidth - 6, TitleHeight - FrameTop - 4, 365 xTexOffset, yTexOffset); 366 CornerFrame(0, FrameTop, ClientWidth, FrameBottom); 367 368 Frame(Canvas, CaptionLeft, 0, ClientWidth - CaptionLeft - 1, 369 FrameTop, 0, 0); 370 Fill(Canvas, CaptionLeft + 3, 3, ClientWidth - 2 * (CaptionLeft) - 6, 371 TitleHeight - 4, xTexOffset, yTexOffset); 372 373 Frame(Canvas, CaptionLeft + 1, 0 + 1, ClientWidth - CaptionLeft - 2, 374 TitleHeight - 1, MainTexture.clBevelLight, MainTexture.clBevelShade); 375 Frame(Canvas, CaptionLeft + 2, 0 + 2, ClientWidth - CaptionLeft - 3, 376 TitleHeight - 1, MainTexture.clBevelLight, MainTexture.clBevelShade); 377 Corner(Canvas, CaptionLeft + 1, 0 + 1, 0, MainTexture); 378 Corner(Canvas, ClientWidth - CaptionLeft - 9, 0 + 1, 1, MainTexture); 379 380 with Canvas do 381 begin 382 Pen.Color := MainTexture.clBevelShade; 383 MoveTo(CaptionLeft + 1, FrameTop + 2); 384 LineTo(CaptionLeft + 1, TitleHeight); 385 Pen.Color := MainTexture.clBevelLight; 386 MoveTo(ClientWidth - CaptionLeft - 2, FrameTop + 2); 387 LineTo(ClientWidth - CaptionLeft - 2, TitleHeight); 353 388 end; 354 if WideBottom then 355 begin 356 Frame(Canvas,CaptionLeft,FrameBottom,ClientWidth-CaptionLeft-1,ClientHeight-1,0,0); 357 Fill(Canvas,CaptionLeft+3,ClientHeight-3-(WideFrame-5), 358 ClientWidth-2*(CaptionLeft)-6,WideFrame-5,xTexOffset,yTexOffset); 359 Frame(Canvas,CaptionLeft+1,ClientHeight-WideFrame-1+1, 360 ClientWidth-CaptionLeft-2,ClientHeight-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 361 Frame(Canvas,CaptionLeft+2,ClientHeight-WideFrame-1+1, 362 ClientWidth-CaptionLeft-3,ClientHeight-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 363 Corner(Canvas,CaptionLeft+1,ClientHeight-9,2,MainTexture); 364 Corner(Canvas,ClientWidth-CaptionLeft-9,ClientHeight-9,3,MainTexture); 365 366 with Canvas do 389 if WideBottom then 390 begin 391 Frame(Canvas, CaptionLeft, FrameBottom, ClientWidth - CaptionLeft - 1, 392 ClientHeight - 1, 0, 0); 393 Fill(Canvas, CaptionLeft + 3, ClientHeight - 3 - (WideFrame - 5), 394 ClientWidth - 2 * (CaptionLeft) - 6, WideFrame - 5, xTexOffset, 395 yTexOffset); 396 Frame(Canvas, CaptionLeft + 1, ClientHeight - WideFrame - 1 + 1, 397 ClientWidth - CaptionLeft - 2, ClientHeight - 2, 398 MainTexture.clBevelLight, MainTexture.clBevelShade); 399 Frame(Canvas, CaptionLeft + 2, ClientHeight - WideFrame - 1 + 1, 400 ClientWidth - CaptionLeft - 3, ClientHeight - 3, 401 MainTexture.clBevelLight, MainTexture.clBevelShade); 402 Corner(Canvas, CaptionLeft + 1, ClientHeight - 9, 2, MainTexture); 403 Corner(Canvas, ClientWidth - CaptionLeft - 9, ClientHeight - 9, 3, 404 MainTexture); 405 406 with Canvas do 367 407 begin 368 Pen.Color:=MainTexture.clBevelShade;369 MoveTo(CaptionLeft+1,ClientHeight-WideFrame);370 LineTo(CaptionLeft+1,FrameBottom-2);371 Pen.Color:=MainTexture.clBevelLight;372 MoveTo(ClientWidth-CaptionLeft-2,ClientHeight-WideFrame);373 LineTo(ClientWidth-CaptionLeft-2,FrameBottom-2);408 Pen.Color := MainTexture.clBevelShade; 409 MoveTo(CaptionLeft + 1, ClientHeight - WideFrame); 410 LineTo(CaptionLeft + 1, FrameBottom - 2); 411 Pen.Color := MainTexture.clBevelLight; 412 MoveTo(ClientWidth - CaptionLeft - 2, ClientHeight - WideFrame); 413 LineTo(ClientWidth - CaptionLeft - 2, FrameBottom - 2); 374 414 end; 375 415 end 376 416 end; 377 RisedTextOut(Canvas,Cut-1,7,Caption);378 379 for i:=0 to ControlCount-1 do380 if Controls[i].Visible and (Controls[i] is TButtonBase) then381 begin 382 R:=Controls[i].BoundsRect;383 if (R.Bottom<=TitleHeight) or (R.Top>=InnerBottom) then384 BtnFrame(Canvas,R,MainTexture);417 RisedTextOut(Canvas, Cut - 1, 7, Caption); 418 419 for i := 0 to ControlCount - 1 do 420 if Controls[i].Visible and (Controls[i] is TButtonBase) then 421 begin 422 R := Controls[i].BoundsRect; 423 if (R.Bottom <= TitleHeight) or (R.Top >= InnerBottom) then 424 BtnFrame(Canvas, R, MainTexture); 385 425 end; 386 426 387 BitBlt(Canvas.Handle,SideFrame,TitleHeight,ClientWidth-2*SideFrame,388 InnerBottom-TitleHeight,offscreen.Canvas.Handle,0,0,SRCCOPY);427 BitBlt(Canvas.Handle, SideFrame, TitleHeight, ClientWidth - 2 * SideFrame, 428 InnerBottom - TitleHeight, Offscreen.Canvas.Handle, 0, 0, SRCCOPY); 389 429 end; 390 430 391 431 procedure TFramedDlg.InitWindowRegion; 392 432 var 393 r0,r1: HRgn; 394 begin 395 if FullCaption then exit; 396 r0:=CreateRectRgn(0,0,ClientWidth,ClientHeight); 397 r1:=CreateRectRgn(0,0,CaptionLeft,TitleHeight-NarrowFrame); 398 CombineRgn(r0,r0,r1,RGN_DIFF); 399 //DeleteObject(r1); 400 r1:=CreateRectRgn(ClientWidth-CaptionLeft,0,ClientWidth,TitleHeight-NarrowFrame); 401 CombineRgn(r0,r0,r1,RGN_DIFF); 402 //DeleteObject(r1); 403 if WideBottom then 404 begin 405 r1:=CreateRectRgn(0,ClientHeight-(WideFrame-NarrowFrame),CaptionLeft, 406 ClientHeight); 407 CombineRgn(r0,r0,r1,RGN_DIFF); 408 //DeleteObject(r1); 409 r1:=CreateRectRgn(ClientWidth-CaptionLeft, 410 ClientHeight-(WideFrame-NarrowFrame),ClientWidth,ClientHeight); 411 CombineRgn(r0,r0,r1,RGN_DIFF); 412 //DeleteObject(r1); 413 end; 414 SetWindowRgn(Handle,r0,false); 415 //DeleteObject(r0); // causes crash with Windows 95 416 end; 417 418 procedure TFramedDlg.FillOffscreen(Left,Top,Width,Height: integer); 419 begin 420 Fill(Offscreen.Canvas,Left,Top,Width,Height,SideFrame+(wMaintexture-ClientWidth) div 2, 421 TitleHeight+(hMaintexture-ClientHeight) div 2); 422 end; 423 433 r0, r1: HRgn; 434 begin 435 if FullCaption then 436 exit; 437 r0 := CreateRectRgn(0, 0, ClientWidth, ClientHeight); 438 r1 := CreateRectRgn(0, 0, CaptionLeft, TitleHeight - NarrowFrame); 439 CombineRgn(r0, r0, r1, RGN_DIFF); 440 // DeleteObject(r1); 441 r1 := CreateRectRgn(ClientWidth - CaptionLeft, 0, ClientWidth, 442 TitleHeight - NarrowFrame); 443 CombineRgn(r0, r0, r1, RGN_DIFF); 444 // DeleteObject(r1); 445 if WideBottom then 446 begin 447 r1 := CreateRectRgn(0, ClientHeight - (WideFrame - NarrowFrame), 448 CaptionLeft, ClientHeight); 449 CombineRgn(r0, r0, r1, RGN_DIFF); 450 // DeleteObject(r1); 451 r1 := CreateRectRgn(ClientWidth - CaptionLeft, 452 ClientHeight - (WideFrame - NarrowFrame), ClientWidth, ClientHeight); 453 CombineRgn(r0, r0, r1, RGN_DIFF); 454 // DeleteObject(r1); 455 end; 456 SetWindowRgn(Handle, r0, false); 457 // DeleteObject(r0); // causes crash with Windows 95 458 end; 459 460 procedure TFramedDlg.FillOffscreen(Left, Top, Width, Height: integer); 461 begin 462 Fill(Offscreen.Canvas, Left, Top, Width, Height, 463 SideFrame + (wMaintexture - ClientWidth) div 2, 464 TitleHeight + (hMaintexture - ClientHeight) div 2); 465 end; 424 466 425 467 procedure CreateOffscreen; 426 468 begin 427 if OffScreen<>nil then exit; 428 offscreen:=TBitmap.Create; 429 Offscreen.PixelFormat:=pf24bit; 430 offscreen.Width:=Screen.Width; 431 if Screen.Height-yUnused<480 then offscreen.Height:=480 432 else offscreen.Height:=Screen.Height-yUnused; 433 offscreen.Canvas.Brush.Style:=bsClear; 434 end; 435 469 if Offscreen <> nil then 470 exit; 471 Offscreen := TBitmap.Create; 472 Offscreen.PixelFormat := pf24bit; 473 Offscreen.Width := Screen.Width; 474 if Screen.Height - yUnused < 480 then 475 Offscreen.Height := 480 476 else 477 Offscreen.Height := Screen.Height - yUnused; 478 Offscreen.Canvas.Brush.Style := bsClear; 479 end; 436 480 437 481 initialization 438 offscreen:=nil; 439 OffscreenUser:=nil; 482 483 Offscreen := nil; 484 OffscreenUser := nil; 440 485 441 486 finalization 442 offscreen.Free; 487 488 Offscreen.Free; 443 489 444 490 end. 445 -
trunk/LocalPlayer/Battle.pas
r2 r6 5 5 6 6 uses 7 ScreenTools, Protocol,Messg,ButtonBase, ButtonA,7 ScreenTools, Protocol, Messg, ButtonBase, ButtonA, 8 8 9 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms; … … 17 17 Shift: TShiftState; X, Y: Integer); 18 18 procedure FormDeactivate(Sender: TObject); 19 procedure FormKeyDown(Sender: TObject; var Key: Word; 20 Shift: TShiftState); 19 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 21 20 procedure FormCreate(Sender: TObject); 22 21 procedure FormShow(Sender: TObject); … … 24 23 procedure CancelBtnClick(Sender: TObject); 25 24 public 26 uix, ToLoc: integer;25 uix, ToLoc: Integer; 27 26 Forecast: TBattleForecastEx; 28 27 IsSuicideQuery: boolean; … … 32 31 BattleDlg: TBattleDlg; 33 32 34 procedure PaintBattleOutcome(ca: TCanvas; xm, ym,uix,ToLoc: integer;33 procedure PaintBattleOutcome(ca: TCanvas; xm, ym, uix, ToLoc: Integer; 35 34 Forecast: TBattleForecastEx); 36 35 37 38 36 implementation 39 37 40 38 uses 41 Term,ClientTools,IsoEngine;39 Term, ClientTools, IsoEngine; 42 40 43 41 {$R *.DFM} 44 42 45 43 const 46 Border=3; 47 MessageLineSpacing=20; 48 49 DamageColor=$0000E0; 50 FanaticColor=$800080; 51 FirstStrikeColor=$A0A0A0; 52 53 54 procedure PaintBattleOutcome(ca: TCanvas; xm,ym,uix,ToLoc: integer; 44 Border = 3; 45 MessageLineSpacing = 20; 46 47 DamageColor = $0000E0; 48 FanaticColor = $800080; 49 FirstStrikeColor = $A0A0A0; 50 51 procedure PaintBattleOutcome(ca: TCanvas; xm, ym, uix, ToLoc: Integer; 55 52 Forecast: TBattleForecastEx); 56 53 var 57 euix,ADamage,DDamage,StrMax,DamageMax,MaxBar,LAStr,LDStr, 58 LADamage,LDDamage,LABaseDamage,LAAvoidedDamage,LDBaseDamage: integer; 59 //TerrType: Cardinal; 60 UnitInfo: TUnitInfo; 61 TextSize: TSize; 62 LabelText: string; 63 FirstStrike: boolean; 64 begin 65 MaxBar:=65; 66 67 //TerrType:=MyMap[ToLoc] and fTerrain; 68 GetUnitInfo(ToLoc,euix,UnitInfo); 69 70 FirstStrike:=(MyModel[MyUn[uix].mix].Cap[mcFirst]>0) 71 and (Forecast.DBaseDamage>=UnitInfo.Health); 72 ADamage:=MyUn[uix].Health-Forecast.EndHealthAtt; 73 if FirstStrike then 74 ADamage:=ADamage+Forecast.ABaseDamage div 2; 75 DDamage:=UnitInfo.Health-Forecast.EndHealthDef; 76 if Forecast.AStr>Forecast.DStr then 77 StrMax:=Forecast.AStr 78 else StrMax:=Forecast.DStr; 79 if ADamage>DDamage then 80 DamageMax:=ADamage 81 else DamageMax:=DDamage; 82 if Forecast.ABaseDamage>Forecast.DBaseDamage then 83 StrMax:=StrMax*DamageMax div Forecast.ABaseDamage 84 else StrMax:=StrMax*DamageMax div Forecast.DBaseDamage; 85 86 LAStr:=Forecast.AStr*MaxBar div StrMax; 87 LDStr:=Forecast.DStr*MaxBar div StrMax; 88 LADamage:=ADamage*MaxBar div DamageMax; 89 LABaseDamage:=Forecast.ABaseDamage*MaxBar div DamageMax; 90 if FirstStrike then 91 LAAvoidedDamage:=LABaseDamage div 2 92 else LAAvoidedDamage:=0; 93 LDDamage:=DDamage*MaxBar div DamageMax; 94 LDBaseDamage:=Forecast.DBaseDamage*MaxBar div DamageMax; 95 96 DarkGradient(ca,xm-8-LAStr,ym-8,LAStr,2); 97 VDarkGradient(ca,xm-8,ym-8-LDStr,LDStr,2); 98 LightGradient(ca,xm+8,ym-8,LDBaseDamage,DamageColor); 99 if LDDamage>LDBaseDamage then 100 LightGradient(ca,xm+8+LDBaseDamage,ym-8,LDDamage-LDBaseDamage,FanaticColor); 101 if LAAvoidedDamage>0 then 102 VLightGradient(ca,xm-8,ym+8,LAAvoidedDamage,FirstStrikeColor); 103 VLightGradient(ca,xm-8,ym+8+LAAvoidedDamage,LABaseDamage-LAAvoidedDamage, 104 DamageColor); 105 if LADamage>LABaseDamage then 106 VLightGradient(ca,xm-8,ym+8+LABaseDamage,LADamage-LABaseDamage,FanaticColor); 107 BitBlt(ca.Handle,xm-12,ym-12,24,24, 108 GrExt[HGrSystem].Mask.Canvas.Handle,26,146,SRCAND); 109 BitBlt(ca.Handle,xm-12,ym-12,24,24, 110 GrExt[HGrSystem].Data.Canvas.Handle,26,146,SRCPAINT); 111 112 LabelText:=Format('%d', [Forecast.AStr]); 113 TextSize:=ca.TextExtent(LabelText); 114 if TextSize.cx div 2+2>LAStr div 2 then 115 RisedTextOut(ca,xm-10-TextSize.cx,ym-(TextSize.cy+1) div 2, LabelText) 116 else RisedTextOut(ca,xm-8-(LAStr+TextSize.cx) div 2,ym-(TextSize.cy+1) div 2, LabelText); 117 118 LabelText:=Format('%d', [Forecast.DStr]); 119 TextSize:=ca.TextExtent(LabelText); 120 if TextSize.cy div 2>LDStr div 2 then 121 RisedTextOut(ca,xm-(TextSize.cx+1) div 2, ym-8-TextSize.cy,LabelText) 122 else RisedTextOut(ca,xm-(TextSize.cx+1) div 2, ym-8-(LDStr+TextSize.cy) div 2,LabelText); 123 124 if Forecast.EndHealthDef<=0 then 125 begin 126 BitBlt(ca.Handle,xm+9+LDDamage-7,ym-6,14,17, 127 GrExt[HGrSystem].Mask.Canvas.Handle,51,153,SRCAND); 128 BitBlt(ca.Handle,xm+8+LDDamage-7,ym-7,14,17, 129 GrExt[HGrSystem].Mask.Canvas.Handle,51,153,SRCAND); 130 BitBlt(ca.Handle,xm+8+LDDamage-7,ym-7,14,17, 131 GrExt[HGrSystem].Data.Canvas.Handle,51,153,SRCPAINT); 132 end; 133 LabelText:=Format('%d', [DDamage]); 134 TextSize:=ca.TextExtent(LabelText); 135 if TextSize.cx div 2+2>LDDamage div 2 then 136 begin 137 if Forecast.EndHealthDef>0 then 138 RisedTextOut(ca,xm+10,ym-(TextSize.cy+1) div 2, LabelText) 139 end 140 else RisedTextOut(ca,xm+8+(LDDamage-TextSize.cx) div 2,ym-(TextSize.cy+1) div 2, LabelText); 141 142 if Forecast.EndHealthAtt<=0 then 143 begin 144 BitBlt(ca.Handle,xm-6,ym+9+LADamage-7,14,17, 145 GrExt[HGrSystem].Mask.Canvas.Handle,51,153,SRCAND); 146 BitBlt(ca.Handle,xm-7,ym+8+LADamage-7,14,17, 147 GrExt[HGrSystem].Mask.Canvas.Handle,51,153,SRCAND); 148 BitBlt(ca.Handle,xm-7,ym+8+LADamage-7,14,17, 149 GrExt[HGrSystem].Data.Canvas.Handle,51,153,SRCPAINT); 150 end; 151 LabelText:=Format('%d', [MyUn[uix].Health-Forecast.EndHealthAtt]); 152 TextSize:=ca.TextExtent(LabelText); 153 if TextSize.cy div 2>(LADamage-LAAvoidedDamage) div 2+LAAvoidedDamage then 154 begin 155 if Forecast.EndHealthAtt>0 then 156 RisedTextOut(ca,xm-(TextSize.cx+1) div 2, ym+8+LAAvoidedDamage,LabelText) 157 end 158 else RisedTextOut(ca,xm-(TextSize.cx+1) div 2, ym+8+LAAvoidedDamage+(LADamage-LAAvoidedDamage-TextSize.cy) div 2,LabelText); 159 160 NoMap.SetOutput(Buffer); 161 BitBlt(Buffer.Canvas.Handle,0,0,66,48,ca.Handle,xm+8+4,ym-8-12-48,SRCCOPY); 162 {if TerrType<fForest then 163 Sprite(Buffer,HGrTerrain,0,16,66,32,1+TerrType*(xxt*2+1),1+yyt) 164 else 165 begin 166 Sprite(Buffer,HGrTerrain,0,16,66,32,1+2*(xxt*2+1),1+yyt+2*(yyt*3+1)); 167 if (TerrType=fForest) and IsJungle(ToLoc div G.lx) then 54 euix, ADamage, DDamage, StrMax, DamageMax, MaxBar, LAStr, LDStr, LADamage, 55 LDDamage, LABaseDamage, LAAvoidedDamage, LDBaseDamage: Integer; 56 // TerrType: Cardinal; 57 UnitInfo: TUnitInfo; 58 TextSize: TSize; 59 LabelText: string; 60 FirstStrike: boolean; 61 begin 62 MaxBar := 65; 63 64 // TerrType:=MyMap[ToLoc] and fTerrain; 65 GetUnitInfo(ToLoc, euix, UnitInfo); 66 67 FirstStrike := (MyModel[MyUn[uix].mix].Cap[mcFirst] > 0) and 68 (Forecast.DBaseDamage >= UnitInfo.Health); 69 ADamage := MyUn[uix].Health - Forecast.EndHealthAtt; 70 if FirstStrike then 71 ADamage := ADamage + Forecast.ABaseDamage div 2; 72 DDamage := UnitInfo.Health - Forecast.EndHealthDef; 73 if Forecast.AStr > Forecast.DStr then 74 StrMax := Forecast.AStr 75 else 76 StrMax := Forecast.DStr; 77 if ADamage > DDamage then 78 DamageMax := ADamage 79 else 80 DamageMax := DDamage; 81 if Forecast.ABaseDamage > Forecast.DBaseDamage then 82 StrMax := StrMax * DamageMax div Forecast.ABaseDamage 83 else 84 StrMax := StrMax * DamageMax div Forecast.DBaseDamage; 85 86 LAStr := Forecast.AStr * MaxBar div StrMax; 87 LDStr := Forecast.DStr * MaxBar div StrMax; 88 LADamage := ADamage * MaxBar div DamageMax; 89 LABaseDamage := Forecast.ABaseDamage * MaxBar div DamageMax; 90 if FirstStrike then 91 LAAvoidedDamage := LABaseDamage div 2 92 else 93 LAAvoidedDamage := 0; 94 LDDamage := DDamage * MaxBar div DamageMax; 95 LDBaseDamage := Forecast.DBaseDamage * MaxBar div DamageMax; 96 97 DarkGradient(ca, xm - 8 - LAStr, ym - 8, LAStr, 2); 98 VDarkGradient(ca, xm - 8, ym - 8 - LDStr, LDStr, 2); 99 LightGradient(ca, xm + 8, ym - 8, LDBaseDamage, DamageColor); 100 if LDDamage > LDBaseDamage then 101 LightGradient(ca, xm + 8 + LDBaseDamage, ym - 8, LDDamage - LDBaseDamage, 102 FanaticColor); 103 if LAAvoidedDamage > 0 then 104 VLightGradient(ca, xm - 8, ym + 8, LAAvoidedDamage, FirstStrikeColor); 105 VLightGradient(ca, xm - 8, ym + 8 + LAAvoidedDamage, 106 LABaseDamage - LAAvoidedDamage, DamageColor); 107 if LADamage > LABaseDamage then 108 VLightGradient(ca, xm - 8, ym + 8 + LABaseDamage, LADamage - LABaseDamage, 109 FanaticColor); 110 BitBlt(ca.Handle, xm - 12, ym - 12, 24, 24, 111 GrExt[HGrSystem].Mask.Canvas.Handle, 26, 146, SRCAND); 112 BitBlt(ca.Handle, xm - 12, ym - 12, 24, 24, 113 GrExt[HGrSystem].Data.Canvas.Handle, 26, 146, SRCPAINT); 114 115 LabelText := Format('%d', [Forecast.AStr]); 116 TextSize := ca.TextExtent(LabelText); 117 if TextSize.cx div 2 + 2 > LAStr div 2 then 118 RisedTextOut(ca, xm - 10 - TextSize.cx, ym - (TextSize.cy + 1) div 2, 119 LabelText) 120 else 121 RisedTextOut(ca, xm - 8 - (LAStr + TextSize.cx) div 2, 122 ym - (TextSize.cy + 1) div 2, LabelText); 123 124 LabelText := Format('%d', [Forecast.DStr]); 125 TextSize := ca.TextExtent(LabelText); 126 if TextSize.cy div 2 > LDStr div 2 then 127 RisedTextOut(ca, xm - (TextSize.cx + 1) div 2, ym - 8 - TextSize.cy, 128 LabelText) 129 else 130 RisedTextOut(ca, xm - (TextSize.cx + 1) div 2, 131 ym - 8 - (LDStr + TextSize.cy) div 2, LabelText); 132 133 if Forecast.EndHealthDef <= 0 then 134 begin 135 BitBlt(ca.Handle, xm + 9 + LDDamage - 7, ym - 6, 14, 17, 136 GrExt[HGrSystem].Mask.Canvas.Handle, 51, 153, SRCAND); 137 BitBlt(ca.Handle, xm + 8 + LDDamage - 7, ym - 7, 14, 17, 138 GrExt[HGrSystem].Mask.Canvas.Handle, 51, 153, SRCAND); 139 BitBlt(ca.Handle, xm + 8 + LDDamage - 7, ym - 7, 14, 17, 140 GrExt[HGrSystem].Data.Canvas.Handle, 51, 153, SRCPAINT); 141 end; 142 LabelText := Format('%d', [DDamage]); 143 TextSize := ca.TextExtent(LabelText); 144 if TextSize.cx div 2 + 2 > LDDamage div 2 then 145 begin 146 if Forecast.EndHealthDef > 0 then 147 RisedTextOut(ca, xm + 10, ym - (TextSize.cy + 1) div 2, LabelText) 148 end 149 else 150 RisedTextOut(ca, xm + 8 + (LDDamage - TextSize.cx) div 2, 151 ym - (TextSize.cy + 1) div 2, LabelText); 152 153 if Forecast.EndHealthAtt <= 0 then 154 begin 155 BitBlt(ca.Handle, xm - 6, ym + 9 + LADamage - 7, 14, 17, 156 GrExt[HGrSystem].Mask.Canvas.Handle, 51, 153, SRCAND); 157 BitBlt(ca.Handle, xm - 7, ym + 8 + LADamage - 7, 14, 17, 158 GrExt[HGrSystem].Mask.Canvas.Handle, 51, 153, SRCAND); 159 BitBlt(ca.Handle, xm - 7, ym + 8 + LADamage - 7, 14, 17, 160 GrExt[HGrSystem].Data.Canvas.Handle, 51, 153, SRCPAINT); 161 end; 162 LabelText := Format('%d', [MyUn[uix].Health - Forecast.EndHealthAtt]); 163 TextSize := ca.TextExtent(LabelText); 164 if TextSize.cy div 2 > (LADamage - LAAvoidedDamage) div 2 + LAAvoidedDamage 165 then 166 begin 167 if Forecast.EndHealthAtt > 0 then 168 RisedTextOut(ca, xm - (TextSize.cx + 1) div 2, ym + 8 + LAAvoidedDamage, 169 LabelText) 170 end 171 else 172 RisedTextOut(ca, xm - (TextSize.cx + 1) div 2, ym + 8 + LAAvoidedDamage + 173 (LADamage - LAAvoidedDamage - TextSize.cy) div 2, LabelText); 174 175 NoMap.SetOutput(Buffer); 176 BitBlt(Buffer.Canvas.Handle, 0, 0, 66, 48, ca.Handle, xm + 8 + 4, 177 ym - 8 - 12 - 48, SRCCOPY); 178 { if TerrType<fForest then 179 Sprite(Buffer,HGrTerrain,0,16,66,32,1+TerrType*(xxt*2+1),1+yyt) 180 else 181 begin 182 Sprite(Buffer,HGrTerrain,0,16,66,32,1+2*(xxt*2+1),1+yyt+2*(yyt*3+1)); 183 if (TerrType=fForest) and IsJungle(ToLoc div G.lx) then 168 184 Sprite(Buffer,HGrTerrain,0,16,66,32,1+7*(xxt*2+1),1+yyt+19*(yyt*3+1)) 169 else Sprite(Buffer,HGrTerrain,0,16,66,32,1+7*(xxt*2+1),1+yyt+2*(2+TerrType-fForest)*(yyt*3+1)); 170 end;} 171 NoMap.PaintUnit(1,0,UnitInfo,0); 172 BitBlt(ca.Handle,xm+8+4,ym-8-12-48,66,48,Buffer.Canvas.Handle,0,0,SRCCOPY); 173 174 BitBlt(Buffer.Canvas.Handle,0,0,66,48,ca.Handle,xm-8-4-66,ym+8+12,SRCCOPY); 175 MakeUnitInfo(me,MyUn[uix],UnitInfo); 176 UnitInfo.Flags:=UnitInfo.Flags and not unFortified; 177 NoMap.PaintUnit(1,0,UnitInfo,0); 178 BitBlt(ca.Handle,xm-8-4-66,ym+8+12,66,48,Buffer.Canvas.Handle,0,0,SRCCOPY); 179 end; {PaintBattleOutcome} 180 185 else Sprite(Buffer,HGrTerrain,0,16,66,32,1+7*(xxt*2+1),1+yyt+2*(2+TerrType-fForest)*(yyt*3+1)); 186 end; } 187 NoMap.PaintUnit(1, 0, UnitInfo, 0); 188 BitBlt(ca.Handle, xm + 8 + 4, ym - 8 - 12 - 48, 66, 48, Buffer.Canvas.Handle, 189 0, 0, SRCCOPY); 190 191 BitBlt(Buffer.Canvas.Handle, 0, 0, 66, 48, ca.Handle, xm - 8 - 4 - 66, 192 ym + 8 + 12, SRCCOPY); 193 MakeUnitInfo(me, MyUn[uix], UnitInfo); 194 UnitInfo.Flags := UnitInfo.Flags and not unFortified; 195 NoMap.PaintUnit(1, 0, UnitInfo, 0); 196 BitBlt(ca.Handle, xm - 8 - 4 - 66, ym + 8 + 12, 66, 48, Buffer.Canvas.Handle, 197 0, 0, SRCCOPY); 198 end; { PaintBattleOutcome } 181 199 182 200 procedure TBattleDlg.FormCreate(Sender: TObject); 183 201 begin 184 OKBtn.Caption:=Phrases.Lookup('BTN_YES');185 CancelBtn.Caption:=Phrases.Lookup('BTN_NO');186 InitButtons();202 OKBtn.Caption := Phrases.Lookup('BTN_YES'); 203 CancelBtn.Caption := Phrases.Lookup('BTN_NO'); 204 InitButtons(); 187 205 end; 188 206 189 207 procedure TBattleDlg.FormShow(Sender: TObject); 190 208 begin 191 if IsSuicideQuery then192 begin 193 ClientWidth:=300;194 ClientHeight:=288;195 OKBtn.Visible:=true;196 CancelBtn.Visible:=true;197 Left:=(Screen.Width-ClientWidth) div 2; // center on screen198 Top:=(Screen.Height-ClientHeight) div 2;199 end 200 else201 begin 202 ClientWidth:=178;203 ClientHeight:=178;204 OKBtn.Visible:=false;205 CancelBtn.Visible:=false;209 if IsSuicideQuery then 210 begin 211 ClientWidth := 300; 212 ClientHeight := 288; 213 OKBtn.Visible := true; 214 CancelBtn.Visible := true; 215 Left := (Screen.Width - ClientWidth) div 2; // center on screen 216 Top := (Screen.Height - ClientHeight) div 2; 217 end 218 else 219 begin 220 ClientWidth := 178; 221 ClientHeight := 178; 222 OKBtn.Visible := false; 223 CancelBtn.Visible := false; 206 224 end; 207 225 end; … … 209 227 procedure TBattleDlg.FormPaint(Sender: TObject); 210 228 var 211 ym,cix,p: integer; 212 s,s1: string; 213 begin 214 with Canvas do 215 begin 216 Brush.Color:=0; 217 FillRect(Rect(0,0,ClientWidth,ClientHeight)); 218 Brush.Style:=bsClear; 219 PaintBackground(self,3+Border,3+Border,ClientWidth-(6+2*Border), 220 ClientHeight-(6+2*Border)) 221 end; 222 Frame(Canvas,Border+1,Border+1,ClientWidth-(2+Border),ClientHeight-(2+Border), 223 MainTexture.clBevelLight,MainTexture.clBevelShade); 224 Frame(Canvas,2+Border,2+Border,ClientWidth-(3+Border),ClientHeight-(3+Border), 225 MainTexture.clBevelLight,MainTexture.clBevelShade); 226 227 if IsSuicideQuery then 228 begin 229 Canvas.Font.Assign(UniFont[ftCaption]); 230 s:=Phrases.Lookup('TITLE_SUICIDE'); 231 RisedTextout(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 7+Border, s); 232 Canvas.Font.Assign(UniFont[ftNormal]); 233 s:=Phrases.Lookup('SUICIDE'); 234 p:=pos('\',s); 235 if p=0 then 236 RisedTextout(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 205, s) 237 else 229 ym, cix, p: Integer; 230 s, s1: string; 231 begin 232 with Canvas do 233 begin 234 Brush.Color := 0; 235 FillRect(Rect(0, 0, ClientWidth, ClientHeight)); 236 Brush.Style := bsClear; 237 PaintBackground(self, 3 + Border, 3 + Border, 238 ClientWidth - (6 + 2 * Border), ClientHeight - (6 + 2 * Border)) 239 end; 240 Frame(Canvas, Border + 1, Border + 1, ClientWidth - (2 + Border), 241 ClientHeight - (2 + Border), MainTexture.clBevelLight, 242 MainTexture.clBevelShade); 243 Frame(Canvas, 2 + Border, 2 + Border, ClientWidth - (3 + Border), 244 ClientHeight - (3 + Border), MainTexture.clBevelLight, 245 MainTexture.clBevelShade); 246 247 if IsSuicideQuery then 248 begin 249 Canvas.Font.Assign(UniFont[ftCaption]); 250 s := Phrases.Lookup('TITLE_SUICIDE'); 251 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 252 7 + Border, s); 253 Canvas.Font.Assign(UniFont[ftNormal]); 254 s := Phrases.Lookup('SUICIDE'); 255 p := pos('\', s); 256 if p = 0 then 257 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s)) 258 div 2, 205, s) 259 else 238 260 begin 239 s1:=copy(s,1,p-1);240 RisedTextout(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s1)) div 2,241 205-MessageLineSpacing div 2, s1);242 s1:=copy(s,p+1,255);243 RisedTextout(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s1)) div 2,244 205+(MessageLineSpacing-MessageLineSpacing div 2), s1);261 s1 := copy(s, 1, p - 1); 262 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s1)) div 2, 263 205 - MessageLineSpacing div 2, s1); 264 s1 := copy(s, p + 1, 255); 265 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s1)) div 2, 266 205 + (MessageLineSpacing - MessageLineSpacing div 2), s1); 245 267 end; 246 ym:=110 247 end 248 else ym:=ClientHeight div 2; 249 Canvas.Font.Assign(UniFont[ftSmall]); 250 PaintBattleOutcome(Canvas, ClientWidth div 2, ym, uix, ToLoc, Forecast); 251 252 for cix:=0 to ControlCount-1 do 253 if (Controls[cix].Visible) and (Controls[cix] is TButtonBase) then 254 BtnFrame(Canvas,Controls[cix].BoundsRect,MainTexture); 268 ym := 110 269 end 270 else 271 ym := ClientHeight div 2; 272 Canvas.Font.Assign(UniFont[ftSmall]); 273 PaintBattleOutcome(Canvas, ClientWidth div 2, ym, uix, ToLoc, Forecast); 274 275 for cix := 0 to ControlCount - 1 do 276 if (Controls[cix].Visible) and (Controls[cix] is TButtonBase) then 277 BtnFrame(Canvas, Controls[cix].BoundsRect, MainTexture); 255 278 end; 256 279 … … 258 281 Shift: TShiftState; X, Y: Integer); 259 282 begin 260 if not IsSuicideQuery then261 Close;283 if not IsSuicideQuery then 284 Close; 262 285 end; 263 286 264 287 procedure TBattleDlg.FormDeactivate(Sender: TObject); 265 288 begin 266 if not IsSuicideQuery then267 Close289 if not IsSuicideQuery then 290 Close 268 291 end; 269 292 … … 271 294 Shift: TShiftState); 272 295 begin 273 if not IsSuicideQuery and (Key<>VK_SHIFT) then274 begin 275 Close;276 MainScreen.Update;277 if Key<>VK_ESCAPE then278 MainScreen.FormKeyDown(Sender, Key, Shift);296 if not IsSuicideQuery and (Key <> VK_SHIFT) then 297 begin 298 Close; 299 MainScreen.Update; 300 if Key <> VK_ESCAPE then 301 MainScreen.FormKeyDown(Sender, Key, Shift); 279 302 end 280 303 end; … … 282 305 procedure TBattleDlg.OKBtnClick(Sender: TObject); 283 306 begin 284 ModalResult:=mrOK;307 ModalResult := mrOK; 285 308 end; 286 309 287 310 procedure TBattleDlg.CancelBtnClick(Sender: TObject); 288 311 begin 289 ModalResult:=mrCancel;312 ModalResult := mrCancel; 290 313 end; 291 314 292 315 end. 293 -
trunk/LocalPlayer/CityScreen.pas
r3 r6 1 1 {$INCLUDE switches} 2 3 2 unit CityScreen; 4 3 … … 6 5 7 6 uses 8 Protocol,ClientTools,Term,ScreenTools,IsoEngine,BaseWin, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ExtCtrls,ButtonA, 7 Protocol, ClientTools, Term, ScreenTools, IsoEngine, BaseWin, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 10 ButtonA, 11 11 ButtonB, ButtonBase, ButtonC, Area; 12 12 13 13 const 14 WM_PLAYSOUND=WM_USER;14 WM_PLAYSOUND = WM_USER; 15 15 16 16 type 17 TCityCloseAction =(None, RestoreFocus, StepFocus);17 TCityCloseAction = (None, RestoreFocus, StepFocus); 18 18 19 19 TCityDlg = class(TBufferedDrawDlg) … … 36 36 Pop1Area: TArea; 37 37 SupportArea: TArea; 38 procedure FormCreate(Sender: TObject);39 procedure FormDestroy(Sender: TObject);40 procedure FormMouseDown(Sender: TObject;Button:TMouseButton;41 Shift: TShiftState;x,y:integer);42 procedure BuyClick(Sender: TObject);43 procedure CloseBtnClick(Sender: TObject);38 procedure FormCreate(Sender: TObject); 39 procedure FormDestroy(Sender: TObject); 40 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 41 Shift: TShiftState; x, y: integer); 42 procedure BuyClick(Sender: TObject); 43 procedure CloseBtnClick(Sender: TObject); 44 44 procedure FormShow(Sender: TObject); 45 45 procedure FormClose(Sender: TObject; var Action: TCloseAction); … … 48 48 procedure NextCityBtnClick(Sender: TObject); 49 49 procedure PrevCityBtnClick(Sender: TObject); 50 procedure FormKeyDown(Sender: TObject; var Key: Word; 51 Shift: TShiftState); 52 //procedure AdviceBtnClick(Sender: TObject); 50 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 51 // procedure AdviceBtnClick(Sender: TObject); 53 52 procedure PageUpBtnClick(Sender: TObject); 54 53 procedure PageDownBtnClick(Sender: TObject); … … 58 57 CloseAction: TCityCloseAction; 59 58 procedure OffscreenPaint; override; 60 procedure ShowNewContent(NewMode, Loc: integer; ShowEvent: cardinal);59 procedure ShowNewContent(NewMode, Loc: integer; ShowEvent: cardinal); 61 60 procedure Reset; 62 61 procedure CheckAge; … … 64 63 private 65 64 c: TCity; 66 Report:TCityReportNew; 67 cOwner,cGov, 68 emix{enemy model index of produced unit}, 69 cix,cLoc,Mode,ZoomArea,Page,PageCount,BlinkTime,OpenSoundEvent, 70 SizeClass,AgePrepared: integer; 71 Optimize_cixTileChange,Optimize_TilesBeforeChange: integer; 65 Report: TCityReportNew; 66 cOwner, cGov, emix { enemy model index of produced unit } , cix, cLoc, Mode, 67 ZoomArea, Page, PageCount, BlinkTime, OpenSoundEvent, SizeClass, 68 AgePrepared: integer; 69 Optimize_cixTileChange, Optimize_TilesBeforeChange: integer; 72 70 Happened: cardinal; 73 imix: array[0..15] of integer;71 imix: array [0 .. 15] of integer; 74 72 CityAreaInfo: TCityAreaInfo; 75 73 AreaMap: TIsoMap; 76 CityMapTemplate, SmallCityMapTemplate, Back, SmallCityMap, ZoomCityMap, Template: TBitmap; 77 IsPort,ProdHint,AllowChange: boolean; 74 CityMapTemplate, SmallCityMapTemplate, Back, SmallCityMap, ZoomCityMap, 75 Template: TBitmap; 76 IsPort, ProdHint, AllowChange: boolean; 78 77 procedure InitSmallCityMap; 79 78 procedure InitZoomCityMap; … … 81 80 procedure ChangeCity(d: integer); 82 81 procedure ChangeResourceWeights(iResourceWeights: integer); 83 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND;82 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND; 84 83 end; 85 84 86 85 var 87 CityDlg: TCityDlg;86 CityDlg: TCityDlg; 88 87 89 88 implementation 90 89 91 90 uses 92 Select, Messg,MessgEx,Help,Inp,Tribes,Directories,91 Select, Messg, MessgEx, Help, Inp, Tribes, Directories, 93 92 94 93 Math; … … 97 96 98 97 const 99 {modes} 100 mSupp=1; mImp=2; 101 102 wBar=106; 103 xDiv=400; xService=296; 104 xmArea=197; ymArea=170; 105 xView=326; yView=275; 106 dxBar=wBar+12; dyBar=39; 107 xHapp=404; yHapp=9; 108 xFood=404; yFood=yHapp+3*dyBar+6; 109 xProd=404; yProd=yFood+3*dyBar+6; 110 xTrade=404; yTrade=yProd+2*dyBar+22; 111 xPoll=xmArea-186; yPoll=ymArea+64; 112 xmOpt=40; ymOpt=ymArea+96+34; 113 xSmallMap=271; ySmallMap=339; wSmallMap=98; hSmallMap=74; 114 xSupport=xSmallMap; ySupport=ySmallmap+hSmallmap+2; wSupport=64; hSupport=18; 115 xZoomMap=34; yZoomMap=338; wZoomMap=228; hZoomMap=124; wZoomEnvironment=68; 116 117 ImpPosition: array[28..nImp-1] of integer= 118 (-1, //imTrGoods 119 21, //imBarracks 120 6, //imGranary 121 1, //imTemple 122 7, //imMarket 123 14, //imLibrary 124 8, //imCourt 125 18, //imWalls 126 10, //imAqueduct 127 11, //imBank 128 5, //imCathedral 129 13, //imUniversity 130 29, //imHarbor 131 2, //imTheater 132 24, //imFactory 133 25, //imMfgPlant 134 28, //imRecycling 135 27, //imPower 136 27, //imHydro 137 27, //imNuclear 138 26, //imPlatform 139 8, //imTownHall 140 10, //imSewer 141 3, //imSupermarket 142 17, //imHighways 143 15, //imResLab 144 19, //imMissileBat 145 23, //imCoastalFort 146 22, //imAirport 147 20, //imDockyard 148 8, //imPalace 149 -1, //imGrWall 150 4, //imColosseum 151 16, //imObservatory 152 21, //imMilAcademy 153 -1, //imBunker 154 -1, //imAlgae 155 9, //imStockEx 156 -1, //imSpacePort 157 -1, //imShipComp 158 -1, //imShipPow 159 -1); //imShipHab 160 98 { modes } 99 mSupp = 1; 100 mImp = 2; 101 102 wBar = 106; 103 xDiv = 400; 104 xService = 296; 105 xmArea = 197; 106 ymArea = 170; 107 xView = 326; 108 yView = 275; 109 dxBar = wBar + 12; 110 dyBar = 39; 111 xHapp = 404; 112 yHapp = 9; 113 xFood = 404; 114 yFood = yHapp + 3 * dyBar + 6; 115 xProd = 404; 116 yProd = yFood + 3 * dyBar + 6; 117 xTrade = 404; 118 yTrade = yProd + 2 * dyBar + 22; 119 xPoll = xmArea - 186; 120 yPoll = ymArea + 64; 121 xmOpt = 40; 122 ymOpt = ymArea + 96 + 34; 123 xSmallMap = 271; 124 ySmallMap = 339; 125 wSmallMap = 98; 126 hSmallMap = 74; 127 xSupport = xSmallMap; 128 ySupport = ySmallMap + hSmallMap + 2; 129 wSupport = 64; 130 hSupport = 18; 131 xZoomMap = 34; 132 yZoomMap = 338; 133 wZoomMap = 228; 134 hZoomMap = 124; 135 wZoomEnvironment = 68; 136 137 ImpPosition: array [28 .. nImp - 1] of integer = (-1, // imTrGoods 138 21, // imBarracks 139 6, // imGranary 140 1, // imTemple 141 7, // imMarket 142 14, // imLibrary 143 8, // imCourt 144 18, // imWalls 145 10, // imAqueduct 146 11, // imBank 147 5, // imCathedral 148 13, // imUniversity 149 29, // imHarbor 150 2, // imTheater 151 24, // imFactory 152 25, // imMfgPlant 153 28, // imRecycling 154 27, // imPower 155 27, // imHydro 156 27, // imNuclear 157 26, // imPlatform 158 8, // imTownHall 159 10, // imSewer 160 3, // imSupermarket 161 17, // imHighways 162 15, // imResLab 163 19, // imMissileBat 164 23, // imCoastalFort 165 22, // imAirport 166 20, // imDockyard 167 8, // imPalace 168 -1, // imGrWall 169 4, // imColosseum 170 16, // imObservatory 171 21, // imMilAcademy 172 -1, // imBunker 173 -1, // imAlgae 174 9, // imStockEx 175 -1, // imSpacePort 176 -1, // imShipComp 177 -1, // imShipPow 178 -1); // imShipHab 161 179 162 180 var 163 ImpSorted: array[0..nImp-1] of integer; 164 165 166 procedure TCityDlg.FormCreate(Sender:TObject); 167 begin 168 inherited; 169 AreaMap:=TIsoMap.Create; 170 AreaMap.SetOutput(offscreen); 171 AreaMap.SetPaintBounds(xmArea-192,ymArea-96-32,xmArea+192,ymArea+96); 172 Mode:=mImp; 173 ZoomArea:=1; 174 ProdHint:=false; 175 RestoreUnFocus:=-1; 176 OpenSoundEvent:=-1; 177 AgePrepared:=-2; 178 Optimize_cixTileChange:=-1; 179 InitButtons(); 180 //InitWindowRegion; 181 CloseBtn.Caption:=Phrases.Lookup('BTN_OK'); 182 BuyBtn.Hint:=Phrases.Lookup('BTN_BUY'); 183 if not Phrases2FallenBackToEnglish then 184 SupportArea.Hint:=Phrases2.Lookup('TIP_SUPUNITS') 185 else SupportArea.Hint:=Phrases.Lookup('SUPUNITS'); 186 if not Phrases2FallenBackToEnglish then 187 begin 188 Pop0Area.Hint:=Phrases2.Lookup('TIP_WORKING'); 189 Pop1Area.Hint:=Phrases2.Lookup('TIP_CIVIL'); 190 PrimacyArea.Hint:=Phrases2.Lookup('TIP_PRIMACY'); 191 ProjectArea.Hint:=Phrases2.Lookup('TIP_PROJECT'); 192 end; 193 194 Back:=TBitmap.Create; 195 Back.PixelFormat:=pf24bit; 196 Back.Width:=ClientWidth; Back.Height:=ClientHeight; 197 Template:=TBitmap.Create; 198 LoadGraphicFile(Template, HomeDir+'Graphics\City', gfNoGamma); 199 Template.PixelFormat:=pf8bit; 200 CityMapTemplate:=TBitmap.Create; 201 LoadGraphicFile(CityMapTemplate, HomeDir+'Graphics\BigCityMap', gfNoGamma); 202 CityMapTemplate.PixelFormat:=pf8bit; 203 SmallCityMapTemplate:=TBitmap.Create; 204 LoadGraphicFile(SmallCityMapTemplate, HomeDir+'Graphics\SmallCityMap', gfNoGamma); 205 SmallCityMapTemplate.PixelFormat:=pf24bit; 206 SmallCityMap:=TBitmap.Create; 207 SmallCityMap.PixelFormat:=pf24bit; 208 SmallCityMap.Width:=98; SmallCityMap.Height:=74; 209 ZoomCityMap:=TBitmap.Create; 210 ZoomCityMap.PixelFormat:=pf24bit; 211 ZoomCityMap.Width:=228; ZoomCityMap.Height:=124; 212 end; 213 214 procedure TCityDlg.FormDestroy(Sender:TObject); 215 begin 216 AreaMap.Free; 217 SmallCityMap.Free; 218 ZoomCityMap.Free; 219 CityMapTemplate.Free; 220 Template.Free; 221 Back.Free; 181 ImpSorted: array [0 .. nImp - 1] of integer; 182 183 procedure TCityDlg.FormCreate(Sender: TObject); 184 begin 185 inherited; 186 AreaMap := TIsoMap.Create; 187 AreaMap.SetOutput(offscreen); 188 AreaMap.SetPaintBounds(xmArea - 192, ymArea - 96 - 32, xmArea + 192, 189 ymArea + 96); 190 Mode := mImp; 191 ZoomArea := 1; 192 ProdHint := false; 193 RestoreUnFocus := -1; 194 OpenSoundEvent := -1; 195 AgePrepared := -2; 196 Optimize_cixTileChange := -1; 197 InitButtons(); 198 // InitWindowRegion; 199 CloseBtn.Caption := Phrases.Lookup('BTN_OK'); 200 BuyBtn.Hint := Phrases.Lookup('BTN_BUY'); 201 if not Phrases2FallenBackToEnglish then 202 SupportArea.Hint := Phrases2.Lookup('TIP_SUPUNITS') 203 else 204 SupportArea.Hint := Phrases.Lookup('SUPUNITS'); 205 if not Phrases2FallenBackToEnglish then 206 begin 207 Pop0Area.Hint := Phrases2.Lookup('TIP_WORKING'); 208 Pop1Area.Hint := Phrases2.Lookup('TIP_CIVIL'); 209 PrimacyArea.Hint := Phrases2.Lookup('TIP_PRIMACY'); 210 ProjectArea.Hint := Phrases2.Lookup('TIP_PROJECT'); 211 end; 212 213 Back := TBitmap.Create; 214 Back.PixelFormat := pf24bit; 215 Back.Width := ClientWidth; 216 Back.Height := ClientHeight; 217 Template := TBitmap.Create; 218 LoadGraphicFile(Template, HomeDir + 'Graphics\City', gfNoGamma); 219 Template.PixelFormat := pf8bit; 220 CityMapTemplate := TBitmap.Create; 221 LoadGraphicFile(CityMapTemplate, HomeDir + 'Graphics\BigCityMap', gfNoGamma); 222 CityMapTemplate.PixelFormat := pf8bit; 223 SmallCityMapTemplate := TBitmap.Create; 224 LoadGraphicFile(SmallCityMapTemplate, HomeDir + 'Graphics\SmallCityMap', 225 gfNoGamma); 226 SmallCityMapTemplate.PixelFormat := pf24bit; 227 SmallCityMap := TBitmap.Create; 228 SmallCityMap.PixelFormat := pf24bit; 229 SmallCityMap.Width := 98; 230 SmallCityMap.Height := 74; 231 ZoomCityMap := TBitmap.Create; 232 ZoomCityMap.PixelFormat := pf24bit; 233 ZoomCityMap.Width := 228; 234 ZoomCityMap.Height := 124; 235 end; 236 237 procedure TCityDlg.FormDestroy(Sender: TObject); 238 begin 239 AreaMap.Free; 240 SmallCityMap.Free; 241 ZoomCityMap.Free; 242 CityMapTemplate.Free; 243 Template.Free; 244 Back.Free; 222 245 end; 223 246 224 247 procedure TCityDlg.Reset; 225 248 begin 226 Mode:=mImp;227 ZoomArea:=1;249 Mode := mImp; 250 ZoomArea := 1; 228 251 end; 229 252 230 253 procedure TCityDlg.CheckAge; 231 254 begin 232 if MainTextureAge<>AgePrepared then233 begin 234 AgePrepared:=MainTextureAge;235 bitblt(Back.Canvas.Handle,0,0,ClientWidth,ClientHeight,236 MainTexture.Image.Canvas.Handle,0,0,SRCCOPY);237 ImageOp_B(Back,Template,0,0,0,0,ClientWidth,ClientHeight);255 if MainTextureAge <> AgePrepared then 256 begin 257 AgePrepared := MainTextureAge; 258 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 259 MainTexture.Image.Canvas.Handle, 0, 0, SRCCOPY); 260 ImageOp_B(Back, Template, 0, 0, 0, 0, ClientWidth, ClientHeight); 238 261 end 239 262 end; 240 263 241 procedure TCityDlg.CloseBtnClick(Sender: TObject);242 begin 243 Close264 procedure TCityDlg.CloseBtnClick(Sender: TObject); 265 begin 266 Close 244 267 end; 245 268 246 269 procedure TCityDlg.InitSmallCityMap; 247 270 var 248 i,iix,cli1,Color0,Color1,Color2: integer; 249 begin 250 if cix>=0 then c:=MyCity[cix]; 251 case MyMap[cLoc] and fTerrain of 252 fPrairie: cli1:=cliPrairie; 253 fHills: cli1:=cliHills; 254 fTundra: cli1:=cliTundra; 255 else cli1:=cliPlains; 256 end; 257 Color0:=Colors.Canvas.Pixels[clkAge0+Age,cliRoad]; 258 Color1:=Colors.Canvas.Pixels[clkCity,cli1]; 259 Color2:=Colors.Canvas.Pixels[clkAge0+Age,cliHouse]; 260 BitBlt(SmallCityMap.Canvas.Handle,0,0,83,hSmallMap,SmallCityMapTemplate.Canvas.Handle,83*SizeClass,0,SRCCOPY); 261 if IsPort then 262 begin 263 BitBlt(SmallCityMap.Canvas.Handle,83,0,15,hSmallMap,SmallCityMapTemplate.Canvas.Handle,332+15,0,SRCCOPY); 264 ImageOp_CCC(SmallCityMap,0,0,83,hSmallMap,Color0,Color1,Color2); 265 Color2:=Colors.Canvas.Pixels[clkCity,cliWater]; 266 ImageOp_CCC(SmallCityMap,83,0,15,hSmallMap,Color0,Color1,Color2); 271 i, iix, cli1, Color0, Color1, Color2: integer; 272 begin 273 if cix >= 0 then 274 c := MyCity[cix]; 275 case MyMap[cLoc] and fTerrain of 276 fPrairie: 277 cli1 := cliPrairie; 278 fHills: 279 cli1 := cliHills; 280 fTundra: 281 cli1 := cliTundra; 282 else 283 cli1 := cliPlains; 284 end; 285 Color0 := Colors.Canvas.Pixels[clkAge0 + Age, cliRoad]; 286 Color1 := Colors.Canvas.Pixels[clkCity, cli1]; 287 Color2 := Colors.Canvas.Pixels[clkAge0 + Age, cliHouse]; 288 bitblt(SmallCityMap.Canvas.Handle, 0, 0, 83, hSmallMap, 289 SmallCityMapTemplate.Canvas.Handle, 83 * SizeClass, 0, SRCCOPY); 290 if IsPort then 291 begin 292 bitblt(SmallCityMap.Canvas.Handle, 83, 0, 15, hSmallMap, 293 SmallCityMapTemplate.Canvas.Handle, 332 + 15, 0, SRCCOPY); 294 ImageOp_CCC(SmallCityMap, 0, 0, 83, hSmallMap, Color0, Color1, Color2); 295 Color2 := Colors.Canvas.Pixels[clkCity, cliWater]; 296 ImageOp_CCC(SmallCityMap, 83, 0, 15, hSmallMap, Color0, Color1, Color2); 267 297 end 268 else 269 begin 270 BitBlt(SmallCityMap.Canvas.Handle,83,0,15,hSmallMap,SmallCityMapTemplate.Canvas.Handle,332,0,SRCCOPY); 271 ImageOp_CCC(SmallCityMap,0,0,wSmallMap,hSmallMap,Color0,Color1,Color2); 272 end; 273 274 with SmallCityMap.canvas do 275 begin 276 brush.Color:=Colors.Canvas.Pixels[clkAge0+Age,cliImp]; 277 for i:=0 to 29 do 278 begin 279 for iix:=28 to nImp-1 do 280 if (ImpPosition[iix]=i) and (c.Built[iix]>0) then 298 else 299 begin 300 bitblt(SmallCityMap.Canvas.Handle, 83, 0, 15, hSmallMap, 301 SmallCityMapTemplate.Canvas.Handle, 332, 0, SRCCOPY); 302 ImageOp_CCC(SmallCityMap, 0, 0, wSmallMap, hSmallMap, Color0, 303 Color1, Color2); 304 end; 305 306 with SmallCityMap.Canvas do 307 begin 308 brush.Color := Colors.Canvas.Pixels[clkAge0 + Age, cliImp]; 309 for i := 0 to 29 do 310 begin 311 for iix := 28 to nImp - 1 do 312 if (ImpPosition[iix] = i) and (c.Built[iix] > 0) then 281 313 begin 282 FillRect(Rect(5+16*(i mod 3)+48*(i div 18), 3+12*(i mod 18 div 3), 283 13+16*(i mod 3)+48*(i div 18), 11+12*(i mod 18 div 3))); 284 break; 314 FillRect(Rect(5 + 16 * (i mod 3) + 48 * (i div 18), 315 3 + 12 * (i mod 18 div 3), 13 + 16 * (i mod 3) + 48 * (i div 18), 316 11 + 12 * (i mod 18 div 3))); 317 break; 285 318 end 286 319 end; 287 i:=30;288 for iix:=0 to nImp do289 if (c.Built[iix]>0) and ((iix<28) or (ImpPosition[iix]<0)) then320 i := 30; 321 for iix := 0 to nImp do 322 if (c.Built[iix] > 0) and ((iix < 28) or (ImpPosition[iix] < 0)) then 290 323 begin 291 FillRect(Rect(5+16*(i mod 3)+48*(i div 18), 3+12*(i mod 18 div 3), 292 13+16*(i mod 3)+48*(i div 18), 11+12*(i mod 18 div 3))); 293 inc(i); 294 if i=36 then break; // area is full 324 FillRect(Rect(5 + 16 * (i mod 3) + 48 * (i div 18), 325 3 + 12 * (i mod 18 div 3), 13 + 16 * (i mod 3) + 48 * (i div 18), 326 11 + 12 * (i mod 18 div 3))); 327 inc(i); 328 if i = 36 then 329 break; // area is full 295 330 end; 296 if c.Project and cpImp<>0 then297 begin 298 iix:=c.Project and cpIndex;299 if iix<>imTrGoods then331 if c.Project and cpImp <> 0 then 332 begin 333 iix := c.Project and cpIndex; 334 if iix <> imTrGoods then 300 335 begin 301 if (iix>=28) and (ImpPosition[iix]>=0) then302 i:=ImpPosition[iix];303 if i<36 then336 if (iix >= 28) and (ImpPosition[iix] >= 0) then 337 i := ImpPosition[iix]; 338 if i < 36 then 304 339 begin 305 brush.Color:=Colors.Canvas.Pixels[clkAge0+Age,cliImpProject]; 306 FillRect(Rect(5+16*(i mod 3)+48*(i div 18), 3+12*(i mod 18 div 3), 307 13+16*(i mod 3)+48*(i div 18), 11+12*(i mod 18 div 3))); 340 brush.Color := Colors.Canvas.Pixels[clkAge0 + Age, cliImpProject]; 341 FillRect(Rect(5 + 16 * (i mod 3) + 48 * (i div 18), 342 3 + 12 * (i mod 18 div 3), 13 + 16 * (i mod 3) + 48 * (i div 18), 343 11 + 12 * (i mod 18 div 3))); 308 344 end 309 345 end 310 346 end; 311 brush.style:=bsClear;347 brush.style := bsClear; 312 348 end 313 349 end; … … 315 351 procedure TCityDlg.InitZoomCityMap; 316 352 begin 317 bitblt(ZoomCityMap.canvas.handle,0,0,wZoomMap,hZoomMap,Back.Canvas.handle, 318 xZoomMap,yZoomMap,SRCCOPY); 319 if Mode=mImp then 320 begin 321 if ZoomArea<3 then 322 ImageOp_B(ZoomCityMap,CityMapTemplate,0,0,376*SizeClass, 323 112*ZoomArea,wZoomMap,hZoomMap) 324 else 325 begin 326 ImageOp_B(ZoomCityMap,CityMapTemplate,0,0,376*SizeClass+216, 327 112*(ZoomArea-3),wZoomMap-wZoomEnvironment,hZoomMap); 328 ImageOp_B(ZoomCityMap,CityMapTemplate,wZoomMap-wZoomEnvironment,0, 329 1504+wZoomEnvironment*byte(IsPort),112*(ZoomArea-3),wZoomEnvironment,hZoomMap); 330 end; 331 end 353 bitblt(ZoomCityMap.Canvas.Handle, 0, 0, wZoomMap, hZoomMap, 354 Back.Canvas.Handle, xZoomMap, yZoomMap, SRCCOPY); 355 if Mode = mImp then 356 begin 357 if ZoomArea < 3 then 358 ImageOp_B(ZoomCityMap, CityMapTemplate, 0, 0, 376 * SizeClass, 359 112 * ZoomArea, wZoomMap, hZoomMap) 360 else 361 begin 362 ImageOp_B(ZoomCityMap, CityMapTemplate, 0, 0, 376 * SizeClass + 216, 363 112 * (ZoomArea - 3), wZoomMap - wZoomEnvironment, hZoomMap); 364 ImageOp_B(ZoomCityMap, CityMapTemplate, wZoomMap - wZoomEnvironment, 0, 365 1504 + wZoomEnvironment * byte(IsPort), 112 * (ZoomArea - 3), 366 wZoomEnvironment, hZoomMap); 367 end; 368 end 332 369 end; 333 370 334 371 procedure TCityDlg.OffscreenPaint; 335 372 336 procedure FillBar(x,y,pos,Growth,max,Kind: integer; IndicateComplete: boolean); 373 procedure FillBar(x, y, pos, Growth, max, Kind: integer; 374 IndicateComplete: boolean); 337 375 var 338 Tex: TTexture;339 begin 340 Tex:=MainTexture;341 if Kind=3 then342 begin 343 Tex.clBevelLight:=GrExt[HGrSystem].Data.Canvas.Pixels[104,36];344 Tex.clBevelShade:=Tex.clBevelLight;345 end; 346 PaintRelativeProgressBar(offscreen.Canvas,Kind,x-3,y,wBar-4,pos,Growth,max,347 IndicateComplete,Tex);348 end; 349 350 procedure PaintResources(x, y,Loc:integer; Add4Happy: boolean);376 Tex: TTexture; 377 begin 378 Tex := MainTexture; 379 if Kind = 3 then 380 begin 381 Tex.clBevelLight := GrExt[HGrSystem].Data.Canvas.Pixels[104, 36]; 382 Tex.clBevelShade := Tex.clBevelLight; 383 end; 384 PaintRelativeProgressBar(offscreen.Canvas, Kind, x - 3, y, wBar - 4, pos, 385 Growth, max, IndicateComplete, Tex); 386 end; 387 388 procedure PaintResources(x, y, Loc: integer; Add4Happy: boolean); 351 389 var 352 d,i,Total,xGr,yGr:integer; 353 TileInfo:TTileInfo; 354 rare: boolean; 355 begin 356 if Server(sGetCityTileInfo,me,Loc,TileInfo)<>eOk then 357 begin assert(cix<0); exit end; 358 Total:=TileInfo.Food+TileInfo.Prod+TileInfo.Trade; 359 rare:=MyMap[Loc] and $06000000>0; 360 if rare then 361 inc(Total); 362 if Add4Happy then 363 inc(Total,4); 364 if Total>1 then d:=(xxt-11) div (Total-1); 365 if d<1 then d:=1; 366 if d>4 then d:=4; 367 for i:=0 to Total-1 do 368 begin 369 yGr:=115; 370 if Add4Happy and (i>=Total-4) then 371 begin xGr:=132; yGr:=126 end 372 else if rare and (i=Total-1) then xGr:=66+110 373 else if i>=TileInfo.Food+TileInfo.Prod then xGr:=66+44 374 else if i>=TileInfo.Prod then xGr:=66 375 else xGr:=66+22; 376 Sprite(offscreen,HGrSystem,x+xxt-5+d*(2*i+1-Total),y+yyt-5,10,10,xGr,yGr); 390 d, i, Total, xGr, yGr: integer; 391 TileInfo: TTileInfo; 392 rare: boolean; 393 begin 394 if Server(sGetCityTileInfo, me, Loc, TileInfo) <> eOk then 395 begin 396 assert(cix < 0); 397 exit 398 end; 399 Total := TileInfo.Food + TileInfo.Prod + TileInfo.Trade; 400 rare := MyMap[Loc] and $06000000 > 0; 401 if rare then 402 inc(Total); 403 if Add4Happy then 404 inc(Total, 4); 405 if Total > 1 then 406 d := (xxt - 11) div (Total - 1); 407 if d < 1 then 408 d := 1; 409 if d > 4 then 410 d := 4; 411 for i := 0 to Total - 1 do 412 begin 413 yGr := 115; 414 if Add4Happy and (i >= Total - 4) then 415 begin 416 xGr := 132; 417 yGr := 126 418 end 419 else if rare and (i = Total - 1) then 420 xGr := 66 + 110 421 else if i >= TileInfo.Food + TileInfo.Prod then 422 xGr := 66 + 44 423 else if i >= TileInfo.Prod then 424 xGr := 66 425 else 426 xGr := 66 + 22; 427 Sprite(offscreen, HGrSystem, x + xxt - 5 + d * (2 * i + 1 - Total), 428 y + yyt - 5, 10, 10, xGr, yGr); 377 429 end 378 430 end; 379 431 380 procedure MakeRed(x, y,w,h: integer);432 procedure MakeRed(x, y, w, h: integer); 381 433 type 382 TLine=array[0..99999,0..2] of Byte;383 PLine=^TLine;434 TLine = array [0 .. 99999, 0 .. 2] of byte; 435 PLine = ^TLine; 384 436 385 437 procedure RedLine(line: PLine; length: integer); 386 438 var 387 i,gray: integer;388 begin 389 for i:=0 to length-1 do439 i, gray: integer; 440 begin 441 for i := 0 to length - 1 do 390 442 begin 391 gray:=(integer(line[i,0])+integer(line[i,1])+integer(line[i,2])) *85 shr 8; 392 line[i,0]:=0; 393 line[i,1]:=0; 394 line[i,2]:=gray; //255-(255-gray) div 2; 443 gray := (integer(line[i, 0]) + integer(line[i, 1]) + integer(line[i, 2]) 444 ) * 85 shr 8; 445 line[i, 0] := 0; 446 line[i, 1] := 0; 447 line[i, 2] := gray; // 255-(255-gray) div 2; 395 448 end 396 449 end; 397 450 398 451 var 399 i: integer;400 begin 401 for i:=0 to h-1 do402 RedLine(@(PLine(Offscreen.ScanLine[y+i])[x]),w)452 i: integer; 453 begin 454 for i := 0 to h - 1 do 455 RedLine(@(PLine(offscreen.ScanLine[y + i])[x]), w) 403 456 end; 404 457 405 458 var 406 line, MessageCount: integer;459 line, MessageCount: integer; 407 460 408 461 procedure CheckMessage(Flag: integer); 409 462 var 410 i, test: integer; 411 s: string; 412 begin 413 if Happened and Flag<>0 then 414 begin 415 i:=0; 416 test:=1; 417 while test<Flag do begin inc(i); inc(test,test) end; 418 419 if AllowChange and (Sounds<>nil) and (OpenSoundEvent=-1) then 463 i, test: integer; 464 s: string; 465 begin 466 if Happened and Flag <> 0 then 467 begin 468 i := 0; 469 test := 1; 470 while test < Flag do 420 471 begin 421 s:=CityEventSoundItem[i]; 422 if s<>'' then s:=Sounds.Lookup(s); 423 if (Flag=chProduction) or (s<>'') and (s[1]<>'*') and (s[1]<>'[') then 424 OpenSoundEvent:=i 472 inc(i); 473 inc(test, test) 425 474 end; 426 475 427 s:=CityEventName(i); 428 { if Flag=chNoGrowthWarning then 429 if c.Built[imAqueduct]=0 then 476 if AllowChange and (Sounds <> nil) and (OpenSoundEvent = -1) then 477 begin 478 s := CityEventSoundItem[i]; 479 if s <> '' then 480 s := Sounds.Lookup(s); 481 if (Flag = chProduction) or (s <> '') and (s[1] <> '*') and (s[1] <> '[') 482 then 483 OpenSoundEvent := i 484 end; 485 486 s := CityEventName(i); 487 { if Flag=chNoGrowthWarning then 488 if c.Built[imAqueduct]=0 then 430 489 s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imAqueduct)]) 431 else s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imSewer)]);} 432 RisedTextOut(offscreen.Canvas,xmOpt+40,ymOpt-1-8*MessageCount+16*line,s); 433 inc(line) 490 else s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imSewer)]); } 491 RisedTextOut(offscreen.Canvas, xmOpt + 40, ymOpt - 1 - 8 * MessageCount + 492 16 * line, s); 493 inc(line) 434 494 end 435 495 end; 436 496 437 497 var 438 x,y,xGr,i,i1,j,iix,d,dx,dy,PrCost,Cnt,Loc1,FreeSupp,Paintiix,HappyGain, 439 OptiType,rx,ry,TrueFood,TrueProd,TruePoll: integer; 440 av: Integer; 441 PrName,s:string; 442 UnitInfo: TUnitInfo; 443 UnitReport: TUnitReport; 444 RedTex: TTexture; 445 IsCityAlive,CanGrow: boolean; 446 begin 447 inherited; 448 if cix>=0 then c:=MyCity[cix]; 449 Report.HypoTiles:=-1; 450 Report.HypoTaxRate:=-1; 451 Report.HypoLuxuryRate:=-1; 452 if cix>=0 then Server(sGetCityReportNew,me,cix,Report) // own city 453 else Server(sGetEnemyCityReportNew,me,cLoc,Report); // enemy city 454 TrueFood:=c.Food; 455 TrueProd:=c.Prod; 456 TruePoll:=c.Pollution; 457 if supervising or (cix<0) then 498 x, y, xGr, i, i1, j, iix, d, dx, dy, PrCost, Cnt, Loc1, FreeSupp, Paintiix, 499 HappyGain, OptiType, rx, ry, TrueFood, TrueProd, TruePoll: integer; 500 av: integer; 501 PrName, s: string; 502 UnitInfo: TUnitInfo; 503 UnitReport: TUnitReport; 504 RedTex: TTexture; 505 IsCityAlive, CanGrow: boolean; 506 begin 507 inherited; 508 if cix >= 0 then 509 c := MyCity[cix]; 510 Report.HypoTiles := -1; 511 Report.HypoTaxRate := -1; 512 Report.HypoLuxuryRate := -1; 513 if cix >= 0 then 514 Server(sGetCityReportNew, me, cix, Report) // own city 515 else 516 Server(sGetEnemyCityReportNew, me, cLoc, Report); // enemy city 517 TrueFood := c.Food; 518 TrueProd := c.Prod; 519 TruePoll := c.Pollution; 520 if supervising or (cix < 0) then 458 521 begin // normalize city from after-turn state 459 dec(TrueFood,Report.FoodSurplus); 460 if TrueFood<0 then 461 TrueFood:=0; // shouldn't happen 462 dec(TrueProd,Report.Production); 463 if TrueProd<0 then 464 TrueProd:=0; // shouldn't happen 465 dec(TruePoll,Report.AddPollution); 466 if TruePoll<0 then 467 TruePoll:=0; // shouldn't happen 468 end; 469 IsCityAlive:= (cGov<>gAnarchy) and (c.Flags and chCaptured=0); 470 if not IsCityAlive then Report.Working:=c.Size; 471 472 RedTex:=MainTexture; 473 RedTex.clBevelLight:=$0000FF; 474 RedTex.clBevelShade:=$000000; 475 RedTex.clTextLight:=$000000; 476 RedTex.clTextShade:=$0000FF; 477 478 bitblt(offscreen.canvas.handle,0,0,640,480,Back.Canvas.handle,0,0,SRCCOPY); 479 480 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 481 RisedTextout(offscreen.Canvas,42,7,Caption); 482 with offscreen.canvas do 522 dec(TrueFood, Report.FoodSurplus); 523 if TrueFood < 0 then 524 TrueFood := 0; // shouldn't happen 525 dec(TrueProd, Report.Production); 526 if TrueProd < 0 then 527 TrueProd := 0; // shouldn't happen 528 dec(TruePoll, Report.AddPollution); 529 if TruePoll < 0 then 530 TruePoll := 0; // shouldn't happen 531 end; 532 IsCityAlive := (cGov <> gAnarchy) and (c.Flags and chCaptured = 0); 533 if not IsCityAlive then 534 Report.Working := c.Size; 535 536 RedTex := MainTexture; 537 RedTex.clBevelLight := $0000FF; 538 RedTex.clBevelShade := $000000; 539 RedTex.clTextLight := $000000; 540 RedTex.clTextShade := $0000FF; 541 542 bitblt(offscreen.Canvas.Handle, 0, 0, 640, 480, Back.Canvas.Handle, 0, 543 0, SRCCOPY); 544 545 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 546 RisedTextOut(offscreen.Canvas, 42, 7, Caption); 547 with offscreen.Canvas do 483 548 begin // city size 484 brush.color:=$000000; 485 fillrect(rect(8+1,7+1,36+1,32+1)); 486 brush.color:=$FFFFFF; 487 fillrect(rect(8,7,36,32)); 488 brush.style:=bsClear; 489 font.color:=$000000; 490 s:=inttostr(c.Size); 491 TextOut(8+14-textwidth(s) div 2, 7, s); 492 end; 493 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 494 495 if not IsCityAlive then 496 begin 497 MakeRed(18,280,298,40); 498 if cGov=gAnarchy then s:=Phrases.Lookup('GOVERNMENT',gAnarchy) 499 else {if c.Flags and chCaptured<>0 then} 500 s:=Phrases.Lookup('CITYEVENTS',14); 501 RisedTextout(offscreen.canvas,167-BiColorTextWidth(offscreen.canvas,s) div 2,ymOpt-9, s); 549 brush.Color := $000000; 550 FillRect(Rect(8 + 1, 7 + 1, 36 + 1, 32 + 1)); 551 brush.Color := $FFFFFF; 552 FillRect(Rect(8, 7, 36, 32)); 553 brush.style := bsClear; 554 Font.Color := $000000; 555 s := inttostr(c.Size); 556 TextOut(8 + 14 - textwidth(s) div 2, 7, s); 557 end; 558 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 559 560 if not IsCityAlive then 561 begin 562 MakeRed(18, 280, 298, 40); 563 if cGov = gAnarchy then 564 s := Phrases.Lookup('GOVERNMENT', gAnarchy) 565 else { if c.Flags and chCaptured<>0 then } 566 s := Phrases.Lookup('CITYEVENTS', 14); 567 RisedTextOut(offscreen.Canvas, 167 - BiColorTextWidth(offscreen.Canvas, s) 568 div 2, ymOpt - 9, s); 502 569 end 503 else if AllowChange then 504 begin 505 OptiType:=c.Status shr 4 and $0F; 506 Sprite(offscreen,HGrSystem2,xmOpt-32,ymOpt-32,64,64,1+OptiType mod 3*64,217+OptiType div 3*64); 507 508 {display messages now} 509 MessageCount:=0; 510 for i:=0 to 31 do 511 if Happened and ($FFFFFFFF-chCaptured) and (1 shl i)<>0 then 512 inc(MessageCount); 513 if MessageCount>3 then 514 MessageCount:=3; 515 if MessageCount>0 then 516 begin 517 MakeBlue(Offscreen,74,280,242,40); 518 line:=0; 519 for i:=0 to nCityEventPriority-1 do 520 if line<MessageCount then 521 CheckMessage(CityEventPriority[i]); 570 else if AllowChange then 571 begin 572 OptiType := c.Status shr 4 and $0F; 573 Sprite(offscreen, HGrSystem2, xmOpt - 32, ymOpt - 32, 64, 64, 574 1 + OptiType mod 3 * 64, 217 + OptiType div 3 * 64); 575 576 { display messages now } 577 MessageCount := 0; 578 for i := 0 to 31 do 579 if Happened and ($FFFFFFFF - chCaptured) and (1 shl i) <> 0 then 580 inc(MessageCount); 581 if MessageCount > 3 then 582 MessageCount := 3; 583 if MessageCount > 0 then 584 begin 585 MakeBlue(offscreen, 74, 280, 242, 40); 586 line := 0; 587 for i := 0 to nCityEventPriority - 1 do 588 if line < MessageCount then 589 CheckMessage(CityEventPriority[i]); 522 590 end 523 else 524 begin 525 s:=Phrases.Lookup('CITYMANAGETYPE',OptiType); 526 j:=pos('\',s); 527 if j=0 then 528 LoweredTextout(offscreen.canvas, -1, MainTexture, xmOpt+40, ymOpt-9, s) 529 else 591 else 592 begin 593 s := Phrases.Lookup('CITYMANAGETYPE', OptiType); 594 j := pos('\', s); 595 if j = 0 then 596 LoweredTextout(offscreen.Canvas, -1, MainTexture, xmOpt + 40, 597 ymOpt - 9, s) 598 else 530 599 begin 531 LoweredTextout(offscreen.canvas, -1, MainTexture, xmOpt+40, ymOpt-17,532 copy(s,1,j-1));533 LoweredTextout(offscreen.canvas, -1, MainTexture, xmOpt+40, ymOpt-1,534 copy(s,j+1,255));600 LoweredTextout(offscreen.Canvas, -1, MainTexture, xmOpt + 40, 601 ymOpt - 17, copy(s, 1, j - 1)); 602 LoweredTextout(offscreen.Canvas, -1, MainTexture, xmOpt + 40, ymOpt - 1, 603 copy(s, j + 1, 255)); 535 604 end 536 605 end 537 606 end; 538 607 539 rx:=(192+xxt*2-1) div (xxt*2); 540 ry:=(96+yyt*2-1) div (yyt*2); 541 AreaMap.Paint(xmArea-xxt*2*rx,ymArea-yyt*2*ry-3*yyt,dLoc(cLoc,-2*rx+1,-2*ry-1),4*rx-1,4*ry+1,cLoc,cOwner, 542 false,AllowChange and IsCityAlive and (c.Status and csResourceWeightsMask=0)); 543 bitblt(offscreen.canvas.handle,xmArea+102,42,90,33,Back.Canvas.handle,xmArea+102,42,SRCCOPY); 544 545 if IsCityAlive then 546 for dy:=-3 to 3 do for dx:=-3 to 3 do 547 if ((dx+dy) and 1=0) and (dx*dx*dy*dy<81) then 608 rx := (192 + xxt * 2 - 1) div (xxt * 2); 609 ry := (96 + yyt * 2 - 1) div (yyt * 2); 610 AreaMap.Paint(xmArea - xxt * 2 * rx, ymArea - yyt * 2 * ry - 3 * yyt, 611 dLoc(cLoc, -2 * rx + 1, -2 * ry - 1), 4 * rx - 1, 4 * ry + 1, cLoc, cOwner, 612 false, AllowChange and IsCityAlive and 613 (c.Status and csResourceWeightsMask = 0)); 614 bitblt(offscreen.Canvas.Handle, xmArea + 102, 42, 90, 33, Back.Canvas.Handle, 615 xmArea + 102, 42, SRCCOPY); 616 617 if IsCityAlive then 618 for dy := -3 to 3 do 619 for dx := -3 to 3 do 620 if ((dx + dy) and 1 = 0) and (dx * dx * dy * dy < 81) then 621 begin 622 Loc1 := dLoc(cLoc, dx, dy); 623 av := CityAreaInfo.Available[(dy + 3) shl 2 + (dx + 3) shr 1]; 624 if ((av = faNotAvailable) or (av = faTreaty) or (av = faInvalid)) and 625 ((Loc1 < 0) or (Loc1 >= G.lx * G.ly) or (MyMap[Loc1] and fCity = 0)) 626 then 627 Sprite(offscreen, HGrTerrain, xmArea - xxt + xxt * dx, 628 ymArea - yyt + yyt * dy, xxt * 2, yyt * 2, 1 + 5 * (xxt * 2 + 1), 629 1 + yyt + 15 * (yyt * 3 + 1)); 630 if (1 shl ((dy + 3) shl 2 + (dx + 3) shr 1) and c.Tiles <> 0) then 631 PaintResources(xmArea - xxt + xxt * dx, ymArea - yyt + yyt * dy, 632 Loc1, (dx = 0) and (dy = 0)); 633 end; 634 635 if Report.Working > 1 then 636 d := (xService - (xmArea - 192) - 8 - 32) div (Report.Working - 1); 637 if d > 28 then 638 d := 28; 639 for i := Report.Working - 1 downto 0 do 640 begin 641 if IsCityAlive then 642 xGr := 29 643 else 644 xGr := 141; 645 bitblt(offscreen.Canvas.Handle, xmArea - 192 + 5 + i * d, ymArea - 96 - 29, 646 27, 30, GrExt[HGrSystem].Mask.Canvas.Handle, xGr, 171, SRCAND); { shadow } 647 Sprite(offscreen, HGrSystem, xmArea - 192 + 4 + i * d, ymArea - 96 - 30, 27, 648 30, xGr, 171); 649 end; 650 if c.Size - Report.Working > 1 then 651 d := (xmArea + 192 - xService - 32) div (c.Size - Report.Working - 1); 652 if d > 28 then 653 d := 28; 654 for i := 0 to c.Size - Report.Working - 1 do 655 begin 656 xGr := 1 + 112; 657 bitblt(offscreen.Canvas.Handle, xmArea + 192 - 27 + 1 - i * d, 29 + 1, 27, 658 30, GrExt[HGrSystem].Mask.Canvas.Handle, xGr, 171, SRCAND); { shadow } 659 Sprite(offscreen, HGrSystem, xmArea + 192 - 27 - i * d, 29, 27, 30, 660 xGr, 171); 661 Sprite(offscreen, HGrSystem, xmArea + 192 - 27 + 4 - i * d, 29 + 32, 10, 662 10, 121, 126); 663 Sprite(offscreen, HGrSystem, xmArea + 192 - 27 + 13 - i * d, 29 + 32, 10, 664 10, 121, 126); 665 // Sprite(offscreen,HGrSystem,xmArea+192-31+18-i*d,ymArea-96-80+32,10,10,88,115); 666 end; 667 668 if c.Project and cpImp = 0 then 669 PrName := Tribe[cOwner].ModelName[c.Project and cpIndex] 670 else 671 PrName := Phrases.Lookup('IMPROVEMENTS', c.Project and cpIndex); 672 PrCost := Report.ProjectCost; 673 674 // happiness section 675 if IsCityAlive then 676 begin 677 if cGov = gFundamentalism then 678 CountBar(offscreen, xHapp, yHapp + dyBar, wBar, 17, 679 Phrases.Lookup('FAITH'), Report.CollectedControl, MainTexture) 680 else 681 begin 682 CountBar(offscreen, xHapp, yHapp + dyBar, wBar, 17, 683 Phrases.Lookup('HAPPINESS'), Report.Morale, MainTexture); 684 CountBar(offscreen, xHapp, yHapp + 2 * dyBar, wBar, 16, 685 Phrases.Lookup('CONTROL'), Report.CollectedControl, MainTexture); 686 end; 687 CountBar(offscreen, xHapp, yHapp, wBar, 8, Phrases.Lookup('LUX'), 688 Report.Luxury, MainTexture); 689 CountBar(offscreen, xHapp + dxBar, yHapp, wBar, 19, 690 Phrases.Lookup('UNREST'), 2 * Report.Deployed, MainTexture); 691 CountBar(offscreen, xHapp + dxBar, yHapp + dyBar, wBar, 17, 692 Phrases.Lookup('HAPPINESSDEMAND'), c.Size, MainTexture); 693 if Report.HappinessBalance >= 0 then 694 CountBar(offscreen, xHapp + dxBar, yHapp + 2 * dyBar, wBar, 17, 695 Phrases.Lookup('HAPPINESSPLUS'), Report.HappinessBalance, MainTexture) 696 else 697 begin 698 MakeRed(xHapp + dxBar - 6, yHapp + 2 * dyBar, wBar + 10, 38); 699 CountBar(offscreen, xHapp + dxBar, yHapp + 2 * dyBar, wBar, 18, 700 Phrases.Lookup('LACK'), -Report.HappinessBalance, RedTex); 701 end; 702 end; 703 704 // food section 705 if IsCityAlive then 706 begin 707 CountBar(offscreen, xFood, yFood + dyBar div 2, wBar, 0, 708 Phrases.Lookup('FOOD'), Report.CollectedFood, MainTexture); 709 CountBar(offscreen, xFood + dxBar, yFood + dyBar, wBar, 0, 710 Phrases.Lookup('DEMAND'), 2 * c.Size, MainTexture); 711 CountBar(offscreen, xFood + dxBar, yFood, wBar, 0, 712 Phrases.Lookup('SUPPORT'), Report.FoodSupport, MainTexture); 713 if Report.FoodSurplus >= 0 then 714 if (cGov = gFuture) or (c.Size >= NeedAqueductSize) and 715 (Report.FoodSurplus < 2) then 716 CountBar(offscreen, xFood + dxBar, yFood + 2 * dyBar, wBar, 6, 717 Phrases.Lookup('PROFIT'), Report.FoodSurplus, MainTexture) 718 else 719 CountBar(offscreen, xFood + dxBar, yFood + 2 * dyBar, wBar, 0, 720 Phrases.Lookup('SURPLUS'), Report.FoodSurplus, MainTexture) 721 else 722 begin 723 MakeRed(xFood + dxBar - 6, yFood + 2 * dyBar, wBar + 10, 38); 724 CountBar(offscreen, xFood + dxBar, yFood + 2 * dyBar, wBar, 1, 725 Phrases.Lookup('LACK'), -Report.FoodSurplus, RedTex); 726 end; 727 end; 728 CanGrow := (c.Size < MaxCitySize) and (cGov <> gFuture) and 729 (Report.FoodSurplus > 0) and ((c.Size < NeedAqueductSize) or 730 (c.Built[imAqueduct] = 1) and (c.Size < NeedSewerSize) or 731 (c.Built[imSewer] = 1)); 732 FillBar(xFood + 3, yFood + 102, TrueFood, 733 CutCityFoodSurplus(Report.FoodSurplus, IsCityAlive, cGov, c.Size), 734 Report.Storage, 1, CanGrow); 735 LoweredTextout(offscreen.Canvas, -1, MainTexture, xFood + 3 - 5, 736 yFood + 102 - 20, Format('%d/%d', [TrueFood, Report.Storage])); 737 LoweredTextout(offscreen.Canvas, -1, MainTexture, xFood - 2, yFood + 66, 738 Phrases.Lookup('STORAGE')); 739 740 // production section 741 if IsCityAlive then 742 begin 743 CountBar(offscreen, xProd, yProd, wBar, 2, Phrases.Lookup('MATERIAL'), 744 Report.CollectedMaterial, MainTexture); 745 CountBar(offscreen, xProd + dxBar, yProd, wBar, 2, 746 Phrases.Lookup('SUPPORT'), Report.MaterialSupport, MainTexture); 747 if Report.Production >= 0 then 748 if c.Project and (cpImp + cpIndex) = cpImp + imTrGoods then 749 CountBar(offscreen, xProd + dxBar, yProd + dyBar + 16, wBar, 6, 750 Phrases.Lookup('PROFIT'), Report.Production, MainTexture) 751 else 752 CountBar(offscreen, xProd + dxBar, yProd + dyBar + 16, wBar, 2, 753 Phrases.Lookup('PROD'), Report.Production, MainTexture) 754 else 755 begin 756 MakeRed(xProd + dxBar - 6, yProd + dyBar, wBar + 10, 38); 757 CountBar(offscreen, xProd + dxBar, yProd + dyBar + 16, wBar, 3, 758 Phrases.Lookup('LACK'), -Report.Production, RedTex); 759 end; 760 end; 761 if c.Project and (cpImp + cpIndex) <> cpImp + imTrGoods then 762 with offscreen.Canvas do 763 begin 764 i := Report.Production; 765 if (i < 0) or not IsCityAlive then 766 i := 0; 767 FillBar(xProd + 3, yProd + 16 + 63, TrueProd, i, PrCost, 4, true); 768 LoweredTextout(offscreen.Canvas, -1, MainTexture, xProd + 3 - 5, 769 yProd + 16 + 43, Format('%d/%d', [TrueProd, PrCost])); 770 if BiColorTextWidth(offscreen.Canvas, PrName) > wBar + dxBar then 548 771 begin 549 Loc1:=dLoc(cLoc,dx,dy); 550 av := CityAreaInfo.Available[(dy+3) shl 2+(dx+3) shr 1]; 551 if ((av = faNotAvailable) or (av = faTreaty) or (av =faInvalid)) 552 and ((Loc1<0) or (Loc1>=G.lx*G.ly) or (MyMap[Loc1] and fCity=0)) then 553 Sprite(offscreen,HGrTerrain,xmArea-xxt+xxt*dx,ymArea-yyt+yyt*dy,xxt*2, 554 yyt*2,1+5*(xxt*2+1),1+yyt+15*(yyt*3+1)); 555 if (1 shl((dy+3) shl 2+(dx+3) shr 1) and c.Tiles<>0) then 556 PaintResources(xmArea-xxt+xxt*dx,ymArea-yyt+yyt*dy,Loc1,(dx=0) and (dy=0)); 772 repeat 773 Delete(PrName, length(PrName), 1) 774 until BiColorTextWidth(offscreen.Canvas, PrName) <= wBar + dxBar; 775 PrName := PrName + '.' 557 776 end; 558 559 if Report.Working>1 then d:=(xService-(xmArea-192)-8-32) div(Report.Working-1); 560 if d>28 then d:=28; 561 for i:=Report.Working-1 downto 0 do 562 begin 563 if IsCityAlive then xGr:=29 564 else xGr:=141; 565 BitBlt(offscreen.Canvas.Handle,xmArea-192+5+i*d,ymArea-96-29, 566 27,30,GrExt[HGrSystem].Mask.Canvas.Handle,xGr,171,SRCAND); {shadow} 567 Sprite(offscreen,HGrSystem,xmArea-192+4+i*d,ymArea-96-30,27,30,xGr,171); 568 end; 569 if c.Size-Report.Working>1 then d:=(xmArea+192-xService-32) div(c.Size-Report.Working-1); 570 if d>28 then d:=28; 571 for i:=0 to c.Size-Report.Working-1 do 572 begin 573 xGr:=1+112; 574 BitBlt(offscreen.Canvas.Handle,xmArea+192-27+1-i*d,29+1, 575 27,30,GrExt[HGrSystem].Mask.Canvas.Handle,xGr,171,SRCAND); {shadow} 576 Sprite(offscreen,HGrSystem,xmArea+192-27-i*d,29,27,30,xGr,171); 577 Sprite(offscreen,HGrSystem,xmArea+192-27+4-i*d,29+32,10,10,121,126); 578 Sprite(offscreen,HGrSystem,xmArea+192-27+13-i*d,29+32,10,10,121,126); 579 // Sprite(offscreen,HGrSystem,xmArea+192-31+18-i*d,ymArea-96-80+32,10,10,88,115); 580 end; 581 582 if c.Project and cpImp=0 then 583 PrName:=Tribe[cOwner].ModelName[c.Project and cpIndex] 584 else PrName:=Phrases.Lookup('IMPROVEMENTS',c.Project and cpIndex); 585 PrCost:=Report.ProjectCost; 586 587 // happiness section 588 if IsCityAlive then 589 begin 590 if cGov=gFundamentalism then 591 CountBar(offscreen,xHapp,yHapp+dyBar,wBar,17,Phrases.Lookup('FAITH'), 592 Report.CollectedControl,MainTexture) 777 end; 778 RisedTextOut(offscreen.Canvas, xProd - 2, yProd + 36, PrName); 779 780 // pollution section 781 if IsCityAlive and (Report.AddPollution > 0) then 782 begin 783 FillBar(xPoll + 3, yPoll + 20, TruePoll, Report.AddPollution, 784 MaxPollution, 3, true); 785 RisedTextOut(offscreen.Canvas, xPoll + 3 - 5, yPoll + 20 - 20, 786 Phrases.Lookup('POLL')); 787 end; 788 789 // trade section 790 if IsCityAlive and (Report.CollectedTrade > 0) then 791 begin 792 CountBar(offscreen, xTrade, yTrade + dyBar div 2, wBar, 4, 793 Phrases.Lookup('TRADE'), Report.CollectedTrade, MainTexture); 794 CountBar(offscreen, xTrade + dxBar, yTrade + 2 * dyBar, wBar, 5, 795 Phrases.Lookup('CORR'), Report.Corruption, MainTexture); 796 CountBar(offscreen, xTrade + dxBar, yTrade, wBar, 6, Phrases.Lookup('TAX'), 797 Report.Tax, MainTexture); 798 CountBar(offscreen, xTrade + dxBar, yTrade + dyBar, wBar, 12, 799 Phrases.Lookup('SCIENCE'), Report.Science, MainTexture); 800 end; 801 802 // small map 803 bitblt(offscreen.Canvas.Handle, xSmallMap, ySmallMap, wSmallMap, hSmallMap, 804 SmallCityMap.Canvas.Handle, 0, 0, SRCCOPY); 805 if Mode = mImp then 806 Frame(offscreen.Canvas, xSmallMap + 48 * (ZoomArea div 3), 807 ySmallMap + 24 * (ZoomArea mod 3), xSmallMap + 48 * (ZoomArea div 3) + 49, 808 ySmallMap + 24 * (ZoomArea mod 3) + 25, MainTexture.clMark, 809 MainTexture.clMark); 810 Frame(offscreen.Canvas, xSmallMap - 1, ySmallMap - 1, xSmallMap + wSmallMap, 811 ySmallMap + hSmallMap, $B0B0B0, $FFFFFF); 812 RFrame(offscreen.Canvas, xSmallMap - 2, ySmallMap - 2, xSmallMap + wSmallMap + 813 1, ySmallMap + hSmallMap + 1, $FFFFFF, $B0B0B0); 814 815 Frame(offscreen.Canvas, xSupport - 1, ySupport - 1, xSupport + wSupport, 816 ySupport + hSupport, $B0B0B0, $FFFFFF); 817 RFrame(offscreen.Canvas, xSupport - 2, ySupport - 2, xSupport + wSupport + 1, 818 ySupport + hSupport + 1, $FFFFFF, $B0B0B0); 819 x := xSupport + wSupport div 2; 820 y := ySupport + hSupport div 2; 821 if Mode = mSupp then 822 begin 823 offscreen.Canvas.brush.Color := MainTexture.clMark; 824 offscreen.Canvas.FillRect(Rect(x - 27, y - 6, x + 27, y + 6)); 825 offscreen.Canvas.brush.style := bsClear; 826 end; 827 Sprite(offscreen, HGrSystem, x - 16, y - 5, 10, 10, 88, 115); 828 Sprite(offscreen, HGrSystem, x - 5, y - 5, 10, 10, 66, 115); 829 Sprite(offscreen, HGrSystem, x + 6, y - 5, 10, 10, 154, 126); 830 831 bitblt(offscreen.Canvas.Handle, xZoomMap, yZoomMap, wZoomMap, hZoomMap, 832 ZoomCityMap.Canvas.Handle, 0, 0, SRCCOPY); 833 834 for i := 0 to 5 do 835 imix[i] := -1; 836 if Mode = mImp then 837 begin 838 if ZoomArea = 5 then 839 begin 840 Cnt := 0; 841 for iix := 0 to nImp - 1 do 842 if ((iix < 28) or (ImpPosition[iix] < 0)) and (c.Built[iix] > 0) then 843 begin 844 i := Cnt - Page * 6; 845 if (i >= 0) and (i < 6) then 846 imix[i] := iix; 847 inc(Cnt); 848 end; 849 PageCount := (Cnt + 5) div 6; 850 end 851 else 852 begin 853 for iix := 28 to nImp - 1 do 854 begin 855 i := ImpPosition[iix] - 6 * ZoomArea; 856 if (i >= 0) and (i < 6) and (c.Built[iix] > 0) then 857 imix[i] := iix; 858 end; 859 PageCount := 0; 860 end; 861 for i := 0 to 5 do 862 if imix[i] >= 0 then 863 begin 864 iix := imix[i]; 865 x := xZoomMap + 14 + 72 * (i mod 3); 866 y := yZoomMap + 14 + 56 * (i div 3); 867 ImpImage(offscreen.Canvas, x, y, iix, cGov, AllowChange and 868 (ClientMode < scContact)); 869 if IsCityAlive then 870 begin 871 if iix = imColosseum then 872 begin 873 Sprite(offscreen, HGrSystem, x + 46, y, 14, 14, 82, 100); 874 end 875 else 876 begin 877 HappyGain := 0; 878 case iix of 879 0 .. 27, imTemple: 880 HappyGain := 2; 881 imTheater: 882 HappyGain := 4; 883 imCathedral: 884 if MyRO.Wonder[woBach].EffectiveOwner = cOwner then 885 HappyGain := 6 886 else 887 HappyGain := 4; 888 end; 889 if HappyGain > 1 then 890 begin 891 d := 30 div (HappyGain - 1); 892 if d > 10 then 893 d := 10 894 end; 895 for j := 0 to HappyGain - 1 do 896 Sprite(offscreen, HGrSystem, x + 50, y + d * j, 10, 10, 132, 126); 897 end; 898 for j := 0 to Imp[iix].Maint - 1 do 899 Sprite(offscreen, HGrSystem, x - 4, y + 29 - 3 * j, 10, 10, 900 132, 115); 901 end 902 end; 903 if imix[0] >= 0 then 904 Imp0Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[0]) 905 else 906 Imp0Area.Hint := ''; 907 if imix[1] >= 0 then 908 Imp1Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[1]) 909 else 910 Imp1Area.Hint := ''; 911 if imix[2] >= 0 then 912 Imp2Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[2]) 913 else 914 Imp2Area.Hint := ''; 915 if imix[3] >= 0 then 916 Imp3Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[3]) 917 else 918 Imp3Area.Hint := ''; 919 if imix[4] >= 0 then 920 Imp4Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[4]) 921 else 922 Imp4Area.Hint := ''; 923 if imix[5] >= 0 then 924 Imp5Area.Hint := Phrases.Lookup('IMPROVEMENTS', imix[5]) 925 else 926 Imp5Area.Hint := ''; 927 end 928 else { if mode=mSupp then } 929 begin 930 LoweredTextout(offscreen.Canvas, -1, MainTexture, xZoomMap + 6, 931 yZoomMap + 2, Phrases.Lookup('SUPUNITS')); 932 FreeSupp := c.Size * SupportFree[cGov] shr 1; 933 Cnt := 0; 934 for i := 0 to MyRO.nUn - 1 do 935 if (MyUn[i].Loc >= 0) and (MyUn[i].Home = cix) then 936 with MyModel[MyUn[i].mix] do 937 begin 938 Server(sGetUnitReport, me, i, UnitReport); 939 if (Cnt >= 6 * Page) and (Cnt < 6 * (Page + 1)) then 940 begin // unit visible in display 941 imix[Cnt - 6 * Page] := i; 942 x := ((Cnt - 6 * Page) mod 3) * 64 + xZoomMap; 943 y := ((Cnt - 6 * Page) div 3) * 52 + yZoomMap + 20; 944 MakeUnitInfo(me, MyUn[i], UnitInfo); 945 NoMap.SetOutput(offscreen); 946 NoMap.PaintUnit(x, y, UnitInfo, MyUn[i].Status); 947 948 for j := 0 to UnitReport.FoodSupport - 1 do 949 Sprite(offscreen, HGrSystem, x + 38 + 11 * j, y + 40, 10, 950 10, 66, 115); 951 for j := 0 to UnitReport.ProdSupport - 1 do 952 begin 953 if (FreeSupp > 0) and 954 (UnitReport.ReportFlags and urfAlwaysSupport = 0) then 955 begin 956 Sprite(offscreen, HGrSystem, x + 16 - 11 * j, y + 40, 10, 957 10, 143, 115); 958 dec(FreeSupp); 959 end 960 else 961 Sprite(offscreen, HGrSystem, x + 16 - 11 * j, y + 40, 10, 962 10, 88, 115); 963 end; 964 if UnitReport.ReportFlags and urfDeployed <> 0 then 965 for j := 0 to 1 do 966 Sprite(offscreen, HGrSystem, x + 27 + 11 * j, y + 40, 10, 967 10, 154, 126) 968 end // unit visible in display 969 else 970 dec(FreeSupp, UnitReport.ProdSupport); 971 inc(Cnt); 972 end; 973 PageCount := (Cnt + 5) div 6; 974 Imp0Area.Hint := ''; 975 Imp1Area.Hint := ''; 976 Imp2Area.Hint := ''; 977 Imp3Area.Hint := ''; 978 Imp4Area.Hint := ''; 979 Imp5Area.Hint := ''; 980 end; 981 PageUpBtn.Visible := PageCount > 1; 982 PageDownBtn.Visible := PageCount > 1; 983 984 with offscreen.Canvas do 985 begin 986 { display project now } 987 DLine(offscreen.Canvas, xView + 9 + xSizeBig, xProd + 2 * wBar + 10, 988 yProd + dyBar + 16, $FFFFFF, $B0B0B0); 989 if ProdHint then 990 begin 991 Frame(offscreen.Canvas, xView + 9 - 1, yView + 5 - 1, 992 xView + 9 + xSizeBig, yView + 5 + ySizeBig, $B0B0B0, $FFFFFF); 993 RFrame(offscreen.Canvas, xView + 9 - 2, yView + 5 - 2, 994 xView + 9 + xSizeBig + 1, yView + 5 + ySizeBig + 1, $FFFFFF, $B0B0B0); 995 with offscreen.Canvas do 996 begin 997 brush.Color := $000000; 998 FillRect(Rect(xView + 9, yView + 5, xView + 1 + 72 - 8, 999 yView + 5 + 40)); 1000 brush.style := bsClear; 1001 end 1002 end 1003 else if AllowChange and (c.Status and 7 <> 0) then 1004 begin // city type autobuild 1005 FrameImage(offscreen.Canvas, bigimp, xView + 9, yView + 5, xSizeBig, 1006 ySizeBig, (c.Status and 7 - 1 + 3) * xSizeBig, 0, (cix >= 0) and 1007 (ClientMode < scContact)); 1008 end 1009 else if c.Project and cpImp = 0 then 1010 begin // project is unit 1011 FrameImage(offscreen.Canvas, bigimp, xView + 9, yView + 5, xSizeBig, 1012 ySizeBig, 0, 0, AllowChange and (ClientMode < scContact)); 1013 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do 1014 Sprite(offscreen, HGr, xView + 5, yView + 1, 64, 44, 1015 pix mod 10 * 65 + 1, pix div 10 * 49 + 1); 1016 end 1017 else 1018 begin // project is building 1019 if ProdHint then 1020 Paintiix := c.Project0 and cpIndex 1021 else 1022 Paintiix := c.Project and cpIndex; 1023 ImpImage(offscreen.Canvas, xView + 9, yView + 5, Paintiix, cGov, 1024 AllowChange and (ClientMode < scContact)); 1025 end; 1026 end; 1027 1028 if AllowChange and (ClientMode < scContact) then 1029 begin 1030 i := Server(sBuyCityProject - sExecute, me, cix, nil^); 1031 BuyBtn.Visible := (i = eOk) or (i = eViolation); 1032 end 593 1033 else 594 begin 595 CountBar(offscreen,xHapp,yHapp+dyBar,wBar,17,Phrases.Lookup('HAPPINESS'), 596 Report.Morale,MainTexture); 597 CountBar(offscreen,xHapp,yHapp+2*dyBar,wBar,16,Phrases.Lookup('CONTROL'), 598 Report.CollectedControl,MainTexture); 599 end; 600 CountBar(offscreen,xHapp,yHapp,wBar,8,Phrases.Lookup('LUX'), 601 Report.Luxury,MainTexture); 602 CountBar(offscreen,xHapp+dxBar,yHapp,wBar,19,Phrases.Lookup('UNREST'), 603 2*Report.Deployed,MainTexture); 604 CountBar(offscreen,xHapp+dxBar,yHapp+dyBar,wBar,17,Phrases.Lookup('HAPPINESSDEMAND'), 605 c.Size,MainTexture); 606 if Report.HappinessBalance>=0 then 607 CountBar(offscreen,xHapp+dxBar,yHapp+2*dyBar,wBar,17,Phrases.Lookup('HAPPINESSPLUS'), 608 Report.HappinessBalance,MainTexture) 1034 BuyBtn.Visible := false; 1035 1036 MarkUsedOffscreen(ClientWidth, ClientHeight); 1037 end; { OffscreenPaint } 1038 1039 procedure TCityDlg.FormShow(Sender: TObject); 1040 var 1041 dx, dy, Loc1: integer; 1042 GetCityData: TGetCityData; 1043 begin 1044 BlinkTime := 5; 1045 if cix >= 0 then 1046 begin { own city } 1047 c := MyCity[cix]; 1048 cOwner := me; 1049 cGov := MyRO.Government; 1050 ProdHint := (cGov <> gAnarchy) and 1051 (Happened and (chProduction or chFounded or chCaptured or 1052 chAllImpsMade) <> 0); 1053 Server(sGetCityAreaInfo, me, cix, CityAreaInfo); 1054 NextCityBtn.Visible := WindowMode = wmPersistent; 1055 PrevCityBtn.Visible := WindowMode = wmPersistent; 1056 end 1057 else { enemy city } 1058 begin 1059 Mode := mImp; 1060 Server(sGetCity, me, cLoc, GetCityData); 1061 c := GetCityData.c; 1062 cOwner := GetCityData.Owner; 1063 cGov := MyRO.EnemyReport[cOwner].Government; 1064 Happened := c.Flags and $7FFFFFFF; 1065 ProdHint := false; 1066 Server(sGetEnemyCityAreaInfo, me, cLoc, CityAreaInfo); 1067 1068 if c.Project and cpImp = 0 then 1069 begin 1070 emix := MyRO.nEnemyModel - 1; 1071 while (emix > 0) and ((MyRO.EnemyModel[emix].Owner <> cOwner) or 1072 (integer(MyRO.EnemyModel[emix].mix) <> c.Project and cpIndex)) do 1073 dec(emix); 1074 if Tribe[cOwner].ModelPicture[c.Project and cpIndex].HGr = 0 then 1075 InitEnemyModel(emix); 1076 end; 1077 1078 NextCityBtn.Visible := false; 1079 PrevCityBtn.Visible := false; 1080 end; 1081 Page := 0; 1082 1083 if c.Size < 5 then 1084 SizeClass := 0 1085 else if c.Size < 9 then 1086 SizeClass := 1 1087 else if c.Size < 13 then 1088 SizeClass := 2 609 1089 else 610 begin 611 MakeRed(xHapp+dxBar-6,yHapp+2*dyBar,wBar+10,38); 612 CountBar(offscreen,xHapp+dxBar,yHapp+2*dyBar,wBar,18,Phrases.Lookup('LACK'), 613 -Report.HappinessBalance,RedTex); 614 end; 615 end; 616 617 // food section 618 if IsCityAlive then 619 begin 620 CountBar(offscreen,xFood,yFood+dyBar div 2,wBar,0,Phrases.Lookup('FOOD'),Report.CollectedFood,MainTexture); 621 CountBar(offscreen,xFood+dxBar,yFood+dyBar,wBar,0,Phrases.Lookup('DEMAND'),2*c.Size,MainTexture); 622 CountBar(offscreen,xFood+dxBar,yFood,wBar,0,Phrases.Lookup('SUPPORT'),Report.FoodSupport,MainTexture); 623 if Report.FoodSurplus>=0 then 624 if (cGov=gFuture) 625 or (c.Size>=NeedAqueductSize) and (Report.FoodSurplus<2) then 626 CountBar(offscreen,xFood+dxBar,yFood+2*dyBar,wBar,6,Phrases.Lookup('PROFIT'), 627 Report.FoodSurplus,MainTexture) 628 else CountBar(offscreen,xFood+dxBar,yFood+2*dyBar,wBar,0,Phrases.Lookup('SURPLUS'), 629 Report.FoodSurplus,MainTexture) 1090 SizeClass := 3; 1091 1092 // check if port 1093 IsPort := false; 1094 for dx := -2 to 2 do 1095 for dy := -2 to 2 do 1096 if abs(dx) + abs(dy) = 2 then 1097 begin 1098 Loc1 := dLoc(cLoc, dx, dy); 1099 if (Loc1 >= 0) and (Loc1 < G.lx * G.ly) and 1100 (MyMap[Loc1] and fTerrain < fGrass) then 1101 IsPort := true; 1102 end; 1103 1104 if WindowMode = wmModal then 1105 begin { center on screen } 1106 Left := (Screen.Width - Width) div 2; 1107 Top := (Screen.Height - Height) div 2; 1108 end; 1109 1110 Caption := CityName(c.ID); 1111 1112 InitSmallCityMap; 1113 InitZoomCityMap; 1114 OpenSoundEvent := -1; 1115 OffscreenPaint; 1116 Timer1.Enabled := true; 1117 end; 1118 1119 procedure TCityDlg.ShowNewContent(NewMode, Loc: integer; ShowEvent: cardinal); 1120 begin 1121 if MyMap[Loc] and fOwned <> 0 then 1122 begin // own city 1123 cix := MyRO.nCity - 1; 1124 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 1125 dec(cix); 1126 assert(cix >= 0); 1127 if (Optimize_cixTileChange >= 0) and 1128 (Optimize_TilesBeforeChange and not MyCity[Optimize_cixTileChange].Tiles 1129 <> 0) then 1130 begin 1131 CityOptimizer_ReleaseCityTiles(Optimize_cixTileChange, 1132 Optimize_TilesBeforeChange and 1133 not MyCity[Optimize_cixTileChange].Tiles); 1134 if WindowMode <> wmModal then 1135 MainScreen.UpdateViews; 1136 end; 1137 Optimize_cixTileChange := cix; 1138 Optimize_TilesBeforeChange := MyCity[cix].Tiles; 1139 end 630 1140 else 631 begin 632 MakeRed(xFood+dxBar-6,yFood+2*dyBar,wBar+10,38); 633 CountBar(offscreen,xFood+dxBar,yFood+2*dyBar,wBar,1,Phrases.Lookup('LACK'), 634 -Report.FoodSurplus,RedTex); 635 end; 636 end; 637 CanGrow:= (c.Size<MaxCitySize) and (cGov<>gFuture) 638 and (Report.FoodSurplus>0) 639 and ((c.Size<NeedAqueductSize) 640 or (c.Built[imAqueduct]=1) and (c.Size<NeedSewerSize) 641 or (c.Built[imSewer]=1)); 642 FillBar(xFood+3,yFood+102,TrueFood, 643 CutCityFoodSurplus(Report.FoodSurplus,IsCityAlive,cGov,c.size), 644 Report.Storage,1,CanGrow); 645 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xFood+3-5,yFood+102-20,Format('%d/%d',[TrueFood,Report.Storage])); 646 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xFood-2,yFood+66,Phrases.Lookup('STORAGE')); 647 648 // production section 649 if IsCityAlive then 650 begin 651 CountBar(offscreen,xProd,yProd,wBar,2,Phrases.Lookup('MATERIAL'), 652 Report.CollectedMaterial,MainTexture); 653 CountBar(offscreen,xProd+dxBar,yProd,wBar,2,Phrases.Lookup('SUPPORT'), 654 Report.MaterialSupport,MainTexture); 655 if Report.Production>=0 then 656 if c.Project and (cpImp+cpIndex)=cpImp+imTrGoods then 657 CountBar(offscreen,xProd+dxBar,yProd+dyBar+16,wBar,6,Phrases.Lookup('PROFIT'), 658 Report.Production,MainTexture) 659 else CountBar(offscreen,xProd+dxBar,yProd+dyBar+16,wBar,2,Phrases.Lookup('PROD'), 660 Report.Production,MainTexture) 661 else 662 begin 663 MakeRed(xProd+dxBar-6,yProd+dyBar,wBar+10,38); 664 CountBar(offscreen,xProd+dxBar,yProd+dyBar+16,wBar,3,Phrases.Lookup('LACK'), 665 -Report.Production,RedTex); 666 end; 667 end; 668 if c.Project and (cpImp+cpIndex)<>cpImp+imTrGoods then with offscreen.Canvas do 669 begin 670 i:=Report.Production; 671 if (i<0) or not IsCityAlive then i:=0; 672 FillBar(xProd+3,yProd+16+63,TrueProd,i,PrCost,4,true); 673 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xProd+3-5,yProd+16+43, 674 Format('%d/%d',[TrueProd,PrCost])); 675 if BiColorTextWidth(offscreen.Canvas,PrName)>wBar+dxBar then 676 begin 677 repeat Delete(PrName,Length(PrName),1) 678 until BiColorTextWidth(offscreen.Canvas,PrName)<=wBar+dxBar; 679 PrName:=PrName+'.' 680 end; 681 end; 682 RisedTextOut(offscreen.Canvas,xProd-2,yProd+36,PrName); 683 684 // pollution section 685 if IsCityAlive and (Report.AddPollution>0) then 686 begin 687 FillBar(xPoll+3,yPoll+20,TruePoll,Report.AddPollution, 688 MaxPollution,3,true); 689 RisedTextOut(offscreen.Canvas,xPoll+3-5,yPoll+20-20,Phrases.Lookup('POLL')); 690 end; 691 692 // trade section 693 if IsCityAlive and (Report.CollectedTrade>0) then 694 begin 695 CountBar(offscreen,xTrade,yTrade+dyBar div 2,wBar,4,Phrases.Lookup('TRADE'),Report.CollectedTrade,MainTexture); 696 CountBar(offscreen,xTrade+dxBar,yTrade+2*dyBar,wBar,5,Phrases.Lookup('CORR'),Report.Corruption,MainTexture); 697 CountBar(offscreen,xTrade+dxBar,yTrade,wBar,6,Phrases.Lookup('TAX'),Report.Tax,MainTexture); 698 CountBar(offscreen,xTrade+dxBar,yTrade+dyBar,wBar,12,Phrases.Lookup('SCIENCE'),Report.Science,MainTexture); 699 end; 700 701 // small map 702 BitBlt(Offscreen.Canvas.Handle,xSmallMap,ySmallmap,wSmallMap,hSmallMap,SmallCitymap.Canvas.Handle,0,0,SRCCOPY); 703 if Mode=mImp then 704 Frame(Offscreen.Canvas,xSmallMap+48*(ZoomArea div 3),ySmallmap+24*(ZoomArea mod 3), 705 xSmallMap+48*(ZoomArea div 3)+49,ySmallmap+24*(ZoomArea mod 3)+25, 706 MainTexture.clMark,MainTexture.clMark); 707 Frame(Offscreen.Canvas,xSmallMap-1,ySmallmap-1,xSmallMap+wSmallMap,ySmallmap+hSmallMap,$B0B0B0,$FFFFFF); 708 RFrame(Offscreen.Canvas,xSmallMap-2,ySmallmap-2,xSmallMap+wSmallMap+1,ySmallmap+hSmallMap+1,$FFFFFF,$B0B0B0); 709 710 Frame(Offscreen.Canvas,xSupport-1,ySupport-1,xSupport+wSupport,ySupport+hSupport,$B0B0B0,$FFFFFF); 711 RFrame(Offscreen.Canvas,xSupport-2,ySupport-2,xSupport+wSupport+1,ySupport+hSupport+1,$FFFFFF,$B0B0B0); 712 x:=xSupport+wSupport div 2; 713 y:=ySupport+hSupport div 2; 714 if Mode=mSupp then 715 begin 716 Offscreen.Canvas.brush.Color:=MainTexture.clMark; 717 Offscreen.Canvas.FillRect(Rect(x-27,y-6,x+27,y+6)); 718 Offscreen.Canvas.brush.style:=bsClear; 719 end; 720 Sprite(offscreen,HGrSystem,x-16,y-5,10,10,88,115); 721 Sprite(offscreen,HGrSystem,x-5,y-5,10,10,66,115); 722 Sprite(offscreen,HGrSystem,x+6,y-5,10,10,154,126); 723 724 BitBlt(Offscreen.Canvas.Handle,xZoomMap,yZoommap,wZoomMap,hZoomMap,ZoomCitymap.Canvas.Handle,0,0,SRCCOPY); 725 726 for i:=0 to 5 do imix[i]:=-1; 727 if Mode=mImp then 728 begin 729 if ZoomArea=5 then 730 begin 731 Cnt:=0; 732 for iix:=0 to nImp-1 do 733 if ((iix<28) or (ImpPosition[iix]<0)) and (c.Built[iix]>0) then 1141 cix := -1; 1142 AllowChange := not supervising and (cix >= 0); 1143 cLoc := Loc; 1144 Happened := ShowEvent; 1145 inherited ShowNewContent(NewMode); 1146 end; 1147 1148 procedure TCityDlg.FormMouseDown(Sender: TObject; Button: TMouseButton; 1149 Shift: TShiftState; x, y: integer); 1150 var 1151 i, qx, qy, dx, dy, fix, NewTiles, Loc1, iix, SellResult: integer; 1152 Rebuild: boolean; 1153 begin 1154 if (ssLeft in Shift) and (x >= xSmallMap) and (x < xSmallMap + wSmallMap) and 1155 (y >= ySmallMap) and (y < ySmallMap + hSmallMap) then 1156 begin 1157 Mode := mImp; 1158 ZoomArea := (y - ySmallMap) * 3 div hSmallMap + 3 * 1159 ((x - xSmallMap) * 2 div wSmallMap); 1160 Page := 0; 1161 InitZoomCityMap; 1162 SmartUpdateContent; 1163 exit; 1164 end; 1165 if (ssLeft in Shift) and (x >= xSupport) and (x < xSupport + wSupport) and 1166 (y >= ySupport) and (y < ySupport + hSupport) then 1167 begin 1168 Mode := mSupp; 1169 Page := 0; 1170 InitZoomCityMap; 1171 SmartUpdateContent; 1172 exit; 1173 end; 1174 if not AllowChange then 1175 exit; // not an own city 1176 1177 if (ssLeft in Shift) then 1178 if (ClientMode < scContact) and (x >= xView) and (y >= yView) and 1179 (x < xView + 73) and (y < yView + 50) then 1180 if cGov = gAnarchy then 1181 with MessgExDlg do 734 1182 begin 735 i:=Cnt-Page*6; 736 if (i>=0) and (i<6) then 737 imix[i]:=iix; 738 inc(Cnt); 739 end; 740 PageCount:=(Cnt+5) div 6; 741 end 742 else 743 begin 744 for iix:=28 to nImp-1 do 745 begin 746 i:=ImpPosition[iix]-6*ZoomArea; 747 if (i>=0) and (i<6) and (c.Built[iix]>0) then 748 imix[i]:=iix; 749 end; 750 PageCount:=0; 751 end; 752 for i:=0 to 5 do if imix[i]>=0 then 753 begin 754 iix:=imix[i]; 755 x:=xZoomMap+14+72*(i mod 3); 756 y:=yZoomMap+14+56*(i div 3); 757 ImpImage(offscreen.Canvas,x,y,iix,cGov,AllowChange and (ClientMode<scContact)); 758 if IsCityAlive then 759 begin 760 if iix=imColosseum then 761 begin 762 Sprite(offscreen,HGrSystem,x+46,y,14,14,82,100); 1183 { MessgText:=Phrases.Lookup('OUTOFCONTROL'); 1184 if c.Project and cpImp=0 then 1185 MessgText:=Format(MessgText,[Tribe[cOwner].ModelName[c.Project and cpIndex]]) 1186 else MessgText:=Format(MessgText,[Phrases.Lookup('IMPROVEMENTS',c.Project and cpIndex)]); } 1187 MessgText := Phrases.Lookup('NOCHANGEINANARCHY'); 1188 Kind := mkOk; 1189 ShowModal; 763 1190 end 764 1191 else 1192 begin 1193 if ProdHint then 765 1194 begin 766 HappyGain:=0; 767 case iix of 768 0..27,imTemple: HappyGain:=2; 769 imTheater: HappyGain:=4; 770 imCathedral: 771 if MyRO.Wonder[woBach].EffectiveOwner=cOwner then HappyGain:=6 772 else HappyGain:=4; 773 end; 774 if HappyGain>1 then 775 begin d:=30 div(HappyGain-1);if d>10 then d:=10 end; 776 for j:=0 to HappyGain-1 do 777 Sprite(offscreen,HGrSystem,x+50,y+d*j,10,10,132,126); 1195 ProdHint := false; 1196 SmartUpdateContent 778 1197 end; 779 for j:=0 to Imp[iix].Maint-1 do 780 Sprite(offscreen,HGrSystem,x-4,y+29-3*j,10,10,132,115); 1198 ChooseProject; 781 1199 end 782 end; 783 if imix[0]>=0 then 784 Imp0Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[0]) 785 else Imp0Area.Hint:=''; 786 if imix[1]>=0 then 787 Imp1Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[1]) 788 else Imp1Area.Hint:=''; 789 if imix[2]>=0 then 790 Imp2Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[2]) 791 else Imp2Area.Hint:=''; 792 if imix[3]>=0 then 793 Imp3Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[3]) 794 else Imp3Area.Hint:=''; 795 if imix[4]>=0 then 796 Imp4Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[4]) 797 else Imp4Area.Hint:=''; 798 if imix[5]>=0 then 799 Imp5Area.Hint:=Phrases.Lookup('IMPROVEMENTS',imix[5]) 800 else Imp5Area.Hint:=''; 801 end 802 else {if mode=mSupp then} 803 begin 804 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xZoomMap+6,yZoomMap+2,Phrases.Lookup('SUPUNITS')); 805 FreeSupp:=c.Size*SupportFree[cGov] shr 1; 806 Cnt:=0; 807 for i:=0 to MyRO.nUn-1 do if (MyUn[i].Loc>=0) and (MyUn[i].Home=cix) then 808 with MyModel[MyUn[i].mix] do 1200 else if (Mode = mImp) and (x >= xZoomMap) and (x < xZoomMap + wZoomMap) and 1201 (y >= yZoomMap) and (y < yZoomMap + hZoomMap) then 1202 begin 1203 i := 5; 1204 while (i >= 0) and not((x >= xZoomMap + 14 + 72 * (i mod 3)) and 1205 (x < xZoomMap + 14 + 56 + 72 * (i mod 3)) and 1206 (y >= yZoomMap + 14 + 56 * (i div 3)) and 1207 (y < yZoomMap + 14 + 40 + 56 * (i div 3))) do 1208 dec(i); 1209 if i >= 0 then 809 1210 begin 810 Server(sGetUnitReport, me, i, UnitReport); 811 if (Cnt>=6*Page) and (Cnt<6*(Page+1)) then 812 begin // unit visible in display 813 imix[Cnt-6*Page]:=i; 814 x:=((Cnt-6*Page) mod 3)*64+xZoomMap; 815 y:=((Cnt-6*Page) div 3)*52+yZoomMap+20; 816 MakeUnitInfo(me,MyUn[i],UnitInfo); 817 NoMap.SetOutput(offscreen); 818 NoMap.PaintUnit(x,y,UnitInfo,MyUn[i].Status); 819 820 for j:=0 to UnitReport.FoodSupport-1 do 821 Sprite(offscreen,HGrSystem,x+38+11*j,y+40,10,10,66,115); 822 for j:=0 to UnitReport.ProdSupport-1 do 823 begin 824 if (FreeSupp>0) and (UnitReport.ReportFlags and urfAlwaysSupport=0) then 1211 iix := imix[i]; 1212 if iix >= 0 then 1213 if ssShift in Shift then 1214 HelpDlg.ShowNewContent(Mode or wmPersistent, hkImp, iix) 1215 else if (ClientMode < scContact) then 1216 with MessgExDlg do 825 1217 begin 826 Sprite(offscreen,HGrSystem,x+16-11*j,y+40,10,10,143,115); 827 dec(FreeSupp); 828 end 829 else Sprite(offscreen,HGrSystem,x+16-11*j,y+40,10,10,88,115); 830 end; 831 if UnitReport.ReportFlags and urfDeployed<>0 then 832 for j:=0 to 1 do 833 Sprite(offscreen,HGrSystem,x+27+11*j,y+40,10,10,154,126) 834 end // unit visible in display 835 else dec(FreeSupp, UnitReport.ProdSupport); 836 inc(Cnt); 837 end; 838 PageCount:=(Cnt+5) div 6; 839 Imp0Area.Hint:=''; 840 Imp1Area.Hint:=''; 841 Imp2Area.Hint:=''; 842 Imp3Area.Hint:=''; 843 Imp4Area.Hint:=''; 844 Imp5Area.Hint:=''; 845 end; 846 PageUpBtn.Visible:= PageCount>1; 847 PageDownBtn.Visible:= PageCount>1; 848 849 with offscreen.Canvas do 850 begin 851 {display project now} 852 DLine(offscreen.Canvas,xView+9+xSizeBig,xProd+2*wBar+10,yProd+dyBar+16, 853 $FFFFFF,$B0B0B0); 854 if prodhint then 855 begin 856 Frame(offscreen.canvas,xView+9-1,yView+5-1,xView+9+xSizeBig,yView+5+ySizeBig,$B0B0B0,$FFFFFF); 857 RFrame(offscreen.canvas,xView+9-2,yView+5-2,xView+9+xSizeBig+1,yView+5+ySizeBig+1,$FFFFFF,$B0B0B0); 858 with offscreen.canvas do 859 begin 860 Brush.Color:=$000000; 861 FillRect(Rect(xView+9,yView+5,xView+1+72-8,yView+5+40)); 862 Brush.Style:=bsClear; 863 end 864 end 865 else if AllowChange and (c.Status and 7<>0) then 866 begin // city type autobuild 867 FrameImage(offscreen.canvas,bigimp,xView+9,yView+5,xSizeBig,ySizeBig, 868 (c.Status and 7-1+3)*xSizeBig,0, 869 (cix>=0) and (ClientMode<scContact)); 870 end 871 else if c.Project and cpImp=0 then 872 begin // project is unit 873 FrameImage(offscreen.canvas,bigimp,xView+9,yView+5,xSizeBig,ySizeBig,0,0, 874 AllowChange and (ClientMode<scContact)); 875 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do 876 Sprite(offscreen,HGr,xView+5,yView+1,64,44, 877 pix mod 10 *65+1,pix div 10*49+1); 878 end 879 else 880 begin // project is building 881 if ProdHint then Paintiix:=c.Project0 and cpIndex 882 else Paintiix:=c.Project and cpIndex; 883 ImpImage(Offscreen.Canvas,xView+9,yView+5,Paintiix,cGov, 884 AllowChange and (ClientMode<scContact)); 885 end; 886 end; 887 888 if AllowChange and (ClientMode<scContact) then 889 begin 890 i:=Server(sBuyCityProject-sExecute,me,cix,nil^); 891 BuyBtn.Visible:= (i=eOk) or (i=eViolation); 892 end 893 else BuyBtn.Visible:=false; 894 895 MarkUsedOffscreen(ClientWidth,ClientHeight); 896 end;{OffscreenPaint} 897 898 procedure TCityDlg.FormShow(Sender: TObject); 899 var 900 dx,dy,Loc1: integer; 901 GetCityData: TGetCityData; 902 begin 903 BlinkTime:=5; 904 if cix>=0 then 905 begin {own city} 906 c:=MyCity[cix]; 907 cOwner:=me; 908 cGov:=MyRO.Government; 909 ProdHint:= (cGov<>gAnarchy) 910 and (Happened and (chProduction or chFounded or chCaptured or chAllImpsMade)<>0); 911 Server(sGetCityAreaInfo,me,cix,CityAreaInfo); 912 NextCityBtn.Visible:= WindowMode=wmPersistent; 913 PrevCityBtn.Visible:= WindowMode=wmPersistent; 914 end 915 else {enemy city} 916 begin 917 Mode:=mImp; 918 Server(sGetCity,me,cLoc,GetCityData); 919 c:=GetCityData.c; 920 cOwner:=GetCityData.Owner; 921 cGov:=MyRO.EnemyReport[cOwner].Government; 922 Happened:=c.Flags and $7FFFFFFF; 923 ProdHint:=false; 924 Server(sGetEnemyCityAreaInfo,me,cLoc,CityAreaInfo); 925 926 if c.Project and cpImp=0 then 927 begin 928 emix:=MyRO.nEnemyModel-1; 929 while (emix>0) and ((MyRO.EnemyModel[emix].Owner<>cOwner) 930 or (integer(MyRO.EnemyModel[emix].mix)<>c.Project and cpIndex)) do dec(emix); 931 if Tribe[cOwner].ModelPicture[c.Project and cpIndex].HGr=0 then 932 InitEnemyModel(emix); 933 end; 934 935 NextCityBtn.Visible:=false; 936 PrevCityBtn.Visible:=false; 937 end; 938 Page:=0; 939 940 if c.Size<5 then SizeClass:=0 941 else if c.Size<9 then SizeClass:=1 942 else if c.Size<13 then SizeClass:=2 943 else SizeClass:=3; 944 945 // check if port 946 IsPort:=false; 947 for dx:=-2 to 2 do for dy:=-2 to 2 do if abs(dx)+abs(dy)=2 then 948 begin 949 Loc1:=dLoc(cLoc,dx,dy); 950 if (Loc1>=0) and (Loc1<G.lx*G.ly) and (MyMap[Loc1] and fTerrain<fGrass) then 951 IsPort:=true; 952 end; 953 954 if WindowMode=wmModal then 955 begin {center on screen} 956 Left:=(Screen.Width-Width) div 2; 957 Top:=(Screen.Height-Height) div 2; 958 end; 959 960 Caption:=CityName(c.ID); 961 962 InitSmallCityMap; 963 InitZoomCityMap; 964 OpenSoundEvent:=-1; 965 OffscreenPaint; 966 Timer1.Enabled:=true; 967 end; 968 969 procedure TCityDlg.ShowNewContent(NewMode,Loc: integer; ShowEvent: cardinal); 970 begin 971 if MyMap[Loc] and fOwned<>0 then 972 begin // own city 973 cix:=MyRO.nCity-1; 974 while (cix>=0) and (MyCity[cix].Loc<>Loc) do dec(cix); 975 assert(cix>=0); 976 if (Optimize_cixTileChange>=0) 977 and (Optimize_TilesBeforeChange 978 and not MyCity[Optimize_cixTileChange].Tiles<>0) then 979 begin 980 CityOptimizer_ReleaseCityTiles(Optimize_cixTileChange, 981 Optimize_TilesBeforeChange and not MyCity[Optimize_cixTileChange].Tiles); 982 if WindowMode<>wmModal then 983 MainScreen.UpdateViews; 984 end; 985 Optimize_cixTileChange:=cix; 986 Optimize_TilesBeforeChange:=MyCity[cix].Tiles; 987 end 988 else cix:=-1; 989 AllowChange:=not supervising and (cix>=0); 990 cLoc:=Loc; 991 Happened:=ShowEvent; 992 inherited ShowNewContent(NewMode); 993 end; 994 995 procedure TCityDlg.FormMouseDown(Sender:TObject; 996 Button:TMouseButton;Shift:TShiftState;x,y:integer); 997 var 998 i,qx,qy,dx,dy,fix,NewTiles,Loc1,iix,SellResult: integer; 999 Rebuild: boolean; 1000 begin 1001 if (ssLeft in Shift) and (x>=xSmallMap) and (x<xSmallMap+wSmallMap) 1002 and (y>=ySmallMap) and (y<ySmallMap+hSmallMap) then 1003 begin 1004 Mode:=mImp; 1005 ZoomArea:=(y-ySmallMap)*3 div hSmallMap+3*((x-xSmallMap)*2 div wSmallMap); 1006 Page:=0; 1007 InitZoomCityMap; 1008 SmartUpdateContent; 1009 exit; 1010 end; 1011 if (ssLeft in Shift) and (x>=xSupport) and (x<xSupport+wSupport) 1012 and (y>=ySupport) and (y<ySupport+hSupport) then 1013 begin 1014 Mode:=mSupp; 1015 Page:=0; 1016 InitZoomCityMap; 1017 SmartUpdateContent; 1018 exit; 1019 end; 1020 if not AllowChange then exit; // not an own city 1021 1022 if (ssLeft in Shift) then 1023 if (ClientMode<scContact) 1024 and (x>=xView) and (y>=yView) and (x<xView+73) and (y<yView+50) then 1025 if cGov=gAnarchy then with MessgExDlg do 1026 begin 1027 { MessgText:=Phrases.Lookup('OUTOFCONTROL'); 1028 if c.Project and cpImp=0 then 1029 MessgText:=Format(MessgText,[Tribe[cOwner].ModelName[c.Project and cpIndex]]) 1030 else MessgText:=Format(MessgText,[Phrases.Lookup('IMPROVEMENTS',c.Project and cpIndex)]);} 1031 MessgText:=Phrases.Lookup('NOCHANGEINANARCHY'); 1032 Kind:=mkOk; 1033 ShowModal; 1034 end 1035 else 1036 begin 1037 if ProdHint then 1038 begin 1039 ProdHint:=false; 1040 SmartUpdateContent 1041 end; 1042 ChooseProject; 1043 end 1044 else if (Mode=mImp) and (x>=xZoomMap) and (x<xZoomMap+wZoomMap) 1045 and (y>=yZoomMap) and (y<yZoomMap+hZoomMap) then 1046 begin 1047 i:=5; 1048 while (i>=0) and 1049 not ((x>=xZoomMap+14+72*(i mod 3)) 1050 and (x<xZoomMap+14+56+72*(i mod 3)) 1051 and (y>=yZoomMap+14+56*(i div 3)) 1052 and (y<yZoomMap+14+40+56*(i div 3))) do 1053 dec(i); 1054 if i>=0 then 1055 begin 1056 iix:=imix[i]; 1057 if iix>=0 then 1058 if ssShift in Shift then 1059 HelpDlg.ShowNewContent(Mode or wmPersistent, hkImp, iix) 1060 else if (ClientMode<scContact) then with MessgExDlg do 1061 begin 1062 IconKind:=mikImp; 1063 IconIndex:=iix; 1064 if (iix=imPalace) or (Imp[iix].Kind=ikWonder) then 1065 begin 1066 MessgText:=Phrases.Lookup('IMPROVEMENTS',iix); 1067 if iix=woOracle then 1068 MessgText:=MessgText+'\'+Format(Phrases.Lookup('ORACLEINCOME'), 1069 [MyRO.OracleIncome]); 1070 Kind:=mkOk; 1071 ShowModal; 1072 end 1073 else 1074 begin 1075 SellResult:=Server(sSellCityImprovement-sExecute,me,cix,iix); 1076 if SellResult<rExecuted then 1218 IconKind := mikImp; 1219 IconIndex := iix; 1220 if (iix = imPalace) or (Imp[iix].Kind = ikWonder) then 1077 1221 begin 1078 if SellResult=eOnlyOnce then1079 MessgText:=Phrases.Lookup('NOSELLAGAIN')1080 else MessgText:=Phrases.Lookup('OUTOFCONTROL');1081 MessgText:=Format(MessgText,[Phrases.Lookup('IMPROVEMENTS',iix)]);1082 Kind:=mkOk;1083 ShowModal;1222 MessgText := Phrases.Lookup('IMPROVEMENTS', iix); 1223 if iix = woOracle then 1224 MessgText := MessgText + '\' + 1225 Format(Phrases.Lookup('ORACLEINCOME'), [MyRO.OracleIncome]); 1226 Kind := mkOk; 1227 ShowModal; 1084 1228 end 1085 else1229 else 1086 1230 begin 1087 if Server(sRebuildCityImprovement-sExecute,me,cix,iix)<rExecuted then 1088 begin // no rebuild possible, ask for sell only 1089 Rebuild:=false; 1090 MessgText:=Phrases.Lookup('IMPROVEMENTS',iix); 1091 if not Phrases2FallenBackToEnglish then 1092 MessgText:=Format(Phrases2.Lookup('SELL2'),[MessgText, 1093 Imp[iix].Cost*BuildCostMod[G.Difficulty[me]] div 12]) 1094 else MessgText:=Format(Phrases.Lookup('SELL'),[MessgText]); 1095 if iix=imSpacePort then with MyRO.Ship[me] do 1096 if Parts[0]+Parts[1]+Parts[2]>0 then 1097 MessgText:=MessgText+' '+Phrases.Lookup('SPDESTRUCTQUERY'); 1098 Kind:=mkYesNo; 1099 ShowModal; 1100 if ModalResult<>mrOK then iix:=-1 1231 SellResult := Server(sSellCityImprovement - sExecute, me, 1232 cix, iix); 1233 if SellResult < rExecuted then 1234 begin 1235 if SellResult = eOnlyOnce then 1236 MessgText := Phrases.Lookup('NOSELLAGAIN') 1237 else 1238 MessgText := Phrases.Lookup('OUTOFCONTROL'); 1239 MessgText := Format(MessgText, 1240 [Phrases.Lookup('IMPROVEMENTS', iix)]); 1241 Kind := mkOk; 1242 ShowModal; 1101 1243 end 1102 else1244 else 1103 1245 begin 1104 Rebuild:=true; 1105 MessgText:=Phrases.Lookup('IMPROVEMENTS',iix); 1106 if not Phrases2FallenBackToEnglish then 1107 MessgText:=Format(Phrases2.Lookup('DISPOSE2'),[MessgText, 1108 Imp[iix].Cost*BuildCostMod[G.Difficulty[me]] div 12 *2 div 3]) 1109 else MessgText:=Format(Phrases.Lookup('DISPOSE'),[MessgText]); 1110 if iix=imSpacePort then with MyRO.Ship[me] do 1111 if Parts[0]+Parts[1]+Parts[2]>0 then 1112 MessgText:=MessgText+' '+Phrases.Lookup('SPDESTRUCTQUERY'); 1113 Kind:=mkYesNo; 1114 ShowModal; 1115 if ModalResult<>mrOK then iix:=-1 1116 end; 1117 if iix>=0 then 1118 begin 1119 if Rebuild then 1246 if Server(sRebuildCityImprovement - sExecute, me, cix, iix) < rExecuted 1247 then 1248 begin // no rebuild possible, ask for sell only 1249 Rebuild := false; 1250 MessgText := Phrases.Lookup('IMPROVEMENTS', iix); 1251 if not Phrases2FallenBackToEnglish then 1252 MessgText := Format(Phrases2.Lookup('SELL2'), 1253 [MessgText, Imp[iix].Cost * BuildCostMod 1254 [G.Difficulty[me]] div 12]) 1255 else 1256 MessgText := Format(Phrases.Lookup('SELL'), [MessgText]); 1257 if iix = imSpacePort then 1258 with MyRO.Ship[me] do 1259 if Parts[0] + Parts[1] + Parts[2] > 0 then 1260 MessgText := MessgText + ' ' + 1261 Phrases.Lookup('SPDESTRUCTQUERY'); 1262 Kind := mkYesNo; 1263 ShowModal; 1264 if ModalResult <> mrOK then 1265 iix := -1 1266 end 1267 else 1120 1268 begin 1121 Play('CITY_REBUILDIMP'); 1122 Server(sRebuildCityImprovement,me,cix,iix); 1269 Rebuild := true; 1270 MessgText := Phrases.Lookup('IMPROVEMENTS', iix); 1271 if not Phrases2FallenBackToEnglish then 1272 MessgText := Format(Phrases2.Lookup('DISPOSE2'), 1273 [MessgText, Imp[iix].Cost * BuildCostMod 1274 [G.Difficulty[me]] div 12 * 2 div 3]) 1275 else 1276 MessgText := Format(Phrases.Lookup('DISPOSE'), 1277 [MessgText]); 1278 if iix = imSpacePort then 1279 with MyRO.Ship[me] do 1280 if Parts[0] + Parts[1] + Parts[2] > 0 then 1281 MessgText := MessgText + ' ' + 1282 Phrases.Lookup('SPDESTRUCTQUERY'); 1283 Kind := mkYesNo; 1284 ShowModal; 1285 if ModalResult <> mrOK then 1286 iix := -1 1287 end; 1288 if iix >= 0 then 1289 begin 1290 if Rebuild then 1291 begin 1292 Play('CITY_REBUILDIMP'); 1293 Server(sRebuildCityImprovement, me, cix, iix); 1294 end 1295 else 1296 begin 1297 Play('CITY_SELLIMP'); 1298 Server(sSellCityImprovement, me, cix, iix); 1299 end; 1300 CityOptimizer_CityChange(cix); 1301 InitSmallCityMap; 1302 SmartUpdateContent; 1303 if WindowMode <> wmModal then 1304 MainScreen.UpdateViews; 1123 1305 end 1124 else1125 begin1126 Play('CITY_SELLIMP');1127 Server(sSellCityImprovement,me,cix,iix);1128 end;1129 CityOptimizer_CityChange(cix);1130 InitSmallCityMap;1131 SmartUpdateContent;1132 if WindowMode<>wmModal then1133 MainScreen.UpdateViews;1134 1306 end 1135 1307 end 1136 1308 end 1137 end1138 1309 end 1139 1310 end 1140 else if (Mode=mSupp) and (x>=xZoomMap) and (x<xZoomMap+wZoomMap)1141 and (y>=yZoomMap) and (y<yZoomMap+hZoomMap) then1142 begin 1143 i:=5;1144 while (i>=0) and1145 not ((x>=xZoomMap+64*(i mod 3))1146 and (x<xZoomMap+64+64*(i mod 3))1147 and (y>=yZoomMap+20+48*(i div 3))1148 and (y<yZoomMap+20+52+48*(i div 3))) do1149 dec(i);1150 if (i>=0) and (imix[i]>=0)then1151 if ssShift in Shift then1152 else if (cix>=0) and (ClientMode<scContact) and (WindowMode<>wmModal) then1311 else if (Mode = mSupp) and (x >= xZoomMap) and (x < xZoomMap + wZoomMap) and 1312 (y >= yZoomMap) and (y < yZoomMap + hZoomMap) then 1313 begin 1314 i := 5; 1315 while (i >= 0) and not((x >= xZoomMap + 64 * (i mod 3)) and 1316 (x < xZoomMap + 64 + 64 * (i mod 3)) and 1317 (y >= yZoomMap + 20 + 48 * (i div 3)) and 1318 (y < yZoomMap + 20 + 52 + 48 * (i div 3))) do 1319 dec(i); 1320 if (i >= 0) and (imix[i] >= 0) then 1321 if ssShift in Shift then 1322 else if (cix >= 0) and (ClientMode < scContact) and 1323 (WindowMode <> wmModal) then 1153 1324 begin 1154 CloseAction:=None;1155 Close;1156 MainScreen.CityClosed(imix[i],false,true);1325 CloseAction := None; 1326 Close; 1327 MainScreen.CityClosed(imix[i], false, true); 1157 1328 end 1158 1329 end 1159 else if (x>=xmArea-192) and (x<xmArea+192) and (y>=ymArea-96) and (y<ymArea+96) then 1160 begin 1161 qx:=((4000*xxt*yyt)+(x-xmArea)*(yyt*2)+(y-ymArea+yyt)*(xxt*2)) div (xxt*yyt*4)-1000; 1162 qy:=((4000*xxt*yyt)+(y-ymArea+yyt)*(xxt*2)-(x-xmArea)*(yyt*2)) div (xxt*yyt*4)-1000; 1163 dx:=qx-qy; 1164 dy:=qx+qy; 1165 if (dx>=-3) and (dx<=3) and (dy>=-3) and (dy<=3) and (dx*dx*dy*dy<81) 1166 and ((dx<>0) or (dy<>0)) then 1167 if ssShift in Shift then 1330 else if (x >= xmArea - 192) and (x < xmArea + 192) and (y >= ymArea - 96) 1331 and (y < ymArea + 96) then 1332 begin 1333 qx := ((4000 * xxt * yyt) + (x - xmArea) * (yyt * 2) + (y - ymArea + yyt) 1334 * (xxt * 2)) div (xxt * yyt * 4) - 1000; 1335 qy := ((4000 * xxt * yyt) + (y - ymArea + yyt) * (xxt * 2) - (x - xmArea) 1336 * (yyt * 2)) div (xxt * yyt * 4) - 1000; 1337 dx := qx - qy; 1338 dy := qx + qy; 1339 if (dx >= -3) and (dx <= 3) and (dy >= -3) and (dy <= 3) and 1340 (dx * dx * dy * dy < 81) and ((dx <> 0) or (dy <> 0)) then 1341 if ssShift in Shift then 1168 1342 begin // terrain help 1169 Loc1:=dLoc(cLoc,dx,dy);1170 if (Loc1>=0) and (Loc1<G.lx*G.ly) then1171 HelpOnTerrain(Loc1, Mode or wmPersistent)1343 Loc1 := dLoc(cLoc, dx, dy); 1344 if (Loc1 >= 0) and (Loc1 < G.lx * G.ly) then 1345 HelpOnTerrain(Loc1, Mode or wmPersistent) 1172 1346 end 1173 else if (ClientMode<scContact) and (cGov<>gAnarchy)1174 and (c.Flags and chCaptured=0) then1347 else if (ClientMode < scContact) and (cGov <> gAnarchy) and 1348 (c.Flags and chCaptured = 0) then 1175 1349 begin // toggle exploitation 1176 assert(not supervising);1177 if c.Status and csResourceWeightsMask<>0 then1350 assert(not supervising); 1351 if c.Status and csResourceWeightsMask <> 0 then 1178 1352 begin 1179 with MessgExDlg do1353 with MessgExDlg do 1180 1354 begin 1181 MessgText:=Phrases.Lookup('CITYMANAGEOFF');1182 OpenSound:='MSG_DEFAULT';1183 Kind:=mkOkCancel;1184 IconKind:=mikFullControl;1185 ShowModal;1355 MessgText := Phrases.Lookup('CITYMANAGEOFF'); 1356 OpenSound := 'MSG_DEFAULT'; 1357 Kind := mkOkCancel; 1358 IconKind := mikFullControl; 1359 ShowModal; 1186 1360 end; 1187 if MessgExDlg.ModalResult=mrOK then1361 if MessgExDlg.ModalResult = mrOK then 1188 1362 begin 1189 MyCity[cix].Status:=MyCity[cix].Status1190 andnot csResourceWeightsMask; // off1191 c.Status:=MyCity[cix].Status;1192 SmartUpdateContent1363 MyCity[cix].Status := MyCity[cix].Status and 1364 not csResourceWeightsMask; // off 1365 c.Status := MyCity[cix].Status; 1366 SmartUpdateContent 1193 1367 end; 1194 exit;1368 exit; 1195 1369 end; 1196 fix:=(dy+3) shl 2+(dx+3) shr 1;1197 NewTiles:=MyCity[cix].Tiles xor (1 shl fix);1198 if Server(sSetCityTiles,me,cix,NewTiles)>=rExecuted then1370 fix := (dy + 3) shl 2 + (dx + 3) shr 1; 1371 NewTiles := MyCity[cix].Tiles xor (1 shl fix); 1372 if Server(sSetCityTiles, me, cix, NewTiles) >= rExecuted then 1199 1373 begin 1200 SmartUpdateContent;1201 if WindowMode<>wmModal then1202 MainScreen.UpdateViews;1374 SmartUpdateContent; 1375 if WindowMode <> wmModal then 1376 MainScreen.UpdateViews; 1203 1377 end 1204 1378 end 1205 1379 end 1206 else if (ClientMode<scContact) and (cGov<>gAnarchy) and (c.Flags and chCaptured=0) 1207 and (x>=xmOpt-32) and (x<xmOpt+32) and (y>=ymOpt-32) and (y<ymOpt+32) then 1208 begin 1209 i:=sqr(x-xmOpt)+sqr(y-ymOpt); // click radius 1210 if i<=32*32 then 1380 else if (ClientMode < scContact) and (cGov <> gAnarchy) and 1381 (c.Flags and chCaptured = 0) and (x >= xmOpt - 32) and (x < xmOpt + 32) 1382 and (y >= ymOpt - 32) and (y < ymOpt + 32) then 1383 begin 1384 i := sqr(x - xmOpt) + sqr(y - ymOpt); // click radius 1385 if i <= 32 * 32 then 1211 1386 begin 1212 if i<16*16 then // inner area clicked 1213 if c.Status and csResourceWeightsMask<>0 then 1214 i:=(c.Status shr 4 and $0F) mod 5 +1 // rotate except off 1215 else i:=3 // rwGrowth 1216 else case trunc(arctan2(x-xmOpt,ymOpt-y)*180/pi) of 1217 -25-52*2..-26-52: i:=1; 1218 -25-52..-26: i:=2; 1219 -25..25: i:=3; 1220 26..25+52: i:=4; 1221 26+52..25+52*2: i:=5; 1222 180-26..180,-180..-180+26: i:=0; 1223 else i:=-1; 1224 end; 1225 if i>=0 then 1387 if i < 16 * 16 then // inner area clicked 1388 if c.Status and csResourceWeightsMask <> 0 then 1389 i := (c.Status shr 4 and $0F) mod 5 + 1 // rotate except off 1390 else 1391 i := 3 // rwGrowth 1392 else 1393 case trunc(arctan2(x - xmOpt, ymOpt - y) * 180 / pi) of 1394 - 25 - 52 * 2 .. -26 - 52: 1395 i := 1; 1396 -25 - 52 .. -26: 1397 i := 2; 1398 -25 .. 25: 1399 i := 3; 1400 26 .. 25 + 52: 1401 i := 4; 1402 26 + 52 .. 25 + 52 * 2: 1403 i := 5; 1404 180 - 26 .. 180, -180 .. -180 + 26: 1405 i := 0; 1406 else 1407 i := -1; 1408 end; 1409 if i >= 0 then 1226 1410 begin 1227 ChangeResourceWeights(i);1228 SmartUpdateContent;1229 if WindowMode<>wmModal then1230 MainScreen.UpdateViews;1411 ChangeResourceWeights(i); 1412 SmartUpdateContent; 1413 if WindowMode <> wmModal then 1414 MainScreen.UpdateViews; 1231 1415 end 1232 1416 end 1233 1417 end; 1234 end; {FormMouseDown}1418 end; { FormMouseDown } 1235 1419 1236 1420 procedure TCityDlg.ChooseProject; 1237 1421 const 1238 ptSelect=0; ptTrGoods=1; ptUn=2; ptCaravan=3; ptImp=4; ptWonder=6; 1239 ptShip=7; ptInvalid=8; 1422 ptSelect = 0; 1423 ptTrGoods = 1; 1424 ptUn = 2; 1425 ptCaravan = 3; 1426 ptImp = 4; 1427 ptWonder = 6; 1428 ptShip = 7; 1429 ptInvalid = 8; 1240 1430 1241 1431 function ProjectType(Project: integer): integer; 1242 1432 begin 1243 if Project and cpCompleted<>0 then result:=ptSelect 1244 else if Project and (cpImp+cpIndex)=cpImp+imTrGoods then result:=ptTrGoods 1245 else if Project and cpImp=0 then 1246 if MyModel[Project and cpIndex].Kind=mkCaravan then result:=ptCaravan 1247 else result:=ptUn 1248 else if Project and cpIndex>=nImp then result:=ptInvalid 1249 else if Imp[Project and cpIndex].Kind=ikWonder then result:=ptWonder 1250 else if Imp[Project and cpIndex].Kind=ikShipPart then result:=ptShip 1251 else result:=ptImp 1433 if Project and cpCompleted <> 0 then 1434 result := ptSelect 1435 else if Project and (cpImp + cpIndex) = cpImp + imTrGoods then 1436 result := ptTrGoods 1437 else if Project and cpImp = 0 then 1438 if MyModel[Project and cpIndex].Kind = mkCaravan then 1439 result := ptCaravan 1440 else 1441 result := ptUn 1442 else if Project and cpIndex >= nImp then 1443 result := ptInvalid 1444 else if Imp[Project and cpIndex].Kind = ikWonder then 1445 result := ptWonder 1446 else if Imp[Project and cpIndex].Kind = ikShipPart then 1447 result := ptShip 1448 else 1449 result := ptImp 1252 1450 end; 1253 1451 1254 1452 var 1255 NewProject, OldMoney,pt0,pt1,cix1: integer;1256 QueryOk: boolean;1257 begin 1258 assert(not supervising);1259 ModalSelectDlg.ShowNewContent_CityProject(wmModal,cix);1260 if ModalSelectDlg.result<>-1 then1261 begin 1262 if ModalSelectDlg.result and cpType<>0 then1263 begin 1264 MyCity[cix].Status:=MyCity[cix].Status and not 71265 or (1+ModalSelectDlg.result and cpIndex);1266 AutoBuild(cix, MyData.ImpOrder[ModalSelectDlg.result and cpIndex]);1453 NewProject, OldMoney, pt0, pt1, cix1: integer; 1454 QueryOk: boolean; 1455 begin 1456 assert(not supervising); 1457 ModalSelectDlg.ShowNewContent_CityProject(wmModal, cix); 1458 if ModalSelectDlg.result <> -1 then 1459 begin 1460 if ModalSelectDlg.result and cpType <> 0 then 1461 begin 1462 MyCity[cix].Status := MyCity[cix].Status and not 7 or 1463 (1 + ModalSelectDlg.result and cpIndex); 1464 AutoBuild(cix, MyData.ImpOrder[ModalSelectDlg.result and cpIndex]); 1267 1465 end 1268 else1269 begin 1270 NewProject:=ModalSelectDlg.result;1271 QueryOk:=true;1272 if (NewProject and cpImp<>0) and (NewProject and cpIndex>=28)1273 and (MyRO.NatBuilt[NewProject and cpIndex]>0) then1274 with MessgExDlg do1466 else 1467 begin 1468 NewProject := ModalSelectDlg.result; 1469 QueryOk := true; 1470 if (NewProject and cpImp <> 0) and (NewProject and cpIndex >= 28) and 1471 (MyRO.NatBuilt[NewProject and cpIndex] > 0) then 1472 with MessgExDlg do 1275 1473 begin 1276 cix1:=MyRO.nCity-1; 1277 while (cix1>=0) and (MyCity[cix1].Built[NewProject and cpIndex]=0) do 1278 dec(cix1); 1279 MessgText:=Format(Phrases.Lookup('DOUBLESTATEIMP'), 1280 [Phrases.Lookup('IMPROVEMENTS', NewProject and cpIndex), 1281 CityName(MyCity[cix1].ID)]); 1282 OpenSound:='MSG_DEFAULT'; 1283 Kind:=mkOkCancel; 1284 IconKind:=mikImp; 1285 IconIndex:=NewProject and cpIndex; 1286 ShowModal; 1287 QueryOk:= ModalResult=mrOK; 1474 cix1 := MyRO.nCity - 1; 1475 while (cix1 >= 0) and 1476 (MyCity[cix1].Built[NewProject and cpIndex] = 0) do 1477 dec(cix1); 1478 MessgText := Format(Phrases.Lookup('DOUBLESTATEIMP'), 1479 [Phrases.Lookup('IMPROVEMENTS', NewProject and cpIndex), 1480 CityName(MyCity[cix1].ID)]); 1481 OpenSound := 'MSG_DEFAULT'; 1482 Kind := mkOkCancel; 1483 IconKind := mikImp; 1484 IconIndex := NewProject and cpIndex; 1485 ShowModal; 1486 QueryOk := ModalResult = mrOK; 1288 1487 end; 1289 if not QueryOk then1290 exit;1291 1292 if (MyCity[cix].Prod>0) then1488 if not QueryOk then 1489 exit; 1490 1491 if (MyCity[cix].Prod > 0) then 1293 1492 begin 1294 pt0:=ProjectType(MyCity[cix].Project0);1295 pt1:=ProjectType(NewProject);1296 if (pt0<>ptSelect) and (pt1<>ptTrGoods) then1493 pt0 := ProjectType(MyCity[cix].Project0); 1494 pt1 := ProjectType(NewProject); 1495 if (pt0 <> ptSelect) and (pt1 <> ptTrGoods) then 1297 1496 begin 1298 if NewProject and (cpImp or cpIndex)<>MyCity[cix].Project0 and (cpImp or cpIndex) then 1497 if NewProject and (cpImp or cpIndex) <> MyCity[cix].Project0 and 1498 (cpImp or cpIndex) then 1299 1499 begin // loss of material -- do query 1300 if (pt1=ptTrGoods) or (pt1=ptShip) or (pt1<>pt0) and (pt0<>ptCaravan) then 1301 QueryOk:=SimpleQuery(mkOkCancel,Format(Phrases.Lookup('LOSEMAT'), 1302 [MyCity[cix].Prod0,MyCity[cix].Prod0]),'MSG_DEFAULT')=mrOK 1303 else if MyCity[cix].Project and (cpImp or cpIndex)=MyCity[cix].Project0 and (cpImp or cpIndex) then 1304 QueryOk:=SimpleQuery(mkOkCancel,Phrases.Lookup('LOSEMAT3'),'MSG_DEFAULT')=mrOK 1500 if (pt1 = ptTrGoods) or (pt1 = ptShip) or (pt1 <> pt0) and 1501 (pt0 <> ptCaravan) then 1502 QueryOk := SimpleQuery(mkOkCancel, 1503 Format(Phrases.Lookup('LOSEMAT'), [MyCity[cix].Prod0, 1504 MyCity[cix].Prod0]), 'MSG_DEFAULT') = mrOK 1505 else if MyCity[cix].Project and (cpImp or cpIndex) = MyCity[cix] 1506 .Project0 and (cpImp or cpIndex) then 1507 QueryOk := SimpleQuery(mkOkCancel, Phrases.Lookup('LOSEMAT3'), 1508 'MSG_DEFAULT') = mrOK 1305 1509 end; 1306 1510 end 1307 1511 end; 1308 if not QueryOk then 1309 exit; 1310 1311 OldMoney:=MyRO.Money; 1312 MyCity[cix].Status:=MyCity[cix].Status and not 7; 1313 if (NewProject and cpImp=0) 1314 and ((MyCity[cix].Size<4) and (MyModel[NewProject and cpIndex].Kind=mkSettler) 1315 or (MyCity[cix].Size<3) and ((MyModel[NewProject and cpIndex].Kind=mkSlaves) 1316 or (NewProject and cpConscripts<>0))) then 1317 if SimpleQuery(mkYesNo,Phrases.Lookup('EMIGRATE'),'MSG_DEFAULT')<>mrOK then 1318 NewProject:=NewProject or cpDisbandCity; 1319 Server(sSetCityProject,me,cix,NewProject); 1320 c.Project:=MyCity[cix].Project; 1321 if MyRO.Money>OldMoney then 1322 Play('CITY_SELLIMP'); 1323 end; 1324 CityOptimizer_CityChange(cix); 1325 1326 if WindowMode<>wmModal then 1327 MainScreen.UpdateViews; 1328 InitSmallCityMap; 1329 SmartUpdateContent; 1330 end; 1331 end; 1332 1333 procedure TCityDlg.BuyClick(Sender:TObject); 1512 if not QueryOk then 1513 exit; 1514 1515 OldMoney := MyRO.Money; 1516 MyCity[cix].Status := MyCity[cix].Status and not 7; 1517 if (NewProject and cpImp = 0) and 1518 ((MyCity[cix].Size < 4) and 1519 (MyModel[NewProject and cpIndex].Kind = mkSettler) or 1520 (MyCity[cix].Size < 3) and 1521 ((MyModel[NewProject and cpIndex].Kind = mkSlaves) or 1522 (NewProject and cpConscripts <> 0))) then 1523 if SimpleQuery(mkYesNo, Phrases.Lookup('EMIGRATE'), 'MSG_DEFAULT') <> mrOK 1524 then 1525 NewProject := NewProject or cpDisbandCity; 1526 Server(sSetCityProject, me, cix, NewProject); 1527 c.Project := MyCity[cix].Project; 1528 if MyRO.Money > OldMoney then 1529 Play('CITY_SELLIMP'); 1530 end; 1531 CityOptimizer_CityChange(cix); 1532 1533 if WindowMode <> wmModal then 1534 MainScreen.UpdateViews; 1535 InitSmallCityMap; 1536 SmartUpdateContent; 1537 end; 1538 end; 1539 1540 procedure TCityDlg.BuyClick(Sender: TObject); 1334 1541 var 1335 NextProd,Cost:integer; 1336 begin 1337 if (cix<0) or (ClientMode>=scContact) then exit; 1338 with MyCity[cix],MessgExDlg do 1339 begin 1340 Cost:=Report.ProjectCost; 1341 NextProd:=Report.Production; 1342 if NextProd<0 then NextProd:=0; 1343 Cost:=Cost-Prod-NextProd; 1344 if (MyRO.Wonder[woMich].EffectiveOwner=me) and (Project and cpImp<>0) then 1345 Cost:=Cost*2 1346 else Cost:=Cost*4; 1347 if (Cost<=0) and (Report.HappinessBalance>=0) {no disorder} then 1348 begin MessgText:=Phrases.Lookup('READY'); Kind:=mkOK; end 1349 else if Cost>MyRO.Money then 1350 begin 1351 OpenSound:='MSG_DEFAULT'; 1352 MessgText:=Format(Phrases.Lookup('NOMONEY'),[Cost,MyRO.Money]); 1353 Kind:=mkOK; 1542 NextProd, Cost: integer; 1543 begin 1544 if (cix < 0) or (ClientMode >= scContact) then 1545 exit; 1546 with MyCity[cix], MessgExDlg do 1547 begin 1548 Cost := Report.ProjectCost; 1549 NextProd := Report.Production; 1550 if NextProd < 0 then 1551 NextProd := 0; 1552 Cost := Cost - Prod - NextProd; 1553 if (MyRO.Wonder[woMich].EffectiveOwner = me) and (Project and cpImp <> 0) 1554 then 1555 Cost := Cost * 2 1556 else 1557 Cost := Cost * 4; 1558 if (Cost <= 0) and (Report.HappinessBalance >= 0) { no disorder } then 1559 begin 1560 MessgText := Phrases.Lookup('READY'); 1561 Kind := mkOk; 1354 1562 end 1355 else begin MessgText:=Format(Phrases.Lookup('BUY'),[Cost]); Kind:=mkYesNo; end; 1356 ShowModal; 1357 if (Kind=mkYesNo) and (ModalResult=mrOK) then 1358 begin 1359 if Server(sBuyCityProject,me,cix,nil^)>=rExecuted then 1563 else if Cost > MyRO.Money then 1564 begin 1565 OpenSound := 'MSG_DEFAULT'; 1566 MessgText := Format(Phrases.Lookup('NOMONEY'), [Cost, MyRO.Money]); 1567 Kind := mkOk; 1568 end 1569 else 1570 begin 1571 MessgText := Format(Phrases.Lookup('BUY'), [Cost]); 1572 Kind := mkYesNo; 1573 end; 1574 ShowModal; 1575 if (Kind = mkYesNo) and (ModalResult = mrOK) then 1576 begin 1577 if Server(sBuyCityProject, me, cix, nil^) >= rExecuted then 1360 1578 begin 1361 Play('CITY_BUYPROJECT');1362 SmartUpdateContent;1363 if WindowMode<>wmModal then1364 MainScreen.UpdateViews;1579 Play('CITY_BUYPROJECT'); 1580 SmartUpdateContent; 1581 if WindowMode <> wmModal then 1582 MainScreen.UpdateViews; 1365 1583 end 1366 1584 end … … 1370 1588 procedure TCityDlg.FormClose(Sender: TObject; var Action: TCloseAction); 1371 1589 begin 1372 Timer1.Enabled:=false; 1373 ProdHint:=false; 1374 MarkCityLoc:=-1; 1375 if Optimize_cixTileChange>=0 then 1376 begin 1377 if Optimize_TilesBeforeChange 1378 and not MyCity[Optimize_cixTileChange].Tiles<>0 then 1379 begin 1380 CityOptimizer_ReleaseCityTiles(Optimize_cixTileChange, 1381 Optimize_TilesBeforeChange and not MyCity[Optimize_cixTileChange].Tiles); 1382 if WindowMode<>wmModal then 1383 MainScreen.UpdateViews; 1384 end; 1385 Optimize_cixTileChange:=-1; 1386 end; 1387 if CloseAction>None then 1388 MainScreen.CityClosed(RestoreUnFocus,CloseAction=StepFocus); 1389 RestoreUnFocus:=-1; 1390 inherited; 1590 Timer1.Enabled := false; 1591 ProdHint := false; 1592 MarkCityLoc := -1; 1593 if Optimize_cixTileChange >= 0 then 1594 begin 1595 if Optimize_TilesBeforeChange and not MyCity[Optimize_cixTileChange] 1596 .Tiles <> 0 then 1597 begin 1598 CityOptimizer_ReleaseCityTiles(Optimize_cixTileChange, 1599 Optimize_TilesBeforeChange and 1600 not MyCity[Optimize_cixTileChange].Tiles); 1601 if WindowMode <> wmModal then 1602 MainScreen.UpdateViews; 1603 end; 1604 Optimize_cixTileChange := -1; 1605 end; 1606 if CloseAction > None then 1607 MainScreen.CityClosed(RestoreUnFocus, CloseAction = StepFocus); 1608 RestoreUnFocus := -1; 1609 inherited; 1391 1610 end; 1392 1611 1393 1612 procedure TCityDlg.Timer1Timer(Sender: TObject); 1394 1613 begin 1395 if ProdHint then 1396 begin 1397 BlinkTime:=(BlinkTime+1) mod 12; 1398 if BlinkTime=0 then with Canvas do 1399 begin 1400 BitBlt(canvas.Handle,xView+5,yView+1,64,2, 1401 back.Canvas.Handle,xView+5,yView+1,SRCCOPY); 1402 BitBlt(canvas.Handle,xView+5,yView+3,2,42, 1403 back.Canvas.Handle,xView+5,yView+3,SRCCOPY); 1404 BitBlt(canvas.Handle,xView+5+62,yView+3,2,42, 1405 back.Canvas.Handle,xView+5+62,yView+3,SRCCOPY); 1406 Frame(canvas,xView+9-1,yView+5-1,xView+9+xSizeBig,yView+5+ySizeBig,$B0B0B0,$FFFFFF); 1407 RFrame(canvas,xView+9-2,yView+5-2,xView+9+xSizeBig+1,yView+5+ySizeBig+1,$FFFFFF,$B0B0B0); 1408 Brush.Color:=$000000; 1409 FillRect(Rect(xView+9,yView+5,xView+1+72-8,yView+5+40)); 1410 Brush.Style:=bsClear; 1411 end 1412 else if BlinkTime=6 then 1413 begin 1414 if AllowChange and (c.Status and 7<>0) then 1614 if ProdHint then 1615 begin 1616 BlinkTime := (BlinkTime + 1) mod 12; 1617 if BlinkTime = 0 then 1618 with Canvas do 1619 begin 1620 bitblt(Canvas.Handle, xView + 5, yView + 1, 64, 2, Back.Canvas.Handle, 1621 xView + 5, yView + 1, SRCCOPY); 1622 bitblt(Canvas.Handle, xView + 5, yView + 3, 2, 42, Back.Canvas.Handle, 1623 xView + 5, yView + 3, SRCCOPY); 1624 bitblt(Canvas.Handle, xView + 5 + 62, yView + 3, 2, 42, 1625 Back.Canvas.Handle, xView + 5 + 62, yView + 3, SRCCOPY); 1626 Frame(Canvas, xView + 9 - 1, yView + 5 - 1, xView + 9 + xSizeBig, 1627 yView + 5 + ySizeBig, $B0B0B0, $FFFFFF); 1628 RFrame(Canvas, xView + 9 - 2, yView + 5 - 2, xView + 9 + xSizeBig + 1, 1629 yView + 5 + ySizeBig + 1, $FFFFFF, $B0B0B0); 1630 brush.Color := $000000; 1631 FillRect(Rect(xView + 9, yView + 5, xView + 1 + 72 - 8, 1632 yView + 5 + 40)); 1633 brush.style := bsClear; 1634 end 1635 else if BlinkTime = 6 then 1636 begin 1637 if AllowChange and (c.Status and 7 <> 0) then 1415 1638 begin // city type autobuild 1416 FrameImage(canvas,bigimp,xView+9,yView+5,xSizeBig,ySizeBig,1417 (c.Status and 7-1+3)*xSizeBig,0,true);1639 FrameImage(Canvas, bigimp, xView + 9, yView + 5, xSizeBig, ySizeBig, 1640 (c.Status and 7 - 1 + 3) * xSizeBig, 0, true); 1418 1641 end 1419 else if c.Project and cpImp=0 then1642 else if c.Project and cpImp = 0 then 1420 1643 begin // project is unit 1421 BitBlt(canvas.Handle,xView+9,yView+5,xSizeBig,ySizeBig,1422 bigimp.Canvas.Handle,0,0,SRCCOPY);1423 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do1424 Sprite(canvas,HGr,xView+5,yView+1,64,44,1425 pix mod 10 *65+1,pix div 10*49+1);1644 bitblt(Canvas.Handle, xView + 9, yView + 5, xSizeBig, ySizeBig, 1645 bigimp.Canvas.Handle, 0, 0, SRCCOPY); 1646 with Tribe[cOwner].ModelPicture[c.Project and cpIndex] do 1647 Sprite(Canvas, HGr, xView + 5, yView + 1, 64, 44, pix mod 10 * 65 + 1, 1648 pix div 10 * 49 + 1); 1426 1649 end 1427 else ImpImage(Canvas,xView+9,yView+5, 1428 c.Project0 and cpIndex,cGov,true); 1650 else 1651 ImpImage(Canvas, xView + 9, yView + 5, c.Project0 and cpIndex, 1652 cGov, true); 1429 1653 end 1430 1654 end … … 1433 1657 procedure TCityDlg.FormPaint(Sender: TObject); 1434 1658 begin 1435 inherited; 1436 if OpenSoundEvent>=0 then PostMessage(Handle, WM_PLAYSOUND, 0, 0); 1437 end; 1438 1439 procedure TCityDlg.OnPlaySound(var Msg:TMessage); 1440 begin 1441 if 1 shl OpenSoundEvent=chProduction then 1442 begin 1443 if c.Project0 and cpImp<>0 then 1444 begin 1445 if c.Project0 and cpIndex>=28 then // wonders have already extra message with sound 1446 if Imp[c.Project0 and cpIndex].Kind=ikShipPart then Play('SHIP_BUILT') 1447 else Play('CITY_IMPCOMPLETE') 1659 inherited; 1660 if OpenSoundEvent >= 0 then 1661 PostMessage(Handle, WM_PLAYSOUND, 0, 0); 1662 end; 1663 1664 procedure TCityDlg.OnPlaySound(var Msg: TMessage); 1665 begin 1666 if 1 shl OpenSoundEvent = chProduction then 1667 begin 1668 if c.Project0 and cpImp <> 0 then 1669 begin 1670 if c.Project0 and cpIndex >= 28 then 1671 // wonders have already extra message with sound 1672 if Imp[c.Project0 and cpIndex].Kind = ikShipPart then 1673 Play('SHIP_BUILT') 1674 else 1675 Play('CITY_IMPCOMPLETE') 1448 1676 end 1449 else Play('CITY_UNITCOMPLETE'); 1677 else 1678 Play('CITY_UNITCOMPLETE'); 1450 1679 end 1451 else Play(CityEventSoundItem[OpenSoundEvent]); 1452 OpenSoundEvent:=-2; 1680 else 1681 Play(CityEventSoundItem[OpenSoundEvent]); 1682 OpenSoundEvent := -2; 1453 1683 end; 1454 1684 1455 1685 function Prio(iix: integer): integer; 1456 1686 begin 1457 case Imp[iix].Kind of 1458 ikWonder: result:=iix+10000; 1459 ikNatLocal, ikNatGlobal: 1687 case Imp[iix].Kind of 1688 ikWonder: 1689 result := iix + 10000; 1690 ikNatLocal, ikNatGlobal: 1691 case iix of 1692 imPalace: 1693 result := 0; 1694 else 1695 result := iix + 20000; 1696 end; 1697 else 1460 1698 case iix of 1461 im Palace: result:=0;1462 else result:=iix+20000;1463 end;1464 else case iix of1465 imTownHall, imCourt: result:=iix+30000;1466 imAqueduct, imSewer: result:=iix+40000;1467 imTemple, imTheater, imCathedral: result:=iix+50000;1468 else result:=iix+90000;1699 imTownHall, imCourt: 1700 result := iix + 30000; 1701 imAqueduct, imSewer: 1702 result := iix + 40000; 1703 imTemple, imTheater, imCathedral: 1704 result := iix + 50000; 1705 else 1706 result := iix + 90000; 1469 1707 end; 1470 1708 end; … … 1473 1711 procedure TCityDlg.NextCityBtnClick(Sender: TObject); 1474 1712 begin 1475 ChangeCity(+1);1713 ChangeCity(+1); 1476 1714 end; 1477 1715 1478 1716 procedure TCityDlg.PrevCityBtnClick(Sender: TObject); 1479 1717 begin 1480 ChangeCity(-1);1718 ChangeCity(-1); 1481 1719 end; 1482 1720 1483 1721 procedure TCityDlg.ChangeCity(d: integer); 1484 1722 var 1485 cixNew: integer;1486 begin 1487 cixNew:=cix;1488 repeat1489 cixNew:=(cixNew+MyRO.nCity+d) mod MyRO.nCity;1490 until (MyCity[cixNew].Loc>=0) or (cixNew=cix);1491 if cixNew<>cix then1492 MainScreen.ZoomToCity(MyCity[cixNew].Loc);1723 cixNew: integer; 1724 begin 1725 cixNew := cix; 1726 repeat 1727 cixNew := (cixNew + MyRO.nCity + d) mod MyRO.nCity; 1728 until (MyCity[cixNew].Loc >= 0) or (cixNew = cix); 1729 if cixNew <> cix then 1730 MainScreen.ZoomToCity(MyCity[cixNew].Loc); 1493 1731 end; 1494 1732 … … 1496 1734 Shift: TShiftState); 1497 1735 begin 1498 if ((Key=VK_UP) or (Key=VK_NUMPAD8)) 1499 and (cix>=0) and (WindowMode=wmPersistent) then 1500 ChangeCity(-1) 1501 else if ((Key=VK_DOWN) or (Key=VK_NUMPAD2)) 1502 and (cix>=0) and (WindowMode=wmPersistent) then 1503 ChangeCity(+1) 1504 else inherited 1505 end; 1506 1507 {procedure TCityDlg.AdviceBtnClick(Sender: TObject); 1508 begin 1509 AdvisorDlg.GiveCityAdvice(cix); 1510 end;} 1736 if ((Key = VK_UP) or (Key = VK_NUMPAD8)) and (cix >= 0) and 1737 (WindowMode = wmPersistent) then 1738 ChangeCity(-1) 1739 else if ((Key = VK_DOWN) or (Key = VK_NUMPAD2)) and (cix >= 0) and 1740 (WindowMode = wmPersistent) then 1741 ChangeCity(+1) 1742 else 1743 inherited 1744 end; 1745 1746 { procedure TCityDlg.AdviceBtnClick(Sender: TObject); 1747 begin 1748 AdvisorDlg.GiveCityAdvice(cix); 1749 end; } 1511 1750 1512 1751 var 1513 i,j,k: integer;1752 i, j, k: integer; 1514 1753 1515 1754 procedure TCityDlg.PageUpBtnClick(Sender: TObject); 1516 1755 begin 1517 if Page>0 then1518 begin 1519 dec(Page);1520 SmartUpdateContent1756 if Page > 0 then 1757 begin 1758 dec(Page); 1759 SmartUpdateContent 1521 1760 end 1522 1761 end; … … 1524 1763 procedure TCityDlg.PageDownBtnClick(Sender: TObject); 1525 1764 begin 1526 if Page<PageCount-1 then1527 begin 1528 inc(Page);1529 SmartUpdateContent1765 if Page < PageCount - 1 then 1766 begin 1767 inc(Page); 1768 SmartUpdateContent 1530 1769 end 1531 1770 end; … … 1533 1772 procedure TCityDlg.ChangeResourceWeights(iResourceWeights: integer); 1534 1773 var 1535 Advice: TCityTileAdviceData; 1536 begin 1537 assert(not supervising); 1538 assert(cix>=0); 1539 MyCity[cix].Status:=MyCity[cix].Status 1540 and not csResourceWeightsMask or (iResourceWeights shl 4); 1541 c.Status:=MyCity[cix].Status; 1542 if iResourceWeights>0 then 1543 begin 1544 Advice.ResourceWeights:=OfferedResourceWeights[iResourceWeights]; 1545 Server(sGetCityTileAdvice,me,cix,Advice); 1546 if Advice.Tiles<>MyCity[cix].Tiles then 1547 Server(sSetCityTiles,me,cix,Advice.Tiles); 1548 end 1549 end; 1550 1774 Advice: TCityTileAdviceData; 1775 begin 1776 assert(not supervising); 1777 assert(cix >= 0); 1778 MyCity[cix].Status := MyCity[cix].Status and not csResourceWeightsMask or 1779 (iResourceWeights shl 4); 1780 c.Status := MyCity[cix].Status; 1781 if iResourceWeights > 0 then 1782 begin 1783 Advice.ResourceWeights := OfferedResourceWeights[iResourceWeights]; 1784 Server(sGetCityTileAdvice, me, cix, Advice); 1785 if Advice.Tiles <> MyCity[cix].Tiles then 1786 Server(sSetCityTiles, me, cix, Advice.Tiles); 1787 end 1788 end; 1551 1789 1552 1790 initialization 1553 for i:=0 to nImp-1 do ImpSorted[i]:=i; 1554 for i:=0 to nImp-2 do for j:=i+1 to nImp-1 do 1555 if Prio(ImpSorted[i])>Prio(ImpSorted[j]) then 1556 begin k:=ImpSorted[i]; ImpSorted[i]:=ImpSorted[j]; ImpSorted[j]:=k end; 1791 1792 for i := 0 to nImp - 1 do 1793 ImpSorted[i] := i; 1794 for i := 0 to nImp - 2 do 1795 for j := i + 1 to nImp - 1 do 1796 if Prio(ImpSorted[i]) > Prio(ImpSorted[j]) then 1797 begin 1798 k := ImpSorted[i]; 1799 ImpSorted[i] := ImpSorted[j]; 1800 ImpSorted[j] := k 1801 end; 1802 1557 1803 end. 1558 -
trunk/LocalPlayer/CityType.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit CityType; 4 3 … … 6 5 7 6 uses 8 Protocol, ClientTools,Term,ScreenTools,BaseWin,7 Protocol, ClientTools, Term, ScreenTools, BaseWin, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 26 25 procedure DeleteBtnClick(Sender: TObject); 27 26 public 28 procedure ShowNewContent(NewMode: integer); 27 procedure ShowNewContent(NewMode: integer); 29 28 protected 30 29 procedure OffscreenPaint; override; 31 30 private 32 nPool, dragiix,ctype: integer;33 Pooliix: array [0..nImp-1] of integer;34 listed: Set of 0 ..nImp;31 nPool, dragiix, ctype: integer; 32 Pooliix: array [0 .. nImp - 1] of integer; 33 listed: Set of 0 .. nImp; 35 34 Changed: boolean; 36 35 procedure LoadType(NewType: integer); … … 48 47 49 48 const 50 xList=7; yList=0; 51 nListRow=4; nListCol=10; 52 xPool=7; yPool=220; 53 nPoolRow=4; nPoolCol=10; 54 xSwitch=7; ySwitch=150; 55 xView=226; yView=130; 56 57 procedure TCityTypeDlg.FormCreate(Sender:TObject); 58 begin 59 inherited; 60 CaptionRight:=CloseBtn.Left; 61 InitButtons(); 62 HelpContext:='MACRO'; 63 Caption:=Phrases.Lookup('TITLE_CITYTYPES'); 64 DeleteBtn.Hint:=Phrases.Lookup('BTN_DELETE'); 65 end; 66 67 procedure TCityTypeDlg.CloseBtnClick(Sender:TObject); 68 begin 69 Close 70 end; 71 72 procedure TCityTypeDlg.FormPaint(Sender:TObject); 73 begin 74 inherited; 75 BtnFrame(Canvas,DeleteBtn.BoundsRect,MainTexture); 49 xList = 7; 50 yList = 0; 51 nListRow = 4; 52 nListCol = 10; 53 xPool = 7; 54 yPool = 220; 55 nPoolRow = 4; 56 nPoolCol = 10; 57 xSwitch = 7; 58 ySwitch = 150; 59 xView = 226; 60 yView = 130; 61 62 procedure TCityTypeDlg.FormCreate(Sender: TObject); 63 begin 64 inherited; 65 CaptionRight := CloseBtn.Left; 66 InitButtons(); 67 HelpContext := 'MACRO'; 68 Caption := Phrases.Lookup('TITLE_CITYTYPES'); 69 DeleteBtn.Hint := Phrases.Lookup('BTN_DELETE'); 70 end; 71 72 procedure TCityTypeDlg.CloseBtnClick(Sender: TObject); 73 begin 74 Close 75 end; 76 77 procedure TCityTypeDlg.FormPaint(Sender: TObject); 78 begin 79 inherited; 80 BtnFrame(Canvas, DeleteBtn.BoundsRect, MainTexture); 76 81 end; 77 82 78 83 procedure TCityTypeDlg.OffscreenPaint; 79 84 var 80 i,iix: integer; 81 s: string; 82 begin 83 inherited; 84 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 85 FillOffscreen(xList-7,yList,42*nListCol+14,32*nListRow); 86 FillOffscreen(xPool-7,yPool,42*nPoolCol+14,32*nPoolRow); 87 FillOffscreen(0,yList+32*nListRow,42*nPoolCol+14,yPool-yList-32*nListRow); 88 89 Frame(offscreen.Canvas,0,yList+32*nListRow,InnerWidth-255,yPool-23, 90 MainTexture.clBevelLight,MainTexture.clBevelShade); 91 Frame(offscreen.Canvas,InnerWidth-254,yList+32*nListRow,InnerWidth-89,yPool-23, 92 MainTexture.clBevelLight,MainTexture.clBevelShade); 93 Frame(offscreen.Canvas,InnerWidth-88,yList+32*nListRow,InnerWidth-1,yPool-23, 94 MainTexture.clBevelLight,MainTexture.clBevelShade); 95 Frame(offscreen.Canvas,0,yPool-22,InnerWidth-1,yPool-1, 96 MainTexture.clBevelLight,MainTexture.clBevelShade); 97 for i:=0 to nCityType-1 do 98 begin 99 RFrame(offscreen.Canvas,xSwitch+i*42,ySwitch,xSwitch+39+i*42,ySwitch+23, 100 MainTexture.clBevelShade,MainTexture.clBevelLight); 101 if i=ctype then 102 Frame(offscreen.Canvas,xSwitch+1+i*42,ySwitch+1,xSwitch+38+i*42,ySwitch+22, 103 MainTexture.clBevelShade,MainTexture.clBevelLight) 104 else Frame(offscreen.Canvas,xSwitch+1+i*42,ySwitch+1,xSwitch+38+i*42,ySwitch+22, 105 MainTexture.clBevelLight,MainTexture.clBevelShade); 106 BitBlt(offscreen.Canvas.Handle,xSwitch+2+i*42,ySwitch+2,xSizeSmall, 107 ySizeSmall,SmallImp.Canvas.Handle,(i+3)*xSizeSmall,0,SRCCOPY) 108 end; 109 RisedTextOut(offscreen.Canvas,8,yList+32*nListRow+2,Phrases.Lookup('BUILDORDER')); 110 RisedTextOut(offscreen.Canvas,8,ySwitch+26,Phrases.Lookup('CITYTYPE',ctype)); 111 s:=Phrases.Lookup('BUILDREST'); 112 RisedTextOut(offscreen.Canvas,(InnerWidth-BiColorTextWidth(Offscreen.Canvas,s)) div 2, 113 yList+72+32*nListRow,s); 114 115 with offscreen.Canvas do 116 begin 117 for i:=1 to nListRow-1 do 118 DLine(offscreen.Canvas,xList-5,xList+4+42*nListCol,yList-1+32*i, 119 MainTexture.clBevelLight,MainTexture.clBevelShade); 120 for i:=0 to nListCol*nListRow-1 do 121 begin 122 s:=IntToStr(i+1); 123 Font.Color:=MainTexture.clTextLight; 124 Textout(xList+20+i mod nListCol *42-TextWidth(s) div 2, 125 yList+15+i div nListCol *32-TextHeight(s) div 2,s); 85 i, iix: integer; 86 s: string; 87 begin 88 inherited; 89 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 90 FillOffscreen(xList - 7, yList, 42 * nListCol + 14, 32 * nListRow); 91 FillOffscreen(xPool - 7, yPool, 42 * nPoolCol + 14, 32 * nPoolRow); 92 FillOffscreen(0, yList + 32 * nListRow, 42 * nPoolCol + 14, 93 yPool - yList - 32 * nListRow); 94 95 Frame(offscreen.Canvas, 0, yList + 32 * nListRow, InnerWidth - 255, 96 yPool - 23, MainTexture.clBevelLight, MainTexture.clBevelShade); 97 Frame(offscreen.Canvas, InnerWidth - 254, yList + 32 * nListRow, 98 InnerWidth - 89, yPool - 23, MainTexture.clBevelLight, 99 MainTexture.clBevelShade); 100 Frame(offscreen.Canvas, InnerWidth - 88, yList + 32 * nListRow, 101 InnerWidth - 1, yPool - 23, MainTexture.clBevelLight, 102 MainTexture.clBevelShade); 103 Frame(offscreen.Canvas, 0, yPool - 22, InnerWidth - 1, yPool - 1, 104 MainTexture.clBevelLight, MainTexture.clBevelShade); 105 for i := 0 to nCityType - 1 do 106 begin 107 RFrame(offscreen.Canvas, xSwitch + i * 42, ySwitch, xSwitch + 39 + i * 42, 108 ySwitch + 23, MainTexture.clBevelShade, MainTexture.clBevelLight); 109 if i = ctype then 110 Frame(offscreen.Canvas, xSwitch + 1 + i * 42, ySwitch + 1, 111 xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.clBevelShade, 112 MainTexture.clBevelLight) 113 else 114 Frame(offscreen.Canvas, xSwitch + 1 + i * 42, ySwitch + 1, 115 xSwitch + 38 + i * 42, ySwitch + 22, MainTexture.clBevelLight, 116 MainTexture.clBevelShade); 117 BitBlt(offscreen.Canvas.Handle, xSwitch + 2 + i * 42, ySwitch + 2, 118 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, (i + 3) * xSizeSmall, 119 0, SRCCOPY) 120 end; 121 RisedTextOut(offscreen.Canvas, 8, yList + 32 * nListRow + 2, 122 Phrases.Lookup('BUILDORDER')); 123 RisedTextOut(offscreen.Canvas, 8, ySwitch + 26, 124 Phrases.Lookup('CITYTYPE', ctype)); 125 s := Phrases.Lookup('BUILDREST'); 126 RisedTextOut(offscreen.Canvas, 127 (InnerWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2, 128 yList + 72 + 32 * nListRow, s); 129 130 with offscreen.Canvas do 131 begin 132 for i := 1 to nListRow - 1 do 133 DLine(offscreen.Canvas, xList - 5, xList + 4 + 42 * nListCol, 134 yList - 1 + 32 * i, MainTexture.clBevelLight, MainTexture.clBevelShade); 135 for i := 0 to nListCol * nListRow - 1 do 136 begin 137 s := IntToStr(i + 1); 138 Font.Color := MainTexture.clTextLight; 139 Textout(xList + 20 + i mod nListCol * 42 - TextWidth(s) div 2, 140 yList + 15 + i div nListCol * 32 - TextHeight(s) div 2, s); 126 141 end 127 142 end; 128 143 129 i:=0; 130 while MyData.ImpOrder[ctype,i]>=0 do 131 begin 132 RFrame(offscreen.Canvas, 133 xList+20-xSizeSmall div 2 + i mod nListCol *42, 134 yList+15-ySizeSmall div 2 + i div nListCol *32, 135 xList+21+xSizeSmall div 2 + i mod nListCol *42, 136 yList+16+ySizeSmall div 2 + i div nListCol *32, 137 MainTexture.clBevelLight,MainTexture.clBevelShade); 138 BitBlt(offscreen.Canvas.Handle, 139 xList+21-xSizeSmall div 2 + i mod nListCol *42, 140 yList+16-ySizeSmall div 2 + i div nListCol *32, 141 xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle, 142 MyData.ImpOrder[ctype,i] mod 7*xSizeSmall, 143 (MyData.ImpOrder[ctype,i]+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY); 144 inc(i); 145 end; 146 147 nPool:=0; 148 for iix:=28 to nImp-1 do 149 if not (iix in listed) and (Imp[iix].Kind=ikCommon) and (iix<>imTrGoods) 150 and (Imp[iix].Preq<>preNA) 151 and ((Imp[iix].Preq=preNone) or (MyRO.Tech[Imp[iix].Preq]>=tsApplicable)) then 152 begin 153 Pooliix[nPool]:=iix; 154 RFrame(offscreen.Canvas, 155 xPool+20-xSizeSmall div 2 + nPool mod nPoolCol *42, 156 yPool+15-ySizeSmall div 2 + nPool div nPoolCol *32, 157 xPool+21+xSizeSmall div 2 + nPool mod nPoolCol *42, 158 yPool+16+ySizeSmall div 2 + nPool div nPoolCol *32, 144 i := 0; 145 while MyData.ImpOrder[ctype, i] >= 0 do 146 begin 147 RFrame(offscreen.Canvas, xList + 20 - xSizeSmall div 2 + i mod nListCol * 148 42, yList + 15 - ySizeSmall div 2 + i div nListCol * 32, 149 xList + 21 + xSizeSmall div 2 + i mod nListCol * 42, 150 yList + 16 + ySizeSmall div 2 + i div nListCol * 32, 159 151 MainTexture.clBevelLight, MainTexture.clBevelShade); 160 BitBlt(offscreen.Canvas.Handle, 161 xPool+21-xSizeSmall div 2 + nPool mod nPoolCol *42, 162 yPool+16-ySizeSmall div 2 + nPool div nPoolCol *32, 163 xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle, 164 iix mod 7*xSizeSmall,(iix+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY); 165 inc(nPool) 152 BitBlt(offscreen.Canvas.Handle, xList + 21 - xSizeSmall div 2 + 153 i mod nListCol * 42, yList + 16 - ySizeSmall div 2 + i div nListCol * 32, 154 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 155 MyData.ImpOrder[ctype, i] mod 7 * xSizeSmall, 156 (MyData.ImpOrder[ctype, i] + SystemIconLines * 7) div 7 * 157 ySizeSmall, SRCCOPY); 158 inc(i); 159 end; 160 161 nPool := 0; 162 for iix := 28 to nImp - 1 do 163 if not(iix in listed) and (Imp[iix].Kind = ikCommon) and (iix <> imTrGoods) 164 and (Imp[iix].Preq <> preNA) and 165 ((Imp[iix].Preq = preNone) or (MyRO.Tech[Imp[iix].Preq] >= tsApplicable)) 166 then 167 begin 168 Pooliix[nPool] := iix; 169 RFrame(offscreen.Canvas, xPool + 20 - xSizeSmall div 2 + 170 nPool mod nPoolCol * 42, yPool + 15 - ySizeSmall div 2 + 171 nPool div nPoolCol * 32, xPool + 21 + xSizeSmall div 2 + 172 nPool mod nPoolCol * 42, yPool + 16 + ySizeSmall div 2 + 173 nPool div nPoolCol * 32, MainTexture.clBevelLight, 174 MainTexture.clBevelShade); 175 BitBlt(offscreen.Canvas.Handle, xPool + 21 - xSizeSmall div 2 + 176 nPool mod nPoolCol * 42, yPool + 16 - ySizeSmall div 2 + 177 nPool div nPoolCol * 32, xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 178 iix mod 7 * xSizeSmall, (iix + SystemIconLines * 7) div 7 * 179 ySizeSmall, SRCCOPY); 180 inc(nPool) 166 181 end; 167 DeleteBtn.Visible:= MyData.ImpOrder[ctype,0]>=0; 168 169 if dragiix>=0 then 170 begin 171 ImpImage(offscreen.Canvas,xView+9,yView+5,dragiix); 172 s:=Phrases.Lookup('IMPROVEMENTS',dragiix); 173 RisedTextOut(offscreen.Canvas,xView+36-BiColorTextWidth(Offscreen.Canvas,s) div 2, 174 ySwitch+26,s); 175 end; 176 MarkUsedOffscreen(InnerWidth,InnerHeight); 177 end; {MainPaint} 182 DeleteBtn.Visible := MyData.ImpOrder[ctype, 0] >= 0; 183 184 if dragiix >= 0 then 185 begin 186 ImpImage(offscreen.Canvas, xView + 9, yView + 5, dragiix); 187 s := Phrases.Lookup('IMPROVEMENTS', dragiix); 188 RisedTextOut(offscreen.Canvas, 189 xView + 36 - BiColorTextWidth(offscreen.Canvas, s) div 2, 190 ySwitch + 26, s); 191 end; 192 MarkUsedOffscreen(InnerWidth, InnerHeight); 193 end; { MainPaint } 178 194 179 195 procedure TCityTypeDlg.LoadType(NewType: integer); 180 196 var 181 i: integer; 182 begin 183 ctype:=NewType; 184 listed:=[]; 185 i:=0; 186 while MyData.ImpOrder[ctype,i]>=0 do 187 begin include(listed,MyData.ImpOrder[ctype,i]); inc(i) end; 188 Changed:=false 197 i: integer; 198 begin 199 ctype := NewType; 200 listed := []; 201 i := 0; 202 while MyData.ImpOrder[ctype, i] >= 0 do 203 begin 204 include(listed, MyData.ImpOrder[ctype, i]); 205 inc(i) 206 end; 207 Changed := false 189 208 end; 190 209 191 210 procedure TCityTypeDlg.SaveType; 192 211 var 193 cix: integer;194 begin 195 if Changed then196 begin 197 for cix:=0 to MyRO.nCity-1 do198 if (MyCity[cix].Loc>=0) and (MyCity[cix].Status and 7=ctype+1) then199 AutoBuild(cix, MyData.ImpOrder[ctype]);200 Changed:=false212 cix: integer; 213 begin 214 if Changed then 215 begin 216 for cix := 0 to MyRO.nCity - 1 do 217 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Status and 7 = ctype + 1) then 218 AutoBuild(cix, MyData.ImpOrder[ctype]); 219 Changed := false 201 220 end; 202 221 end; … … 204 223 procedure TCityTypeDlg.FormShow(Sender: TObject); 205 224 begin 206 LoadType(0);207 dragiix:=-1;208 OffscreenPaint;225 LoadType(0); 226 dragiix := -1; 227 OffscreenPaint; 209 228 end; 210 229 211 230 procedure TCityTypeDlg.ShowNewContent(NewMode: integer); 212 231 begin 213 inherited ShowNewContent(NewMode); 214 end; 215 216 procedure TCityTypeDlg.PaintBox1MouseDown(Sender: TObject; 217 Button: TMouseButton; Shift: TShiftState; x, y: integer); 218 var 219 i: integer; 220 begin 221 x:=x-SideFrame; y:=y-WideFrame; 222 i:=(x-xList) div 42+(y-yList) div 32 *nListCol; 223 if (i<nImp) and (MyData.ImpOrder[ctype,i]>=0) 224 and (x>xList+2+ i mod nListCol *42) and (y>yList+5+ i div nListCol *32) 225 and (x<xList+3+36+ i mod nListCol *42) and (y<yList+6+20+ i div nListCol *32) then 226 begin 227 if ssShift in Shift then 228 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, MyData.ImpOrder[ctype,i]) 229 else 230 begin 231 dragiix:=MyData.ImpOrder[ctype,i]; 232 Screen.Cursor:=crImpDrag; 232 inherited ShowNewContent(NewMode); 233 end; 234 235 procedure TCityTypeDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 236 Shift: TShiftState; x, y: integer); 237 var 238 i: integer; 239 begin 240 x := x - SideFrame; 241 y := y - WideFrame; 242 i := (x - xList) div 42 + (y - yList) div 32 * nListCol; 243 if (i < nImp) and (MyData.ImpOrder[ctype, i] >= 0) and 244 (x > xList + 2 + i mod nListCol * 42) and 245 (y > yList + 5 + i div nListCol * 32) and 246 (x < xList + 3 + 36 + i mod nListCol * 42) and 247 (y < yList + 6 + 20 + i div nListCol * 32) then 248 begin 249 if ssShift in Shift then 250 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, 251 MyData.ImpOrder[ctype, i]) 252 else 253 begin 254 dragiix := MyData.ImpOrder[ctype, i]; 255 Screen.Cursor := crImpDrag; 256 SmartUpdateContent 257 end; 258 exit; 259 end; 260 i := (x - xPool) div 42 + (y - yPool) div 32 * nPoolCol; 261 if (i < nPool) and (x > xPool + 2 + i mod nPoolCol * 42) and 262 (y > yPool + 5 + i div nPoolCol * 32) and 263 (x < xPool + 3 + 36 + i mod nPoolCol * 42) and 264 (y < yPool + 6 + 20 + i div nPoolCol * 32) then 265 begin 266 if ssShift in Shift then 267 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Pooliix[i]) 268 else 269 begin 270 dragiix := Pooliix[i]; 271 Screen.Cursor := crImpDrag; 272 SmartUpdateContent 273 end; 274 exit; 275 end; 276 i := (x - xSwitch) div 42; 277 if (i < nCityType) and (x > xSwitch + 2 + i * 42) and 278 (x < xSwitch + 3 + 36 + i * 42) and (y >= ySwitch + 2) and (y < ySwitch + 22) 279 then 280 begin 281 SaveType; 282 LoadType(i); 233 283 SmartUpdateContent 234 end;235 exit;236 end;237 i:=(x-xPool) div 42+(y-yPool) div 32 *nPoolCol;238 if (i<nPool) and (x>xPool+2+ i mod nPoolCol *42)239 and (y>yPool+5+ i div nPoolCol *32) and (x<xPool+3+36+ i mod nPoolCol *42)240 and (y<yPool+6+20+ i div nPoolCol *32) then241 begin242 if ssShift in Shift then243 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Pooliix[i])244 else245 begin246 dragiix:=Pooliix[i];247 Screen.Cursor:=crImpDrag;248 SmartUpdateContent249 end;250 exit;251 end;252 i:=(x-xSwitch) div 42;253 if (i<nCityType) and (x>xSwitch+2+ i*42) and (x<xSwitch+3+36+i*42)254 and (y>=ySwitch+2) and (y<ySwitch+22) then255 begin256 SaveType;257 LoadType(i);258 SmartUpdateContent259 284 end 260 285 end; … … 265 290 procedure UnList(iix: integer); 266 291 var 292 i: integer; 293 begin 294 i := 0; 295 while (MyData.ImpOrder[ctype, i] >= 0) and 296 (MyData.ImpOrder[ctype, i] <> iix) do 297 inc(i); 298 assert(MyData.ImpOrder[ctype, i] = iix); 299 move(MyData.ImpOrder[ctype, i + 1], MyData.ImpOrder[ctype, i], nImp - i); 300 Exclude(listed, iix); 301 end; 302 303 var 267 304 i: integer; 268 begin 269 i:=0; 270 while (MyData.ImpOrder[ctype,i]>=0) and (MyData.ImpOrder[ctype,i]<>iix) do 271 inc(i); 272 assert(MyData.ImpOrder[ctype,i]=iix); 273 move(MyData.ImpOrder[ctype,i+1],MyData.ImpOrder[ctype,i],nImp-i); 274 Exclude(listed,iix); 275 end; 276 277 var 278 i: integer; 279 begin 280 x:=x-SideFrame; y:=y-WideFrame; 281 if dragiix>=0 then 282 begin 283 if (x>=xList) and (x<xList+nListCol*42) 284 and (y>=yList) and (y<yList+nListRow*32) then 285 begin 286 if dragiix in listed then UnList(dragiix); 287 i:=(x-xList) div 42+(y-yList) div 32 *nListCol; 288 while (i>0) and (MyData.ImpOrder[ctype,i-1]<0) do dec(i); 289 move(MyData.ImpOrder[ctype,i],MyData.ImpOrder[ctype,i+1],nImp-i-1); 290 MyData.ImpOrder[ctype,i]:=dragiix; 291 include(listed,dragiix); 292 Changed:=true 305 begin 306 x := x - SideFrame; 307 y := y - WideFrame; 308 if dragiix >= 0 then 309 begin 310 if (x >= xList) and (x < xList + nListCol * 42) and (y >= yList) and 311 (y < yList + nListRow * 32) then 312 begin 313 if dragiix in listed then 314 UnList(dragiix); 315 i := (x - xList) div 42 + (y - yList) div 32 * nListCol; 316 while (i > 0) and (MyData.ImpOrder[ctype, i - 1] < 0) do 317 dec(i); 318 move(MyData.ImpOrder[ctype, i], MyData.ImpOrder[ctype, i + 1], 319 nImp - i - 1); 320 MyData.ImpOrder[ctype, i] := dragiix; 321 include(listed, dragiix); 322 Changed := true 293 323 end 294 else if (dragiix in listed) and (x>=xPool) and (x<xPool+nPoolCol*42)295 and (y>=yPool) and (y<yPool+nPoolRow*32) then296 begin 297 UnList(dragiix);298 Changed:=true324 else if (dragiix in listed) and (x >= xPool) and (x < xPool + nPoolCol * 42) 325 and (y >= yPool) and (y < yPool + nPoolRow * 32) then 326 begin 327 UnList(dragiix); 328 Changed := true 299 329 end; 300 dragiix:=-1; 330 dragiix := -1; 331 SmartUpdateContent 332 end; 333 Screen.Cursor := crDefault 334 end; 335 336 procedure TCityTypeDlg.FormClose(Sender: TObject; var Action: TCloseAction); 337 begin 338 SaveType; 339 inherited; 340 end; 341 342 procedure TCityTypeDlg.DeleteBtnClick(Sender: TObject); 343 begin 344 fillchar(MyData.ImpOrder[ctype], sizeof(MyData.ImpOrder[ctype]), -1); 345 listed := []; 346 Changed := true; 301 347 SmartUpdateContent 302 end;303 Screen.Cursor:=crDefault304 end;305 306 procedure TCityTypeDlg.FormClose(Sender: TObject; var Action: TCloseAction);307 begin308 SaveType;309 inherited;310 end;311 312 procedure TCityTypeDlg.DeleteBtnClick(Sender: TObject);313 begin314 fillchar(MyData.ImpOrder[ctype],sizeof(MyData.ImpOrder[ctype]),-1);315 listed:=[];316 Changed:=true;317 SmartUpdateContent318 348 end; 319 349 320 350 end. 321 -
trunk/LocalPlayer/ClientTools.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit ClientTools; 4 3 … … 9 8 10 9 const 11 nOfferedResourceWeights=6;12 OfferedResourceWeights: array[0..nOfferedResourceWeights-1] of cardinal=13 (rwOff, rwMaxScience, rwForceScience, rwMaxGrowth, rwForceProd, rwMaxProd);10 nOfferedResourceWeights = 6; 11 OfferedResourceWeights: array [0 .. nOfferedResourceWeights - 1] of cardinal = 12 (rwOff, rwMaxScience, rwForceScience, rwMaxGrowth, rwForceProd, rwMaxProd); 14 13 15 14 type 16 TImpOrder=array[0..(nImp+4) div 4 *4 -1] of ShortInt;17 TEnhancementJobs=array[0..11,0..7] of Byte;18 JobResultSet=set of 0..39;15 TImpOrder = array [0 .. (nImp + 4) div 4 * 4 - 1] of ShortInt; 16 TEnhancementJobs = array [0 .. 11, 0 .. 7] of Byte; 17 JobResultSet = set of 0 .. 39; 19 18 20 19 var 21 Server: TServerCall; 22 G: TNewGameData; 23 me: integer; 24 MyRO: ^TPlayerContext; 25 MyMap: ^TTileList; 26 MyUn: ^TUnList; 27 MyCity: ^TCityList; 28 MyModel: ^TModelList; 29 30 AdvValue: array[0..nAdv-1] of integer; 31 32 33 function dLoc(Loc,dx,dy: integer): integer; 34 function Distance(Loc0,Loc1: integer): integer; 35 function UnrestAtLoc(uix,Loc: integer): boolean; 20 Server: TServerCall; 21 G: TNewGameData; 22 me: integer; 23 MyRO: ^TPlayerContext; 24 MyMap: ^TTileList; 25 MyUn: ^TUnList; 26 MyCity: ^TCityList; 27 MyModel: ^TModelList; 28 29 AdvValue: array [0 .. nAdv - 1] of integer; 30 31 function dLoc(Loc, dx, dy: integer): integer; 32 function Distance(Loc0, Loc1: integer): integer; 33 function UnrestAtLoc(uix, Loc: integer): boolean; 36 34 function GetMoveAdvice(uix, ToLoc: integer; 37 35 var MoveAdviceData: TMoveAdviceData): integer; … … 43 41 function IsMilReportNew(Enemy: integer): boolean; 44 42 function CutCityFoodSurplus(FoodSurplus: integer; IsCityAlive: boolean; 45 gov,size: integer): integer; 46 function CityTaxBalance(cix: integer; const CityReport: TCityReportNew): integer; 43 gov, size: integer): integer; 44 function CityTaxBalance(cix: integer; const CityReport: TCityReportNew) 45 : integer; 47 46 procedure SumCities(var TaxSum, ScienceSum: integer); 48 function JobTest(uix, Job: integer; IgnoreResults: JobResultSet = []): boolean;47 function JobTest(uix, Job: integer; IgnoreResults: JobResultSet = []): boolean; 49 48 procedure GetUnitInfo(Loc: integer; var uix: integer; var UnitInfo: TUnitInfo); 50 49 procedure GetCityInfo(Loc: integer; var cix: integer; var CityInfo: TCityInfo); 51 50 function UnitExhausted(uix: integer): boolean; 52 51 function ModelHash(const ModelInfo: TModelInfo): integer; 53 function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs): integer; 52 function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs) 53 : integer; 54 54 function AutoBuild(cix: integer; const ImpOrder: TImpOrder): boolean; 55 55 procedure DebugMessage(Level: integer; Text: string); … … 62 62 procedure CityOptimizer_EndOfTurn; 63 63 64 65 64 implementation 66 65 67 66 var 68 CityNeedsOptimize: array[0..ncmax-1] of boolean; 69 70 71 function dLoc(Loc,dx,dy: integer): integer; 67 CityNeedsOptimize: array [0 .. ncmax - 1] of boolean; 68 69 function dLoc(Loc, dx, dy: integer): integer; 72 70 var 73 y0: integer;71 y0: integer; 74 72 begin 75 y0:=(Loc+G.lx*1024) div G.lx -1024; 76 result:=(Loc+(dx+y0 and 1+G.lx*1024) shr 1) mod G.lx +G.lx*(y0+dy) 73 y0 := (Loc + G.lx * 1024) div G.lx - 1024; 74 result := (Loc + (dx + y0 and 1 + G.lx * 1024) shr 1) mod G.lx + G.lx 75 * (y0 + dy) 77 76 end; 78 77 79 function Distance(Loc0, Loc1: integer): integer;78 function Distance(Loc0, Loc1: integer): integer; 80 79 var 81 dx,dy: integer;80 dx, dy: integer; 82 81 begin 83 inc(Loc0,G.lx*1024);84 inc(Loc1,G.lx*1024);85 dx:=abs(((Loc1 mod G.lx *2 +Loc1 div G.lx and 1) 86 -(Loc0 mod G.lx *2 +Loc0 div G.lx and 1)+3*G.lx) mod (2*G.lx) -G.lx);87 dy:=abs(Loc1 div G.lx-Loc0 div G.lx);88 result:=dx+dy+abs(dx-dy) shr 1;82 inc(Loc0, G.lx * 1024); 83 inc(Loc1, G.lx * 1024); 84 dx := abs(((Loc1 mod G.lx * 2 + Loc1 div G.lx and 1) - (Loc0 mod G.lx * 2 + 85 Loc0 div G.lx and 1) + 3 * G.lx) mod (2 * G.lx) - G.lx); 86 dy := abs(Loc1 div G.lx - Loc0 div G.lx); 87 result := dx + dy + abs(dx - dy) shr 1; 89 88 end; 90 89 91 function UnrestAtLoc(uix, Loc: integer): boolean;90 function UnrestAtLoc(uix, Loc: integer): boolean; 92 91 var 93 uix1: integer;92 uix1: integer; 94 93 begin 95 result:=false;96 if MyModel[MyUn[uix].mix].Flags and mdCivil=0 then97 case MyRO.Government of98 gRepublic, gFuture:99 result:=(MyRO.Territory[Loc]>=0) and (MyRO.Territory[Loc]<>me)100 and (MyRO.Treaty[MyRO.Territory[Loc]]<trAlliance);101 gDemocracy:102 result:=(MyRO.Territory[Loc]<0) or (MyRO.Territory[Loc]<>me)103 and (MyRO.Treaty[MyRO.Territory[Loc]]<trAlliance);94 result := false; 95 if MyModel[MyUn[uix].mix].Flags and mdCivil = 0 then 96 case MyRO.Government of 97 gRepublic, gFuture: 98 result := (MyRO.Territory[Loc] >= 0) and (MyRO.Territory[Loc] <> me) and 99 (MyRO.Treaty[MyRO.Territory[Loc]] < trAlliance); 100 gDemocracy: 101 result := (MyRO.Territory[Loc] < 0) or (MyRO.Territory[Loc] <> me) and 102 (MyRO.Treaty[MyRO.Territory[Loc]] < trAlliance); 104 103 end; 105 with MyModel[MyUn[uix].mix] do106 if Cap[mcSeaTrans]+Cap[mcAirTrans]+Cap[mcCarrier]>0 then107 for uix1:=0 to MyRO.nUn-1 do // check transported units too108 if (MyUn[uix1].Loc>=0) and (MyUn[uix1].Master=uix) then109 result:=result or UnrestAtLoc(uix1,Loc);104 with MyModel[MyUn[uix].mix] do 105 if Cap[mcSeaTrans] + Cap[mcAirTrans] + Cap[mcCarrier] > 0 then 106 for uix1 := 0 to MyRO.nUn - 1 do // check transported units too 107 if (MyUn[uix1].Loc >= 0) and (MyUn[uix1].Master = uix) then 108 result := result or UnrestAtLoc(uix1, Loc); 110 109 end; 111 110 112 function GetMoveAdvice(uix, ToLoc: integer; var MoveAdviceData: TMoveAdviceData): integer; 111 function GetMoveAdvice(uix, ToLoc: integer; 112 var MoveAdviceData: TMoveAdviceData): integer; 113 113 var 114 MinEndHealth: integer;114 MinEndHealth: integer; 115 115 begin 116 if MyModel[MyUn[uix].mix].Domain=dGround then MinEndHealth:=100 117 else MinEndHealth:=1; // resistent to hostile terrain -- don't consider 118 repeat 119 if MyUn[uix].Health>=MinEndHealth then 120 begin 121 MoveAdviceData.ToLoc:=ToLoc; 122 MoveAdviceData.MoreTurns:=999; 123 MoveAdviceData.MaxHostile_MovementLeft:=MyUn[uix].Health-MinEndHealth; 124 result:=Server(sGetMoveAdvice,me,uix,MoveAdviceData); 125 if (MinEndHealth<=1) or (result<>eNoWay) then exit; 116 if MyModel[MyUn[uix].mix].Domain = dGround then 117 MinEndHealth := 100 118 else 119 MinEndHealth := 1; // resistent to hostile terrain -- don't consider 120 repeat 121 if MyUn[uix].Health >= MinEndHealth then 122 begin 123 MoveAdviceData.ToLoc := ToLoc; 124 MoveAdviceData.MoreTurns := 999; 125 MoveAdviceData.MaxHostile_MovementLeft := MyUn[uix].Health - MinEndHealth; 126 result := Server(sGetMoveAdvice, me, uix, MoveAdviceData); 127 if (MinEndHealth <= 1) or (result <> eNoWay) then 128 exit; 126 129 end; 127 case MinEndHealth of 128 100: MinEndHealth:=50; 129 50: MinEndHealth:=25; 130 25: MinEndHealth:=12; 131 else MinEndHealth:=1 130 case MinEndHealth of 131 100: 132 MinEndHealth := 50; 133 50: 134 MinEndHealth := 25; 135 25: 136 MinEndHealth := 12; 137 else 138 MinEndHealth := 1 132 139 end; 133 until false 134 end; 135 136 function ColorOfHealth(Health: integer): integer; 137 var 138 red,green: integer; 139 begin 140 green:=400*Health div 100; if green>200 then green:=200; 141 red:=510*(100-Health) div 100; if red>255 then red:=255; 142 result:=green shl 8 + red 143 end; 144 145 function IsMultiPlayerGame: boolean; 146 var 147 p1: integer; 148 begin 149 result:=false; 150 for p1:=1 to nPl-1 do 151 if G.RO[p1]<>nil then result:=true; 152 end; 153 154 procedure ItsMeAgain(p: integer); 155 begin 156 if G.RO[p]<>nil then 157 MyRO:=pointer(G.RO[p]) 158 else if G.SuperVisorRO[p]<>nil then 159 MyRO:=pointer(G.SuperVisorRO[p]) 160 else exit; 161 me:=p; 162 MyMap:=pointer(MyRO.Map); 163 MyUn:=pointer(MyRO.Un); 164 MyCity:=pointer(MyRO.City); 165 MyModel:=pointer(MyRO.Model); 166 end; 167 168 function GetAge(p: integer): integer; 169 var 170 i: integer; 171 begin 172 if p=me then 173 begin 174 result:=0; 175 for i:=1 to 3 do 176 if MyRO.Tech[AgePreq[i]]>=tsApplicable then result:=i; 177 end 178 else 179 begin 180 result:=0; 181 for i:=1 to 3 do 182 if MyRO.EnemyReport[p].Tech[AgePreq[i]]>=tsApplicable then result:=i; 183 end 184 end; 185 186 function IsCivilReportNew(Enemy: integer): boolean; 187 var 188 i: integer; 189 begin 190 assert(Enemy<>me); 191 i:=MyRO.EnemyReport[Enemy].TurnOfCivilReport; 192 result:= (i=MyRO.Turn) or (i=MyRO.Turn-1) and (Enemy>me); 193 end; 194 195 function IsMilReportNew(Enemy: integer): boolean; 196 var 197 i: integer; 198 begin 199 assert(Enemy<>me); 200 i:=MyRO.EnemyReport[Enemy].TurnOfMilReport; 201 result:= (i=MyRO.Turn) or (i=MyRO.Turn-1) and (Enemy>me); 202 end; 203 204 function CutCityFoodSurplus(FoodSurplus: integer; IsCityAlive: boolean; 205 gov,size: integer): integer; 206 begin 207 result:=FoodSurplus; 208 if not IsCityAlive 209 or (result>0) 210 and ((gov=gFuture) 211 or (size>=NeedAqueductSize) and (result<2)) then 212 result:=0; {no growth} 213 end; 214 215 function CityTaxBalance(cix: integer; const CityReport: TCityReportNew): integer; 216 var 217 i: integer; 218 begin 219 result:=0; 220 if (CityReport.HappinessBalance>=0) {no disorder} 221 and (MyCity[cix].Flags and chCaptured=0) then // not captured 222 begin 223 inc(result, CityReport.Tax); 224 if (MyCity[cix].Project and (cpImp+cpIndex)=cpImp+imTrGoods) 225 and (CityReport.Production>0) then 226 inc(result, CityReport.Production); 227 if ((MyRO.Government=gFuture) 228 or (MyCity[cix].Size>=NeedAqueductSize) 229 and (CityReport.FoodSurplus<2)) 230 and (CityReport.FoodSurplus>0) then 231 inc(result, CityReport.FoodSurplus); 232 end; 233 for i:=28 to nImp-1 do if MyCity[cix].Built[i]>0 then 234 dec(result, Imp[i].Maint); 235 end; 236 237 procedure SumCities(var TaxSum, ScienceSum: integer); 238 var 239 cix: integer; 240 CityReport: TCityReportNew; 241 begin 242 TaxSum:=MyRO.OracleIncome; 243 ScienceSum:=0; 244 if MyRO.Government=gAnarchy then exit; 245 for cix:=0 to MyRO.nCity-1 do if MyCity[cix].Loc>=0 then 246 begin 247 CityReport.HypoTiles:=-1; 248 CityReport.HypoTaxRate:=-1; 249 CityReport.HypoLuxuryRate:=-1; 250 Server(sGetCityReportNew,me,cix,CityReport); 251 if (CityReport.HappinessBalance>=0) {no disorder} 252 and (MyCity[cix].Flags and chCaptured=0) then // not captured 253 ScienceSum:=ScienceSum+CityReport.Science; 254 TaxSum:=TaxSum+CityTaxBalance(cix, CityReport); 255 end; 256 end; 257 258 function JobTest(uix,Job: integer; IgnoreResults: JobResultSet): boolean; 259 var 260 Test: integer; 261 begin 262 Test:=Server(sStartJob+Job shl 4-sExecute,me,uix,nil^); 263 result:= (Test>=rExecuted) or (Test in IgnoreResults); 264 end; 265 266 procedure GetUnitInfo(Loc: integer; var uix: integer; var UnitInfo: TUnitInfo); 267 var 268 i,Cnt: integer; 269 begin 270 if MyMap[Loc] and fOwned<>0 then 271 begin 272 Server(sGetDefender,me,Loc,uix); 273 Cnt:=0; 274 for i:=0 to MyRO.nUn-1 do 275 if MyUn[i].Loc=Loc then inc(Cnt); 276 MakeUnitInfo(me,MyUn[uix],UnitInfo); 277 if Cnt>1 then UnitInfo.Flags:=UnitInfo.Flags or unMulti; 278 end 279 else 280 begin 281 uix:=MyRO.nEnemyUn-1; 282 while (uix>=0) and (MyRO.EnemyUn[uix].Loc<>Loc) do dec(uix); 283 UnitInfo:=MyRO.EnemyUn[uix]; 284 end 285 end;{GetUnitInfo} 286 287 procedure GetCityInfo(Loc: integer; var cix: integer; var CityInfo: TCityInfo); 288 begin 289 if MyMap[Loc] and fOwned<>0 then 290 begin 291 CityInfo.Loc:=Loc; 292 cix:=MyRO.nCity-1; 293 while (cix>=0) and (MyCity[cix].Loc<>Loc) do dec(cix); 294 with CityInfo do 295 begin 296 Owner:=me; 297 ID:=MyCity[cix].ID; 298 Size:=MyCity[cix].Size; 299 Flags:=0; 300 if MyCity[cix].Built[imPalace]>0 then inc(Flags,ciCapital); 301 if (MyCity[cix].Built[imWalls]>0) 302 or (MyMap[MyCity[cix].Loc] and fGrWall<>0) then inc(Flags,ciWalled); 303 if MyCity[cix].Built[imCoastalFort]>0 then inc(Flags,ciCoastalFort); 304 if MyCity[cix].Built[imMissileBat]>0 then inc(Flags,ciMissileBat); 305 if MyCity[cix].Built[imBunker]>0 then inc(Flags,ciBunker); 306 if MyCity[cix].Built[imSpacePort]>0 then inc(Flags,ciSpacePort); 140 until false end; 141 142 function ColorOfHealth(Health: integer): integer; 143 var 144 red, green: integer; 145 begin 146 green := 400 * Health div 100; 147 if green > 200 then 148 green := 200; 149 red := 510 * (100 - Health) div 100; 150 if red > 255 then 151 red := 255; 152 result := green shl 8 + red 153 end; 154 155 function IsMultiPlayerGame: boolean; 156 var 157 p1: integer; 158 begin 159 result := false; 160 for p1 := 1 to nPl - 1 do 161 if G.RO[p1] <> nil then 162 result := true; 163 end; 164 165 procedure ItsMeAgain(p: integer); 166 begin 167 if G.RO[p] <> nil then 168 MyRO := pointer(G.RO[p]) 169 else if G.SuperVisorRO[p] <> nil then 170 MyRO := pointer(G.SuperVisorRO[p]) 171 else 172 exit; 173 me := p; 174 MyMap := pointer(MyRO.Map); 175 MyUn := pointer(MyRO.Un); 176 MyCity := pointer(MyRO.City); 177 MyModel := pointer(MyRO.Model); 178 end; 179 180 function GetAge(p: integer): integer; 181 var 182 i: integer; 183 begin 184 if p = me then 185 begin 186 result := 0; 187 for i := 1 to 3 do 188 if MyRO.Tech[AgePreq[i]] >= tsApplicable then 189 result := i; 307 190 end 308 end 309 else 310 begin 311 cix:=MyRO.nEnemyCity-1; 312 while (cix>=0) and (MyRO.EnemyCity[cix].Loc<>Loc) do dec(cix); 313 CityInfo:=MyRO.EnemyCity[cix]; 314 end 315 end; 316 317 function UnitExhausted(uix: integer): boolean; 318 // check if another move of this unit is still possible 319 var 320 dx, dy: integer; 321 begin 322 result:=true; 323 if (MyUn[uix].Movement>0) or (MyRO.Wonder[woShinkansen].EffectiveOwner=me) then 324 if (MyUn[uix].Movement>=100) or ((MyModel[MyUn[uix].mix].Kind=mkCaravan) 325 and (MyMap[MyUn[uix].Loc] and fCity<>0)) then 326 result:=false 327 else for dx:=-2 to 2 do for dy:=-2 to 2 do if abs(dx)+abs(dy)=2 then 328 if Server(sMoveUnit-sExecute+dx and 7 shl 4+dy and 7 shl 7,me,uix,nil^)>=rExecuted then 329 result:=false; 330 end; 331 332 function ModelHash(const ModelInfo: TModelInfo): integer; 333 var 334 i,FeatureCode,Hash1,Hash2,Hash2r,d: cardinal; 335 begin 336 with ModelInfo do 337 if Kind>mkEnemyDeveloped then 338 result:=integer($C0000000+Speed div 50+Kind shl 8) 339 else 340 begin 341 FeatureCode:=0; 342 for i:=mcFirstNonCap to nFeature-1 do 343 if 1 shl Domain and Feature[i].Domains<>0 then 344 begin 345 FeatureCode:=FeatureCode*2; 346 if 1 shl (i-mcFirstNonCap)<>0 then 347 inc(FeatureCode); 348 end; 349 case Domain of 350 dGround: 351 begin 352 assert(FeatureCode<1 shl 8); 353 assert(Attack<5113); 354 assert(Defense<2273); 355 assert(Cost<1611); 356 Hash1:=(Attack*2273+Defense)*9+(Speed-150) div 50; 357 Hash2:=FeatureCode*1611+Cost; 358 end; 359 dSea: 360 begin 361 assert(FeatureCode<1 shl 9); 362 assert(Attack<12193); 363 assert(Defense<6097); 364 assert(Cost<4381); 365 Hash1:=((Attack*6097+Defense)*5+(Speed-350) div 100)*2; 366 if Weight>=6 then inc(Hash1); 367 Hash2:=((TTrans*17+ATrans_Fuel) shl 9+FeatureCode)*4381+Cost; 368 end; 369 dAir: 370 begin 371 assert(FeatureCode<1 shl 5); 372 assert(Attack<2407); 373 assert(Defense<1605); 374 assert(Bombs<4813); 375 assert(Cost<2089); 376 Hash1:=(Attack*1605+Defense) shl 5+FeatureCode; 377 Hash2:=((Bombs*7+ATrans_Fuel)*4+TTrans)*2089+Cost; 378 end; 379 end; 380 Hash2r:=0; 381 for i:=0 to 7 do 382 begin 383 Hash2r:=Hash2r*13; 384 d:=Hash2 div 13; 385 inc(Hash2r,Hash2-d*13); 386 Hash2:=d 387 end; 388 result:=integer(Domain shl 30+Hash1 xor Hash2r) 191 else 192 begin 193 result := 0; 194 for i := 1 to 3 do 195 if MyRO.EnemyReport[p].Tech[AgePreq[i]] >= tsApplicable then 196 result := i; 389 197 end 390 end; 391 392 function ProcessEnhancement(uix: integer; const Jobs: TEnhancementJobs): integer; 393 { return values: 394 eJobDone - all applicable jobs done 395 eOK - enhancement not complete 396 eDied - job done and died (thurst) } 397 var 398 stage, NextJob, Tile: integer; 399 Done: Set of jNone..jTrans; 400 begin 401 Done:=[]; 402 Tile:=MyMap[MyUn[uix].Loc]; 403 if Tile and fRoad<>0 then include(Done,jRoad); 404 if Tile and fRR<>0 then include(Done,jRR); 405 if (Tile and fTerImp=tiIrrigation) or (Tile and fTerImp=tiFarm) then 406 include(Done,jIrr); 407 if Tile and fTerImp=tiFarm then include(Done,jFarm); 408 if Tile and fTerImp=tiMine then include(Done,jMine); 409 if Tile and fPoll=0 then include(Done,jPoll); 410 411 if MyUn[uix].Job=jNone then result:=eJobDone 412 else result:=eOK; 413 while (result<>eOK) and (result<>eDied) do 414 begin 415 stage:=-1; 416 repeat 417 if stage=-1 then NextJob:=jPoll 418 else NextJob:=Jobs[Tile and fTerrain,stage]; 419 if (NextJob=jNone) or not (NextJob in Done) then Break; 420 inc(stage); 421 until stage=5; 422 if (stage=5) or (NextJob=jNone) then 423 begin result:=eJobDone; Break; end; // tile enhancement complete 424 result:=Server(sStartJob+NextJob shl 4,me,uix,nil^); 425 include(Done,NextJob) 426 end; 427 end; 428 429 function AutoBuild(cix: integer; const ImpOrder: TImpOrder): boolean; 430 var 431 i,NewProject: integer; 432 begin 433 result:=false; 434 if (MyCity[cix].Project and (cpImp+cpIndex)=cpImp+imTrGoods) 435 or (MyCity[cix].Flags and chProduction<>0) then 436 begin 437 i:=0; 438 repeat 439 while (ImpOrder[i]>=0) and (MyCity[cix].Built[ImpOrder[i]]>0) do inc(i); 440 if ImpOrder[i]<0 then Break; 441 assert(i<nImp); 442 NewProject:=cpImp+ImpOrder[i]; 443 if Server(sSetCityProject,me,cix,NewProject)>=rExecuted then 444 begin 445 result:=true; 446 CityOptimizer_CityChange(cix); 447 Break; 448 end; 449 inc(i); 450 until false 451 end 452 end; 453 454 procedure CalculateAdvValues; 455 var 456 i,j: integer; 457 known: array[0..nAdv-1] of integer; 458 459 procedure MarkPreqs(i: integer); 460 begin 461 if known[i]=0 then 462 begin 463 known[i]:=1; 464 if (i<>adScience) and (i<>adMassProduction) then 465 begin 466 if (AdvPreq[i,0]>=0) then MarkPreqs(AdvPreq[i,0]); 467 if (AdvPreq[i,1]>=0) then MarkPreqs(AdvPreq[i,1]); 198 end; 199 200 function IsCivilReportNew(Enemy: integer): boolean; 201 var 202 i: integer; 203 begin 204 assert(Enemy <> me); 205 i := MyRO.EnemyReport[Enemy].TurnOfCivilReport; 206 result := (i = MyRO.Turn) or (i = MyRO.Turn - 1) and (Enemy > me); 207 end; 208 209 function IsMilReportNew(Enemy: integer): boolean; 210 var 211 i: integer; 212 begin 213 assert(Enemy <> me); 214 i := MyRO.EnemyReport[Enemy].TurnOfMilReport; 215 result := (i = MyRO.Turn) or (i = MyRO.Turn - 1) and (Enemy > me); 216 end; 217 218 function CutCityFoodSurplus(FoodSurplus: integer; IsCityAlive: boolean; 219 gov, size: integer): integer; 220 begin 221 result := FoodSurplus; 222 if not IsCityAlive or (result > 0) and 223 ((gov = gFuture) or (size >= NeedAqueductSize) and (result < 2)) then 224 result := 0; { no growth } 225 end; 226 227 function CityTaxBalance(cix: integer; 228 const CityReport: TCityReportNew): integer; 229 var 230 i: integer; 231 begin 232 result := 0; 233 if (CityReport.HappinessBalance >= 0) { no disorder } 234 and (MyCity[cix].Flags and chCaptured = 0) then // not captured 235 begin 236 inc(result, CityReport.Tax); 237 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) and 238 (CityReport.Production > 0) then 239 inc(result, CityReport.Production); 240 if ((MyRO.Government = gFuture) or (MyCity[cix].size >= NeedAqueductSize) 241 and (CityReport.FoodSurplus < 2)) and (CityReport.FoodSurplus > 0) then 242 inc(result, CityReport.FoodSurplus); 243 end; 244 for i := 28 to nImp - 1 do 245 if MyCity[cix].Built[i] > 0 then 246 dec(result, Imp[i].Maint); 247 end; 248 249 procedure SumCities(var TaxSum, ScienceSum: integer); 250 var 251 cix: integer; 252 CityReport: TCityReportNew; 253 begin 254 TaxSum := MyRO.OracleIncome; 255 ScienceSum := 0; 256 if MyRO.Government = gAnarchy then 257 exit; 258 for cix := 0 to MyRO.nCity - 1 do 259 if MyCity[cix].Loc >= 0 then 260 begin 261 CityReport.HypoTiles := -1; 262 CityReport.HypoTaxRate := -1; 263 CityReport.HypoLuxuryRate := -1; 264 Server(sGetCityReportNew, me, cix, CityReport); 265 if (CityReport.HappinessBalance >= 0) { no disorder } 266 and (MyCity[cix].Flags and chCaptured = 0) then // not captured 267 ScienceSum := ScienceSum + CityReport.Science; 268 TaxSum := TaxSum + CityTaxBalance(cix, CityReport); 269 end; 270 end; 271 272 function JobTest(uix, Job: integer; IgnoreResults: JobResultSet): boolean; 273 var 274 Test: integer; 275 begin 276 Test := Server(sStartJob + Job shl 4 - sExecute, me, uix, nil^); 277 result := (Test >= rExecuted) or (Test in IgnoreResults); 278 end; 279 280 procedure GetUnitInfo(Loc: integer; var uix: integer; 281 var UnitInfo: TUnitInfo); 282 var 283 i, Cnt: integer; 284 begin 285 if MyMap[Loc] and fOwned <> 0 then 286 begin 287 Server(sGetDefender, me, Loc, uix); 288 Cnt := 0; 289 for i := 0 to MyRO.nUn - 1 do 290 if MyUn[i].Loc = Loc then 291 inc(Cnt); 292 MakeUnitInfo(me, MyUn[uix], UnitInfo); 293 if Cnt > 1 then 294 UnitInfo.Flags := UnitInfo.Flags or unMulti; 295 end 296 else 297 begin 298 uix := MyRO.nEnemyUn - 1; 299 while (uix >= 0) and (MyRO.EnemyUn[uix].Loc <> Loc) do 300 dec(uix); 301 UnitInfo := MyRO.EnemyUn[uix]; 302 end 303 end; { GetUnitInfo } 304 305 procedure GetCityInfo(Loc: integer; var cix: integer; 306 var CityInfo: TCityInfo); 307 begin 308 if MyMap[Loc] and fOwned <> 0 then 309 begin 310 CityInfo.Loc := Loc; 311 cix := MyRO.nCity - 1; 312 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 313 dec(cix); 314 with CityInfo do 315 begin 316 Owner := me; 317 ID := MyCity[cix].ID; 318 size := MyCity[cix].size; 319 Flags := 0; 320 if MyCity[cix].Built[imPalace] > 0 then 321 inc(Flags, ciCapital); 322 if (MyCity[cix].Built[imWalls] > 0) or 323 (MyMap[MyCity[cix].Loc] and fGrWall <> 0) then 324 inc(Flags, ciWalled); 325 if MyCity[cix].Built[imCoastalFort] > 0 then 326 inc(Flags, ciCoastalFort); 327 if MyCity[cix].Built[imMissileBat] > 0 then 328 inc(Flags, ciMissileBat); 329 if MyCity[cix].Built[imBunker] > 0 then 330 inc(Flags, ciBunker); 331 if MyCity[cix].Built[imSpacePort] > 0 then 332 inc(Flags, ciSpacePort); 468 333 end 469 334 end 470 end; 471 472 begin 473 FillChar(AdvValue,SizeOf(AdvValue),0); 474 for i:=0 to nAdv-1 do 475 begin 476 FillChar(known,SizeOf(known),0); 477 MarkPreqs(i); 478 for j:=0 to nAdv-1 do if known[j]>0 then inc(AdvValue[i]); 479 if i in FutureTech then inc(AdvValue[i],3000) 480 else if known[adMassProduction]>0 then inc(AdvValue[i],2000) 481 else if known[adScience]>0 then inc(AdvValue[i],1000) 482 end; 483 end; 484 485 procedure DebugMessage(Level: integer; Text: string); 486 begin 487 Server(sMessage,me,Level,pchar(Text)^) 488 end; 489 490 function MarkCitiesAround(Loc,cixExcept: integer): boolean; 491 // return whether a city was marked 492 var 493 cix: integer; 494 begin 495 result:=false; 496 for cix:=0 to MyRO.nCity-1 do 497 if (cix<>cixExcept) and (MyCity[cix].Loc>=0) 498 and (MyCity[cix].Flags and chCaptured=0) 499 and (Distance(MyCity[cix].Loc,Loc)<=5) then 500 begin 501 CityNeedsOptimize[cix]:=true; 502 result:=true; 335 else 336 begin 337 cix := MyRO.nEnemyCity - 1; 338 while (cix >= 0) and (MyRO.EnemyCity[cix].Loc <> Loc) do 339 dec(cix); 340 CityInfo := MyRO.EnemyCity[cix]; 503 341 end 504 end; 505 506 procedure OptimizeCities(CheckOnly: boolean); 507 var 508 cix,fix,dx,dy,Loc1,OptiType: integer; 509 done: boolean; 510 Advice: TCityTileAdviceData; 511 begin 512 repeat 513 done:=true; 514 for cix:=0 to MyRO.nCity-1 do if CityNeedsOptimize[cix] then 515 begin 516 OptiType:=MyCity[cix].Status shr 4 and $0F; 517 if OptiType<>0 then 518 begin 519 Advice.ResourceWeights:=OfferedResourceWeights[OptiType]; 520 Server(sGetCityTileAdvice,me,cix,Advice); 521 if Advice.Tiles<>MyCity[cix].Tiles then 522 if CheckOnly then 523 assert(false) 342 end; 343 344 function UnitExhausted(uix: integer): boolean; 345 // check if another move of this unit is still possible 346 var 347 dx, dy: integer; 348 begin 349 result := true; 350 if (MyUn[uix].Movement > 0) or 351 (MyRO.Wonder[woShinkansen].EffectiveOwner = me) then 352 if (MyUn[uix].Movement >= 100) or 353 ((MyModel[MyUn[uix].mix].Kind = mkCaravan) and 354 (MyMap[MyUn[uix].Loc] and fCity <> 0)) then 355 result := false 356 else 357 for dx := -2 to 2 do 358 for dy := -2 to 2 do 359 if abs(dx) + abs(dy) = 2 then 360 if Server(sMoveUnit - sExecute + dx and 7 shl 4 + dy and 7 shl 7, 361 me, uix, nil^) >= rExecuted then 362 result := false; 363 end; 364 365 function ModelHash(const ModelInfo: TModelInfo): integer; 366 var 367 i, FeatureCode, Hash1, Hash2, Hash2r, d: cardinal; 368 begin 369 with ModelInfo do 370 if Kind > mkEnemyDeveloped then 371 result := integer($C0000000 + Speed div 50 + Kind shl 8) 372 else 373 begin 374 FeatureCode := 0; 375 for i := mcFirstNonCap to nFeature - 1 do 376 if 1 shl Domain and Feature[i].Domains <> 0 then 377 begin 378 FeatureCode := FeatureCode * 2; 379 if 1 shl (i - mcFirstNonCap) <> 0 then 380 inc(FeatureCode); 381 end; 382 case Domain of 383 dGround: 384 begin 385 assert(FeatureCode < 1 shl 8); 386 assert(Attack < 5113); 387 assert(Defense < 2273); 388 assert(Cost < 1611); 389 Hash1 := (Attack * 2273 + Defense) * 9 + (Speed - 150) div 50; 390 Hash2 := FeatureCode * 1611 + Cost; 391 end; 392 dSea: 393 begin 394 assert(FeatureCode < 1 shl 9); 395 assert(Attack < 12193); 396 assert(Defense < 6097); 397 assert(Cost < 4381); 398 Hash1 := ((Attack * 6097 + Defense) * 5 + (Speed - 350) 399 div 100) * 2; 400 if Weight >= 6 then 401 inc(Hash1); 402 Hash2 := ((TTrans * 17 + ATrans_Fuel) shl 9 + FeatureCode) * 403 4381 + Cost; 404 end; 405 dAir: 406 begin 407 assert(FeatureCode < 1 shl 5); 408 assert(Attack < 2407); 409 assert(Defense < 1605); 410 assert(Bombs < 4813); 411 assert(Cost < 2089); 412 Hash1 := (Attack * 1605 + Defense) shl 5 + FeatureCode; 413 Hash2 := ((Bombs * 7 + ATrans_Fuel) * 4 + TTrans) * 2089 + Cost; 414 end; 415 end; 416 Hash2r := 0; 417 for i := 0 to 7 do 418 begin 419 Hash2r := Hash2r * 13; 420 d := Hash2 div 13; 421 inc(Hash2r, Hash2 - d * 13); 422 Hash2 := d 423 end; 424 result := integer(Domain shl 30 + Hash1 xor Hash2r) 425 end 426 end; 427 428 function ProcessEnhancement(uix: integer; 429 const Jobs: TEnhancementJobs): integer; 430 { return values: 431 eJobDone - all applicable jobs done 432 eOK - enhancement not complete 433 eDied - job done and died (thurst) } 434 var 435 stage, NextJob, Tile: integer; 436 Done: Set of jNone .. jTrans; 437 begin 438 Done := []; 439 Tile := MyMap[MyUn[uix].Loc]; 440 if Tile and fRoad <> 0 then 441 include(Done, jRoad); 442 if Tile and fRR <> 0 then 443 include(Done, jRR); 444 if (Tile and fTerImp = tiIrrigation) or (Tile and fTerImp = tiFarm) then 445 include(Done, jIrr); 446 if Tile and fTerImp = tiFarm then 447 include(Done, jFarm); 448 if Tile and fTerImp = tiMine then 449 include(Done, jMine); 450 if Tile and fPoll = 0 then 451 include(Done, jPoll); 452 453 if MyUn[uix].Job = jNone then 454 result := eJobDone 455 else 456 result := eOK; 457 while (result <> eOK) and (result <> eDied) do 458 begin 459 stage := -1; 460 repeat 461 if stage = -1 then 462 NextJob := jPoll 524 463 else 464 NextJob := Jobs[Tile and fTerrain, stage]; 465 if (NextJob = jNone) or not(NextJob in Done) then 466 Break; 467 inc(stage); 468 until stage = 5; 469 if (stage = 5) or (NextJob = jNone) then 470 begin 471 result := eJobDone; 472 Break; 473 end; // tile enhancement complete 474 result := Server(sStartJob + NextJob shl 4, me, uix, nil^); 475 include(Done, NextJob) 476 end; 477 end; 478 479 function AutoBuild(cix: integer; const ImpOrder: TImpOrder): boolean; 480 var 481 i, NewProject: integer; 482 begin 483 result := false; 484 if (MyCity[cix].Project and (cpImp + cpIndex) = cpImp + imTrGoods) or 485 (MyCity[cix].Flags and chProduction <> 0) then 486 begin 487 i := 0; 488 repeat 489 while (ImpOrder[i] >= 0) and (MyCity[cix].Built[ImpOrder[i]] > 0) do 490 inc(i); 491 if ImpOrder[i] < 0 then 492 Break; 493 assert(i < nImp); 494 NewProject := cpImp + ImpOrder[i]; 495 if Server(sSetCityProject, me, cix, NewProject) >= rExecuted then 496 begin 497 result := true; 498 CityOptimizer_CityChange(cix); 499 Break; 500 end; 501 inc(i); 502 until false end end; 503 504 procedure CalculateAdvValues; 505 var 506 i, j: integer; 507 known: array [0 .. nAdv - 1] of integer; 508 509 procedure MarkPreqs(i: integer); 510 begin 511 if known[i] = 0 then 525 512 begin 526 for fix:=1 to 26 do 527 if MyCity[cix].Tiles and not Advice.Tiles and (1 shl fix)<>0 then 528 begin // tile no longer used by this city -- check using it by another 529 dy:=fix shr 2-3; dx:=fix and 3 shl 1 -3 + (dy+3) and 1; 530 Loc1:=dLoc(MyCity[cix].Loc,dx,dy); 531 if MarkCitiesAround(Loc1,cix) then 532 done:=false; 513 known[i] := 1; 514 if (i <> adScience) and (i <> adMassProduction) then 515 begin 516 if (AdvPreq[i, 0] >= 0) then 517 MarkPreqs(AdvPreq[i, 0]); 518 if (AdvPreq[i, 1] >= 0) then 519 MarkPreqs(AdvPreq[i, 1]); 520 end 521 end 522 end; 523 524 begin 525 FillChar(AdvValue, SizeOf(AdvValue), 0); 526 for i := 0 to nAdv - 1 do 527 begin 528 FillChar(known, SizeOf(known), 0); 529 MarkPreqs(i); 530 for j := 0 to nAdv - 1 do 531 if known[j] > 0 then 532 inc(AdvValue[i]); 533 if i in FutureTech then 534 inc(AdvValue[i], 3000) 535 else if known[adMassProduction] > 0 then 536 inc(AdvValue[i], 2000) 537 else if known[adScience] > 0 then 538 inc(AdvValue[i], 1000) 539 end; 540 end; 541 542 procedure DebugMessage(Level: integer; Text: string); 543 begin 544 Server(sMessage, me, Level, pchar(Text)^) 545 end; 546 547 function MarkCitiesAround(Loc, cixExcept: integer): boolean; 548 // return whether a city was marked 549 var 550 cix: integer; 551 begin 552 result := false; 553 for cix := 0 to MyRO.nCity - 1 do 554 if (cix <> cixExcept) and (MyCity[cix].Loc >= 0) and 555 (MyCity[cix].Flags and chCaptured = 0) and 556 (Distance(MyCity[cix].Loc, Loc) <= 5) then 557 begin 558 CityNeedsOptimize[cix] := true; 559 result := true; 560 end 561 end; 562 563 procedure OptimizeCities(CheckOnly: boolean); 564 var 565 cix, fix, dx, dy, Loc1, OptiType: integer; 566 Done: boolean; 567 Advice: TCityTileAdviceData; 568 begin 569 repeat 570 Done := true; 571 for cix := 0 to MyRO.nCity - 1 do 572 if CityNeedsOptimize[cix] then 573 begin 574 OptiType := MyCity[cix].Status shr 4 and $0F; 575 if OptiType <> 0 then 576 begin 577 Advice.ResourceWeights := OfferedResourceWeights[OptiType]; 578 Server(sGetCityTileAdvice, me, cix, Advice); 579 if Advice.Tiles <> MyCity[cix].Tiles then 580 if CheckOnly then 581 assert(false) 582 else 583 begin 584 for fix := 1 to 26 do 585 if MyCity[cix].Tiles and not Advice.Tiles and 586 (1 shl fix) <> 0 then 587 begin // tile no longer used by this city -- check using it by another 588 dy := fix shr 2 - 3; 589 dx := fix and 3 shl 1 - 3 + (dy + 3) and 1; 590 Loc1 := dLoc(MyCity[cix].Loc, dx, dy); 591 if MarkCitiesAround(Loc1, cix) then 592 Done := false; 593 end; 594 Server(sSetCityTiles, me, cix, Advice.Tiles); 595 end; 533 596 end; 534 Server(sSetCityTiles,me,cix,Advice.Tiles); 535 end; 536 end; 537 CityNeedsOptimize[cix]:=false; 538 end; 539 until done; 540 end; 541 542 procedure CityOptimizer_BeginOfTurn; 543 var 544 cix: integer; 545 begin 546 fillchar(CityNeedsOptimize,MyRO.nCity-1,0); //false 547 if MyRO.Government<>gAnarchy then 548 begin 549 for cix:=0 to MyRO.nCity-1 do 550 if (MyCity[cix].Loc>=0) and (MyCity[cix].Flags and chCaptured=0) then 551 CityNeedsOptimize[cix]:=true; 552 OptimizeCities(false); // optimize all cities 553 end 554 end; 555 556 procedure CityOptimizer_CityChange(cix: integer); 557 begin 558 if (MyRO.Government<>gAnarchy) and (MyCity[cix].Flags and chCaptured=0) then 559 begin 560 CityNeedsOptimize[cix]:=true; 561 OptimizeCities(false); 562 end 563 end; 564 565 procedure CityOptimizer_TileBecomesAvailable(Loc: integer); 566 begin 567 if (MyRO.Government<>gAnarchy) and MarkCitiesAround(Loc,-1) then 568 OptimizeCities(false); 569 end; 570 571 procedure CityOptimizer_ReleaseCityTiles(cix, ReleasedTiles: integer); 572 var 573 fix,dx,dy,Loc1: integer; 574 done: boolean; 575 begin 576 if (MyRO.Government<>gAnarchy) and (ReleasedTiles<>0) then 577 begin 578 done:=true; 579 for fix:=1 to 26 do if ReleasedTiles and (1 shl fix)<>0 then 580 begin 581 dy:=fix shr 2-3; dx:=fix and 3 shl 1 -3 + (dy+3) and 1; 582 Loc1:=dLoc(MyCity[cix].Loc,dx,dy); 583 if MarkCitiesAround(Loc1,cix) then 584 done:=false; 585 end; 586 if not done then 587 OptimizeCities(false); 588 end 589 end; 590 591 procedure CityOptimizer_BeforeRemoveUnit(uix: integer); 592 var 593 uix1: integer; 594 begin 595 if MyRO.Government<>gAnarchy then 596 begin 597 if MyUn[uix].Home>=0 then 598 CityNeedsOptimize[MyUn[uix].Home]:=true; 599 600 // transported units are also removed 601 for uix1:=0 to MyRO.nUn-1 do 602 if (MyUn[uix1].Loc>=0) and (MyUn[uix1].Master=uix) 603 and (MyUn[uix1].Home>=0) then 604 CityNeedsOptimize[MyUn[uix1].Home]:=true; 605 end 606 end; 607 608 procedure CityOptimizer_AfterRemoveUnit; 609 begin 610 if MyRO.Government<>gAnarchy then 611 OptimizeCities(false); 612 end; 613 614 procedure CityOptimizer_EndOfTurn; 615 // all cities should already be optimized here -- only check this 616 var 617 cix: integer; 618 begin 597 CityNeedsOptimize[cix] := false; 598 end; 599 until Done; 600 end; 601 602 procedure CityOptimizer_BeginOfTurn; 603 var 604 cix: integer; 605 begin 606 FillChar(CityNeedsOptimize, MyRO.nCity - 1, 0); // false 607 if MyRO.Government <> gAnarchy then 608 begin 609 for cix := 0 to MyRO.nCity - 1 do 610 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Flags and chCaptured = 0) 611 then 612 CityNeedsOptimize[cix] := true; 613 OptimizeCities(false); // optimize all cities 614 end 615 end; 616 617 procedure CityOptimizer_CityChange(cix: integer); 618 begin 619 if (MyRO.Government <> gAnarchy) and 620 (MyCity[cix].Flags and chCaptured = 0) then 621 begin 622 CityNeedsOptimize[cix] := true; 623 OptimizeCities(false); 624 end 625 end; 626 627 procedure CityOptimizer_TileBecomesAvailable(Loc: integer); 628 begin 629 if (MyRO.Government <> gAnarchy) and MarkCitiesAround(Loc, -1) then 630 OptimizeCities(false); 631 end; 632 633 procedure CityOptimizer_ReleaseCityTiles(cix, ReleasedTiles: integer); 634 var 635 fix, dx, dy, Loc1: integer; 636 Done: boolean; 637 begin 638 if (MyRO.Government <> gAnarchy) and (ReleasedTiles <> 0) then 639 begin 640 Done := true; 641 for fix := 1 to 26 do 642 if ReleasedTiles and (1 shl fix) <> 0 then 643 begin 644 dy := fix shr 2 - 3; 645 dx := fix and 3 shl 1 - 3 + (dy + 3) and 1; 646 Loc1 := dLoc(MyCity[cix].Loc, dx, dy); 647 if MarkCitiesAround(Loc1, cix) then 648 Done := false; 649 end; 650 if not Done then 651 OptimizeCities(false); 652 end 653 end; 654 655 procedure CityOptimizer_BeforeRemoveUnit(uix: integer); 656 var 657 uix1: integer; 658 begin 659 if MyRO.Government <> gAnarchy then 660 begin 661 if MyUn[uix].Home >= 0 then 662 CityNeedsOptimize[MyUn[uix].Home] := true; 663 664 // transported units are also removed 665 for uix1 := 0 to MyRO.nUn - 1 do 666 if (MyUn[uix1].Loc >= 0) and (MyUn[uix1].Master = uix) and 667 (MyUn[uix1].Home >= 0) then 668 CityNeedsOptimize[MyUn[uix1].Home] := true; 669 end 670 end; 671 672 procedure CityOptimizer_AfterRemoveUnit; 673 begin 674 if MyRO.Government <> gAnarchy then 675 OptimizeCities(false); 676 end; 677 678 procedure CityOptimizer_EndOfTurn; 679 // all cities should already be optimized here -- only check this 680 var 681 cix: integer; 682 begin 619 683 {$IFOPT O-} 620 if MyRO.Government<>gAnarchy then 621 begin 622 fillchar(CityNeedsOptimize,MyRO.nCity-1,0); //false 623 for cix:=0 to MyRO.nCity-1 do 624 if (MyCity[cix].Loc>=0) and (MyCity[cix].Flags and chCaptured=0) then 625 CityNeedsOptimize[cix]:=true; 626 OptimizeCities(true); // check all cities 627 end; 684 if MyRO.Government <> gAnarchy then 685 begin 686 FillChar(CityNeedsOptimize, MyRO.nCity - 1, 0); // false 687 for cix := 0 to MyRO.nCity - 1 do 688 if (MyCity[cix].Loc >= 0) and (MyCity[cix].Flags and chCaptured = 0) 689 then 690 CityNeedsOptimize[cix] := true; 691 OptimizeCities(true); // check all cities 692 end; 628 693 {$ENDIF} 629 end; 630 694 end; 631 695 632 696 initialization 633 assert(nImp<128); 697 698 assert(nImp < 128); 634 699 CalculateAdvValues; 635 700 636 701 end. 637 -
trunk/LocalPlayer/Diagram.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Diagram; 4 3 … … 22 21 procedure ToggleBtnClick(Sender: TObject); 23 22 procedure PlayerClick(Sender: TObject); 24 procedure FormKeyDown(Sender: TObject; var Key: word; 25 Shift: TShiftState); 23 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 26 24 27 25 public … … 31 29 32 30 private 33 Kind: (dkChart,dkShip);34 Player, Mode: integer;31 Kind: (dkChart, dkShip); 32 Player, Mode: integer; 35 33 end; 36 34 … … 38 36 DiaDlg: TDiaDlg; 39 37 40 procedure PaintColonyShip(canvas: TCanvas; Player,Left,Width,Top: integer); 41 38 procedure PaintColonyShip(canvas: TCanvas; Player, Left, Width, Top: integer); 42 39 43 40 implementation 44 41 45 42 uses 46 Protocol, ScreenTools, ClientTools,Term,Tribes;43 Protocol, ScreenTools, ClientTools, Term, Tribes; 47 44 48 45 {$R *.DFM} 49 46 50 47 const 51 Border=24; 52 RoundPixels: array[0..nStat-1] of integer=(0,0,0,5,5,5); 53 54 yArea=48; 55 xComp: array[0..5] of integer=(-60,-28,4,4,36,68); 56 yComp: array[0..5] of integer=(-40,-40,-79,-1,-40,-40); 57 xPow: array[0..3] of integer=(-116,-116,-116,-116); 58 yPow: array[0..3] of integer=(-28,0,-44,16); 59 xHab: array[0..1] of integer=(23,23); 60 yHab: array[0..1] of integer=(-81,1); 61 62 procedure PaintColonyShip(canvas: TCanvas; Player,Left,Width,Top: integer); 63 var 64 i,x,r,nComp,nPow,nHab: integer; 65 begin 66 with canvas do 67 begin 68 Brush.Color:=$000000; 69 FillRect(Rect(Left,Top,Left+Width,Top+200)); 70 Brush.Style:=bsClear; 71 Frame(Canvas,Left-1,Top-1,Left+Width,Top+200,MainTexture.clBevelShade,MainTexture.clBevelLight); 72 RFrame(Canvas,Left-2,Top-2,Left+Width+1,Top+200+1,MainTexture.clBevelShade,MainTexture.clBevelLight); 73 74 // stars 75 RandSeed:=Player*11111; 76 for i:=1 to Width-16 do 48 Border = 24; 49 RoundPixels: array [0 .. nStat - 1] of integer = (0, 0, 0, 5, 5, 5); 50 51 yArea = 48; 52 xComp: array [0 .. 5] of integer = (-60, -28, 4, 4, 36, 68); 53 yComp: array [0 .. 5] of integer = (-40, -40, -79, -1, -40, -40); 54 xPow: array [0 .. 3] of integer = (-116, -116, -116, -116); 55 yPow: array [0 .. 3] of integer = (-28, 0, -44, 16); 56 xHab: array [0 .. 1] of integer = (23, 23); 57 yHab: array [0 .. 1] of integer = (-81, 1); 58 59 procedure PaintColonyShip(canvas: TCanvas; Player, Left, Width, Top: integer); 60 var 61 i, x, r, nComp, nPow, nHab: integer; 62 begin 63 with canvas do 64 begin 65 Brush.Color := $000000; 66 FillRect(Rect(Left, Top, Left + Width, Top + 200)); 67 Brush.Style := bsClear; 68 Frame(canvas, Left - 1, Top - 1, Left + Width, Top + 200, 69 MainTexture.clBevelShade, MainTexture.clBevelLight); 70 RFrame(canvas, Left - 2, Top - 2, Left + Width + 1, Top + 200 + 1, 71 MainTexture.clBevelShade, MainTexture.clBevelLight); 72 73 // stars 74 RandSeed := Player * 11111; 75 for i := 1 to Width - 16 do 77 76 begin 78 x:=Random((Width-16)*200); 79 r:=Random(13)+28; 80 Pixels[x div 200+8,x mod 200+Top]:=(r*r*r*r div 10001)*$10101; 77 x := Random((Width - 16) * 200); 78 r := Random(13) + 28; 79 Pixels[x div 200 + 8, x mod 200 + Top] := 80 (r * r * r * r div 10001) * $10101; 81 81 end; 82 82 83 nComp:=MyRO.Ship[Player].Parts[spComp]; 84 nPow:=MyRO.Ship[Player].Parts[spPow]; 85 nHab:=MyRO.Ship[Player].Parts[spHab]; 86 if nComp>6 then nComp:=6; 87 if nPow>4 then nPow:=4; 88 if nHab>2 then nHab:=2; 89 for i:=0 to nHab-1 do 90 Sprite(canvas,HGrSystem2,Left+Width div 2+xHab[i],Top+100+yHab[i], 91 80,80,34,1); 92 for i:=0 to nComp-1 do 93 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[i],Top+100+yComp[i], 94 32,80,1,1); 95 if nComp>0 then 96 for i:=3 downto nPow do 97 Sprite(canvas,HGrSystem2,Left+Width div 2+xPow[i]+40,Top+100+yPow[i], 98 16,27,1,82); 99 for i:=nPow-1 downto 0 do 100 Sprite(canvas,HGrSystem2,Left+Width div 2+xPow[i],Top+100+yPow[i], 101 56,28,58,82); 102 if (nComp<3) and (nHab>=1) then 103 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[2]+32-16,Top+100+7+yComp[2], 104 16,27,1,82); 105 if (nComp>=3) and (nHab<1) then 106 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[2]+32,Top+100+7+yComp[2], 107 16,27,18,82); 108 if (nComp<4) and (nHab>=2) then 109 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[3]+32-16,Top+100+46+yComp[3], 110 16,27,1,82); 111 if (nComp>=4) and (nHab<2) then 112 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[3]+32,Top+100+46+yComp[3], 113 16,27,18,82); 114 if (nComp<>6) and (nComp<>2) and not ((nComp=0) and (nPow<1)) then 115 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[nComp],Top+100+7+yComp[nComp], 116 16,27,18,82); 117 if (nComp<>6) and (nComp<>3) and not ((nComp=0) and (nPow<2)) then 118 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[nComp],Top+100+46+yComp[nComp], 119 16,27,18,82); 120 if nComp=2 then 121 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[3],Top+100+7+yComp[3], 122 16,27,18,82); 123 if nComp=3 then 124 Sprite(canvas,HGrSystem2,Left+Width div 2+xComp[4],Top+100+7+yComp[4], 125 16,27,18,82); 83 nComp := MyRO.Ship[Player].Parts[spComp]; 84 nPow := MyRO.Ship[Player].Parts[spPow]; 85 nHab := MyRO.Ship[Player].Parts[spHab]; 86 if nComp > 6 then 87 nComp := 6; 88 if nPow > 4 then 89 nPow := 4; 90 if nHab > 2 then 91 nHab := 2; 92 for i := 0 to nHab - 1 do 93 Sprite(canvas, HGrSystem2, Left + Width div 2 + xHab[i], 94 Top + 100 + yHab[i], 80, 80, 34, 1); 95 for i := 0 to nComp - 1 do 96 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[i], 97 Top + 100 + yComp[i], 32, 80, 1, 1); 98 if nComp > 0 then 99 for i := 3 downto nPow do 100 Sprite(canvas, HGrSystem2, Left + Width div 2 + xPow[i] + 40, 101 Top + 100 + yPow[i], 16, 27, 1, 82); 102 for i := nPow - 1 downto 0 do 103 Sprite(canvas, HGrSystem2, Left + Width div 2 + xPow[i], 104 Top + 100 + yPow[i], 56, 28, 58, 82); 105 if (nComp < 3) and (nHab >= 1) then 106 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32 - 16, 107 Top + 100 + 7 + yComp[2], 16, 27, 1, 82); 108 if (nComp >= 3) and (nHab < 1) then 109 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[2] + 32, 110 Top + 100 + 7 + yComp[2], 16, 27, 18, 82); 111 if (nComp < 4) and (nHab >= 2) then 112 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32 - 16, 113 Top + 100 + 46 + yComp[3], 16, 27, 1, 82); 114 if (nComp >= 4) and (nHab < 2) then 115 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3] + 32, 116 Top + 100 + 46 + yComp[3], 16, 27, 18, 82); 117 if (nComp <> 6) and (nComp <> 2) and not((nComp = 0) and (nPow < 1)) then 118 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[nComp], 119 Top + 100 + 7 + yComp[nComp], 16, 27, 18, 82); 120 if (nComp <> 6) and (nComp <> 3) and not((nComp = 0) and (nPow < 2)) then 121 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[nComp], 122 Top + 100 + 46 + yComp[nComp], 16, 27, 18, 82); 123 if nComp = 2 then 124 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[3], 125 Top + 100 + 7 + yComp[3], 16, 27, 18, 82); 126 if nComp = 3 then 127 Sprite(canvas, HGrSystem2, Left + Width div 2 + xComp[4], 128 Top + 100 + 7 + yComp[4], 16, 27, 18, 82); 126 129 end 127 130 end; … … 129 132 procedure TDiaDlg.FormCreate(Sender: TObject); 130 133 begin 131 inherited;132 TitleHeight:=WideFrame+20;133 InnerHeight:=ClientHeight-TitleHeight-NarrowFrame;134 CaptionRight:=CloseBtn.Left;135 CaptionLeft:=ToggleBtn.Left+ToggleBtn.Width;136 InitButtons();134 inherited; 135 TitleHeight := WideFrame + 20; 136 InnerHeight := ClientHeight - TitleHeight - NarrowFrame; 137 CaptionRight := CloseBtn.Left; 138 CaptionLeft := ToggleBtn.Left + ToggleBtn.Width; 139 InitButtons(); 137 140 end; 138 141 139 142 procedure TDiaDlg.CloseBtnClick(Sender: TObject); 140 143 begin 141 Close;144 Close; 142 145 end; 143 146 144 147 procedure TDiaDlg.OffscreenPaint; 145 148 type 146 TLine=array[0..99999,0..2] of Byte;147 var 148 p,T,max,x,y,y0,Stop,r,RoundRange,LineStep: integer;149 s: string;150 List: ^TChart;149 TLine = array [0 .. 99999, 0 .. 2] of Byte; 150 var 151 p, T, max, x, y, y0, Stop, r, RoundRange, LineStep: integer; 152 s: string; 153 List: ^TChart; 151 154 152 155 function Round(T: integer): integer; 153 156 var 154 n,i: integer; 155 begin 156 if T<RoundRange then n:=T else n:=RoundRange; 157 result:=0; 158 for i:=T-n to T do inc(result,List[i]); 159 result:=result div (n+1); 157 n, i: integer; 158 begin 159 if T < RoundRange then 160 n := T 161 else 162 n := RoundRange; 163 result := 0; 164 for i := T - n to T do 165 inc(result, List[i]); 166 result := result div (n + 1); 160 167 end; 161 168 162 procedure ShareBar(x,y:integer; Cap:string; val0,val1: integer); 163 begin 164 LoweredTextOut(offscreen.Canvas,-1,MainTexture,x-2,y,Cap); 165 DLine(offscreen.Canvas,x-2,x+169,y+16,MainTexture.clTextShade, 166 MainTexture.clTextLight); 167 if val0>0 then s:=Format(Phrases.Lookup('SHARE'),[val0,val1]) 168 else s:='0'; 169 RisedTextOut(offscreen.Canvas,x+170-BiColorTextWidth(Offscreen.Canvas,s),y,s); 169 procedure ShareBar(x, y: integer; Cap: string; val0, val1: integer); 170 begin 171 LoweredTextOut(offscreen.canvas, -1, MainTexture, x - 2, y, Cap); 172 DLine(offscreen.canvas, x - 2, x + 169, y + 16, MainTexture.clTextShade, 173 MainTexture.clTextLight); 174 if val0 > 0 then 175 s := Format(Phrases.Lookup('SHARE'), [val0, val1]) 176 else 177 s := '0'; 178 RisedTextOut(offscreen.canvas, 179 x + 170 - BiColorTextWidth(offscreen.canvas, s), y, s); 170 180 end; 171 181 172 182 begin 173 inherited; 174 if Kind=dkChart then with offscreen.Canvas do 175 begin 176 Font.Assign(UniFont[ftTiny]); 177 Font.Color:=$808080; 178 179 RoundRange:=RoundPixels[Mode]*(MyRO.Turn-1) div (InnerWidth-2*Border); 180 181 GetMem(List,4*(MyRO.Turn+2)); 182 if Mode=stExplore then max:=G.lx*G.ly 183 else 183 inherited; 184 if Kind = dkChart then 185 with offscreen.canvas do 184 186 begin 185 max:=-1; 186 for p:=0 to nPl-1 do 187 if (G.Difficulty[p]>0) 188 and (Server(sGetChart+Mode shl 4,me,p,List^)>=rExecuted) then 189 for T:=0 to MyRO.Turn-1 do 190 begin r:=Round(T); if r>max then max:=r; end; 187 Font.Assign(UniFont[ftTiny]); 188 Font.Color := $808080; 189 190 RoundRange := RoundPixels[Mode] * (MyRO.Turn - 1) 191 div (InnerWidth - 2 * Border); 192 193 GetMem(List, 4 * (MyRO.Turn + 2)); 194 if Mode = stExplore then 195 max := G.lx * G.ly 196 else 197 begin 198 max := -1; 199 for p := 0 to nPl - 1 do 200 if (G.Difficulty[p] > 0) and 201 (Server(sGetChart + Mode shl 4, me, p, List^) >= rExecuted) then 202 for T := 0 to MyRO.Turn - 1 do 203 begin 204 r := Round(T); 205 if r > max then 206 max := r; 207 end; 208 end; 209 210 Brush.Color := $000000; 211 FillRect(Rect(0, 0, InnerWidth, InnerHeight)); 212 Brush.Style := bsClear; 213 Pen.Color := $606060; 214 MoveTo(Border, InnerHeight - Border); 215 LineTo(InnerWidth - Border, InnerHeight - Border); 216 if MyRO.Turn >= 800 then 217 LineStep := 200 218 else if MyRO.Turn >= 400 then 219 LineStep := 100 220 else 221 LineStep := 50; 222 for T := 0 to (MyRO.Turn - 1) div LineStep do 223 begin 224 x := Border + (InnerWidth - 2 * Border) * T * 225 LineStep div (MyRO.Turn - 1); 226 MoveTo(x, Border); 227 LineTo(x, InnerHeight - Border); 228 s := IntToStr(abs(TurnToYear(T * LineStep))); 229 Textout(x - TextWidth(s) div 2, Border - 16, s); 230 end; 231 232 if max > 0 then 233 begin 234 for p := 0 to nPl - 1 do 235 if (G.Difficulty[p] > 0) and 236 (Server(sGetChart + Mode shl 4, me, p, List^) >= rExecuted) then 237 begin 238 Pen.Color := Tribe[p].Color; 239 Stop := MyRO.Turn - 1; 240 while (Stop > 0) and (List[Stop] = 0) do 241 dec(Stop); 242 for T := 0 to Stop do 243 begin 244 r := Round(T); 245 x := Border + (InnerWidth - 2 * Border) * T div (MyRO.Turn - 1); 246 y := InnerHeight - Border - (InnerHeight - 2 * Border) * 247 r div max; 248 if T = 0 then 249 MoveTo(x, y) 250 // else if Mode=stTerritory then 251 // begin LineTo(x,y0); LineTo(x,y) end 252 else if RoundPixels[Mode] = 0 then 253 begin 254 if (y <> y0) or (T = Stop) then 255 LineTo(x, y) 256 end 257 else 258 LineTo(x, y); 259 y0 := y; 260 end; 261 end; 262 end; 263 FreeMem(List); 264 end 265 else 266 with offscreen.canvas do 267 begin 268 Font.Assign(UniFont[ftSmall]); 269 FillOffscreen(0, 0, InnerWidth, InnerHeight); 270 271 PaintColonyShip(offscreen.canvas, Player, 8, InnerWidth - 16, yArea); 272 273 ShareBar(InnerWidth div 2 - 85, InnerHeight - 62, 274 Phrases.Lookup('SHIPHAB'), MyRO.Ship[Player].Parts[spHab], 2); 275 ShareBar(InnerWidth div 2 - 85, InnerHeight - 43, 276 Phrases.Lookup('SHIPPOW'), MyRO.Ship[Player].Parts[spPow], 4); 277 ShareBar(InnerWidth div 2 - 85, InnerHeight - 24, 278 Phrases.Lookup('SHIPCOMP'), MyRO.Ship[Player].Parts[spComp], 6); 191 279 end; 192 193 Brush.Color:=$000000; 194 FillRect(Rect(0,0,InnerWidth,InnerHeight)); 195 Brush.Style:=bsClear;196 Pen.Color:=$606060; 197 MoveTo(Border,InnerHeight-Border);198 LineTo(InnerWidth-Border,InnerHeight-Border); 199 i f MyRO.Turn>=800 then LineStep:=200200 else if MyRO.Turn>=400 then LineStep:=100201 else LineStep:=50;202 for T:=0 to (MyRO.Turn-1) div LineStep do203 begin204 x:=Border+(InnerWidth-2*Border)*T*LineStep div (MyRO.Turn-1);205 MoveTo(x,Border);206 LineTo(x,InnerHeight-Border);207 s:=IntToStr(abs(TurnToYear(T*LineStep)));208 Textout(x-TextWidth(s) div 2,Border-16,s); 209 end;210 211 if max>0then212 begin213 for p:=0 to nPl-1 do214 if (G.Difficulty[p]>0)215 and (Server(sGetChart+Mode shl 4,me,p,List^)>=rExecuted) then216 begin217 Pen.Color:=Tribe[p].Color;218 Stop:=MyRO.Turn-1; 219 while (Stop>0) and (List[Stop]=0) do dec(Stop);220 for T:=0 to Stop do 221 begin222 r:=Round(T);223 x:=Border+(InnerWidth-2*Border)*T div (MyRO.Turn-1);224 y:=InnerHeight-Border-(InnerHeight-2*Border)*r div max;225 if T=0 then MoveTo(x,y)226 // else if Mode=stTerritory then 227 // begin LineTo(x,y0); LineTo(x,y) end 228 else if RoundPixels[Mode]=0 then 229 begin 230 if (y<>y0) or (T=Stop) then LineTo(x,y) 231 end232 else LineTo(x,y);233 y0:=y;234 end;235 end;236 end;237 FreeMem(List);280 MarkUsedOffscreen(InnerWidth, InnerHeight); 281 end; // OffscreenPaint 282 283 procedure TDiaDlg.FormPaint(Sender: TObject); 284 var 285 s: string; 286 begin 287 inherited; 288 canvas.Font.Assign(UniFont[ftNormal]); 289 if Kind = dkChart then 290 s := Phrases.Lookup('DIAGRAM', Mode) 291 else 292 s := Tribe[Player].TPhrase('SHORTNAME'); 293 LoweredTextOut(canvas, -1, MainTexture, 294 (ClientWidth - BiColorTextWidth(canvas, s)) div 2, 31, s); 295 end; 296 297 procedure TDiaDlg.FormShow(Sender: TObject); 298 begin 299 if WindowMode = wmModal then 300 begin { center on screen } 301 Left := (Screen.Width - Width) div 2; 302 Top := (Screen.Height - Height) div 2; 303 end; 304 OffscreenPaint; 305 end; 306 307 procedure TDiaDlg.ShowNewContent_Charts(NewMode: integer); 308 begin 309 Kind := dkChart; 310 Mode := stPop; 311 ToggleBtn.ButtonIndex := 15; 312 ToggleBtn.Hint := Phrases.Lookup('BTN_PAGE'); 313 Caption := Phrases.Lookup('TITLE_DIAGRAMS'); 314 inherited ShowNewContent(NewMode); 315 end; 316 317 procedure TDiaDlg.ShowNewContent_Ship(NewMode, p: integer); 318 begin 319 Kind := dkShip; 320 if p < 0 then 321 begin 322 Player := me; 323 while MyRO.Ship[Player].Parts[spComp] + MyRO.Ship[Player].Parts[spPow] + 324 MyRO.Ship[Player].Parts[spHab] = 0 do 325 Player := (Player + 1) mod nPl; 238 326 end 239 else with offscreen.Canvas do 240 begin 241 Font.Assign(UniFont[ftSmall]); 242 FillOffscreen(0,0,InnerWidth,InnerHeight); 243 244 PaintColonyShip(offscreen.Canvas,Player,8,InnerWidth-16,yArea); 245 246 ShareBar(InnerWidth div 2-85,InnerHeight-62,Phrases.Lookup('SHIPHAB'), 247 MyRO.Ship[Player].Parts[spHab],2); 248 ShareBar(InnerWidth div 2-85,InnerHeight-43,Phrases.Lookup('SHIPPOW'), 249 MyRO.Ship[Player].Parts[spPow],4); 250 ShareBar(InnerWidth div 2-85,InnerHeight-24,Phrases.Lookup('SHIPCOMP'), 251 MyRO.Ship[Player].Parts[spComp],6); 252 end; 253 MarkUsedOffscreen(InnerWidth,InnerHeight); 254 end; // OffscreenPaint 255 256 procedure TDiaDlg.FormPaint(Sender: TObject); 257 var 258 s: string; 259 begin 260 inherited; 261 Canvas.Font.Assign(UniFont[ftNormal]); 262 if Kind=dkChart then s:=Phrases.Lookup('DIAGRAM',Mode) 263 else s:=Tribe[Player].TPhrase('SHORTNAME'); 264 LoweredTextOut(Canvas, -1, MainTexture, 265 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 31, s); 266 end; 267 268 procedure TDiaDlg.FormShow(Sender: TObject); 269 begin 270 if WindowMode=wmModal then 271 begin {center on screen} 272 Left:=(Screen.Width-Width) div 2; 273 Top:=(Screen.Height-Height) div 2; 274 end; 275 OffscreenPaint; 276 end; 277 278 procedure TDiaDlg.ShowNewContent_Charts(NewMode: integer); 279 begin 280 Kind:=dkChart; 281 Mode:=stPop; 282 ToggleBtn.ButtonIndex:=15; 283 ToggleBtn.Hint:=Phrases.Lookup('BTN_PAGE'); 284 Caption:=Phrases.Lookup('TITLE_DIAGRAMS'); 285 inherited ShowNewContent(NewMode); 286 end; 287 288 procedure TDiaDlg.ShowNewContent_Ship(NewMode,p: integer); 289 begin 290 Kind:=dkShip; 291 if p<0 then 292 begin 293 Player:=me; 294 while MyRO.Ship[Player].Parts[spComp]+MyRO.Ship[Player].Parts[spPow] 295 +MyRO.Ship[Player].Parts[spHab]=0 do 296 Player:=(Player+1) mod nPl; 327 else 328 Player := p; 329 ToggleBtn.ButtonIndex := 28; 330 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT'); 331 Caption := Phrases.Lookup('TITLE_SHIPS'); 332 inherited ShowNewContent(NewMode); 333 end; 334 335 procedure TDiaDlg.ToggleBtnClick(Sender: TObject); 336 var 337 p1: integer; 338 m: TMenuItem; 339 begin 340 if Kind = dkChart then 341 begin 342 Mode := (Mode + 1) mod nStat; 343 OffscreenPaint; 344 Invalidate; 297 345 end 298 else Player:=p; 299 ToggleBtn.ButtonIndex:=28; 300 ToggleBtn.Hint:=Phrases.Lookup('BTN_SELECT');301 Caption:=Phrases.Lookup('TITLE_SHIPS'); 302 inherited ShowNewContent(NewMode); 303 end; 304 305 procedure TDiaDlg.ToggleBtnClick(Sender: TObject);306 var 307 p1: integer;308 m: TMenuItem;309 begin 310 if Kind=dkChartthen311 begin312 Mode:=(Mode+1) mod nStat;313 OffscreenPaint;314 Invalidate;346 else 347 begin 348 EmptyMenu(Popup.Items); 349 for p1 := 0 to nPl - 1 do 350 if MyRO.Ship[p1].Parts[spComp] + MyRO.Ship[p1].Parts[spPow] + 351 MyRO.Ship[p1].Parts[spHab] > 0 then 352 begin 353 m := TMenuItem.Create(Popup); 354 m.RadioItem := true; 355 m.Caption := Tribe[p1].TPhrase('SHORTNAME'); 356 m.Tag := p1; 357 m.OnClick := PlayerClick; 358 if p1 = Player then 359 m.Checked := true; 360 Popup.Items.Add(m); 361 end; 362 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height); 315 363 end 316 else317 begin318 EmptyMenu(Popup.Items);319 for p1:=0 to nPl-1 do320 if MyRO.Ship[p1].Parts[spComp]+MyRO.Ship[p1].Parts[spPow]321 +MyRO.Ship[p1].Parts[spHab]>0 then322 begin323 m:=TMenuItem.Create(Popup);324 m.RadioItem:=true;325 m.Caption:=Tribe[p1].TPhrase('SHORTNAME');326 m.Tag:=p1;327 m.OnClick:=PlayerClick;328 if p1=Player then m.Checked:=true;329 Popup.Items.Add(m);330 end;331 Popup.Popup(Left+ToggleBtn.Left, Top+ToggleBtn.Top+ToggleBtn.Height);332 end333 364 end; 334 365 335 366 procedure TDiaDlg.PlayerClick(Sender: TObject); 336 367 begin 337 ShowNewContent_Ship(FWindowMode, TComponent(Sender).Tag);368 ShowNewContent_Ship(FWindowMode, TComponent(Sender).Tag); 338 369 end; 339 370 … … 341 372 Shift: TShiftState); 342 373 begin 343 if (Key=VK_F6) and (Kind=dkChart) then // my key 344 ToggleBtnClick(nil) 345 else if (Key=VK_F8) and (Kind=dkShip) then // my other key 346 else inherited 374 if (Key = VK_F6) and (Kind = dkChart) then // my key 375 ToggleBtnClick(nil) 376 else if (Key = VK_F8) and (Kind = dkShip) then // my other key 377 else 378 inherited 347 379 end; 348 380 349 381 end. 350 -
trunk/LocalPlayer/Diplomacy.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Diplomacy; 4 3 … … 7 6 uses Protocol; 8 7 9 function DipCommandToString(pSender, pTarget, Treaty, OppCommand, Command: integer;10 const OppOffer, Offer: TOffer): string;8 function DipCommandToString(pSender, pTarget, Treaty, OppCommand, 9 Command: integer; const OppOffer, Offer: TOffer): string; 11 10 12 11 implementation 13 12 14 13 uses 15 ScreenTools,Tribes,SysUtils;14 ScreenTools, Tribes, SysUtils; 16 15 17 16 function DipCommandToString; … … 19 18 function PriceToString(p, Price: integer): string; 20 19 begin 21 case Price and opMask of22 opChoose:23 result:=Phrases.Lookup('PRICE_CHOOSE');24 opCivilReport:25 result:=Tribe[p].TPhrase('PRICE_CIVIL');26 opMilReport:27 result:=Tribe[p].TPhrase('PRICE_MIL');28 opMap:29 result:=Tribe[p].TPhrase('PRICE_MAP');30 opTreaty:31 {if Price-opTreaty<Treaty then32 case Treaty of20 case Price and opMask of 21 opChoose: 22 result := Phrases.Lookup('PRICE_CHOOSE'); 23 opCivilReport: 24 result := Tribe[p].TPhrase('PRICE_CIVIL'); 25 opMilReport: 26 result := Tribe[p].TPhrase('PRICE_MIL'); 27 opMap: 28 result := Tribe[p].TPhrase('PRICE_MAP'); 29 opTreaty: 30 { if Price-opTreaty<Treaty then 31 case Treaty of 33 32 trPeace: result:=Phrases.Lookup('FRENDTREATY_PEACE'); 34 33 trFriendlyContact: result:=Phrases.Lookup('FRENDTREATY_FRIENDLY'); 35 34 trAlliance: result:=Phrases.Lookup('FRENDTREATY_ALLIANCE'); 36 35 end 37 else} result:=Phrases.Lookup('TREATY',Price-opTreaty); 38 opShipParts: 39 case Price shr 16 and $f of 40 0: result:=Format(Phrases.Lookup('PRICE_SHIPCOMP'),[Price and $FFFF]); 41 1: result:=Format(Phrases.Lookup('PRICE_SHIPPOW'),[Price and $FFFF]); 42 2: result:=Format(Phrases.Lookup('PRICE_SHIPHAB'),[Price and $FFFF]); 43 end; 44 opMoney: 45 result:=Format('%d%%c',[Price-opMoney]); 46 opTribute: 47 result:=Format(Phrases.Lookup('PRICE_TRIBUTE'),[Price-opTribute]); 48 opTech: 49 result:=Phrases.Lookup('ADVANCES',Price-opTech); 50 opAllTech: 51 result:=Tribe[p].TPhrase('PRICE_ALLTECH'); 52 opModel: 53 result:=Tribe[p].ModelName[Price-opModel]; 54 opAllModel: 55 result:=Tribe[p].TPhrase('PRICE_ALLMODEL'); 56 { opCity: 57 result:=Format(TPhrase('PRICE_CITY',p),[CityName(Price-opCity)]);} 36 else } result := Phrases.Lookup('TREATY', Price - opTreaty); 37 opShipParts: 38 case Price shr 16 and $F of 39 0: 40 result := Format(Phrases.Lookup('PRICE_SHIPCOMP'), 41 [Price and $FFFF]); 42 1: 43 result := Format(Phrases.Lookup('PRICE_SHIPPOW'), 44 [Price and $FFFF]); 45 2: 46 result := Format(Phrases.Lookup('PRICE_SHIPHAB'), 47 [Price and $FFFF]); 48 end; 49 opMoney: 50 result := Format('%d%%c', [Price - opMoney]); 51 opTribute: 52 result := Format(Phrases.Lookup('PRICE_TRIBUTE'), [Price - opTribute]); 53 opTech: 54 result := Phrases.Lookup('ADVANCES', Price - opTech); 55 opAllTech: 56 result := Tribe[p].TPhrase('PRICE_ALLTECH'); 57 opModel: 58 result := Tribe[p].ModelName[Price - opModel]; 59 opAllModel: 60 result := Tribe[p].TPhrase('PRICE_ALLMODEL'); 61 { opCity: 62 result:=Format(TPhrase('PRICE_CITY',p),[CityName(Price-opCity)]); } 58 63 end 59 64 end; 60 65 61 66 var 62 i: integer;63 sAdd,sDeliver, sCost: string;64 DoIntro: boolean;67 i: integer; 68 sAdd, sDeliver, sCost: string; 69 DoIntro: boolean; 65 70 begin 66 DoIntro:= OppCommand=scDipStart; 67 case Command of 68 scDipCancelTreaty: 69 begin 70 case Treaty of 71 trPeace: result:=Phrases.Lookup('FRCANCELTREATY_PEACE'); 72 trFriendlyContact: result:=Phrases.Lookup('FRCANCELTREATY_FRIENDLY'); 73 trAlliance: result:=Phrases.Lookup('FRCANCELTREATY_ALLIANCE'); 74 end; 75 DoIntro:=false; 76 end; 77 scDipNotice: result:=Phrases.Lookup('FRNOTICE'); 78 scDipAccept: 79 begin 80 if (OppOffer.nDeliver+OppOffer.nCost=1) 81 and (OppOffer.Price[0] and opMask=opTreaty) 82 and (integer(OppOffer.Price[0]-opTreaty)>Treaty) then // simple treaty offer 83 {if OppOffer.Price[0]-opTreaty=trCeaseFire then 84 result:=Tribe[pTarget].TPhrase('FRACCEPTCEASEFIRE') 85 else} result:=Tribe[pTarget].TPhrase('FRACCEPTTREATY') 86 else if OppOffer.nDeliver=0 then 87 result:=Tribe[pSender].TPhrase('FRACCEPTDEMAND_STRONG') 88 else if OppOffer.nCost=0 then 89 result:=Tribe[pSender].TPhrase('FRACCEPTPRESENT') 90 else result:=Tribe[pSender].TPhrase('FRACCEPTOFFER'); 91 end; 92 scDipBreak: 93 begin 94 result:=Tribe[pTarget].TPhrase('FRBREAK'); 95 DoIntro:=false; 96 end; 97 scDipOffer: 98 begin 99 result:=''; 100 if (OppCommand=scDipOffer) and ((OppOffer.nDeliver>0) or (OppOffer.nCost>0)) 101 and (Offer.nCost+Offer.nDeliver<=2) then 102 begin // respond to made offer before making own one 103 if (OppOffer.nDeliver+OppOffer.nCost=1) 104 and (OppOffer.Price[0] and opMask=opTreaty) 105 and (integer(OppOffer.Price[0]-opTreaty)>Treaty) then // simple treaty offer 106 result:=Tribe[pSender].TPhrase('FRNOTACCEPTTREATY')+'\' 107 else if OppOffer.nDeliver=0 then 108 result:=Tribe[pSender].TPhrase('FRNOTACCEPTDEMAND_STRONG')+'\' 109 else if OppOffer.nCost=0 then 110 result:=Tribe[pSender].TPhrase('FRNOTACCEPTPRESENT')+'\'; 111 end; 112 113 sDeliver:=''; 114 for i:=0 to Offer.nDeliver-1 do 115 begin 116 sAdd:=PriceToString(pSender,Offer.Price[i]); 117 if i=0 then sDeliver:=sAdd 118 else sDeliver:=Format(Phrases.Lookup('PRICE_CONCAT'),[sDeliver,sAdd]) 119 end; 120 sCost:=''; 121 for i:=0 to Offer.nCost-1 do 122 begin 123 sAdd:=PriceToString(pTarget,Offer.Price[Offer.nDeliver+i]); 124 if i=0 then sCost:=sAdd 125 else sCost:=Format(Phrases.Lookup('PRICE_CONCAT'),[sCost,sAdd]) 126 end; 127 128 if (Offer.nDeliver=0) and (Offer.nCost=0) then 129 begin // no offer made 130 if (OppCommand=scDipOffer) and ((OppOffer.nDeliver=0) and (OppOffer.nCost=0)) then 131 result:=Tribe[pTarget].TPhrase('FRBYE') 132 else 133 begin 134 if (result='') and (OppCommand=scDipOffer) 135 and ((OppOffer.nDeliver>0) or (OppOffer.nCost>0)) then 71 DoIntro := OppCommand = scDipStart; 72 case Command of 73 scDipCancelTreaty: 74 begin 75 case Treaty of 76 trPeace: 77 result := Phrases.Lookup('FRCANCELTREATY_PEACE'); 78 trFriendlyContact: 79 result := Phrases.Lookup('FRCANCELTREATY_FRIENDLY'); 80 trAlliance: 81 result := Phrases.Lookup('FRCANCELTREATY_ALLIANCE'); 82 end; 83 DoIntro := false; 84 end; 85 scDipNotice: 86 result := Phrases.Lookup('FRNOTICE'); 87 scDipAccept: 88 begin 89 if (OppOffer.nDeliver + OppOffer.nCost = 1) and 90 (OppOffer.Price[0] and opMask = opTreaty) and 91 (integer(OppOffer.Price[0] - opTreaty) > Treaty) then 92 // simple treaty offer 93 { if OppOffer.Price[0]-opTreaty=trCeaseFire then 94 result:=Tribe[pTarget].TPhrase('FRACCEPTCEASEFIRE') 95 else } result := Tribe[pTarget].TPhrase('FRACCEPTTREATY') 96 else if OppOffer.nDeliver = 0 then 97 result := Tribe[pSender].TPhrase('FRACCEPTDEMAND_STRONG') 98 else if OppOffer.nCost = 0 then 99 result := Tribe[pSender].TPhrase('FRACCEPTPRESENT') 100 else 101 result := Tribe[pSender].TPhrase('FRACCEPTOFFER'); 102 end; 103 scDipBreak: 104 begin 105 result := Tribe[pTarget].TPhrase('FRBREAK'); 106 DoIntro := false; 107 end; 108 scDipOffer: 109 begin 110 result := ''; 111 if (OppCommand = scDipOffer) and 112 ((OppOffer.nDeliver > 0) or (OppOffer.nCost > 0)) and 113 (Offer.nCost + Offer.nDeliver <= 2) then 114 begin // respond to made offer before making own one 115 if (OppOffer.nDeliver + OppOffer.nCost = 1) and 116 (OppOffer.Price[0] and opMask = opTreaty) and 117 (integer(OppOffer.Price[0] - opTreaty) > Treaty) then 118 // simple treaty offer 119 result := Tribe[pSender].TPhrase('FRNOTACCEPTTREATY') + '\' 120 else if OppOffer.nDeliver = 0 then 121 result := Tribe[pSender].TPhrase('FRNOTACCEPTDEMAND_STRONG') + '\' 122 else if OppOffer.nCost = 0 then 123 result := Tribe[pSender].TPhrase('FRNOTACCEPTPRESENT') + '\'; 124 end; 125 126 sDeliver := ''; 127 for i := 0 to Offer.nDeliver - 1 do 128 begin 129 sAdd := PriceToString(pSender, Offer.Price[i]); 130 if i = 0 then 131 sDeliver := sAdd 132 else 133 sDeliver := Format(Phrases.Lookup('PRICE_CONCAT'), [sDeliver, sAdd]) 134 end; 135 sCost := ''; 136 for i := 0 to Offer.nCost - 1 do 137 begin 138 sAdd := PriceToString(pTarget, Offer.Price[Offer.nDeliver + i]); 139 if i = 0 then 140 sCost := sAdd 141 else 142 sCost := Format(Phrases.Lookup('PRICE_CONCAT'), [sCost, sAdd]) 143 end; 144 145 if (Offer.nDeliver = 0) and (Offer.nCost = 0) then 146 begin // no offer made 147 if (OppCommand = scDipOffer) and 148 ((OppOffer.nDeliver = 0) and (OppOffer.nCost = 0)) then 149 result := Tribe[pTarget].TPhrase('FRBYE') 150 else 136 151 begin 137 if (OppOffer.nDeliver=1) and (OppOffer.Price[0]=opChoose) 138 and not Phrases2FallenBackToEnglish then 139 result:=Tribe[pSender].TString(Phrases2.Lookup('FRNOTACCEPTANYOFFER'))+' ' 140 else if (OppOffer.nCost=1) and (OppOffer.Price[OppOffer.nDeliver]=opChoose) 141 and not Phrases2FallenBackToEnglish then 142 result:=Tribe[pSender].TString(Phrases2.Lookup('FRNOTACCEPTANYWANT'))+' ' 143 else result:=Tribe[pSender].TPhrase('FRNOTACCEPTOFFER')+' '; 144 end; 145 result:=result+Phrases.Lookup('FRDONE'); 146 DoIntro:=false 152 if (result = '') and (OppCommand = scDipOffer) and 153 ((OppOffer.nDeliver > 0) or (OppOffer.nCost > 0)) then 154 begin 155 if (OppOffer.nDeliver = 1) and (OppOffer.Price[0] = opChoose) and 156 not Phrases2FallenBackToEnglish then 157 result := Tribe[pSender].TString 158 (Phrases2.Lookup('FRNOTACCEPTANYOFFER')) + ' ' 159 else if (OppOffer.nCost = 1) and 160 (OppOffer.Price[OppOffer.nDeliver] = opChoose) and not Phrases2FallenBackToEnglish 161 then 162 result := Tribe[pSender].TString 163 (Phrases2.Lookup('FRNOTACCEPTANYWANT')) + ' ' 164 else 165 result := Tribe[pSender].TPhrase('FRNOTACCEPTOFFER') + ' '; 166 end; 167 result := result + Phrases.Lookup('FRDONE'); 168 DoIntro := false 169 end 147 170 end 148 end 149 else if (Offer.nDeliver+Offer.nCost=1) 150 and (Offer.Price[0] and opMask=opTreaty) 151 and (integer(Offer.Price[0]-opTreaty)>Treaty) then // simple treaty offer 152 begin 153 case Offer.Price[0]-opTreaty of 154 //trCeaseFire: result:=result+Tribe[pTarget].TPhrase('FRCEASEFIRE'); 155 trPeace: result:=result+Tribe[pTarget].TPhrase('FRPEACE'); 156 trFriendlyContact: result:=result+Tribe[pTarget].TPhrase('FRFRIENDLY'); 157 trAlliance: result:=result+Tribe[pTarget].TPhrase('FRALLIANCE'); 171 else if (Offer.nDeliver + Offer.nCost = 1) and 172 (Offer.Price[0] and opMask = opTreaty) and 173 (integer(Offer.Price[0] - opTreaty) > Treaty) then 174 // simple treaty offer 175 begin 176 case Offer.Price[0] - opTreaty of 177 // trCeaseFire: result:=result+Tribe[pTarget].TPhrase('FRCEASEFIRE'); 178 trPeace: 179 result := result + Tribe[pTarget].TPhrase('FRPEACE'); 180 trFriendlyContact: 181 result := result + Tribe[pTarget].TPhrase('FRFRIENDLY'); 182 trAlliance: 183 result := result + Tribe[pTarget].TPhrase('FRALLIANCE'); 184 end 158 185 end 159 end 160 else if Offer.nDeliver=0 then // demand 161 begin 162 if (Treaty>=trFriendlyContact) and not Phrases2FallenBackToEnglish then 163 result:=result+Format(Tribe[pTarget].TString(Phrases2.Lookup('FRDEMAND_SOFT')),[sCost]) 164 else 165 begin 166 result:=result+Format(Tribe[pTarget].TPhrase('FRDEMAND_STRONG'),[sCost]); 167 DoIntro:=false 186 else if Offer.nDeliver = 0 then // demand 187 begin 188 if (Treaty >= trFriendlyContact) and not Phrases2FallenBackToEnglish 189 then 190 result := result + 191 Format(Tribe[pTarget].TString(Phrases2.Lookup('FRDEMAND_SOFT') 192 ), [sCost]) 193 else 194 begin 195 result := result + 196 Format(Tribe[pTarget].TPhrase('FRDEMAND_STRONG'), [sCost]); 197 DoIntro := false 198 end 168 199 end 169 end 170 else if Offer.nCost=0 then // present 171 result:=result+Format(Tribe[pTarget].TPhrase('FRPRESENT'),[sDeliver]) 172 else if (Offer.nDeliver=1) and (Offer.Price[0]=opChoose) then 173 result:=result+Format(Phrases.Lookup('FRDELCHOICE'),[sCost]) 174 else if (Offer.nCost=1) and (Offer.Price[Offer.nDeliver]=opChoose) then 175 result:=result+Format(Phrases.Lookup('FRCOSTCHOICE'),[sDeliver]) 176 else result:=result+Format(Phrases.Lookup('FROFFER'),[sDeliver,sCost]); 177 end; 200 else if Offer.nCost = 0 then // present 201 result := result + Format(Tribe[pTarget].TPhrase('FRPRESENT'), 202 [sDeliver]) 203 else if (Offer.nDeliver = 1) and (Offer.Price[0] = opChoose) then 204 result := result + Format(Phrases.Lookup('FRDELCHOICE'), [sCost]) 205 else if (Offer.nCost = 1) and (Offer.Price[Offer.nDeliver] = opChoose) 206 then 207 result := result + Format(Phrases.Lookup('FRCOSTCHOICE'), [sDeliver]) 208 else 209 result := result + Format(Phrases.Lookup('FROFFER'), 210 [sDeliver, sCost]); 211 end; 178 212 end; 179 if DoIntro then 180 if Treaty<trPeace then 181 result:=Tribe[pSender].TPhrase('FRSTART_NOTREATY')+' '+result 182 else result:=Tribe[pSender].TPhrase('FRSTART_PEACE')+' '+result 213 if DoIntro then 214 if Treaty < trPeace then 215 result := Tribe[pSender].TPhrase('FRSTART_NOTREATY') + ' ' + result 216 else 217 result := Tribe[pSender].TPhrase('FRSTART_PEACE') + ' ' + result 183 218 end; 184 219 185 220 end. 186 -
trunk/LocalPlayer/Draft.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Draft; 4 3 … … 6 5 7 6 uses 8 Protocol,ClientTools,Term,ScreenTools,PVSB,BaseWin, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ExtCtrls,ButtonA, 7 Protocol, ClientTools, Term, ScreenTools, PVSB, BaseWin, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, 10 ButtonA, 11 11 ButtonB, ButtonBase, Area; 12 12 … … 28 28 procedure FormDestroy(Sender: TObject); 29 29 public 30 procedure ShowNewContent(NewMode: integer); 30 procedure ShowNewContent(NewMode: integer); 31 31 protected 32 32 procedure OffscreenPaint; override; 33 33 private 34 Domain, MaxLines,Lines,Cut,yDomain,yFeature,yWeight,yTotal,yView,IncCap,35 DecCap: integer;36 code: array [0..nFeature-1] of integer;37 Template, Back: TBitmap;38 function IsFeatureInList(d, i: integer): boolean;34 Domain, MaxLines, Lines, Cut, yDomain, yFeature, yWeight, yTotal, yView, 35 IncCap, DecCap: integer; 36 code: array [0 .. nFeature - 1] of integer; 37 Template, Back: TBitmap; 38 function IsFeatureInList(d, i: integer): boolean; 39 39 procedure SetDomain(d: integer); 40 40 end; … … 45 45 implementation 46 46 47 uses Help, Tribes,Directories;47 uses Help, Tribes, Directories; 48 48 49 49 {$R *.DFM} 50 50 51 51 const 52 MaxLines0=11; LinePitch=20; 53 xDomain=30; yDomain0=464; DomainPitch=40; 54 xFeature=38; yFeature0=42; 55 xWeight=100; yWeight0=271; 56 xTotal=20; xTotal2=34; yTotal0=354; 57 xView=17; yView0=283; 52 MaxLines0 = 11; 53 LinePitch = 20; 54 xDomain = 30; 55 yDomain0 = 464; 56 DomainPitch = 40; 57 xFeature = 38; 58 yFeature0 = 42; 59 xWeight = 100; 60 yWeight0 = 271; 61 xTotal = 20; 62 xTotal2 = 34; 63 yTotal0 = 354; 64 xView = 17; 65 yView0 = 283; 58 66 59 67 procedure TDraftDlg.FormCreate(Sender: TObject); 60 68 begin 61 inherited;62 InitButtons();63 HelpContext:='CLASSES';64 Caption:=Phrases.Lookup('TITLE_DRAFT');65 OKBtn.Caption:=Phrases.Lookup('BTN_OK');66 67 if not Phrases2FallenBackToEnglish then68 begin 69 GroundArea.Hint:=Phrases2.Lookup('DRAFTDOMAIN',0);70 SeaArea.Hint:=Phrases2.Lookup('DRAFTDOMAIN',1);71 AirArea.Hint:=Phrases2.Lookup('DRAFTDOMAIN',2);69 inherited; 70 InitButtons(); 71 HelpContext := 'CLASSES'; 72 Caption := Phrases.Lookup('TITLE_DRAFT'); 73 OKBtn.Caption := Phrases.Lookup('BTN_OK'); 74 75 if not Phrases2FallenBackToEnglish then 76 begin 77 GroundArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 0); 78 SeaArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 1); 79 AirArea.Hint := Phrases2.Lookup('DRAFTDOMAIN', 2); 72 80 end 73 else 74 begin 75 GroundArea.Hint:=Phrases.Lookup('DOMAIN',0); 76 SeaArea.Hint:=Phrases.Lookup('DOMAIN',1); 77 AirArea.Hint:=Phrases.Lookup('DOMAIN',2); 78 end; 79 80 Back:=TBitmap.Create; 81 Back.PixelFormat:=pf24bit; 82 Back.Width:=ClientWidth; Back.Height:=ClientHeight; 83 Template:=TBitmap.Create; 84 LoadGraphicFile(Template, HomeDir+'Graphics\MiliRes', gfNoGamma); 85 Template.PixelFormat:=pf8bit; 81 else 82 begin 83 GroundArea.Hint := Phrases.Lookup('DOMAIN', 0); 84 SeaArea.Hint := Phrases.Lookup('DOMAIN', 1); 85 AirArea.Hint := Phrases.Lookup('DOMAIN', 2); 86 end; 87 88 Back := TBitmap.Create; 89 Back.PixelFormat := pf24bit; 90 Back.Width := ClientWidth; 91 Back.Height := ClientHeight; 92 Template := TBitmap.Create; 93 LoadGraphicFile(Template, HomeDir + 'Graphics\MiliRes', gfNoGamma); 94 Template.PixelFormat := pf8bit; 86 95 end; 87 96 88 97 procedure TDraftDlg.FormDestroy(Sender: TObject); 89 98 begin 90 Template.Free;99 Template.Free; 91 100 end; 92 101 93 102 procedure TDraftDlg.CloseBtnClick(Sender: TObject); 94 103 begin 95 ModalResult:=mrCancel;104 ModalResult := mrCancel; 96 105 end; 97 106 … … 100 109 function DomainAvailable(d: integer): boolean; 101 110 begin 102 result:=(upgrade[d,0].Preq=preNone)103 or (MyRO.Tech[upgrade[d,0].Preq]>=tsApplicable);111 result := (upgrade[d, 0].Preq = preNone) or 112 (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable); 104 113 end; 105 114 106 115 procedure PaintTotalBars; 107 116 var 108 i,y,dx,num,w: integer; 109 s: string; 110 begin 111 with offscreen.Canvas do 112 begin 113 // strength bar 114 y:=yTotal; 115 DarkGradient(Offscreen.Canvas,xTotal-6,y+1,184,2); 116 DarkGradient(Offscreen.Canvas,xTotal2+172,y+1,95,2); 117 RisedTextOut(Offscreen.Canvas,xTotal-2,y,Phrases.Lookup('UNITSTRENGTH')); 118 RisedTextOut(Offscreen.Canvas,xTotal+112+30,y,'x'+IntToStr(MyRO.DevModel.MStrength)); 119 RisedTextOut(Offscreen.Canvas,xTotal2+148+30,y,'='); 120 s:=IntToStr(MyRO.DevModel.Attack)+'/'+IntToStr(MyRO.DevModel.Defense); 121 RisedTextOut(Offscreen.Canvas,xTotal2+170+64+30-BiColorTextWidth(Offscreen.Canvas,s),y,s); 122 123 // transport bar 124 if MyRO.DevModel.MTrans>0 then 117 i, y, dx, num, w: integer; 118 s: string; 119 begin 120 with offscreen.Canvas do 121 begin 122 // strength bar 123 y := yTotal; 124 DarkGradient(offscreen.Canvas, xTotal - 6, y + 1, 184, 2); 125 DarkGradient(offscreen.Canvas, xTotal2 + 172, y + 1, 95, 2); 126 RisedTextOut(offscreen.Canvas, xTotal - 2, y, 127 Phrases.Lookup('UNITSTRENGTH')); 128 RisedTextOut(offscreen.Canvas, xTotal + 112 + 30, y, 129 'x' + IntToStr(MyRO.DevModel.MStrength)); 130 RisedTextOut(offscreen.Canvas, xTotal2 + 148 + 30, y, '='); 131 s := IntToStr(MyRO.DevModel.Attack) + '/' + 132 IntToStr(MyRO.DevModel.Defense); 133 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 134 BiColorTextWidth(offscreen.Canvas, s), y, s); 135 136 // transport bar 137 if MyRO.DevModel.MTrans > 0 then 125 138 begin 126 y:=yTotal+19; 127 DarkGradient(Offscreen.Canvas,xTotal-6,y+1,184,1); 128 DarkGradient(Offscreen.Canvas,xTotal2+172,y+1,95,1); 129 RisedTextOut(Offscreen.Canvas,xTotal-2,y,Phrases.Lookup('UNITTRANSPORT')); 130 RisedTextOut(Offscreen.Canvas,xTotal+112+30,y,'x'+IntToStr(MyRO.DevModel.MTrans)); 131 RisedTextOut(Offscreen.Canvas,xTotal2+148+30,y,'='); 132 133 Font.Color:=$000000; 134 dx:=-237-30; 135 for i:=mcFirstNonCap-1 downto 3 do 136 if i in [mcSeaTrans,mcCarrier,mcAirTrans] then 139 y := yTotal + 19; 140 DarkGradient(offscreen.Canvas, xTotal - 6, y + 1, 184, 1); 141 DarkGradient(offscreen.Canvas, xTotal2 + 172, y + 1, 95, 1); 142 RisedTextOut(offscreen.Canvas, xTotal - 2, y, 143 Phrases.Lookup('UNITTRANSPORT')); 144 RisedTextOut(offscreen.Canvas, xTotal + 112 + 30, y, 145 'x' + IntToStr(MyRO.DevModel.MTrans)); 146 RisedTextOut(offscreen.Canvas, xTotal2 + 148 + 30, y, '='); 147 148 Font.Color := $000000; 149 dx := -237 - 30; 150 for i := mcFirstNonCap - 1 downto 3 do 151 if i in [mcSeaTrans, mcCarrier, mcAirTrans] then 137 152 begin 138 num:=MyRO.DevModel.Cap[i]*MyRO.DevModel.MTrans;139 if num>0 then153 num := MyRO.DevModel.Cap[i] * MyRO.DevModel.MTrans; 154 if num > 0 then 140 155 begin 141 inc(dx,15); 142 Brush.Color:=$C0C0C0; 143 FrameRect(Rect(xTotal2-3-dx,y+2,xTotal2+11-dx,y+16)); 144 Brush.Style:=bsClear; 145 Sprite(Offscreen,HGrSystem,xTotal2-1-dx,y+4,10,10,66+i mod 11 *11,137+i div 11 *11); 146 if num>1 then 156 inc(dx, 15); 157 Brush.Color := $C0C0C0; 158 FrameRect(Rect(xTotal2 - 3 - dx, y + 2, 159 xTotal2 + 11 - dx, y + 16)); 160 Brush.Style := bsClear; 161 Sprite(offscreen, HGrSystem, xTotal2 - 1 - dx, y + 4, 10, 10, 162 66 + i mod 11 * 11, 137 + i div 11 * 11); 163 if num > 1 then 147 164 begin 148 s:=IntToStr(num); 149 w:=TextWidth(s); 150 inc(dx,w+1); 151 Brush.Color:=$FFFFFF; 152 FillRect(Rect(xTotal2-3-dx,y+2,xTotal2+w-1-dx,y+16)); 153 Brush.Style:=bsClear; 154 Textout(xTotal2-3-dx+1,y,s); 165 s := IntToStr(num); 166 w := TextWidth(s); 167 inc(dx, w + 1); 168 Brush.Color := $FFFFFF; 169 FillRect(Rect(xTotal2 - 3 - dx, y + 2, 170 xTotal2 + w - 1 - dx, y + 16)); 171 Brush.Style := bsClear; 172 Textout(xTotal2 - 3 - dx + 1, y, s); 155 173 end; 156 174 end; … … 158 176 end; 159 177 160 // speed bar 161 y:=yTotal+38; 162 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,y,Phrases.Lookup('UNITSPEED')); 163 DLine(offscreen.Canvas,xTotal-2,xTotal+174,y+16,MainTexture.clBevelShade, 164 MainTexture.clBevelLight); 165 DLine(offscreen.Canvas,xTotal2+176,xTotal2+263,y+16,MainTexture.clBevelShade, 166 MainTexture.clBevelLight); 167 s:=MovementToString(MyRO.DevModel.Speed); 168 RisedTextOut(offscreen.Canvas,xTotal2+170+64+30-TextWidth(s),y,s); 169 170 // cost bar 171 y:=yTotal+57; 172 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,y,Phrases.Lookup('UNITCOST')); 173 LoweredTextOut(Offscreen.Canvas,-1,MainTexture,xTotal+112+30,y,'x'+IntToStr(MyRO.DevModel.MCost)); 174 LoweredTextOut(Offscreen.Canvas,-1,MainTexture,xTotal2+148+30,y,'='); 175 DLine(offscreen.Canvas,xTotal-2,xTotal+174,y+16,MainTexture.clBevelShade, 176 MainTexture.clBevelLight); 177 DLine(offscreen.Canvas,xTotal2+176,xTotal2+263,y+16,MainTexture.clBevelShade, 178 MainTexture.clBevelLight); 179 s:=IntToStr(MyRO.DevModel.Cost); 180 RisedTextOut(offscreen.Canvas,xTotal2+170+64+30-12-TextWidth(s),y,s); 181 Sprite(offscreen,HGrSystem,xTotal2+170+54+30,y+4,10,10,88,115); 182 183 if G.Difficulty[me]<>2 then 178 // speed bar 179 y := yTotal + 38; 180 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y, 181 Phrases.Lookup('UNITSPEED')); 182 DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16, 183 MainTexture.clBevelShade, MainTexture.clBevelLight); 184 DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16, 185 MainTexture.clBevelShade, MainTexture.clBevelLight); 186 s := MovementToString(MyRO.DevModel.Speed); 187 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 188 TextWidth(s), y, s); 189 190 // cost bar 191 y := yTotal + 57; 192 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y, 193 Phrases.Lookup('UNITCOST')); 194 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal + 112 + 30, y, 195 'x' + IntToStr(MyRO.DevModel.MCost)); 196 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 197 xTotal2 + 148 + 30, y, '='); 198 DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16, 199 MainTexture.clBevelShade, MainTexture.clBevelLight); 200 DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16, 201 MainTexture.clBevelShade, MainTexture.clBevelLight); 202 s := IntToStr(MyRO.DevModel.Cost); 203 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 - 204 TextWidth(s), y, s); 205 Sprite(offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y + 4, 10, 206 10, 88, 115); 207 208 if G.Difficulty[me] <> 2 then 184 209 begin // corrected cost bar 185 y:=yTotal+76; 186 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,y, 187 Phrases.Lookup('COSTDIFF'+char(48+G.Difficulty[me]))); 188 LoweredTextOut(Offscreen.Canvas,-1,MainTexture,xTotal2+148+30,y,'='); 189 DLine(offscreen.Canvas,xTotal-2,xTotal+174,y+16,MainTexture.clBevelShade, 190 MainTexture.clBevelLight); 191 DLine(offscreen.Canvas,xTotal2+176,xTotal2+263,y+16,MainTexture.clBevelShade, 192 MainTexture.clBevelLight); 193 s:=IntToStr(MyRO.DevModel.Cost*BuildCostMod[G.Difficulty[me]] div 12); 194 RisedTextOut(offscreen.Canvas,xTotal2+170+64+30-12-TextWidth(s),y,s); 195 Sprite(offscreen,HGrSystem,xTotal2+170+54+30,y+4,10,10,88,115); 210 y := yTotal + 76; 211 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, y, 212 Phrases.Lookup('COSTDIFF' + char(48 + G.Difficulty[me]))); 213 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 214 xTotal2 + 148 + 30, y, '='); 215 DLine(offscreen.Canvas, xTotal - 2, xTotal + 174, y + 16, 216 MainTexture.clBevelShade, MainTexture.clBevelLight); 217 DLine(offscreen.Canvas, xTotal2 + 176, xTotal2 + 263, y + 16, 218 MainTexture.clBevelShade, MainTexture.clBevelLight); 219 s := IntToStr(MyRO.DevModel.Cost * BuildCostMod 220 [G.Difficulty[me]] div 12); 221 RisedTextOut(offscreen.Canvas, xTotal2 + 170 + 64 + 30 - 12 - 222 TextWidth(s), y, s); 223 Sprite(offscreen, HGrSystem, xTotal2 + 170 + 54 + 30, y + 4, 10, 224 10, 88, 115); 196 225 end; 197 226 end; … … 199 228 200 229 var 201 i,j,x,d,n,TextColor,CapWeight,DomainCount: integer; 202 begin 203 inherited; 204 205 ClientHeight:=Template.Height-Cut; 206 if ClientHeight>hMainTexture then // assemble background from 2 texture tiles 207 begin 208 bitblt(Back.Canvas.Handle,0,0,ClientWidth,64,MainTexture.Image.Canvas.Handle, 209 (wMainTexture-ClientWidth) div 2,hMainTexture-64,SRCCOPY); 210 bitblt(Back.Canvas.Handle,0,64,ClientWidth,ClientHeight-64, 211 MainTexture.Image.Canvas.Handle,(wMainTexture-ClientWidth) div 2,0,SRCCOPY); 230 i, j, x, d, n, TextColor, CapWeight, DomainCount: integer; 231 begin 232 inherited; 233 234 ClientHeight := Template.Height - Cut; 235 if ClientHeight > hMainTexture then 236 // assemble background from 2 texture tiles 237 begin 238 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, 64, 239 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 240 hMainTexture - 64, SRCCOPY); 241 bitblt(Back.Canvas.Handle, 0, 64, ClientWidth, ClientHeight - 64, 242 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 243 0, SRCCOPY); 212 244 end 213 else bitblt(Back.Canvas.Handle,0,0,ClientWidth,ClientHeight,MainTexture.Image.Canvas.Handle, 214 (wMainTexture-ClientWidth) div 2,(hMainTexture-ClientHeight) div 2,SRCCOPY); 215 ImageOp_B(Back,Template,0,0,0,0,Template.Width,64); 216 ImageOp_B(Back,Template,0,64,0,64+Cut,Template.Width,Template.Height-64-Cut); 217 218 bitblt(offscreen.canvas.handle,0,0,ClientWidth,ClientHeight,Back.Canvas.handle,0,0,SRCCOPY); 219 220 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 221 RisedTextout(offscreen.Canvas,10,7,Caption); 222 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 223 224 with MyRO.DevModel do 225 begin 226 DomainCount:=0; 227 for d:=0 to nDomains-1 do 228 if DomainAvailable(d) then 229 inc(DomainCount); 230 if DomainCount>1 then 231 begin 232 for d:=0 to nDomains-1 do 245 else 246 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 247 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 248 (hMainTexture - ClientHeight) div 2, SRCCOPY); 249 ImageOp_B(Back, Template, 0, 0, 0, 0, Template.Width, 64); 250 ImageOp_B(Back, Template, 0, 64, 0, 64 + Cut, Template.Width, 251 Template.Height - 64 - Cut); 252 253 bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 254 Back.Canvas.Handle, 0, 0, SRCCOPY); 255 256 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 257 RisedTextOut(offscreen.Canvas, 10, 7, Caption); 258 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 259 260 with MyRO.DevModel do 261 begin 262 DomainCount := 0; 263 for d := 0 to nDomains - 1 do 233 264 if DomainAvailable(d) then 265 inc(DomainCount); 266 if DomainCount > 1 then 267 begin 268 for d := 0 to nDomains - 1 do 269 if DomainAvailable(d) then 234 270 begin 235 x:=xDomain+d*DomainPitch; 236 if d=Domain then 237 ImageOp_BCC(Offscreen,Templates,x,yDomain,142,246+37*d,36,36,0,$00C0FF) 238 else ImageOp_BCC(Offscreen,Templates,x,yDomain,142,246+37*d,36,36,0,$606060); 271 x := xDomain + d * DomainPitch; 272 if d = Domain then 273 ImageOp_BCC(offscreen, Templates, x, yDomain, 142, 246 + 37 * d, 36, 274 36, 0, $00C0FF) 275 else 276 ImageOp_BCC(offscreen, Templates, x, yDomain, 142, 246 + 37 * d, 36, 277 36, 0, $606060); 239 278 end; 240 Frame(Offscreen.Canvas,xDomain-11,yDomain-3,xDomain+2*DomainPitch+46,241 yDomain+38,$B0B0B0,$FFFFFF);242 RFrame(Offscreen.Canvas,xDomain-12,yDomain-4,xDomain+2*DomainPitch+47,243 yDomain+39,$FFFFFF,$B0B0B0);244 end; 245 GroundArea.Top:=yDomain;246 GroundArea.Visible:=DomainAvailable(dGround);247 SeaArea.Top:=yDomain;248 SeaArea.Visible:=DomainAvailable(dSea);249 AirArea.Top:=yDomain;250 AirArea.Visible:=DomainAvailable(dAir);251 252 PaintTotalBars;253 254 // display weight255 with offscreen.Canvas do256 begin 257 for i:=0 to MaxWeight-1 do258 if i<Weight then259 ImageOp_BCC(Offscreen,Templates,xWeight+20*i,260 yWeight,123,400,18,20,0,$949494)261 else ImageOp_BCC(Offscreen,Templates,xWeight+20*i,262 yWeight,105,400,18,20,0,$949494);263 end;264 265 with offscreen.Canvas do for i:=0 to Lines-1 do 266 begin267 if not (code[i] in AutoFeature) then279 Frame(offscreen.Canvas, xDomain - 11, yDomain - 3, 280 xDomain + 2 * DomainPitch + 46, yDomain + 38, $B0B0B0, $FFFFFF); 281 RFrame(offscreen.Canvas, xDomain - 12, yDomain - 4, 282 xDomain + 2 * DomainPitch + 47, yDomain + 39, $FFFFFF, $B0B0B0); 283 end; 284 GroundArea.Top := yDomain; 285 GroundArea.Visible := DomainAvailable(dGround); 286 SeaArea.Top := yDomain; 287 SeaArea.Visible := DomainAvailable(dSea); 288 AirArea.Top := yDomain; 289 AirArea.Visible := DomainAvailable(dAir); 290 291 PaintTotalBars; 292 293 // display weight 294 with offscreen.Canvas do 295 begin 296 for i := 0 to MaxWeight - 1 do 297 if i < Weight then 298 ImageOp_BCC(offscreen, Templates, xWeight + 20 * i, yWeight, 123, 400, 299 18, 20, 0, $949494) 300 else 301 ImageOp_BCC(offscreen, Templates, xWeight + 20 * i, yWeight, 105, 400, 302 18, 20, 0, $949494); 303 end; 304 305 with offscreen.Canvas do 306 for i := 0 to Lines - 1 do 268 307 begin 269 // paint +/- butttons 270 if code[i]<mcFirstNonCap then 308 if not(code[i] in AutoFeature) then 271 309 begin 272 Dump(offscreen,HGrSystem,xFeature-21,yFeature+2+LinePitch*i, 273 12,12,169,172); 274 Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i, 275 12,12,169,159); 276 RFrame(offscreen.Canvas,xFeature-(21+1),yFeature+2+LinePitch*i-1, 277 xFeature-(21-24),yFeature+2+LinePitch*i+12, 278 MainTexture.clBevelShade,MainTexture.clBevelLight); 279 end 280 else 281 begin 282 Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i, 283 12,12,169,185+13*MyRO.DevModel.Cap[code[i]]); 284 RFrame(offscreen.Canvas,xFeature-(9+1),yFeature+2+LinePitch*i-1, 285 xFeature-(21-24),yFeature+2+LinePitch*i+12, 286 MainTexture.clBevelShade,MainTexture.clBevelLight); 287 end; 288 289 // paint cost 290 LightGradient(offscreen.Canvas,xFeature+34,yFeature+LinePitch*i,50, 291 GrExt[HGrSystem].Data.Canvas.Pixels[187,137]); 292 if (Domain=dGround) and (code[i]=mcDefense) then CapWeight:=2 293 else CapWeight:=Feature[code[i]].Weight; 294 n:=CapWeight+Feature[code[i]].Cost; 295 d:=6; 296 while (n-1)*d*2>48-10 do dec(d); 297 for j:=0 to n-1 do 298 if j<CapWeight then 299 Sprite(offscreen,HGrSystem,xFeature+54+(j*2+1-n)*d, 300 yFeature+2+LinePitch*i+1,10,10,88,126) 301 else Sprite(offscreen,HGrSystem,xFeature+54+(j*2+1-n)*d, 302 yFeature+2+LinePitch*i+1,10,10,88,115); 303 end; // if not (code[i] in AutoFeature) 304 DarkGradient(offscreen.Canvas,xFeature+17,yFeature+LinePitch*i,16,1); 305 Frame(offscreen.canvas,xFeature+18,yFeature+1+LinePitch*i, 306 xFeature+20-2+13,yFeature+2+1-2+13+LinePitch*i,$C0C0C0,$C0C0C0); 307 Sprite(offscreen,HGrSystem,xFeature+20,yFeature+2+1+LinePitch*i, 308 10,10,66+code[i] mod 11 *11,137+code[i] div 11 *11); 309 310 if MyRO.DevModel.Cap[code[i]]>0 then TextColor:=MainTexture.clLitText 311 else TextColor:=-1; 312 313 if code[i]<mcFirstNonCap then 314 LoweredTextOut(offscreen.Canvas,TextColor,MainTexture,xFeature+7, 315 yFeature+LinePitch*i-1,IntToStr(MyRO.DevModel.Cap[code[i]])); 316 LoweredTextOut(offscreen.Canvas,TextColor,MainTexture,xFeature+88, 317 yFeature+LinePitch*i-1,Phrases.Lookup('FEATURES',code[i])); 318 end; 319 end; 320 321 // free features 322 j:=0; 323 for i:=0 to nFeature-1 do 324 if (i in AutoFeature) 325 and (1 shl Domain and Feature[i].Domains<>0) and (Feature[i].Preq<>preNA) 326 and ((Feature[i].Preq=preSun) and (MyRO.Wonder[woSun].EffectiveOwner=me) 327 or (Feature[i].Preq>=0) and (MyRO.Tech[Feature[i].Preq]>=tsApplicable)) 328 and not ((Feature[i].Preq=adSteamEngine) 329 and (MyRO.Tech[adNuclearPower]>=tsApplicable)) then 330 begin 331 DarkGradient(offscreen.Canvas,xWeight+4,yWeight+32+LinePitch*j,16,1); 332 Frame(offscreen.canvas,xWeight+5,yWeight+33+LinePitch*j, 333 xWeight+18,yWeight+47+LinePitch*j,$C0C0C0,$C0C0C0); 334 Sprite(offscreen,HGrSystem,xWeight+7,yWeight+36+LinePitch*j, 335 10,10,66+i mod 11 *11,137+i div 11 *11); 336 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xWeight+26, 337 yWeight+31+LinePitch*j,Phrases.Lookup('FEATURES',i)); 338 inc(j); 339 end; 340 341 with Tribe[me].ModelPicture[MyRO.nModel] do 342 begin 343 FrameImage(offscreen.canvas,BigImp,xView+4,yView+4,xSizeBig,ySizeBig,0,0); 344 Sprite(offscreen,HGr,xView,yView,64,44,pix mod 10 *65+1,pix div 10*49+1); 345 end; 346 MarkUsedOffscreen(ClientWidth,ClientHeight); 347 end;{MainPaint} 310 // paint +/- butttons 311 if code[i] < mcFirstNonCap then 312 begin 313 Dump(offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch * 314 i, 12, 12, 169, 172); 315 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 316 i, 12, 12, 169, 159); 317 RFrame(offscreen.Canvas, xFeature - (21 + 1), 318 yFeature + 2 + LinePitch * i - 1, xFeature - (21 - 24), 319 yFeature + 2 + LinePitch * i + 12, MainTexture.clBevelShade, 320 MainTexture.clBevelLight); 321 end 322 else 323 begin 324 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 325 i, 12, 12, 169, 185 + 13 * MyRO.DevModel.Cap[code[i]]); 326 RFrame(offscreen.Canvas, xFeature - (9 + 1), 327 yFeature + 2 + LinePitch * i - 1, xFeature - (21 - 24), 328 yFeature + 2 + LinePitch * i + 12, MainTexture.clBevelShade, 329 MainTexture.clBevelLight); 330 end; 331 332 // paint cost 333 LightGradient(offscreen.Canvas, xFeature + 34, 334 yFeature + LinePitch * i, 50, GrExt[HGrSystem].Data.Canvas.Pixels 335 [187, 137]); 336 if (Domain = dGround) and (code[i] = mcDefense) then 337 CapWeight := 2 338 else 339 CapWeight := Feature[code[i]].Weight; 340 n := CapWeight + Feature[code[i]].Cost; 341 d := 6; 342 while (n - 1) * d * 2 > 48 - 10 do 343 dec(d); 344 for j := 0 to n - 1 do 345 if j < CapWeight then 346 Sprite(offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d, 347 yFeature + 2 + LinePitch * i + 1, 10, 10, 88, 126) 348 else 349 Sprite(offscreen, HGrSystem, xFeature + 54 + (j * 2 + 1 - n) * d, 350 yFeature + 2 + LinePitch * i + 1, 10, 10, 88, 115); 351 end; // if not (code[i] in AutoFeature) 352 DarkGradient(offscreen.Canvas, xFeature + 17, 353 yFeature + LinePitch * i, 16, 1); 354 Frame(offscreen.Canvas, xFeature + 18, yFeature + 1 + LinePitch * i, 355 xFeature + 20 - 2 + 13, yFeature + 2 + 1 - 2 + 13 + LinePitch * i, 356 $C0C0C0, $C0C0C0); 357 Sprite(offscreen, HGrSystem, xFeature + 20, yFeature + 2 + 1 + LinePitch 358 * i, 10, 10, 66 + code[i] mod 11 * 11, 137 + code[i] div 11 * 11); 359 360 if MyRO.DevModel.Cap[code[i]] > 0 then 361 TextColor := MainTexture.clLitText 362 else 363 TextColor := -1; 364 365 if code[i] < mcFirstNonCap then 366 LoweredTextOut(offscreen.Canvas, TextColor, MainTexture, xFeature + 7, 367 yFeature + LinePitch * i - 1, IntToStr(MyRO.DevModel.Cap[code[i]])); 368 LoweredTextOut(offscreen.Canvas, TextColor, MainTexture, xFeature + 88, 369 yFeature + LinePitch * i - 1, Phrases.Lookup('FEATURES', code[i])); 370 end; 371 end; 372 373 // free features 374 j := 0; 375 for i := 0 to nFeature - 1 do 376 if (i in AutoFeature) and (1 shl Domain and Feature[i].Domains <> 0) and 377 (Feature[i].Preq <> preNA) and 378 ((Feature[i].Preq = preSun) and (MyRO.Wonder[woSun].EffectiveOwner = me) 379 or (Feature[i].Preq >= 0) and (MyRO.Tech[Feature[i].Preq] >= tsApplicable) 380 ) and not((Feature[i].Preq = adSteamEngine) and 381 (MyRO.Tech[adNuclearPower] >= tsApplicable)) then 382 begin 383 DarkGradient(offscreen.Canvas, xWeight + 4, yWeight + 32 + LinePitch 384 * j, 16, 1); 385 Frame(offscreen.Canvas, xWeight + 5, yWeight + 33 + LinePitch * j, 386 xWeight + 18, yWeight + 47 + LinePitch * j, $C0C0C0, $C0C0C0); 387 Sprite(offscreen, HGrSystem, xWeight + 7, yWeight + 36 + LinePitch * j, 388 10, 10, 66 + i mod 11 * 11, 137 + i div 11 * 11); 389 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xWeight + 26, 390 yWeight + 31 + LinePitch * j, Phrases.Lookup('FEATURES', i)); 391 inc(j); 392 end; 393 394 with Tribe[me].ModelPicture[MyRO.nModel] do 395 begin 396 FrameImage(offscreen.Canvas, BigImp, xView + 4, yView + 4, xSizeBig, 397 ySizeBig, 0, 0); 398 Sprite(offscreen, HGr, xView, yView, 64, 44, pix mod 10 * 65 + 1, 399 pix div 10 * 49 + 1); 400 end; 401 MarkUsedOffscreen(ClientWidth, ClientHeight); 402 end; { MainPaint } 348 403 349 404 procedure TDraftDlg.SetDomain(d: integer); … … 351 406 function Prio(fix: integer): integer; 352 407 var 353 FeaturePreq: integer; 354 begin 355 FeaturePreq:=Feature[fix].Preq; 356 assert(FeaturePreq<>preNA); 357 if fix<mcFirstNonCap then result:=10000+fix 358 else if FeaturePreq=preNone then result:=20000 359 else if FeaturePreq<0 then result:=40000 360 else result:=30000+AdvValue[FeaturePreq]; 361 if not (fix in AutoFeature) then inc(result,90000); 408 FeaturePreq: integer; 409 begin 410 FeaturePreq := Feature[fix].Preq; 411 assert(FeaturePreq <> preNA); 412 if fix < mcFirstNonCap then 413 result := 10000 + fix 414 else if FeaturePreq = preNone then 415 result := 20000 416 else if FeaturePreq < 0 then 417 result := 40000 418 else 419 result := 30000 + AdvValue[FeaturePreq]; 420 if not(fix in AutoFeature) then 421 inc(result, 90000); 362 422 end; 363 423 364 424 var 365 i,j,x: integer; 366 begin 367 Domain:=d; 368 Lines:=0; 369 for i:=0 to nFeature-1 do 370 if IsFeatureInList(Domain,i) then 371 begin code[Lines]:=i; inc(Lines) end; 372 yFeature:=yFeature0+(MaxLines-Lines)*LinePitch div 2; 373 374 // sort features 375 for i:=0 to Lines-2 do for j:=i+1 to Lines-1 do 376 if Prio(code[i])>Prio(code[j]) then 377 begin // exchange 378 x:=code[i]; 379 code[i]:=code[j]; 380 code[j]:=x 381 end; 382 end; 383 384 function TDraftDlg.IsFeatureInList(d,i: integer): boolean; 385 begin 386 result:= not (i in AutoFeature) 387 and (1 shl d and Feature[i].Domains<>0) and (Feature[i].Preq<>preNA) 388 and ((Feature[i].Preq=preNone) 389 or (Feature[i].Preq=preSun) and (MyRO.Wonder[woSun].EffectiveOwner=me) 390 or (Feature[i].Preq>=0) and (MyRO.Tech[Feature[i].Preq]>=tsApplicable)); 425 i, j, x: integer; 426 begin 427 Domain := d; 428 Lines := 0; 429 for i := 0 to nFeature - 1 do 430 if IsFeatureInList(Domain, i) then 431 begin 432 code[Lines] := i; 433 inc(Lines) 434 end; 435 yFeature := yFeature0 + (MaxLines - Lines) * LinePitch div 2; 436 437 // sort features 438 for i := 0 to Lines - 2 do 439 for j := i + 1 to Lines - 1 do 440 if Prio(code[i]) > Prio(code[j]) then 441 begin // exchange 442 x := code[i]; 443 code[i] := code[j]; 444 code[j] := x 445 end; 446 end; 447 448 function TDraftDlg.IsFeatureInList(d, i: integer): boolean; 449 begin 450 result := not(i in AutoFeature) and (1 shl d and Feature[i].Domains <> 0) and 451 (Feature[i].Preq <> preNA) and 452 ((Feature[i].Preq = preNone) or (Feature[i].Preq = preSun) and 453 (MyRO.Wonder[woSun].EffectiveOwner = me) or (Feature[i].Preq >= 0) and 454 (MyRO.Tech[Feature[i].Preq] >= tsApplicable)); 391 455 end; 392 456 393 457 procedure TDraftDlg.FormShow(Sender: TObject); 394 458 var 395 count,d,i: integer; 396 begin 397 Domain:=dGround; 398 while (Domain<dAir) and (upgrade[Domain,0].Preq<>preNone) 399 and (MyRO.Tech[upgrade[Domain,0].Preq]<tsApplicable) do inc(Domain); 400 401 // count max number of features in any domain 402 MaxLines:=0; 403 for d:=0 to nDomains-1 do 404 if (upgrade[d,0].Preq=preNone) 405 or (MyRO.Tech[upgrade[d,0].Preq]>=tsApplicable) then 406 begin 407 count:=0; 408 for i:=0 to nFeature-1 do 409 if IsFeatureInList(d,i) then 410 inc(count); 411 if count>MaxLines then 412 MaxLines:=count; 413 end; 414 Cut:=(MaxLines0-MaxLines)*LinePitch; 415 OKBtn.Top:=477-Cut; 416 yDomain:=yDomain0-Cut; 417 yWeight:=yWeight0-Cut; 418 yTotal:=yTotal0-Cut; 419 yView:=yView0-Cut; 420 421 if WindowMode=wmModal then 422 begin {center on screen} 423 Left:=(Screen.Width-Template.Width) div 2; 424 Top:=(Screen.Height-(Template.Height-Cut)) div 2; 425 end; 426 427 SetDomain(Domain); 428 Server(sCreateDevModel,me,Domain,nil^); 429 MyModel[MyRO.nModel]:=MyRO.DevModel; 430 InitMyModel(MyRO.nModel,false); 431 OffscreenPaint; 432 IncCap:=-1; DecCap:=-1; 459 count, d, i: integer; 460 begin 461 Domain := dGround; 462 while (Domain < dAir) and (upgrade[Domain, 0].Preq <> preNone) and 463 (MyRO.Tech[upgrade[Domain, 0].Preq] < tsApplicable) do 464 inc(Domain); 465 466 // count max number of features in any domain 467 MaxLines := 0; 468 for d := 0 to nDomains - 1 do 469 if (upgrade[d, 0].Preq = preNone) or 470 (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable) then 471 begin 472 count := 0; 473 for i := 0 to nFeature - 1 do 474 if IsFeatureInList(d, i) then 475 inc(count); 476 if count > MaxLines then 477 MaxLines := count; 478 end; 479 Cut := (MaxLines0 - MaxLines) * LinePitch; 480 OKBtn.Top := 477 - Cut; 481 yDomain := yDomain0 - Cut; 482 yWeight := yWeight0 - Cut; 483 yTotal := yTotal0 - Cut; 484 yView := yView0 - Cut; 485 486 if WindowMode = wmModal then 487 begin { center on screen } 488 Left := (Screen.Width - Template.Width) div 2; 489 Top := (Screen.Height - (Template.Height - Cut)) div 2; 490 end; 491 492 SetDomain(Domain); 493 Server(sCreateDevModel, me, Domain, nil^); 494 MyModel[MyRO.nModel] := MyRO.DevModel; 495 InitMyModel(MyRO.nModel, false); 496 OffscreenPaint; 497 IncCap := -1; 498 DecCap := -1; 433 499 end; 434 500 435 501 procedure TDraftDlg.ShowNewContent(NewMode: integer); 436 502 begin 437 inherited ShowNewContent(NewMode);503 inherited ShowNewContent(NewMode); 438 504 end; 439 505 … … 441 507 Shift: TShiftState; x, y: integer); 442 508 var 443 i,d: integer; 444 begin 445 if Button=mbLeft then 446 begin 447 for d:=0 to nDomains-1 do 448 if (d<>Domain) and ((upgrade[d,0].Preq=preNone) 449 or (MyRO.Tech[upgrade[d,0].Preq]>=tsApplicable)) 450 and (x>=xDomain+d*DomainPitch) and (x<xDomain+d*DomainPitch+36) 451 and (y>=yDomain) and (y<yDomain+36) then 509 i, d: integer; 510 begin 511 if Button = mbLeft then 512 begin 513 for d := 0 to nDomains - 1 do 514 if (d <> Domain) and ((upgrade[d, 0].Preq = preNone) or 515 (MyRO.Tech[upgrade[d, 0].Preq] >= tsApplicable)) and 516 (x >= xDomain + d * DomainPitch) and 517 (x < xDomain + d * DomainPitch + 36) and (y >= yDomain) and 518 (y < yDomain + 36) then 452 519 begin 453 SetDomain(d);454 Server(sCreateDevModel,me,Domain,nil^);455 MyModel[MyRO.nModel]:=MyRO.DevModel;456 InitMyModel(MyRO.nModel,false);457 SmartUpdateContent;520 SetDomain(d); 521 Server(sCreateDevModel, me, Domain, nil^); 522 MyModel[MyRO.nModel] := MyRO.DevModel; 523 InitMyModel(MyRO.nModel, false); 524 SmartUpdateContent; 458 525 end; 459 526 460 if (y>=yFeature) and (y<yFeature+LinePitch*Lines) then461 begin 462 i:=(y-yFeature) div LinePitch;463 if (x>=xFeature-21) and (x<ClientWidth) and (ssShift in Shift) then464 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkFeature, code[i])465 else if not(code[i] in AutoFeature) then527 if (y >= yFeature) and (y < yFeature + LinePitch * Lines) then 528 begin 529 i := (y - yFeature) div LinePitch; 530 if (x >= xFeature - 21) and (x < ClientWidth) and (ssShift in Shift) then 531 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkFeature, code[i]) 532 else if not(code[i] in AutoFeature) then 466 533 begin 467 if (code[i]<mcFirstNonCap) and (x>=xFeature-21) and (x<xFeature-21+12) then 534 if (code[i] < mcFirstNonCap) and (x >= xFeature - 21) and 535 (x < xFeature - 21 + 12) then 468 536 begin 469 IncCap:=code[i]; 470 Dump(offscreen,HGrSystem,xFeature-21,yFeature+2+LinePitch*i,12,12,182,172); 471 SmartInvalidate; 537 IncCap := code[i]; 538 Dump(offscreen, HGrSystem, xFeature - 21, yFeature + 2 + LinePitch * 539 i, 12, 12, 182, 172); 540 SmartInvalidate; 472 541 end 473 else if (x>=xFeature-9) and (x<xFeature-9+12) then542 else if (x >= xFeature - 9) and (x < xFeature - 9 + 12) then 474 543 begin 475 DecCap:=code[i]; 476 if code[i]<mcFirstNonCap then 477 Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i,12,12,182,159) 478 else Dump(offscreen,HGrSystem,xFeature-9,yFeature+2+LinePitch*i, 479 12,12,182,185+13*MyRO.DevModel.Cap[code[i]]); 480 SmartInvalidate; 544 DecCap := code[i]; 545 if code[i] < mcFirstNonCap then 546 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 547 i, 12, 12, 182, 159) 548 else 549 Dump(offscreen, HGrSystem, xFeature - 9, yFeature + 2 + LinePitch * 550 i, 12, 12, 182, 185 + 13 * MyRO.DevModel.Cap[code[i]]); 551 SmartInvalidate; 481 552 end; 482 553 end … … 488 559 Shift: TShiftState; x, y: integer); 489 560 var 490 NewValue: integer;491 begin 492 if IncCap>=0 then493 begin 494 NewValue:=MyRO.DevModel.Cap[IncCap]+1;495 Server(sSetDevModelCap+NewValue shl 4,me,IncCap,nil^);496 MyModel[MyRO.nModel]:=MyRO.DevModel;497 InitMyModel(MyRO.nModel,false);498 SmartUpdateContent;499 IncCap:=-1;561 NewValue: integer; 562 begin 563 if IncCap >= 0 then 564 begin 565 NewValue := MyRO.DevModel.Cap[IncCap] + 1; 566 Server(sSetDevModelCap + NewValue shl 4, me, IncCap, nil^); 567 MyModel[MyRO.nModel] := MyRO.DevModel; 568 InitMyModel(MyRO.nModel, false); 569 SmartUpdateContent; 570 IncCap := -1; 500 571 end 501 else if DecCap>=0 then 502 begin 503 if (DecCap>=mcFirstNonCap) or (MyRO.DevModel.Cap[DecCap]>0) then 504 begin 505 NewValue:=MyRO.DevModel.Cap[DecCap]-1; 506 if DecCap>=mcFirstNonCap then NewValue:=-NewValue; 507 Server(sSetDevModelCap+NewValue shl 4,me,DecCap,nil^); 508 MyModel[MyRO.nModel]:=MyRO.DevModel; 509 InitMyModel(MyRO.nModel,false); 510 end; 511 SmartUpdateContent; 512 DecCap:=-1; 572 else if DecCap >= 0 then 573 begin 574 if (DecCap >= mcFirstNonCap) or (MyRO.DevModel.Cap[DecCap] > 0) then 575 begin 576 NewValue := MyRO.DevModel.Cap[DecCap] - 1; 577 if DecCap >= mcFirstNonCap then 578 NewValue := -NewValue; 579 Server(sSetDevModelCap + NewValue shl 4, me, DecCap, nil^); 580 MyModel[MyRO.nModel] := MyRO.DevModel; 581 InitMyModel(MyRO.nModel, false); 582 end; 583 SmartUpdateContent; 584 DecCap := -1; 513 585 end; 514 586 end; … … 516 588 procedure TDraftDlg.OKBtnClick(Sender: TObject); 517 589 begin 518 ModalResult:=mrOK;590 ModalResult := mrOK; 519 591 end; 520 592 521 593 end. 522 -
trunk/LocalPlayer/Enhance.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Enhance; 4 3 … … 6 5 7 6 uses 8 ScreenTools, BaseWin,Protocol,ClientTools,Term,7 ScreenTools, BaseWin, Protocol, ClientTools, Term, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 31 30 procedure TerrClick(Sender: TObject); 32 31 procedure JobClick(Sender: TObject); 33 procedure FormKeyDown(Sender: TObject; var Key: Word; 34 Shift: TShiftState); 32 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 35 33 public 36 34 procedure ShowNewContent(NewMode: integer; TerrType: integer = -1); … … 51 49 procedure TEnhanceDlg.FormCreate(Sender: TObject); 52 50 var 53 TerrType: integer; 54 m: TMenuItem; 55 begin 56 inherited; 57 CaptionRight:=CloseBtn.Left; 58 CaptionLeft:=ToggleBtn.Left+ToggleBtn.Width; 59 InitButtons(); 60 HelpContext:='MACRO'; 61 Caption:=Phrases.Lookup('TITLE_ENHANCE'); 62 ToggleBtn.Hint:=Phrases.Lookup('BTN_SELECT'); 63 64 for TerrType:=fGrass to fMountains do if TerrType<>fJungle then 51 TerrType: integer; 52 m: TMenuItem; 53 begin 54 inherited; 55 CaptionRight := CloseBtn.Left; 56 CaptionLeft := ToggleBtn.Left + ToggleBtn.Width; 57 InitButtons(); 58 HelpContext := 'MACRO'; 59 Caption := Phrases.Lookup('TITLE_ENHANCE'); 60 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT'); 61 62 for TerrType := fGrass to fMountains do 63 if TerrType <> fJungle then 64 begin 65 m := TMenuItem.Create(Popup); 66 m.RadioItem := true; 67 if TerrType = fGrass then 68 m.Caption := Format(Phrases.Lookup('TWOTERRAINS'), 69 [Phrases.Lookup('TERRAIN', fGrass), Phrases.Lookup('TERRAIN', 70 fGrass + 12)]) 71 else if TerrType = fForest then 72 m.Caption := Format(Phrases.Lookup('TWOTERRAINS'), 73 [Phrases.Lookup('TERRAIN', fForest), Phrases.Lookup('TERRAIN', 74 fJungle)]) 75 else 76 m.Caption := Phrases.Lookup('TERRAIN', TerrType); 77 m.Tag := TerrType; 78 m.OnClick := TerrClick; 79 Popup.Items.Add(m); 80 end; 81 end; 82 83 procedure TEnhanceDlg.FormPaint(Sender: TObject); 84 var 85 i: integer; 86 begin 87 inherited; 88 BtnFrame(Canvas, Rect(job1.Left, job1.Top, job7.Left + job7.Width, 89 job1.Top + job1.Height), MainTexture); 90 BtnFrame(Canvas, Rect(job3.Left, job3.Top, job9.Left + job9.Width, 91 job3.Top + job3.Height), MainTexture); 92 for i := 0 to ControlCount - 1 do 93 if Controls[i] is TButtonC then 94 BitBlt(Canvas.Handle, Controls[i].Left + 2, Controls[i].Top - 11, 8, 8, 95 GrExt[HGrSystem].Data.Canvas.Handle, 121 + Controls[i].Tag mod 7 * 9, 96 1 + Controls[i].Tag div 7 * 9, SRCCOPY); 97 end; 98 99 procedure TEnhanceDlg.FormShow(Sender: TObject); 100 begin 101 OffscreenPaint; 102 end; 103 104 procedure TEnhanceDlg.ShowNewContent(NewMode, TerrType: integer); 105 begin 106 if (TerrType < fGrass) or (TerrType > fMountains) then 107 Page := fGrass 108 else 109 Page := TerrType; 110 inherited ShowNewContent(NewMode); 111 end; 112 113 procedure TEnhanceDlg.OffscreenPaint; 114 var 115 i, stage, TerrType, TileImp, x, EndStage, Cost, LastJob: integer; 116 s: string; 117 Done: Set of jNone .. jTrans; 118 TypeChanged: boolean; 119 begin 120 OffscreenUser := self; 121 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 122 FillOffscreen(0, 0, InnerWidth, InnerHeight); 123 124 EndStage := 0; 125 while (EndStage < 5) and (MyData.EnhancementJobs[Page, EndStage] <> jNone) do 126 inc(EndStage); 127 x := InnerWidth div 2 - xxt - (xxt + 3) * EndStage; 128 129 TerrType := Page; 130 TileImp := 0; 131 Done := []; 132 Cost := 0; 133 for stage := 0 to EndStage do 65 134 begin 66 m:=TMenuItem.Create(Popup); 67 m.RadioItem:=true; 68 if TerrType=fGrass then 69 m.Caption:=Format(Phrases.Lookup('TWOTERRAINS'), 70 [Phrases.Lookup('TERRAIN',fGrass), Phrases.Lookup('TERRAIN',fGrass+12)]) 71 else if TerrType=fForest then 72 m.Caption:=Format(Phrases.Lookup('TWOTERRAINS'), 73 [Phrases.Lookup('TERRAIN',fForest), Phrases.Lookup('TERRAIN',fJungle)]) 74 else m.Caption:=Phrases.Lookup('TERRAIN',TerrType); 75 m.Tag:=TerrType; 76 m.OnClick:=TerrClick; 77 Popup.Items.Add(m); 78 end; 79 end; 80 81 procedure TEnhanceDlg.FormPaint(Sender: TObject); 82 var 83 i: integer; 84 begin 85 inherited; 86 BtnFrame(Canvas,Rect(job1.Left,job1.Top,job7.Left+job7.Width,job1.Top+job1.Height),MainTexture); 87 BtnFrame(Canvas,Rect(job3.Left,job3.Top,job9.Left+job9.Width,job3.Top+job3.Height),MainTexture); 88 for i:=0 to ControlCount-1 do if Controls[i] is TButtonC then 89 BitBlt(Canvas.Handle,Controls[i].Left+2,Controls[i].Top-11,8,8, 90 GrExt[HGrSystem].Data.Canvas.Handle,121+Controls[i].Tag mod 7 *9, 91 1+Controls[i].Tag div 7 *9,SRCCOPY); 92 end; 93 94 procedure TEnhanceDlg.FormShow(Sender: TObject); 95 begin 96 OffscreenPaint; 97 end; 98 99 procedure TEnhanceDlg.ShowNewContent(NewMode,TerrType: integer); 100 begin 101 if (TerrType<fGrass) or (TerrType>fMountains) then Page:=fGrass 102 else Page:=TerrType; 103 inherited ShowNewContent(NewMode); 104 end; 105 106 procedure TEnhanceDlg.OffscreenPaint; 107 var 108 i,stage,TerrType,TileImp,x,EndStage,Cost,LastJob: integer; 109 s: string; 110 Done: Set of jNone..jTrans; 111 TypeChanged: boolean; 112 begin 113 OffscreenUser:=self; 114 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 115 FillOffscreen(0,0,InnerWidth,InnerHeight); 116 117 EndStage:=0; 118 while (EndStage<5) and (MyData.EnhancementJobs[Page,EndStage]<>jNone) do 119 inc(EndStage); 120 x:=InnerWidth div 2-xxt-(xxt+3)*EndStage; 121 122 TerrType:=Page; 123 TileImp:=0; 124 Done:=[]; 125 Cost:=0; 126 for stage:=0 to EndStage do 127 begin 128 if stage>0 then 129 begin 130 Sprite(offscreen,HGrSystem,x-10,66,14,14,80,1); 131 case MyData.EnhancementJobs[Page,stage-1] of 132 jRoad: 133 begin 134 inc(Cost,Terrain[TerrType].MoveCost*RoadWork); 135 TileImp:=TileImp or fRoad; 136 end; 137 jRR: 138 begin 139 inc(Cost,Terrain[TerrType].MoveCost*RRWork); 140 TileImp:=TileImp or fRR; 141 end; 142 jIrr: 143 begin 144 inc(Cost,Terrain[TerrType].IrrClearWork); 145 TileImp:=TileImp and not fTerImp or tiIrrigation; 146 end; 147 jFarm: 148 begin 149 inc(Cost,Terrain[TerrType].IrrClearWork*FarmWork); 150 TileImp:=TileImp and not fTerImp or tiFarm; 151 end; 152 jMine: 153 begin 154 inc(Cost,Terrain[TerrType].MineAfforestWork); 155 TileImp:=TileImp and not fTerImp or tiMine; 156 end; 157 jClear: 158 begin 159 inc(Cost,Terrain[TerrType].IrrClearWork); 160 TerrType:=Terrain[TerrType].ClearTerrain; 161 end; 162 jAfforest: 163 begin 164 inc(Cost,Terrain[TerrType].MineAfforestWork); 165 TerrType:=Terrain[TerrType].AfforestTerrain; 166 end; 167 jTrans: 168 begin 169 inc(Cost,Terrain[TerrType].TransWork); 170 TerrType:=Terrain[TerrType].TransTerrain; 171 end; 135 if stage > 0 then 136 begin 137 Sprite(offscreen, HGrSystem, x - 10, 66, 14, 14, 80, 1); 138 case MyData.EnhancementJobs[Page, stage - 1] of 139 jRoad: 140 begin 141 inc(Cost, Terrain[TerrType].MoveCost * RoadWork); 142 TileImp := TileImp or fRoad; 143 end; 144 jRR: 145 begin 146 inc(Cost, Terrain[TerrType].MoveCost * RRWork); 147 TileImp := TileImp or fRR; 148 end; 149 jIrr: 150 begin 151 inc(Cost, Terrain[TerrType].IrrClearWork); 152 TileImp := TileImp and not fTerImp or tiIrrigation; 153 end; 154 jFarm: 155 begin 156 inc(Cost, Terrain[TerrType].IrrClearWork * FarmWork); 157 TileImp := TileImp and not fTerImp or tiFarm; 158 end; 159 jMine: 160 begin 161 inc(Cost, Terrain[TerrType].MineAfforestWork); 162 TileImp := TileImp and not fTerImp or tiMine; 163 end; 164 jClear: 165 begin 166 inc(Cost, Terrain[TerrType].IrrClearWork); 167 TerrType := Terrain[TerrType].ClearTerrain; 168 end; 169 jAfforest: 170 begin 171 inc(Cost, Terrain[TerrType].MineAfforestWork); 172 TerrType := Terrain[TerrType].AfforestTerrain; 173 end; 174 jTrans: 175 begin 176 inc(Cost, Terrain[TerrType].TransWork); 177 TerrType := Terrain[TerrType].TransTerrain; 178 end; 172 179 end; 173 include(Done,MyData.EnhancementJobs[Page,stage-1]); 174 end; 175 176 if TerrType<fForest then 177 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+TerrType*(xxt*2+1),1+yyt) 178 else 179 begin 180 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+2*(xxt*2+1),1+yyt+2*(yyt*3+1)); 181 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+7*(xxt*2+1),1+yyt+2*(2+TerrType-fForest)*(yyt*3+1)); 182 end; 183 if TileImp and fTerImp=tiFarm then 184 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+(xxt*2+1),1+yyt+12*(yyt*3+1)) 185 else if TileImp and fTerImp=tiIrrigation then 186 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1,1+yyt+12*(yyt*3+1)); 187 if TileImp and fRR<>0 then 188 begin 189 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+6*(xxt*2+1),1+yyt+10*(yyt*3+1)); 190 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+2*(xxt*2+1),1+yyt+10*(yyt*3+1)); 180 include(Done, MyData.EnhancementJobs[Page, stage - 1]); 181 end; 182 183 if TerrType < fForest then 184 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 185 1 + TerrType * (xxt * 2 + 1), 1 + yyt) 186 else 187 begin 188 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 189 1 + 2 * (xxt * 2 + 1), 1 + yyt + 2 * (yyt * 3 + 1)); 190 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 191 1 + 7 * (xxt * 2 + 1), 1 + yyt + 2 * (2 + TerrType - fForest) * 192 (yyt * 3 + 1)); 193 end; 194 if TileImp and fTerImp = tiFarm then 195 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 196 1 + (xxt * 2 + 1), 1 + yyt + 12 * (yyt * 3 + 1)) 197 else if TileImp and fTerImp = tiIrrigation then 198 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 1, 199 1 + yyt + 12 * (yyt * 3 + 1)); 200 if TileImp and fRR <> 0 then 201 begin 202 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 203 1 + 6 * (xxt * 2 + 1), 1 + yyt + 10 * (yyt * 3 + 1)); 204 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 205 1 + 2 * (xxt * 2 + 1), 1 + yyt + 10 * (yyt * 3 + 1)); 191 206 end 192 else if TileImp and fRoad<>0 then 193 begin 194 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+6*(xxt*2+1),1+yyt+9*(yyt*3+1)); 195 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+2*(xxt*2+1),1+yyt+9*(yyt*3+1)); 196 end; 197 if TileImp and fTerImp=tiMine then 198 Sprite(offscreen,HGrTerrain,x,64-yyt,xxt*2,yyt*2,1+2*(xxt*2+1),1+yyt+12*(yyt*3+1)); 199 inc(x,xxt*2+6) 200 end; 201 202 for i:=0 to Popup.Items.Count-1 do 203 if Popup.Items[i].Tag=Page then 204 s:=Popup.Items[i].Caption; 205 if Cost>0 then s:=Format(Phrases.Lookup('ENHANCE'),[s,MovementToString(Cost)]); 206 LoweredTextOut(offscreen.Canvas,-1,MainTexture, 207 (InnerWidth-BiColorTextWidth(Offscreen.Canvas,s)) div 2,12,s); 208 209 if EndStage>0 then LastJob:=MyData.EnhancementJobs[Page,EndStage-1] 210 else LastJob:=jNone; 211 if jRoad in Done then job1.ButtonIndex:=3 else job1.ButtonIndex:=2; 212 if jRR in Done then job2.ButtonIndex:=3 else job2.ButtonIndex:=2; 213 if jIrr in Done then job4.ButtonIndex:=3 else job4.ButtonIndex:=2; 214 if jFarm in Done then job5.ButtonIndex:=3 else job5.ButtonIndex:=2; 215 if jMine in Done then job7.ButtonIndex:=3 else job7.ButtonIndex:=2; 216 if LastJob=jClear then job3.ButtonIndex:=3 else job3.ButtonIndex:=2; 217 if LastJob=jAfforest then job6.ButtonIndex:=3 else job6.ButtonIndex:=2; 218 if LastJob=jTrans then job9.ButtonIndex:=3 else job9.ButtonIndex:=2; 219 220 TypeChanged:= LastJob in [jClear, jAfforest, jTrans]; 221 job1.Visible:=(jRoad in Done) or not TypeChanged; 222 job2.Visible:=(jRR in Done) or not TypeChanged; 223 job4.Visible:=(jIrr in Done) or not TypeChanged and (Terrain[TerrType].IrrEff>0); 224 job5.Visible:=(jFarm in Done) or not TypeChanged and (Terrain[TerrType].IrrEff>0); 225 job7.Visible:=(jMine in Done) or not TypeChanged and (Terrain[TerrType].MineEff>0); 226 job3.Visible:=not TypeChanged and (Terrain[TerrType].ClearTerrain>=0) 227 and ((TerrType<>fDesert) or (MyRO.Wonder[woGardens].EffectiveOwner=me)) 228 or (LastJob=jClear); 229 job6.Visible:=not TypeChanged and (Terrain[TerrType].AfforestTerrain>=0) 230 or (LastJob=jAfforest); 231 job9.Visible:=not TypeChanged and (Terrain[TerrType].TransTerrain>=0) 232 or (LastJob=jTrans); 233 234 MarkUsedOffscreen(InnerWidth,InnerHeight); 235 end; {OffscreenPaint} 207 else if TileImp and fRoad <> 0 then 208 begin 209 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 210 1 + 6 * (xxt * 2 + 1), 1 + yyt + 9 * (yyt * 3 + 1)); 211 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 212 1 + 2 * (xxt * 2 + 1), 1 + yyt + 9 * (yyt * 3 + 1)); 213 end; 214 if TileImp and fTerImp = tiMine then 215 Sprite(offscreen, HGrTerrain, x, 64 - yyt, xxt * 2, yyt * 2, 216 1 + 2 * (xxt * 2 + 1), 1 + yyt + 12 * (yyt * 3 + 1)); 217 inc(x, xxt * 2 + 6) 218 end; 219 220 for i := 0 to Popup.Items.Count - 1 do 221 if Popup.Items[i].Tag = Page then 222 s := Popup.Items[i].Caption; 223 if Cost > 0 then 224 s := Format(Phrases.Lookup('ENHANCE'), [s, MovementToString(Cost)]); 225 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 226 (InnerWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2, 12, s); 227 228 if EndStage > 0 then 229 LastJob := MyData.EnhancementJobs[Page, EndStage - 1] 230 else 231 LastJob := jNone; 232 if jRoad in Done then 233 job1.ButtonIndex := 3 234 else 235 job1.ButtonIndex := 2; 236 if jRR in Done then 237 job2.ButtonIndex := 3 238 else 239 job2.ButtonIndex := 2; 240 if jIrr in Done then 241 job4.ButtonIndex := 3 242 else 243 job4.ButtonIndex := 2; 244 if jFarm in Done then 245 job5.ButtonIndex := 3 246 else 247 job5.ButtonIndex := 2; 248 if jMine in Done then 249 job7.ButtonIndex := 3 250 else 251 job7.ButtonIndex := 2; 252 if LastJob = jClear then 253 job3.ButtonIndex := 3 254 else 255 job3.ButtonIndex := 2; 256 if LastJob = jAfforest then 257 job6.ButtonIndex := 3 258 else 259 job6.ButtonIndex := 2; 260 if LastJob = jTrans then 261 job9.ButtonIndex := 3 262 else 263 job9.ButtonIndex := 2; 264 265 TypeChanged := LastJob in [jClear, jAfforest, jTrans]; 266 job1.Visible := (jRoad in Done) or not TypeChanged; 267 job2.Visible := (jRR in Done) or not TypeChanged; 268 job4.Visible := (jIrr in Done) or not TypeChanged and 269 (Terrain[TerrType].IrrEff > 0); 270 job5.Visible := (jFarm in Done) or not TypeChanged and 271 (Terrain[TerrType].IrrEff > 0); 272 job7.Visible := (jMine in Done) or not TypeChanged and 273 (Terrain[TerrType].MineEff > 0); 274 job3.Visible := not TypeChanged and (Terrain[TerrType].ClearTerrain >= 0) and 275 ((TerrType <> fDesert) or (MyRO.Wonder[woGardens].EffectiveOwner = me)) or 276 (LastJob = jClear); 277 job6.Visible := not TypeChanged and (Terrain[TerrType].AfforestTerrain >= 0) 278 or (LastJob = jAfforest); 279 job9.Visible := not TypeChanged and (Terrain[TerrType].TransTerrain >= 0) or 280 (LastJob = jTrans); 281 282 MarkUsedOffscreen(InnerWidth, InnerHeight); 283 end; { OffscreenPaint } 236 284 237 285 procedure TEnhanceDlg.CloseBtnClick(Sender: TObject); 238 286 begin 239 Close287 Close 240 288 end; 241 289 242 290 procedure TEnhanceDlg.ToggleBtnClick(Sender: TObject); 243 291 var 244 i: integer;245 begin 246 for i:=0 to Popup.Items.Count-1 do247 Popup.Items[i].Checked:= Popup.Items[i].Tag=Page;248 Popup.Popup(Left+ToggleBtn.Left, Top+ToggleBtn.Top+ToggleBtn.Height);292 i: integer; 293 begin 294 for i := 0 to Popup.Items.Count - 1 do 295 Popup.Items[i].Checked := Popup.Items[i].Tag = Page; 296 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height); 249 297 end; 250 298 251 299 procedure TEnhanceDlg.TerrClick(Sender: TObject); 252 300 begin 253 Page:=TComponent(Sender).Tag;254 SmartUpdateContent301 Page := TComponent(Sender).Tag; 302 SmartUpdateContent 255 303 end; 256 304 257 305 procedure TEnhanceDlg.JobClick(Sender: TObject); 258 306 var 259 stage, NewJob: integer;260 Done: Set of jNone..jTrans;307 stage, NewJob: integer; 308 Done: Set of jNone .. jTrans; 261 309 262 310 procedure RemoveJob(j: integer); 263 311 begin // remove job 264 stage:=0;265 while (stage<5) and (MyData.EnhancementJobs[Page,stage]<>jNone) do266 begin 267 if (MyData.EnhancementJobs[Page,stage]=j) or (j=jRoad)268 and (MyData.EnhancementJobs[Page,stage]=jRR)269 or (j=jIrr) and (MyData.EnhancementJobs[Page,stage]=jFarm) then312 stage := 0; 313 while (stage < 5) and (MyData.EnhancementJobs[Page, stage] <> jNone) do 314 begin 315 if (MyData.EnhancementJobs[Page, stage] = j) or (j = jRoad) and 316 (MyData.EnhancementJobs[Page, stage] = jRR) or (j = jIrr) and 317 (MyData.EnhancementJobs[Page, stage] = jFarm) then 270 318 begin 271 if stage<4 then272 move(MyData.EnhancementJobs[Page,stage+1],273 MyData.EnhancementJobs[Page,stage],4-stage);274 MyData.EnhancementJobs[Page,4]:=jNone319 if stage < 4 then 320 move(MyData.EnhancementJobs[Page, stage + 1], 321 MyData.EnhancementJobs[Page, stage], 4 - stage); 322 MyData.EnhancementJobs[Page, 4] := jNone 275 323 end 276 else inc(stage); 277 end; 278 end; 279 280 begin 281 NewJob:=TButtonC(Sender).Tag; 282 Done:=[]; 283 stage:=0; 284 while (stage<5) and (MyData.EnhancementJobs[Page,stage]<>jNone) do 324 else 325 inc(stage); 326 end; 327 end; 328 329 begin 330 NewJob := TButtonC(Sender).Tag; 331 Done := []; 332 stage := 0; 333 while (stage < 5) and (MyData.EnhancementJobs[Page, stage] <> jNone) do 285 334 begin 286 include(Done, MyData.EnhancementJobs[Page,stage]); 287 inc(stage); 288 end; 289 if NewJob in Done then RemoveJob(NewJob) 290 else 335 include(Done, MyData.EnhancementJobs[Page, stage]); 336 inc(stage); 337 end; 338 if NewJob in Done then 339 RemoveJob(NewJob) 340 else 291 341 begin // add job 292 if NewJob in [jMine,jAfforest] then RemoveJob(jIrr); 293 if NewJob in [jIrr,jFarm,jTrans] then RemoveJob(jMine); 294 if (NewJob=jRR) and not (jRoad in Done) then 295 begin MyData.EnhancementJobs[Page,stage]:=jRoad; inc(stage) end; 296 if (NewJob=jFarm) and not (jIrr in Done) then 297 begin MyData.EnhancementJobs[Page,stage]:=jIrr; inc(stage) end; 298 MyData.EnhancementJobs[Page,stage]:=NewJob 299 end; 300 SmartUpdateContent 342 if NewJob in [jMine, jAfforest] then 343 RemoveJob(jIrr); 344 if NewJob in [jIrr, jFarm, jTrans] then 345 RemoveJob(jMine); 346 if (NewJob = jRR) and not(jRoad in Done) then 347 begin 348 MyData.EnhancementJobs[Page, stage] := jRoad; 349 inc(stage) 350 end; 351 if (NewJob = jFarm) and not(jIrr in Done) then 352 begin 353 MyData.EnhancementJobs[Page, stage] := jIrr; 354 inc(stage) 355 end; 356 MyData.EnhancementJobs[Page, stage] := NewJob 357 end; 358 SmartUpdateContent 301 359 end; 302 360 … … 304 362 Shift: TShiftState); 305 363 begin 306 if Key=VK_ESCAPE then Close 307 else if Key=VK_F1 then 308 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, HelpDlg.TextIndex('MACRO')) 364 if Key = VK_ESCAPE then 365 Close 366 else if Key = VK_F1 then 367 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, 368 HelpDlg.TextIndex('MACRO')) 309 369 end; 310 370 311 371 end. 312 -
trunk/LocalPlayer/Help.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Help; 4 3 … … 6 5 7 6 uses 8 Protocol, ScreenTools,BaseWin,StringTables,7 Protocol, ScreenTools, BaseWin, StringTables, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 12 11 13 12 const 14 MaxHist=16; 15 16 {link categories} 17 hkNoLink=0;hkAdv=1;hkImp=2;hkTer=3;hkFeature=4;hkInternet=5;hkModel=6;hkMisc=7; 18 hkCrossLink=$40; 19 hkText=$80; 20 21 liInvalid=$3FFF; // link index indicates invalid link 22 23 {link indices for category hkMisc} 24 miscMain=0; miscCredits=1; miscGovList=2; miscJobList=3; miscSearchResult=7; 25 26 fJungle=8; // pseudo terrain 27 13 MaxHist = 16; 14 15 { link categories } 16 hkNoLink = 0; 17 hkAdv = 1; 18 hkImp = 2; 19 hkTer = 3; 20 hkFeature = 4; 21 hkInternet = 5; 22 hkModel = 6; 23 hkMisc = 7; 24 hkCrossLink = $40; 25 hkText = $80; 26 27 liInvalid = $3FFF; // link index indicates invalid link 28 29 { link indices for category hkMisc } 30 miscMain = 0; 31 miscCredits = 1; 32 miscGovList = 2; 33 miscJobList = 3; 34 miscSearchResult = 7; 35 36 fJungle = 8; // pseudo terrain 28 37 29 38 type 30 THyperText =class(TStringList)31 procedure AddLine(s: String = ''; Format: integer =0; Picpix: integer =0;32 LinkCategory: integer = 0; LinkIndex: integer =0);39 THyperText = class(TStringList) 40 procedure AddLine(s: String = ''; Format: integer = 0; Picpix: integer = 0; 41 LinkCategory: integer = 0; LinkIndex: integer = 0); 33 42 procedure LF; 34 43 end; 35 44 36 45 THelpDlg = class(TFramedDlg) … … 39 48 TopBtn: TButtonB; 40 49 SearchBtn: TButtonB; 41 procedure FormCreate(Sender: TObject);42 procedure FormDestroy(Sender: TObject);43 procedure FormPaint(Sender: TObject);44 procedure CloseBtnClick(Sender: TObject);45 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; x,46 y: integer);50 procedure FormCreate(Sender: TObject); 51 procedure FormDestroy(Sender: TObject); 52 procedure FormPaint(Sender: TObject); 53 procedure CloseBtnClick(Sender: TObject); 54 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; 55 x, y: integer); 47 56 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 48 57 Shift: TShiftState; x, y: integer); … … 50 59 procedure TopBtnClick(Sender: TObject); 51 60 procedure FormClose(Sender: TObject; var Action: TCloseAction); 52 procedure FormKeyDown(Sender: TObject; var Key: Word; 53 Shift: TShiftState); 61 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 54 62 procedure SearchBtnClick(Sender: TObject); 55 63 public 56 64 Difficulty: integer; 57 procedure ShowNewContent(NewMode, Category,Index: integer);65 procedure ShowNewContent(NewMode, Category, Index: integer); 58 66 procedure ClearHistory; 59 67 function TextIndex(Item: string): integer; … … 61 69 procedure OffscreenPaint; override; 62 70 private 63 Kind,no,Sel,nHist,CaptionColor: integer; 64 hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, hJOBHELP: integer; 71 Kind, no, Sel, nHist, CaptionColor: integer; 72 hADVHELP, hIMPHELP, hFEATUREHELP, hGOVHELP, hSPECIALMODEL, 73 hJOBHELP: integer; 65 74 SearchContent, NewSearchContent: string; 66 75 CaptionFont: TFont; 67 76 MainText, SearchResult: THyperText; 68 77 HelpText: TStringTable; 69 ExtPic, TerrIcon: TBitmap;70 sb: TPVScrollbar;71 x0: array [-2..18] of integer;72 HistKind: array [0..MaxHist-1] of integer;73 HistNo: array [0..MaxHist-1] of integer;74 HistPos: array [0..MaxHist-1] of integer;75 HistSearchContent: array [0..MaxHist-1] of shortstring;78 ExtPic, TerrIcon: TBitmap; 79 sb: TPVScrollbar; 80 x0: array [-2 .. 18] of integer; 81 HistKind: array [0 .. MaxHist - 1] of integer; 82 HistNo: array [0 .. MaxHist - 1] of integer; 83 HistPos: array [0 .. MaxHist - 1] of integer; 84 HistSearchContent: array [0 .. MaxHist - 1] of shortstring; 76 85 procedure line(ca: TCanvas; i: integer; lit: boolean); 77 86 procedure Prepare(sbPos: integer = 0); 78 procedure WaterSign(x0, y0,iix: integer);87 procedure WaterSign(x0, y0, iix: integer); 79 88 procedure Search(SearchString: string); 80 procedure OnScroll(var m: TMessage); message WM_VSCROLL;81 procedure OnMouseWheel(var m: TMessage); message WM_MOUSEWHEEL;82 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;89 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 90 procedure OnMouseWheel(var m: TMessage); message WM_MOUSEWHEEL; 91 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE; 83 92 end; 84 93 … … 89 98 90 99 uses 91 Directories,ClientTools,Term,Tribes,ShellAPI, Inp,Messg;100 Directories, ClientTools, Term, Tribes, ShellAPI, Inp, Messg; 92 101 93 102 {$R *.DFM} 94 103 95 104 type 96 THelpLineInfo=packed record97 Format, Picpix: Byte;98 Link: Word;105 THelpLineInfo = packed record 106 Format, Picpix: Byte; 107 Link: Word; 99 108 end; 100 109 … … 102 111 LinkCategory: integer; LinkIndex: integer); 103 112 var 104 HelpLineInfo: THelpLineInfo;113 HelpLineInfo: THelpLineInfo; 105 114 begin 106 if LinkIndex<0 then LinkIndex:=liInvalid; 107 HelpLineInfo.Format:=Format; 108 HelpLineInfo.Picpix:=Picpix; 109 HelpLineInfo.Link:=LinkCategory shl 8+LinkIndex; 110 AddObject(s,TObject(HelpLineInfo)); 115 if LinkIndex < 0 then 116 LinkIndex := liInvalid; 117 HelpLineInfo.Format := Format; 118 HelpLineInfo.Picpix := Picpix; 119 HelpLineInfo.Link := LinkCategory shl 8 + LinkIndex; 120 AddObject(s, TObject(HelpLineInfo)); 111 121 end; 112 122 113 123 procedure THyperText.LF; 114 124 begin 115 AddLine;125 AddLine; 116 126 end; 117 127 118 119 128 const 120 {text formats} 121 pkNormal=0;pkCaption=1;pkSmallIcon=2;pkBigIcon=3;pkAdvIcon=4;pkTer=5; 122 pkBigTer=6;pkFeature=7;pkDot=8;pkNormal_Dot=9;pkDomain=10;pkSection=11; 123 pkBigFeature=12;pkExp=13;pkAITStat=14;pkExternal=15;pkModel=16;pkNormal_64=17; 124 pkIllu=18;pkLogo=19;pkTerImp=20;pkRightIcon=21;pkAdvIcon_AsPreq=22; 125 pkSmallIcon_AsPreq=23;pkSpecialIcon=24;pkGov=25; 126 127 nSeeAlso=14; 128 SeeAlso: array[0..nSeeAlso-1] of record Kind,no,SeeKind,SeeNo: integer end= 129 ((Kind:hkImp;no:imWalls;SeeKind:hkFeature;SeeNo:mcArtillery), 130 (Kind:hkImp;no:imHydro;SeeKind:hkImp;SeeNo:woHoover), 131 (Kind:hkImp;no:imWalls;SeeKind:hkImp;SeeNo:imGrWall), 132 (Kind:hkImp;no:imHighways;SeeKind:hkAdv;SeeNo:adWheel), 133 (Kind:hkImp;no:imCathedral;SeeKind:hkImp;SeeNo:woBach), 134 (Kind:hkImp;no:imBank;SeeKind:hkImp;SeeNo:imStockEx), 135 (Kind:hkImp;no:imShipComp;SeeKind:hkImp;SeeNo:imSpacePort), 136 (Kind:hkImp;no:imShipPow;SeeKind:hkImp;SeeNo:imSpacePort), 137 (Kind:hkImp;no:imShipHab;SeeKind:hkImp;SeeNo:imSpacePort), 138 (Kind:hkFeature;no:mcSub;SeeKind:hkFeature;SeeNo:mcRadar), 139 (Kind:hkFeature;no:mcDefense;SeeKind:hkAdv;SeeNo:adSteel), 140 (Kind:hkFeature;no:mcSE;SeeKind:hkFeature;SeeNo:mcNP), 141 (Kind:hkAdv;no:adWheel;SeeKind:hkImp;SeeNo:imHighways), 142 (Kind:hkAdv;no:adSteel;SeeKind:hkFeature;SeeNo:mcDefense)); 143 144 nTerrainHelp=14; 145 TerrainHelp: array[0..nTerrainHelp-1] of integer= 146 (fGrass,fGrass+12,fPrairie,fForest,fJungle,fHills,fMountains,fSwamp,fTundra,fArctic, 147 fDesert,3*12{DeadLands},fShore,fOcean); 148 149 nJobHelp=8; 150 JobHelp: array[0..nJobHelp-1] of integer= 151 (jRoad,jRR,jCanal,jIrr,jFarm,jMine,jFort,jBase); 152 153 154 procedure THelpDlg.FormCreate(Sender:TObject); 129 { text formats } 130 pkNormal = 0; 131 pkCaption = 1; 132 pkSmallIcon = 2; 133 pkBigIcon = 3; 134 pkAdvIcon = 4; 135 pkTer = 5; 136 pkBigTer = 6; 137 pkFeature = 7; 138 pkDot = 8; 139 pkNormal_Dot = 9; 140 pkDomain = 10; 141 pkSection = 11; 142 pkBigFeature = 12; 143 pkExp = 13; 144 pkAITStat = 14; 145 pkExternal = 15; 146 pkModel = 16; 147 pkNormal_64 = 17; 148 pkIllu = 18; 149 pkLogo = 19; 150 pkTerImp = 20; 151 pkRightIcon = 21; 152 pkAdvIcon_AsPreq = 22; 153 pkSmallIcon_AsPreq = 23; 154 pkSpecialIcon = 24; 155 pkGov = 25; 156 157 nSeeAlso = 14; 158 SeeAlso: array [0 .. nSeeAlso - 1] of record Kind, no, SeeKind, 159 SeeNo: integer end = ((Kind: hkImp; no: imWalls; SeeKind: hkFeature; 160 SeeNo: mcArtillery), (Kind: hkImp; no: imHydro; SeeKind: hkImp; 161 SeeNo: woHoover), (Kind: hkImp; no: imWalls; SeeKind: hkImp; 162 SeeNo: imGrWall), (Kind: hkImp; no: imHighways; SeeKind: hkAdv; 163 SeeNo: adWheel), (Kind: hkImp; no: imCathedral; SeeKind: hkImp; 164 SeeNo: woBach), (Kind: hkImp; no: imBank; SeeKind: hkImp; SeeNo: imStockEx), 165 (Kind: hkImp; no: imShipComp; SeeKind: hkImp; SeeNo: imSpacePort), 166 (Kind: hkImp; no: imShipPow; SeeKind: hkImp; SeeNo: imSpacePort), 167 (Kind: hkImp; no: imShipHab; SeeKind: hkImp; SeeNo: imSpacePort), 168 (Kind: hkFeature; no: mcSub; SeeKind: hkFeature; SeeNo: mcRadar), 169 (Kind: hkFeature; no: mcDefense; SeeKind: hkAdv; SeeNo: adSteel), 170 (Kind: hkFeature; no: mcSE; SeeKind: hkFeature; SeeNo: mcNP), (Kind: hkAdv; 171 no: adWheel; SeeKind: hkImp; SeeNo: imHighways), (Kind: hkAdv; no: adSteel; 172 SeeKind: hkFeature; SeeNo: mcDefense)); 173 174 nTerrainHelp = 14; 175 TerrainHelp: array [0 .. nTerrainHelp - 1] of integer = (fGrass, fGrass + 12, 176 fPrairie, fForest, fJungle, fHills, fMountains, fSwamp, fTundra, fArctic, 177 fDesert, 3 * 12 { DeadLands } , fShore, fOcean); 178 179 nJobHelp = 8; 180 JobHelp: array [0 .. nJobHelp - 1] of integer = (jRoad, jRR, jCanal, jIrr, 181 jFarm, jMine, jFort, jBase); 182 183 procedure THelpDlg.FormCreate(Sender: TObject); 155 184 begin 156 inherited; 157 CaptionLeft:=BackBtn.Left+BackBtn.Width; 158 CaptionRight:=SearchBtn.Left; 159 inc(ModalFrameIndent,29); 160 MainText:=THyperText.Create; 161 SearchResult:=THyperText.Create; 162 CreatePVSB(sb,Handle,36,551,36+432); 163 164 HelpText:=TStringTable.Create; 165 HelpText.LoadFromFile(LocalizedFilePath('Help\help.txt')); 166 hADVHELP:=HelpText.Gethandle('ADVHELP'); 167 hIMPHELP:=HelpText.Gethandle('IMPHELP'); 168 hFEATUREHELP:=HelpText.Gethandle('FEATUREHELP'); 169 hGOVHELP:=HelpText.Gethandle('GOVHELP'); 170 hSPECIALMODEL:=HelpText.Gethandle('SPECIALMODEL'); 171 hJOBHELP:=HelpText.Gethandle('JOBHELP'); 172 173 CaptionFont:=Font.Create; 174 CaptionFont.Assign(UniFont[ftNormal]); 175 CaptionFont.Style:=CaptionFont.Style+[fsItalic,fsBold]; 176 InitButtons(); 177 178 TopBtn.Hint:=Phrases.Lookup('BTN_CONTENTS'); 179 BackBtn.Hint:=Phrases.Lookup('BTN_BACK'); 180 SearchBtn.Hint:=Phrases.Lookup('BTN_SEARCH'); 181 182 ExtPic:=TBitmap.Create; 183 TerrIcon:=TBitmap.Create; 184 TerrIcon.PixelFormat:=pf24bit; 185 TerrIcon.Width:=xSizeBig; TerrIcon.Height:=ySizeBig; 186 SearchContent:=''; 187 nHist:=-1; 185 inherited; 186 CaptionLeft := BackBtn.Left + BackBtn.Width; 187 CaptionRight := SearchBtn.Left; 188 inc(ModalFrameIndent, 29); 189 MainText := THyperText.Create; 190 SearchResult := THyperText.Create; 191 CreatePVSB(sb, Handle, 36, 551, 36 + 432); 192 193 HelpText := TStringTable.Create; 194 HelpText.LoadFromFile(LocalizedFilePath('Help\help.txt')); 195 hADVHELP := HelpText.Gethandle('ADVHELP'); 196 hIMPHELP := HelpText.Gethandle('IMPHELP'); 197 hFEATUREHELP := HelpText.Gethandle('FEATUREHELP'); 198 hGOVHELP := HelpText.Gethandle('GOVHELP'); 199 hSPECIALMODEL := HelpText.Gethandle('SPECIALMODEL'); 200 hJOBHELP := HelpText.Gethandle('JOBHELP'); 201 202 CaptionFont := Font.Create; 203 CaptionFont.Assign(UniFont[ftNormal]); 204 CaptionFont.Style := CaptionFont.Style + [fsItalic, fsBold]; 205 InitButtons(); 206 207 TopBtn.Hint := Phrases.Lookup('BTN_CONTENTS'); 208 BackBtn.Hint := Phrases.Lookup('BTN_BACK'); 209 SearchBtn.Hint := Phrases.Lookup('BTN_SEARCH'); 210 211 ExtPic := TBitmap.Create; 212 TerrIcon := TBitmap.Create; 213 TerrIcon.PixelFormat := pf24bit; 214 TerrIcon.Width := xSizeBig; 215 TerrIcon.Height := ySizeBig; 216 SearchContent := ''; 217 nHist := -1; 188 218 end; 189 219 190 220 procedure THelpDlg.ClearHistory; 191 221 begin 192 nHist:=-1;222 nHist := -1; 193 223 end; 194 224 195 procedure THelpDlg.FormDestroy(Sender: TObject);225 procedure THelpDlg.FormDestroy(Sender: TObject); 196 226 begin 197 MainText.Free;198 SearchResult.Free;199 ExtPic.Free;200 TerrIcon.Free;201 HelpText.Free;202 //CaptionFont.Free;227 MainText.Free; 228 SearchResult.Free; 229 ExtPic.Free; 230 TerrIcon.Free; 231 HelpText.Free; 232 // CaptionFont.Free; 203 233 end; 204 234 205 procedure THelpDlg.CloseBtnClick(Sender: TObject);235 procedure THelpDlg.CloseBtnClick(Sender: TObject); 206 236 begin 207 Close237 Close 208 238 end; 209 239 210 procedure THelpDlg.OnScroll(var m: TMessage);240 procedure THelpDlg.OnScroll(var m: TMessage); 211 241 begin 212 if ProcessPVSB(sb,m) then 213 begin Sel:=-1; SmartUpdateContent(true) end 214 end; 215 216 procedure THelpDlg.OnMouseWheel(var m:TMessage); 217 begin 218 if ProcessMouseWheel(sb,m) then 219 begin 220 Sel:=-1; 221 SmartUpdateContent(true); 222 PaintBox1MouseMove(nil, [], m.lParam and $FFFF-Left, m.lParam shr 16-Top); 242 if ProcessPVSB(sb, m) then 243 begin 244 Sel := -1; 245 SmartUpdateContent(true) 223 246 end 224 247 end; 225 248 226 procedure THelpDlg.OnMouse Leave(var Msg:TMessage);249 procedure THelpDlg.OnMouseWheel(var m: TMessage); 227 250 begin 228 if Sel<>-1 then 229 begin 230 line(Canvas,Sel,false); 231 Sel:=-1 251 if ProcessMouseWheel(sb, m) then 252 begin 253 Sel := -1; 254 SmartUpdateContent(true); 255 PaintBox1MouseMove(nil, [], m.lParam and $FFFF - Left, 256 m.lParam shr 16 - Top); 232 257 end 233 258 end; 234 259 235 procedure THelpDlg. FormPaint(Sender:TObject);260 procedure THelpDlg.OnMouseLeave(var Msg: TMessage); 236 261 begin 237 inherited; 238 Canvas.Font.Assign(UniFont[ftNormal]); 262 if Sel <> -1 then 263 begin 264 line(Canvas, Sel, false); 265 Sel := -1 266 end 267 end; 268 269 procedure THelpDlg.FormPaint(Sender: TObject); 270 begin 271 inherited; 272 Canvas.Font.Assign(UniFont[ftNormal]); 239 273 end; 240 274 241 275 procedure THelpDlg.line(ca: TCanvas; i: integer; lit: boolean); 242 276 var 243 TextColor,x,y: integer;244 TextSize: TSize;245 s: string;277 TextColor, x, y: integer; 278 TextSize: TSize; 279 s: string; 246 280 begin 247 s:=MainText[sb.si.npos+i]; 248 if s='' then exit; 249 x:=x0[i]; y:=2+i*24; 250 if ca=Canvas then 251 begin x:=x+SideFrame; y:=y+WideFrame end; 252 if THelpLineInfo(MainText.Objects[sb.si.npos+i]).Format 253 in [pkCaption,pkBigTer,pkRightIcon,pkBigFeature] then 254 begin 255 ca.Font.Assign(CaptionFont); 256 { ca.brush.color:=CaptionColor; 257 ca.FillRect(rect(x,i*24,x+24,i*24+24)); 258 ca.brush.color:=$FFFFFF; 259 ca.FrameRect(rect(x+1,i*24+1,x+24-1,i*24+24-1)); 260 ca.Brush.Style:=bsClear;} 261 BitBlt(ca.handle,x,y-4,24,24,GrExt[HGrSystem].Data.Canvas.Handle,1,146,SRCCOPY); 262 BiColorTextOut(ca,$FFFFFF,$7F007F,x+10-ca.Textwidth(s[1]) div 2,y-3,s[1]); 263 BiColorTextOut(ca,CaptionColor,$7F007F,x+24,y-3,copy(s,2,255)); 264 ca.Font.Assign(UniFont[ftNormal]); 265 end 266 else if THelpLineInfo(MainText.Objects[sb.si.npos+i]).Format=pkSection then 267 begin 268 ca.Font.Assign(CaptionFont); 269 BiColorTextOut(ca,CaptionColor,$7F007F,x,y-3,s); 270 ca.Font.Assign(UniFont[ftNormal]); 271 end 272 else 273 begin 274 if (Kind=hkMisc) and (no=miscMain) then 281 s := MainText[sb.si.npos + i]; 282 if s = '' then 283 exit; 284 x := x0[i]; 285 y := 2 + i * 24; 286 if ca = Canvas then 287 begin 288 x := x + SideFrame; 289 y := y + WideFrame 290 end; 291 if THelpLineInfo(MainText.Objects[sb.si.npos + i]).Format 292 in [pkCaption, pkBigTer, pkRightIcon, pkBigFeature] then 293 begin 275 294 ca.Font.Assign(CaptionFont); 276 TextColor:=Colors.Canvas.Pixels[clkMisc,cliPaperText]; 277 if ca=Canvas then 278 begin 279 TextSize.cx:=BiColorTextWidth(ca,s); 280 TextSize.cy:=ca.TextHeight(s); 281 if y+TextSize.cy>=WideFrame+InnerHeight then 282 TextSize.cy:=WideFrame+InnerHeight-y; 283 FillSeamless(ca,x,y,TextSize.cx,TextSize.cy,-SideFrame,sb.si.npos*24-WideFrame, 284 Paper); 285 end; 286 BiColorTextOut(ca,TextColor,$7F007F,x,y,s); 287 if lit then with ca do 288 begin 289 assert(ca=Canvas); 290 pen.color:=TextColor; 291 moveto(x+1,y+TextSize.cy-2); 292 lineto(x+TextSize.cx,y+TextSize.cy-2); 293 end; 294 if (Kind=hkMisc) and (no=miscMain) then 295 { ca.brush.color:=CaptionColor; 296 ca.FillRect(rect(x,i*24,x+24,i*24+24)); 297 ca.brush.color:=$FFFFFF; 298 ca.FrameRect(rect(x+1,i*24+1,x+24-1,i*24+24-1)); 299 ca.Brush.Style:=bsClear; } 300 BitBlt(ca.Handle, x, y - 4, 24, 24, GrExt[HGrSystem].Data.Canvas.Handle, 1, 301 146, SRCCOPY); 302 BiColorTextOut(ca, $FFFFFF, $7F007F, x + 10 - ca.Textwidth(s[1]) div 2, 303 y - 3, s[1]); 304 BiColorTextOut(ca, CaptionColor, $7F007F, x + 24, y - 3, copy(s, 2, 255)); 295 305 ca.Font.Assign(UniFont[ftNormal]); 296 306 end 307 else if THelpLineInfo(MainText.Objects[sb.si.npos + i]).Format = pkSection 308 then 309 begin 310 ca.Font.Assign(CaptionFont); 311 BiColorTextOut(ca, CaptionColor, $7F007F, x, y - 3, s); 312 ca.Font.Assign(UniFont[ftNormal]); 313 end 314 else 315 begin 316 if (Kind = hkMisc) and (no = miscMain) then 317 ca.Font.Assign(CaptionFont); 318 TextColor := Colors.Canvas.Pixels[clkMisc, cliPaperText]; 319 if ca = Canvas then 320 begin 321 TextSize.cx := BiColorTextWidth(ca, s); 322 TextSize.cy := ca.TextHeight(s); 323 if y + TextSize.cy >= WideFrame + InnerHeight then 324 TextSize.cy := WideFrame + InnerHeight - y; 325 FillSeamless(ca, x, y, TextSize.cx, TextSize.cy, -SideFrame, 326 sb.si.npos * 24 - WideFrame, Paper); 327 end; 328 BiColorTextOut(ca, TextColor, $7F007F, x, y, s); 329 if lit then 330 with ca do 331 begin 332 assert(ca = Canvas); 333 pen.color := TextColor; 334 moveto(x + 1, y + TextSize.cy - 2); 335 lineto(x + TextSize.cx, y + TextSize.cy - 2); 336 end; 337 if (Kind = hkMisc) and (no = miscMain) then 338 ca.Font.Assign(UniFont[ftNormal]); 339 end 297 340 end; 298 341 299 procedure THelpDlg.WaterSign(x0, y0,iix: integer);342 procedure THelpDlg.WaterSign(x0, y0, iix: integer); 300 343 const 301 nHeaven=28;302 maxsum=9*9*255 *75 div 100;344 nHeaven = 28; 345 maxsum = 9 * 9 * 255 * 75 div 100; 303 346 type 304 TLine=array[0..649,0..2] of Byte;347 TLine = array [0 .. 649, 0 .. 2] of Byte; 305 348 var 306 x,y,dx,dy,xSrc,ySrc,sum,xx: integer;307 Heaven: array[0..nHeaven] of integer;308 PaintLine,CoalLine: ^TLine;309 ImpLine: array[-1..1] of ^TLine;349 x, y, dx, dy, xSrc, ySrc, sum, xx: integer; 350 Heaven: array [0 .. nHeaven] of integer; 351 PaintLine, CoalLine: ^TLine; 352 ImpLine: array [-1 .. 1] of ^TLine; 310 353 begin 311 // assume eiffel tower has free common heaven 312 for dy:=0 to nHeaven-1 do 313 Heaven[dy]:=BigImp.Canvas.Pixels[woEiffel mod 7 *xSizeBig, 314 (SystemIconLines+woEiffel div 7)*ySizeBig+dy]; 315 316 xSrc:=iix mod 7 *xSizeBig; 317 ySrc:=(iix div 7+1) *ySizeBig; 318 for y:=0 to ySizeBig*2-1 do if (y0+y>=0) and (y0+y<InnerHeight) then 319 begin 320 PaintLine:=OffScreen.ScanLine[y0+y]; 321 CoalLine:=Templates.ScanLine[yCoal+y]; 322 for dy:=-1 to 1 do 323 if ((y+dy) shr 1>=0) and ((y+dy) shr 1<ySizeBig) then 324 ImpLine[dy]:=BigImp.ScanLine[ySrc+(y+dy) shr 1]; 325 for x:=0 to xSizeBig*2-1 do 326 begin 327 sum:=0; 328 for dx:=-1 to 1 do 354 // assume eiffel tower has free common heaven 355 for dy := 0 to nHeaven - 1 do 356 Heaven[dy] := BigImp.Canvas.Pixels[woEiffel mod 7 * xSizeBig, 357 (SystemIconLines + woEiffel div 7) * ySizeBig + dy]; 358 359 xSrc := iix mod 7 * xSizeBig; 360 ySrc := (iix div 7 + 1) * ySizeBig; 361 for y := 0 to ySizeBig * 2 - 1 do 362 if (y0 + y >= 0) and (y0 + y < InnerHeight) then 363 begin 364 PaintLine := OffScreen.ScanLine[y0 + y]; 365 CoalLine := Templates.ScanLine[yCoal + y]; 366 for dy := -1 to 1 do 367 if ((y + dy) shr 1 >= 0) and ((y + dy) shr 1 < ySizeBig) then 368 ImpLine[dy] := BigImp.ScanLine[ySrc + (y + dy) shr 1]; 369 for x := 0 to xSizeBig * 2 - 1 do 329 370 begin 330 xx:=xSrc+(x+dx) shr 1; 331 for dy:=-1 to 1 do 332 if ((y+dy) shr 1<0) or ((y+dy) shr 1>=ySizeBig) 333 or ((x+dx) shr 1<0) or ((x+dx) shr 1>=xSizeBig) 334 or ((y+dy) shr 1<nHeaven) 335 and (ImpLine[dy,xx,0] shl 16+ImpLine[dy,xx,1] shl 8+ImpLine[dy,xx,2]=Heaven[(y+dy) shr 1]) then 336 sum:=sum+9*255 337 else sum:=sum+ImpLine[dy,xx,0]+5*ImpLine[dy,xx,1]+3*ImpLine[dy,xx,2]; 371 sum := 0; 372 for dx := -1 to 1 do 373 begin 374 xx := xSrc + (x + dx) shr 1; 375 for dy := -1 to 1 do 376 if ((y + dy) shr 1 < 0) or ((y + dy) shr 1 >= ySizeBig) or 377 ((x + dx) shr 1 < 0) or ((x + dx) shr 1 >= xSizeBig) or 378 ((y + dy) shr 1 < nHeaven) and 379 (ImpLine[dy, xx, 0] shl 16 + ImpLine[dy, xx, 1] shl 8 + 380 ImpLine[dy, xx, 2] = Heaven[(y + dy) shr 1]) then 381 sum := sum + 9 * 255 382 else 383 sum := sum + ImpLine[dy, xx, 0] + 5 * ImpLine[dy, xx, 1] + 3 * 384 ImpLine[dy, xx, 2]; 385 end; 386 if sum < maxsum then 387 begin // no saturation 388 sum := 1 shl 22 - (maxsum - sum) * (256 - CoalLine[xCoal + x, 0] * 2); 389 PaintLine[x0 + x, 0] := PaintLine[x0 + x, 0] * sum shr 22; 390 PaintLine[x0 + x, 1] := PaintLine[x0 + x, 1] * sum shr 22; 391 PaintLine[x0 + x, 2] := PaintLine[x0 + x, 2] * sum shr 22; 392 end 393 end 394 end; 395 end; 396 397 procedure THelpDlg.OffscreenPaint; 398 399 procedure PaintTerrIcon(x, y, xSrc, ySrc: integer); 400 begin 401 Frame(OffScreen.Canvas, x - 1, y - 1, x + xSizeBig, y + ySizeBig, 402 $000000, $000000); 403 if 2 * yyt < 40 then 404 begin 405 Sprite(OffScreen, HGrTerrain, x, y, 56, 2 * yyt, xSrc, ySrc); 406 Sprite(OffScreen, HGrTerrain, x, y + 2 * yyt, 56, 40 - 2 * yyt, 407 xSrc, ySrc); 408 end 409 else 410 Sprite(OffScreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc); 411 Sprite(OffScreen, HGrTerrain, x, y, xxt, yyt, xSrc + xxt, ySrc + yyt); 412 Sprite(OffScreen, HGrTerrain, x, y + yyt, xxt, 40 - yyt, xSrc + xxt, ySrc); 413 Sprite(OffScreen, HGrTerrain, x + xxt, y, 56 - xxt, yyt, xSrc, ySrc + yyt); 414 Sprite(OffScreen, HGrTerrain, x + xxt, y + yyt, 56 - xxt, 40 - yyt, 415 xSrc, ySrc); 416 end; 417 418 var 419 i, j, yl, srcno, ofs, cnt, y: integer; 420 s: string; 421 HelpLineInfo: THelpLineInfo; 422 begin 423 inherited; 424 CaptionColor := Colors.Canvas.Pixels[clkMisc, cliPaperCaption]; 425 FillSeamless(OffScreen.Canvas, 0, 0, InnerWidth, InnerHeight, 0, 426 sb.si.npos * 24, Paper); 427 with OffScreen.Canvas do 428 begin 429 Font.Assign(UniFont[ftNormal]); 430 for i := -sb.si.npos to InnerHeight div 24 do 431 if sb.si.npos + i < MainText.Count then 432 begin 433 HelpLineInfo := THelpLineInfo(MainText.Objects[sb.si.npos + i]); 434 if HelpLineInfo.Format = pkExternal then 435 begin 436 yl := ExtPic.Height; 437 if 4 + i * 24 + yl > InnerHeight then 438 yl := InnerHeight - (4 + i * 24); 439 BitBlt(Handle, 8, 4 + i * 24, ExtPic.Width, yl, ExtPic.Canvas.Handle, 440 0, 0, SRCCOPY); 441 end 338 442 end; 339 if sum<maxsum then 340 begin // no saturation 341 sum:=1 shl 22 - (maxsum-sum)*(256-CoalLine[xCoal+x,0]*2); 342 PaintLine[x0+x,0]:=PaintLine[x0+x,0]*sum shr 22; 343 PaintLine[x0+x,1]:=PaintLine[x0+x,1]*sum shr 22; 344 PaintLine[x0+x,2]:=PaintLine[x0+x,2]*sum shr 22; 443 for i := -2 to InnerHeight div 24 do 444 if (sb.si.npos + i >= 0) and (sb.si.npos + i < MainText.Count) then 445 begin 446 HelpLineInfo := THelpLineInfo(MainText.Objects[sb.si.npos + i]); 447 if HelpLineInfo.Link <> 0 then 448 begin 449 if (Kind = hkMisc) and (no = miscSearchResult) then 450 Sprite(OffScreen, HGrSystem, 18, 9 + i * 24, 8, 8, 90, 16) 451 else if HelpLineInfo.Format in [pkSmallIcon_AsPreq, pkAdvIcon_AsPreq] 452 then 453 Sprite(OffScreen, HGrSystem, 12, i * 24 + 5, 14, 14, 65, 20) 454 else if HelpLineInfo.Link and (hkCrossLink shl 8) <> 0 then 455 Sprite(OffScreen, HGrSystem, 12, i * 24 + 5, 14, 14, 80, 1) 456 else if not((Kind = hkMisc) and (no = miscMain)) then 457 Sprite(OffScreen, HGrSystem, 10, i * 24 + 6, 14, 14, 65, 1); 458 x0[i] := 24; 459 end 460 else 461 x0[i] := 0; 462 case HelpLineInfo.Format of 463 pkLogo: 464 begin 465 Server(sGetVersion, 0, 0, j); 466 s := Format('%d.%d.%d', [j shr 16 and $FF, j shr 8 and $FF, 467 j and $FF]); 468 PaintLogo(OffScreen.Canvas, (InnerWidth - 122) div 2, i * 24 + 1, 469 GrExt[HGrSystem].Data.Canvas.Pixels[95, 1], $000000); 470 Font.Assign(UniFont[ftSmall]); 471 BiColorTextOut(OffScreen.Canvas, $000000, $7F007F, 472 (InnerWidth - Textwidth(s)) div 2, i * 24 + 26, s); 473 Font.Assign(UniFont[ftNormal]); 474 end; 475 pkSmallIcon, pkSmallIcon_AsPreq: 476 begin 477 Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 478 8 + xSizeSmall + x0[i], 2 + 20 + i * 24, $000000, $000000); 479 if HelpLineInfo.Picpix = imPalace then 480 BitBlt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, 481 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 482 0 * xSizeSmall, 1 * ySizeSmall, SRCCOPY) 483 else 484 BitBlt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, 485 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 486 HelpLineInfo.Picpix mod 7 * xSizeSmall, 487 (HelpLineInfo.Picpix + SystemIconLines * 7) div 7 * 488 ySizeSmall, SRCCOPY); 489 x0[i] := x0[i] + (8 + 8 + 36); 490 end; 491 pkBigIcon: 492 begin 493 FrameImage(OffScreen.Canvas, BigImp, x0[i] + 12, i * 24 - 7, 56, 494 40, HelpLineInfo.Picpix mod 7 * xSizeBig, 495 HelpLineInfo.Picpix div 7 * ySizeBig); 496 x0[i] := 64 + 8 + 8 + x0[i]; 497 end; 498 pkSpecialIcon: 499 begin 500 case HelpLineInfo.Picpix of 501 0: 502 FrameImage(OffScreen.Canvas, GrExt[HGrSystem2].Data, 503 12 + x0[i], -7 + i * 24, 56, 40, 137, 127); 504 1: 505 begin 506 PaintTerrIcon(12 + x0[i], -7 + i * 24, 507 1 + 3 * (xxt * 2 + 1), 1 + yyt); 508 if 2 * yyt < 40 then 509 Sprite(OffScreen, HGrTerrain, 12 + x0[i], -7 + 4 + i * 24, 510 56, 2 * yyt, 1 + 3 * (xxt * 2 + 1) + xxt - 28, 511 1 + yyt + 1 * (yyt * 3 + 1)) 512 else 513 Sprite(OffScreen, HGrTerrain, 12 + x0[i], 514 -7 + 4 + i * 24 - 4, 56, 40, 1 + 3 * (xxt * 2 + 1) + xxt 515 - 28, 1 + yyt + 1 * (yyt * 3 + 1) + yyt - 20); 516 end; 517 2: 518 begin 519 PaintTerrIcon(12 + x0[i], -7 + i * 24, 520 1 + 7 * (xxt * 2 + 1), 1 + yyt + 4 * (yyt * 3 + 1)); 521 if 2 * yyt < 40 then 522 Sprite(OffScreen, HGrTerrain, 12 + x0[i], -7 + 4 + i * 24, 523 56, 32, 1 + 4 * (xxt * 2 + 1) + xxt - 28, 524 1 + yyt + 12 * (yyt * 3 + 1) + yyt - 16) 525 else 526 Sprite(OffScreen, HGrTerrain, 12 + x0[i], -7 + 4 + i * 24, 527 56, 32, 1 + 4 * (xxt * 2 + 1) + xxt - 28, 528 1 + yyt + 12 * (yyt * 3 + 1) + yyt - 16) 529 end; 530 end; 531 x0[i] := 64 + 8 + 8 + x0[i]; 532 end; 533 pkDomain: 534 begin 535 Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 536 8 + 36 + x0[i], 2 + 20 + i * 24, $000000, $000000); 537 Dump(OffScreen, HGrSystem, 8 + x0[i], 2 + i * 24, 36, 20, 538 75 + HelpLineInfo.Picpix * 37, 295); 539 x0[i] := x0[i] + (8 + 8 + 36); 540 end; 541 pkAdvIcon, pkAdvIcon_AsPreq: 542 begin 543 Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 544 8 + xSizeSmall + x0[i], 2 + ySizeSmall + i * 24, 545 $000000, $000000); 546 if AdvIcon[HelpLineInfo.Picpix] < 84 then 547 BitBlt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, 548 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 549 (AdvIcon[HelpLineInfo.Picpix] + SystemIconLines * 7) mod 7 * 550 xSizeSmall, (AdvIcon[HelpLineInfo.Picpix] + SystemIconLines * 551 7) div 7 * ySizeSmall, SRCCOPY) 552 else 553 Dump(OffScreen, HGrSystem, 8 + x0[i], 2 + i * 24, 36, 20, 554 1 + (AdvIcon[HelpLineInfo.Picpix] - 84) mod 8 * 37, 555 295 + (AdvIcon[HelpLineInfo.Picpix] - 84) div 8 * 21); 556 j := AdvValue[HelpLineInfo.Picpix] div 1000; 557 BitBlt(Handle, x0[i] + 4, 4 + i * 24, 14, 14, 558 GrExt[HGrSystem].Mask.Canvas.Handle, 127 + j * 15, 85, SRCAND); 559 Sprite(OffScreen, HGrSystem, x0[i] + 3, 3 + i * 24, 14, 14, 560 127 + j * 15, 85); 561 x0[i] := x0[i] + (8 + 8 + 36); 562 end; 563 pkRightIcon: 564 begin 565 if Imp[HelpLineInfo.Picpix].Kind <> ikWonder then 566 ImpImage(OffScreen.Canvas, InnerWidth - (40 + xSizeBig), i * 24, 567 HelpLineInfo.Picpix, gDespotism) 568 else 569 WaterSign(InnerWidth - (40 + 2 * xSizeBig), i * 24 - 8, 570 HelpLineInfo.Picpix + 7); 571 x0[i] := x0[i] + 8; 572 end; 573 pkIllu: 574 WaterSign(8, i * 24 - 8, HelpLineInfo.Picpix); 575 pkBigFeature: 576 begin 577 cnt := 0; 578 for j := nDomains - 1 downto 0 do 579 if 1 shl j and Feature[HelpLineInfo.Picpix].Domains <> 0 then 580 begin 581 inc(cnt); 582 Dump(OffScreen, HGrSystem, InnerWidth - 38 - 38 * cnt, 583 i * 24 + 1, 36, 20, 75 + j * 37, 295); 584 Frame(OffScreen.Canvas, InnerWidth - 39 - 38 * cnt, i * 24, 585 InnerWidth - 2 - 38 * cnt, i * 24 + 21, $000000, $000000); 586 end; 587 DarkGradient(OffScreen.Canvas, InnerWidth - 38 - 38 * cnt, 588 i * 24 + 23, cnt * 38 - 2, 1); 589 ofs := InnerWidth - (39 + 7) - 19 * cnt; 590 with OffScreen.Canvas do 591 begin 592 Brush.color := $C0C0C0; 593 FrameRect(Rect(ofs, 1 + 23 + i * 24, ofs + 14, 594 15 + 23 + i * 24)); 595 Brush.Style := bsClear; 596 Sprite(OffScreen, HGrSystem, ofs + 2, 3 + 23 + i * 24, 10, 10, 597 66 + HelpLineInfo.Picpix mod 11 * 11, 598 137 + HelpLineInfo.Picpix div 11 * 11); 599 end; 600 x0[i] := x0[i] + 8; 601 end; 602 pkTer, pkBigTer: 603 begin 604 if HelpLineInfo.Format = pkBigTer then 605 y := i * 24 - 3 + yyt 606 else 607 y := i * 24 + 13; 608 if HelpLineInfo.Picpix >= 3 * 12 then 609 srcno := 2 * 9 + 6 610 else if HelpLineInfo.Picpix mod 12 = fJungle then 611 srcno := 18 * 9 612 else if HelpLineInfo.Picpix mod 12 < fJungle then 613 srcno := HelpLineInfo.Picpix mod 12 614 else 615 srcno := 27 + (HelpLineInfo.Picpix mod 12 - 9) * 18; 616 if HelpLineInfo.Format = pkTer then 617 begin 618 ofs := x0[i] + 8; 619 x0[i] := 2 * xxt + 8 + ofs; 620 end 621 else 622 begin 623 ofs := InnerWidth - (2 * xxt + 38); 624 x0[i] := x0[i] + 8; 625 end; 626 if srcno >= fJungle then 627 begin 628 Sprite(OffScreen, HGrTerrain, ofs + 4, y - yyt + 2, xxt * 2 - 8, 629 yyt * 2 - 4, 5 + 2 * (xxt * 2 + 1), 630 3 + yyt + 2 * (yyt * 3 + 1)); 631 Sprite(OffScreen, HGrTerrain, ofs, y - 2 * yyt, xxt * 2, 632 yyt * 3 - 2, 1 + srcno mod 9 * (xxt * 2 + 1), 633 1 + srcno div 9 * (yyt * 3 + 1)); 634 end 635 else 636 Sprite(OffScreen, HGrTerrain, ofs + 4, y - yyt + 2, xxt * 2 - 8, 637 yyt * 2 - 4, 5 + srcno mod 9 * (xxt * 2 + 1), 638 3 + yyt + srcno div 9 * (yyt * 3 + 1)); 639 if HelpLineInfo.Picpix >= 3 * 12 then { rare resource } 640 Sprite(OffScreen, HGrTerrain, ofs, y - 2 * yyt, xxt * 2, 641 yyt * 3, 1 + 8 * (xxt * 2 + 1), 642 1 + (HelpLineInfo.Picpix - 2 * 12) * (yyt * 3 + 1)) 643 else if HelpLineInfo.Picpix >= 12 then { special tile } 644 begin 645 if HelpLineInfo.Picpix mod 12 = fJungle then 646 srcno := 17 * 9 + 8 647 else if HelpLineInfo.Picpix mod 12 < fJungle then 648 srcno := HelpLineInfo.Picpix mod 12 649 else 650 srcno := 18 + 8 + (HelpLineInfo.Picpix mod 12 - 9) * 18; 651 srcno := srcno + HelpLineInfo.Picpix div 12 * 9; 652 Sprite(OffScreen, HGrTerrain, ofs, y - 2 * yyt, xxt * 2, 653 yyt * 3, 1 + srcno mod 9 * (xxt * 2 + 1), 654 1 + srcno div 9 * (yyt * 3 + 1)); 655 end; 656 end; 657 pkTerImp: 658 begin 659 ofs := 8; 660 if HelpLineInfo.Picpix = 5 then 661 begin // display mine on hills 662 Sprite(OffScreen, HGrTerrain, ofs + 4, i * 24 + 13 - yyt, 663 xxt * 2 - 8, yyt * 2 - 4, 5 + 2 * (xxt * 2 + 1), 664 3 + yyt + 2 * (yyt * 3 + 1)); 665 srcno := 45 666 end 667 else 668 srcno := fPrairie; // display on prairie 669 Sprite(OffScreen, HGrTerrain, ofs + 4, i * 24 + 13 - yyt, 670 xxt * 2 - 8, yyt * 2 - 4, 5 + srcno mod 9 * (xxt * 2 + 1), 671 3 + yyt + srcno div 9 * (yyt * 3 + 1)); 672 if HelpLineInfo.Picpix = 12 then { river } 673 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - yyt, xxt * 2, 674 yyt * 2, 1 + 5 * (xxt * 2 + 1), 1 + yyt + 13 * (yyt * 3 + 1)) 675 else if HelpLineInfo.Picpix >= 3 then { improvement 2 } 676 begin 677 if HelpLineInfo.Picpix = 6 then 678 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - 2 * yyt, 679 xxt * 2, yyt * 3, 1 + 7 * (xxt * 2 + 1), 680 1 + 12 * (yyt * 3 + 1)); 681 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - 2 * yyt, 682 xxt * 2, yyt * 3, 1 + (HelpLineInfo.Picpix - 3) * 683 (xxt * 2 + 1), 1 + 12 * (yyt * 3 + 1)) 684 end 685 else { improvement 1 } 686 begin 687 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - 2 * yyt, 688 xxt * 2, yyt * 3, 1 + 2 * (xxt * 2 + 1), 689 1 + (9 + HelpLineInfo.Picpix) * (yyt * 3 + 1)); 690 Sprite(OffScreen, HGrTerrain, ofs, i * 24 + 11 - 2 * yyt, 691 xxt * 2, yyt * 3, 1 + 5 * (xxt * 2 + 1), 692 1 + (9 + HelpLineInfo.Picpix) * (yyt * 3 + 1)) 693 end; 694 x0[i] := x0[i] + 8; 695 end; 696 pkModel: 697 begin 698 FrameImage(OffScreen.Canvas, BigImp, x0[i] + 12, i * 24 - 7, 699 56, 40, 0, 0); 700 Sprite(OffScreen, HGrStdUnits, x0[i] + 8, i * 24 - 11, 64, 44, 701 1 + HelpLineInfo.Picpix mod 10 * 65, 702 1 + HelpLineInfo.Picpix div 10 * 49); 703 x0[i] := 64 + 8 + 8 + x0[i]; 704 end; 705 pkFeature: 706 begin 707 DarkGradient(OffScreen.Canvas, x0[i] + 8 - 1, 708 7 + i * 24 - 3, 16, 1); 709 Frame(OffScreen.Canvas, x0[i] + 8, 7 + i * 24 - 2, x0[i] + 8 + 13, 710 7 + i * 24 - 2 + 13, $C0C0C0, $C0C0C0); 711 Sprite(OffScreen, HGrSystem, x0[i] + 8 + 2, 7 + i * 24, 10, 10, 712 66 + HelpLineInfo.Picpix mod 11 * 11, 713 137 + HelpLineInfo.Picpix div 11 * 11); 714 x0[i] := x0[i] + 8 + 8 + 2 + 13; 715 end; 716 pkExp: 717 begin 718 Frame(OffScreen.Canvas, 20 - 1, 8 - 4 + i * 24, 20 + 12, 719 8 + 11 + i * 24, $000000, $000000); 720 Dump(OffScreen, HGrSystem, 20, 8 - 3 + i * 24, 12, 14, 721 121 + HelpLineInfo.Picpix * 13, 28); 722 x0[i] := 20 + 8 + 11; 723 end; 724 pkAITStat: 725 begin 726 Sprite(OffScreen, HGrSystem, 20, 6 + i * 24, 14, 14, 727 1 + HelpLineInfo.Picpix * 15, 316); 728 x0[i] := 20 + 8 + 11; 729 end; 730 pkGov: 731 begin 732 Frame(OffScreen.Canvas, 8 - 1 + x0[i], 2 - 1 + i * 24, 733 8 + xSizeSmall + x0[i], 2 + 20 + i * 24, $000000, $000000); 734 BitBlt(OffScreen.Canvas.Handle, 8 + x0[i], 2 + i * 24, xSizeSmall, 735 ySizeSmall, SmallImp.Canvas.Handle, (HelpLineInfo.Picpix - 1) * 736 xSizeSmall, ySizeSmall, SRCCOPY); 737 x0[i] := x0[i] + (8 + 8 + 36); 738 end; 739 pkDot: 740 begin 741 Sprite(OffScreen, HGrSystem, x0[i] + 18, 9 + i * 24, 8, 742 8, 81, 16); 743 x0[i] := 20 + 8 + 4; 744 end; 745 pkNormal_Dot: 746 x0[i] := 20 + 8 + 4; 747 pkNormal_64: 748 x0[i] := 64 + 8 + 8; 749 else 750 x0[i] := x0[i] + 8 751 end; 752 line(OffScreen.Canvas, i, false) 753 end 754 end; 755 MarkUsedOffscreen(InnerWidth, InnerHeight + 13 + 48); 756 end; { OffscreenPaint } 757 758 procedure THelpDlg.Prepare(sbPos: integer = 0); 759 var 760 i, j, special, Domain, Headline, TerrType, TerrSubType: integer; 761 s: string; 762 ps: pchar; 763 List: THyperText; 764 CheckSeeAlso: boolean; 765 766 procedure AddAdv(i: integer); 767 begin 768 MainText.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon, i, 769 hkAdv + hkCrossLink, i); 770 end; 771 772 procedure AddPreqAdv(i: integer); 773 begin 774 MainText.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon_AsPreq, i, 775 hkAdv + hkCrossLink, i); 776 end; 777 778 procedure AddImp(i: integer); 779 begin 780 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, 781 hkImp + hkCrossLink, i); 782 end; 783 784 procedure AddPreqImp(i: integer); 785 begin 786 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon_AsPreq, i, 787 hkImp + hkCrossLink, i); 788 end; 789 790 procedure AddTer(i: integer); 791 begin 792 if MainText.Count > 1 then 793 begin 794 MainText.LF; 795 end; 796 MainText.AddLine(Phrases.Lookup('TERRAIN', i), pkTer, i, hkTer, i); 797 end; 798 799 procedure AddFeature(i: integer); 800 begin 801 MainText.AddLine(Phrases.Lookup('FEATURES', i), pkFeature, i, 802 hkFeature + hkCrossLink, i); 803 end; 804 805 procedure AddModel(i: integer); 806 var 807 pix: integer; 808 Name: string; 809 begin 810 if MainText.Count > 1 then 811 MainText.LF; 812 FindStdModelPicture(SpecialModelPictureCode[i], pix, Name); 813 MainText.AddLine(Name, pkModel, pix, hkModel + hkCrossLink, i) 814 end; 815 816 procedure AddStandardBlock(Item: string); 817 var 818 i: integer; 819 begin 820 with MainText do 821 begin 822 if Item = 'LOGO' then 823 begin 824 AddLine('', pkLogo); 825 LF; 826 end 827 else if Item = 'TECHFORMULA' then 828 begin 829 i := Difficulty; 830 if i = 0 then 831 i := 2; 832 AddLine(Format(HelpText.Lookup('TECHFORMULA'), [TechFormula_M[i], 833 TechFormula_D[i]])) 834 end 835 else if Item = 'EXPERIENCE' then 836 for i := 0 to nExp - 1 do 837 AddLine(Phrases.Lookup('EXPERIENCE', i), pkExp, i) 838 else if Item = 'MODERN' then 839 for i := 1 to 3 do 840 begin 841 LF; 842 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + i), pkTer, 3 * 12 + i); 843 end 844 else if Item = 'SAVED' then 845 AddLine(DataDir + 'Saved', pkNormal) 846 else if Item = 'AITSTAT' then 847 for i := 0 to 3 do 848 AddLine(Phrases2.Lookup('AITSTAT', i), pkAITStat, i) 849 end 850 end; 851 852 procedure DecodeItem(s: string; var Category, Index: integer); 853 var 854 i: integer; 855 begin 856 if (length(s) > 0) and (s[1] = ':') then 857 begin 858 Category := hkMisc; 859 Index := 0; 860 for i := 3 to length(s) do 861 Index := Index * 10 + ord(s[i]) - 48; 862 case s[2] of 863 'A': 864 Category := hkAdv; 865 'B': 866 Category := hkImp; 867 'T': 868 Category := hkTer; 869 'F': 870 Category := hkFeature; 871 'E': 872 Category := hkInternet; 873 'S': 874 Category := hkModel; 875 'C': 876 Index := miscCredits; 877 'J': 878 Index := miscJobList; 879 'G': 880 Index := miscGovList; 881 end; 882 if (Category <> hkMisc) and (Index = 0) then 883 Index := 200; 884 end 885 else 886 begin 887 Category := hkText; 888 Index := HelpText.Gethandle(copy(s, 1, 255)); 889 end; 890 end; 891 892 procedure AddText(s: string); 893 var 894 i, p, l, ofs, CurrentFormat, FollowFormat, Picpix, LinkCategory, LinkIndex, 895 RightMargin: integer; 896 Name: string; 897 begin 898 RightMargin := InnerWidth - 16 - GetSystemMetrics(SM_CXVSCROLL); 899 FollowFormat := pkNormal; 900 while s <> '' do 901 begin 902 Picpix := 0; 903 LinkCategory := 0; 904 LinkIndex := 0; 905 if s[1] = '$' then 906 begin // window caption 907 p := 1; 908 repeat 909 inc(p) 910 until (p > length(s)) or (s[p] = '\'); 911 Caption := copy(s, 2, p - 2); 912 Delete(s, 1, p); 913 end 914 else if s[1] = '&' then 915 begin // standard block 916 p := 1; 917 repeat 918 inc(p) 919 until (p > length(s)) or (s[p] = '\'); 920 AddStandardBlock(copy(s, 2, p - 2)); 921 Delete(s, 1, p); 922 end 923 else if s[1] = '@' then 924 begin // image 925 if (length(s) >= 2) and (s[2] = '@') then 926 begin // generate from icon 927 Picpix := 0; 928 p := 3; 929 while (p <= length(s)) and (s[p] <> '\') do 930 begin 931 Picpix := Picpix * 10 + ord(s[p]) - 48; 932 inc(p) 933 end; 934 if (Picpix < 0) or (Picpix >= nImp) then 935 Picpix := 0; 936 MainText.AddLine('', pkIllu, Picpix); 937 MainText.LF; 938 MainText.LF; 939 end 940 else 941 begin // external image 942 p := 1; 943 repeat 944 inc(p) 945 until (p > length(s)) or (s[p] = '\'); 946 if LoadLocalizedGraphicFile(ExtPic, 'Help\' + copy(s, 2, p - 2)) then 947 begin 948 MainText.AddLine('', pkExternal); 949 for i := 0 to (ExtPic.Height - 12) div 24 do 950 MainText.LF; 951 end; 952 end; 953 Delete(s, 1, p); 954 end 955 else 956 begin 957 case s[1] of 958 ':', ';': 959 begin // link 960 p := 1; 961 repeat 962 inc(p) 963 until (p > length(s)) or (s[p] = '\') or (s[p] = ' '); 964 DecodeItem(copy(s, 2, p - 2), LinkCategory, LinkIndex); 965 CurrentFormat := 0; 966 if (LinkCategory <> hkText) and (LinkIndex < 200) then 967 // show icon 968 case LinkCategory of 969 hkAdv: 970 begin 971 CurrentFormat := pkAdvIcon; 972 Picpix := LinkIndex 973 end; 974 hkImp: 975 begin 976 CurrentFormat := pkSmallIcon; 977 Picpix := LinkIndex 978 end; 979 hkTer: 980 begin 981 CurrentFormat := pkTer; 982 Picpix := LinkIndex 983 end; 984 hkFeature: 985 begin 986 CurrentFormat := pkFeature; 987 Picpix := LinkIndex 988 end; 989 hkModel: 990 begin 991 CurrentFormat := pkModel; 992 FindStdModelPicture(SpecialModelPictureCode[LinkIndex], 993 Picpix, Name); 994 end; 995 end; 996 if s[1] = ':' then 997 LinkCategory := LinkCategory + hkCrossLink; 998 if (p > length(s)) or (s[p] = ' ') then 999 Delete(s, 1, p) 1000 else 1001 Delete(s, 1, p - 1) 1002 end; 1003 '!': // highlited 1004 if (length(s) >= 2) and (s[2] = '!') then 1005 begin 1006 if MainText.Count > 1 then 1007 MainText.LF; 1008 FollowFormat := pkCaption; 1009 CurrentFormat := pkCaption; 1010 Delete(s, 1, 2); 1011 end 1012 else 1013 begin 1014 FollowFormat := pkSection; 1015 CurrentFormat := pkSection; 1016 Delete(s, 1, 1); 1017 end; 1018 '-': 1019 begin // list 1020 FollowFormat := pkNormal_Dot; 1021 CurrentFormat := pkDot; 1022 Delete(s, 1, 1); 1023 end; 1024 else 1025 CurrentFormat := FollowFormat; 1026 end; 1027 if FollowFormat = pkNormal_Dot then 1028 ofs := 20 + 4 + 8 1029 else 1030 ofs := 8; 1031 p := 0; 1032 repeat 1033 repeat 1034 inc(p) 1035 until (p > length(s)) or (s[p] = ' ') or (s[p] = '\'); 1036 if (BiColorTextWidth(OffScreen.Canvas, copy(s, 1, p - 1)) <= 1037 RightMargin - ofs) then 1038 l := p - 1 1039 else 1040 Break; 1041 until (p >= length(s)) or (s[l + 1] = '\'); 1042 MainText.AddLine(copy(s, 1, l), CurrentFormat, Picpix, LinkCategory, 1043 LinkIndex); 1044 if (l < length(s)) and (s[l + 1] = '\') then 1045 FollowFormat := pkNormal; 1046 Delete(s, 1, l + 1); 345 1047 end 346 1048 end 347 1049 end; 348 end;349 350 procedure THelpDlg.OffscreenPaint;351 352 procedure PaintTerrIcon(x,y,xSrc,ySrc: integer);353 begin354 Frame(offscreen.canvas,x-1,y-1,x+xSizeBig,y+ySizeBig,$000000,$000000);355 if 2*yyt<40 then356 begin357 Sprite(Offscreen, HGrTerrain, x, y, 56, 2*yyt, xSrc, ySrc);358 Sprite(Offscreen, HGrTerrain, x, y+2*yyt, 56, 40-2*yyt, xSrc, ySrc);359 end360 else Sprite(Offscreen, HGrTerrain, x, y, 56, 40, xSrc, ySrc);361 Sprite(Offscreen, HGrTerrain, x, y, xxt, yyt, xSrc+xxt, ySrc+yyt);362 Sprite(Offscreen, HGrTerrain, x, y+yyt, xxt, 40-yyt, xSrc+xxt, ySrc);363 Sprite(Offscreen, HGrTerrain, x+xxt, y, 56-xxt, yyt, xSrc, ySrc+yyt);364 Sprite(Offscreen, HGrTerrain, x+xxt, y+yyt, 56-xxt, 40-yyt, xSrc, ySrc);365 end;366 367 var368 i,j,yl,srcno,ofs,cnt,y: integer;369 s: string;370 HelpLineInfo: THelpLineInfo;371 begin372 inherited;373 CaptionColor:=Colors.Canvas.Pixels[clkMisc,cliPaperCaption];374 FillSeamless(offscreen.Canvas,0,0,InnerWidth,InnerHeight,0,sb.si.npos*24,375 Paper);376 with offscreen.Canvas do377 begin378 Font.Assign(UniFont[ftNormal]);379 for i:=-sb.si.npos to InnerHeight div 24 do380 if sb.si.npos+i<MainText.Count then381 begin382 HelpLineInfo:=THelpLineInfo(MainText.Objects[sb.si.npos+i]);383 if HelpLineInfo.Format=pkExternal then384 begin385 yl:=ExtPic.Height;386 if 4+i*24+yl>InnerHeight then yl:=InnerHeight-(4+i*24);387 BitBlt(Handle,8,4+i*24,ExtPic.Width,yl,388 ExtPic.Canvas.Handle,0,0,SRCCOPY);389 end390 end;391 for i:=-2 to InnerHeight div 24 do392 if (sb.si.npos+i>=0) and (sb.si.npos+i<MainText.Count) then393 begin394 HelpLineInfo:=THelpLineInfo(MainText.Objects[sb.si.npos+i]);395 if HelpLineInfo.Link<>0 then396 begin397 if (Kind=hkMisc) and (no=miscSearchResult) then398 Sprite(offscreen,HGrSystem,18,9+i*24,8,8,90,16)399 else if HelpLineInfo.Format in [pkSmallIcon_AsPreq,pkAdvIcon_AsPreq] then400 Sprite(offscreen,HGrSystem,12,i*24+5,14,14,65,20)401 else if HelpLineInfo.Link and (hkCrossLink shl 8)<>0 then402 Sprite(offscreen,HGrSystem,12,i*24+5,14,14,80,1)403 else if not ((Kind=hkMisc) and (no=miscMain)) then404 Sprite(offscreen,HGrSystem,10,i*24+6,14,14,65,1);405 x0[i]:=24;406 end407 else x0[i]:=0;408 case HelpLineInfo.Format of409 pkLogo:410 begin411 Server(sGetVersion,0,0,j);412 s:=Format('%d.%d.%d',[j shr 16 and $FF, j shr 8 and $FF, j and $FF]);413 PaintLogo(offscreen.canvas,(InnerWidth-122) div 2,i*24+1,414 GrExt[HGrSystem].Data.Canvas.Pixels[95,1],$000000);415 Font.Assign(UniFont[ftSmall]);416 BiColorTextout(offscreen.Canvas,$000000,$7F007F,417 (InnerWidth-TextWidth(s)) div 2,i*24+26,s);418 Font.Assign(UniFont[ftNormal]);419 end;420 pkSmallIcon,pkSmallIcon_AsPreq:421 begin422 Frame(offscreen.Canvas,8-1+x0[i],2-1+i*24,8+xSizeSmall+x0[i],2+20+i*24,423 $000000,$000000);424 if HelpLineInfo.Picpix=imPalace then425 BitBlt(offscreen.Canvas.Handle,8+x0[i],2+i*24,xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle,426 0*xSizeSmall,1*ySizeSmall,SRCCOPY)427 else BitBlt(offscreen.Canvas.Handle,8+x0[i],2+i*24,xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle,428 HelpLineInfo.Picpix mod 7*xSizeSmall,(HelpLineInfo.Picpix+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY);429 x0[i]:=x0[i]+(8+8+36);430 end;431 pkBigIcon:432 begin433 FrameImage(offscreen.canvas,BigImp,x0[i]+12,i*24-7,56,40,434 HelpLineInfo.Picpix mod 7*xSizeBig,435 HelpLineInfo.Picpix div 7*ySizeBig);436 x0[i]:=64+8+8+x0[i];437 end;438 pkSpecialIcon:439 begin440 case HelpLineInfo.Picpix of441 0:442 FrameImage(Offscreen.Canvas, GrExt[HGrSystem2].Data, 12+x0[i],-7+i*24, 56, 40, 137, 127);443 1:444 begin445 PaintTerrIcon(12+x0[i],-7+i*24, 1+3*(xxt*2+1), 1+yyt);446 if 2*yyt<40 then447 Sprite(Offscreen, HGrTerrain, 12+x0[i],-7+4+i*24, 56, 2*yyt, 1+3*(xxt*2+1)+xxt-28, 1+yyt+1*(yyt*3+1))448 else Sprite(Offscreen, HGrTerrain, 12+x0[i],-7+4+i*24-4, 56, 40, 1+3*(xxt*2+1)+xxt-28, 1+yyt+1*(yyt*3+1)+yyt-20);449 end;450 2:451 begin452 PaintTerrIcon(12+x0[i],-7+i*24, 1+7*(xxt*2+1), 1+yyt+4*(yyt*3+1));453 if 2*yyt<40 then454 Sprite(Offscreen, HGrTerrain, 12+x0[i],-7+4+i*24, 56, 32, 1+4*(xxt*2+1)+xxt-28, 1+yyt+12*(yyt*3+1)+yyt-16)455 else Sprite(Offscreen, HGrTerrain, 12+x0[i],-7+4+i*24, 56, 32, 1+4*(xxt*2+1)+xxt-28, 1+yyt+12*(yyt*3+1)+yyt-16)456 end;457 end;458 x0[i]:=64+8+8+x0[i];459 end;460 pkDomain:461 begin462 Frame(offscreen.Canvas,8-1+x0[i],2-1+i*24,8+36+x0[i],2+20+i*24,463 $000000,$000000);464 Dump(offscreen,HGrSystem,8+x0[i],2+i*24,36,20,465 75+HelpLineInfo.Picpix*37,295);466 x0[i]:=x0[i]+(8+8+36);467 end;468 pkAdvIcon,pkAdvIcon_AsPreq:469 begin470 Frame(offscreen.Canvas,8-1+x0[i],2-1+i*24,8+xSizeSmall+x0[i],2+ySizeSmall+i*24,471 $000000,$000000);472 if AdvIcon[HelpLineInfo.Picpix]<84 then473 BitBlt(offscreen.Canvas.Handle,8+x0[i],2+i*24,xSizeSmall,ySizeSmall,474 SmallImp.Canvas.Handle, (AdvIcon[HelpLineInfo.Picpix]+SystemIconLines*7) mod 7*xSizeSmall,475 (AdvIcon[HelpLineInfo.Picpix]+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY)476 else477 Dump(offscreen,HGrSystem,8+x0[i],2+i*24,36,20,478 1+(AdvIcon[HelpLineInfo.Picpix]-84) mod 8*37,479 295+(AdvIcon[HelpLineInfo.Picpix]-84) div 8*21);480 j:=AdvValue[HelpLineInfo.Picpix] div 1000;481 BitBlt(Handle,x0[i]+4,4+i*24,14,14,482 GrExt[HGrSystem].Mask.Canvas.Handle,127+j*15,85,SRCAND);483 Sprite(offscreen,HGrSystem,x0[i]+3,3+i*24,14,14,127+j*15,85);484 x0[i]:=x0[i]+(8+8+36);485 end;486 pkRightIcon:487 begin488 if Imp[HelpLineInfo.Picpix].Kind<>ikWonder then489 ImpImage(Offscreen.Canvas,InnerWidth-(40+xSizeBig),i*24,490 HelpLineInfo.Picpix, gDespotism)491 else WaterSign(InnerWidth-(40+2*xSizeBig),i*24-8,HelpLineInfo.Picpix+7);492 x0[i]:=x0[i]+8;493 end;494 pkIllu:495 WaterSign(8,i*24-8,HelpLineInfo.Picpix);496 pkBigFeature:497 begin498 cnt:=0;499 for j:=nDomains-1 downto 0 do500 if 1 shl j and Feature[HelpLineInfo.Picpix].Domains<>0 then501 begin502 inc(cnt);503 Dump(offscreen,HGrSystem,InnerWidth-38-38*cnt,i*24+1,36,20,75+j*37,295);504 Frame(offscreen.canvas,InnerWidth-39-38*cnt,i*24,505 InnerWidth-2-38*cnt,i*24+21,506 $000000,$000000);507 end;508 DarkGradient(offscreen.Canvas,InnerWidth-38-38*cnt,i*24+23,cnt*38-2,1);509 ofs:=InnerWidth-(39+7)-19*cnt;510 with offscreen.Canvas do511 begin512 Brush.Color:=$C0C0C0;513 FrameRect(Rect(ofs,1+23+i*24,ofs+14,15+23+i*24));514 Brush.Style:=bsClear;515 Sprite(offscreen,HGrSystem,ofs+2,3+23+i*24,10,10,516 66+HelpLineInfo.Picpix mod 11 *11,517 137+HelpLineInfo.Picpix div 11 *11);518 end;519 x0[i]:=x0[i]+8;520 end;521 pkTer,pkBigTer:522 begin523 if HelpLineInfo.Format=pkBigTer then524 y:=i*24-3+yyt525 else y:=i*24+13;526 if HelpLineInfo.Picpix>=3*12 then srcno:=2*9+6527 else if HelpLineInfo.Picpix mod 12=fJungle then srcno:=18*9528 else if HelpLineInfo.Picpix mod 12<fJungle then529 srcno:=HelpLineInfo.Picpix mod 12530 else srcno:=27+(HelpLineInfo.Picpix mod 12-9)*18;531 if HelpLineInfo.Format=pkTer then532 begin ofs:=x0[i]+8; x0[i]:=2*xxt+8+ofs; end533 else begin ofs:=InnerWidth-(2*xxt+38); x0[i]:=x0[i]+8; end;534 if srcno>=fJungle then535 begin536 Sprite(offscreen,HGrTerrain,ofs+4,y-yyt+2,xxt*2-8,yyt*2-4,537 5+2*(xxt*2+1),3+yyt+2*(yyt*3+1));538 Sprite(offscreen,HGrTerrain,ofs,y-2*yyt,xxt*2,yyt*3-2,539 1+srcno mod 9 *(xxt*2+1),1+srcno div 9 *(yyt*3+1));540 end541 else Sprite(offscreen,HGrTerrain,ofs+4,y-yyt+2,xxt*2-8,yyt*2-4,542 5+srcno mod 9 *(xxt*2+1),3+yyt+srcno div 9 *(yyt*3+1));543 if HelpLineInfo.Picpix>=3*12 then {rare resource}544 Sprite(offscreen,HGrTerrain,ofs,y-2*yyt,xxt*2,yyt*3,545 1+8*(xxt*2+1), 1+(HelpLineInfo.Picpix-2*12)*(yyt*3+1))546 else if HelpLineInfo.Picpix>=12 then {special tile}547 begin548 if HelpLineInfo.Picpix mod 12=fJungle then srcno:=17*9+8549 else if HelpLineInfo.Picpix mod 12<fJungle then550 srcno:=HelpLineInfo.Picpix mod 12551 else srcno:=18+8+(HelpLineInfo.Picpix mod 12-9)*18;552 srcno:=srcno+HelpLineInfo.Picpix div 12*9;553 Sprite(offscreen,HGrTerrain,ofs,y-2*yyt,xxt*2,yyt*3,554 1+srcno mod 9 *(xxt*2+1),1+srcno div 9 *(yyt*3+1));555 end;556 end;557 pkTerImp:558 begin559 ofs:=8;560 if HelpLineInfo.Picpix=5 then561 begin // display mine on hills562 Sprite(offscreen,HGrTerrain,ofs+4,i*24+13-yyt,xxt*2-8,yyt*2-4,563 5+2*(xxt*2+1),3+yyt+2*(yyt*3+1));564 srcno:=45565 end566 else srcno:=fPrairie; // display on prairie567 Sprite(offscreen,HGrTerrain,ofs+4,i*24+13-yyt,xxt*2-8,yyt*2-4,568 5+srcno mod 9 *(xxt*2+1),3+yyt+srcno div 9 *(yyt*3+1));569 if HelpLineInfo.Picpix=12 then {river}570 Sprite(offscreen,HGrTerrain,ofs,i*24+11-yyt,xxt*2,yyt*2,1+5*(xxt*2+1),571 1+yyt+13*(yyt*3+1))572 else if HelpLineInfo.Picpix>=3 then {improvement 2}573 begin574 if HelpLineInfo.Picpix=6 then575 Sprite(offscreen,HGrTerrain,ofs,i*24+11-2*yyt,xxt*2,yyt*3,576 1+7 *(xxt*2+1),1+12 *(yyt*3+1));577 Sprite(offscreen,HGrTerrain,ofs,i*24+11-2*yyt,xxt*2,yyt*3,578 1+(HelpLineInfo.Picpix-3)*(xxt*2+1), 1+12*(yyt*3+1))579 end580 else {improvement 1}581 begin582 Sprite(offscreen,HGrTerrain,ofs,i*24+11-2*yyt,xxt*2,yyt*3,583 1+2*(xxt*2+1),1+(9+HelpLineInfo.Picpix)*(yyt*3+1));584 Sprite(offscreen,HGrTerrain,ofs,i*24+11-2*yyt,xxt*2,yyt*3,585 1+5*(xxt*2+1),1+(9+HelpLineInfo.Picpix)*(yyt*3+1))586 end;587 x0[i]:=x0[i]+8;588 end;589 pkModel:590 begin591 FrameImage(offscreen.canvas,BigImp,x0[i]+12,i*24-7,56,40,0,0);592 Sprite(offscreen,HGrStdUnits,x0[i]+8,i*24-11,64,44,593 1+HelpLineInfo.Picpix mod 10 *65,1+HelpLineInfo.Picpix div 10 *49);594 x0[i]:=64+8+8+x0[i];595 end;596 pkFeature:597 begin598 DarkGradient(offscreen.Canvas,x0[i]+8-1,7+i*24-3,16,1);599 Frame(offscreen.canvas,x0[i]+8,7+i*24-2,x0[i]+8+13,7+i*24-2+13,600 $C0C0C0,$C0C0C0);601 Sprite(offscreen,HGrSystem,x0[i]+8+2,7+i*24,10,10,602 66+HelpLineInfo.Picpix mod 11*11,137+HelpLineInfo.Picpix div 11*11);603 x0[i]:=x0[i]+8+8+2+13;604 end;605 pkExp:606 begin607 Frame(offscreen.Canvas,20-1,8-4+i*24,20+12,8+11+i*24,$000000,$000000);608 Dump(offscreen,HGrSystem,20,8-3+i*24,12,14,121+HelpLineInfo.Picpix*13,28);609 x0[i]:=20+8+11;610 end;611 pkAITStat:612 begin613 Sprite(offscreen,HGrSystem,20,6+i*24,14,14,1+HelpLineInfo.Picpix*15,316);614 x0[i]:=20+8+11;615 end;616 pkGov:617 begin618 Frame(offscreen.Canvas,8-1+x0[i],2-1+i*24,8+xSizeSmall+x0[i],2+20+i*24,619 $000000,$000000);620 BitBlt(offscreen.Canvas.Handle,8+x0[i],2+i*24,xSizeSmall,ySizeSmall,SmallImp.Canvas.Handle,621 (HelpLineInfo.Picpix-1)*xSizeSmall,ySizeSmall,SRCCOPY);622 x0[i]:=x0[i]+(8+8+36);623 end;624 pkDot:625 begin626 Sprite(offscreen,HGrSystem,x0[i]+18,9+i*24,8,8,81,16);627 x0[i]:=20+8+4;628 end;629 pkNormal_Dot:630 x0[i]:=20+8+4;631 pkNormal_64:632 x0[i]:=64+8+8;633 else x0[i]:=x0[i]+8634 end;635 line(offscreen.Canvas,i,false)636 end637 end;638 MarkUsedOffscreen(InnerWidth,InnerHeight+13+48);639 end; {OffscreenPaint}640 641 procedure THelpDlg.Prepare(sbPos: integer = 0);642 var643 i,j,special,Domain,Headline,TerrType,TerrSubType: integer;644 s: string;645 ps: pchar;646 List: THyperText;647 CheckSeeAlso: boolean;648 649 procedure AddAdv(i: integer);650 begin651 MainText.AddLine(Phrases.Lookup('ADVANCES',i),pkAdvIcon,i,hkAdv+hkCrossLink,i);652 end;653 654 procedure AddPreqAdv(i: integer);655 begin656 MainText.AddLine(Phrases.Lookup('ADVANCES',i),pkAdvIcon_AsPreq,i,hkAdv+hkCrossLink,i);657 end;658 659 procedure AddImp(i: integer);660 begin661 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp+hkCrossLink,i);662 end;663 664 procedure AddPreqImp(i: integer);665 begin666 MainText.AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon_AsPreq,i,hkImp+hkCrossLink,i);667 end;668 669 procedure AddTer(i: integer);670 begin671 if MainText.Count>1 then begin MainText.LF; end;672 MainText.AddLine(Phrases.Lookup('TERRAIN',i),pkTer,i,hkTer,i);673 end;674 675 procedure AddFeature(i: integer);676 begin677 MainText.AddLine(Phrases.Lookup('FEATURES',i),pkFeature,i,hkFeature+hkCrossLink,i);678 end;679 680 procedure AddModel(i: integer);681 var682 pix: integer;683 Name: string;684 begin685 if MainText.Count>1 then MainText.LF;686 FindStdModelPicture(SpecialModelPictureCode[i],pix,Name);687 MainText.AddLine(Name,pkModel,pix,hkModel+hkCrossLink,i)688 end;689 690 procedure AddStandardBlock(Item: string);691 var692 i: integer;693 begin694 with MainText do695 begin696 if Item='LOGO' then697 begin AddLine('',pkLogo); LF; end698 else if Item='TECHFORMULA' then699 begin700 i:=Difficulty;701 if i=0 then i:=2;702 AddLine(Format(HelpText.Lookup('TECHFORMULA'),[TechFormula_M[i],TechFormula_D[i]]))703 end704 else if Item='EXPERIENCE' then705 for i:=0 to nExp-1 do AddLine(Phrases.Lookup('EXPERIENCE',i),pkExp,i)706 else if Item='MODERN' then707 for i:=1 to 3 do708 begin709 LF;710 AddLine(Phrases.Lookup('TERRAIN',3*12+i),pkTer,3*12+i);711 end712 else if Item='SAVED' then713 AddLine(DataDir+'Saved',pkNormal)714 else if Item='AITSTAT' then715 for i:=0 to 3 do AddLine(Phrases2.Lookup('AITSTAT',i),pkAITStat,i)716 end717 end;718 719 procedure DecodeItem(s: string; var Category, Index: integer);720 var721 i: integer;722 begin723 if (length(s)>0) and (s[1]=':') then724 begin725 Category:=hkMisc;726 Index:=0;727 for i:=3 to Length(s) do Index:=Index*10+ord(s[i])-48;728 case s[2] of729 'A': Category:=hkAdv;730 'B': Category:=hkImp;731 'T': Category:=hkTer;732 'F': Category:=hkFeature;733 'E': Category:=hkInternet;734 'S': Category:=hkModel;735 'C': Index:=miscCredits;736 'J': Index:=miscJobList;737 'G': Index:=miscGovList;738 end;739 if (Category<>hkMisc) and (Index=0) then740 Index:=200;741 end742 else743 begin744 Category:=hkText;745 Index:=HelpText.GetHandle(copy(s,1,255));746 end;747 end;748 749 procedure AddText(s: string);750 var751 i,p,l,ofs,CurrentFormat,FollowFormat,Picpix,LinkCategory,LinkIndex,RightMargin: integer;752 Name: string;753 begin754 RightMargin:=InnerWidth-16-GetSystemMetrics(SM_CXVSCROLL);755 FollowFormat:=pkNormal;756 while s<>'' do757 begin758 Picpix:=0;759 LinkCategory:=0;760 LinkIndex:=0;761 if s[1]='$' then762 begin // window caption763 p:=1;764 repeat inc(p) until (p>Length(s)) or (s[p]='\');765 Caption:=Copy(s,2,p-2);766 Delete(s,1,p);767 end768 else if s[1]='&' then769 begin // standard block770 p:=1;771 repeat inc(p) until (p>Length(s)) or (s[p]='\');772 AddStandardBlock(Copy(s,2,p-2));773 Delete(s,1,p);774 end775 else if s[1]='@' then776 begin // image777 if (Length(s)>=2) and (s[2]='@') then778 begin // generate from icon779 Picpix:=0;780 p:=3;781 while (p<=Length(s)) and (s[p]<>'\') do782 begin Picpix:=Picpix*10+ord(s[p])-48; inc(p) end;783 if (Picpix<0) or (Picpix>=nImp) then Picpix:=0;784 MainText.AddLine('',pkIllu,Picpix);785 MainText.LF;786 MainText.LF;787 end788 else789 begin // external image790 p:=1;791 repeat inc(p) until (p>Length(s)) or (s[p]='\');792 if LoadLocalizedGraphicFile(ExtPic, 'Help\'+Copy(s,2,p-2)) then793 begin794 MainText.AddLine('',pkExternal);795 for i:=0 to (ExtPic.Height-12) div 24 do MainText.LF;796 end;797 end;798 Delete(s,1,p);799 end800 else801 begin802 case s[1] of803 ':',';':804 begin // link805 p:=1;806 repeat inc(p) until (p>Length(s)) or (s[p]='\') or (s[p]=' ');807 DecodeItem(copy(s,2,p-2), LinkCategory, LinkIndex);808 CurrentFormat:=0;809 if (LinkCategory<>hkText) and (LinkIndex<200) then // show icon810 case LinkCategory of811 hkAdv:812 begin CurrentFormat:=pkAdvIcon; Picpix:=LinkIndex end;813 hkImp:814 begin CurrentFormat:=pkSmallIcon; Picpix:=LinkIndex end;815 hkTer:816 begin CurrentFormat:=pkTer; Picpix:=LinkIndex end;817 hkFeature:818 begin CurrentFormat:=pkFeature; Picpix:=LinkIndex end;819 hkModel:820 begin821 CurrentFormat:=pkModel;822 FindStdModelPicture(SpecialModelPictureCode[LinkIndex],Picpix,Name);823 end;824 end;825 if s[1]=':' then LinkCategory:=LinkCategory+hkCrossLink;826 if (p>Length(s)) or (s[p]=' ') then Delete(s,1,p)827 else Delete(s,1,p-1)828 end;829 '!': // highlited830 if (length(s)>=2) and (s[2]='!') then831 begin832 if MainText.Count>1 then MainText.LF;833 FollowFormat:=pkCaption;834 CurrentFormat:=pkCaption;835 Delete(s,1,2);836 end837 else838 begin839 FollowFormat:=pkSection;840 CurrentFormat:=pkSection;841 Delete(s,1,1);842 end;843 '-':844 begin // list845 FollowFormat:=pkNormal_Dot;846 CurrentFormat:=pkDot;847 Delete(s,1,1);848 end;849 else CurrentFormat:=FollowFormat;850 end;851 if FollowFormat=pkNormal_Dot then ofs:=20+4+8852 else ofs:=8;853 p:=0;854 repeat855 repeat inc(p) until (p>Length(s)) or (s[p]=' ') or (s[p]='\');856 if (BiColorTextWidth(Offscreen.Canvas,Copy(s,1,p-1))<=RightMargin-ofs) then857 l:=p-1858 else Break;859 until (p>=Length(s)) or (s[l+1]='\');860 MainText.AddLine(Copy(s,1,l),CurrentFormat,Picpix,LinkCategory,LinkIndex);861 if (l<Length(s)) and (s[l+1]='\') then FollowFormat:=pkNormal;862 Delete(s,1,l+1);863 end864 end865 end;866 1050 867 1051 procedure AddItem(Item: string); 868 1052 begin 869 AddText(HelpText.Lookup(Item));1053 AddText(HelpText.Lookup(Item)); 870 1054 end; 871 1055 872 1056 procedure AddModelText(i: integer); 873 1057 var 874 pix: integer; 875 s: string; 876 begin 877 with MainText do 878 begin 879 if Count>1 then begin LF; LF; end; 880 FindStdModelPicture(SpecialModelPictureCode[i],pix,s); 881 AddLine(s,pkSection); 882 AddLine(Format(HelpText.Lookup('STRENGTH'), 883 [SpecialModel[i].Attack,SpecialModel[i].Defense]),pkNormal_64); 884 AddLine(Format(HelpText.Lookup('SPEED'), 885 [MovementToString(SpecialModel[i].Speed)]),pkModel,pix); 886 if Difficulty=0 then 887 AddLine(Format(HelpText.Lookup('BUILDCOST'), 888 [SpecialModel[i].Cost]),pkNormal_64) 889 else AddLine(Format(HelpText.Lookup('BUILDCOST'), 890 [SpecialModel[i].Cost*BuildCostMod[Difficulty] div 12]),pkNormal_64); 891 s:=HelpText.LookupByHandle(hSPECIALMODEL,i); 892 if (s<>'') and (s<>'*') then AddText(s); 893 if SpecialModelPreq[i]>=0 then AddPreqAdv(SpecialModelPreq[i]) 894 else if SpecialModelPreq[i]=preLighthouse then AddPreqImp(woLighthouse) 895 else if SpecialModelPreq[i]=preBuilder then AddPreqImp(woPyramids) 896 else if SpecialModelPreq[i]=preLeo then AddPreqImp(woLeo); 897 if SpecialModelPreq[i]<>preNone then 898 MainText[Count-1]:=Format(HelpText.Lookup('REQUIRED'),[MainText[Count-1]]); 1058 pix: integer; 1059 s: string; 1060 begin 1061 with MainText do 1062 begin 1063 if Count > 1 then 1064 begin 1065 LF; 1066 LF; 1067 end; 1068 FindStdModelPicture(SpecialModelPictureCode[i], pix, s); 1069 AddLine(s, pkSection); 1070 AddLine(Format(HelpText.Lookup('STRENGTH'), [SpecialModel[i].Attack, 1071 SpecialModel[i].Defense]), pkNormal_64); 1072 AddLine(Format(HelpText.Lookup('SPEED'), 1073 [MovementToString(SpecialModel[i].Speed)]), pkModel, pix); 1074 if Difficulty = 0 then 1075 AddLine(Format(HelpText.Lookup('BUILDCOST'), [SpecialModel[i].Cost]), 1076 pkNormal_64) 1077 else 1078 AddLine(Format(HelpText.Lookup('BUILDCOST'), 1079 [SpecialModel[i].Cost * BuildCostMod[Difficulty] div 12]), 1080 pkNormal_64); 1081 s := HelpText.LookupByHandle(hSPECIALMODEL, i); 1082 if (s <> '') and (s <> '*') then 1083 AddText(s); 1084 if SpecialModelPreq[i] >= 0 then 1085 AddPreqAdv(SpecialModelPreq[i]) 1086 else if SpecialModelPreq[i] = preLighthouse then 1087 AddPreqImp(woLighthouse) 1088 else if SpecialModelPreq[i] = preBuilder then 1089 AddPreqImp(woPyramids) 1090 else if SpecialModelPreq[i] = preLeo then 1091 AddPreqImp(woLeo); 1092 if SpecialModelPreq[i] <> preNone then 1093 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), 1094 [MainText[Count - 1]]); 899 1095 end 900 1096 end; … … 902 1098 procedure AddJobList; 903 1099 var 904 i,JobCost: integer;905 begin 906 with MainText do907 begin 908 for i:=0 to nJobHelp-1 do1100 i, JobCost: integer; 1101 begin 1102 with MainText do 1103 begin 1104 for i := 0 to nJobHelp - 1 do 909 1105 begin 910 if i>0 then begin LF; LF end; 911 AddLine(Phrases.Lookup('JOBRESULT',JobHelp[i]),pkSection); 912 AddLine; 913 AddLine('',pkTerImp,i); 914 AddLine; 915 AddText(HelpText.LookupByHandle(hJOBHELP,i)); 916 JobCost:=-1; 917 case JobHelp[i] of 918 jCanal: JobCost:=CanalWork; 919 jFort: JobCost:=FortWork; 920 jBase: JobCost:=BaseWork; 1106 if i > 0 then 1107 begin 1108 LF; 1109 LF 921 1110 end; 922 if JobCost>=0 then 923 AddText(Format(HelpText.Lookup('JOBCOST'),[MovementToString(JobCost)])) 924 else AddText(HelpText.Lookup('JOBCOSTVAR')); 925 if JobPreq[JobHelp[i]]<>preNone then 1111 AddLine(Phrases.Lookup('JOBRESULT', JobHelp[i]), pkSection); 1112 AddLine; 1113 AddLine('', pkTerImp, i); 1114 AddLine; 1115 AddText(HelpText.LookupByHandle(hJOBHELP, i)); 1116 JobCost := -1; 1117 case JobHelp[i] of 1118 jCanal: 1119 JobCost := CanalWork; 1120 jFort: 1121 JobCost := FortWork; 1122 jBase: 1123 JobCost := BaseWork; 1124 end; 1125 if JobCost >= 0 then 1126 AddText(Format(HelpText.Lookup('JOBCOST'), 1127 [MovementToString(JobCost)])) 1128 else 1129 AddText(HelpText.Lookup('JOBCOSTVAR')); 1130 if JobPreq[JobHelp[i]] <> preNone then 926 1131 begin 927 AddPreqAdv(JobPreq[JobHelp[i]]); 928 MainText[Count-1]:=Format(HelpText.Lookup('REQUIRED'),[MainText[Count-1]]); 1132 AddPreqAdv(JobPreq[JobHelp[i]]); 1133 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), 1134 [MainText[Count - 1]]); 929 1135 end 930 1136 end; … … 934 1140 procedure AddGraphicCredits; 935 1141 var 936 i: integer; 937 s: string; 938 sr: TSearchRec; 939 List, plus: tstringlist; 940 begin 941 List:=tstringlist.Create; 942 plus:=tstringlist.Create; 943 if FindFirst(HomeDir+'Graphics\*.credits.txt',$27,sr)=0 then 944 repeat 945 plus.LoadFromFile(HomeDir+'Graphics\'+sr.Name); 946 List.AddStrings(plus); 947 until FindNext(sr)<>0; 948 FindClose(sr); 949 plus.Free; 950 951 List.Sort; 952 i:=1; 953 while i<List.Count do 954 if List[i]=List[i-1] then List.Delete(i) 955 else inc(i); 956 957 for i:=0 to List.Count-1 do 958 begin 959 s:=List[i]; 960 while BiColorTextWidth(Offscreen.Canvas,s)>InnerWidth-16 961 -GetSystemMetrics(SM_CXVSCROLL) do 962 Delete(s,Length(s),1); 963 MainText.AddLine(s); 1142 i: integer; 1143 s: string; 1144 sr: TSearchRec; 1145 List, plus: TStringList; 1146 begin 1147 List := TStringList.Create; 1148 plus := TStringList.Create; 1149 if FindFirst(HomeDir + 'Graphics\*.credits.txt', $27, sr) = 0 then 1150 repeat 1151 plus.LoadFromFile(HomeDir + 'Graphics\' + sr.Name); 1152 List.AddStrings(plus); 1153 until FindNext(sr) <> 0; 1154 FindClose(sr); 1155 plus.Free; 1156 1157 List.Sort; 1158 i := 1; 1159 while i < List.Count do 1160 if List[i] = List[i - 1] then 1161 List.Delete(i) 1162 else 1163 inc(i); 1164 1165 for i := 0 to List.Count - 1 do 1166 begin 1167 s := List[i]; 1168 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - 1169 GetSystemMetrics(SM_CXVSCROLL) do 1170 Delete(s, length(s), 1); 1171 MainText.AddLine(s); 964 1172 end; 965 List.Free;1173 List.Free; 966 1174 end; 967 1175 968 1176 procedure AddSoundCredits; 969 1177 var 970 i: integer;971 s: string;972 List: tstringlist;973 begin 974 List:=tstringlist.Create;975 List.LoadFromFile(HomeDir+'Sounds\sound.credits.txt');976 for i:=0 to List.Count-1 do977 begin 978 s:=List[i];979 while BiColorTextWidth(Offscreen.Canvas,s)>InnerWidth-16980 -GetSystemMetrics(SM_CXVSCROLL) do981 Delete(s,Length(s),1);982 MainText.AddLine(s);1178 i: integer; 1179 s: string; 1180 List: TStringList; 1181 begin 1182 List := TStringList.Create; 1183 List.LoadFromFile(HomeDir + 'Sounds\sound.credits.txt'); 1184 for i := 0 to List.Count - 1 do 1185 begin 1186 s := List[i]; 1187 while BiColorTextWidth(OffScreen.Canvas, s) > InnerWidth - 16 - 1188 GetSystemMetrics(SM_CXVSCROLL) do 1189 Delete(s, length(s), 1); 1190 MainText.AddLine(s); 983 1191 end; 984 List.Free;1192 List.Free; 985 1193 end; 986 1194 987 1195 procedure NextSection(Item: string); 988 1196 begin 989 if MainText.Count>1 then 990 if MainText.Count=Headline+1 then MainText.Delete(Headline) 991 else MainText.LF; 992 MainText.AddLine(HelpText.Lookup(Item),pkSection); 993 Headline:=MainText.Count-1; 994 end; 995 996 begin {Prepare} 997 with MainText do 998 begin 999 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 1000 CheckSeeAlso:=false; 1001 Clear; 1002 Headline:=-1; 1003 if (no>=200) or not (Kind in [hkAdv,hkImp,hkTer,hkFeature]) then 1004 LF; 1005 case Kind of 1006 hkText: AddText(HelpText.LookupByHandle(no)); 1007 hkMisc: 1008 begin 1009 case no of 1010 miscMain: 1197 if MainText.Count > 1 then 1198 if MainText.Count = Headline + 1 then 1199 MainText.Delete(Headline) 1200 else 1201 MainText.LF; 1202 MainText.AddLine(HelpText.Lookup(Item), pkSection); 1203 Headline := MainText.Count - 1; 1204 end; 1205 1206 begin { Prepare } 1207 with MainText do 1208 begin 1209 OffScreen.Canvas.Font.Assign(UniFont[ftNormal]); 1210 CheckSeeAlso := false; 1211 Clear; 1212 Headline := -1; 1213 if (no >= 200) or not(Kind in [hkAdv, hkImp, hkTer, hkFeature]) then 1214 LF; 1215 case Kind of 1216 hkText: 1217 AddText(HelpText.LookupByHandle(no)); 1218 hkMisc: 1219 begin 1220 case no of 1221 miscMain: 1222 begin 1223 Caption := HelpText.Lookup('HELPTITLE_MAIN'); 1224 AddLine(HelpText.Lookup('HELPTITLE_QUICKSTART'), pkSpecialIcon, 1225 0, { pkBigIcon,22, } hkText, HelpText.Gethandle('QUICK')); 1226 LF; 1227 AddLine(HelpText.Lookup('HELPTITLE_CONCEPTS'), pkBigIcon, 6, 1228 hkText, HelpText.Gethandle('CONCEPTS')); 1229 LF; 1230 AddLine(HelpText.Lookup('HELPTITLE_TERLIST'), pkSpecialIcon, 1, 1231 hkTer, 200); 1232 LF; 1233 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkSpecialIcon, 2, 1234 hkMisc, miscJobList); 1235 LF; 1236 AddLine(HelpText.Lookup('HELPTITLE_TECHLIST'), pkBigIcon, 39, 1237 hkAdv, 200); 1238 LF; 1239 FindStdModelPicture(SpecialModelPictureCode[6], i, s); 1240 AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkModel, i, 1241 hkModel, 0); 1242 LF; 1243 AddLine(HelpText.Lookup('HELPTITLE_FEATURELIST'), pkBigIcon, 28, 1244 hkFeature, 200); 1245 LF; 1246 AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'), pkBigIcon, 1247 7 * SystemIconLines + imCourt, hkImp, 200); 1248 LF; 1249 AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'), pkBigIcon, 1250 7 * SystemIconLines + imStockEx, hkImp, 201); 1251 LF; 1252 AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'), pkBigIcon, 1253 7 * SystemIconLines, hkImp, 202); 1254 LF; 1255 AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkBigIcon, 1256 gDemocracy + 6, hkMisc, miscGovList); 1257 LF; 1258 AddLine(HelpText.Lookup('HELPTITLE_KEYS'), pkBigIcon, 2, hkText, 1259 HelpText.Gethandle('HOTKEYS')); 1260 LF; 1261 AddLine(HelpText.Lookup('HELPTITLE_ABOUT'), pkBigIcon, 1, 1262 hkText, HelpText.Gethandle('ABOUT')); 1263 LF; 1264 AddLine(HelpText.Lookup('HELPTITLE_CREDITS'), pkBigIcon, 22, 1265 hkMisc, miscCredits); 1266 end; 1267 miscCredits: 1268 begin 1269 AddItem('CREDITS'); 1270 LF; 1271 AddGraphicCredits; 1272 NextSection('CRED_CAPSOUND'); 1273 AddSoundCredits; 1274 NextSection('CRED_CAPAI'); 1275 Server(sGetAICredits, 0, 0, ps); 1276 AddText(ps); 1277 NextSection('CRED_CAPLANG'); 1278 AddItem('AUTHOR'); 1279 end; 1280 miscJobList: 1281 begin 1282 Caption := HelpText.Lookup('HELPTITLE_JOBLIST'); 1283 AddJobList; 1284 LF; 1285 AddItem('TERIMPEXCLUDE'); 1286 LF; 1287 AddItem('TERIMPCITY'); 1288 end; 1289 miscGovList: 1290 begin 1291 Caption := HelpText.Lookup('HELPTITLE_GOVLIST'); 1292 for i := 1 to nGov do 1293 begin 1294 AddLine(Phrases.Lookup('GOVERNMENT', i mod nGov), pkSection); 1295 LF; 1296 if i = nGov then 1297 AddLine('', pkBigIcon, 7 * SystemIconLines + imPalace) 1298 else 1299 AddLine('', pkBigIcon, i + 6); 1300 LF; 1301 AddText(HelpText.LookupByHandle(hGOVHELP, i mod nGov)); 1302 if i mod nGov >= 2 then 1303 begin 1304 AddPreqAdv(GovPreq[i mod nGov]); 1305 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), 1306 [MainText[Count - 1]]); 1307 end; 1308 if i < nGov then 1309 begin 1310 LF; 1311 LF; 1312 end 1313 end 1314 end; 1315 miscSearchResult: 1316 begin 1317 Caption := HelpText.Lookup('HELPTITLE_SEARCHRESULTS'); 1318 AddText(Format(HelpText.Lookup('MATCHES'), [SearchContent])); 1319 MainText.AddStrings(SearchResult); 1320 end 1321 end; // case no 1322 end; 1323 1324 hkAdv: 1325 if no = 200 then 1326 begin // complete advance list 1327 Caption := HelpText.Lookup('HELPTITLE_TECHLIST'); 1328 List := THyperText.Create; 1329 for j := 0 to 3 do 1011 1330 begin 1012 Caption:=HelpText.Lookup('HELPTITLE_MAIN'); 1013 AddLine(HelpText.Lookup('HELPTITLE_QUICKSTART'),pkSpecialIcon,0,{pkBigIcon,22,}hkText,HelpText.GetHandle('QUICK')); LF; 1014 AddLine(HelpText.Lookup('HELPTITLE_CONCEPTS'),pkBigIcon,6,hkText,HelpText.GetHandle('CONCEPTS')); LF; 1015 AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSpecialIcon,1,hkTer,200); LF; 1016 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'),pkSpecialIcon,2,hkMisc,miscJobList); LF; 1017 AddLine(HelpText.Lookup('HELPTITLE_TECHLIST'),pkBigIcon,39,hkAdv,200); LF; 1018 FindStdModelPicture(SpecialModelPictureCode[6],i,s); 1019 AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'),pkModel,i,hkModel,0); LF; 1020 AddLine(HelpText.Lookup('HELPTITLE_FEATURELIST'),pkBigIcon,28,hkFeature,200); LF; 1021 AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkBigIcon,7*SystemIconLines+imCourt,hkImp,200); LF; 1022 AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'),pkBigIcon,7*SystemIconLines+imStockEx,hkImp,201); LF; 1023 AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'),pkBigIcon,7*SystemIconLines,hkImp,202); LF; 1024 AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'),pkBigIcon,gDemocracy+6,hkMisc,miscGovList); LF; 1025 AddLine(HelpText.Lookup('HELPTITLE_KEYS'),pkBigIcon,2,hkText,HelpText.GetHandle('HOTKEYS')); LF; 1026 AddLine(HelpText.Lookup('HELPTITLE_ABOUT'),pkBigIcon,1,hkText,HelpText.GetHandle('ABOUT')); LF; 1027 AddLine(HelpText.Lookup('HELPTITLE_CREDITS'),pkBigIcon,22,hkMisc,miscCredits); 1331 if j > 0 then 1332 begin 1333 LF; 1334 LF; 1335 end; 1336 AddLine(HelpText.Lookup('TECHAGE', j), pkSection); 1337 if j = 1 then 1338 AddLine(Phrases.Lookup('ADVANCES', adScience) + ' ' + 1339 HelpText.Lookup('BASETECH'), pkAdvIcon, adScience, hkAdv, 1340 adScience); 1341 if j = 2 then 1342 AddLine(Phrases.Lookup('ADVANCES', adMassProduction) + ' ' + 1343 HelpText.Lookup('BASETECH'), pkAdvIcon, adMassProduction, hkAdv, 1344 adMassProduction); 1345 List.Clear; 1346 for i := 0 to nAdv - 1 do 1347 if (i <> adScience) and (i <> adMassProduction) and 1348 (AdvValue[i] div 1000 = j) then 1349 List.AddLine(Phrases.Lookup('ADVANCES', i), pkAdvIcon, i, 1350 hkAdv, i); 1351 List.Sort; 1352 AddStrings(List); 1028 1353 end; 1029 miscCredits: 1354 List.Free 1355 end 1356 else // single advance 1357 begin 1358 Caption := Phrases.Lookup('ADVANCES', no); 1359 LF; 1360 AddLine(Phrases.Lookup('ADVANCES', no), pkCaption); 1361 if no in FutureTech then 1030 1362 begin 1031 AddItem('CREDITS'); 1032 LF; 1033 AddGraphicCredits; 1034 NextSection('CRED_CAPSOUND'); 1035 AddSoundCredits; 1036 NextSection('CRED_CAPAI'); 1037 Server(sGetAICredits,0,0,ps); 1038 AddText(ps); 1039 NextSection('CRED_CAPLANG'); 1040 AddItem('AUTHOR'); 1041 end; 1042 miscJobList: 1043 begin 1044 Caption:=HelpText.Lookup('HELPTITLE_JOBLIST'); 1045 AddJobList; 1046 LF; 1047 AddItem('TERIMPEXCLUDE'); 1048 LF; 1049 AddItem('TERIMPCITY'); 1050 end; 1051 miscGovList: 1052 begin 1053 Caption:=HelpText.Lookup('HELPTITLE_GOVLIST'); 1054 for i:=1 to nGov do 1055 begin 1056 AddLine(Phrases.Lookup('GOVERNMENT',i mod nGov),pkSection); 1363 AddLine(HelpText.Lookup('HELPSPEC_FUTURE')); 1057 1364 LF; 1058 if i=nGov then 1059 AddLine('',pkBigIcon,7*SystemIconLines+imPalace) 1060 else AddLine('',pkBigIcon,i+6); 1061 LF; 1062 AddText(HelpText.LookupByHandle(hGOVHELP,i mod nGov)); 1063 if i mod nGov>=2 then 1365 if no = futResearchTechnology then 1366 AddItem('FUTURETECHHELP100') 1367 else 1368 AddItem('FUTURETECHHELP25'); 1369 end 1370 else 1371 AddLine(HelpText.Lookup('HELPSPEC_ADV')); 1372 if AdvPreq[no, 2] <> preNone then 1373 NextSection('PREREQALT') 1374 else 1375 NextSection('PREREQ'); 1376 for i := 0 to 2 do 1377 if AdvPreq[no, i] <> preNone then 1378 AddPreqAdv(AdvPreq[no, i]); 1379 NextSection('GOVALLOW'); 1380 for i := 2 to nGov - 1 do 1381 if GovPreq[i] = no then 1382 AddLine(Phrases.Lookup('GOVERNMENT', i), pkGov, i, 1383 hkMisc + hkCrossLink, miscGovList); 1384 NextSection('BUILDALLOW'); 1385 for i := 0 to 27 do 1386 if Imp[i].Preq = no then 1387 AddImp(i); 1388 for i := 28 to nImp - 1 do 1389 if (Imp[i].Preq = no) and (Imp[i].Kind <> ikCommon) then 1390 AddImp(i); 1391 for i := 28 to nImp - 1 do 1392 if (Imp[i].Preq = no) and (Imp[i].Kind = ikCommon) then 1393 AddImp(i); 1394 NextSection('MODELALLOW'); 1395 for i := 0 to nSpecialModel - 1 do 1396 if SpecialModelPreq[i] = no then 1397 AddModel(i); 1398 NextSection('FEATALLOW'); 1399 for i := 0 to nFeature - 1 do 1400 if Feature[i].Preq = no then 1401 AddFeature(i); 1402 NextSection('FOLLOWADV'); 1403 for i := 0 to nAdv - 1 do 1404 if (AdvPreq[i, 0] = no) or (AdvPreq[i, 1] = no) or 1405 (AdvPreq[i, 2] = no) then 1406 AddAdv(i); 1407 NextSection('UPGRADEALLOW'); 1408 for Domain := 0 to nDomains - 1 do 1409 for i := 1 to nUpgrade - 1 do 1410 if upgrade[Domain, i].Preq = no then 1064 1411 begin 1065 AddPreqAdv(GovPreq[i mod nGov]); 1066 MainText[Count-1]:=Format(HelpText.Lookup('REQUIRED'),[MainText[Count-1]]); 1412 if upgrade[Domain, i].Strength > 0 then 1413 AddLine(Format(HelpText.Lookup('STRENGTHUP'), 1414 [Phrases.Lookup('DOMAIN', Domain), upgrade[Domain, 1415 i].Strength]), pkDomain, Domain); 1416 if upgrade[Domain, i].Trans > 0 then 1417 AddLine(Format(HelpText.Lookup('TRANSUP'), 1418 [Phrases.Lookup('DOMAIN', Domain), upgrade[Domain, i].Trans] 1419 ), pkDomain, Domain); 1420 if no in FutureTech then 1421 AddLine(Format(HelpText.Lookup('COSTUP'), 1422 [upgrade[Domain, i].Cost]), pkNormal_Dot) 1423 else 1424 AddLine(Format(HelpText.Lookup('COSTMIN'), 1425 [upgrade[Domain, i].Cost]), pkNormal_Dot) 1067 1426 end; 1068 if i<nGov then begin LF; LF; end 1069 end 1070 end; 1071 miscSearchResult: 1072 begin 1073 Caption:=HelpText.Lookup('HELPTITLE_SEARCHRESULTS'); 1074 AddText(Format(HelpText.Lookup('MATCHES'), [SearchContent])); 1075 MainText.AddStrings(SearchResult); 1076 end 1077 end; // case no 1078 end; 1079 1080 hkAdv: 1081 if no=200 then 1082 begin // complete advance list 1083 Caption:=HelpText.Lookup('HELPTITLE_TECHLIST'); 1084 List:=THyperText.Create; 1085 for j:=0 to 3 do 1086 begin 1087 if j>0 then begin LF; LF; end; 1088 AddLine(HelpText.Lookup('TECHAGE',j),pkSection); 1089 if j=1 then 1090 AddLine(Phrases.Lookup('ADVANCES',adScience)+' ' 1091 +HelpText.Lookup('BASETECH'), 1092 pkAdvIcon,adScience,hkAdv,adScience); 1093 if j=2 then 1094 AddLine(Phrases.Lookup('ADVANCES',adMassProduction)+' ' 1095 +HelpText.Lookup('BASETECH'), 1096 pkAdvIcon,adMassProduction,hkAdv,adMassProduction); 1097 List.Clear; 1098 for i:=0 to nAdv-1 do 1099 if (i<>adScience) and (i<>adMassProduction) and (AdvValue[i] div 1000=j) then 1100 List.AddLine(Phrases.Lookup('ADVANCES',i),pkAdvIcon,i,hkAdv,i); 1427 NextSection('EXPIRATION'); 1428 for i := 0 to 27 do 1429 if (Imp[i].Preq <> preNA) and (Imp[i].Expiration = no) then 1430 AddImp(i); 1431 NextSection('ADVEFFECT'); 1432 s := HelpText.LookupByHandle(hADVHELP, no); 1433 if s <> '*' then 1434 AddText(s); 1435 NextSection('SEEALSO'); 1436 CheckSeeAlso := true 1437 end; 1438 1439 hkImp: 1440 if no = 200 then 1441 begin // complete city improvement list 1442 Caption := HelpText.Lookup('HELPTITLE_IMPLIST'); 1443 // AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkSection); 1444 List := THyperText.Create; 1445 for i := 28 to nImp - 1 do 1446 if (i <> imTrGoods) and (Imp[i].Preq <> preNA) and 1447 (Imp[i].Kind = ikCommon) then 1448 List.AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, 1449 i, hkImp, i); 1101 1450 List.Sort; 1102 1451 AddStrings(List); 1452 List.Free 1453 end 1454 else if no = 201 then 1455 begin // complete nat. project list 1456 Caption := HelpText.Lookup('HELPTITLE_UNIQUELIST'); 1457 // AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'),pkSection); 1458 for i := 28 to nImp - 1 do 1459 if (Imp[i].Preq <> preNA) and 1460 ((Imp[i].Kind = ikNatLocal) or (Imp[i].Kind = ikNatGlobal)) then 1461 AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, 1462 hkImp, i); 1463 { LF; 1464 LF; 1465 AddLine(HelpText.Lookup('HELPTITLE_SHIPPARTLIST'),pkSection); 1466 for i:=28 to nImp-1 do 1467 if (Imp[i].Preq<>preNA) and (Imp[i].Kind=ikShipPart) then 1468 AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i); } 1469 end 1470 else if no = 202 then 1471 begin // complete wonder list 1472 Caption := HelpText.Lookup('HELPTITLE_WONDERLIST'); 1473 // AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'),pkSection); 1474 for i := 0 to 27 do 1475 if Imp[i].Preq <> preNA then 1476 AddLine(Phrases.Lookup('IMPROVEMENTS', i), pkSmallIcon, i, 1477 hkImp, i); 1478 end 1479 else 1480 begin // single building 1481 Caption := Phrases.Lookup('IMPROVEMENTS', no); 1482 LF; 1483 AddLine(Phrases.Lookup('IMPROVEMENTS', no), pkRightIcon, no); 1484 case Imp[no].Kind of 1485 ikWonder: 1486 AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1487 ikCommon: 1488 AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1489 ikShipPart: 1490 AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1491 else 1492 AddLine(HelpText.Lookup('HELPSPEC_NAT')) 1103 1493 end; 1104 List.Free 1494 if Imp[no].Kind <> ikShipPart then 1495 begin 1496 NextSection('EFFECT'); 1497 AddText(HelpText.LookupByHandle(hIMPHELP, no)); 1498 end; 1499 if no = woSun then 1500 begin 1501 AddFeature(mcFirst); 1502 AddFeature(mcWill); 1503 AddFeature(mcAcademy); 1504 end; 1505 if (no < 28) and not Phrases2FallenBackToEnglish then 1506 begin 1507 LF; 1508 if Imp[no].Expiration >= 0 then 1509 AddText(Phrases2.Lookup('HELP_WONDERMORALE1')) 1510 else 1511 AddText(Phrases2.Lookup('HELP_WONDERMORALE2')); 1512 end; 1513 if Imp[no].Preq <> preNone then 1514 begin 1515 NextSection('PREREQ'); 1516 AddPreqAdv(Imp[no].Preq); 1517 end; 1518 NextSection('COSTS'); 1519 if Difficulty = 0 then 1520 s := Format(HelpText.Lookup('BUILDCOST'), [Imp[no].Cost]) 1521 else 1522 s := Format(HelpText.Lookup('BUILDCOST'), 1523 [Imp[no].Cost * BuildCostMod[Difficulty] div 12]); 1524 AddLine(s); 1525 if Imp[no].Maint > 0 then 1526 AddLine(Format(HelpText.Lookup('MAINTCOST'), [Imp[no].Maint])); 1527 j := 0; 1528 for i := 0 to nImpReplacement - 1 do 1529 if ImpReplacement[i].NewImp = no then 1530 begin 1531 if j = 0 then 1532 begin 1533 NextSection('REPLACE'); 1534 AddItem('REPLACETEXT'); 1535 j := 1 1536 end; 1537 AddImp(ImpReplacement[i].OldImp); 1538 end; 1539 if Imp[no].Kind = ikShipPart then 1540 begin 1541 LF; 1542 if no = imShipComp then 1543 i := 1 1544 else if no = imShipPow then 1545 i := 2 1546 else { if no=imShipHab then } 1547 i := 3; 1548 AddLine(Format(HelpText.Lookup('RAREREQUIRED'), 1549 [Phrases.Lookup('TERRAIN', 3 * 12 + i)]), pkTer, 3 * 12 + i); 1550 end; 1551 if (no < 28) and (Imp[no].Expiration >= 0) then 1552 begin 1553 NextSection('EXPIRATION'); 1554 s := Format(HelpText.Lookup('EXPWITH'), 1555 [Phrases.Lookup('ADVANCES', Imp[no].Expiration)]); 1556 if no = woPyramids then 1557 s := s + ' ' + HelpText.Lookup('EXPSLAVE'); 1558 AddText(s); 1559 end; 1560 NextSection('SEEALSO'); 1561 if (no < 28) and (Imp[no].Expiration >= 0) then 1562 AddImp(woEiffel); 1563 for i := 0 to nImpReplacement - 1 do 1564 if ImpReplacement[i].OldImp = no then 1565 AddImp(ImpReplacement[i].NewImp); 1566 if no = imSupermarket then 1567 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, 1568 hkMisc + hkCrossLink, miscJobList); 1569 CheckSeeAlso := true 1570 end; 1571 1572 hkTer: 1573 if no = 200 then 1574 begin // complete terrain type list 1575 Caption := HelpText.Lookup('HELPTITLE_TERLIST'); 1576 // AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSection); 1577 for i := 0 to nTerrainHelp - 1 do 1578 AddTer(TerrainHelp[i]); 1105 1579 end 1106 else // single advance 1107 begin 1108 Caption:=Phrases.Lookup('ADVANCES',no); 1109 LF; 1110 AddLine(Phrases.Lookup('ADVANCES',no),pkCaption); 1111 if no in FutureTech then 1580 else 1581 begin // sigle terrain type 1582 TerrType := no mod 12; 1583 if TerrType = fJungle then 1584 TerrType := fForest; 1585 TerrSubType := no div 12; 1586 if no = 3 * 12 then 1112 1587 begin 1113 AddLine(HelpText.Lookup('HELPSPEC_FUTURE')); 1114 LF; 1115 if no=futResearchTechnology then 1116 AddItem('FUTURETECHHELP100') 1117 else AddItem('FUTURETECHHELP25'); 1118 end 1119 else AddLine(HelpText.Lookup('HELPSPEC_ADV')); 1120 if AdvPreq[no,2]<>preNone then NextSection('PREREQALT') 1121 else NextSection('PREREQ'); 1122 for i:=0 to 2 do 1123 if AdvPreq[no,i]<>preNone then AddPreqAdv(AdvPreq[no,i]); 1124 NextSection('GOVALLOW'); 1125 for i:=2 to nGov-1 do 1126 if GovPreq[i]=no then 1127 AddLine(Phrases.Lookup('GOVERNMENT',i),pkGov,i, 1128 hkMisc+hkCrossLink,miscGovList); 1129 NextSection('BUILDALLOW'); 1130 for i:=0 to 27 do 1131 if Imp[i].Preq=no then AddImp(i); 1132 for i:=28 to nImp-1 do 1133 if (Imp[i].Preq=no) and (Imp[i].Kind<>ikCommon) then AddImp(i); 1134 for i:=28 to nImp-1 do 1135 if (Imp[i].Preq=no) and (Imp[i].Kind=ikCommon) then AddImp(i); 1136 NextSection('MODELALLOW'); 1137 for i:=0 to nSpecialModel-1 do 1138 if SpecialModelPreq[i]=no then AddModel(i); 1139 NextSection('FEATALLOW'); 1140 for i:=0 to nFeature-1 do if Feature[i].Preq=no then AddFeature(i); 1141 NextSection('FOLLOWADV'); 1142 for i:=0 to nAdv-1 do 1143 if (AdvPreq[i,0]=no) or (AdvPreq[i,1]=no) or (AdvPreq[i,2]=no) then 1144 AddAdv(i); 1145 NextSection('UPGRADEALLOW'); 1146 for Domain:=0 to nDomains-1 do for i:=1 to nUpgrade-1 do 1147 if upgrade[Domain,i].Preq=no then 1148 begin 1149 if upgrade[Domain,i].Strength>0 then 1150 AddLine(Format(HelpText.Lookup('STRENGTHUP'), 1151 [Phrases.Lookup('DOMAIN',Domain),upgrade[Domain,i].Strength]), 1152 pkDomain,Domain); 1153 if upgrade[Domain,i].Trans>0 then 1154 AddLine(Format(HelpText.Lookup('TRANSUP'), 1155 [Phrases.Lookup('DOMAIN',Domain),upgrade[Domain,i].Trans]), 1156 pkDomain,Domain); 1157 if no in FutureTech then 1158 AddLine(Format(HelpText.Lookup('COSTUP'), 1159 [upgrade[Domain,i].Cost]),pkNormal_Dot) 1160 else 1161 AddLine(Format(HelpText.Lookup('COSTMIN'), 1162 [upgrade[Domain,i].Cost]),pkNormal_Dot) 1163 end; 1164 NextSection('EXPIRATION'); 1165 for i:=0 to 27 do 1166 if (Imp[i].Preq<>preNA) and (Imp[i].Expiration=no) then AddImp(i); 1167 NextSection('ADVEFFECT'); 1168 s:=HelpText.LookupByHandle(hADVHELP,no); 1169 if s<>'*' then AddText(s); 1170 NextSection('SEEALSO'); 1171 CheckSeeAlso:=true 1172 end; 1173 1174 hkImp: 1175 if no=200 then 1176 begin // complete city improvement list 1177 Caption:=HelpText.Lookup('HELPTITLE_IMPLIST'); 1178 // AddLine(HelpText.Lookup('HELPTITLE_IMPLIST'),pkSection); 1179 List:=THyperText.Create; 1180 for i:=28 to nImp-1 do 1181 if (i<>imTrGoods) and (Imp[i].Preq<>preNA) and (Imp[i].Kind=ikCommon) then 1182 List.AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i); 1183 List.Sort; 1184 AddStrings(List); 1185 List.Free 1186 end 1187 else if no=201 then 1188 begin // complete nat. project list 1189 Caption:=HelpText.Lookup('HELPTITLE_UNIQUELIST'); 1190 // AddLine(HelpText.Lookup('HELPTITLE_UNIQUELIST'),pkSection); 1191 for i:=28 to nImp-1 do 1192 if (Imp[i].Preq<>preNA) 1193 and ((Imp[i].Kind=ikNatLocal) or (Imp[i].Kind=ikNatGlobal)) then 1194 AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i); 1195 { LF; 1196 LF; 1197 AddLine(HelpText.Lookup('HELPTITLE_SHIPPARTLIST'),pkSection); 1198 for i:=28 to nImp-1 do 1199 if (Imp[i].Preq<>preNA) and (Imp[i].Kind=ikShipPart) then 1200 AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i);} 1201 end 1202 else if no=202 then 1203 begin // complete wonder list 1204 Caption:=HelpText.Lookup('HELPTITLE_WONDERLIST'); 1205 // AddLine(HelpText.Lookup('HELPTITLE_WONDERLIST'),pkSection); 1206 for i:=0 to 27 do if Imp[i].Preq<>preNA then 1207 AddLine(Phrases.Lookup('IMPROVEMENTS',i),pkSmallIcon,i,hkImp,i); 1208 end 1209 else 1210 begin // single building 1211 Caption:=Phrases.Lookup('IMPROVEMENTS',no); 1212 LF; 1213 AddLine(Phrases.Lookup('IMPROVEMENTS',no),pkRightIcon,no); 1214 case Imp[no].Kind of 1215 ikWonder: AddLine(HelpText.Lookup('HELPSPEC_WONDER')); 1216 ikCommon: AddLine(HelpText.Lookup('HELPSPEC_IMP')); 1217 ikShipPart: AddLine(HelpText.Lookup('HELPSPEC_SHIPPART')); 1218 else AddLine(HelpText.Lookup('HELPSPEC_NAT')) 1588 TerrType := fDesert; 1589 TerrSubType := 0 1219 1590 end; 1220 if Imp[no].Kind<>ikShipPart then1591 with Terrain[TerrType] do 1221 1592 begin 1222 NextSection('EFFECT'); 1223 AddText(HelpText.LookupByHandle(hIMPHELP,no)); 1224 end; 1225 if no=woSun then 1226 begin 1227 AddFeature(mcFirst); 1228 AddFeature(mcWill); 1229 AddFeature(mcAcademy); 1230 end; 1231 if (no<28) and not Phrases2FallenBackToEnglish then 1232 begin 1233 LF; 1234 if Imp[no].Expiration>=0 then 1235 AddText(Phrases2.Lookup('HELP_WONDERMORALE1')) 1236 else AddText(Phrases2.Lookup('HELP_WONDERMORALE2')); 1237 end; 1238 if Imp[no].Preq<>preNone then 1239 begin 1240 NextSection('PREREQ'); 1241 AddPreqAdv(Imp[no].Preq); 1242 end; 1243 NextSection('COSTS'); 1244 if Difficulty=0 then 1245 s:=Format(HelpText.Lookup('BUILDCOST'),[Imp[no].Cost]) 1246 else s:=Format(HelpText.Lookup('BUILDCOST'), 1247 [Imp[no].Cost*BuildCostMod[Difficulty] div 12]); 1248 AddLine(s); 1249 if Imp[no].Maint>0 then 1250 AddLine(Format(HelpText.Lookup('MAINTCOST'),[Imp[no].Maint])); 1251 j:=0; 1252 for i:=0 to nImpReplacement-1 do if ImpReplacement[i].NewImp=no then 1253 begin 1254 if j=0 then 1255 begin NextSection('REPLACE'); AddItem('REPLACETEXT'); j:=1 end; 1256 AddImp(ImpReplacement[i].OldImp); 1257 end; 1258 if Imp[no].Kind=ikShipPart then 1259 begin 1260 LF; 1261 if no=imShipComp then i:=1 1262 else if no=imShipPow then i:=2 1263 else {if no=imShipHab then} i:=3; 1264 AddLine(Format(HelpText.Lookup('RAREREQUIRED'), 1265 [Phrases.Lookup('TERRAIN',3*12+i)]),pkTer,3*12+i); 1266 end; 1267 if (no<28) and (Imp[no].Expiration>=0) then 1268 begin 1269 NextSection('EXPIRATION'); 1270 s:=Format(HelpText.Lookup('EXPWITH'),[Phrases.Lookup('ADVANCES',Imp[no].Expiration)]); 1271 if no=woPyramids then s:=s+' '+HelpText.Lookup('EXPSLAVE'); 1272 AddText(s); 1273 end; 1274 NextSection('SEEALSO'); 1275 if (no<28) and (Imp[no].Expiration>=0) then AddImp(woEiffel); 1276 for i:=0 to nImpReplacement-1 do if ImpReplacement[i].OldImp=no then 1277 AddImp(ImpReplacement[i].NewImp); 1278 if no=imSupermarket then 1279 AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'),pkNormal,0,hkMisc+hkCrossLink,miscJobList); 1280 CheckSeeAlso:=true 1281 end; 1282 1283 hkTer: 1284 if no=200 then 1285 begin // complete terrain type list 1286 Caption:=HelpText.Lookup('HELPTITLE_TERLIST'); 1287 // AddLine(HelpText.Lookup('HELPTITLE_TERLIST'),pkSection); 1288 for i:=0 to nTerrainHelp-1 do AddTer(TerrainHelp[i]); 1289 end 1290 else 1291 begin // sigle terrain type 1292 TerrType:=no mod 12; 1293 if TerrType=fJungle then TerrType:=fForest; 1294 TerrSubType:=no div 12; 1295 if no=3*12 then 1296 begin TerrType:=fDesert; TerrSubType:=0 end; 1297 with Terrain[TerrType] do 1298 begin 1299 Caption:=Phrases.Lookup('TERRAIN',no); 1300 LF; 1301 AddLine(Phrases.Lookup('TERRAIN',no), pkBigTer, no); 1302 AddLine(HelpText.Lookup('HELPSPEC_TER')); 1303 LF; 1304 if (ProdRes[TerrSubType]>0) or (MineEff>0) then 1305 AddLine(Format(HelpText.Lookup('RESPROD'),[ProdRes[TerrSubType]])); 1306 if (no<3*12) and (MineEff>0) then 1307 MainText[Count-1]:=MainText[Count-1]+' ' 1308 +Format(HelpText.Lookup('MOREMINE'),[MineEff]); 1309 if (FoodRes[TerrSubType]>0) or (IrrEff>0) then 1310 AddLine(Format(HelpText.Lookup('RESFOOD'),[FoodRes[TerrSubType]])); 1311 if (no<3*12) and (IrrEff>0) then 1312 MainText[Count-1]:=MainText[Count-1]+' ' 1313 +Format(HelpText.Lookup('MOREIRR'),[IrrEff]); 1314 if TradeRes[TerrSubType]>0 then 1315 AddLine(Format(HelpText.Lookup('RESTRADE'),[TradeRes[TerrSubType]])); 1316 if Defense>4 then 1317 AddLine(Format(HelpText.Lookup('DEFBONUS'),[(Defense-4)*25])); 1318 if (TerrType>=fGrass) and (TerrType<>fMountains) then 1319 if MoveCost=2 then 1320 AddLine(HelpText.Lookup('MOVEHEAVY')) 1321 else AddLine(HelpText.Lookup('MOVEPLAIN')); 1322 if no=3*12 then 1323 begin 1593 Caption := Phrases.Lookup('TERRAIN', no); 1324 1594 LF; 1325 AddText(HelpText.Lookup('DEADLANDS')); 1326 end; 1327 if (TerrType=fDesert) and (no<>fDesert+12) then 1328 begin 1595 AddLine(Phrases.Lookup('TERRAIN', no), pkBigTer, no); 1596 AddLine(HelpText.Lookup('HELPSPEC_TER')); 1329 1597 LF; 1330 AddText(Format(HelpText.Lookup('HOSTILE'),[DesertThurst])); 1331 end; 1332 if TerrType=fArctic then 1333 begin 1334 LF; 1335 AddText(Format(HelpText.Lookup('HOSTILE'),[ArcticThurst])); 1336 end; 1337 if (no<3*12) and (TransTerrain>=0) then 1338 begin 1339 LF; 1340 i:=TransTerrain; 1341 if (TerrType<>fGrass) and (i<>fGrass) then 1342 i:=i+TerrSubType*12; // trafo to same special resource group 1343 AddLine(Format(HelpText.Lookup('TRAFO'), 1344 [Phrases.Lookup('TERRAIN',i)]),pkTer,i,hkTer+hkCrossLink,i); 1345 if no=fSwamp+12 then 1598 if (ProdRes[TerrSubType] > 0) or (MineEff > 0) then 1599 AddLine(Format(HelpText.Lookup('RESPROD'), 1600 [ProdRes[TerrSubType]])); 1601 if (no < 3 * 12) and (MineEff > 0) then 1602 MainText[Count - 1] := MainText[Count - 1] + ' ' + 1603 Format(HelpText.Lookup('MOREMINE'), [MineEff]); 1604 if (FoodRes[TerrSubType] > 0) or (IrrEff > 0) then 1605 AddLine(Format(HelpText.Lookup('RESFOOD'), 1606 [FoodRes[TerrSubType]])); 1607 if (no < 3 * 12) and (IrrEff > 0) then 1608 MainText[Count - 1] := MainText[Count - 1] + ' ' + 1609 Format(HelpText.Lookup('MOREIRR'), [IrrEff]); 1610 if TradeRes[TerrSubType] > 0 then 1611 AddLine(Format(HelpText.Lookup('RESTRADE'), 1612 [TradeRes[TerrSubType]])); 1613 if Defense > 4 then 1614 AddLine(Format(HelpText.Lookup('DEFBONUS'), 1615 [(Defense - 4) * 25])); 1616 if (TerrType >= fGrass) and (TerrType <> fMountains) then 1617 if MoveCost = 2 then 1618 AddLine(HelpText.Lookup('MOVEHEAVY')) 1619 else 1620 AddLine(HelpText.Lookup('MOVEPLAIN')); 1621 if no = 3 * 12 then 1622 begin 1623 LF; 1624 AddText(HelpText.Lookup('DEADLANDS')); 1625 end; 1626 if (TerrType = fDesert) and (no <> fDesert + 12) then 1627 begin 1628 LF; 1629 AddText(Format(HelpText.Lookup('HOSTILE'), [DesertThurst])); 1630 end; 1631 if TerrType = fArctic then 1632 begin 1633 LF; 1634 AddText(Format(HelpText.Lookup('HOSTILE'), [ArcticThurst])); 1635 end; 1636 if (no < 3 * 12) and (TransTerrain >= 0) then 1637 begin 1638 LF; 1639 i := TransTerrain; 1640 if (TerrType <> fGrass) and (i <> fGrass) then 1641 i := i + TerrSubType * 12; 1642 // trafo to same special resource group 1643 AddLine(Format(HelpText.Lookup('TRAFO'), 1644 [Phrases.Lookup('TERRAIN', i)]), pkTer, i, 1645 hkTer + hkCrossLink, i); 1646 if no = fSwamp + 12 then 1346 1647 begin 1648 LF; 1649 AddLine(Format(HelpText.Lookup('TRAFO'), 1650 [Phrases.Lookup('TERRAIN', TransTerrain + 24)]), pkTer, 1651 TransTerrain + 24, hkTer + hkCrossLink, TransTerrain + 24); 1652 end 1653 else if i = fGrass then 1654 begin 1655 LF; 1656 AddLine(Format(HelpText.Lookup('TRAFO'), 1657 [Phrases.Lookup('TERRAIN', fGrass + 12)]), pkTer, fGrass + 12, 1658 hkTer + hkCrossLink, fGrass + 12); 1659 end 1660 end; 1661 NextSection('SPECIAL'); 1662 if no = 3 * 12 then 1663 begin 1347 1664 LF; 1348 AddLine(Format(HelpText.Lookup('TRAFO'), 1349 [Phrases.Lookup('TERRAIN',TransTerrain+24)]),pkTer,TransTerrain+24, 1350 hkTer+hkCrossLink,TransTerrain+24); 1351 end 1352 else if i=fGrass then 1665 for special := 1 to 3 do 1353 1666 begin 1354 LF; 1355 AddLine(Format(HelpText.Lookup('TRAFO'), 1356 [Phrases.Lookup('TERRAIN',fGrass+12)]),pkTer,fGrass+12, 1357 hkTer+hkCrossLink,fGrass+12); 1358 end 1359 end; 1360 NextSection('SPECIAL'); 1361 if no=3*12 then 1362 begin 1363 LF; 1364 for special:=1 to 3 do 1365 begin 1366 if special>1 then LF; 1367 AddLine(Phrases.Lookup('TERRAIN',3*12+special),pkTer,3*12+special); 1667 if special > 1 then 1668 LF; 1669 AddLine(Phrases.Lookup('TERRAIN', 3 * 12 + special), pkTer, 1670 3 * 12 + special); 1368 1671 end 1369 1672 end 1370 else if (no<12) and (no<>fGrass) and (no<>fOcean) then1371 begin 1372 LF;1373 for special:=1 to 2 do1374 if (no<>fArctic) and (no<>fSwamp) or (special<2) then1673 else if (no < 12) and (no <> fGrass) and (no <> fOcean) then 1674 begin 1675 LF; 1676 for special := 1 to 2 do 1677 if (no <> fArctic) and (no <> fSwamp) or (special < 2) then 1375 1678 begin 1376 if special>1 then LF; 1377 AddLine(Phrases.Lookup('TERRAIN',no+special*12),pkTer,no+special*12); 1378 i:=FoodRes[special]-FoodRes[0]; 1379 if i<>0 then 1380 MainText[Count-1]:=MainText[Count-1]+Format(HelpText.Lookup('SPECIALFOOD'),[i]); 1381 i:=ProdRes[special]-ProdRes[0]; 1382 if i<>0 then 1383 MainText[Count-1]:=MainText[Count-1]+Format(HelpText.Lookup('SPECIALPROD'),[i]); 1384 i:=TradeRes[special]-TradeRes[0]; 1385 if i<>0 then 1386 MainText[Count-1]:=MainText[Count-1]+Format(HelpText.Lookup('SPECIALTRADE'),[i]); 1679 if special > 1 then 1680 LF; 1681 AddLine(Phrases.Lookup('TERRAIN', no + special * 12), pkTer, 1682 no + special * 12); 1683 i := FoodRes[special] - FoodRes[0]; 1684 if i <> 0 then 1685 MainText[Count - 1] := MainText[Count - 1] + 1686 Format(HelpText.Lookup('SPECIALFOOD'), [i]); 1687 i := ProdRes[special] - ProdRes[0]; 1688 if i <> 0 then 1689 MainText[Count - 1] := MainText[Count - 1] + 1690 Format(HelpText.Lookup('SPECIALPROD'), [i]); 1691 i := TradeRes[special] - TradeRes[0]; 1692 if i <> 0 then 1693 MainText[Count - 1] := MainText[Count - 1] + 1694 Format(HelpText.Lookup('SPECIALTRADE'), [i]); 1387 1695 end; 1388 1696 end; 1389 if no=3*12 then1390 begin 1391 LF;1392 AddText(HelpText.Lookup('RARE'));1393 end; 1394 if (no<3*12) and (TerrType in [fDesert,fArctic]) then1395 begin 1396 NextSection('SEEALSO');1397 AddImp(woGardens);1398 CheckSeeAlso:=true1697 if no = 3 * 12 then 1698 begin 1699 LF; 1700 AddText(HelpText.Lookup('RARE')); 1701 end; 1702 if (no < 3 * 12) and (TerrType in [fDesert, fArctic]) then 1703 begin 1704 NextSection('SEEALSO'); 1705 AddImp(woGardens); 1706 CheckSeeAlso := true 1399 1707 end 1400 1708 end 1401 1709 end; 1402 1710 1403 hkFeature:1404 if no=200 then1711 hkFeature: 1712 if no = 200 then 1405 1713 begin // complete feature list 1406 Caption:=HelpText.Lookup('HELPTITLE_FEATURELIST');1407 List:=THyperText.Create;1408 for special:=0 to 2 do1714 Caption := HelpText.Lookup('HELPTITLE_FEATURELIST'); 1715 List := THyperText.Create; 1716 for special := 0 to 2 do 1409 1717 begin 1410 if special>0 then begin LF; LF end; 1411 case special of 1412 0: AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'),pkSection); 1413 1: AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'),pkSection); 1414 2: AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'),pkSection); 1415 end; 1416 List.Clear; 1417 for i:=0 to nFeature-1 do if Feature[i].Preq<>preNA then 1418 begin 1419 if i<mcFirstNonCap then j:=0 1420 else if i in AutoFeature then j:=2 1421 else j:=1; 1422 if j=special then 1423 List.AddLine(Phrases.Lookup('FEATURES',i),pkFeature,i,hkFeature,i); 1424 end; 1425 List.Sort; 1426 AddStrings(List); 1718 if special > 0 then 1719 begin 1720 LF; 1721 LF 1722 end; 1723 case special of 1724 0: 1725 AddLine(HelpText.Lookup('HELPTITLE_FEATURE1LIST'), pkSection); 1726 1: 1727 AddLine(HelpText.Lookup('HELPTITLE_FEATURE2LIST'), pkSection); 1728 2: 1729 AddLine(HelpText.Lookup('HELPTITLE_FEATURE3LIST'), pkSection); 1730 end; 1731 List.Clear; 1732 for i := 0 to nFeature - 1 do 1733 if Feature[i].Preq <> preNA then 1734 begin 1735 if i < mcFirstNonCap then 1736 j := 0 1737 else if i in AutoFeature then 1738 j := 2 1739 else 1740 j := 1; 1741 if j = special then 1742 List.AddLine(Phrases.Lookup('FEATURES', i), pkFeature, i, 1743 hkFeature, i); 1744 end; 1745 List.Sort; 1746 AddStrings(List); 1427 1747 end; 1428 List.Free1748 List.Free 1429 1749 end 1430 else1750 else 1431 1751 begin // single feature 1432 Caption:=Phrases.Lookup('FEATURES',no); 1433 LF; 1434 AddLine(Phrases.Lookup('FEATURES',no),pkBigFeature,no); 1435 if no<mcFirstNonCap then 1436 AddLine(HelpText.Lookup('HELPSPEC_CAP')) 1437 else if no in AutoFeature then 1438 AddLine(HelpText.Lookup('HELPSPEC_STANDARD')) 1439 else AddLine(HelpText.Lookup('HELPSPEC_FEATURE')); 1440 NextSection('EFFECT'); 1441 AddText(HelpText.LookupByHandle(hFEATUREHELP,no)); 1442 if (Feature[no].Weight<>0) or (Feature[no].Cost<>0) then 1752 Caption := Phrases.Lookup('FEATURES', no); 1753 LF; 1754 AddLine(Phrases.Lookup('FEATURES', no), pkBigFeature, no); 1755 if no < mcFirstNonCap then 1756 AddLine(HelpText.Lookup('HELPSPEC_CAP')) 1757 else if no in AutoFeature then 1758 AddLine(HelpText.Lookup('HELPSPEC_STANDARD')) 1759 else 1760 AddLine(HelpText.Lookup('HELPSPEC_FEATURE')); 1761 NextSection('EFFECT'); 1762 AddText(HelpText.LookupByHandle(hFEATUREHELP, no)); 1763 if (Feature[no].Weight <> 0) or (Feature[no].Cost <> 0) then 1443 1764 begin 1444 NextSection('COSTS'); 1445 s:=IntToStr(Feature[no].Cost); 1446 if Feature[no].Cost>=0 then s:='+'+s; 1447 AddLine(Format(HelpText.Lookup('COSTBASE'),[s])); 1448 if Feature[no].Weight>0 then 1449 begin 1450 AddLine(Format(HelpText.Lookup('WEIGHT'), 1451 ['+'+IntToStr(Feature[no].Weight)])); 1452 if no=mcDefense then 1453 AddLine(Format(HelpText.Lookup('WEIGHT'),['+2']),pkDomain,dGround); 1765 NextSection('COSTS'); 1766 s := IntToStr(Feature[no].Cost); 1767 if Feature[no].Cost >= 0 then 1768 s := '+' + s; 1769 AddLine(Format(HelpText.Lookup('COSTBASE'), [s])); 1770 if Feature[no].Weight > 0 then 1771 begin 1772 AddLine(Format(HelpText.Lookup('WEIGHT'), 1773 ['+' + IntToStr(Feature[no].Weight)])); 1774 if no = mcDefense then 1775 AddLine(Format(HelpText.Lookup('WEIGHT'), ['+2']), 1776 pkDomain, dGround); 1454 1777 end 1455 1778 end; 1456 if Feature[no].Preq<>preNone then1779 if Feature[no].Preq <> preNone then 1457 1780 begin 1781 LF; 1782 if Feature[no].Preq = preSun then 1783 AddPreqImp(woSun) // sun tsu feature 1784 else 1785 AddPreqAdv(Feature[no].Preq); 1786 MainText[Count - 1] := Format(HelpText.Lookup('REQUIRED'), 1787 [MainText[Count - 1]]); 1788 end; 1789 NextSection('SEEALSO'); 1790 CheckSeeAlso := true 1791 end; 1792 1793 hkModel: 1794 begin 1795 Caption := HelpText.Lookup('HELPTITLE_MODELLIST'); 1796 for i := 0 to nSpecialModel - 1 do 1797 if i <> 2 then 1798 AddModelText(i); 1458 1799 LF; 1459 if Feature[no].Preq=preSun then AddPreqImp(woSun) // sun tsu feature 1460 else AddPreqAdv(Feature[no].Preq); 1461 MainText[Count-1]:=Format(HelpText.Lookup('REQUIRED'),[MainText[Count-1]]); 1800 AddItem('MODELNOTE'); 1801 end; 1802 1803 end; 1804 if CheckSeeAlso then 1805 for i := 0 to nSeeAlso - 1 do 1806 if (SeeAlso[i].Kind = Kind) and (SeeAlso[i].no = no) then 1807 case SeeAlso[i].SeeKind of 1808 hkImp: 1809 AddImp(SeeAlso[i].SeeNo); 1810 hkAdv: 1811 AddAdv(SeeAlso[i].SeeNo); 1812 hkFeature: 1813 AddFeature(SeeAlso[i].SeeNo); 1462 1814 end; 1463 NextSection('SEEALSO'); 1464 CheckSeeAlso:=true 1465 end; 1466 1467 hkModel: 1468 begin 1469 Caption:=HelpText.Lookup('HELPTITLE_MODELLIST'); 1470 for i:=0 to nSpecialModel-1 do if i<>2 then AddModelText(i); 1471 LF; 1472 AddItem('MODELNOTE'); 1473 end; 1474 1815 if (Headline >= 0) and (Count = Headline + 1) then 1816 Delete(Headline) 1817 else 1818 LF; 1819 1820 InitPVSB(sb, Count - 1, InnerHeight div 24); 1821 if sbPos <> 0 then 1822 begin 1823 sb.si.npos := sbPos; 1824 sb.si.FMask := SIF_POS; 1825 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 1475 1826 end; 1476 if CheckSeeAlso then 1477 for i:=0 to nSeeAlso-1 do 1478 if (SeeAlso[i].Kind=Kind) and (SeeAlso[i].no=no) then 1479 case SeeAlso[i].SeeKind of 1480 hkImp: AddImp(SeeAlso[i].SeeNo); 1481 hkAdv: AddAdv(SeeAlso[i].SeeNo); 1482 hkFeature: AddFeature(SeeAlso[i].SeeNo); 1483 end; 1484 if (Headline>=0) and (Count=Headline+1) then Delete(Headline) 1485 else LF; 1486 1487 InitPVSB(sb,Count-1,InnerHeight div 24); 1488 if sbPos<>0 then 1489 begin 1490 sb.si.npos:=sbPos; 1491 sb.si.FMask:=SIF_POS; 1492 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 1493 end; 1494 BackBtn.Visible:= nHist>0; 1495 TopBtn.Visible:= (nHist>0) or (Kind<>hkMisc) or (no<>miscMain); 1496 Sel:=-1; 1827 BackBtn.Visible := nHist > 0; 1828 TopBtn.Visible := (nHist > 0) or (Kind <> hkMisc) or (no <> miscMain); 1829 Sel := -1; 1497 1830 end; // with MainText 1498 end; { Prepare}1831 end; { Prepare } 1499 1832 1500 1833 procedure THelpDlg.ShowNewContent(NewMode, Category, Index: integer); 1501 1834 begin 1502 if (Category<>Kind) or (Index<>no) 1503 or (Category=hkMisc) and (Index=miscSearchResult) then 1504 begin 1505 if nHist=MaxHist then 1506 begin 1507 move(HistKind[2],HistKind[1],4*(nHist-2)); 1508 move(HistNo[2],HistNo[1],4*(nHist-2)); 1509 move(HistPos[2],HistPos[1],4*(nHist-2)); 1510 move(HistSearchContent[2],HistSearchContent[1],sizeof(shortstring)*(nHist-2)); 1835 if (Category <> Kind) or (Index <> no) or (Category = hkMisc) and 1836 (Index = miscSearchResult) then 1837 begin 1838 if nHist = MaxHist then 1839 begin 1840 move(HistKind[2], HistKind[1], 4 * (nHist - 2)); 1841 move(HistNo[2], HistNo[1], 4 * (nHist - 2)); 1842 move(HistPos[2], HistPos[1], 4 * (nHist - 2)); 1843 move(HistSearchContent[2], HistSearchContent[1], 1844 sizeof(shortstring) * (nHist - 2)); 1511 1845 end 1512 else inc(nHist); 1513 if nHist>0 then 1514 begin 1515 HistKind[nHist-1]:=Kind; 1516 HistNo[nHist-1]:=no; 1517 HistPos[nHist-1]:=sb.si.npos; 1518 HistSearchContent[nHist-1]:=SearchContent 1846 else 1847 inc(nHist); 1848 if nHist > 0 then 1849 begin 1850 HistKind[nHist - 1] := Kind; 1851 HistNo[nHist - 1] := no; 1852 HistPos[nHist - 1] := sb.si.npos; 1853 HistSearchContent[nHist - 1] := SearchContent 1519 1854 end 1520 1855 end; 1521 Kind:=Category;1522 no:=Index;1523 SearchContent:=NewSearchContent;1524 Prepare;1525 OffscreenPaint;1526 inherited ShowNewContent(NewMode);1856 Kind := Category; 1857 no := Index; 1858 SearchContent := NewSearchContent; 1859 Prepare; 1860 OffscreenPaint; 1861 inherited ShowNewContent(NewMode); 1527 1862 end; 1528 1863 … … 1530 1865 x, y: integer); 1531 1866 var 1532 i0,Sel0:integer;1867 i0, Sel0: integer; 1533 1868 begin 1534 y:=y-WideFrame; 1535 i0:=sb.si.npos; 1536 Sel0:=Sel; 1537 if (x>=SideFrame) and (x<SideFrame+InnerWidth) and (y>=0) and (y<InnerHeight) 1538 and (y mod 24>=8) then 1539 Sel:=y div 24 1540 else Sel:=-1; 1541 if (Sel+i0>=MainText.Count) or (Sel>=0) 1542 and (THelpLineInfo(MainText.Objects[Sel+i0]).Link=0) then Sel:=-1; 1543 if Sel<>Sel0 then 1544 begin 1545 if Sel0<>-1 then line(Canvas,Sel0,false); 1546 if Sel<>-1 then line(Canvas,Sel,true) 1869 y := y - WideFrame; 1870 i0 := sb.si.npos; 1871 Sel0 := Sel; 1872 if (x >= SideFrame) and (x < SideFrame + InnerWidth) and (y >= 0) and 1873 (y < InnerHeight) and (y mod 24 >= 8) then 1874 Sel := y div 24 1875 else 1876 Sel := -1; 1877 if (Sel + i0 >= MainText.Count) or (Sel >= 0) and 1878 (THelpLineInfo(MainText.Objects[Sel + i0]).Link = 0) then 1879 Sel := -1; 1880 if Sel <> Sel0 then 1881 begin 1882 if Sel0 <> -1 then 1883 line(Canvas, Sel0, false); 1884 if Sel <> -1 then 1885 line(Canvas, Sel, true) 1547 1886 end 1548 1887 end; 1549 1888 1550 procedure THelpDlg.PaintBox1MouseDown(Sender: TObject; 1551 Button: TMouseButton;Shift: TShiftState; x, y: integer);1889 procedure THelpDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 1890 Shift: TShiftState; x, y: integer); 1552 1891 begin 1553 if Sel>=0 then with THelpLineInfo(MainText.Objects[Sel+sb.si.npos]) do 1554 if Link shr 8 and $3F=hkInternet then 1555 case Link and $FF of 1556 1: ShellExecute(Handle,'open',pchar(HomeDir+'AI Template\AI development manual.html'),'','', 1557 SW_SHOWNORMAL); 1558 2: ShellExecute(Handle,'open','http://c-evo.org','','', 1559 SW_SHOWNORMAL); 1560 3: ShellExecute(Handle,'open','http://c-evo.org/_sg/contact','','', 1561 SW_SHOWNORMAL); 1892 if Sel >= 0 then 1893 with THelpLineInfo(MainText.Objects[Sel + sb.si.npos]) do 1894 if Link shr 8 and $3F = hkInternet then 1895 case Link and $FF of 1896 1: 1897 ShellExecute(Handle, 'open', 1898 pchar(HomeDir + 'AI Template\AI development manual.html'), '', '', 1899 SW_SHOWNORMAL); 1900 2: 1901 ShellExecute(Handle, 'open', 'http://c-evo.org', '', '', 1902 SW_SHOWNORMAL); 1903 3: 1904 ShellExecute(Handle, 'open', 'http://c-evo.org/_sg/contact', '', '', 1905 SW_SHOWNORMAL); 1906 end 1907 else 1908 begin 1909 if (Link >= $8000) and (Link and $3FFF = liInvalid) then 1910 exit; // invalid link; 1911 if Link >= $8000 then 1912 ShowNewContent(FWindowMode, hkText, Link and $3FFF) 1913 else 1914 ShowNewContent(FWindowMode, Link shr 8 and $3F, Link and $FF); 1562 1915 end 1563 else1564 begin1565 if (Link>=$8000) and (Link and $3FFF=liInvalid) then1566 exit; // invalid link;1567 if Link>=$8000 then1568 ShowNewContent(FWindowMode, hkText, Link and $3FFF)1569 else ShowNewContent(FWindowMode, Link shr 8 and $3F, Link and $FF);1570 end1571 1916 end; 1572 1917 1573 1918 procedure THelpDlg.BackBtnClick(Sender: TObject); 1574 1919 begin 1575 if nHist>0 then1576 begin 1577 dec(nHist);1578 if (HistKind[nHist]=hkMisc) and (HistNo[nHist]=miscSearchResult)1579 and (HistSearchContent[nHist]<>SearchContent) then1580 begin 1581 SearchContent:=HistSearchContent[nHist];1582 Search(SearchContent);1920 if nHist > 0 then 1921 begin 1922 dec(nHist); 1923 if (HistKind[nHist] = hkMisc) and (HistNo[nHist] = miscSearchResult) and 1924 (HistSearchContent[nHist] <> SearchContent) then 1925 begin 1926 SearchContent := HistSearchContent[nHist]; 1927 Search(SearchContent); 1583 1928 end; 1584 Kind:=HistKind[nHist]; 1585 no:=HistNo[nHist]; 1586 Prepare(HistPos[nHist]); 1929 Kind := HistKind[nHist]; 1930 no := HistNo[nHist]; 1931 Prepare(HistPos[nHist]); 1932 OffscreenPaint; 1933 Invalidate; 1934 end 1935 end; 1936 1937 procedure THelpDlg.TopBtnClick(Sender: TObject); 1938 begin 1939 nHist := 0; 1940 Kind := hkMisc; 1941 no := miscMain; 1942 Prepare; 1587 1943 OffscreenPaint; 1588 1944 Invalidate; 1589 end1590 end;1591 1592 procedure THelpDlg.TopBtnClick(Sender: TObject);1593 begin1594 nHist:=0;1595 Kind:=hkMisc;1596 no:=miscMain;1597 Prepare;1598 OffscreenPaint;1599 Invalidate;1600 1945 end; 1601 1946 1602 1947 procedure THelpDlg.FormClose(Sender: TObject; var Action: TCloseAction); 1603 1948 begin 1604 ExtPic.Height:=0;1605 inherited;1949 ExtPic.Height := 0; 1950 inherited; 1606 1951 end; 1607 1952 1608 1953 function THelpDlg.TextIndex(Item: string): integer; 1609 1954 begin 1610 result:=HelpText.GetHandle(Item)1955 result := HelpText.Gethandle(Item) 1611 1956 end; 1612 1957 … … 1614 1959 Shift: TShiftState); 1615 1960 begin 1616 if Key=VK_F1 then // my key 1617 else inherited 1961 if Key = VK_F1 then // my key 1962 else 1963 inherited 1618 1964 end; 1619 1965 1620 1966 procedure THelpDlg.SearchBtnClick(Sender: TObject); 1621 1967 begin 1622 InputDlg.Caption:=Phrases.Lookup('SEARCH'); 1623 InputDlg.EInput.Text:=SearchContent; 1624 InputDlg.CenterToRect(BoundsRect); 1625 InputDlg.ShowModal; 1626 if (InputDlg.ModalResult=mrOK) and (length(InputDlg.EInput.Text)>=2) then 1627 begin 1628 Search(InputDlg.EInput.Text); 1629 case SearchResult.Count of 1630 0: SimpleMessage(Format(HelpText.Lookup('NOMATCHES'), [InputDlg.EInput.Text])); 1631 1: 1632 with THelpLineInfo(SearchResult.Objects[0]) do 1633 if Link>=$8000 then 1634 ShowNewContent(FWindowMode, hkText, Link and $3FFF) 1635 else ShowNewContent(FWindowMode, Link shr 8 and $3F, Link and $FF); 1968 InputDlg.Caption := Phrases.Lookup('SEARCH'); 1969 InputDlg.EInput.Text := SearchContent; 1970 InputDlg.CenterToRect(BoundsRect); 1971 InputDlg.ShowModal; 1972 if (InputDlg.ModalResult = mrOK) and (length(InputDlg.EInput.Text) >= 2) then 1973 begin 1974 Search(InputDlg.EInput.Text); 1975 case SearchResult.Count of 1976 0: 1977 SimpleMessage(Format(HelpText.Lookup('NOMATCHES'), 1978 [InputDlg.EInput.Text])); 1979 1: 1980 with THelpLineInfo(SearchResult.Objects[0]) do 1981 if Link >= $8000 then 1982 ShowNewContent(FWindowMode, hkText, Link and $3FFF) 1983 else 1984 ShowNewContent(FWindowMode, Link shr 8 and $3F, Link and $FF); 1636 1985 else 1637 1986 begin 1638 NewSearchContent:=InputDlg.EInput.Text;1639 ShowNewContent(FWindowMode, hkMisc, miscSearchResult);1987 NewSearchContent := InputDlg.EInput.Text; 1988 ShowNewContent(FWindowMode, hkMisc, miscSearchResult); 1640 1989 end 1641 1990 end … … 1645 1994 procedure THelpDlg.Search(SearchString: string); 1646 1995 var 1647 h, i, PrevHandle, PrevIndex, p, RightMargin: integer;1648 s: string;1649 mADVHELP, mIMPHELP, mFEATUREHELP: set of 0..255;1650 bGOVHELP, bSPECIALMODEL, bJOBHELP: boolean;1996 h, i, PrevHandle, PrevIndex, p, RightMargin: integer; 1997 s: string; 1998 mADVHELP, mIMPHELP, mFEATUREHELP: set of 0 .. 255; 1999 bGOVHELP, bSPECIALMODEL, bJOBHELP: boolean; 1651 2000 begin 1652 SearchResult.Clear;1653 mADVHELP:=[];1654 mIMPHELP:=[];1655 mFEATUREHELP:=[];1656 bGOVHELP:=false;1657 bSPECIALMODEL:=false;1658 bJOBHELP:=false;1659 1660 // search in generic reference1661 SearchString:=UpperCase(SearchString);1662 for i:=0 to 35+4 do1663 begin 1664 s:=Phrases.Lookup('TERRAIN',i);1665 if pos(SearchString,UpperCase(s))>0 then1666 if i<36 then1667 SearchResult.AddLine(s+' '+HelpText.Lookup('HELPSPEC_TER'),pkNormal,0,1668 hkTer+hkCrossLink,i)1669 else2001 SearchResult.Clear; 2002 mADVHELP := []; 2003 mIMPHELP := []; 2004 mFEATUREHELP := []; 2005 bGOVHELP := false; 2006 bSPECIALMODEL := false; 2007 bJOBHELP := false; 2008 2009 // search in generic reference 2010 SearchString := UpperCase(SearchString); 2011 for i := 0 to 35 + 4 do 2012 begin 2013 s := Phrases.Lookup('TERRAIN', i); 2014 if pos(SearchString, UpperCase(s)) > 0 then 2015 if i < 36 then 2016 SearchResult.AddLine(s + ' ' + HelpText.Lookup('HELPSPEC_TER'), 2017 pkNormal, 0, hkTer + hkCrossLink, i) 2018 else 1670 2019 begin 1671 SearchResult.AddLine(Phrases.Lookup('TERRAIN',36)+' ' 1672 +HelpText.Lookup('HELPSPEC_TER'),pkNormal,0,hkTer+hkCrossLink,36); 1673 if i>36 then 1674 SearchResult.AddLine(Phrases.Lookup('IMPROVEMENTS',imShipComp+i-37) 1675 +' '+HelpText.Lookup('HELPSPEC_SHIPPART'), 1676 pkNormal,0,hkImp+hkCrossLink,imShipComp+i-37); 1677 break 2020 SearchResult.AddLine(Phrases.Lookup('TERRAIN', 36) + ' ' + 2021 HelpText.Lookup('HELPSPEC_TER'), pkNormal, 0, 2022 hkTer + hkCrossLink, 36); 2023 if i > 36 then 2024 SearchResult.AddLine(Phrases.Lookup('IMPROVEMENTS', 2025 imShipComp + i - 37) + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'), 2026 pkNormal, 0, hkImp + hkCrossLink, imShipComp + i - 37); 2027 Break 1678 2028 end 1679 2029 end; 1680 for i:=0 to nJobHelp-1 do 1681 if pos(SearchString,UpperCase(Phrases.Lookup('JOBRESULT',JobHelp[i])))>0 then 1682 begin 1683 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'),pkNormal,0, 1684 hkMisc+hkCrossLink,miscJobList); 1685 bJOBHELP:=true; 1686 break 2030 for i := 0 to nJobHelp - 1 do 2031 if pos(SearchString, UpperCase(Phrases.Lookup('JOBRESULT', JobHelp[i]))) > 0 2032 then 2033 begin 2034 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, 2035 hkMisc + hkCrossLink, miscJobList); 2036 bJOBHELP := true; 2037 Break 1687 2038 end; 1688 for i:=0 to nAdv-1 do 1689 begin 1690 s:=Phrases.Lookup('ADVANCES',i); 1691 if pos(SearchString,UpperCase(s))>0 then 1692 begin 1693 if i in FutureTech then s:=s+' '+HelpText.Lookup('HELPSPEC_FUTURE') 1694 else s:=s+' '+HelpText.Lookup('HELPSPEC_ADV'); 1695 SearchResult.AddLine(s,pkNormal,0,hkAdv+hkCrossLink,i); 1696 include(mADVHELP,i); 2039 for i := 0 to nAdv - 1 do 2040 begin 2041 s := Phrases.Lookup('ADVANCES', i); 2042 if pos(SearchString, UpperCase(s)) > 0 then 2043 begin 2044 if i in FutureTech then 2045 s := s + ' ' + HelpText.Lookup('HELPSPEC_FUTURE') 2046 else 2047 s := s + ' ' + HelpText.Lookup('HELPSPEC_ADV'); 2048 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i); 2049 include(mADVHELP, i); 1697 2050 end 1698 2051 end; 1699 for i:=0 to nSpecialModel-1 do1700 begin 1701 FindStdModelPicture(SpecialModelPictureCode[i],h,s);1702 if pos(SearchString,UpperCase(s))>0 then1703 begin 1704 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'),pkNormal,0,1705 hkModel+hkCrossLink,0);1706 bSPECIALMODEL:=true;1707 break2052 for i := 0 to nSpecialModel - 1 do 2053 begin 2054 FindStdModelPicture(SpecialModelPictureCode[i], h, s); 2055 if pos(SearchString, UpperCase(s)) > 0 then 2056 begin 2057 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkNormal, 0, 2058 hkModel + hkCrossLink, 0); 2059 bSPECIALMODEL := true; 2060 Break 1708 2061 end; 1709 2062 end; 1710 for i:=0 to nFeature-1 do 1711 begin 1712 s:=Phrases.Lookup('FEATURES',i); 1713 if pos(SearchString,UpperCase(s))>0 then 1714 begin 1715 if i<mcFirstNonCap then s:=s+' '+HelpText.Lookup('HELPSPEC_CAP') 1716 else if i in AutoFeature then s:=s+' '+HelpText.Lookup('HELPSPEC_STANDARD') 1717 else s:=s+' '+HelpText.Lookup('HELPSPEC_FEATURE'); 1718 SearchResult.AddLine(s,pkNormal,0,hkFeature+hkCrossLink,i); 1719 include(mFEATUREHELP,i); 2063 for i := 0 to nFeature - 1 do 2064 begin 2065 s := Phrases.Lookup('FEATURES', i); 2066 if pos(SearchString, UpperCase(s)) > 0 then 2067 begin 2068 if i < mcFirstNonCap then 2069 s := s + ' ' + HelpText.Lookup('HELPSPEC_CAP') 2070 else if i in AutoFeature then 2071 s := s + ' ' + HelpText.Lookup('HELPSPEC_STANDARD') 2072 else 2073 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2074 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 2075 include(mFEATUREHELP, i); 1720 2076 end 1721 2077 end; 1722 for i:=0 to nImp-1 do 1723 begin 1724 s:=Phrases.Lookup('IMPROVEMENTS',i); 1725 if pos(SearchString,UpperCase(s))>0 then 1726 begin 1727 case Imp[i].Kind of 1728 ikWonder: s:=s+' '+HelpText.Lookup('HELPSPEC_WONDER'); 1729 ikCommon: s:=s+' '+HelpText.Lookup('HELPSPEC_IMP'); 1730 ikShipPart: s:=s+' '+HelpText.Lookup('HELPSPEC_SHIPPART'); 1731 else s:=s+' '+HelpText.Lookup('HELPSPEC_NAT') 2078 for i := 0 to nImp - 1 do 2079 begin 2080 s := Phrases.Lookup('IMPROVEMENTS', i); 2081 if pos(SearchString, UpperCase(s)) > 0 then 2082 begin 2083 case Imp[i].Kind of 2084 ikWonder: 2085 s := s + ' ' + HelpText.Lookup('HELPSPEC_WONDER'); 2086 ikCommon: 2087 s := s + ' ' + HelpText.Lookup('HELPSPEC_IMP'); 2088 ikShipPart: 2089 s := s + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'); 2090 else 2091 s := s + ' ' + HelpText.Lookup('HELPSPEC_NAT') 1732 2092 end; 1733 SearchResult.AddLine(s,pkNormal,0,hkImp+hkCrossLink,i);1734 include(mIMPHELP,i);2093 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i); 2094 include(mIMPHELP, i); 1735 2095 end 1736 2096 end; 1737 for i:=0 to nGov-1 do1738 if pos(SearchString,UpperCase(Phrases.Lookup('GOVERNMENT',i)))>0 then1739 begin 1740 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'),pkNormal,0,1741 hkMisc+hkCrossLink,miscGovList);1742 bGOVHELP:=true;1743 break2097 for i := 0 to nGov - 1 do 2098 if pos(SearchString, UpperCase(Phrases.Lookup('GOVERNMENT', i))) > 0 then 2099 begin 2100 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkNormal, 0, 2101 hkMisc + hkCrossLink, miscGovList); 2102 bGOVHELP := true; 2103 Break 1744 2104 end; 1745 2105 1746 // full text search 1747 h:=-1; 1748 repeat 1749 PrevHandle:=h; 1750 PrevIndex:=i; 1751 if not HelpText.Search(SearchString, h, i) then 1752 break; 1753 if h=hADVHELP then 1754 begin 1755 if (i>=0) and ((i<>PrevIndex) or (h<>PrevHandle)) and not (i in mADVHELP) then 2106 // full text search 2107 h := -1; 2108 repeat 2109 PrevHandle := h; 2110 PrevIndex := i; 2111 if not HelpText.Search(SearchString, h, i) then 2112 Break; 2113 if h = hADVHELP then 2114 begin 2115 if (i >= 0) and ((i <> PrevIndex) or (h <> PrevHandle)) and 2116 not(i in mADVHELP) then 1756 2117 begin 1757 s:=Phrases.Lookup('ADVANCES',i); 1758 if i in FutureTech then s:=s+' '+HelpText.Lookup('HELPSPEC_FUTURE') 1759 else s:=s+' '+HelpText.Lookup('HELPSPEC_ADV'); 1760 SearchResult.AddLine(s,pkNormal,0,hkAdv+hkCrossLink,i) 2118 s := Phrases.Lookup('ADVANCES', i); 2119 if i in FutureTech then 2120 s := s + ' ' + HelpText.Lookup('HELPSPEC_FUTURE') 2121 else 2122 s := s + ' ' + HelpText.Lookup('HELPSPEC_ADV'); 2123 SearchResult.AddLine(s, pkNormal, 0, hkAdv + hkCrossLink, i) 1761 2124 end 1762 2125 end 1763 else if h=hIMPHELP then 1764 begin 1765 if (i>=0) and ((i<>PrevIndex) or (h<>PrevHandle)) and not (i in mIMPHELP) then 2126 else if h = hIMPHELP then 2127 begin 2128 if (i >= 0) and ((i <> PrevIndex) or (h <> PrevHandle)) and 2129 not(i in mIMPHELP) then 1766 2130 begin 1767 s:=Phrases.Lookup('IMPROVEMENTS',i); 1768 case Imp[i].Kind of 1769 ikWonder: s:=s+' '+HelpText.Lookup('HELPSPEC_WONDER'); 1770 ikCommon: s:=s+' '+HelpText.Lookup('HELPSPEC_IMP'); 1771 ikShipPart: s:=s+' '+HelpText.Lookup('HELPSPEC_SHIPPART'); 1772 else s:=s+' '+HelpText.Lookup('HELPSPEC_NAT') 2131 s := Phrases.Lookup('IMPROVEMENTS', i); 2132 case Imp[i].Kind of 2133 ikWonder: 2134 s := s + ' ' + HelpText.Lookup('HELPSPEC_WONDER'); 2135 ikCommon: 2136 s := s + ' ' + HelpText.Lookup('HELPSPEC_IMP'); 2137 ikShipPart: 2138 s := s + ' ' + HelpText.Lookup('HELPSPEC_SHIPPART'); 2139 else 2140 s := s + ' ' + HelpText.Lookup('HELPSPEC_NAT') 1773 2141 end; 1774 SearchResult.AddLine(s,pkNormal,0,hkImp+hkCrossLink,i)2142 SearchResult.AddLine(s, pkNormal, 0, hkImp + hkCrossLink, i) 1775 2143 end 1776 2144 end 1777 else if h=hFEATUREHELP then 1778 begin 1779 if (i>=0) and ((i<>PrevIndex) or (h<>PrevHandle)) and not (i in mFEATUREHELP) then 2145 else if h = hFEATUREHELP then 2146 begin 2147 if (i >= 0) and ((i <> PrevIndex) or (h <> PrevHandle)) and 2148 not(i in mFEATUREHELP) then 1780 2149 begin 1781 s:=Phrases.Lookup('FEATURES',i); 1782 if i<mcFirstNonCap then s:=s+' '+HelpText.Lookup('HELPSPEC_CAP') 1783 else if i in AutoFeature then s:=s+' '+HelpText.Lookup('HELPSPEC_STANDARD') 1784 else s:=s+' '+HelpText.Lookup('HELPSPEC_FEATURE'); 1785 SearchResult.AddLine(s,pkNormal,0,hkFeature+hkCrossLink,i); 2150 s := Phrases.Lookup('FEATURES', i); 2151 if i < mcFirstNonCap then 2152 s := s + ' ' + HelpText.Lookup('HELPSPEC_CAP') 2153 else if i in AutoFeature then 2154 s := s + ' ' + HelpText.Lookup('HELPSPEC_STANDARD') 2155 else 2156 s := s + ' ' + HelpText.Lookup('HELPSPEC_FEATURE'); 2157 SearchResult.AddLine(s, pkNormal, 0, hkFeature + hkCrossLink, i); 1786 2158 end 1787 2159 end 1788 else if h=hGOVHELP then1789 begin 1790 if (i>=0) and (h<>PrevHandle) and not bGOVHELP then1791 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'),pkNormal,0,1792 hkMisc+hkCrossLink,miscGovList)2160 else if h = hGOVHELP then 2161 begin 2162 if (i >= 0) and (h <> PrevHandle) and not bGOVHELP then 2163 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_GOVLIST'), pkNormal, 0, 2164 hkMisc + hkCrossLink, miscGovList) 1793 2165 end 1794 else if h=hSPECIALMODEL then1795 begin 1796 if (i>=0) and (h<>PrevHandle) and not bSPECIALMODEL then1797 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'),pkNormal,0,1798 hkModel+hkCrossLink,0)2166 else if h = hSPECIALMODEL then 2167 begin 2168 if (i >= 0) and (h <> PrevHandle) and not bSPECIALMODEL then 2169 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_MODELLIST'), pkNormal, 2170 0, hkModel + hkCrossLink, 0) 1799 2171 end 1800 else if h=hJOBHELP then1801 begin 1802 if (i>=0) and (h<>PrevHandle) and not bJOBHELP then1803 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'),pkNormal,0,1804 hkMisc+hkCrossLink,miscJobList)2172 else if h = hJOBHELP then 2173 begin 2174 if (i >= 0) and (h <> PrevHandle) and not bJOBHELP then 2175 SearchResult.AddLine(HelpText.Lookup('HELPTITLE_JOBLIST'), pkNormal, 0, 2176 hkMisc + hkCrossLink, miscJobList) 1805 2177 end 1806 else if {(h<>hMAIN) and} (h<>PrevHandle) then1807 begin 1808 s:=HelpText.LookupByHandle(h);1809 p:=pos('$',s);1810 if p>0 then2178 else if { (h<>hMAIN) and } (h <> PrevHandle) then 2179 begin 2180 s := HelpText.LookupByHandle(h); 2181 p := pos('$', s); 2182 if p > 0 then 1811 2183 begin 1812 s:=copy(s,p+1,maxint);1813 p:=pos('\',s);1814 if p>0 then1815 s:=copy(s,1,p-1);1816 SearchResult.AddLine(s, pkNormal, 0, hkText+hkCrossLink, h);2184 s := copy(s, p + 1, maxint); 2185 p := pos('\', s); 2186 if p > 0 then 2187 s := copy(s, 1, p - 1); 2188 SearchResult.AddLine(s, pkNormal, 0, hkText + hkCrossLink, h); 1817 2189 end 1818 2190 end 1819 until false; 1820 1821 // cut lines to fit to window 1822 RightMargin:=InnerWidth-16-GetSystemMetrics(SM_CXVSCROLL); 1823 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 1824 for i:=0 to SearchResult.Count-1 do 1825 begin 1826 while BiColorTextWidth(Offscreen.Canvas, SearchResult[i])>RightMargin-32 do 1827 SearchResult[i]:=copy(SearchResult[i], 1, length(SearchResult[i])-1) 1828 end; 1829 end; 2191 until false; 2192 2193 // cut lines to fit to window 2194 RightMargin := InnerWidth - 16 - GetSystemMetrics(SM_CXVSCROLL); 2195 OffScreen.Canvas.Font.Assign(UniFont[ftNormal]); 2196 for i := 0 to SearchResult.Count - 1 do 2197 begin 2198 while BiColorTextWidth(OffScreen.Canvas, SearchResult[i]) > 2199 RightMargin - 32 do 2200 SearchResult[i] := copy(SearchResult[i], 1, length(SearchResult[i]) - 1) 2201 end; 2202 end; 1830 2203 1831 2204 end. 1832 -
trunk/LocalPlayer/IsoEngine.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit IsoEngine; 4 3 … … 6 5 7 6 uses 8 Protocol,ClientTools,ScreenTools,Tribes, 9 {$IFNDEF SCR}Term,{$ENDIF} 10 11 Windows,SysUtils,Classes,Graphics; 7 Protocol, ClientTools, ScreenTools, Tribes, 8 {$IFNDEF SCR}Term, {$ENDIF} 9 Windows, SysUtils, Classes, Graphics; 12 10 13 11 type 14 TInitEnemyModelEvent=function(emix: integer): boolean; 15 16 TIsoMap = class 17 constructor Create; 18 procedure SetOutput(Output: TBitmap); 19 procedure SetPaintBounds(Left, Top, Right, Bottom: integer); 20 procedure Paint(x,y,Loc,nx,ny,CityLoc,CityOwner:integer; UseBlink: boolean = false; CityAllowClick: boolean = false); 21 procedure PaintUnit(x,y:integer;const UnitInfo:TUnitInfo;Status:integer); 22 procedure PaintCity(x,y:integer;const CityInfo:TCityInfo; accessory: boolean = true); 23 procedure BitBlt(Src: TBitmap; x,y,Width,Height,xSrc,ySrc,Rop: integer); 24 25 procedure AttackBegin(const ShowMove: TShowMove); 26 procedure AttackEffect(const ShowMove: TShowMove); 27 procedure AttackEnd; 28 29 protected 30 FOutput: TBitmap; 31 FLeft, FTop, FRight, FBottom, RealTop, RealBottom, AttLoc, DefLoc, DefHealth, FAdviceLoc: integer; 32 OutDC, DataDC, MaskDC: Cardinal; 33 function Connection4(Loc,Mask,Value:integer):integer; 34 function Connection8(Loc,Mask:integer):integer; 35 function OceanConnection(Loc: integer): integer; 36 procedure PaintShore(x,y,Loc:integer); 37 procedure PaintTileExtraTerrain(x,y,Loc: integer); 38 procedure PaintTileObjects(x,y,Loc,CityLoc,CityOwner:integer; UseBlink: boolean); 39 procedure PaintGrid(x,y,nx,ny: integer); 40 procedure FillRect(x,y,Width,Height,Color: integer); 41 procedure Textout(x,y,Color: integer; const s: string); 42 procedure Sprite(HGr,xDst,yDst,Width,Height,xGr,yGr: integer); 43 procedure TSprite(xDst,yDst,grix: integer; PureBlack: boolean = false); 44 45 public 46 property AdviceLoc: integer read FAdviceLoc write FAdviceLoc; 12 TInitEnemyModelEvent = function(emix: integer): boolean; 13 14 TIsoMap = class 15 constructor Create; 16 procedure SetOutput(Output: TBitmap); 17 procedure SetPaintBounds(Left, Top, Right, Bottom: integer); 18 procedure Paint(x, y, Loc, nx, ny, CityLoc, CityOwner: integer; 19 UseBlink: boolean = false; CityAllowClick: boolean = false); 20 procedure PaintUnit(x, y: integer; const UnitInfo: TUnitInfo; 21 Status: integer); 22 procedure PaintCity(x, y: integer; const CityInfo: TCityInfo; 23 accessory: boolean = true); 24 procedure BitBlt(Src: TBitmap; x, y, Width, Height, xSrc, ySrc, 25 Rop: integer); 26 27 procedure AttackBegin(const ShowMove: TShowMove); 28 procedure AttackEffect(const ShowMove: TShowMove); 29 procedure AttackEnd; 30 31 protected 32 FOutput: TBitmap; 33 FLeft, FTop, FRight, FBottom, RealTop, RealBottom, AttLoc, DefLoc, 34 DefHealth, FAdviceLoc: integer; 35 OutDC, DataDC, MaskDC: Cardinal; 36 function Connection4(Loc, Mask, Value: integer): integer; 37 function Connection8(Loc, Mask: integer): integer; 38 function OceanConnection(Loc: integer): integer; 39 procedure PaintShore(x, y, Loc: integer); 40 procedure PaintTileExtraTerrain(x, y, Loc: integer); 41 procedure PaintTileObjects(x, y, Loc, CityLoc, CityOwner: integer; 42 UseBlink: boolean); 43 procedure PaintGrid(x, y, nx, ny: integer); 44 procedure FillRect(x, y, Width, Height, Color: integer); 45 procedure Textout(x, y, Color: integer; const s: string); 46 procedure Sprite(HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 47 procedure TSprite(xDst, yDst, grix: integer; PureBlack: boolean = false); 48 49 public 50 property AdviceLoc: integer read FAdviceLoc write FAdviceLoc; 47 51 end; 48 52 49 50 53 const 51 // options switched by buttons 52 moPolitical=0; moCityNames=1; moGreatWall=4; moGrid=5; moBareTerrain=6; 53 54 // other options 55 moEditMode=16; moLocCodes=17; 56 54 // options switched by buttons 55 moPolitical = 0; 56 moCityNames = 1; 57 moGreatWall = 4; 58 moGrid = 5; 59 moBareTerrain = 6; 60 61 // other options 62 moEditMode = 16; 63 moLocCodes = 17; 57 64 58 65 var 59 NoMap: TIsoMap; 60 Options: integer; 61 pDebugMap: integer; //-1 for off 62 66 NoMap: TIsoMap; 67 Options: integer; 68 pDebugMap: integer; // -1 for off 63 69 64 70 function IsJungle(y: integer): boolean; … … 68 74 procedure Reset; 69 75 70 71 76 implementation 72 77 73 78 const 74 ShoreDither=fGrass;75 TerrainIconLines=21;79 ShoreDither = fGrass; 80 TerrainIconLines = 21; 76 81 77 82 var 78 BordersOK: integer;79 OnInitEnemyModel: TInitEnemyModelEvent;80 LandPatch,OceanPatch, Borders: TBitmap;81 TSpriteSize: array[0..TerrainIconLines*9-1] of TRect;82 DebugMap: ^TTileList;83 CitiesPictures: array[2..3,0..3] of TCityPicture;84 FoW, ShowLoc, ShowCityNames, ShowObjects, ShowBorder, ShowMyBorder,85 ShowGrWall, ShowDebug: boolean;83 BordersOK: integer; 84 OnInitEnemyModel: TInitEnemyModelEvent; 85 LandPatch, OceanPatch, Borders: TBitmap; 86 TSpriteSize: array [0 .. TerrainIconLines * 9 - 1] of TRect; 87 DebugMap: ^TTileList; 88 CitiesPictures: array [2 .. 3, 0 .. 3] of TCityPicture; 89 FoW, ShowLoc, ShowCityNames, ShowObjects, ShowBorder, ShowMyBorder, 90 ShowGrWall, ShowDebug: boolean; 86 91 87 92 function IsJungle(y: integer): boolean; 88 93 begin 89 result:= (y>(G.ly-2) div 4) and (G.ly-1-y>(G.ly-2) div 4)94 result := (y > (G.ly - 2) div 4) and (G.ly - 1 - y > (G.ly - 2) div 4) 90 95 end; 91 96 92 97 procedure Init(InitEnemyModelHandler: TInitEnemyModelEvent); 93 98 begin 94 OnInitEnemyModel:=InitEnemyModelHandler;95 if NoMap<>nil then96 NoMap.Free;97 NoMap:=TIsoMap.Create;99 OnInitEnemyModel := InitEnemyModelHandler; 100 if NoMap <> nil then 101 NoMap.Free; 102 NoMap := TIsoMap.Create; 98 103 end; 99 104 100 105 function ApplyTileSize(xxtNew, yytNew: integer): boolean; 101 106 type 102 TLine=array[0..INFIN,0..2] of Byte;107 TLine = array [0 .. INFIN, 0 .. 2] of Byte; 103 108 var 104 i,x,y,xSrc,ySrc,HGrTerrainNew,HGrCitiesNew,age,size:integer;105 LandMore,OceanMore,DitherMask,Mask24: TBitmap;106 MaskLine: array[0..32*3-1] of ^TLine; // 32 = assumed maximum for yyt107 Border: boolean;109 i, x, y, xSrc, ySrc, HGrTerrainNew, HGrCitiesNew, age, size: integer; 110 LandMore, OceanMore, DitherMask, Mask24: TBitmap; 111 MaskLine: array [0 .. 32 * 3 - 1] of ^TLine; // 32 = assumed maximum for yyt 112 Border: boolean; 108 113 begin 109 result:=false; 110 HGrTerrainNew:=LoadGraphicSet(Format('Terrain%dx%d',[xxtNew*2,yytNew*2])); 111 if HGrTerrainNew<0 then 112 exit; 113 HGrCitiesNew:=LoadGraphicSet(Format('Cities%dx%d',[xxtNew*2,yytNew*2])); 114 if HGrCitiesNew<0 then 115 exit; 116 xxt:=xxtNew; yyt:=yytNew; 117 HGrTerrain:=HGrTerrainNew; 118 HGrCities:=HGrCitiesNew; 119 result:=true; 120 121 // prepare age 2+3 cities 122 for age:=2 to 3 do 123 for size:=0 to 3 do with CitiesPictures[age,size] do 124 FindPosition(HGrCities,size*(xxt*2+1),(age-2)*(yyt*3+1),xxt*2-1,yyt*3-1, 125 $00FFFF,xShield,yShield); 126 127 {prepare dithered ground tiles} 128 if LandPatch<>nil then 129 LandPatch.Free; 130 LandPatch:=TBitmap.Create; 131 LandPatch.PixelFormat:=pf24bit; 132 LandPatch.Canvas.Brush.Color:=0; 133 LandPatch.Width:=xxt*18; LandPatch.Height:=yyt*9; 134 if OceanPatch<>nil then 135 OceanPatch.Free; 136 OceanPatch:=TBitmap.Create; 137 OceanPatch.PixelFormat:=pf24bit; 138 OceanPatch.Canvas.Brush.Color:=0; 139 OceanPatch.Width:=xxt*8; OceanPatch.Height:=yyt*4; 140 LandMore:=TBitmap.Create; 141 LandMore.PixelFormat:=pf24bit; 142 LandMore.Canvas.Brush.Color:=0; 143 LandMore.Width:=xxt*18; LandMore.Height:=yyt*9; 144 OceanMore:=TBitmap.Create; 145 OceanMore.PixelFormat:=pf24bit; 146 OceanMore.Canvas.Brush.Color:=0; 147 OceanMore.Width:=xxt*8; OceanMore.Height:=yyt*4; 148 DitherMask:=TBitmap.Create; 149 DitherMask.PixelFormat:=pf24bit; 150 DitherMask.Width:=xxt*2; DitherMask.Height:=yyt*2; 151 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt*2, 152 GrExt[HGrTerrain].Mask.Canvas.Handle,1+7*(xxt*2+1),1+yyt+15*(yyt*3+1),SRCAND); 153 154 for x:=-1 to 6 do 114 result := false; 115 HGrTerrainNew := LoadGraphicSet(Format('Terrain%dx%d', 116 [xxtNew * 2, yytNew * 2])); 117 if HGrTerrainNew < 0 then 118 exit; 119 HGrCitiesNew := LoadGraphicSet(Format('Cities%dx%d', 120 [xxtNew * 2, yytNew * 2])); 121 if HGrCitiesNew < 0 then 122 exit; 123 xxt := xxtNew; 124 yyt := yytNew; 125 HGrTerrain := HGrTerrainNew; 126 HGrCities := HGrCitiesNew; 127 result := true; 128 129 // prepare age 2+3 cities 130 for age := 2 to 3 do 131 for size := 0 to 3 do 132 with CitiesPictures[age, size] do 133 FindPosition(HGrCities, size * (xxt * 2 + 1), (age - 2) * (yyt * 3 + 1), 134 xxt * 2 - 1, yyt * 3 - 1, $00FFFF, xShield, yShield); 135 136 { prepare dithered ground tiles } 137 if LandPatch <> nil then 138 LandPatch.Free; 139 LandPatch := TBitmap.Create; 140 LandPatch.PixelFormat := pf24bit; 141 LandPatch.Canvas.Brush.Color := 0; 142 LandPatch.Width := xxt * 18; 143 LandPatch.Height := yyt * 9; 144 if OceanPatch <> nil then 145 OceanPatch.Free; 146 OceanPatch := TBitmap.Create; 147 OceanPatch.PixelFormat := pf24bit; 148 OceanPatch.Canvas.Brush.Color := 0; 149 OceanPatch.Width := xxt * 8; 150 OceanPatch.Height := yyt * 4; 151 LandMore := TBitmap.Create; 152 LandMore.PixelFormat := pf24bit; 153 LandMore.Canvas.Brush.Color := 0; 154 LandMore.Width := xxt * 18; 155 LandMore.Height := yyt * 9; 156 OceanMore := TBitmap.Create; 157 OceanMore.PixelFormat := pf24bit; 158 OceanMore.Canvas.Brush.Color := 0; 159 OceanMore.Width := xxt * 8; 160 OceanMore.Height := yyt * 4; 161 DitherMask := TBitmap.Create; 162 DitherMask.PixelFormat := pf24bit; 163 DitherMask.Width := xxt * 2; 164 DitherMask.Height := yyt * 2; 165 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2, 166 GrExt[HGrTerrain].Mask.Canvas.Handle, 1 + 7 * (xxt * 2 + 1), 167 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 168 169 for x := -1 to 6 do 155 170 begin 156 if x=-1 then begin xSrc:=ShoreDither*(xxt*2+1)+1; ySrc:=1+yyt end 157 else if x=6 then begin xSrc:=1+(xxt*2+1)*2; ySrc:=1+yyt+(yyt*3+1)*2 end 158 else begin xSrc:=(x+2)*(xxt*2+1)+1; ySrc:=1+yyt end; 159 for y:=-1 to 6 do 160 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt*2,yyt, 161 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY); 162 for y:=-2 to 6 do 163 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt,yyt, 164 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+xxt,ySrc+yyt,SRCPAINT); 165 for y:=-2 to 6 do 166 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2)+xxt,(y+2)*yyt,xxt,yyt, 167 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+yyt,SRCPAINT); 168 for y:=-2 to 6 do 169 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt,yyt, 170 DitherMask.Canvas.Handle,xxt,yyt,SRCAND); 171 for y:=-2 to 6 do 172 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2)+xxt,(y+2)*yyt,xxt,yyt, 173 DitherMask.Canvas.Handle,0,yyt,SRCAND); 171 if x = -1 then 172 begin 173 xSrc := ShoreDither * (xxt * 2 + 1) + 1; 174 ySrc := 1 + yyt 175 end 176 else if x = 6 then 177 begin 178 xSrc := 1 + (xxt * 2 + 1) * 2; 179 ySrc := 1 + yyt + (yyt * 3 + 1) * 2 180 end 181 else 182 begin 183 xSrc := (x + 2) * (xxt * 2 + 1) + 1; 184 ySrc := 1 + yyt 185 end; 186 for y := -1 to 6 do 187 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 188 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, 189 SRCCOPY); 190 for y := -2 to 6 do 191 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt, 192 yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, 193 SRCPAINT); 194 for y := -2 to 6 do 195 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt, 196 xxt, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc + yyt, 197 SRCPAINT); 198 for y := -2 to 6 do 199 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, xxt, 200 yyt, DitherMask.Canvas.Handle, xxt, yyt, SRCAND); 201 for y := -2 to 6 do 202 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2) + xxt, (y + 2) * yyt, 203 xxt, yyt, DitherMask.Canvas.Handle, 0, yyt, SRCAND); 174 204 end; 175 205 176 for y:=-1 to 6 do206 for y := -1 to 6 do 177 207 begin 178 if y=-1 then begin xSrc:=ShoreDither*(xxt*2+1)+1; ySrc:=1+yyt end 179 else if y=6 then begin xSrc:=1+2*(xxt*2+1); ySrc:=1+yyt+2*(yyt*3+1) end 180 else begin xSrc:=(y+2)*(xxt*2+1)+1; ySrc:=1+yyt end; 181 for x:=-2 to 6 do 182 BitBlt(LandMore.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt*2,yyt, 183 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY); 184 BitBlt(LandMore.Canvas.Handle,xxt*2,(y+2)*yyt,xxt,yyt, 185 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+xxt,ySrc+yyt,SRCPAINT); 186 for x:=0 to 7 do 187 BitBlt(LandMore.Canvas.Handle,(x+2)*(xxt*2)-xxt,(y+2)*yyt,xxt*2,yyt, 188 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+yyt,SRCPAINT); 189 for x:=-2 to 6 do 190 BitBlt(LandMore.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt*2,yyt, 191 DitherMask.Canvas.Handle,0,0,SRCAND); 208 if y = -1 then 209 begin 210 xSrc := ShoreDither * (xxt * 2 + 1) + 1; 211 ySrc := 1 + yyt 212 end 213 else if y = 6 then 214 begin 215 xSrc := 1 + 2 * (xxt * 2 + 1); 216 ySrc := 1 + yyt + 2 * (yyt * 3 + 1) 217 end 218 else 219 begin 220 xSrc := (y + 2) * (xxt * 2 + 1) + 1; 221 ySrc := 1 + yyt 222 end; 223 for x := -2 to 6 do 224 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 225 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, 226 SRCCOPY); 227 BitBlt(LandMore.Canvas.Handle, xxt * 2, (y + 2) * yyt, xxt, yyt, 228 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, SRCPAINT); 229 for x := 0 to 7 do 230 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt, 231 xxt * 2, yyt, GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc + yyt, 232 SRCPAINT); 233 for x := -2 to 6 do 234 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 235 xxt * 2, yyt, DitherMask.Canvas.Handle, 0, 0, SRCAND); 192 236 end; 193 237 194 for x:=0 to 3 do for y:=0 to 3 do 238 for x := 0 to 3 do 239 for y := 0 to 3 do 240 begin 241 if (x = 1) and (y = 1) then 242 xSrc := 1 243 else 244 xSrc := (x mod 2) * (xxt * 2 + 1) + 1; 245 ySrc := 1 + yyt; 246 if (x >= 1) = (y >= 2) then 247 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt, 248 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, SRCCOPY); 249 if (x >= 1) and ((y < 2) or (x >= 2)) then 250 begin 251 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt, 252 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, 253 SRCPAINT); 254 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 255 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc + yyt, SRCPAINT); 256 end; 257 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt, 258 DitherMask.Canvas.Handle, xxt, yyt, SRCAND); 259 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 260 DitherMask.Canvas.Handle, 0, yyt, SRCAND); 261 end; 262 263 for y := 0 to 3 do 264 for x := 0 to 3 do 265 begin 266 if (x = 1) and (y = 1) then 267 xSrc := 1 268 else 269 xSrc := (y mod 2) * (xxt * 2 + 1) + 1; 270 ySrc := 1 + yyt; 271 if (x < 1) or (y >= 2) then 272 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt, 273 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc, SRCCOPY); 274 if (x = 1) and (y < 2) or (x >= 2) and (y >= 1) then 275 begin 276 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt, yyt, 277 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc + xxt, ySrc + yyt, 278 SRCPAINT); 279 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2) + xxt, y * yyt, xxt, yyt, 280 GrExt[HGrTerrain].Data.Canvas.Handle, xSrc, ySrc + yyt, SRCPAINT); 281 end; 282 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt, 283 DitherMask.Canvas.Handle, 0, 0, SRCAND); 284 end; 285 286 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2, 287 DitherMask.Canvas.Handle, 0, 0, DSTINVERT); { invert dither mask } 288 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt * 2, 289 GrExt[HGrTerrain].Mask.Canvas.Handle, 1, 1 + yyt, SRCPAINT); 290 291 for x := -1 to 6 do 292 for y := -2 to 6 do 293 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), (y + 2) * yyt, 294 xxt * 2, yyt, DitherMask.Canvas.Handle, 0, 0, SRCAND); 295 296 for y := -1 to 6 do 297 for x := -2 to 7 do 298 BitBlt(LandMore.Canvas.Handle, (x + 2) * (xxt * 2) - xxt, (y + 2) * yyt, 299 xxt * 2, yyt, DitherMask.Canvas.Handle, 0, yyt, SRCAND); 300 301 BitBlt(LandPatch.Canvas.Handle, 0, 0, (xxt * 2) * 9, yyt * 9, 302 LandMore.Canvas.Handle, 0, 0, SRCPAINT); 303 304 for x := 0 to 3 do 305 for y := 0 to 3 do 306 BitBlt(OceanPatch.Canvas.Handle, x * (xxt * 2), y * yyt, xxt * 2, yyt, 307 DitherMask.Canvas.Handle, 0, 0, SRCAND); 308 309 for y := 0 to 3 do 310 for x := 0 to 4 do 311 BitBlt(OceanMore.Canvas.Handle, x * (xxt * 2) - xxt, y * yyt, xxt * 2, 312 yyt, DitherMask.Canvas.Handle, 0, yyt, SRCAND); 313 314 BitBlt(OceanPatch.Canvas.Handle, 0, 0, (xxt * 2) * 4, yyt * 4, 315 OceanMore.Canvas.Handle, 0, 0, SRCPAINT); 316 317 with DitherMask.Canvas do 195 318 begin 196 if (x=1) and (y=1) then xSrc:=1 197 else xSrc:=(x mod 2)*(xxt*2+1)+1; 198 ySrc:=1+yyt; 199 if (x>=1)=(y>=2) then 200 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2),y*yyt,xxt*2,yyt, 201 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY); 202 if (x>=1) and ((y<2) or (x>=2)) then 319 Brush.Color := $FFFFFF; 320 FillRect(Rect(0, 0, xxt * 2, yyt)); 321 end; 322 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt, 323 GrExt[HGrTerrain].Mask.Canvas.Handle, 1, 1 + yyt, SRCCOPY); 324 325 for x := 0 to 6 do 326 BitBlt(LandPatch.Canvas.Handle, (x + 2) * (xxt * 2), yyt, xxt * 2, yyt, 327 DitherMask.Canvas.Handle, 0, 0, SRCAND); 328 329 BitBlt(DitherMask.Canvas.Handle, 0, 0, xxt * 2, yyt, DitherMask.Canvas.Handle, 330 0, 0, DSTINVERT); 331 332 for y := 0 to 6 do 333 BitBlt(LandPatch.Canvas.Handle, xxt * 2, (y + 2) * yyt, xxt * 2, yyt, 334 DitherMask.Canvas.Handle, 0, 0, SRCAND); 335 336 LandMore.Free; 337 OceanMore.Free; 338 DitherMask.Free; 339 // LandPatch.Savetofile('landpatch.bmp'); 340 341 // reduce size of terrain icons 342 Mask24 := TBitmap.Create; 343 Mask24.Assign(GrExt[HGrTerrain].Mask); 344 Mask24.PixelFormat := pf24bit; 345 for ySrc := 0 to TerrainIconLines - 1 do 346 begin 347 for i := 0 to yyt * 3 - 1 do 348 MaskLine[i] := Mask24.ScanLine[1 + ySrc * (yyt * 3 + 1) + i]; 349 for xSrc := 0 to 9 - 1 do 203 350 begin 204 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2),y*yyt,xxt,yyt, 205 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+xxt,ySrc+yyt,SRCPAINT); 206 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2)+xxt,y*yyt,xxt,yyt, 207 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+yyt,SRCPAINT); 208 end; 209 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2),y*yyt,xxt,yyt, 210 DitherMask.Canvas.Handle,xxt,yyt,SRCAND); 211 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2)+xxt,y*yyt,xxt,yyt, 212 DitherMask.Canvas.Handle,0,yyt,SRCAND); 213 end; 214 215 for y:=0 to 3 do for x:=0 to 3 do 216 begin 217 if (x=1) and (y=1) then xSrc:=1 218 else xSrc:=(y mod 2)*(xxt*2+1)+1; 219 ySrc:=1+yyt; 220 if (x<1) or (y>=2) then 221 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2),y*yyt,xxt*2,yyt, 222 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc,SRCCOPY); 223 if (x=1) and (y<2) or (x>=2) and (y>=1) then 224 begin 225 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2),y*yyt,xxt,yyt, 226 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc+xxt,ySrc+yyt,SRCPAINT); 227 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2)+xxt,y*yyt,xxt,yyt, 228 GrExt[HGrTerrain].Data.Canvas.Handle,xSrc,ySrc+yyt,SRCPAINT); 229 end; 230 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2),y*yyt,xxt*2,yyt, 231 DitherMask.Canvas.Handle,0,0,SRCAND); 232 end; 233 234 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt*2, 235 DitherMask.Canvas.Handle,0,0,DSTINVERT); {invert dither mask} 236 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt*2, 237 GrExt[HGrTerrain].Mask.Canvas.Handle,1,1+yyt,SRCPAINT); 238 239 for x:=-1 to 6 do 240 for y:=-2 to 6 do 241 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),(y+2)*yyt,xxt*2,yyt, 242 DitherMask.Canvas.Handle,0,0,SRCAND); 243 244 for y:=-1 to 6 do 245 for x:=-2 to 7 do 246 BitBlt(LandMore.Canvas.Handle,(x+2)*(xxt*2)-xxt,(y+2)*yyt,xxt*2,yyt, 247 DitherMask.Canvas.Handle,0,yyt,SRCAND); 248 249 BitBlt(LandPatch.Canvas.Handle,0,0,(xxt*2)*9,yyt*9,LandMore.Canvas.Handle,0,0, 250 SRCPAINT); 251 252 for x:=0 to 3 do 253 for y:=0 to 3 do 254 BitBlt(OceanPatch.Canvas.Handle,x*(xxt*2),y*yyt,xxt*2,yyt, 255 DitherMask.Canvas.Handle,0,0,SRCAND); 256 257 for y:=0 to 3 do 258 for x:=0 to 4 do 259 BitBlt(OceanMore.Canvas.Handle,x*(xxt*2)-xxt,y*yyt,xxt*2,yyt, 260 DitherMask.Canvas.Handle,0,yyt,SRCAND); 261 262 BitBlt(OceanPatch.Canvas.Handle,0,0,(xxt*2)*4,yyt*4,OceanMore.Canvas.Handle,0,0, 263 SRCPAINT); 264 265 with DitherMask.Canvas do 266 begin 267 Brush.Color:=$FFFFFF; 268 FillRect(Rect(0,0,xxt*2,yyt)); 269 end; 270 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt, 271 GrExt[HGrTerrain].Mask.Canvas.Handle,1,1+yyt,SRCCOPY); 272 273 for x:=0 to 6 do 274 BitBlt(LandPatch.Canvas.Handle,(x+2)*(xxt*2),yyt,xxt*2,yyt, 275 DitherMask.Canvas.Handle,0,0,SRCAND); 276 277 BitBlt(DitherMask.Canvas.Handle,0,0,xxt*2,yyt, 278 DitherMask.Canvas.Handle,0,0,DSTINVERT); 279 280 for y:=0 to 6 do 281 BitBlt(LandPatch.Canvas.Handle,xxt*2,(y+2)*yyt,xxt*2,yyt, 282 DitherMask.Canvas.Handle,0,0,SRCAND); 283 284 LandMore.Free; OceanMore.Free; DitherMask.Free; 285 //LandPatch.Savetofile('landpatch.bmp'); 286 287 // reduce size of terrain icons 288 Mask24:=TBitmap.Create; 289 Mask24.Assign(GrExt[HGrTerrain].Mask); 290 Mask24.PixelFormat:=pf24bit; 291 for ySrc:=0 to TerrainIconLines-1 do 292 begin 293 for i:=0 to yyt*3-1 do 294 MaskLine[i]:=Mask24.ScanLine[1+ySrc*(yyt*3+1)+i]; 295 for xSrc:=0 to 9-1 do 296 begin 297 i:=ySrc*9+xSrc; 298 TSpriteSize[i].Left:=0; 299 repeat 300 Border:=true; 301 for y:=0 to yyt*3-1 do 302 if MaskLine[y]^[1+xSrc*(xxt*2+1)+TSpriteSize[i].Left,0]=0 then 303 Border:=false; 304 if Border then inc(TSpriteSize[i].Left) 305 until not Border or (TSpriteSize[i].Left=xxt*2-1); 306 TSpriteSize[i].Top:=0; 307 repeat 308 Border:=true; 309 for x:=0 to xxt*2-1 do 310 if MaskLine[TSpriteSize[i].Top]^[1+xSrc*(xxt*2+1)+x,0]=0 then 311 Border:=false; 312 if Border then inc(TSpriteSize[i].Top) 313 until not Border or (TSpriteSize[i].Top=yyt*3-1); 314 TSpriteSize[i].Right:=xxt*2; 315 repeat 316 Border:=true; 317 for y:=0 to yyt*3-1 do 318 if MaskLine[y]^[xSrc*(xxt*2+1)+TSpriteSize[i].Right,0]=0 then 319 Border:=false; 320 if Border then dec(TSpriteSize[i].Right) 321 until not Border or (TSpriteSize[i].Right=TSpriteSize[i].Left); 322 TSpriteSize[i].Bottom:=yyt*3; 323 repeat 324 Border:=true; 325 for x:=0 to xxt*2-1 do 326 if MaskLine[TSpriteSize[i].Bottom-1]^[1+xSrc*(xxt*2+1)+x,0]=0 then 327 Border:=false; 328 if Border then dec(TSpriteSize[i].Bottom) 329 until not Border or (TSpriteSize[i].Bottom=TSpriteSize[i].Top); 330 end 331 end; 332 Mask24.Free; 333 334 if Borders<>nil then 335 Borders.Free; 336 Borders:=TBitmap.Create; 337 Borders.PixelFormat:=pf24bit; 338 Borders.Width:=xxt*2; Borders.Height:=(yyt*2)*nPl; 339 BordersOK:=0; 340 end; 341 342 procedure Done; 343 begin 344 NoMap.Free; 345 NoMap:=nil; 346 LandPatch.Free; 347 LandPatch:=nil; 348 OceanPatch.Free; 349 OceanPatch:=nil; 350 Borders.Free; 351 Borders:=nil; 352 end; 353 354 procedure Reset; 355 begin 356 BordersOK:=0; 357 end; 358 359 constructor TIsoMap.Create; 360 begin 361 inherited; 362 FLeft:=0; 363 FTop:=0; 364 FRight:=0; 365 FBottom:=0; 366 AttLoc:=-1; 367 DefLoc:=-1; 368 FAdviceLoc:=-1; 369 end; 370 371 procedure TIsoMap.SetOutput(Output: TBitmap); 372 begin 373 FOutput:=Output; 374 FLeft:=0; 375 FTop:=0; 376 FRight:=FOutput.Width; 377 FBottom:=FOutput.Height; 378 end; 379 380 procedure TIsoMap.SetPaintBounds(Left, Top, Right, Bottom: integer); 381 begin 382 FLeft:=Left; FTop:=Top; FRight:=Right; FBottom:=Bottom; 383 end; 384 385 procedure TIsoMap.FillRect(x,y,Width,Height,Color: integer); 386 begin 387 if x<FLeft then 388 begin Width:=Width-(FLeft-x); x:=FLeft end; 389 if y<FTop then 390 begin Height:=Height-(FTop-y); y:=FTop end; 391 if x+Width>=FRight then Width:=FRight-x; 392 if y+Height>=FBottom then Height:=FBottom-y; 393 if (Width<=0) or (Height<=0) then 394 exit; 395 396 with FOutput.Canvas do 397 begin 398 Brush.Color:=Color; 399 FillRect(Rect(x,y,x+Width,y+Height)); 400 Brush.Style:=bsClear; 401 end 402 end; 403 404 procedure TIsoMap.Textout(x,y,Color: integer; const s: string); 405 begin 406 FOutput.Canvas.Font.Color:=Color; 407 FOutput.Canvas.TextRect(Rect(FLeft,FTop,FRight,FBottom), x, y, s) 408 end; 409 410 procedure TIsoMap.BitBlt(Src: TBitmap; x,y,Width,Height,xSrc,ySrc,Rop: integer); 411 begin 412 if x<FLeft then 413 begin Width:=Width-(FLeft-x); xSrc:=xSrc+(FLeft-x); x:=FLeft end; 414 if y<FTop then 415 begin Height:=Height-(FTop-y); ySrc:=ySrc+(FTop-y); y:=FTop end; 416 if x+Width>=FRight then Width:=FRight-x; 417 if y+Height>=FBottom then Height:=FBottom-y; 418 if (Width<=0) or (Height<=0) then 419 exit; 420 421 Windows.BitBlt(FOutput.Canvas.Handle,x,y,Width,Height,Src.Canvas.Handle,xSrc, 422 ySrc,Rop); 423 end; 424 425 procedure TIsoMap.Sprite(HGr,xDst,yDst,Width,Height,xGr,yGr: integer); 426 begin 427 BitBlt(GrExt[HGr].Mask,xDst,yDst,Width,Height,xGr,yGr,SRCAND); 428 BitBlt(GrExt[HGr].Data,xDst,yDst,Width,Height,xGr,yGr,SRCPAINT); 429 end; 430 431 procedure TIsoMap.TSprite(xDst,yDst,grix: integer; PureBlack: boolean = false); 432 var 433 Width, Height, xSrc, ySrc: integer; 434 begin 435 Width:=TSpriteSize[grix].Right-TSpriteSize[grix].Left; 436 Height:=TSpriteSize[grix].Bottom-TSpriteSize[grix].Top; 437 xSrc:=1+grix mod 9 *(xxt*2+1)+TSpriteSize[grix].Left; 438 ySrc:=1+grix div 9 *(yyt*3+1)+TSpriteSize[grix].Top; 439 xDst:=xDst+TSpriteSize[grix].Left; 440 yDst:=yDst-yyt+TSpriteSize[grix].Top; 441 if xDst<FLeft then 442 begin Width:=Width-(FLeft-xDst); xSrc:=xSrc+(FLeft-xDst); xDst:=FLeft end; 443 if yDst<FTop then 444 begin Height:=Height-(FTop-yDst); ySrc:=ySrc+(FTop-yDst); yDst:=FTop end; 445 if xDst+Width>=FRight then Width:=FRight-xDst; 446 if yDst+Height>=FBottom then Height:=FBottom-yDst; 447 if (Width<=0) or (Height<=0) then 448 exit; 449 450 Windows.BitBlt(OutDC,xDst,yDst,Width,Height,MaskDC,xSrc,ySrc,SRCAND); 451 if not PureBlack then 452 Windows.BitBlt(OutDC,xDst,yDst,Width,Height,DataDC,xSrc,ySrc,SRCPAINT); 453 end; 454 455 procedure TIsoMap.PaintUnit(x,y:integer;const UnitInfo:TUnitInfo;Status:integer); 456 var 457 xsh,ysh,xGr,yGr,j,mixShow: integer; 458 begin 459 with UnitInfo do if (Owner=me) or (emix<>$FFFF) then 460 begin 461 if Job=jCity then mixShow:=-1 // building site 462 else mixShow:=mix; 463 if (Tribe[Owner].ModelPicture[mixShow].HGr=0) and (@OnInitEnemyModel<>nil) then 464 if not OnInitEnemyModel(emix) then 465 exit; 466 xsh:=Tribe[Owner].ModelPicture[mixShow].xShield; 467 ysh:=Tribe[Owner].ModelPicture[mixShow].yShield; 468 {$IFNDEF SCR}if Status and usStay<>0 then j:=19 469 else if Status and usRecover<>0 then j:=16 470 else if Status and (usGoto or usEnhance)=usGoto or usEnhance then j:=18 471 else if Status and usEnhance<>0 then j:=17 472 else if Status and usGoto<>0 then j:=20 473 else{$ENDIF} if Job=jCity then j:=jNone 474 else j:=Job; 475 if Flags and unMulti<>0 then 476 Sprite(Tribe[Owner].symHGr,x+xsh-1+4,y+ysh-2,14,12, 477 33+Tribe[Owner].sympix mod 10 *65,1+Tribe[Owner].sympix div 10 *49); 478 Sprite(Tribe[Owner].symHGr,x+xsh-1,y+ysh-2,14,12, 479 18+Tribe[Owner].sympix mod 10 *65,1+Tribe[Owner].sympix div 10 *49); 480 FillRect(x+xsh,y+ysh+5,1+Health*11 div 100,3,ColorOfHealth(Health)); 481 if j>0 then 482 begin 483 xGr:=121+j mod 7 *9; yGr:=1+j div 7 *9; 484 BitBlt(GrExt[HGrSystem].Mask,x+xsh+3,y+ysh+9,8,8,xGr,yGr,SRCAND); 485 Sprite(HGrSystem,x+xsh+2,y+ysh+8,8,8,xGr,yGr); 486 end; 487 with Tribe[Owner].ModelPicture[mixShow] do 488 Sprite(HGr,x,y,64,48,pix mod 10 *65+1,pix div 10 *49+1); 489 if Flags and unFortified<>0 then 490 begin 491 { OutDC:=FOutput.Canvas.Handle; 492 DataDC:=GrExt[HGrTerrain].Data.Canvas.Handle; 493 MaskDC:=GrExt[HGrTerrain].Mask.Canvas.Handle; 494 TSprite(x,y+16,12*9+7);} 495 Sprite(HGrStdUnits,x,y,xxu*2,yyu*2,1+6*(xxu*2+1),1); 496 end 497 end 498 end;{PaintUnit} 499 500 procedure TIsoMap.PaintCity(x,y:integer; const CityInfo:TCityInfo; 501 accessory: boolean); 502 var 503 age,cHGr,cpix,xGr,xShield,yShield,LabelTextColor,LabelLength: integer; 504 cpic:TCityPicture; 505 s:string; 506 begin 507 age:=GetAge(CityInfo.Owner); 508 if CityInfo.Size<5 then xGr:=0 509 else if CityInfo.Size<9 then xGr:=1 510 else if CityInfo.Size<13 then xGr:=2 511 else xGr:=3; 512 Tribe[CityInfo.Owner].InitAge(age); 513 if age<2 then 514 begin 515 cHGr:=Tribe[CityInfo.Owner].cHGr; 516 cpix:=Tribe[CityInfo.Owner].cpix; 517 if (ciWalled and CityInfo.Flags=0) 518 or (GrExt[cHGr].Data.Canvas.Pixels[(xGr+4)*65,cpix*49+48]=$00FFFF) then 519 Sprite(cHGr,x-xxc,y-2*yyc,xxc*2,yyc*3,xGr*(xxc*2+1)+1,1+cpix*(yyc*3+1)); 520 if ciWalled and CityInfo.Flags<>0 then 521 Sprite(cHGr,x-xxc,y-2*yyc,xxc*2,yyc*3,(xGr+4)*(xxc*2+1)+1,1+cpix*(yyc*3+1)); 522 end 523 else 524 begin 525 if ciWalled and CityInfo.Flags<>0 then 526 Sprite(HGrCities,x-xxt,y-2*yyt,2*xxt,3*yyt,(xGr+4)*(2*xxt+1)+1,1+(age-2)*(3*yyt+1)) 527 else Sprite(HGrCities,x-xxt,y-2*yyt,2*xxt,3*yyt,xGr*(2*xxt+1)+1,1+(age-2)*(3*yyt+1)); 528 end; 529 530 if not Accessory then exit; 531 532 {if ciCapital and CityInfo.Flags<>0 then 533 Sprite(Tribe[CityInfo.Owner].symHGr,x+cpic.xf,y-13+cpic.yf,13,14, 534 1+Tribe[CityInfo.Owner].sympix mod 10 *65, 535 1+Tribe[CityInfo.Owner].sympix div 10 *49); {capital -- paint flag} 536 537 if MyMap[CityInfo.Loc] and fObserved<>0 then 538 begin 539 if age<2 then 540 begin 541 cpic:=Tribe[CityInfo.Owner].CityPicture[xGr]; 542 xShield:=x-xxc+cpic.xShield; 543 yShield:=y-2*yyc+cpic.yShield; 544 end 545 else 546 begin 547 cpic:=CitiesPictures[age,xGr]; 548 xShield:=x-xxt+cpic.xShield; 549 yShield:=y-2*yyt+cpic.yShield; 550 end; 551 s:=IntToStr(CityInfo.Size); 552 LabelLength:=FOutput.Canvas.TextWidth(s); 553 FillRect(xShield,yShield,LabelLength+4,16,$000000); 554 if MyMap[CityInfo.Loc] and (fUnit or fObserved)=fObserved then 555 // empty city 556 LabelTextColor:=Tribe[CityInfo.Owner].Color 557 else 558 begin 559 FillRect(xShield+1,yShield+1,LabelLength+2,14,Tribe[CityInfo.Owner].Color); 560 LabelTextColor:=$000000; 561 end; 562 Textout(xShield+2,yShield-1,LabelTextColor,s); 563 end 564 end;{PaintCity} 565 566 function PoleTile(Loc: integer): integer; 567 begin {virtual pole tile} 568 result:=fUNKNOWN; 569 if Loc<-2*G.lx then 570 else if Loc<-G.lx then 571 begin 572 if (MyMap[dLoc(Loc,0,2)] and fTerrain<>fUNKNOWN) 573 and (MyMap[dLoc(Loc,-2,2)] and fTerrain<>fUNKNOWN) 574 and (MyMap[dLoc(Loc,2,2)] and fTerrain<>fUNKNOWN) then result:=fArctic; 575 if (MyMap[dLoc(Loc,0,2)] and fObserved<>0) 576 and (MyMap[dLoc(Loc,-2,2)] and fObserved<>0) 577 and (MyMap[dLoc(Loc,2,2)] and fObserved<>0) then 578 result:=result or fObserved 579 end 580 else if Loc<0 then 581 begin 582 if (MyMap[dLoc(Loc,-1,1)] and fTerrain<>fUNKNOWN) 583 and (MyMap[dLoc(Loc,1,1)] and fTerrain<>fUNKNOWN) then result:=fArctic; 584 if (MyMap[dLoc(Loc,-1,1)] and fObserved<>0) 585 and (MyMap[dLoc(Loc,1,1)] and fObserved<>0) then 586 result:=result or fObserved 587 end 588 else if Loc<G.lx*(G.ly+1) then 589 begin 590 if (MyMap[dLoc(Loc,-1,-1)] and fTerrain<>fUNKNOWN) 591 and (MyMap[dLoc(Loc,1,-1)] and fTerrain<>fUNKNOWN) then result:=fArctic; 592 if (MyMap[dLoc(Loc,-1,-1)] and fObserved<>0) 593 and (MyMap[dLoc(Loc,1,-1)] and fObserved<>0) then 594 result:=result or fObserved 595 end 596 else if Loc<G.lx*(G.ly+2) then 597 begin 598 if (MyMap[dLoc(Loc,0,-2)] and fTerrain<>fUNKNOWN) 599 and (MyMap[dLoc(Loc,-2,-2)] and fTerrain<>fUNKNOWN) 600 and (MyMap[dLoc(Loc,2,-2)] and fTerrain<>fUNKNOWN) then result:=fArctic; 601 if (MyMap[dLoc(Loc,0,-2)] and fObserved<>0) 602 and (MyMap[dLoc(Loc,-2,-2)] and fObserved<>0) 603 and (MyMap[dLoc(Loc,2,-2)] and fObserved<>0) then 604 result:=result or fObserved 605 end 606 end; 607 608 const 609 Dirx: array[0..7] of integer=(1,2,1,0,-1,-2,-1,0); 610 Diry: array[0..7] of integer=(-1,0,1,2,1,0,-1,-2); 611 612 function TIsoMap.Connection4(Loc,Mask,Value:integer):integer; 613 begin 614 result:=0; 615 if dLoc(Loc,1,-1)>=0 then 616 begin 617 if MyMap[dLoc(Loc,1,-1)] and Mask=Cardinal(Value) then inc(result,1); 618 if MyMap[dLoc(Loc,-1,-1)] and Mask=Cardinal(Value) then inc(result,8); 619 end; 620 if dLoc(Loc,1,1)<G.lx*G.ly then 621 begin 622 if MyMap[dLoc(Loc,1,1)] and Mask=Cardinal(Value) then inc(result,2); 623 if MyMap[dLoc(Loc,-1,1)] and Mask=Cardinal(Value) then inc(result,4); 624 end 625 end; 626 627 function TIsoMap.Connection8(Loc,Mask:integer):integer; 628 var 629 Dir, ConnLoc: integer; 630 begin 631 result:=0; 632 for Dir:=0 to 7 do 633 begin 634 ConnLoc:=dLoc(Loc,Dirx[Dir],Diry[Dir]); 635 if (ConnLoc>=0) and (ConnLoc<G.lx*G.ly) and (MyMap[ConnLoc] and Mask<>0) then 636 inc(result,1 shl Dir); 637 end 638 end; 639 640 function TIsoMap.OceanConnection(Loc: integer): integer; 641 var 642 Dir,ConnLoc: integer; 643 begin 644 result:=0; 645 for Dir:=0 to 7 do 646 begin 647 ConnLoc:=dLoc(Loc,Dirx[Dir],Diry[Dir]); 648 if (ConnLoc<0) or (ConnLoc>=G.lx*G.ly) 649 or ((MyMap[ConnLoc]-2) and fTerrain<13) then 650 inc(result,1 shl Dir); 651 end 652 end; 653 654 procedure TIsoMap.PaintShore(x,y,Loc:integer); 655 var 656 Conn,Tile:integer; 657 begin 658 if (y<=FTop-yyt*2) or (y>FBottom) or (x<=FLeft-xxt*2) or (x>FRight) then exit; 659 if (Loc<0) or (Loc>=G.lx*G.ly) then exit; 660 Tile:=MyMap[Loc]; 661 if Tile and fTerrain>=fGrass then exit; 662 Conn:=OceanConnection(Loc); 663 if Conn=0 then exit; 664 665 BitBlt(GrExt[HGrTerrain].Data,x+xxt div 2,y,xxt,yyt, 666 1+(Conn shr 6 +Conn and 1 shl 2)*(xxt*2+1), 667 1+yyt+(16+Tile and fTerrain)*(yyt*3+1),SRCPAINT); 668 BitBlt(GrExt[HGrTerrain].Data,x+xxt,y+yyt div 2,xxt,yyt, 669 1+(Conn and 7)*(xxt*2+1)+xxt, 670 1+yyt*2+(16+Tile and fTerrain)*(yyt*3+1),SRCPAINT); 671 BitBlt(GrExt[HGrTerrain].Data,x+xxt div 2,y+yyt,xxt,yyt, 672 1+(Conn shr 2 and 7)*(xxt*2+1)+xxt, 673 1+yyt+(16+Tile and fTerrain)*(yyt*3+1),SRCPAINT); 674 BitBlt(GrExt[HGrTerrain].Data,x,y+yyt div 2,xxt,yyt, 675 1+(Conn shr 4 and 7)*(xxt*2+1), 676 1+yyt*2+(16+Tile and fTerrain)*(yyt*3+1),SRCPAINT); 677 Conn:=Connection4(Loc,fTerrain,fUNKNOWN); {dither to black} 678 if Conn and 1<>0 then 679 BitBlt(GrExt[HGrTerrain].Mask,x+xxt,y,xxt,yyt,1+7*(xxt*2+1)+xxt, 680 1+yyt+15*(yyt*3+1),SRCAND); 681 if Conn and 2<>0 then 682 BitBlt(GrExt[HGrTerrain].Mask,x+xxt,y+yyt,xxt,yyt,1+7*(xxt*2+1)+xxt, 683 1+yyt*2+15*(yyt*3+1),SRCAND); 684 if Conn and 4<>0 then 685 BitBlt(GrExt[HGrTerrain].Mask,x,y+yyt,xxt,yyt,1+7*(xxt*2+1), 686 1+yyt*2+15*(yyt*3+1),SRCAND); 687 if Conn and 8<>0 then 688 BitBlt(GrExt[HGrTerrain].Mask,x,y,xxt,yyt,1+7*(xxt*2+1), 689 1+yyt+15*(yyt*3+1),SRCAND); 690 end; 691 692 procedure TIsoMap.PaintTileExtraTerrain(x,y,Loc: integer); 693 var 694 Dir,Conn,RRConn,yGr,Tile,yLoc:integer; 695 begin 696 if (Loc<0) or (Loc>=G.lx*G.ly) or (y<=-yyt*2) or (y>FOutput.Height) 697 or (x<=-xxt*2) or (x>FOutput.Width) then exit; 698 Tile:=MyMap[Loc]; 699 if Tile and fTerrain=fForest then 700 begin 701 yLoc:=Loc div G.lx; 702 if IsJungle(yLoc) then yGr:=18 703 else yGr:=3; 704 Conn:=Connection4(Loc,fTerrain,Tile and fTerrain); 705 if (yLoc=(G.ly-2) div 4) or (G.ly-1-yLoc=(G.ly+2) div 4) then 706 Conn:=Conn and not 6 // no connection to south 707 else if (yLoc=(G.ly+2) div 4) or (G.ly-1-yLoc=(G.ly-2) div 4) then 708 Conn:=Conn and not 9; // no connection to north 709 TSprite(x,y,Conn mod 8+(yGr+Conn div 8)*9); 710 end 711 else if Tile and fTerrain in [fHills,fMountains,fForest] then 712 begin 713 yGr:=3+2*(Tile and fTerrain-fForest); 714 Conn:=Connection4(Loc,fTerrain,Tile and fTerrain); 715 TSprite(x,y,Conn mod 8+(yGr+Conn div 8)*9); 716 end 717 else if Tile and fDeadLands<>0 then 718 TSprite(x,y,2*9+6); 719 720 if ShowObjects then 721 begin 722 if Tile and fTerImp=tiFarm then TSprite(x,y,109) {farmland} 723 else if Tile and fTerImp=tiIrrigation then TSprite(x,y,108); // irrigation 724 end; 725 if Tile and fRiver<>0 then 726 begin 727 Conn:=Connection4(Loc,fRiver,fRiver) or Connection4(Loc,fTerrain,fShore) 728 or Connection4(Loc,fTerrain,fUNKNOWN); 729 TSprite(x,y,Conn mod 8+(13+Conn div 8)*9); 730 end; 731 732 if Tile and fTerrain<fGrass then 733 begin 734 Conn:=Connection4(Loc,fRiver,fRiver); 735 for Dir:=0 to 3 do if Conn and (1 shl Dir)<>0 then {river mouths} 736 TSprite(x,y,15*9+Dir); 737 if ShowObjects then 738 begin 739 Conn:=Connection8(Loc,fCanal); 740 for Dir:=0 to 7 do if Conn and (1 shl Dir)<>0 then {canal mouths} 741 TSprite(x,y,20*9+1+Dir); 742 end 743 end; 744 745 if ShowObjects then 746 begin 747 if (Tile and fCanal<>0) or (Tile and fCity<>0) then 748 begin // paint canal connections 749 Conn:=Connection8(Loc,fCanal or fCity); 750 if Tile and fCanal<>0 then Conn:=Conn or ($FF-OceanConnection(Loc)); 751 if Conn=0 then 752 begin 753 if Tile and fCanal<>0 then TSprite(x,y,99) 754 end 755 else for Dir:=0 to 7 do if (1 shl Dir) and Conn<>0 then 756 TSprite(x,y,100+Dir); 757 end; 758 if Tile and (fRR or fCity)<>0 then RRConn:=Connection8(Loc,fRR or fCity) 759 else RRConn:=0; 760 if Tile and (fRoad or fRR or fCity)<>0 then 761 begin // paint road connections 762 Conn:=Connection8(Loc,fRoad or fRR or fCity) and not RRConn; 763 if (Conn=0) and (Tile and (fRR or fCity)=0) then TSprite(x,y,81) 764 else if Conn>0 then 765 for Dir:=0 to 7 do if (1 shl Dir) and Conn<>0 then TSprite(x,y,82+Dir); 766 end; 767 // paint railroad connections 768 if (Tile and fRR<>0) and (RRConn=0) then TSprite(x,y,90) 769 else if RRConn>0 then 770 for Dir:=0 to 7 do if (1 shl Dir) and RRConn<>0 then TSprite(x,y,91+Dir); 771 end; 772 end; 773 774 // (x,y) is top left pixel of (2*xxt,3*yyt) rectangle 775 procedure TIsoMap.PaintTileObjects(x,y,Loc,CityLoc,CityOwner:integer; 776 UseBlink: boolean); 777 type 778 TLine=array[0..9*65,0..2] of Byte; 779 var 780 p1,p2,uix,cix,dy,Loc1,Tile,Multi,Destination: integer; 781 CityInfo:TCityInfo; 782 UnitInfo:TUnitInfo; 783 fog: boolean; 784 785 procedure NameCity; 786 var 787 cix,xs,w: integer; 788 BehindCityInfo:TCityInfo; 789 s: string; 790 IsCapital: boolean; 791 begin 792 BehindCityInfo.Loc:=Loc-2*G.lx; 793 if ShowCityNames and (Options and (1 shl moEditMode)=0) 794 and (BehindCityInfo.Loc>=0) and (BehindCityInfo.Loc<G.lx*G.ly) 795 and (MyMap[BehindCityInfo.Loc] and fCity<>0) then 796 begin 797 GetCityInfo(BehindCityInfo.Loc,cix,BehindCityInfo); 798 IsCapital:= BehindCityInfo.Flags and ciCapital<>0; 799 {if Showuix and (cix>=0) then s:=IntToStr(cix) 800 else} s:=CityName(BehindCityInfo.ID); 801 w:=FOutput.Canvas.TextWidth(s); 802 xs:=x+xxt-(w+1) div 2; 803 if IsCapital then 804 FOutput.Canvas.Font.Style:=FOutput.Canvas.Font.Style+[fsUnderline]; 805 Textout(xs+1,y-9,$000000,s); 806 Textout(xs,y-10,$FFFFFF,s); 807 if IsCapital then 808 FOutput.Canvas.Font.Style:=FOutput.Canvas.Font.Style-[fsUnderline]; 809 end; 810 end; 811 812 procedure ShowSpacePort; 813 begin 814 if ShowObjects and (Options and (1 shl moEditMode)=0) and (Tile and fCity<>0) 815 and (CityInfo.Flags and ciSpacePort<>0) then 816 TSprite(x+xxt,y-6,12*9+5); 817 end; 818 819 procedure PaintBorder; 820 var 821 dx,dy: integer; 822 Line: ^TLine; 823 begin 824 if ShowBorder and (Loc>=0) and (Loc<G.lx*G.ly) 825 and (Tile and fTerrain<>fUNKNOWN) then 826 begin 827 p1:=MyRO.Territory[Loc]; 828 if (p1>=0) and (ShowMyBorder or (p1<>me)) then 829 begin 830 if BordersOK and (1 shl p1)=0 then 831 begin 832 Windows.BitBlt(Borders.Canvas.Handle,0,p1*(yyt*2),xxt*2,yyt*2, 833 GrExt[HGrTerrain].Data.Canvas.Handle,1+8*(xxt*2+1),1+yyt+16*(yyt*3+1),SRCCOPY); 834 for dy:=0 to yyt*2-1 do 835 begin 836 Line:=Borders.ScanLine[p1*(yyt*2)+dy]; 837 for dx:=0 to xxt*2-1 do if Line[dx,0]=99 then 351 i := ySrc * 9 + xSrc; 352 TSpriteSize[i].Left := 0; 353 repeat 354 Border := true; 355 for y := 0 to yyt * 3 - 1 do 356 if MaskLine[y]^[1 + xSrc * (xxt * 2 + 1) + TSpriteSize[i].Left, 0] = 0 357 then 358 Border := false; 359 if Border then 360 inc(TSpriteSize[i].Left) until not Border or 361 (TSpriteSize[i].Left = xxt * 2 - 1); 362 TSpriteSize[i].Top := 0; 363 repeat 364 Border := true; 365 for x := 0 to xxt * 2 - 1 do 366 if MaskLine[TSpriteSize[i].Top]^[1 + xSrc * (xxt * 2 + 1) + x, 0] = 0 367 then 368 Border := false; 369 if Border then 370 inc(TSpriteSize[i].Top) until not Border or 371 (TSpriteSize[i].Top = yyt * 3 - 1); 372 TSpriteSize[i].Right := xxt * 2; 373 repeat 374 Border := true; 375 for y := 0 to yyt * 3 - 1 do 376 if MaskLine[y]^[xSrc * (xxt * 2 + 1) + TSpriteSize[i].Right, 0] = 0 377 then 378 Border := false; 379 if Border then 380 dec(TSpriteSize[i].Right) until not Border or 381 (TSpriteSize[i].Right = TSpriteSize[i].Left); 382 TSpriteSize[i].Bottom := yyt * 3; 383 repeat 384 Border := true; 385 for x := 0 to xxt * 2 - 1 do 386 if MaskLine[TSpriteSize[i].Bottom - 1]^ 387 [1 + xSrc * (xxt * 2 + 1) + x, 0] = 0 then 388 Border := false; 389 if Border then 390 dec(TSpriteSize[i].Bottom) until not Border or 391 (TSpriteSize[i].Bottom = TSpriteSize[i].Top); 392 end 393 end; 394 Mask24.Free; 395 396 if Borders <> nil then 397 Borders.Free; 398 Borders := TBitmap.Create; 399 Borders.PixelFormat := pf24bit; 400 Borders.Width := xxt * 2; 401 Borders.Height := (yyt * 2) * nPl; 402 BordersOK := 0; 403 end; 404 405 procedure Done; 406 begin 407 NoMap.Free; 408 NoMap := nil; 409 LandPatch.Free; 410 LandPatch := nil; 411 OceanPatch.Free; 412 OceanPatch := nil; 413 Borders.Free; 414 Borders := nil; 415 end; 416 417 procedure Reset; 418 begin 419 BordersOK := 0; 420 end; 421 422 constructor TIsoMap.Create; 423 begin 424 inherited; 425 FLeft := 0; 426 FTop := 0; 427 FRight := 0; 428 FBottom := 0; 429 AttLoc := -1; 430 DefLoc := -1; 431 FAdviceLoc := -1; 432 end; 433 434 procedure TIsoMap.SetOutput(Output: TBitmap); 435 begin 436 FOutput := Output; 437 FLeft := 0; 438 FTop := 0; 439 FRight := FOutput.Width; 440 FBottom := FOutput.Height; 441 end; 442 443 procedure TIsoMap.SetPaintBounds(Left, Top, Right, Bottom: integer); 444 begin 445 FLeft := Left; 446 FTop := Top; 447 FRight := Right; 448 FBottom := Bottom; 449 end; 450 451 procedure TIsoMap.FillRect(x, y, Width, Height, Color: integer); 452 begin 453 if x < FLeft then 454 begin 455 Width := Width - (FLeft - x); 456 x := FLeft 457 end; 458 if y < FTop then 459 begin 460 Height := Height - (FTop - y); 461 y := FTop 462 end; 463 if x + Width >= FRight then 464 Width := FRight - x; 465 if y + Height >= FBottom then 466 Height := FBottom - y; 467 if (Width <= 0) or (Height <= 0) then 468 exit; 469 470 with FOutput.Canvas do 471 begin 472 Brush.Color := Color; 473 FillRect(Rect(x, y, x + Width, y + Height)); 474 Brush.Style := bsClear; 475 end 476 end; 477 478 procedure TIsoMap.Textout(x, y, Color: integer; const s: string); 479 begin 480 FOutput.Canvas.Font.Color := Color; 481 FOutput.Canvas.TextRect(Rect(FLeft, FTop, FRight, FBottom), x, y, s) 482 end; 483 484 procedure TIsoMap.BitBlt(Src: TBitmap; x, y, Width, Height, xSrc, ySrc, 485 Rop: integer); 486 begin 487 if x < FLeft then 488 begin 489 Width := Width - (FLeft - x); 490 xSrc := xSrc + (FLeft - x); 491 x := FLeft 492 end; 493 if y < FTop then 494 begin 495 Height := Height - (FTop - y); 496 ySrc := ySrc + (FTop - y); 497 y := FTop 498 end; 499 if x + Width >= FRight then 500 Width := FRight - x; 501 if y + Height >= FBottom then 502 Height := FBottom - y; 503 if (Width <= 0) or (Height <= 0) then 504 exit; 505 506 Windows.BitBlt(FOutput.Canvas.Handle, x, y, Width, Height, 507 Src.Canvas.Handle, xSrc, ySrc, Rop); 508 end; 509 510 procedure TIsoMap.Sprite(HGr, xDst, yDst, Width, Height, xGr, 511 yGr: integer); 512 begin 513 BitBlt(GrExt[HGr].Mask, xDst, yDst, Width, Height, xGr, yGr, SRCAND); 514 BitBlt(GrExt[HGr].Data, xDst, yDst, Width, Height, xGr, yGr, 515 SRCPAINT); 516 end; 517 518 procedure TIsoMap.TSprite(xDst, yDst, grix: integer; 519 PureBlack: boolean = false); 520 var 521 Width, Height, xSrc, ySrc: integer; 522 begin 523 Width := TSpriteSize[grix].Right - TSpriteSize[grix].Left; 524 Height := TSpriteSize[grix].Bottom - TSpriteSize[grix].Top; 525 xSrc := 1 + grix mod 9 * (xxt * 2 + 1) + TSpriteSize[grix].Left; 526 ySrc := 1 + grix div 9 * (yyt * 3 + 1) + TSpriteSize[grix].Top; 527 xDst := xDst + TSpriteSize[grix].Left; 528 yDst := yDst - yyt + TSpriteSize[grix].Top; 529 if xDst < FLeft then 530 begin 531 Width := Width - (FLeft - xDst); 532 xSrc := xSrc + (FLeft - xDst); 533 xDst := FLeft 534 end; 535 if yDst < FTop then 536 begin 537 Height := Height - (FTop - yDst); 538 ySrc := ySrc + (FTop - yDst); 539 yDst := FTop 540 end; 541 if xDst + Width >= FRight then 542 Width := FRight - xDst; 543 if yDst + Height >= FBottom then 544 Height := FBottom - yDst; 545 if (Width <= 0) or (Height <= 0) then 546 exit; 547 548 Windows.BitBlt(OutDC, xDst, yDst, Width, Height, MaskDC, xSrc, 549 ySrc, SRCAND); 550 if not PureBlack then 551 Windows.BitBlt(OutDC, xDst, yDst, Width, Height, DataDC, xSrc, ySrc, 552 SRCPAINT); 553 end; 554 555 procedure TIsoMap.PaintUnit(x, y: integer; const UnitInfo: TUnitInfo; 556 Status: integer); 557 var 558 xsh, ysh, xGr, yGr, j, mixShow: integer; 559 begin 560 with UnitInfo do 561 if (Owner = me) or (emix <> $FFFF) then 838 562 begin 839 Line[dx,0]:=Tribe[p1].Color shr 16 and $FF; 840 Line[dx,1]:=Tribe[p1].Color shr 8 and $FF; 841 Line[dx,2]:=Tribe[p1].Color and $FF; 563 if Job = jCity then 564 mixShow := -1 // building site 565 else 566 mixShow := mix; 567 if (Tribe[Owner].ModelPicture[mixShow].HGr = 0) and 568 (@OnInitEnemyModel <> nil) then 569 if not OnInitEnemyModel(emix) then 570 exit; 571 xsh := Tribe[Owner].ModelPicture[mixShow].xShield; 572 ysh := Tribe[Owner].ModelPicture[mixShow].yShield; 573 {$IFNDEF SCR} if Status and usStay <> 0 then 574 j := 19 575 else if Status and usRecover <> 0 then 576 j := 16 577 else if Status and (usGoto or usEnhance) = usGoto or usEnhance 578 then 579 j := 18 580 else if Status and usEnhance <> 0 then 581 j := 17 582 else if Status and usGoto <> 0 then 583 j := 20 584 else {$ENDIF} if Job = jCity then 585 j := jNone 586 else 587 j := Job; 588 if Flags and unMulti <> 0 then 589 Sprite(Tribe[Owner].symHGr, x + xsh - 1 + 4, y + ysh - 2, 14, 590 12, 33 + Tribe[Owner].sympix mod 10 * 65, 591 1 + Tribe[Owner].sympix div 10 * 49); 592 Sprite(Tribe[Owner].symHGr, x + xsh - 1, y + ysh - 2, 14, 12, 593 18 + Tribe[Owner].sympix mod 10 * 65, 594 1 + Tribe[Owner].sympix div 10 * 49); 595 FillRect(x + xsh, y + ysh + 5, 1 + Health * 11 div 100, 3, 596 ColorOfHealth(Health)); 597 if j > 0 then 598 begin 599 xGr := 121 + j mod 7 * 9; 600 yGr := 1 + j div 7 * 9; 601 BitBlt(GrExt[HGrSystem].Mask, x + xsh + 3, y + ysh + 9, 8, 8, 602 xGr, yGr, SRCAND); 603 Sprite(HGrSystem, x + xsh + 2, y + ysh + 8, 8, 8, xGr, yGr); 604 end; 605 with Tribe[Owner].ModelPicture[mixShow] do 606 Sprite(HGr, x, y, 64, 48, pix mod 10 * 65 + 1, 607 pix div 10 * 49 + 1); 608 if Flags and unFortified <> 0 then 609 begin 610 { OutDC:=FOutput.Canvas.Handle; 611 DataDC:=GrExt[HGrTerrain].Data.Canvas.Handle; 612 MaskDC:=GrExt[HGrTerrain].Mask.Canvas.Handle; 613 TSprite(x,y+16,12*9+7); } 614 Sprite(HGrStdUnits, x, y, xxu * 2, yyu * 2, 615 1 + 6 * (xxu * 2 + 1), 1); 616 end 842 617 end 843 end; 844 BordersOK:=BordersOK or 1 shl p1; 845 end; 846 for dy:=0 to 1 do for dx:=0 to 1 do 847 begin 848 Loc1:=dLoc(Loc,dx*2-1,dy*2-1); 849 begin 850 if (Loc1<0) or (Loc1>=G.lx*G.ly) then p2:=-1 851 else if MyMap[Loc1] and fTerrain=fUNKNOWN then 852 p2:=p1 853 else p2:=MyRO.Territory[Loc1]; 854 if p2<>p1 then 618 end; { PaintUnit } 619 620 procedure TIsoMap.PaintCity(x, y: integer; const CityInfo: TCityInfo; 621 accessory: boolean); 622 var 623 age, cHGr, cpix, xGr, xShield, yShield, LabelTextColor, 624 LabelLength: integer; 625 cpic: TCityPicture; 626 s: string; 627 begin 628 age := GetAge(CityInfo.Owner); 629 if CityInfo.size < 5 then 630 xGr := 0 631 else if CityInfo.size < 9 then 632 xGr := 1 633 else if CityInfo.size < 13 then 634 xGr := 2 635 else 636 xGr := 3; 637 Tribe[CityInfo.Owner].InitAge(age); 638 if age < 2 then 639 begin 640 cHGr := Tribe[CityInfo.Owner].cHGr; 641 cpix := Tribe[CityInfo.Owner].cpix; 642 if (ciWalled and CityInfo.Flags = 0) or 643 (GrExt[cHGr].Data.Canvas.Pixels[(xGr + 4) * 65, cpix * 49 + 48] 644 = $00FFFF) then 645 Sprite(cHGr, x - xxc, y - 2 * yyc, xxc * 2, yyc * 3, 646 xGr * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1)); 647 if ciWalled and CityInfo.Flags <> 0 then 648 Sprite(cHGr, x - xxc, y - 2 * yyc, xxc * 2, yyc * 3, 649 (xGr + 4) * (xxc * 2 + 1) + 1, 1 + cpix * (yyc * 3 + 1)); 650 end 651 else 652 begin 653 if ciWalled and CityInfo.Flags <> 0 then 654 Sprite(HGrCities, x - xxt, y - 2 * yyt, 2 * xxt, 3 * yyt, 655 (xGr + 4) * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1)) 656 else 657 Sprite(HGrCities, x - xxt, y - 2 * yyt, 2 * xxt, 3 * yyt, 658 xGr * (2 * xxt + 1) + 1, 1 + (age - 2) * (3 * yyt + 1)); 659 end; 660 661 if not accessory then 662 exit; 663 664 { if ciCapital and CityInfo.Flags<>0 then 665 Sprite(Tribe[CityInfo.Owner].symHGr,x+cpic.xf,y-13+cpic.yf,13,14, 666 1+Tribe[CityInfo.Owner].sympix mod 10 *65, 667 1+Tribe[CityInfo.Owner].sympix div 10 *49); {capital -- paint flag } 668 669 if MyMap[CityInfo.Loc] and fObserved <> 0 then 670 begin 671 if age < 2 then 855 672 begin 856 BitBlt(GrExt[HGrTerrain].Mask,x+dx*xxt,y+dy*yyt,xxt,yyt,857 1+8*(xxt*2+1)+dx*xxt,1+yyt+16*(yyt*3+1)+dy*yyt,SRCAND);858 BitBlt(Borders,x+dx*xxt,y+dy*yyt,xxt,yyt,dx*xxt,p1*(yyt*2)+dy*yyt,SRCPAINT);673 cpic := Tribe[CityInfo.Owner].CityPicture[xGr]; 674 xShield := x - xxc + cpic.xShield; 675 yShield := y - 2 * yyc + cpic.yShield; 859 676 end 860 end; 861 end 862 end 863 end; 864 end; 865 866 begin 867 if (Loc<0) or (Loc>=G.lx*G.ly) then Tile:=PoleTile(Loc) 868 else Tile:=MyMap[Loc]; 869 if ShowObjects and (Options and (1 shl moEditMode)=0) and (Tile and fCity<>0) then 870 GetCityInfo(Loc,cix,CityInfo); 871 if (y<=FTop-yyt*2) or (y>FBottom) or (x<=FLeft-xxt*2) or (x>FRight) then 872 begin NameCity; ShowSpacePort; exit; end; 873 if Tile and fTerrain=fUNKNOWN then 874 begin NameCity; ShowSpacePort; exit end;{square not discovered} 875 876 if not (FoW and (Tile and fObserved=0)) then 877 PaintBorder; 878 879 if (Loc>=0) and (Loc<G.lx*G.ly) and (Loc=FAdviceLoc) then 880 TSprite(x,y,7+9*2); 881 882 if (Loc>=0) and (Loc<G.lx*G.ly) and (Tile and fSpecial<>0) then {special ressources} 883 begin 884 dy:=Loc div G.lx; 885 if Tile and fTerrain<fForest then 886 TSprite(x,y,Tile and fTerrain+(Tile and fSpecial shr 5)*9) 887 else if (Tile and fTerrain=fForest) and IsJungle(dy) then 888 TSprite(x,y,8+17*9+(Tile and fSpecial shr 5)*9) 889 else TSprite(x,y,8+2*9+((Tile and fTerrain-fForest)*2+Tile and fSpecial shr 5)*9); 890 end; 891 892 if ShowObjects then 893 begin 894 if Tile and fTerImp=tiMine then 895 TSprite(x,y,2+9*12); 896 if Tile and fTerImp=tiBase then 897 TSprite(x,y,4+9*12); 898 if Tile and fPoll<>0 then 899 TSprite(x,y,6+9*12); 900 if Tile and fTerImp=tiFort then 901 begin 902 TSprite(x,y,7+9*12); 903 if Tile and fObserved=0 then 904 TSprite(x,y,3+9*12); 905 end; 906 end; 907 if Tile and fDeadLands<>0 then TSprite(x,y,(12+Tile shr 25 and 3)*9+8); 908 909 if Options and (1 shl moEditMode)<>0 then 910 fog:= (Loc<0) or (Loc>=G.lx*G.ly) 911 //else if CityLoc>=0 then 912 // fog:= (Loc<0) or (Loc>=G.lx*G.ly) or (Distance(Loc,CityLoc)>5) 913 else if ShowGrWall then fog:= Tile and fGrWall=0 914 else fog:=FoW and (Tile and fObserved=0); 915 if fog and ShowObjects then 916 if Loc<-G.lx then 917 Sprite(HGrTerrain,x,y+yyt,xxt*2,yyt,1+6*(xxt*2+1),1+yyt*2+15*(yyt*3+1)) 918 else if Loc>=G.lx*(G.ly+1) then 919 Sprite(HGrTerrain,x,y,xxt*2,yyt,1+6*(xxt*2+1),1+yyt+15*(yyt*3+1)) 920 else TSprite(x,y,6+9*15,xxt<>33); 921 922 if FoW and (Tile and fObserved=0) then 923 PaintBorder; 677 else 678 begin 679 cpic := CitiesPictures[age, xGr]; 680 xShield := x - xxt + cpic.xShield; 681 yShield := y - 2 * yyt + cpic.yShield; 682 end; 683 s := IntToStr(CityInfo.size); 684 LabelLength := FOutput.Canvas.TextWidth(s); 685 FillRect(xShield, yShield, LabelLength + 4, 16, $000000); 686 if MyMap[CityInfo.Loc] and (fUnit or fObserved) = fObserved then 687 // empty city 688 LabelTextColor := Tribe[CityInfo.Owner].Color 689 else 690 begin 691 FillRect(xShield + 1, yShield + 1, LabelLength + 2, 14, 692 Tribe[CityInfo.Owner].Color); 693 LabelTextColor := $000000; 694 end; 695 Textout(xShield + 2, yShield - 1, LabelTextColor, s); 696 end 697 end; { PaintCity } 698 699 function PoleTile(Loc: integer): integer; 700 begin { virtual pole tile } 701 result := fUNKNOWN; 702 if Loc < -2 * G.lx then 703 else if Loc < -G.lx then 704 begin 705 if (MyMap[dLoc(Loc, 0, 2)] and fTerrain <> fUNKNOWN) and 706 (MyMap[dLoc(Loc, -2, 2)] and fTerrain <> fUNKNOWN) and 707 (MyMap[dLoc(Loc, 2, 2)] and fTerrain <> fUNKNOWN) then 708 result := fArctic; 709 if (MyMap[dLoc(Loc, 0, 2)] and fObserved <> 0) and 710 (MyMap[dLoc(Loc, -2, 2)] and fObserved <> 0) and 711 (MyMap[dLoc(Loc, 2, 2)] and fObserved <> 0) then 712 result := result or fObserved 713 end 714 else if Loc < 0 then 715 begin 716 if (MyMap[dLoc(Loc, -1, 1)] and fTerrain <> fUNKNOWN) and 717 (MyMap[dLoc(Loc, 1, 1)] and fTerrain <> fUNKNOWN) then 718 result := fArctic; 719 if (MyMap[dLoc(Loc, -1, 1)] and fObserved <> 0) and 720 (MyMap[dLoc(Loc, 1, 1)] and fObserved <> 0) then 721 result := result or fObserved 722 end 723 else if Loc < G.lx * (G.ly + 1) then 724 begin 725 if (MyMap[dLoc(Loc, -1, -1)] and fTerrain <> fUNKNOWN) and 726 (MyMap[dLoc(Loc, 1, -1)] and fTerrain <> fUNKNOWN) then 727 result := fArctic; 728 if (MyMap[dLoc(Loc, -1, -1)] and fObserved <> 0) and 729 (MyMap[dLoc(Loc, 1, -1)] and fObserved <> 0) then 730 result := result or fObserved 731 end 732 else if Loc < G.lx * (G.ly + 2) then 733 begin 734 if (MyMap[dLoc(Loc, 0, -2)] and fTerrain <> fUNKNOWN) and 735 (MyMap[dLoc(Loc, -2, -2)] and fTerrain <> fUNKNOWN) and 736 (MyMap[dLoc(Loc, 2, -2)] and fTerrain <> fUNKNOWN) then 737 result := fArctic; 738 if (MyMap[dLoc(Loc, 0, -2)] and fObserved <> 0) and 739 (MyMap[dLoc(Loc, -2, -2)] and fObserved <> 0) and 740 (MyMap[dLoc(Loc, 2, -2)] and fObserved <> 0) then 741 result := result or fObserved 742 end 743 end; 744 745 const 746 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0); 747 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2); 748 749 function TIsoMap.Connection4(Loc, Mask, Value: integer): integer; 750 begin 751 result := 0; 752 if dLoc(Loc, 1, -1) >= 0 then 753 begin 754 if MyMap[dLoc(Loc, 1, -1)] and Mask = Cardinal(Value) then 755 inc(result, 1); 756 if MyMap[dLoc(Loc, -1, -1)] and Mask = Cardinal(Value) then 757 inc(result, 8); 758 end; 759 if dLoc(Loc, 1, 1) < G.lx * G.ly then 760 begin 761 if MyMap[dLoc(Loc, 1, 1)] and Mask = Cardinal(Value) then 762 inc(result, 2); 763 if MyMap[dLoc(Loc, -1, 1)] and Mask = Cardinal(Value) then 764 inc(result, 4); 765 end 766 end; 767 768 function TIsoMap.Connection8(Loc, Mask: integer): integer; 769 var 770 Dir, ConnLoc: integer; 771 begin 772 result := 0; 773 for Dir := 0 to 7 do 774 begin 775 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 776 if (ConnLoc >= 0) and (ConnLoc < G.lx * G.ly) and 777 (MyMap[ConnLoc] and Mask <> 0) then 778 inc(result, 1 shl Dir); 779 end 780 end; 781 782 function TIsoMap.OceanConnection(Loc: integer): integer; 783 var 784 Dir, ConnLoc: integer; 785 begin 786 result := 0; 787 for Dir := 0 to 7 do 788 begin 789 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 790 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or 791 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then 792 inc(result, 1 shl Dir); 793 end 794 end; 795 796 procedure TIsoMap.PaintShore(x, y, Loc: integer); 797 var 798 Conn, Tile: integer; 799 begin 800 if (y <= FTop - yyt * 2) or (y > FBottom) or (x <= FLeft - xxt * 2) or 801 (x > FRight) then 802 exit; 803 if (Loc < 0) or (Loc >= G.lx * G.ly) then 804 exit; 805 Tile := MyMap[Loc]; 806 if Tile and fTerrain >= fGrass then 807 exit; 808 Conn := OceanConnection(Loc); 809 if Conn = 0 then 810 exit; 811 812 BitBlt(GrExt[HGrTerrain].Data, x + xxt div 2, y, xxt, yyt, 813 1 + (Conn shr 6 + Conn and 1 shl 2) * (xxt * 2 + 1), 814 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 815 BitBlt(GrExt[HGrTerrain].Data, x + xxt, y + yyt div 2, xxt, yyt, 816 1 + (Conn and 7) * (xxt * 2 + 1) + xxt, 817 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 818 BitBlt(GrExt[HGrTerrain].Data, x + xxt div 2, y + yyt, xxt, yyt, 819 1 + (Conn shr 2 and 7) * (xxt * 2 + 1) + xxt, 820 1 + yyt + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 821 BitBlt(GrExt[HGrTerrain].Data, x, y + yyt div 2, xxt, yyt, 822 1 + (Conn shr 4 and 7) * (xxt * 2 + 1), 823 1 + yyt * 2 + (16 + Tile and fTerrain) * (yyt * 3 + 1), SRCPAINT); 824 Conn := Connection4(Loc, fTerrain, fUNKNOWN); { dither to black } 825 if Conn and 1 <> 0 then 826 BitBlt(GrExt[HGrTerrain].Mask, x + xxt, y, xxt, yyt, 827 1 + 7 * (xxt * 2 + 1) + xxt, 828 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 829 if Conn and 2 <> 0 then 830 BitBlt(GrExt[HGrTerrain].Mask, x + xxt, y + yyt, xxt, yyt, 831 1 + 7 * (xxt * 2 + 1) + xxt, 1 + yyt * 2 + 15 * 832 (yyt * 3 + 1), SRCAND); 833 if Conn and 4 <> 0 then 834 BitBlt(GrExt[HGrTerrain].Mask, x, y + yyt, xxt, yyt, 835 1 + 7 * (xxt * 2 + 1), 1 + yyt * 2 + 15 * (yyt * 3 + 1), SRCAND); 836 if Conn and 8 <> 0 then 837 BitBlt(GrExt[HGrTerrain].Mask, x, y, xxt, yyt, 838 1 + 7 * (xxt * 2 + 1), 1 + yyt + 15 * (yyt * 3 + 1), SRCAND); 839 end; 840 841 procedure TIsoMap.PaintTileExtraTerrain(x, y, Loc: integer); 842 var 843 Dir, Conn, RRConn, yGr, Tile, yLoc: integer; 844 begin 845 if (Loc < 0) or (Loc >= G.lx * G.ly) or (y <= -yyt * 2) or 846 (y > FOutput.Height) or (x <= -xxt * 2) or (x > FOutput.Width) then 847 exit; 848 Tile := MyMap[Loc]; 849 if Tile and fTerrain = fForest then 850 begin 851 yLoc := Loc div G.lx; 852 if IsJungle(yLoc) then 853 yGr := 18 854 else 855 yGr := 3; 856 Conn := Connection4(Loc, fTerrain, Tile and fTerrain); 857 if (yLoc = (G.ly - 2) div 4) or (G.ly - 1 - yLoc = (G.ly + 2) div 4) 858 then 859 Conn := Conn and not 6 // no connection to south 860 else if (yLoc = (G.ly + 2) div 4) or 861 (G.ly - 1 - yLoc = (G.ly - 2) div 4) then 862 Conn := Conn and not 9; // no connection to north 863 TSprite(x, y, Conn mod 8 + (yGr + Conn div 8) * 9); 864 end 865 else if Tile and fTerrain in [fHills, fMountains, fForest] then 866 begin 867 yGr := 3 + 2 * (Tile and fTerrain - fForest); 868 Conn := Connection4(Loc, fTerrain, Tile and fTerrain); 869 TSprite(x, y, Conn mod 8 + (yGr + Conn div 8) * 9); 870 end 871 else if Tile and fDeadLands <> 0 then 872 TSprite(x, y, 2 * 9 + 6); 873 874 if ShowObjects then 875 begin 876 if Tile and fTerImp = tiFarm then 877 TSprite(x, y, 109) { farmland } 878 else if Tile and fTerImp = tiIrrigation then 879 TSprite(x, y, 108); // irrigation 880 end; 881 if Tile and fRiver <> 0 then 882 begin 883 Conn := Connection4(Loc, fRiver, fRiver) or 884 Connection4(Loc, fTerrain, fShore) or 885 Connection4(Loc, fTerrain, fUNKNOWN); 886 TSprite(x, y, Conn mod 8 + (13 + Conn div 8) * 9); 887 end; 888 889 if Tile and fTerrain < fGrass then 890 begin 891 Conn := Connection4(Loc, fRiver, fRiver); 892 for Dir := 0 to 3 do 893 if Conn and (1 shl Dir) <> 0 then { river mouths } 894 TSprite(x, y, 15 * 9 + Dir); 895 if ShowObjects then 896 begin 897 Conn := Connection8(Loc, fCanal); 898 for Dir := 0 to 7 do 899 if Conn and (1 shl Dir) <> 0 then { canal mouths } 900 TSprite(x, y, 20 * 9 + 1 + Dir); 901 end 902 end; 903 904 if ShowObjects then 905 begin 906 if (Tile and fCanal <> 0) or (Tile and fCity <> 0) then 907 begin // paint canal connections 908 Conn := Connection8(Loc, fCanal or fCity); 909 if Tile and fCanal <> 0 then 910 Conn := Conn or ($FF - OceanConnection(Loc)); 911 if Conn = 0 then 912 begin 913 if Tile and fCanal <> 0 then 914 TSprite(x, y, 99) 915 end 916 else 917 for Dir := 0 to 7 do 918 if (1 shl Dir) and Conn <> 0 then 919 TSprite(x, y, 100 + Dir); 920 end; 921 if Tile and (fRR or fCity) <> 0 then 922 RRConn := Connection8(Loc, fRR or fCity) 923 else 924 RRConn := 0; 925 if Tile and (fRoad or fRR or fCity) <> 0 then 926 begin // paint road connections 927 Conn := Connection8(Loc, fRoad or fRR or fCity) and not RRConn; 928 if (Conn = 0) and (Tile and (fRR or fCity) = 0) then 929 TSprite(x, y, 81) 930 else if Conn > 0 then 931 for Dir := 0 to 7 do 932 if (1 shl Dir) and Conn <> 0 then 933 TSprite(x, y, 82 + Dir); 934 end; 935 // paint railroad connections 936 if (Tile and fRR <> 0) and (RRConn = 0) then 937 TSprite(x, y, 90) 938 else if RRConn > 0 then 939 for Dir := 0 to 7 do 940 if (1 shl Dir) and RRConn <> 0 then 941 TSprite(x, y, 91 + Dir); 942 end; 943 end; 944 945 // (x,y) is top left pixel of (2*xxt,3*yyt) rectangle 946 procedure TIsoMap.PaintTileObjects(x, y, Loc, CityLoc, 947 CityOwner: integer; UseBlink: boolean); 948 type 949 TLine = array [0 .. 9 * 65, 0 .. 2] of Byte; 950 var 951 p1, p2, uix, cix, dy, Loc1, Tile, Multi, Destination: integer; 952 CityInfo: TCityInfo; 953 UnitInfo: TUnitInfo; 954 fog: boolean; 955 956 procedure NameCity; 957 var 958 cix, xs, w: integer; 959 BehindCityInfo: TCityInfo; 960 s: string; 961 IsCapital: boolean; 962 begin 963 BehindCityInfo.Loc := Loc - 2 * G.lx; 964 if ShowCityNames and (Options and (1 shl moEditMode) = 0) and 965 (BehindCityInfo.Loc >= 0) and (BehindCityInfo.Loc < G.lx * G.ly) 966 and (MyMap[BehindCityInfo.Loc] and fCity <> 0) then 967 begin 968 GetCityInfo(BehindCityInfo.Loc, cix, BehindCityInfo); 969 IsCapital := BehindCityInfo.Flags and ciCapital <> 0; 970 { if Showuix and (cix>=0) then s:=IntToStr(cix) 971 else } s := CityName(BehindCityInfo.ID); 972 w := FOutput.Canvas.TextWidth(s); 973 xs := x + xxt - (w + 1) div 2; 974 if IsCapital then 975 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style + 976 [fsUnderline]; 977 Textout(xs + 1, y - 9, $000000, s); 978 Textout(xs, y - 10, $FFFFFF, s); 979 if IsCapital then 980 FOutput.Canvas.Font.Style := FOutput.Canvas.Font.Style - 981 [fsUnderline]; 982 end; 983 end; 984 985 procedure ShowSpacePort; 986 begin 987 if ShowObjects and (Options and (1 shl moEditMode) = 0) and 988 (Tile and fCity <> 0) and (CityInfo.Flags and ciSpacePort <> 0) 989 then 990 TSprite(x + xxt, y - 6, 12 * 9 + 5); 991 end; 992 993 procedure PaintBorder; 994 var 995 dx, dy: integer; 996 Line: ^TLine; 997 begin 998 if ShowBorder and (Loc >= 0) and (Loc < G.lx * G.ly) and 999 (Tile and fTerrain <> fUNKNOWN) then 1000 begin 1001 p1 := MyRO.Territory[Loc]; 1002 if (p1 >= 0) and (ShowMyBorder or (p1 <> me)) then 1003 begin 1004 if BordersOK and (1 shl p1) = 0 then 1005 begin 1006 Windows.BitBlt(Borders.Canvas.Handle, 0, p1 * (yyt * 2), 1007 xxt * 2, yyt * 2, GrExt[HGrTerrain].Data.Canvas.Handle, 1008 1 + 8 * (xxt * 2 + 1), 1009 1 + yyt + 16 * (yyt * 3 + 1), SRCCOPY); 1010 for dy := 0 to yyt * 2 - 1 do 1011 begin 1012 Line := Borders.ScanLine[p1 * (yyt * 2) + dy]; 1013 for dx := 0 to xxt * 2 - 1 do 1014 if Line[dx, 0] = 99 then 1015 begin 1016 Line[dx, 0] := Tribe[p1].Color shr 16 and $FF; 1017 Line[dx, 1] := Tribe[p1].Color shr 8 and $FF; 1018 Line[dx, 2] := Tribe[p1].Color and $FF; 1019 end 1020 end; 1021 BordersOK := BordersOK or 1 shl p1; 1022 end; 1023 for dy := 0 to 1 do 1024 for dx := 0 to 1 do 1025 begin 1026 Loc1 := dLoc(Loc, dx * 2 - 1, dy * 2 - 1); 1027 begin 1028 if (Loc1 < 0) or (Loc1 >= G.lx * G.ly) then 1029 p2 := -1 1030 else if MyMap[Loc1] and fTerrain = fUNKNOWN then 1031 p2 := p1 1032 else 1033 p2 := MyRO.Territory[Loc1]; 1034 if p2 <> p1 then 1035 begin 1036 BitBlt(GrExt[HGrTerrain].Mask, x + dx * xxt, 1037 y + dy * yyt, xxt, yyt, 1 + 8 * (xxt * 2 + 1) + dx * 1038 xxt, 1 + yyt + 16 * (yyt * 3 + 1) + dy * yyt, SRCAND); 1039 BitBlt(Borders, x + dx * xxt, y + dy * yyt, xxt, yyt, 1040 dx * xxt, p1 * (yyt * 2) + dy * yyt, SRCPAINT); 1041 end 1042 end; 1043 end 1044 end 1045 end; 1046 end; 1047 1048 begin 1049 if (Loc < 0) or (Loc >= G.lx * G.ly) then 1050 Tile := PoleTile(Loc) 1051 else 1052 Tile := MyMap[Loc]; 1053 if ShowObjects and (Options and (1 shl moEditMode) = 0) and 1054 (Tile and fCity <> 0) then 1055 GetCityInfo(Loc, cix, CityInfo); 1056 if (y <= FTop - yyt * 2) or (y > FBottom) or (x <= FLeft - xxt * 2) or 1057 (x > FRight) then 1058 begin 1059 NameCity; 1060 ShowSpacePort; 1061 exit; 1062 end; 1063 if Tile and fTerrain = fUNKNOWN then 1064 begin 1065 NameCity; 1066 ShowSpacePort; 1067 exit 1068 end; { square not discovered } 1069 1070 if not(FoW and (Tile and fObserved = 0)) then 1071 PaintBorder; 1072 1073 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Loc = FAdviceLoc) then 1074 TSprite(x, y, 7 + 9 * 2); 1075 1076 if (Loc >= 0) and (Loc < G.lx * G.ly) and (Tile and fSpecial <> 0) 1077 then { special ressources } 1078 begin 1079 dy := Loc div G.lx; 1080 if Tile and fTerrain < fForest then 1081 TSprite(x, y, Tile and fTerrain + (Tile and fSpecial shr 5) * 9) 1082 else if (Tile and fTerrain = fForest) and IsJungle(dy) then 1083 TSprite(x, y, 8 + 17 * 9 + (Tile and fSpecial shr 5) * 9) 1084 else 1085 TSprite(x, y, 8 + 2 * 9 + ((Tile and fTerrain - fForest) * 2 + 1086 Tile and fSpecial shr 5) * 9); 1087 end; 1088 1089 if ShowObjects then 1090 begin 1091 if Tile and fTerImp = tiMine then 1092 TSprite(x, y, 2 + 9 * 12); 1093 if Tile and fTerImp = tiBase then 1094 TSprite(x, y, 4 + 9 * 12); 1095 if Tile and fPoll <> 0 then 1096 TSprite(x, y, 6 + 9 * 12); 1097 if Tile and fTerImp = tiFort then 1098 begin 1099 TSprite(x, y, 7 + 9 * 12); 1100 if Tile and fObserved = 0 then 1101 TSprite(x, y, 3 + 9 * 12); 1102 end; 1103 end; 1104 if Tile and fDeadLands <> 0 then 1105 TSprite(x, y, (12 + Tile shr 25 and 3) * 9 + 8); 1106 1107 if Options and (1 shl moEditMode) <> 0 then 1108 fog := (Loc < 0) or (Loc >= G.lx * G.ly) 1109 // else if CityLoc>=0 then 1110 // fog:= (Loc<0) or (Loc>=G.lx*G.ly) or (Distance(Loc,CityLoc)>5) 1111 else if ShowGrWall then 1112 fog := Tile and fGrWall = 0 1113 else 1114 fog := FoW and (Tile and fObserved = 0); 1115 if fog and ShowObjects then 1116 if Loc < -G.lx then 1117 Sprite(HGrTerrain, x, y + yyt, xxt * 2, yyt, 1118 1 + 6 * (xxt * 2 + 1), 1 + yyt * 2 + 15 * (yyt * 3 + 1)) 1119 else if Loc >= G.lx * (G.ly + 1) then 1120 Sprite(HGrTerrain, x, y, xxt * 2, yyt, 1 + 6 * (xxt * 2 + 1), 1121 1 + yyt + 15 * (yyt * 3 + 1)) 1122 else 1123 TSprite(x, y, 6 + 9 * 15, xxt <> 33); 1124 1125 if FoW and (Tile and fObserved = 0) then 1126 PaintBorder; 924 1127 925 1128 {$IFNDEF SCR} 926 // paint goto destination mark 927 if DestinationMarkON and (CityOwner<0) and (UnFocus>=0) 928 and (MyUn[UnFocus].Status and usGoto<>0) then 929 begin 930 Destination:=MyUn[UnFocus].Status shr 16; 931 if (Destination=Loc) and (Destination<>MyUn[UnFocus].Loc) then 932 if not UseBlink or BlinkOn then TSprite(x,y,8+9*1) 933 else TSprite(x,y,8+9*2) 934 end; 1129 // paint goto destination mark 1130 if DestinationMarkON and (CityOwner < 0) and (UnFocus >= 0) and 1131 (MyUn[UnFocus].Status and usGoto <> 0) then 1132 begin 1133 Destination := MyUn[UnFocus].Status shr 16; 1134 if (Destination = Loc) and (Destination <> MyUn[UnFocus].Loc) then 1135 if not UseBlink or BlinkOn then 1136 TSprite(x, y, 8 + 9 * 1) 1137 else 1138 TSprite(x, y, 8 + 9 * 2) 1139 end; 935 1140 {$ENDIF} 936 937 if Options and (1 shl moEditMode)<>0 then 938 begin 939 if Tile and fPrefStartPos<>0 then TSprite(x,y,0+9*1) 940 else if Tile and fStartPos<>0 then TSprite(x,y,0+9*2); 941 end 942 else if ShowObjects then 943 begin 944 { if (CityLoc<0) and (UnFocus>=0) and (Loc=MyUn[UnFocus].Loc) then 945 if BlinkOn then TSprite(x,y,8+9*0) 946 else TSprite(x,y,8+9*1);} 947 948 NameCity; 949 ShowSpacePort; 950 if Tile and fCity<>0 then 951 PaintCity(x+xxt,y+yyt,CityInfo,CityOwner<0); 952 953 if (Tile and fUnit<>0) and (Loc<>AttLoc) 954 and ((Loc<>DefLoc) or (DefHealth<>0)) 955 {$IFNDEF SCR}and ((CityOwner>=0) or (UnFocus<0) or not UseBlink or BlinkON 956 or (Loc<>MyUn[UnFocus].Loc)){$ENDIF} 957 and ((Tile and fCity<>fCity) or (Loc=DefLoc) 958 {$IFNDEF SCR}or (not UseBlink or BlinkON) and (UnFocus>=0) 959 and (Loc=MyUn[UnFocus].Loc){$ENDIF}) then 960 begin {unit} 961 GetUnitInfo(Loc,uix,UnitInfo); 962 if (Loc=DefLoc) and (DefHealth>=0) then 963 UnitInfo.Health:=DefHealth; 964 if (UnitInfo.Owner<>CityOwner) 965 and not ((CityOwner=me) and (MyRO.Treaty[UnitInfo.Owner]=trAlliance)) then 966 {$IFNDEF SCR}if (UnFocus>=0) and (Loc=MyUn[UnFocus].Loc) then {active unit} 967 begin 968 Multi:=UnitInfo.Flags and unMulti; 969 MakeUnitInfo(me,MyUn[UnFocus],UnitInfo); 970 UnitInfo.Flags:=UnitInfo.Flags or Multi; 971 PaintUnit(x+(xxt-xxu),y+(yyt-yyu_anchor),UnitInfo,MyUn[UnFocus].Status); 972 end 973 else if UnitInfo.Owner=me then 974 begin 975 if ClientMode=cMovieTurn then 976 PaintUnit(x+(xxt-xxu),y+(yyt-yyu_anchor),UnitInfo,0) 977 // status is not set with precise timing during loading 978 else PaintUnit(x+(xxt-xxu),y+(yyt-yyu_anchor),UnitInfo,MyUn[uix].Status); 979 // if Showuix then Textout(x+16,y+5,$80FF00,IntToStr(uix)); 980 end 981 else{$ENDIF} PaintUnit(x+(xxt-xxu),y+(yyt-yyu_anchor),UnitInfo,0); 982 end 983 else if Tile and fHiddenUnit<>0 then 984 Sprite(HGrStdUnits,x+(xxt-xxu),y+(yyt-yyu_anchor),xxu*2,yyu*2, 985 1+5*(xxu*2+1),1) 986 else if Tile and fStealthUnit<>0 then 987 Sprite(HGrStdUnits,x+(xxt-xxu),y+(yyt-yyu_anchor),xxu*2,yyu*2, 988 1+5*(xxu*2+1),1+1*(yyu*2+1)) 989 end; 990 991 if ShowObjects and (Tile and fTerImp=tiFort) and (Tile and fObserved<>0) then 992 TSprite(x,y,3+9*12); 993 994 if (Loc>=0) and (Loc<G.lx*G.ly) then 995 if ShowLoc then Textout(x+xxt-16,y+yyt-9,$FFFF00,IntToStr(Loc)) 996 else if ShowDebug and (DebugMap<>nil) 997 and (Loc>=0) and (Loc<G.lx*G.ly) and (DebugMap[Loc]<>0) then 998 Textout(x+xxt-16,y+yyt-9,$00E0FF,IntToStr(integer(DebugMap[Loc]))) 999 end;{PaintTileObjects} 1000 1001 procedure TIsoMap.PaintGrid(x,y,nx,ny: integer); 1002 1003 procedure ClippedLine(dx0,dy0: integer; mirror: boolean); 1004 var 1005 x0,x1,dxmin,dymin,dxmax,dymax,n: integer; 1006 begin 1007 with FOutput.Canvas do 1008 begin 1009 dxmin:=(FLeft-x) div xxt; 1010 dymin:=(RealTop-y) div yyt; 1011 dxmax:=(FRight-x-1) div xxt+1; 1012 dymax:=(RealBottom-y-1) div yyt+1; 1013 n:=dymax-dy0; 1014 if mirror then 1015 begin 1016 if dx0-dxmin<n then n:=dx0-dxmin; 1017 if dx0>dxmax then 1018 begin n:=n-(dx0-dxmax); dy0:=dy0+(dx0-dxmax); dx0:=dxmax end; 1019 if dy0<dymin then 1020 begin n:=n-(dymin-dy0); dx0:=dx0-(dymin-dy0); dy0:=dymin end; 1021 end 1022 else 1023 begin 1024 if dxmax-dx0<n then n:=dxmax-dx0; 1025 if dx0<dxmin then 1026 begin n:=n-(dxmin-dx0); dy0:=dy0+(dxmin-dx0); dx0:=dxmin end; 1027 if dy0<dymin then 1028 begin n:=n-(dymin-dy0); dx0:=dx0+(dymin-dy0); dy0:=dymin end; 1029 end; 1030 if n<=0 then exit; 1031 if mirror then begin x0:=x+dx0*xxt-1; x1:=x+(dx0-n)*xxt-1; end 1032 else begin x0:=x+dx0*xxt; x1:=x+(dx0+n)*xxt; end; 1033 moveto(x0,y+dy0*yyt); 1034 lineto(x1,y+(dy0+n)*yyt); 1035 end 1036 end; 1037 1038 var 1039 i: integer; 1040 begin 1041 FOutput.Canvas.pen.color:=$000000; //$FF shl (8*random(3)); 1042 for i:=0 to nx div 2 do ClippedLine(i*2,0,false); 1043 for i:=1 to (nx+1) div 2 do ClippedLine(i*2,0,true); 1044 for i:=0 to ny div 2 do 1045 begin 1046 ClippedLine(0,2*i+2,false); 1047 ClippedLine(nx+1,2*i+1+nx and 1,true); 1048 end; 1049 end; 1050 1051 procedure TIsoMap.Paint(x,y,Loc,nx,ny,CityLoc,CityOwner:integer; 1052 UseBlink: boolean; CityAllowClick: boolean); 1053 1054 function IsShoreTile(Loc: integer):boolean; 1055 const 1056 Dirx: array[0..7] of integer=(1,2,1,0,-1,-2,-1,0); 1057 Diry: array[0..7] of integer=(-1,0,1,2,1,0,-1,-2); 1058 var 1059 Dir,ConnLoc: integer; 1060 begin 1061 result:=false; 1062 for Dir:=0 to 7 do 1063 begin 1064 ConnLoc:=dLoc(Loc,Dirx[Dir],Diry[Dir]); 1065 if (ConnLoc<0) or (ConnLoc>=G.lx*G.ly) 1066 or ((MyMap[ConnLoc]-2) and fTerrain<13) then 1067 result:=true 1068 end 1069 end; 1070 1071 procedure ShadeOutside(x0,y0,x1,y1,xm,ym: integer); 1072 const 1073 rShade=3.75; 1074 1075 procedure MakeDark(line: pointer; length: integer); 1076 type 1077 TCardArray=array[0..9999] of cardinal; 1078 PCardArray=^TCardArray; 1079 TByteArray=array[0..9999] of byte; 1080 PByteArray=^TByteArray; 1081 var 1082 i,rest: integer; 1083 begin 1084 for i:=length*3 div 4-1 downto 0 do 1085 PCardArray(line)[i]:=PCardArray(line)[i] shr 1 and $7F7F7F7F; 1086 rest:=(length*3 div 4)*4; 1087 for i:=length*3 mod 4-1 downto 0 do 1088 PByteArray(line)[rest+i]:=PByteArray(line)[rest+i] shr 1 and $7F; 1089 end; 1090 1091 type 1092 TLine=array[0..99999,0..2] of Byte; 1093 var 1094 y,wBright: integer; 1095 y_n,w_n: single; 1096 line: ^TLine; 1097 begin 1098 for y:=y0 to y1-1 do 1099 begin 1100 line:=FOutput.ScanLine[y]; 1101 y_n:=(y-ym)/yyt; 1102 if abs(y_n)<rShade then 1103 begin 1104 w_n:=sqrt(sqr(rShade)-sqr(y_n)); 1105 wBright:=trunc(w_n*xxt+0.5); 1106 MakeDark(@line[x0],xm-x0-wBright); 1107 MakeDark(@line[xm+wBright],x1-xm-wBright); 1108 end 1109 else MakeDark(@line[x0],x1-x0); 1110 end 1111 end; 1112 1113 procedure CityGrid(xm,ym: integer); 1114 var 1115 i: integer; 1116 begin 1117 with FOutput.Canvas do 1118 begin 1119 if CityAllowClick then pen.Color:=$FFFFFF 1120 else pen.color:=$000000; 1121 pen.width:=1; 1122 for i:=0 to 3 do 1123 begin 1124 moveto(xm-xxt*(4-i),ym+yyt*(1+i)); lineto(xm+xxt*(1+i),ym-yyt*(4-i)); 1125 moveto(xm-xxt*(4-i),ym-yyt*(1+i)); lineto(xm+xxt*(1+i),ym+yyt*(4-i)); 1126 end; 1127 moveto(xm-xxt*4,ym+yyt*1); lineto(xm-xxt*1,ym+yyt*4); 1128 moveto(xm+xxt*1,ym+yyt*4); lineto(xm+xxt*4,ym+yyt*1); 1129 moveto(xm-xxt*4,ym-yyt*1); lineto(xm-xxt*1,ym-yyt*4); 1130 moveto(xm+xxt*1,ym-yyt*4); lineto(xm+xxt*4,ym-yyt*1); 1131 pen.width:=1; 1132 end 1133 end; 1134 1135 var 1136 dx,dy,xm,ym,ALoc,BLoc,ATer,BTer,Aix,bix:integer; 1137 begin 1138 FoW:=true; 1139 ShowLoc:=Options and (1 shl moLocCodes)<>0; 1140 ShowDebug:= pDebugMap>=0; 1141 ShowObjects:= (CityOwner>=0) or (Options and (1 shl moBareTerrain)=0); 1142 ShowCityNames:= ShowObjects and (CityOwner<0) and (Options and (1 shl moCityNames)<>0); 1143 ShowBorder:=true; 1144 ShowMyBorder:= CityOwner<0; 1145 ShowGrWall:= (CityOwner<0) and (Options and (1 shl moGreatWall)<>0); 1146 if ShowDebug then 1147 Server(sGetDebugMap,me,pDebugMap,DebugMap) 1148 else DebugMap:=nil; 1149 with FOutput.Canvas do 1150 begin 1151 RealTop:=y-((Loc+12345*G.lx) div G.lx-12345)*yyt; 1152 RealBottom:=y+(G.ly-((Loc+12345*G.lx) div G.lx-12345)+3)*yyt; 1153 Brush.Color:=EmptySpaceColor; 1154 if RealTop>FTop then 1155 FillRect(Rect(FLeft,FTop,FRight,RealTop)) 1156 else RealTop:=FTop; 1157 if RealBottom<FBottom then 1158 FillRect(Rect(FLeft,RealBottom,FRight,FBottom)) 1159 else RealBottom:=FBottom; 1160 Brush.Color:=$000000; 1161 FillRect(Rect(FLeft,RealTop,FRight,RealBottom)); 1162 Brush.Style:=bsClear; 1163 end; 1164 1165 for dy:=0 to ny+1 do if (Loc+dy*G.lx>=0) and (Loc+(dy-3)*G.lx<G.lx*G.ly) then 1166 for dx:=0 to nx do 1167 begin 1168 ALoc:=dLoc(Loc,dx-(dy+dx) and 1,dy-2); 1169 BLoc:=dLoc(Loc,dx-(dy+dx+1) and 1,dy-1); 1170 if (ALoc<0) or (ALoc>=G.lx*G.ly) then ATer:=PoleTile(ALoc) and fTerrain 1171 else ATer:=MyMap[ALoc] and fTerrain; 1172 if (BLoc<0) or (BLoc>=G.lx*G.ly) then BTer:=PoleTile(BLoc) and fTerrain 1173 else BTer:=MyMap[BLoc] and fTerrain; 1174 1175 if (ATer<>fUNKNOWN) or (BTer<>fUNKNOWN) then 1176 if ((ATer<fGrass) or (ATer=fUNKNOWN)) and ((BTer<fGrass) or (BTer=fUNKNOWN)) then 1177 begin 1178 if ATer=fUNKNOWN then Aix:=0 1179 else if IsShoreTile(ALoc) then 1180 if ATer=fOcean then Aix:=-1 1181 else Aix:=1 1182 else Aix:=ATer+2; 1183 if BTer=fUNKNOWN then bix:=0 1184 else if IsShoreTile(BLoc) then 1185 if BTer=fOcean then bix:=-1 1186 else bix:=1 1187 else bix:=BTer+2; 1188 if (Aix>1) or (bix>1) then 1189 begin 1190 if aix=-1 then 1191 if bix=fOcean+2 then begin aix:=0; bix:=0 end 1192 else begin aix:=0; bix:=1 end 1193 else if bix=-1 then 1194 if aix=fOcean+2 then begin aix:=1; bix:=1 end 1195 else begin aix:=1; bix:=0 end; 1196 BitBlt(OceanPatch,x+dx*xxt,y+dy*yyt,xxt,yyt, 1197 Aix*(xxt*2)+(dx+dy+1) and 1 *xxt,bix*yyt,SRCCOPY) 1141 if Options and (1 shl moEditMode) <> 0 then 1142 begin 1143 if Tile and fPrefStartPos <> 0 then 1144 TSprite(x, y, 0 + 9 * 1) 1145 else if Tile and fStartPos <> 0 then 1146 TSprite(x, y, 0 + 9 * 2); 1198 1147 end 1199 end 1200 else 1201 begin 1202 if ATer=fUNKNOWN then Aix:=0 1203 else if (ALoc>=0) and (ALoc<G.lx*G.ly) and (MyMap[ALoc] and fDeadLands<>0) then 1204 Aix:=-2 1205 else if ATer=fOcean then Aix:=-1 1206 else if ATer=fShore then Aix:=1 1207 else if ATer>=fForest then Aix:=8 1208 else Aix:=ATer; 1209 if BTer=fUNKNOWN then bix:=0 1210 else if (BLoc>=0) and (BLoc<G.lx*G.ly) and (MyMap[BLoc] and fDeadLands<>0) then 1211 Bix:=-2 1212 else if BTer=fOcean then bix:=-1 1213 else if BTer=fShore then bix:=1 1214 else if BTer>=fForest then bix:=8 1215 else bix:=BTer; 1216 if (Aix=-2) and (Bix=-2) then 1217 begin Aix:=fDesert; Bix:=fDesert end 1218 else if Aix=-2 then 1219 if Bix<2 then Aix:=8 else Aix:=Bix 1220 else if Bix=-2 then 1221 if Aix<2 then Bix:=8 else Bix:=Aix; 1222 if Aix=-1 then BitBlt(GrExt[HGrTerrain].Data,x+dx*xxt,y+dy*yyt,xxt,yyt, 1223 1+6*(xxt*2+1)+(dx+dy+1) and 1 *xxt,1+yyt,SRCCOPY) // arctic <-> ocean 1224 else if bix=-1 then BitBlt(GrExt[HGrTerrain].Data,x+dx*xxt,y+dy*yyt,xxt, 1225 yyt,1+6*(xxt*2+1)+xxt-(dx+dy+1) and 1 *xxt,1+yyt*2,SRCCOPY) // arctic <-> ocean 1226 else BitBlt(LandPatch,x+dx*xxt,y+dy*yyt,xxt,yyt, 1227 Aix*(xxt*2)+(dx+dy+1) and 1 *xxt,bix*yyt,SRCCOPY) 1228 end 1229 end; 1230 1231 OutDC:=FOutput.Canvas.Handle; 1232 DataDC:=GrExt[HGrTerrain].Data.Canvas.Handle; 1233 MaskDC:=GrExt[HGrTerrain].Mask.Canvas.Handle; 1234 for dy:=-2 to ny+1 do for dx:=-1 to nx do if (dx+dy) and 1=0 then 1235 PaintShore(x+xxt*dx,y+yyt+yyt*dy,dLoc(Loc,dx,dy)); 1236 for dy:=-2 to ny+1 do for dx:=-1 to nx do if (dx+dy) and 1=0 then 1237 PaintTileExtraTerrain(x+xxt*dx,y+yyt+yyt*dy,dLoc(Loc,dx,dy)); 1238 if CityOwner>=0 then 1239 begin 1240 for dy:=-2 to ny+1 do for dx:=-2 to nx+1 do if (dx+dy) and 1=0 then 1241 begin 1242 ALoc:=dLoc(Loc,dx,dy); 1243 if Distance(ALoc,CityLoc)>5 then 1244 PaintTileObjects(x+xxt*dx,y+yyt+yyt*dy,ALoc,CityLoc,CityOwner,UseBlink); 1245 end; 1246 dx:=((CityLoc mod G.lx *2 +CityLoc div G.lx and 1) 1247 -((Loc+666*G.lx) mod G.lx *2 1248 +(Loc+666*G.lx) div G.lx and 1)+3*G.lx) mod (2*G.lx) -G.lx; 1249 dy:=CityLoc div G.lx-(Loc+666*G.lx) div G.lx+666; 1250 xm:=x+(dx+1)*xxt; 1251 ym:=y+(dy+1)*yyt+yyt; 1252 ShadeOutside(FLeft,FTop,FRight,FBottom,xm,ym); 1253 CityGrid(xm,ym); 1254 for dy:=-2 to ny+1 do for dx:=-2 to nx+1 do if (dx+dy) and 1=0 then 1255 begin 1256 ALoc:=dLoc(Loc,dx,dy); 1257 if Distance(ALoc,CityLoc)<=5 then 1258 PaintTileObjects(x+xxt*dx,y+yyt+yyt*dy,ALoc,CityLoc,CityOwner,UseBlink); 1259 end; 1260 end 1261 else 1262 begin 1263 if ShowLoc or (Options and (1 shl moEditMode)<>0) 1264 or (Options and (1 shl moGrid)<>0) then 1265 PaintGrid(x,y,nx,ny); 1266 for dy:=-2 to ny+1 do for dx:=-2 to nx+1 do if (dx+dy) and 1=0 then 1267 PaintTileObjects(x+xxt*dx,y+yyt+yyt*dy,dLoc(Loc,dx,dy),CityLoc,CityOwner,UseBlink); 1268 end; 1269 1270 //frame(FOutput.Canvas,x+1,y+1,x+nx*33+33-2,y+ny*16+32-2,$FFFF,$FFFF); 1271 end; {Paint} 1272 1273 procedure TIsoMap.AttackBegin(const ShowMove: TShowMove); 1274 begin 1275 AttLoc:=ShowMove.FromLoc; 1276 DefLoc:=dLoc(AttLoc,ShowMove.dx,ShowMove.dy); 1277 DefHealth:=-1; 1278 end; 1279 1280 procedure TIsoMap.AttackEffect(const ShowMove: TShowMove); 1281 begin 1282 DefHealth:=ShowMove.EndHealthDef; 1283 end; 1284 1285 procedure TIsoMap.AttackEnd; 1286 begin 1287 AttLoc:=-1; 1288 DefLoc:=-1; 1289 end; 1290 1148 else if ShowObjects then 1149 begin 1150 { if (CityLoc<0) and (UnFocus>=0) and (Loc=MyUn[UnFocus].Loc) then 1151 if BlinkOn then TSprite(x,y,8+9*0) 1152 else TSprite(x,y,8+9*1); } 1153 1154 NameCity; 1155 ShowSpacePort; 1156 if Tile and fCity <> 0 then 1157 PaintCity(x + xxt, y + yyt, CityInfo, CityOwner < 0); 1158 1159 if (Tile and fUnit <> 0) and (Loc <> AttLoc) and 1160 ((Loc <> DefLoc) or (DefHealth <> 0)) 1161 {$IFNDEF SCR} and ((CityOwner >= 0) or (UnFocus < 0) or not UseBlink or 1162 BlinkOn or (Loc <> MyUn[UnFocus].Loc)){$ENDIF} 1163 and ((Tile and fCity <> fCity) or (Loc = DefLoc) 1164 {$IFNDEF SCR} or (not UseBlink or BlinkOn) and (UnFocus >= 0) and 1165 (Loc = MyUn[UnFocus].Loc){$ENDIF}) then 1166 begin { unit } 1167 GetUnitInfo(Loc, uix, UnitInfo); 1168 if (Loc = DefLoc) and (DefHealth >= 0) then 1169 UnitInfo.Health := DefHealth; 1170 if (UnitInfo.Owner <> CityOwner) and 1171 not((CityOwner = me) and 1172 (MyRO.Treaty[UnitInfo.Owner] = trAlliance)) then 1173 {$IFNDEF SCR} if (UnFocus >= 0) and (Loc = MyUn[UnFocus].Loc) then { active unit } 1174 begin 1175 Multi := UnitInfo.Flags and unMulti; 1176 MakeUnitInfo(me, MyUn[UnFocus], UnitInfo); 1177 UnitInfo.Flags := UnitInfo.Flags or Multi; 1178 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 1179 MyUn[UnFocus].Status); 1180 end 1181 else if UnitInfo.Owner = me then 1182 begin 1183 if ClientMode = cMovieTurn then 1184 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), 1185 UnitInfo, 0) 1186 // status is not set with precise timing during loading 1187 else 1188 PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 1189 MyUn[uix].Status); 1190 // if Showuix then Textout(x+16,y+5,$80FF00,IntToStr(uix)); 1191 end 1192 else {$ENDIF} PaintUnit(x + (xxt - xxu), y + (yyt - yyu_anchor), UnitInfo, 0); 1193 end 1194 else if Tile and fHiddenUnit <> 0 then 1195 Sprite(HGrStdUnits, x + (xxt - xxu), y + (yyt - yyu_anchor), 1196 xxu * 2, yyu * 2, 1 + 5 * (xxu * 2 + 1), 1) 1197 else if Tile and fStealthUnit <> 0 then 1198 Sprite(HGrStdUnits, x + (xxt - xxu), y + (yyt - yyu_anchor), 1199 xxu * 2, yyu * 2, 1 + 5 * (xxu * 2 + 1), 1 + 1 * (yyu * 2 + 1)) 1200 end; 1201 1202 if ShowObjects and (Tile and fTerImp = tiFort) and 1203 (Tile and fObserved <> 0) then 1204 TSprite(x, y, 3 + 9 * 12); 1205 1206 if (Loc >= 0) and (Loc < G.lx * G.ly) then 1207 if ShowLoc then 1208 Textout(x + xxt - 16, y + yyt - 9, $FFFF00, IntToStr(Loc)) 1209 else if ShowDebug and (DebugMap <> nil) and (Loc >= 0) and 1210 (Loc < G.lx * G.ly) and (DebugMap[Loc] <> 0) then 1211 Textout(x + xxt - 16, y + yyt - 9, $00E0FF, 1212 IntToStr(integer(DebugMap[Loc]))) 1213 end; { PaintTileObjects } 1214 1215 procedure TIsoMap.PaintGrid(x, y, nx, ny: integer); 1216 1217 procedure ClippedLine(dx0, dy0: integer; mirror: boolean); 1218 var 1219 x0, x1, dxmin, dymin, dxmax, dymax, n: integer; 1220 begin 1221 with FOutput.Canvas do 1222 begin 1223 dxmin := (FLeft - x) div xxt; 1224 dymin := (RealTop - y) div yyt; 1225 dxmax := (FRight - x - 1) div xxt + 1; 1226 dymax := (RealBottom - y - 1) div yyt + 1; 1227 n := dymax - dy0; 1228 if mirror then 1229 begin 1230 if dx0 - dxmin < n then 1231 n := dx0 - dxmin; 1232 if dx0 > dxmax then 1233 begin 1234 n := n - (dx0 - dxmax); 1235 dy0 := dy0 + (dx0 - dxmax); 1236 dx0 := dxmax 1237 end; 1238 if dy0 < dymin then 1239 begin 1240 n := n - (dymin - dy0); 1241 dx0 := dx0 - (dymin - dy0); 1242 dy0 := dymin 1243 end; 1244 end 1245 else 1246 begin 1247 if dxmax - dx0 < n then 1248 n := dxmax - dx0; 1249 if dx0 < dxmin then 1250 begin 1251 n := n - (dxmin - dx0); 1252 dy0 := dy0 + (dxmin - dx0); 1253 dx0 := dxmin 1254 end; 1255 if dy0 < dymin then 1256 begin 1257 n := n - (dymin - dy0); 1258 dx0 := dx0 + (dymin - dy0); 1259 dy0 := dymin 1260 end; 1261 end; 1262 if n <= 0 then 1263 exit; 1264 if mirror then 1265 begin 1266 x0 := x + dx0 * xxt - 1; 1267 x1 := x + (dx0 - n) * xxt - 1; 1268 end 1269 else 1270 begin 1271 x0 := x + dx0 * xxt; 1272 x1 := x + (dx0 + n) * xxt; 1273 end; 1274 moveto(x0, y + dy0 * yyt); 1275 lineto(x1, y + (dy0 + n) * yyt); 1276 end 1277 end; 1278 1279 var 1280 i: integer; 1281 begin 1282 FOutput.Canvas.pen.Color := $000000; // $FF shl (8*random(3)); 1283 for i := 0 to nx div 2 do 1284 ClippedLine(i * 2, 0, false); 1285 for i := 1 to (nx + 1) div 2 do 1286 ClippedLine(i * 2, 0, true); 1287 for i := 0 to ny div 2 do 1288 begin 1289 ClippedLine(0, 2 * i + 2, false); 1290 ClippedLine(nx + 1, 2 * i + 1 + nx and 1, true); 1291 end; 1292 end; 1293 1294 procedure TIsoMap.Paint(x, y, Loc, nx, ny, CityLoc, CityOwner: integer; 1295 UseBlink: boolean; CityAllowClick: boolean); 1296 1297 function IsShoreTile(Loc: integer): boolean; 1298 const 1299 Dirx: array [0 .. 7] of integer = (1, 2, 1, 0, -1, -2, -1, 0); 1300 Diry: array [0 .. 7] of integer = (-1, 0, 1, 2, 1, 0, -1, -2); 1301 var 1302 Dir, ConnLoc: integer; 1303 begin 1304 result := false; 1305 for Dir := 0 to 7 do 1306 begin 1307 ConnLoc := dLoc(Loc, Dirx[Dir], Diry[Dir]); 1308 if (ConnLoc < 0) or (ConnLoc >= G.lx * G.ly) or 1309 ((MyMap[ConnLoc] - 2) and fTerrain < 13) then 1310 result := true 1311 end 1312 end; 1313 1314 procedure ShadeOutside(x0, y0, x1, y1, xm, ym: integer); 1315 const 1316 rShade = 3.75; 1317 1318 procedure MakeDark(Line: pointer; length: integer); 1319 type 1320 TCardArray = array [0 .. 9999] of Cardinal; 1321 PCardArray = ^TCardArray; 1322 TByteArray = array [0 .. 9999] of Byte; 1323 PByteArray = ^TByteArray; 1324 var 1325 i, rest: integer; 1326 begin 1327 for i := length * 3 div 4 - 1 downto 0 do 1328 PCardArray(Line)[i] := PCardArray(Line)[i] shr 1 and $7F7F7F7F; 1329 rest := (length * 3 div 4) * 4; 1330 for i := length * 3 mod 4 - 1 downto 0 do 1331 PByteArray(Line)[rest + i] := PByteArray(Line) 1332 [rest + i] shr 1 and $7F; 1333 end; 1334 1335 type 1336 TLine = array [0 .. 99999, 0 .. 2] of Byte; 1337 var 1338 y, wBright: integer; 1339 y_n, w_n: single; 1340 Line: ^TLine; 1341 begin 1342 for y := y0 to y1 - 1 do 1343 begin 1344 Line := FOutput.ScanLine[y]; 1345 y_n := (y - ym) / yyt; 1346 if abs(y_n) < rShade then 1347 begin 1348 w_n := sqrt(sqr(rShade) - sqr(y_n)); 1349 wBright := trunc(w_n * xxt + 0.5); 1350 MakeDark(@Line[x0], xm - x0 - wBright); 1351 MakeDark(@Line[xm + wBright], x1 - xm - wBright); 1352 end 1353 else 1354 MakeDark(@Line[x0], x1 - x0); 1355 end 1356 end; 1357 1358 procedure CityGrid(xm, ym: integer); 1359 var 1360 i: integer; 1361 begin 1362 with FOutput.Canvas do 1363 begin 1364 if CityAllowClick then 1365 pen.Color := $FFFFFF 1366 else 1367 pen.Color := $000000; 1368 pen.Width := 1; 1369 for i := 0 to 3 do 1370 begin 1371 moveto(xm - xxt * (4 - i), ym + yyt * (1 + i)); 1372 lineto(xm + xxt * (1 + i), ym - yyt * (4 - i)); 1373 moveto(xm - xxt * (4 - i), ym - yyt * (1 + i)); 1374 lineto(xm + xxt * (1 + i), ym + yyt * (4 - i)); 1375 end; 1376 moveto(xm - xxt * 4, ym + yyt * 1); 1377 lineto(xm - xxt * 1, ym + yyt * 4); 1378 moveto(xm + xxt * 1, ym + yyt * 4); 1379 lineto(xm + xxt * 4, ym + yyt * 1); 1380 moveto(xm - xxt * 4, ym - yyt * 1); 1381 lineto(xm - xxt * 1, ym - yyt * 4); 1382 moveto(xm + xxt * 1, ym - yyt * 4); 1383 lineto(xm + xxt * 4, ym - yyt * 1); 1384 pen.Width := 1; 1385 end 1386 end; 1387 1388 var 1389 dx, dy, xm, ym, ALoc, BLoc, ATer, BTer, Aix, bix: integer; 1390 begin 1391 FoW := true; 1392 ShowLoc := Options and (1 shl moLocCodes) <> 0; 1393 ShowDebug := pDebugMap >= 0; 1394 ShowObjects := (CityOwner >= 0) or 1395 (Options and (1 shl moBareTerrain) = 0); 1396 ShowCityNames := ShowObjects and (CityOwner < 0) and 1397 (Options and (1 shl moCityNames) <> 0); 1398 ShowBorder := true; 1399 ShowMyBorder := CityOwner < 0; 1400 ShowGrWall := (CityOwner < 0) and 1401 (Options and (1 shl moGreatWall) <> 0); 1402 if ShowDebug then 1403 Server(sGetDebugMap, me, pDebugMap, DebugMap) 1404 else 1405 DebugMap := nil; 1406 with FOutput.Canvas do 1407 begin 1408 RealTop := y - ((Loc + 12345 * G.lx) div G.lx - 12345) * yyt; 1409 RealBottom := y + 1410 (G.ly - ((Loc + 12345 * G.lx) div G.lx - 12345) + 3) * yyt; 1411 Brush.Color := EmptySpaceColor; 1412 if RealTop > FTop then 1413 FillRect(Rect(FLeft, FTop, FRight, RealTop)) 1414 else 1415 RealTop := FTop; 1416 if RealBottom < FBottom then 1417 FillRect(Rect(FLeft, RealBottom, FRight, FBottom)) 1418 else 1419 RealBottom := FBottom; 1420 Brush.Color := $000000; 1421 FillRect(Rect(FLeft, RealTop, FRight, RealBottom)); 1422 Brush.Style := bsClear; 1423 end; 1424 1425 for dy := 0 to ny + 1 do 1426 if (Loc + dy * G.lx >= 0) and (Loc + (dy - 3) * G.lx < G.lx * G.ly) 1427 then 1428 for dx := 0 to nx do 1429 begin 1430 ALoc := dLoc(Loc, dx - (dy + dx) and 1, dy - 2); 1431 BLoc := dLoc(Loc, dx - (dy + dx + 1) and 1, dy - 1); 1432 if (ALoc < 0) or (ALoc >= G.lx * G.ly) then 1433 ATer := PoleTile(ALoc) and fTerrain 1434 else 1435 ATer := MyMap[ALoc] and fTerrain; 1436 if (BLoc < 0) or (BLoc >= G.lx * G.ly) then 1437 BTer := PoleTile(BLoc) and fTerrain 1438 else 1439 BTer := MyMap[BLoc] and fTerrain; 1440 1441 if (ATer <> fUNKNOWN) or (BTer <> fUNKNOWN) then 1442 if ((ATer < fGrass) or (ATer = fUNKNOWN)) and 1443 ((BTer < fGrass) or (BTer = fUNKNOWN)) then 1444 begin 1445 if ATer = fUNKNOWN then 1446 Aix := 0 1447 else if IsShoreTile(ALoc) then 1448 if ATer = fOcean then 1449 Aix := -1 1450 else 1451 Aix := 1 1452 else 1453 Aix := ATer + 2; 1454 if BTer = fUNKNOWN then 1455 bix := 0 1456 else if IsShoreTile(BLoc) then 1457 if BTer = fOcean then 1458 bix := -1 1459 else 1460 bix := 1 1461 else 1462 bix := BTer + 2; 1463 if (Aix > 1) or (bix > 1) then 1464 begin 1465 if Aix = -1 then 1466 if bix = fOcean + 2 then 1467 begin 1468 Aix := 0; 1469 bix := 0 1470 end 1471 else 1472 begin 1473 Aix := 0; 1474 bix := 1 1475 end 1476 else if bix = -1 then 1477 if Aix = fOcean + 2 then 1478 begin 1479 Aix := 1; 1480 bix := 1 1481 end 1482 else 1483 begin 1484 Aix := 1; 1485 bix := 0 1486 end; 1487 BitBlt(OceanPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1488 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, 1489 bix * yyt, SRCCOPY) 1490 end 1491 end 1492 else 1493 begin 1494 if ATer = fUNKNOWN then 1495 Aix := 0 1496 else if (ALoc >= 0) and (ALoc < G.lx * G.ly) and 1497 (MyMap[ALoc] and fDeadLands <> 0) then 1498 Aix := -2 1499 else if ATer = fOcean then 1500 Aix := -1 1501 else if ATer = fShore then 1502 Aix := 1 1503 else if ATer >= fForest then 1504 Aix := 8 1505 else 1506 Aix := ATer; 1507 if BTer = fUNKNOWN then 1508 bix := 0 1509 else if (BLoc >= 0) and (BLoc < G.lx * G.ly) and 1510 (MyMap[BLoc] and fDeadLands <> 0) then 1511 bix := -2 1512 else if BTer = fOcean then 1513 bix := -1 1514 else if BTer = fShore then 1515 bix := 1 1516 else if BTer >= fForest then 1517 bix := 8 1518 else 1519 bix := BTer; 1520 if (Aix = -2) and (bix = -2) then 1521 begin 1522 Aix := fDesert; 1523 bix := fDesert 1524 end 1525 else if Aix = -2 then 1526 if bix < 2 then 1527 Aix := 8 1528 else 1529 Aix := bix 1530 else if bix = -2 then 1531 if Aix < 2 then 1532 bix := 8 1533 else 1534 bix := Aix; 1535 if Aix = -1 then 1536 BitBlt(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, 1537 xxt, yyt, 1 + 6 * (xxt * 2 + 1) + (dx + dy + 1) and 1538 1 * xxt, 1 + yyt, SRCCOPY) // arctic <-> ocean 1539 else if bix = -1 then 1540 BitBlt(GrExt[HGrTerrain].Data, x + dx * xxt, y + dy * yyt, 1541 xxt, yyt, 1 + 6 * (xxt * 2 + 1) + xxt - (dx + dy + 1) 1542 and 1 * xxt, 1 + yyt * 2, SRCCOPY) // arctic <-> ocean 1543 else 1544 BitBlt(LandPatch, x + dx * xxt, y + dy * yyt, xxt, yyt, 1545 Aix * (xxt * 2) + (dx + dy + 1) and 1 * xxt, 1546 bix * yyt, SRCCOPY) 1547 end 1548 end; 1549 1550 OutDC := FOutput.Canvas.Handle; 1551 DataDC := GrExt[HGrTerrain].Data.Canvas.Handle; 1552 MaskDC := GrExt[HGrTerrain].Mask.Canvas.Handle; 1553 for dy := -2 to ny + 1 do 1554 for dx := -1 to nx do 1555 if (dx + dy) and 1 = 0 then 1556 PaintShore(x + xxt * dx, y + yyt + yyt * dy, dLoc(Loc, dx, dy)); 1557 for dy := -2 to ny + 1 do 1558 for dx := -1 to nx do 1559 if (dx + dy) and 1 = 0 then 1560 PaintTileExtraTerrain(x + xxt * dx, y + yyt + yyt * dy, 1561 dLoc(Loc, dx, dy)); 1562 if CityOwner >= 0 then 1563 begin 1564 for dy := -2 to ny + 1 do 1565 for dx := -2 to nx + 1 do 1566 if (dx + dy) and 1 = 0 then 1567 begin 1568 ALoc := dLoc(Loc, dx, dy); 1569 if Distance(ALoc, CityLoc) > 5 then 1570 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, ALoc, 1571 CityLoc, CityOwner, UseBlink); 1572 end; 1573 dx := ((CityLoc mod G.lx * 2 + CityLoc div G.lx and 1) - 1574 ((Loc + 666 * G.lx) mod G.lx * 2 + (Loc + 666 * G.lx) div G.lx and 1575 1) + 3 * G.lx) mod (2 * G.lx) - G.lx; 1576 dy := CityLoc div G.lx - (Loc + 666 * G.lx) div G.lx + 666; 1577 xm := x + (dx + 1) * xxt; 1578 ym := y + (dy + 1) * yyt + yyt; 1579 ShadeOutside(FLeft, FTop, FRight, FBottom, xm, ym); 1580 CityGrid(xm, ym); 1581 for dy := -2 to ny + 1 do 1582 for dx := -2 to nx + 1 do 1583 if (dx + dy) and 1 = 0 then 1584 begin 1585 ALoc := dLoc(Loc, dx, dy); 1586 if Distance(ALoc, CityLoc) <= 5 then 1587 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, ALoc, 1588 CityLoc, CityOwner, UseBlink); 1589 end; 1590 end 1591 else 1592 begin 1593 if ShowLoc or (Options and (1 shl moEditMode) <> 0) or 1594 (Options and (1 shl moGrid) <> 0) then 1595 PaintGrid(x, y, nx, ny); 1596 for dy := -2 to ny + 1 do 1597 for dx := -2 to nx + 1 do 1598 if (dx + dy) and 1 = 0 then 1599 PaintTileObjects(x + xxt * dx, y + yyt + yyt * dy, 1600 dLoc(Loc, dx, dy), CityLoc, CityOwner, UseBlink); 1601 end; 1602 1603 // frame(FOutput.Canvas,x+1,y+1,x+nx*33+33-2,y+ny*16+32-2,$FFFF,$FFFF); 1604 end; { Paint } 1605 1606 procedure TIsoMap.AttackBegin(const ShowMove: TShowMove); 1607 begin 1608 AttLoc := ShowMove.FromLoc; 1609 DefLoc := dLoc(AttLoc, ShowMove.dx, ShowMove.dy); 1610 DefHealth := -1; 1611 end; 1612 1613 procedure TIsoMap.AttackEffect(const ShowMove: TShowMove); 1614 begin 1615 DefHealth := ShowMove.EndHealthDef; 1616 end; 1617 1618 procedure TIsoMap.AttackEnd; 1619 begin 1620 AttLoc := -1; 1621 DefLoc := -1; 1622 end; 1291 1623 1292 1624 initialization 1293 1625 1294 NoMap:=nil; 1295 LandPatch:=nil; 1296 OceanPatch:=nil; 1297 Borders:=nil; 1626 NoMap := nil; 1627 LandPatch := nil; 1628 OceanPatch := nil; 1629 Borders := nil; 1630 1298 1631 end. 1299 -
trunk/LocalPlayer/LocalPlayer.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit LocalPlayer; 4 3 5 4 interface 6 5 7 procedure Client(Command, Player:integer;var Data); stdcall;6 procedure Client(Command, Player: integer; var Data); stdcall; 8 7 9 8 procedure SetAIName(p: integer; Name: string); 10 11 9 12 10 implementation 13 11 14 12 uses 15 Term,CityScreen,Draft,MessgEx,Select,CityType,Help,UnitStat,Diagram,16 NatStat,Wonders,Nego,Enhance,BaseWin,Battle,Rates,TechTree,13 Term, CityScreen, Draft, MessgEx, Select, CityType, Help, UnitStat, Diagram, 14 NatStat, Wonders, Nego, Enhance, BaseWin, Battle, Rates, TechTree, 17 15 18 Forms;16 Forms; 19 17 20 18 var 21 FormsCreated: boolean;19 FormsCreated: boolean; 22 20 23 21 procedure Client; 24 22 begin 25 if not FormsCreated then23 if not FormsCreated then 26 24 begin 27 FormsCreated:=true;28 BaseWin.CreateOffscreen;29 Application.CreateForm(TMainScreen, MainScreen);30 Application.CreateForm(TCityDlg, CityDlg);31 Application.CreateForm(TModalSelectDlg, ModalSelectDlg);32 Application.CreateForm(TListDlg, ListDlg);33 Application.CreateForm(TMessgExDlg, MessgExDlg);34 Application.CreateForm(TDraftDlg, DraftDlg);35 Application.CreateForm(TCityTypeDlg, CityTypeDlg);36 Application.CreateForm(THelpDlg, HelpDlg);37 Application.CreateForm(TUnitStatDlg, UnitStatDlg);38 Application.CreateForm(TDiaDlg, DiaDlg);39 Application.CreateForm(TNatStatDlg, NatStatDlg);40 Application.CreateForm(TWondersDlg, WondersDlg);41 Application.CreateForm(TNegoDlg, NegoDlg);42 Application.CreateForm(TEnhanceDlg, EnhanceDlg);43 Application.CreateForm(TBattleDlg, BattleDlg);44 //Application.CreateForm(TAdvisorDlg, AdvisorDlg);45 Application.CreateForm(TRatesDlg, RatesDlg);46 Application.CreateForm(TTechTreeDlg, TechTreeDlg);25 FormsCreated := true; 26 BaseWin.CreateOffscreen; 27 Application.CreateForm(TMainScreen, MainScreen); 28 Application.CreateForm(TCityDlg, CityDlg); 29 Application.CreateForm(TModalSelectDlg, ModalSelectDlg); 30 Application.CreateForm(TListDlg, ListDlg); 31 Application.CreateForm(TMessgExDlg, MessgExDlg); 32 Application.CreateForm(TDraftDlg, DraftDlg); 33 Application.CreateForm(TCityTypeDlg, CityTypeDlg); 34 Application.CreateForm(THelpDlg, HelpDlg); 35 Application.CreateForm(TUnitStatDlg, UnitStatDlg); 36 Application.CreateForm(TDiaDlg, DiaDlg); 37 Application.CreateForm(TNatStatDlg, NatStatDlg); 38 Application.CreateForm(TWondersDlg, WondersDlg); 39 Application.CreateForm(TNegoDlg, NegoDlg); 40 Application.CreateForm(TEnhanceDlg, EnhanceDlg); 41 Application.CreateForm(TBattleDlg, BattleDlg); 42 // Application.CreateForm(TAdvisorDlg, AdvisorDlg); 43 Application.CreateForm(TRatesDlg, RatesDlg); 44 Application.CreateForm(TTechTreeDlg, TechTreeDlg); 47 45 end; 48 MainScreen.Client(Command,Player,Data);46 MainScreen.Client(Command, Player, Data); 49 47 end; 50 48 51 49 procedure SetAIName(p: integer; Name: string); 52 50 begin 53 MainScreen.SetAIName(p, Name);51 MainScreen.SetAIName(p, Name); 54 52 end; 55 53 56 54 initialization 57 FormsCreated:=false; 55 56 FormsCreated := false; 58 57 59 58 end. 60 -
trunk/LocalPlayer/MessgEx.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit MessgEx; 4 3 … … 6 5 7 6 uses 8 Messg, Protocol,ScreenTools,9 10 Windows, Messages,SysUtils,Classes,Graphics,Controls,Forms,ButtonA,7 Messg, Protocol, ScreenTools, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA, 11 10 ButtonB, ButtonBase, StdCtrls; 12 11 … … 18 17 RemoveBtn: TButtonB; 19 18 EInput: TEdit; 20 procedure FormCreate(Sender: TObject);21 procedure FormPaint(Sender: TObject);19 procedure FormCreate(Sender: TObject); 20 procedure FormPaint(Sender: TObject); 22 21 procedure FormShow(Sender: TObject); 23 22 procedure Button1Click(Sender: TObject); … … 30 29 Kind, IconKind, IconIndex, HelpKind, HelpNo, CenterTo: integer; 31 30 OpenSound: string; 32 function ShowModal: Integer; override;31 function ShowModal: integer; override; 33 32 procedure CancelMovie; 34 33 private 35 34 MovieCancelled: boolean; 36 procedure PaintBook(ca: TCanvas; x, y,clPage,clCover: integer);35 procedure PaintBook(ca: TCanvas; x, y, clPage, clCover: integer); 37 36 procedure PaintMyArmy; 38 37 procedure PaintEnemyArmy; 39 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND;38 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND; 40 39 end; 41 40 42 41 const 43 // extra message kinds 44 mkYesNoCancel=4; mkOkCancelRemove=5; mkOkHelp=6; mkModel=7; 45 46 47 //message icon kinds 48 mikNone=-1; mikImp=0; mikModel=1; mikTribe=2; mikBook=3; mikAge=4; 49 mikPureIcon=5; mikMyArmy=6; mikEnemyArmy=7; mikFullControl=8; mikShip=9; 50 mikBigIcon=10; mikEnemyShipComplete=11; 51 52 53 var 54 MessgExDlg:TMessgExDlg; 42 // extra message kinds 43 mkYesNoCancel = 4; 44 mkOkCancelRemove = 5; 45 mkOkHelp = 6; 46 mkModel = 7; 47 48 // message icon kinds 49 mikNone = -1; 50 mikImp = 0; 51 mikModel = 1; 52 mikTribe = 2; 53 mikBook = 3; 54 mikAge = 4; 55 mikPureIcon = 5; 56 mikMyArmy = 6; 57 mikEnemyArmy = 7; 58 mikFullControl = 8; 59 mikShip = 9; 60 mikBigIcon = 10; 61 mikEnemyShipComplete = 11; 62 63 var 64 MessgExDlg: TMessgExDlg; 55 65 56 66 procedure SoundMessageEx(SimpleText, SoundItem: string); 57 67 procedure TribeMessage(p: integer; SimpleText, SoundItem: string); 58 function SimpleQuery(QueryKind: integer; SimpleText, SoundItem: string): 59 integer; 60 procedure ContextMessage(SimpleText, SoundItem: string; ContextKind, 61 ContextNo: integer); 62 68 function SimpleQuery(QueryKind: integer; SimpleText, SoundItem: string) 69 : integer; 70 procedure ContextMessage(SimpleText, SoundItem: string; 71 ContextKind, ContextNo: integer); 63 72 64 73 implementation 65 74 66 75 uses 67 ClientTools,BaseWin,Term,Help, Select, Diplomacy, Inp, UnitStat, Tribes,68 IsoEngine,Diagram;76 ClientTools, BaseWin, Term, Help, Select, Diplomacy, Inp, UnitStat, Tribes, 77 IsoEngine, Diagram; 69 78 70 79 {$R *.DFM} 71 80 72 81 const 73 LostUnitsPerLine=6; 74 75 var 76 PerfFreq: int64; 77 78 79 procedure TMessgExDlg.FormCreate(Sender:TObject); 80 begin 81 inherited; 82 IconKind:=mikNone; 83 CenterTo:=0; 84 OpenSound:=''; 82 LostUnitsPerLine = 6; 83 84 var 85 PerfFreq: int64; 86 87 procedure TMessgExDlg.FormCreate(Sender: TObject); 88 begin 89 inherited; 90 IconKind := mikNone; 91 CenterTo := 0; 92 OpenSound := ''; 85 93 end; 86 94 87 95 procedure TMessgExDlg.FormShow(Sender: TObject); 88 96 var 89 i: integer; 90 begin 91 if IconKind=mikEnemyArmy then 92 InitAllEnemyModels; 93 94 Button1.Visible:= GameMode<>cMovie; 95 Button2.Visible:= (GameMode<>cMovie) and (Kind<>mkOk); 96 Button3.Visible:= (GameMode<>cMovie) and (Kind=mkYesNoCancel); 97 RemoveBtn.Visible:= (GameMode<>cMovie) and (Kind=mkOkCancelRemove); 98 EInput.Visible:= (GameMode<>cMovie) and (Kind=mkModel); 99 if Button3.Visible then 100 begin Button1.Left:=43; Button2.Left:=159; end 101 else if Button2.Visible then 102 begin Button1.Left:=101; Button2.Left:=217; end 103 else Button1.Left:=159; 104 RemoveBtn.Left:=ClientWidth-38; 105 case Kind of 106 mkYesNo, mkYesNoCancel: 97 i: integer; 98 begin 99 if IconKind = mikEnemyArmy then 100 InitAllEnemyModels; 101 102 Button1.Visible := GameMode <> cMovie; 103 Button2.Visible := (GameMode <> cMovie) and (Kind <> mkOk); 104 Button3.Visible := (GameMode <> cMovie) and (Kind = mkYesNoCancel); 105 RemoveBtn.Visible := (GameMode <> cMovie) and (Kind = mkOkCancelRemove); 106 EInput.Visible := (GameMode <> cMovie) and (Kind = mkModel); 107 if Button3.Visible then 108 begin 109 Button1.Left := 43; 110 Button2.Left := 159; 111 end 112 else if Button2.Visible then 113 begin 114 Button1.Left := 101; 115 Button2.Left := 217; 116 end 117 else 118 Button1.Left := 159; 119 RemoveBtn.Left := ClientWidth - 38; 120 case Kind of 121 mkYesNo, mkYesNoCancel: 122 begin 123 Button1.Caption := Phrases.Lookup('BTN_YES'); 124 Button2.Caption := Phrases.Lookup('BTN_NO') 125 end; 126 mkOKCancel, mkOkCancelRemove: 127 begin 128 Button1.Caption := Phrases.Lookup('BTN_OK'); 129 Button2.Caption := Phrases.Lookup('BTN_CANCEL'); 130 end; 131 else 107 132 begin 108 Button1.Caption:=Phrases.Lookup('BTN_YES');109 Button2.Caption:=Phrases.Lookup('BTN_NO')133 Button1.Caption := Phrases.Lookup('BTN_OK'); 134 Button2.Caption := Phrases.Lookup('BTN_INFO'); 110 135 end; 111 mkOKCancel, mkOkCancelRemove: 136 end; 137 Button3.Caption := Phrases.Lookup('BTN_CANCEL'); 138 RemoveBtn.Hint := Phrases.Lookup('BTN_DELGAME'); 139 140 case IconKind of 141 mikImp, mikModel, mikAge, mikPureIcon: 142 TopSpace := 56; 143 mikBigIcon: 144 TopSpace := 152; 145 mikEnemyShipComplete: 146 TopSpace := 136; 147 mikBook: 148 if IconIndex >= 0 then 149 TopSpace := 84 150 else 151 TopSpace := 47; 152 mikTribe: 153 begin 154 Tribe[IconIndex].InitAge(GetAge(IconIndex)); 155 if Tribe[IconIndex].faceHGr >= 0 then 156 TopSpace := 64 157 end; 158 mikFullControl: 159 TopSpace := 80; 160 mikShip: 161 TopSpace := 240; 162 else 163 TopSpace := 0; 164 end; 165 166 SplitText(true); 167 ClientHeight := 72 + Border + TopSpace + Lines * MessageLineSpacing; 168 if GameMode = cMovie then 169 ClientHeight := ClientHeight - 32; 170 if Kind = mkModel then 171 ClientHeight := ClientHeight + 36; 172 if IconKind in [mikMyArmy, mikEnemyArmy] then 173 begin 174 if nLostArmy > LostUnitsPerLine * 6 then 175 ClientHeight := ClientHeight + 6 * 48 176 else 177 ClientHeight := ClientHeight + ((nLostArmy - 1) div LostUnitsPerLine 178 + 1) * 48; 179 end; 180 case CenterTo of 181 0: 182 begin 183 Left := (Screen.Width - ClientWidth) div 2; 184 Top := (Screen.Height - ClientHeight) div 2 - MapCenterUp; 185 end; 186 1: 187 begin 188 Left := (Screen.Width - ClientWidth) div 4; 189 Top := (Screen.Height - ClientHeight) * 2 div 3 - MapCenterUp; 190 end; 191 -1: 192 begin 193 Left := (Screen.Width - ClientWidth) div 4; 194 Top := (Screen.Height - ClientHeight) div 3 - MapCenterUp; 195 end; 196 end; 197 for i := 0 to ControlCount - 1 do 198 Controls[i].Top := ClientHeight - (34 + Border); 199 if Kind = mkModel then 200 EInput.Top := ClientHeight - (76 + Border); 201 end; 202 203 function TMessgExDlg.ShowModal: integer; 204 var 205 Ticks0, Ticks: int64; 206 begin 207 if GameMode = cMovie then 208 begin 209 if not((GameMode = cMovie) and (MovieSpeed = 4)) then 112 210 begin 113 Button1.Caption:=Phrases.Lookup('BTN_OK'); 114 Button2.Caption:=Phrases.Lookup('BTN_CANCEL'); 211 MovieCancelled := false; 212 Show; 213 QueryPerformanceCounter(Ticks0); 214 repeat 215 Application.ProcessMessages; 216 Sleep(1); 217 QueryPerformanceCounter(Ticks); 218 until MovieCancelled or ((Ticks - Ticks0) * 1000 >= 1500 * PerfFreq); 219 Hide; 115 220 end; 116 else 221 result := mrOk; 222 end 223 else 224 result := inherited ShowModal; 225 end; 226 227 procedure TMessgExDlg.CancelMovie; 228 begin 229 MovieCancelled := true; 230 end; 231 232 procedure TMessgExDlg.PaintBook(ca: TCanvas; x, y, clPage, clCover: integer); 233 const 234 xScrewed = 77; 235 yScrewed = 10; 236 wScrewed = 43; 237 hScrewed = 27; 238 type 239 TLine = array [0 .. 9999, 0 .. 2] of Byte; 240 var 241 ix, iy, xDst, yDst, dx, dy, xIcon, yIcon, xb, yb, wb, hb: integer; 242 x1, xR, yR, share: single; 243 Screwed: array [0 .. wScrewed - 1, 0 .. hScrewed - 1, 0 .. 3] of single; 244 SrcLine: ^TLine; 245 246 begin 247 if IconIndex >= 0 then 248 begin 249 xIcon := IconIndex mod 7 * xSizeBig; 250 yIcon := (IconIndex + SystemIconLines * 7) div 7 * ySizeBig; 251 // prepare screwed icon 252 fillchar(Screwed, sizeof(Screwed), 0); 253 for iy := 0 to 39 do 117 254 begin 118 Button1.Caption:=Phrases.Lookup('BTN_OK'); 119 Button2.Caption:=Phrases.Lookup('BTN_INFO'); 255 SrcLine := BigImp.ScanLine[iy + yIcon]; 256 for ix := 0 to 55 do 257 begin 258 xR := ix * (37 + iy * 5 / 40) / 56; 259 xDst := Trunc(xR); 260 xR := Frac(xR); 261 x1 := (120 - ix) * (120 - ix) - 10000; 262 yR := iy * 18 / 40 + x1 * x1 / 4000000; 263 yDst := Trunc(yR); 264 yR := Frac(yR); 265 for dx := 0 to 1 do 266 for dy := 0 to 1 do 267 begin 268 if dx = 0 then 269 share := 1 - xR 270 else 271 share := xR; 272 if dy = 0 then 273 share := share * (1 - yR) 274 else 275 share := share * yR; 276 Screwed[xDst + dx, yDst + dy, 0] := Screwed[xDst + dx, yDst + dy, 0] 277 + share * SrcLine[ix + xIcon, 0]; 278 Screwed[xDst + dx, yDst + dy, 1] := Screwed[xDst + dx, yDst + dy, 1] 279 + share * SrcLine[ix + xIcon, 1]; 280 Screwed[xDst + dx, yDst + dy, 2] := Screwed[xDst + dx, yDst + dy, 2] 281 + share * SrcLine[ix + xIcon, 2]; 282 Screwed[xDst + dx, yDst + dy, 3] := Screwed[xDst + dx, yDst + dy, 283 3] + share; 284 end 285 end; 120 286 end; 121 end; 122 Button3.Caption:=Phrases.Lookup('BTN_CANCEL'); 123 RemoveBtn.Hint:=Phrases.Lookup('BTN_DELGAME'); 124 125 case IconKind of 126 mikImp,mikModel,mikAge,mikPureIcon: 127 TopSpace:=56; 128 mikBigIcon: 129 TopSpace:=152; 130 mikEnemyShipComplete: 131 TopSpace:=136; 132 mikBook: 133 if IconIndex>=0 then TopSpace:=84 134 else TopSpace:=47; 135 mikTribe: 287 xb := xBBook; 288 yb := yBBook; 289 wb := wBBook; 290 hb := hBBook; 291 end 292 else 293 begin 294 xb := xSBook; 295 yb := ySBook; 296 wb := wSBook; 297 hb := hSBook; 298 end; 299 x := x - wb div 2; 300 301 // paint 302 BitBlt(LogoBuffer.Canvas.Handle, 0, 0, wb, hb, ca.Handle, x, y, SRCCOPY); 303 304 if IconIndex >= 0 then 305 for iy := 0 to hScrewed - 1 do 306 for ix := 0 to wScrewed - 1 do 307 if Screwed[ix, iy, 3] > 0.01 then 308 LogoBuffer.Canvas.Pixels[xScrewed + ix, yScrewed + iy] := 309 Trunc(Screwed[ix, iy, 2] / Screwed[ix, iy, 3]) + 310 Trunc(Screwed[ix, iy, 1] / Screwed[ix, iy, 3]) shl 8 + 311 Trunc(Screwed[ix, iy, 0] / Screwed[ix, iy, 3]) shl 16; 312 313 ImageOp_BCC(LogoBuffer, Templates, 0, 0, xb, yb, wb, hb, clCover, clPage); 314 315 BitBlt(ca.Handle, x, y, wb, hb, LogoBuffer.Canvas.Handle, 0, 0, SRCCOPY); 316 end; 317 318 procedure TMessgExDlg.PaintMyArmy; 319 begin 320 end; 321 322 procedure TMessgExDlg.PaintEnemyArmy; 323 var 324 emix, ix, iy, x, y, count, UnitsInLine: integer; 325 begin 326 ix := 0; 327 iy := 0; 328 if nLostArmy > LostUnitsPerLine then 329 UnitsInLine := LostUnitsPerLine 330 else 331 UnitsInLine := nLostArmy; 332 for emix := 0 to MyRO.nEnemyModel - 1 do 333 for count := 0 to LostArmy[emix] - 1 do 136 334 begin 137 Tribe[IconIndex].InitAge(GetAge(IconIndex)); 138 if Tribe[IconIndex].faceHGr>=0 then 139 TopSpace:=64 140 end; 141 mikFullControl: 142 TopSpace:=80; 143 mikShip: 144 TopSpace:=240; 145 else TopSpace:=0; 146 end; 147 148 SplitText(true); 149 ClientHeight:=72+Border+TopSpace+Lines*MessageLineSpacing; 150 if GameMode=cMovie then ClientHeight:=ClientHeight-32; 151 if Kind=mkModel then 152 ClientHeight:=ClientHeight+36; 153 if IconKind in [mikMyArmy,mikEnemyArmy] then 154 begin 155 if nLostArmy>LostUnitsPerLine*6 then ClientHeight:=ClientHeight+6*48 156 else ClientHeight:=ClientHeight+((nLostArmy-1) div LostUnitsPerLine +1)*48; 157 end; 158 case CenterTo of 159 0: 160 begin 161 Left:=(Screen.Width-ClientWidth) div 2; 162 Top:=(Screen.Height-ClientHeight) div 2-MapCenterUp; 163 end; 164 1: 165 begin 166 Left:=(Screen.Width-ClientWidth) div 4; 167 Top:=(Screen.Height-ClientHeight)*2 div 3-MapCenterUp; 168 end; 169 -1: 170 begin 171 Left:=(Screen.Width-ClientWidth) div 4; 172 Top:=(Screen.Height-ClientHeight) div 3-MapCenterUp; 173 end; 174 end; 175 for i:=0 to ControlCount-1 do 176 Controls[i].Top:=ClientHeight-(34+Border); 177 if Kind=mkModel then 178 EInput.Top:=ClientHeight-(76+Border); 179 end; 180 181 function TMessgExDlg.ShowModal: Integer; 182 var 183 Ticks0,Ticks: int64; 184 begin 185 if GameMode=cMovie then 186 begin 187 if not ((GameMode=cMovie) and (MovieSpeed=4)) then 188 begin 189 MovieCancelled:=false; 190 Show; 191 QueryPerformanceCounter(Ticks0); 192 repeat 193 Application.ProcessMessages; 194 Sleep(1); 195 QueryPerformanceCounter(Ticks); 196 until MovieCancelled or ((Ticks-Ticks0)*1000>=1500*PerfFreq); 197 Hide; 198 end; 199 result:=mrOk; 200 end 201 else 202 result:=inherited ShowModal; 203 end; 204 205 procedure TMessgExDlg.CancelMovie; 206 begin 207 MovieCancelled:=true; 208 end; 209 210 procedure TMessgExDlg.PaintBook(ca: TCanvas; x,y,clPage,clCover: integer); 211 const 212 xScrewed=77; yScrewed=10; wScrewed=43; hScrewed=27; 213 type 214 TLine=array[0..9999,0..2] of Byte; 215 var 216 ix,iy,xDst,yDst,dx,dy,xIcon,yIcon,xb,yb,wb,hb: integer; 217 x1,xR,yR,share: single; 218 Screwed: array[0..wScrewed-1,0..hScrewed-1,0..3] of single; 219 SrcLine: ^TLine; 220 221 begin 222 if IconIndex>=0 then 223 begin 224 xIcon:=IconIndex mod 7*xSizeBig; 225 yIcon:=(IconIndex+SystemIconLines*7) div 7*ySizeBig; 226 // prepare screwed icon 227 fillchar(Screwed,sizeof(Screwed),0); 228 for iy:=0 to 39 do 229 begin 230 SrcLine:=BigImp.ScanLine[iy+yIcon]; 231 for ix:=0 to 55 do 232 begin 233 xR:=ix*(37+iy*5/40)/56; 234 xDst:=Trunc(xR); 235 xR:=Frac(xR); 236 x1:=(120-ix)*(120-ix)-10000; 237 yR:=iy*18/40 +x1*x1/4000000; 238 yDst:=Trunc(yR); 239 yR:=Frac(yR); 240 for dx:=0 to 1 do for dy:=0 to 1 do 241 begin 242 if dx=0 then share:=1-xR else share:=xR; 243 if dy=0 then share:=share*(1-yR) else share:=share*yR; 244 Screwed[xDst+dx,yDst+dy,0]:= 245 Screwed[xDst+dx,yDst+dy,0]+share*SrcLine[ix+xIcon,0]; 246 Screwed[xDst+dx,yDst+dy,1]:= 247 Screwed[xDst+dx,yDst+dy,1]+share*SrcLine[ix+xIcon,1]; 248 Screwed[xDst+dx,yDst+dy,2]:= 249 Screwed[xDst+dx,yDst+dy,2]+share*SrcLine[ix+xIcon,2]; 250 Screwed[xDst+dx,yDst+dy,3]:= 251 Screwed[xDst+dx,yDst+dy,3]+share; 252 end 253 end; 254 end; 255 xb:=xBBook; yb:=yBBook; wb:=wBBook; hb:=hBBook; 256 end 257 else begin xb:=xSBook; yb:=ySBook; wb:=wSBook; hb:=hSBook; end; 258 x:=x-wb div 2; 259 260 // paint 261 BitBlt(LogoBuffer.Canvas.Handle,0,0,wb,hb,ca.handle,x,y,SRCCOPY); 262 263 if IconIndex>=0 then 264 for iy:=0 to hScrewed-1 do for ix:=0 to wScrewed-1 do 265 if Screwed[ix,iy,3]>0.01 then 266 LogoBuffer.Canvas.Pixels[xScrewed+ix,yScrewed+iy]:= 267 trunc(Screwed[ix,iy,2]/Screwed[ix,iy,3]) 268 +trunc(Screwed[ix,iy,1]/Screwed[ix,iy,3]) shl 8 269 +trunc(Screwed[ix,iy,0]/Screwed[ix,iy,3]) shl 16; 270 271 ImageOp_BCC(LogoBuffer,Templates,0,0,xb,yb,wb,hb,clCover,clPage); 272 273 BitBlt(ca.handle,x,y,wb,hb,LogoBuffer.Canvas.Handle,0,0,SRCCOPY); 274 end; 275 276 procedure TMessgExDlg.PaintMyArmy; 277 begin 278 end; 279 280 procedure TMessgExDlg.PaintEnemyArmy; 281 var 282 emix,ix,iy,x,y,count,UnitsInLine: integer; 283 begin 284 ix:=0; 285 iy:=0; 286 if nLostArmy>LostUnitsPerLine then 287 UnitsInLine:=LostUnitsPerLine 288 else UnitsInLine:=nLostArmy; 289 for emix:=0 to MyRO.nEnemyModel-1 do 290 for count:=0 to LostArmy[emix]-1 do 291 begin 292 x:=ClientWidth div 2+ix*64-UnitsInLine*32; 293 y:=26+Border+TopSpace+Lines*MessageLineSpacing+iy*48; 294 with MyRO.EnemyModel[emix],Tribe[Owner].ModelPicture[mix] do 295 begin 296 BitBlt(Canvas.Handle,x,y,64,48,GrExt[HGr].Mask.Canvas.Handle, 297 pix mod 10 *65+1,pix div 10 *49+1,SRCAND); 298 BitBlt(Canvas.Handle,x,y,64,48,GrExt[HGr].Data.Canvas.Handle, 299 pix mod 10 *65+1,pix div 10 *49+1,SRCPAINT); 300 end; 301 302 // next position 303 inc(ix); 304 if ix=LostUnitsPerLine then 335 x := ClientWidth div 2 + ix * 64 - UnitsInLine * 32; 336 y := 26 + Border + TopSpace + Lines * MessageLineSpacing + iy * 48; 337 with MyRO.EnemyModel[emix], Tribe[Owner].ModelPicture[mix] do 338 begin 339 BitBlt(Canvas.Handle, x, y, 64, 48, GrExt[HGr].Mask.Canvas.Handle, 340 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCAND); 341 BitBlt(Canvas.Handle, x, y, 64, 48, GrExt[HGr].Data.Canvas.Handle, 342 pix mod 10 * 65 + 1, pix div 10 * 49 + 1, SRCPAINT); 343 end; 344 345 // next position 346 inc(ix); 347 if ix = LostUnitsPerLine then 305 348 begin // next line 306 ix:=0;307 inc(iy);308 if iy=6 then309 exit;310 UnitsInLine:=nLostArmy-LostUnitsPerLine*iy;311 if UnitsInLine>LostUnitsPerLine then312 UnitsInLine:=LostUnitsPerLine;349 ix := 0; 350 inc(iy); 351 if iy = 6 then 352 exit; 353 UnitsInLine := nLostArmy - LostUnitsPerLine * iy; 354 if UnitsInLine > LostUnitsPerLine then 355 UnitsInLine := LostUnitsPerLine; 313 356 end 314 357 end; 315 358 end; 316 359 317 procedure TMessgExDlg.FormPaint(Sender: TObject);318 var 319 p1,clSaveTextLight,clSaveTextShade: integer;320 begin 321 if (IconKind=mikImp) and (IconIndex=27) then360 procedure TMessgExDlg.FormPaint(Sender: TObject); 361 var 362 p1, clSaveTextLight, clSaveTextShade: integer; 363 begin 364 if (IconKind = mikImp) and (IconIndex = 27) then 322 365 begin // "YOU WIN" message 323 clSaveTextLight:=MainTexture.clTextLight; 324 clSaveTextShade:=MainTexture.clTextShade; 325 MainTexture.clTextLight:=$000000; // gold 326 MainTexture.clTextShade:=$0FDBFF; 327 inherited; 328 MainTexture.clTextLight:=clSaveTextLight; 329 MainTexture.clTextShade:=clSaveTextShade; 330 end 331 else 332 inherited; 333 334 case IconKind of 335 mikImp: 336 if Imp[IconIndex].Kind=ikWonder then 337 begin 338 p1:=MyRO.Wonder[IconIndex].EffectiveOwner; 339 BitBlt(Buffer.Canvas.Handle,0,0,xSizeBig+2*GlowRange,ySizeBig+2*GlowRange, 340 Canvas.Handle,ClientWidth div 2-(28+GlowRange),24-GlowRange,SRCCOPY); 341 BitBlt(Buffer.Canvas.Handle,GlowRange,GlowRange,xSizeBig,ySizeBig, 342 BigImp.Canvas.Handle,IconIndex mod 7*xSizeBig, 343 (IconIndex+SystemIconLines*7) div 7*ySizeBig,SRCCOPY); 344 if p1<0 then 345 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, $000000) 346 else GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, 347 Tribe[p1].Color); 348 BitBlt(Canvas.Handle,ClientWidth div 2-(28+GlowRange),24-GlowRange, 349 xSizeBig+2*GlowRange,ySizeBig+2*GlowRange,Buffer.Canvas.Handle,0,0, 350 SRCCOPY); 366 clSaveTextLight := MainTexture.clTextLight; 367 clSaveTextShade := MainTexture.clTextShade; 368 MainTexture.clTextLight := $000000; // gold 369 MainTexture.clTextShade := $0FDBFF; 370 inherited; 371 MainTexture.clTextLight := clSaveTextLight; 372 MainTexture.clTextShade := clSaveTextShade; 373 end 374 else 375 inherited; 376 377 case IconKind of 378 mikImp: 379 if Imp[IconIndex].Kind = ikWonder then 380 begin 381 p1 := MyRO.Wonder[IconIndex].EffectiveOwner; 382 BitBlt(Buffer.Canvas.Handle, 0, 0, xSizeBig + 2 * GlowRange, 383 ySizeBig + 2 * GlowRange, Canvas.Handle, 384 ClientWidth div 2 - (28 + GlowRange), 24 - GlowRange, SRCCOPY); 385 BitBlt(Buffer.Canvas.Handle, GlowRange, GlowRange, xSizeBig, ySizeBig, 386 BigImp.Canvas.Handle, IconIndex mod 7 * xSizeBig, 387 (IconIndex + SystemIconLines * 7) div 7 * ySizeBig, SRCCOPY); 388 if p1 < 0 then 389 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, $000000) 390 else 391 GlowFrame(Buffer, GlowRange, GlowRange, xSizeBig, ySizeBig, 392 Tribe[p1].Color); 393 BitBlt(Canvas.Handle, ClientWidth div 2 - (28 + GlowRange), 394 24 - GlowRange, xSizeBig + 2 * GlowRange, ySizeBig + 2 * GlowRange, 395 Buffer.Canvas.Handle, 0, 0, SRCCOPY); 351 396 end 352 else ImpImage(Canvas,ClientWidth div 2-28,24,IconIndex); 353 mikAge: 354 begin 355 if IconIndex=0 then 356 ImpImage(Canvas,ClientWidth div 2-28,24,-7) 357 else ImpImage(Canvas,ClientWidth div 2-28,24,24+IconIndex) 358 end; 359 mikModel: 360 with Tribe[me].ModelPicture[IconIndex] do 361 begin 362 FrameImage(Canvas,BigImp,ClientWidth div 2-28,24,xSizeBig,ySizeBig,0,0); 363 BitBlt(Canvas.Handle,ClientWidth div 2-32,20,64,44, 364 GrExt[HGr].Mask.Canvas.Handle,pix mod 10 *65+1,pix div 10*49+1,SRCAND); 365 BitBlt(Canvas.Handle,ClientWidth div 2-32,20,64,44, 366 GrExt[HGr].Data.Canvas.Handle,pix mod 10 *65+1,pix div 10*49+1,SRCPAINT); 367 end; 368 mikBook: 369 PaintBook(Canvas,ClientWidth div 2,24,MainTexture.clPage,MainTexture.clCover); 370 mikTribe: 371 if Tribe[IconIndex].faceHGr>=0 then 372 begin 373 Frame(Canvas,ClientWidth div 2-32-1,24-1,ClientWidth div 2+32, 374 24+48,$000000,$000000); 375 BitBlt(Canvas.Handle,ClientWidth div 2-32,24,64,48, 376 GrExt[Tribe[IconIndex].faceHGr].Data.Canvas.Handle, 377 1+Tribe[IconIndex].facepix mod 10 *65, 378 1+Tribe[IconIndex].facepix div 10 *49, SRCCOPY) 379 end; 380 mikPureIcon: 381 FrameImage(Canvas, BigImp, ClientWidth div 2-28,24,xSizeBig, ySizeBig, 382 IconIndex mod 7*xSizeBig, 383 IconIndex div 7*ySizeBig); 384 mikBigIcon: 385 FrameImage(Canvas, BigImp, ClientWidth div 2-3*28,32,xSizeBig*3, ySizeBig*3, 386 IconIndex mod 2*3*xSizeBig, 387 IconIndex div 2*3*ySizeBig); 388 mikEnemyShipComplete: 389 begin 390 BitBlt(Buffer.Canvas.Handle,0,0,140,120,Canvas.Handle, 391 (ClientWidth-140) div 2,24,SRCCOPY); 392 ImageOp_BCC(Buffer,Templates,0,0,1,279,140,120,0,$FFFFFF); 393 BitBlt(Canvas.Handle,(ClientWidth-140) div 2,24,140, 394 120,Buffer.Canvas.Handle,0,0,SRCCOPY); 395 end; 396 mikMyArmy: 397 PaintMyArmy; 398 mikEnemyArmy: 399 PaintEnemyArmy; 400 mikFullControl: 401 Sprite(Canvas,HGrSystem2,ClientWidth div 2-31,24,63,63,1,281); 402 mikShip: 403 PaintColonyShip(Canvas,IconIndex,17,ClientWidth-34,38); 404 end; 405 406 if EInput.Visible then EditFrame(Canvas,EInput.BoundsRect,MainTexture); 407 408 if OpenSound<>'' then PostMessage(Handle, WM_PLAYSOUND, 0, 0); 409 end; {FormPaint} 397 else 398 ImpImage(Canvas, ClientWidth div 2 - 28, 24, IconIndex); 399 mikAge: 400 begin 401 if IconIndex = 0 then 402 ImpImage(Canvas, ClientWidth div 2 - 28, 24, -7) 403 else 404 ImpImage(Canvas, ClientWidth div 2 - 28, 24, 24 + IconIndex) 405 end; 406 mikModel: 407 with Tribe[me].ModelPicture[IconIndex] do 408 begin 409 FrameImage(Canvas, BigImp, ClientWidth div 2 - 28, 24, xSizeBig, 410 ySizeBig, 0, 0); 411 BitBlt(Canvas.Handle, ClientWidth div 2 - 32, 20, 64, 44, 412 GrExt[HGr].Mask.Canvas.Handle, pix mod 10 * 65 + 1, 413 pix div 10 * 49 + 1, SRCAND); 414 BitBlt(Canvas.Handle, ClientWidth div 2 - 32, 20, 64, 44, 415 GrExt[HGr].Data.Canvas.Handle, pix mod 10 * 65 + 1, 416 pix div 10 * 49 + 1, SRCPAINT); 417 end; 418 mikBook: 419 PaintBook(Canvas, ClientWidth div 2, 24, MainTexture.clPage, 420 MainTexture.clCover); 421 mikTribe: 422 if Tribe[IconIndex].faceHGr >= 0 then 423 begin 424 Frame(Canvas, ClientWidth div 2 - 32 - 1, 24 - 1, 425 ClientWidth div 2 + 32, 24 + 48, $000000, $000000); 426 BitBlt(Canvas.Handle, ClientWidth div 2 - 32, 24, 64, 48, 427 GrExt[Tribe[IconIndex].faceHGr].Data.Canvas.Handle, 428 1 + Tribe[IconIndex].facepix mod 10 * 65, 429 1 + Tribe[IconIndex].facepix div 10 * 49, SRCCOPY) 430 end; 431 mikPureIcon: 432 FrameImage(Canvas, BigImp, ClientWidth div 2 - 28, 24, xSizeBig, ySizeBig, 433 IconIndex mod 7 * xSizeBig, IconIndex div 7 * ySizeBig); 434 mikBigIcon: 435 FrameImage(Canvas, BigImp, ClientWidth div 2 - 3 * 28, 32, xSizeBig * 3, 436 ySizeBig * 3, IconIndex mod 2 * 3 * xSizeBig, 437 IconIndex div 2 * 3 * ySizeBig); 438 mikEnemyShipComplete: 439 begin 440 BitBlt(Buffer.Canvas.Handle, 0, 0, 140, 120, Canvas.Handle, 441 (ClientWidth - 140) div 2, 24, SRCCOPY); 442 ImageOp_BCC(Buffer, Templates, 0, 0, 1, 279, 140, 120, 0, $FFFFFF); 443 BitBlt(Canvas.Handle, (ClientWidth - 140) div 2, 24, 140, 120, 444 Buffer.Canvas.Handle, 0, 0, SRCCOPY); 445 end; 446 mikMyArmy: 447 PaintMyArmy; 448 mikEnemyArmy: 449 PaintEnemyArmy; 450 mikFullControl: 451 Sprite(Canvas, HGrSystem2, ClientWidth div 2 - 31, 24, 63, 63, 1, 281); 452 mikShip: 453 PaintColonyShip(Canvas, IconIndex, 17, ClientWidth - 34, 38); 454 end; 455 456 if EInput.Visible then 457 EditFrame(Canvas, EInput.BoundsRect, MainTexture); 458 459 if OpenSound <> '' then 460 PostMessage(Handle, WM_PLAYSOUND, 0, 0); 461 end; { FormPaint } 410 462 411 463 procedure TMessgExDlg.Button1Click(Sender: TObject); 412 464 begin 413 ModalResult:=mrOK;465 ModalResult := mrOk; 414 466 end; 415 467 416 468 procedure TMessgExDlg.Button2Click(Sender: TObject); 417 469 begin 418 if Kind=mkOkHelp then 419 HelpDlg.ShowNewContent(wmSubmodal, HelpKind, HelpNo) 420 else if Kind=mkModel then 421 UnitStatDlg.ShowNewContent_OwnModel(wmSubmodal, IconIndex) 422 else ModalResult:=mrIgnore; 470 if Kind = mkOkHelp then 471 HelpDlg.ShowNewContent(wmSubmodal, HelpKind, HelpNo) 472 else if Kind = mkModel then 473 UnitStatDlg.ShowNewContent_OwnModel(wmSubmodal, IconIndex) 474 else 475 ModalResult := mrIgnore; 423 476 end; 424 477 425 478 procedure TMessgExDlg.Button3Click(Sender: TObject); 426 479 begin 427 ModalResult:=mrCancel480 ModalResult := mrCancel 428 481 end; 429 482 430 483 procedure TMessgExDlg.RemoveBtnClick(Sender: TObject); 431 484 begin 432 ModalResult:=mrNo485 ModalResult := mrNo 433 486 end; 434 487 435 488 procedure TMessgExDlg.FormKeyPress(Sender: TObject; var Key: char); 436 489 begin 437 if Key=#13 then ModalResult:=mrOK 438 else if (Key=#27) then 439 if Button3.Visible then ModalResult:=mrCancel 440 else if Button2.Visible then ModalResult:=mrIgnore 490 if Key = #13 then 491 ModalResult := mrOk 492 else if (Key = #27) then 493 if Button3.Visible then 494 ModalResult := mrCancel 495 else if Button2.Visible then 496 ModalResult := mrIgnore 441 497 end; 442 498 … … 444 500 // because Messg.SoundMessage not capable of movie mode 445 501 begin 446 with MessgExDlg do447 begin 448 MessgText:=SimpleText;449 OpenSound:=SoundItem;450 Kind:=mkOK;451 ShowModal;502 with MessgExDlg do 503 begin 504 MessgText := SimpleText; 505 OpenSound := SoundItem; 506 Kind := mkOk; 507 ShowModal; 452 508 end 453 509 end; … … 455 511 procedure TribeMessage(p: integer; SimpleText, SoundItem: string); 456 512 begin 457 with MessgExDlg do458 begin 459 OpenSound:=SoundItem;460 MessgText:=SimpleText;461 Kind:=mkOK;462 IconKind:=mikTribe;463 IconIndex:=p;464 ShowModal;465 end; 466 end; 467 468 function SimpleQuery(QueryKind: integer; SimpleText, SoundItem: string) :469 integer;470 begin 471 with MessgExDlg do472 begin 473 MessgText:=SimpleText;474 OpenSound:=SoundItem;475 Kind:=QueryKind;476 ShowModal;477 result:=ModalResult478 end 479 end; 480 481 procedure ContextMessage(SimpleText, SoundItem: string; ContextKind,482 Context No: integer);483 begin 484 with MessgExDlg do485 begin 486 MessgText:=SimpleText;487 OpenSound:=SoundItem;488 Kind:=mkOkHelp;489 HelpKind:=ContextKind;490 HelpNo:=ContextNo;491 ShowModal;513 with MessgExDlg do 514 begin 515 OpenSound := SoundItem; 516 MessgText := SimpleText; 517 Kind := mkOk; 518 IconKind := mikTribe; 519 IconIndex := p; 520 ShowModal; 521 end; 522 end; 523 524 function SimpleQuery(QueryKind: integer; SimpleText, SoundItem: string) 525 : integer; 526 begin 527 with MessgExDlg do 528 begin 529 MessgText := SimpleText; 530 OpenSound := SoundItem; 531 Kind := QueryKind; 532 ShowModal; 533 result := ModalResult 534 end 535 end; 536 537 procedure ContextMessage(SimpleText, SoundItem: string; 538 ContextKind, ContextNo: integer); 539 begin 540 with MessgExDlg do 541 begin 542 MessgText := SimpleText; 543 OpenSound := SoundItem; 544 Kind := mkOkHelp; 545 HelpKind := ContextKind; 546 HelpNo := ContextNo; 547 ShowModal; 492 548 end 493 549 end; … … 495 551 procedure TMessgExDlg.FormClose(Sender: TObject; var Action: TCloseAction); 496 552 begin 497 IconKind:=mikNone; 498 CenterTo:=0; 499 end; 500 501 procedure TMessgExDlg.OnPlaySound(var Msg:TMessage); 502 begin 503 Play(OpenSound); 504 OpenSound:=''; 505 end; 506 553 IconKind := mikNone; 554 CenterTo := 0; 555 end; 556 557 procedure TMessgExDlg.OnPlaySound(var Msg: TMessage); 558 begin 559 Play(OpenSound); 560 OpenSound := ''; 561 end; 507 562 508 563 initialization 564 509 565 QueryPerformanceFrequency(PerfFreq); 510 566 511 567 end. 512 -
trunk/LocalPlayer/NatStat.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit NatStat; 4 3 … … 6 5 7 6 uses 8 Protocol, ClientTools,Term,ScreenTools,BaseWin,7 Protocol, ClientTools, Term, ScreenTools, BaseWin, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 12 11 13 12 type 14 PEnemyReport =^TEnemyReport;13 PEnemyReport = ^TEnemyReport; 15 14 16 15 TNatStatDlg = class(TBufferedDrawDlg) … … 28 27 procedure ToggleBtnClick(Sender: TObject); 29 28 procedure PlayerClick(Sender: TObject); 30 procedure FormKeyDown(Sender: TObject; var Key: word; 31 Shift: TShiftState); 29 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 32 30 procedure FormDestroy(Sender: TObject); 33 31 procedure ScrollUpBtnClick(Sender: TObject); … … 45 43 private 46 44 pView, AgePrepared, LinesDown: integer; 47 SelfReport, CurrentReport: PEnemyReport;48 ShowContact, ContactEnabled: boolean;45 SelfReport, CurrentReport: PEnemyReport; 46 ShowContact, ContactEnabled: boolean; 49 47 Back, Template: TBitmap; 50 48 ReportText: TStringList; … … 55 53 NatStatDlg: TNatStatDlg; 56 54 57 58 55 implementation 59 56 … … 61 58 62 59 uses 63 Diagram, Select,Messg,MessgEx, Help,Tribes,Directories;60 Diagram, Select, Messg, MessgEx, Help, Tribes, Directories; 64 61 65 62 const 66 xIcon=326; yIcon=49; 67 xAttrib=96; yAttrib=40; 68 xRelation=16; yRelation=110; 69 PaperShade=3; 70 ReportLines=12; 71 LineSpacing=22; 72 xReport=24; yReport=165; wReport=352; hReport=ReportLines*LineSpacing; 73 63 xIcon = 326; 64 yIcon = 49; 65 xAttrib = 96; 66 yAttrib = 40; 67 xRelation = 16; 68 yRelation = 110; 69 PaperShade = 3; 70 ReportLines = 12; 71 LineSpacing = 22; 72 xReport = 24; 73 yReport = 165; 74 wReport = 352; 75 hReport = ReportLines * LineSpacing; 74 76 75 77 procedure TNatStatDlg.FormCreate(Sender: TObject); 76 78 begin 77 inherited; 78 AgePrepared:=-2; 79 GetMem(SelfReport,SizeOf(TEnemyReport)-2*(INFIN+1)); 80 ReportText:=TStringList.Create; 81 InitButtons(); 82 ContactBtn.Template:=Templates; 83 HelpContext:='DIPLOMACY'; 84 ToggleBtn.Hint:=Phrases.Lookup('BTN_SELECT'); 85 ContactBtn.Hint:=Phrases.Lookup('BTN_DIALOG'); 86 87 Back:=TBitmap.Create; 88 Back.PixelFormat:=pf24bit; 89 Back.Width:=ClientWidth; Back.Height:=ClientHeight; 90 Template:=TBitmap.Create; 91 LoadGraphicFile(Template, HomeDir+'Graphics\Nation', gfNoGamma); 92 Template.PixelFormat:=pf8bit; 79 inherited; 80 AgePrepared := -2; 81 GetMem(SelfReport, SizeOf(TEnemyReport) - 2 * (INFIN + 1)); 82 ReportText := TStringList.Create; 83 InitButtons(); 84 ContactBtn.Template := Templates; 85 HelpContext := 'DIPLOMACY'; 86 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT'); 87 ContactBtn.Hint := Phrases.Lookup('BTN_DIALOG'); 88 89 Back := TBitmap.Create; 90 Back.PixelFormat := pf24bit; 91 Back.Width := ClientWidth; 92 Back.Height := ClientHeight; 93 Template := TBitmap.Create; 94 LoadGraphicFile(Template, HomeDir + 'Graphics\Nation', gfNoGamma); 95 Template.PixelFormat := pf8bit; 93 96 end; 94 97 95 98 procedure TNatStatDlg.FormDestroy(Sender: TObject); 96 99 begin 97 ReportText.Free;98 FreeMem(SelfReport);99 Template.Free;100 Back.Free;100 ReportText.Free; 101 FreeMem(SelfReport); 102 Template.Free; 103 Back.Free; 101 104 end; 102 105 103 106 procedure TNatStatDlg.CheckAge; 104 107 begin 105 if MainTextureAge<>AgePrepared then106 begin 107 AgePrepared:=MainTextureAge;108 bitblt(Back.Canvas.Handle,0,0,ClientWidth,ClientHeight,109 MainTexture.Image.Canvas.Handle,(wMainTexture-ClientWidth) div 2,110 (hMainTexture-ClientHeight) div 2,SRCCOPY);111 ImageOp_B(Back,Template,0,0,0,0,ClientWidth,ClientHeight);108 if MainTextureAge <> AgePrepared then 109 begin 110 AgePrepared := MainTextureAge; 111 bitblt(Back.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 112 MainTexture.Image.Canvas.Handle, (wMainTexture - ClientWidth) div 2, 113 (hMainTexture - ClientHeight) div 2, SRCCOPY); 114 ImageOp_B(Back, Template, 0, 0, 0, 0, ClientWidth, ClientHeight); 112 115 end 113 116 end; … … 115 118 procedure TNatStatDlg.FormShow(Sender: TObject); 116 119 begin 117 if pView=me then 118 begin 119 SelfReport.TurnOfCivilReport:=MyRO.Turn; 120 SelfReport.TurnOfMilReport:=MyRO.Turn; 121 move(MyRO.Treaty, SelfReport.Treaty, sizeof(SelfReport.Treaty)); 122 SelfReport.Government:=MyRO.Government; 123 SelfReport.Money:=MyRO.Money; 124 CurrentReport:=pointer(SelfReport); 125 end 126 else CurrentReport:=pointer(MyRO.EnemyReport[pView]); 127 if CurrentReport.TurnOfCivilReport>=0 then 128 GenerateReportText; 129 ShowContact:= (pView<>me) and (not supervising or (me<>0)); 130 ContactEnabled:= ShowContact and not supervising 131 and (1 shl pView and MyRO.Alive<>0); 132 ContactBtn.Visible:=ContactEnabled and (MyRO.Happened and phGameEnd=0) 133 and (ClientMode<scContact); 134 ScrollUpBtn.Visible:=(CurrentReport.TurnOfCivilReport>=0) 135 and (ReportText.Count>ReportLines); 136 ScrollDownBtn.Visible:=(CurrentReport.TurnOfCivilReport>=0) 137 and (ReportText.Count>ReportLines); 138 if OptionChecked and (1 shl soTellAI)<>0 then 139 TellAIBtn.ButtonIndex:=3 140 else TellAIBtn.ButtonIndex:=2; 141 Caption:=Tribe[pView].TPhrase('TITLE_NATION'); 142 LinesDown:=0; 143 144 OffscreenPaint; 145 end; 146 147 procedure TNatStatDlg.ShowNewContent(NewMode,p: integer); 148 begin 149 if p<0 then 150 if ClientMode>=scContact then 151 pView:=DipMem[me].pContact 120 if pView = me then 121 begin 122 SelfReport.TurnOfCivilReport := MyRO.Turn; 123 SelfReport.TurnOfMilReport := MyRO.Turn; 124 move(MyRO.Treaty, SelfReport.Treaty, SizeOf(SelfReport.Treaty)); 125 SelfReport.Government := MyRO.Government; 126 SelfReport.Money := MyRO.Money; 127 CurrentReport := pointer(SelfReport); 128 end 152 129 else 153 begin 154 pView:=0; 155 while (pView<nPl) and ((MyRO.Treaty[pView]<trNone) 156 or (1 shl pView and MyRO.Alive=0)) do 157 inc(pView); 158 if pView>=nPl then pView:=me; 130 CurrentReport := pointer(MyRO.EnemyReport[pView]); 131 if CurrentReport.TurnOfCivilReport >= 0 then 132 GenerateReportText; 133 ShowContact := (pView <> me) and (not supervising or (me <> 0)); 134 ContactEnabled := ShowContact and not supervising and 135 (1 shl pView and MyRO.Alive <> 0); 136 ContactBtn.Visible := ContactEnabled and (MyRO.Happened and phGameEnd = 0) and 137 (ClientMode < scContact); 138 ScrollUpBtn.Visible := (CurrentReport.TurnOfCivilReport >= 0) and 139 (ReportText.Count > ReportLines); 140 ScrollDownBtn.Visible := (CurrentReport.TurnOfCivilReport >= 0) and 141 (ReportText.Count > ReportLines); 142 if OptionChecked and (1 shl soTellAI) <> 0 then 143 TellAIBtn.ButtonIndex := 3 144 else 145 TellAIBtn.ButtonIndex := 2; 146 Caption := Tribe[pView].TPhrase('TITLE_NATION'); 147 LinesDown := 0; 148 149 OffscreenPaint; 150 end; 151 152 procedure TNatStatDlg.ShowNewContent(NewMode, p: integer); 153 begin 154 if p < 0 then 155 if ClientMode >= scContact then 156 pView := DipMem[me].pContact 157 else 158 begin 159 pView := 0; 160 while (pView < nPl) and ((MyRO.Treaty[pView] < trNone) or 161 (1 shl pView and MyRO.Alive = 0)) do 162 inc(pView); 163 if pView >= nPl then 164 pView := me; 159 165 end 160 else pView:=p; 161 inherited ShowNewContent(NewMode); 166 else 167 pView := p; 168 inherited ShowNewContent(NewMode); 162 169 end; 163 170 164 171 procedure TNatStatDlg.PlayerClick(Sender: TObject); 165 172 begin 166 ShowNewContent(FWindowMode, TComponent(Sender).Tag);173 ShowNewContent(FWindowMode, TComponent(Sender).Tag); 167 174 end; 168 175 169 176 procedure TNatStatDlg.GenerateReportText; 170 177 var 171 List: ^TChart;178 List: ^TChart; 172 179 173 180 function StatText(no: integer): string; 174 181 var 175 i: integer; 176 begin 177 if (CurrentReport.TurnOfCivilReport>=0) and (Server(sGetChart+no shl 4,me,pView,List^)>=rExecuted) then 178 begin 179 i:=List[CurrentReport.TurnOfCivilReport]; 180 case no of 181 stPop: result:=Format(Phrases.Lookup('FRSTATPOP'),[i]); 182 stTerritory: result:=Format(Phrases.Lookup('FRSTATTER'),[i]); 183 stScience: result:=Format(Phrases.Lookup('FRSTATTECH'),[i div nAdv]); 184 stExplore: result:=Format(Phrases.Lookup('FRSTATEXP'),[i*100 div (G.lx*G.ly)]); 182 i: integer; 183 begin 184 if (CurrentReport.TurnOfCivilReport >= 0) and 185 (Server(sGetChart + no shl 4, me, pView, List^) >= rExecuted) then 186 begin 187 i := List[CurrentReport.TurnOfCivilReport]; 188 case no of 189 stPop: 190 result := Format(Phrases.Lookup('FRSTATPOP'), [i]); 191 stTerritory: 192 result := Format(Phrases.Lookup('FRSTATTER'), [i]); 193 stScience: 194 result := Format(Phrases.Lookup('FRSTATTECH'), [i div nAdv]); 195 stExplore: 196 result := Format(Phrases.Lookup('FRSTATEXP'), 197 [i * 100 div (G.lx * G.ly)]); 185 198 end; 186 199 end … … 188 201 189 202 var 190 p1,Treaty: integer; 191 s: string; 192 HasContact,ExtinctPart: boolean; 193 begin 194 GetMem(List,4*(MyRO.Turn+2)); 195 196 ReportText.Clear; 197 ReportText.Add(''); 198 if (MyRO.Turn-CurrentReport.TurnOfCivilReport>1) 199 and (1 shl pView and MyRO.Alive<>0) then 200 begin 201 s:=Format(Phrases.Lookup('FROLDCIVILREP'), 202 [TurnToString(CurrentReport.TurnOfCivilReport)]); 203 ReportText.Add('C'+s); 203 p1, Treaty: integer; 204 s: string; 205 HasContact, ExtinctPart: boolean; 206 begin 207 GetMem(List, 4 * (MyRO.Turn + 2)); 208 209 ReportText.Clear; 204 210 ReportText.Add(''); 205 end; 206 207 if (1 shl pView and MyRO.Alive<>0) then 208 begin 209 ReportText.Add('M'+Format(Phrases.Lookup('FRTREASURY'),[CurrentReport.Money])); 210 ReportText.Add('P'+StatText(stPop)); 211 ReportText.Add('T'+StatText(stTerritory)); 212 end; 213 ReportText.Add('S'+StatText(stScience)); 214 ReportText.Add('E'+StatText(stExplore)); 215 HasContact:=false; 216 for p1:=0 to nPl-1 do 217 if (p1<>me) and (CurrentReport.Treaty[p1]>trNoContact) then 218 HasContact:=true; 219 if HasContact then 220 begin 211 if (MyRO.Turn - CurrentReport.TurnOfCivilReport > 1) and 212 (1 shl pView and MyRO.Alive <> 0) then 213 begin 214 s := Format(Phrases.Lookup('FROLDCIVILREP'), 215 [TurnToString(CurrentReport.TurnOfCivilReport)]); 216 ReportText.Add('C' + s); 217 ReportText.Add(''); 218 end; 219 220 if (1 shl pView and MyRO.Alive <> 0) then 221 begin 222 ReportText.Add('M' + Format(Phrases.Lookup('FRTREASURY'), 223 [CurrentReport.Money])); 224 ReportText.Add('P' + StatText(stPop)); 225 ReportText.Add('T' + StatText(stTerritory)); 226 end; 227 ReportText.Add('S' + StatText(stScience)); 228 ReportText.Add('E' + StatText(stExplore)); 229 HasContact := false; 230 for p1 := 0 to nPl - 1 do 231 if (p1 <> me) and (CurrentReport.Treaty[p1] > trNoContact) then 232 HasContact := true; 233 if HasContact then 234 begin 235 ReportText.Add(''); 236 ReportText.Add(' ' + Phrases.Lookup('FRRELATIONS')); 237 for ExtinctPart := false to true do 238 for Treaty := trAlliance downto trNone do 239 for p1 := 0 to nPl - 1 do 240 if (p1 <> me) and (CurrentReport.Treaty[p1] = Treaty) and 241 ((1 shl p1 and MyRO.Alive = 0) = ExtinctPart) then 242 begin 243 s := Tribe[p1].TString(Phrases.Lookup('HAVETREATY', Treaty)); 244 if ExtinctPart then 245 s := '(' + s + ')'; 246 ReportText.Add(char(48 + Treaty) + s); 247 end; 248 end; 221 249 ReportText.Add(''); 222 ReportText.Add(' '+Phrases.Lookup('FRRELATIONS')); 223 for ExtinctPart:=false to true do 224 for Treaty:=trAlliance downto trNone do 225 for p1:=0 to nPl-1 do 226 if (p1<>me) and (CurrentReport.Treaty[p1]=Treaty) 227 and ((1 shl p1 and MyRO.Alive=0)=ExtinctPart) then 228 begin 229 s:=Tribe[p1].TString(Phrases.Lookup('HAVETREATY', Treaty)); 230 if ExtinctPart then s:='('+s+')'; 231 ReportText.Add(char(48+Treaty)+s); 232 end; 233 end; 234 ReportText.Add(''); 235 236 FreeMem(List); 250 251 FreeMem(List); 237 252 end; 238 253 239 254 procedure TNatStatDlg.OffscreenPaint; 240 255 var 241 i, y: integer; 242 s: string; 243 ps: pchar; 244 Extinct: boolean; 245 246 begin 247 inherited; 248 249 Extinct:= 1 shl pView and MyRO.Alive=0; 250 251 bitblt(offscreen.canvas.handle,0,0,ClientWidth,ClientHeight,Back.Canvas.handle,0,0,SRCCOPY); 252 253 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 254 RisedTextout(offscreen.Canvas,40{(ClientWidth-BiColorTextWidth(offscreen.canvas,caption)) div 2},7,Caption); 255 256 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 257 258 with offscreen do 259 begin 260 // show leader picture 261 Tribe[pView].InitAge(GetAge(pView)); 262 if Tribe[pView].faceHGr>=0 then 263 begin 264 Dump(offscreen,Tribe[pView].faceHGr,18,yIcon-4,64,48, 265 1+Tribe[pView].facepix mod 10 *65,1+Tribe[pView].facepix div 10 *49); 266 frame(offscreen.Canvas,18-1,yIcon-4-1,18+64,yIcon-4+48,$000000,$000000); 256 i, y: integer; 257 s: string; 258 ps: pchar; 259 Extinct: boolean; 260 261 begin 262 inherited; 263 264 Extinct := 1 shl pView and MyRO.Alive = 0; 265 266 bitblt(offscreen.Canvas.Handle, 0, 0, ClientWidth, ClientHeight, 267 Back.Canvas.Handle, 0, 0, SRCCOPY); 268 269 offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 270 RisedTextout(offscreen.Canvas, 271 40 { (ClientWidth-BiColorTextWidth(offscreen.canvas,caption)) div 2 } , 272 7, Caption); 273 274 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 275 276 with offscreen do 277 begin 278 // show leader picture 279 Tribe[pView].InitAge(GetAge(pView)); 280 if Tribe[pView].faceHGr >= 0 then 281 begin 282 Dump(offscreen, Tribe[pView].faceHGr, 18, yIcon - 4, 64, 48, 283 1 + Tribe[pView].facepix mod 10 * 65, 284 1 + Tribe[pView].facepix div 10 * 49); 285 frame(offscreen.Canvas, 18 - 1, yIcon - 4 - 1, 18 + 64, yIcon - 4 + 48, 286 $000000, $000000); 267 287 end; 268 288 269 if (pView=me) or not Extinct then 270 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib, 271 Phrases.Lookup('GOVERNMENT',CurrentReport.Government)+Phrases.Lookup('FRAND')); 272 if pView=me then 273 begin 274 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+19, 275 Phrases.Lookup('CREDIBILITY',RoughCredibility(MyRO.Credibility))); 276 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+38, 277 Format(Phrases.Lookup('FRCREDIBILITY'),[MyRO.Credibility])); 289 if (pView = me) or not Extinct then 290 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib, 291 Phrases.Lookup('GOVERNMENT', CurrentReport.Government) + 292 Phrases.Lookup('FRAND')); 293 if pView = me then 294 begin 295 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 19, 296 Phrases.Lookup('CREDIBILITY', RoughCredibility(MyRO.Credibility))); 297 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 38, 298 Format(Phrases.Lookup('FRCREDIBILITY'), [MyRO.Credibility])); 278 299 end 279 else280 begin 281 if Extinct then282 begin 283 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+9,284 Phrases.Lookup('FREXTINCT'));285 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+28,286 TurnToString(CurrentReport.TurnOfCivilReport))300 else 301 begin 302 if Extinct then 303 begin 304 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 9, 305 Phrases.Lookup('FREXTINCT')); 306 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 28, 307 TurnToString(CurrentReport.TurnOfCivilReport)) 287 308 end 288 else 289 begin 290 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+19, 291 Phrases.Lookup('CREDIBILITY',RoughCredibility(CurrentReport.Credibility))); 292 LoweredTextOut(Canvas,-1,MainTexture,xAttrib,yAttrib+38, 293 Format(Phrases.Lookup('FRCREDIBILITY'),[CurrentReport.Credibility])); 309 else 310 begin 311 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 19, 312 Phrases.Lookup('CREDIBILITY', 313 RoughCredibility(CurrentReport.Credibility))); 314 LoweredTextOut(Canvas, -1, MainTexture, xAttrib, yAttrib + 38, 315 Format(Phrases.Lookup('FRCREDIBILITY'), [CurrentReport.Credibility])); 294 316 end; 295 317 296 if MyRO.Treaty[pView]=trNoContact then297 begin 298 s:=Phrases.Lookup('FRNOCONTACT');299 LoweredTextOut(Canvas,-1,MainTexture,300 (ClientWidth-BiColorTextWidth(canvas,s)) div 2,yRelation+9,s)318 if MyRO.Treaty[pView] = trNoContact then 319 begin 320 s := Phrases.Lookup('FRNOCONTACT'); 321 LoweredTextOut(Canvas, -1, MainTexture, 322 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, yRelation + 9, s) 301 323 end 302 else if ShowContact then303 begin 304 LoweredTextOut(Canvas,-1,MainTexture,xRelation,yRelation,305 Phrases.Lookup('FRTREATY'));306 LoweredTextOut(Canvas,-1,MainTexture,ClientWidth div 2,yRelation,307 Phrases.Lookup('TREATY',MyRO.Treaty[pView]));308 if CurrentReport.TurnOfContact<0 then309 LoweredTextOut(Canvas,-1,MainTexture,ClientWidth div 2,yRelation+19,310 Phrases.Lookup('FRNOVISIT'))311 else324 else if ShowContact then 325 begin 326 LoweredTextOut(Canvas, -1, MainTexture, xRelation, yRelation, 327 Phrases.Lookup('FRTREATY')); 328 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2, yRelation, 329 Phrases.Lookup('TREATY', MyRO.Treaty[pView])); 330 if CurrentReport.TurnOfContact < 0 then 331 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2, 332 yRelation + 19, Phrases.Lookup('FRNOVISIT')) 333 else 312 334 begin 313 LoweredTextOut(Canvas,-1,MainTexture,xRelation,yRelation+19,314 Phrases.Lookup('FRLASTCONTACT'));315 if CurrentReport.TurnOfContact>=0 then316 LoweredTextOut(Canvas,-1,MainTexture,ClientWidth div 2,yRelation+19,317 TurnToString(CurrentReport.TurnOfContact));335 LoweredTextOut(Canvas, -1, MainTexture, xRelation, yRelation + 19, 336 Phrases.Lookup('FRLASTCONTACT')); 337 if CurrentReport.TurnOfContact >= 0 then 338 LoweredTextOut(Canvas, -1, MainTexture, ClientWidth div 2, 339 yRelation + 19, TurnToString(CurrentReport.TurnOfContact)); 318 340 end; 319 341 end; 320 342 321 if Extinct then322 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,0,200)323 {else if CurrentReport.Government=gAnarchy then324 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,112,400,325 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact))326 else327 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,328 56*(CurrentReport.Government-1),40,329 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact))};343 if Extinct then 344 FrameImage(Canvas, BigImp, xIcon, yIcon, xSizeBig, ySizeBig, 0, 200) 345 { else if CurrentReport.Government=gAnarchy then 346 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig,112,400, 347 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact)) 348 else 349 FrameImage(canvas,BigImp,xIcon,yIcon,xSizeBig,ySizeBig, 350 56*(CurrentReport.Government-1),40, 351 ContactEnabled and (MyRO.Happened and phGameEnd=0) and (ClientMode<scContact)) }; 330 352 end; 331 353 332 if CurrentReport.TurnOfCivilReport>=0 then354 if CurrentReport.TurnOfCivilReport >= 0 then 333 355 begin // print state report 334 FillSeamless(Canvas, xReport, yReport, wReport, hReport, 0, 0, Paper);335 with canvas do336 begin 337 Brush.Color:=MainTexture.clBevelShade;338 FillRect(Rect(xReport+wReport, yReport+PaperShade,339 xReport+wReport+PaperShade, yReport+hReport+PaperShade));340 FillRect(Rect(xReport+PaperShade, yReport+hReport,341 xReport+wReport+PaperShade, yReport+hReport+PaperShade));342 Brush.Style:=bsClear;356 FillSeamless(Canvas, xReport, yReport, wReport, hReport, 0, 0, Paper); 357 with Canvas do 358 begin 359 Brush.Color := MainTexture.clBevelShade; 360 FillRect(Rect(xReport + wReport, yReport + PaperShade, 361 xReport + wReport + PaperShade, yReport + hReport + PaperShade)); 362 FillRect(Rect(xReport + PaperShade, yReport + hReport, 363 xReport + wReport + PaperShade, yReport + hReport + PaperShade)); 364 Brush.Style := bsClear; 343 365 end; 344 366 345 y:=0;346 for i:=0 to ReportText.Count-1 do347 begin 348 if (i>=LinesDown) and (i<LinesDown+ReportLines) then367 y := 0; 368 for i := 0 to ReportText.Count - 1 do 369 begin 370 if (i >= LinesDown) and (i < LinesDown + ReportLines) then 349 371 begin 350 s:=ReportText[i];351 if s<>'' then372 s := ReportText[i]; 373 if s <> '' then 352 374 begin 353 //LineType:=s[1];354 delete(s,1,1);355 BiColorTextOut(canvas,Colors.Canvas.Pixels[clkMisc,cliPaperText],356 $7F007F,xReport+8,yReport+LineSpacing*y,s);375 // LineType:=s[1]; 376 delete(s, 1, 1); 377 BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkMisc, cliPaperText], 378 $7F007F, xReport + 8, yReport + LineSpacing * y, s); 357 379 end; 358 inc(y);380 inc(y); 359 381 end 360 382 end; 361 383 end 384 else 385 begin 386 s := Phrases.Lookup('FRNOCIVILREP'); 387 RisedTextout(Canvas, (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 388 yReport + hReport div 2 - 10, s); 389 end; 390 391 if OptionChecked and (1 shl soTellAI) <> 0 then 392 begin 393 Server(sGetAIInfo, me, pView, ps); 394 LoweredTextOut(Canvas, -1, MainTexture, 42, 445, ps); 395 end 396 else 397 LoweredTextOut(Canvas, -2, MainTexture, 42, 445, 398 Phrases2.Lookup('MENU_TELLAI')); 399 end; 400 ContactBtn.SetBack(offscreen.Canvas, ContactBtn.Left, ContactBtn.Top); 401 402 MarkUsedOffscreen(ClientWidth, ClientHeight); 403 end; { OffscreenPaint } 404 405 procedure TNatStatDlg.CloseBtnClick(Sender: TObject); 406 begin 407 Close 408 end; 409 410 procedure TNatStatDlg.DialogBtnClick(Sender: TObject); 411 var 412 ContactResult: integer; 413 begin 414 ContactResult := MainScreen.DipCall(scContact + pView shl 4); 415 if ContactResult < rExecuted then 416 begin 417 if ContactResult = eColdWar then 418 SoundMessage(Phrases.Lookup('FRCOLDWAR'), 'MSG_DEFAULT') 419 else if MyRO.Government = gAnarchy then 420 SoundMessage(Tribe[me].TPhrase('FRMYANARCHY'), 'MSG_DEFAULT') 421 else if ContactResult = eAnarchy then 422 if MyRO.Treaty[pView] >= trPeace then 423 begin 424 if MainScreen.ContactRefused(pView, 'FRANARCHY') then 425 SmartUpdateContent 426 end 427 else 428 SoundMessage(Tribe[pView].TPhrase('FRANARCHY'), 'MSG_DEFAULT'); 429 end 362 430 else 363 begin 364 s:=Phrases.Lookup('FRNOCIVILREP'); 365 RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 366 yReport+hReport div 2-10,s); 431 Close 432 end; 433 434 procedure TNatStatDlg.ToggleBtnClick(Sender: TObject); 435 var 436 p1, StartCount: integer; 437 m: TMenuItem; 438 ExtinctPart: boolean; 439 begin 440 EmptyMenu(Popup.Items); 441 442 // own nation 443 if G.Difficulty[me] <> 0 then 444 begin 445 m := TMenuItem.Create(Popup); 446 m.RadioItem := true; 447 m.Caption := Tribe[me].TPhrase('TITLE_NATION'); 448 m.Tag := me; 449 m.OnClick := PlayerClick; 450 if me = pView then 451 m.Checked := true; 452 Popup.Items.Add(m); 453 end; 454 455 // foreign nations 456 for ExtinctPart := false to true do 457 begin 458 StartCount := Popup.Items.Count; 459 for p1 := 0 to nPl - 1 do 460 if ExtinctPart and (G.Difficulty[p1] > 0) and 461 (1 shl p1 and MyRO.Alive = 0) or not ExtinctPart and 462 (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] >= trNone) then 463 begin 464 m := TMenuItem.Create(Popup); 465 m.RadioItem := true; 466 m.Caption := Tribe[p1].TPhrase('TITLE_NATION'); 467 if ExtinctPart then 468 m.Caption := '(' + m.Caption + ')'; 469 m.Tag := p1; 470 m.OnClick := PlayerClick; 471 if p1 = pView then 472 m.Checked := true; 473 Popup.Items.Add(m); 474 end; 475 if (StartCount > 0) and (Popup.Items.Count > StartCount) then 476 begin // seperator 477 m := TMenuItem.Create(Popup); 478 m.Caption := '-'; 479 Popup.Items.Insert(StartCount, m); 367 480 end; 368 369 if OptionChecked and (1 shl soTellAI)<>0 then 370 begin 371 Server(sGetAIInfo,me,pView,ps); 372 LoweredTextOut(Canvas,-1,MainTexture,42,445,ps); 373 end 374 else LoweredTextOut(Canvas,-2,MainTexture,42,445,Phrases2.Lookup('MENU_TELLAI')); 375 end; 376 ContactBtn.SetBack(Offscreen.Canvas,ContactBtn.Left,ContactBtn.Top); 377 378 MarkUsedOffscreen(ClientWidth,ClientHeight); 379 end; {OffscreenPaint} 380 381 procedure TNatStatDlg.CloseBtnClick(Sender: TObject); 382 begin 383 Close 384 end; 385 386 procedure TNatStatDlg.DialogBtnClick(Sender: TObject); 387 var 388 ContactResult: integer; 389 begin 390 ContactResult:=MainScreen.DipCall(scContact+pView shl 4); 391 if ContactResult<rExecuted then 392 begin 393 if ContactResult=eColdWar then 394 SoundMessage(Phrases.Lookup('FRCOLDWAR'),'MSG_DEFAULT') 395 else if MyRO.Government=gAnarchy then 396 SoundMessage(Tribe[me].TPhrase('FRMYANARCHY'),'MSG_DEFAULT') 397 else if ContactResult=eAnarchy then 398 if MyRO.Treaty[pView]>=trPeace then 399 begin 400 if MainScreen.ContactRefused(pView, 'FRANARCHY') then 401 SmartUpdateContent 402 end 403 else SoundMessage(Tribe[pView].TPhrase('FRANARCHY'),'MSG_DEFAULT'); 404 end 405 else Close 406 end; 407 408 procedure TNatStatDlg.ToggleBtnClick(Sender: TObject); 409 var 410 p1,StartCount: integer; 411 m: TMenuItem; 412 ExtinctPart: boolean; 413 begin 414 EmptyMenu(Popup.Items); 415 416 // own nation 417 if G.Difficulty[me]<>0 then 418 begin 419 m:=TMenuItem.Create(Popup); 420 m.RadioItem:=true; 421 m.Caption:=Tribe[me].TPhrase('TITLE_NATION'); 422 m.Tag:=me; 423 m.OnClick:=PlayerClick; 424 if me=pView then m.Checked:=true; 425 Popup.Items.Add(m); 426 end; 427 428 // foreign nations 429 for ExtinctPart:=false to true do 430 begin 431 StartCount:=Popup.Items.Count; 432 for p1:=0 to nPl-1 do 433 if ExtinctPart and (G.Difficulty[p1]>0) and (1 shl p1 and MyRO.Alive=0) 434 or not ExtinctPart and (1 shl p1 and MyRO.Alive<>0) 435 and (MyRO.Treaty[p1]>=trNone) then 436 begin 437 m:=TMenuItem.Create(Popup); 438 m.RadioItem:=true; 439 m.Caption:=Tribe[p1].TPhrase('TITLE_NATION'); 440 if ExtinctPart then 441 m.Caption:='('+m.Caption+')'; 442 m.Tag:=p1; 443 m.OnClick:=PlayerClick; 444 if p1=pView then m.Checked:=true; 445 Popup.Items.Add(m); 446 end; 447 if (StartCount>0) and (Popup.Items.Count>StartCount) then 448 begin //seperator 449 m:=TMenuItem.Create(Popup); 450 m.Caption:='-'; 451 Popup.Items.Insert(StartCount,m); 452 end; 453 end; 454 455 Popup.Popup(Left+ToggleBtn.Left, Top+ToggleBtn.Top+ToggleBtn.Height); 481 end; 482 483 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + ToggleBtn.Height); 456 484 end; 457 485 … … 459 487 Shift: TShiftState); 460 488 var 461 i: integer;462 begin 463 if Key=VK_F9 then // my key489 i: integer; 490 begin 491 if Key = VK_F9 then // my key 464 492 begin // toggle nation 465 i:=0; 466 repeat 467 pView:=(pView+1) mod nPl; 468 inc(i); 469 until (i>=nPl) 470 or (1 shl pView and MyRO.Alive<>0) and (MyRO.Treaty[pView]>=trNone); 471 if i>=nPl then pView:=me; 472 Tag:=pView; 473 PlayerClick(self); // no, this is not nice 474 end 475 else inherited 493 i := 0; 494 repeat 495 pView := (pView + 1) mod nPl; 496 inc(i); 497 until (i >= nPl) or (1 shl pView and MyRO.Alive <> 0) and 498 (MyRO.Treaty[pView] >= trNone); 499 if i >= nPl then 500 pView := me; 501 Tag := pView; 502 PlayerClick(self); // no, this is not nice 503 end 504 else 505 inherited 476 506 end; 477 507 478 508 procedure TNatStatDlg.EcoChange; 479 509 begin 480 if Visible and (pView=me) then 481 begin 482 SelfReport.Government:=MyRO.Government; 483 SelfReport.Money:=MyRO.Money; 510 if Visible and (pView = me) then 511 begin 512 SelfReport.Government := MyRO.Government; 513 SelfReport.Money := MyRO.Money; 514 SmartUpdateContent 515 end 516 end; 517 518 procedure TNatStatDlg.ScrollUpBtnClick(Sender: TObject); 519 begin 520 if LinesDown > 0 then 521 begin 522 dec(LinesDown); 523 SmartUpdateContent; 524 end 525 end; 526 527 procedure TNatStatDlg.ScrollDownBtnClick(Sender: TObject); 528 begin 529 if LinesDown + ReportLines < ReportText.Count then 530 begin 531 inc(LinesDown); 532 SmartUpdateContent; 533 end 534 end; 535 536 procedure TNatStatDlg.TellAIBtnClick(Sender: TObject); 537 begin 538 OptionChecked := OptionChecked xor (1 shl soTellAI); 539 if OptionChecked and (1 shl soTellAI) <> 0 then 540 TellAIBtn.ButtonIndex := 3 541 else 542 TellAIBtn.ButtonIndex := 2; 484 543 SmartUpdateContent 485 end486 end;487 488 procedure TNatStatDlg.ScrollUpBtnClick(Sender: TObject);489 begin490 if LinesDown>0 then491 begin492 dec(LinesDown);493 SmartUpdateContent;494 end495 end;496 497 procedure TNatStatDlg.ScrollDownBtnClick(Sender: TObject);498 begin499 if LinesDown+ReportLines<ReportText.Count then500 begin501 inc(LinesDown);502 SmartUpdateContent;503 end504 end;505 506 procedure TNatStatDlg.TellAIBtnClick(Sender: TObject);507 begin508 OptionChecked:=OptionChecked xor (1 shl soTellAI);509 if OptionChecked and (1 shl soTellAI)<>0 then510 TellAIBtn.ButtonIndex:=3511 else TellAIBtn.ButtonIndex:=2;512 SmartUpdateContent513 544 end; 514 545 515 546 end. 516 -
trunk/LocalPlayer/Nego.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Nego; 4 3 … … 6 5 7 6 uses 8 ScreenTools, BaseWin,Protocol,Term,7 ScreenTools, BaseWin, Protocol, Term, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA, 11 10 ButtonBase, ButtonB, ButtonC, ButtonN; 12 11 13 14 12 const 15 MaxHistory=62;13 MaxHistory = 62; 16 14 17 15 type 18 THistory =record16 THistory = record 19 17 n: integer; 20 Text: array [0..MaxHistory-1] of ansistring;21 18 Text: array [0 .. MaxHistory - 1] of ansistring; 19 end; 22 20 23 21 TNegoDlg = class(TBufferedDrawDlg) … … 56 54 procedure FormCreate(Sender: TObject); 57 55 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 58 Shift: TShiftState; X, Y: Integer);56 Shift: TShiftState; X, Y: integer); 59 57 procedure OkBtnClick(Sender: TObject); 60 58 procedure BwdBtnClick(Sender: TObject); 61 59 procedure FwdBtnClick(Sender: TObject); 62 60 procedure CloseBtnClick(Sender: TObject); 63 procedure FormKeyDown(Sender: TObject; var Key: Word; 64 Shift: TShiftState); 61 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 65 62 procedure FormShow(Sender: TObject); 66 63 procedure WantClick(Sender: TObject); … … 79 76 CurrentOffer: TOffer; 80 77 MyAllowed, OppoAllowed: TPriceSet; 81 CommandAllowed: set of scDipNotice -scDipStart..scDipBreak-scDipStart;82 History: array [0..nPl-1] of THistory;78 CommandAllowed: set of scDipNotice - scDipStart .. scDipBreak - scDipStart; 79 History: array [0 .. nPl - 1] of THistory; 83 80 RomanFont: TFont; 84 Costs, Delivers: array[0..11] of cardinal;81 Costs, Delivers: array [0 .. 11] of cardinal; 85 82 procedure ResetCurrentOffer; 86 83 procedure BuildCurrentOffer; 87 84 procedure FindAllowed; 88 85 procedure SplitText(Text: string; Bounds: TRect); 89 procedure PaintNationPicture( x,y,p: integer);86 procedure PaintNationPicture(X, Y, p: integer); 90 87 procedure SetButtonStates; 91 88 end; … … 97 94 98 95 uses 99 Messg,ClientTools,Diplomacy, Inp, Select, NatStat, Help,Tribes, MessgEx;96 Messg, ClientTools, Diplomacy, Inp, Select, NatStat, Help, Tribes, MessgEx; 100 97 101 98 {$R *.DFM} 102 99 103 100 const 104 xPadC=140; yPadC=427; 105 xPad0=140; yPad0=13; 106 xPad1=334; yPad1=13; 107 wIcon=40; hIcon=40; 108 wText=300; hText=256; 109 xText0=14; yText0=154; 110 xText1=326; yText1=154; 111 xNationPicture0=20; xNationPicture1=556; 112 yNationPicture=40; 113 yAttitude=148; 114 xCred0=42; yCred0=92; 115 xCred1=578; yCred1=92; 116 PaperShade=3; 117 PaperBorder_Left=12; PaperBorder_Right=8; 118 ListIndent=24; 119 120 opLowTreaty=$FE000000; 121 122 RomanNo: array[0..15] of string= 123 ('I','II','III','IV','V','VI','VII','VIII','IX','X','XI','XII','XIII','XIV','XV','XVI'); 124 125 ButtonPrice: array[0..11] of cardinal= 126 (opChoose,opCivilReport,opMilReport,opMap,opAllTech,opAllTech,opAllModel,opMoney, 127 opTreaty,opLowTreaty,opShipParts,opShipParts); 128 101 xPadC = 140; 102 yPadC = 427; 103 xPad0 = 140; 104 yPad0 = 13; 105 xPad1 = 334; 106 yPad1 = 13; 107 wIcon = 40; 108 hIcon = 40; 109 wText = 300; 110 hText = 256; 111 xText0 = 14; 112 yText0 = 154; 113 xText1 = 326; 114 yText1 = 154; 115 xNationPicture0 = 20; 116 xNationPicture1 = 556; 117 yNationPicture = 40; 118 yAttitude = 148; 119 xCred0 = 42; 120 yCred0 = 92; 121 xCred1 = 578; 122 yCred1 = 92; 123 PaperShade = 3; 124 PaperBorder_Left = 12; 125 PaperBorder_Right = 8; 126 ListIndent = 24; 127 128 opLowTreaty = $FE000000; 129 130 RomanNo: array [0 .. 15] of string = ('I', 'II', 'III', 'IV', 'V', 'VI', 131 'VII', 'VIII', 'IX', 'X', 'XI', 'XII', 'XIII', 'XIV', 'XV', 'XVI'); 132 133 ButtonPrice: array [0 .. 11] of cardinal = (opChoose, opCivilReport, 134 opMilReport, opMap, opAllTech, opAllTech, opAllModel, opMoney, opTreaty, 135 opLowTreaty, opShipParts, opShipParts); 129 136 130 137 procedure TNegoDlg.FormCreate(Sender: TObject); 131 138 var 132 cix: integer; 133 begin 134 InitButtons(); 135 for cix:=0 to ComponentCount-1 do 136 if Components[cix] is TButtonN then with TButtonN(Components[cix]) do 137 begin 138 Graphic:=GrExt[HGrSystem].Data; 139 Mask:=GrExt[HGrSystem].Mask; 140 BackGraphic:=GrExt[HGrSystem2].Data; 141 case Tag shr 8 of 142 1: SmartHint:=Phrases.Lookup('WANT', ButtonIndex-6); 143 2: SmartHint:=Phrases.Lookup('OFFER', ButtonIndex-6); 139 cix: integer; 140 begin 141 InitButtons(); 142 for cix := 0 to ComponentCount - 1 do 143 if Components[cix] is TButtonN then 144 with TButtonN(Components[cix]) do 145 begin 146 Graphic := GrExt[HGrSystem].Data; 147 Mask := GrExt[HGrSystem].Mask; 148 BackGraphic := GrExt[HGrSystem2].Data; 149 case Tag shr 8 of 150 1: 151 SmartHint := Phrases.Lookup('WANT', ButtonIndex - 6); 152 2: 153 SmartHint := Phrases.Lookup('OFFER', ButtonIndex - 6); 154 end; 144 155 end; 156 157 fillchar(History, sizeof(History), 0); 158 RomanFont := TFont.Create; 159 RomanFont.Name := 'Times New Roman'; 160 RomanFont.Size := Round(144 * 72 / RomanFont.PixelsPerInch); 161 RomanFont.Color := Colors.Canvas.Pixels[clkMisc, cliPaper]; 162 HelpContext := 'DIPLOMACY'; 163 OkBtn.Caption := Phrases.Lookup('BTN_OK'); 164 AcceptBtn.SmartHint := Phrases.Lookup('BTN_ACCEPT'); 165 ExitBtn.SmartHint := Phrases.Lookup('BTN_BREAK'); 166 CancelTreatyBtn.SmartHint := Phrases.Lookup('BTN_CNTREATY'); 167 end; 168 169 procedure TNegoDlg.FormShow(Sender: TObject); 170 begin 171 OffscreenPaint; 172 end; 173 174 procedure TNegoDlg.ResetCurrentOffer; 175 var 176 i: integer; 177 begin 178 CurrentOffer.nDeliver := 0; 179 CurrentOffer.nCost := 0; 180 for i := 0 to 11 do 181 Costs[i] := $FFFFFFFF; 182 for i := 0 to 11 do 183 Delivers[i] := $FFFFFFFF; 184 end; 185 186 procedure TNegoDlg.ShowNewContent(NewMode: integer); 187 begin 188 inherited ShowNewContent(NewMode); 189 SetButtonStates; 190 if (ClientMode = scDipCancelTreaty) or (ClientMode = scDipBreak) then 191 PassBtn.SmartHint := Phrases.Lookup('BTN_NOTICE') 192 else 193 PassBtn.SmartHint := Phrases.Lookup('BTN_PASS'); 194 case MyRO.Treaty[DipMem[me].pContact] of 195 trNone: 196 begin 197 WantHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_WANTPEACE'); 198 OfferHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_OFFERPEACE'); 199 // WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTCEASEFIRE'); 200 // OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERCEASEFIRE'); 201 end; 202 { trCeasefire: 203 begin 204 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTPEACE'); 205 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERPEACE'); 206 end; } 207 trPeace: 208 begin 209 WantHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_WANTFRIENDLY'); 210 OfferHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_OFFERFRIENDLY'); 211 // WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDPEACE'); 212 // OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDPEACE'); 213 end; 214 trFriendlyContact: 215 begin 216 WantHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_WANTALLIANCE'); 217 OfferHiTreatyBtn.SmartHint := Phrases.Lookup('BTN_OFFERALLIANCE'); 218 end; 219 { trAlliance: 220 begin 221 WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDALLIANCE'); 222 OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDALLIANCE'); 223 end; } 224 end; 225 end; 226 227 procedure TNegoDlg.Start; 228 begin 229 if ClientMode <> scDipStart then 230 with History[me] do 231 begin 232 if n = MaxHistory then 233 begin 234 move(Text[2], Text[0], (MaxHistory - 2) * sizeof(integer)); 235 dec(n, 2); 236 end; 237 Text[n] := copy(DipCommandToString(DipMem[me].pContact, me, 238 DipMem[me].FormerTreaty, DipMem[me].SentCommand, ClientMode, 239 DipMem[me].SentOffer, ReceivedOffer), 1, 255); 240 inc(n); 145 241 end; 146 147 fillchar(History, sizeof(History), 0); 148 RomanFont:=TFont.Create; 149 RomanFont.Name:='Times New Roman'; 150 RomanFont.Size:=Round(144 * 72/RomanFont.PixelsPerInch); 151 RomanFont.Color:=Colors.Canvas.Pixels[clkMisc,cliPaper]; 152 HelpContext:='DIPLOMACY'; 153 OkBtn.Caption:=Phrases.Lookup('BTN_OK'); 154 AcceptBtn.SmartHint:=Phrases.Lookup('BTN_ACCEPT'); 155 ExitBtn.SmartHint:=Phrases.Lookup('BTN_BREAK'); 156 CancelTreatyBtn.SmartHint:=Phrases.Lookup('BTN_CNTREATY'); 157 end; 158 159 procedure TNegoDlg.FormShow(Sender: TObject); 160 begin 161 OffscreenPaint; 162 end; 163 164 procedure TNegoDlg.ResetCurrentOffer; 165 var 166 i: integer; 167 begin 168 CurrentOffer.nDeliver:=0; 169 CurrentOffer.nCost:=0; 170 for i:=0 to 11 do 171 Costs[i]:=$FFFFFFFF; 172 for i:=0 to 11 do 173 Delivers[i]:=$FFFFFFFF; 174 end; 175 176 procedure TNegoDlg.ShowNewContent(NewMode: integer); 177 begin 178 inherited ShowNewContent(NewMode); 179 SetButtonStates; 180 if (ClientMode=scDipCancelTreaty) or (ClientMode=scDipBreak) then 181 PassBtn.SmartHint:=Phrases.Lookup('BTN_NOTICE') 182 else PassBtn.SmartHint:=Phrases.Lookup('BTN_PASS'); 183 case MyRO.Treaty[DipMem[me].pContact] of 184 trNone: 185 begin 186 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTPEACE'); 187 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERPEACE'); 188 //WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTCEASEFIRE'); 189 //OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERCEASEFIRE'); 190 end; 191 {trCeasefire: 192 begin 193 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTPEACE'); 194 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERPEACE'); 195 end;} 196 trPeace: 197 begin 198 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTFRIENDLY'); 199 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERFRIENDLY'); 200 //WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDPEACE'); 201 //OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDPEACE'); 202 end; 203 trFriendlyContact: 204 begin 205 WantHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTALLIANCE'); 206 OfferHiTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERALLIANCE'); 207 end; 208 {trAlliance: 209 begin 210 WantLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_WANTENDALLIANCE'); 211 OfferLoTreatyBtn.SmartHint:=Phrases.Lookup('BTN_OFFERENDALLIANCE'); 212 end;} 213 end; 214 end; 215 216 procedure TNegoDlg.Start; 217 begin 218 if ClientMode<>scDipStart then with History[me] do 219 begin 220 if n=MaxHistory then 221 begin 222 move(Text[2], Text[0], (MaxHistory-2)*sizeof(integer)); 223 dec(n,2); 224 end; 225 Text[n]:=copy(DipCommandToString(DipMem[me].pContact,me, 226 DipMem[me].FormerTreaty, DipMem[me].SentCommand, ClientMode, 227 DipMem[me].SentOffer, ReceivedOffer),1,255); 228 inc(n); 229 end; 230 assert(History[me].n mod 2=1); 231 232 Page:=History[me].n; 233 FindAllowed; 234 ResetCurrentOffer; 235 236 (*if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver=1) 237 and (ReceivedOffer.nCost=0) and (ReceivedOffer.Price[0] and opMask=opTreaty) then 238 begin // prepare to demand price for treaty 239 CurrentOffer.nDeliver:=1; 240 CurrentOffer.Price[0]:=ReceivedOffer.Price[0]; 241 CurrentOffer.nCost:=0; 242 end 243 else 244 begin 245 if (ClientMode=scDipOffer) and (ReceivedOffer.nCost>0) then 242 assert(History[me].n mod 2 = 1); 243 244 Page := History[me].n; 245 FindAllowed; 246 ResetCurrentOffer; 247 248 (* if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver=1) 249 and (ReceivedOffer.nCost=0) and (ReceivedOffer.Price[0] and opMask=opTreaty) then 250 begin // prepare to demand price for treaty 251 CurrentOffer.nDeliver:=1; 252 CurrentOffer.Price[0]:=ReceivedOffer.Price[0]; 253 CurrentOffer.nCost:=0; 254 end 255 else 256 begin 257 if (ClientMode=scDipOffer) and (ReceivedOffer.nCost>0) then 246 258 begin 247 259 CurrentOffer.nDeliver:=1; 248 260 CurrentOffer.Price[0]:=ReceivedOffer.Price[ReceivedOffer.nDeliver] 249 261 end 250 else CurrentOffer.nDeliver:=0;251 if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver>0) then262 else CurrentOffer.nDeliver:=0; 263 if (ClientMode=scDipOffer) and (ReceivedOffer.nDeliver>0) then 252 264 begin 253 265 CurrentOffer.nCost:=1; 254 266 CurrentOffer.Price[CurrentOffer.nDeliver]:=ReceivedOffer.Price[0] 255 267 end 256 else CurrentOffer.nCost:=0257 end;*)258 DipCommand:=-1;259 ShowNewContent(wmPersistent);268 else CurrentOffer.nCost:=0 269 end; *) 270 DipCommand := -1; 271 ShowNewContent(wmPersistent); 260 272 end; 261 273 262 274 procedure TNegoDlg.SplitText(Text: string; Bounds: TRect); 263 275 var 264 nLines,Line,Start,Stop,OrdinaryStop,Indent,y: integer;265 s: string;266 preview, Dot: boolean;267 begin 268 for preview:=true downto false do269 begin 270 Start:=1;271 Line:=0;272 Indent:=0;273 while Start<Length(Text) do274 begin 275 Dot:=false;276 if (Start=1) or (Text[Start-1]='\') then277 if Text[Start]='-' then276 nLines, Line, Start, Stop, OrdinaryStop, Indent, Y: integer; 277 s: string; 278 preview, Dot: boolean; 279 begin 280 for preview := true downto false do 281 begin 282 Start := 1; 283 Line := 0; 284 Indent := 0; 285 while Start < Length(Text) do 286 begin 287 Dot := false; 288 if (Start = 1) or (Text[Start - 1] = '\') then 289 if Text[Start] = '-' then 278 290 begin 279 Indent:=ListIndent; 280 inc(Start); 281 if Start=Length(Text) then break; 282 Dot:=true; 291 Indent := ListIndent; 292 inc(Start); 293 if Start = Length(Text) then 294 break; 295 Dot := true; 283 296 end 284 else Indent:=0; 285 Stop:=Start; 286 while (Stop<Length(Text)) and (Text[Stop]<>'\') do 287 begin 288 inc(Stop); 289 if BiColorTextWidth(Offscreen.Canvas,Copy(Text,Start,Stop-Start+1)) 290 >Bounds.Right-Bounds.Left-PaperBorder_Left-PaperBorder_Right-Indent then 291 begin dec(Stop); break end; 297 else 298 Indent := 0; 299 Stop := Start; 300 while (Stop < Length(Text)) and (Text[Stop] <> '\') do 301 begin 302 inc(Stop); 303 if BiColorTextWidth(Offscreen.Canvas, 304 copy(Text, Start, Stop - Start + 1)) > Bounds.Right - Bounds.Left - 305 PaperBorder_Left - PaperBorder_Right - Indent then 306 begin 307 dec(Stop); 308 break 309 end; 292 310 end; 293 if Stop<>Length(Text) then 294 begin 295 OrdinaryStop:=Stop; 296 while (Text[OrdinaryStop+1]<>' ') and (Text[OrdinaryStop+1]<>'\') do 297 dec(OrdinaryStop); 298 if (OrdinaryStop+1-Start)*2>=Stop-Start then 299 Stop:=OrdinaryStop 311 if Stop <> Length(Text) then 312 begin 313 OrdinaryStop := Stop; 314 while (Text[OrdinaryStop + 1] <> ' ') and 315 (Text[OrdinaryStop + 1] <> '\') do 316 dec(OrdinaryStop); 317 if (OrdinaryStop + 1 - Start) * 2 >= Stop - Start then 318 Stop := OrdinaryStop 300 319 end; 301 if not preview then 302 begin 303 y:=(Bounds.Top+Bounds.Bottom) div 2-10*nLines+20*Line-1; 304 if Dot then 305 Sprite(offscreen,HGrSystem,Bounds.Left+PaperBorder_Left+(ListIndent-14), 306 y+7,8,8,90,16); 307 s:=Copy(Text,Start,Stop-Start+1); 308 BiColorTextOut(Offscreen.Canvas,Colors.Canvas.Pixels[clkMisc,cliPaperText], 309 $7F007F,Bounds.Left+PaperBorder_Left+Indent,y,s); 320 if not preview then 321 begin 322 Y := (Bounds.Top + Bounds.Bottom) div 2 - 10 * nLines + 20 * Line - 1; 323 if Dot then 324 Sprite(Offscreen, HGrSystem, Bounds.Left + PaperBorder_Left + 325 (ListIndent - 14), Y + 7, 8, 8, 90, 16); 326 s := copy(Text, Start, Stop - Start + 1); 327 BiColorTextOut(Offscreen.Canvas, Colors.Canvas.Pixels[clkMisc, 328 cliPaperText], $7F007F, Bounds.Left + PaperBorder_Left + 329 Indent, Y, s); 310 330 end; 311 inc(Line);312 Start:=Stop+2;331 inc(Line); 332 Start := Stop + 2; 313 333 end; 314 nLines:=Line;334 nLines := Line; 315 335 end 316 336 end; … … 318 338 procedure TNegoDlg.FindAllowed; 319 339 var 320 i: integer; 321 begin 322 CommandAllowed:=[scDipOffer-scDipStart]; 323 if ClientMode<>scDipBreak then include(CommandAllowed,scDipBreak-scDipStart); 324 if MyRO.Treaty[DipMem[me].pContact]>=trPeace then 325 include(CommandAllowed,scDipCancelTreaty-scDipStart); 326 if (ClientMode=scDipOffer) 327 and (Server(scDipAccept-sExecute,me,0,nil^)>=rExecuted) then 328 include(CommandAllowed,scDipAccept-scDipStart); 329 330 MyAllowed:=[opChoose shr 24, opMoney shr 24]; 331 OppoAllowed:=[opChoose shr 24, opMoney shr 24]; 332 if not IsCivilReportNew(DipMem[me].pContact) then 340 i: integer; 341 begin 342 CommandAllowed := [scDipOffer - scDipStart]; 343 if ClientMode <> scDipBreak then 344 include(CommandAllowed, scDipBreak - scDipStart); 345 if MyRO.Treaty[DipMem[me].pContact] >= trPeace then 346 include(CommandAllowed, scDipCancelTreaty - scDipStart); 347 if (ClientMode = scDipOffer) and (Server(scDipAccept - sExecute, me, 0, nil^) 348 >= rExecuted) then 349 include(CommandAllowed, scDipAccept - scDipStart); 350 351 MyAllowed := [opChoose shr 24, opMoney shr 24]; 352 OppoAllowed := [opChoose shr 24, opMoney shr 24]; 353 if not IsCivilReportNew(DipMem[me].pContact) then 333 354 begin // no up-to-date civil report 334 MyAllowed:=MyAllowed+[opCivilReport shr 24]; 335 for i:=0 to nAdv-1 do if MyRO.Tech[i]>=tsApplicable then 336 begin MyAllowed:=MyAllowed+[opAllTech shr 24]; break end; 337 OppoAllowed:=OppoAllowed+[opCivilReport shr 24,opAllTech shr 24]; 355 MyAllowed := MyAllowed + [opCivilReport shr 24]; 356 for i := 0 to nAdv - 1 do 357 if MyRO.Tech[i] >= tsApplicable then 358 begin 359 MyAllowed := MyAllowed + [opAllTech shr 24]; 360 break 361 end; 362 OppoAllowed := OppoAllowed + [opCivilReport shr 24, opAllTech shr 24]; 338 363 end 339 else364 else 340 365 begin // check techs 341 for i:=0 to nAdv-1 do if not (i in FutureTech) then 342 if (MyRO.Tech[i]<tsSeen) 343 and (MyRO.EnemyReport[DipMem[me].pContact].Tech[i]>=tsApplicable) then 344 OppoAllowed:=OppoAllowed+[opAllTech shr 24] 345 else if (MyRO.EnemyReport[DipMem[me].pContact].Tech[i]<tsSeen) 346 and (MyRO.Tech[i]>=tsApplicable) then 347 MyAllowed:=MyAllowed+[opAllTech shr 24]; 348 end; 349 if not IsMilReportNew(DipMem[me].pContact) then 366 for i := 0 to nAdv - 1 do 367 if not(i in FutureTech) then 368 if (MyRO.Tech[i] < tsSeen) and 369 (MyRO.EnemyReport[DipMem[me].pContact].Tech[i] >= tsApplicable) then 370 OppoAllowed := OppoAllowed + [opAllTech shr 24] 371 else if (MyRO.EnemyReport[DipMem[me].pContact].Tech[i] < tsSeen) and 372 (MyRO.Tech[i] >= tsApplicable) then 373 MyAllowed := MyAllowed + [opAllTech shr 24]; 374 end; 375 if not IsMilReportNew(DipMem[me].pContact) then 350 376 begin // no up-to-date military report 351 MyAllowed:=MyAllowed+[opMilReport shr 24];352 if MyRO.nModel>3 then353 MyAllowed:=MyAllowed+[opAllModel shr 24];354 OppoAllowed:=OppoAllowed+[opMilReport shr 24,opAllModel shr 24];377 MyAllowed := MyAllowed + [opMilReport shr 24]; 378 if MyRO.nModel > 3 then 379 MyAllowed := MyAllowed + [opAllModel shr 24]; 380 OppoAllowed := OppoAllowed + [opMilReport shr 24, opAllModel shr 24]; 355 381 end 356 else 357 begin 358 if ModalSelectDlg.OnlyChoice(kChooseModel)<>mixAll then 359 MyAllowed:=MyAllowed+[opAllModel shr 24]; 360 if ModalSelectDlg.OnlyChoice(kChooseEModel)<>mixAll then 361 OppoAllowed:=OppoAllowed+[opAllModel shr 24]; 362 end; 363 if MyRO.Treaty[DipMem[me].pContact]<trAlliance then 364 begin 365 MyAllowed:=MyAllowed+[opTreaty shr 24,opMap shr 24]; 366 OppoAllowed:=OppoAllowed+[opTreaty shr 24,opMap shr 24]; 367 end; 368 {if MyRO.Treaty[DipMem[me].pContact] in [trNone,trPeace,trAlliance] then 369 begin 370 MyAllowed:=MyAllowed+[opLowTreaty shr 24]; 371 OppoAllowed:=OppoAllowed+[opLowTreaty shr 24]; 372 end;} 373 for i:=0 to nShipPart-1 do 374 begin 375 if MyRO.Ship[me].Parts[i]>0 then 376 include(MyAllowed, opShipParts shr 24); 377 if MyRO.Ship[DipMem[me].pContact].Parts[i]>0 then 378 include(OppoAllowed, opShipParts shr 24); 379 end; 380 MyAllowed:=MyAllowed-DipMem[me].DeliveredPrices*[opAllTech shr 24,opAllModel shr 24,opCivilReport shr 24,opMilReport shr 24,opMap shr 24]; 381 OppoAllowed:=OppoAllowed-DipMem[me].ReceivedPrices*[opAllTech shr 24,opAllModel shr 24,opCivilReport shr 24,opMilReport shr 24,opMap shr 24]; 382 end; 383 384 procedure TNegoDlg.PaintNationPicture(x,y,p: integer); 385 begin 386 with Offscreen.Canvas do 387 begin 388 Pen.Color:=$000000; 389 Brush.Color:=Tribe[p].Color; 390 Rectangle(x-6,y-1,x+70,y+49); 391 Brush.Color:=$000000; 392 Tribe[p].InitAge(GetAge(p)); 393 if Tribe[p].faceHGr>=0 then 394 Dump(offscreen,Tribe[p].faceHGr,x,y,64,48, 395 1+Tribe[p].facepix mod 10 *65,1+Tribe[p].facepix div 10 *49) 396 else FillRect(Rect(x,y,x+64,y+48)); 397 Brush.Style:=bsClear; 398 Frame(Offscreen.Canvas,x-1,y-1,x+64,y+48,$000000,$000000); 382 else 383 begin 384 if ModalSelectDlg.OnlyChoice(kChooseModel) <> mixAll then 385 MyAllowed := MyAllowed + [opAllModel shr 24]; 386 if ModalSelectDlg.OnlyChoice(kChooseEModel) <> mixAll then 387 OppoAllowed := OppoAllowed + [opAllModel shr 24]; 388 end; 389 if MyRO.Treaty[DipMem[me].pContact] < trAlliance then 390 begin 391 MyAllowed := MyAllowed + [opTreaty shr 24, opMap shr 24]; 392 OppoAllowed := OppoAllowed + [opTreaty shr 24, opMap shr 24]; 393 end; 394 { if MyRO.Treaty[DipMem[me].pContact] in [trNone,trPeace,trAlliance] then 395 begin 396 MyAllowed:=MyAllowed+[opLowTreaty shr 24]; 397 OppoAllowed:=OppoAllowed+[opLowTreaty shr 24]; 398 end; } 399 for i := 0 to nShipPart - 1 do 400 begin 401 if MyRO.Ship[me].Parts[i] > 0 then 402 include(MyAllowed, opShipParts shr 24); 403 if MyRO.Ship[DipMem[me].pContact].Parts[i] > 0 then 404 include(OppoAllowed, opShipParts shr 24); 405 end; 406 MyAllowed := MyAllowed - DipMem[me].DeliveredPrices * 407 [opAllTech shr 24, opAllModel shr 24, opCivilReport shr 24, 408 opMilReport shr 24, opMap shr 24]; 409 OppoAllowed := OppoAllowed - DipMem[me].ReceivedPrices * 410 [opAllTech shr 24, opAllModel shr 24, opCivilReport shr 24, 411 opMilReport shr 24, opMap shr 24]; 412 end; 413 414 procedure TNegoDlg.PaintNationPicture(X, Y, p: integer); 415 begin 416 with Offscreen.Canvas do 417 begin 418 Pen.Color := $000000; 419 Brush.Color := Tribe[p].Color; 420 Rectangle(X - 6, Y - 1, X + 70, Y + 49); 421 Brush.Color := $000000; 422 Tribe[p].InitAge(GetAge(p)); 423 if Tribe[p].faceHGr >= 0 then 424 Dump(Offscreen, Tribe[p].faceHGr, X, Y, 64, 48, 425 1 + Tribe[p].facepix mod 10 * 65, 1 + Tribe[p].facepix div 10 * 49) 426 else 427 FillRect(Rect(X, Y, X + 64, Y + 48)); 428 Brush.Style := bsClear; 429 Frame(Offscreen.Canvas, X - 1, Y - 1, X + 64, Y + 48, $000000, $000000); 399 430 end 400 431 end; … … 402 433 procedure TNegoDlg.SetButtonStates; 403 434 var 404 cix: integer; 405 IsActionPage: boolean; 406 begin 407 IsActionPage:= Page=History[me].n; 408 409 AcceptBtn.Possible:= IsActionPage and (scDipAccept-scDipStart in CommandAllowed); 410 AcceptBtn.Lit:= DipCommand=scDipAccept; 411 PassBtn.Possible:= IsActionPage and (scDipOffer-scDipStart in CommandAllowed); 412 PassBtn.Lit:= (DipCommand=scDipNotice) 413 or (DipCommand=scDipOffer) and (CurrentOffer.nDeliver=0) and (CurrentOffer.nCost=0); 414 ExitBtn.Possible:= IsActionPage and (scDipBreak-scDipStart in CommandAllowed); 415 ExitBtn.Lit:= DipCommand=scDipBreak; 416 CancelTreatyBtn.Possible:= IsActionPage and (scDipCancelTreaty-scDipStart in CommandAllowed); 417 CancelTreatyBtn.Lit:= DipCommand=scDipCancelTreaty; 418 419 for cix:=0 to ComponentCount-1 do 420 if Components[cix] is TButtonN then 421 with TButtonN(Components[cix]) do 422 case Tag shr 8 of 423 1: // Costs 424 begin 425 Possible:= IsActionPage and (ButtonPrice[Tag and $FF] shr 24 in OppoAllowed); 426 Lit:=Costs[Tag and $FF]<>$FFFFFFFF; 427 end; 428 2: // Delivers 429 begin 430 Possible:= IsActionPage and (ButtonPrice[Tag and $FF] shr 24 in MyAllowed); 431 Lit:=Delivers[Tag and $FF]<>$FFFFFFFF; 432 end 435 cix: integer; 436 IsActionPage: boolean; 437 begin 438 IsActionPage := Page = History[me].n; 439 440 AcceptBtn.Possible := IsActionPage and 441 (scDipAccept - scDipStart in CommandAllowed); 442 AcceptBtn.Lit := DipCommand = scDipAccept; 443 PassBtn.Possible := IsActionPage and 444 (scDipOffer - scDipStart in CommandAllowed); 445 PassBtn.Lit := (DipCommand = scDipNotice) or (DipCommand = scDipOffer) and 446 (CurrentOffer.nDeliver = 0) and (CurrentOffer.nCost = 0); 447 ExitBtn.Possible := IsActionPage and 448 (scDipBreak - scDipStart in CommandAllowed); 449 ExitBtn.Lit := DipCommand = scDipBreak; 450 CancelTreatyBtn.Possible := IsActionPage and 451 (scDipCancelTreaty - scDipStart in CommandAllowed); 452 CancelTreatyBtn.Lit := DipCommand = scDipCancelTreaty; 453 454 for cix := 0 to ComponentCount - 1 do 455 if Components[cix] is TButtonN then 456 with TButtonN(Components[cix]) do 457 case Tag shr 8 of 458 1: // Costs 459 begin 460 Possible := IsActionPage and 461 (ButtonPrice[Tag and $FF] shr 24 in OppoAllowed); 462 Lit := Costs[Tag and $FF] <> $FFFFFFFF; 463 end; 464 2: // Delivers 465 begin 466 Possible := IsActionPage and 467 (ButtonPrice[Tag and $FF] shr 24 in MyAllowed); 468 Lit := Delivers[Tag and $FF] <> $FFFFFFFF; 469 end 433 470 end; 434 471 end; … … 436 473 procedure TNegoDlg.OffscreenPaint; 437 474 var 438 i,cred: integer; 439 s: string; 440 OkEnabled: boolean; 441 begin 442 if (OffscreenUser<>nil) and (OffscreenUser<>self) then OffscreenUser.Update; 475 i, cred: integer; 476 s: string; 477 OkEnabled: boolean; 478 begin 479 if (OffscreenUser <> nil) and (OffscreenUser <> self) then 480 OffscreenUser.Update; 443 481 // complete working with old owner to prevent rebound 444 OffscreenUser:=self; 445 446 if (DipCommand>=0) and (Page=History[me].n) then 447 History[me].Text[History[me].n]:=copy(DipCommandToString(me,DipMem[me].pContact, 448 MyRO.Treaty[DipMem[me].pContact],ClientMode, DipCommand, ReceivedOffer, CurrentOffer),1,255); 449 450 FwdBtn.Visible:= Page<History[me].n; 451 BwdBtn.Visible:= Page>=2; 452 if Page<History[me].n then OkEnabled:=false 453 else if DipCommand=scDipOffer then 454 OkEnabled:= Server(scDipOffer-sExecute,me,0,CurrentOffer)>=rExecuted 455 else OkEnabled:= DipCommand>=0; 456 OkBtn.Visible:=OkEnabled; 457 458 Fill(Offscreen.Canvas,3,3,ClientWidth-6,ClientHeight-6, 459 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 460 Frame(Offscreen.Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 461 Frame(Offscreen.Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 462 Frame(Offscreen.Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 463 Corner(Offscreen.Canvas,1,1,0,MainTexture); 464 Corner(Offscreen.Canvas,ClientWidth-9,1,1,MainTexture); 465 Corner(Offscreen.Canvas,1,ClientHeight-9,2,MainTexture); 466 Corner(Offscreen.Canvas,ClientWidth-9,ClientHeight-9,3,MainTexture); 467 468 BtnFrame(Offscreen.Canvas,OkBtn.BoundsRect,MainTexture); 469 BtnFrame(Offscreen.Canvas,BwdBtn.BoundsRect,MainTexture); 470 BtnFrame(Offscreen.Canvas,FwdBtn.BoundsRect,MainTexture); 471 BtnFrame(Offscreen.Canvas,CloseBtn.BoundsRect,MainTexture); 472 473 RFrame(Offscreen.Canvas,xPadC-2, yPadC-2, xPadC+41+42*3,yPadC+41, 474 $FFFFFF,$B0B0B0); 475 RFrame(Offscreen.Canvas,xPad0-2, yPad0-2,xPad0+41+42*3, 476 yPad0+41+42*2,$FFFFFF,$B0B0B0); 477 RFrame(Offscreen.Canvas,xPad1-2, yPad1-2,xPad1+41+42*3, 478 yPad1+41+42*2,$FFFFFF,$B0B0B0); 479 480 PaintNationPicture(xNationPicture0,yNationPicture,DipMem[me].pContact); 481 PaintNationPicture(xNationPicture1,yNationPicture,me); 482 483 if History[me].Text[Page-1]<>'' then 484 begin 485 FillSeamless(Offscreen.Canvas, xText0, yText0, wText, hText, 0, 0, Paper); 486 i:=Page-1; 487 if History[me].Text[0]='' then dec(i); 488 if i<16 then 489 begin 482 OffscreenUser := self; 483 484 if (DipCommand >= 0) and (Page = History[me].n) then 485 History[me].Text[History[me].n] := 486 copy(DipCommandToString(me, DipMem[me].pContact, 487 MyRO.Treaty[DipMem[me].pContact], ClientMode, DipCommand, ReceivedOffer, 488 CurrentOffer), 1, 255); 489 490 FwdBtn.Visible := Page < History[me].n; 491 BwdBtn.Visible := Page >= 2; 492 if Page < History[me].n then 493 OkEnabled := false 494 else if DipCommand = scDipOffer then 495 OkEnabled := Server(scDipOffer - sExecute, me, 0, CurrentOffer) >= rExecuted 496 else 497 OkEnabled := DipCommand >= 0; 498 OkBtn.Visible := OkEnabled; 499 500 Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6, 501 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2); 502 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 503 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 504 MainTexture.clBevelLight, MainTexture.clBevelShade); 505 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 506 MainTexture.clBevelLight, MainTexture.clBevelShade); 507 Corner(Offscreen.Canvas, 1, 1, 0, MainTexture); 508 Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture); 509 Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture); 510 Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture); 511 512 BtnFrame(Offscreen.Canvas, OkBtn.BoundsRect, MainTexture); 513 BtnFrame(Offscreen.Canvas, BwdBtn.BoundsRect, MainTexture); 514 BtnFrame(Offscreen.Canvas, FwdBtn.BoundsRect, MainTexture); 515 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture); 516 517 RFrame(Offscreen.Canvas, xPadC - 2, yPadC - 2, xPadC + 41 + 42 * 3, 518 yPadC + 41, $FFFFFF, $B0B0B0); 519 RFrame(Offscreen.Canvas, xPad0 - 2, yPad0 - 2, xPad0 + 41 + 42 * 3, 520 yPad0 + 41 + 42 * 2, $FFFFFF, $B0B0B0); 521 RFrame(Offscreen.Canvas, xPad1 - 2, yPad1 - 2, xPad1 + 41 + 42 * 3, 522 yPad1 + 41 + 42 * 2, $FFFFFF, $B0B0B0); 523 524 PaintNationPicture(xNationPicture0, yNationPicture, DipMem[me].pContact); 525 PaintNationPicture(xNationPicture1, yNationPicture, me); 526 527 if History[me].Text[Page - 1] <> '' then 528 begin 529 FillSeamless(Offscreen.Canvas, xText0, yText0, wText, hText, 0, 0, Paper); 530 i := Page - 1; 531 if History[me].Text[0] = '' then 532 dec(i); 533 if i < 16 then 534 begin 535 Offscreen.Canvas.Font.Assign(RomanFont); 536 Offscreen.Canvas.TextOut 537 (xText0 + (wText - Offscreen.Canvas.TextWidth(RomanNo[i])) div 2, 538 yText0 + (hText - Offscreen.Canvas.TextHeight(RomanNo[i])) div 2, 539 RomanNo[i]); 540 end 541 end; 542 FillSeamless(Offscreen.Canvas, xText1, yText1, wText, hText, 0, 0, Paper); 543 i := Page; 544 if History[me].Text[0] = '' then 545 dec(i); 546 if i < 16 then 547 begin 490 548 Offscreen.Canvas.Font.Assign(RomanFont); 491 Offscreen.Canvas.TextOut(xText0+(wText-Offscreen.Canvas.TextWidth(RomanNo[i])) div 2, 492 yText0+(hText-Offscreen.Canvas.TextHeight(RomanNo[i])) div 2,RomanNo[i]); 493 end 494 end; 495 FillSeamless(Offscreen.Canvas, xText1, yText1, wText, hText, 0, 0, Paper); 496 i:=Page; 497 if History[me].Text[0]='' then dec(i); 498 if i<16 then 499 begin 500 Offscreen.Canvas.Font.Assign(RomanFont); 501 Offscreen.Canvas.TextOut(xText1+(wText-Offscreen.Canvas.TextWidth(RomanNo[i])) div 2, 502 yText1+(hText-Offscreen.Canvas.TextHeight(RomanNo[i])) div 2,RomanNo[i]); 503 end; 504 with Offscreen.Canvas do 505 begin 506 Brush.Color:=MainTexture.clBevelShade; 507 if History[me].Text[Page-1]<>'' then 508 begin 509 FillRect(Rect(xText0+wText, yText0+PaperShade, xText0+wText+PaperShade, 510 yText0+hText+PaperShade)); 511 FillRect(Rect(xText0+PaperShade, yText0+hText, xText0+wText+PaperShade, 512 yText0+hText+PaperShade)); 549 Offscreen.Canvas.TextOut 550 (xText1 + (wText - Offscreen.Canvas.TextWidth(RomanNo[i])) div 2, 551 yText1 + (hText - Offscreen.Canvas.TextHeight(RomanNo[i])) div 2, 552 RomanNo[i]); 553 end; 554 with Offscreen.Canvas do 555 begin 556 Brush.Color := MainTexture.clBevelShade; 557 if History[me].Text[Page - 1] <> '' then 558 begin 559 FillRect(Rect(xText0 + wText, yText0 + PaperShade, 560 xText0 + wText + PaperShade, yText0 + hText + PaperShade)); 561 FillRect(Rect(xText0 + PaperShade, yText0 + hText, 562 xText0 + wText + PaperShade, yText0 + hText + PaperShade)); 513 563 end; 514 FillRect(Rect(xText1+wText, yText1+PaperShade, xText1+wText+PaperShade,515 yText1+hText+PaperShade));516 FillRect(Rect(xText1+PaperShade, yText1+hText, xText1+wText+PaperShade,517 yText1+hText+PaperShade));518 Brush.Style:=bsClear;519 end; 520 521 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]);522 523 {if Page=History[me].n then524 begin // show attitude525 s:=Phrases.Lookup('ATTITUDE',MyRO.EnemyReport[DipMem[me].pContact].Attitude);526 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture,527 RisedTextOut(Offscreen.Canvas,xText0+wText div 2-564 FillRect(Rect(xText1 + wText, yText1 + PaperShade, 565 xText1 + wText + PaperShade, yText1 + hText + PaperShade)); 566 FillRect(Rect(xText1 + PaperShade, yText1 + hText, 567 xText1 + wText + PaperShade, yText1 + hText + PaperShade)); 568 Brush.Style := bsClear; 569 end; 570 571 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 572 573 { if Page=History[me].n then 574 begin // show attitude 575 s:=Phrases.Lookup('ATTITUDE',MyRO.EnemyReport[DipMem[me].pContact].Attitude); 576 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture, 577 RisedTextOut(Offscreen.Canvas,xText0+wText div 2- 528 578 BiColorTextWidth(Offscreen.Canvas,s) div 2,yAttitude,s); 529 s:=Phrases.Lookup('ATTITUDE',MyRO.Attitude[DipMem[me].pContact]);530 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture,531 RisedTextOut(Offscreen.Canvas,xText1+wText div 2-579 s:=Phrases.Lookup('ATTITUDE',MyRO.Attitude[DipMem[me].pContact]); 580 //LoweredTextOut(Offscreen.Canvas,-1,MainTexture, 581 RisedTextOut(Offscreen.Canvas,xText1+wText div 2- 532 582 BiColorTextWidth(Offscreen.Canvas,s) div 2,yAttitude,s); 533 end;} 534 535 if History[me].Text[Page-1]<>'' then 536 SplitText(History[me].Text[Page-1], 537 Rect(xText0, yText0, xText0+wText, yText0+hText)); 538 if (Page<History[me].n) or OkEnabled then 539 SplitText(History[me].Text[Page], Rect(xText1, yText1, xText1+wText, yText1+hText)); 540 541 // show credibility 542 Offscreen.Canvas.Font.Assign(UniFont[ftTiny]); 543 cred:=MyRO.EnemyReport[DipMem[me].pContact].Credibility; 544 case cred of 545 0..49: i:= 3; 50..90: i:=0; 91..100: i:=1; end; 546 PaintProgressBar(Offscreen.Canvas,i,xCred0,yCred0+17,(cred+2) div 5,0,20,MainTexture); 547 s:=IntToStr(cred); 548 RisedTextOut(Offscreen.Canvas,xCred0+10-(BiColorTextWidth(Offscreen.Canvas,s)+1) div 2,yCred0,s); 549 case MyRO.Credibility of 550 0..49: i:= 3; 50..90: i:=0; 91..100: i:=1; end; 551 PaintProgressBar(Offscreen.Canvas,i,xCred1,yCred1+17,(MyRO.Credibility+2) div 5,0,20,MainTexture); 552 s:=IntToStr(MyRO.Credibility); 553 RisedTextOut(Offscreen.Canvas,xCred1+10-(BiColorTextWidth(Offscreen.Canvas,s)+1) div 2,yCred1,s); 554 555 MarkUsedOffscreen(ClientWidth,ClientHeight); 556 end; {OffscreenPaint} 583 end; } 584 585 if History[me].Text[Page - 1] <> '' then 586 SplitText(History[me].Text[Page - 1], Rect(xText0, yText0, xText0 + wText, 587 yText0 + hText)); 588 if (Page < History[me].n) or OkEnabled then 589 SplitText(History[me].Text[Page], Rect(xText1, yText1, xText1 + wText, 590 yText1 + hText)); 591 592 // show credibility 593 Offscreen.Canvas.Font.Assign(UniFont[ftTiny]); 594 cred := MyRO.EnemyReport[DipMem[me].pContact].Credibility; 595 case cred of 596 0 .. 49: 597 i := 3; 598 50 .. 90: 599 i := 0; 600 91 .. 100: 601 i := 1; 602 end; 603 PaintProgressBar(Offscreen.Canvas, i, xCred0, yCred0 + 17, (cred + 2) div 5, 604 0, 20, MainTexture); 605 s := IntToStr(cred); 606 RisedTextOut(Offscreen.Canvas, xCred0 + 10 - 607 (BiColorTextWidth(Offscreen.Canvas, s) + 1) div 2, yCred0, s); 608 case MyRO.Credibility of 609 0 .. 49: 610 i := 3; 611 50 .. 90: 612 i := 0; 613 91 .. 100: 614 i := 1; 615 end; 616 PaintProgressBar(Offscreen.Canvas, i, xCred1, yCred1 + 17, 617 (MyRO.Credibility + 2) div 5, 0, 20, MainTexture); 618 s := IntToStr(MyRO.Credibility); 619 RisedTextOut(Offscreen.Canvas, xCred1 + 10 - 620 (BiColorTextWidth(Offscreen.Canvas, s) + 1) div 2, yCred1, s); 621 622 MarkUsedOffscreen(ClientWidth, ClientHeight); 623 end; { OffscreenPaint } 557 624 558 625 procedure TNegoDlg.Initiate; 559 626 begin 560 History[me].n:=1;561 History[me].Text[0]:='';627 History[me].n := 1; 628 History[me].Text[0] := ''; 562 629 end; 563 630 564 631 procedure TNegoDlg.Respond; 565 632 begin 566 History[me].n:=0;633 History[me].n := 0; 567 634 end; 568 635 569 636 procedure TNegoDlg.FormMouseDown(Sender: TObject; Button: TMouseButton; 570 Shift: TShiftState; X, Y: Integer);571 begin 572 if (x>=xNationPicture0) and (x<xNationPicture0+64) 573 and (y>=yNationPicture) and (y<yNationPicture+48) then574 NatStatDlg.ShowNewContent(FWindowMode or wmPersistent, DipMem[me].pContact)575 else if (x>=xNationPicture1) and (x<xNationPicture1+64) 576 and (y>=yNationPicture) and (y<yNationPicture+48) then577 NatStatDlg.ShowNewContent(FWindowMode or wmPersistent,me)637 Shift: TShiftState; X, Y: integer); 638 begin 639 if (X >= xNationPicture0) and (X < xNationPicture0 + 64) and 640 (Y >= yNationPicture) and (Y < yNationPicture + 48) then 641 NatStatDlg.ShowNewContent(FWindowMode or wmPersistent, DipMem[me].pContact) 642 else if (X >= xNationPicture1) and (X < xNationPicture1 + 64) and 643 (Y >= yNationPicture) and (Y < yNationPicture + 48) then 644 NatStatDlg.ShowNewContent(FWindowMode or wmPersistent, me) 578 645 end; 579 646 580 647 procedure TNegoDlg.BwdBtnClick(Sender: TObject); 581 648 begin 582 dec(Page,2);583 SetButtonStates;584 SmartUpdateContent;649 dec(Page, 2); 650 SetButtonStates; 651 SmartUpdateContent; 585 652 end; 586 653 587 654 procedure TNegoDlg.FwdBtnClick(Sender: TObject); 588 655 begin 589 inc(Page,2);590 SetButtonStates;591 SmartUpdateContent;656 inc(Page, 2); 657 SetButtonStates; 658 SmartUpdateContent; 592 659 end; 593 660 594 661 procedure TNegoDlg.OkBtnClick(Sender: TObject); 595 662 begin 596 inc(History[me].n); 597 if DipCommand=scDipOffer then 598 MainScreen.OfferCall(CurrentOffer) 599 else MainScreen.DipCall(DipCommand); 663 inc(History[me].n); 664 if DipCommand = scDipOffer then 665 MainScreen.OfferCall(CurrentOffer) 666 else 667 MainScreen.DipCall(DipCommand); 600 668 end; 601 669 602 670 procedure TNegoDlg.CloseBtnClick(Sender: TObject); 603 671 begin 604 Close672 Close 605 673 end; 606 674 … … 608 676 Shift: TShiftState); 609 677 begin 610 if Key=VK_RETURN then 611 begin 612 if OkBtn.Visible then OkBtnClick(nil) 678 if Key = VK_RETURN then 679 begin 680 if OkBtn.Visible then 681 OkBtnClick(nil) 613 682 end 614 else inherited 683 else 684 inherited 615 685 end; 616 686 617 687 procedure TNegoDlg.BuildCurrentOffer; 618 688 var 619 i: integer; 620 begin 621 CurrentOffer.nDeliver:=0; 622 CurrentOffer.nCost:=0; 623 for i:=0 to 11 do if Delivers[i]<>$FFFFFFFF then 624 begin 625 CurrentOffer.Price[CurrentOffer.nDeliver]:=Delivers[i]; 626 inc(CurrentOffer.nDeliver); 627 end; 628 for i:=0 to 11 do if Costs[i]<>$FFFFFFFF then 629 begin 630 CurrentOffer.Price[CurrentOffer.nDeliver+CurrentOffer.nCost]:=Costs[i]; 631 inc(CurrentOffer.nCost); 632 end; 689 i: integer; 690 begin 691 CurrentOffer.nDeliver := 0; 692 CurrentOffer.nCost := 0; 693 for i := 0 to 11 do 694 if Delivers[i] <> $FFFFFFFF then 695 begin 696 CurrentOffer.Price[CurrentOffer.nDeliver] := Delivers[i]; 697 inc(CurrentOffer.nDeliver); 698 end; 699 for i := 0 to 11 do 700 if Costs[i] <> $FFFFFFFF then 701 begin 702 CurrentOffer.Price[CurrentOffer.nDeliver + CurrentOffer.nCost] := 703 Costs[i]; 704 inc(CurrentOffer.nCost); 705 end; 633 706 end; 634 707 635 708 procedure TNegoDlg.WantClick(Sender: TObject); 636 709 var 637 a,i,max: integer;638 Price: cardinal;639 begin 640 if (Page<>History[me].n) 641 or (ClientMode=scDipCancelTreaty) or (ClientMode=scDipBreak) then642 exit;643 if Costs[TButtonN(Sender).Tag and $FF]<>$FFFFFFFF then644 Price:=$FFFFFFFF // toggle off645 else646 begin 647 if CurrentOffer.nCost>=2 then648 begin 649 SimpleMessage(Phrases.Lookup('MAX2WANTS'));650 exit710 a, i, max: integer; 711 Price: cardinal; 712 begin 713 if (Page <> History[me].n) or (ClientMode = scDipCancelTreaty) or 714 (ClientMode = scDipBreak) then 715 exit; 716 if Costs[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then 717 Price := $FFFFFFFF // toggle off 718 else 719 begin 720 if CurrentOffer.nCost >= 2 then 721 begin 722 SimpleMessage(Phrases.Lookup('MAX2WANTS')); 723 exit 651 724 end; 652 Price:=ButtonPrice[TButtonN(Sender).Tag and $FF]; 653 if not (Price shr 24 in OppoAllowed) then exit; 654 case Price of 655 opCivilReport, opMilReport: 656 inc(Price,DipMem[me].pContact shl 16+MyRO.Turn); // !!! choose player and year! 657 opMoney: 658 begin // choose amount 659 InputDlg.Caption:=Phrases.Lookup('TITLE_AMOUNT'); 660 InputDlg.EInput.Text:=''; 661 InputDlg.CenterToRect(BoundsRect); 662 InputDlg.ShowModal; 663 if InputDlg.ModalResult<>mrOK then exit; 664 val(InputDlg.EInput.Text,a,i); 665 if (i<>0) or (a<=0) or (a>=MaxMoneyPrice) then exit; 666 inc(Price,a); 667 end; 668 opShipParts: 669 begin // choose type and number 670 if MyRO.NatBuilt[imSpacePort]=0 then with MessgExDlg do 725 Price := ButtonPrice[TButtonN(Sender).Tag and $FF]; 726 if not(Price shr 24 in OppoAllowed) then 727 exit; 728 case Price of 729 opCivilReport, opMilReport: 730 inc(Price, DipMem[me].pContact shl 16 + MyRO.Turn); 731 // !!! choose player and year! 732 opMoney: 733 begin // choose amount 734 InputDlg.Caption := Phrases.Lookup('TITLE_AMOUNT'); 735 InputDlg.EInput.Text := ''; 736 InputDlg.CenterToRect(BoundsRect); 737 InputDlg.ShowModal; 738 if InputDlg.ModalResult <> mrOK then 739 exit; 740 val(InputDlg.EInput.Text, a, i); 741 if (i <> 0) or (a <= 0) or (a >= MaxMoneyPrice) then 742 exit; 743 inc(Price, a); 744 end; 745 opShipParts: 746 begin // choose type and number 747 if MyRO.NatBuilt[imSpacePort] = 0 then 748 with MessgExDlg do 749 begin 750 OpenSound := 'WARNING_LOWSUPPORT'; 751 MessgText := Phrases.Lookup('NOSPACEPORT'); 752 Kind := mkYesNo; 753 IconKind := mikImp; 754 IconIndex := imSpacePort; 755 ShowModal; 756 if ModalResult <> mrOK then 757 exit 758 end; 759 ModalSelectDlg.ShowNewContent(wmModal, kEShipPart); 760 if ModalSelectDlg.result < 0 then 761 exit; 762 inc(Price, ModalSelectDlg.result shl 16); 763 max := MyRO.Ship[DipMem[me].pContact].Parts[ModalSelectDlg.result]; 764 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER'); 765 InputDlg.EInput.Text := ''; 766 InputDlg.CenterToRect(BoundsRect); 767 InputDlg.ShowModal; 768 if InputDlg.ModalResult <> mrOK then 769 exit; 770 val(InputDlg.EInput.Text, a, i); 771 if (i <> 0) or (a <= 0) then 772 exit; 773 if a > max then 774 a := max; 775 if a > MaxShipPartPrice then 776 a := MaxShipPartPrice; 777 inc(Price, a) 778 end; 779 opAllTech: 780 begin // choose technology 781 ModalSelectDlg.ShowNewContent(wmModal, kChooseETech); 782 if ModalSelectDlg.result < 0 then 783 exit; 784 if ModalSelectDlg.result = adAll then 785 Price := opAllTech 786 else 787 Price := OpTech + ModalSelectDlg.result; 788 end; 789 opAllModel: 790 begin // choose model 791 ModalSelectDlg.ShowNewContent(wmModal, kChooseEModel); 792 if ModalSelectDlg.result < 0 then 793 exit; 794 if ModalSelectDlg.result = mixAll then 795 Price := opAllModel 796 else 797 Price := OpModel + MyRO.EnemyModel[ModalSelectDlg.result].mix; 798 end; 799 opTreaty: 671 800 begin 672 OpenSound:='WARNING_LOWSUPPORT'; 673 MessgText:=Phrases.Lookup('NOSPACEPORT'); 674 Kind:=mkYesNo; 675 IconKind:=mikImp; 676 IconIndex:=imSpacePort; 677 ShowModal; 678 if ModalResult<>mrOK then exit 679 end; 680 ModalSelectDlg.ShowNewContent(wmModal,kEShipPart); 681 if ModalSelectDlg.result<0 then exit; 682 inc(Price, ModalSelectDlg.result shl 16); 683 max:=MyRO.Ship[DipMem[me].pContact].Parts[ModalSelectDlg.result]; 684 InputDlg.Caption:=Phrases.Lookup('TITLE_NUMBER'); 685 InputDlg.EInput.Text:=''; 686 InputDlg.CenterToRect(BoundsRect); 687 InputDlg.ShowModal; 688 if InputDlg.ModalResult<>mrOK then exit; 689 val(InputDlg.EInput.Text,a,i); 690 if (i<>0) or (a<=0) then exit; 691 if a>max then a:=max; 692 if a>MaxShipPartPrice then a:=MaxShipPartPrice; 693 inc(Price,a) 694 end; 695 opAllTech: 696 begin // choose technology 697 ModalSelectDlg.ShowNewContent(wmModal,kChooseETech); 698 if ModalSelectDlg.result<0 then exit; 699 if ModalSelectDlg.result=adAll then Price:=opAllTech 700 else Price:=OpTech+ModalSelectDlg.result; 701 end; 702 opAllModel: 703 begin // choose model 704 ModalSelectDlg.ShowNewContent(wmModal,kChooseEModel); 705 if ModalSelectDlg.result<0 then exit; 706 if ModalSelectDlg.result=mixAll then Price:=opAllModel 707 else Price:=OpModel+MyRO.EnemyModel[ModalSelectDlg.result].mix; 708 end; 709 opTreaty: 710 begin 711 if MyRO.Treaty[DipMem[me].pContact]<trPeace then Price:=opTreaty+trPeace 712 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]+1; 713 end; 714 { opLowTreaty: 715 begin 716 if MyRO.Treaty[DipMem[me].pContact]=trNone then Price:=opTreaty+trCeaseFire 717 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 718 end} 801 if MyRO.Treaty[DipMem[me].pContact] < trPeace then 802 Price := opTreaty + trPeace 803 else 804 Price := opTreaty + MyRO.Treaty[DipMem[me].pContact] + 1; 805 end; 806 { opLowTreaty: 807 begin 808 if MyRO.Treaty[DipMem[me].pContact]=trNone then Price:=opTreaty+trCeaseFire 809 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 810 end } 719 811 end; 720 812 end; 721 813 722 Costs[TButtonN(Sender).Tag and $FF]:=Price;723 BuildCurrentOffer;724 DipCommand:=scDipOffer;725 SetButtonStates;726 SmartUpdateContent;814 Costs[TButtonN(Sender).Tag and $FF] := Price; 815 BuildCurrentOffer; 816 DipCommand := scDipOffer; 817 SetButtonStates; 818 SmartUpdateContent; 727 819 end; 728 820 729 821 procedure TNegoDlg.OfferClick(Sender: TObject); 730 822 var 731 a,i,max: integer;732 Price: cardinal;733 begin 734 if (Page<>History[me].n) 735 or (ClientMode=scDipCancelTreaty) or (ClientMode=scDipBreak) then736 exit;737 if Delivers[TButtonN(Sender).Tag and $FF]<>$FFFFFFFF then738 Price:=$FFFFFFFF // toggle off739 else740 begin 741 if CurrentOffer.nDeliver>=2 then742 begin 743 SimpleMessage(Phrases.Lookup('MAX2OFFERS'));744 exit823 a, i, max: integer; 824 Price: cardinal; 825 begin 826 if (Page <> History[me].n) or (ClientMode = scDipCancelTreaty) or 827 (ClientMode = scDipBreak) then 828 exit; 829 if Delivers[TButtonN(Sender).Tag and $FF] <> $FFFFFFFF then 830 Price := $FFFFFFFF // toggle off 831 else 832 begin 833 if CurrentOffer.nDeliver >= 2 then 834 begin 835 SimpleMessage(Phrases.Lookup('MAX2OFFERS')); 836 exit 745 837 end; 746 Price:=ButtonPrice[TButtonN(Sender).Tag and $FF]; 747 if not (Price shr 24 in MyAllowed) then exit; 748 case Price of 749 opCivilReport, opMilReport: 750 inc(Price,me shl 16+MyRO.Turn); // !!! choose player and year! 751 opMoney: 752 begin // choose amount 753 InputDlg.Caption:=Phrases.Lookup('TITLE_AMOUNT'); 754 InputDlg.EInput.Text:=''; 755 InputDlg.CenterToRect(BoundsRect); 756 InputDlg.ShowModal; 757 if InputDlg.ModalResult<>mrOK then exit; 758 val(InputDlg.EInput.Text,a,i); 759 if (i<>0) or (a<=0) or (a>=MaxMoneyPrice) then exit; 760 if (Price=opMoney) and (a>MyRO.Money) then 761 a:=MyRO.Money; 762 inc(Price,a); 763 end; 764 opShipParts: 765 begin // choose type and number 766 ModalSelectDlg.ShowNewContent(wmModal,kShipPart); 767 if ModalSelectDlg.result<0 then exit; 768 inc(Price, ModalSelectDlg.result shl 16); 769 max:=MyRO.Ship[me].Parts[ModalSelectDlg.result]; 770 InputDlg.Caption:=Phrases.Lookup('TITLE_NUMBER'); 771 InputDlg.EInput.Text:=''; 772 InputDlg.CenterToRect(BoundsRect); 773 InputDlg.ShowModal; 774 if InputDlg.ModalResult<>mrOK then exit; 775 val(InputDlg.EInput.Text,a,i); 776 if (i<>0) or (a<=0) then exit; 777 if a>max then a:=max; 778 if a>MaxShipPartPrice then a:=MaxShipPartPrice; 779 inc(Price,a) 780 end; 781 opAllTech: 782 begin // choose technology 783 ModalSelectDlg.ShowNewContent(wmModal,kChooseTech); 784 if ModalSelectDlg.result<0 then exit; 785 if ModalSelectDlg.result=adAll then Price:=opAllTech 786 else Price:=OpTech+ModalSelectDlg.result; 787 end; 788 opAllModel: 789 begin // choose model 790 ModalSelectDlg.ShowNewContent(wmModal,kChooseModel); 791 if ModalSelectDlg.result<0 then exit; 792 if ModalSelectDlg.result=mixAll then Price:=opAllModel 793 else Price:=opModel+ModalSelectDlg.result 794 end; 795 opTreaty: 796 begin 797 if MyRO.Treaty[DipMem[me].pContact]<trPeace then Price:=opTreaty+trPeace 798 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]+1; 799 end; 800 { opLowTreaty: 801 begin 802 if MyRO.Treaty[DipMem[me].pContact]=trNone then Price:=opTreaty+trCeaseFire 803 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 804 end} 838 Price := ButtonPrice[TButtonN(Sender).Tag and $FF]; 839 if not(Price shr 24 in MyAllowed) then 840 exit; 841 case Price of 842 opCivilReport, opMilReport: 843 inc(Price, me shl 16 + MyRO.Turn); // !!! choose player and year! 844 opMoney: 845 begin // choose amount 846 InputDlg.Caption := Phrases.Lookup('TITLE_AMOUNT'); 847 InputDlg.EInput.Text := ''; 848 InputDlg.CenterToRect(BoundsRect); 849 InputDlg.ShowModal; 850 if InputDlg.ModalResult <> mrOK then 851 exit; 852 val(InputDlg.EInput.Text, a, i); 853 if (i <> 0) or (a <= 0) or (a >= MaxMoneyPrice) then 854 exit; 855 if (Price = opMoney) and (a > MyRO.Money) then 856 a := MyRO.Money; 857 inc(Price, a); 858 end; 859 opShipParts: 860 begin // choose type and number 861 ModalSelectDlg.ShowNewContent(wmModal, kShipPart); 862 if ModalSelectDlg.result < 0 then 863 exit; 864 inc(Price, ModalSelectDlg.result shl 16); 865 max := MyRO.Ship[me].Parts[ModalSelectDlg.result]; 866 InputDlg.Caption := Phrases.Lookup('TITLE_NUMBER'); 867 InputDlg.EInput.Text := ''; 868 InputDlg.CenterToRect(BoundsRect); 869 InputDlg.ShowModal; 870 if InputDlg.ModalResult <> mrOK then 871 exit; 872 val(InputDlg.EInput.Text, a, i); 873 if (i <> 0) or (a <= 0) then 874 exit; 875 if a > max then 876 a := max; 877 if a > MaxShipPartPrice then 878 a := MaxShipPartPrice; 879 inc(Price, a) 880 end; 881 opAllTech: 882 begin // choose technology 883 ModalSelectDlg.ShowNewContent(wmModal, kChooseTech); 884 if ModalSelectDlg.result < 0 then 885 exit; 886 if ModalSelectDlg.result = adAll then 887 Price := opAllTech 888 else 889 Price := OpTech + ModalSelectDlg.result; 890 end; 891 opAllModel: 892 begin // choose model 893 ModalSelectDlg.ShowNewContent(wmModal, kChooseModel); 894 if ModalSelectDlg.result < 0 then 895 exit; 896 if ModalSelectDlg.result = mixAll then 897 Price := opAllModel 898 else 899 Price := OpModel + ModalSelectDlg.result 900 end; 901 opTreaty: 902 begin 903 if MyRO.Treaty[DipMem[me].pContact] < trPeace then 904 Price := opTreaty + trPeace 905 else 906 Price := opTreaty + MyRO.Treaty[DipMem[me].pContact] + 1; 907 end; 908 { opLowTreaty: 909 begin 910 if MyRO.Treaty[DipMem[me].pContact]=trNone then Price:=opTreaty+trCeaseFire 911 else Price:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 912 end } 805 913 end; 806 914 end; 807 915 808 Delivers[TButtonN(Sender).Tag and $FF]:=Price;809 BuildCurrentOffer;810 DipCommand:=scDipOffer;811 SetButtonStates;812 SmartUpdateContent;916 Delivers[TButtonN(Sender).Tag and $FF] := Price; 917 BuildCurrentOffer; 918 DipCommand := scDipOffer; 919 SetButtonStates; 920 SmartUpdateContent; 813 921 end; 814 922 815 923 procedure TNegoDlg.FastBtnClick(Sender: TObject); 816 924 var 817 NewCommand: cardinal; 818 begin 819 if Page<>History[me].n then exit; 820 NewCommand:=TButtonN(Sender).Tag and $FF+scDipStart; 821 if not (NewCommand-scDipStart in CommandAllowed) then exit; 822 if (NewCommand=scDipCancelTreaty) 823 and (MyRO.Turn<MyRO.LastCancelTreaty[DipMem[me].pContact]+CancelTreatyTurns) then 824 begin 825 SimpleMessage(Phrases.Lookup('CANCELTREATYRUSH')); 826 exit; 827 end; 828 if (NewCommand=scDipOffer) 829 and ((ClientMode=scDipCancelTreaty) or (ClientMode=scDipBreak)) then 830 DipCommand:=scDipNotice 831 else DipCommand:=NewCommand; 832 ResetCurrentOffer; 833 SetButtonStates; 834 SmartUpdateContent; 925 NewCommand: cardinal; 926 begin 927 if Page <> History[me].n then 928 exit; 929 NewCommand := TButtonN(Sender).Tag and $FF + scDipStart; 930 if not(NewCommand - scDipStart in CommandAllowed) then 931 exit; 932 if (NewCommand = scDipCancelTreaty) and 933 (MyRO.Turn < MyRO.LastCancelTreaty[DipMem[me].pContact] + CancelTreatyTurns) 934 then 935 begin 936 SimpleMessage(Phrases.Lookup('CANCELTREATYRUSH')); 937 exit; 938 end; 939 if (NewCommand = scDipOffer) and ((ClientMode = scDipCancelTreaty) or 940 (ClientMode = scDipBreak)) then 941 DipCommand := scDipNotice 942 else 943 DipCommand := NewCommand; 944 ResetCurrentOffer; 945 SetButtonStates; 946 SmartUpdateContent; 835 947 end; 836 948 837 949 end. 838 -
trunk/LocalPlayer/PVSB.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit PVSB; 4 3 … … 6 5 7 6 uses 8 Windows, Messages,SysUtils;7 Windows, Messages, SysUtils; 9 8 10 9 type 11 TPVScrollbar=record h:integer;si:TScrollInfo end; 10 TPVScrollbar = record 11 h: integer; 12 si: TScrollInfo end; 12 13 13 procedure CreatePVSB(var sb:TPVScrollbar;Handle,y0,x1,y1:integer); 14 procedure InitPVSB(var sb:TPVScrollbar;max,Page:integer); 15 function ProcessPVSB(var sb:TPVScrollbar;const m:TMessage):boolean; 16 function ProcessMouseWheel(var sb:TPVScrollbar;const m:TMessage):boolean; 17 procedure ShowPVSB(var sb:TPVScrollbar; Visible: boolean); 18 procedure EndPVSB(var sb:TPVScrollbar); 14 procedure CreatePVSB(var sb: TPVScrollbar; Handle, y0, x1, y1: integer); 15 procedure InitPVSB(var sb: TPVScrollbar; max, Page: integer); 16 function ProcessPVSB(var sb: TPVScrollbar; const m: TMessage): boolean; 17 function ProcessMouseWheel(var sb: TPVScrollbar; const m: TMessage) 18 : boolean; 19 procedure ShowPVSB(var sb: TPVScrollbar; Visible: boolean); 20 procedure EndPVSB(var sb: TPVScrollbar); 19 21 20 22 implementation 21 23 22 24 const 23 Count:integer= 0;25 Count: integer = 0; 24 26 25 27 procedure CreatePVSB; 26 28 begin 27 inc(Count); 28 sb.h:=CreateWindowEx(0,'SCROLLBAR',pchar('PVSB'+IntToStr(Count)), 29 SBS_VERT or WS_CHILD or SBS_RIGHTALIGN,x1-100,y0,100,y1-y0,Handle,0,0,nil); 30 sb.si.cbSize:=28; 29 inc(Count); 30 sb.h := CreateWindowEx(0, 'SCROLLBAR', pchar('PVSB' + IntToStr(Count)), 31 SBS_VERT or WS_CHILD or SBS_RIGHTALIGN, x1 - 100, y0, 100, y1 - y0, 32 Handle, 0, 0, nil); 33 sb.si.cbSize := 28; 31 34 end; 32 35 33 36 procedure InitPVSB; 34 37 begin 35 with sb.si do38 with sb.si do 36 39 begin 37 nMin:=0;nMax:=max;npos:=0;nPage:=Page; 38 FMask:=SIF_PAGE or SIF_POS or SIF_RANGE; 40 nMin := 0; 41 nMax := max; 42 npos := 0; 43 nPage := Page; 44 FMask := SIF_PAGE or SIF_POS or SIF_RANGE; 39 45 end; 40 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 41 if max<Page then ShowWindow(sb.h,SW_HIDE) else ShowWindow(sb.h,SW_SHOW) 46 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 47 if max < Page then 48 ShowWindow(sb.h, SW_HIDE) 49 else 50 ShowWindow(sb.h, SW_SHOW) 42 51 end; 43 52 44 53 function ProcessPVSB; 45 54 var 46 NewPos:integer;55 NewPos: integer; 47 56 begin 48 with sb.si do 49 if nMax<integer(nPage) then result:=false 50 else 57 with sb.si do 58 if nMax < integer(nPage) then 59 result := false 60 else 51 61 begin 52 if m.wParamLo in[SB_THUMBPOSITION,SB_THUMBTRACK] then 53 begin result:=m.wParamHi<>npos;npos:=m.wParamHi;end 54 else 62 if m.wParamLo in [SB_THUMBPOSITION, SB_THUMBTRACK] then 55 63 begin 56 case m.wParamLo of 57 SB_LINEUP:NewPos:=npos-1;SB_LINEDOWN:NewPos:=npos+1; 58 SB_PAGEUP:NewPos:=npos-integer(nPage);SB_PAGEDOWN:NewPos:=npos+integer(nPage); 59 else NewPos:=npos 64 result := m.wParamHi <> npos; 65 npos := m.wParamHi; 66 end 67 else 68 begin 69 case m.wParamLo of 70 SB_LINEUP: 71 NewPos := npos - 1; 72 SB_LINEDOWN: 73 NewPos := npos + 1; 74 SB_PAGEUP: 75 NewPos := npos - integer(nPage); 76 SB_PAGEDOWN: 77 NewPos := npos + integer(nPage); 78 else 79 NewPos := npos 60 80 end; 61 if NewPos<0 then NewPos:=0; 62 if NewPos>nMax-integer(nPage)+1 then NewPos:=nMax-integer(nPage)+1; 63 result:=NewPos<>npos; 64 if (NewPos<>npos) or (m.wParamLo=SB_ENDSCROLL) then 81 if NewPos < 0 then 82 NewPos := 0; 83 if NewPos > nMax - integer(nPage) + 1 then 84 NewPos := nMax - integer(nPage) + 1; 85 result := NewPos <> npos; 86 if (NewPos <> npos) or (m.wParamLo = SB_ENDSCROLL) then 65 87 begin 66 npos:=NewPos;FMask:=SIF_POS; 67 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 88 npos := NewPos; 89 FMask := SIF_POS; 90 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 68 91 end; 69 92 end … … 73 96 function ProcessMouseWheel; 74 97 var 75 NewPos:integer;98 NewPos: integer; 76 99 begin 77 with sb.si do 78 if nMax<integer(nPage) then result:=false 79 else 100 with sb.si do 101 if nMax < integer(nPage) then 102 result := false 103 else 80 104 begin 81 NewPos:=npos-m.wParam div (1 shl 16*40); 82 if NewPos<0 then NewPos:=0; 83 if NewPos>nMax-integer(nPage)+1 then NewPos:=nMax-integer(nPage)+1; 84 result:=NewPos<>npos; 85 if NewPos<>npos then 105 NewPos := npos - m.wParam div (1 shl 16 * 40); 106 if NewPos < 0 then 107 NewPos := 0; 108 if NewPos > nMax - integer(nPage) + 1 then 109 NewPos := nMax - integer(nPage) + 1; 110 result := NewPos <> npos; 111 if NewPos <> npos then 86 112 begin 87 npos:=NewPos;FMask:=SIF_POS; 88 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 113 npos := NewPos; 114 FMask := SIF_POS; 115 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 89 116 end 90 117 end 91 118 end; 92 119 93 procedure ShowPVSB(var sb: TPVScrollbar; Visible: boolean);120 procedure ShowPVSB(var sb: TPVScrollbar; Visible: boolean); 94 121 begin 95 if not Visible or (sb.si.nMax<integer(sb.si.nPage)) then 96 ShowWindow(sb.h,SW_HIDE) 97 else ShowWindow(sb.h,SW_SHOW) 122 if not Visible or (sb.si.nMax < integer(sb.si.nPage)) then 123 ShowWindow(sb.h, SW_HIDE) 124 else 125 ShowWindow(sb.h, SW_SHOW) 98 126 end; 99 127 100 procedure EndPVSB(var sb: TPVScrollbar);128 procedure EndPVSB(var sb: TPVScrollbar); 101 129 begin 102 with sb.si do130 with sb.si do 103 131 begin 104 if nMax<integer(nPage) then npos:=0 // hidden 105 else 132 if nMax < integer(nPage) then 133 npos := 0 // hidden 134 else 106 135 begin 107 sb.si.npos:=nMax-integer(nPage)+1;108 sb.si.FMask:=SIF_POS;109 SetScrollInfo(sb.h,SB_CTL,sb.si,true);136 sb.si.npos := nMax - integer(nPage) + 1; 137 sb.si.FMask := SIF_POS; 138 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 110 139 end 111 140 end … … 113 142 114 143 end. 115 -
trunk/LocalPlayer/Rates.pas
r2 r6 5 5 6 6 uses 7 Protocol, ScreenTools,BaseWin,7 Protocol, ScreenTools, BaseWin, 8 8 9 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 32 32 33 33 uses 34 ClientTools, Term,Tribes;34 ClientTools, Term, Tribes; 35 35 36 36 {$R *.DFM} 37 37 38 38 const 39 MessageLineSpacing=20; 40 39 MessageLineSpacing = 20; 41 40 42 41 procedure TRatesDlg.FormCreate(Sender: TObject); 43 42 begin 44 TitleHeight:=Screen.Height;45 InitButtons();43 TitleHeight := Screen.Height; 44 InitButtons(); 46 45 end; 47 46 48 47 procedure TRatesDlg.OffscreenPaint; 49 48 var 50 p,x,y,current,max,i: integer; 51 s,s1: string; 52 begin 53 if (OffscreenUser<>nil) and (OffscreenUser<>self) then OffscreenUser.Update; 49 p, x, y, current, max, i: integer; 50 s, s1: string; 51 begin 52 if (OffscreenUser <> nil) and (OffscreenUser <> self) then 53 OffscreenUser.Update; 54 54 // complete working with old owner to prevent rebound 55 OffscreenUser:=self; 56 57 Fill(Offscreen.Canvas, 0,0,ClientWidth,ClientHeight, 58 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 59 Frame(Offscreen.Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 60 Frame(Offscreen.Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 61 Frame(Offscreen.Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 62 63 BtnFrame(Offscreen.Canvas,CloseBtn.BoundsRect,MainTexture); 64 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 65 s:=Phrases.Lookup('TITLE_RATES'); 66 RisedTextOut(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Offscreen.Canvas,s)) div 2-1,7,s); 67 68 if MyRO.Wonder[woLiberty].EffectiveOwner=me then 69 s:=Phrases.Lookup('NORATES') 70 else s:=Phrases.Lookup('RATES'); 71 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 72 p:=pos('\',s); 73 if p=0 then 74 RisedTextout(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 114, s) 75 else 76 begin 77 s1:=copy(s,1,p-1); 78 RisedTextout(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Offscreen.Canvas,s1)) div 2, 79 114-MessageLineSpacing div 2, s1); 80 s1:=copy(s,p+1,255); 81 RisedTextout(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Offscreen.Canvas,s1)) div 2, 82 114+(MessageLineSpacing-MessageLineSpacing div 2), s1); 83 end; 84 Offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 85 86 if MyRO.Wonder[woLiberty].EffectiveOwner=me then 87 begin 88 GlowFrame(Offscreen, ClientWidth div 2-xSizeBig div 2, 89 52,xSizeBig, ySizeBig, Tribe[me].Color); 90 BitBlt(Offscreen.Canvas.Handle, ClientWidth div 2-xSizeBig div 2, 91 52, xSizeBig, ySizeBig,BigImp.Canvas.Handle, 92 (woLiberty mod 7)*xSizeBig, (woLiberty div 7+SystemIconLines)*ySizeBig, SRCCOPY); 93 end 94 else 95 begin 96 // ImageOp_CBC(Offscreen,Templates,260,40,145,112,36,36,$404000,$8B8BEB); 97 98 s:=Phrases.Lookup('SCIENCE'); 99 RisedTextOut(Offscreen.Canvas,16+120-BiColorTextWidth(Offscreen.Canvas,s),44,s); 100 s:=Format('%d%%',[100-MyRO.TaxRate-MyRO.LuxRate]); 101 RisedTextOut(Offscreen.Canvas,16+120-BiColorTextWidth(Offscreen.Canvas,s),60,s); 102 //PaintProgressBar(Offscreen.Canvas,2,16,81,(100-MyRO.LuxRate-MyRO.TaxRate)*120 div 100,0,120,MainTexture); 103 104 // reverse progress bar for science 105 x:=16; 106 y:=81; 107 current:=(100-MyRO.LuxRate-MyRO.TaxRate)*120 div 100; 108 max:=120; 109 Frame(Offscreen.Canvas,x-1,y-1,x+max,y+7,$000000,$000000); 110 RFrame(Offscreen.Canvas,x-2,y-2,x+max+1,y+8,MainTexture.clBevelShade,MainTexture.clBevelLight); 111 with Offscreen.Canvas do 55 OffscreenUser := self; 56 57 Fill(Offscreen.Canvas, 0, 0, ClientWidth, ClientHeight, 58 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2); 59 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 60 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 61 MainTexture.clBevelLight, MainTexture.clBevelShade); 62 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 63 MainTexture.clBevelLight, MainTexture.clBevelShade); 64 65 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture); 66 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 67 s := Phrases.Lookup('TITLE_RATES'); 68 RisedTextOut(Offscreen.Canvas, 69 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s)) div 2 - 1, 7, s); 70 71 if MyRO.Wonder[woLiberty].EffectiveOwner = me then 72 s := Phrases.Lookup('NORATES') 73 else 74 s := Phrases.Lookup('RATES'); 75 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 76 p := pos('\', s); 77 if p = 0 then 78 RisedTextOut(Offscreen.Canvas, (ClientWidth - BiColorTextWidth(Canvas, s)) 79 div 2, 114, s) 80 else 81 begin 82 s1 := copy(s, 1, p - 1); 83 RisedTextOut(Offscreen.Canvas, 84 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s1)) div 2, 85 114 - MessageLineSpacing div 2, s1); 86 s1 := copy(s, p + 1, 255); 87 RisedTextOut(Offscreen.Canvas, 88 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s1)) div 2, 89 114 + (MessageLineSpacing - MessageLineSpacing div 2), s1); 90 end; 91 Offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 92 93 if MyRO.Wonder[woLiberty].EffectiveOwner = me then 94 begin 95 GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2, 52, xSizeBig, 96 ySizeBig, Tribe[me].Color); 97 BitBlt(Offscreen.Canvas.Handle, ClientWidth div 2 - xSizeBig div 2, 52, 98 xSizeBig, ySizeBig, BigImp.Canvas.Handle, (woLiberty mod 7) * xSizeBig, 99 (woLiberty div 7 + SystemIconLines) * ySizeBig, SRCCOPY); 100 end 101 else 102 begin 103 // ImageOp_CBC(Offscreen,Templates,260,40,145,112,36,36,$404000,$8B8BEB); 104 105 s := Phrases.Lookup('SCIENCE'); 106 RisedTextOut(Offscreen.Canvas, 107 16 + 120 - BiColorTextWidth(Offscreen.Canvas, s), 44, s); 108 s := Format('%d%%', [100 - MyRO.TaxRate - MyRO.LuxRate]); 109 RisedTextOut(Offscreen.Canvas, 110 16 + 120 - BiColorTextWidth(Offscreen.Canvas, s), 60, s); 111 // PaintProgressBar(Offscreen.Canvas,2,16,81,(100-MyRO.LuxRate-MyRO.TaxRate)*120 div 100,0,120,MainTexture); 112 113 // reverse progress bar for science 114 x := 16; 115 y := 81; 116 current := (100 - MyRO.LuxRate - MyRO.TaxRate) * 120 div 100; 117 max := 120; 118 Frame(Offscreen.Canvas, x - 1, y - 1, x + max, y + 7, $000000, $000000); 119 RFrame(Offscreen.Canvas, x - 2, y - 2, x + max + 1, y + 8, 120 MainTexture.clBevelShade, MainTexture.clBevelLight); 121 with Offscreen.Canvas do 112 122 begin 113 for i:=0 to current div 8-1 do114 BitBlt(Handle,x+max-8-i*8,y,8,7,GrExt[HGrSystem].Data.Canvas.Handle,104,115 9+8*2,SRCCOPY);116 BitBlt(Handle,x+max-current,y,117 current-8*(current div 8),7,GrExt[HGrSystem].Data.Canvas.Handle,104,9+8*2,SRCCOPY);118 Brush.Color:=$000000;119 FillRect(Rect(x,y,x+max-current,y+7));120 Brush.Style:=bsClear;123 for i := 0 to current div 8 - 1 do 124 BitBlt(Handle, x + max - 8 - i * 8, y, 8, 7, 125 GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * 2, SRCCOPY); 126 BitBlt(Handle, x + max - current, y, current - 8 * (current div 8), 7, 127 GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * 2, SRCCOPY); 128 Brush.Color := $000000; 129 FillRect(Rect(x, y, x + max - current, y + 7)); 130 Brush.Style := bsClear; 121 131 end; 122 132 123 RisedTextOut(Offscreen.Canvas,16+160,44,Phrases.Lookup('LUX')); 124 s:=Format('%d%%',[MyRO.LuxRate]); 125 RisedTextOut(Offscreen.Canvas,16+160{+120-BiColorTextWidth(Offscreen.Canvas,s)},60,s); 126 PaintProgressBar(Offscreen.Canvas,5,16+160,81,MyRO.LuxRate*120 div 100,0,120,MainTexture); 127 RFrame(Offscreen.Canvas,ScienceBtn.Left-1,LuxBtn.Top-1,LuxBtn.Left+12, 128 LuxBtn.Top+12,MainTexture.clBevelShade,MainTexture.clBevelLight); 129 end; 130 131 DLine(Offscreen.Canvas,1,ClientWidth-2,154, MainTexture.clBevelShade, MainTexture.clBevelLight); 132 RisedTextOut(Offscreen.Canvas,16+80,164,Phrases.Lookup('TAXRATE')); 133 s:=Format('%d%%',[MyRO.TaxRate]); 134 RisedTextOut(Offscreen.Canvas,16+80{+120-BiColorTextWidth(Offscreen.Canvas,s)},180,s); 135 PaintProgressBar(Offscreen.Canvas,0,16+80,201,MyRO.TaxRate*120 div 100,0,120,MainTexture); 136 RFrame(Offscreen.Canvas,TaxUpBtn.Left-1,TaxUpBtn.Top-1,TaxUpBtn.Left+12, 137 TaxDownBtn.Top+12,MainTexture.clBevelShade,MainTexture.clBevelLight); 138 139 MarkUsedOffscreen(ClientWidth,ClientHeight); 133 RisedTextOut(Offscreen.Canvas, 16 + 160, 44, Phrases.Lookup('LUX')); 134 s := Format('%d%%', [MyRO.LuxRate]); 135 RisedTextOut(Offscreen.Canvas, 136 16 + 160 { +120-BiColorTextWidth(Offscreen.Canvas,s) } , 60, s); 137 PaintProgressBar(Offscreen.Canvas, 5, 16 + 160, 81, 138 MyRO.LuxRate * 120 div 100, 0, 120, MainTexture); 139 RFrame(Offscreen.Canvas, ScienceBtn.Left - 1, LuxBtn.Top - 1, 140 LuxBtn.Left + 12, LuxBtn.Top + 12, MainTexture.clBevelShade, 141 MainTexture.clBevelLight); 142 end; 143 144 DLine(Offscreen.Canvas, 1, ClientWidth - 2, 154, MainTexture.clBevelShade, 145 MainTexture.clBevelLight); 146 RisedTextOut(Offscreen.Canvas, 16 + 80, 164, Phrases.Lookup('TAXRATE')); 147 s := Format('%d%%', [MyRO.TaxRate]); 148 RisedTextOut(Offscreen.Canvas, 149 16 + 80 { +120-BiColorTextWidth(Offscreen.Canvas,s) } , 180, s); 150 PaintProgressBar(Offscreen.Canvas, 0, 16 + 80, 201, 151 MyRO.TaxRate * 120 div 100, 0, 120, MainTexture); 152 RFrame(Offscreen.Canvas, TaxUpBtn.Left - 1, TaxUpBtn.Top - 1, 153 TaxUpBtn.Left + 12, TaxDownBtn.Top + 12, MainTexture.clBevelShade, 154 MainTexture.clBevelLight); 155 156 MarkUsedOffscreen(ClientWidth, ClientHeight); 140 157 end; 141 158 142 159 procedure TRatesDlg.ShowNewContent(NewMode: integer); 143 160 begin 144 inherited ShowNewContent(NewMode);161 inherited ShowNewContent(NewMode); 145 162 end; 146 163 147 164 procedure TRatesDlg.FormShow(Sender: TObject); 148 165 begin 149 if MyRO.Wonder[woLiberty].EffectiveOwner=me then150 begin 151 ScienceBtn.Visible:=false;152 LuxBtn.Visible:=false;153 end 154 else155 begin 156 ScienceBtn.Visible:=true;157 LuxBtn.Visible:=true;158 end; 159 OffscreenPaint;166 if MyRO.Wonder[woLiberty].EffectiveOwner = me then 167 begin 168 ScienceBtn.Visible := false; 169 LuxBtn.Visible := false; 170 end 171 else 172 begin 173 ScienceBtn.Visible := true; 174 LuxBtn.Visible := true; 175 end; 176 OffscreenPaint; 160 177 end; 161 178 162 179 procedure TRatesDlg.CloseBtnClick(Sender: TObject); 163 180 begin 164 Close;181 Close; 165 182 end; 166 183 167 184 procedure TRatesDlg.TaxLuxBtnClick(Sender: TObject); 168 185 var 169 NewTax, NewLux: integer; 170 begin 171 NewTax:=MyRO.TaxRate div 10; 172 NewLux:=MyRO.LuxRate div 10; 173 if Sender=TaxUpBtn then 174 begin 175 if NewTax<10 then inc(NewTax); 176 if NewTax+NewLux>10 then dec(NewLux); 177 end 178 else if (Sender=TaxDownBtn) and (NewTax>0) then 179 dec(NewTax) 180 else if (Sender=ScienceBtn) and (NewLux>0) then 181 dec(NewLux) 182 else if (Sender=LuxBtn) and (NewLux+NewTax<100) then 183 inc(NewLux); 184 if Server(sSetRates,me,NewTax+NewLux shl 4,nil^)<>eNotChanged then 185 begin 186 CityOptimizer_BeginOfTurn; 187 SmartUpdateContent; 188 MainScreen.UpdateViews(true); 186 NewTax, NewLux: integer; 187 begin 188 NewTax := MyRO.TaxRate div 10; 189 NewLux := MyRO.LuxRate div 10; 190 if Sender = TaxUpBtn then 191 begin 192 if NewTax < 10 then 193 inc(NewTax); 194 if NewTax + NewLux > 10 then 195 dec(NewLux); 196 end 197 else if (Sender = TaxDownBtn) and (NewTax > 0) then 198 dec(NewTax) 199 else if (Sender = ScienceBtn) and (NewLux > 0) then 200 dec(NewLux) 201 else if (Sender = LuxBtn) and (NewLux + NewTax < 100) then 202 inc(NewLux); 203 if Server(sSetRates, me, NewTax + NewLux shl 4, nil^) <> eNotChanged then 204 begin 205 CityOptimizer_BeginOfTurn; 206 SmartUpdateContent; 207 MainScreen.UpdateViews(true); 189 208 end 190 209 end; 191 210 192 211 end. 193 -
trunk/LocalPlayer/Select.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Select; 4 3 … … 6 5 7 6 uses 8 Protocol, ClientTools,Term,ScreenTools,IsoEngine,PVSB,BaseWin,9 10 Windows, Messages,SysUtils,Classes,Graphics,Controls,Forms,11 ExtCtrls, ButtonB, ButtonBase, Menus;7 Protocol, ClientTools, Term, ScreenTools, IsoEngine, PVSB, BaseWin, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, 10 ExtCtrls, ButtonB, ButtonBase, Menus; 12 11 13 12 const 14 MaxLayer=3;13 MaxLayer = 3; 15 14 16 15 type 17 TListKind =(kProject,kAdvance,kFarAdvance,kCities,kCityEvents,kModels,kEModels,18 k AllEModels,kTribe,kScience,kShipPart,kEShipPart,kChooseTech,19 kChooseETech, kChooseModel,kChooseEModel,kChooseCity,kChooseECity,20 kStealTech, kGov,kMission);16 TListKind = (kProject, kAdvance, kFarAdvance, kCities, kCityEvents, kModels, 17 kEModels, kAllEModels, kTribe, kScience, kShipPart, kEShipPart, kChooseTech, 18 kChooseETech, kChooseModel, kChooseEModel, kChooseCity, kChooseECity, 19 kStealTech, kGov, kMission); 21 20 22 21 TListDlg = class(TFramedDlg) … … 27 26 ToggleBtn: TButtonB; 28 27 Popup: TPopupMenu; 29 procedure PaintBox1MouseMove(Sender: TObject;Shift:TShiftState;x,30 y:integer);31 procedure FormCreate(Sender: TObject);32 procedure PaintBox1MouseDown(Sender: TObject;Button:TMouseButton;33 Shift: TShiftState;x,y:integer);34 procedure FormPaint(Sender: TObject);35 procedure CloseBtnClick(Sender: TObject);28 procedure PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; 29 x, y: integer); 30 procedure FormCreate(Sender: TObject); 31 procedure PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 32 Shift: TShiftState; x, y: integer); 33 procedure FormPaint(Sender: TObject); 34 procedure CloseBtnClick(Sender: TObject); 36 35 procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); 37 36 procedure FormShow(Sender: TObject); 38 37 procedure ModeBtnClick(Sender: TObject); 39 38 procedure ToggleBtnClick(Sender: TObject); 40 procedure FormKeyDown(Sender: TObject; var Key: word; 41 Shift: TShiftState); 39 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 42 40 procedure PlayerClick(Sender: TObject); 43 41 procedure FormDestroy(Sender: TObject); … … 45 43 public 46 44 result: integer; 47 function OnlyChoice(TestKind: TListKind): integer; // -2=empty, -1=ambiguous, other=only choice 45 function OnlyChoice(TestKind: TListKind): integer; 46 // -2=empty, -1=ambiguous, other=only choice 48 47 procedure OffscreenPaint; override; 49 48 procedure ShowNewContent(NewMode: integer; ListKind: TListKind); … … 57 56 private 58 57 Kind: TListKind; 59 LineDistance, MaxLines,cixProject,pView,Sel,DispLines,Layer,nColumn,60 TechNameSpace, ScienceNation: integer;61 sb: TPVScrollbar;62 Lines, FirstShrinkedLine: array [0..MaxLayer-1] of integer;63 code: array [0..MaxLayer-1,0..4095] of integer;64 Column: array [0..nPl-1] of integer;65 Closable, MultiPage: boolean;58 LineDistance, MaxLines, cixProject, pView, Sel, DispLines, Layer, nColumn, 59 TechNameSpace, ScienceNation: integer; 60 sb: TPVScrollbar; 61 Lines, FirstShrinkedLine: array [0 .. MaxLayer - 1] of integer; 62 code: array [0 .. MaxLayer - 1, 0 .. 4095] of integer; 63 Column: array [0 .. nPl - 1] of integer; 64 Closable, MultiPage: boolean; 66 65 ScienceNationDot: TBitmap; 67 66 procedure InitLines; … … 69 68 function RenameCity(cix: integer): boolean; 70 69 function RenameModel(mix: integer): boolean; 71 procedure OnScroll(var m: TMessage); message WM_VSCROLL;72 procedure OnMouseWheel(var m: TMessage); message WM_MOUSEWHEEL;73 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE;74 end; 75 76 TModalSelectDlg =TListDlg;70 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 71 procedure OnMouseWheel(var m: TMessage); message WM_MOUSEWHEEL; 72 procedure OnMouseLeave(var Msg: TMessage); message CM_MOUSELEAVE; 73 end; 74 75 TModalSelectDlg = TListDlg; 77 76 78 77 const 79 cpType=$10000;80 mixAll=$10000;81 adAll=$10000;78 cpType = $10000; 79 mixAll = $10000; 80 adAll = $10000; 82 81 83 82 var … … 88 87 89 88 uses 90 CityScreen, Help, UnitStat, Tribes, Inp;89 CityScreen, Help, UnitStat, Tribes, Inp; 91 90 92 91 {$R *.DFM} 93 92 94 93 const 95 CityNameSpace=127;96 97 MustChooseKind=[kTribe,kStealTech,kGov];98 99 100 procedure TListDlg.FormCreate(Sender:TObject); 101 begin 102 inherited;103 Canvas.Font.Assign(UniFont[ftNormal]);104 CreatePVSB(sb,Handle,2,361,2+422);105 InitButtons();106 Kind:=kMission;107 Layer0Btn.Hint:=Phrases.Lookup('BTN_IMPRS');108 Layer1Btn.Hint:=Phrases.Lookup('BTN_WONDERS');109 Layer2Btn.Hint:=Phrases.Lookup('BTN_CLASSES');110 ScienceNationDot:=TBitmap.Create;111 ScienceNationDot.PixelFormat:=pf24bit;112 ScienceNationDot.Width:=17; ScienceNationDot.Height:=17;94 CityNameSpace = 127; 95 96 MustChooseKind = [kTribe, kStealTech, kGov]; 97 98 procedure TListDlg.FormCreate(Sender: TObject); 99 begin 100 inherited; 101 Canvas.Font.Assign(UniFont[ftNormal]); 102 CreatePVSB(sb, Handle, 2, 361, 2 + 422); 103 InitButtons(); 104 Kind := kMission; 105 Layer0Btn.Hint := Phrases.Lookup('BTN_IMPRS'); 106 Layer1Btn.Hint := Phrases.Lookup('BTN_WONDERS'); 107 Layer2Btn.Hint := Phrases.Lookup('BTN_CLASSES'); 108 ScienceNationDot := TBitmap.Create; 109 ScienceNationDot.PixelFormat := pf24bit; 110 ScienceNationDot.Width := 17; 111 ScienceNationDot.Height := 17; 113 112 end; 114 113 115 114 procedure TListDlg.FormDestroy(Sender: TObject); 116 115 begin 117 ScienceNationDot.Free; 118 end; 119 120 procedure TListDlg.CloseBtnClick(Sender:TObject); 121 begin 122 Closable:=true; Close 123 end; 124 125 procedure TListDlg.FormCloseQuery(Sender: TObject; 126 var CanClose: boolean); 127 begin 128 CanClose:=Closable or not(Kind in MustChooseKind) 129 end; 130 131 procedure TListDlg.OnScroll(var m:TMessage); 132 begin 133 if ProcessPVSB(sb,m) then 134 begin Sel:=-2; SmartUpdateContent(true) end 135 end; 136 137 procedure TListDlg.OnMouseWheel(var m:TMessage); 138 begin 139 if ProcessMouseWheel(sb,m) then 140 begin 141 Sel:=-2; 142 SmartUpdateContent(true); 143 PaintBox1MouseMove(nil, [], m.lParam and $FFFF-Left, m.lParam shr 16-Top); 116 ScienceNationDot.Free; 117 end; 118 119 procedure TListDlg.CloseBtnClick(Sender: TObject); 120 begin 121 Closable := true; 122 Close 123 end; 124 125 procedure TListDlg.FormCloseQuery(Sender: TObject; var CanClose: boolean); 126 begin 127 CanClose := Closable or not(Kind in MustChooseKind) 128 end; 129 130 procedure TListDlg.OnScroll(var m: TMessage); 131 begin 132 if ProcessPVSB(sb, m) then 133 begin 134 Sel := -2; 135 SmartUpdateContent(true) 144 136 end 145 137 end; 146 138 147 procedure TListDlg.OnMouseLeave(var Msg:TMessage); 148 begin 149 if not Closable and (Sel<>-2) then 150 begin 151 line(Canvas,Sel,false,false); 152 Sel:=-2; 139 procedure TListDlg.OnMouseWheel(var m: TMessage); 140 begin 141 if ProcessMouseWheel(sb, m) then 142 begin 143 Sel := -2; 144 SmartUpdateContent(true); 145 PaintBox1MouseMove(nil, [], m.lParam and $FFFF - Left, 146 m.lParam shr 16 - Top); 153 147 end 154 148 end; 155 149 156 procedure TListDlg.FormPaint(Sender:TObject); 150 procedure TListDlg.OnMouseLeave(var Msg: TMessage); 151 begin 152 if not Closable and (Sel <> -2) then 153 begin 154 line(Canvas, Sel, false, false); 155 Sel := -2; 156 end 157 end; 158 159 procedure TListDlg.FormPaint(Sender: TObject); 157 160 var 158 s: string; 159 begin 160 inherited; 161 Canvas.Font.Assign(UniFont[ftNormal]); 162 if Sel<>-2 then line(Canvas,Sel,false,true); 163 s:=''; 164 if (Kind=kAdvance) and (MyData.FarTech<>adNone) then 165 s:=Format(Phrases.Lookup('TECHFOCUS'), 166 [Phrases.Lookup('ADVANCES',MyData.FarTech)]) 167 else if Kind=kModels then s:=Tribe[me].TPhrase('SHORTNAME') 168 else if Kind=kEModels then 169 s:=Tribe[pView].TPhrase('SHORTNAME') 170 +' ('+TurnToString(MyRO.EnemyReport[pView].TurnOfMilReport)+')'; 171 if s<>'' then 172 LoweredTextOut(Canvas, -1, MainTexture, 173 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 31, s); 174 if not MultiPage and (Kind in [kProject,kAdvance,kFarAdvance]) 175 and not Phrases2FallenBackToEnglish then 176 begin 177 s:=Phrases2.Lookup('SHIFTCLICK'); 178 LoweredTextOut(Canvas, -2, MainTexture, 179 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, ClientHeight-29, s); 161 s: string; 162 begin 163 inherited; 164 Canvas.Font.Assign(UniFont[ftNormal]); 165 if Sel <> -2 then 166 line(Canvas, Sel, false, true); 167 s := ''; 168 if (Kind = kAdvance) and (MyData.FarTech <> adNone) then 169 s := Format(Phrases.Lookup('TECHFOCUS'), 170 [Phrases.Lookup('ADVANCES', MyData.FarTech)]) 171 else if Kind = kModels then 172 s := Tribe[me].TPhrase('SHORTNAME') 173 else if Kind = kEModels then 174 s := Tribe[pView].TPhrase('SHORTNAME') + ' (' + 175 TurnToString(MyRO.EnemyReport[pView].TurnOfMilReport) + ')'; 176 if s <> '' then 177 LoweredTextOut(Canvas, -1, MainTexture, 178 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 31, s); 179 if not MultiPage and (Kind in [kProject, kAdvance, kFarAdvance]) and not Phrases2FallenBackToEnglish 180 then 181 begin 182 s := Phrases2.Lookup('SHIFTCLICK'); 183 LoweredTextOut(Canvas, -2, MainTexture, 184 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, ClientHeight - 29, s); 180 185 end 181 186 end; … … 184 189 // paint a line 185 190 186 procedure DisplayProject(x,y,pix: integer); 187 begin 188 if pix and (cpType or cpImp)=0 then 189 with Tribe[me].ModelPicture[pix and cpIndex] do 190 Sprite(offscreen,HGr,x,y,64,48,pix mod 10*65+1, pix div 10 *49+1) 191 else 191 procedure DisplayProject(x, y, pix: integer); 192 begin 193 if pix and (cpType or cpImp) = 0 then 194 with Tribe[me].ModelPicture[pix and cpIndex] do 195 Sprite(offscreen, HGr, x, y, 64, 48, pix mod 10 * 65 + 1, 196 pix div 10 * 49 + 1) 197 else 192 198 begin 193 Frame(offscreen.Canvas,x+(16-1),y+(16-2),x+(16+xSizeSmall), 194 y+(16-1+ySizeSmall),MainTexture.clBevelLight,MainTexture.clBevelShade); 195 if pix and cpType=0 then 196 if (pix and cpIndex=imPalace) and (MyRO.Government<>gAnarchy) then 197 BitBlt(offscreen.Canvas.Handle,x+16,y+(16-1),xSizeSmall,ySizeSmall, 198 SmallImp.Canvas.Handle,(MyRO.Government-1)*xSizeSmall, 199 ySizeSmall,SRCCOPY) 200 else BitBlt(offscreen.Canvas.Handle,x+16,y+(16-1),xSizeSmall,ySizeSmall, 201 SmallImp.Canvas.Handle,pix and cpIndex mod 7*xSizeSmall, 202 (pix and cpIndex+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY) 203 else BitBlt(offscreen.Canvas.Handle,x+16,y+(16-1),xSizeSmall,ySizeSmall, 204 SmallImp.Canvas.Handle,(3+pix and cpIndex)*xSizeSmall, 0,SRCCOPY) 199 Frame(offscreen.Canvas, x + (16 - 1), y + (16 - 2), x + (16 + xSizeSmall), 200 y + (16 - 1 + ySizeSmall), MainTexture.clBevelLight, 201 MainTexture.clBevelShade); 202 if pix and cpType = 0 then 203 if (pix and cpIndex = imPalace) and (MyRO.Government <> gAnarchy) then 204 BitBlt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall, 205 ySizeSmall, SmallImp.Canvas.Handle, (MyRO.Government - 1) * 206 xSizeSmall, ySizeSmall, SRCCOPY) 207 else 208 BitBlt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall, 209 ySizeSmall, SmallImp.Canvas.Handle, pix and cpIndex mod 7 * 210 xSizeSmall, (pix and cpIndex + SystemIconLines * 7) div 7 * 211 ySizeSmall, SRCCOPY) 212 else 213 BitBlt(offscreen.Canvas.Handle, x + 16, y + (16 - 1), xSizeSmall, 214 ySizeSmall, SmallImp.Canvas.Handle, (3 + pix and cpIndex) * 215 xSizeSmall, 0, SRCCOPY) 205 216 end; 206 217 end; 207 218 208 procedure ReplaceText(x, y,Color: integer; s: string);219 procedure ReplaceText(x, y, Color: integer; s: string); 209 220 var 210 TextSize: TSize;211 begin 212 if ca=Canvas then221 TextSize: TSize; 222 begin 223 if ca = Canvas then 213 224 begin 214 TextSize.cx:=BiColorTextWidth(ca,s);215 TextSize.cy:=ca.TextHeight(s);216 if y+TextSize.cy>=TitleHeight+InnerHeight then217 TextSize.cy:=TitleHeight+InnerHeight-y;218 Fill(ca,x,y,TextSize.cx,TextSize.cy,(wMaintexture-ClientWidth) div 2,219 (hMaintexture-ClientHeight) div 2);225 TextSize.cx := BiColorTextWidth(ca, s); 226 TextSize.cy := ca.TextHeight(s); 227 if y + TextSize.cy >= TitleHeight + InnerHeight then 228 TextSize.cy := TitleHeight + InnerHeight - y; 229 Fill(ca, x, y, TextSize.cx, TextSize.cy, (wMaintexture - ClientWidth) 230 div 2, (hMaintexture - ClientHeight) div 2); 220 231 end; 221 LoweredTextOut(ca,Color,MainTexture,x,y,s);232 LoweredTextOut(ca, Color, MainTexture, x, y, s); 222 233 end; 223 234 224 235 var 225 icon,ofs,x,y,y0,lix,i,j,TextColor,Available,first,test,FutureCount, 226 growth,TrueFood,TrueProd:integer; 227 CityReport: TCityReportNew; 228 mox: ^TModelInfo; 229 s,number: string; 230 CanGrow: boolean; 231 begin 232 lix:=code[Layer,sb.si.npos+l]; 233 y0:=2+(l+1)*LineDistance; 234 if sb.si.npos+l>=FirstShrinkedLine[Layer] then 235 ofs:=(sb.si.npos+l-FirstShrinkedLine[Layer]) and 1 *33 236 else {if FirstShrinkedLine[Layer]<Lines[Layer] then} ofs:=33; 237 238 if Kind in [kCities,kCityEvents] then with MyCity[lix] do 239 begin 240 x:=104-76; y:=y0; 241 if ca=Canvas then 242 begin x:=x+SideFrame; y:=y+TitleHeight end; 243 if lit then TextColor:=MainTexture.clLitText else TextColor:=-1; 244 s:=CityName(ID); 245 while BiColorTextWidth(ca,s)>CityNameSpace do 246 delete(s,length(s),1); 247 ReplaceText(x+15,y,TextColor,s); 248 249 if NonText then with offscreen.canvas do 250 begin // city size 251 brush.color:=$000000; 252 fillrect(rect(x-4-11,y+1,x-4+13,y+21)); 253 brush.color:=$FFFFFF; 254 fillrect(rect(x-4-12,y,x-4+12,y+20)); 255 brush.style:=bsClear; 256 font.color:=$000000; 257 s:=inttostr(MyCity[lix].Size); 258 TextOut(x-4-textwidth(s) div 2, y, s); 259 end; 260 261 if Kind=kCityEvents then 236 icon, ofs, x, y, y0, lix, i, j, TextColor, Available, first, test, 237 FutureCount, growth, TrueFood, TrueProd: integer; 238 CityReport: TCityReportNew; 239 mox: ^TModelInfo; 240 s, number: string; 241 CanGrow: boolean; 242 begin 243 lix := code[Layer, sb.si.npos + l]; 244 y0 := 2 + (l + 1) * LineDistance; 245 if sb.si.npos + l >= FirstShrinkedLine[Layer] then 246 ofs := (sb.si.npos + l - FirstShrinkedLine[Layer]) and 1 * 33 247 else { if FirstShrinkedLine[Layer]<Lines[Layer] then } 248 ofs := 33; 249 250 if Kind in [kCities, kCityEvents] then 251 with MyCity[lix] do 262 252 begin 263 first:=-1;264 for j:=0 to nCityEventPriority-1 do265 if (Flags and CityRepMask and CityEventPriority[j]<>0)then266 begin first:=j; Break end;267 if first>=0 then268 begin269 i:=0;270 test:=1;271 while test<CityEventPriority[first] do272 begin inc(i); inc(test,test) end;273 s:=CityEventName(i);274 { if CityEventPriority[first]=chNoGrowthWarning then 275 if Built[imAqueduct]=0 then276 s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imAqueduct)])277 else begin s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imSewer)]); i:=17 end;}278 ReplaceText(x+(CityNameSpace+4+40+18+8),y,TextColor,s); 253 x := 104 - 76; 254 y := y0; 255 if ca = Canvas then 256 begin 257 x := x + SideFrame; 258 y := y + TitleHeight 259 end; 260 if lit then 261 TextColor := MainTexture.clLitText 262 else 263 TextColor := -1; 264 s := CityName(ID); 265 while BiColorTextWidth(ca, s) > CityNameSpace do 266 delete(s, length(s), 1); 267 ReplaceText(x + 15, y, TextColor, s); 268 279 269 if NonText then 280 begin 281 Sprite(offscreen,HGrSystem,105-76+CityNameSpace+4+40,y0+1,18,18, 282 1+i mod 3 *19,1+i div 3 *19); 283 x:=InnerWidth-26; 284 for j:=nCityEventPriority-1 downto first+1 do 285 if (Flags and CityRepMask and CityEventPriority[j]<>0) then 286 begin 287 i:=0; 288 test:=1; 289 while test<CityEventPriority[j] do 290 begin inc(i); inc(test,test) end; 291 if (CityEventPriority[j]=chNoGrowthWarning) 292 and (Built[imAqueduct]>0) then 293 i:=17; 294 Sprite(offscreen,HGrSystem,x,y0+1,18,18,1+i mod 3 *19, 295 1+i div 3 *19); 296 dec(x,20) 297 end 270 with offscreen.Canvas do 271 begin // city size 272 brush.Color := $000000; 273 fillrect(rect(x - 4 - 11, y + 1, x - 4 + 13, y + 21)); 274 brush.Color := $FFFFFF; 275 fillrect(rect(x - 4 - 12, y, x - 4 + 12, y + 20)); 276 brush.style := bsClear; 277 Font.Color := $000000; 278 s := inttostr(MyCity[lix].Size); 279 TextOut(x - 4 - textwidth(s) div 2, y, s); 280 end; 281 282 if Kind = kCityEvents then 283 begin 284 first := -1; 285 for j := 0 to nCityEventPriority - 1 do 286 if (Flags and CityRepMask and CityEventPriority[j] <> 0) then 287 begin 288 first := j; 289 Break 290 end; 291 if first >= 0 then 292 begin 293 i := 0; 294 test := 1; 295 while test < CityEventPriority[first] do 296 begin 297 inc(i); 298 inc(test, test) 299 end; 300 s := CityEventName(i); 301 { if CityEventPriority[first]=chNoGrowthWarning then 302 if Built[imAqueduct]=0 then 303 s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imAqueduct)]) 304 else begin s:=Format(s,[Phrases.Lookup('IMPROVEMENTS',imSewer)]); i:=17 end; } 305 ReplaceText(x + (CityNameSpace + 4 + 40 + 18 + 8), y, TextColor, s); 306 if NonText then 307 begin 308 Sprite(offscreen, HGrSystem, 105 - 76 + CityNameSpace + 4 + 40, 309 y0 + 1, 18, 18, 1 + i mod 3 * 19, 1 + i div 3 * 19); 310 x := InnerWidth - 26; 311 for j := nCityEventPriority - 1 downto first + 1 do 312 if (Flags and CityRepMask and CityEventPriority[j] <> 0) then 313 begin 314 i := 0; 315 test := 1; 316 while test < CityEventPriority[j] do 317 begin 318 inc(i); 319 inc(test, test) 320 end; 321 if (CityEventPriority[j] = chNoGrowthWarning) and 322 (Built[imAqueduct] > 0) then 323 i := 17; 324 Sprite(offscreen, HGrSystem, x, y0 + 1, 18, 18, 325 1 + i mod 3 * 19, 1 + i div 3 * 19); 326 dec(x, 20) 327 end 328 end 298 329 end 299 330 end 331 else 332 begin 333 CityReport.HypoTiles := -1; 334 CityReport.HypoTaxRate := -1; 335 CityReport.HypoLuxuryRate := -1; 336 Server(sGetCityReportNew, me, lix, CityReport); 337 TrueFood := Food; 338 TrueProd := Prod; 339 if supervising then 340 begin // normalize city from after-turn state 341 dec(TrueFood, CityReport.FoodSurplus); 342 if TrueFood < 0 then 343 TrueFood := 0; // shouldn't happen 344 dec(TrueProd, CityReport.Production); 345 if TrueProd < 0 then 346 TrueProd := 0; // shouldn't happen 347 end; 348 349 s := ''; // disorder info 350 if Flags and chCaptured <> 0 then 351 s := Phrases.Lookup('CITYEVENTS', 14) 352 else if CityReport.HappinessBalance < 0 then 353 s := Phrases.Lookup('CITYEVENTS', 0); 354 if s <> '' then 355 begin { disorder } 356 if NonText then 357 begin 358 DarkGradient(offscreen.Canvas, 99 + 31 + CityNameSpace + 4, 359 y0 + 2, 131, 3); 360 ca.Font.Assign(UniFont[ftSmall]); 361 RisedTextout(offscreen.Canvas, 103 + CityNameSpace + 4 + 31, 362 y0 + 1, s); 363 ca.Font.Assign(UniFont[ftNormal]); 364 end 365 end 366 else 367 begin 368 { s:=IntToStr(CityReport.FoodSurplus); 369 ReplaceText(x+(CityNameSpace+4+48)-BiColorTextWidth(ca,s),y,TextColor,s); } 370 s := inttostr(CityReport.Science); 371 ReplaceText(x + CityNameSpace + 4 + 370 + 48 - BiColorTextWidth(ca, 372 s), y, TextColor, s); 373 s := inttostr(CityReport.Production); 374 ReplaceText(x + CityNameSpace + 4 + 132 - BiColorTextWidth(ca, s), y, 375 TextColor, s); 376 if NonText then 377 begin 378 // Sprite(offscreen,HGrSystem,x+CityNameSpace+4+333+1,y+6,10,10,66,115); 379 Sprite(offscreen, HGrSystem, x + CityNameSpace + 4 + 370 + 48 + 1, 380 y + 6, 10, 10, 77, 126); 381 Sprite(offscreen, HGrSystem, x + CityNameSpace + 4 + 132 + 1, y + 6, 382 10, 10, 88, 115); 383 end 384 end; 385 s := inttostr(CityTaxBalance(lix, CityReport)); 386 ReplaceText(x + CityNameSpace + 4 + 370 - BiColorTextWidth(ca, s), y, 387 TextColor, s); 388 // if Project and (cpImp+cpIndex)<>cpImp+imTrGoods then 389 // ReplaceText(x+CityNameSpace+4+333+1,y,TextColor,Format('%d/%d',[TrueProd,CityReport.ProjectCost])); 390 if NonText then 391 begin 392 Sprite(offscreen, HGrSystem, x + CityNameSpace + 4 + 370 + 1, y + 6, 393 10, 10, 132, 115); 394 395 // food progress 396 CanGrow := (Size < MaxCitySize) and (MyRO.Government <> gFuture) and 397 (CityReport.FoodSurplus > 0) and 398 ((Size < NeedAqueductSize) or (Built[imAqueduct] = 1) and 399 (Size < NeedSewerSize) or (Built[imSewer] = 1)); 400 PaintRelativeProgressBar(offscreen.Canvas, 1, x + 15 + CityNameSpace + 401 4, y + 7, 68, TrueFood, CutCityFoodSurplus(CityReport.FoodSurplus, 402 (MyRO.Government <> gAnarchy) and (Flags and chCaptured = 0), 403 MyRO.Government, Size), CityReport.Storage, CanGrow, MainTexture); 404 405 if Project <> cpImp + imTrGoods then 406 begin 407 DisplayProject(ofs + 104 - 76 + x - 28 + CityNameSpace + 4 + 206 - 408 60, y0 - 15, Project); 409 410 // production progress 411 growth := CityReport.Production; 412 if (growth < 0) or (MyRO.Government = gAnarchy) or 413 (Flags and chCaptured <> 0) then 414 growth := 0; 415 PaintRelativeProgressBar(offscreen.Canvas, 4, 416 x + CityNameSpace + 4 + 304 - 60 + 9, y + 7, 68, TrueProd, growth, 417 CityReport.ProjectCost, true, MainTexture); 418 end; 419 end 420 end; 300 421 end 422 else if Kind in [kModels, kEModels] then 423 begin 424 x := 104; 425 y := y0; 426 if ca = Canvas then 427 begin 428 x := x + SideFrame; 429 y := y + TitleHeight 430 end; 431 if lit then 432 TextColor := MainTexture.clLitText 433 else 434 TextColor := -1; 435 if Kind = kModels then 436 begin 437 Available := 0; 438 for j := 0 to MyRO.nUn - 1 do 439 if (MyUn[j].Loc >= 0) and (MyUn[j].mix = lix) then 440 inc(Available); 441 if MainScreen.mNames.Checked then 442 s := Tribe[me].ModelName[lix] 443 else 444 s := Format(Tribe[me].TPhrase('GENMODEL'), [lix]); 445 if NonText then 446 DisplayProject(8 + ofs, y0 - 15, lix); 447 end 448 else 449 begin 450 Available := MyRO.EnemyReport[pView].UnCount[lix]; 451 if MainScreen.mNames.Checked then 452 s := Tribe[pView].ModelName[lix] 453 else 454 s := Format(Tribe[pView].TPhrase('GENMODEL'), [lix]); 455 if NonText then 456 with Tribe[pView].ModelPicture[lix] do 457 Sprite(offscreen, HGr, 8 + ofs, y0 - 15, 64, 48, pix mod 10 * 65 + 1, 458 pix div 10 * 49 + 1); 459 end; 460 if Available > 0 then 461 ReplaceText(x + 32 - BiColorTextWidth(ca, inttostr(Available)), y, 462 TextColor, inttostr(Available)); 463 ReplaceText(x + 40, y, TextColor, s); 464 end 301 465 else 302 begin 303 CityReport.HypoTiles:=-1; 304 CityReport.HypoTaxRate:=-1; 305 CityReport.HypoLuxuryRate:=-1; 306 Server(sGetCityReportNew,me,lix,CityReport); 307 TrueFood:=Food; 308 TrueProd:=Prod; 309 if supervising then 310 begin // normalize city from after-turn state 311 dec(TrueFood,CityReport.FoodSurplus); 312 if TrueFood<0 then 313 TrueFood:=0; // shouldn't happen 314 dec(TrueProd,CityReport.Production); 315 if TrueProd<0 then 316 TrueProd:=0; // shouldn't happen 317 end; 318 319 s:=''; // disorder info 320 if Flags and chCaptured<>0 then 321 s:=Phrases.Lookup('CITYEVENTS',14) 322 else if CityReport.HappinessBalance<0 then 323 s:=Phrases.Lookup('CITYEVENTS',0); 324 if s<>'' then 325 begin {disorder} 326 if NonText then 327 begin 328 DarkGradient(offscreen.Canvas,99+31+CityNameSpace+4,y0+2,131,3); 329 ca.Font.Assign(UniFont[ftSmall]); 330 RisedTextout(offscreen.canvas,103+CityNameSpace+4+31,y0+1,s); 331 ca.Font.Assign(UniFont[ftNormal]); 332 end 333 end 334 else 335 begin 336 { s:=IntToStr(CityReport.FoodSurplus); 337 ReplaceText(x+(CityNameSpace+4+48)-BiColorTextWidth(ca,s),y,TextColor,s);} 338 s:=IntToStr(CityReport.Science); 339 ReplaceText(x+CityNameSpace+4+370+48-BiColorTextWidth(ca,s),y,TextColor,s); 340 s:=IntToStr(CityReport.Production); 341 ReplaceText(x+CityNameSpace+4+132-BiColorTextWidth(ca,s),y,TextColor,s); 342 if NonText then 343 begin 344 //Sprite(offscreen,HGrSystem,x+CityNameSpace+4+333+1,y+6,10,10,66,115); 345 Sprite(offscreen,HGrSystem,x+CityNameSpace+4+370+48+1,y+6,10,10,77,126); 346 Sprite(offscreen,HGrSystem,x+CityNameSpace+4+132+1,y+6,10,10,88,115); 347 end 348 end; 349 s:=IntToStr(CityTaxBalance(lix, CityReport)); 350 ReplaceText(x+CityNameSpace+4+370-BiColorTextWidth(ca,s),y,TextColor,s); 351 //if Project and (cpImp+cpIndex)<>cpImp+imTrGoods then 352 // ReplaceText(x+CityNameSpace+4+333+1,y,TextColor,Format('%d/%d',[TrueProd,CityReport.ProjectCost])); 353 if NonText then 354 begin 355 Sprite(offscreen,HGrSystem,x+CityNameSpace+4+370+1,y+6,10,10,132,115); 356 357 // food progress 358 CanGrow:=(Size<MaxCitySize) and (MyRO.Government<>gFuture) 359 and (CityReport.FoodSurplus>0) 360 and ((Size<NeedAqueductSize) 361 or (Built[imAqueduct]=1) and (Size<NeedSewerSize) 362 or (Built[imSewer]=1)); 363 PaintRelativeProgressBar(offscreen.canvas,1,x+15+CityNameSpace+4,y+7,68,TrueFood, 364 CutCityFoodSurplus(CityReport.FoodSurplus, 365 (MyRO.Government<>gAnarchy) and (Flags and chCaptured=0), 366 MyRO.Government,Size),CityReport.Storage,CanGrow,MainTexture); 367 368 if Project<>cpImp+imTrGoods then 369 begin 370 DisplayProject(ofs+104-76+x-28+CityNameSpace+4+206-60,y0-15,Project); 371 372 // production progress 373 growth:=CityReport.Production; 374 if (growth<0) or (MyRO.Government=gAnarchy) 375 or (Flags and chCaptured<>0) then 376 growth:=0; 377 PaintRelativeProgressBar(offscreen.canvas,4,x+CityNameSpace+4+304-60+9,y+7,68, 378 TrueProd,growth,CityReport.ProjectCost,true,MainTexture); 379 end; 380 end 381 end; 382 end 383 else if Kind in [kModels,kEModels] then 384 begin 385 x:=104; y:=y0; 386 if ca=Canvas then 387 begin x:=x+SideFrame; y:=y+TitleHeight end; 388 if lit then TextColor:=MainTexture.clLitText else TextColor:=-1; 389 if Kind=kModels then 390 begin 391 Available:=0; 392 for j:=0 to MyRO.nUn-1 do 393 if (MyUn[j].Loc>=0) and (MyUn[j].mix=lix) then inc(Available); 394 if MainScreen.mNames.Checked then 395 s:=Tribe[me].ModelName[lix] 396 else s:=Format(Tribe[me].TPhrase('GENMODEL'),[lix]); 397 if NonText then DisplayProject(8+ofs,y0-15,lix); 398 end 399 else 400 begin 401 Available:=MyRO.EnemyReport[pView].UnCount[lix]; 402 if MainScreen.mNames.Checked then 403 s:=Tribe[pView].ModelName[lix] 404 else s:=Format(Tribe[pView].TPhrase('GENMODEL'),[lix]); 405 if NonText then 406 with Tribe[pView].ModelPicture[lix] do 407 Sprite(offscreen,HGr,8+ofs,y0-15,64,48,pix mod 10*65+1, pix div 10 *49+1); 408 end; 409 if Available>0 then 410 ReplaceText(x+32-BiColorTextWidth(ca,IntToStr(Available)),y,TextColor, 411 IntToStr(Available)); 412 ReplaceText(x+40,y,TextColor,s); 413 end 414 else 415 begin 416 case Kind of 417 kAllEModels, kChooseEModel: 418 if lix=mixAll then s:=Phrases.Lookup('PRICECAT_ALLMODEL') 419 else 420 begin 421 mox:=@MyRO.EnemyModel[lix]; 422 if MainScreen.mNames.Checked then 423 begin 424 s:=Tribe[mox.Owner].ModelName[mox.mix]; 425 if (Kind=kAllEModels) and (code[1,sb.si.npos+l]=0) then 426 s:=Format(Tribe[mox.Owner].TPhrase('OWNED'), [s]); 466 begin 467 case Kind of 468 kAllEModels, kChooseEModel: 469 if lix = mixAll then 470 s := Phrases.Lookup('PRICECAT_ALLMODEL') 471 else 472 begin 473 mox := @MyRO.EnemyModel[lix]; 474 if MainScreen.mNames.Checked then 475 begin 476 s := Tribe[mox.Owner].ModelName[mox.mix]; 477 if (Kind = kAllEModels) and (code[1, sb.si.npos + l] = 0) then 478 s := Format(Tribe[mox.Owner].TPhrase('OWNED'), [s]); 427 479 end 428 else s:=Format(Tribe[mox.Owner].TPhrase('GENMODEL'),[mox.mix]); 429 if NonText then 430 with Tribe[mox.Owner].ModelPicture[mox.mix] do 431 Sprite(offscreen,HGr,8+ofs,y0-15,64,48,pix mod 10*65+1, pix div 10 *49+1); 432 end; 433 kChooseModel: 434 if lix=mixAll then s:=Phrases.Lookup('PRICECAT_ALLMODEL') 435 else 436 begin 437 s:=Tribe[me].ModelName[lix]; 438 if NonText then DisplayProject(8+ofs,y0-15,lix); 439 end; 440 kProject: 441 begin 442 if lix and cpType<>0 then s:=Phrases.Lookup('CITYTYPE',lix and cpIndex) 443 else if lix and cpImp=0 then with MyModel[lix and cpIndex] do 444 begin 445 s:=Tribe[me].ModelName[lix and cpIndex]; 446 if lix and cpConscripts<>0 then 447 s:=Format(Phrases.Lookup('CONSCRIPTS'),[s]); 448 end 449 else 450 begin 451 s:=Phrases.Lookup('IMPROVEMENTS',lix and cpIndex); 452 if (Imp[lix and cpIndex].Kind in [ikNatLocal,ikNatGlobal]) 453 and (MyRO.NatBuilt[lix and cpIndex]>0) 454 or (lix and cpIndex in [imPower,imHydro,imNuclear]) 455 and (MyCity[cixProject].Built[imPower] 456 +MyCity[cixProject].Built[imHydro] 457 +MyCity[cixProject].Built[imNuclear]>0) then 458 s:=Format(Phrases.Lookup('NATEXISTS'),[s]); 459 end; 460 if NonText then DisplayProject(8+ofs,y0-15,lix); 461 end; 462 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, kStealTech: 463 begin 464 if lix=adAll then s:=Phrases.Lookup('PRICECAT_ALLTECH') 465 else 466 begin 467 if lix=adNexus then s:=Phrases.Lookup('NEXUS') 468 else if lix=adNone then s:=Phrases.Lookup('NOFARTECH') 469 else if lix=adMilitary then s:=Phrases.Lookup('INITUNIT') 480 else 481 s := Format(Tribe[mox.Owner].TPhrase('GENMODEL'), [mox.mix]); 482 if NonText then 483 with Tribe[mox.Owner].ModelPicture[mox.mix] do 484 Sprite(offscreen, HGr, 8 + ofs, y0 - 15, 64, 48, 485 pix mod 10 * 65 + 1, pix div 10 * 49 + 1); 486 end; 487 kChooseModel: 488 if lix = mixAll then 489 s := Phrases.Lookup('PRICECAT_ALLMODEL') 470 490 else 471 begin 472 s:=Phrases.Lookup('ADVANCES',lix); 473 if (Kind=kAdvance) and (lix in FutureTech) then 474 if MyRO.Tech[lix]<tsApplicable then s:=s+' 1' 475 else s:=s+' '+IntToStr(MyRO.Tech[lix]+1); 476 end; 477 if BiColorTextWidth(ca,s)>TechNameSpace+8 then 478 begin 479 repeat 480 delete(s,length(s),1); 481 until BiColorTextWidth(ca,s)<=TechNameSpace+5; 482 s:=s+'.'; 483 end; 484 485 if NonText then 486 begin // show tech icon 487 if lix=adNexus then 491 begin 492 s := Tribe[me].ModelName[lix]; 493 if NonText then 494 DisplayProject(8 + ofs, y0 - 15, lix); 495 end; 496 kProject: 497 begin 498 if lix and cpType <> 0 then 499 s := Phrases.Lookup('CITYTYPE', lix and cpIndex) 500 else if lix and cpImp = 0 then 501 with MyModel[lix and cpIndex] do 488 502 begin 489 Frame(offscreen.Canvas,(8+16-1),y0-1,(8+16+36), 490 y0+20,MainTexture.clBevelLight,MainTexture.clBevelShade); 491 Dump(offscreen,HGrSystem,(8+16),y0,36,20,223,295) 492 end 493 else if lix=adNone then 494 begin 495 Frame(offscreen.Canvas,(8+16-1),y0-1,(8+16+36), 496 y0+20,MainTexture.clBevelLight,MainTexture.clBevelShade); 497 Dump(offscreen,HGrSystem,(8+16),y0,36,20,260,295) 498 end 499 else if lix=adMilitary then 500 begin 501 Frame(offscreen.Canvas,(8+16-1),y0-1,(8+16+36), 502 y0+20,MainTexture.clBevelLight,MainTexture.clBevelShade); 503 Dump(offscreen,HGrSystem,(8+16),y0,36,20,38,295) 503 s := Tribe[me].ModelName[lix and cpIndex]; 504 if lix and cpConscripts <> 0 then 505 s := Format(Phrases.Lookup('CONSCRIPTS'), [s]); 504 506 end 505 507 else 508 begin 509 s := Phrases.Lookup('IMPROVEMENTS', lix and cpIndex); 510 if (Imp[lix and cpIndex].Kind in [ikNatLocal, ikNatGlobal]) and 511 (MyRO.NatBuilt[lix and cpIndex] > 0) or 512 (lix and cpIndex in [imPower, imHydro, imNuclear]) and 513 (MyCity[cixProject].Built[imPower] + MyCity[cixProject].Built 514 [imHydro] + MyCity[cixProject].Built[imNuclear] > 0) then 515 s := Format(Phrases.Lookup('NATEXISTS'), [s]); 516 end; 517 if NonText then 518 DisplayProject(8 + ofs, y0 - 15, lix); 519 end; 520 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, kStealTech: 521 begin 522 if lix = adAll then 523 s := Phrases.Lookup('PRICECAT_ALLTECH') 524 else 525 begin 526 if lix = adNexus then 527 s := Phrases.Lookup('NEXUS') 528 else if lix = adNone then 529 s := Phrases.Lookup('NOFARTECH') 530 else if lix = adMilitary then 531 s := Phrases.Lookup('INITUNIT') 532 else 506 533 begin 507 Frame(offscreen.Canvas,(8+16-1),y0-1,(8+16+xSizeSmall), 508 y0+ySizeSmall,MainTexture.clBevelLight,MainTexture.clBevelShade); 509 if AdvIcon[lix]<84 then 510 BitBlt(offscreen.Canvas.Handle,(8+16),y0,xSizeSmall,ySizeSmall, 511 SmallImp.Canvas.Handle,(AdvIcon[lix]+SystemIconLines*7) mod 7*xSizeSmall, 512 (AdvIcon[lix]+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY) 513 else Dump(offscreen,HGrSystem,(8+16),y0,36,20, 514 1+(AdvIcon[lix]-84) mod 8*37,295+(AdvIcon[lix]-84) div 8*21); 515 j:=AdvValue[lix] div 1000; 516 BitBlt(Handle,(8+16-4),y0+2,14,14, 517 GrExt[HGrSystem].Mask.Canvas.Handle,127+j*15,85,SRCAND); 518 Sprite(offscreen,HGrSystem,(8+16-5),y0+1,14,14, 519 127+j*15,85); 534 s := Phrases.Lookup('ADVANCES', lix); 535 if (Kind = kAdvance) and (lix in FutureTech) then 536 if MyRO.Tech[lix] < tsApplicable then 537 s := s + ' 1' 538 else 539 s := s + ' ' + inttostr(MyRO.Tech[lix] + 1); 520 540 end; 521 end; 522 end; 523 524 if NonText and (Kind in [kAdvance, kScience]) then 525 begin // show research state 526 for j:=0 to nColumn-1 do 527 begin 528 FutureCount:=0; 529 if j=0 then // own science 530 if lix=MyRO.ResearchTech then 541 if BiColorTextWidth(ca, s) > TechNameSpace + 8 then 542 begin 543 repeat 544 delete(s, length(s), 1); 545 until BiColorTextWidth(ca, s) <= TechNameSpace + 5; 546 s := s + '.'; 547 end; 548 549 if NonText then 550 begin // show tech icon 551 if lix = adNexus then 531 552 begin 532 Server(sGetTechCost,me,0,icon);533 icon:=4+MyRO.Research*4 div icon;534 if icon>4+3 then icon:=4+3553 Frame(offscreen.Canvas, (8 + 16 - 1), y0 - 1, (8 + 16 + 36), 554 y0 + 20, MainTexture.clBevelLight, MainTexture.clBevelShade); 555 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, 223, 295) 535 556 end 536 else if (lix>=adMilitary) then 537 icon:=-1 538 else if lix in FutureTech then 557 else if lix = adNone then 539 558 begin 540 icon:=-1; 541 FutureCount:=MyRO.Tech[lix]; 559 Frame(offscreen.Canvas, (8 + 16 - 1), y0 - 1, (8 + 16 + 36), 560 y0 + 20, MainTexture.clBevelLight, MainTexture.clBevelShade); 561 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, 260, 295) 542 562 end 543 else if MyRO.Tech[lix]=tsSeen then icon:=1 544 else if MyRO.Tech[lix]>=tsApplicable then icon:=2 545 else icon:=-1 546 else with MyRO.EnemyReport[Column[j]]^ do // enemy science 547 if (MyRO.Alive and (1 shl Column[j])<>0) 548 and (TurnOfCivilReport>=0) and (lix=ResearchTech) 549 and ((lix=adMilitary) or (lix in FutureTech) 550 or (Tech[lix]<tsApplicable)) then 563 else if lix = adMilitary then 551 564 begin 552 icon:=4+ResearchDone div 25; 553 if icon>4+3 then icon:=4+3 565 Frame(offscreen.Canvas, (8 + 16 - 1), y0 - 1, (8 + 16 + 36), 566 y0 + 20, MainTexture.clBevelLight, MainTexture.clBevelShade); 567 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, 38, 295) 554 568 end 555 else if lix=adMilitary then 556 icon:=-1 557 else if lix in FutureTech then 569 else 558 570 begin 559 icon:=-1; 560 FutureCount:=Tech[lix] 571 Frame(offscreen.Canvas, (8 + 16 - 1), y0 - 1, 572 (8 + 16 + xSizeSmall), y0 + ySizeSmall, 573 MainTexture.clBevelLight, MainTexture.clBevelShade); 574 if AdvIcon[lix] < 84 then 575 BitBlt(offscreen.Canvas.Handle, (8 + 16), y0, xSizeSmall, 576 ySizeSmall, SmallImp.Canvas.Handle, 577 (AdvIcon[lix] + SystemIconLines * 7) mod 7 * xSizeSmall, 578 (AdvIcon[lix] + SystemIconLines * 7) div 7 * 579 ySizeSmall, SRCCOPY) 580 else 581 Dump(offscreen, HGrSystem, (8 + 16), y0, 36, 20, 582 1 + (AdvIcon[lix] - 84) mod 8 * 37, 583 295 + (AdvIcon[lix] - 84) div 8 * 21); 584 j := AdvValue[lix] div 1000; 585 BitBlt(Handle, (8 + 16 - 4), y0 + 2, 14, 14, 586 GrExt[HGrSystem].Mask.Canvas.Handle, 127 + j * 15, 587 85, SRCAND); 588 Sprite(offscreen, HGrSystem, (8 + 16 - 5), y0 + 1, 14, 14, 589 127 + j * 15, 85); 590 end; 591 end; 592 end; 593 594 if NonText and (Kind in [kAdvance, kScience]) then 595 begin // show research state 596 for j := 0 to nColumn - 1 do 597 begin 598 FutureCount := 0; 599 if j = 0 then // own science 600 if lix = MyRO.ResearchTech then 601 begin 602 Server(sGetTechCost, me, 0, icon); 603 icon := 4 + MyRO.Research * 4 div icon; 604 if icon > 4 + 3 then 605 icon := 4 + 3 606 end 607 else if (lix >= adMilitary) then 608 icon := -1 609 else if lix in FutureTech then 610 begin 611 icon := -1; 612 FutureCount := MyRO.Tech[lix]; 613 end 614 else if MyRO.Tech[lix] = tsSeen then 615 icon := 1 616 else if MyRO.Tech[lix] >= tsApplicable then 617 icon := 2 618 else 619 icon := -1 620 else 621 with MyRO.EnemyReport[Column[j]]^ do // enemy science 622 if (MyRO.Alive and (1 shl Column[j]) <> 0) and 623 (TurnOfCivilReport >= 0) and (lix = ResearchTech) and 624 ((lix = adMilitary) or (lix in FutureTech) or 625 (Tech[lix] < tsApplicable)) then 626 begin 627 icon := 4 + ResearchDone div 25; 628 if icon > 4 + 3 then 629 icon := 4 + 3 630 end 631 else if lix = adMilitary then 632 icon := -1 633 else if lix in FutureTech then 634 begin 635 icon := -1; 636 FutureCount := Tech[lix] 637 end 638 else if Tech[lix] >= tsApplicable then 639 icon := 2 640 else if Tech[lix] = tsSeen then 641 icon := 1 642 else 643 icon := -1; 644 if icon >= 0 then 645 Sprite(offscreen, HGrSystem, 104 - 33 + 15 + 3 + TechNameSpace + 646 24 * j, y0 + 3, 14, 14, 67 + icon * 15, 85) 647 else if (Kind = kScience) and (FutureCount > 0) then 648 begin 649 number := inttostr(FutureCount); 650 RisedTextout(ca, 104 - 33 + 15 + 10 + TechNameSpace + 24 * j - 651 BiColorTextWidth(ca, number) div 2, y0, number); 561 652 end 562 else if Tech[lix]>=tsApplicable then563 icon:=2564 else if Tech[lix]=tsSeen then565 icon:=1566 else icon:=-1;567 if icon>=0 then568 Sprite(offscreen,HGrSystem,104-33+15+3+TechNameSpace+24*j,y0+3,569 14,14,67+icon*15,85)570 else if (Kind=kScience) and (FutureCount>0) then571 begin572 number:=inttostr(FutureCount);573 RisedTextOut(ca,104-33+15+10+TechNameSpace+24*j574 -BiColorTextWidth(ca,number) div 2,y0,number);575 653 end 654 end; 655 end; // kAdvance, kScience 656 kTribe: 657 s := TribeNames[lix]; 658 kShipPart: 659 begin 660 s := Phrases.Lookup('IMPROVEMENTS', imShipComp + lix) + ' (' + 661 inttostr(MyRO.Ship[me].Parts[lix]) + ')'; 662 if NonText then 663 DisplayProject(8 + ofs, y0 - 15, cpImp + imShipComp + lix); 664 end; 665 kEShipPart: 666 begin 667 s := Phrases.Lookup('IMPROVEMENTS', imShipComp + lix) + ' (' + 668 inttostr(MyRO.Ship[DipMem[me].pContact].Parts[lix]) + ')'; 669 if NonText then 670 DisplayProject(8 + ofs, y0 - 15, cpImp + imShipComp + lix); 671 end; 672 kGov: 673 begin 674 s := Phrases.Lookup('GOVERNMENT', lix); 675 if NonText then 676 begin 677 Frame(offscreen.Canvas, 8 + 16 - 1, y0 - 15 + (16 - 2), 678 8 + 16 + xSizeSmall, y0 - 15 + (16 - 1 + ySizeSmall), 679 MainTexture.clBevelLight, MainTexture.clBevelShade); 680 BitBlt(offscreen.Canvas.Handle, 8 + 16, y0 - 15 + (16 - 1), 681 xSizeSmall, ySizeSmall, SmallImp.Canvas.Handle, 682 (lix - 1) * xSizeSmall, ySizeSmall, SRCCOPY); 576 683 end 577 684 end; 578 end; // kAdvance, kScience 579 kTribe: 580 s:=TribeNames[lix]; 581 kShipPart: 582 begin 583 s:=Phrases.Lookup('IMPROVEMENTS',imShipComp+lix) 584 +' ('+inttostr(MyRO.Ship[me].Parts[lix])+')'; 585 if NonText then DisplayProject(8+ofs,y0-15,cpImp+imShipComp+lix); 586 end; 587 kEShipPart: 588 begin 589 s:=Phrases.Lookup('IMPROVEMENTS',imShipComp+lix) 590 +' ('+inttostr(MyRO.Ship[DipMem[me].pContact].Parts[lix])+')'; 591 if NonText then DisplayProject(8+ofs,y0-15,cpImp+imShipComp+lix); 592 end; 593 kGov: 594 begin 595 s:=Phrases.Lookup('GOVERNMENT',lix); 596 if NonText then 597 begin 598 Frame(offscreen.Canvas,8+16-1,y0-15+(16-2),8+16+xSizeSmall, 599 y0-15+(16-1+ySizeSmall),MainTexture.clBevelLight,MainTexture.clBevelShade); 600 BitBlt(offscreen.Canvas.Handle,8+16,y0-15+(16-1),xSizeSmall,ySizeSmall, 601 SmallImp.Canvas.Handle,(lix-1)*xSizeSmall,ySizeSmall,SRCCOPY); 602 end 603 end; 604 kMission: 605 s:=Phrases.Lookup('SPYMISSION',lix); 685 kMission: 686 s := Phrases.Lookup('SPYMISSION', lix); 606 687 end; 607 case Kind of 608 kTribe,kMission: // center text 609 if Lines[0]>MaxLines then 610 x:=(InnerWidth-GetSystemMetrics(SM_CXVSCROLL)) div 2-BiColorTextWidth(ca,s) div 2 611 else x:=InnerWidth div 2-BiColorTextWidth(ca,s) div 2; 612 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, kStealTech, kGov: 613 x:=104-33; 614 kAllEModels: x:=104; 615 else x:=104+15; 688 case Kind of 689 kTribe, kMission: // center text 690 if Lines[0] > MaxLines then 691 x := (InnerWidth - GetSystemMetrics(SM_CXVSCROLL)) div 2 - 692 BiColorTextWidth(ca, s) div 2 693 else 694 x := InnerWidth div 2 - BiColorTextWidth(ca, s) div 2; 695 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, 696 kStealTech, kGov: 697 x := 104 - 33; 698 kAllEModels: 699 x := 104; 700 else 701 x := 104 + 15; 616 702 end; 617 y:=y0; 618 if ca=Canvas then 619 begin x:=x+SideFrame; y:=y+TitleHeight end; 620 if lit then TextColor:=MainTexture.clLitText 621 else TextColor:=-1; 622 { if Kind=kTribe then ReplaceText_Tribe(x,y,TextColor, 623 integer(TribeNames.Objects[lix]),s) 624 else} ReplaceText(x,y,TextColor,s); 703 y := y0; 704 if ca = Canvas then 705 begin 706 x := x + SideFrame; 707 y := y + TitleHeight 708 end; 709 if lit then 710 TextColor := MainTexture.clLitText 711 else 712 TextColor := -1; 713 { if Kind=kTribe then ReplaceText_Tribe(x,y,TextColor, 714 integer(TribeNames.Objects[lix]),s) 715 else } ReplaceText(x, y, TextColor, s); 625 716 end 626 717 end; … … 628 719 procedure TListDlg.OffscreenPaint; 629 720 var 630 i,j: integer; 631 begin 632 case Kind of 633 kCities: Caption:=Tribe[me].TPhrase('TITLE_CITIES'); 634 kCityEvents: Caption:=Format(Phrases.Lookup('TITLE_EVENTS'),[TurnToString(MyRO.Turn)]); 635 end; 636 637 inherited; 638 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 639 FillOffscreen(0,0,InnerWidth,InnerHeight); 640 with offscreen.Canvas do 641 begin 642 if Kind=kScience then 643 for i:=1 to nColumn-1 do 644 begin 645 Pen.Color:=$000000; 646 MoveTo(104-33+15+TechNameSpace+24*i,0); 647 LineTo(104-33+15+TechNameSpace+24*i,InnerHeight); 648 MoveTo(104-33+15+TechNameSpace+9*2+24*i,0); 649 LineTo(104-33+15+TechNameSpace+9*2+24*i,InnerHeight); 650 if MyRO.EnemyReport[Column[i]].TurnOfCivilReport>=MyRO.Turn-1 then 651 begin 652 brush.color:=Tribe[Column[i]].Color; 653 FillRect(Rect(104-33+14+TechNameSpace+24*i+1*2,0, 654 104-33+17+TechNameSpace+24*i+8*2,InnerHeight)); 655 brush.style:=bsClear; 721 i, j: integer; 722 begin 723 case Kind of 724 kCities: 725 Caption := Tribe[me].TPhrase('TITLE_CITIES'); 726 kCityEvents: 727 Caption := Format(Phrases.Lookup('TITLE_EVENTS'), 728 [TurnToString(MyRO.Turn)]); 729 end; 730 731 inherited; 732 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 733 FillOffscreen(0, 0, InnerWidth, InnerHeight); 734 with offscreen.Canvas do 735 begin 736 if Kind = kScience then 737 for i := 1 to nColumn - 1 do 738 begin 739 Pen.Color := $000000; 740 MoveTo(104 - 33 + 15 + TechNameSpace + 24 * i, 0); 741 LineTo(104 - 33 + 15 + TechNameSpace + 24 * i, InnerHeight); 742 MoveTo(104 - 33 + 15 + TechNameSpace + 9 * 2 + 24 * i, 0); 743 LineTo(104 - 33 + 15 + TechNameSpace + 9 * 2 + 24 * i, InnerHeight); 744 if MyRO.EnemyReport[Column[i]].TurnOfCivilReport >= MyRO.Turn - 1 then 745 begin 746 brush.Color := Tribe[Column[i]].Color; 747 fillrect(rect(104 - 33 + 14 + TechNameSpace + 24 * i + 1 * 2, 0, 748 104 - 33 + 17 + TechNameSpace + 24 * i + 8 * 2, InnerHeight)); 749 brush.style := bsClear; 656 750 end 657 else751 else 658 752 begin // colored player columns 659 Pen.Color:=Tribe[Column[i]].Color;660 for j:=1 to 8 do661 begin 662 MoveTo(104-33+15+TechNameSpace+24*i+j*2,0);663 LineTo(104-33+15+TechNameSpace+24*i+j*2,InnerHeight);753 Pen.Color := Tribe[Column[i]].Color; 754 for j := 1 to 8 do 755 begin 756 MoveTo(104 - 33 + 15 + TechNameSpace + 24 * i + j * 2, 0); 757 LineTo(104 - 33 + 15 + TechNameSpace + 24 * i + j * 2, InnerHeight); 664 758 end 665 759 end; 666 760 end; 667 for i:=-1 to DispLines do if (i+sb.si.npos>=0) and (i+sb.si.npos<Lines[Layer]) then 668 line(offscreen.Canvas,i,true,false) 669 end; 670 MarkUsedOffscreen(InnerWidth,8+48+DispLines*LineDistance); 671 end; 672 673 procedure TListDlg.PaintBox1MouseMove(Sender:TObject; 674 Shift:TShiftState;x,y:integer); 761 for i := -1 to DispLines do 762 if (i + sb.si.npos >= 0) and (i + sb.si.npos < Lines[Layer]) then 763 line(offscreen.Canvas, i, true, false) 764 end; 765 MarkUsedOffscreen(InnerWidth, 8 + 48 + DispLines * LineDistance); 766 end; 767 768 procedure TListDlg.PaintBox1MouseMove(Sender: TObject; Shift: TShiftState; 769 x, y: integer); 675 770 var 676 i0,Sel0,iColumn,OldScienceNation,xScreen: integer; 677 s: string; 678 begin 679 y:=y-TitleHeight; 680 i0:=sb.si.npos; 681 Sel0:=Sel; 682 if (x>=SideFrame) and (x<SideFrame+InnerWidth) and (y>=0) and (y<InnerHeight) 683 and (y mod LineDistance>=4) and (y mod LineDistance<20) then 684 Sel:=y div LineDistance-1 685 else Sel:=-2; 686 if (Sel<-1) or (Sel>DispLines) or (Sel+i0<0) or (Sel+i0>=Lines[Layer]) then 687 Sel:=-2; 688 if Sel<>Sel0 then 689 begin 690 if Sel0<>-2 then line(Canvas,Sel0,false,false); 691 if Sel<>-2 then line(Canvas,Sel,false,true) 692 end; 693 694 if Kind=kScience then 771 i0, Sel0, iColumn, OldScienceNation, xScreen: integer; 772 s: string; 773 begin 774 y := y - TitleHeight; 775 i0 := sb.si.npos; 776 Sel0 := Sel; 777 if (x >= SideFrame) and (x < SideFrame + InnerWidth) and (y >= 0) and 778 (y < InnerHeight) and (y mod LineDistance >= 4) and (y mod LineDistance < 20) 779 then 780 Sel := y div LineDistance - 1 781 else 782 Sel := -2; 783 if (Sel < -1) or (Sel > DispLines) or (Sel + i0 < 0) or 784 (Sel + i0 >= Lines[Layer]) then 785 Sel := -2; 786 if Sel <> Sel0 then 787 begin 788 if Sel0 <> -2 then 789 line(Canvas, Sel0, false, false); 790 if Sel <> -2 then 791 line(Canvas, Sel, false, true) 792 end; 793 794 if Kind = kScience then 695 795 begin // show nation under cursor position 696 OldScienceNation:=ScienceNation; 697 ScienceNation:=-1; 698 if (x>=SideFrame+(104-33+15+TechNameSpace)) and ((x-SideFrame-(104-33+15+TechNameSpace)) mod 24<=18) 699 and (y>=0) and (y<InnerHeight) then 796 OldScienceNation := ScienceNation; 797 ScienceNation := -1; 798 if (x >= SideFrame + (104 - 33 + 15 + TechNameSpace)) and 799 ((x - SideFrame - (104 - 33 + 15 + TechNameSpace)) mod 24 <= 18) and 800 (y >= 0) and (y < InnerHeight) then 700 801 begin 701 iColumn:=(x-SideFrame-(104-33+15+TechNameSpace)) div 24;702 if (iColumn>=1) and (iColumn<nColumn) then703 ScienceNation:=Column[iColumn];802 iColumn := (x - SideFrame - (104 - 33 + 15 + TechNameSpace)) div 24; 803 if (iColumn >= 1) and (iColumn < nColumn) then 804 ScienceNation := Column[iColumn]; 704 805 end; 705 if ScienceNation<>OldScienceNation then806 if ScienceNation <> OldScienceNation then 706 807 begin 707 Fill(Canvas,9,ClientHeight-29,ClientWidth-18,24, 708 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 709 if ScienceNation>=0 then 710 begin 711 s:=Tribe[ScienceNation].TPhrase('SHORTNAME'); 712 if MyRO.Alive and (1 shl ScienceNation)=0 then 713 s:=Format(Phrases.Lookup('SCIENCEREPORT_EXTINCT'),[s]) // extinct 714 else if MyRO.EnemyReport[ScienceNation].TurnOfCivilReport<MyRO.Turn-1 then 715 s:=s+' ('+TurnToString(MyRO.EnemyReport[ScienceNation].TurnOfCivilReport)+')'; // old report 716 xScreen:=(ClientWidth-BiColorTextWidth(Canvas,s)) div 2; 717 LoweredTextOut(Canvas, -1, MainTexture, xScreen+10, ClientHeight-29, s); 718 BitBlt(ScienceNationDot.Canvas.Handle,0,0,17,17,Canvas.Handle,xScreen-10, 719 ClientHeight-27,SRCCOPY); 720 ImageOp_BCC(ScienceNationDot,Templates,0,0,114,211,17,17, 721 MainTexture.clBevelShade,Tribe[ScienceNation].Color); 722 BitBlt(Canvas.Handle,xScreen-10,ClientHeight-27,17,17, 723 ScienceNationDot.Canvas.Handle,0,0,SRCCOPY); 808 Fill(Canvas, 9, ClientHeight - 29, ClientWidth - 18, 24, 809 (wMaintexture - ClientWidth) div 2, 810 (hMaintexture - ClientHeight) div 2); 811 if ScienceNation >= 0 then 812 begin 813 s := Tribe[ScienceNation].TPhrase('SHORTNAME'); 814 if MyRO.Alive and (1 shl ScienceNation) = 0 then 815 s := Format(Phrases.Lookup('SCIENCEREPORT_EXTINCT'), [s]) // extinct 816 else if MyRO.EnemyReport[ScienceNation].TurnOfCivilReport < MyRO.Turn - 1 817 then 818 s := s + ' (' + TurnToString(MyRO.EnemyReport[ScienceNation] 819 .TurnOfCivilReport) + ')'; // old report 820 xScreen := (ClientWidth - BiColorTextWidth(Canvas, s)) div 2; 821 LoweredTextOut(Canvas, -1, MainTexture, xScreen + 10, 822 ClientHeight - 29, s); 823 BitBlt(ScienceNationDot.Canvas.Handle, 0, 0, 17, 17, Canvas.Handle, 824 xScreen - 10, ClientHeight - 27, SRCCOPY); 825 ImageOp_BCC(ScienceNationDot, Templates, 0, 0, 114, 211, 17, 17, 826 MainTexture.clBevelShade, Tribe[ScienceNation].Color); 827 BitBlt(Canvas.Handle, xScreen - 10, ClientHeight - 27, 17, 17, 828 ScienceNationDot.Canvas.Handle, 0, 0, SRCCOPY); 724 829 end; 725 830 end … … 729 834 function TListDlg.RenameCity(cix: integer): boolean; 730 835 var 731 CityNameInfo: TCityNameInfo; 732 begin 733 InputDlg.Caption:=Phrases.Lookup('TITLE_CITYNAME'); 734 InputDlg.EInput.Text:=CityName(MyCity[cix].ID); 735 InputDlg.CenterToRect(BoundsRect); 736 InputDlg.ShowModal; 737 if (InputDlg.ModalResult=mrOK) and (InputDlg.EInput.Text<>'') 738 and (InputDlg.EInput.Text<>CityName(MyCity[cix].ID)) then 739 begin 740 CityNameInfo.ID:=MyCity[cix].ID; 741 CityNameInfo.NewName:=InputDlg.EInput.Text; 742 Server(cSetCityName+(Length(CityNameInfo.NewName)+8) div 4,me,0,CityNameInfo); 743 if CityDlg.Visible then begin CityDlg.FormShow(nil); CityDlg.Invalidate end; 744 result:=true 836 CityNameInfo: TCityNameInfo; 837 begin 838 InputDlg.Caption := Phrases.Lookup('TITLE_CITYNAME'); 839 InputDlg.EInput.Text := CityName(MyCity[cix].ID); 840 InputDlg.CenterToRect(BoundsRect); 841 InputDlg.ShowModal; 842 if (InputDlg.ModalResult = mrOK) and (InputDlg.EInput.Text <> '') and 843 (InputDlg.EInput.Text <> CityName(MyCity[cix].ID)) then 844 begin 845 CityNameInfo.ID := MyCity[cix].ID; 846 CityNameInfo.NewName := InputDlg.EInput.Text; 847 Server(cSetCityName + (length(CityNameInfo.NewName) + 8) div 4, me, 0, 848 CityNameInfo); 849 if CityDlg.Visible then 850 begin 851 CityDlg.FormShow(nil); 852 CityDlg.Invalidate 853 end; 854 result := true 745 855 end 746 else result:=false 856 else 857 result := false 747 858 end; 748 859 749 860 function TListDlg.RenameModel(mix: integer): boolean; 750 861 var 751 ModelNameInfo: TModelNameInfo; 752 begin 753 InputDlg.Caption:=Phrases.Lookup('TITLE_MODELNAME'); 754 InputDlg.EInput.Text:=Tribe[me].ModelName[mix]; 755 InputDlg.CenterToRect(BoundsRect); 756 InputDlg.ShowModal; 757 if (InputDlg.ModalResult=mrOK) and (InputDlg.EInput.Text<>'') 758 and (InputDlg.EInput.Text<>Tribe[me].ModelName[mix]) then 759 begin 760 ModelNameInfo.mix:=mix; 761 ModelNameInfo.NewName:=InputDlg.EInput.Text; 762 Server(cSetModelName+(Length(ModelNameInfo.NewName)+1+4+3) div 4, 763 me,0,ModelNameInfo); 764 if UnitStatDlg.Visible then begin UnitStatDlg.FormShow(nil); UnitStatDlg.Invalidate end; 765 result:=true 862 ModelNameInfo: TModelNameInfo; 863 begin 864 InputDlg.Caption := Phrases.Lookup('TITLE_MODELNAME'); 865 InputDlg.EInput.Text := Tribe[me].ModelName[mix]; 866 InputDlg.CenterToRect(BoundsRect); 867 InputDlg.ShowModal; 868 if (InputDlg.ModalResult = mrOK) and (InputDlg.EInput.Text <> '') and 869 (InputDlg.EInput.Text <> Tribe[me].ModelName[mix]) then 870 begin 871 ModelNameInfo.mix := mix; 872 ModelNameInfo.NewName := InputDlg.EInput.Text; 873 Server(cSetModelName + (length(ModelNameInfo.NewName) + 1 + 4 + 3) div 4, 874 me, 0, ModelNameInfo); 875 if UnitStatDlg.Visible then 876 begin 877 UnitStatDlg.FormShow(nil); 878 UnitStatDlg.Invalidate 879 end; 880 result := true 766 881 end 767 else result:=false 768 end; 769 770 procedure TListDlg.PaintBox1MouseDown(Sender:TObject;Button:TMouseButton; 771 Shift:TShiftState;x,y:integer); 882 else 883 result := false 884 end; 885 886 procedure TListDlg.PaintBox1MouseDown(Sender: TObject; Button: TMouseButton; 887 Shift: TShiftState; x, y: integer); 772 888 var 773 lix: integer; 774 begin 775 if sb.si.npos+Sel>=0 then lix:=code[Layer,sb.si.npos+Sel]; 776 if Kind in [kScience,kCities,kCityEvents,kModels,kEModels,kAllEModels] then 777 include(Shift, ssShift); // don't close list window 778 if (ssLeft in Shift) and not(ssShift in Shift) then 779 begin 780 if Sel<>-2 then 781 begin result:=lix; Closable:=true; Close end 889 lix: integer; 890 begin 891 if sb.si.npos + Sel >= 0 then 892 lix := code[Layer, sb.si.npos + Sel]; 893 if Kind in [kScience, kCities, kCityEvents, kModels, kEModels, kAllEModels] 894 then 895 include(Shift, ssShift); // don't close list window 896 if (ssLeft in Shift) and not(ssShift in Shift) then 897 begin 898 if Sel <> -2 then 899 begin 900 result := lix; 901 Closable := true; 902 Close 903 end 782 904 end 783 else if (ssLeft in Shift) and (ssShift in Shift) then905 else if (ssLeft in Shift) and (ssShift in Shift) then 784 906 begin // show help/info popup 785 if Sel<>-2 then 786 case Kind of 787 kCities: 788 MainScreen.ZoomToCity(MyCity[lix].Loc); 789 kCityEvents: 790 MainScreen.ZoomToCity(MyCity[lix].Loc, false, MyCity[lix].Flags and CityRepMask); 791 kModels,kChooseModel: 792 if lix<>mixAll then 793 UnitStatDlg.ShowNewContent_OwnModel(FWindowMode or wmPersistent, lix); 794 kEModels: 795 UnitStatDlg.ShowNewContent_EnemyModel(FWindowMode or wmPersistent, code[1,sb.si.npos+Sel]); 796 kAllEModels,kChooseEModel: 797 if lix<>mixAll then 798 UnitStatDlg.ShowNewContent_EnemyModel(FWindowMode or wmPersistent, lix); 799 kAdvance,kFarAdvance,kScience,kChooseTech,kChooseETech,kStealTech: 800 if lix=adMilitary then 801 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, HelpDlg.TextIndex('MILRES')) 802 else if lix<adMilitary then 803 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkAdv, lix); 804 kProject: 805 if lix=cpImp+imTrGoods then 806 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText,HelpDlg.TextIndex('TRADINGGOODS')) 807 else if lix and (cpImp+cpType)=0 then 808 UnitStatDlg.ShowNewContent_OwnModel(FWindowMode or wmPersistent, lix and cpIndex) 809 else if (lix and cpType=0) and (lix<>cpImp+imTrGoods) then 810 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, lix and cpIndex); 811 kGov: 812 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkMisc, miscGovList); 813 kShipPart,kEShipPart:; 907 if Sel <> -2 then 908 case Kind of 909 kCities: 910 MainScreen.ZoomToCity(MyCity[lix].Loc); 911 kCityEvents: 912 MainScreen.ZoomToCity(MyCity[lix].Loc, false, MyCity[lix].Flags and 913 CityRepMask); 914 kModels, kChooseModel: 915 if lix <> mixAll then 916 UnitStatDlg.ShowNewContent_OwnModel(FWindowMode or 917 wmPersistent, lix); 918 kEModels: 919 UnitStatDlg.ShowNewContent_EnemyModel(FWindowMode or wmPersistent, 920 code[1, sb.si.npos + Sel]); 921 kAllEModels, kChooseEModel: 922 if lix <> mixAll then 923 UnitStatDlg.ShowNewContent_EnemyModel(FWindowMode or 924 wmPersistent, lix); 925 kAdvance, kFarAdvance, kScience, kChooseTech, kChooseETech, kStealTech: 926 if lix = adMilitary then 927 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, 928 HelpDlg.TextIndex('MILRES')) 929 else if lix < adMilitary then 930 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkAdv, lix); 931 kProject: 932 if lix = cpImp + imTrGoods then 933 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkText, 934 HelpDlg.TextIndex('TRADINGGOODS')) 935 else if lix and (cpImp + cpType) = 0 then 936 UnitStatDlg.ShowNewContent_OwnModel(FWindowMode or wmPersistent, 937 lix and cpIndex) 938 else if (lix and cpType = 0) and (lix <> cpImp + imTrGoods) then 939 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, 940 lix and cpIndex); 941 kGov: 942 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkMisc, 943 miscGovList); 944 kShipPart, kEShipPart: 945 ; 814 946 end 815 947 end 816 else if ssRight in Shift then 817 begin 818 if Sel<>-2 then 819 case Kind of 820 kCities, kCityEvents: 821 if RenameCity(lix) then SmartUpdateContent; 822 kModels: 823 if RenameModel(lix) then SmartUpdateContent; 948 else if ssRight in Shift then 949 begin 950 if Sel <> -2 then 951 case Kind of 952 kCities, kCityEvents: 953 if RenameCity(lix) then 954 SmartUpdateContent; 955 kModels: 956 if RenameModel(lix) then 957 SmartUpdateContent; 824 958 end 825 959 end … … 828 962 procedure TListDlg.InitLines; 829 963 var 830 required: array[0..nAdv-1] of integer; 831 832 procedure TryAddImpLine(Layer,Project: integer); 833 begin 834 if Server(sSetCityProject-sExecute,me,cixProject,Project)>=rExecuted then 835 begin code[Layer,Lines[Layer]]:=Project; inc(Lines[Layer]); end; 964 required: array [0 .. nAdv - 1] of integer; 965 966 procedure TryAddImpLine(Layer, Project: integer); 967 begin 968 if Server(sSetCityProject - sExecute, me, cixProject, Project) >= rExecuted 969 then 970 begin 971 code[Layer, Lines[Layer]] := Project; 972 inc(Lines[Layer]); 973 end; 836 974 end; 837 975 838 976 procedure SortTechs; 839 977 var 840 i,j,swap: integer;978 i, j, swap: integer; 841 979 begin // sort by advancedness 842 for i:=0 to Lines[0]-2 do if code[0,i]<adMilitary then 843 for j:=i+1 to Lines[0]-1 do 844 if AdvValue[code[0,i]]*nAdv+code[0,i]<AdvValue[code[0,j]]*nAdv+code[0,j] then 845 begin swap:=code[0,i]; code[0,i]:=code[0,j]; code[0,j]:=swap end; 980 for i := 0 to Lines[0] - 2 do 981 if code[0, i] < adMilitary then 982 for j := i + 1 to Lines[0] - 1 do 983 if AdvValue[code[0, i]] * nAdv + code[0, i] < AdvValue[code[0, j]] * 984 nAdv + code[0, j] then 985 begin 986 swap := code[0, i]; 987 code[0, i] := code[0, j]; 988 code[0, j] := swap 989 end; 846 990 end; 847 991 848 992 procedure SortCities; 849 993 var 850 i,j,swap: integer; 851 begin 852 for i:=0 to Lines[0]-2 do 853 for j:=i+1 to Lines[0]-1 do 854 if CityName(MyCity[code[0,i]].ID)>CityName(MyCity[code[0,j]].ID) then 855 begin swap:=code[0,i]; code[0,i]:=code[0,j]; code[0,j]:=swap end; 856 end; 857 858 function ModelSortValue(const mi: TModelInfo; MixPlayers: boolean = false): integer; 859 begin 860 result:=(mi.Domain+1) shl 28 -mi.mix; 861 if MixPlayers then dec(result, ModelCode(mi) shl 16); 994 i, j, swap: integer; 995 begin 996 for i := 0 to Lines[0] - 2 do 997 for j := i + 1 to Lines[0] - 1 do 998 if CityName(MyCity[code[0, i]].ID) > CityName(MyCity[code[0, j]].ID) 999 then 1000 begin 1001 swap := code[0, i]; 1002 code[0, i] := code[0, j]; 1003 code[0, j] := swap 1004 end; 1005 end; 1006 1007 function ModelSortValue(const mi: TModelInfo; 1008 MixPlayers: boolean = false): integer; 1009 begin 1010 result := (mi.Domain + 1) shl 28 - mi.mix; 1011 if MixPlayers then 1012 dec(result, ModelCode(mi) shl 16); 862 1013 end; 863 1014 864 1015 procedure SortModels; 865 1016 var 866 i,j,swap: integer;1017 i, j, swap: integer; 867 1018 begin // sort by code[2] 868 for i:=0 to Lines[0]-2 do for j:=i+1 to Lines[0]-1 do 869 if code[2,i]>code[2,j] then 870 begin 871 swap:=code[0,i]; code[0,i]:=code[0,j]; code[0,j]:=swap; 872 swap:=code[1,i]; code[1,i]:=code[1,j]; code[1,j]:=swap; 873 swap:=code[2,i]; code[2,i]:=code[2,j]; code[2,j]:=swap; 874 end; 1019 for i := 0 to Lines[0] - 2 do 1020 for j := i + 1 to Lines[0] - 1 do 1021 if code[2, i] > code[2, j] then 1022 begin 1023 swap := code[0, i]; 1024 code[0, i] := code[0, j]; 1025 code[0, j] := swap; 1026 swap := code[1, i]; 1027 code[1, i] := code[1, j]; 1028 code[1, j] := swap; 1029 swap := code[2, i]; 1030 code[2, i] := code[2, j]; 1031 code[2, j] := swap; 1032 end; 875 1033 end; 876 1034 877 1035 procedure MarkPreqs(i: integer); 878 1036 begin 879 required[i]:=1;880 if MyRO.Tech[i]<tsSeen then1037 required[i] := 1; 1038 if MyRO.Tech[i] < tsSeen then 881 1039 begin 882 if (AdvPreq[i,0]>=0) then MarkPreqs(AdvPreq[i,0]); 883 if (AdvPreq[i,1]>=0) then MarkPreqs(AdvPreq[i,1]); 1040 if (AdvPreq[i, 0] >= 0) then 1041 MarkPreqs(AdvPreq[i, 0]); 1042 if (AdvPreq[i, 1] >= 0) then 1043 MarkPreqs(AdvPreq[i, 1]); 884 1044 end 885 1045 end; 886 1046 887 1047 var 888 Loc1,i,j,p1,dx,dy,mix,emix,EnemyType,TestEnemyType:integer; 889 mi: TModelInfo; 890 PPicture, PTestPicture: ^TModelPicture; 891 ModelOk: array[0..4095] of boolean; 892 ok: boolean; 893 begin 894 for i:=0 to MaxLayer-1 do 895 begin Lines[i]:=0; FirstShrinkedLine[i]:=MaxInt end; 896 case Kind of 897 kProject: 898 begin 899 // improvements 900 code[0,0]:=cpImp+imTrGoods; 901 Lines[0]:=1; 902 for i:=28 to nImp-1 do 903 if Imp[i].Kind=ikCommon then 904 TryAddImpLine(0,i+cpImp); 905 for i:=28 to nImp-1 do 906 if not (Imp[i].Kind in [ikCommon,ikTrGoods]) 907 and ((MyRO.NatBuilt[i]=0) or (Imp[i].Kind=ikNatLocal)) then 908 TryAddImpLine(0,i+cpImp); 909 for i:=0 to nCityType-1 do if MyData.ImpOrder[i,0]>=0 then 910 begin code[0,Lines[0]]:=cpType+i; inc(Lines[0]); end; 911 912 // wonders 913 for i:=0 to 27 do 914 TryAddImpLine(1,i+cpImp); 915 916 // units 917 for i:=0 to MyRO.nModel-1 do 918 begin 919 { if MyModel[i].Kind=mkSlaves then 920 ok:= MyRO.Wonder[woPyramids].EffectiveOwner=me 921 else} if MyModel[i].Domain=dSea then 922 begin 923 ok:=false; 924 for dx:=-2 to 2 do for dy:=-2 to 2 do if abs(dx)+abs(dy)=2 then 925 begin 926 Loc1:=dLoc(MyCity[cixProject].Loc,dx,dy); 927 if (Loc1>=0) and (Loc1<G.lx*G.ly) 928 and ((MyMap[Loc1] and fTerrain=fShore) or (MyMap[Loc1] and fCanal>0)) then 929 ok:=true; 1048 Loc1, i, j, p1, dx, dy, mix, emix, EnemyType, TestEnemyType: integer; 1049 mi: TModelInfo; 1050 PPicture, PTestPicture: ^TModelPicture; 1051 ModelOk: array [0 .. 4095] of boolean; 1052 ok: boolean; 1053 begin 1054 for i := 0 to MaxLayer - 1 do 1055 begin 1056 Lines[i] := 0; 1057 FirstShrinkedLine[i] := MaxInt 1058 end; 1059 case Kind of 1060 kProject: 1061 begin 1062 // improvements 1063 code[0, 0] := cpImp + imTrGoods; 1064 Lines[0] := 1; 1065 for i := 28 to nImp - 1 do 1066 if Imp[i].Kind = ikCommon then 1067 TryAddImpLine(0, i + cpImp); 1068 for i := 28 to nImp - 1 do 1069 if not(Imp[i].Kind in [ikCommon, ikTrGoods]) and 1070 ((MyRO.NatBuilt[i] = 0) or (Imp[i].Kind = ikNatLocal)) then 1071 TryAddImpLine(0, i + cpImp); 1072 for i := 0 to nCityType - 1 do 1073 if MyData.ImpOrder[i, 0] >= 0 then 1074 begin 1075 code[0, Lines[0]] := cpType + i; 1076 inc(Lines[0]); 1077 end; 1078 1079 // wonders 1080 for i := 0 to 27 do 1081 TryAddImpLine(1, i + cpImp); 1082 1083 // units 1084 for i := 0 to MyRO.nModel - 1 do 1085 begin 1086 { if MyModel[i].Kind=mkSlaves then 1087 ok:= MyRO.Wonder[woPyramids].EffectiveOwner=me 1088 else } if MyModel[i].Domain = dSea then 1089 begin 1090 ok := false; 1091 for dx := -2 to 2 do 1092 for dy := -2 to 2 do 1093 if abs(dx) + abs(dy) = 2 then 1094 begin 1095 Loc1 := dLoc(MyCity[cixProject].Loc, dx, dy); 1096 if (Loc1 >= 0) and (Loc1 < G.lx * G.ly) and 1097 ((MyMap[Loc1] and fTerrain = fShore) or 1098 (MyMap[Loc1] and fCanal > 0)) then 1099 ok := true; 1100 end 930 1101 end 1102 else 1103 ok := true; 1104 if ok then 1105 begin 1106 if MyModel[i].Status and msObsolete = 0 then 1107 begin 1108 code[2, Lines[2]] := i; 1109 inc(Lines[2]) 1110 end; 1111 if MyModel[i].Status and msAllowConscripts <> 0 then 1112 begin 1113 code[2, Lines[2]] := i + cpConscripts; 1114 inc(Lines[2]) 1115 end; 1116 end; 1117 end; 1118 FirstShrinkedLine[2] := 0; 1119 end; 1120 kAdvance: 1121 begin 1122 nColumn := 1; 1123 if MyData.FarTech <> adNone then 1124 begin 1125 FillChar(required, SizeOf(required), 0); 1126 MarkPreqs(MyData.FarTech); 1127 end; 1128 for i := 0 to nAdv - 1 do 1129 if ((i in FutureTech) or (MyRO.Tech[i] < tsApplicable)) and 1130 (Server(sSetResearch - sExecute, me, i, nil^) >= rExecuted) and 1131 ((MyData.FarTech = adNone) or (required[i] > 0)) then 1132 begin 1133 code[0, Lines[0]] := i; 1134 inc(Lines[0]); 1135 end; 1136 SortTechs; 1137 if Lines[0] = 0 then // no more techs -- offer nexus 1138 begin 1139 code[0, Lines[0]] := adNexus; 1140 inc(Lines[0]); 1141 end; 1142 ok := false; 1143 for i := 0 to nDomains - 1 do 1144 if (upgrade[i, 0].Preq = preNone) or 1145 (MyRO.Tech[upgrade[i, 0].Preq] >= tsApplicable) then 1146 ok := true; 1147 if ok then { new unit class } 1148 begin 1149 code[0, Lines[0]] := adMilitary; 1150 inc(Lines[0]) 1151 end; 1152 end; 1153 kFarAdvance: 1154 begin 1155 code[0, Lines[0]] := adNone; 1156 inc(Lines[0]); 1157 for i := 0 to nAdv - 1 do 1158 if not(i in FutureTech) and (MyRO.Tech[i] < tsApplicable) and 1159 ((AdvValue[i] < 2000) or (MyRO.Tech[adMassProduction] > tsNA)) and 1160 ((AdvValue[i] < 1000) or (MyRO.Tech[adScience] > tsNA)) then 1161 begin 1162 code[0, Lines[0]] := i; 1163 inc(Lines[0]); 1164 end; 1165 SortTechs; 1166 end; 1167 kChooseTech: 1168 begin 1169 for i := 0 to nAdv - 1 do 1170 if not(i in FutureTech) and (MyRO.Tech[i] >= tsApplicable) and 1171 (MyRO.EnemyReport[DipMem[me].pContact].Tech[i] < tsSeen) then 1172 begin 1173 code[0, Lines[0]] := i; 1174 inc(Lines[0]); 1175 end; 1176 SortTechs; 1177 // if Lines[0]>1 then 1178 begin 1179 code[0, Lines[0]] := adAll; 1180 inc(Lines[0]); 1181 end; 1182 end; 1183 kChooseETech: 1184 begin 1185 for i := 0 to nAdv - 1 do 1186 if not(i in FutureTech) and (MyRO.Tech[i] < tsSeen) and 1187 (MyRO.EnemyReport[DipMem[me].pContact].Tech[i] >= tsApplicable) then 1188 begin 1189 code[0, Lines[0]] := i; 1190 inc(Lines[0]); 1191 end; 1192 SortTechs; 1193 // if Lines[0]>1 then 1194 begin 1195 code[0, Lines[0]] := adAll; 1196 inc(Lines[0]); 1197 end; 1198 end; 1199 kStealTech: 1200 begin 1201 for i := 0 to nAdv - 1 do 1202 if Server(sStealTech - sExecute, me, i, nil^) >= rExecuted then 1203 begin 1204 code[0, Lines[0]] := i; 1205 inc(Lines[0]); 1206 end; 1207 SortTechs; 1208 end; 1209 kScience: 1210 begin 1211 Column[0] := me; 1212 nColumn := 1; 1213 for EnemyType := 0 to 2 do 1214 for p1 := 0 to nPl - 1 do 1215 if (MyRO.EnemyReport[p1] <> nil) and 1216 ((MyRO.EnemyReport[p1].TurnOfContact >= 0) or 1217 (MyRO.EnemyReport[p1].TurnOfCivilReport >= 0)) then 1218 begin 1219 if MyRO.Alive and (1 shl p1) = 0 then 1220 TestEnemyType := 2 // extinct enemy -- move to right end 1221 else if MyRO.EnemyReport[p1].TurnOfCivilReport >= MyRO.Turn - 1 1222 then 1223 TestEnemyType := 0 // current report -- move to left end 1224 else 1225 TestEnemyType := 1; 1226 if TestEnemyType = EnemyType then 1227 begin 1228 Column[nColumn] := p1; 1229 inc(nColumn); 1230 end; 1231 end; 1232 for i := 0 to nAdv - 1 do 1233 begin 1234 ok := (MyRO.Tech[i] <> tsNA) or (MyRO.ResearchTech = i); 1235 for j := 1 to nColumn - 1 do 1236 with MyRO.EnemyReport[Column[j]]^ do 1237 if (Tech[i] <> tsNA) or (TurnOfCivilReport >= 0) and 1238 (ResearchTech = i) then 1239 ok := true; 1240 if ok then 1241 begin 1242 code[0, Lines[0]] := i; 1243 inc(Lines[0]); 1244 end; 1245 end; 1246 SortTechs; 1247 1248 ok := MyRO.ResearchTech = adMilitary; 1249 for j := 1 to nColumn - 1 do 1250 with MyRO.EnemyReport[Column[j]]^ do 1251 if (MyRO.Alive and (1 shl Column[j]) <> 0) and 1252 (TurnOfCivilReport >= 0) and (ResearchTech = adMilitary) then 1253 ok := true; 1254 if ok then 1255 begin 1256 code[0, Lines[0]] := adMilitary; 1257 inc(Lines[0]); 931 1258 end 932 else ok:=true; 933 if ok then 934 begin 935 if MyModel[i].Status and msObsolete=0 then 936 begin code[2,Lines[2]]:=i; inc(Lines[2]) end; 937 if MyModel[i].Status and msAllowConscripts<>0 then 938 begin code[2,Lines[2]]:=i+cpConscripts; inc(Lines[2]) end; 939 end; 940 end; 941 FirstShrinkedLine[2]:=0; 942 end; 943 kAdvance: 944 begin 945 nColumn:=1; 946 if MyData.FarTech<>adNone then 947 begin 948 FillChar(required,SizeOf(required),0); 949 MarkPreqs(MyData.FarTech); 950 end; 951 for i:=0 to nAdv-1 do 952 if ((i in FutureTech) or (MyRO.Tech[i]<tsApplicable)) 953 and (Server(sSetResearch-sExecute,me,i,nil^)>=rExecuted) 954 and ((MyData.FarTech=adNone) or (required[i]>0)) then 955 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 956 SortTechs; 957 if Lines[0]=0 then // no more techs -- offer nexus 958 begin code[0,Lines[0]]:=adNexus; inc(Lines[0]); end; 959 ok:=false; 960 for i:=0 to nDomains-1 do 961 if (upgrade[i,0].Preq=preNone) 962 or (MyRO.Tech[upgrade[i,0].Preq]>=tsApplicable) then 963 ok:=true; 964 if ok then {new unit class} 965 begin code[0,Lines[0]]:=adMilitary; inc(Lines[0]) end; 966 end; 967 kFarAdvance: 968 begin 969 code[0,Lines[0]]:=adNone; inc(Lines[0]); 970 for i:=0 to nAdv-1 do 971 if not (i in FutureTech) and (MyRO.Tech[i]<tsApplicable) 972 and ((AdvValue[i]<2000) or (MyRO.Tech[adMassProduction]>tsNA)) 973 and ((AdvValue[i]<1000) or (MyRO.Tech[adScience]>tsNA)) then 974 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 975 SortTechs; 976 end; 977 kChooseTech: 978 begin 979 for i:=0 to nAdv-1 do 980 if not (i in FutureTech) and (MyRO.Tech[i]>=tsApplicable) 981 and (MyRO.EnemyReport[DipMem[me].pContact].Tech[i]<tsSeen) then 982 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 983 SortTechs; 984 // if Lines[0]>1 then 985 begin code[0,Lines[0]]:=adAll; inc(Lines[0]); end; 986 end; 987 kChooseETech: 988 begin 989 for i:=0 to nAdv-1 do 990 if not (i in FutureTech) and (MyRO.Tech[i]<tsSeen) 991 and (MyRO.EnemyReport[DipMem[me].pContact].Tech[i]>=tsApplicable) then 992 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 993 SortTechs; 994 // if Lines[0]>1 then 995 begin code[0,Lines[0]]:=adAll; inc(Lines[0]); end; 996 end; 997 kStealTech: 998 begin 999 for i:=0 to nAdv-1 do 1000 if Server(sStealTech-sExecute, me, i, nil^)>=rExecuted then 1001 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1002 SortTechs; 1003 end; 1004 kScience: 1005 begin 1006 Column[0]:=me; 1007 nColumn:=1; 1008 for EnemyType:=0 to 2 do 1009 for p1:=0 to nPl-1 do 1010 if (MyRO.EnemyReport[p1]<>nil) 1011 and ((MyRO.EnemyReport[p1].TurnOfContact>=0) 1012 or (MyRO.EnemyReport[p1].TurnOfCivilReport>=0)) then 1013 begin 1014 if MyRO.Alive and (1 shl p1)=0 then 1015 TestEnemyType:=2 // extinct enemy -- move to right end 1016 else if MyRO.EnemyReport[p1].TurnOfCivilReport>=MyRO.Turn-1 then 1017 TestEnemyType:=0 // current report -- move to left end 1018 else TestEnemyType:=1; 1019 if TestEnemyType=EnemyType then 1020 begin Column[nColumn]:=p1; inc(nColumn); end; 1021 end; 1022 for i:=0 to nAdv-1 do 1023 begin 1024 ok:= (MyRO.Tech[i]<>tsNA) or (MyRO.ResearchTech=i); 1025 for j:=1 to nColumn-1 do with MyRO.EnemyReport[Column[j]]^ do 1026 if (Tech[i]<>tsNA) or (TurnOfCivilReport>=0) and (ResearchTech=i) then 1027 ok:=true; 1028 if ok then 1029 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1030 end; 1031 SortTechs; 1032 1033 ok:= MyRO.ResearchTech=adMilitary; 1034 for j:=1 to nColumn-1 do with MyRO.EnemyReport[Column[j]]^ do 1035 if (MyRO.Alive and (1 shl Column[j])<>0) 1036 and (TurnOfCivilReport>=0) and (ResearchTech=adMilitary) then 1037 ok:=true; 1038 if ok then 1039 begin code[0,Lines[0]]:=adMilitary; inc(Lines[0]); end 1040 end; 1041 kCities{, kChooseCity}: 1042 begin 1043 if ClientMode<scContact then 1044 for i:=0 to MyRO.nCity-1 do if MyCity[i].Loc>=0 then 1045 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1046 SortCities; 1047 FirstShrinkedLine[0]:=0 1048 end; 1049 kCityEvents: 1050 begin 1051 for i:=0 to MyRO.nCity-1 do 1052 if (MyCity[i].Loc>=0) and (MyCity[i].Flags and CityRepMask<>0) then 1053 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1054 SortCities; 1055 FirstShrinkedLine[0]:=0 1056 end; 1057 { kChooseECity: 1058 begin 1059 for i:=0 to MyRO.nEnemyCity-1 do 1259 end; 1260 kCities { , kChooseCity } : 1261 begin 1262 if ClientMode < scContact then 1263 for i := 0 to MyRO.nCity - 1 do 1264 if MyCity[i].Loc >= 0 then 1265 begin 1266 code[0, Lines[0]] := i; 1267 inc(Lines[0]) 1268 end; 1269 SortCities; 1270 FirstShrinkedLine[0] := 0 1271 end; 1272 kCityEvents: 1273 begin 1274 for i := 0 to MyRO.nCity - 1 do 1275 if (MyCity[i].Loc >= 0) and (MyCity[i].Flags and CityRepMask <> 0) 1276 then 1277 begin 1278 code[0, Lines[0]] := i; 1279 inc(Lines[0]) 1280 end; 1281 SortCities; 1282 FirstShrinkedLine[0] := 0 1283 end; 1284 { kChooseECity: 1285 begin 1286 for i:=0 to MyRO.nEnemyCity-1 do 1060 1287 if (MyRO.EnemyCity[i].Loc>=0) 1061 and (MyRO.EnemyCity[i].owner=DipMem[me].pContact) then 1062 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1063 FirstShrinkedLine:=0 1064 end;} 1065 kModels: 1066 begin 1067 for mix:=0 to MyRO.nModel-1 do 1068 begin 1069 code[0,mix]:=mix; 1070 MakeModelInfo(me, mix, MyModel[mix], mi); 1071 code[2,mix]:=ModelSortValue(mi); 1072 end; 1073 Lines[0]:=MyRO.nModel; 1074 SortModels; 1075 FirstShrinkedLine[0]:=0 1076 end; 1077 kChooseModel: 1078 begin 1079 for mix:=3 to MyRO.nModel-1 do 1080 begin // check if opponent already has this model 1081 MakeModelInfo(me,mix,MyModel[mix],mi); 1082 ok:=true; 1083 for emix:=0 to MyRO.nEnemyModel-1 do 1084 if (MyRO.EnemyModel[emix].Owner=DipMem[me].pContact) 1085 and IsSameModel(MyRO.EnemyModel[emix],mi) then 1086 ok:=false; 1087 if ok then 1088 begin 1089 code[0,Lines[0]]:=mix; 1090 MakeModelInfo(me, mix, MyModel[mix], mi); 1091 code[2,Lines[0]]:=ModelSortValue(mi); 1092 inc(Lines[0]); 1093 end; 1094 end; 1095 SortModels; 1096 // if Lines[0]>1 then 1097 begin code[0,Lines[0]]:=mixAll; inc(Lines[0]); end; 1098 FirstShrinkedLine[0]:=0 1099 end; 1100 kChooseEModel: 1101 begin 1102 if MyRO.TestFlags and tfUncover<>0 then 1103 Server(sGetModels,me,0,nil^); 1104 for emix:=0 to MyRO.nEnemyModel-1 do 1105 ModelOk[emix]:= MyRO.EnemyModel[emix].Owner=DipMem[me].pContact; 1106 for mix:=0 to MyRO.nModel-1 do 1107 begin // don't list models I already have 1108 MakeModelInfo(me,mix,MyModel[mix],mi); 1109 for emix:=0 to MyRO.nEnemyModel-1 do 1110 ModelOk[emix]:=ModelOk[emix] 1111 and not IsSameModel(MyRO.EnemyModel[emix],mi); 1112 end; 1113 for emix:=0 to MyRO.nEnemyModel-1 do if ModelOk[emix] then 1114 begin 1115 if Tribe[DipMem[me].pContact].ModelPicture[MyRO.EnemyModel[emix].mix].HGr=0 then 1116 InitEnemyModel(emix); 1117 code[0,Lines[0]]:=emix; 1118 code[2,Lines[0]]:=ModelSortValue(MyRO.EnemyModel[emix]); 1119 inc(Lines[0]); 1120 end; 1121 SortModels; 1122 // if not IsMilReportNew(DipMem[me].pContact) or (Lines[0]>1) then 1123 begin code[0,Lines[0]]:=mixAll; inc(Lines[0]); end; 1124 FirstShrinkedLine[0]:=0 1125 end; 1126 kEModels: 1127 begin 1128 for i:=0 to MyRO.EnemyReport[pView].nModelCounted-1 do 1129 begin 1130 code[1,Lines[0]]:=MyRO.nEnemyModel-1; 1131 while (code[1,Lines[0]]>=0) 1132 and not ((MyRO.EnemyModel[code[1,Lines[0]]].Owner=pView) 1133 and (MyRO.EnemyModel[code[1,Lines[0]]].mix=i)) do 1134 dec(code[1,Lines[0]]); 1135 if Tribe[pView].ModelPicture[i].HGr=0 then 1136 InitEnemyModel(code[1,Lines[0]]); 1137 code[0,Lines[0]]:=i; 1138 code[2,Lines[0]]:=ModelSortValue(MyRO.EnemyModel[code[1,Lines[0]]]); 1139 inc(Lines[0]); 1140 end; 1141 SortModels; 1142 FirstShrinkedLine[0]:=0 1143 end; 1144 kAllEModels: 1145 begin 1146 if (MyRO.TestFlags and tfUncover<>0) or (G.Difficulty[me]=0) then 1147 Server(sGetModels,me,0,nil^); 1148 for emix:=0 to MyRO.nEnemyModel-1 do 1149 if (MyRO.EnemyModel[emix].mix>=3) 1150 and (MyRO.EnemyModel[emix].Kind in [mkSelfDeveloped,mkEnemyDeveloped]) then 1151 begin 1152 PPicture:=@Tribe[MyRO.EnemyModel[emix].Owner].ModelPicture[MyRO.EnemyModel[emix].mix]; 1153 if PPicture.HGr=0 then InitEnemyModel(emix); 1154 ok:=true; 1155 if MainScreen.mNames.Checked then 1156 for j:=0 to Lines[0]-1 do 1288 and (MyRO.EnemyCity[i].owner=DipMem[me].pContact) then 1289 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1290 FirstShrinkedLine:=0 1291 end; } 1292 kModels: 1293 begin 1294 for mix := 0 to MyRO.nModel - 1 do 1295 begin 1296 code[0, mix] := mix; 1297 MakeModelInfo(me, mix, MyModel[mix], mi); 1298 code[2, mix] := ModelSortValue(mi); 1299 end; 1300 Lines[0] := MyRO.nModel; 1301 SortModels; 1302 FirstShrinkedLine[0] := 0 1303 end; 1304 kChooseModel: 1305 begin 1306 for mix := 3 to MyRO.nModel - 1 do 1307 begin // check if opponent already has this model 1308 MakeModelInfo(me, mix, MyModel[mix], mi); 1309 ok := true; 1310 for emix := 0 to MyRO.nEnemyModel - 1 do 1311 if (MyRO.EnemyModel[emix].Owner = DipMem[me].pContact) and 1312 IsSameModel(MyRO.EnemyModel[emix], mi) then 1313 ok := false; 1314 if ok then 1315 begin 1316 code[0, Lines[0]] := mix; 1317 MakeModelInfo(me, mix, MyModel[mix], mi); 1318 code[2, Lines[0]] := ModelSortValue(mi); 1319 inc(Lines[0]); 1320 end; 1321 end; 1322 SortModels; 1323 // if Lines[0]>1 then 1324 begin 1325 code[0, Lines[0]] := mixAll; 1326 inc(Lines[0]); 1327 end; 1328 FirstShrinkedLine[0] := 0 1329 end; 1330 kChooseEModel: 1331 begin 1332 if MyRO.TestFlags and tfUncover <> 0 then 1333 Server(sGetModels, me, 0, nil^); 1334 for emix := 0 to MyRO.nEnemyModel - 1 do 1335 ModelOk[emix] := MyRO.EnemyModel[emix].Owner = DipMem[me].pContact; 1336 for mix := 0 to MyRO.nModel - 1 do 1337 begin // don't list models I already have 1338 MakeModelInfo(me, mix, MyModel[mix], mi); 1339 for emix := 0 to MyRO.nEnemyModel - 1 do 1340 ModelOk[emix] := ModelOk[emix] and 1341 not IsSameModel(MyRO.EnemyModel[emix], mi); 1342 end; 1343 for emix := 0 to MyRO.nEnemyModel - 1 do 1344 if ModelOk[emix] then 1345 begin 1346 if Tribe[DipMem[me].pContact].ModelPicture 1347 [MyRO.EnemyModel[emix].mix].HGr = 0 then 1348 InitEnemyModel(emix); 1349 code[0, Lines[0]] := emix; 1350 code[2, Lines[0]] := ModelSortValue(MyRO.EnemyModel[emix]); 1351 inc(Lines[0]); 1352 end; 1353 SortModels; 1354 // if not IsMilReportNew(DipMem[me].pContact) or (Lines[0]>1) then 1355 begin 1356 code[0, Lines[0]] := mixAll; 1357 inc(Lines[0]); 1358 end; 1359 FirstShrinkedLine[0] := 0 1360 end; 1361 kEModels: 1362 begin 1363 for i := 0 to MyRO.EnemyReport[pView].nModelCounted - 1 do 1364 begin 1365 code[1, Lines[0]] := MyRO.nEnemyModel - 1; 1366 while (code[1, Lines[0]] >= 0) and 1367 not((MyRO.EnemyModel[code[1, Lines[0]]].Owner = pView) and 1368 (MyRO.EnemyModel[code[1, Lines[0]]].mix = i)) do 1369 dec(code[1, Lines[0]]); 1370 if Tribe[pView].ModelPicture[i].HGr = 0 then 1371 InitEnemyModel(code[1, Lines[0]]); 1372 code[0, Lines[0]] := i; 1373 code[2, Lines[0]] := 1374 ModelSortValue(MyRO.EnemyModel[code[1, Lines[0]]]); 1375 inc(Lines[0]); 1376 end; 1377 SortModels; 1378 FirstShrinkedLine[0] := 0 1379 end; 1380 kAllEModels: 1381 begin 1382 if (MyRO.TestFlags and tfUncover <> 0) or (G.Difficulty[me] = 0) then 1383 Server(sGetModels, me, 0, nil^); 1384 for emix := 0 to MyRO.nEnemyModel - 1 do 1385 if (MyRO.EnemyModel[emix].mix >= 3) and 1386 (MyRO.EnemyModel[emix].Kind in [mkSelfDeveloped, mkEnemyDeveloped]) 1387 then 1388 begin 1389 PPicture := @Tribe[MyRO.EnemyModel[emix].Owner].ModelPicture 1390 [MyRO.EnemyModel[emix].mix]; 1391 if PPicture.HGr = 0 then 1392 InitEnemyModel(emix); 1393 ok := true; 1394 if MainScreen.mNames.Checked then 1395 for j := 0 to Lines[0] - 1 do 1396 begin 1397 PTestPicture := @Tribe[MyRO.EnemyModel[code[0, j]].Owner] 1398 .ModelPicture[MyRO.EnemyModel[code[0, j]].mix]; 1399 if (PPicture.HGr = PTestPicture.HGr) and 1400 (PPicture.pix = PTestPicture.pix) and 1401 (ModelHash(MyRO.EnemyModel[emix]) 1402 = ModelHash(MyRO.EnemyModel[code[0, j]])) then 1403 begin 1404 code[1, j] := 1; 1405 ok := false; 1406 Break 1407 end; 1408 end; 1409 if ok then 1157 1410 begin 1158 PTestPicture:=@Tribe[MyRO.EnemyModel[code[0,j]].Owner].ModelPicture[MyRO.EnemyModel[code[0,j]].mix]; 1159 if (PPicture.HGr=PTestPicture.HGr) and (PPicture.pix=PTestPicture.pix) 1160 and (ModelHash(MyRO.EnemyModel[emix])=ModelHash(MyRO.EnemyModel[code[0,j]])) then 1161 begin code[1,j]:=1; ok:=false; Break end; 1162 end; 1163 if ok then 1164 begin 1165 code[0,Lines[0]]:=emix; 1166 code[1,Lines[0]]:=0; 1167 code[2,Lines[0]]:=ModelSortValue(MyRO.EnemyModel[emix],true); 1168 inc(Lines[0]); 1169 end 1170 end; 1171 SortModels; 1172 FirstShrinkedLine[0]:=0 1173 end; 1174 kTribe: 1175 for i:=0 to TribeNames.Count-1 do 1176 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1177 (* kDeliver: 1178 if MyRO.Treaty[DipMem[me].pContact]<trAlliance then 1411 code[0, Lines[0]] := emix; 1412 code[1, Lines[0]] := 0; 1413 code[2, Lines[0]] := ModelSortValue(MyRO.EnemyModel[emix], true); 1414 inc(Lines[0]); 1415 end 1416 end; 1417 SortModels; 1418 FirstShrinkedLine[0] := 0 1419 end; 1420 kTribe: 1421 for i := 0 to TribeNames.Count - 1 do 1422 begin 1423 code[0, Lines[0]] := i; 1424 inc(Lines[0]) 1425 end; 1426 (* kDeliver: 1427 if MyRO.Treaty[DipMem[me].pContact]<trAlliance then 1179 1428 begin // suggest next treaty level 1180 1429 code[0,Lines[0]]:=opTreaty+MyRO.Treaty[DipMem[me].pContact]+1; 1181 1430 inc(Lines[0]); 1182 1431 end; 1183 if MyRO.Treaty[DipMem[me].pContact]=trNone then1432 if MyRO.Treaty[DipMem[me].pContact]=trNone then 1184 1433 begin // suggest peace 1185 1434 code[0,Lines[0]]:=opTreaty+trPeace; 1186 1435 inc(Lines[0]); 1187 1436 end; 1188 if MyRO.Treaty[DipMem[me].pContact]>trNone then1437 if MyRO.Treaty[DipMem[me].pContact]>trNone then 1189 1438 begin // suggest next treaty level 1190 1439 code[0,Lines[0]]:=opTreaty+MyRO.Treaty[DipMem[me].pContact]-1; 1191 1440 inc(Lines[0]); 1192 end;*) 1193 kShipPart: 1441 end; *) 1442 kShipPart: 1443 begin 1444 Lines[0] := 0; 1445 for i := 0 to nShipPart - 1 do 1446 if MyRO.Ship[me].Parts[i] > 0 then 1447 begin 1448 code[0, Lines[0]] := i; 1449 inc(Lines[0]); 1450 end; 1451 end; 1452 kEShipPart: 1453 begin 1454 Lines[0] := 0; 1455 for i := 0 to nShipPart - 1 do 1456 if MyRO.Ship[DipMem[me].pContact].Parts[i] > 0 then 1457 begin 1458 code[0, Lines[0]] := i; 1459 inc(Lines[0]); 1460 end; 1461 end; 1462 kGov: 1463 for i := 1 to nGov - 1 do 1464 if (GovPreq[i] <> preNA) and 1465 ((GovPreq[i] = preNone) or (MyRO.Tech[GovPreq[i]] >= tsApplicable)) 1466 then 1467 begin 1468 code[0, Lines[0]] := i; 1469 inc(Lines[0]) 1470 end; 1471 kMission: 1472 for i := 0 to nSpyMission - 1 do 1473 begin 1474 code[0, Lines[0]] := i; 1475 inc(Lines[0]) 1476 end; 1477 end; 1478 1479 if Kind = kProject then // test if choice fitting to one screen 1480 if Lines[0] + Lines[1] + Lines[2] <= MaxLines then 1194 1481 begin 1195 Lines[0]:=0; 1196 for i:=0 to nShipPart-1 do 1197 if MyRO.Ship[me].Parts[i]>0 then 1198 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1199 end; 1200 kEShipPart: 1201 begin 1202 Lines[0]:=0; 1203 for i:=0 to nShipPart-1 do 1204 if MyRO.Ship[DipMem[me].pContact].Parts[i]>0 then 1205 begin code[0,Lines[0]]:=i; inc(Lines[0]); end; 1206 end; 1207 kGov: 1208 for i:=1 to nGov-1 do 1209 if (GovPreq[i]<>preNA) and ((GovPreq[i]=preNone) 1210 or (MyRO.Tech[GovPreq[i]]>=tsApplicable)) then 1211 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1212 kMission: 1213 for i:=0 to nSpyMission-1 do 1214 begin code[0,Lines[0]]:=i; inc(Lines[0]) end; 1215 end; 1216 1217 if Kind=kProject then // test if choice fitting to one screen 1218 if Lines[0]+Lines[1]+Lines[2]<=MaxLines then 1219 begin 1220 for i:=0 to Lines[1]-1 do // add wonders to first page 1221 begin code[0,Lines[0]]:=code[1,i]; inc(Lines[0]); end; 1222 Lines[1]:=0; 1223 FirstShrinkedLine[0]:=Lines[0]; 1224 for i:=0 to Lines[2]-1 do // add models to first page 1225 begin code[0,Lines[0]]:=code[2,i]; inc(Lines[0]); end; 1226 Lines[2]:=0; 1482 for i := 0 to Lines[1] - 1 do // add wonders to first page 1483 begin 1484 code[0, Lines[0]] := code[1, i]; 1485 inc(Lines[0]); 1486 end; 1487 Lines[1] := 0; 1488 FirstShrinkedLine[0] := Lines[0]; 1489 for i := 0 to Lines[2] - 1 do // add models to first page 1490 begin 1491 code[0, Lines[0]] := code[2, i]; 1492 inc(Lines[0]); 1493 end; 1494 Lines[2] := 0; 1227 1495 end; 1228 1496 end; // InitLines … … 1230 1498 function TListDlg.OnlyChoice(TestKind: TListKind): integer; 1231 1499 begin 1232 Kind:=TestKind; 1233 InitLines; 1234 if Lines[0]=0 then result:=-2 1235 else if Lines[0]>1 then result:=-1 1236 else result:=code[0,0]; 1500 Kind := TestKind; 1501 InitLines; 1502 if Lines[0] = 0 then 1503 result := -2 1504 else if Lines[0] > 1 then 1505 result := -1 1506 else 1507 result := code[0, 0]; 1237 1508 end; 1238 1509 1239 1510 procedure TListDlg.FormShow(Sender: TObject); 1240 1511 var 1241 i: integer; 1242 begin 1243 result:=-1; 1244 Closable:=false; 1245 1246 if Kind=kTribe then 1247 begin 1248 LineDistance:=21; // looks ugly with scrollbar 1249 MaxLines:=(hMainTexture-(24+TitleHeight+NarrowFrame)) div LineDistance -1; 1512 i: integer; 1513 begin 1514 result := -1; 1515 Closable := false; 1516 1517 if Kind = kTribe then 1518 begin 1519 LineDistance := 21; // looks ugly with scrollbar 1520 MaxLines := (hMaintexture - (24 + TitleHeight + NarrowFrame)) 1521 div LineDistance - 1; 1250 1522 end 1251 else 1252 begin 1253 LineDistance:=24; 1254 MaxLines:=(hMainTexture-(24+TitleHeight+WideFrame)) div LineDistance -1; 1255 end; 1256 InitLines; 1257 1258 MultiPage:=false; 1259 for i:=1 to MaxLayer-1 do if Lines[i]>0 then MultiPage:=true; 1260 WideBottom:=MultiPage or (Kind=kScience) 1261 or not Phrases2FallenBackToEnglish 1262 and (Kind in [kProject,kAdvance,kFarAdvance]); 1263 if (Kind=kAdvance) and (MyData.FarTech<>adNone) 1264 or (Kind=kModels) or (Kind=kEModels) then 1265 TitleHeight:=WideFrame+20 1266 else TitleHeight:=WideFrame; 1267 1268 DispLines:=Lines[0]; 1269 for i:=0 to MaxLayer-1 do if Lines[i]>DispLines then DispLines:=Lines[i]; 1270 if WideBottom then 1271 begin 1272 if DispLines>MaxLines then 1273 DispLines:=MaxLines; 1274 InnerHeight:=LineDistance*(DispLines+1)+24; 1275 ClientHeight:=InnerHeight+TitleHeight+WideFrame 1523 else 1524 begin 1525 LineDistance := 24; 1526 MaxLines := (hMaintexture - (24 + TitleHeight + WideFrame)) 1527 div LineDistance - 1; 1528 end; 1529 InitLines; 1530 1531 MultiPage := false; 1532 for i := 1 to MaxLayer - 1 do 1533 if Lines[i] > 0 then 1534 MultiPage := true; 1535 WideBottom := MultiPage or (Kind = kScience) or 1536 not Phrases2FallenBackToEnglish and 1537 (Kind in [kProject, kAdvance, kFarAdvance]); 1538 if (Kind = kAdvance) and (MyData.FarTech <> adNone) or (Kind = kModels) or 1539 (Kind = kEModels) then 1540 TitleHeight := WideFrame + 20 1541 else 1542 TitleHeight := WideFrame; 1543 1544 DispLines := Lines[0]; 1545 for i := 0 to MaxLayer - 1 do 1546 if Lines[i] > DispLines then 1547 DispLines := Lines[i]; 1548 if WideBottom then 1549 begin 1550 if DispLines > MaxLines then 1551 DispLines := MaxLines; 1552 InnerHeight := LineDistance * (DispLines + 1) + 24; 1553 ClientHeight := InnerHeight + TitleHeight + WideFrame 1276 1554 end 1277 else 1278 begin 1279 if DispLines>MaxLines then 1280 DispLines:=MaxLines; 1281 InnerHeight:=LineDistance*(DispLines+1)+24; 1282 ClientHeight:=InnerHeight+TitleHeight+NarrowFrame; 1283 end; 1284 assert(ClientHeight<=hMainTexture); 1285 1286 TechNameSpace:=224; 1287 case Kind of 1288 kGov: InnerWidth:=272; 1289 kCities, kCityEvents: InnerWidth:=640-18; 1290 kTribe: 1291 if Lines[0]>MaxLines then InnerWidth:=280+GetSystemMetrics(SM_CXVSCROLL) 1292 else InnerWidth:=280; 1293 kScience: 1294 begin 1295 InnerWidth:=104-33+15+8+TechNameSpace+24*nColumn+GetSystemMetrics(SM_CXVSCROLL); 1296 if InnerWidth+2*SideFrame>640 then 1297 begin 1298 TechNameSpace:=TechNameSpace+640-InnerWidth-2*SideFrame; 1299 InnerWidth:=640-2*SideFrame 1300 end 1301 end; 1302 kAdvance,kFarAdvance: 1303 InnerWidth:=104-33+15+8+TechNameSpace+24+GetSystemMetrics(SM_CXVSCROLL); 1304 kChooseTech, kChooseETech, kStealTech: 1305 InnerWidth:=104-33+15+8+TechNameSpace+GetSystemMetrics(SM_CXVSCROLL); 1306 else InnerWidth:=363; 1307 end; 1308 ClientWidth:=InnerWidth+2*SideFrame; 1309 1310 CloseBtn.Left:=ClientWidth-38; 1311 CaptionLeft:=ToggleBtn.Left+ToggleBtn.Width; 1312 CaptionRight:=CloseBtn.Left; 1313 SetWindowPos(sb.h,0,SideFrame+InnerWidth-GetSystemMetrics(SM_CXVSCROLL), 1314 TitleHeight,GetSystemMetrics(SM_CXVSCROLL),LineDistance*DispLines+48, 1315 SWP_NOZORDER or SWP_NOREDRAW); 1316 1317 if WindowMode=wmModal then 1318 begin {center on screen} 1319 if Kind=kTribe then 1320 Left:=(Screen.Width-800)*3 div 8+130 1321 else Left:=(Screen.Width-Width) div 2; 1322 Top:=(Screen.Height-Height) div 2; 1323 if Kind=kProject then 1324 Top:=Top+48; 1325 end; 1326 1327 Layer0Btn.Visible:= MultiPage and (Lines[0]>0); 1328 Layer1Btn.Visible:= MultiPage and (Lines[1]>0); 1329 Layer2Btn.Visible:= MultiPage and (Lines[2]>0); 1330 if Kind=kProject then 1331 begin 1332 Layer0Btn.Top:=ClientHeight-31; 1333 Layer0Btn.Left:=ClientWidth div 2-(12+29); 1334 Layer0Btn.Down:=true; 1335 Layer1Btn.Top:=ClientHeight-31; 1336 Layer1Btn.Left:=ClientWidth div 2-(12-29); 1337 Layer1Btn.Down:=false; 1338 Layer2Btn.Top:=ClientHeight-31; 1339 Layer2Btn.Left:=ClientWidth div 2-12; 1340 Layer2Btn.Down:=false; 1341 end; 1342 1343 Layer:=0; 1344 Sel:=-2; 1345 ScienceNation:=-1; 1346 InitPVSB(sb,Lines[Layer]-1,DispLines); 1347 1348 OffscreenPaint; 1555 else 1556 begin 1557 if DispLines > MaxLines then 1558 DispLines := MaxLines; 1559 InnerHeight := LineDistance * (DispLines + 1) + 24; 1560 ClientHeight := InnerHeight + TitleHeight + NarrowFrame; 1561 end; 1562 assert(ClientHeight <= hMaintexture); 1563 1564 TechNameSpace := 224; 1565 case Kind of 1566 kGov: 1567 InnerWidth := 272; 1568 kCities, kCityEvents: 1569 InnerWidth := 640 - 18; 1570 kTribe: 1571 if Lines[0] > MaxLines then 1572 InnerWidth := 280 + GetSystemMetrics(SM_CXVSCROLL) 1573 else 1574 InnerWidth := 280; 1575 kScience: 1576 begin 1577 InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 24 * nColumn + 1578 GetSystemMetrics(SM_CXVSCROLL); 1579 if InnerWidth + 2 * SideFrame > 640 then 1580 begin 1581 TechNameSpace := TechNameSpace + 640 - InnerWidth - 2 * SideFrame; 1582 InnerWidth := 640 - 2 * SideFrame 1583 end 1584 end; 1585 kAdvance, kFarAdvance: 1586 InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 24 + 1587 GetSystemMetrics(SM_CXVSCROLL); 1588 kChooseTech, kChooseETech, kStealTech: 1589 InnerWidth := 104 - 33 + 15 + 8 + TechNameSpace + 1590 GetSystemMetrics(SM_CXVSCROLL); 1591 else 1592 InnerWidth := 363; 1593 end; 1594 ClientWidth := InnerWidth + 2 * SideFrame; 1595 1596 CloseBtn.Left := ClientWidth - 38; 1597 CaptionLeft := ToggleBtn.Left + ToggleBtn.Width; 1598 CaptionRight := CloseBtn.Left; 1599 SetWindowPos(sb.h, 0, SideFrame + InnerWidth - GetSystemMetrics(SM_CXVSCROLL), 1600 TitleHeight, GetSystemMetrics(SM_CXVSCROLL), LineDistance * DispLines + 48, 1601 SWP_NOZORDER or SWP_NOREDRAW); 1602 1603 if WindowMode = wmModal then 1604 begin { center on screen } 1605 if Kind = kTribe then 1606 Left := (Screen.Width - 800) * 3 div 8 + 130 1607 else 1608 Left := (Screen.Width - Width) div 2; 1609 Top := (Screen.Height - Height) div 2; 1610 if Kind = kProject then 1611 Top := Top + 48; 1612 end; 1613 1614 Layer0Btn.Visible := MultiPage and (Lines[0] > 0); 1615 Layer1Btn.Visible := MultiPage and (Lines[1] > 0); 1616 Layer2Btn.Visible := MultiPage and (Lines[2] > 0); 1617 if Kind = kProject then 1618 begin 1619 Layer0Btn.Top := ClientHeight - 31; 1620 Layer0Btn.Left := ClientWidth div 2 - (12 + 29); 1621 Layer0Btn.Down := true; 1622 Layer1Btn.Top := ClientHeight - 31; 1623 Layer1Btn.Left := ClientWidth div 2 - (12 - 29); 1624 Layer1Btn.Down := false; 1625 Layer2Btn.Top := ClientHeight - 31; 1626 Layer2Btn.Left := ClientWidth div 2 - 12; 1627 Layer2Btn.Down := false; 1628 end; 1629 1630 Layer := 0; 1631 Sel := -2; 1632 ScienceNation := -1; 1633 InitPVSB(sb, Lines[Layer] - 1, DispLines); 1634 1635 OffscreenPaint; 1349 1636 end; 1350 1637 1351 1638 procedure TListDlg.ShowNewContent(NewMode: integer; ListKind: TListKind); 1352 1639 var 1353 i: integer; 1354 ShowFocus, forceclose: boolean; 1355 begin 1356 forceclose:= (ListKind<>Kind) 1357 and not ((Kind=kCities) and (ListKind=kCityEvents)) 1358 and not ((Kind=kCityEvents) and (ListKind=kCities)) 1359 and not ((Kind=kModels) and (ListKind=kEModels)) 1360 and not ((Kind=kEModels) and (ListKind=kModels)); 1361 1362 Kind:=ListKind; 1363 ModalIndication:= not (Kind in MustChooseKind); 1364 case Kind of 1365 kProject: Caption:=Phrases.Lookup('TITLE_PROJECT'); 1366 kAdvance: Caption:=Phrases.Lookup('TITLE_TECHSELECT'); 1367 kFarAdvance: Caption:=Phrases.Lookup('TITLE_FARTECH'); 1368 kModels, kEModels: Caption:=Phrases.Lookup('FRMILREP'); 1369 kAllEModels: Caption:=Phrases.Lookup('TITLE_EMODELS'); 1370 kTribe: Caption:=Phrases.Lookup('TITLE_TRIBE'); 1371 kScience: Caption:=Phrases.Lookup('TITLE_SCIENCE'); 1372 kShipPart, kEShipPart: Caption:=Phrases.Lookup('TITLE_CHOOSESHIPPART'); 1373 kChooseTech, kChooseETech: Caption:=Phrases.Lookup('TITLE_CHOOSETECH'); 1374 kChooseModel, kChooseEModel: Caption:=Phrases.Lookup('TITLE_CHOOSEMODEL'); 1375 kStealTech: Caption:=Phrases.Lookup('TITLE_CHOOSETECH'); 1376 kGov: Caption:=Phrases.Lookup('TITLE_GOV'); 1377 kMission: Caption:=Phrases.Lookup('TITLE_SPYMISSION'); 1378 end; 1379 1380 case Kind of 1381 kMission: HelpContext:='SPYMISSIONS'; 1382 else HelpContext:='CONCEPTS' 1383 end; 1384 1385 if Kind=kAdvance then 1386 begin 1387 ToggleBtn.ButtonIndex:=13; 1388 ToggleBtn.Hint:=Phrases.Lookup('FARTECH') 1640 i: integer; 1641 ShowFocus, forceclose: boolean; 1642 begin 1643 forceclose := (ListKind <> Kind) and 1644 not((Kind = kCities) and (ListKind = kCityEvents)) and 1645 not((Kind = kCityEvents) and (ListKind = kCities)) and 1646 not((Kind = kModels) and (ListKind = kEModels)) and 1647 not((Kind = kEModels) and (ListKind = kModels)); 1648 1649 Kind := ListKind; 1650 ModalIndication := not(Kind in MustChooseKind); 1651 case Kind of 1652 kProject: 1653 Caption := Phrases.Lookup('TITLE_PROJECT'); 1654 kAdvance: 1655 Caption := Phrases.Lookup('TITLE_TECHSELECT'); 1656 kFarAdvance: 1657 Caption := Phrases.Lookup('TITLE_FARTECH'); 1658 kModels, kEModels: 1659 Caption := Phrases.Lookup('FRMILREP'); 1660 kAllEModels: 1661 Caption := Phrases.Lookup('TITLE_EMODELS'); 1662 kTribe: 1663 Caption := Phrases.Lookup('TITLE_TRIBE'); 1664 kScience: 1665 Caption := Phrases.Lookup('TITLE_SCIENCE'); 1666 kShipPart, kEShipPart: 1667 Caption := Phrases.Lookup('TITLE_CHOOSESHIPPART'); 1668 kChooseTech, kChooseETech: 1669 Caption := Phrases.Lookup('TITLE_CHOOSETECH'); 1670 kChooseModel, kChooseEModel: 1671 Caption := Phrases.Lookup('TITLE_CHOOSEMODEL'); 1672 kStealTech: 1673 Caption := Phrases.Lookup('TITLE_CHOOSETECH'); 1674 kGov: 1675 Caption := Phrases.Lookup('TITLE_GOV'); 1676 kMission: 1677 Caption := Phrases.Lookup('TITLE_SPYMISSION'); 1678 end; 1679 1680 case Kind of 1681 kMission: 1682 HelpContext := 'SPYMISSIONS'; 1683 else 1684 HelpContext := 'CONCEPTS' 1685 end; 1686 1687 if Kind = kAdvance then 1688 begin 1689 ToggleBtn.ButtonIndex := 13; 1690 ToggleBtn.Hint := Phrases.Lookup('FARTECH') 1389 1691 end 1390 else if Kind=kCities then1391 begin 1392 ToggleBtn.ButtonIndex:=15;1393 ToggleBtn.Hint:=Phrases.Lookup('BTN_PAGE')1692 else if Kind = kCities then 1693 begin 1694 ToggleBtn.ButtonIndex := 15; 1695 ToggleBtn.Hint := Phrases.Lookup('BTN_PAGE') 1394 1696 end 1395 else1396 begin1397 ToggleBtn.ButtonIndex:=28;1398 ToggleBtn.Hint:=Phrases.Lookup('BTN_SELECT')1399 end;1400 1401 if Kind=kAdvance then // show focus button?1402 if MyData.FarTech<>adNone then1403 ShowFocus:=true1404 1697 else 1698 begin 1699 ToggleBtn.ButtonIndex := 28; 1700 ToggleBtn.Hint := Phrases.Lookup('BTN_SELECT') 1701 end; 1702 1703 if Kind = kAdvance then // show focus button? 1704 if MyData.FarTech <> adNone then 1705 ShowFocus := true 1706 else 1405 1707 begin 1406 ShowFocus:=false;1407 for i:=0 to nAdv-1 do1408 if not (i in FutureTech) and (MyRO.Tech[i]<tsApplicable)1409 and ((AdvValue[i]<2000) or (MyRO.Tech[adMassProduction]>tsNA))1410 and ((AdvValue[i]<1000) or (MyRO.Tech[adScience]>tsNA))1411 and (Server(sSetResearch-sExecute,me,i,nil^)<rExecuted) then1412 ShowFocus:=true;1708 ShowFocus := false; 1709 for i := 0 to nAdv - 1 do 1710 if not(i in FutureTech) and (MyRO.Tech[i] < tsApplicable) and 1711 ((AdvValue[i] < 2000) or (MyRO.Tech[adMassProduction] > tsNA)) and 1712 ((AdvValue[i] < 1000) or (MyRO.Tech[adScience] > tsNA)) and 1713 (Server(sSetResearch - sExecute, me, i, nil^) < rExecuted) then 1714 ShowFocus := true; 1413 1715 end; 1414 ToggleBtn.Visible:= (Kind=kCities) and not supervising 1415 or (Kind=kAdvance) and ShowFocus 1416 or (Kind=kModels) 1417 or (Kind=kEModels); 1418 CloseBtn.Visible:= not(Kind in MustChooseKind); 1419 1420 inherited ShowNewContent(NewMode, forceclose); 1716 ToggleBtn.Visible := (Kind = kCities) and not supervising or (Kind = kAdvance) 1717 and ShowFocus or (Kind = kModels) or (Kind = kEModels); 1718 CloseBtn.Visible := not(Kind in MustChooseKind); 1719 1720 inherited ShowNewContent(NewMode, forceclose); 1421 1721 end; // ShowNewContent 1422 1722 1423 1723 procedure TListDlg.ShowNewContent_CityProject(NewMode, cix: integer); 1424 1724 begin 1425 cixProject:=cix;1426 ShowNewContent(NewMode, kProject);1725 cixProject := cix; 1726 ShowNewContent(NewMode, kProject); 1427 1727 end; 1428 1728 1429 1729 procedure TListDlg.ShowNewContent_MilReport(NewMode, p: integer); 1430 1730 begin 1431 pView:=p; 1432 if p=me then ShowNewContent(NewMode, kModels) 1433 else ShowNewContent(NewMode, kEModels) 1731 pView := p; 1732 if p = me then 1733 ShowNewContent(NewMode, kModels) 1734 else 1735 ShowNewContent(NewMode, kEModels) 1434 1736 end; 1435 1737 1436 1738 procedure TListDlg.PlayerClick(Sender: TObject); 1437 1739 begin 1438 if TComponent(Sender).Tag=me then Kind:=kModels 1439 else 1440 begin 1441 Kind:=kEModels; 1442 pView:=TComponent(Sender).Tag; 1443 end; 1444 InitLines; 1445 Sel:=-2; 1446 InitPVSB(sb,Lines[Layer]-1,DispLines); 1447 OffscreenPaint; 1448 Invalidate 1740 if TComponent(Sender).Tag = me then 1741 Kind := kModels 1742 else 1743 begin 1744 Kind := kEModels; 1745 pView := TComponent(Sender).Tag; 1746 end; 1747 InitLines; 1748 Sel := -2; 1749 InitPVSB(sb, Lines[Layer] - 1, DispLines); 1750 OffscreenPaint; 1751 Invalidate 1449 1752 end; 1450 1753 1451 1754 procedure TListDlg.ModeBtnClick(Sender: TObject); 1452 1755 begin 1453 Layer0Btn.Down:= Sender=Layer0Btn;1454 Layer1Btn.Down:= Sender=Layer1Btn;1455 Layer2Btn.Down:= Sender=Layer2Btn;1456 Layer:=TComponent(Sender).Tag;1457 1458 Sel:=-2;1459 InitPVSB(sb,Lines[Layer]-1,DispLines);1460 SmartUpdateContent1756 Layer0Btn.Down := Sender = Layer0Btn; 1757 Layer1Btn.Down := Sender = Layer1Btn; 1758 Layer2Btn.Down := Sender = Layer2Btn; 1759 Layer := TComponent(Sender).Tag; 1760 1761 Sel := -2; 1762 InitPVSB(sb, Lines[Layer] - 1, DispLines); 1763 SmartUpdateContent 1461 1764 end; 1462 1765 1463 1766 procedure TListDlg.ToggleBtnClick(Sender: TObject); 1464 1767 var 1465 p1: integer; 1466 m: TMenuItem; 1467 begin 1468 case Kind of 1469 kAdvance: 1470 begin 1471 result:=adFar; 1472 Closable:=true; 1473 Close 1474 end; 1475 kCities, kCityEvents: 1476 begin 1477 if Kind=kCities then Kind:=kCityEvents 1478 else Kind:=kCities; 1479 OffscreenPaint; 1480 Invalidate; 1481 end; 1482 kModels, kEModels: 1483 begin 1484 EmptyMenu(Popup.Items); 1485 if G.Difficulty[me]>0 then 1486 begin 1487 m:=TMenuItem.Create(Popup); 1488 m.RadioItem:=true; 1489 m.Caption:=Tribe[me].TPhrase('SHORTNAME'); 1490 m.Tag:=me; 1491 m.OnClick:=PlayerClick; 1492 if Kind=kModels then m.Checked:=true; 1493 Popup.Items.Add(m); 1494 end; 1495 for p1:=0 to nPl-1 do 1496 if (p1<>me) and (MyRO.EnemyReport[p1]<>nil) 1497 and (MyRO.EnemyReport[p1].TurnOfMilReport>=0) then 1498 begin 1499 m:=TMenuItem.Create(Popup); 1500 m.RadioItem:=true; 1501 m.Caption:=Tribe[p1].TPhrase('SHORTNAME'); 1502 m.Tag:=p1; 1503 m.OnClick:=PlayerClick; 1504 if (Kind=kEModels) and (p1=pView) then m.Checked:=true; 1505 Popup.Items.Add(m); 1506 end; 1507 Popup.Popup(Left+ToggleBtn.Left, Top+ToggleBtn.Top+ToggleBtn.Height); 1508 end 1768 p1: integer; 1769 m: TMenuItem; 1770 begin 1771 case Kind of 1772 kAdvance: 1773 begin 1774 result := adFar; 1775 Closable := true; 1776 Close 1777 end; 1778 kCities, kCityEvents: 1779 begin 1780 if Kind = kCities then 1781 Kind := kCityEvents 1782 else 1783 Kind := kCities; 1784 OffscreenPaint; 1785 Invalidate; 1786 end; 1787 kModels, kEModels: 1788 begin 1789 EmptyMenu(Popup.Items); 1790 if G.Difficulty[me] > 0 then 1791 begin 1792 m := TMenuItem.Create(Popup); 1793 m.RadioItem := true; 1794 m.Caption := Tribe[me].TPhrase('SHORTNAME'); 1795 m.Tag := me; 1796 m.OnClick := PlayerClick; 1797 if Kind = kModels then 1798 m.Checked := true; 1799 Popup.Items.Add(m); 1800 end; 1801 for p1 := 0 to nPl - 1 do 1802 if (p1 <> me) and (MyRO.EnemyReport[p1] <> nil) and 1803 (MyRO.EnemyReport[p1].TurnOfMilReport >= 0) then 1804 begin 1805 m := TMenuItem.Create(Popup); 1806 m.RadioItem := true; 1807 m.Caption := Tribe[p1].TPhrase('SHORTNAME'); 1808 m.Tag := p1; 1809 m.OnClick := PlayerClick; 1810 if (Kind = kEModels) and (p1 = pView) then 1811 m.Checked := true; 1812 Popup.Items.Add(m); 1813 end; 1814 Popup.Popup(Left + ToggleBtn.Left, Top + ToggleBtn.Top + 1815 ToggleBtn.Height); 1816 end 1509 1817 end 1510 1818 end; … … 1513 1821 Shift: TShiftState); 1514 1822 begin 1515 if (Key=VK_F2) and (Kind in [kModels,kEModels]) then // my key 1516 // !!! toggle 1517 else if (Key=VK_F3) and (Kind in [kCities,kCityEvents]) then // my key 1518 ToggleBtnClick(nil) 1519 else if ((Key=VK_ESCAPE) or (Key=VK_RETURN)) and not CloseBtn.Visible then // prevent closing 1520 else inherited 1823 if (Key = VK_F2) and (Kind in [kModels, kEModels]) then // my key 1824 // !!! toggle 1825 else if (Key = VK_F3) and (Kind in [kCities, kCityEvents]) then // my key 1826 ToggleBtnClick(nil) 1827 else if ((Key = VK_ESCAPE) or (Key = VK_RETURN)) and not CloseBtn.Visible then 1828 // prevent closing 1829 else 1830 inherited 1521 1831 end; 1522 1832 1523 1833 procedure TListDlg.EcoChange; 1524 1834 begin 1525 if Visible and (Kind=kCities) then SmartUpdateContent 1835 if Visible and (Kind = kCities) then 1836 SmartUpdateContent 1526 1837 end; 1527 1838 1528 1839 procedure TListDlg.TechChange; 1529 1840 begin 1530 if Visible and (Kind=kScience) then1531 begin 1532 FormShow(nil);1533 Invalidate;1841 if Visible and (Kind = kScience) then 1842 begin 1843 FormShow(nil); 1844 Invalidate; 1534 1845 end; 1535 1846 end; … … 1537 1848 procedure TListDlg.AddCity; 1538 1849 begin 1539 if Visible and (Kind=kCities) then1540 begin 1541 FormShow(nil);1542 Invalidate;1850 if Visible and (Kind = kCities) then 1851 begin 1852 FormShow(nil); 1853 Invalidate; 1543 1854 end; 1544 1855 end; … … 1546 1857 procedure TListDlg.RemoveUnit; 1547 1858 begin 1548 if ListDlg.Visible and (Kind=kModels) then1549 SmartUpdateContent;1859 if ListDlg.Visible and (Kind = kModels) then 1860 SmartUpdateContent; 1550 1861 end; 1551 1862 1552 1863 end. 1553 -
trunk/LocalPlayer/TechTree.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit TechTree; 4 3 … … 6 5 7 6 uses 8 ScreenTools, Messg,7 ScreenTools, Messg, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 21 20 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 22 21 Shift: TShiftState; X, Y: Integer); 23 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, 24 Y: Integer); 25 procedure FormKeyDown(Sender: TObject; var Key: Word; 26 Shift: TShiftState); 22 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 23 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 27 24 procedure CloseBtnClick(Sender: TObject); 28 25 private 29 xOffset, yOffset, xDown, yDown: integer;26 xOffset, yOffset, xDown, yDown: Integer; 30 27 Image: TBitmap; 31 28 dragging: boolean; … … 43 40 44 41 const 45 BlackBorder=4; 46 LeftBorder=72; RightBorder=45; TopBorder=16; BottomBorder=48; 47 xStart=0; yStart=40; 48 xPitch=160; yPitch=90; 49 xLegend=44; yLegend=79; yLegendPitch=32; 50 51 function min(a,b: integer): integer; 52 begin 53 if a<b then 54 result:=a 55 else result:=b; 56 end; 57 58 function max(a,b: integer): integer; 59 begin 60 if a>b then 61 result:=a 62 else result:=b; 42 BlackBorder = 4; 43 LeftBorder = 72; 44 RightBorder = 45; 45 TopBorder = 16; 46 BottomBorder = 48; 47 xStart = 0; 48 yStart = 40; 49 xPitch = 160; 50 yPitch = 90; 51 xLegend = 44; 52 yLegend = 79; 53 yLegendPitch = 32; 54 55 function min(a, b: Integer): Integer; 56 begin 57 if a < b then 58 result := a 59 else 60 result := b; 61 end; 62 63 function max(a, b: Integer): Integer; 64 begin 65 if a > b then 66 result := a 67 else 68 result := b; 63 69 end; 64 70 65 71 procedure TTechTreeDlg.FormCreate(Sender: TObject); 66 72 begin 67 InitButtons;68 Image:=nil;73 InitButtons; 74 Image := nil; 69 75 end; 70 76 71 77 procedure TTechTreeDlg.FormPaint(Sender: TObject); 72 78 var 73 x,w: integer; 74 begin 75 with Canvas do 76 begin 77 // black border 78 brush.color:=$000000; 79 fillrect(rect(0,0,BlackBorder,ClientHeight)); 80 fillrect(rect(BlackBorder,0,ClientWidth-BlackBorder,BlackBorder)); 81 fillrect(rect(ClientWidth-BlackBorder,0,ClientWidth,ClientHeight)); 82 fillrect(rect(BlackBorder,ClientHeight-BlackBorder,ClientWidth-BlackBorder, 83 ClientHeight)); 84 85 // texturize empty space 86 brush.color:=$FFFFFF; 87 if xOffset>0 then 88 FillRectSeamless(Canvas,BlackBorder,BlackBorder,BlackBorder+xOffset, 89 ClientHeight-BlackBorder,-BlackBorder-xOffset,-BlackBorder-yOffset,Paper); 90 if xOffset+Image.width<ClientWidth-2*BlackBorder then 91 FillRectSeamless(Canvas,BlackBorder+xOffset+Image.width,BlackBorder, 92 ClientWidth-BlackBorder,ClientHeight-BlackBorder,-BlackBorder-xOffset, 93 -BlackBorder-yOffset,Paper); 94 x:=max(BlackBorder,BlackBorder+xOffset); 95 w:=min(BlackBorder+xOffset+Image.width,ClientWidth-BlackBorder); 96 if yOffset>0 then 97 FillRectSeamless(Canvas,x,BlackBorder,w,BlackBorder+yOffset, 98 -BlackBorder-xOffset,-BlackBorder-yOffset,Paper); 99 if yOffset+Image.height<ClientHeight-2*BlackBorder then 100 FillRectSeamless(Canvas,x,BlackBorder+yOffset+Image.height,w, 101 ClientHeight-BlackBorder,-BlackBorder-xOffset,-BlackBorder-yOffset,Paper); 79 X, w: Integer; 80 begin 81 with Canvas do 82 begin 83 // black border 84 brush.color := $000000; 85 fillrect(rect(0, 0, BlackBorder, ClientHeight)); 86 fillrect(rect(BlackBorder, 0, ClientWidth - BlackBorder, BlackBorder)); 87 fillrect(rect(ClientWidth - BlackBorder, 0, ClientWidth, ClientHeight)); 88 fillrect(rect(BlackBorder, ClientHeight - BlackBorder, 89 ClientWidth - BlackBorder, ClientHeight)); 90 91 // texturize empty space 92 brush.color := $FFFFFF; 93 if xOffset > 0 then 94 FillRectSeamless(Canvas, BlackBorder, BlackBorder, BlackBorder + xOffset, 95 ClientHeight - BlackBorder, -BlackBorder - xOffset, 96 -BlackBorder - yOffset, Paper); 97 if xOffset + Image.width < ClientWidth - 2 * BlackBorder then 98 FillRectSeamless(Canvas, BlackBorder + xOffset + Image.width, BlackBorder, 99 ClientWidth - BlackBorder, ClientHeight - BlackBorder, 100 -BlackBorder - xOffset, -BlackBorder - yOffset, Paper); 101 X := max(BlackBorder, BlackBorder + xOffset); 102 w := min(BlackBorder + xOffset + Image.width, ClientWidth - BlackBorder); 103 if yOffset > 0 then 104 FillRectSeamless(Canvas, X, BlackBorder, w, BlackBorder + yOffset, 105 -BlackBorder - xOffset, -BlackBorder - yOffset, Paper); 106 if yOffset + Image.height < ClientHeight - 2 * BlackBorder then 107 FillRectSeamless(Canvas, X, BlackBorder + yOffset + Image.height, w, 108 ClientHeight - BlackBorder, -BlackBorder - xOffset, 109 -BlackBorder - yOffset, Paper); 102 110 end; 103 BitBlt(Canvas.Handle,max(BlackBorder,BlackBorder+xOffset), 104 max(BlackBorder,BlackBorder+yOffset), 105 min(Image.width,min(Image.width+xOffset, 106 min(ClientWidth-2*BlackBorder,ClientWidth-2*BlackBorder-xOffset))), 107 min(Image.Height,min(Image.height+yOffset, 108 min(ClientHeight-2*BlackBorder,ClientHeight-2*BlackBorder-yOffset))), 109 Image.Canvas.Handle,max(0,-xOffset),max(0,-yOffset),SRCCOPY); 111 BitBlt(Canvas.Handle, max(BlackBorder, BlackBorder + xOffset), 112 max(BlackBorder, BlackBorder + yOffset), 113 min(Image.width, min(Image.width + xOffset, 114 min(ClientWidth - 2 * BlackBorder, ClientWidth - 2 * BlackBorder - xOffset)) 115 ), min(Image.height, min(Image.height + yOffset, 116 min(ClientHeight - 2 * BlackBorder, ClientHeight - 2 * BlackBorder - 117 yOffset))), Image.Canvas.Handle, max(0, -xOffset), 118 max(0, -yOffset), SRCCOPY); 110 119 end; 111 120 112 121 procedure TTechTreeDlg.FormShow(Sender: TObject); 113 122 type 114 TLine=array[0..9999,0..2] of Byte;123 TLine = array [0 .. 9999, 0 .. 2] of Byte; 115 124 var 116 x,y,ad,TexWidth,TexHeight: integer;117 s: string;118 SrcLine, DstLine: ^TLine;119 begin 120 if Image=nil then121 begin 122 Image:=TBitmap.Create;123 LoadGraphicFile(Image, HomeDir+'Help\AdvTree',gfNoGamma);124 Image.PixelFormat:=pf24bit;125 126 with Image.Canvas do125 X, Y, ad, TexWidth, TexHeight: Integer; 126 s: string; 127 SrcLine, DstLine: ^TLine; 128 begin 129 if Image = nil then 130 begin 131 Image := TBitmap.Create; 132 LoadGraphicFile(Image, HomeDir + 'Help\AdvTree', gfNoGamma); 133 Image.PixelFormat := pf24bit; 134 135 with Image.Canvas do 127 136 begin 128 // write advance names129 Font.Assign(UniFont[ftSmall]);130 Font.Color:=clBlack;131 Brush.Style:=bsClear;132 for x:=0 to (Image.width-xStart) div xPitch do133 for y:=0 to (Image.height-yStart) div yPitch do137 // write advance names 138 Font.Assign(UniFont[ftSmall]); 139 Font.color := clBlack; 140 brush.Style := bsClear; 141 for X := 0 to (Image.width - xStart) div xPitch do 142 for Y := 0 to (Image.height - yStart) div yPitch do 134 143 begin 135 ad:=Pixels[xStart+x*xPitch+10,yStart+y*yPitch-1];136 if ad and $FFFF00=0 then144 ad := Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1]; 145 if ad and $FFFF00 = 0 then 137 146 begin 138 s:=Phrases.Lookup('ADVANCES',ad); 139 while TextWidth(s)>112 do 140 Delete(s,Length(s),1); 141 TextOut(xStart+x*xPitch+2,yStart+y*yPitch,s); 142 Pixels[xStart+x*xPitch+10,yStart+y*yPitch-1]:=$7F007F; 147 s := Phrases.Lookup('ADVANCES', ad); 148 while TextWidth(s) > 112 do 149 Delete(s, Length(s), 1); 150 TextOut(xStart + X * xPitch + 2, yStart + Y * yPitch, s); 151 Pixels[xStart + X * xPitch + 10, yStart + Y * yPitch - 1] 152 := $7F007F; 143 153 end 144 154 end; 145 155 146 // write legend 147 TextOut(xLegend,yLegend,Phrases2.Lookup('ADVTREE_UP0')); 148 TextOut(xLegend,yLegend+yLegendPitch,Phrases2.Lookup('ADVTREE_UP1')); 149 TextOut(xLegend,yLegend+2*yLegendPitch,Phrases2.Lookup('ADVTREE_UP2')); 150 TextOut(xLegend,yLegend+3*yLegendPitch,Phrases2.Lookup('ADVTREE_GOV')); 151 TextOut(xLegend,yLegend+4*yLegendPitch,Phrases2.Lookup('ADVTREE_OTHER')); 156 // write legend 157 TextOut(xLegend, yLegend, Phrases2.Lookup('ADVTREE_UP0')); 158 TextOut(xLegend, yLegend + yLegendPitch, Phrases2.Lookup('ADVTREE_UP1')); 159 TextOut(xLegend, yLegend + 2 * yLegendPitch, 160 Phrases2.Lookup('ADVTREE_UP2')); 161 TextOut(xLegend, yLegend + 3 * yLegendPitch, 162 Phrases2.Lookup('ADVTREE_GOV')); 163 TextOut(xLegend, yLegend + 4 * yLegendPitch, 164 Phrases2.Lookup('ADVTREE_OTHER')); 152 165 end; 153 166 154 // texturize background155 TexWidth:=Paper.width;156 TexHeight:=Paper.height;157 for y:=0 to Image.height-1 do167 // texturize background 168 TexWidth := Paper.width; 169 TexHeight := Paper.height; 170 for Y := 0 to Image.height - 1 do 158 171 begin 159 SrcLine:=Paper.ScanLine[ymod TexHeight];160 DstLine:=Image.ScanLine[y];161 for x:=0 to Image.Width-1 do172 SrcLine := Paper.ScanLine[Y mod TexHeight]; 173 DstLine := Image.ScanLine[Y]; 174 for X := 0 to Image.width - 1 do 162 175 begin 163 if Cardinal((@DstLine[x])^) and $FFFFFF=$7F007F then // transparent164 DstLine[x]:=SrcLine[xmod TexWidth];176 if Cardinal((@DstLine[X])^) and $FFFFFF = $7F007F then // transparent 177 DstLine[X] := SrcLine[X mod TexWidth]; 165 178 end 166 179 end 167 180 end; 168 181 169 // fit window to image, center image in window, center window to screen 170 Width:=min(Screen.Width-40,Image.Width+LeftBorder+RightBorder+2*BlackBorder); 171 Height:=min(Screen.Height-40,Image.Height+TopBorder+BottomBorder+2*BlackBorder); 172 Left:=(Screen.Width-Width) div 2; 173 Top:=(Screen.Height-Height) div 2; 174 CloseBtn.Left:=Width-CloseBtn.Width-BlackBorder-8; 175 CloseBtn.Top:=BlackBorder+8; 176 xOffset:=(ClientWidth-Image.width+LeftBorder-RightBorder) div 2-BlackBorder; 177 yOffset:=ClientHeight-2*BlackBorder-Image.height-BottomBorder; 182 // fit window to image, center image in window, center window to screen 183 width := min(Screen.width - 40, Image.width + LeftBorder + RightBorder + 2 * 184 BlackBorder); 185 height := min(Screen.height - 40, Image.height + TopBorder + BottomBorder + 2 186 * BlackBorder); 187 Left := (Screen.width - width) div 2; 188 Top := (Screen.height - height) div 2; 189 CloseBtn.Left := width - CloseBtn.width - BlackBorder - 8; 190 CloseBtn.Top := BlackBorder + 8; 191 xOffset := (ClientWidth - Image.width + LeftBorder - RightBorder) div 2 - 192 BlackBorder; 193 yOffset := ClientHeight - 2 * BlackBorder - Image.height - BottomBorder; 178 194 end; 179 195 … … 181 197 Shift: TShiftState; X, Y: Integer); 182 198 begin 183 if Button=mbLeft then184 begin 185 dragging:=true;186 xDown:=x;187 yDown:=y;199 if Button = mbLeft then 200 begin 201 dragging := true; 202 xDown := X; 203 yDown := Y; 188 204 end 189 205 end; … … 192 208 Shift: TShiftState; X, Y: Integer); 193 209 begin 194 dragging:=false;210 dragging := false; 195 211 end; 196 212 … … 198 214 X, Y: Integer); 199 215 begin 200 if dragging then 201 begin 202 xOffset:=xOffset+x-xDown; 203 yOffset:=yOffset+y-yDown; 204 xDown:=x; 205 yDown:=y; 206 207 if xOffset>LeftBorder then 208 xOffset:=LeftBorder; 209 if xOffset<ClientWidth-2*BlackBorder-Image.width-RightBorder then 210 xOffset:=ClientWidth-2*BlackBorder-Image.width-RightBorder; 211 if yOffset>TopBorder then 212 yOffset:=TopBorder; 213 if yOffset<ClientHeight-2*BlackBorder-Image.height-BottomBorder then 214 yOffset:=ClientHeight-2*BlackBorder-Image.height-BottomBorder; 215 216 SmartInvalidate; 216 if dragging then 217 begin 218 xOffset := xOffset + X - xDown; 219 yOffset := yOffset + Y - yDown; 220 xDown := X; 221 yDown := Y; 222 223 if xOffset > LeftBorder then 224 xOffset := LeftBorder; 225 if xOffset < ClientWidth - 2 * BlackBorder - Image.width - RightBorder then 226 xOffset := ClientWidth - 2 * BlackBorder - Image.width - RightBorder; 227 if yOffset > TopBorder then 228 yOffset := TopBorder; 229 if yOffset < ClientHeight - 2 * BlackBorder - Image.height - BottomBorder 230 then 231 yOffset := ClientHeight - 2 * BlackBorder - Image.height - BottomBorder; 232 233 SmartInvalidate; 217 234 end 218 235 end; … … 221 238 Shift: TShiftState); 222 239 begin 223 if key=VK_ESCAPE then224 Close;240 if Key = VK_ESCAPE then 241 Close; 225 242 end; 226 243 227 244 procedure TTechTreeDlg.CloseBtnClick(Sender: TObject); 228 245 begin 229 Close();246 Close(); 230 247 end; 231 248 -
trunk/LocalPlayer/Term.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Term; 4 3 … … 6 5 7 6 uses 8 Protocol,Tribes,PVSB,ClientTools,ScreenTools,BaseWin,Messg,ButtonBase, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Menus,ExtCtrls, 11 ButtonA,ButtonB, ButtonC, EOTButton, Area; 7 Protocol, Tribes, PVSB, ClientTools, ScreenTools, BaseWin, Messg, ButtonBase, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus, 10 ExtCtrls, 11 ButtonA, ButtonB, ButtonC, EOTButton, Area; 12 12 13 13 const 14 WM_EOT=WM_USER; 15 16 pltsNormal=0; pltsBlink=1; 14 WM_EOT = WM_USER; 15 16 pltsNormal = 0; 17 pltsBlink = 1; 17 18 18 19 type 19 20 TMainScreen = class(TDrawDlg) 20 Timer1: TTimer;21 Timer1: TTimer; 21 22 GamePopup: TPopupMenu; 22 UnitPopup: TPopupMenu;23 mIrrigation: TMenuItem;24 mCity: TMenuItem;25 mRoad: TMenuItem;26 mMine: TMenuItem;27 mPollution: TMenuItem;28 mHome: TMenuItem;23 UnitPopup: TPopupMenu; 24 mIrrigation: TMenuItem; 25 mCity: TMenuItem; 26 mRoad: TMenuItem; 27 mMine: TMenuItem; 28 mPollution: TMenuItem; 29 mHome: TMenuItem; 29 30 mStay: TMenuItem; 30 mDisband: TMenuItem;31 mWait: TMenuItem;32 mNoOrders: TMenuItem;33 MTrans: TMenuItem;31 mDisband: TMenuItem; 32 mWait: TMenuItem; 33 mNoOrders: TMenuItem; 34 MTrans: TMenuItem; 34 35 UnitBtn: TButtonB; 35 36 mResign: TMenuItem; … … 163 164 N12: TMenuItem; 164 165 mRep14: TMenuItem; 165 procedure FormCreate(Sender:TObject); 166 procedure FormDestroy(Sender:TObject); 167 procedure Timer1Timer(Sender:TObject); 168 procedure MapBoxMouseDown(Sender:TObject;Button:TMouseButton; 169 Shift:TShiftState;x,y:integer); 170 procedure EOTClick(Sender:TObject); 171 procedure PanelBoxMouseDown(Sender:TObject;Button:TMouseButton; 172 Shift:TShiftState;x,y:integer); 173 procedure FormKeyDown(Sender:TObject;var Key:word; 174 Shift:TShiftState); 175 procedure MenuClick(Sender:TObject); 176 procedure FormResize(Sender:TObject); 166 procedure FormCreate(Sender: TObject); 167 procedure FormDestroy(Sender: TObject); 168 procedure Timer1Timer(Sender: TObject); 169 procedure MapBoxMouseDown(Sender: TObject; Button: TMouseButton; 170 Shift: TShiftState; x, y: integer); 171 procedure EOTClick(Sender: TObject); 172 procedure PanelBoxMouseDown(Sender: TObject; Button: TMouseButton; 173 Shift: TShiftState; x, y: integer); 174 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 175 procedure MenuClick(Sender: TObject); 176 procedure FormResize(Sender: TObject); 177 177 procedure PanelBtnClick(Sender: TObject); 178 178 procedure FormCloseQuery(Sender: TObject; var CanClose: boolean); 179 179 procedure Toggle(Sender: TObject); 180 procedure PanelBoxMouseMove(Sender: TObject; Shift: TShiftState; x,181 y: integer);180 procedure PanelBoxMouseMove(Sender: TObject; Shift: TShiftState; 181 x, y: integer); 182 182 procedure PanelBoxMouseUp(Sender: TObject; Button: TMouseButton; 183 183 Shift: TShiftState; x, y: integer); 184 procedure MapBoxMouseMove(Sender: TObject; Shift: TShiftState; x,185 y: integer);184 procedure MapBoxMouseMove(Sender: TObject; Shift: TShiftState; 185 x, y: integer); 186 186 procedure mShowClick(Sender: TObject); 187 187 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; 188 188 Shift: TShiftState; x, y: integer); 189 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, 190 y: integer); 189 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer); 191 190 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 192 191 Shift: TShiftState; x, y: integer); … … 200 199 procedure mNamesClick(Sender: TObject); 201 200 procedure MapBtnClick(Sender: TObject); 202 procedure FormKeyUp(Sender: TObject; var Key: Word; 203 Shift: TShiftState); 201 procedure FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState); 204 202 procedure CreateUnitClick(Sender: TObject); 205 203 procedure mSoundOffClick(Sender: TObject); … … 217 215 public 218 216 procedure CreateParams(var p: TCreateParams); override; 219 procedure Client(Command, NewPlayer:integer;var Data);217 procedure Client(Command, NewPlayer: integer; var Data); 220 218 procedure SetAIName(p: integer; Name: string); 221 219 function ZoomToCity(Loc: integer; NextUnitOnClose: boolean = false; … … 229 227 230 228 private 231 xw,yw,xwd,ywd,xwMini,ywMini,xMidPanel,xRightPanel,xTroop,xTerrain,xMini, 232 yMini,ywmax,ywcenter,TroopLoc,TrCnt,TrRow,TrPitch,MapWidth,MapOffset, 233 MapHeight,BlinkTime,BrushLoc,EditLoc,xMouse,yMouse: integer; 229 xw, yw, xwd, ywd, xwMini, ywMini, xMidPanel, xRightPanel, xTroop, xTerrain, 230 xMini, yMini, ywmax, ywcenter, TroopLoc, TrCnt, TrRow, TrPitch, MapWidth, 231 MapOffset, MapHeight, BlinkTime, BrushLoc, EditLoc, xMouse, 232 yMouse: integer; 234 233 BrushType: Cardinal; 235 trix: array[0..63] of integer;236 AILogo: array [0..nPl-1] of TBitmap;237 Mini, Panel,TopBar: TBitmap;238 sb: TPVScrollbar;239 Closable, RepaintOnResize,Tracking,TurnComplete,Edited,GoOnPhase,234 trix: array [0 .. 63] of integer; 235 AILogo: array [0 .. nPl - 1] of TBitmap; 236 Mini, Panel, TopBar: TBitmap; 237 sb: TPVScrollbar; 238 Closable, RepaintOnResize, Tracking, TurnComplete, Edited, GoOnPhase, 240 239 HaveStrategyAdvice, FirstMovieTurn: boolean; 241 240 procedure ArrangeMidPanel; … … 246 245 procedure CopyMiniToPanel; 247 246 procedure PanelPaint; 248 procedure NextUnit(NearLoc: integer;AutoTurn:boolean);249 procedure Scroll(dx, dy: integer);250 procedure Centre(Loc: integer);251 procedure SetTroopLoc(Loc: integer);252 procedure ProcessRect(x0, y0,nx,ny,Options: integer);247 procedure NextUnit(NearLoc: integer; AutoTurn: boolean); 248 procedure Scroll(dx, dy: integer); 249 procedure Centre(Loc: integer); 250 procedure SetTroopLoc(Loc: integer); 251 procedure ProcessRect(x0, y0, nx, ny, Options: integer); 253 252 procedure PaintLoc(Loc: integer; Radius: integer = 0); 254 253 procedure PaintLoc_BeforeMove(FromLoc: integer); 255 254 procedure PaintLocTemp(Loc: integer; Style: integer = pltsNormal); 256 procedure PaintBufferToScreen(xMap, yMap,width,height: integer);255 procedure PaintBufferToScreen(xMap, yMap, width, height: integer); 257 256 procedure PaintDestination; 258 procedure SetUnFocus(uix: integer);259 function MoveUnit(dx, dy:integer; Options: integer = 0): integer;257 procedure SetUnFocus(uix: integer); 258 function MoveUnit(dx, dy: integer; Options: integer = 0): integer; 260 259 procedure MoveToLoc(Loc: integer; CheckSuicide: boolean); 261 procedure MoveOnScreen(ShowMove: TShowMove; Step0, Step1,nStep: integer;260 procedure MoveOnScreen(ShowMove: TShowMove; Step0, Step1, nStep: integer; 262 261 Restore: boolean = true); 263 procedure FocusOnLoc(Loc: integer; Options: integer = 0);262 procedure FocusOnLoc(Loc: integer; Options: integer = 0); 264 263 function EndTurn(WasSkipped: boolean = false): boolean; 265 264 procedure EndNego; 266 function IsPanelPixel(x, y: integer): boolean;265 function IsPanelPixel(x, y: integer): boolean; 267 266 procedure InitPopup(Popup: TPopupMenu); 268 267 procedure SetMapOptions; … … 272 271 procedure SetDebugMap(p: integer); 273 272 procedure SetViewpoint(p: integer); 274 function LocationOfScreenPixel(x, y: integer): integer;275 procedure SetTileSize(x, y: integer);276 procedure RectInvalidate(Left, Top,Rigth,Bottom: integer);277 procedure SmartRectInvalidate(Left, Top,Rigth,Bottom: integer);273 function LocationOfScreenPixel(x, y: integer): integer; 274 procedure SetTileSize(x, y: integer); 275 procedure RectInvalidate(Left, Top, Rigth, Bottom: integer); 276 procedure SmartRectInvalidate(Left, Top, Rigth, Bottom: integer); 278 277 procedure SaveSettings; 279 procedure OnScroll(var m: TMessage); message WM_VSCROLL;280 procedure OnEOT(var Msg: TMessage); message WM_EOT;278 procedure OnScroll(var m: TMessage); message WM_VSCROLL; 279 procedure OnEOT(var Msg: TMessage); message WM_EOT; 281 280 end; 282 281 283 282 var 284 MainScreen:TMainScreen;283 MainScreen: TMainScreen; 285 284 286 285 type 287 TTribeInfo=record288 trix: integer;289 FileName: ShortString;286 TTribeInfo = record 287 trix: integer; 288 FileName: ShortString; 290 289 end; 291 TCityNameInfo=record 292 ID: integer; 293 NewName: ShortString 294 end; 295 TModelNameInfo=record 296 mix: integer; 297 NewName: ShortString 298 end; 299 TPriceSet=Set of $00..$FF; 300 301 const 302 crImpDrag=2; 303 crFlatHand=3; 304 305 xxu=32; yyu=24; // half of unit slot size x/y 306 yyu_anchor=32; 307 xxc=32; yyc=16; // 1/2 of city slot size in x, 1/2 of ground tile size in y (=1/3 of slot) 308 309 // layout 310 TopBarHeight=41; 311 PanelHeight=168; 312 MidPanelHeight=120; // TopBarHeight+MidPanelHeight should be same as BaseWin.yUnused 313 MapCenterUp=(MidPanelHeight-TopBarHeight) div 2; 314 315 nCityType=4; 316 317 {client exclusive commands:} 318 cSetTribe=$9000;cSetNewModelPicture=$9100;cSetModelName=$9110; 319 cSetModelPicture=$9120;cSetSlaveIndex=$9131; 320 cSetCityName=$9200; 321 322 // city status flags 323 csTypeMask=$0007; csToldDelay=$0008; csResourceWeightsMask=$00F0; 324 csToldBombard=$0100; 325 326 {unit status flags} 327 usStay=$01; usWaiting=$02; usGoto=$04; usEnhance=$08; usRecover=$10; 328 usToldNoReturn=$100; 329 usPersistent=usStay or usGoto or usEnhance or usRecover or integer($FFFF0000); 330 331 {model status flags} 332 msObsolete=$1; msAllowConscripts=$2; 333 334 {additional city happened flags} 335 chTypeDel=$8000; chAllImpsMade=$4000; 336 337 adNone=$801; adFar=$802; adNexus=$803; 338 339 SpecialModelPictureCode: array[0..nSpecialModel-1] of integer= 340 (10,11,40,41,21,30,{50,51,}64,74,{71,}73); 341 342 pixSlaves=0; pixNoSlaves=1; // index of slaves in StdUnits 343 344 // icons.bmp properties 345 xSizeSmall=36; ySizeSmall=20; 346 SystemIconLines=2; // lines of system icons in icons.bmp before improvements 347 348 // save options apart from what's defined by SaveOption 349 soTellAI=30; 350 soExtraMask=$40000000; 351 352 nCityEventPriority=16; 353 CityEventPriority: array[0..nCityEventPriority-1] of integer= 354 (chDisorder,chImprovementLost,chUnitLost,chAllImpsMade,chProduction, 355 chOldWonder,chNoSettlerProd,chPopDecrease,chProductionSabotaged, 356 chNoGrowthWarning,chPollution,chTypeDel,chFounded,chSiege,chAfterCapture, 357 chPopIncrease); 358 359 CityEventSoundItem: array[0..15] of string= 360 ('CITY_DISORDER','','CITY_POPPLUS','CITY_POPMINUS','CITY_UNITLOST', 361 'CITY_IMPLOST','CITY_SABOTAGE','CITY_GROWTHNEEDSIMP','CITY_POLLUTION', 362 'CITY_SIEGE','CITY_WONDEREX','CITY_EMDELAY','CITY_FOUNDED','CITY_FOUNDED','', 363 'CITY_INVALIDTYPE'); 364 365 type 366 TPersistentData=record 367 FarTech, ToldAge, ToldModels, ToldAlive, ToldContact, ToldOwnCredibility, 368 ColdWarStart, PeaceEvaHappened: integer; 369 EnhancementJobs: TEnhancementJobs; 370 ImpOrder: array[0..nCityType-1] of TImpOrder; 371 ToldWonders: array[0..27] of TWonderInfo; 372 ToldTech: array[0..nAdv-1] of ShortInt; 373 end; 374 375 var 376 MyData: ^TPersistentData; 377 AdvIcon:array[0..nAdv-1] of integer; {icons displayed with the technologies} 378 xxt,yyt, // half of tile size x/y 379 GameMode,ClientMode,Age,UnFocus,OptionChecked,MapOptionChecked,nLostArmy, 380 ScienceSum,TaxSum,SoundPreloadDone,MarkCityLoc,HGrTerrain,HGrCities, 381 MovieSpeed: integer; 382 CityRepMask: cardinal; 383 ReceivedOffer: TOffer; 384 Buffer,SmallImp: TBitmap; 385 BlinkON,DestinationMarkON,StartRunning,StayOnTop_Ensured,supervising: boolean; 386 UnusedTribeFiles, TribeNames: tstringlist; 387 TribeOriginal: array[0..nPl-1] of boolean; 388 LostArmy: array[0..nPl*nMmax-1] of integer; 389 DipMem: array[0..nPl-1] of record 390 pContact, SentCommand, FormerTreaty: integer; 391 SentOffer: TOffer; 392 DeliveredPrices, ReceivedPrices: TPriceSet; 290 291 TCityNameInfo = record 292 ID: integer; 293 NewName: ShortString end; 294 TModelNameInfo = record mix: integer; 295 NewName: ShortString end; 296 TPriceSet = Set of $00 .. $FF; 297 298 const 299 crImpDrag = 2; 300 crFlatHand = 3; 301 302 xxu = 32; 303 yyu = 24; // half of unit slot size x/y 304 yyu_anchor = 32; 305 xxc = 32; 306 yyc = 16; // 1/2 of city slot size in x, 1/2 of ground tile size in y (=1/3 of slot) 307 308 // layout 309 TopBarHeight = 41; 310 PanelHeight = 168; 311 MidPanelHeight = 120; 312 // TopBarHeight+MidPanelHeight should be same as BaseWin.yUnused 313 MapCenterUp = (MidPanelHeight - TopBarHeight) div 2; 314 315 nCityType = 4; 316 317 { client exclusive commands: } 318 cSetTribe = $9000; 319 cSetNewModelPicture = $9100; 320 cSetModelName = $9110; 321 cSetModelPicture = $9120; 322 cSetSlaveIndex = $9131; 323 cSetCityName = $9200; 324 325 // city status flags 326 csTypeMask = $0007; 327 csToldDelay = $0008; 328 csResourceWeightsMask = $00F0; 329 csToldBombard = $0100; 330 331 { unit status flags } 332 usStay = $01; 333 usWaiting = $02; 334 usGoto = $04; 335 usEnhance = $08; 336 usRecover = $10; 337 usToldNoReturn = $100; 338 usPersistent = usStay or usGoto or usEnhance or usRecover or 339 integer($FFFF0000); 340 341 { model status flags } 342 msObsolete = $1; 343 msAllowConscripts = $2; 344 345 { additional city happened flags } 346 chTypeDel = $8000; 347 chAllImpsMade = $4000; 348 349 adNone = $801; 350 adFar = $802; 351 adNexus = $803; 352 353 SpecialModelPictureCode: array [0 .. nSpecialModel - 1] of integer = (10, 354 11, 40, 41, 21, 30, { 50,51, } 64, 74, { 71, } 73); 355 356 pixSlaves = 0; 357 pixNoSlaves = 1; // index of slaves in StdUnits 358 359 // icons.bmp properties 360 xSizeSmall = 36; 361 ySizeSmall = 20; 362 SystemIconLines = 2; 363 // lines of system icons in icons.bmp before improvements 364 365 // save options apart from what's defined by SaveOption 366 soTellAI = 30; 367 soExtraMask = $40000000; 368 369 nCityEventPriority = 16; 370 CityEventPriority: array [0 .. nCityEventPriority - 1] of integer = 371 (chDisorder, chImprovementLost, chUnitLost, chAllImpsMade, chProduction, 372 chOldWonder, chNoSettlerProd, chPopDecrease, chProductionSabotaged, 373 chNoGrowthWarning, chPollution, chTypeDel, chFounded, chSiege, 374 chAfterCapture, chPopIncrease); 375 376 CityEventSoundItem: array [0 .. 15] of string = ('CITY_DISORDER', '', 377 'CITY_POPPLUS', 'CITY_POPMINUS', 'CITY_UNITLOST', 'CITY_IMPLOST', 378 'CITY_SABOTAGE', 'CITY_GROWTHNEEDSIMP', 'CITY_POLLUTION', 'CITY_SIEGE', 379 'CITY_WONDEREX', 'CITY_EMDELAY', 'CITY_FOUNDED', 'CITY_FOUNDED', '', 380 'CITY_INVALIDTYPE'); 381 382 type 383 TPersistentData = record 384 FarTech, ToldAge, ToldModels, ToldAlive, ToldContact, ToldOwnCredibility, 385 ColdWarStart, PeaceEvaHappened: integer; 386 EnhancementJobs: TEnhancementJobs; 387 ImpOrder: array [0 .. nCityType - 1] of TImpOrder; 388 ToldWonders: array [0 .. 27] of TWonderInfo; 389 ToldTech: array [0 .. nAdv - 1] of ShortInt; 390 end; 391 392 var 393 MyData: ^TPersistentData; 394 AdvIcon: array [0 .. nAdv - 1] of integer; 395 { icons displayed with the technologies } 396 xxt, yyt, // half of tile size x/y 397 GameMode, ClientMode, Age, UnFocus, OptionChecked, MapOptionChecked, 398 nLostArmy, ScienceSum, TaxSum, SoundPreloadDone, MarkCityLoc, HGrTerrain, 399 HGrCities, MovieSpeed: integer; 400 CityRepMask: Cardinal; 401 ReceivedOffer: TOffer; 402 Buffer, SmallImp: TBitmap; 403 BlinkON, DestinationMarkON, StartRunning, StayOnTop_Ensured, 404 supervising: boolean; 405 UnusedTribeFiles, TribeNames: tstringlist; 406 TribeOriginal: array [0 .. nPl - 1] of boolean; 407 LostArmy: array [0 .. nPl * nMmax - 1] of integer; 408 DipMem: array [0 .. nPl - 1] of record pContact, SentCommand, 409 FormerTreaty: integer; 410 SentOffer: TOffer; 411 DeliveredPrices, ReceivedPrices: TPriceSet; 393 412 end; 394 413 … … 400 419 procedure InitMyModel(mix: integer; final: boolean); 401 420 402 procedure ImpImage(ca: TCanvas; x, y,iix: integer; Government: integer = -1;421 procedure ImpImage(ca: TCanvas; x, y, iix: integer; Government: integer = -1; 403 422 IsControl: boolean = false); 404 423 procedure HelpOnTerrain(Loc, NewMode: integer); 405 424 406 407 425 implementation 408 426 409 427 uses 410 Directories,IsoEngine,CityScreen,Draft,MessgEx,Select,CityType,Help, 411 UnitStat,Diplomacy,Inp,log,Diagram,NatStat,Wonders,Enhance,Nego,Battle,Rates, 428 Directories, IsoEngine, CityScreen, Draft, MessgEx, Select, CityType, Help, 429 UnitStat, Diplomacy, Inp, log, Diagram, NatStat, Wonders, Enhance, Nego, 430 Battle, Rates, 412 431 TechTree, 413 432 414 Registry,ShellAPI; 415 433 Registry, ShellAPI; 416 434 417 435 {$R *.DFM} … … 419 437 420 438 const 421 lxmax_xxx=130; 422 LeftPanelWidth=70; 423 LeftPanelWidth_Editor=46; 424 overlap=PanelHeight-MidPanelHeight; 425 yTroop=PanelHeight-83; 426 xPalace=66; yPalace=24; //120; 427 xAdvisor=108; yAdvisor=48; 428 xUnitText=80; 429 PaperShade=3; 430 BlinkOnTime=12; BlinkOffTime=6; 431 MoveTime=300; // {time for moving a unit in ms} 432 WaitAfterShowMove=32; 433 FastScrolling=false; // causes problems with overlapping windows 434 435 nBrushTypes=26; 436 BrushTypes: array[0..nBrushTypes-1] of Cardinal= 437 (fPrefStartPos,fStartPos, 438 fShore,fGrass,fTundra,fPrairie,fDesert,fSwamp,fForest,fHills,fMountains,fArctic, 439 fDeadLands,fDeadLands or fCobalt,fDeadLands or fUranium, 440 fDeadLands or fMercury,fRiver, 441 fRoad,fRR,fCanal,tiIrrigation,tiFarm,tiMine,fPoll,tiFort,tiBase); 442 443 // MoveUnit options: 444 muAutoNoWait=$0001; muAutoNext=$0002; muNoSuicideCheck=$0004; 445 446 // ProcessRect options: 447 prPaint=$0001; prAutoBounds=$0002; prInvalidate=$0004; 448 449 // FocusOnLoc options: 450 flRepaintPanel=$0001; flImmUpdate=$0002; 451 452 nSaveOption=22; 439 lxmax_xxx = 130; 440 LeftPanelWidth = 70; 441 LeftPanelWidth_Editor = 46; 442 overlap = PanelHeight - MidPanelHeight; 443 yTroop = PanelHeight - 83; 444 xPalace = 66; 445 yPalace = 24; // 120; 446 xAdvisor = 108; 447 yAdvisor = 48; 448 xUnitText = 80; 449 PaperShade = 3; 450 BlinkOnTime = 12; 451 BlinkOffTime = 6; 452 MoveTime = 300; // {time for moving a unit in ms} 453 WaitAfterShowMove = 32; 454 FastScrolling = false; // causes problems with overlapping windows 455 456 nBrushTypes = 26; 457 BrushTypes: array [0 .. nBrushTypes - 1] of Cardinal = (fPrefStartPos, 458 fStartPos, fShore, fGrass, fTundra, fPrairie, fDesert, fSwamp, fForest, 459 fHills, fMountains, fArctic, fDeadLands, fDeadLands or fCobalt, 460 fDeadLands or fUranium, fDeadLands or fMercury, fRiver, fRoad, fRR, fCanal, 461 tiIrrigation, tiFarm, tiMine, fPoll, tiFort, tiBase); 462 463 // MoveUnit options: 464 muAutoNoWait = $0001; 465 muAutoNext = $0002; 466 muNoSuicideCheck = $0004; 467 468 // ProcessRect options: 469 prPaint = $0001; 470 prAutoBounds = $0002; 471 prInvalidate = $0004; 472 473 // FocusOnLoc options: 474 flRepaintPanel = $0001; 475 flImmUpdate = $0002; 476 477 nSaveOption = 22; 453 478 454 479 var 455 Jump: array[0..nPl-1] of integer; 456 pTurn,pLogo,UnStartLoc,ToldSlavery: integer; 457 PerfFreq: int64; 458 SmallScreen, GameOK, MapValid, skipped, idle: boolean; 459 460 SaveOption: array[0..nSaveOption-1] of integer; 461 MiniColors: array[0..11,0..1] of TColor; 462 MainMap: TIsoMap; 463 CurrentMoveInfo: record 464 AfterMovePaintRadius,AfterAttackExpeller: integer; 465 DoShow,IsAlly: boolean; 466 end; 467 480 Jump: array [0 .. nPl - 1] of integer; 481 pTurn, pLogo, UnStartLoc, ToldSlavery: integer; 482 PerfFreq: int64; 483 SmallScreen, GameOK, MapValid, skipped, idle: boolean; 484 485 SaveOption: array [0 .. nSaveOption - 1] of integer; 486 MiniColors: array [0 .. 11, 0 .. 1] of TColor; 487 MainMap: TIsoMap; 488 CurrentMoveInfo: record AfterMovePaintRadius, AfterAttackExpeller: integer; 489 DoShow, IsAlly: boolean; 490 end; 468 491 469 492 function CityEventName(i: integer): string; 470 493 begin 471 if i=14 then // chAllImpsMade 472 if not Phrases2FallenBackToEnglish then 473 result:=Phrases2.Lookup('CITYEVENT_ALLIMPSMADE') 474 else result:=Phrases.Lookup('CITYEVENTS',1) 475 else result:=Phrases.Lookup('CITYEVENTS',i); 494 if i = 14 then // chAllImpsMade 495 if not Phrases2FallenBackToEnglish then 496 result := Phrases2.Lookup('CITYEVENT_ALLIMPSMADE') 497 else 498 result := Phrases.Lookup('CITYEVENTS', 1) 499 else 500 result := Phrases.Lookup('CITYEVENTS', i); 476 501 end; 477 502 478 503 procedure InitSmallImp; 479 504 const 480 cut=4;481 Sharpen=80;505 cut = 4; 506 Sharpen = 80; 482 507 type 483 TLine=array[0..99999,0..2] of Byte;484 TBuffer=array[0..99999,0..2] of integer;508 TLine = array [0 .. 99999, 0 .. 2] of Byte; 509 TBuffer = array [0 .. 99999, 0 .. 2] of integer; 485 510 var 486 sum,Cnt,dx,dy,nx,ny,ix,iy,ir,x,y,c,ch,xdivider,ydivider: integer; 487 resampled: ^TBuffer; 488 line: ^TLine; 511 sum, Cnt, dx, dy, nx, ny, ix, iy, ir, x, y, c, ch, xdivider, 512 ydivider: integer; 513 resampled: ^TBuffer; 514 line: ^TLine; 489 515 begin 490 nx:=BigImp.Width div xSizeBig *xSizeSmall; 491 ny:=BigImp.Height div ySizeBig *ySizeSmall; 492 493 // resample icons 494 GetMem(resampled,nx*ny*12); 495 FillChar(resampled^,nx*ny*12,0); 496 for ix:=0 to BigImp.Width div xSizeBig-1 do for iy:=0 to BigImp.Height div ySizeBig-1 do 497 for y:=0 to ySizeBig-2*cut-1 do 498 begin 499 ydivider:=(y*ySizeSmall div (ySizeBig-2*cut)+1)*(ySizeBig-2*cut)-y*ySizeSmall; 500 if ydivider>ySizeSmall then ydivider:=ySizeSmall; 501 line:=BigImp.ScanLine[cut+iy*ySizeBig+y]; 502 for x:=0 to xSizeBig-1 do 503 begin 504 ir:=ix*xSizeSmall+iy*nx*ySizeSmall 505 +x*xSizeSmall div xSizeBig + y*ySizeSmall div (ySizeBig-2*cut) *nx; 506 xdivider:=(x*xSizeSmall div xSizeBig+1)*xSizeBig-x*xSizeSmall; 507 if xdivider>xSizeSmall then xdivider:=xSizeSmall; 508 for ch:=0 to 2 do 509 begin 510 c:=line[ix*xSizeBig+x,ch]; 511 inc(resampled[ir,ch],c*xdivider*ydivider); 512 if xdivider<xSizeSmall then 513 inc(resampled[ir+1,ch],c*(xSizeSmall-xdivider)*ydivider); 514 if ydivider<ySizeSmall then 515 inc(resampled[ir+nx,ch],c*xdivider*(ySizeSmall-ydivider)); 516 if (xdivider<xSizeSmall) and (ydivider<ySizeSmall) then 517 inc(resampled[ir+nx+1,ch],c*(xSizeSmall-xdivider)*(ySizeSmall-ydivider)); 516 nx := BigImp.width div xSizeBig * xSizeSmall; 517 ny := BigImp.height div ySizeBig * ySizeSmall; 518 519 // resample icons 520 GetMem(resampled, nx * ny * 12); 521 FillChar(resampled^, nx * ny * 12, 0); 522 for ix := 0 to BigImp.width div xSizeBig - 1 do 523 for iy := 0 to BigImp.height div ySizeBig - 1 do 524 for y := 0 to ySizeBig - 2 * cut - 1 do 525 begin 526 ydivider := (y * ySizeSmall div (ySizeBig - 2 * cut) + 1) * 527 (ySizeBig - 2 * cut) - y * ySizeSmall; 528 if ydivider > ySizeSmall then 529 ydivider := ySizeSmall; 530 line := BigImp.ScanLine[cut + iy * ySizeBig + y]; 531 for x := 0 to xSizeBig - 1 do 532 begin 533 ir := ix * xSizeSmall + iy * nx * ySizeSmall + x * 534 xSizeSmall div xSizeBig + y * 535 ySizeSmall div (ySizeBig - 2 * cut) * nx; 536 xdivider := (x * xSizeSmall div xSizeBig + 1) * xSizeBig - x * 537 xSizeSmall; 538 if xdivider > xSizeSmall then 539 xdivider := xSizeSmall; 540 for ch := 0 to 2 do 541 begin 542 c := line[ix * xSizeBig + x, ch]; 543 inc(resampled[ir, ch], c * xdivider * ydivider); 544 if xdivider < xSizeSmall then 545 inc(resampled[ir + 1, ch], c * (xSizeSmall - xdivider) * 546 ydivider); 547 if ydivider < ySizeSmall then 548 inc(resampled[ir + nx, ch], 549 c * xdivider * (ySizeSmall - ydivider)); 550 if (xdivider < xSizeSmall) and (ydivider < ySizeSmall) then 551 inc(resampled[ir + nx + 1, ch], c * (xSizeSmall - xdivider) * 552 (ySizeSmall - ydivider)); 553 end 518 554 end 519 end 520 end; 521 522 // sharpen resampled icons 523 SmallImp.Width:=nx; SmallImp.Height:=ny;524 for y:=0 to ny-1 do555 end; 556 557 // sharpen resampled icons 558 SmallImp.width := nx; 559 SmallImp.height := ny; 560 for y := 0 to ny - 1 do 525 561 begin 526 line:=SmallImp.ScanLine[y]; 527 for x:=0 to nx-1 do 528 for ch:=0 to 2 do 529 begin 530 sum:=0; 531 Cnt:=0; 532 for dy:=-1 to 1 do 533 if ((dy>=0) or (y mod ySizeSmall>0)) and ((dy<=0) or (y mod ySizeSmall<ySizeSmall-1)) then 534 for dx:=-1 to 1 do 535 if ((dx>=0) or (x mod xSizeSmall>0)) and ((dx<=0) or (x mod xSizeSmall<xSizeSmall-1)) then 562 line := SmallImp.ScanLine[y]; 563 for x := 0 to nx - 1 do 564 for ch := 0 to 2 do 565 begin 566 sum := 0; 567 Cnt := 0; 568 for dy := -1 to 1 do 569 if ((dy >= 0) or (y mod ySizeSmall > 0)) and 570 ((dy <= 0) or (y mod ySizeSmall < ySizeSmall - 1)) then 571 for dx := -1 to 1 do 572 if ((dx >= 0) or (x mod xSizeSmall > 0)) and 573 ((dx <= 0) or (x mod xSizeSmall < xSizeSmall - 1)) then 536 574 begin 537 inc(sum,resampled[x+dx+nx*(y+dy),ch]);538 inc(Cnt);575 inc(sum, resampled[x + dx + nx * (y + dy), ch]); 576 inc(Cnt); 539 577 end; 540 sum:=((Cnt*Sharpen+800)*resampled[x+nx*y,ch]-sum*Sharpen) div (800*xSizeBig*(ySizeBig-2*cut)); 541 if sum<0 then sum:=0; 542 if sum>255 then sum:=255; 543 line[x][ch]:=sum; 578 sum := ((Cnt * Sharpen + 800) * resampled[x + nx * y, ch] - sum * 579 Sharpen) div (800 * xSizeBig * (ySizeBig - 2 * cut)); 580 if sum < 0 then 581 sum := 0; 582 if sum > 255 then 583 sum := 255; 584 line[x][ch] := sum; 544 585 end; 545 586 end; 546 FreeMem(resampled);547 //smallimp.savetofile(homedir+'smallimp.bmp'); //!!!587 FreeMem(resampled); 588 // smallimp.savetofile(homedir+'smallimp.bmp'); //!!! 548 589 end; 549 590 550 procedure ImpImage(ca: TCanvas; x, y,iix: integer; Government: integer;591 procedure ImpImage(ca: TCanvas; x, y, iix: integer; Government: integer; 551 592 IsControl: boolean); 552 593 begin 553 if Government<0 then 554 Government:=MyRO.Government; 555 if (iix=imPalace) and (Government<>gAnarchy) then 556 iix:=Government-8; 557 FrameImage(ca, BigImp, x, y, xSizeBig, ySizeBig, 558 (iix+SystemIconLines*7) mod 7*xSizeBig, 559 (iix+SystemIconLines*7) div 7*ySizeBig, IsControl); 594 if Government < 0 then 595 Government := MyRO.Government; 596 if (iix = imPalace) and (Government <> gAnarchy) then 597 iix := Government - 8; 598 FrameImage(ca, BigImp, x, y, xSizeBig, ySizeBig, (iix + SystemIconLines * 7) 599 mod 7 * xSizeBig, (iix + SystemIconLines * 7) div 7 * ySizeBig, IsControl); 560 600 end; 561 601 562 602 procedure HelpOnTerrain(Loc, NewMode: integer); 563 603 begin 564 if MyMap[Loc] and fDeadLands<>0 then 565 HelpDlg.ShowNewContent(NewMode, hkTer, 3*12) 566 else if (MyMap[Loc] and fTerrain=fForest) and IsJungle(Loc div G.lx) then 567 HelpDlg.ShowNewContent(NewMode, hkTer, fJungle + (MyMap[Loc] shr 5 and 3)*12) 568 else HelpDlg.ShowNewContent(NewMode, hkTer, 569 MyMap[Loc] and fTerrain + (MyMap[Loc] shr 5 and 3)*12); 604 if MyMap[Loc] and fDeadLands <> 0 then 605 HelpDlg.ShowNewContent(NewMode, hkTer, 3 * 12) 606 else if (MyMap[Loc] and fTerrain = fForest) and IsJungle(Loc div G.lx) then 607 HelpDlg.ShowNewContent(NewMode, hkTer, 608 fJungle + (MyMap[Loc] shr 5 and 3) * 12) 609 else 610 HelpDlg.ShowNewContent(NewMode, hkTer, MyMap[Loc] and fTerrain + 611 (MyMap[Loc] shr 5 and 3) * 12); 570 612 end; 571 613 572 573 {*** tribe management procedures ***} 614 { *** tribe management procedures *** } 574 615 575 616 function RoughCredibility(Credibility: integer): integer; 576 617 begin 577 case Credibility of 578 0..69: result:=0; 70..89: result:=1; 90..99: result:=2; 100: result:=3 end; 579 end; 580 581 procedure ChooseModelPicture(p,mix,code,Hash,Turn: integer; 582 ForceNew,final: boolean); 583 var 584 i: integer; 585 Picture: TModelPictureInfo; 586 IsNew: boolean; 587 begin 588 Picture.trix:=p; 589 Picture.mix:=mix; 590 if code=74 then 591 begin // use correct pictures for slaves 592 if Tribe[p].mixSlaves<0 then 593 if not TribeOriginal[p] then Tribe[p].mixSlaves:=mix 594 else begin i:=mix+p shl 16; Server(cSetSlaveIndex,0,0,i); end; 595 if ToldSlavery=1 then Picture.pix:=pixSlaves else Picture.pix:=pixNoSlaves; 596 Picture.Hash:=0; 597 Picture.GrName:='StdUnits'; 598 IsNew:=true; 599 end 600 else 601 begin 602 Picture.Hash:=Hash; 603 IsNew:=Tribe[p].ChooseModelPicture(Picture,code,Turn,ForceNew); 604 end; 605 if final then 606 if not TribeOriginal[p] then 607 Tribe[p].SetModelPicture(Picture, IsNew) 608 else if IsNew then 609 Server(cSetNewModelPicture+(Length(Picture.GrName)+1+16+3) div 4,0, 610 0,Picture) 611 else Server(cSetModelPicture+(Length(Picture.GrName)+1+16+3) div 4,0, 612 0,Picture) 613 else with Tribe[p].ModelPicture[mix] do 614 begin 615 HGr:=LoadGraphicSet(Picture.GrName); 616 pix:=Picture.pix; 618 case Credibility of 619 0 .. 69: 620 result := 0; 621 70 .. 89: 622 result := 1; 623 90 .. 99: 624 result := 2; 625 100: 626 result := 3 617 627 end; 618 628 end; 619 629 630 procedure ChooseModelPicture(p, mix, code, Hash, Turn: integer; 631 ForceNew, final: boolean); 632 var 633 i: integer; 634 Picture: TModelPictureInfo; 635 IsNew: boolean; 636 begin 637 Picture.trix := p; 638 Picture.mix := mix; 639 if code = 74 then 640 begin // use correct pictures for slaves 641 if Tribe[p].mixSlaves < 0 then 642 if not TribeOriginal[p] then 643 Tribe[p].mixSlaves := mix 644 else 645 begin 646 i := mix + p shl 16; 647 Server(cSetSlaveIndex, 0, 0, i); 648 end; 649 if ToldSlavery = 1 then 650 Picture.pix := pixSlaves 651 else 652 Picture.pix := pixNoSlaves; 653 Picture.Hash := 0; 654 Picture.GrName := 'StdUnits'; 655 IsNew := true; 656 end 657 else 658 begin 659 Picture.Hash := Hash; 660 IsNew := Tribe[p].ChooseModelPicture(Picture, code, Turn, ForceNew); 661 end; 662 if final then 663 if not TribeOriginal[p] then 664 Tribe[p].SetModelPicture(Picture, IsNew) 665 else if IsNew then 666 Server(cSetNewModelPicture + (Length(Picture.GrName) + 1 + 16 + 3) div 4, 667 0, 0, Picture) 668 else 669 Server(cSetModelPicture + (Length(Picture.GrName) + 1 + 16 + 3) div 4, 0, 670 0, Picture) 671 else 672 with Tribe[p].ModelPicture[mix] do 673 begin 674 HGr := LoadGraphicSet(Picture.GrName); 675 pix := Picture.pix; 676 end; 677 end; 678 620 679 function InitEnemyModel(emix: integer): boolean; 621 680 begin 622 if GameMode=cMovie then 623 begin result:=false; exit end; 624 with MyRO.EnemyModel[emix] do 625 ChooseModelPicture(Owner, mix, ModelCode(MyRO.EnemyModel[emix]), 626 ModelHash(MyRO.EnemyModel[emix]), MyRO.Turn, false, true); 627 result:=true 681 if GameMode = cMovie then 682 begin 683 result := false; 684 exit 685 end; 686 with MyRO.EnemyModel[emix] do 687 ChooseModelPicture(Owner, mix, ModelCode(MyRO.EnemyModel[emix]), 688 ModelHash(MyRO.EnemyModel[emix]), MyRO.Turn, false, true); 689 result := true 628 690 end; 629 691 630 692 procedure InitAllEnemyModels; 631 693 var 632 emix: integer;694 emix: integer; 633 695 begin 634 for emix:=0 to MyRO.nEnemyModel-1 do635 with MyRO.EnemyModel[emix] do636 if Tribe[Owner].ModelPicture[mix].HGr=0 then637 InitEnemyModel(emix);696 for emix := 0 to MyRO.nEnemyModel - 1 do 697 with MyRO.EnemyModel[emix] do 698 if Tribe[Owner].ModelPicture[mix].HGr = 0 then 699 InitEnemyModel(emix); 638 700 end; 639 701 640 702 procedure InitMyModel(mix: integer; final: boolean); 641 703 var 642 mi: TModelInfo;704 mi: TModelInfo; 643 705 begin 644 if (GameMode=cMovie) and (MyModel[mix].Kind<$08) then exit; 706 if (GameMode = cMovie) and (MyModel[mix].Kind < $08) then 707 exit; 645 708 // don't exit for special units because cSetModelPicture comes after TellNewModels 646 MakeModelInfo(me,mix,MyModel[mix],mi);647 ChooseModelPicture(me, mix, ModelCode(mi), ModelHash(mi), MyRO.Turn, false,648 final);709 MakeModelInfo(me, mix, MyModel[mix], mi); 710 ChooseModelPicture(me, mix, ModelCode(mi), ModelHash(mi), MyRO.Turn, 711 false, final); 649 712 end; 650 713 651 714 function AttackSound(code: integer): string; 652 715 begin 653 result:='ATTACK_'+char(48+code div 100 mod 10)+char(48+code div 10 mod 10) 654 +char(48+code mod 10);716 result := 'ATTACK_' + char(48 + code div 100 mod 10) + 717 char(48 + code div 10 mod 10) + char(48 + code mod 10); 655 718 end; 656 719 … … 658 721 // check whether aircraft survived low-fuel warning 659 722 begin 660 assert(not supervising);661 with MyUn[uix] do662 if (Status and usToldNoReturn<>0)663 and ((MyMap[Loc] and fCity<>0) or (MyMap[Loc] and fTerImp=tiBase)664 or (Master>=0)) then665 Status:=Status and not usToldNoReturn;723 assert(not supervising); 724 with MyUn[uix] do 725 if (Status and usToldNoReturn <> 0) and 726 ((MyMap[Loc] and fCity <> 0) or (MyMap[Loc] and fTerImp = tiBase) or 727 (Master >= 0)) then 728 Status := Status and not usToldNoReturn; 666 729 end; 667 730 668 function CreateTribe(p: integer; FileName:string; Original: boolean): boolean;731 function CreateTribe(p: integer; FileName: string; Original: boolean): boolean; 669 732 begin 670 if not FileExists(LocalizedFilePath('Tribes\'+FileName+'.tribe.txt')) then 671 begin result:=false; exit end; 672 673 TribeOriginal[p]:=Original; 674 Tribe[p]:=TTribe.Create(FileName); 675 with Tribe[p] do 733 if not FileExists(LocalizedFilePath('Tribes\' + FileName + '.tribe.txt')) then 676 734 begin 677 if (GameMode=cNewGame) or not Original then 678 begin 679 Term.ChooseModelPicture(p,0,010,1,0,true,true); 680 Term.ChooseModelPicture(p,1,040,1,0,true,true); 681 Term.ChooseModelPicture(p,2,041,1,0,true,true); 682 Term.ChooseModelPicture(p,-1,017,1,0,true,true); 683 end; 684 DipMem[p].pContact:=-1; 735 result := false; 736 exit 685 737 end; 686 result:=true; 738 739 TribeOriginal[p] := Original; 740 Tribe[p] := TTribe.Create(FileName); 741 with Tribe[p] do 742 begin 743 if (GameMode = cNewGame) or not Original then 744 begin 745 Term.ChooseModelPicture(p, 0, 010, 1, 0, true, true); 746 Term.ChooseModelPicture(p, 1, 040, 1, 0, true, true); 747 Term.ChooseModelPicture(p, 2, 041, 1, 0, true, true); 748 Term.ChooseModelPicture(p, -1, 017, 1, 0, true, true); 749 end; 750 DipMem[p].pContact := -1; 751 end; 752 result := true; 687 753 end; 688 754 689 755 procedure TellNewContacts; 690 756 var 691 p1: integer;757 p1: integer; 692 758 begin 693 if not supervising then694 for p1:=0 to nPl-1 do695 if (p1<>me) and (1 shl p1 and MyData.ToldContact=0)696 and (1 shl p1 and MyRO.Alive<>0) and (MyRO.Treaty[p1]>trNoContact) then697 begin 698 TribeMessage(p1, Tribe[p1].TPhrase('FRNEWNATION'), '');699 MyData.ToldContact:=MyData.ToldContact or (1 shl p1);759 if not supervising then 760 for p1 := 0 to nPl - 1 do 761 if (p1 <> me) and (1 shl p1 and MyData.ToldContact = 0) and 762 (1 shl p1 and MyRO.Alive <> 0) and (MyRO.Treaty[p1] > trNoContact) then 763 begin 764 TribeMessage(p1, Tribe[p1].TPhrase('FRNEWNATION'), ''); 765 MyData.ToldContact := MyData.ToldContact or (1 shl p1); 700 766 end 701 767 end; … … 703 769 procedure TellNewModels; 704 770 var 705 mix: integer;706 ModelNameInfo: TModelNameInfo;771 mix: integer; 772 ModelNameInfo: TModelNameInfo; 707 773 begin 708 if supervising then 709 exit; 710 with Tribe[me] do while MyData.ToldModels<MyRO.nModel do 711 begin {new Unit class available} 712 if (ModelPicture[MyData.ToldModels].HGr>0) 713 and (MyModel[MyData.ToldModels].Kind<>mkSelfDeveloped) then 714 begin // save picture of DevModel 715 ModelPicture[MyData.ToldModels+1]:=ModelPicture[MyData.ToldModels]; 716 ModelName[MyData.ToldModels+1]:=ModelName[MyData.ToldModels]; 717 ModelPicture[MyData.ToldModels].HGr:=0 718 end; 719 if ModelPicture[MyData.ToldModels].HGr=0 then 720 InitMyModel(MyData.ToldModels,true); {only run if no researched model} 721 with MessgExDlg do 722 begin 723 { MakeModelInfo(me,MyData.ToldModels,MyModel[MyData.ToldModels],mi); 724 if mi.Attack=0 then OpenSound:='MSG_DEFAULT' 725 else OpenSound:=AttackSound(ModelCode(mi));} 726 if MyModel[MyData.ToldModels].Kind=mkSelfDeveloped then 727 OpenSound:='NEWMODEL_'+char(48+Age); 728 MessgText:=Phrases.Lookup('MODELAVAILABLE'); 729 if GameMode=cMovie then 730 begin 731 Kind:=mkOkHelp; // doesn't matter 732 MessgText:=MessgText+'\'+ModelName[MyData.ToldModels]; 774 if supervising then 775 exit; 776 with Tribe[me] do 777 while MyData.ToldModels < MyRO.nModel do 778 begin { new Unit class available } 779 if (ModelPicture[MyData.ToldModels].HGr > 0) and 780 (MyModel[MyData.ToldModels].Kind <> mkSelfDeveloped) then 781 begin // save picture of DevModel 782 ModelPicture[MyData.ToldModels + 1] := ModelPicture[MyData.ToldModels]; 783 ModelName[MyData.ToldModels + 1] := ModelName[MyData.ToldModels]; 784 ModelPicture[MyData.ToldModels].HGr := 0 785 end; 786 if ModelPicture[MyData.ToldModels].HGr = 0 then 787 InitMyModel(MyData.ToldModels, true); 788 { only run if no researched model } 789 with MessgExDlg do 790 begin 791 { MakeModelInfo(me,MyData.ToldModels,MyModel[MyData.ToldModels],mi); 792 if mi.Attack=0 then OpenSound:='MSG_DEFAULT' 793 else OpenSound:=AttackSound(ModelCode(mi)); } 794 if MyModel[MyData.ToldModels].Kind = mkSelfDeveloped then 795 OpenSound := 'NEWMODEL_' + char(48 + Age); 796 MessgText := Phrases.Lookup('MODELAVAILABLE'); 797 if GameMode = cMovie then 798 begin 799 Kind := mkOkHelp; // doesn't matter 800 MessgText := MessgText + '\' + ModelName[MyData.ToldModels]; 801 end 802 else 803 begin 804 Kind := mkModel; 805 EInput.Text := ModelName[MyData.ToldModels]; 806 end; 807 IconKind := mikModel; 808 IconIndex := MyData.ToldModels; 809 ShowModal; 810 if (EInput.Text <> '') and (EInput.Text <> ModelName[MyData.ToldModels]) 811 then 812 begin // user renamed model 813 ModelNameInfo.mix := MyData.ToldModels; 814 ModelNameInfo.NewName := EInput.Text; 815 Server(cSetModelName + (Length(ModelNameInfo.NewName) + 1 + 4 + 3) 816 div 4, me, 0, ModelNameInfo); 817 end 818 end; 819 if MyModel[MyData.ToldModels].Kind = mkSettler then 820 begin // engineers make settlers obsolete 821 for mix := 0 to MyData.ToldModels - 1 do 822 if MyModel[mix].Kind = mkSettler then 823 MyModel[mix].Status := MyModel[mix].Status or msObsolete; 824 end; 825 inc(MyData.ToldModels) 826 end; 827 end; 828 829 procedure PaintZoomedTile(dst: TBitmap; x, y, Loc: integer); 830 831 procedure TSprite(xDst, yDst, xSrc, ySrc: integer); 832 begin 833 Sprite(dst, HGrTerrain, x + xDst, y + yDst, xxt * 2, yyt * 3, 834 1 + xSrc * (xxt * 2 + 1), 1 + ySrc * (yyt * 3 + 1)); 835 end; 836 837 procedure TSprite4(xSrc, ySrc: integer); 838 begin 839 Sprite(dst, HGrTerrain, x + xxt, y + yyt + 2, xxt * 2, yyt * 2 - 2, 840 1 + xSrc * (xxt * 2 + 1), 3 + yyt + ySrc * (yyt * 3 + 1)); 841 Sprite(dst, HGrTerrain, x + 4, y + 2 * yyt, xxt * 2 - 4, yyt * 2, 842 5 + xSrc * (xxt * 2 + 1), 1 + yyt + ySrc * (yyt * 3 + 1)); 843 Sprite(dst, HGrTerrain, x + xxt * 2, y + 2 * yyt, xxt * 2 - 4, yyt * 2, 844 1 + xSrc * (xxt * 2 + 1), 1 + yyt + ySrc * (yyt * 3 + 1)); 845 Sprite(dst, HGrTerrain, x + xxt, y + yyt * 3, xxt * 2, yyt * 2 - 2, 846 1 + xSrc * (xxt * 2 + 1), 1 + yyt + ySrc * (yyt * 3 + 1)); 847 end; 848 849 var 850 cix, ySrc, Tile: integer; 851 begin 852 Tile := MyMap[Loc]; 853 if Tile and fCity <> 0 then 854 begin 855 if MyRO.Tech[adRailroad] >= tsApplicable then 856 Tile := Tile or fRR 857 else 858 Tile := Tile or fRoad; 859 if Tile and fOwned <> 0 then 860 begin 861 cix := MyRO.nCity - 1; 862 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 863 dec(cix); 864 assert(cix >= 0); 865 if MyCity[cix].Built[imSupermarket] > 0 then 866 Tile := Tile or tiFarm 867 else 868 Tile := Tile or tiIrrigation; 869 end 870 else 871 Tile := Tile or tiIrrigation; 872 end; 873 874 if Tile and fTerrain >= fForest then 875 TSprite4(2, 2) 876 else 877 TSprite4(Tile and fTerrain, 0); 878 if Tile and fTerrain >= fForest then 879 begin 880 if (Tile and fTerrain = fForest) and IsJungle(Loc div G.lx) then 881 ySrc := 18 882 else 883 ySrc := 3 + 2 * (Tile and fTerrain - fForest); 884 TSprite(xxt, 0, 6, ySrc); 885 TSprite(0, yyt, 3, ySrc); 886 TSprite((xxt * 2), yyt, 4, ySrc + 1); 887 TSprite(xxt, (yyt * 2), 1, ySrc + 1); 888 end; 889 890 // irrigation 891 case Tile and fTerImp of 892 tiIrrigation: 893 begin 894 TSprite(xxt, 0, 0, 12); 895 TSprite(xxt * 2, yyt, 0, 12); 896 end; 897 tiFarm: 898 begin 899 TSprite(xxt, 0, 1, 12); 900 TSprite(xxt * 2, yyt, 1, 12); 733 901 end 902 end; 903 904 // river/canal/road/railroad 905 if Tile and fRiver <> 0 then 906 begin 907 TSprite(0, yyt, 2, 14); 908 TSprite(xxt, (yyt * 2), 2, 14); 909 end; 910 if Tile and fCanal <> 0 then 911 begin 912 TSprite(xxt, 0, 7, 11); 913 TSprite(xxt, 0, 3, 11); 914 TSprite(xxt * 2, yyt, 7, 11); 915 TSprite(xxt * 2, yyt, 3, 11); 916 end; 917 if Tile and fRR <> 0 then 918 begin 919 TSprite((xxt * 2), yyt, 1, 10); 920 TSprite((xxt * 2), yyt, 5, 10); 921 TSprite(xxt, (yyt * 2), 1, 10); 922 TSprite(xxt, (yyt * 2), 5, 10); 923 end 924 else if Tile and fRoad <> 0 then 925 begin 926 TSprite((xxt * 2), yyt, 8, 9); 927 TSprite((xxt * 2), yyt, 5, 9); 928 TSprite(xxt, (yyt * 2), 1, 9); 929 TSprite(xxt, (yyt * 2), 5, 9); 930 end; 931 932 if Tile and fPoll <> 0 then 933 TSprite(xxt, (yyt * 2), 6, 12); 934 935 // special 936 if Tile and (fTerrain or fSpecial) = fGrass or fSpecial1 then 937 TSprite4(2, 1) 938 else if Tile and fSpecial <> 0 then 939 if Tile and fTerrain < fForest then 940 TSprite(0, yyt, Tile and fTerrain, Tile and fSpecial shr 5) 941 else if (Tile and fTerrain = fForest) and IsJungle(Loc div G.lx) then 942 TSprite(0, yyt, 8, 17 + Tile and fSpecial shr 5) 734 943 else 735 begin 736 Kind:=mkModel; 737 EInput.Text:=ModelName[MyData.ToldModels]; 944 TSprite(0, yyt, 8, 2 + (Tile and fTerrain - fForest) * 2 + Tile and 945 fSpecial shr 5) 946 else if Tile and fDeadLands <> 0 then 947 begin 948 TSprite4(6, 2); 949 TSprite(xxt, yyt, 8, 12 + Tile shr 25 and 3); 950 end; 951 952 // other improvements 953 case Tile and fTerImp of 954 tiMine: 955 TSprite(xxt, 0, 2, 12); 956 tiFort: 957 begin 958 TSprite(xxt, 0, 7, 12); 959 TSprite(xxt, 0, 3, 12); 738 960 end; 739 IconKind:=mikModel; 740 IconIndex:=MyData.ToldModels; 741 ShowModal; 742 if (EInput.Text<>'') and (EInput.Text<>ModelName[MyData.ToldModels]) then 743 begin // user renamed model 744 ModelNameInfo.mix:=MyData.ToldModels; 745 ModelNameInfo.NewName:=EInput.Text; 746 Server(cSetModelName+(Length(ModelNameInfo.NewName)+1+4+3) div 4, 747 me,0,ModelNameInfo); 748 end 749 end; 750 if MyModel[MyData.ToldModels].kind=mkSettler then 751 begin // engineers make settlers obsolete 752 for mix:=0 to MyData.ToldModels-1 do 753 if MyModel[mix].Kind=mkSettler then 754 MyModel[mix].Status:=MyModel[mix].Status or msObsolete; 755 end; 756 inc(MyData.ToldModels) 961 tiBase: 962 TSprite(xxt, 0, 4, 12); 757 963 end; 758 964 end; 759 965 760 procedure PaintZoomedTile(dst: TBitmap; x,y,Loc: integer); 761 762 procedure TSprite(xDst, yDst, xSrc, ySrc: integer); 966 function ChooseResearch: boolean; 967 var 968 ChosenResearch: integer; 969 begin 970 if (MyData.FarTech <> adNone) and (MyRO.Tech[MyData.FarTech] >= tsApplicable) 971 then 972 MyData.FarTech := adNone; 973 repeat 974 { research complete -- select new } 975 repeat 976 ModalSelectDlg.ShowNewContent(wmModal, kAdvance); 977 if ModalSelectDlg.result < 0 then 978 begin 979 result := false; 980 exit 981 end; 982 ChosenResearch := ModalSelectDlg.result; 983 if ChosenResearch = adMilitary then 984 begin 985 DraftDlg.ShowNewContent(wmModal); 986 if DraftDlg.ModalResult <> mrOK then 987 Tribe[me].ModelPicture[MyRO.nModel].HGr := 0 988 end 989 until (ChosenResearch <> adMilitary) or (DraftDlg.ModalResult = mrOK); 990 991 if ChosenResearch = adMilitary then 992 InitMyModel(MyRO.nModel, true) 993 else if ChosenResearch = adFar then 994 begin 995 ModalSelectDlg.ShowNewContent(wmModal, kFarAdvance); 996 if ModalSelectDlg.result >= 0 then 997 if (ModalSelectDlg.result = adNone) or 998 (Server(sSetResearch - sExecute, me, ModalSelectDlg.result, nil^) < 999 rExecuted) then 1000 MyData.FarTech := ModalSelectDlg.result 1001 else 1002 begin 1003 ChosenResearch := ModalSelectDlg.result; 1004 // can be researched immediately 1005 MyData.FarTech := adNone 1006 end 1007 end; 1008 until ChosenResearch <> adFar; 1009 if ChosenResearch = adNexus then 1010 MyData.FarTech := adNexus 1011 else 1012 Server(sSetResearch, me, ChosenResearch, nil^); 1013 ListDlg.TechChange; 1014 result := true; 1015 end; 1016 1017 (* ** client function handling ** *) 1018 1019 function TMainScreen.DipCall(Command: integer): integer; 1020 var 1021 i: integer; 1022 IsTreatyDeal: boolean; 763 1023 begin 764 Sprite(dst, HGrTerrain, x+xDst, y+yDst, xxt*2, yyt*3, 1+xSrc*(xxt*2+1), 765 1+ySrc*(yyt*3+1)); 766 end; 767 768 procedure TSprite4(xSrc, ySrc: integer); 769 begin 770 Sprite(dst, HGrTerrain, x+xxt, y+yyt+2, xxt*2, yyt*2-2, 1+xSrc*(xxt*2+1), 771 3+yyt+ySrc*(yyt*3+1)); 772 Sprite(dst, HGrTerrain, x+4, y+2*yyt, xxt*2-4, yyt*2, 5+xSrc*(xxt*2+1), 773 1+yyt+ySrc*(yyt*3+1)); 774 Sprite(dst, HGrTerrain, x+xxt*2, y+2*yyt, xxt*2-4, yyt*2, 1+xSrc*(xxt*2+1), 775 1+yyt+ySrc*(yyt*3+1)); 776 Sprite(dst, HGrTerrain, x+xxt, y+yyt*3, xxt*2, yyt*2-2, 1+xSrc*(xxt*2+1), 777 1+yyt+ySrc*(yyt*3+1)); 778 end; 779 780 var 781 cix, ySrc, Tile: integer; 782 begin 783 Tile:=MyMap[Loc]; 784 if Tile and fCity<>0 then 785 begin 786 if MyRO.Tech[adRailroad]>=tsApplicable then 787 Tile:=Tile or fRR 788 else Tile:=Tile or fRoad; 789 if Tile and fOwned<>0 then 790 begin 791 cix:=MyRO.nCity-1; 792 while (cix>=0) and (MyCity[cix].Loc<>Loc) do dec(cix); 793 assert(cix>=0); 794 if MyCity[cix].Built[imSupermarket]>0 then 795 Tile:=Tile or tiFarm 796 else Tile:=Tile or tiIrrigation; 797 end 798 else Tile:=Tile or tiIrrigation; 799 end; 800 801 if Tile and fTerrain>=fForest then TSprite4(2,2) 802 else TSprite4(Tile and fTerrain,0); 803 if Tile and fTerrain>=fForest then 804 begin 805 if (Tile and fTerrain=fForest) and IsJungle(Loc div G.lx) then ySrc:=18 806 else ySrc:=3+2*(Tile and fTerrain-fForest); 807 TSprite(xxt, 0, 6, ySrc); 808 TSprite(0, yyt, 3, ySrc); 809 TSprite((xxt*2), yyt, 4, ySrc+1); 810 TSprite(xxt, (yyt*2), 1, ySrc+1); 811 end; 812 813 // irrigation 814 case Tile and fTerImp of 815 tiIrrigation: 816 begin 817 TSprite(xxt,0,0,12); 818 TSprite(xxt*2,yyt,0,12); 819 end; 820 tiFarm: 821 begin 822 TSprite(xxt,0,1,12); 823 TSprite(xxt*2,yyt,1,12); 1024 result := Server(Command, me, 0, nil^); 1025 if result >= rExecuted then 1026 begin 1027 if Command and $FF0F = scContact then 1028 begin 1029 DipMem[me].pContact := Command shr 4 and $F; 1030 NegoDlg.Initiate; 1031 DipMem[me].DeliveredPrices := []; 1032 DipMem[me].ReceivedPrices := []; 1033 end; 1034 1035 DipMem[me].SentCommand := Command; 1036 DipMem[me].FormerTreaty := MyRO.Treaty[DipMem[me].pContact]; 1037 if Command = scDipCancelTreaty then 1038 Play('CANCELTREATY') 1039 else if Command = scDipAccept then 1040 begin // remember delivered and received prices 1041 for i := 0 to ReceivedOffer.nDeliver - 1 do 1042 include(DipMem[me].ReceivedPrices, ReceivedOffer.Price[i] shr 24); 1043 for i := 0 to ReceivedOffer.nCost - 1 do 1044 include(DipMem[me].DeliveredPrices, 1045 ReceivedOffer.Price[ReceivedOffer.nDeliver + i] shr 24); 1046 IsTreatyDeal := false; 1047 for i := 0 to ReceivedOffer.nDeliver + ReceivedOffer.nCost - 1 do 1048 if ReceivedOffer.Price[i] and opMask = opTreaty then 1049 IsTreatyDeal := true; 1050 if IsTreatyDeal then 1051 Play('NEWTREATY') 1052 else 1053 Play('ACCEPTOFFER'); 1054 end; 1055 CityDlg.CloseAction := None; 1056 if G.RO[DipMem[me].pContact] <> nil then 1057 begin // close windows for next player 1058 for i := 0 to Screen.FormCount - 1 do 1059 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 1060 then 1061 Screen.Forms[i].Close; 1062 end 1063 else 1064 begin 1065 if CityDlg.Visible then 1066 CityDlg.Close; 1067 if UnitStatDlg.Visible then 1068 UnitStatDlg.Close; 1069 end 824 1070 end 825 1071 end; 826 1072 827 // river/canal/road/railroad 828 if Tile and fRiver<>0 then 1073 function TMainScreen.OfferCall(var Offer: TOffer): integer; 1074 var 1075 i: integer; 829 1076 begin 830 TSprite(0, yyt, 2, 14); 831 TSprite(xxt, (yyt*2), 2, 14); 1077 result := Server(scDipOffer, me, 0, Offer); 1078 if result >= rExecuted then 1079 begin 1080 DipMem[me].SentCommand := scDipOffer; 1081 DipMem[me].FormerTreaty := MyRO.Treaty[DipMem[me].pContact]; 1082 DipMem[me].SentOffer := Offer; 1083 CityDlg.CloseAction := None; 1084 if G.RO[DipMem[me].pContact] <> nil then 1085 begin // close windows for next player 1086 for i := 0 to Screen.FormCount - 1 do 1087 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 1088 then 1089 Screen.Forms[i].Close; 1090 end 1091 else 1092 begin 1093 if CityDlg.Visible then 1094 CityDlg.Close; 1095 if UnitStatDlg.Visible then 1096 UnitStatDlg.Close; 1097 end 1098 end 832 1099 end; 833 if Tile and fCanal<>0 then 1100 1101 procedure TMainScreen.SetUnFocus(uix: integer); 1102 var 1103 Loc0: integer; 834 1104 begin 835 TSprite(xxt, 0, 7, 11); 836 TSprite(xxt, 0, 3, 11); 837 TSprite(xxt*2,yyt,7,11); 838 TSprite(xxt*2,yyt,3,11); 839 end; 840 if Tile and fRR<>0 then 841 begin 842 TSprite((xxt*2), yyt, 1, 10); 843 TSprite((xxt*2), yyt, 5, 10); 844 TSprite(xxt, (yyt*2), 1, 10); 845 TSprite(xxt, (yyt*2), 5, 10); 846 end 847 else if Tile and fRoad<>0 then 848 begin 849 TSprite((xxt*2), yyt, 8, 9); 850 TSprite((xxt*2), yyt, 5, 9); 851 TSprite(xxt, (yyt*2), 1, 9); 852 TSprite(xxt, (yyt*2), 5, 9); 853 end; 854 855 if Tile and fPoll<>0 then 856 TSprite(xxt,(yyt*2),6,12); 857 858 // special 859 if Tile and (fTerrain or fSpecial)=fGrass or fSpecial1 then 860 TSprite4(2,1) 861 else if Tile and fSpecial<>0 then 862 if Tile and fTerrain<fForest then 863 TSprite(0, yyt, Tile and fTerrain, Tile and fSpecial shr 5) 864 else if (Tile and fTerrain=fForest) and IsJungle(Loc div G.lx) then 865 TSprite(0, yyt, 8, 17+Tile and fSpecial shr 5) 866 else TSprite(0, yyt, 8, 2+(Tile and fTerrain-fForest)*2+Tile and fSpecial shr 5) 867 else if Tile and fDeadLands<>0 then 868 begin 869 TSprite4(6,2); 870 TSprite(xxt, yyt, 8, 12+Tile shr 25 and 3); 871 end; 872 873 // other improvements 874 case Tile and fTerImp of 875 tiMine: TSprite(xxt, 0, 2, 12); 876 tiFort: begin TSprite(xxt, 0, 7, 12); TSprite(xxt, 0, 3, 12); end; 877 tiBase: TSprite(xxt, 0, 4, 12); 878 end; 879 end; 880 881 function ChooseResearch: boolean; 882 var 883 ChosenResearch: integer; 884 begin 885 if (MyData.FarTech<>adNone) and (MyRO.Tech[MyData.FarTech]>=tsApplicable) then 886 MyData.FarTech:=adNone; 887 repeat 888 {research complete -- select new} 889 repeat 890 ModalSelectDlg.ShowNewContent(wmModal,kAdvance); 891 if ModalSelectDlg.result<0 then 892 begin result:=false; exit end; 893 ChosenResearch:=ModalSelectDlg.result; 894 if ChosenResearch=adMilitary then 895 begin 896 DraftDlg.ShowNewContent(wmModal); 897 if DraftDlg.ModalResult<>mrOK then 898 Tribe[me].ModelPicture[MyRO.nModel].HGr:=0 899 end 900 until (ChosenResearch<>adMilitary) or (DraftDlg.ModalResult=mrOK); 901 902 if ChosenResearch=adMilitary then InitMyModel(MyRO.nModel,true) 903 else if ChosenResearch=adFar then 904 begin 905 ModalSelectDlg.ShowNewContent(wmModal,kFarAdvance); 906 if ModalSelectDlg.result>=0 then 907 if (ModalSelectDlg.Result=adNone) or 908 (Server(sSetResearch-sExecute,me,ModalSelectDlg.Result,nil^)<rExecuted) then 909 MyData.FarTech:=ModalSelectDlg.result 910 else 911 begin 912 ChosenResearch:=ModalSelectDlg.result; // can be researched immediately 913 MyData.FarTech:=adNone 914 end 915 end; 916 until ChosenResearch<>adFar; 917 if ChosenResearch=adNexus then MyData.FarTech:=adNexus 918 else Server(sSetResearch,me,ChosenResearch,nil^); 919 ListDlg.TechChange; 920 result:=true; 921 end; 922 923 924 (*** client function handling ***) 925 926 function TMainScreen.DipCall(Command: integer): integer; 927 var 928 i: integer; 929 IsTreatyDeal: boolean; 930 begin 931 result:=Server(Command,me,0,nil^); 932 if result>=rExecuted then 933 begin 934 if Command and $FF0F=scContact then 935 begin 936 DipMem[me].pContact:=Command shr 4 and $f; 937 NegoDlg.Initiate; 938 DipMem[me].DeliveredPrices:=[]; 939 DipMem[me].ReceivedPrices:=[]; 940 end; 941 942 DipMem[me].SentCommand:=Command; 943 DipMem[me].FormerTreaty:=MyRO.Treaty[DipMem[me].pContact]; 944 if Command=scDipCancelTreaty then Play('CANCELTREATY') 945 else if Command=scDipAccept then 946 begin // remember delivered and received prices 947 for i:=0 to ReceivedOffer.nDeliver-1 do 948 include(DipMem[me].ReceivedPrices,ReceivedOffer.Price[i] shr 24); 949 for i:=0 to ReceivedOffer.nCost-1 do 950 include(DipMem[me].DeliveredPrices, 951 ReceivedOffer.Price[ReceivedOffer.nDeliver+i] shr 24); 952 IsTreatyDeal:=false; 953 for i:=0 to ReceivedOffer.nDeliver+ReceivedOffer.nCost-1 do 954 if ReceivedOffer.Price[i] and opMask=opTreaty then 955 IsTreatyDeal:=true; 956 if IsTreatyDeal then Play('NEWTREATY') 957 else Play('ACCEPTOFFER'); 958 end; 959 CityDlg.CloseAction:=None; 960 if G.RO[DipMem[me].pContact]<>nil then 961 begin // close windows for next player 962 for i:=0 to Screen.FormCount-1 do 963 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 964 Screen.Forms[i].Close; 965 end 966 else 967 begin 968 if CityDlg.Visible then CityDlg.Close; 969 if UnitStatDlg.Visible then UnitStatDlg.Close; 970 end 971 end 972 end; 973 974 function TMainScreen.OfferCall(var Offer: TOffer): integer; 975 var 976 i: integer; 977 begin 978 result:=Server(scDipOffer,me,0,Offer); 979 if result>=rExecuted then 980 begin 981 DipMem[me].SentCommand:=scDipOffer; 982 DipMem[me].FormerTreaty:=MyRO.Treaty[DipMem[me].pContact]; 983 DipMem[me].SentOffer:=Offer; 984 CityDlg.CloseAction:=None; 985 if G.RO[DipMem[me].pContact]<>nil then 986 begin // close windows for next player 987 for i:=0 to Screen.FormCount-1 do 988 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 989 Screen.Forms[i].Close; 990 end 991 else 992 begin 993 if CityDlg.Visible then CityDlg.Close; 994 if UnitStatDlg.Visible then UnitStatDlg.Close; 995 end 996 end 997 end; 998 999 procedure TMainScreen.SetUnFocus(uix:integer); 1000 var 1001 Loc0: integer; 1002 begin 1003 assert(not ((uix>=0) and supervising)); 1004 if uix<>UnFocus then 1005 begin 1006 DestinationMarkON:=false; 1007 PaintDestination; 1008 if uix>=0 then UnStartLoc:=MyUn[uix].Loc; 1009 BlinkON:=false; 1010 BlinkTime:=-1; 1011 if UnFocus>=0 then 1012 begin 1013 Loc0:=MyUn[UnFocus].Loc; 1014 if (uix<0) or (Loc0<>MyUn[uix].Loc) then 1015 begin 1016 UnFocus:=-1; 1017 PaintLoc(Loc0); 1018 end 1019 end; 1020 UnFocus:=uix; 1021 end; 1022 UnitInfoBtn.Visible:= UnFocus>=0; 1023 UnitBtn.Visible:= UnFocus>=0; 1024 CheckTerrainBtnVisible; 1025 end; 1026 1027 procedure TMainScreen.CheckTerrainBtnVisible; 1028 var 1029 Tile: integer; 1030 mox: ^TModel; 1031 begin 1032 if UnFocus>=0 then 1033 begin 1034 mox:=@MyModel[MyUn[UnFocus].mix]; 1035 Tile:=MyMap[MyUn[UnFocus].Loc]; 1036 TerrainBtn.Visible:= (Tile and fCity=0) and (MyUn[UnFocus].Master<0) 1037 and ((mox.Kind=mkSettler) or (mox.Kind=mkSlaves) and (MyRO.Wonder[woPyramids].EffectiveOwner>=0)); 1038 end 1039 else TerrainBtn.Visible:=false; 1040 end; 1041 1042 procedure TMainScreen.CheckMovieSpeedBtnState; 1043 begin 1044 if GameMode=cMovie then 1045 begin 1046 MovieSpeed1Btn.Down:= MovieSpeed=1; 1047 MovieSpeed1Btn.Visible:=true; 1048 MovieSpeed2Btn.Down:= MovieSpeed=2; 1049 MovieSpeed2Btn.Visible:=true; 1050 MovieSpeed3Btn.Down:= MovieSpeed=3; 1051 MovieSpeed3Btn.Visible:=true; 1052 MovieSpeed4Btn.Down:= MovieSpeed=4; 1053 MovieSpeed4Btn.Visible:=true; 1054 end 1055 else 1056 begin 1057 MovieSpeed1Btn.Visible:=false; 1058 MovieSpeed2Btn.Visible:=false; 1059 MovieSpeed3Btn.Visible:=false; 1060 MovieSpeed4Btn.Visible:=false; 1061 end 1062 end; 1063 1064 procedure TMainScreen.SetMapOptions; 1065 begin 1066 IsoEngine.Options:=MapOptionChecked; 1067 if ClientMode=cEditMap then 1068 IsoEngine.Options:=IsoEngine.Options or (1 shl moEditMode); 1069 if mLocCodes.Checked then 1070 IsoEngine.Options:=IsoEngine.Options or (1 shl moLocCodes); 1071 end; 1072 1073 procedure TMainScreen.UpdateViews(UpdateCityScreen: boolean); 1074 begin 1075 SumCities(TaxSum,ScienceSum); 1076 PanelPaint; // TopBar was enough!!! 1077 ListDlg.EcoChange; 1078 NatStatDlg.EcoChange; 1079 if UpdateCityScreen then 1080 CityDlg.SmartUpdateContent; 1081 end; 1082 1083 procedure TMainScreen.SetAIName(p: integer; Name: string); 1084 begin 1085 if Name='' then 1086 begin 1087 if AILogo[p]<>nil then 1088 begin AILogo[p].free; AILogo[p]:=nil end 1089 end 1090 else 1091 begin 1092 if AILogo[p]=nil then 1093 AILogo[p]:=TBitmap.Create; 1094 if not LoadGraphicFile(AILogo[p], HomeDir+Name, gfNoError) then 1095 begin AILogo[p].free; AILogo[p]:=nil end 1096 end 1097 end; 1098 1099 function TMainScreen.ContactRefused(p: integer; Item: String): boolean; 1100 // return whether treaty was cancelled 1101 var 1102 s: string; 1103 begin 1104 assert(MyRO.Treaty[p]>=trPeace); 1105 s:=Tribe[p].TPhrase(Item); 1106 if MyRO.Turn<MyRO.LastCancelTreaty[p]+CancelTreatyTurns then 1107 begin 1108 SimpleMessage(s); 1109 result:=false; 1110 end 1111 else 1112 begin 1113 case MyRO.Treaty[p] of 1114 trPeace: s:=s+' '+Phrases.Lookup('FRCANCELQUERY_PEACE'); 1115 trFriendlyContact: s:=s+' '+Phrases.Lookup('FRCANCELQUERY_FRIENDLY'); 1116 trAlliance: s:=s+' '+Phrases.Lookup('FRCANCELQUERY_ALLIANCE'); 1117 end; 1118 result:= SimpleQuery(mkYesNo,s,'NEGO_REJECTED')=mrOK; 1119 if result then 1120 begin 1121 Play('CANCELTREATY'); 1122 Server(sCancelTreaty,me,0,nil^); 1123 if MyRO.Treaty[p]=trNone then 1124 CityOptimizer_BeginOfTurn; // peace treaty was cancelled -- use formerly forbidden tiles 1125 MapValid:=false; 1126 PaintAllMaps; 1127 end 1128 end 1129 end; 1130 1131 procedure TMainScreen.RememberPeaceViolation; 1132 var 1133 uix,p1: integer; 1134 begin 1135 MyData.PeaceEvaHappened:=0; 1136 for uix:=0 to MyRO.nUn-1 do with MyUn[uix] do if Loc>=0 then 1137 begin 1138 p1:=MyRO.Territory[Loc]; 1139 if (p1<>me) and (p1>=0) and (MyRO.Turn=MyRO.EvaStart[p1]+(PeaceEvaTurns-1)) then 1140 MyData.PeaceEvaHappened:=MyData.PeaceEvaHappened or (1 shl p1); 1141 end; 1142 end; 1143 1144 procedure TMainScreen.Client(Command,NewPlayer:integer;var Data); 1145 1146 procedure GetTribeList; 1147 var 1148 SearchRec: TSearchRec; 1149 Color: TColor; 1150 Name: string; 1151 ok: boolean; 1152 begin 1153 UnusedTribeFiles.Clear; 1154 ok:= FindFirst(DataDir+'Localization\'+'Tribes\*.tribe.txt', 1155 faArchive+faReadOnly,SearchRec)=0; 1156 if not ok then 1157 begin 1158 FindClose(SearchRec); 1159 ok:= FindFirst(HomeDir+'Tribes\*.tribe.txt', 1160 faArchive+faReadOnly,SearchRec)=0; 1161 end; 1162 if ok then 1163 repeat 1164 SearchRec.Name:=Copy(SearchRec.Name,1,Length(SearchRec.Name)-10); 1165 if GetTribeInfo(SearchRec.Name,Name,Color) then 1166 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); 1167 until FindNext(SearchRec)<>0; 1168 FindClose(SearchRec); 1169 end; 1170 1171 function ChooseUnusedTribe: integer; 1172 var 1173 i,j,ColorDistance, BestColorDistance, TestColorDistance, CountBest: integer; 1174 begin 1175 Assert(UnusedTribeFiles.Count>0); 1176 result:=-1; 1177 BestColorDistance:=-1; 1178 for j:=0 to UnusedTribeFiles.Count-1 do 1179 begin 1180 ColorDistance:=250; // consider differences more than this infinite 1181 for i:=0 to nPl-1 do if Tribe[i]<>nil then 1182 begin 1183 TestColorDistance:=abs(integer(UnusedTribeFiles.Objects[j]) shr 16 and $FF - Tribe[i].Color shr 16 and $FF) 1184 +abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and $FF - Tribe[i].Color shr 8 and $FF)*3 1185 +abs(integer(UnusedTribeFiles.Objects[j]) and $FF - Tribe[i].Color and $FF)*2; 1186 if TestColorDistance<ColorDistance then 1187 ColorDistance:=TestColorDistance 1188 end; 1189 if ColorDistance>BestColorDistance then 1190 begin CountBest:=0; BestColorDistance:=ColorDistance end; 1191 if ColorDistance=BestColorDistance then 1192 begin inc(CountBest); if random(CountBest)=0 then result:=j end 1193 end; 1194 end; 1195 1196 procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange); 1197 var 1198 i,TestCost,MostCost: integer; 1199 Ship1Plus,Ship2Plus: boolean; 1200 begin 1201 with ShowShipChange, MessgExDlg do 1202 begin 1203 case Reason of 1204 scrProduction: 1205 begin 1206 OpenSound:='SHIP_BUILT'; 1207 MessgText:=Tribe[Ship1Owner].TPhrase('SHIPBUILT'); 1208 IconKind:=mikShip; 1209 IconIndex:=Ship1Owner; 1210 end; 1211 1212 scrDestruction: 1213 begin 1214 OpenSound:='SHIP_DESTROYED'; 1215 MessgText:=Tribe[Ship1Owner].TPhrase('SHIPDESTROYED'); 1216 IconKind:=mikImp; 1217 end; 1218 1219 scrTrade: 1220 begin 1221 OpenSound:='SHIP_TRADED'; 1222 Ship1Plus:=false; 1223 Ship2Plus:=false; 1224 for i:=0 to nShipPart-1 do 1225 begin 1226 if Ship1Change[i]>0 then Ship1Plus:=true; 1227 if Ship2Change[i]>0 then Ship2Plus:=true; 1228 end; 1229 if Ship1Plus and Ship2Plus then 1230 MessgText:=Tribe[Ship1Owner].TPhrase('SHIPBITRADE1') 1231 +' '+Tribe[Ship2Owner].TPhrase('SHIPBITRADE2') 1232 else if Ship1Plus then 1233 MessgText:=Tribe[Ship1Owner].TPhrase('SHIPUNITRADE1') 1234 +' '+Tribe[Ship2Owner].TPhrase('SHIPUNITRADE2') 1235 else //if Ship2Plus then 1236 MessgText:=Tribe[Ship2Owner].TPhrase('SHIPUNITRADE1') 1237 +' '+Tribe[Ship1Owner].TPhrase('SHIPUNITRADE2'); 1238 IconKind:=mikImp; 1239 end; 1240 1241 scrCapture: 1242 begin 1243 OpenSound:='SHIP_CAPTURED'; 1244 MessgText:=Tribe[Ship2Owner].TPhrase('SHIPCAPTURE1') 1245 +' '+Tribe[Ship1Owner].TPhrase('SHIPCAPTURE2'); 1246 IconKind:=mikShip; 1247 IconIndex:=Ship2Owner; 1105 assert(not((uix >= 0) and supervising)); 1106 if uix <> UnFocus then 1107 begin 1108 DestinationMarkON := false; 1109 PaintDestination; 1110 if uix >= 0 then 1111 UnStartLoc := MyUn[uix].Loc; 1112 BlinkON := false; 1113 BlinkTime := -1; 1114 if UnFocus >= 0 then 1115 begin 1116 Loc0 := MyUn[UnFocus].Loc; 1117 if (uix < 0) or (Loc0 <> MyUn[uix].Loc) then 1118 begin 1119 UnFocus := -1; 1120 PaintLoc(Loc0); 1248 1121 end 1249 1122 end; 1250 1251 if IconKind=mikImp then 1252 begin 1253 MostCost:=0; 1254 for i:=0 to nShipPart-1 do 1255 begin 1256 TestCost:=abs(Ship1Change[i])*Imp[imShipComp+i].Cost; 1257 if TestCost>MostCost then 1258 begin MostCost:=TestCost; IconIndex:=imShipComp+i end 1259 end; 1123 UnFocus := uix; 1124 end; 1125 UnitInfoBtn.Visible := UnFocus >= 0; 1126 UnitBtn.Visible := UnFocus >= 0; 1127 CheckTerrainBtnVisible; 1128 end; 1129 1130 procedure TMainScreen.CheckTerrainBtnVisible; 1131 var 1132 Tile: integer; 1133 mox: ^TModel; 1134 begin 1135 if UnFocus >= 0 then 1136 begin 1137 mox := @MyModel[MyUn[UnFocus].mix]; 1138 Tile := MyMap[MyUn[UnFocus].Loc]; 1139 TerrainBtn.Visible := (Tile and fCity = 0) and (MyUn[UnFocus].Master < 0) 1140 and ((mox.Kind = mkSettler) or (mox.Kind = mkSlaves) and 1141 (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)); 1142 end 1143 else 1144 TerrainBtn.Visible := false; 1145 end; 1146 1147 procedure TMainScreen.CheckMovieSpeedBtnState; 1148 begin 1149 if GameMode = cMovie then 1150 begin 1151 MovieSpeed1Btn.Down := MovieSpeed = 1; 1152 MovieSpeed1Btn.Visible := true; 1153 MovieSpeed2Btn.Down := MovieSpeed = 2; 1154 MovieSpeed2Btn.Visible := true; 1155 MovieSpeed3Btn.Down := MovieSpeed = 3; 1156 MovieSpeed3Btn.Visible := true; 1157 MovieSpeed4Btn.Down := MovieSpeed = 4; 1158 MovieSpeed4Btn.Visible := true; 1159 end 1160 else 1161 begin 1162 MovieSpeed1Btn.Visible := false; 1163 MovieSpeed2Btn.Visible := false; 1164 MovieSpeed3Btn.Visible := false; 1165 MovieSpeed4Btn.Visible := false; 1166 end 1167 end; 1168 1169 procedure TMainScreen.SetMapOptions; 1170 begin 1171 IsoEngine.Options := MapOptionChecked; 1172 if ClientMode = cEditMap then 1173 IsoEngine.Options := IsoEngine.Options or (1 shl moEditMode); 1174 if mLocCodes.Checked then 1175 IsoEngine.Options := IsoEngine.Options or (1 shl moLocCodes); 1176 end; 1177 1178 procedure TMainScreen.UpdateViews(UpdateCityScreen: boolean); 1179 begin 1180 SumCities(TaxSum, ScienceSum); 1181 PanelPaint; // TopBar was enough!!! 1182 ListDlg.EcoChange; 1183 NatStatDlg.EcoChange; 1184 if UpdateCityScreen then 1185 CityDlg.SmartUpdateContent; 1186 end; 1187 1188 procedure TMainScreen.SetAIName(p: integer; Name: string); 1189 begin 1190 if Name = '' then 1191 begin 1192 if AILogo[p] <> nil then 1193 begin 1194 AILogo[p].free; 1195 AILogo[p] := nil 1196 end 1197 end 1198 else 1199 begin 1200 if AILogo[p] = nil then 1201 AILogo[p] := TBitmap.Create; 1202 if not LoadGraphicFile(AILogo[p], HomeDir + Name, gfNoError) then 1203 begin 1204 AILogo[p].free; 1205 AILogo[p] := nil 1206 end 1207 end 1208 end; 1209 1210 function TMainScreen.ContactRefused(p: integer; Item: String): boolean; 1211 // return whether treaty was cancelled 1212 var 1213 s: string; 1214 begin 1215 assert(MyRO.Treaty[p] >= trPeace); 1216 s := Tribe[p].TPhrase(Item); 1217 if MyRO.Turn < MyRO.LastCancelTreaty[p] + CancelTreatyTurns then 1218 begin 1219 SimpleMessage(s); 1220 result := false; 1221 end 1222 else 1223 begin 1224 case MyRO.Treaty[p] of 1225 trPeace: 1226 s := s + ' ' + Phrases.Lookup('FRCANCELQUERY_PEACE'); 1227 trFriendlyContact: 1228 s := s + ' ' + Phrases.Lookup('FRCANCELQUERY_FRIENDLY'); 1229 trAlliance: 1230 s := s + ' ' + Phrases.Lookup('FRCANCELQUERY_ALLIANCE'); 1260 1231 end; 1261 1262 Kind:=mkOk; 1263 ShowModal; 1264 end; 1232 result := SimpleQuery(mkYesNo, s, 'NEGO_REJECTED') = mrOK; 1233 if result then 1234 begin 1235 Play('CANCELTREATY'); 1236 Server(sCancelTreaty, me, 0, nil^); 1237 if MyRO.Treaty[p] = trNone then 1238 CityOptimizer_BeginOfTurn; 1239 // peace treaty was cancelled -- use formerly forbidden tiles 1240 MapValid := false; 1241 PaintAllMaps; 1242 end 1243 end 1265 1244 end; 1266 1245 1267 procedure InitModule;1246 procedure TMainScreen.RememberPeaceViolation; 1268 1247 var 1269 x,y,i,j,Domain:integer;1248 uix, p1: integer; 1270 1249 begin 1271 {search icons for advances:} 1272 for i:=0 to nAdv-1 do 1273 if i in FutureTech then AdvIcon[i]:=96+i-futResearchTechnology 1274 else 1275 begin 1276 AdvIcon[i]:=-1; 1277 for Domain:=0 to nDomains-1 do 1278 for j:=0 to nUpgrade-1 do if upgrade[Domain,j].Preq=i then 1279 if AdvIcon[i]>=0 then AdvIcon[i]:=85 1280 else AdvIcon[i]:=86+Domain; 1281 for j:=0 to nFeature-1 do if Feature[j].Preq=i then 1282 for Domain:=0 to nDomains-1 do 1283 if 1 shl Domain and Feature[j].Domains<>0 then 1284 if (AdvIcon[i]>=0) and (AdvIcon[i]<>86+Domain) then AdvIcon[i]:=85 1285 else AdvIcon[i]:=86+Domain; 1286 for j:=28 to nImp-1 do if Imp[j].Preq=i then AdvIcon[i]:=j; 1287 for j:=28 to nImp-1 do 1288 if (Imp[j].Preq=i) and (Imp[j].Kind<>ikCommon) then AdvIcon[i]:=j; 1289 for j:=0 to nJob-1 do if i=JobPreq[j] then AdvIcon[i]:=84; 1290 for j:=0 to 27 do if Imp[j].Preq=i then AdvIcon[i]:=j; 1291 if AdvIcon[i]<0 then 1292 if AdvValue[i]<1000 then AdvIcon[i]:=-7 1293 else AdvIcon[i]:=24+AdvValue[i] div 1000; 1294 for j:=2 to nGov-1 do if GovPreq[j]=i then AdvIcon[i]:=j-8; 1250 MyData.PeaceEvaHappened := 0; 1251 for uix := 0 to MyRO.nUn - 1 do 1252 with MyUn[uix] do 1253 if Loc >= 0 then 1254 begin 1255 p1 := MyRO.Territory[Loc]; 1256 if (p1 <> me) and (p1 >= 0) and 1257 (MyRO.Turn = MyRO.EvaStart[p1] + (PeaceEvaTurns - 1)) then 1258 MyData.PeaceEvaHappened := MyData.PeaceEvaHappened or (1 shl p1); 1259 end; 1260 end; 1261 1262 procedure TMainScreen.Client(Command, NewPlayer: integer; var Data); 1263 1264 procedure GetTribeList; 1265 var 1266 SearchRec: TSearchRec; 1267 Color: TColor; 1268 Name: string; 1269 ok: boolean; 1270 begin 1271 UnusedTribeFiles.Clear; 1272 ok := FindFirst(DataDir + 'Localization\' + 'Tribes\*.tribe.txt', 1273 faArchive + faReadOnly, SearchRec) = 0; 1274 if not ok then 1275 begin 1276 FindClose(SearchRec); 1277 ok := FindFirst(HomeDir + 'Tribes\*.tribe.txt', faArchive + faReadOnly, 1278 SearchRec) = 0; 1295 1279 end; 1296 AdvIcon[adConscription]:=86+dGround; 1297 1298 UnusedTribeFiles:=tstringlist.Create; 1299 UnusedTribeFiles.Sorted:=true; 1300 TribeNames:=tstringlist.Create; 1301 1302 for x:=0 to 11 do for y:=0 to 1 do 1303 MiniColors[x,y]:=GrExt[HGrSystem].Data.Canvas.Pixels[66+x,67+y]; 1304 IsoEngine.Init(InitEnemyModel); 1305 if not IsoEngine.ApplyTileSize(xxt,yyt) and ((xxt<>48) or (yyt<>24)) then 1306 ApplyTileSize(48,24); // non-default tile size is missing a file, switch to default 1307 MainMap:=TIsoMap.Create; 1308 MainMap.SetOutput(offscreen); 1309 1310 HGrStdUnits:=LoadGraphicSet('StdUnits'); 1311 SmallImp:=TBitmap.Create; 1312 SmallImp.PixelFormat:=pf24bit; 1313 InitSmallImp; 1314 SoundPreloadDone:=0; 1315 StartRunning:=false; 1316 StayOnTop_Ensured:=false; 1317 1318 CreatePVSB(sb,Handle,100-200,122,100+MidPanelHeight-16-200); 1319 end;{InitModule} 1280 if ok then 1281 repeat 1282 SearchRec.Name := Copy(SearchRec.Name, 1, 1283 Length(SearchRec.Name) - 10); 1284 if GetTribeInfo(SearchRec.Name, Name, Color) then 1285 UnusedTribeFiles.AddObject(SearchRec.Name, TObject(Color)); 1286 until FindNext(SearchRec) <> 0; 1287 FindClose(SearchRec); 1288 end; 1289 1290 function ChooseUnusedTribe: integer; 1291 var 1292 i, j, ColorDistance, BestColorDistance, TestColorDistance, 1293 CountBest: integer; 1294 begin 1295 assert(UnusedTribeFiles.Count > 0); 1296 result := -1; 1297 BestColorDistance := -1; 1298 for j := 0 to UnusedTribeFiles.Count - 1 do 1299 begin 1300 ColorDistance := 250; // consider differences more than this infinite 1301 for i := 0 to nPl - 1 do 1302 if Tribe[i] <> nil then 1303 begin 1304 TestColorDistance := 1305 abs(integer(UnusedTribeFiles.Objects[j]) shr 16 and 1306 $FF - Tribe[i].Color shr 16 and $FF) + 1307 abs(integer(UnusedTribeFiles.Objects[j]) shr 8 and 1308 $FF - Tribe[i].Color shr 8 and $FF) * 3 + 1309 abs(integer(UnusedTribeFiles.Objects[j]) and 1310 $FF - Tribe[i].Color and $FF) * 2; 1311 if TestColorDistance < ColorDistance then 1312 ColorDistance := TestColorDistance 1313 end; 1314 if ColorDistance > BestColorDistance then 1315 begin 1316 CountBest := 0; 1317 BestColorDistance := ColorDistance 1318 end; 1319 if ColorDistance = BestColorDistance then 1320 begin 1321 inc(CountBest); 1322 if random(CountBest) = 0 then 1323 result := j 1324 end 1325 end; 1326 end; 1327 1328 procedure ShowEnemyShipChange(ShowShipChange: TShowShipChange); 1329 var 1330 i, TestCost, MostCost: integer; 1331 Ship1Plus, Ship2Plus: boolean; 1332 begin 1333 with ShowShipChange, MessgExDlg do 1334 begin 1335 case Reason of 1336 scrProduction: 1337 begin 1338 OpenSound := 'SHIP_BUILT'; 1339 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBUILT'); 1340 IconKind := mikShip; 1341 IconIndex := Ship1Owner; 1342 end; 1343 1344 scrDestruction: 1345 begin 1346 OpenSound := 'SHIP_DESTROYED'; 1347 MessgText := Tribe[Ship1Owner].TPhrase('SHIPDESTROYED'); 1348 IconKind := mikImp; 1349 end; 1350 1351 scrTrade: 1352 begin 1353 OpenSound := 'SHIP_TRADED'; 1354 Ship1Plus := false; 1355 Ship2Plus := false; 1356 for i := 0 to nShipPart - 1 do 1357 begin 1358 if Ship1Change[i] > 0 then 1359 Ship1Plus := true; 1360 if Ship2Change[i] > 0 then 1361 Ship2Plus := true; 1362 end; 1363 if Ship1Plus and Ship2Plus then 1364 MessgText := Tribe[Ship1Owner].TPhrase('SHIPBITRADE1') + ' ' + 1365 Tribe[Ship2Owner].TPhrase('SHIPBITRADE2') 1366 else if Ship1Plus then 1367 MessgText := Tribe[Ship1Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1368 Tribe[Ship2Owner].TPhrase('SHIPUNITRADE2') 1369 else // if Ship2Plus then 1370 MessgText := Tribe[Ship2Owner].TPhrase('SHIPUNITRADE1') + ' ' + 1371 Tribe[Ship1Owner].TPhrase('SHIPUNITRADE2'); 1372 IconKind := mikImp; 1373 end; 1374 1375 scrCapture: 1376 begin 1377 OpenSound := 'SHIP_CAPTURED'; 1378 MessgText := Tribe[Ship2Owner].TPhrase('SHIPCAPTURE1') + ' ' + 1379 Tribe[Ship1Owner].TPhrase('SHIPCAPTURE2'); 1380 IconKind := mikShip; 1381 IconIndex := Ship2Owner; 1382 end 1383 end; 1384 1385 if IconKind = mikImp then 1386 begin 1387 MostCost := 0; 1388 for i := 0 to nShipPart - 1 do 1389 begin 1390 TestCost := abs(Ship1Change[i]) * Imp[imShipComp + i].Cost; 1391 if TestCost > MostCost then 1392 begin 1393 MostCost := TestCost; 1394 IconIndex := imShipComp + i 1395 end 1396 end; 1397 end; 1398 1399 Kind := mkOk; 1400 ShowModal; 1401 end; 1402 end; 1403 1404 procedure InitModule; 1405 var 1406 x, y, i, j, Domain: integer; 1407 begin 1408 { search icons for advances: } 1409 for i := 0 to nAdv - 1 do 1410 if i in FutureTech then 1411 AdvIcon[i] := 96 + i - futResearchTechnology 1412 else 1413 begin 1414 AdvIcon[i] := -1; 1415 for Domain := 0 to nDomains - 1 do 1416 for j := 0 to nUpgrade - 1 do 1417 if upgrade[Domain, j].Preq = i then 1418 if AdvIcon[i] >= 0 then 1419 AdvIcon[i] := 85 1420 else 1421 AdvIcon[i] := 86 + Domain; 1422 for j := 0 to nFeature - 1 do 1423 if Feature[j].Preq = i then 1424 for Domain := 0 to nDomains - 1 do 1425 if 1 shl Domain and Feature[j].Domains <> 0 then 1426 if (AdvIcon[i] >= 0) and (AdvIcon[i] <> 86 + Domain) then 1427 AdvIcon[i] := 85 1428 else 1429 AdvIcon[i] := 86 + Domain; 1430 for j := 28 to nImp - 1 do 1431 if Imp[j].Preq = i then 1432 AdvIcon[i] := j; 1433 for j := 28 to nImp - 1 do 1434 if (Imp[j].Preq = i) and (Imp[j].Kind <> ikCommon) then 1435 AdvIcon[i] := j; 1436 for j := 0 to nJob - 1 do 1437 if i = JobPreq[j] then 1438 AdvIcon[i] := 84; 1439 for j := 0 to 27 do 1440 if Imp[j].Preq = i then 1441 AdvIcon[i] := j; 1442 if AdvIcon[i] < 0 then 1443 if AdvValue[i] < 1000 then 1444 AdvIcon[i] := -7 1445 else 1446 AdvIcon[i] := 24 + AdvValue[i] div 1000; 1447 for j := 2 to nGov - 1 do 1448 if GovPreq[j] = i then 1449 AdvIcon[i] := j - 8; 1450 end; 1451 AdvIcon[adConscription] := 86 + dGround; 1452 1453 UnusedTribeFiles := tstringlist.Create; 1454 UnusedTribeFiles.Sorted := true; 1455 TribeNames := tstringlist.Create; 1456 1457 for x := 0 to 11 do 1458 for y := 0 to 1 do 1459 MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels 1460 [66 + x, 67 + y]; 1461 IsoEngine.Init(InitEnemyModel); 1462 if not IsoEngine.ApplyTileSize(xxt, yyt) and ((xxt <> 48) or (yyt <> 24)) 1463 then 1464 ApplyTileSize(48, 24); 1465 // non-default tile size is missing a file, switch to default 1466 MainMap := TIsoMap.Create; 1467 MainMap.SetOutput(offscreen); 1468 1469 HGrStdUnits := LoadGraphicSet('StdUnits'); 1470 SmallImp := TBitmap.Create; 1471 SmallImp.PixelFormat := pf24bit; 1472 InitSmallImp; 1473 SoundPreloadDone := 0; 1474 StartRunning := false; 1475 StayOnTop_Ensured := false; 1476 1477 CreatePVSB(sb, Handle, 100 - 200, 122, 100 + MidPanelHeight - 16 - 200); 1478 end; { InitModule } 1320 1479 1321 1480 // sound blocks for preload 1322 1481 const 1323 sbStart=$01; sbWonder=$02; sbScience=$04; sbContact=$08; 1324 sbTurn=$10; sbAll=$FF; 1325 1326 procedure SoundPreload(Check: integer); 1327 const 1328 nStartBlock=27; 1329 StartBlock: array[0..nStartBlock-1] of string= 1330 ('INVALID','TURNEND','DISBAND','CHEAT','MSG_DEFAULT','WARNING_DISORDER', 1331 'WARNING_FAMINE','WARNING_LOWSUPPORT','WARNING_LOWFUNDS','MOVE_MOUNTAIN', 1332 'MOVE_LOAD','MOVE_UNLOAD','MOVE_DIE','NOMOVE_TIME','NOMOVE_DOMAIN', 1333 'NOMOVE_DEFAULT','CITY_SELLIMP','CITY_REBUILDIMP','CITY_BUYPROJECT', 1334 'CITY_UTILIZE','NEWMODEL_0','NEWADVANCE_0','AGE_0','REVOLUTION','NEWGOV', 1335 'CITY_INVALIDTYPE','MSG_GAMEOVER'); 1336 1337 nWonderBlock=6; 1338 WonderBlock: array[0..nWonderBlock-1] of string= 1339 ('WONDER_BUILT','WONDER_CAPTURED','WONDER_EXPIRED','WONDER_DESTROYED', 1340 'MSG_COLDWAR','NEWADVANCE_GRLIB'); 1341 1342 nScienceBlock=17; 1343 ScienceBlock: array[0..nScienceBlock-1] of string= 1344 ('MOVE_PARACHUTE','MOVE_PLANESTART','MOVE_PLANELANDING','MOVE_COVERT', 1345 'NEWMODEL_1','NEWMODEL_2','NEWMODEL_3','NEWADVANCE_1','NEWADVANCE_2', 1346 'NEWADVANCE_3','AGE_1','AGE_2','AGE_3','SHIP_BUILT','SHIP_TRADED', 1347 'SHIP_CAPTURED','SHIP_DESTROYED'); 1348 1349 nContactBlock=20; 1350 ContactBlock: array[0..nContactBlock-1] of string= 1351 ('NEWTREATY','CANCELTREATY','ACCEPTOFFER','MSG_WITHDRAW','MSG_BANKRUPT', 1352 'CONTACT_0','CONTACT_1','CONTACT_2','CONTACT_3','CONTACT_4','CONTACT_5', 1353 'CONTACT_5','CONTACT_6','NEGO_REJECTED','MOVE_CAPTURE','MOVE_EXPEL', 1354 'NOMOVE_TREATY','NOMOVE_ZOC','NOMOVE_SUBMARINE','NOMOVE_STEALTH'); 1355 1356 var 1357 i,cix,mix: integer; 1358 need: boolean; 1359 mi: TModelInfo; 1360 begin 1361 if Check and sbStart and not SoundPreloadDone<>0 then 1362 begin 1363 for i:=0 to nStartBlock-1 do PreparePlay(StartBlock[i]); 1364 SoundPreloadDone:=SoundPreloadDone or sbStart; 1365 end; 1366 if Check and sbWonder and not SoundPreloadDone<>0 then 1367 begin 1368 need:=false; 1369 for i:=0 to 27 do if MyRO.Wonder[i].CityID<>-1 then need:=true; 1370 if need then 1371 begin 1372 for i:=0 to nWonderBlock-1 do PreparePlay(WonderBlock[i]); 1373 SoundPreloadDone:=SoundPreloadDone or sbWonder; 1482 sbStart = $01; 1483 sbWonder = $02; 1484 sbScience = $04; 1485 sbContact = $08; 1486 sbTurn = $10; 1487 sbAll = $FF; 1488 1489 procedure SoundPreload(Check: integer); 1490 const 1491 nStartBlock = 27; 1492 StartBlock: array [0 .. nStartBlock - 1] of string = ('INVALID', 1493 'TURNEND', 'DISBAND', 'CHEAT', 'MSG_DEFAULT', 'WARNING_DISORDER', 1494 'WARNING_FAMINE', 'WARNING_LOWSUPPORT', 'WARNING_LOWFUNDS', 1495 'MOVE_MOUNTAIN', 'MOVE_LOAD', 'MOVE_UNLOAD', 'MOVE_DIE', 'NOMOVE_TIME', 1496 'NOMOVE_DOMAIN', 'NOMOVE_DEFAULT', 'CITY_SELLIMP', 'CITY_REBUILDIMP', 1497 'CITY_BUYPROJECT', 'CITY_UTILIZE', 'NEWMODEL_0', 'NEWADVANCE_0', 1498 'AGE_0', 'REVOLUTION', 'NEWGOV', 'CITY_INVALIDTYPE', 'MSG_GAMEOVER'); 1499 1500 nWonderBlock = 6; 1501 WonderBlock: array [0 .. nWonderBlock - 1] of string = ('WONDER_BUILT', 1502 'WONDER_CAPTURED', 'WONDER_EXPIRED', 'WONDER_DESTROYED', 'MSG_COLDWAR', 1503 'NEWADVANCE_GRLIB'); 1504 1505 nScienceBlock = 17; 1506 ScienceBlock: array [0 .. nScienceBlock - 1] of string = 1507 ('MOVE_PARACHUTE', 'MOVE_PLANESTART', 'MOVE_PLANELANDING', 1508 'MOVE_COVERT', 'NEWMODEL_1', 'NEWMODEL_2', 'NEWMODEL_3', 'NEWADVANCE_1', 1509 'NEWADVANCE_2', 'NEWADVANCE_3', 'AGE_1', 'AGE_2', 'AGE_3', 'SHIP_BUILT', 1510 'SHIP_TRADED', 'SHIP_CAPTURED', 'SHIP_DESTROYED'); 1511 1512 nContactBlock = 20; 1513 ContactBlock: array [0 .. nContactBlock - 1] of string = ('NEWTREATY', 1514 'CANCELTREATY', 'ACCEPTOFFER', 'MSG_WITHDRAW', 'MSG_BANKRUPT', 1515 'CONTACT_0', 'CONTACT_1', 'CONTACT_2', 'CONTACT_3', 'CONTACT_4', 1516 'CONTACT_5', 'CONTACT_5', 'CONTACT_6', 'NEGO_REJECTED', 'MOVE_CAPTURE', 1517 'MOVE_EXPEL', 'NOMOVE_TREATY', 'NOMOVE_ZOC', 'NOMOVE_SUBMARINE', 1518 'NOMOVE_STEALTH'); 1519 1520 var 1521 i, cix, mix: integer; 1522 need: boolean; 1523 mi: TModelInfo; 1524 begin 1525 if Check and sbStart and not SoundPreloadDone <> 0 then 1526 begin 1527 for i := 0 to nStartBlock - 1 do 1528 PreparePlay(StartBlock[i]); 1529 SoundPreloadDone := SoundPreloadDone or sbStart; 1374 1530 end; 1375 end; 1376 if (Check and sbScience and not SoundPreloadDone<>0) 1377 and (MyRO.Tech[adScience]>=tsApplicable) then 1378 begin 1379 for i:=0 to nScienceBlock-1 do PreparePlay(ScienceBlock[i]); 1380 SoundPreloadDone:=SoundPreloadDone or sbScience; 1381 end; 1382 if (Check and sbContact and not SoundPreloadDone<>0) 1383 and (MyRO.nEnemyModel+MyRO.nEnemyCity>0) then 1384 begin 1385 for i:=0 to nContactBlock-1 do PreparePlay(ContactBlock[i]); 1386 SoundPreloadDone:=SoundPreloadDone or sbContact; 1387 end; 1388 if Check and sbTurn<>0 then 1389 begin 1390 if MyRO.Happened and phShipComplete<>0 then 1391 PreparePlay('MSG_YOUWIN'); 1392 if MyData.ToldAlive<>MyRO.Alive then PreparePlay('MSG_EXTINCT'); 1393 for cix:=0 to MyRO.nCity-1 do with MyCity[cix] do 1394 if (Loc>=0) and (Flags and CityRepMask<>0) then 1395 for i:=0 to 12 do if 1 shl i and Flags and CityRepMask<>0 then 1396 PreparePlay(CityEventSoundItem[i]); 1397 for mix:=0 to MyRO.nModel-1 do with MyModel[mix] do if Attack>0 then 1398 begin 1399 MakeModelInfo(me,mix,MyModel[mix],mi); 1400 PreparePlay(AttackSound(ModelCode(mi))); 1401 end 1402 end 1403 end; 1404 1405 procedure InitTurn(p: integer); 1406 const 1407 nAdvBookIcon=16; 1408 AdvBookIcon: array[0..nAdvBookIcon-1] of record Adv,Icon: integer end= 1409 ((Adv:adPolyTheism;Icon:woZeus),(Adv:adBronzeWorking;Icon:woColossus), 1410 (Adv:adMapMaking;Icon:woLighthouse),(Adv:adPoetry;Icon:imTheater), 1411 (Adv:adMonotheism;Icon:woMich),(Adv:adPhilosophy;Icon:woLeo), 1412 (Adv:adTheoryOfGravity;Icon:woNewton),(Adv:adSteel;Icon:woEiffel), 1413 (Adv:adDemocracy;Icon:woLiberty),(Adv:adAutomobile;Icon:imHighways), 1414 (Adv:adSanitation;Icon:imSewer),(Adv:adElectronics;Icon:woHoover), 1415 (Adv:adNuclearFission;Icon:woManhattan),(Adv:adRecycling;Icon:imRecycling), 1416 (Adv:adComputers;Icon:imResLab),(Adv:adSpaceFlight;Icon:woMIR)); 1417 var 1418 Domain,p1,i,ad,uix,cix,MoveOptions,MoveResult,Loc1,Dist,NewAgeCenterTo, 1419 Bankrupt,ShipMore,Winners,NewGovAvailable,dx,dy:integer; 1420 MoveAdviceData: TMoveAdviceData; 1421 Picture: TModelPictureInfo; 1422 s, Item, Item2: string; 1423 UpdatePanel, OwnWonder, ok, Stop, ShowCityList, WondersOnly,AllowCityScreen: boolean; 1424 begin 1425 if IsMultiPlayerGame and (p<>me) then 1426 begin 1427 UnitInfoBtn.Visible:=false; 1428 UnitBtn.Visible:=false; 1429 TerrainBtn.Visible:=false; 1430 EOT.Visible:=false; 1431 end; 1432 if IsMultiPlayerGame and (p<>me) and (G.RO[0].Happened and phShipComplete=0) then 1433 begin //inter player screen 1434 for i:=0 to ControlCount-1 do if Controls[i] is TButtonC then 1435 Controls[i].visible:=false; 1436 me:=-1; 1437 SetMainTextureByAge(-1); 1438 with Panel.Canvas do 1439 begin 1440 Brush.Color:=$000000; 1441 FillRect(Rect(0,0,Panel.Width,Panel.Height)); 1442 Brush.Style:=bsClear; 1531 if Check and sbWonder and not SoundPreloadDone <> 0 then 1532 begin 1533 need := false; 1534 for i := 0 to 27 do 1535 if MyRO.Wonder[i].CityID <> -1 then 1536 need := true; 1537 if need then 1538 begin 1539 for i := 0 to nWonderBlock - 1 do 1540 PreparePlay(WonderBlock[i]); 1541 SoundPreloadDone := SoundPreloadDone or sbWonder; 1542 end; 1443 1543 end; 1444 with TopBar.Canvas do 1445 begin 1446 Brush.Color:=$000000; 1447 FillRect(Rect(0,0,TopBar.Width,TopBar.Height)); 1448 Brush.Style:=bsClear; 1544 if (Check and sbScience and not SoundPreloadDone <> 0) and 1545 (MyRO.Tech[adScience] >= tsApplicable) then 1546 begin 1547 for i := 0 to nScienceBlock - 1 do 1548 PreparePlay(ScienceBlock[i]); 1549 SoundPreloadDone := SoundPreloadDone or sbScience; 1449 1550 end; 1450 Invalidate; 1451 1452 s:=TurnToString(G.RO[0].Turn); 1453 if supervising then 1454 SimpleMessage(Format(Phrases.Lookup('SUPERTURN'),[s])) 1455 else SimpleMessage(Format(Tribe[NewPlayer].TPhrase('TURN'),[s])); 1456 end; 1457 for i:=0 to ControlCount-1 do if Controls[i] is TButtonC then 1458 Controls[i].visible:=true; 1459 1460 ItsMeAgain(p); 1461 MyData:=G.RO[p].Data; 1462 if not supervising then 1463 SoundPreload(sbAll); 1464 if (me=0) and ((MyRO.Turn=0) or (ClientMode=cResume)) then 1465 Invalidate; // colorize empty space 1466 1467 if not supervising then 1468 begin 1469 { if MyRO.Happened and phGameEnd<>0 then 1470 begin 1471 Age:=3; 1472 SetMainTextureByAge(-1); 1551 if (Check and sbContact and not SoundPreloadDone <> 0) and 1552 (MyRO.nEnemyModel + MyRO.nEnemyCity > 0) then 1553 begin 1554 for i := 0 to nContactBlock - 1 do 1555 PreparePlay(ContactBlock[i]); 1556 SoundPreloadDone := SoundPreloadDone or sbContact; 1557 end; 1558 if Check and sbTurn <> 0 then 1559 begin 1560 if MyRO.Happened and phShipComplete <> 0 then 1561 PreparePlay('MSG_YOUWIN'); 1562 if MyData.ToldAlive <> MyRO.Alive then 1563 PreparePlay('MSG_EXTINCT'); 1564 for cix := 0 to MyRO.nCity - 1 do 1565 with MyCity[cix] do 1566 if (Loc >= 0) and (Flags and CityRepMask <> 0) then 1567 for i := 0 to 12 do 1568 if 1 shl i and Flags and CityRepMask <> 0 then 1569 PreparePlay(CityEventSoundItem[i]); 1570 for mix := 0 to MyRO.nModel - 1 do 1571 with MyModel[mix] do 1572 if Attack > 0 then 1573 begin 1574 MakeModelInfo(me, mix, MyModel[mix], mi); 1575 PreparePlay(AttackSound(ModelCode(mi))); 1576 end 1473 1577 end 1474 else} 1475 begin 1476 Age:=GetAge(me); 1477 if SetMainTextureByAge(Age) then 1478 EOT.Invalidate; // has visible background parts in its bounds 1578 end; 1579 1580 procedure InitTurn(p: integer); 1581 const 1582 nAdvBookIcon = 16; 1583 AdvBookIcon: array [0 .. nAdvBookIcon - 1] of record Adv, 1584 Icon: integer end = ((Adv: adPolyTheism; Icon: woZeus), 1585 (Adv: adBronzeWorking; Icon: woColossus), (Adv: adMapMaking; 1586 Icon: woLighthouse), (Adv: adPoetry; Icon: imTheater), 1587 (Adv: adMonotheism; Icon: woMich), (Adv: adPhilosophy; Icon: woLeo), 1588 (Adv: adTheoryOfGravity; Icon: woNewton), (Adv: adSteel; 1589 Icon: woEiffel), (Adv: adDemocracy; Icon: woLiberty), 1590 (Adv: adAutomobile; Icon: imHighways), (Adv: adSanitation; 1591 Icon: imSewer), (Adv: adElectronics; Icon: woHoover), 1592 (Adv: adNuclearFission; Icon: woManhattan), (Adv: adRecycling; 1593 Icon: imRecycling), (Adv: adComputers; Icon: imResLab), 1594 (Adv: adSpaceFlight; Icon: woMIR)); 1595 var 1596 Domain, p1, i, ad, uix, cix, MoveOptions, MoveResult, Loc1, Dist, 1597 NewAgeCenterTo, Bankrupt, ShipMore, Winners, NewGovAvailable, dx, 1598 dy: integer; 1599 MoveAdviceData: TMoveAdviceData; 1600 Picture: TModelPictureInfo; 1601 s, Item, Item2: string; 1602 UpdatePanel, OwnWonder, ok, Stop, ShowCityList, WondersOnly, 1603 AllowCityScreen: boolean; 1604 begin 1605 if IsMultiPlayerGame and (p <> me) then 1606 begin 1607 UnitInfoBtn.Visible := false; 1608 UnitBtn.Visible := false; 1609 TerrainBtn.Visible := false; 1610 EOT.Visible := false; 1479 1611 end; 1480 // age:=MyRO.Turn mod 4; //!!! 1481 if ClientMode=cMovieTurn then 1482 EOT.ButtonIndex:=eotCancel 1483 else if ClientMode<scContact then 1484 EOT.ButtonIndex:=eotGray 1485 else EOT.ButtonIndex:=eotBackToNego; 1486 end 1487 else 1488 begin 1489 Age:=0; 1490 SetMainTextureByAge(-1); 1491 if ClientMode=cMovieTurn then 1492 EOT.ButtonIndex:=eotCancel 1493 else EOT.ButtonIndex:=eotBlinkOn; 1494 end; 1495 InitCityMark(MainTexture); 1496 CityDlg.CheckAge; 1497 NatStatDlg.CheckAge; 1498 UnitStatDlg.CheckAge; 1499 HelpDlg.Difficulty:=G.Difficulty[me]; 1500 1501 UnFocus:=-1; 1502 MarkCityLoc:=-1; 1503 BlinkON:=false; 1504 BlinkTime:=-1; 1505 Tracking:=false; 1506 TurnComplete:=false; 1507 1508 if (ToldSlavery<0) 1509 or ((ToldSlavery=1)<>(MyRO.Wonder[woPyramids].EffectiveOwner>=0)) then 1510 begin 1511 if MyRO.Wonder[woPyramids].EffectiveOwner>=0 then ToldSlavery:=1 1512 else ToldSlavery:=0; 1513 for p1:=0 to nPl-1 do 1514 if (Tribe[p1]<>nil) and (Tribe[p1].mixSlaves>=0) then 1515 with Picture do 1516 begin // replace unit picture 1517 mix:=Tribe[p1].mixSlaves; 1518 if ToldSlavery=1 then pix:=pixSlaves else pix:=pixNoSlaves; 1519 Hash:=0; 1520 GrName:='StdUnits'; 1521 Tribe[p1].SetModelPicture(Picture, true); 1612 if IsMultiPlayerGame and (p <> me) and 1613 (G.RO[0].Happened and phShipComplete = 0) then 1614 begin // inter player screen 1615 for i := 0 to ControlCount - 1 do 1616 if Controls[i] is TButtonC then 1617 Controls[i].Visible := false; 1618 me := -1; 1619 SetMainTextureByAge(-1); 1620 with Panel.Canvas do 1621 begin 1622 Brush.Color := $000000; 1623 FillRect(Rect(0, 0, Panel.width, Panel.height)); 1624 Brush.Style := bsClear; 1625 end; 1626 with TopBar.Canvas do 1627 begin 1628 Brush.Color := $000000; 1629 FillRect(Rect(0, 0, TopBar.width, TopBar.height)); 1630 Brush.Style := bsClear; 1631 end; 1632 Invalidate; 1633 1634 s := TurnToString(G.RO[0].Turn); 1635 if supervising then 1636 SimpleMessage(Format(Phrases.Lookup('SUPERTURN'), [s])) 1637 else 1638 SimpleMessage(Format(Tribe[NewPlayer].TPhrase('TURN'), [s])); 1639 end; 1640 for i := 0 to ControlCount - 1 do 1641 if Controls[i] is TButtonC then 1642 Controls[i].Visible := true; 1643 1644 ItsMeAgain(p); 1645 MyData := G.RO[p].Data; 1646 if not supervising then 1647 SoundPreload(sbAll); 1648 if (me = 0) and ((MyRO.Turn = 0) or (ClientMode = cResume)) then 1649 Invalidate; // colorize empty space 1650 1651 if not supervising then 1652 begin 1653 1654 { if MyRO.Happened and phGameEnd<>0 then 1655 begin 1656 Age:=3; 1657 SetMainTextureByAge(-1); 1522 1658 end 1523 end; 1524 1525 if not supervising and (ClientMode=cTurn) then 1526 begin 1527 for cix:=0 to MyRO.nCity-1 do 1528 if (MyCity[cix].Loc>=0) 1529 and ((MyRO.Turn=0) or (MyCity[cix].Flags and chFounded<>0)) then 1530 MyCity[cix].Status:=MyCity[cix].Status 1531 and not csResourceWeightsMask or (3 shl 4); // new city, set to maximum growth 1532 end; 1533 if (ClientMode=cTurn) or (ClientMode=cContinue) then 1534 CityOptimizer_BeginOfTurn; // maybe peace was made or has ended 1535 SumCities(TaxSum,ScienceSum); 1536 1537 if ClientMode=cMovieTurn then 1538 begin 1539 UnitInfoBtn.Visible:=false; 1540 UnitBtn.Visible:=false; 1541 TerrainBtn.Visible:=false; 1542 EOT.Hint:=Phrases.Lookup('BTN_STOP'); 1543 EOT.Visible:=true; 1544 end 1545 else if ClientMode<scContact then 1546 begin 1547 UnitInfoBtn.Visible:= UnFocus>=0; 1548 UnitBtn.Visible:= UnFocus>=0; 1549 CheckTerrainBtnVisible; 1550 TurnComplete:=supervising; 1551 EOT.Hint:=Phrases.Lookup('BTN_ENDTURN'); 1552 EOT.Visible:= Server(sTurn-sExecute,me,0,nil^)>=rExecuted; 1553 end 1554 else 1555 begin 1556 UnitInfoBtn.Visible:=false; 1557 UnitBtn.Visible:=false; 1558 TerrainBtn.Visible:=false; 1559 EOT.Hint:=Phrases.Lookup('BTN_NEGO'); 1560 EOT.Visible:=true; 1561 end; 1562 SetTroopLoc(-1); 1563 MapValid:=false; 1564 NewAgeCenterTo:=0; 1565 if ((MyRO.Turn=0) and not supervising or IsMultiPlayerGame 1566 or (ClientMode=cResume)) and (MyRO.nCity>0) then 1567 begin 1568 Loc1:=MyCity[0].Loc; 1569 if (ClientMode=cTurn) and (MyRO.Turn=0) then 1570 begin // move city out of center to not be covered by welcome screen 1571 dx:=MapWidth div (xxt*5); 1572 if dx>5 then 1573 dx:=5; 1574 dy:=MapHeight div (yyt*5); 1575 if dy>5 then 1576 dy:=5; 1577 if Loc1>=G.lx*G.ly div 2 then 1578 begin 1579 NewAgeCenterTo:=-1; 1580 Loc1:=dLoc(Loc1,-dx,-dy) 1581 end 1659 else } 1660 begin 1661 Age := GetAge(me); 1662 if SetMainTextureByAge(Age) then 1663 EOT.Invalidate; // has visible background parts in its bounds 1664 end; 1665 // age:=MyRO.Turn mod 4; //!!! 1666 if ClientMode = cMovieTurn then 1667 EOT.ButtonIndex := eotCancel 1668 else if ClientMode < scContact then 1669 EOT.ButtonIndex := eotGray 1670 else 1671 EOT.ButtonIndex := eotBackToNego; 1672 end 1582 1673 else 1583 begin 1584 NewAgeCenterTo:=1; 1585 Loc1:=dLoc(Loc1,-dx,dy); 1586 end 1674 begin 1675 Age := 0; 1676 SetMainTextureByAge(-1); 1677 if ClientMode = cMovieTurn then 1678 EOT.ButtonIndex := eotCancel 1679 else 1680 EOT.ButtonIndex := eotBlinkOn; 1587 1681 end; 1588 Centre(Loc1) 1589 end; 1590 1591 for i:=0 to Screen.FormCount-1 do 1592 if Screen.Forms[i] is TBufferedDrawDlg then 1593 Screen.Forms[i].Enabled:=true; 1594 1595 if ClientMode<>cResume then 1596 begin 1597 PaintAll; 1598 if (MyRO.Happened and phChangeGov<>0) and (MyRO.NatBuilt[imPalace]>0) then 1599 ImpImage(Panel.Canvas, ClientWidth-xPalace, yPalace, imPalace, gAnarchy{, GameMode<>cMovie}); 1600 // first turn after anarchy -- don't show despotism palace! 1601 Update; 1602 for i:=0 to Screen.FormCount-1 do 1603 if (Screen.Forms[i].Visible) and (Screen.Forms[i] is TBufferedDrawDlg) then 1604 begin 1605 if @Screen.Forms[i].OnShow<>nil then 1606 Screen.Forms[i].OnShow(nil); 1607 Screen.Forms[i].Invalidate; 1608 Screen.Forms[i].Update; 1609 end; 1610 1611 if MyRO.Happened and phGameEnd<>0 then 1612 with MessgExDlg do 1613 begin // game ended 1614 if MyRO.Happened and phExtinct<>0 then 1682 InitCityMark(MainTexture); 1683 CityDlg.CheckAge; 1684 NatStatDlg.CheckAge; 1685 UnitStatDlg.CheckAge; 1686 HelpDlg.Difficulty := G.Difficulty[me]; 1687 1688 UnFocus := -1; 1689 MarkCityLoc := -1; 1690 BlinkON := false; 1691 BlinkTime := -1; 1692 Tracking := false; 1693 TurnComplete := false; 1694 1695 if (ToldSlavery < 0) or 1696 ((ToldSlavery = 1) <> (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) 1697 then 1698 begin 1699 if MyRO.Wonder[woPyramids].EffectiveOwner >= 0 then 1700 ToldSlavery := 1 1701 else 1702 ToldSlavery := 0; 1703 for p1 := 0 to nPl - 1 do 1704 if (Tribe[p1] <> nil) and (Tribe[p1].mixSlaves >= 0) then 1705 with Picture do 1706 begin // replace unit picture 1707 mix := Tribe[p1].mixSlaves; 1708 if ToldSlavery = 1 then 1709 pix := pixSlaves 1710 else 1711 pix := pixNoSlaves; 1712 Hash := 0; 1713 GrName := 'StdUnits'; 1714 Tribe[p1].SetModelPicture(Picture, true); 1715 end 1716 end; 1717 1718 if not supervising and (ClientMode = cTurn) then 1719 begin 1720 for cix := 0 to MyRO.nCity - 1 do 1721 if (MyCity[cix].Loc >= 0) and 1722 ((MyRO.Turn = 0) or (MyCity[cix].Flags and chFounded <> 0)) then 1723 MyCity[cix].Status := MyCity[cix].Status and 1724 not csResourceWeightsMask or (3 shl 4); 1725 // new city, set to maximum growth 1726 end; 1727 if (ClientMode = cTurn) or (ClientMode = cContinue) then 1728 CityOptimizer_BeginOfTurn; // maybe peace was made or has ended 1729 SumCities(TaxSum, ScienceSum); 1730 1731 if ClientMode = cMovieTurn then 1732 begin 1733 UnitInfoBtn.Visible := false; 1734 UnitBtn.Visible := false; 1735 TerrainBtn.Visible := false; 1736 EOT.Hint := Phrases.Lookup('BTN_STOP'); 1737 EOT.Visible := true; 1738 end 1739 else if ClientMode < scContact then 1740 begin 1741 UnitInfoBtn.Visible := UnFocus >= 0; 1742 UnitBtn.Visible := UnFocus >= 0; 1743 CheckTerrainBtnVisible; 1744 TurnComplete := supervising; 1745 EOT.Hint := Phrases.Lookup('BTN_ENDTURN'); 1746 EOT.Visible := Server(sTurn - sExecute, me, 0, nil^) >= rExecuted; 1747 end 1748 else 1749 begin 1750 UnitInfoBtn.Visible := false; 1751 UnitBtn.Visible := false; 1752 TerrainBtn.Visible := false; 1753 EOT.Hint := Phrases.Lookup('BTN_NEGO'); 1754 EOT.Visible := true; 1755 end; 1756 SetTroopLoc(-1); 1757 MapValid := false; 1758 NewAgeCenterTo := 0; 1759 if ((MyRO.Turn = 0) and not supervising or IsMultiPlayerGame or 1760 (ClientMode = cResume)) and (MyRO.nCity > 0) then 1761 begin 1762 Loc1 := MyCity[0].Loc; 1763 if (ClientMode = cTurn) and (MyRO.Turn = 0) then 1764 begin // move city out of center to not be covered by welcome screen 1765 dx := MapWidth div (xxt * 5); 1766 if dx > 5 then 1767 dx := 5; 1768 dy := MapHeight div (yyt * 5); 1769 if dy > 5 then 1770 dy := 5; 1771 if Loc1 >= G.lx * G.ly div 2 then 1615 1772 begin 1616 OpenSound:='MSG_GAMEOVER'; 1617 MessgText:=Tribe[me].TPhrase('GAMEOVER'); 1618 IconKind:=mikBigIcon; 1619 IconIndex:=8; 1773 NewAgeCenterTo := -1; 1774 Loc1 := dLoc(Loc1, -dx, -dy) 1620 1775 end 1621 else if MyRO.Happened and phShipComplete<>0 then1776 else 1622 1777 begin 1623 Winners:=0; 1624 for p1:=0 to nPl-1 do if 1 shl p1 and MyRO.Alive<>0 then 1778 NewAgeCenterTo := 1; 1779 Loc1 := dLoc(Loc1, -dx, dy); 1780 end 1781 end; 1782 Centre(Loc1) 1783 end; 1784 1785 for i := 0 to Screen.FormCount - 1 do 1786 if Screen.Forms[i] is TBufferedDrawDlg then 1787 Screen.Forms[i].Enabled := true; 1788 1789 if ClientMode <> cResume then 1790 begin 1791 PaintAll; 1792 if (MyRO.Happened and phChangeGov <> 0) and (MyRO.NatBuilt[imPalace] > 0) 1793 then 1794 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, 1795 gAnarchy { , GameMode<>cMovie } ); 1796 // first turn after anarchy -- don't show despotism palace! 1797 Update; 1798 for i := 0 to Screen.FormCount - 1 do 1799 if (Screen.Forms[i].Visible) and (Screen.Forms[i] is TBufferedDrawDlg) 1800 then 1801 begin 1802 if @Screen.Forms[i].OnShow <> nil then 1803 Screen.Forms[i].OnShow(nil); 1804 Screen.Forms[i].Invalidate; 1805 Screen.Forms[i].Update; 1806 end; 1807 1808 if MyRO.Happened and phGameEnd <> 0 then 1809 with MessgExDlg do 1810 begin // game ended 1811 if MyRO.Happened and phExtinct <> 0 then 1625 1812 begin 1626 Winners:=Winners or 1 shl p1; 1627 for i:=0 to nShipPart-1 do 1628 if MyRO.Ship[p1].Parts[i]<ShipNeed[i] then 1629 Winners:=Winners and not (1 shl p1); 1813 OpenSound := 'MSG_GAMEOVER'; 1814 MessgText := Tribe[me].TPhrase('GAMEOVER'); 1815 IconKind := mikBigIcon; 1816 IconIndex := 8; 1817 end 1818 else if MyRO.Happened and phShipComplete <> 0 then 1819 begin 1820 Winners := 0; 1821 for p1 := 0 to nPl - 1 do 1822 if 1 shl p1 and MyRO.Alive <> 0 then 1823 begin 1824 Winners := Winners or 1 shl p1; 1825 for i := 0 to nShipPart - 1 do 1826 if MyRO.Ship[p1].Parts[i] < ShipNeed[i] then 1827 Winners := Winners and not(1 shl p1); 1828 end; 1829 assert(Winners <> 0); 1830 if Winners and (1 shl me) <> 0 then 1831 begin 1832 s := ''; 1833 for p1 := 0 to nPl - 1 do 1834 if (p1 <> me) and (1 shl p1 and Winners <> 0) then 1835 if s = '' then 1836 s := Tribe[p1].TPhrase('SHORTNAME') 1837 else 1838 s := Format(Phrases.Lookup('SHAREDWIN_CONCAT'), 1839 [s, Tribe[p1].TPhrase('SHORTNAME')]); 1840 1841 OpenSound := 'MSG_YOUWIN'; 1842 MessgText := Tribe[me].TPhrase('MYSPACESHIP'); 1843 if s <> '' then 1844 MessgText := MessgText + '\' + 1845 Format(Phrases.Lookup('SHAREDWIN'), [s]); 1846 IconKind := mikBigIcon; 1847 IconIndex := 9; 1848 end 1849 else 1850 begin 1851 assert(me = 0); 1852 OpenSound := 'MSG_GAMEOVER'; 1853 MessgText := ''; 1854 for p1 := 0 to nPl - 1 do 1855 if Winners and (1 shl p1) <> 0 then 1856 MessgText := MessgText + Tribe[p1].TPhrase('SPACESHIP1'); 1857 MessgText := MessgText + '\' + Phrases.Lookup('SPACESHIP2'); 1858 IconKind := mikEnemyShipComplete; 1859 end 1860 end 1861 else { if MyRO.Happened and fTimeUp<>0 then } 1862 begin 1863 assert(me = 0); 1864 OpenSound := 'MSG_GAMEOVER'; 1865 if not supervising then 1866 MessgText := Tribe[me].TPhrase('TIMEUP') 1867 else 1868 MessgText := Phrases.Lookup('TIMEUPSUPER'); 1869 IconKind := mikImp; 1870 IconIndex := 22; 1630 1871 end; 1631 assert(Winners<>0); 1632 if Winners and (1 shl me)<>0 then 1872 Kind := mkOk; 1873 ShowModal; 1874 if MyRO.Happened and phExtinct = 0 then 1633 1875 begin 1634 s:=''; 1635 for p1:=0 to nPl-1 do 1636 if (p1<>me) and (1 shl p1 and Winners<>0) then 1637 if s='' then s:=Tribe[p1].TPhrase('SHORTNAME') 1638 else s:=Format(Phrases.Lookup('SHAREDWIN_CONCAT'), 1639 [s,Tribe[p1].TPhrase('SHORTNAME')]); 1640 1641 OpenSound:='MSG_YOUWIN'; 1642 MessgText:=Tribe[me].TPhrase('MYSPACESHIP'); 1643 if s<>'' then 1644 MessgText:=MessgText+'\'+Format(Phrases.Lookup('SHAREDWIN'),[s]); 1645 IconKind:=mikBigIcon; 1646 IconIndex:=9; 1876 p1 := 0; 1877 while (p1 < nPl - 1) and (Winners and (1 shl p1) = 0) do 1878 inc(p1); 1879 if MyRO.Happened and phShipComplete = 0 then 1880 DiaDlg.ShowNewContent_Charts(wmModal); 1881 end; 1882 TurnComplete := true; 1883 exit; 1884 end; 1885 if not supervising and (1 shl me and MyRO.Alive = 0) then 1886 begin 1887 TurnComplete := true; 1888 exit; 1889 end; 1890 1891 if (ClientMode = cContinue) and 1892 (DipMem[me].SentCommand and $FF0F = scContact) then 1893 // contact was refused 1894 if MyRO.Treaty[DipMem[me].pContact] >= trPeace then 1895 ContactRefused(DipMem[me].pContact, 'FRREJECTED') 1896 else 1897 SoundMessage(Tribe[DipMem[me].pContact].TPhrase('FRREJECTED'), 1898 'NEGO_REJECTED'); 1899 1900 if not supervising and (Age > MyData.ToldAge) and 1901 ((Age > 0) or (ClientMode <> cMovieTurn)) then 1902 with MessgExDlg do 1903 begin 1904 if Age = 0 then 1905 begin 1906 if Phrases2FallenBackToEnglish then 1907 begin 1908 s := Tribe[me].TPhrase('AGE0'); 1909 MessgText := 1910 Format(s, [TurnToString(MyRO.Turn), CityName(MyCity[0].ID)]) 1911 end 1912 else 1913 begin 1914 s := Tribe[me].TString(Phrases2.Lookup('AGE0')); 1915 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1916 end 1647 1917 end 1648 else1918 else 1649 1919 begin 1650 assert(me=0); 1651 OpenSound:='MSG_GAMEOVER'; 1652 MessgText:=''; 1653 for p1:=0 to nPl-1 do if Winners and (1 shl p1)<>0 then 1654 MessgText:=MessgText+Tribe[p1].TPhrase('SPACESHIP1'); 1655 MessgText:=MessgText+'\'+Phrases.Lookup('SPACESHIP2'); 1656 IconKind:=mikEnemyShipComplete; 1920 s := Tribe[me].TPhrase('AGE' + char(48 + Age)); 1921 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1922 end; 1923 IconKind := mikAge; 1924 IconIndex := Age; 1925 { if age=0 then } Kind := mkOk 1926 { else begin Kind:=mkOkHelp; HelpKind:=hkAdv; HelpNo:=AgePreq[age]; end }; 1927 CenterTo := NewAgeCenterTo; 1928 OpenSound := 'AGE_' + char(48 + Age); 1929 ShowModal; 1930 MyData.ToldAge := Age; 1931 if Age > 0 then 1932 MyData.ToldTech[AgePreq[Age]] := MyRO.Tech[AgePreq[Age]]; 1933 end; 1934 1935 if MyData.ToldAlive <> MyRO.Alive then 1936 begin 1937 for p1 := 0 to nPl - 1 do 1938 if (MyData.ToldAlive - MyRO.Alive) and (1 shl p1) <> 0 then 1939 with MessgExDlg do 1940 begin 1941 OpenSound := 'MSG_EXTINCT'; 1942 s := Tribe[p1].TPhrase('EXTINCT'); 1943 MessgText := Format(s, [TurnToString(MyRO.Turn)]); 1944 if MyRO.Alive = 1 shl me then 1945 MessgText := MessgText + Phrases.Lookup('EXTINCTALL'); 1946 Kind := mkOk; 1947 IconKind := mikImp; 1948 IconIndex := 21; 1949 ShowModal; 1950 end; 1951 if (ClientMode <> cMovieTurn) and not supervising then 1952 DiaDlg.ShowNewContent_Charts(wmModal); 1953 end; 1954 1955 // tell changes of own credibility 1956 if not supervising then 1957 begin 1958 if RoughCredibility(MyRO.Credibility) <> 1959 RoughCredibility(MyData.ToldOwnCredibility) then 1960 begin 1961 if RoughCredibility(MyRO.Credibility) > 1962 RoughCredibility(MyData.ToldOwnCredibility) then 1963 s := Phrases.Lookup('CREDUP') 1964 else 1965 s := Phrases.Lookup('CREDDOWN'); 1966 TribeMessage(me, 1967 Format(s, [Phrases.Lookup('CREDIBILITY', 1968 RoughCredibility(MyRO.Credibility))]), ''); 1969 end; 1970 MyData.ToldOwnCredibility := MyRO.Credibility; 1971 end; 1972 1973 for i := 0 to 27 do 1974 begin 1975 OwnWonder := false; 1976 for cix := 0 to MyRO.nCity - 1 do 1977 if (MyCity[cix].Loc >= 0) and 1978 (MyCity[cix].ID = MyRO.Wonder[i].CityID) then 1979 OwnWonder := true; 1980 if MyRO.Wonder[i].CityID <> MyData.ToldWonders[i].CityID then 1981 begin 1982 if MyRO.Wonder[i].CityID = -2 then 1983 with MessgExDlg do 1984 begin { tell about destroyed wonders } 1985 OpenSound := 'WONDER_DESTROYED'; 1986 MessgText := Format(Phrases.Lookup('WONDERDEST'), 1987 [Phrases.Lookup('IMPROVEMENTS', i)]); 1988 Kind := mkOkHelp; 1989 HelpKind := hkImp; 1990 HelpNo := i; 1991 IconKind := mikImp; 1992 IconIndex := i; 1993 ShowModal; 1994 end 1995 else 1996 begin 1997 if i = woManhattan then 1998 if MyRO.Wonder[i].EffectiveOwner > me then 1999 MyData.ColdWarStart := MyRO.Turn - 1 2000 else 2001 MyData.ColdWarStart := MyRO.Turn; 2002 if not OwnWonder then 2003 with MessgExDlg do 2004 begin { tell about newly built wonders } 2005 if i = woManhattan then 2006 begin 2007 OpenSound := 'MSG_COLDWAR'; 2008 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('COLDWAR') 2009 end 2010 else if MyRO.Wonder[i].EffectiveOwner >= 0 then 2011 begin 2012 OpenSound := 'WONDER_BUILT'; 2013 s := Tribe[MyRO.Wonder[i].EffectiveOwner] 2014 .TPhrase('WONDERBUILT') 2015 end 2016 else 2017 begin 2018 OpenSound := 'MSG_DEFAULT'; 2019 s := Phrases.Lookup('WONDERBUILTEXP'); 2020 // already expired when built 2021 end; 2022 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i), 2023 CityName(MyRO.Wonder[i].CityID)]); 2024 Kind := mkOkHelp; 2025 HelpKind := hkImp; 2026 HelpNo := i; 2027 IconKind := mikImp; 2028 IconIndex := i; 2029 ShowModal; 2030 end 1657 2031 end 1658 2032 end 1659 else {if MyRO.Happened and fTimeUp<>0 then} 2033 else if (MyRO.Wonder[i].EffectiveOwner <> MyData.ToldWonders[i] 2034 .EffectiveOwner) and (MyRO.Wonder[i].CityID > -2) then 2035 if MyRO.Wonder[i].EffectiveOwner < 0 then 2036 begin 2037 if i <> woMIR then 2038 with MessgExDlg do 2039 begin { tell about expired wonders } 2040 OpenSound := 'WONDER_EXPIRED'; 2041 MessgText := Format(Phrases.Lookup('WONDEREXP'), 2042 [Phrases.Lookup('IMPROVEMENTS', i), 2043 CityName(MyRO.Wonder[i].CityID)]); 2044 Kind := mkOkHelp; 2045 HelpKind := hkImp; 2046 HelpNo := i; 2047 IconKind := mikImp; 2048 IconIndex := i; 2049 ShowModal; 2050 end 2051 end 2052 else if (MyData.ToldWonders[i].EffectiveOwner >= 0) and not OwnWonder 2053 then 2054 with MessgExDlg do 2055 begin { tell about capture of wonders } 2056 OpenSound := 'WONDER_CAPTURED'; 2057 s := Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERCAPT'); 2058 MessgText := Format(s, [Phrases.Lookup('IMPROVEMENTS', i), 2059 CityName(MyRO.Wonder[i].CityID)]); 2060 Kind := mkOkHelp; 2061 HelpKind := hkImp; 2062 HelpNo := i; 2063 IconKind := mikImp; 2064 IconIndex := i; 2065 ShowModal; 2066 end; 2067 end; 2068 2069 if MyRO.Turn = MyData.ColdWarStart + ColdWarTurns then 2070 begin 2071 SoundMessageEx(Phrases.Lookup('COLDWAREND'), 'MSG_DEFAULT'); 2072 MyData.ColdWarStart := -ColdWarTurns - 1 2073 end; 2074 2075 TellNewModels; 2076 end; // ClientMode<>cResume 2077 MyData.ToldAlive := MyRO.Alive; 2078 move(MyRO.Wonder, MyData.ToldWonders, SizeOf(MyData.ToldWonders)); 2079 2080 NewGovAvailable := -1; 2081 if ClientMode <> cResume then 2082 begin // tell about new techs 2083 for ad := 0 to nAdv - 1 do 2084 if (MyRO.TestFlags and tfAllTechs = 0) and 2085 ((MyRO.Tech[ad] >= tsApplicable) <> 2086 (MyData.ToldTech[ad] >= tsApplicable)) or (ad in FutureTech) and 2087 (MyRO.Tech[ad] <> MyData.ToldTech[ad]) then 2088 with MessgExDlg do 2089 begin 2090 Item := 'RESEARCH_GENERAL'; 2091 if GameMode <> cMovie then 2092 OpenSound := 'NEWADVANCE_' + char(48 + Age); 2093 Item2 := Phrases.Lookup('ADVANCES', ad); 2094 if ad in FutureTech then 2095 Item2 := Item2 + ' ' + IntToStr(MyRO.Tech[ad]); 2096 MessgText := Format(Phrases.Lookup(Item), [Item2]); 2097 Kind := mkOkHelp; 2098 HelpKind := hkAdv; 2099 HelpNo := ad; 2100 IconKind := mikBook; 2101 IconIndex := -1; 2102 for i := 0 to nAdvBookIcon - 1 do 2103 if AdvBookIcon[i].Adv = ad then 2104 IconIndex := AdvBookIcon[i].Icon; 2105 ShowModal; 2106 MyData.ToldTech[ad] := MyRO.Tech[ad]; 2107 for i := gMonarchy to nGov - 1 do 2108 if GovPreq[i] = ad then 2109 NewGovAvailable := i; 2110 end; 2111 end; 2112 2113 ShowCityList := false; 2114 if ClientMode = cTurn then 2115 begin 2116 if (MyRO.Happened and phTech <> 0) and (MyData.FarTech <> adNexus) then 2117 ChooseResearch; 2118 2119 UpdatePanel := false; 2120 if MyRO.Happened and phChangeGov <> 0 then 2121 begin 2122 ModalSelectDlg.ShowNewContent(wmModal, kGov); 2123 Play('NEWGOV'); 2124 Server(sSetGovernment, me, ModalSelectDlg.result, nil^); 2125 CityOptimizer_BeginOfTurn; 2126 UpdatePanel := true; 2127 end; 2128 end; // ClientMode=cTurn 2129 2130 if not supervising and ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) 2131 then 2132 for cix := 0 to MyRO.nCity - 1 do 2133 with MyCity[cix] do 2134 Status := Status and not csToldBombard; 2135 2136 if ((ClientMode = cTurn) or (ClientMode = cMovieTurn)) and 2137 (MyRO.Government <> gAnarchy) then 2138 begin 2139 // tell what happened in cities 2140 for WondersOnly := true downto false do 2141 for cix := 0 to MyRO.nCity - 1 do 2142 with MyCity[cix] do 2143 if (MyRO.Turn > 0) and (Loc >= 0) and (Flags and chCaptured = 0) 2144 and (WondersOnly = (Flags and chProduction <> 0) and 2145 (Project0 and cpImp <> 0) and (Project0 and cpIndex < 28)) then 2146 begin 2147 if WondersOnly then 2148 with MessgExDlg do 2149 begin { tell about newly built wonder } 2150 OpenSound := 'WONDER_BUILT'; 2151 s := Tribe[me].TPhrase('WONDERBUILTOWN'); 2152 MessgText := 2153 Format(s, [Phrases.Lookup('IMPROVEMENTS', 2154 Project0 and cpIndex), CityName(ID)]); 2155 Kind := mkOkHelp; 2156 HelpKind := hkImp; 2157 HelpNo := Project0 and cpIndex; 2158 IconKind := mikImp; 2159 IconIndex := Project0 and cpIndex; 2160 ShowModal; 2161 end; 2162 if not supervising and (ClientMode = cTurn) then 2163 begin 2164 AllowCityScreen := true; 2165 if (Status and 7 <> 0) and 2166 (Project and (cpImp + cpIndex) = cpImp + imTrGoods) then 2167 if (MyData.ImpOrder[Status and 7 - 1, 0] >= 0) then 2168 begin 2169 if AutoBuild(cix, MyData.ImpOrder[Status and 7 - 1]) then 2170 AllowCityScreen := false 2171 else if Flags and chProduction <> 0 then 2172 Flags := (Flags and not chProduction) or chAllImpsMade 2173 end 2174 else 2175 Flags := Flags or chTypeDel; 2176 if (Size >= NeedAqueductSize) and 2177 (MyRO.Tech[Imp[imAqueduct].Preq] < tsApplicable) or 2178 (Size >= NeedSewerSize) and 2179 (MyRO.Tech[Imp[imSewer].Preq] < tsApplicable) then 2180 Flags := Flags and not chNoGrowthWarning; 2181 // don't remind of unknown building 2182 if Flags and chNoSettlerProd = 0 then 2183 Status := Status and not csToldDelay 2184 else if Status and csToldDelay = 0 then 2185 Status := Status or csToldDelay 2186 else 2187 Flags := Flags and not chNoSettlerProd; 2188 if mRepScreens.Checked then 2189 begin 2190 if (Flags and CityRepMask <> 0) and AllowCityScreen then 2191 begin { show what happened in cities } 2192 SetTroopLoc(MyCity[cix].Loc); 2193 MarkCityLoc := MyCity[cix].Loc; 2194 PanelPaint; 2195 CityDlg.CloseAction := None; 2196 CityDlg.ShowNewContent(wmModal, MyCity[cix].Loc, 2197 Flags and CityRepMask); 2198 UpdatePanel := true; 2199 end 2200 end 2201 else { if mRepList.Checked then } 2202 begin 2203 if Flags and CityRepMask <> 0 then 2204 ShowCityList := true 2205 end 2206 end 2207 end; { city loop } 2208 end; // ClientMode=cTurn 2209 2210 if ClientMode = cTurn then 2211 begin 2212 if NewGovAvailable >= 0 then 2213 with MessgExDlg do 1660 2214 begin 1661 assert(me=0); 1662 OpenSound:='MSG_GAMEOVER'; 1663 if not supervising then MessgText:=Tribe[me].TPhrase('TIMEUP') 1664 else MessgText:=Phrases.Lookup('TIMEUPSUPER'); 1665 IconKind:=mikImp; 1666 IconIndex:=22; 2215 MessgText := Format(Phrases.Lookup('AUTOREVOLUTION'), 2216 [Phrases.Lookup('GOVERNMENT', NewGovAvailable)]); 2217 Kind := mkYesNo; 2218 IconKind := mikPureIcon; 2219 IconIndex := 6 + NewGovAvailable; 2220 ShowModal; 2221 if ModalResult = mrOK then 2222 begin 2223 Play('REVOLUTION'); 2224 Server(sRevolution, me, 0, nil^); 2225 end 1667 2226 end; 1668 Kind:=mkOK; 1669 ShowModal; 1670 if MyRO.Happened and phExtinct=0 then 2227 end; // ClientMode=cTurn 2228 2229 if (ClientMode = cTurn) or (ClientMode = cMovieTurn) then 2230 begin 2231 if MyRO.Happened and phGliderLost <> 0 then 2232 ContextMessage(Phrases.Lookup('GLIDERLOST'), 'MSG_DEFAULT', 2233 hkModel, 200); 2234 if MyRO.Happened and phPlaneLost <> 0 then 2235 ContextMessage(Phrases.Lookup('PLANELOST'), 'MSG_DEFAULT', 2236 hkFeature, mcFuel); 2237 if MyRO.Happened and phPeaceEvacuation <> 0 then 2238 for p1 := 0 to nPl - 1 do 2239 if 1 shl p1 and MyData.PeaceEvaHappened <> 0 then 2240 SoundMessageEx(Tribe[p1].TPhrase('WITHDRAW'), 'MSG_DEFAULT'); 2241 if MyRO.Happened and phPeaceViolation <> 0 then 2242 for p1 := 0 to nPl - 1 do 2243 if (1 shl p1 and MyRO.Alive <> 0) and (MyRO.EvaStart[p1] = MyRO.Turn) 2244 then 2245 SoundMessageEx(Format(Tribe[p1].TPhrase('VIOLATION'), 2246 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW'); 2247 TellNewContacts; 2248 end; 2249 2250 if ClientMode = cMovieTurn then 2251 Update 2252 else if ClientMode = cTurn then 2253 begin 2254 if UpdatePanel then 2255 UpdateViews; 2256 Application.ProcessMessages; 2257 2258 if not supervising then 2259 for uix := 0 to MyRO.nUn - 1 do 2260 with MyUn[uix] do 2261 if Loc >= 0 then 2262 begin 2263 if Flags and unWithdrawn <> 0 then 2264 Status := 0; 2265 if Health = 100 then 2266 Status := Status and not usRecover; 2267 if (Master >= 0) or UnitExhausted(uix) then 2268 Status := Status and not usWaiting 2269 else 2270 Status := Status or usWaiting; 2271 CheckToldNoReturn(uix); 2272 if Status and usGoto <> 0 then 2273 begin { continue multi-turn goto } 2274 SetUnFocus(uix); 2275 SetTroopLoc(Loc); 2276 FocusOnLoc(TroopLoc, flRepaintPanel or flImmUpdate); 2277 if Status shr 16 = $7FFF then 2278 MoveResult := GetMoveAdvice(UnFocus, maNextCity, 2279 MoveAdviceData) 2280 else 2281 MoveResult := GetMoveAdvice(UnFocus, Status shr 16, 2282 MoveAdviceData); 2283 if MoveResult >= rExecuted then 2284 begin // !!! Shinkansen 2285 MoveResult := eOK; 2286 ok := true; 2287 for i := 0 to MoveAdviceData.nStep - 1 do 2288 begin 2289 Loc1 := dLoc(Loc, MoveAdviceData.dx[i], 2290 MoveAdviceData.dy[i]); 2291 if (MyMap[Loc1] and (fCity or fOwned) = fCity) 2292 // don't capture cities during auto move 2293 or (MyMap[Loc1] and (fUnit or fOwned) = fUnit) then 2294 // don't attack during auto move 2295 begin 2296 ok := false; 2297 Break 2298 end 2299 else 2300 begin 2301 if (Loc1 = MoveAdviceData.ToLoc) or 2302 (MoveAdviceData.ToLoc = maNextCity) and 2303 (MyMap[dLoc(Loc, MoveAdviceData.dx[i], 2304 MoveAdviceData.dy[i])] and fCity <> 0) then 2305 MoveOptions := muAutoNoWait 2306 else 2307 MoveOptions := 0; 2308 MoveResult := MoveUnit(MoveAdviceData.dx[i], 2309 MoveAdviceData.dy[i], MoveOptions); 2310 if (MoveResult < rExecuted) or 2311 (MoveResult = eEnemySpotted) then 2312 begin 2313 ok := false; 2314 Break 2315 end; 2316 end 2317 end; 2318 Stop := not ok or (Loc = MoveAdviceData.ToLoc) or 2319 (MoveAdviceData.ToLoc = maNextCity) and 2320 (MyMap[Loc] and fCity <> 0) 2321 end 2322 else 2323 begin 2324 MoveResult := eOK; 2325 Stop := true; 2326 end; 2327 2328 if MoveResult <> eDied then 2329 if Stop then 2330 Status := Status and ($FFFF - usGoto) 2331 else 2332 Status := Status and not usWaiting; 2333 end; 2334 2335 if Status and (usEnhance or usGoto) = usEnhance then 2336 // continue terrain enhancement 2337 begin 2338 MoveResult := ProcessEnhancement(uix, MyData.EnhancementJobs); 2339 if MoveResult <> eDied then 2340 if MoveResult = eJobDone then 2341 Status := Status and not usEnhance 2342 else 2343 Status := Status and not usWaiting; 2344 end 2345 end; 2346 end; // ClientMode=cTurn 2347 2348 HaveStrategyAdvice := false; 2349 // (GameMode<>cMovie) and not supervising 2350 // and AdvisorDlg.HaveStrategyAdvice; 2351 GoOnPhase := true; 2352 if supervising or (GameMode = cMovie) then 2353 begin 2354 SetTroopLoc(-1); 2355 PaintAll 2356 end { supervisor } 2357 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then 2358 begin 2359 SetUnFocus(0); 2360 ZoomToCity(MyCity[0].Loc) 2361 end } 2362 else 2363 begin 2364 if ClientMode >= scContact then 2365 SetUnFocus(-1) 2366 else 2367 NextUnit(-1, false); 2368 if UnFocus < 0 then 2369 begin 2370 UnStartLoc := -1; 2371 if IsMultiPlayerGame or (ClientMode = cResume) then 2372 if MyRO.nCity > 0 then 2373 FocusOnLoc(MyCity[0].Loc) 2374 else 2375 FocusOnLoc(G.lx * G.ly div 2); 2376 SetTroopLoc(-1); 2377 PanelPaint 2378 end; 2379 if ShowCityList then 2380 ListDlg.ShowNewContent(wmPersistent, kCityEvents); 2381 end; 2382 end; { InitTurn } 2383 2384 var 2385 i, j, p1, mix, ToLoc, AnimationSpeed, ShowMoveDomain, cix, ecix: integer; 2386 Color: TColor; 2387 Name, s: string; 2388 TribeInfo: TTribeInfo; 2389 mi: TModelInfo; 2390 SkipTurn, IsAlpine, IsTreatyDeal: boolean; 2391 2392 begin { >>>client } 2393 case Command of 2394 cTurn, cResume, cContinue, cMovieTurn, scContact, 2395 scDipStart .. scDipBreak: 2396 begin 2397 supervising := G.Difficulty[NewPlayer] = 0; 2398 ArrangeMidPanel; 2399 end 2400 end; 2401 case Command of 2402 cDebugMessage: 2403 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(@Data)); 2404 2405 cShowNego: 2406 with TShowNegoData(Data) do 2407 begin 2408 s := Format('P%d to P%d: ', [pSender, pTarget]); 2409 if (Action = scDipOffer) and (Offer.nDeliver + Offer.nCost > 0) then 1671 2410 begin 1672 p1:=0; 1673 while (p1<nPl-1) and (Winners and (1 shl p1)=0) do inc(p1); 1674 if MyRO.Happened and phShipComplete=0 then 1675 DiaDlg.ShowNewContent_Charts(wmModal); 2411 s := s + 'Offer '; 2412 for i := 0 to Offer.nDeliver + Offer.nCost - 1 do 2413 begin 2414 if i = Offer.nDeliver then 2415 s := s + ' for ' 2416 else if i > 0 then 2417 s := s + '+'; 2418 case Offer.Price[i] and opMask of 2419 opChoose: 2420 s := s + 'Price of choice'; 2421 opCivilReport: 2422 s := s + 'State report'; 2423 opMilReport: 2424 s := s + 'Military report'; 2425 opMap: 2426 s := s + 'Map'; 2427 opTreaty: 2428 s := s + 'Treaty'; 2429 opShipParts: 2430 s := s + 'Ship part'; 2431 opMoney: 2432 s := s + IntToStr(Offer.Price[i] and $FFFFFF) + 'o'; 2433 opTribute: 2434 s := s + IntToStr(Offer.Price[i] and $FFFFFF) + 'o tribute'; 2435 opTech: 2436 s := s + Phrases.Lookup('ADVANCES', 2437 Offer.Price[i] and $FFFFFF); 2438 opAllTech: 2439 s := s + 'All advances'; 2440 opModel: 2441 s := s + Tribe[pSender].ModelName[Offer.Price[i] and $FFFFFF]; 2442 opAllModel: 2443 s := s + 'All models'; 2444 end 2445 end; 2446 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2447 end 2448 else if Action = scDipAccept then 2449 begin 2450 s := s + '--- ACCEPTED! ---'; 2451 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2452 end 2453 end; 2454 2455 cInitModule: 2456 begin 2457 Server := TInitModuleData(Data).Server; 2458 // AdvisorDlg.Init; 2459 InitModule; 2460 TInitModuleData(Data).DataSize := SizeOf(TPersistentData); 2461 TInitModuleData(Data).Flags := aiThreaded; 2462 end; 2463 2464 cReleaseModule: 2465 begin 2466 SmallImp.free; 2467 UnusedTribeFiles.free; 2468 TribeNames.free; 2469 MainMap.free; 2470 IsoEngine.Done; 2471 // AdvisorDlg.DeInit; 2472 end; 2473 2474 cHelpOnly, cStartHelp, cStartCredits: 2475 begin 2476 Age := 0; 2477 if Command = cHelpOnly then 2478 SetMainTextureByAge(-1); 2479 Tribes.Init; 2480 HelpDlg.UserLeft := (Screen.width - HelpDlg.width) div 2; 2481 HelpDlg.UserTop := (Screen.height - HelpDlg.height) div 2; 2482 HelpDlg.Difficulty := 0; 2483 if Command = cStartCredits then 2484 HelpDlg.ShowNewContent(wmModal, hkMisc, miscCredits) 2485 else 2486 HelpDlg.ShowNewContent(wmModal, hkMisc, miscMain); 2487 Tribes.Done; 2488 end; 2489 2490 cNewGame, cLoadGame, cMovie, cNewMap: 2491 begin 2492 { if (Command=cNewGame) or (Command=cLoadGame) then 2493 AdvisorDlg.NewGame(Data); } 2494 GenerateNames := mNames.Checked; 2495 GameOK := true; 2496 G := TNewGameData(Data); 2497 me := -1; 2498 pLogo := -1; 2499 ClientMode := -1; 2500 SetMapOptions; 2501 IsoEngine.pDebugMap := -1; 2502 idle := false; 2503 FillChar(Jump, SizeOf(Jump), 0); 2504 if StartRunning then 2505 Jump[0] := 999999; 2506 GameMode := Command; 2507 for i := 0 to nGrExt - 1 do 2508 FillChar(GrExt[i].pixUsed, GrExt[i].Data.height div 49 * 10, 0); 2509 IsoEngine.Reset; 2510 Tribes.Init; 2511 GetTribeList; 2512 for p1 := 0 to nPl - 1 do 2513 if (G.RO[p1] <> nil) and (G.RO[p1].Data <> nil) then 2514 with TPersistentData(G.RO[p1].Data^) do 2515 begin 2516 FarTech := adNone; 2517 FillChar(EnhancementJobs, SizeOf(EnhancementJobs), jNone); 2518 FillChar(ImpOrder, SizeOf(ImpOrder), -1); 2519 ColdWarStart := -ColdWarTurns - 1; 2520 ToldAge := -1; 2521 ToldModels := 3; 2522 ToldAlive := 0; 2523 ToldContact := 0; 2524 ToldOwnCredibility := InitialCredibility; 2525 for i := 0 to nPl - 1 do 2526 if G.Difficulty[i] > 0 then 2527 inc(ToldAlive, 1 shl i); 2528 PeaceEvaHappened := 0; 2529 for i := 0 to 27 do 2530 with ToldWonders[i] do 2531 begin 2532 CityID := -1; 2533 EffectiveOwner := -1 2534 end; 2535 FillChar(ToldTech, SizeOf(ToldTech), tsNA); 2536 if G.Difficulty[p1] > 0 then 2537 SoundPreload(sbStart); 2538 end; 2539 2540 // arrange dialogs 2541 ListDlg.UserLeft := 8; 2542 ListDlg.UserTop := TopBarHeight + 8; 2543 HelpDlg.UserLeft := Screen.width - HelpDlg.width - 8; 2544 HelpDlg.UserTop := TopBarHeight + 8; 2545 UnitStatDlg.UserLeft := 397; 2546 UnitStatDlg.UserTop := TopBarHeight + 64; 2547 DiaDlg.UserLeft := (Screen.width - DiaDlg.width) div 2; 2548 DiaDlg.UserTop := (Screen.height - DiaDlg.height) div 2; 2549 NatStatDlg.UserLeft := Screen.width - NatStatDlg.width - 8; 2550 NatStatDlg.UserTop := Screen.height - PanelHeight - 2551 NatStatDlg.height - 8; 2552 if NatStatDlg.UserTop < 8 then 2553 NatStatDlg.UserTop := 8; 2554 2555 Age := 0; 2556 MovieSpeed := 1; 2557 LogDlg.mSlot.Visible := true; 2558 LogDlg.Host := self; 2559 HelpDlg.ClearHistory; 2560 CityDlg.Reset; 2561 2562 Mini.width := G.lx * 2; 2563 Mini.height := G.ly; 2564 for i := 0 to nPl - 1 do 2565 begin 2566 Tribe[i] := nil; 2567 TribeOriginal[i] := false; 1676 2568 end; 1677 TurnComplete:=true; 1678 exit; 1679 end; 1680 if not supervising and (1 shl me and MyRO.Alive=0) then 1681 begin TurnComplete:=true; exit; end; 1682 1683 if (ClientMode=cContinue) and (DipMem[me].SentCommand and $FF0F=scContact) then 1684 // contact was refused 1685 if MyRO.Treaty[DipMem[me].pContact]>=trPeace then 1686 ContactRefused(DipMem[me].pContact, 'FRREJECTED') 1687 else SoundMessage(Tribe[DipMem[me].pContact].TPhrase('FRREJECTED'),'NEGO_REJECTED'); 1688 1689 if not supervising and (Age>MyData.ToldAge) 1690 and ((Age>0) or (ClientMode<>cMovieTurn)) then with MessgExDlg do 1691 begin 1692 if Age=0 then 1693 begin 1694 if Phrases2FallenBackToEnglish then 2569 ToldSlavery := -1; 2570 RepaintOnResize := false; 2571 Closable := false; 2572 FirstMovieTurn := true; 2573 2574 MenuArea.Visible := GameMode <> cMovie; 2575 TreasuryArea.Visible := GameMode < cMovie; 2576 ResearchArea.Visible := GameMode < cMovie; 2577 ManagementArea.Visible := GameMode < cMovie; 2578 end; 2579 2580 cGetReady, cReplay: 2581 if NewPlayer = 0 then 2582 begin 2583 i := 0; 2584 for p1 := 0 to nPl - 1 do 2585 if (G.Difficulty[p1] > 0) and (Tribe[p1] = nil) then 2586 inc(i); 2587 if i > UnusedTribeFiles.Count then 1695 2588 begin 1696 s:=Tribe[me].TPhrase('AGE0');1697 MessgText:=Format(s,[TurnToString(MyRO.Turn),CityName(MyCity[0].ID)])2589 GameOK := false; 2590 SimpleMessage(Phrases.Lookup('TOOFEWTRIBES')); 1698 2591 end 2592 else 2593 begin 2594 for p1 := 0 to nPl - 1 do 2595 if (G.Difficulty[p1] > 0) and (Tribe[p1] = nil) and 2596 (G.RO[p1] <> nil) then 2597 begin // let player select own tribes 2598 TribeInfo.trix := p1; 2599 TribeNames.Clear; 2600 for j := 0 to UnusedTribeFiles.Count - 1 do 2601 begin 2602 GetTribeInfo(UnusedTribeFiles[j], Name, Color); 2603 TribeNames.AddObject(Name, TObject(Color)); 2604 end; 2605 assert(TribeNames.Count > 0); 2606 ModalSelectDlg.ShowNewContent(wmModal, kTribe); 2607 Application.ProcessMessages; 2608 TribeInfo.FileName := UnusedTribeFiles[ModalSelectDlg.result]; 2609 UnusedTribeFiles.Delete(ModalSelectDlg.result); 2610 2611 if GameMode = cLoadGame then 2612 CreateTribe(TribeInfo.trix, TribeInfo.FileName, false) 2613 else 2614 Server(cSetTribe + (Length(TribeInfo.FileName) + 1 + 7) div 4, 2615 0, 0, TribeInfo); 2616 end; 2617 2618 for p1 := 0 to nPl - 1 do 2619 if (G.Difficulty[p1] > 0) and (Tribe[p1] = nil) and 2620 (G.RO[p1] = nil) then 2621 begin // autoselect enemy tribes 2622 j := ChooseUnusedTribe; 2623 TribeInfo.FileName := UnusedTribeFiles[j]; 2624 UnusedTribeFiles.Delete(j); 2625 TribeInfo.trix := p1; 2626 if GameMode = cLoadGame then 2627 CreateTribe(TribeInfo.trix, TribeInfo.FileName, false) 2628 else 2629 Server(cSetTribe + (Length(TribeInfo.FileName) + 1 + 7) div 4, 2630 0, 0, TribeInfo); 2631 end; 2632 end; 2633 if not mNames.Checked then 2634 for p1 := 0 to nPl - 1 do 2635 if Tribe[p1] <> nil then 2636 Tribe[p1].NumberName := p1; 2637 end; 2638 2639 cBreakGame: 2640 begin 2641 SaveSettings; 2642 CityDlg.CloseAction := None; 2643 for i := 0 to Screen.FormCount - 1 do 2644 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 2645 then 2646 Screen.Forms[i].Close; 2647 if LogDlg.Visible then 2648 LogDlg.Close; 2649 LogDlg.List.Clear; 2650 StartRunning := not idle and (Jump[0] > 0); // AI called Reload 2651 me := -1; 2652 idle := false; 2653 ClientMode := -1; 2654 UnitInfoBtn.Visible := false; 2655 UnitBtn.Visible := false; 2656 TerrainBtn.Visible := false; 2657 MovieSpeed1Btn.Visible := false; 2658 MovieSpeed2Btn.Visible := false; 2659 MovieSpeed3Btn.Visible := false; 2660 MovieSpeed4Btn.Visible := false; 2661 EOT.Visible := false; 2662 for i := 0 to ControlCount - 1 do 2663 if Controls[i] is TButtonC then 2664 Controls[i].Visible := false; 2665 InitPVSB(sb, 0, 1); 2666 for p1 := 0 to nPl - 1 do 2667 if Tribe[p1] <> nil then 2668 Tribe[p1].free; 2669 Tribes.Done; 2670 RepaintOnResize := false; 2671 Closable := true; 2672 Close; 2673 { if (GameMode=cNewGame) or (GameMode=cLoadGame) then 2674 AdvisorDlg.BreakGame; } 2675 end; 2676 2677 cShowGame: 2678 begin 2679 with Panel.Canvas do 2680 begin 2681 Brush.Color := $000000; 2682 FillRect(Rect(0, 0, Panel.width, Panel.height)); 2683 Brush.Style := bsClear; 2684 end; 2685 with TopBar.Canvas do 2686 begin 2687 Brush.Color := $000000; 2688 FillRect(Rect(0, 0, TopBar.width, TopBar.height)); 2689 Brush.Style := bsClear; 2690 end; 2691 FormResize(nil); // place mini map correctly according to its size 2692 Show; 2693 Update; 2694 RepaintOnResize := true; 2695 xw := 0; 2696 yw := ywcenter; 2697 if not StayOnTop_Ensured then 2698 begin 2699 StayOnTop_Ensured := true; 2700 CityDlg.StayOnTop_Workaround; 2701 CityTypeDlg.StayOnTop_Workaround; 2702 DiaDlg.StayOnTop_Workaround; 2703 DraftDlg.StayOnTop_Workaround; 2704 EnhanceDlg.StayOnTop_Workaround; 2705 HelpDlg.StayOnTop_Workaround; 2706 NatStatDlg.StayOnTop_Workaround; 2707 NegoDlg.StayOnTop_Workaround; 2708 ModalSelectDlg.StayOnTop_Workaround; 2709 ListDlg.StayOnTop_Workaround; 2710 UnitStatDlg.StayOnTop_Workaround; 2711 WondersDlg.StayOnTop_Workaround; 2712 RatesDlg.StayOnTop_Workaround; 2713 end; 2714 end; 2715 2716 cShowTurnChange: 2717 begin 2718 if integer(Data) >= 0 then 2719 begin 2720 pLogo := integer(Data); 2721 if G.RO[pLogo] = nil then 2722 begin 2723 if AILogo[pLogo] <> nil then 2724 BitBlt(Canvas.Handle, (xRightPanel + 10) - (16 + 64), 2725 ClientHeight - PanelHeight, 64, 64, 2726 AILogo[pLogo].Canvas.Handle, 0, 0, SRCCOPY); 2727 end 2728 end 2729 end; 2730 2731 cTurn, cResume, cContinue: 2732 if not GameOK then 2733 Server(sResign, NewPlayer, 0, nil^) 1699 2734 else 2735 begin 2736 ClientMode := Command; 2737 pTurn := NewPlayer; 2738 pLogo := NewPlayer; 2739 2740 if Command = cResume then 2741 begin // init non-original model pictures (maybe tribes not found) 2742 for p1 := 0 to nPl - 1 do 2743 if G.RO[p1] <> nil then 2744 begin 2745 ItsMeAgain(p1); 2746 for mix := 0 to MyRO.nModel - 1 do 2747 if Tribe[me].ModelPicture[mix].HGr = 0 then 2748 InitMyModel(mix, true); 2749 end; 2750 me := -1; 2751 end; 2752 2753 if Jump[pTurn] > 0 then 2754 Application.ProcessMessages; 2755 if Jump[pTurn] > 0 then 2756 if G.RO[NewPlayer].Happened and phGameEnd <> 0 then 2757 Jump[pTurn] := 0 2758 else 2759 dec(Jump[pTurn]); 2760 SkipTurn := Jump[pTurn] > 0; 2761 if SkipTurn then 1700 2762 begin 1701 s:=Tribe[me].TString(Phrases2.Lookup('AGE0')); 1702 MessgText:=Format(s,[TurnToString(MyRO.Turn)]); 2763 ItsMeAgain(NewPlayer); 2764 MyData := G.RO[NewPlayer].Data; 2765 SetTroopLoc(-1); 2766 MiniPaint; 2767 InitAllEnemyModels; // necessary for correct replay 2768 if not EndTurn(true) then 2769 SkipTurn := false; 2770 end; 2771 if not SkipTurn then 2772 begin 2773 if ((ClientMode < scDipStart) or (ClientMode > scDipBreak)) and 2774 NegoDlg.Visible then 2775 NegoDlg.Close; 2776 skipped := false; // always show my moves during my turn 2777 idle := true; 2778 InitTurn(NewPlayer); 2779 DipMem[me].pContact := -1; 2780 (* if (me=0) and (MyRO.Alive and (1 shl me)=0)} then 2781 begin 2782 if SimpleQuery(Phrases.Lookup('RESIGN'))=mrIgnore then 2783 Server(sResign,me,0,nil^) 2784 else Server(sBreak,me,0,nil^) 2785 end 2786 else Play('TURNSTART'); *) 2787 end; 2788 end; 2789 2790 cMovieTurn: 2791 begin 2792 ClientMode := Command; 2793 pTurn := NewPlayer; 2794 pLogo := -1; 2795 skipped := false; // always show my moves during my turn 2796 idle := true; 2797 if FirstMovieTurn then 2798 begin 2799 CheckMovieSpeedBtnState; 2800 FirstMovieTurn := false; 2801 end; 2802 InitTurn(NewPlayer); 2803 Application.ProcessMessages; 2804 if MovieSpeed = 4 then 2805 begin 2806 Sleep(75); 2807 // this break will ensure speed of fast forward does not depend on cpu speed 2808 Application.ProcessMessages; 2809 end 2810 end; 2811 2812 cMovieEndTurn: 2813 begin 2814 RememberPeaceViolation; 2815 pTurn := -1; 2816 pLogo := -1; 2817 MapValid := false; 2818 ClientMode := -1; 2819 idle := false; 2820 skipped := false; 2821 end; 2822 2823 cEditMap: 2824 begin 2825 ClientMode := cEditMap; 2826 SetMapOptions; 2827 IsoEngine.pDebugMap := -1; 2828 ItsMeAgain(0); 2829 MyData := nil; 2830 UnitInfoBtn.Visible := false; 2831 UnitBtn.Visible := false; 2832 TerrainBtn.Visible := false; 2833 MovieSpeed1Btn.Visible := false; 2834 MovieSpeed2Btn.Visible := false; 2835 MovieSpeed3Btn.Visible := false; 2836 MovieSpeed4Btn.Visible := false; 2837 EOT.Visible := false; 2838 HelpDlg.Difficulty := 0; 2839 BrushType := fGrass; 2840 BrushLoc := -1; 2841 Edited := false; 2842 UnFocus := -1; 2843 MarkCityLoc := -1; 2844 Tracking := false; 2845 TurnComplete := false; 2846 MapValid := false; 2847 FormResize(nil); // calculate geometrics and paint all 2848 SetTroopLoc(-1); 2849 idle := true 2850 end; 2851 2852 (* cNewContact: 2853 begin 2854 end; 2855 *) 2856 2857 scContact: 2858 begin 2859 DipMem[NewPlayer].pContact := integer(Data); 2860 if Jump[NewPlayer] > 0 then 2861 DipCall(scReject) 2862 else 2863 begin 2864 ClientMode := Command; 2865 InitTurn(NewPlayer); 2866 MyData.ToldContact := MyData.ToldContact or (1 shl integer(Data)); 2867 // don't tell about new nation when already contacted by them 2868 with MessgExDlg do 2869 begin 2870 OpenSound := 'CONTACT_' + char(48 + MyRO.EnemyReport[integer(Data) 2871 ].Attitude); 2872 MessgText := Tribe[integer(Data)].TPhrase('FRCONTACT'); 2873 Kind := mkYesNo; 2874 IconKind := mikTribe; 2875 IconIndex := integer(Data); 2876 ShowModal; 2877 if ModalResult = mrOK then 2878 begin 2879 NegoDlg.Respond; 2880 DipMem[me].DeliveredPrices := []; 2881 DipMem[me].ReceivedPrices := []; 2882 DipCall(scDipStart) 2883 end 2884 else 2885 begin 2886 DipCall(scReject); 2887 EndNego 2888 end 2889 end 2890 end; 2891 end; 2892 2893 scDipStart .. scDipBreak: 2894 begin 2895 ClientMode := Command; 2896 InitTurn(NewPlayer); 2897 if Command = scDipStart then 2898 Play('CONTACT_' + char(48 + MyRO.Attitude[DipMem[NewPlayer] 2899 .pContact])) 2900 else if Command = scDipCancelTreaty then 2901 Play('CANCELTREATY') 2902 else if Command = scDipOffer then 2903 begin 2904 ReceivedOffer := TOffer(Data); 2905 InitAllEnemyModels; 2906 end 2907 else if Command = scDipAccept then 2908 begin // remember delivered and received prices 2909 for i := 0 to DipMem[me].SentOffer.nDeliver - 1 do 2910 include(DipMem[me].DeliveredPrices, 2911 DipMem[me].SentOffer.Price[i] shr 24); 2912 for i := 0 to DipMem[me].SentOffer.nCost - 1 do 2913 include(DipMem[me].ReceivedPrices, 2914 DipMem[me].SentOffer.Price[DipMem[me].SentOffer.nDeliver + 2915 i] shr 24); 2916 IsTreatyDeal := false; 2917 for i := 0 to ReceivedOffer.nDeliver + ReceivedOffer.nCost - 1 do 2918 if DipMem[me].SentOffer.Price[i] and opMask = opTreaty then 2919 IsTreatyDeal := true; 2920 if IsTreatyDeal then 2921 Play('NEWTREATY') 2922 else 2923 Play('ACCEPTOFFER'); 2924 end; 2925 NegoDlg.Start; 2926 idle := true 2927 end; 2928 2929 cShowCancelTreaty: 2930 if not IsMultiPlayerGame then 2931 begin 2932 case G.RO[NewPlayer].Treaty[integer(Data)] of 2933 trPeace: 2934 s := Tribe[integer(Data)].TPhrase('FRCANCELBYREJECT_PEACE'); 2935 trFriendlyContact: 2936 s := Tribe[integer(Data)].TPhrase('FRCANCELBYREJECT_FRIENDLY'); 2937 trAlliance: 2938 s := Tribe[integer(Data)].TPhrase('FRCANCELBYREJECT_ALLIANCE'); 2939 end; 2940 TribeMessage(integer(Data), s, 'CANCELTREATY'); 2941 end; 2942 2943 cShowCancelTreatyByAlliance: 2944 if idle and (NewPlayer = me) then 2945 TribeMessage(integer(Data), Tribe[integer(Data) 2946 ].TPhrase('FRENEMYALLIANCE'), 'CANCELTREATY'); 2947 2948 cShowSupportAllianceAgainst: 2949 if not IsMultiPlayerGame and (Jump[0] = 0) then 2950 TribeMessage(integer(Data) and $F, 2951 Tribe[integer(Data) and $F].TPhrase('FRMYALLIANCE1') + ' ' + 2952 Tribe[integer(Data) shr 4].TPhrase('FRMYALLIANCE2'), 2953 'CANCELTREATY'); 2954 2955 cShowPeaceViolation: 2956 if not IsMultiPlayerGame and (Jump[0] = 0) then 2957 TribeMessage(integer(Data), 2958 Format(Tribe[integer(Data)].TPhrase('EVIOLATION'), 2959 [TurnToString(MyRO.Turn + PeaceEvaTurns - 1)]), 'MSG_WITHDRAW'); 2960 2961 cShowEndContact: 2962 EndNego; 2963 2964 cShowUnitChanged, cShowCityChanged, cShowAfterMove, cShowAfterAttack: 2965 if (idle and (NewPlayer = me) or not idle and not skipped) and 2966 not((GameMode = cMovie) and (MovieSpeed = 4)) then 2967 begin 2968 assert(NewPlayer = me); 2969 if not idle or (GameMode = cMovie) then 2970 Application.ProcessMessages; 2971 if Command = cShowCityChanged then 2972 begin 2973 CurrentMoveInfo.DoShow := false; 2974 if idle then 2975 CurrentMoveInfo.DoShow := true 2976 else if CurrentMoveInfo.IsAlly then 2977 CurrentMoveInfo.DoShow := not mAlNoMoves.Checked 2978 else 2979 CurrentMoveInfo.DoShow := not mEnNoMoves.Checked 2980 end 2981 else if Command = cShowUnitChanged then 2982 begin 2983 CurrentMoveInfo.DoShow := false; 2984 if idle then 2985 CurrentMoveInfo.DoShow := not mEffectiveMovesOnly.Checked 2986 else if CurrentMoveInfo.IsAlly then 2987 CurrentMoveInfo.DoShow := 2988 not(mAlNoMoves.Checked or mAlEffectiveMovesOnly.Checked) 2989 else 2990 CurrentMoveInfo.DoShow := 2991 not(mEnNoMoves.Checked or mEnAttacks.Checked) 2992 end; 2993 // else keep DoShow from cShowMove/cShowAttack 2994 2995 if CurrentMoveInfo.DoShow then 2996 begin 2997 if Command = cShowCityChanged then 2998 MapValid := false; 2999 FocusOnLoc(integer(Data), flImmUpdate); 3000 // OldUnFocus:=UnFocus; 3001 // UnFocus:=-1; 3002 if Command = cShowAfterMove then 3003 PaintLoc(integer(Data), CurrentMoveInfo.AfterMovePaintRadius) 3004 // show discovered areas 3005 else 3006 PaintLoc(integer(Data), 1); 3007 // UnFocus:=OldUnFocus; 3008 if (Command = cShowAfterAttack) and 3009 (CurrentMoveInfo.AfterAttackExpeller >= 0) then 3010 begin 3011 SoundMessageEx(Tribe[CurrentMoveInfo.AfterAttackExpeller] 3012 .TPhrase('EXPEL'), ''); 3013 CurrentMoveInfo.AfterAttackExpeller := -1; 3014 Update; // remove message box from screen 3015 end 3016 else if not idle then 3017 if Command = cShowCityChanged then 3018 Sleep(MoveTime * WaitAfterShowMove div 16) 3019 else if (Command = cShowUnitChanged) and 3020 (MyMap[integer(Data)] and fUnit <> 0) then 3021 Sleep(MoveTime * WaitAfterShowMove div 32) 3022 end // if CurrentMoveInfo.DoShow 3023 else 3024 MapValid := false; 3025 end; 3026 3027 cShowMoving, cShowCapturing: 3028 if (idle and (NewPlayer = me) or not idle and not skipped and 3029 (TShowMove(Data).emix <> $FFFF)) and 3030 not((GameMode = cMovie) and (MovieSpeed = 4)) then 3031 begin 3032 assert(NewPlayer = me); 3033 if not idle or (GameMode = cMovie) then 3034 Application.ProcessMessages; 3035 with TShowMove(Data) do 3036 begin 3037 CurrentMoveInfo.DoShow := false; 3038 if not idle and (Tribe[Owner].ModelPicture[mix].HGr = 0) then 3039 InitEnemyModel(emix); 3040 3041 ToLoc := dLoc(FromLoc, dx, dy); 3042 if idle then 3043 begin // own unit -- make discovered land visible 3044 assert(Owner = me); // no foreign moves during my turn! 3045 CurrentMoveInfo.DoShow := not mEffectiveMovesOnly.Checked or 3046 (Command = cShowCapturing); 3047 if CurrentMoveInfo.DoShow then 3048 begin 3049 if GameMode = cMovie then 3050 begin 3051 if MovieSpeed = 3 then 3052 AnimationSpeed := 4 3053 else if MovieSpeed = 2 then 3054 AnimationSpeed := 8 3055 else 3056 AnimationSpeed := 16; 3057 end 3058 else 3059 begin 3060 if mVeryFastMoves.Checked then 3061 AnimationSpeed := 4 3062 else if mFastMoves.Checked then 3063 AnimationSpeed := 8 3064 else 3065 AnimationSpeed := 16; 3066 end; 3067 with MyModel[mix] do 3068 begin 3069 if (Kind = mkDiplomat) or (Domain = dAir) or 3070 (Cap[mcRadar] + Cap[mcCarrier] + Cap[mcAcademy] > 0) or 3071 (MyMap[ToLoc] and fTerrain = fMountains) or 3072 (MyMap[ToLoc] and fTerImp = tiFort) or 3073 (MyMap[ToLoc] and fTerImp = tiBase) then 3074 CurrentMoveInfo.AfterMovePaintRadius := 2 3075 else 3076 CurrentMoveInfo.AfterMovePaintRadius := 1; 3077 if (MyRO.Wonder[woShinkansen].EffectiveOwner = me) and 3078 (Domain = dGround) and 3079 (MyMap[FromLoc] and (fRR or fCity) <> 0) and 3080 (MyMap[ToLoc] and (fRR or fCity) <> 0) and 3081 (Flags and umPlaneUnloading = 0) then 3082 AnimationSpeed := 4; 3083 ShowMoveDomain := Domain; 3084 IsAlpine := Cap[mcAlpine] > 0; 3085 end 3086 end 3087 end 3088 else 3089 begin 3090 CurrentMoveInfo.IsAlly := MyRO.Treaty[Owner] = trAlliance; 3091 if GameMode = cMovie then 3092 CurrentMoveInfo.DoShow := true 3093 else if CurrentMoveInfo.IsAlly then 3094 CurrentMoveInfo.DoShow := not mAlNoMoves.Checked and 3095 not(mAlEffectiveMovesOnly.Checked and 3096 (Command <> cShowCapturing)) 3097 else 3098 CurrentMoveInfo.DoShow := not mEnNoMoves.Checked and 3099 not(mEnAttacks.Checked and (Command <> cShowCapturing)); 3100 if CurrentMoveInfo.DoShow then 3101 begin 3102 if Command = cShowCapturing then 3103 begin // show capture message 3104 if MyMap[ToLoc] and fOwned <> 0 then 3105 begin // own city, search 3106 cix := MyRO.nCity - 1; 3107 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do 3108 dec(cix); 3109 s := CityName(MyCity[cix].ID); 3110 end 3111 else 3112 begin // foreign city, search 3113 ecix := MyRO.nEnemyCity - 1; 3114 while (ecix >= 0) and (MyRO.EnemyCity[ecix].Loc <> ToLoc) do 3115 dec(ecix); 3116 s := CityName(MyRO.EnemyCity[ecix].ID); 3117 end; 3118 TribeMessage(Owner, Format(Tribe[Owner].TPhrase('CAPTURE'), 3119 [s]), ''); 3120 Update; // remove message box from screen 3121 end; 3122 3123 if CurrentMoveInfo.IsAlly then 3124 begin // allied unit -- make discovered land visible 3125 if mAlFastMoves.Checked then 3126 AnimationSpeed := 8 3127 else 3128 AnimationSpeed := 16; 3129 with MyRO.EnemyModel[emix] do 3130 if (Kind = mkDiplomat) or (Domain = dAir) or 3131 (ATrans_Fuel > 0) or 3132 (Cap and (1 shl (mcRadar - mcFirstNonCap) or 3133 1 shl (mcAcademy - mcFirstNonCap)) <> 0) or 3134 (MyMap[ToLoc] and fTerrain = fMountains) or 3135 (MyMap[ToLoc] and fTerImp = tiFort) or 3136 (MyMap[ToLoc] and fTerImp = tiBase) then 3137 CurrentMoveInfo.AfterMovePaintRadius := 2 3138 else 3139 CurrentMoveInfo.AfterMovePaintRadius := 1 3140 end 3141 else 3142 begin 3143 if mEnFastMoves.Checked then 3144 AnimationSpeed := 8 3145 else 3146 AnimationSpeed := 16; 3147 CurrentMoveInfo.AfterMovePaintRadius := 0; 3148 // enemy unit, nothing discovered 3149 end; 3150 if GameMode = cMovie then 3151 begin 3152 if MovieSpeed = 3 then 3153 AnimationSpeed := 4 3154 else if MovieSpeed = 2 then 3155 AnimationSpeed := 8 3156 else 3157 AnimationSpeed := 16; 3158 end; 3159 ShowMoveDomain := MyRO.EnemyModel[emix].Domain; 3160 IsAlpine := MyRO.EnemyModel[emix].Cap and 3161 (1 shl (mcAlpine - mcFirstNonCap)) <> 0; 3162 end 3163 end; 3164 3165 if CurrentMoveInfo.DoShow then 3166 begin 3167 if Command = cShowCapturing then 3168 Play('MOVE_CAPTURE') 3169 else if EndHealth <= 0 then 3170 Play('MOVE_DIE') 3171 else if Flags and umSpyMission <> 0 then 3172 Play('MOVE_COVERT') 3173 else if Flags and umShipLoading <> 0 then 3174 if ShowMoveDomain = dAir then 3175 Play('MOVE_PLANELANDING') 3176 else 3177 Play('MOVE_LOAD') 3178 else if Flags and umPlaneLoading <> 0 then 3179 Play('MOVE_LOAD') 3180 else if Flags and umShipUnloading <> 0 then 3181 if ShowMoveDomain = dAir then 3182 Play('MOVE_PLANESTART') 3183 else 3184 Play('MOVE_UNLOAD') 3185 else if Flags and umPlaneUnloading <> 0 then 3186 if (MyMap[FromLoc] and fCity = 0) and 3187 (MyMap[FromLoc] and fTerImp <> tiBase) then 3188 Play('MOVE_PARACHUTE') 3189 else 3190 Play('MOVE_UNLOAD') 3191 else if (ShowMoveDomain = dGround) and not IsAlpine and 3192 (MyMap[ToLoc] and fTerrain = fMountains) and 3193 ((MyMap[FromLoc] and (fRoad or fRR or fCity) = 0) or 3194 (MyMap[ToLoc] and (fRoad or fRR or fCity) = 0)) then 3195 Play('MOVE_MOUNTAIN'); 3196 3197 FocusOnLoc(FromLoc, flImmUpdate); 3198 PaintLoc_BeforeMove(FromLoc); 3199 if Command = cShowCapturing then 3200 MoveOnScreen(TShowMove(Data), 1, 32, 32) 3201 else 3202 MoveOnScreen(TShowMove(Data), 1, AnimationSpeed, AnimationSpeed) 3203 end // if CurrentMoveInfo.DoShow 3204 else 3205 MapValid := false; 3206 end 3207 end; 3208 3209 cShowAttacking: 3210 if (idle and (NewPlayer = me) or not idle and not skipped and 3211 (TShowMove(Data).emix <> $FFFF)) and 3212 not((GameMode = cMovie) and (MovieSpeed = 4)) then 3213 begin 3214 assert(NewPlayer = me); 3215 if not idle or (GameMode = cMovie) then 3216 Application.ProcessMessages; 3217 with TShowMove(Data) do 3218 begin 3219 CurrentMoveInfo.AfterAttackExpeller := -1; 3220 CurrentMoveInfo.DoShow := false; 3221 if idle then 3222 CurrentMoveInfo.DoShow := true // own unit -- always show attacks 3223 else 3224 begin 3225 CurrentMoveInfo.IsAlly := MyRO.Treaty[Owner] = trAlliance; 3226 if CurrentMoveInfo.IsAlly then 3227 CurrentMoveInfo.DoShow := not mAlNoMoves.Checked 3228 else 3229 CurrentMoveInfo.DoShow := not mEnNoMoves.Checked; 3230 end; 3231 if CurrentMoveInfo.DoShow then 3232 begin 3233 ToLoc := dLoc(FromLoc, dx, dy); 3234 if Tribe[Owner].ModelPicture[mix].HGr = 0 then 3235 InitEnemyModel(emix); 3236 3237 if (MyMap[ToLoc] and (fCity or fUnit or fOwned) = fCity or fOwned) 3238 then 3239 begin // tell about bombardment 3240 cix := MyRO.nCity - 1; 3241 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do 3242 dec(cix); 3243 if MyCity[cix].Status and csToldBombard = 0 then 3244 begin 3245 if not supervising then 3246 MyCity[cix].Status := MyCity[cix].Status or csToldBombard; 3247 s := CityName(MyCity[cix].ID); 3248 SoundMessageEx(Format(Tribe[Owner].TPhrase('BOMBARD'), 3249 [s]), ''); 3250 Update; // remove message box from screen 3251 end; 3252 end 3253 else if Flags and umExpelling <> 0 then 3254 CurrentMoveInfo.AfterAttackExpeller := Owner; 3255 3256 if Flags and umExpelling <> 0 then 3257 Play('MOVE_EXPEL') 3258 else if Owner = me then 3259 begin 3260 MakeModelInfo(me, mix, MyModel[mix], mi); 3261 Play(AttackSound(ModelCode(mi))); 3262 end 3263 else 3264 Play(AttackSound(ModelCode(MyRO.EnemyModel[emix]))); 3265 3266 FocusOnLoc(FromLoc, flImmUpdate); 3267 3268 // before combat 3269 MainMap.AttackBegin(TShowMove(Data)); 3270 if MyMap[ToLoc] and fCity <> 0 then 3271 PaintLoc(ToLoc); 3272 PaintLoc(FromLoc); 3273 MoveOnScreen(TShowMove(Data), 1, 9, 16); 3274 MoveOnScreen(TShowMove(Data), 17, 12, 32); 3275 MoveOnScreen(TShowMove(Data), 7, 11, 16); 3276 3277 // after combat 3278 MainMap.AttackEffect(TShowMove(Data)); 3279 PaintLoc(ToLoc); 3280 if EndHealth > 0 then 3281 begin 3282 Health := EndHealth; 3283 MoveOnScreen(TShowMove(Data), 10, 0, 16); 3284 end 3285 else if not idle then 3286 Sleep(MoveTime div 2); 3287 MainMap.AttackEnd; 3288 end // if CurrentMoveInfo.DoShow 3289 else 3290 MapValid := false; 3291 end 3292 end; 3293 3294 cShowMissionResult: 3295 if Cardinal(Data) = 0 then 3296 SoundMessageEx(Phrases.Lookup('NOFOREIGNINFO'), '') 3297 else 3298 begin 3299 s := Phrases.Lookup('FOREIGNINFO'); 3300 for p1 := 0 to nPl - 1 do 3301 if 3 shl (p1 * 2) and Cardinal(Data) <> 0 then 3302 s := s + '\' + Tribe[p1].TPhrase('SHORTNAME'); 3303 SoundMessageEx(s, '') 3304 end; 3305 3306 cShowShipChange: 3307 if not IsMultiPlayerGame and (Jump[0] = 0) then 3308 ShowEnemyShipChange(TShowShipChange(Data)); 3309 3310 cShowGreatLibTech: 3311 if not IsMultiPlayerGame and (Jump[0] = 0) then 3312 with MessgExDlg do 3313 begin 3314 MessgText := Format(Phrases.Lookup('GRLIB_GENERAL'), 3315 [Phrases.Lookup('ADVANCES', integer(Data))]); 3316 OpenSound := 'NEWADVANCE_GRLIB'; 3317 Kind := mkOk; 3318 IconKind := mikImp; 3319 IconIndex := woGrLibrary; 3320 ShowModal; 3321 end; 3322 3323 cRefreshDebugMap: 3324 begin 3325 if integer(Data) = IsoEngine.pDebugMap then 3326 begin 3327 MapValid := false; 3328 MainOffscreenPaint; 3329 Update; 3330 end 3331 end; 3332 3333 else 3334 if Command >= cClientEx then 3335 case Command and $FFF0 of 3336 3337 cSetTribe: 3338 with TTribeInfo(Data) do 3339 begin 3340 i := UnusedTribeFiles.Count - 1; 3341 while (i >= 0) and 3342 (AnsiCompareFileName(UnusedTribeFiles[i], FileName) <> 0) do 3343 dec(i); 3344 if i >= 0 then 3345 UnusedTribeFiles.Delete(i); 3346 CreateTribe(trix, FileName, true); 3347 end; 3348 3349 cSetNewModelPicture, cSetModelPicture: 3350 if TribeOriginal[TModelPictureInfo(Data).trix] then 3351 Tribe[TModelPictureInfo(Data).trix].SetModelPicture 3352 (TModelPictureInfo(Data), Command and 3353 $FFF0 = cSetNewModelPicture); 3354 3355 cSetSlaveIndex and $FFF0: 3356 Tribe[integer(Data) shr 16].mixSlaves := integer(Data) and $FFFF; 3357 3358 cSetCityName: 3359 with TCityNameInfo(Data) do 3360 if TribeOriginal[ID shr 12] then 3361 Tribe[ID shr 12].SetCityName(ID and $FFF, NewName); 3362 3363 cSetModelName: 3364 with TModelNameInfo(Data) do 3365 if TribeOriginal[NewPlayer] then 3366 Tribe[NewPlayer].ModelName[mix] := NewName; 3367 end 3368 end 3369 end; { <<<client } 3370 3371 { *** main part *** } 3372 3373 procedure TMainScreen.CreateParams(var p: TCreateParams); 3374 var 3375 DefaultOptionChecked: integer; 3376 Reg: TRegistry; 3377 doinit: boolean; 3378 begin 3379 inherited; 3380 3381 // define which menu settings to save 3382 SaveOption[0] := mAlEffectiveMovesOnly.Tag; 3383 SaveOption[1] := mEnMoves.Tag; 3384 SaveOption[2] := mEnAttacks.Tag; 3385 SaveOption[3] := mEnNoMoves.Tag; 3386 SaveOption[4] := mWaitTurn.Tag; 3387 SaveOption[5] := mEffectiveMovesOnly.Tag; 3388 SaveOption[6] := mEnFastMoves.Tag; 3389 SaveOption[7] := mSlowMoves.Tag; 3390 SaveOption[8] := mFastMoves.Tag; 3391 SaveOption[9] := mVeryFastMoves.Tag; 3392 SaveOption[10] := mNames.Tag; 3393 SaveOption[11] := mRepList.Tag; 3394 SaveOption[12] := mRepScreens.Tag; 3395 SaveOption[13] := mSoundOff.Tag; 3396 SaveOption[14] := mSoundOn.Tag; 3397 SaveOption[15] := mSoundOnAlt.Tag; 3398 SaveOption[16] := mScrollSlow.Tag; 3399 SaveOption[17] := mScrollFast.Tag; 3400 SaveOption[18] := mScrollOff.Tag; 3401 SaveOption[19] := mAlSlowMoves.Tag; 3402 SaveOption[20] := mAlFastMoves.Tag; 3403 SaveOption[21] := mAlNoMoves.Tag; 3404 DefaultOptionChecked := 1 shl 1 + 1 shl 7 + 1 shl 10 + 1 shl 12 + 1 shl 14 + 3405 1 shl 18 + 1 shl 19; 3406 3407 Reg := TRegistry.Create; 3408 doinit := true; 3409 if Reg.KeyExists('SOFTWARE\cevo\RegVer9') then 3410 begin 3411 doinit := false; 3412 Reg.OpenKey('SOFTWARE\cevo\RegVer9', false); 3413 try 3414 xxt := Reg.ReadInteger('TileWidth') div 2; 3415 yyt := Reg.ReadInteger('TileHeight') div 2; 3416 OptionChecked := Reg.ReadInteger('OptionChecked'); 3417 MapOptionChecked := Reg.ReadInteger('MapOptionChecked'); 3418 CityRepMask := Cardinal(Reg.ReadInteger('CityReport')); 3419 except 3420 doinit := true; 3421 end; 3422 Reg.closekey; 3423 if OptionChecked and (7 shl 16) = 0 then 3424 OptionChecked := OptionChecked or (1 shl 16); 3425 // old regver with no scrolling 3426 end; 3427 Reg.free; 3428 if doinit then 3429 begin 3430 xxt := 48; 3431 yyt := 24; 3432 OptionChecked := DefaultOptionChecked; 3433 MapOptionChecked := 1 shl moCityNames; 3434 CityRepMask := Cardinal(not chPopIncrease and not chNoGrowthWarning and 3435 not chCaptured); 3436 end; 3437 3438 if FullScreen then 3439 begin 3440 p.Style := $87000000; 3441 BorderStyle := bsNone; 3442 BorderIcons := []; 3443 end; 3444 3445 if 1 shl 13 and OptionChecked <> 0 then 3446 SoundMode := smOff 3447 else if 1 shl 15 and OptionChecked <> 0 then 3448 SoundMode := smOnAlt 3449 else 3450 SoundMode := smOn 3451 end; 3452 3453 procedure TMainScreen.FormCreate(Sender: TObject); 3454 var 3455 i, j: integer; 3456 begin 3457 Screen.Cursors[crImpDrag] := LoadCursor(HInstance, 'DRAG'); 3458 Screen.Cursors[crFlatHand] := LoadCursor(HInstance, 'FLATHAND'); 3459 3460 // tag-controlled language 3461 for i := 0 to ComponentCount - 1 do 3462 if Components[i].Tag and $FF <> 0 then 3463 if Components[i] is TMenuItem then 3464 begin 3465 TMenuItem(Components[i]).Caption := Phrases.Lookup('CONTROLS', 3466 -1 + Components[i].Tag and $FF); 3467 for j := 0 to nSaveOption - 1 do 3468 if Components[i].Tag and $FF = SaveOption[j] then 3469 TMenuItem(Components[i]).Checked := 1 shl j and 3470 OptionChecked <> 0; 3471 end 3472 else if Components[i] is TButtonBase then 3473 begin 3474 TButtonBase(Components[i]).Hint := Phrases.Lookup('CONTROLS', 3475 -1 + Components[i].Tag and $FF); 3476 if (Components[i] is TButtonC) and 3477 (TButtonC(Components[i]).ButtonIndex <> 1) then 3478 TButtonC(Components[i]).ButtonIndex := 3479 MapOptionChecked shr (Components[i].Tag shr 8) and 1 + 2 3480 end; 3481 3482 // non-tag-controlled language 3483 mTechTree.Caption := Phrases2.Lookup('MENU_ADVTREE'); 3484 mViewpoint.Caption := Phrases2.Lookup('MENU_VIEWPOINT'); 3485 if not Phrases2FallenBackToEnglish then 3486 begin 3487 MenuArea.Hint := Phrases2.Lookup('BTN_MENU'); 3488 TreasuryArea.Hint := Phrases2.Lookup('TIP_TREASURY'); 3489 ResearchArea.Hint := Phrases.Lookup('SCIENCE'); 3490 ManagementArea.Hint := Phrases2.Lookup('BTN_MANAGE'); 3491 end; 3492 for i := 0 to mRep.Count - 1 do 3493 begin 3494 j := mRep[i].Tag shr 8; 3495 mRep[i].Caption := CityEventName(j); 3496 mRep[i].Checked := CityRepMask and (1 shl j) <> 0; 3497 end; 3498 3499 Mini := TBitmap.Create; 3500 Mini.PixelFormat := pf24bit; 3501 Panel := TBitmap.Create; 3502 Panel.PixelFormat := pf24bit; 3503 Panel.Canvas.Font.Assign(UniFont[ftSmall]); 3504 Panel.Canvas.Brush.Style := bsClear; 3505 TopBar := TBitmap.Create; 3506 TopBar.PixelFormat := pf24bit; 3507 TopBar.Canvas.Font.Assign(UniFont[ftNormal]); 3508 TopBar.Canvas.Brush.Style := bsClear; 3509 Buffer := TBitmap.Create; 3510 Buffer.PixelFormat := pf24bit; 3511 if 2 * lxmax > 3 * xSizeBig then 3512 Buffer.width := 2 * lxmax 3513 else 3514 Buffer.width := 3 * xSizeBig; 3515 if lymax > 3 * ySizeBig then 3516 Buffer.height := lymax 3517 else 3518 Buffer.height := 3 * ySizeBig; 3519 Buffer.Canvas.Font.Assign(UniFont[ftSmall]); 3520 for i := 0 to nPl - 1 do 3521 AILogo[i] := nil; 3522 Canvas.Font.Assign(UniFont[ftSmall]); 3523 InitButtons(); 3524 EOT.Template := Templates; 3525 end; 3526 3527 procedure TMainScreen.FormDestroy(Sender: TObject); 3528 var 3529 i: integer; 3530 begin 3531 Mini.free; 3532 Buffer.free; 3533 Panel.free; 3534 for i := 0 to nPl - 1 do 3535 if AILogo[i] <> nil then 3536 AILogo[i].free; 3537 end; 3538 3539 procedure TMainScreen.FormResize(Sender: TObject); 3540 var 3541 MiniFrame, MaxMapWidth: integer; 3542 begin 3543 SmallScreen := ClientWidth < 1024; 3544 MaxMapWidth := (G.lx * 2 - 3) * xxt; 3545 // avoide the same tile being visible left and right 3546 if ClientWidth <= MaxMapWidth then 3547 begin 3548 MapWidth := ClientWidth; 3549 MapOffset := 0; 3550 end 3551 else 3552 begin 3553 MapWidth := MaxMapWidth; 3554 MapOffset := (ClientWidth - MapWidth) div 2; 3555 end; 3556 MapHeight := ClientHeight - TopBarHeight - PanelHeight + overlap; 3557 Panel.width := ClientWidth; 3558 Panel.height := PanelHeight; 3559 TopBar.width := ClientWidth; 3560 TopBar.height := TopBarHeight; 3561 MiniFrame := (lxmax_xxx - G.ly) div 2; 3562 xMidPanel := (G.lx + MiniFrame) * 2 + 1; 3563 xRightPanel := ClientWidth - LeftPanelWidth - 10; 3564 if ClientMode = cEditMap then 3565 TrPitch := 2 * xxt 3566 else 3567 TrPitch := 66; 3568 xMini := MiniFrame - 5; 3569 yMini := (PanelHeight - 26 - lxmax_xxx) div 2 + MiniFrame; 3570 ywmax := (G.ly - MapHeight div yyt + 1) and not 1; 3571 ywcenter := -((MapHeight - yyt * (G.ly - 1)) div (4 * yyt)) * 2; 3572 // only for ywmax<=0 3573 if ywmax <= 0 then 3574 yw := ywcenter 3575 else if yw < 0 then 3576 yw := 0 3577 else if yw > ywmax then 3578 yw := ywmax; 3579 UnitInfoBtn.Top := ClientHeight - 29; 3580 UnitInfoBtn.Left := xMidPanel + 7 + 99; 3581 UnitBtn.Top := ClientHeight - 29; 3582 UnitBtn.Left := xMidPanel + 7 + 99 + 31; 3583 TerrainBtn.Top := ClientHeight - 29; 3584 TerrainBtn.Left := xMidPanel + 7 + 99 + 62; 3585 MovieSpeed1Btn.Top := ClientHeight - 91; 3586 MovieSpeed1Btn.Left := ClientWidth div 2 - 62; 3587 MovieSpeed2Btn.Top := ClientHeight - 91; 3588 MovieSpeed2Btn.Left := ClientWidth div 2 - 62 + 29; 3589 MovieSpeed3Btn.Top := ClientHeight - 91; 3590 MovieSpeed3Btn.Left := ClientWidth div 2 - 62 + 2 * 29; 3591 MovieSpeed4Btn.Top := ClientHeight - 91; 3592 MovieSpeed4Btn.Left := ClientWidth div 2 - 62 + 3 * 29 + 12; 3593 EOT.Top := ClientHeight - 64; 3594 EOT.Left := ClientWidth - 62; 3595 SetWindowPos(sb.h, 0, xRightPanel + 10 - 14 - 3596 GetSystemMetrics(SM_CXVSCROLL), ClientHeight - MidPanelHeight + 8, 0, 0, 3597 SWP_NOSIZE or SWP_NOZORDER); 3598 MapBtn0.Left := xMini + G.lx - 44; 3599 MapBtn0.Top := ClientHeight - 15; 3600 MapBtn1.Left := xMini + G.lx - 28; 3601 MapBtn1.Top := ClientHeight - 15; 3602 { MapBtn2.Left:=xMini+G.lx-20; 3603 MapBtn2.Top:=ClientHeight-15; 3604 MapBtn3.Left:=xMini+G.lx-4; 3605 MapBtn3.Top:=ClientHeight-15; } 3606 MapBtn5.Left := xMini + G.lx - 12; 3607 MapBtn5.Top := ClientHeight - 15; 3608 MapBtn4.Left := xMini + G.lx + 20; 3609 MapBtn4.Top := ClientHeight - 15; 3610 MapBtn6.Left := xMini + G.lx + 36; 3611 MapBtn6.Top := ClientHeight - 15; 3612 TreasuryArea.Left := ClientWidth div 2 - 172; 3613 ResearchArea.Left := ClientWidth div 2; 3614 ManagementArea.Left := ClientWidth - xPalace; 3615 ManagementArea.Top := TopBarHeight + MapHeight - overlap + yPalace; 3616 ArrangeMidPanel; 3617 if RepaintOnResize then 3618 begin 3619 RectInvalidate(0, TopBarHeight, ClientWidth, TopBarHeight + MapHeight); 3620 MapValid := false; 3621 PaintAll 3622 end 3623 end; 3624 3625 procedure TMainScreen.FormCloseQuery(Sender: TObject; var CanClose: boolean); 3626 begin 3627 CanClose := Closable; 3628 if not Closable and idle and (me = 0) and (ClientMode < scContact) then 3629 MenuClick(mResign) 3630 end; 3631 3632 procedure TMainScreen.OnScroll(var m: TMessage); 3633 begin 3634 if ProcessPVSB(sb, m) then 3635 begin 3636 PanelPaint; 3637 Update 3638 end 3639 end; 3640 3641 procedure TMainScreen.OnEOT(var Msg: TMessage); 3642 begin 3643 EndTurn 3644 end; 3645 3646 procedure TMainScreen.EOTClick(Sender: TObject); 3647 begin 3648 if GameMode = cMovie then 3649 begin 3650 MessgExDlg.CancelMovie; 3651 Server(sBreak, me, 0, nil^) 3652 end 3653 else if ClientMode < 0 then 3654 skipped := true 3655 else if ClientMode >= scContact then 3656 NegoDlg.ShowNewContent(wmPersistent) 3657 else if Jump[pTurn] > 0 then 3658 begin 3659 Jump[pTurn] := 0; 3660 StartRunning := false 3661 end 3662 else 3663 EndTurn 3664 end; 3665 3666 // set xTerrain, xTroop, and TrRow 3667 procedure TMainScreen.ArrangeMidPanel; 3668 begin 3669 if ClientMode = cEditMap then 3670 xTroop := xMidPanel + 15 3671 else 3672 begin 3673 if supervising then 3674 xTerrain := xMidPanel + 2 * xxt + 14 3675 else if ClientWidth < 1280 then 3676 xTerrain := ClientWidth div 2 + (1280 - ClientWidth) div 3 3677 else 3678 xTerrain := ClientWidth div 2; 3679 xTroop := xTerrain + 2 * xxt + 12; 3680 if SmallScreen and not supervising then 3681 xTroop := xRightPanel + 10 - 3 * 66 - 3682 GetSystemMetrics(SM_CXVSCROLL) - 19 - 4; 3683 // not perfect but we assume almost no one is still playing on a 800x600 screen 3684 end; 3685 TrRow := (xRightPanel + 10 - xTroop - GetSystemMetrics(SM_CXVSCROLL) - 19) 3686 div TrPitch; 3687 end; 3688 3689 function TMainScreen.EndTurn(WasSkipped: boolean): boolean; 3690 3691 function IsResourceUnused(cix, NeedFood, NeedProd: integer): boolean; 3692 var 3693 dx, dy, fix: integer; 3694 CityAreaInfo: TCityAreaInfo; 3695 TileInfo: TTileInfo; 3696 begin 3697 Server(sGetCityAreaInfo, me, cix, CityAreaInfo); 3698 for dy := -3 to 3 do 3699 for dx := -3 to 3 do 3700 if ((dx + dy) and 1 = 0) and (dx * dx * dy * dy < 81) then 3701 begin 3702 fix := (dy + 3) shl 2 + (dx + 3) shr 1; 3703 if (MyCity[cix].Tiles and (1 shl fix) = 0) // not used yet 3704 and (CityAreaInfo.Available[fix] = faAvailable) then // usable 3705 begin 3706 TileInfo.ExplCity := cix; 3707 Server(sGetHypoCityTileInfo, me, dLoc(MyCity[cix].Loc, dx, dy), 3708 TileInfo); 3709 if (TileInfo.Food >= NeedFood) and (TileInfo.Prod >= NeedProd) 3710 then 3711 begin 3712 result := true; 3713 exit 3714 end; 3715 end 3716 end; 3717 result := false; 3718 end; 3719 3720 var 3721 i, p1, uix, cix, CenterLoc: integer; 3722 MsgItem: string; 3723 CityReport: TCityReport; 3724 PlaneReturnData: TPlaneReturnData; 3725 Zoom: boolean; 3726 begin 3727 result := false; 3728 if ClientMode >= scDipOffer then 3729 exit; 3730 3731 if supervising and (me <> 0) then 3732 begin 3733 for i := 0 to Screen.FormCount - 1 do 3734 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 3735 then 3736 Screen.Forms[i].Close; // close windows 3737 ItsMeAgain(0); 3738 end; 3739 3740 CityOptimizer_EndOfTurn; 3741 3742 if not WasSkipped then // check warnings 3743 begin 3744 // need to move planes home? 3745 for uix := 0 to MyRO.nUn - 1 do 3746 with MyUn[uix] do 3747 if (Loc >= 0) and (MyModel[mix].Domain = dAir) and 3748 (Status and usToldNoReturn = 0) and (Master < 0) and 3749 (MyMap[Loc] and fCity = 0) and (MyMap[Loc] and fTerImp <> tiBase) 3750 then 3751 begin 3752 PlaneReturnData.Fuel := Fuel; 3753 PlaneReturnData.Loc := Loc; 3754 PlaneReturnData.Movement := 0; // end turn without further movement? 3755 if Server(sGetPlaneReturn, me, uix, PlaneReturnData) = eNoWay then 3756 begin 3757 CenterLoc := Loc + G.lx * 6; 3758 // centering the unit itself would make it covered by the query dialog 3759 while CenterLoc >= G.lx * G.ly do 3760 dec(CenterLoc, G.lx * 2); 3761 Centre(CenterLoc); 3762 SetTroopLoc(-1); 3763 PaintAll; 3764 3765 if MyModel[mix].Kind = mkSpecial_Glider then 3766 MsgItem := 'LOWFUEL_GLIDER' 3767 else 3768 MsgItem := 'LOWFUEL'; 3769 if SimpleQuery(mkYesNo, Phrases.Lookup(MsgItem), 3770 'WARNING_LOWSUPPORT') <> mrOK then 3771 begin 3772 SetUnFocus(uix); 3773 SetTroopLoc(Loc); 3774 PanelPaint; 3775 exit; 3776 end; 3777 MyUn[uix].Status := MyUn[uix].Status or usToldNoReturn; 3778 end 3779 end; 3780 3781 if not supervising and (MyRO.TestFlags and tfImmImprove = 0) and 3782 (MyRO.Government <> gAnarchy) and (MyRO.Money + TaxSum < 0) and 3783 (MyRO.TaxRate < 100) then // low funds! 3784 with MessgExDlg do 3785 begin 3786 OpenSound := 'WARNING_LOWFUNDS'; 3787 MessgText := Phrases.Lookup('LOWFUNDS'); 3788 Kind := mkYesNo; 3789 IconKind := mikImp; 3790 IconIndex := imTrGoods; 3791 ShowModal; 3792 if ModalResult <> mrOK then 3793 exit 3794 end; 3795 3796 if MyRO.Government <> gAnarchy then 3797 for cix := 0 to MyRO.nCity - 1 do 3798 with MyCity[cix] do 3799 if (Loc >= 0) and (Flags and chCaptured = 0) then 3800 begin 3801 Zoom := false; 3802 CityReport.HypoTiles := -1; 3803 CityReport.HypoTax := -1; 3804 CityReport.HypoLux := -1; 3805 Server(sGetCityReport, me, cix, CityReport); 3806 3807 if (CityReport.Working - CityReport.Happy > Size shr 1) and 3808 (Flags and chCaptured <= $10000) then 3809 with MessgExDlg do 3810 begin 3811 OpenSound := 'WARNING_DISORDER'; 3812 if Status and csResourceWeightsMask = 0 then 3813 MsgItem := 'DISORDER' 3814 else 3815 MsgItem := 'DISORDER_UNREST'; 3816 MessgText := Format(Phrases.Lookup(MsgItem), [CityName(ID)]); 3817 Kind := mkYesNo; 3818 // BigIcon:=29; 3819 ShowModal; 3820 Zoom := ModalResult <> mrOK; 3821 end; 3822 if not Zoom and (Food + CityReport.FoodRep - CityReport.Eaten < 0) 3823 then 3824 with MessgExDlg do 3825 begin 3826 OpenSound := 'WARNING_FAMINE'; 3827 if Status and csResourceWeightsMask = 0 then 3828 MsgItem := 'FAMINE' 3829 else if (CityReport.Deployed <> 0) and 3830 IsResourceUnused(cix, 1, 0) then 3831 MsgItem := 'FAMINE_UNREST' 3832 else 3833 MsgItem := 'FAMINE_TILES'; 3834 MessgText := Format(Phrases.Lookup(MsgItem), [CityName(ID)]); 3835 Kind := mkYesNo; 3836 IconKind := mikImp; 3837 IconIndex := 22; 3838 ShowModal; 3839 Zoom := ModalResult <> mrOK; 3840 end; 3841 if not Zoom and (CityReport.ProdRep < CityReport.Support) then 3842 with MessgExDlg do 3843 begin 3844 OpenSound := 'WARNING_LOWSUPPORT'; 3845 if Status and csResourceWeightsMask = 0 then 3846 MsgItem := 'LOWSUPPORT' 3847 else if (CityReport.Deployed <> 0) and 3848 IsResourceUnused(cix, 0, 1) then 3849 MsgItem := 'LOWSUPPORT_UNREST' 3850 else 3851 MsgItem := 'LOWSUPPORT_TILES'; 3852 MessgText := Format(Phrases.Lookup(MsgItem), [CityName(ID)]); 3853 Kind := mkYesNo; 3854 IconKind := mikImp; 3855 IconIndex := 29; 3856 ShowModal; 3857 Zoom := ModalResult <> mrOK; 3858 end; 3859 if Zoom then 3860 begin // zoom to city 3861 ZoomToCity(Loc); 3862 exit 3863 end 3864 end; 3865 3866 if (MyRO.Happened and phTech <> 0) and (MyRO.ResearchTech < 0) and 3867 (MyData.FarTech <> adNexus) then 3868 if not ChooseResearch then 3869 exit; 3870 end; 3871 3872 RememberPeaceViolation; 3873 3874 SetUnFocus(-1); 3875 for uix := 0 to MyRO.nUn - 1 do 3876 MyUn[uix].Status := MyUn[uix].Status and usPersistent; 3877 3878 CityDlg.CloseAction := None; 3879 if IsMultiPlayerGame then 3880 begin // close windows for next player 3881 for i := 0 to Screen.FormCount - 1 do 3882 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 3883 then 3884 Screen.Forms[i].Close; 3885 end 3886 else 3887 begin 3888 if CityDlg.Visible then 3889 CityDlg.Close; 3890 if UnitStatDlg.Visible then 3891 UnitStatDlg.Close; 3892 end; 3893 for i := 0 to Screen.FormCount - 1 do 3894 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 3895 Screen.Forms[i].Enabled := false; 3896 3897 if Server(sTurn, pTurn, 0, nil^) >= rExecuted then 3898 begin 3899 if Jump[pTurn] > 0 then 3900 EOT.Hint := Phrases.Lookup('BTN_STOP') 3901 else 3902 EOT.Hint := Phrases.Lookup('BTN_SKIP'); 3903 result := true; 3904 SetTroopLoc(-1); 3905 pTurn := -1; 3906 pLogo := -1; 3907 UnitInfoBtn.Visible := false; 3908 UnitBtn.Visible := false; 3909 TerrainBtn.Visible := false; 3910 EOT.ButtonIndex := eotCancel; 3911 EOT.Visible := true; 3912 MapValid := false; 3913 PanelPaint; 3914 Update; 3915 ClientMode := -1; 3916 idle := false; 3917 skipped := WasSkipped; 3918 for p1 := 1 to nPl - 1 do 3919 if G.RO[p1] <> nil then 3920 skipped := true; // don't show enemy moves in hotseat mode 3921 end 3922 else 3923 PanelPaint 3924 end; // EndTurn 3925 3926 procedure TMainScreen.EndNego; 3927 begin 3928 if NegoDlg.Visible then 3929 NegoDlg.Close; 3930 HaveStrategyAdvice := false; 3931 // AdvisorDlg.HaveStrategyAdvice; 3932 // negotiation might have changed advices 3933 EOT.ButtonIndex := eotCancel; 3934 EOT.Visible := true; 3935 PanelPaint; 3936 Update; 3937 ClientMode := -1; 3938 idle := false; 3939 end; 3940 3941 procedure TMainScreen.ProcessRect(x0, y0, nx, ny, Options: integer); 3942 var 3943 xs, ys, xl, yl: integer; 3944 begin 3945 xl := nx * xxt + xxt; 3946 yl := ny * yyt + yyt * 2; 3947 xs := (x0 - xw) * (xxt * 2) + y0 and 1 * xxt - G.lx * (xxt * 2); 3948 // |xs+xl/2-MapWidth/2| -> min 3949 while abs(2 * (xs + G.lx * (xxt * 2)) + xl - MapWidth) < 3950 abs(2 * xs + xl - MapWidth) do 3951 inc(xs, G.lx * (xxt * 2)); 3952 ys := (y0 - yw) * yyt - yyt; 3953 if xs + xl > MapWidth then 3954 xl := MapWidth - xs; 3955 if ys + yl > MapHeight then 3956 yl := MapHeight - ys; 3957 if (xl <= 0) or (yl <= 0) then 3958 exit; 3959 if Options and prPaint <> 0 then 3960 begin 3961 if Options and prAutoBounds <> 0 then 3962 MainMap.SetPaintBounds(xs, ys, xs + xl, ys + yl); 3963 MainMap.Paint(xs, ys, x0 + G.lx * y0, nx, ny, -1, -1); 3964 end; 3965 if Options and prInvalidate <> 0 then 3966 RectInvalidate(MapOffset + xs, TopBarHeight + ys, MapOffset + xs + xl, 3967 TopBarHeight + ys + yl) 3968 end; 3969 3970 procedure TMainScreen.PaintLoc(Loc: integer; Radius: integer = 0); 3971 var 3972 yLoc, x0: integer; 3973 begin 3974 if MapValid then 3975 begin 3976 yLoc := (Loc + G.lx * 1024) div G.lx - 1024; 3977 x0 := (Loc + (yLoc and 1 - 2 * Radius + G.lx * 1024) div 2) mod G.lx; 3978 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3979 ProcessRect(x0, yLoc - 2 * Radius, 4 * Radius + 1, 4 * Radius + 1, 3980 prPaint or prAutoBounds or prInvalidate); 3981 Update; 3982 end 3983 end; 3984 3985 procedure TMainScreen.PaintLocTemp(Loc, Style: integer); 3986 var 3987 y0, x0, xMap, yMap: integer; 3988 begin 3989 if not MapValid then 3990 exit; 3991 Buffer.Canvas.Font.Assign(UniFont[ftSmall]); 3992 y0 := Loc div G.lx; 3993 x0 := Loc mod G.lx; 3994 xMap := (x0 - xw) * (xxt * 2) + y0 and 1 * xxt - G.lx * (xxt * 2); 3995 // |xMap+xxt-MapWidth/2| -> min 3996 while abs(2 * (xMap + G.lx * (xxt * 2)) + 2 * xxt - MapWidth) < 3997 abs(2 * xMap + 2 * xxt - MapWidth) do 3998 inc(xMap, G.lx * (xxt * 2)); 3999 yMap := (y0 - yw) * yyt - yyt; 4000 NoMap.SetOutput(Buffer); 4001 NoMap.SetPaintBounds(0, 0, 2 * xxt, 3 * yyt); 4002 NoMap.Paint(0, 0, Loc, 1, 1, -1, -1, Style = pltsBlink); 4003 PaintBufferToScreen(xMap, yMap, 2 * xxt, 3 * yyt); 4004 end; 4005 4006 // paint content of buffer directly to screen instead of offscreen 4007 // panel protusions are added 4008 // NoMap must be set to buffer and bounds before 4009 procedure TMainScreen.PaintBufferToScreen(xMap, yMap, width, height: integer); 4010 begin 4011 if xMap + width > MapWidth then 4012 width := MapWidth - xMap; 4013 if yMap + height > MapHeight then 4014 height := MapHeight - yMap; 4015 if (width <= 0) or (height <= 0) or (width + xMap <= 0) or 4016 (height + yMap <= 0) then 4017 exit; 4018 4019 NoMap.BitBlt(Panel, -xMap - MapOffset, -yMap + MapHeight - overlap, 4020 xMidPanel, overlap, 0, 0, SRCCOPY); 4021 NoMap.BitBlt(Panel, -xMap - MapOffset + xRightPanel, 4022 -yMap + MapHeight - overlap, Panel.width - xRightPanel, overlap, 4023 xRightPanel, 0, SRCCOPY); 4024 if yMap < 0 then 4025 begin 4026 if xMap < 0 then 4027 BitBlt(Canvas.Handle, MapOffset, TopBarHeight, width + xMap, 4028 height + yMap, Buffer.Canvas.Handle, -xMap, -yMap, SRCCOPY) 4029 else 4030 BitBlt(Canvas.Handle, xMap + MapOffset, TopBarHeight, width, 4031 height + yMap, Buffer.Canvas.Handle, 0, -yMap, SRCCOPY) 4032 end 4033 else 4034 begin 4035 if xMap < 0 then 4036 BitBlt(Canvas.Handle, MapOffset, TopBarHeight + yMap, width + xMap, 4037 height, Buffer.Canvas.Handle, -xMap, 0, SRCCOPY) 4038 else 4039 BitBlt(Canvas.Handle, xMap + MapOffset, TopBarHeight + yMap, width, 4040 height, Buffer.Canvas.Handle, 0, 0, SRCCOPY); 4041 end 4042 end; 4043 4044 procedure TMainScreen.PaintLoc_BeforeMove(FromLoc: integer); 4045 var 4046 yLoc, x0: integer; 4047 begin 4048 if MapValid then 4049 begin 4050 yLoc := (FromLoc + G.lx * 1024) div G.lx - 1024; 4051 x0 := (FromLoc + (yLoc and 1 + G.lx * 1024) div 2) mod G.lx; 4052 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 4053 ProcessRect(x0, yLoc, 1, 1, prPaint or prAutoBounds); 4054 end 4055 end; 4056 4057 procedure TMainScreen.PaintDestination; 4058 var 4059 Destination: integer; 4060 begin 4061 if (UnFocus >= 0) and (MyUn[UnFocus].Status and usGoto <> 0) then 4062 begin 4063 Destination := MyUn[UnFocus].Status shr 16; 4064 if (Destination <> $7FFF) and (Destination <> MyUn[UnFocus].Loc) then 4065 PaintLocTemp(Destination, pltsBlink); 4066 end; 4067 end; 4068 4069 procedure TMainScreen.MiniPaint; 4070 type 4071 TLine = array [0 .. 99999999, 0 .. 2] of Byte; 4072 var 4073 uix, cix, x, y, Loc, i, hw, xm, cm, cmPolOcean, cmPolNone: integer; 4074 PrevMiniLine, MiniLine: ^TLine; 4075 begin 4076 cmPolOcean := GrExt[HGrSystem].Data.Canvas.Pixels[101, 67]; 4077 cmPolNone := GrExt[HGrSystem].Data.Canvas.Pixels[102, 67]; 4078 hw := MapWidth div (xxt * 2); 4079 with Mini.Canvas do 4080 begin 4081 Brush.Color := $000000; 4082 FillRect(Rect(0, 0, Mini.width, Mini.height)); 4083 end; 4084 MiniLine := nil; 4085 for y := 0 to G.ly - 1 do 4086 begin 4087 PrevMiniLine := MiniLine; 4088 MiniLine := Mini.ScanLine[y]; 4089 for x := 0 to G.lx - 1 do 4090 if MyMap[x + G.lx * y] and fTerrain <> fUNKNOWN then 4091 begin 4092 Loc := x + G.lx * y; 4093 for i := 0 to 1 do 4094 begin 4095 xm := ((x - xwMini) * 2 + i + y and 1 - hw + G.lx * 5) 4096 mod (G.lx * 2); 4097 cm := MiniColors[MyMap[Loc] and fTerrain, i]; 4098 if ClientMode = cEditMap then 4099 begin 4100 if MyMap[Loc] and (fPrefStartPos or fStartPos) <> 0 then 4101 cm := $FFFFFF; 4102 end 4103 else if MyMap[Loc] and fCity <> 0 then 4104 begin 4105 cix := MyRO.nCity - 1; 4106 while (cix >= 0) and (MyCity[cix].Loc <> Loc) do 4107 dec(cix); 4108 if cix >= 0 then 4109 cm := Tribe[me].Color 4110 else 4111 begin 4112 cix := MyRO.nEnemyCity - 1; 4113 while (cix >= 0) and (MyRO.EnemyCity[cix].Loc <> Loc) do 4114 dec(cix); 4115 if cix >= 0 then 4116 cm := Tribe[MyRO.EnemyCity[cix].Owner].Color 4117 end; 4118 cm := $808080 or cm shr 1; { increase brightness } 4119 if PrevMiniLine <> nil then 4120 begin // 2x2 city dot covers two scanlines 4121 PrevMiniLine[xm, 0] := cm shr 16; 4122 PrevMiniLine[xm, 1] := cm shr 8 and $FF; 4123 PrevMiniLine[xm, 2] := cm and $FF; 4124 end 4125 end 4126 else if (i = 0) and (MyMap[Loc] and fUnit <> 0) then 4127 begin 4128 uix := MyRO.nUn - 1; 4129 while (uix >= 0) and (MyUn[uix].Loc <> Loc) do 4130 dec(uix); 4131 if uix >= 0 then 4132 cm := Tribe[me].Color 4133 else 4134 begin 4135 uix := MyRO.nEnemyUn - 1; 4136 while (uix >= 0) and (MyRO.EnemyUn[uix].Loc <> Loc) do 4137 dec(uix); 4138 if uix >= 0 then 4139 cm := Tribe[MyRO.EnemyUn[uix].Owner].Color 4140 end; 4141 cm := $808080 or cm shr 1; { increase brightness } 4142 end 4143 else if MapOptionChecked and (1 shl moPolitical) <> 0 then 4144 begin 4145 if MyMap[Loc] and fTerrain < fGrass then 4146 cm := cmPolOcean 4147 else if MyRO.Territory[Loc] < 0 then 4148 cm := cmPolNone 4149 else 4150 cm := Tribe[MyRO.Territory[Loc]].Color; 4151 end; 4152 MiniLine[xm, 0] := cm shr 16; 4153 MiniLine[xm, 1] := cm shr 8 and $FF; 4154 MiniLine[xm, 2] := cm and $FF; 4155 end; 4156 end 4157 end; 4158 end; 4159 4160 procedure TMainScreen.MainOffscreenPaint; 4161 var 4162 ProcessOptions: integer; 4163 rec: TRect; 4164 DoInvalidate: boolean; 4165 begin 4166 if me < 0 then 4167 with offscreen.Canvas do 4168 begin 4169 Brush.Color := $000000; 4170 FillRect(Rect(0, 0, MapWidth, MapHeight)); 4171 Brush.Style := bsClear; 4172 OffscreenUser := self; 4173 exit 4174 end; 4175 4176 MainMap.SetPaintBounds(0, 0, MapWidth, MapHeight); 4177 if OffscreenUser <> self then 4178 begin 4179 if OffscreenUser <> nil then 4180 OffscreenUser.Update; 4181 // complete working with old owner to prevent rebound 4182 if MapValid and (xwd = xw) and (ywd = yw) then 4183 MainMap.SetPaintBounds(0, 0, UsedOffscreenWidth, UsedOffscreenHeight); 4184 MapValid := false; 4185 OffscreenUser := self; 4186 end; 4187 4188 if xw - xwd > G.lx div 2 then 4189 xwd := xwd + G.lx 4190 else if xwd - xw > G.lx div 2 then 4191 xwd := xwd - G.lx; 4192 if not MapValid or (xw - xwd > MapWidth div (xxt * 2)) or 4193 (xwd - xw > MapWidth div (xxt * 2)) or (yw - ywd > MapHeight div yyt) or 4194 (ywd - yw > MapHeight div yyt) then 4195 begin 4196 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 4197 ProcessRect(xw, yw, MapWidth div xxt, MapHeight div yyt, 4198 prPaint or prInvalidate) 4199 end 4200 else 4201 begin 4202 if (xwd = xw) and (ywd = yw) then 4203 exit; { map window not moved } 4204 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 4205 rec := Rect(0, 0, MapWidth, MapHeight); 4206 ScrollDC(offscreen.Canvas.Handle, (xwd - xw) * (xxt * 2), 4207 (ywd - yw) * yyt, rec, rec, 0, nil); 4208 for DoInvalidate := false to FastScrolling do 4209 begin 4210 if DoInvalidate then 4211 begin 4212 rec.Bottom := MapHeight - overlap; 4213 ScrollDC(Canvas.Handle, (xwd - xw) * (xxt * 2), (ywd - yw) * yyt, rec, 4214 rec, 0, nil); 4215 ProcessOptions := prInvalidate; 4216 end 4217 else 4218 ProcessOptions := prPaint or prAutoBounds; 4219 if yw < ywd then 4220 begin 4221 ProcessRect(xw, yw, MapWidth div xxt, ywd - yw - 1, ProcessOptions); 4222 if xw < xwd then 4223 ProcessRect(xw, ywd, (xwd - xw) * 2 - 1, MapHeight div yyt - ywd + 4224 yw, ProcessOptions) 4225 else if xw > xwd then 4226 ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, ywd, 4227 (xw - xwd) * 2 + 1, MapHeight div yyt - ywd + yw, ProcessOptions) 4228 end 4229 else if yw > ywd then 4230 begin 4231 if DoInvalidate then 4232 RectInvalidate(MapOffset, TopBarHeight + MapHeight - overlap - 4233 (yw - ywd) * yyt, MapOffset + MapWidth, TopBarHeight + MapHeight 4234 - overlap) 4235 else 4236 ProcessRect(xw, (ywd + MapHeight div (yyt * 2) * 2), 4237 MapWidth div xxt, yw - ywd + 1, ProcessOptions); 4238 if xw < xwd then 4239 ProcessRect(xw, yw, (xwd - xw) * 2 - 1, MapHeight div yyt - yw + ywd 4240 - 2, ProcessOptions) 4241 else if xw > xwd then 4242 ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, yw, 4243 (xw - xwd) * 2 + 1, MapHeight div yyt - yw + ywd - 2, 4244 ProcessOptions) 4245 end 4246 else if xw < xwd then 4247 ProcessRect(xw, yw, (xwd - xw) * 2 - 1, MapHeight div yyt, 4248 ProcessOptions) 4249 else if xw > xwd then 4250 ProcessRect((xwd + MapWidth div (xxt * 2)) mod G.lx, yw, 4251 (xw - xwd) * 2 + 1, MapHeight div yyt, ProcessOptions); 4252 end; 4253 if not FastScrolling then 4254 RectInvalidate(MapOffset, TopBarHeight, MapOffset + MapWidth, 4255 TopBarHeight + MapHeight - overlap); 4256 RectInvalidate(xMidPanel, TopBarHeight + MapHeight - overlap, xRightPanel, 4257 TopBarHeight + MapHeight) 4258 end; 4259 // if (xwd<>xw) or (ywd<>yw) then 4260 // Server(sChangeSuperView,me,yw*G.lx+xw,nil^); // for synchronizing client side viewer, not used currently 4261 xwd := xw; 4262 ywd := yw; 4263 MapValid := true; 4264 end; 4265 4266 procedure TMainScreen.PaintAll; 4267 begin 4268 MainOffscreenPaint; 4269 xwMini := xw; 4270 ywMini := yw; 4271 MiniPaint; 4272 PanelPaint; 4273 end; 4274 4275 procedure TMainScreen.PaintAllMaps; 4276 begin 4277 MainOffscreenPaint; 4278 xwMini := xw; 4279 ywMini := yw; 4280 MiniPaint; 4281 CopyMiniToPanel; 4282 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2, 4283 xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini + 4284 2 + G.ly); 4285 end; 4286 4287 procedure TMainScreen.CopyMiniToPanel; 4288 begin 4289 BitBlt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly, 4290 Mini.Canvas.Handle, 0, 0, SRCCOPY); 4291 if MarkCityLoc >= 0 then 4292 Sprite(Panel, HGrSystem, 4293 xMini - 2 + (4 * G.lx + 2 * (MarkCityLoc mod G.lx) + 4294 (G.lx - MapWidth div (xxt * 2)) - 2 * xwd) mod (2 * G.lx) + 4295 MarkCityLoc div G.lx and 1, yMini - 3 + MarkCityLoc div G.lx, 10, 4296 10, 77, 47) 4297 else if ywmax <= 0 then 4298 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2), yMini + 2, 4299 xMini + 1 + G.lx + MapWidth div (xxt * 2), yMini + 2 + G.ly - 1, 4300 MainTexture.clMark, MainTexture.clMark) 4301 else 4302 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (xxt * 2), 4303 yMini + 2 + yw, xMini + 1 + G.lx + MapWidth div (xxt * 2), 4304 yMini + yw + MapHeight div yyt, MainTexture.clMark, MainTexture.clMark); 4305 end; 4306 4307 procedure TMainScreen.PanelPaint; 4308 4309 function MovementToString(var Un: TUn): string; 4310 begin 4311 result := ScreenTools.MovementToString(Un.Movement); 4312 if Un.Master >= 0 then 4313 result := '(' + result + ')' 4314 else if (MyModel[Un.mix].Domain = dAir) and 4315 (MyModel[Un.mix].Kind <> mkSpecial_Glider) then 4316 result := Format('%s(%d)', [result, Un.Fuel]); 4317 end; 4318 4319 var 4320 i, uix, uixDefender, x, xSrc, ySrc, xSrcBase, ySrcBase, CostFactor, Count, 4321 mixShow, xTreasurySection, xResearchSection, JobFocus, TrueMoney, 4322 TrueResearch: integer; 4323 Tile: Cardinal; 4324 s: string; 4325 unx: TUn; 4326 UnitInfo: TUnitInfo; 4327 JobProgressData: TJobProgressData; 4328 Prio: boolean; 4329 begin 4330 with Panel.Canvas do 4331 begin 4332 Fill(Panel.Canvas, 0, 3, xMidPanel + 7 - 10, PanelHeight - 3, 4333 wMainTexture - (xMidPanel + 7 - 10), hMainTexture - PanelHeight); 4334 Fill(Panel.Canvas, xRightPanel + 10 - 7, 3, Panel.width - xRightPanel - 10 4335 + 7, PanelHeight - 3, -(xRightPanel + 10 - 7), 4336 hMainTexture - PanelHeight); 4337 FillLarge(Panel.Canvas, xMidPanel - 2, PanelHeight - MidPanelHeight, 4338 xRightPanel + 2, PanelHeight, ClientWidth div 2); 4339 4340 Brush.Style := bsClear; 4341 Pen.Color := $000000; 4342 MoveTo(0, 0); 4343 LineTo(xMidPanel + 7 - 8, 0); 4344 LineTo(xMidPanel + 7 - 8, PanelHeight - MidPanelHeight); 4345 LineTo(xRightPanel, PanelHeight - MidPanelHeight); 4346 LineTo(xRightPanel, 0); 4347 LineTo(ClientWidth, 0); 4348 Pen.Color := MainTexture.clBevelLight; 4349 MoveTo(xMidPanel + 7 - 9, PanelHeight - MidPanelHeight + 2); 4350 LineTo(xRightPanel + 10 - 8, PanelHeight - MidPanelHeight + 2); 4351 Pen.Color := MainTexture.clBevelLight; 4352 MoveTo(0, 1); 4353 LineTo(xMidPanel + 7 - 9, 1); 4354 Pen.Color := MainTexture.clBevelShade; 4355 LineTo(xMidPanel + 7 - 9, PanelHeight - MidPanelHeight + 1); 4356 Pen.Color := MainTexture.clBevelLight; 4357 LineTo(xRightPanel + 10 - 9, PanelHeight - MidPanelHeight + 1); 4358 Pen.Color := MainTexture.clBevelLight; 4359 LineTo(xRightPanel + 10 - 9, 1); 4360 LineTo(ClientWidth, 1); 4361 MoveTo(ClientWidth, 2); 4362 LineTo(xRightPanel + 10 - 8, 2); 4363 LineTo(xRightPanel + 10 - 8, PanelHeight); 4364 MoveTo(0, 2); 4365 LineTo(xMidPanel + 7 - 10, 2); 4366 Pen.Color := MainTexture.clBevelShade; 4367 LineTo(xMidPanel + 7 - 10, PanelHeight); 4368 Corner(Panel.Canvas, xMidPanel + 7 - 16, 1, 1, MainTexture); 4369 Corner(Panel.Canvas, xRightPanel + 10 - 9, 1, 0, MainTexture); 4370 if ClientMode <> cEditMap then 4371 begin 4372 if supervising then 4373 begin 4374 Frame(Panel.Canvas, ClientWidth - xPalace - 1, yPalace - 1, 4375 ClientWidth - xPalace + xSizeBig, yPalace + ySizeBig, 4376 $B0B0B0, $FFFFFF); 4377 RFrame(Panel.Canvas, ClientWidth - xPalace - 2, yPalace - 2, 4378 ClientWidth - xPalace + xSizeBig + 1, yPalace + ySizeBig + 1, 4379 $FFFFFF, $B0B0B0); 4380 BitBlt(Panel.Canvas.Handle, ClientWidth - xPalace, yPalace, xSizeBig, 4381 ySizeBig, GrExt[HGrSystem2].Data.Canvas.Handle, 70, 123, SRCCOPY); 4382 end 4383 else if MyRO.NatBuilt[imPalace] > 0 then 4384 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, imPalace, -1, 4385 GameMode <> cMovie 4386 { (GameMode<>cMovie) and (MyRO.Government<>gAnarchy) } ) 4387 else 4388 ImpImage(Panel.Canvas, ClientWidth - xPalace, yPalace, 21, -1, 4389 GameMode <> cMovie 4390 { (GameMode<>cMovie) and (MyRO.Government<>gAnarchy) } ); 4391 end; 4392 4393 if GameMode = cMovie then 4394 Frame(Panel.Canvas, xMini + 1, yMini + 1, xMini + 2 + G.lx * 2, 4395 yMini + 2 + G.ly, $000000, $000000) 4396 else 4397 begin 4398 Frame(Panel.Canvas, xMini + 1, yMini + 1, xMini + 2 + G.lx * 2, 4399 yMini + 2 + G.ly, $B0B0B0, $FFFFFF); 4400 RFrame(Panel.Canvas, xMini, yMini, xMini + 3 + G.lx * 2, 4401 yMini + 3 + G.ly, $FFFFFF, $B0B0B0); 4402 end; 4403 CopyMiniToPanel; 4404 if ClientMode <> cEditMap then // MapBtn icons 4405 for i := 0 to 5 do 4406 if i <> 3 then 4407 Dump(Panel, HGrSystem, xMini + G.lx - 42 + 16 * i, PanelHeight - 26, 4408 8, 8, 121 + i * 9, 61); 4409 4410 if ClientMode = cEditMap then 4411 begin 4412 for i := 0 to TrRow - 1 do 4413 trix[i] := -1; 4414 Count := 0; 4415 for i := 0 to nBrushTypes - 1 do 4416 begin // display terrain types 4417 if (Count >= TrRow * sb.si.npos) and (Count < TrRow * (sb.si.npos + 1)) 4418 then 4419 begin 4420 trix[Count - TrRow * sb.si.npos] := BrushTypes[i]; 4421 x := (Count - TrRow * sb.si.npos) * TrPitch; 4422 xSrcBase := -1; 4423 case BrushTypes[i] of 4424 0 .. 8: 4425 begin 4426 xSrc := BrushTypes[i]; 4427 ySrc := 0 4428 end; 4429 9 .. 30: 4430 begin 4431 xSrcBase := 2; 4432 ySrcBase := 2; 4433 xSrc := 0; 4434 ySrc := 2 * integer(BrushTypes[i]) - 15 4435 end; 4436 fRiver: 4437 begin 4438 xSrc := 7; 4439 ySrc := 14 4440 end; 4441 fRoad: 4442 begin 4443 xSrc := 0; 4444 ySrc := 9 4445 end; 4446 fRR: 4447 begin 4448 xSrc := 0; 4449 ySrc := 10 4450 end; 4451 fCanal: 4452 begin 4453 xSrc := 0; 4454 ySrc := 11 4455 end; 4456 fPoll: 4457 begin 4458 xSrc := 6; 4459 ySrc := 12 4460 end; 4461 fDeadLands, fDeadLands or fCobalt, fDeadLands or fUranium, 4462 fDeadLands or fMercury: 4463 begin 4464 xSrcBase := 6; 4465 ySrcBase := 2; 4466 xSrc := 8; 4467 ySrc := 12 + BrushTypes[i] shr 25; 4468 end; 4469 tiIrrigation, tiFarm, tiMine, tiBase: 4470 begin 4471 xSrc := BrushTypes[i] shr 12 - 1; 4472 ySrc := 12 4473 end; 4474 tiFort: 4475 begin 4476 xSrc := 3; 4477 ySrc := 12; 4478 xSrcBase := 7; 4479 ySrcBase := 12 4480 end; 4481 fPrefStartPos: 4482 begin 4483 xSrc := 0; 4484 ySrc := 1 4485 end; 4486 fStartPos: 4487 begin 4488 xSrc := 0; 4489 ySrc := 2 4490 end; 4491 end; 4492 if xSrcBase >= 0 then 4493 Sprite(Panel, HGrTerrain, xTroop + 2 + x, yTroop + 9 - yyt, 4494 xxt * 2, yyt * 3, 1 + xSrcBase * (xxt * 2 + 1), 4495 1 + ySrcBase * (yyt * 3 + 1)); 4496 Sprite(Panel, HGrTerrain, xTroop + 2 + x, yTroop + 9 - yyt, xxt * 2, 4497 yyt * 3, 1 + xSrc * (xxt * 2 + 1), 1 + ySrc * (yyt * 3 + 1)); 4498 if BrushTypes[i] = BrushType then 4499 begin 4500 Frame(Panel.Canvas, xTroop + 2 + x, yTroop + 7 - yyt div 2, 4501 xTroop + 2 * xxt + x, yTroop + 2 * yyt + 11, $000000, $000000); 4502 Frame(Panel.Canvas, xTroop + 1 + x, yTroop + 6 - yyt div 2, 4503 xTroop + 2 * xxt - 1 + x, yTroop + 2 * yyt + 10, 4504 MainTexture.clMark, MainTexture.clMark); 4505 end 4506 end; 4507 inc(Count) 4508 end; 4509 case BrushType of 4510 fDesert, fPrairie, fTundra, fArctic, fSwamp, fHills, fMountains: 4511 s := Phrases.Lookup('TERRAIN', BrushType); 4512 fShore: 4513 s := Format(Phrases.Lookup('TWOTERRAINS'), 4514 [Phrases.Lookup('TERRAIN', fOcean), Phrases.Lookup('TERRAIN', 4515 fShore)]); 4516 fGrass: 4517 s := Format(Phrases.Lookup('TWOTERRAINS'), 4518 [Phrases.Lookup('TERRAIN', fGrass), Phrases.Lookup('TERRAIN', 4519 fGrass + 12)]); 4520 fForest: 4521 s := Format(Phrases.Lookup('TWOTERRAINS'), 4522 [Phrases.Lookup('TERRAIN', fForest), Phrases.Lookup('TERRAIN', 4523 fJungle)]); 4524 fRiver: 4525 s := Phrases.Lookup('RIVER'); 4526 fDeadLands, fDeadLands or fCobalt, fDeadLands or fUranium, 4527 fDeadLands or fMercury: 4528 s := Phrases.Lookup('TERRAIN', 3 * 12 + BrushType shr 25); 4529 fPrefStartPos: 4530 s := Phrases.Lookup('MAP_PREFSTART'); 4531 fStartPos: 4532 s := Phrases.Lookup('MAP_START'); 4533 fPoll: 4534 s := Phrases.Lookup('POLL'); 4535 else // terrain improvements 4536 begin 4537 case BrushType of 4538 fRoad: 4539 i := 1; 4540 fRR: 4541 i := 2; 4542 tiIrrigation: 4543 i := 4; 4544 tiFarm: 4545 i := 5; 4546 tiMine: 4547 i := 7; 4548 fCanal: 4549 i := 8; 4550 tiFort: 4551 i := 10; 4552 tiBase: 4553 i := 12; 4554 end; 4555 s := Phrases.Lookup('JOBRESULT', i); 4556 end 4557 end; 4558 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop + 1, 4559 PanelHeight - 19, s); 4560 end 4561 else if TroopLoc >= 0 then 4562 begin 4563 Brush.Style := bsClear; 4564 if UnFocus >= 0 then 4565 with MyUn[UnFocus], MyModel[mix] do 4566 begin { display info about selected unit } 4567 if Job = jCity then 4568 mixShow := -1 // building site 4569 else 4570 mixShow := mix; 4571 with Tribe[me].ModelPicture[mixShow] do 4572 begin 4573 Sprite(Panel, HGr, xMidPanel + 7 + 12, yTroop + 1, 64, 48, 4574 pix mod 10 * 65 + 1, pix div 10 * 49 + 1); 4575 if MyUn[UnFocus].Flags and unFortified <> 0 then 4576 Sprite(Panel, HGrStdUnits, xMidPanel + 7 + 12, yTroop + 1, 4577 xxu * 2, yyu * 2, 1 + 6 * (xxu * 2 + 1), 1); 4578 end; 4579 4580 MakeBlue(Panel, xMidPanel + 7 + 12 + 10, yTroop - 13, 44, 12); 4581 s := MovementToString(MyUn[UnFocus]); 4582 RisedTextOut(Panel.Canvas, xMidPanel + 7 + 12 + 32 - 4583 BiColorTextWidth(Panel.Canvas, s) div 2, yTroop - 16, s); 4584 4585 s := IntToStr(Health) + '%'; 4586 LightGradient(Panel.Canvas, xMidPanel + 7 + 12 + 7, 4587 PanelHeight - 22, (Health + 1) div 2, 4588 (ColorOfHealth(Health) and $FEFEFE shr 2) * 3); 4589 if Health < 100 then 4590 LightGradient(Panel.Canvas, xMidPanel + 7 + 12 + 7 + (Health + 1) 4591 div 2, PanelHeight - 22, 50 - (Health + 1) div 2, $000000); 4592 RisedTextOut(Panel.Canvas, xMidPanel + 7 + 12 + 32 - 4593 BiColorTextWidth(Panel.Canvas, s) div 2, PanelHeight - 23, s); 4594 4595 FrameImage(Panel.Canvas, GrExt[HGrSystem].Data, 4596 xMidPanel + 7 + xUnitText, yTroop + 15, 12, 14, 4597 121 + Exp div ExpCost * 13, 28); 4598 if Job = jCity then 4599 s := Tribe[me].ModelName[-1] 4600 else 4601 s := Tribe[me].ModelName[mix]; 4602 if Home >= 0 then 4603 begin 4604 LoweredTextOut(Panel.Canvas, -1, MainTexture, 4605 xMidPanel + 7 + xUnitText + 18, yTroop + 5, s); 4606 LoweredTextOut(Panel.Canvas, -1, MainTexture, 4607 xMidPanel + 7 + xUnitText + 18, yTroop + 21, 4608 '(' + CityName(MyCity[Home].ID) + ')'); 4609 end 4610 else 4611 LoweredTextOut(Panel.Canvas, -1, MainTexture, 4612 xMidPanel + 7 + xUnitText + 18, yTroop + 13, s); 4613 end; 4614 4615 if (UnFocus >= 0) and (MyUn[UnFocus].Loc <> TroopLoc) then 4616 begin // divide panel 4617 if SmallScreen and not supervising then 4618 x := xTroop - 8 4619 else 4620 x := xTroop - 152; 4621 Pen.Color := MainTexture.clBevelShade; 4622 MoveTo(x - 1, PanelHeight - MidPanelHeight + 2); 4623 LineTo(x - 1, PanelHeight); 4624 Pen.Color := MainTexture.clBevelLight; 4625 MoveTo(x, PanelHeight - MidPanelHeight + 2); 4626 LineTo(x, PanelHeight); 4627 end; 4628 4629 for i := 0 to 23 do 4630 trix[i] := -1; 4631 if MyMap[TroopLoc] and fUnit <> 0 then 4632 begin 4633 if MyMap[TroopLoc] and fOwned <> 0 then 4634 begin 4635 if (TrCnt > 1) or (UnFocus < 0) or (MyUn[UnFocus].Loc <> TroopLoc) 4636 then 4637 begin 4638 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop + 10, 4639 PanelHeight - 24, Phrases.Lookup('PRESENT')); 4640 Server(sGetDefender, me, TroopLoc, uixDefender); 4641 Count := 0; 4642 for Prio := true downto false do 4643 for uix := 0 to MyRO.nUn - 1 do 4644 if (uix = uixDefender) = Prio then 4645 begin // display own units 4646 unx := MyUn[uix]; 4647 if unx.Loc = TroopLoc then 4648 begin 4649 if (Count >= TrRow * sb.si.npos) and 4650 (Count < TrRow * (sb.si.npos + 1)) then 4651 begin 4652 trix[Count - TrRow * sb.si.npos] := uix; 4653 MakeUnitInfo(me, unx, UnitInfo); 4654 x := (Count - TrRow * sb.si.npos) * TrPitch; 4655 if uix = UnFocus then 4656 begin 4657 Frame(Panel.Canvas, xTroop + 4 + x, yTroop + 3, 4658 xTroop + 64 + x, yTroop + 47, $000000, $000000); 4659 Frame(Panel.Canvas, xTroop + 3 + x, yTroop + 2, 4660 xTroop + 63 + x, yTroop + 46, MainTexture.clMark, 4661 MainTexture.clMark); 4662 end 4663 else if (unx.Master >= 0) and (unx.Master = UnFocus) 4664 then 4665 begin 4666 CFrame(Panel.Canvas, xTroop + 4 + x, yTroop + 3, 4667 xTroop + 64 + x, yTroop + 47, 8, $000000); 4668 CFrame(Panel.Canvas, xTroop + 3 + x, yTroop + 2, 4669 xTroop + 63 + x, yTroop + 46, 8, 4670 MainTexture.clMark); 4671 end; 4672 NoMap.SetOutput(Panel); 4673 NoMap.PaintUnit(xTroop + 2 + x, yTroop + 1, UnitInfo, 4674 unx.Status); 4675 if (ClientMode < scContact) and 4676 ((unx.Job > jNone) or 4677 (unx.Status and (usStay or usRecover or usGoto) <> 0)) 4678 then 4679 Sprite(Panel, HGrSystem, xTroop + 2 + 60 - 20 + x, 4680 yTroop + 35, 20, 20, 81, 25); 4681 4682 if not supervising then 4683 begin 4684 MakeBlue(Panel, xTroop + 2 + 10 + x, 4685 yTroop - 13, 44, 12); 4686 s := MovementToString(unx); 4687 RisedTextOut(Panel.Canvas, 4688 xTroop + x + 34 - BiColorTextWidth(Panel.Canvas, s) 4689 div 2, yTroop - 16, s); 4690 end 4691 end; 4692 inc(Count) 4693 end; 4694 end; // for uix:=0 to MyRO.nUn-1 4695 assert(Count = TrCnt); 4696 end 4697 end 4698 else 4699 begin 4700 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop + 8, 4701 PanelHeight - 24, Phrases.Lookup('PRESENT')); 4702 Server(sGetUnits, me, TroopLoc, Count); 4703 for i := 0 to Count - 1 do 4704 if (i >= TrRow * sb.si.npos) and (i < TrRow * (sb.si.npos + 1)) 4705 then 4706 begin // display enemy units 4707 trix[i - TrRow * sb.si.npos] := i; 4708 x := (i - TrRow * sb.si.npos) * TrPitch; 4709 NoMap.SetOutput(Panel); 4710 NoMap.PaintUnit(xTroop + 2 + x, yTroop + 1, 4711 MyRO.EnemyUn[MyRO.nEnemyUn + i], 0); 4712 end; 4713 end; 4714 end; 4715 if not SmallScreen or supervising then 4716 begin // show terrain and improvements 4717 PaintZoomedTile(Panel, xTerrain - xxt * 2, 110 - yyt * 3, TroopLoc); 4718 if (UnFocus >= 0) and (MyUn[UnFocus].Job <> jNone) then 4719 begin 4720 JobFocus := MyUn[UnFocus].Job; 4721 Server(sGetJobProgress, me, MyUn[UnFocus].Loc, JobProgressData); 4722 MakeBlue(Panel, xTerrain - 72, 148 - 17, 144, 31); 4723 PaintRelativeProgressBar(Panel.Canvas, 3, xTerrain - 68, 148 + 3, 4724 63, JobProgressData[JobFocus].Done, 4725 JobProgressData[JobFocus].NextTurnPlus, 4726 JobProgressData[JobFocus].Required, true, MainTexture); 4727 s := Format('%s/%s', 4728 [ScreenTools.MovementToString(JobProgressData[JobFocus].Done), 4729 ScreenTools.MovementToString(JobProgressData[JobFocus] 4730 .Required)]); 4731 RisedTextOut(Panel.Canvas, xTerrain + 6, 148 - 3, s); 4732 Tile := MyMap[MyUn[UnFocus].Loc]; 4733 if (JobFocus = jRoad) and (Tile and fRiver <> 0) then 4734 JobFocus := nJob + 0 4735 else if (JobFocus = jRR) and (Tile and fRiver <> 0) then 4736 JobFocus := nJob + 1 4737 else if JobFocus = jClear then 4738 begin 4739 if Tile and fTerrain = fForest then 4740 JobFocus := nJob + 2 4741 else if Tile and fTerrain = fDesert then 4742 JobFocus := nJob + 3 4743 else 4744 JobFocus := nJob + 4 4745 end; 4746 s := Phrases.Lookup('JOBRESULT', JobFocus); 4747 RisedTextOut(Panel.Canvas, xTerrain - BiColorTextWidth(Panel.Canvas, 4748 s) div 2, 148 - 19, s); 4749 end; 4750 if MyMap[TroopLoc] and (fTerrain or fSpecial) = fGrass or fSpecial1 4751 then 4752 s := Phrases.Lookup('TERRAIN', fGrass + 12) 4753 else if MyMap[TroopLoc] and fDeadLands <> 0 then 4754 s := Phrases.Lookup('TERRAIN', 3 * 12) 4755 else if (MyMap[TroopLoc] and fTerrain = fForest) and 4756 IsJungle(TroopLoc div G.lx) then 4757 s := Phrases.Lookup('TERRAIN', fJungle) 4758 else 4759 s := Phrases.Lookup('TERRAIN', MyMap[TroopLoc] and fTerrain); 4760 RisedTextOut(Panel.Canvas, xTerrain - BiColorTextWidth(Panel.Canvas, 4761 s) div 2, 99, s); 4762 end; 4763 4764 if TerrainBtn.Visible then 4765 with TerrainBtn do 4766 RFrame(Panel.Canvas, Left - 1, Top - self.ClientHeight + 4767 (PanelHeight - 1), Left + width, Top + height - self.ClientHeight 4768 + PanelHeight, MainTexture.clBevelShade, MainTexture.clBevelLight) 4769 end { if TroopLoc>=0 } 4770 end; 4771 4772 for i := 0 to ControlCount - 1 do 4773 if Controls[i] is TButtonB then 4774 with TButtonB(Controls[i]) do 4775 begin 4776 if Visible then 4777 begin 4778 Dump(Panel, HGrSystem, Left, Top - self.ClientHeight + PanelHeight, 4779 25, 25, 169, 243); 4780 Sprite(Panel, HGrSystem, Left, Top - self.ClientHeight + 4781 PanelHeight, 25, 25, 1 + 26 * ButtonIndex, 337); 4782 RFrame(Panel.Canvas, Left - 1, Top - self.ClientHeight + 4783 (PanelHeight - 1), Left + width, Top + height - self.ClientHeight 4784 + PanelHeight, MainTexture.clBevelShade, 4785 MainTexture.clBevelLight); 4786 end; 4787 end; 4788 4789 if ClientMode <> cEditMap then 4790 begin 4791 for i := 0 to ControlCount - 1 do 4792 if Controls[i] is TButtonC then 4793 with TButtonC(Controls[i]) do 4794 begin 4795 Dump(Panel, HGrSystem, Left, Top - self.ClientHeight + PanelHeight, 4796 12, 12, 169, 178 + 13 * ButtonIndex); 4797 RFrame(Panel.Canvas, Left - 1, Top - self.ClientHeight + 4798 (PanelHeight - 1), Left + width, Top + height - self.ClientHeight 4799 + PanelHeight, MainTexture.clBevelShade, 4800 MainTexture.clBevelLight); 4801 end 4802 end; 4803 EOT.SetBack(Panel.Canvas, EOT.Left, EOT.Top - (ClientHeight - PanelHeight)); 4804 SmartRectInvalidate(0, ClientHeight - PanelHeight, ClientWidth, 4805 ClientHeight); 4806 4807 // topbar 4808 xTreasurySection := ClientWidth div 2 - 172; 4809 xResearchSection := ClientWidth div 2; 4810 // ClientWidth div 2+68 = maximum to right 4811 FillLarge(TopBar.Canvas, 0, 0, ClientWidth, TopBarHeight - 3, 4812 ClientWidth div 2); 4813 with TopBar.Canvas do 4814 begin 4815 Pen.Color := $000000; 4816 MoveTo(0, TopBarHeight - 1); 4817 LineTo(ClientWidth, TopBarHeight - 1); 4818 Pen.Color := MainTexture.clBevelShade; 4819 MoveTo(0, TopBarHeight - 2); 4820 LineTo(ClientWidth, TopBarHeight - 2); 4821 MoveTo(0, TopBarHeight - 3); 4822 LineTo(ClientWidth, TopBarHeight - 3); 4823 Pen.Color := MainTexture.clBevelLight; 4824 Frame(TopBar.Canvas, 40, -1, xTreasurySection - 1, TopBarHeight - 7, 4825 MainTexture.clBevelShade, MainTexture.clBevelLight); 4826 Frame(TopBar.Canvas, xResearchSection + 332, -1, ClientWidth, 4827 TopBarHeight - 7, MainTexture.clBevelShade, MainTexture.clBevelLight); 4828 end; 4829 if GameMode <> cMovie then 4830 ImageOp_BCC(TopBar, Templates, 2, 1, 145, 38, 36, 36, $BFBF20, $4040DF); 4831 if MyRO.nCity > 0 then 4832 begin 4833 TrueMoney := MyRO.Money; 4834 TrueResearch := MyRO.Research; 4835 if supervising then 4836 begin // normalize values from after-turn state 4837 dec(TrueMoney, TaxSum); 4838 if TrueMoney < 0 then 4839 TrueMoney := 0; // shouldn't happen 4840 dec(TrueResearch, ScienceSum); 4841 if TrueResearch < 0 then 4842 TrueResearch := 0; // shouldn't happen 4843 end; 4844 4845 // treasury section 4846 ImageOp_BCC(TopBar, Templates, xTreasurySection + 8, 1, 145, 1, 36, 36, 4847 $40A040, $4030C0); 4848 s := IntToStr(TrueMoney); 4849 LoweredTextOut(TopBar.Canvas, -1, MainTexture, xTreasurySection + 48, 0, 4850 s + '%c'); 4851 if MyRO.Government <> gAnarchy then 4852 begin 4853 ImageOp_BCC(TopBar, Templates, xTreasurySection + 48, 22, 124, 1, 14, 4854 14, $0000C0, $0080C0); 4855 if TaxSum >= 0 then 4856 s := Format(Phrases.Lookup('MONEYGAINPOS'), [TaxSum]) 4857 else 4858 s := Format(Phrases.Lookup('MONEYGAINNEG'), [TaxSum]); 4859 LoweredTextOut(TopBar.Canvas, -1, MainTexture, 4860 xTreasurySection + 48 + 15, 18, s); 4861 end; 4862 4863 // research section 4864 ImageOp_BCC(TopBar, Templates, xResearchSection + 8, 1, 145, 75, 36, 36, 4865 $FF0000, $00FFE0); 4866 if MyData.FarTech <> adNexus then 4867 begin 4868 if MyRO.ResearchTech < 0 then 4869 CostFactor := 2 4870 else if (MyRO.ResearchTech = adMilitary) or 4871 (MyRO.Tech[MyRO.ResearchTech] = tsSeen) then 4872 CostFactor := 1 4873 else if MyRO.ResearchTech in FutureTech then 4874 if MyRO.Government = gFuture then 4875 CostFactor := 4 4876 else 4877 CostFactor := 8 4878 else 4879 CostFactor := 2; 4880 Server(sGetTechCost, me, 0, i); 4881 CostFactor := CostFactor * 22; // length of progress bar 4882 PaintRelativeProgressBar(TopBar.Canvas, 2, xResearchSection + 48 + 1, 4883 26, CostFactor, TrueResearch, ScienceSum, i, true, MainTexture); 4884 4885 if MyRO.ResearchTech < 0 then 4886 s := Phrases.Lookup('SCIENCE') 4887 else if MyRO.ResearchTech = adMilitary then 4888 s := Phrases.Lookup('INITUNIT') 4889 else 4890 begin 4891 s := Phrases.Lookup('ADVANCES', MyRO.ResearchTech); 4892 if MyRO.ResearchTech in FutureTech then 4893 if MyRO.Tech[MyRO.ResearchTech] >= 1 then 4894 s := s + ' ' + IntToStr(MyRO.Tech[MyRO.ResearchTech] + 1) 4895 else 4896 s := s + ' 1'; 4897 end; 4898 if ScienceSum > 0 then 4899 begin 4900 { j:=(i-MyRO.Research-1) div ScienceSum +1; 4901 if j<1 then j:=1; 4902 if j>1 then 4903 s:=Format(Phrases.Lookup('TECHWAIT'),[s,j]); } 4904 LoweredTextOut(TopBar.Canvas, -1, MainTexture, 4905 xResearchSection + 48, 0, s); 4906 end 4907 else 4908 LoweredTextOut(TopBar.Canvas, -1, MainTexture, 4909 xResearchSection + 48, 0, s); 4910 end 4911 else 4912 CostFactor := 0; 4913 if (MyData.FarTech <> adNexus) and (ScienceSum > 0) then 4914 begin 4915 ImageOp_BCC(TopBar, Templates, xResearchSection + 48 + CostFactor + 11, 4916 22, 124, 1, 14, 14, $0000C0, $0080C0); 4917 s := Format(Phrases.Lookup('TECHGAIN'), [ScienceSum]); 4918 LoweredTextOut(TopBar.Canvas, -1, MainTexture, xResearchSection + 48 + 4919 CostFactor + 26, 18, s); 4920 end 4921 end; 4922 if ClientMode <> cEditMap then 4923 begin 4924 TopBar.Canvas.Font.Assign(UniFont[ftCaption]); 4925 s := TurnToString(MyRO.Turn); 4926 RisedTextOut(TopBar.Canvas, 4927 40 + (xTreasurySection - 40 - BiColorTextWidth(TopBar.Canvas, s)) 4928 div 2, 6, s); 4929 TopBar.Canvas.Font.Assign(UniFont[ftNormal]); 4930 end; 4931 RectInvalidate(0, 0, ClientWidth, TopBarHeight); 4932 end; { PanelPaint } 4933 4934 procedure TMainScreen.FocusOnLoc(Loc: integer; Options: integer = 0); 4935 var 4936 dx: integer; 4937 Outside, Changed: boolean; 4938 begin 4939 dx := G.lx + 1 - (xw - Loc + G.lx * 1024 + 1) mod G.lx; 4940 Outside := (dx >= (MapWidth + 1) div (xxt * 2) - 2) or (ywmax > 0) and 4941 ((yw > 0) and (Loc div G.lx <= yw + 1) or (yw < ywmax) and 4942 (Loc div G.lx >= yw + (MapHeight - 1) div yyt - 2)); 4943 Changed := true; 4944 if Outside then 4945 begin 4946 Centre(Loc); 4947 PaintAllMaps 4948 end 4949 else if not MapValid then 4950 PaintAllMaps 4951 else 4952 Changed := false; 4953 if Options and flRepaintPanel <> 0 then 4954 PanelPaint; 4955 if Changed and (Options and flImmUpdate <> 0) then 4956 Update; 4957 end; 4958 4959 procedure TMainScreen.NextUnit(NearLoc: integer; AutoTurn: boolean); 4960 var 4961 Dist, TestDist: single; 4962 i, uix, NewFocus: integer; 4963 GotoOnly: boolean; 4964 begin 4965 if ClientMode >= scContact then 4966 exit; 4967 DestinationMarkON := false; 4968 PaintDestination; 4969 for GotoOnly := GoOnPhase downto false do 4970 begin 4971 NewFocus := -1; 4972 for i := 1 to MyRO.nUn do 4973 begin 4974 uix := (UnFocus + i) mod MyRO.nUn; 4975 if (MyUn[uix].Loc >= 0) and (MyUn[uix].Job = jNone) and 4976 (MyUn[uix].Status and (usStay or usRecover or usWaiting) = usWaiting) 4977 and (not GotoOnly or (MyUn[uix].Status and usGoto <> 0)) then 4978 if NearLoc < 0 then 4979 begin 4980 NewFocus := uix; 4981 Break 4982 end 4983 else 4984 begin 4985 TestDist := Distance(NearLoc, MyUn[uix].Loc); 4986 if (NewFocus < 0) or (TestDist < Dist) then 4987 begin 4988 NewFocus := uix; 4989 Dist := TestDist 4990 end 4991 end 4992 end; 4993 if GotoOnly then 4994 if NewFocus < 0 then 4995 GoOnPhase := false 4996 else 4997 Break; 4998 end; 4999 if NewFocus >= 0 then 5000 begin 5001 SetUnFocus(NewFocus); 5002 SetTroopLoc(MyUn[NewFocus].Loc); 5003 FocusOnLoc(TroopLoc, flRepaintPanel) 5004 end 5005 else if AutoTurn and not mWaitTurn.Checked then 5006 begin 5007 TurnComplete := true; 5008 SetUnFocus(-1); 5009 SetTroopLoc(-1); 5010 PostMessage(Handle, WM_EOT, 0, 0) 5011 end 5012 else 5013 begin 5014 if { (UnFocus>=0) and } not TurnComplete and EOT.Visible then 5015 Play('TURNEND'); 5016 TurnComplete := true; 5017 SetUnFocus(-1); 5018 SetTroopLoc(-1); 5019 PanelPaint; 5020 end; 5021 end; { NextUnit } 5022 5023 procedure TMainScreen.Scroll(dx, dy: integer); 5024 begin 5025 xw := (xw + G.lx + dx) mod G.lx; 5026 if ywmax > 0 then 5027 begin 5028 yw := yw + 2 * dy; 5029 if yw < 0 then 5030 yw := 0 5031 else if yw > ywmax then 5032 yw := ywmax; 5033 end; 5034 MainOffscreenPaint; 5035 xwMini := xw; 5036 ywMini := yw; 5037 MiniPaint; 5038 CopyMiniToPanel; 5039 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 2, 5040 xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini + 5041 2 + G.ly); 5042 Update; 5043 end; 5044 5045 procedure TMainScreen.Timer1Timer(Sender: TObject); 5046 var 5047 dx, dy, speed: integer; 5048 begin 5049 if idle and (me >= 0) and (GameMode <> cMovie) then 5050 if (fsModal in Screen.ActiveForm.FormState) or 5051 (Screen.ActiveForm is TBufferedDrawDlg) and 5052 (TBufferedDrawDlg(Screen.ActiveForm).WindowMode <> wmPersistent) then 5053 begin 5054 BlinkTime := BlinkOnTime + BlinkOffTime - 1; 5055 if not BlinkON then 5056 begin 5057 BlinkON := true; 5058 if UnFocus >= 0 then 5059 PaintLocTemp(MyUn[UnFocus].Loc) 5060 else if TurnComplete and not supervising then 5061 EOT.SetButtonIndexFast(eotBlinkOn) 5062 end 5063 end 5064 else 5065 begin 5066 if Application.Active and not mScrollOff.Checked then 5067 begin 5068 if mScrollFast.Checked then 5069 speed := 2 5070 else 5071 speed := 1; 5072 dx := 0; 5073 dy := 0; 5074 if Mouse.CursorPos.y < Screen.height - PanelHeight then 5075 if Mouse.CursorPos.x = 0 then 5076 dx := -speed // scroll left 5077 else if Mouse.CursorPos.x = Screen.width - 1 then 5078 dx := speed; // scroll right 5079 if Mouse.CursorPos.y = 0 then 5080 dy := -speed // scroll up 5081 else if (Mouse.CursorPos.y = Screen.height - 1) and 5082 (Mouse.CursorPos.x >= TerrainBtn.Left + TerrainBtn.width) and 5083 (Mouse.CursorPos.x < xRightPanel + 10 - 8) then 5084 dy := speed; // scroll down 5085 if (dx <> 0) or (dy <> 0) then 5086 begin 5087 if (Screen.ActiveForm <> MainScreen) and 5088 (@Screen.ActiveForm.OnDeactivate <> nil) then 5089 Screen.ActiveForm.OnDeactivate(nil); 5090 Scroll(dx, dy); 5091 end 5092 end; 5093 5094 BlinkTime := (BlinkTime + 1) mod (BlinkOnTime + BlinkOffTime); 5095 BlinkON := BlinkTime >= BlinkOffTime; 5096 DestinationMarkON := true; 5097 if UnFocus >= 0 then 5098 begin 5099 if (BlinkTime = 0) or (BlinkTime = BlinkOffTime) then 5100 begin 5101 PaintLocTemp(MyUn[UnFocus].Loc, pltsBlink); 5102 PaintDestination; 5103 // if MoveHintToLoc>=0 then 5104 // ShowMoveHint(MoveHintToLoc, true); 1703 5105 end 1704 5106 end 1705 else 1706 begin 1707 s:=Tribe[me].TPhrase('AGE'+char(48+Age)); 1708 MessgText:=Format(s,[TurnToString(MyRO.Turn)]); 1709 end; 1710 IconKind:=mikAge; 1711 IconIndex:=Age; 1712 {if age=0 then} Kind:=mkOK 1713 {else begin Kind:=mkOkHelp; HelpKind:=hkAdv; HelpNo:=AgePreq[age]; end}; 1714 CenterTo:=NewAgeCenterTo; 1715 OpenSound:='AGE_'+char(48+Age); 1716 ShowModal; 1717 MyData.ToldAge:=Age; 1718 if Age>0 then 1719 MyData.ToldTech[AgePreq[Age]]:=MyRO.Tech[AgePreq[Age]]; 1720 end; 1721 1722 if MyData.ToldAlive<>MyRO.Alive then 1723 begin 1724 for p1:=0 to nPl-1 do 1725 if (MyData.ToldAlive-MyRO.Alive) and (1 shl p1)<>0 then 1726 with MessgExDlg do 1727 begin 1728 OpenSound:='MSG_EXTINCT'; 1729 s:=Tribe[p1].TPhrase('EXTINCT'); 1730 MessgText:=Format(s,[TurnToString(MyRO.Turn)]); 1731 if MyRO.Alive=1 shl me then 1732 MessgText:=MessgText+Phrases.Lookup('EXTINCTALL'); 1733 Kind:=mkOK; 1734 IconKind:=mikImp; 1735 IconIndex:=21; 1736 ShowModal; 5107 else if TurnComplete and not supervising then 5108 begin 5109 if BlinkTime = 0 then 5110 EOT.SetButtonIndexFast(eotBlinkOff) 5111 else if BlinkTime = BlinkOffTime then 5112 EOT.SetButtonIndexFast(eotBlinkOn) 5113 end 5114 end 5115 end; 5116 5117 procedure TMainScreen.Centre(Loc: integer); 5118 begin 5119 if FastScrolling and MapValid then 5120 Update; 5121 // necessary because ScrollDC for form canvas is called after 5122 xw := (Loc mod G.lx - (MapWidth - xxt * 2 * ((Loc div G.lx) and 1)) 5123 div (xxt * 4) + G.lx) mod G.lx; 5124 if ywmax <= 0 then 5125 yw := ywcenter 5126 else 5127 begin 5128 yw := (Loc div G.lx - MapHeight div (yyt * 2) + 1) and not 1; 5129 if yw < 0 then 5130 yw := 0 5131 else if yw > ywmax then 5132 yw := ywmax; 5133 end 5134 end; 5135 5136 function TMainScreen.ZoomToCity(Loc: integer; 5137 NextUnitOnClose: boolean = false; ShowEvent: integer = 0): boolean; 5138 begin 5139 result := MyMap[Loc] and (fOwned or fSpiedOut) <> 0; 5140 if result then 5141 with CityDlg do 5142 begin 5143 if ClientMode >= scContact then 5144 begin 5145 CloseAction := None; 5146 RestoreUnFocus := -1; 5147 end 5148 else if NextUnitOnClose then 5149 begin 5150 CloseAction := StepFocus; 5151 RestoreUnFocus := -1; 5152 end 5153 else if not Visible then 5154 begin 5155 CloseAction := RestoreFocus; 5156 RestoreUnFocus := UnFocus; 5157 end; 5158 SetUnFocus(-1); 5159 SetTroopLoc(Loc); 5160 MarkCityLoc := Loc; 5161 PanelPaint; 5162 ShowNewContent(wmPersistent, Loc, ShowEvent); 5163 end 5164 end; 5165 5166 function TMainScreen.LocationOfScreenPixel(x, y: integer): integer; 5167 var 5168 qx, qy: integer; 5169 begin 5170 qx := (x * (yyt * 2) + y * (xxt * 2) + xxt * yyt * 2) 5171 div (xxt * yyt * 4) - 1; 5172 qy := (y * (xxt * 2) - x * (yyt * 2) - xxt * yyt * 2 + 4000 * xxt * yyt) 5173 div (xxt * yyt * 4) - 999; 5174 result := (xw + (qx - qy + 2048) div 2 - 1024 + G.lx) mod G.lx + G.lx * 5175 (yw + qx + qy); 5176 end; 5177 5178 procedure TMainScreen.MapBoxMouseDown(Sender: TObject; Button: TMouseButton; 5179 Shift: TShiftState; x, y: integer); 5180 var 5181 i, uix, emix, p1, dx, dy, MouseLoc: integer; 5182 EditTileData: TEditTileData; 5183 m, m2: TMenuItem; 5184 MoveAdviceData: TMoveAdviceData; 5185 DoCenter: boolean; 5186 begin 5187 if GameMode = cMovie then 5188 exit; 5189 5190 if CityDlg.Visible then 5191 CityDlg.Close; 5192 if UnitStatDlg.Visible then 5193 UnitStatDlg.Close; 5194 MouseLoc := LocationOfScreenPixel(x, y); 5195 if (MouseLoc < 0) or (MouseLoc >= G.lx * G.ly) then 5196 exit; 5197 if (Button = mbLeft) and not(ssShift in Shift) then 5198 begin 5199 DoCenter := true; 5200 if ClientMode = cEditMap then 5201 begin 5202 DoCenter := false; 5203 EditTileData.Loc := MouseLoc; 5204 if ssCtrl in Shift then // toggle special resource 5205 case MyMap[MouseLoc] and fTerrain of 5206 fOcean: 5207 EditTileData.NewTile := MyMap[MouseLoc]; 5208 fGrass, fArctic: 5209 EditTileData.NewTile := MyMap[MouseLoc] and not fSpecial or 5210 ((MyMap[MouseLoc] shr 5 and 3 + 1) mod 2 shl 5); 5211 else 5212 EditTileData.NewTile := MyMap[MouseLoc] and not fSpecial or 5213 ((MyMap[MouseLoc] shr 5 and 3 + 1) mod 3 shl 5) 5214 end 5215 else if BrushType <= fTerrain then 5216 EditTileData.NewTile := MyMap[MouseLoc] and not fTerrain or 5217 fSpecial or BrushType 5218 else if BrushType and fDeadLands <> 0 then 5219 if MyMap[MouseLoc] and (fDeadLands or fModern) = BrushType and 5220 (fDeadLands or fModern) then 5221 EditTileData.NewTile := MyMap[MouseLoc] and 5222 not(fDeadLands or fModern) 5223 else 5224 EditTileData.NewTile := MyMap[MouseLoc] and 5225 not(fDeadLands or fModern) or BrushType 5226 else if BrushType and fTerImp <> 0 then 5227 if MyMap[MouseLoc] and fTerImp = BrushType then 5228 EditTileData.NewTile := MyMap[MouseLoc] and not fTerImp 5229 else 5230 EditTileData.NewTile := MyMap[MouseLoc] and not fTerImp or BrushType 5231 else if BrushType and (fPrefStartPos or fStartPos) <> 0 then 5232 if MyMap[MouseLoc] and (fPrefStartPos or fStartPos) = BrushType and 5233 (fPrefStartPos or fStartPos) then 5234 EditTileData.NewTile := MyMap[MouseLoc] and 5235 not(fPrefStartPos or fStartPos) 5236 else 5237 EditTileData.NewTile := MyMap[MouseLoc] and 5238 not(fPrefStartPos or fStartPos) or BrushType 5239 else 5240 EditTileData.NewTile := MyMap[MouseLoc] xor BrushType; 5241 Server(sEditTile, me, 0, EditTileData); 5242 Edited := true; 5243 BrushLoc := MouseLoc; 5244 PaintLoc(MouseLoc, 2); 5245 MiniPaint; 5246 BitBlt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly, 5247 Mini.Canvas.Handle, 0, 0, SRCCOPY); 5248 if ywmax <= 0 then 5249 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (2 * xxt), 5250 yMini + 2, xMini + 1 + G.lx + MapWidth div (2 * xxt), 5251 yMini + 2 + G.ly - 1, MainTexture.clMark, MainTexture.clMark) 5252 else 5253 Frame(Panel.Canvas, xMini + 2 + G.lx - MapWidth div (2 * xxt), 5254 yMini + 2 + yw, xMini + 2 + G.lx + MapWidth div (2 * xxt) - 1, 5255 yMini + 2 + yw + MapHeight div yyt - 2, MainTexture.clMark, 5256 MainTexture.clMark); 5257 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 5258 2, xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini 5259 + 2 + G.ly) 5260 end 5261 else if MyMap[MouseLoc] and fCity <> 0 then { city clicked } 5262 begin 5263 if MyMap[MouseLoc] and (fOwned or fSpiedOut) <> 0 then 5264 begin 5265 ZoomToCity(MouseLoc); 5266 DoCenter := false; 5267 end 5268 else 5269 begin 5270 UnitStatDlg.ShowNewContent_EnemyCity(wmPersistent, MouseLoc); 5271 DoCenter := false; 5272 end 5273 end 5274 else if MyMap[MouseLoc] and fUnit <> 0 then { unit clicked } 5275 if MyMap[MouseLoc] and fOwned <> 0 then 5276 begin 5277 DoCenter := false; 5278 if not supervising and (ClientMode < scContact) then 5279 begin // not in negotiation mode 5280 if (UnFocus >= 0) and (MyUn[UnFocus].Loc = MouseLoc) then 5281 begin // rotate 5282 uix := (UnFocus + 1) mod MyRO.nUn; 5283 i := MyRO.nUn - 1; 5284 while i > 0 do 5285 begin 5286 if (MyUn[uix].Loc = MouseLoc) and (MyUn[uix].Job = jNone) and 5287 (MyUn[uix].Status and (usStay or usRecover or usEnhance or 5288 usWaiting) = usWaiting) then 5289 Break; 5290 dec(i); 5291 uix := (uix + 1) mod MyRO.nUn; 5292 end; 5293 if i = 0 then 5294 uix := UnFocus 5295 end 5296 else 5297 Server(sGetDefender, me, MouseLoc, uix); 5298 if uix <> UnFocus then 5299 SetUnFocus(uix); 5300 TurnComplete := false; 5301 EOT.ButtonIndex := eotGray; 5302 end; 5303 SetTroopLoc(MouseLoc); 5304 PanelPaint; 5305 end // own unit 5306 else if (MyMap[MouseLoc] and fSpiedOut <> 0) and not(ssCtrl in Shift) 5307 then 5308 begin 5309 DoCenter := false; 5310 SetTroopLoc(MouseLoc); 5311 PanelPaint; 5312 end 5313 else 5314 begin 5315 DoCenter := false; 5316 UnitStatDlg.ShowNewContent_EnemyLoc(wmPersistent, MouseLoc); 5317 end; 5318 if DoCenter then 5319 begin 5320 Centre(MouseLoc); 5321 PaintAllMaps 5322 end 5323 end 5324 else if (ClientMode <> cEditMap) and (Button = mbRight) and 5325 not(ssShift in Shift) then 5326 begin 5327 if supervising then 5328 begin 5329 EditLoc := MouseLoc; 5330 Server(sGetModels, me, 0, nil^); 5331 EmptyMenu(mCreateUnit); 5332 for p1 := 0 to nPl - 1 do 5333 if 1 shl p1 and MyRO.Alive <> 0 then 5334 begin 5335 m := TMenuItem.Create(mCreateUnit); 5336 m.Caption := Tribe[p1].TPhrase('SHORTNAME'); 5337 for emix := MyRO.nEnemyModel - 1 downto 0 do 5338 if (MyRO.EnemyModel[emix].Owner = p1) and 5339 (Server(sCreateUnit - sExecute + p1 shl 4, me, 5340 MyRO.EnemyModel[emix].mix, MouseLoc) >= rExecuted) then 5341 begin 5342 if Tribe[p1].ModelPicture[MyRO.EnemyModel[emix].mix].HGr = 0 5343 then 5344 InitEnemyModel(emix); 5345 m2 := TMenuItem.Create(m); 5346 m2.Caption := Tribe[p1].ModelName[MyRO.EnemyModel[emix].mix]; 5347 m2.Tag := p1 shl 16 + MyRO.EnemyModel[emix].mix; 5348 m2.OnClick := CreateUnitClick; 5349 m.Add(m2); 5350 end; 5351 m.Visible := m.Count > 0; 5352 mCreateUnit.Add(m); 5353 end; 5354 if FullScreen then 5355 EditPopup.Popup(Left + x, Top + y) 5356 else 5357 EditPopup.Popup(Left + x + 4, 5358 Top + y + GetSystemMetrics(SM_CYCAPTION) + 4); 5359 end 5360 else if (UnFocus >= 0) and (MyUn[UnFocus].Loc <> MouseLoc) then 5361 with MyUn[UnFocus] do 5362 begin 5363 dx := ((MouseLoc mod G.lx * 2 + MouseLoc div G.lx and 1) - 5364 (Loc mod G.lx * 2 + Loc div G.lx and 1) + 3 * G.lx) 5365 mod (2 * G.lx) - G.lx; 5366 dy := MouseLoc div G.lx - Loc div G.lx; 5367 if abs(dx) + abs(dy) < 3 then 5368 begin 5369 DestinationMarkON := false; 5370 PaintDestination; 5371 Status := Status and 5372 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting; 5373 MoveUnit(dx, dy, muAutoNext) { simple move } 5374 end 5375 else if GetMoveAdvice(UnFocus, MouseLoc, MoveAdviceData) >= rExecuted 5376 then 5377 begin 5378 if MyMap[MouseLoc] and (fUnit or fOwned) = fUnit then 5379 begin // check for suicide mission before movement 5380 with MyUn[UnFocus], BattleDlg.Forecast do 5381 begin 5382 pAtt := me; 5383 mixAtt := mix; 5384 HealthAtt := Health; 5385 ExpAtt := Exp; 5386 FlagsAtt := Flags; 5387 end; 5388 BattleDlg.Forecast.Movement := MyUn[UnFocus].Movement; 5389 if (Server(sGetBattleForecastEx, me, MouseLoc, BattleDlg.Forecast) 5390 >= rExecuted) and (BattleDlg.Forecast.EndHealthAtt <= 0) then 5391 begin 5392 BattleDlg.uix := UnFocus; 5393 BattleDlg.ToLoc := MouseLoc; 5394 BattleDlg.IsSuicideQuery := true; 5395 BattleDlg.ShowModal; 5396 if BattleDlg.ModalResult <> mrOK then 5397 exit; 5398 end 1737 5399 end; 1738 if (ClientMode<>cMovieTurn) and not supervising then 1739 DiaDlg.ShowNewContent_Charts(wmModal); 1740 end; 1741 1742 // tell changes of own credibility 1743 if not supervising then 1744 begin 1745 if RoughCredibility(MyRO.Credibility) 1746 <>RoughCredibility(MyData.ToldOwnCredibility) then 1747 begin 1748 if RoughCredibility(MyRO.Credibility) 1749 >RoughCredibility(MyData.ToldOwnCredibility) then 1750 s:=Phrases.Lookup('CREDUP') 1751 else s:=Phrases.Lookup('CREDDOWN'); 1752 TribeMessage(me, Format(s,[Phrases.Lookup('CREDIBILITY', 1753 RoughCredibility(MyRO.Credibility))]), ''); 1754 end; 1755 MyData.ToldOwnCredibility:=MyRO.Credibility; 1756 end; 1757 1758 for i:=0 to 27 do 1759 begin 1760 OwnWonder:=false; 1761 for cix:=0 to MyRO.nCity-1 do 1762 if (MyCity[cix].Loc>=0) and (MyCity[cix].ID=MyRO.Wonder[i].CityID) then 1763 OwnWonder:=true; 1764 if MyRO.Wonder[i].CityID<>MyData.ToldWonders[i].CityID then 1765 begin 1766 if MyRO.Wonder[i].CityID=-2 then with MessgExDlg do 1767 begin {tell about destroyed wonders} 1768 OpenSound:='WONDER_DESTROYED'; 1769 MessgText:=Format(Phrases.Lookup('WONDERDEST'), 1770 [Phrases.Lookup('IMPROVEMENTS',i)]); 1771 Kind:=mkOkHelp; 1772 HelpKind:=hkImp; 1773 HelpNo:=i; 1774 IconKind:=mikImp; 1775 IconIndex:=i; 1776 ShowModal; 1777 end 1778 else 1779 begin 1780 if i=woManhattan then 1781 if MyRO.Wonder[i].EffectiveOwner>me then 1782 MyData.ColdWarStart:=MyRO.Turn-1 1783 else MyData.ColdWarStart:=MyRO.Turn; 1784 if not OwnWonder then with MessgExDlg do 1785 begin {tell about newly built wonders} 1786 if i=woManhattan then 1787 begin 1788 OpenSound:='MSG_COLDWAR'; 1789 s:=Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('COLDWAR') 1790 end 1791 else if MyRO.Wonder[i].EffectiveOwner>=0 then 1792 begin 1793 OpenSound:='WONDER_BUILT'; 1794 s:=Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERBUILT') 1795 end 1796 else 1797 begin 1798 OpenSound:='MSG_DEFAULT'; 1799 s:=Phrases.Lookup('WONDERBUILTEXP'); // already expired when built 1800 end; 1801 MessgText:=Format(s, [Phrases.Lookup('IMPROVEMENTS',i), 1802 CityName(MyRO.Wonder[i].CityID)]); 1803 Kind:=mkOkHelp; 1804 HelpKind:=hkImp; 1805 HelpNo:=i; 1806 IconKind:=mikImp; 1807 IconIndex:=i; 1808 ShowModal; 1809 end 5400 DestinationMarkON := false; 5401 PaintDestination; 5402 Status := Status and not(usStay or usRecover or usEnhance) or 5403 usWaiting; 5404 MoveToLoc(MouseLoc, false); { goto } 1810 5405 end 1811 5406 end 1812 else if (MyRO.Wonder[i].EffectiveOwner<>MyData.ToldWonders[i].EffectiveOwner) 1813 and (MyRO.Wonder[i].CityID>-2) then 1814 if MyRO.Wonder[i].EffectiveOwner<0 then 5407 end 5408 else if (Button = mbMiddle) and (UnFocus >= 0) and 5409 (MyModel[MyUn[UnFocus].mix].Kind in [mkSettler, mkSlaves]) then 5410 begin 5411 DestinationMarkON := false; 5412 PaintDestination; 5413 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 5414 ($FFFF - usStay - usRecover - usGoto) or usEnhance; 5415 uix := UnFocus; 5416 if MouseLoc <> MyUn[uix].Loc then 5417 MoveToLoc(MouseLoc, true); { goto } 5418 if (UnFocus = uix) and (MyUn[uix].Loc = MouseLoc) then 5419 MenuClick(mEnhance) 5420 end 5421 else if (Button = mbLeft) and (ssShift in Shift) and 5422 (MyMap[MouseLoc] and fTerrain <> fUNKNOWN) then 5423 HelpOnTerrain(MouseLoc, wmPersistent) 5424 else if (ClientMode <= cContinue) and (Button = mbRight) and 5425 (ssShift in Shift) and (UnFocus >= 0) and 5426 (MyMap[MouseLoc] and (fUnit or fOwned) = fUnit) then 5427 begin // battle forecast 5428 with MyUn[UnFocus], BattleDlg.Forecast do 5429 begin 5430 pAtt := me; 5431 mixAtt := mix; 5432 HealthAtt := Health; 5433 ExpAtt := Exp; 5434 FlagsAtt := Flags; 5435 end; 5436 BattleDlg.Forecast.Movement := MyUn[UnFocus].Movement; 5437 if Server(sGetBattleForecastEx, me, MouseLoc, BattleDlg.Forecast) >= rExecuted 5438 then 5439 begin 5440 BattleDlg.uix := UnFocus; 5441 BattleDlg.ToLoc := MouseLoc; 5442 BattleDlg.Left := x - BattleDlg.width div 2; 5443 if BattleDlg.Left < 0 then 5444 BattleDlg.Left := 0 5445 else if BattleDlg.Left + BattleDlg.width > Screen.width then 5446 BattleDlg.Left := Screen.width - BattleDlg.width; 5447 BattleDlg.Top := y - BattleDlg.height div 2; 5448 if BattleDlg.Top < 0 then 5449 BattleDlg.Top := 0 5450 else if BattleDlg.Top + BattleDlg.height > Screen.height then 5451 BattleDlg.Top := Screen.height - BattleDlg.height; 5452 BattleDlg.IsSuicideQuery := false; 5453 BattleDlg.Show; 5454 end 5455 end 5456 end; 5457 5458 function TMainScreen.MoveUnit(dx, dy: integer; Options: integer): integer; 5459 // move focused unit to adjacent tile 5460 var 5461 i, cix, uix, euix, FromLoc, ToLoc, DirCode, UnFocus0, Defender, Mission, p1, 5462 NewTiles, cixChanged: integer; 5463 OldToTile: Cardinal; 5464 CityCaptured, IsAttack, OldUnrest, NewUnrest, NeedEcoUpdate, 5465 NeedRepaintPanel, ToTransport, ToShip: boolean; 5466 PlaneReturnData: TPlaneReturnData; 5467 QueryItem: string; 5468 begin 5469 result := eInvalid; 5470 UnFocus0 := UnFocus; 5471 FromLoc := MyUn[UnFocus].Loc; 5472 ToLoc := dLoc(FromLoc, dx, dy); 5473 if (ToLoc < 0) or (ToLoc >= G.lx * G.ly) then 5474 begin 5475 result := eInvalid; 5476 exit; 5477 end; 5478 if MyMap[ToLoc] and fStealthUnit <> 0 then 5479 begin 5480 SoundMessage(Phrases.Lookup('ATTACKSTEALTH'), ''); 5481 exit; 5482 end; 5483 if MyMap[ToLoc] and fHiddenUnit <> 0 then 5484 begin 5485 SoundMessage(Phrases.Lookup('ATTACKSUB'), ''); 5486 exit; 5487 end; 5488 5489 if MyMap[ToLoc] and (fUnit or fOwned) = fUnit then 5490 begin // attack -- search enemy unit 5491 if (MyModel[MyUn[UnFocus].mix].Attack = 0) and 5492 not((MyModel[MyUn[UnFocus].mix].Cap[mcBombs] > 0) and 5493 (MyUn[UnFocus].Flags and unBombsLoaded <> 0)) then 5494 begin 5495 SoundMessage(Phrases.Lookup('NOATTACKER'), ''); 5496 exit; 5497 end; 5498 euix := MyRO.nEnemyUn - 1; 5499 while (euix >= 0) and (MyRO.EnemyUn[euix].Loc <> ToLoc) do 5500 dec(euix); 5501 end; 5502 5503 DirCode := dx and 7 shl 4 + dy and 7 shl 7; 5504 result := Server(sMoveUnit - sExecute + DirCode, me, UnFocus, nil^); 5505 if (result < rExecuted) and (MyUn[UnFocus].Job > jNone) then 5506 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 5507 if (result < rExecuted) and (result <> eNoTime_Move) then 5508 begin 5509 case result of 5510 eNoTime_Load: 5511 if MyModel[MyUn[UnFocus].mix].Domain = dAir then 5512 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'), 'NOMOVE_TIME') 5513 else 5514 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 5515 [MovementToString(MyModel[MyUn[UnFocus].mix].speed)]), 5516 'NOMOVE_TIME'); 5517 eNoTime_Bombard: 5518 SoundMessage(Phrases.Lookup('NOTIMEBOMBARD'), 'NOMOVE_TIME'); 5519 eNoTime_Expel: 5520 SoundMessage(Phrases.Lookup('NOTIMEEXPEL'), 'NOMOVE_TIME'); 5521 eNoRoad: 5522 SoundMessage(Phrases.Lookup('NOROAD'), 'NOMOVE_DEFAULT'); 5523 eNoNav: 5524 SoundMessage(Phrases.Lookup('NONAV'), 'NOMOVE_DEFAULT'); 5525 eNoCapturer: 5526 SoundMessage(Phrases.Lookup('NOCAPTURER'), 'NOMOVE_DEFAULT'); 5527 eNoBombarder: 5528 SoundMessage(Phrases.Lookup('NOBOMBARDER'), 'NOMOVE_DEFAULT'); 5529 eZOC: 5530 ContextMessage(Phrases.Lookup('ZOC'), 'NOMOVE_ZOC', hkText, 5531 HelpDlg.TextIndex('MOVEMENT')); 5532 eTreaty: 5533 if MyMap[ToLoc] and (fUnit or fOwned) <> fUnit 5534 then { no enemy unit -- move } 5535 SoundMessage(Tribe[MyRO.Territory[ToLoc]].TPhrase('PEACE_NOMOVE'), 5536 'NOMOVE_TREATY') 5537 else 5538 SoundMessage(Tribe[MyRO.EnemyUn[euix].Owner] 5539 .TPhrase('PEACE_NOATTACK'), 'NOMOVE_TREATY'); 5540 eDomainMismatch: 1815 5541 begin 1816 if i<>woMir then with MessgExDlg do 1817 begin {tell about expired wonders} 1818 OpenSound:='WONDER_EXPIRED'; 1819 MessgText:=Format(Phrases.Lookup('WONDEREXP'), 1820 [Phrases.Lookup('IMPROVEMENTS',i), 1821 CityName(MyRO.Wonder[i].CityID)]); 1822 Kind:=mkOkHelp; 1823 HelpKind:=hkImp; 1824 HelpNo:=i; 1825 IconKind:=mikImp; 1826 IconIndex:=i; 1827 ShowModal; 5542 if (MyModel[MyUn[UnFocus].mix].Domain < dSea) and 5543 (MyMap[ToLoc] and (fUnit or fOwned) = fUnit or fOwned) then 5544 begin // false load attempt 5545 ToShip := false; 5546 ToTransport := false; 5547 for uix := 0 to MyRO.nUn - 1 do 5548 if (MyUn[uix].Loc = ToLoc) and 5549 (MyModel[MyUn[uix].mix].Domain = dSea) then 5550 begin 5551 ToShip := true; 5552 if MyModel[MyUn[uix].mix].Cap[mcSeaTrans] > 0 then 5553 ToTransport := true; 5554 end; 5555 if ToTransport then 5556 SoundMessage(Phrases.Lookup('FULLTRANSPORT'), 'NOMOVE_DEFAULT') 5557 else if ToShip then 5558 SoundMessage(Phrases.Lookup('NOTRANSPORT'), 'NOMOVE_DEFAULT') 5559 else 5560 Play('NOMOVE_DOMAIN'); 1828 5561 end 5562 else 5563 Play('NOMOVE_DOMAIN'); 1829 5564 end 1830 else if (MyData.ToldWonders[i].EffectiveOwner>=0) and not OwnWonder then 1831 with MessgExDlg do 1832 begin {tell about capture of wonders} 1833 OpenSound:='WONDER_CAPTURED'; 1834 s:=Tribe[MyRO.Wonder[i].EffectiveOwner].TPhrase('WONDERCAPT'); 1835 MessgText:=Format(s, [Phrases.Lookup('IMPROVEMENTS',i), 1836 CityName(MyRO.Wonder[i].CityID)]); 1837 Kind:=mkOkHelp; 1838 HelpKind:=hkImp; 1839 HelpNo:=i; 1840 IconKind:=mikImp; 1841 IconIndex:=i; 1842 ShowModal; 5565 else 5566 Play('NOMOVE_DEFAULT'); 5567 end; 5568 exit; 5569 end; 5570 5571 if ((result = eWon) or (result = eLost) or (result = eBloody)) and 5572 (MyUn[UnFocus].Movement < 100) and 5573 (MyModel[MyUn[UnFocus].mix].Cap[mcWill] = 0) then 5574 begin 5575 if SimpleQuery(mkYesNo, Format(Phrases.Lookup('FASTATTACK'), 5576 [MyUn[UnFocus].Movement]), 'NOMOVE_TIME') <> mrOK then 5577 begin 5578 result := eInvalid; 5579 exit; 5580 end; 5581 Update; // remove message box from screen 5582 end; 5583 5584 OldUnrest := false; 5585 NewUnrest := false; 5586 if (result >= rExecuted) and (result and rUnitRemoved = 0) and 5587 (MyMap[ToLoc] and (fUnit or fOwned) <> fUnit) then 5588 begin 5589 OldUnrest := UnrestAtLoc(UnFocus, FromLoc); 5590 NewUnrest := UnrestAtLoc(UnFocus, ToLoc); 5591 if NewUnrest > OldUnrest then 5592 begin 5593 if MyRO.Government = gDemocracy then 5594 begin 5595 QueryItem := 'UNREST_NOTOWN'; 5596 p1 := me; 5597 end 5598 else 5599 begin 5600 QueryItem := 'UNREST_FOREIGN'; 5601 p1 := MyRO.Territory[ToLoc]; 5602 end; 5603 with MessgExDlg do 5604 begin 5605 MessgText := Format(Tribe[p1].TPhrase(QueryItem), 5606 [Phrases.Lookup('GOVERNMENT', MyRO.Government)]); 5607 Kind := mkYesNo; 5608 IconKind := mikImp; 5609 IconIndex := imPalace; 5610 ShowModal; 5611 if ModalResult <> mrOK then 5612 begin 5613 result := eInvalid; 5614 exit; 5615 end; 5616 end; 5617 Update; // remove message box from screen 5618 end 5619 end; 5620 5621 if (result >= rExecuted) and (MyModel[MyUn[UnFocus].mix].Domain = dAir) and 5622 (MyUn[UnFocus].Status and usToldNoReturn = 0) then 5623 begin // can plane return? 5624 PlaneReturnData.Fuel := MyUn[UnFocus].Fuel; 5625 if (MyMap[ToLoc] and (fUnit or fOwned) = fUnit) or 5626 (MyMap[ToLoc] and (fCity or fOwned) = fCity) then 5627 begin // attack/expel/bombard -> 100MP 5628 PlaneReturnData.Loc := FromLoc; 5629 PlaneReturnData.Movement := MyUn[UnFocus].Movement - 100; 5630 if PlaneReturnData.Movement < 0 then 5631 PlaneReturnData.Movement := 0; 5632 end 5633 else // move 5634 begin 5635 PlaneReturnData.Loc := ToLoc; 5636 if dx and 1 <> 0 then 5637 PlaneReturnData.Movement := MyUn[UnFocus].Movement - 100 5638 else 5639 PlaneReturnData.Movement := MyUn[UnFocus].Movement - 150; 5640 end; 5641 if Server(sGetPlaneReturn, me, UnFocus, PlaneReturnData) = eNoWay then 5642 begin 5643 if MyModel[MyUn[UnFocus].mix].Kind = mkSpecial_Glider then 5644 QueryItem := 'LOWFUEL_GLIDER' 5645 else 5646 QueryItem := 'LOWFUEL'; 5647 if SimpleQuery(mkYesNo, Phrases.Lookup(QueryItem), 'WARNING_LOWSUPPORT') 5648 <> mrOK then 5649 begin 5650 result := eInvalid; 5651 exit; 5652 end; 5653 Update; // remove message box from screen 5654 MyUn[UnFocus].Status := MyUn[UnFocus].Status or usToldNoReturn; 5655 end 5656 end; 5657 5658 if result = eMissionDone then 5659 begin 5660 ModalSelectDlg.ShowNewContent(wmModal, kMission); 5661 Update; // dialog still on screen 5662 Mission := ModalSelectDlg.result; 5663 if Mission < 0 then 5664 exit; 5665 Server(sSetSpyMission + Mission shl 4, me, 0, nil^); 5666 end; 5667 5668 CityCaptured := false; 5669 if result = eNoTime_Move then 5670 Play('NOMOVE_TIME') 5671 else 5672 begin 5673 NeedEcoUpdate := false; 5674 DestinationMarkON := false; 5675 PaintDestination; 5676 if result and rUnitRemoved <> 0 then 5677 CityOptimizer_BeforeRemoveUnit(UnFocus); 5678 IsAttack := (result = eBombarded) or (result <> eMissionDone) and 5679 (MyMap[ToLoc] and (fUnit or fOwned) = fUnit); 5680 if not IsAttack then 5681 begin // move 5682 cix := MyRO.nCity - 1; { look for own city at dest location } 5683 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do 5684 dec(cix); 5685 if (result <> eMissionDone) and (MyMap[ToLoc] and fCity <> 0) and 5686 (cix < 0) then 5687 CityCaptured := true; 5688 result := Server(sMoveUnit + DirCode, me, UnFocus, nil^); 5689 case result of 5690 eHiddenUnit: 5691 begin 5692 Play('NOMOVE_SUBMARINE'); 5693 PaintLoc(ToLoc) 1843 5694 end; 1844 end; 1845 1846 if MyRO.Turn=MyData.ColdWarStart+ColdWarTurns then 1847 begin 1848 SoundMessageEx(Phrases.Lookup('COLDWAREND'),'MSG_DEFAULT'); 1849 MyData.ColdWarStart:=-ColdWarTurns-1 1850 end; 1851 1852 TellNewModels; 1853 end; // ClientMode<>cResume 1854 MyData.ToldAlive:=MyRO.Alive; 1855 move(MyRO.Wonder,MyData.ToldWonders,SizeOf(MyData.ToldWonders)); 1856 1857 NewGovAvailable:=-1; 1858 if ClientMode<>cResume then 1859 begin // tell about new techs 1860 for ad:=0 to nAdv-1 do 1861 if (MyRO.TestFlags and tfAllTechs=0) 1862 and ((MyRO.Tech[ad]>=tsApplicable)<>(MyData.ToldTech[ad]>=tsApplicable)) 1863 or (ad in FutureTech ) and (MyRO.Tech[ad]<>MyData.ToldTech[ad]) then 1864 with MessgExDlg do 1865 begin 1866 Item:='RESEARCH_GENERAL'; 1867 if GameMode<>cMovie then 1868 OpenSound:='NEWADVANCE_'+char(48+Age); 1869 Item2:=Phrases.Lookup('ADVANCES',ad); 1870 if ad in FutureTech then Item2:=Item2+' '+IntToStr(MyRO.Tech[ad]); 1871 MessgText:=Format(Phrases.Lookup(Item),[Item2]); 1872 Kind:=mkOkHelp; 1873 HelpKind:=hkAdv; 1874 HelpNo:=ad; 1875 IconKind:=mikBook; 1876 IconIndex:=-1; 1877 for i:=0 to nAdvBookIcon-1 do if AdvBookIcon[i].Adv=ad then 1878 IconIndex:=AdvBookIcon[i].Icon; 1879 ShowModal; 1880 MyData.ToldTech[ad]:=MyRO.Tech[ad]; 1881 for i:=gMonarchy to nGov-1 do if GovPreq[i]=ad then 1882 NewGovAvailable:=i; 1883 end; 1884 end; 1885 1886 ShowCityList:=false; 1887 if ClientMode=cTurn then 1888 begin 1889 if (MyRO.Happened and phTech<>0) and (MyData.FarTech<>adNexus) then 1890 ChooseResearch; 1891 1892 UpdatePanel:=false; 1893 if MyRO.Happened and phChangeGov<>0 then 1894 begin 1895 ModalSelectDlg.ShowNewContent(wmModal,kGov); 1896 Play('NEWGOV'); 1897 Server(sSetGovernment,me,ModalSelectDlg.result,nil^); 1898 CityOptimizer_BeginOfTurn; 1899 UpdatePanel:=true; 1900 end; 1901 end; // ClientMode=cTurn 1902 1903 if not supervising and ((ClientMode=cTurn) or (ClientMode=cMovieTurn)) then 1904 for cix:=0 to MyRO.nCity-1 do with MyCity[cix] do 1905 Status:=Status and not csToldBombard; 1906 1907 if ((ClientMode=cTurn) or (ClientMode=cMovieTurn)) 1908 and (MyRO.Government<>gAnarchy) then 1909 begin 1910 // tell what happened in cities 1911 for WondersOnly:=true downto false do 1912 for cix:=0 to MyRO.nCity-1 do with MyCity[cix] do 1913 if (MyRO.Turn>0) and (Loc>=0) and (Flags and chCaptured=0) 1914 and (WondersOnly=(Flags and chProduction<>0) 1915 and (Project0 and cpImp<>0) and (Project0 and cpIndex<28)) then 1916 begin 1917 if WondersOnly then with MessgExDlg do 1918 begin {tell about newly built wonder} 1919 OpenSound:='WONDER_BUILT'; 1920 s:=Tribe[me].TPhrase('WONDERBUILTOWN'); 1921 MessgText:=Format(s, [Phrases.Lookup('IMPROVEMENTS',Project0 and cpIndex), 1922 CityName(ID)]); 1923 Kind:=mkOkHelp; 1924 HelpKind:=hkImp; 1925 HelpNo:=Project0 and cpIndex; 1926 IconKind:=mikImp; 1927 IconIndex:=Project0 and cpIndex; 1928 ShowModal; 5695 eStealthUnit: 5696 begin 5697 Play('NOMOVE_STEALTH'); 5698 PaintLoc(ToLoc) 1929 5699 end; 1930 if not supervising and (ClientMode=cTurn) then5700 eZOC_EnemySpotted: 1931 5701 begin 1932 AllowCityScreen:=true; 1933 if (Status and 7<>0) and (Project and (cpImp+cpIndex)=cpImp+imTrGoods) then 1934 if (MyData.ImpOrder[Status and 7-1,0]>=0) then 5702 Play('NOMOVE_ZOC'); 5703 PaintLoc(ToLoc, 1) 5704 end; 5705 rExecuted .. maxint: 5706 begin 5707 if result and rUnitRemoved <> 0 then 5708 UnFocus := -1 // unit died 5709 else 5710 begin 5711 assert(UnFocus >= 0); 5712 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 5713 not(usStay or usRecover); 5714 for uix := 0 to MyRO.nUn - 1 do 5715 if MyUn[uix].Master = UnFocus then 5716 MyUn[uix].Status := MyUn[uix].Status and not usWaiting; 5717 if CityCaptured and 5718 (MyRO.Government in [gRepublic, gDemocracy, gFuture]) then 5719 begin // borders have moved, unrest might have changed in any city 5720 CityOptimizer_BeginOfTurn; 5721 NeedEcoUpdate := true; 5722 end 5723 else 1935 5724 begin 1936 if AutoBuild(cix,MyData.ImpOrder[Status and 7-1]) then 1937 AllowCityScreen:=false 1938 else if Flags and chProduction<>0 then 1939 Flags:=(Flags and not chProduction) or chAllImpsMade 1940 end 1941 else Flags:=Flags or chTypeDel; 1942 if (Size>=NeedAqueductSize) and (MyRO.Tech[Imp[imAqueduct].Preq]<tsApplicable) 1943 or (Size>=NeedSewerSize) and (MyRO.Tech[Imp[imSewer].Preq]<tsApplicable) then 1944 Flags:=Flags and not chNoGrowthWarning; // don't remind of unknown building 1945 if Flags and chNoSettlerProd=0 then 1946 Status:=Status and not csToldDelay 1947 else if Status and csToldDelay=0 then 1948 Status:=Status or csToldDelay 1949 else Flags:=Flags and not chNoSettlerProd; 1950 if mRepScreens.Checked then 1951 begin 1952 if (Flags and CityRepMask<>0) and AllowCityScreen then 1953 begin {show what happened in cities} 1954 SetTroopLoc(MyCity[cix].Loc); 1955 MarkCityLoc:=MyCity[cix].Loc; 1956 PanelPaint; 1957 CityDlg.CloseAction:=None; 1958 CityDlg.ShowNewContent(wmModal, MyCity[cix].Loc, Flags and CityRepMask); 1959 UpdatePanel:=true; 1960 end 1961 end 1962 else {if mRepList.Checked then} 1963 begin 1964 if Flags and CityRepMask<>0 then 1965 ShowCityList:=true 1966 end 1967 end 1968 end; {city loop} 1969 end; // ClientMode=cTurn 1970 1971 if ClientMode=cTurn then 1972 begin 1973 if NewGovAvailable>=0 then with MessgExDlg do 1974 begin 1975 MessgText:=Format(Phrases.Lookup('AUTOREVOLUTION'), 1976 [Phrases.Lookup('GOVERNMENT',NewGovAvailable)]); 1977 Kind:=mkYesNo; 1978 IconKind:=mikPureIcon; 1979 IconIndex:=6+NewGovAvailable; 1980 ShowModal; 1981 if ModalResult=mrOK then 1982 begin 1983 Play('REVOLUTION'); 1984 Server(sRevolution,me,0,nil^); 1985 end 1986 end; 1987 end; // ClientMode=cTurn 1988 1989 if (ClientMode=cTurn) or (ClientMode=cMovieTurn) then 1990 begin 1991 if MyRO.Happened and phGliderLost<>0 then 1992 ContextMessage(Phrases.Lookup('GLIDERLOST'), 'MSG_DEFAULT', hkModel, 200); 1993 if MyRO.Happened and phPlaneLost<>0 then 1994 ContextMessage(Phrases.Lookup('PLANELOST'), 'MSG_DEFAULT', hkFeature, 1995 mcFuel); 1996 if MyRO.Happened and phPeaceEvacuation<>0 then 1997 for p1:=0 to nPl-1 do if 1 shl p1 and MyData.PeaceEvaHappened<>0 then 1998 SoundMessageEx(Tribe[p1].TPhrase('WITHDRAW'), 'MSG_DEFAULT'); 1999 if MyRO.Happened and phPeaceViolation<>0 then 2000 for p1:=0 to nPl-1 do 2001 if (1 shl p1 and MyRO.Alive<>0) and (MyRO.EvaStart[p1]=MyRO.Turn) then 2002 SoundMessageEx(Format(Tribe[p1].TPhrase('VIOLATION'), 2003 [TurnToString(MyRO.Turn+PeaceEvaTurns-1)]), 'MSG_WITHDRAW'); 2004 TellNewContacts; 2005 end; 2006 2007 if ClientMode=cMovieTurn then Update 2008 else if ClientMode=cTurn then 2009 begin 2010 if UpdatePanel then UpdateViews; 2011 Application.ProcessMessages; 2012 2013 if not supervising then 2014 for uix:=0 to MyRO.nUn-1 do with MyUn[uix] do if Loc>=0 then 2015 begin 2016 if Flags and unWithdrawn<>0 then Status:=0; 2017 if Health=100 then 2018 Status:=Status and not usRecover; 2019 if (Master>=0) or UnitExhausted(uix) then 2020 Status:=Status and not usWaiting 2021 else Status:=Status or usWaiting; 2022 CheckToldNoReturn(uix); 2023 if Status and usGoto<>0 then 2024 begin {continue multi-turn goto} 2025 SetUnFocus(uix); 2026 SetTroopLoc(Loc); 2027 FocusOnLoc(TroopLoc,flRepaintPanel or flImmUpdate); 2028 if Status shr 16=$7FFF then 2029 MoveResult:=GetMoveAdvice(UnFocus,maNextCity,MoveAdviceData) 2030 else MoveResult:=GetMoveAdvice(UnFocus,Status shr 16,MoveAdviceData); 2031 if MoveResult>=rExecuted then 2032 begin // !!! Shinkansen 2033 MoveResult:=eOK; 2034 ok:=true; 2035 for i:=0 to MoveAdviceData.nStep-1 do 2036 begin 2037 Loc1:=dLoc(Loc,MoveAdviceData.dx[i],MoveAdviceData.dy[i]); 2038 if (MyMap[Loc1] and (fCity or fOwned)=fCity) // don't capture cities during auto move 2039 or (MyMap[Loc1] and (fUnit or fOwned)=fUnit) then // don't attack during auto move 2040 begin ok:=false; Break end 2041 else 2042 begin 2043 if (Loc1=MoveAdviceData.ToLoc) or (MoveAdviceData.ToLoc=maNextCity) 2044 and (MyMap[dLoc(Loc,MoveAdviceData.dx[i],MoveAdviceData.dy[i])] and fCity<>0) then 2045 MoveOptions:=muAutoNoWait 2046 else MoveOptions:=0; 2047 MoveResult:=MoveUnit(MoveAdviceData.dx[i],MoveAdviceData.dy[i],MoveOptions); 2048 if (MoveResult<rExecuted) or (MoveResult=eEnemySpotted) then 2049 begin ok:=false; Break end; 5725 if OldUnrest <> NewUnrest then 5726 begin 5727 CityOptimizer_CityChange(MyUn[UnFocus].Home); 5728 for uix := 0 to MyRO.nUn - 1 do 5729 if MyUn[uix].Master = UnFocus then 5730 CityOptimizer_CityChange(MyUn[uix].Home); 5731 NeedEcoUpdate := true; 5732 end; 5733 if (MyRO.Government = gDespotism) and 5734 (MyModel[MyUn[UnFocus].mix].Kind = mkSpecial_TownGuard) then 5735 begin 5736 if MyMap[FromLoc] and fCity <> 0 then 5737 begin // town guard moved out of city in despotism -- reoptimize! 5738 cixChanged := MyRO.nCity - 1; 5739 while (cixChanged >= 0) and 5740 (MyCity[cixChanged].Loc <> FromLoc) do 5741 dec(cixChanged); 5742 assert(cixChanged >= 0); 5743 if cixChanged >= 0 then 5744 begin 5745 CityOptimizer_CityChange(cixChanged); 5746 NeedEcoUpdate := true; 5747 end; 5748 end; 5749 if (MyMap[ToLoc] and fCity <> 0) and not CityCaptured then 5750 begin // town guard moved into city in despotism -- reoptimize! 5751 cixChanged := MyRO.nCity - 1; 5752 while (cixChanged >= 0) and 5753 (MyCity[cixChanged].Loc <> ToLoc) do 5754 dec(cixChanged); 5755 assert(cixChanged >= 0); 5756 if cixChanged >= 0 then 5757 begin 5758 CityOptimizer_CityChange(cixChanged); 5759 NeedEcoUpdate := true; 5760 end 5761 end 5762 end 2050 5763 end 2051 5764 end; 2052 Stop:=not ok or (Loc=MoveAdviceData.ToLoc)2053 or (MoveAdviceData.ToLoc=maNextCity) and (MyMap[Loc] and fCity<>0)2054 end2055 else2056 begin2057 MoveResult:=eOK;2058 Stop:=true;2059 5765 end; 2060 2061 if MoveResult<>eDied then 2062 if Stop then Status:=Status and ($FFFF-usGoto) 2063 else Status:=Status and not usWaiting; 5766 else 5767 assert(false); 5768 end; 5769 SetTroopLoc(ToLoc); 5770 end 5771 else 5772 begin { enemy unit -- attack } 5773 if result = eBombarded then 5774 Defender := MyRO.Territory[ToLoc] 5775 else 5776 Defender := MyRO.EnemyUn[euix].Owner; 5777 { if MyRO.Treaty[Defender]=trCeaseFire then 5778 if SimpleQuery(mkYesNo,Phrases.Lookup('FRCANCELQUERY_CEASEFIRE'), 5779 'MSG_DEFAULT')<>mrOK then 5780 exit; } 5781 if (Options and muNoSuicideCheck = 0) and (result and rUnitRemoved <> 0) 5782 and (result <> eMissionDone) then 5783 begin // suicide query 5784 with MyUn[UnFocus], BattleDlg.Forecast do 5785 begin 5786 pAtt := me; 5787 mixAtt := mix; 5788 HealthAtt := Health; 5789 ExpAtt := Exp; 5790 FlagsAtt := Flags; 2064 5791 end; 2065 2066 if Status and (usEnhance or usGoto)=usEnhance then 2067 // continue terrain enhancement 5792 BattleDlg.Forecast.Movement := MyUn[UnFocus].Movement; 5793 Server(sGetBattleForecastEx, me, ToLoc, BattleDlg.Forecast); 5794 BattleDlg.uix := UnFocus; 5795 BattleDlg.ToLoc := ToLoc; 5796 BattleDlg.IsSuicideQuery := true; 5797 BattleDlg.ShowModal; 5798 if BattleDlg.ModalResult <> mrOK then 5799 exit; 5800 end; 5801 5802 cixChanged := -1; 5803 if (result and rUnitRemoved <> 0) and (MyRO.Government = gDespotism) and 5804 (MyModel[MyUn[UnFocus].mix].Kind = mkSpecial_TownGuard) and 5805 (MyMap[FromLoc] and fCity <> 0) then 5806 begin // town guard died in city in despotism -- reoptimize! 5807 cixChanged := MyRO.nCity - 1; 5808 while (cixChanged >= 0) and (MyCity[cixChanged].Loc <> FromLoc) do 5809 dec(cixChanged); 5810 assert(cixChanged >= 0); 5811 end; 5812 5813 for i := 0 to MyRO.nEnemyModel - 1 do 5814 LostArmy[i] := MyRO.EnemyModel[i].Lost; 5815 OldToTile := MyMap[ToLoc]; 5816 result := Server(sMoveUnit + DirCode, me, UnFocus, nil^); 5817 nLostArmy := 0; 5818 for i := 0 to MyRO.nEnemyModel - 1 do 5819 begin 5820 LostArmy[i] := MyRO.EnemyModel[i].Lost - LostArmy[i]; 5821 inc(nLostArmy, LostArmy[i]) 5822 end; 5823 if result and rUnitRemoved <> 0 then 5824 begin 5825 UnFocus := -1; 5826 SetTroopLoc(FromLoc); 5827 end; 5828 if (OldToTile and not MyMap[ToLoc] and fCity <> 0) and 5829 (MyRO.Government in [gRepublic, gDemocracy, gFuture]) then 5830 begin // city was destroyed, borders have moved, unrest might have changed in any city 5831 CityOptimizer_BeginOfTurn; 5832 NeedEcoUpdate := true; 5833 end 5834 else 5835 begin 5836 if cixChanged >= 0 then 2068 5837 begin 2069 MoveResult:=ProcessEnhancement(uix,MyData.EnhancementJobs); 2070 if MoveResult<>eDied then 2071 if MoveResult=eJobDone then Status:=Status and not usEnhance 2072 else Status:=Status and not usWaiting; 2073 end 2074 end; 2075 end; // ClientMode=cTurn 2076 2077 HaveStrategyAdvice:= false; 2078 // (GameMode<>cMovie) and not supervising 2079 // and AdvisorDlg.HaveStrategyAdvice; 2080 GoOnPhase:=true; 2081 if supervising or (GameMode=cMovie) then 2082 begin SetTroopLoc(-1); PaintAll end {supervisor} 2083 { else if (ClientMode=cTurn) and (MyRO.Turn=0) then 2084 begin 2085 SetUnFocus(0); 2086 ZoomToCity(MyCity[0].Loc) 2087 end} 2088 else 2089 begin 2090 if ClientMode>=scContact then SetUnFocus(-1) 2091 else NextUnit(-1,false); 2092 if UnFocus<0 then 2093 begin 2094 UnStartLoc:=-1; 2095 if IsMultiPlayerGame or (ClientMode=cResume) then 2096 if MyRO.nCity>0 then FocusOnLoc(MyCity[0].Loc) 2097 else FocusOnLoc(G.lx*G.ly div 2); 2098 SetTroopLoc(-1); 2099 PanelPaint 2100 end; 2101 if ShowCityList then 2102 ListDlg.ShowNewContent(wmPersistent,kCityEvents); 2103 end; 2104 end;{InitTurn} 2105 2106 var 2107 i,j,p1,mix,ToLoc,AnimationSpeed,ShowMoveDomain,cix,ecix: integer; 2108 Color: TColor; 2109 Name,s: string; 2110 TribeInfo: TTribeInfo; 2111 mi: TModelInfo; 2112 SkipTurn,IsAlpine,IsTreatyDeal: boolean; 2113 2114 begin {>>>client} 2115 case command of 2116 cTurn,cResume,cContinue,cMovieTurn,scContact,scDipStart..scDipBreak: 2117 begin 2118 supervising:= G.Difficulty[NewPlayer]=0; 2119 ArrangeMidPanel; 2120 end 2121 end; 2122 case Command of 2123 cDebugMessage: 2124 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(@Data)); 2125 2126 cShowNego: with TShowNegoData(Data) do 2127 begin 2128 s:=Format('P%d to P%d: ',[pSender,pTarget]); 2129 if (Action=scDipOffer) and (Offer.nDeliver+Offer.nCost>0) then 2130 begin 2131 s:=s+'Offer '; 2132 for i:=0 to Offer.nDeliver+Offer.nCost-1 do 2133 begin 2134 if i=Offer.nDeliver then s:=s+' for ' 2135 else if i>0 then s:=s+'+'; 2136 case Offer.Price[i] and opMask of 2137 opChoose: s:=s+'Price of choice'; 2138 opCivilReport: s:=s+'State report'; 2139 opMilReport: s:=s+'Military report'; 2140 opMap: s:=s+'Map'; 2141 opTreaty: s:=s+'Treaty'; 2142 opShipParts: s:=s+'Ship part'; 2143 opMoney: s:=s+InttoStr(Offer.Price[i] and $FFFFFF)+'o'; 2144 opTribute: s:=s+InttoStr(Offer.Price[i] and $FFFFFF)+'o tribute'; 2145 opTech: s:=s+Phrases.Lookup('ADVANCES', Offer.Price[i] and $FFFFFF); 2146 opAllTech: s:=s+'All advances'; 2147 opModel: s:=s+Tribe[pSender].ModelName[Offer.Price[i] and $FFFFFF]; 2148 opAllModel: s:=s+'All models'; 2149 end 2150 end; 2151 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2152 end 2153 else if Action=scDipAccept then 2154 begin 2155 s:=s+'--- ACCEPTED! ---'; 2156 LogDlg.Add(NewPlayer, G.RO[0].Turn, pchar(s)); 2157 end 2158 end; 2159 2160 cInitModule: 2161 begin 2162 Server:=TInitModuleData(Data).Server; 2163 //AdvisorDlg.Init; 2164 InitModule; 2165 TInitModuleData(Data).DataSize:=SizeOf(TPersistentData); 2166 TInitModuleData(Data).Flags:=aiThreaded; 2167 end; 2168 2169 cReleaseModule: 2170 begin 2171 SmallImp.Free; 2172 UnusedTribeFiles.Free; 2173 TribeNames.Free; 2174 MainMap.Free; 2175 IsoEngine.Done; 2176 //AdvisorDlg.DeInit; 2177 end; 2178 2179 cHelpOnly,cStartHelp,cStartCredits: 2180 begin 2181 Age:=0; 2182 if Command=cHelpOnly then 2183 SetMainTextureByAge(-1); 2184 Tribes.Init; 2185 HelpDlg.UserLeft:=(Screen.Width-HelpDlg.Width) div 2; 2186 HelpDlg.UserTop:=(Screen.Height-HelpDlg.Height) div 2; 2187 HelpDlg.Difficulty:=0; 2188 if Command=cStartCredits then 2189 HelpDlg.ShowNewContent(wmModal, hkMisc, miscCredits) 2190 else HelpDlg.ShowNewContent(wmModal, hkMisc, miscMain); 2191 Tribes.Done; 2192 end; 2193 2194 cNewGame,cLoadGame,cMovie,cNewMap: 2195 begin 2196 {if (Command=cNewGame) or (Command=cLoadGame) then 2197 AdvisorDlg.NewGame(Data);} 2198 GenerateNames:=mNames.Checked; 2199 GameOK:=true; 2200 G:=TNewGameData(Data); 2201 me:=-1; 2202 pLogo:=-1; 2203 ClientMode:=-1; 2204 SetMapOptions; 2205 IsoEngine.pDebugMap:=-1; 2206 idle:=false; 2207 FillChar(Jump,SizeOf(Jump),0); 2208 if StartRunning then Jump[0]:=999999; 2209 GameMode:=Command; 2210 for i:=0 to nGrExt-1 do 2211 FillChar(GrExt[i].pixUsed,GrExt[i].Data.Height div 49 *10,0); 2212 IsoEngine.Reset; 2213 Tribes.Init; 2214 GetTribeList; 2215 for p1:=0 to nPl-1 do if (G.RO[p1]<>nil) and (G.RO[p1].Data<>nil) then 2216 with TPersistentData(G.RO[p1].Data^) do 2217 begin 2218 FarTech:=adNone; 2219 FillChar(EnhancementJobs,SizeOf(EnhancementJobs),jNone); 2220 FillChar(ImpOrder,SizeOf(ImpOrder),-1); 2221 ColdWarStart:=-ColdWarTurns-1; 2222 ToldAge:=-1; 2223 ToldModels:=3; 2224 ToldAlive:=0; 2225 ToldContact:=0; 2226 ToldOwnCredibility:=InitialCredibility; 2227 for i:=0 to nPl-1 do if G.Difficulty[i]>0 then inc(ToldAlive,1 shl i); 2228 PeaceEvaHappened:=0; 2229 for i:=0 to 27 do with ToldWonders[i] do 2230 begin CityID:=-1; EffectiveOwner:=-1 end; 2231 FillChar(ToldTech,SizeOf(ToldTech),tsNA); 2232 if G.Difficulty[p1]>0 then 2233 SoundPreload(sbStart); 2234 end; 2235 2236 // arrange dialogs 2237 ListDlg.UserLeft:=8; 2238 ListDlg.UserTop:=TopBarHeight+8; 2239 HelpDlg.UserLeft:=Screen.Width-HelpDlg.Width-8; 2240 HelpDlg.UserTop:=TopBarHeight+8; 2241 UnitStatDlg.UserLeft:=397; 2242 UnitStatDlg.UserTop:=TopBarHeight+64; 2243 DiaDlg.UserLeft:=(Screen.Width-DiaDlg.Width) div 2; 2244 DiaDlg.UserTop:=(Screen.Height-DiaDlg.Height) div 2; 2245 NatStatDlg.UserLeft:=Screen.Width-NatStatDlg.Width-8; 2246 NatStatDlg.UserTop:=Screen.Height-PanelHeight-NatStatDlg.Height-8; 2247 if NatStatDlg.UserTop<8 then 2248 NatStatDlg.UserTop:=8; 2249 2250 Age:=0; 2251 MovieSpeed:=1; 2252 LogDlg.mSlot.Visible:=true; 2253 LogDlg.Host:=self; 2254 HelpDlg.ClearHistory; 2255 CityDlg.Reset; 2256 2257 Mini.Width:=G.lx*2; Mini.Height:=G.ly; 2258 for i:=0 to nPl-1 do 2259 begin Tribe[i]:=nil; TribeOriginal[i]:=false; end; 2260 ToldSlavery:=-1; 2261 RepaintOnResize:=false; 2262 Closable:=false; 2263 FirstMovieTurn:=true; 2264 2265 MenuArea.Visible:= GameMode<>cMovie; 2266 TreasuryArea.Visible:= GameMode<cMovie; 2267 ResearchArea.Visible:= GameMode<cMovie; 2268 ManagementArea.Visible:= GameMode<cMovie; 2269 end; 2270 2271 cGetReady,cReplay: if NewPlayer=0 then 2272 begin 2273 i:=0; 2274 for p1:=0 to nPl-1 do 2275 if (G.Difficulty[p1]>0) and (Tribe[p1]=nil) then inc(i); 2276 if i>UnusedTribeFiles.Count then 2277 begin 2278 GameOK:=false; 2279 SimpleMessage(Phrases.Lookup('TOOFEWTRIBES')); 2280 end 2281 else 2282 begin 2283 for p1:=0 to nPl-1 do 2284 if (G.Difficulty[p1]>0) and (Tribe[p1]=nil) and (G.RO[p1]<>nil) then 2285 begin // let player select own tribes 2286 TribeInfo.trix:=p1; 2287 TribeNames.Clear; 2288 for j:=0 to UnusedTribeFiles.Count-1 do 2289 begin 2290 GetTribeInfo(UnusedTribeFiles[j], Name, Color); 2291 TribeNames.AddObject(Name,TObject(Color)); 2292 end; 2293 assert(TribeNames.Count>0); 2294 ModalSelectDlg.ShowNewContent(wmModal,kTribe); 2295 Application.ProcessMessages; 2296 TribeInfo.FileName:=UnusedTribeFiles[ModalSelectDlg.result]; 2297 UnusedTribeFiles.Delete(ModalSelectDlg.result); 2298 2299 if GameMode=cLoadGame then 2300 CreateTribe(TribeInfo.trix,TribeInfo.FileName,false) 2301 else Server(cSetTribe+(Length(TribeInfo.FileName)+1+7) div 4, 2302 0,0,TribeInfo); 5838 CityOptimizer_CityChange(cixChanged); 5839 NeedEcoUpdate := true; 2303 5840 end; 2304 2305 for p1:=0 to nPl-1 do 2306 if (G.Difficulty[p1]>0) and (Tribe[p1]=nil) and (G.RO[p1]=nil) then 2307 begin // autoselect enemy tribes 2308 j:=ChooseUnusedTribe; 2309 TribeInfo.FileName:=UnusedTribeFiles[j]; 2310 UnusedTribeFiles.Delete(j); 2311 TribeInfo.trix:=p1; 2312 if GameMode=cLoadGame then 2313 CreateTribe(TribeInfo.trix,TribeInfo.FileName,false) 2314 else Server(cSetTribe+(Length(TribeInfo.FileName)+1+7) div 4, 2315 0,0,TribeInfo); 5841 if (result = eWon) or (result = eBloody) or (result = eExpelled) then 5842 begin 5843 CityOptimizer_TileBecomesAvailable(ToLoc); 5844 NeedEcoUpdate := true; 2316 5845 end; 2317 end; 2318 if not mNames.Checked then 2319 for p1:=0 to nPl-1 do if Tribe[p1]<>nil then 2320 Tribe[p1].NumberName:=p1; 2321 end; 2322 2323 cBreakGame: 2324 begin 2325 SaveSettings; 2326 CityDlg.CloseAction:=None; 2327 for i:=0 to Screen.FormCount-1 do 2328 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 2329 Screen.Forms[i].Close; 2330 if LogDlg.Visible then LogDlg.Close; 2331 LogDlg.List.Clear; 2332 StartRunning:=not idle and (Jump[0]>0); // AI called Reload 2333 me:=-1; 2334 idle:=false; 2335 ClientMode:=-1; 2336 UnitInfoBtn.Visible:=false; 2337 UnitBtn.Visible:=false; 2338 TerrainBtn.Visible:=false; 2339 MovieSpeed1Btn.Visible:=false; 2340 MovieSpeed2Btn.Visible:=false; 2341 MovieSpeed3Btn.Visible:=false; 2342 MovieSpeed4Btn.Visible:=false; 2343 EOT.Visible:=false; 2344 for i:=0 to ControlCount-1 do if Controls[i] is TButtonC then 2345 Controls[i].visible:=false; 2346 InitPVSB(sb,0,1); 2347 for p1:=0 to nPl-1 do if Tribe[p1]<>nil then Tribe[p1].Free; 2348 Tribes.Done; 2349 RepaintOnResize:=false; 2350 Closable:=true; Close; 2351 {if (GameMode=cNewGame) or (GameMode=cLoadGame) then 2352 AdvisorDlg.BreakGame;} 2353 end; 2354 2355 cShowGame: 2356 begin 2357 with Panel.Canvas do 2358 begin 2359 Brush.Color:=$000000; 2360 FillRect(Rect(0,0,Panel.Width,Panel.Height)); 2361 Brush.Style:=bsClear; 2362 end; 2363 with TopBar.Canvas do 2364 begin 2365 Brush.Color:=$000000; 2366 FillRect(Rect(0,0,TopBar.Width,TopBar.Height)); 2367 Brush.Style:=bsClear; 2368 end; 2369 FormResize(nil); // place mini map correctly according to its size 2370 Show; 2371 Update; 2372 RepaintOnResize:=true; 2373 xw:=0; yw:=ywcenter; 2374 if not StayOnTop_Ensured then 2375 begin 2376 StayOnTop_Ensured:=true; 2377 CityDlg.StayOnTop_Workaround; 2378 CityTypeDlg.StayOnTop_Workaround; 2379 DiaDlg.StayOnTop_Workaround; 2380 DraftDlg.StayOnTop_Workaround; 2381 EnhanceDlg.StayOnTop_Workaround; 2382 HelpDlg.StayOnTop_Workaround; 2383 NatStatDlg.StayOnTop_Workaround; 2384 NegoDlg.StayOnTop_Workaround; 2385 ModalSelectDlg.StayOnTop_Workaround; 2386 ListDlg.StayOnTop_Workaround; 2387 UnitStatDlg.StayOnTop_Workaround; 2388 WondersDlg.StayOnTop_Workaround; 2389 RatesDlg.StayOnTop_Workaround; 2390 end; 2391 end; 2392 2393 cShowTurnChange: 2394 begin 2395 if integer(data)>=0 then 2396 begin 2397 pLogo:=integer(data); 2398 if G.RO[pLogo]=nil then 2399 begin 2400 if AILogo[pLogo]<>nil then 2401 BitBlt(Canvas.Handle, (xRightPanel+10)-(16+64), ClientHeight-PanelHeight, 64,64, 2402 AILogo[pLogo].Canvas.Handle,0,0,SRCCOPY); 2403 end 2404 end 2405 end; 2406 2407 cTurn,cResume,cContinue: 2408 if not GameOK then Server(sResign,NewPlayer,0,nil^) 2409 else 2410 begin 2411 ClientMode:=Command; 2412 pTurn:=NewPlayer; 2413 pLogo:=NewPlayer; 2414 2415 if Command=cResume then 2416 begin // init non-original model pictures (maybe tribes not found) 2417 for p1:=0 to nPl-1 do if G.RO[p1]<>nil then 5846 end; 5847 if nLostArmy > 1 then 5848 begin 5849 with MessgExDlg do 2418 5850 begin 2419 ItsMeAgain(p1); 2420 for mix:=0 to MyRO.nModel-1 do 2421 if Tribe[me].ModelPicture[mix].HGr=0 then 2422 InitMyModel(mix, true); 2423 end; 2424 me:=-1; 2425 end; 2426 2427 if Jump[pTurn]>0 then 2428 Application.ProcessMessages; 2429 if Jump[pTurn]>0 then 2430 if G.RO[NewPlayer].Happened and phGameEnd<>0 then Jump[pTurn]:=0 2431 else dec(Jump[pTurn]); 2432 SkipTurn:= Jump[pTurn]>0; 2433 if SkipTurn then 2434 begin 2435 ItsMeAgain(NewPlayer); 2436 MyData:=G.RO[NewPlayer].Data; 2437 SetTroopLoc(-1); 2438 MiniPaint; 2439 InitAllEnemyModels; // necessary for correct replay 2440 if not EndTurn(true) then SkipTurn:=false; 2441 end; 2442 if not SkipTurn then 2443 begin 2444 if ((ClientMode<scDipStart) or (ClientMode>scDipBreak)) 2445 and NegoDlg.Visible then 2446 NegoDlg.Close; 2447 skipped:=false; // always show my moves during my turn 2448 idle:=true; 2449 InitTurn(NewPlayer); 2450 DipMem[me].pContact:=-1; 2451 (* if (me=0) and (MyRO.Alive and (1 shl me)=0)} then 2452 begin 2453 if SimpleQuery(Phrases.Lookup('RESIGN'))=mrIgnore then 2454 Server(sResign,me,0,nil^) 2455 else Server(sBreak,me,0,nil^) 2456 end 2457 else Play('TURNSTART');*) 2458 end; 2459 end; 2460 2461 cMovieTurn: 2462 begin 2463 ClientMode:=Command; 2464 pTurn:=NewPlayer; 2465 pLogo:=-1; 2466 skipped:=false; // always show my moves during my turn 2467 idle:=true; 2468 if FirstMovieTurn then 2469 begin 2470 CheckMovieSpeedBtnState; 2471 FirstMovieTurn:=false; 2472 end; 2473 InitTurn(NewPlayer); 2474 Application.ProcessMessages; 2475 if MovieSpeed=4 then 2476 begin 2477 Sleep(75); // this break will ensure speed of fast forward does not depend on cpu speed 2478 Application.ProcessMessages; 2479 end 2480 end; 2481 2482 cMovieEndTurn: 2483 begin 2484 RememberPeaceViolation; 2485 pTurn:=-1; 2486 pLogo:=-1; 2487 MapValid:=false; 2488 ClientMode:=-1; 2489 idle:=false; 2490 skipped:=false; 2491 end; 2492 2493 cEditMap: 2494 begin 2495 ClientMode:=cEditMap; 2496 SetMapOptions; 2497 IsoEngine.pDebugMap:=-1; 2498 ItsMeAgain(0); 2499 MyData:=nil; 2500 UnitInfoBtn.Visible:=false; 2501 UnitBtn.Visible:=false; 2502 TerrainBtn.Visible:=false; 2503 MovieSpeed1Btn.Visible:=false; 2504 MovieSpeed2Btn.Visible:=false; 2505 MovieSpeed3Btn.Visible:=false; 2506 MovieSpeed4Btn.Visible:=false; 2507 EOT.Visible:=false; 2508 HelpDlg.Difficulty:=0; 2509 BrushType:=fGrass; 2510 BrushLoc:=-1; 2511 Edited:=false; 2512 UnFocus:=-1; 2513 MarkCityLoc:=-1; 2514 Tracking:=false; 2515 TurnComplete:=false; 2516 MapValid:=false; 2517 FormResize(nil); // calculate geometrics and paint all 2518 SetTroopLoc(-1); 2519 idle:=true 2520 end; 2521 2522 (* cNewContact: 2523 begin 2524 end; 2525 *) 2526 2527 scContact: 2528 begin 2529 DipMem[NewPlayer].pContact:=integer(Data); 2530 if Jump[NewPlayer]>0 then DipCall(scReject) 2531 else 2532 begin 2533 ClientMode:=Command; 2534 InitTurn(NewPlayer); 2535 MyData.ToldContact:=MyData.ToldContact or (1 shl integer(Data)); 2536 // don't tell about new nation when already contacted by them 2537 with MessgExDlg do 2538 begin 2539 OpenSound:='CONTACT_'+char(48+MyRO.EnemyReport[integer(Data)].Attitude); 2540 MessgText:=Tribe[integer(Data)].TPhrase('FRCONTACT'); 2541 Kind:=mkYesNo; 2542 IconKind:=mikTribe; 2543 IconIndex:=integer(Data); 2544 ShowModal; 2545 if ModalResult=mrOK then 2546 begin 2547 NegoDlg.Respond; 2548 DipMem[me].DeliveredPrices:=[]; 2549 DipMem[me].ReceivedPrices:=[]; 2550 DipCall(scDipStart) 2551 end 2552 else 2553 begin 2554 DipCall(scReject); 2555 EndNego 5851 Kind := mkOk; 5852 IconKind := mikEnemyArmy; 5853 MessgText := Tribe[Defender].TString(Phrases.Lookup('ARMYLOST', 5854 MyRO.EnemyModel[MyRO.EnemyUn[euix].emix].Domain)); 5855 ShowModal; 2556 5856 end 2557 5857 end 2558 5858 end; 2559 end; 2560 2561 scDipStart..scDipBreak: 2562 begin 2563 ClientMode:=Command; 2564 InitTurn(NewPlayer); 2565 if Command=scDipStart then 2566 Play('CONTACT_'+char(48+MyRO.Attitude[DipMem[NewPlayer].pContact])) 2567 else if Command=scDipCancelTreaty then 2568 Play('CANCELTREATY') 2569 else if Command=scDipOffer then 2570 begin 2571 ReceivedOffer:=TOffer(Data); 2572 InitAllEnemyModels; 5859 if result and rUnitRemoved <> 0 then 5860 begin 5861 CityOptimizer_AfterRemoveUnit; 5862 ListDlg.RemoveUnit; 5863 NeedEcoUpdate := true; 5864 end; 5865 if NeedEcoUpdate then 5866 begin 5867 UpdateViews(true); 5868 Update 2573 5869 end 2574 else if Command=scDipAccept then 2575 begin // remember delivered and received prices 2576 for i:=0 to DipMem[me].SentOffer.nDeliver-1 do 2577 include(DipMem[me].DeliveredPrices,DipMem[me].SentOffer.Price[i] shr 24); 2578 for i:=0 to DipMem[me].SentOffer.nCost-1 do 2579 include(DipMem[me].ReceivedPrices, 2580 DipMem[me].SentOffer.Price[DipMem[me].SentOffer.nDeliver+i] shr 24); 2581 IsTreatyDeal:=false; 2582 for i:=0 to ReceivedOffer.nDeliver+ReceivedOffer.nCost-1 do 2583 if DipMem[me].SentOffer.Price[i] and opMask=opTreaty then 2584 IsTreatyDeal:=true; 2585 if IsTreatyDeal then Play('NEWTREATY') 2586 else Play('ACCEPTOFFER'); 5870 end; 5871 5872 if result = eMissionDone then 5873 begin 5874 p1 := MyRO.Territory[ToLoc]; 5875 case Mission of 5876 smStealMap: 5877 begin 5878 MapValid := false; 5879 PaintAllMaps 5880 end; 5881 smStealCivilReport: 5882 TribeMessage(p1, Tribe[p1].TPhrase('DOSSIER_PREPARED'), ''); 5883 smStealMilReport: 5884 ListDlg.ShowNewContent_MilReport(wmPersistent, p1); 2587 5885 end; 2588 NegoDlg.Start; 2589 idle:=true 2590 end; 2591 2592 cShowCancelTreaty: 2593 if not IsMultiPlayerGame then 2594 begin 2595 case G.RO[NewPlayer].Treaty[integer(data)] of 2596 trPeace: s:=Tribe[integer(data)].TPhrase('FRCANCELBYREJECT_PEACE'); 2597 trFriendlyContact: s:=Tribe[integer(data)].TPhrase('FRCANCELBYREJECT_FRIENDLY'); 2598 trAlliance: s:=Tribe[integer(data)].TPhrase('FRCANCELBYREJECT_ALLIANCE'); 2599 end; 2600 TribeMessage(integer(data), s, 'CANCELTREATY'); 5886 end; 5887 5888 if UnFocus >= 0 then 5889 CheckToldNoReturn(UnFocus); 5890 5891 NeedRepaintPanel := false; 5892 if result >= rExecuted then 5893 begin 5894 if CityCaptured and (MyMap[ToLoc] and fCity = 0) then 5895 begin // city destroyed 5896 for i := 0 to 27 do { tell about destroyed wonders } 5897 if (MyRO.Wonder[i].CityID = -2) and 5898 (MyData.ToldWonders[i].CityID <> -2) then 5899 with MessgExDlg do 5900 begin 5901 if WondersDlg.Visible then 5902 WondersDlg.SmartUpdateContent(false); 5903 OpenSound := 'WONDER_DESTROYED'; 5904 MessgText := Format(Phrases.Lookup('WONDERDEST'), 5905 [Phrases.Lookup('IMPROVEMENTS', i)]); 5906 Kind := mkOkHelp; 5907 HelpKind := hkImp; 5908 HelpNo := i; 5909 IconKind := mikImp; 5910 IconIndex := i; 5911 ShowModal; 5912 MyData.ToldWonders[i] := MyRO.Wonder[i]; 5913 end 2601 5914 end; 2602 2603 cShowCancelTreatyByAlliance: 2604 if idle and (NewPlayer=me) then 2605 TribeMessage(integer(data), Tribe[integer(data)].TPhrase('FRENEMYALLIANCE'), 2606 'CANCELTREATY'); 2607 2608 cShowSupportAllianceAgainst: 2609 if not IsMultiPlayerGame and (Jump[0]=0) then 2610 TribeMessage(integer(data) and $F, 2611 Tribe[integer(data) and $F].TPhrase('FRMYALLIANCE1') 2612 +' '+Tribe[integer(data) shr 4].TPhrase('FRMYALLIANCE2'), 2613 'CANCELTREATY'); 2614 2615 cShowPeaceViolation: 2616 if not IsMultiPlayerGame and (Jump[0]=0) then 2617 TribeMessage(integer(data), Format(Tribe[integer(data)].TPhrase('EVIOLATION'), 2618 [TurnToString(MyRO.Turn+PeaceEvaTurns-1)]), 'MSG_WITHDRAW'); 2619 2620 cShowEndContact: EndNego; 2621 2622 cShowUnitChanged,cShowCityChanged,cShowAfterMove,cShowAfterAttack: 2623 if (idle and (NewPlayer=me) or not idle and not skipped) 2624 and not ((GameMode=cMovie) and (MovieSpeed=4)) then 2625 begin 2626 assert(NewPlayer=me); 2627 if not idle or (GameMode=cMovie) then 2628 Application.ProcessMessages; 2629 if Command=cShowCityChanged then 2630 begin 2631 CurrentMoveInfo.DoShow:=false; 2632 if idle then 2633 CurrentMoveInfo.DoShow:=true 2634 else if CurrentMoveInfo.IsAlly then 2635 CurrentMoveInfo.DoShow:=not mAlNoMoves.Checked 2636 else CurrentMoveInfo.DoShow:=not mEnNoMoves.Checked 5915 if CityCaptured and (MyMap[ToLoc] and fCity <> 0) then 5916 begin // city captured 5917 ListDlg.AddCity; 5918 for i := 0 to 27 do { tell about capture of wonders } 5919 if MyRO.City[MyRO.nCity - 1].Built[i] > 0 then 5920 with MessgExDlg do 5921 begin 5922 if WondersDlg.Visible then 5923 WondersDlg.SmartUpdateContent(false); 5924 OpenSound := 'WONDER_CAPTURED'; 5925 MessgText := Format(Tribe[me].TPhrase('WONDERCAPTOWN'), 5926 [Phrases.Lookup('IMPROVEMENTS', i)]); 5927 Kind := mkOkHelp; 5928 HelpKind := hkImp; 5929 HelpNo := i; 5930 IconKind := mikImp; 5931 IconIndex := i; 5932 ShowModal; 5933 MyData.ToldWonders[i] := MyRO.Wonder[i]; 5934 end; 5935 5936 if MyRO.Happened and phStealTech <> 0 then 5937 begin { Temple of Zeus -- choose advance to steal } 5938 ModalSelectDlg.ShowNewContent(wmModal, kStealTech); 5939 Server(sStealTech, me, ModalSelectDlg.result, nil^); 5940 end; 5941 TellNewModels; 5942 5943 cix := MyRO.nCity - 1; 5944 while (cix >= 0) and (MyCity[cix].Loc <> ToLoc) do 5945 dec(cix); 5946 assert(cix >= 0); 5947 MyCity[cix].Status := MyCity[cix].Status and 5948 not csResourceWeightsMask or (3 shl 4); 5949 // captured city, set to maximum growth 5950 NewTiles := 1 shl 13; { exploit central tile only } 5951 Server(sSetCityTiles, me, cix, NewTiles); 5952 end 5953 else 5954 NeedRepaintPanel := true; 5955 end; 5956 TellNewContacts; 5957 5958 if (UnFocus >= 0) and (MyUn[UnFocus].Master >= 0) then 5959 with MyUn[MyUn[UnFocus].Master] do 5960 if Status and usStay <> 0 then 5961 begin 5962 Status := Status and not usStay; 5963 if (Movement >= 100) and (Status and (usRecover or usGoto) = 0) then 5964 Status := Status or usWaiting; 5965 end; 5966 if Options and (muAutoNoWait or muAutoNext) <> 0 then 5967 begin 5968 if (UnFocus >= 0) and ((result = eNoTime_Move) or UnitExhausted(UnFocus) 5969 or (MyUn[UnFocus].Master >= 0) or 5970 (MyModel[MyUn[UnFocus].mix].Domain = dAir) and 5971 ((MyMap[MyUn[UnFocus].Loc] and fCity <> 0) { aircrafts stop in cities } 5972 or (MyMap[MyUn[UnFocus].Loc] and fTerImp = tiBase))) then 5973 begin 5974 MyUn[UnFocus].Status := MyUn[UnFocus].Status and not usWaiting; 5975 if Options and muAutoNext <> 0 then 5976 if CityCaptured and (MyMap[ToLoc] and fCity <> 0) then 5977 begin 5978 UnFocus := -1; 5979 PaintLoc(ToLoc); // don't show unit in city if not selected 5980 end 5981 else 5982 NextUnit(UnStartLoc, true) 5983 end 5984 else if (UnFocus < 0) and (Options and muAutoNext <> 0) then 5985 NextUnit(UnStartLoc, result <> eMissionDone); 5986 end; 5987 5988 if NeedRepaintPanel and (UnFocus = UnFocus0) then 5989 if IsAttack then 5990 PanelPaint 5991 else 5992 begin 5993 assert(result <> eMissionDone); 5994 CheckTerrainBtnVisible; 5995 FocusOnLoc(ToLoc, flRepaintPanel or flImmUpdate) 5996 end; 5997 5998 if (result >= rExecuted) and CityCaptured and (MyMap[ToLoc] and fCity <> 0) 5999 then 6000 ZoomToCity(ToLoc, UnFocus < 0, chCaptured); // show captured city 6001 end; // moveunit 6002 6003 procedure TMainScreen.MoveOnScreen(ShowMove: TShowMove; 6004 Step0, Step1, nStep: integer; Restore: boolean = true); 6005 var 6006 ToLoc, xFromLoc, yFromLoc, xToLoc, yToLoc, xFrom, yFrom, xTo, yTo, xMin, 6007 yMin, xRange, yRange, xw1, Step, xMoving, yMoving, yl, 6008 SliceCount: integer; 6009 UnitInfo: TUnitInfo; 6010 Ticks0, Ticks: int64; 6011 begin 6012 Timer1.Enabled := false; 6013 QueryPerformanceCounter(Ticks0); 6014 with ShowMove do 6015 begin 6016 UnitInfo.Owner := Owner; 6017 UnitInfo.mix := mix; 6018 UnitInfo.Health := Health; 6019 UnitInfo.Job := jNone; 6020 UnitInfo.Flags := Flags; 6021 if Owner <> me then 6022 UnitInfo.emix := emix; 6023 6024 ToLoc := dLoc(FromLoc, dx, dy); 6025 xToLoc := ToLoc mod G.lx; 6026 yToLoc := ToLoc div G.lx; 6027 xFromLoc := FromLoc mod G.lx; 6028 yFromLoc := FromLoc div G.lx; 6029 if xToLoc > xFromLoc + 2 then 6030 xToLoc := xToLoc - G.lx 6031 else if xToLoc < xFromLoc - 2 then 6032 xToLoc := xToLoc + G.lx; 6033 6034 xw1 := xw + G.lx; 6035 // ((xFromLoc-xw1)*2+yFromLoc and 1+1)*xxt+dx*xxt/2-MapWidth/2 -> min 6036 while abs(((xFromLoc - xw1 + G.lx) * 2 + yFromLoc and 1 + 1) * xxt * 2 + 6037 dx * xxt - MapWidth) < abs(((xFromLoc - xw1) * 2 + yFromLoc and 1 + 1) * 6038 xxt * 2 + dx * xxt - MapWidth) do 6039 dec(xw1, G.lx); 6040 6041 xTo := (xToLoc - xw1) * (xxt * 2) + yToLoc and 1 * xxt + (xxt - xxu); 6042 yTo := (yToLoc - yw) * yyt + (yyt - yyu_anchor); 6043 xFrom := (xFromLoc - xw1) * (xxt * 2) + yFromLoc and 1 * xxt + 6044 (xxt - xxu); 6045 yFrom := (yFromLoc - yw) * yyt + (yyt - yyu_anchor); 6046 if xFrom < xTo then 6047 begin 6048 xMin := xFrom; 6049 xRange := xTo - xFrom 6050 end 6051 else 6052 begin 6053 xMin := xTo; 6054 xRange := xFrom - xTo 6055 end; 6056 if yFrom < yTo then 6057 begin 6058 yMin := yFrom; 6059 yRange := yTo - yFrom 6060 end 6061 else 6062 begin 6063 yMin := yTo; 6064 yRange := yFrom - yTo 6065 end; 6066 inc(xRange, xxt * 2); 6067 inc(yRange, yyt * 3); 6068 6069 MainOffscreenPaint; 6070 NoMap.SetOutput(Buffer); 6071 NoMap.SetPaintBounds(0, 0, xRange, yRange); 6072 for Step := 0 to abs(Step1 - Step0) do 6073 begin 6074 BitBlt(Buffer.Canvas.Handle, 0, 0, xRange, yRange, 6075 offscreen.Canvas.Handle, xMin, yMin, SRCCOPY); 6076 if Step1 <> Step0 then 6077 begin 6078 xMoving := xFrom + 6079 Round((Step0 + Step * (Step1 - Step0) div abs(Step1 - Step0)) * 6080 (xTo - xFrom) / nStep); 6081 yMoving := yFrom + 6082 Round((Step0 + Step * (Step1 - Step0) div abs(Step1 - Step0)) * 6083 (yTo - yFrom) / nStep); 2637 6084 end 2638 else if Command=cShowUnitChanged then 2639 begin 2640 CurrentMoveInfo.DoShow:=false; 2641 if idle then 2642 CurrentMoveInfo.DoShow:=not mEffectiveMovesOnly.Checked 2643 else if CurrentMoveInfo.IsAlly then 2644 CurrentMoveInfo.DoShow:=not (mAlNoMoves.Checked or mAlEffectiveMovesOnly.Checked) 2645 else CurrentMoveInfo.DoShow:=not (mEnNoMoves.Checked or mEnAttacks.Checked) 2646 end; 2647 // else keep DoShow from cShowMove/cShowAttack 2648 2649 if CurrentMoveInfo.DoShow then 2650 begin 2651 if Command=cShowCityChanged then MapValid:=false; 2652 FocusOnLoc(integer(Data),flImmUpdate); 2653 // OldUnFocus:=UnFocus; 2654 // UnFocus:=-1; 2655 if Command=cShowAfterMove then 2656 PaintLoc(integer(Data),CurrentMoveInfo.AfterMovePaintRadius) // show discovered areas 2657 else PaintLoc(integer(Data),1); 2658 // UnFocus:=OldUnFocus; 2659 if (Command=cShowAfterAttack) and (CurrentMoveInfo.AfterAttackExpeller>=0) then 6085 else 6086 begin 6087 xMoving := xFrom; 6088 yMoving := yFrom; 6089 end; 6090 NoMap.PaintUnit(xMoving - xMin, yMoving - yMin, UnitInfo, 0); 6091 PaintBufferToScreen(xMin, yMin, xRange, yRange); 6092 6093 SliceCount := 0; 6094 Ticks := Ticks0; 6095 repeat 6096 if (SliceCount = 0) or ((Ticks - Ticks0) * 12000 * (SliceCount + 1) 6097 div SliceCount < MoveTime * PerfFreq) then 2660 6098 begin 2661 SoundMessageEx(Tribe[CurrentMoveInfo.AfterAttackExpeller].TPhrase('EXPEL'),''); 2662 CurrentMoveInfo.AfterAttackExpeller:=-1; 2663 Update; // remove message box from screen 6099 if not idle or (GameMode = cMovie) then 6100 Application.ProcessMessages; 6101 Sleep(1); 6102 inc(SliceCount) 6103 end; 6104 QueryPerformanceCounter(Ticks); 6105 until (Ticks - Ticks0) * 12000 >= MoveTime * PerfFreq; 6106 Ticks0 := Ticks 6107 end; 6108 end; 6109 if Restore then 6110 begin 6111 BitBlt(Buffer.Canvas.Handle, 0, 0, xRange, yRange, 6112 offscreen.Canvas.Handle, xMin, yMin, SRCCOPY); 6113 PaintBufferToScreen(xMin, yMin, xRange, yRange); 6114 end; 6115 BlinkTime := -1; 6116 Timer1.Enabled := true; 6117 end; 6118 6119 procedure TMainScreen.MoveToLoc(Loc: integer; CheckSuicide: boolean); 6120 // path finder: move focused unit to loc, start multi-turn goto if too far 6121 var 6122 uix, i, MoveOptions, NextLoc, MoveResult: integer; 6123 MoveAdviceData: TMoveAdviceData; 6124 StopReason: (None, Arrived, Dead, NoTime, EnemySpotted, MoveError); 6125 begin 6126 if MyUn[UnFocus].Job > jNone then 6127 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 6128 if GetMoveAdvice(UnFocus, Loc, MoveAdviceData) >= rExecuted then 6129 begin 6130 uix := UnFocus; 6131 StopReason := None; 6132 repeat 6133 for i := 0 to MoveAdviceData.nStep - 1 do 6134 begin 6135 if i = MoveAdviceData.nStep - 1 then 6136 MoveOptions := muAutoNext 6137 else 6138 MoveOptions := 0; 6139 NextLoc := dLoc(MyUn[uix].Loc, MoveAdviceData.dx[i], 6140 MoveAdviceData.dy[i]); 6141 if (NextLoc = Loc) or (Loc = maNextCity) and 6142 (MyMap[NextLoc] and fCity <> 0) then 6143 StopReason := Arrived; 6144 if not CheckSuicide and (NextLoc = Loc) then 6145 MoveOptions := MoveOptions or muNoSuicideCheck; 6146 MoveResult := MoveUnit(MoveAdviceData.dx[i], MoveAdviceData.dy[i], 6147 MoveOptions); 6148 if MoveResult < rExecuted then 6149 StopReason := MoveError 6150 else if MoveResult and rUnitRemoved <> 0 then 6151 StopReason := Dead 6152 else if (StopReason = None) and (MoveResult and rEnemySpotted <> 0) 6153 then 6154 StopReason := EnemySpotted; 6155 if StopReason <> None then 6156 Break; 6157 end; 6158 if (StopReason = None) and 6159 ((MoveAdviceData.nStep < 25) or 6160 (MyRO.Wonder[woShinkansen].EffectiveOwner <> me)) then 6161 StopReason := NoTime; 6162 if StopReason <> None then 6163 Break; 6164 if GetMoveAdvice(UnFocus, Loc, MoveAdviceData) < rExecuted then 6165 begin 6166 assert(false); 6167 Break 6168 end 6169 until false; 6170 6171 case StopReason of 6172 None: 6173 assert(false); 6174 Arrived: 6175 MyUn[uix].Status := MyUn[uix].Status and ($FFFF - usGoto); 6176 Dead: 6177 if UnFocus < 0 then 6178 NextUnit(UnStartLoc, false); 6179 else 6180 begin // multi-turn goto 6181 if Loc = maNextCity then 6182 MyUn[uix].Status := MyUn[uix].Status and 6183 ($FFFF - usStay - usRecover) or usGoto + $7FFF shl 16 6184 else 6185 MyUn[uix].Status := MyUn[uix].Status and 6186 ($FFFF - usStay - usRecover) or usGoto + Loc shl 16; 6187 PaintLoc(MyUn[uix].Loc); 6188 if (StopReason = NoTime) and (UnFocus = uix) then 6189 begin 6190 MyUn[uix].Status := MyUn[uix].Status and not usWaiting; 6191 NextUnit(UnStartLoc, true) 6192 end; 2664 6193 end 2665 else if not idle then 2666 if Command=cShowCityChanged then 2667 Sleep(MoveTime*WaitAfterShowMove div 16) 2668 else if (Command=cShowUnitChanged) 2669 and (MyMap[integer(Data)] and fUnit<>0) then 2670 Sleep(MoveTime*WaitAfterShowMove div 32) 2671 end // if CurrentMoveInfo.DoShow 2672 else MapValid:=false; 6194 end 6195 end 6196 end; 6197 6198 procedure TMainScreen.PanelBoxMouseDown(Sender: TObject; 6199 Button: TMouseButton; Shift: TShiftState; x, y: integer); 6200 var 6201 i, xMouse, MouseLoc, p1: integer; 6202 begin 6203 if GameMode = cMovie then 6204 exit; 6205 6206 if Button = mbLeft then 6207 begin 6208 if (x >= xMini + 2) and (y >= yMini + 2) and (x < xMini + 2 + 2 * G.lx) 6209 and (y < yMini + 2 + G.ly) then 6210 if ssShift in Shift then 6211 begin 6212 xMouse := (xwMini + (x - (xMini + 2) + MapWidth div (xxt * 2) + 6213 G.lx) div 2) mod G.lx; 6214 MouseLoc := xMouse + G.lx * (y - (yMini + 2)); 6215 if MyMap[MouseLoc] and fTerrain <> fUNKNOWN then 6216 begin 6217 p1 := MyRO.Territory[MouseLoc]; 6218 if (p1 = me) or (p1 >= 0) and (MyRO.Treaty[p1] >= trNone) then 6219 NatStatDlg.ShowNewContent(wmPersistent, p1); 6220 end 6221 end 6222 else 6223 begin 6224 if CityDlg.Visible then 6225 CityDlg.Close; 6226 if UnitStatDlg.Visible then 6227 UnitStatDlg.Close; 6228 Tracking := true; 6229 PanelBoxMouseMove(Sender, Shift + [ssLeft], x, y); 6230 end 6231 else if (ClientMode <> cEditMap) and (x >= ClientWidth - xPalace) and 6232 (y >= yPalace) and (x < ClientWidth - xPalace + xSizeBig) and 6233 (y < yPalace + ySizeBig) then 6234 begin 6235 InitPopup(StatPopup); 6236 if FullScreen then 6237 StatPopup.Popup(Left + ClientWidth - xPalace + xSizeBig + 2, 6238 Top + ClientHeight - PanelHeight + yPalace - 1) 6239 else 6240 StatPopup.Popup(Left + ClientWidth - xPalace + 6, 6241 Top + ClientHeight - PanelHeight + yPalace + ySizeBig + 6242 GetSystemMetrics(SM_CYCAPTION) + 3) 6243 end 6244 (* else if (x>=xAdvisor-3) and (y>=yAdvisor-3) 6245 and (x<xAdvisor+16+3) and (y<yAdvisor+16+3) and HaveStrategyAdvice then 6246 AdviceBtnClick *) 6247 else if (x >= xTroop + 1) and (y >= yTroop + 1) and 6248 (x < xTroop + TrRow * TrPitch) and (y <= yTroop + 55) then 6249 begin 6250 i := (x - xTroop - 1) div TrPitch; 6251 if trix[i] >= 0 then 6252 if ClientMode = cEditMap then 6253 begin 6254 BrushType := trix[i]; 6255 PanelPaint 6256 end 6257 else if (TroopLoc >= 0) then 6258 if MyMap[TroopLoc] and fOwned <> 0 then 6259 begin 6260 if ssShift in Shift then 6261 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, 6262 MyUn[trix[i]].mix) 6263 else if not supervising and (ClientMode < scContact) and 6264 (x - xTroop - 1 - i * TrPitch >= 60 - 20) and 6265 (y >= yTroop + 35) and 6266 ((MyUn[trix[i]].Job > jNone) or (MyUn[trix[i]].Status and 6267 (usStay or usRecover or usGoto) <> 0)) then 6268 begin // wake up 6269 MyUn[trix[i]].Status := MyUn[trix[i]].Status and 6270 ($FFFF - usStay - usRecover - usGoto - usEnhance) or 6271 usWaiting; 6272 if MyUn[trix[i]].Job > jNone then 6273 Server(sStartJob + jNone shl 4, me, trix[i], nil^); 6274 if (UnFocus < 0) and not CityDlg.Visible then 6275 begin 6276 SetUnFocus(trix[i]); 6277 SetTroopLoc(MyUn[trix[i]].Loc); 6278 FocusOnLoc(TroopLoc, flRepaintPanel) 6279 end 6280 else 6281 begin 6282 if CityDlg.Visible and (CityDlg.RestoreUnFocus < 0) then 6283 CityDlg.RestoreUnFocus := trix[i]; 6284 PanelPaint; 6285 end 6286 end 6287 else if (ClientMode < scContact) then 6288 begin 6289 if supervising then 6290 UnitStatDlg.ShowNewContent_OwnUnit(wmPersistent, trix[i]) 6291 else if CityDlg.Visible then 6292 begin 6293 CityDlg.CloseAction := None; 6294 CityDlg.Close; 6295 SumCities(TaxSum, ScienceSum); 6296 SetUnFocus(trix[i]); 6297 end 6298 else 6299 begin 6300 DestinationMarkON := false; 6301 PaintDestination; 6302 UnFocus := trix[i]; 6303 UnStartLoc := TroopLoc; 6304 BlinkTime := 0; 6305 BlinkON := false; 6306 PaintLoc(TroopLoc); 6307 end; 6308 if UnFocus >= 0 then 6309 begin 6310 UnitInfoBtn.Visible := true; 6311 UnitBtn.Visible := true; 6312 TurnComplete := false; 6313 EOT.ButtonIndex := eotGray; 6314 end; 6315 CheckTerrainBtnVisible; 6316 PanelPaint; 6317 end 6318 end 6319 else if Server(sGetUnits, me, TroopLoc, TrCnt) >= rExecuted then 6320 if ssShift in Shift then 6321 UnitStatDlg.ShowNewContent_EnemyModel(wmPersistent, 6322 MyRO.EnemyUn[MyRO.nEnemyUn + trix[i]].emix) // model info 6323 else 6324 UnitStatDlg.ShowNewContent_EnemyUnit(wmPersistent, 6325 MyRO.nEnemyUn + trix[i]); // unit info 6326 end 6327 end 6328 end; 6329 6330 procedure TMainScreen.SetTroopLoc(Loc: integer); 6331 var 6332 trixFocus, uix, uixDefender: integer; 6333 Prio: boolean; 6334 begin 6335 TroopLoc := Loc; 6336 TrRow := (xRightPanel + 10 - xTroop - GetSystemMetrics(SM_CXVSCROLL) - 19) 6337 div TrPitch; 6338 TrCnt := 0; 6339 trixFocus := -1; 6340 if ClientMode = cEditMap then 6341 TrCnt := nBrushTypes 6342 else if (Loc >= 0) and (MyMap[Loc] and fUnit <> 0) then 6343 if MyMap[Loc] and fOwned <> 0 then 6344 begin // count own units here 6345 Server(sGetDefender, me, TroopLoc, uixDefender); 6346 for Prio := true downto false do 6347 for uix := 0 to MyRO.nUn - 1 do 6348 if ((uix = uixDefender) = Prio) and (MyUn[uix].Loc = Loc) then 6349 begin 6350 if uix = UnFocus then 6351 trixFocus := TrCnt; 6352 inc(TrCnt); 6353 end 6354 end 6355 else // count enemy units here 6356 Server(sGetUnits, me, Loc, TrCnt); 6357 if TrCnt = 0 then 6358 InitPVSB(sb, 0, 1) 6359 else 6360 begin 6361 InitPVSB(sb, (TrCnt + TrRow - 1) div TrRow - 1, 1); 6362 with sb.si do 6363 if (nMax >= integer(nPage)) and (trixFocus >= 0) then 6364 begin 6365 sb.si.npos := trixFocus div TrRow; 6366 sb.si.FMask := SIF_POS; 6367 SetScrollInfo(sb.h, SB_CTL, sb.si, true); 6368 end 6369 end 6370 end; 6371 6372 (* procedure TMainScreen.ShowMoveHint(ToLoc: integer; Force: boolean = false); 6373 var 6374 Step,Loc,x0,y0,xs,ys: integer; 6375 Info: string; 6376 InfoSize: TSize; 6377 MoveAdvice: TMoveAdviceData; 6378 begin 6379 if (ToLoc<0) or (ToLoc>=G.lx*G.ly) 6380 or (UnFocus<0) or (MyUn[UnFocus].Loc=ToLoc) then 6381 ToLoc:=-1 6382 else 6383 begin 6384 MoveAdvice.ToLoc:=ToLoc; 6385 MoveAdvice.MoreTurns:=0; 6386 MoveAdvice.MaxHostile_MovementLeft:=MyUn[UnFocus].Health-50; 6387 if Server(sGetMoveAdvice,me,UnFocus,MoveAdvice)<rExecuted then 6388 ToLoc:=-1 2673 6389 end; 2674 2675 cShowMoving,cShowCapturing: 2676 if (idle and (NewPlayer=me) 2677 or not idle and not skipped and (TShowMove(Data).emix<>$FFFF)) 2678 and not ((GameMode=cMovie) and (MovieSpeed=4)) then 2679 begin 2680 assert(NewPlayer=me); 2681 if not idle or (GameMode=cMovie) then 2682 Application.ProcessMessages; 2683 with TShowMove(Data) do 2684 begin 2685 CurrentMoveInfo.DoShow:=false; 2686 if not idle and (Tribe[Owner].ModelPicture[mix].HGr=0) then 2687 InitEnemyModel(emix); 2688 2689 ToLoc:=dLoc(FromLoc,dx,dy); 2690 if idle then 2691 begin // own unit -- make discovered land visible 2692 assert(Owner=me); // no foreign moves during my turn! 2693 CurrentMoveInfo.DoShow:=not mEffectiveMovesOnly.Checked 2694 or (Command=cShowCapturing); 2695 if CurrentMoveInfo.DoShow then 6390 if (ToLoc=MoveHintToLoc) and not Force then exit; 6391 if (ToLoc<>MoveHintToLoc) and (MoveHintToLoc>=0) then 6392 begin invalidate; update end; // clear old hint from screen 6393 MoveHintToLoc:=ToLoc; 6394 if ToLoc<0 then exit; 6395 6396 with canvas do 6397 begin 6398 Pen.Color:=$80C0FF; 6399 Pen.Width:=3; 6400 Loc:=MyUn[UnFocus].Loc; 6401 for Step:=0 to MoveAdvice.nStep do 6402 begin 6403 y0:=(Loc+G.lx*1024) div G.lx -1024; 6404 x0:=(Loc+(y0 and 1+G.lx*1024) div 2) mod G.lx; 6405 xs:=(x0-xw)*66+y0 and 1*33-G.lx*66; 6406 while abs(2*(xs+G.lx*66)-MapWidth)<abs(2*xs-MapWidth) do 6407 inc(xs,G.lx*66); 6408 ys:=(y0-yw)*16; 6409 if Step=0 then moveto(xs+33,ys+16) 6410 else lineto(xs+33,ys+16); 6411 if Step<MoveAdvice.nStep then 6412 Loc:=dLoc(Loc,MoveAdvice.dx[Step],MoveAdvice.dy[Step]); 6413 end; 6414 Brush.Color:=$80C0FF; 6415 Info:=' '+inttostr(88)+' '; 6416 InfoSize:=TextExtent(Info); 6417 TextOut(xs+33-InfoSize.cx div 2, ys+16-InfoSize.cy div 2, Info); 6418 Brush.Style:=bsClear; 6419 end 6420 end; *) 6421 6422 procedure TMainScreen.SetDebugMap(p: integer); 6423 begin 6424 IsoEngine.pDebugMap := p; 6425 IsoEngine.Options := IsoEngine.Options and not(1 shl moLocCodes); 6426 mLocCodes.Checked := false; 6427 MapValid := false; 6428 MainOffscreenPaint; 6429 end; 6430 6431 procedure TMainScreen.SetViewpoint(p: integer); 6432 var 6433 i: integer; 6434 begin 6435 if supervising and (G.RO[0].Turn > 0) and 6436 ((p = 0) or (1 shl p and G.RO[0].Alive <> 0)) then 6437 begin 6438 for i := 0 to Screen.FormCount - 1 do 6439 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 6440 then 6441 Screen.Forms[i].Close; // close windows 6442 ItsMeAgain(p); 6443 SumCities(TaxSum, ScienceSum); 6444 for i := 0 to MyRO.nModel - 1 do 6445 if Tribe[me].ModelPicture[i].HGr = 0 then 6446 InitMyModel(i, true); 6447 6448 SetTroopLoc(-1); 6449 PanelPaint; 6450 MapValid := false; 6451 PaintAllMaps; 6452 end 6453 end; 6454 6455 procedure TMainScreen.FormKeyDown(Sender: TObject; var Key: word; 6456 Shift: TShiftState); 6457 6458 procedure MenuClick_Check(Popup: TPopupMenu; Item: TMenuItem); 6459 begin 6460 InitPopup(Popup); 6461 if Item.Visible and Item.Enabled then 6462 MenuClick(Item); 6463 end; 6464 6465 var 6466 dx, dy: integer; 6467 time0, time1: int64; 6468 begin 6469 if GameMode = cMovie then 6470 begin 6471 case Key of 6472 VK_F4: 6473 MenuClick_Check(StatPopup, mScienceStat); 6474 VK_F6: 6475 MenuClick_Check(StatPopup, mDiagram); 6476 VK_F7: 6477 MenuClick_Check(StatPopup, mWonders); 6478 VK_F8: 6479 MenuClick_Check(StatPopup, mShips); 6480 end; 6481 exit; 6482 end; 6483 6484 if not idle then 6485 exit; 6486 6487 if ClientMode = cEditMap then 6488 begin 6489 if Shift = [ssCtrl] then 6490 case char(Key) of 6491 (* 'A': 6492 begin // auto symmetry 6493 Server($7F0,me,0,nil^); 6494 MapValid:=false; 6495 PaintAll; 6496 end; 6497 'B': 6498 begin // land mass 6499 dy:=0; 6500 for dx:=G.lx to G.lx*(G.ly-1)-1 do 6501 if MyMap[dx] and fTerrain>=fGrass then inc(dy); 6502 dy:=dy 6503 end; *) 6504 'Q': 6505 MenuClick(mResign); 6506 'R': 6507 MenuClick(mRandomMap); 6508 end 6509 else if Shift = [] then 6510 case char(Key) of 6511 char(VK_F1): 6512 MenuClick(mHelp); 6513 end; 6514 exit; 6515 end; 6516 6517 if Shift = [ssAlt] then 6518 case char(Key) of 6519 '0': 6520 SetDebugMap(-1); 6521 '1' .. '9': 6522 SetDebugMap(ord(Key) - 48); 6523 end 6524 else if Shift = [ssCtrl] then 6525 case char(Key) of 6526 'J': 6527 MenuClick(mJump); 6528 'K': 6529 mShowClick(mDebugMap); 6530 'L': 6531 mShowClick(mLocCodes); 6532 'M': 6533 if LogDlg.Visible then 6534 LogDlg.Close 6535 else 6536 LogDlg.Show; 6537 'N': 6538 mNamesClick(mNames); 6539 'Q': 6540 MenuClick_Check(GamePopup, mResign); 6541 'R': 6542 MenuClick(mRun); 6543 '0' .. '9': 2696 6544 begin 2697 if GameMode=cMovie then 6545 if ord(Key) - 48 = me then 6546 SetViewpoint(0) 6547 else 6548 SetViewpoint(ord(Key) - 48); 6549 end; 6550 ' ': 6551 begin // test map repaint time 6552 QueryPerformanceCounter(time0); 6553 MapValid := false; 6554 MainOffscreenPaint; 6555 QueryPerformanceCounter(time1); 6556 SimpleMessage(Format('Map repaint time: %.3f ms', 6557 [{$IFDEF VER100}(time1.LowPart - time0.LowPart) 6558 {$ELSE}(time1 - time0){$ENDIF} * 1000.0 / PerfFreq])); 6559 end 6560 end 6561 else if Shift = [] then 6562 case char(Key) of 6563 char(VK_F1): 6564 MenuClick(mHelp); 6565 char(VK_F2): 6566 MenuClick_Check(StatPopup, mUnitStat); 6567 char(VK_F3): 6568 MenuClick_Check(StatPopup, mCityStat); 6569 char(VK_F4): 6570 MenuClick_Check(StatPopup, mScienceStat); 6571 char(VK_F5): 6572 MenuClick_Check(StatPopup, mEUnitStat); 6573 char(VK_F6): 6574 MenuClick_Check(StatPopup, mDiagram); 6575 char(VK_F7): 6576 MenuClick_Check(StatPopup, mWonders); 6577 char(VK_F8): 6578 MenuClick_Check(StatPopup, mShips); 6579 char(VK_F9): 6580 MenuClick_Check(StatPopup, mNations); 6581 char(VK_F10): 6582 MenuClick_Check(StatPopup, mEmpire); 6583 char(VK_ADD): 6584 EndTurn; 6585 '1': 6586 MapBtnClick(MapBtn0); 6587 '2': 6588 MapBtnClick(MapBtn1); 6589 '3': 6590 MapBtnClick(MapBtn4); 6591 '4': 6592 MapBtnClick(MapBtn5); 6593 '5': 6594 MapBtnClick(MapBtn6); 6595 'T': 6596 MenuClick(mTechTree); 6597 'W': 6598 MenuClick(mWait); 6599 end; 6600 6601 if UnFocus >= 0 then 6602 if Shift = [ssCtrl] then 6603 case char(Key) of 6604 'C': 6605 MenuClick_Check(UnitPopup, mCancel); 6606 'D': 6607 MenuClick(mDisband); 6608 'P': 6609 MenuClick_Check(UnitPopup, mPillage); 6610 'T': 6611 MenuClick_Check(UnitPopup, mSelectTransport); 6612 end 6613 else if Shift = [] then 6614 case char(Key) of 6615 ' ': 6616 MenuClick(mNoOrders); 6617 'A': 6618 MenuClick_Check(TerrainPopup, mAirBase); 6619 'B': 6620 MenuClick_Check(UnitPopup, mCity); 6621 'C': 6622 MenuClick(mCentre); 6623 'E': 2698 6624 begin 2699 if MovieSpeed=3 then AnimationSpeed:=4 2700 else if MovieSpeed=2 then AnimationSpeed:=8 2701 else AnimationSpeed:=16; 6625 InitPopup(TerrainPopup); 6626 if mEnhance.Visible and mEnhance.Enabled then 6627 MenuClick(mEnhance) 6628 else 6629 MenuClick(mEnhanceDef) 6630 end; 6631 'F': 6632 MenuClick_Check(TerrainPopup, mFort); 6633 'G': 6634 MenuClick_Check(UnitPopup, mGoOn); 6635 'H': 6636 MenuClick_Check(UnitPopup, mHome); 6637 'I': 6638 if JobTest(UnFocus, jFarm, [eTreaty]) then 6639 MenuClick(mFarm) 6640 else if JobTest(UnFocus, jClear, [eTreaty]) then 6641 MenuClick(mClear) 6642 else 6643 MenuClick_Check(TerrainPopup, mIrrigation); 6644 'L': 6645 MenuClick_Check(UnitPopup, mLoad); 6646 'M': 6647 if JobTest(UnFocus, jAfforest, [eTreaty]) then 6648 MenuClick(mAfforest) 6649 else 6650 MenuClick_Check(TerrainPopup, mMine); 6651 'N': 6652 MenuClick_Check(TerrainPopup, mCanal); 6653 'O': 6654 MenuClick_Check(TerrainPopup, MTrans); 6655 'P': 6656 MenuClick_Check(TerrainPopup, mPollution); 6657 'R': 6658 if JobTest(UnFocus, jRR, [eTreaty]) then 6659 MenuClick(mRR) 6660 else 6661 MenuClick_Check(TerrainPopup, mRoad); 6662 'S': 6663 MenuClick(mStay); 6664 'U': 6665 MenuClick_Check(UnitPopup, mUnload); 6666 'V': 6667 MenuClick_Check(UnitPopup, mRecover); 6668 'Z': 6669 MenuClick_Check(UnitPopup, mUtilize); 6670 #33 .. #40, #97 .. #100, #102 .. #105: 6671 begin { arrow keys } 6672 DestinationMarkON := false; 6673 PaintDestination; 6674 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 6675 ($FFFF - usStay - usRecover - usGoto - usEnhance) or 6676 usWaiting; 6677 case Key of 6678 VK_NUMPAD1, VK_END: 6679 begin 6680 dx := -1; 6681 dy := 1 6682 end; 6683 VK_NUMPAD2, VK_DOWN: 6684 begin 6685 dx := 0; 6686 dy := 2 6687 end; 6688 VK_NUMPAD3, VK_NEXT: 6689 begin 6690 dx := 1; 6691 dy := 1 6692 end; 6693 VK_NUMPAD4, VK_LEFT: 6694 begin 6695 dx := -2; 6696 dy := 0 6697 end; 6698 VK_NUMPAD6, VK_RIGHT: 6699 begin 6700 dx := 2; 6701 dy := 0 6702 end; 6703 VK_NUMPAD7, VK_HOME: 6704 begin 6705 dx := -1; 6706 dy := -1 6707 end; 6708 VK_NUMPAD8, VK_UP: 6709 begin 6710 dx := 0; 6711 dy := -2 6712 end; 6713 VK_NUMPAD9, VK_PRIOR: 6714 begin 6715 dx := 1; 6716 dy := -1 6717 end; 6718 end; 6719 MoveUnit(dx, dy, muAutoNext) 6720 end; 6721 end 6722 end; 6723 6724 procedure TMainScreen.MenuClick(Sender: TObject); 6725 6726 function DoJob(j0: integer): integer; 6727 var 6728 Loc0, Movement0: integer; 6729 begin 6730 with MyUn[UnFocus] do 6731 begin 6732 DestinationMarkON := false; 6733 PaintDestination; 6734 Loc0 := Loc; 6735 Movement0 := Movement; 6736 if j0 < 0 then 6737 result := ProcessEnhancement(UnFocus, MyData.EnhancementJobs) 6738 // terrain enhancement 6739 else 6740 result := Server(sStartJob + j0 shl 4, me, UnFocus, nil^); 6741 if result >= rExecuted then 6742 begin 6743 if result = eDied then 6744 UnFocus := -1; 6745 PaintLoc(Loc0); 6746 if UnFocus >= 0 then 6747 begin 6748 if (j0 < 0) and (result <> eJobDone) then 6749 // multi-turn terrain enhancement 6750 Status := Status and ($FFFF - usStay - usRecover - usGoto) or 6751 usEnhance 6752 else 6753 Status := Status and 6754 ($FFFF - usStay - usRecover - usGoto - usEnhance); 6755 if (Job <> jNone) or (Movement0 < 100) then 6756 begin 6757 Status := Status and not usWaiting; 6758 NextUnit(UnStartLoc, true); 2702 6759 end 6760 else 6761 PanelPaint 6762 end 2703 6763 else 6764 NextUnit(UnStartLoc, true); 6765 end 6766 end; 6767 case result of 6768 eNoBridgeBuilding: 6769 SoundMessage(Phrases.Lookup('NOBB'), 'INVALID'); 6770 eNoCityTerrain: 6771 SoundMessage(Phrases.Lookup('NOCITY'), 'INVALID'); 6772 eTreaty: 6773 SoundMessage(Tribe[MyRO.Territory[Loc0]].TPhrase('PEACE_NOWORK'), 6774 'NOMOVE_TREATY'); 6775 else 6776 if result < rExecuted then 6777 Play('INVALID') 6778 end 6779 end; 6780 6781 var 6782 i, uix, NewFocus, Loc0, OldMaster, Destination, cix, cixOldHome, 6783 ServerResult: integer; 6784 AltGovs, Changed: boolean; 6785 QueryText: string; 6786 6787 begin 6788 if Sender = mResign then 6789 if ClientMode = cEditMap then 6790 begin 6791 if Edited then 6792 begin 6793 QueryText := Phrases.Lookup('MAP_CLOSE'); 6794 case SimpleQuery(mkYesNoCancel, QueryText, '') of 6795 mrIgnore: 6796 Server(sAbandonMap, me, 0, nil^); 6797 mrOK: 6798 Server(sSaveMap, me, 0, nil^); 6799 end 6800 end 6801 else 6802 Server(sAbandonMap, me, 0, nil^) 6803 end 6804 else 6805 begin 6806 if Server(sGetGameChanged, 0, 0, nil^) = eOK then 6807 begin 6808 QueryText := Phrases.Lookup('RESIGN'); 6809 case SimpleQuery(mkYesNoCancel, QueryText, '') of 6810 mrIgnore: 6811 Server(sResign, 0, 0, nil^); 6812 mrOK: 6813 Server(sBreak, 0, 0, nil^) 6814 end 6815 end 6816 else 6817 Server(sResign, 0, 0, nil^) 6818 end 6819 else if Sender = mEmpire then 6820 RatesDlg.ShowNewContent(wmPersistent) 6821 else if Sender = mRevolution then 6822 begin 6823 AltGovs := false; 6824 for i := 2 to nGov - 1 do 6825 if (GovPreq[i] <> preNA) and 6826 ((GovPreq[i] = preNone) or (MyRO.Tech[GovPreq[i]] >= tsApplicable)) 6827 then 6828 AltGovs := true; 6829 6830 if not AltGovs then 6831 SoundMessage(Phrases.Lookup('NOALTGOVS'), 'MSG_DEFAULT') 6832 else 6833 begin 6834 Changed := false; 6835 if MyRO.Happened and phChangeGov <> 0 then 6836 begin 6837 ModalSelectDlg.ShowNewContent(wmModal, kGov); 6838 if ModalSelectDlg.result >= 0 then 6839 begin 6840 Play('NEWGOV'); 6841 Server(sSetGovernment, me, ModalSelectDlg.result, nil^); 6842 CityOptimizer_BeginOfTurn; 6843 Changed := true; 6844 end 6845 end 6846 else 6847 with MessgExDlg do 6848 begin // revolution! 6849 MessgText := Tribe[me].TPhrase('REVOLUTION'); 6850 Kind := mkYesNo; 6851 IconKind := mikPureIcon; 6852 IconIndex := 72; // anarchy palace 6853 ShowModal; 6854 if ModalResult = mrOK then 2704 6855 begin 2705 if mVeryFastMoves.Checked then AnimationSpeed:=4 2706 else if mFastMoves.Checked then AnimationSpeed:=8 2707 else AnimationSpeed:=16; 2708 end; 2709 with MyModel[mix] do 6856 Play('REVOLUTION'); 6857 Server(sRevolution, me, 0, nil^); 6858 Changed := true; 6859 if NatStatDlg.Visible then 6860 NatStatDlg.Close; 6861 if CityDlg.Visible then 6862 CityDlg.Close; 6863 end 6864 end; 6865 if Changed then 6866 UpdateViews(true); 6867 end 6868 end 6869 else if Sender = mWebsite then 6870 ShellExecute(Handle, 'open', 'http://c-evo.org', '', '', SW_SHOWNORMAL) 6871 else if Sender = mRandomMap then 6872 begin 6873 if not Edited or (SimpleQuery(mkYesNo, Phrases.Lookup('MAP_RANDOM'), '') 6874 = mrOK) then 6875 begin 6876 Server(sRandomMap, me, 0, nil^); 6877 Edited := true; 6878 MapValid := false; 6879 PaintAllMaps; 6880 end 6881 end 6882 else if Sender = mJump then 6883 begin 6884 if supervising then 6885 Jump[0] := 20 6886 else 6887 Jump[me] := 20; 6888 EndTurn(true); 6889 end 6890 else if Sender = mRun then 6891 begin 6892 if supervising then 6893 Jump[0] := 999999 6894 else 6895 Jump[me] := 999999; 6896 EndTurn(true); 6897 end 6898 else if Sender = mEnhanceDef then 6899 begin 6900 if UnFocus >= 0 then 6901 EnhanceDlg.ShowNewContent(wmPersistent, 6902 MyMap[MyUn[UnFocus].Loc] and fTerrain) 6903 else 6904 EnhanceDlg.ShowNewContent(wmPersistent) 6905 end 6906 else if Sender = mCityTypes then 6907 CityTypeDlg.ShowNewContent(wmModal) 6908 // must be modal because types are not saved before closing 6909 else if Sender = mUnitStat then 6910 begin 6911 if G.Difficulty[me] > 0 then 6912 ListDlg.ShowNewContent_MilReport(wmPersistent, me) 6913 else 6914 begin 6915 i := 1; 6916 while (i < nPl) and (1 shl i and MyRO.Alive = 0) do 6917 inc(i); 6918 if i < nPl then 6919 ListDlg.ShowNewContent_MilReport(wmPersistent, i); 6920 end; 6921 end 6922 else if Sender = mEUnitStat then 6923 begin 6924 if MyRO.nEnemyModel > 0 then 6925 ListDlg.ShowNewContent(wmPersistent, kAllEModels); 6926 end 6927 else if Sender = mCityStat then 6928 ListDlg.ShowNewContent(wmPersistent, kCities) 6929 else if Sender = mScienceStat then 6930 ListDlg.ShowNewContent(wmPersistent, kScience) 6931 else if Sender = mNations then 6932 NatStatDlg.ShowNewContent(wmPersistent) 6933 else if Sender = mHelp then 6934 if ClientMode = cEditMap then 6935 HelpDlg.ShowNewContent(wmPersistent, hkText, 6936 HelpDlg.TextIndex('MAPEDIT')) 6937 else 6938 HelpDlg.ShowNewContent(wmPersistent, hkMisc, miscMain) 6939 else if Sender = mTechTree then 6940 TechTreeDlg.ShowModal 6941 else if Sender = mWonders then 6942 WondersDlg.ShowNewContent(wmPersistent) 6943 else if Sender = mDiagram then 6944 DiaDlg.ShowNewContent_Charts(wmPersistent) 6945 else if Sender = mShips then 6946 DiaDlg.ShowNewContent_Ship(wmPersistent) 6947 else if Sender = mWait then 6948 begin 6949 if UnFocus >= 0 then 6950 begin 6951 DestinationMarkON := false; 6952 PaintDestination; 6953 MyUn[UnFocus].Status := MyUn[UnFocus].Status and 6954 ($FFFF - usStay - usRecover - usGoto - usEnhance) or usWaiting; 6955 end; 6956 NextUnit(-1, false); 6957 end 6958 else if UnFocus >= 0 then 6959 with MyUn[UnFocus] do 6960 if Sender = mGoOn then 6961 begin 6962 if Status shr 16 = $7FFF then 6963 Destination := maNextCity 6964 else 6965 Destination := Status shr 16; 6966 Status := Status and not(usStay or usRecover) or usWaiting; 6967 MoveToLoc(Destination, true); 6968 end 6969 else if Sender = mHome then 6970 if MyMap[Loc] and fCity <> 0 then 6971 begin 6972 cixOldHome := Home; 6973 if Server(sSetUnitHome, me, UnFocus, nil^) >= rExecuted then 2710 6974 begin 2711 if (Kind=mkDiplomat) or (Domain=dAir) 2712 or (Cap[mcRadar]+Cap[mcCarrier]+Cap[mcAcademy]>0) 2713 or (MyMap[ToLoc] and fTerrain=fMountains) 2714 or (MyMap[ToLoc] and fTerImp=tiFort) 2715 or (MyMap[ToLoc] and fTerImp=tiBase) then 2716 CurrentMoveInfo.AfterMovePaintRadius:=2 2717 else CurrentMoveInfo.AfterMovePaintRadius:=1; 2718 if (MyRO.Wonder[woShinkansen].EffectiveOwner=me) 2719 and (Domain=dGround) 2720 and (MyMap[FromLoc] and (fRR or fCity)<>0) 2721 and (MyMap[ToLoc] and (fRR or fCity)<>0) 2722 and (Flags and umPlaneUnloading=0) then 2723 AnimationSpeed:=4; 2724 ShowMoveDomain:=Domain; 2725 IsAlpine:= Cap[mcAlpine]>0; 6975 CityOptimizer_CityChange(cixOldHome); 6976 CityOptimizer_CityChange(Home); 6977 UpdateViews(true); 6978 end 6979 else 6980 Play('INVALID'); 6981 end 6982 else 6983 begin 6984 Status := Status and not(usStay or usRecover or usEnhance); 6985 MoveToLoc(maNextCity, true) 6986 end 6987 else if Sender = mCentre then 6988 begin 6989 Centre(Loc); 6990 PaintAllMaps 6991 end 6992 else if Sender = mCity then 6993 begin 6994 Loc0 := Loc; 6995 if MyMap[Loc] and fCity = 0 then 6996 begin // build city 6997 if DoJob(jCity) = eCity then 6998 begin 6999 MapValid := false; 7000 PaintAll; 7001 ZoomToCity(Loc0, true, chFounded); 2726 7002 end 2727 7003 end 7004 else 7005 begin 7006 CityOptimizer_BeforeRemoveUnit(UnFocus); 7007 ServerResult := Server(sAddToCity, me, UnFocus, nil^); 7008 if ServerResult >= rExecuted then 7009 begin 7010 cix := MyRO.nCity - 1; 7011 while (cix >= 0) and (MyCity[cix].Loc <> Loc0) do 7012 dec(cix); 7013 assert(cix >= 0); 7014 CityOptimizer_CityChange(cix); 7015 CityOptimizer_AfterRemoveUnit; // does nothing here 7016 SetTroopLoc(Loc0); 7017 UpdateViews(true); 7018 DestinationMarkON := false; 7019 PaintDestination; 7020 UnFocus := -1; 7021 PaintLoc(Loc0); 7022 NextUnit(UnStartLoc, true); 7023 end 7024 else if ServerResult = eMaxSize then 7025 SimpleMessage(Phrases.Lookup('ADDTOMAXSIZE')); 7026 end 2728 7027 end 7028 else if Sender = mRoad then 7029 DoJob(jRoad) 7030 else if Sender = mRR then 7031 DoJob(jRR) 7032 else if Sender = mClear then 7033 DoJob(jClear) 7034 else if Sender = mIrrigation then 7035 DoJob(jIrr) 7036 else if Sender = mFarm then 7037 DoJob(jFarm) 7038 else if Sender = mAfforest then 7039 DoJob(jAfforest) 7040 else if Sender = mMine then 7041 DoJob(jMine) 7042 else if Sender = mCanal then 7043 DoJob(jCanal) 7044 else if Sender = MTrans then 7045 DoJob(jTrans) 7046 else if Sender = mFort then 7047 DoJob(jFort) 7048 else if Sender = mAirBase then 7049 DoJob(jBase) 7050 else if Sender = mPollution then 7051 DoJob(jPoll) 7052 else if Sender = mPillage then 7053 DoJob(jPillage) 7054 else if Sender = mEnhance then 7055 DoJob(-1) 7056 else if Sender = mStay then 7057 begin 7058 DestinationMarkON := false; 7059 PaintDestination; 7060 Status := Status and ($FFFF - usRecover - usGoto - usEnhance) 7061 or usStay; 7062 if Job > jNone then 7063 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 7064 NextUnit(UnStartLoc, true) 7065 end 7066 else if Sender = mRecover then 7067 begin 7068 DestinationMarkON := false; 7069 PaintDestination; 7070 Status := Status and ($FFFF - usStay - usGoto - usEnhance) or 7071 usRecover; 7072 if Job > jNone then 7073 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 7074 NextUnit(UnStartLoc, true) 7075 end 7076 else if Sender = mNoOrders then 7077 begin 7078 Status := Status and not usWaiting; 7079 NextUnit(UnStartLoc, true) 7080 end 7081 else if Sender = mCancel then 7082 begin 7083 DestinationMarkON := false; 7084 PaintDestination; 7085 Status := Status and ($FFFF - usRecover - usGoto - usEnhance); 7086 if Job > jNone then 7087 Server(sStartJob + jNone shl 4, me, UnFocus, nil^); 7088 end 7089 else if (Sender = mDisband) or (Sender = mUtilize) then 7090 begin 7091 if (Sender = mUtilize) and 7092 not(Server(sRemoveUnit - sExecute, me, UnFocus, nil^) = eUtilized) 7093 then 7094 begin 7095 SimpleMessage(Phrases2.Lookup('SHIP_UTILIZE')); 7096 // freight for colony ship is the only case in which the command is 7097 // available to player though not valid 7098 exit 7099 end; 7100 if (Sender = mUtilize) and (Health < 100) then 7101 if SimpleQuery(mkYesNo, Phrases.Lookup('DAMAGED_UTILIZE'), '') <> mrOK 7102 then 7103 exit; 7104 Loc0 := Loc; 7105 CityOptimizer_BeforeRemoveUnit(UnFocus); 7106 if Server(sRemoveUnit, me, UnFocus, nil^) = eUtilized then 7107 Play('CITY_UTILIZE') 7108 else 7109 Play('DISBAND'); 7110 CityOptimizer_AfterRemoveUnit; 7111 SetTroopLoc(Loc0); 7112 UpdateViews(true); 7113 DestinationMarkON := false; 7114 PaintDestination; 7115 UnFocus := -1; 7116 PaintLoc(Loc0); 7117 NextUnit(UnStartLoc, true); 7118 end 7119 else if Sender = mLoad then 7120 begin 7121 i := Server(sLoadUnit, me, UnFocus, nil^); 7122 if i >= rExecuted then 7123 begin 7124 if MyModel[mix].Domain = dAir then 7125 Play('MOVE_PLANELANDING') 7126 else 7127 Play('MOVE_LOAD'); 7128 DestinationMarkON := false; 7129 PaintDestination; 7130 Status := Status and 7131 ($FFFF - usWaiting - usStay - usRecover - usGoto - usEnhance); 7132 NextUnit(UnStartLoc, true); 7133 end 7134 else if i = eNoTime_Load then 7135 if MyModel[mix].Domain = dAir then 7136 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'), 'NOMOVE_TIME') 7137 else 7138 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 7139 [MovementToString(MyModel[mix].speed)]), 'NOMOVE_TIME'); 7140 end 7141 else if Sender = mUnload then 7142 if Master >= 0 then 7143 begin 7144 OldMaster := Master; 7145 i := Server(sUnloadUnit, me, UnFocus, nil^); 7146 if i >= rExecuted then 7147 begin 7148 if MyModel[mix].Domain = dAir then 7149 Play('MOVE_PLANESTART') 7150 else if (MyModel[MyUn[OldMaster].mix].Domain = dAir) and 7151 (MyMap[Loc] and fCity = 0) and 7152 (MyMap[Loc] and fTerImp <> tiBase) then 7153 Play('MOVE_PARACHUTE') 7154 else 7155 Play('MOVE_UNLOAD'); 7156 Status := Status and not usWaiting; 7157 if MyModel[mix].Domain <> dAir then 7158 NextUnit(Loc, true) 7159 else 7160 PanelPaint 7161 end 7162 else if i = eNoTime_Load then 7163 if MyModel[mix].Domain = dAir then 7164 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'), 'NOMOVE_TIME') 7165 else 7166 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 7167 [MovementToString(MyModel[mix].speed)]), 'NOMOVE_TIME'); 7168 end 7169 else 7170 begin 7171 NewFocus := -1; 7172 uix := UnFocus; 7173 for i := 1 to MyRO.nUn - 1 do 7174 begin 7175 uix := (uix + MyRO.nUn - 1) mod MyRO.nUn; 7176 if (MyUn[uix].Master = UnFocus) and 7177 (MyUn[uix].Movement = integer(MyModel[MyUn[uix].mix].speed)) 7178 then 7179 begin 7180 MyUn[uix].Status := MyUn[uix].Status or usWaiting; 7181 NewFocus := uix 7182 end; 7183 end; 7184 if NewFocus >= 0 then 7185 begin 7186 SetUnFocus(NewFocus); 7187 SetTroopLoc(Loc); 7188 PanelPaint 7189 end 7190 end 7191 else if Sender = mSelectTransport then 7192 Server(sSelectTransport, me, UnFocus, nil^) 7193 end; 7194 7195 procedure TMainScreen.InitPopup(Popup: TPopupMenu); 7196 var 7197 i, p1, Tile, Test: integer; 7198 NoSuper, extended, Multi, NeedSep, HaveCities: boolean; 7199 LastSep, m: TMenuItem; 7200 mox: ^TModel; 7201 begin 7202 NoSuper := not supervising and (1 shl me and MyRO.Alive <> 0); 7203 HaveCities := false; 7204 for i := 0 to MyRO.nCity - 1 do 7205 if MyCity[i].Loc >= 0 then 7206 begin 7207 HaveCities := true; 7208 Break 7209 end; 7210 if Popup = GamePopup then 7211 begin 7212 mTechTree.Visible := ClientMode <> cEditMap; 7213 mResign.Enabled := supervising or (me = 0) and (ClientMode < scContact); 7214 mRandomMap.Visible := (ClientMode = cEditMap) and 7215 (Server(sMapGeneratorRequest, me, 0, nil^) = eOK); 7216 mOptions.Visible := ClientMode <> cEditMap; 7217 mManip.Visible := ClientMode <> cEditMap; 7218 if ClientMode <> cEditMap then 7219 begin 7220 mWaitTurn.Visible := NoSuper; 7221 mRep.Visible := NoSuper; 7222 mRepList.Visible := NoSuper; 7223 mRepScreens.Visible := NoSuper; 7224 N10.Visible := NoSuper; 7225 mOwnMovement.Visible := NoSuper; 7226 mAllyMovement.Visible := NoSuper; 7227 case SoundMode of 7228 smOff: 7229 mSoundOff.Checked := true; 7230 smOn: 7231 mSoundOn.Checked := true; 7232 smOnAlt: 7233 mSoundOnAlt.Checked := true; 7234 end; 7235 7236 for i := 0 to nTestFlags - 1 do 7237 mManip[i].Checked := MyRO.TestFlags and (1 shl i) <> 0; 7238 mManip.Enabled := supervising or (me = 0); 7239 7240 Multi := false; 7241 for p1 := 1 to nPl - 1 do 7242 if G.RO[p1] <> nil then 7243 Multi := true; 7244 mEnemyMovement.Visible := not Multi; 7245 end; 7246 mMacro.Visible := NoSuper and (ClientMode < scContact); 7247 if NoSuper and (ClientMode < scContact) then 7248 begin 7249 mCityTypes.Enabled := false; 7250 // check if city types already usefull: 7251 if MyRO.nCity > 0 then 7252 for i := 28 to nImp - 1 do 7253 if (i <> imTrGoods) and (Imp[i].Kind = ikCommon) and 7254 (Imp[i].Preq <> preNA) and 7255 ((Imp[i].Preq = preNone) or 7256 (MyRO.Tech[Imp[i].Preq] >= tsApplicable)) then 7257 begin 7258 mCityTypes.Enabled := true; 7259 Break 7260 end; 7261 end; 7262 mViewpoint.Visible := (ClientMode <> cEditMap) and supervising; 7263 mViewpoint.Enabled := G.RO[0].Turn > 0; 7264 if supervising then 7265 begin 7266 EmptyMenu(mViewpoint); 7267 for p1 := 0 to nPl - 1 do 7268 if (p1 = 0) or (1 shl p1 and G.RO[0].Alive <> 0) then 7269 begin 7270 m := TMenuItem.Create(mViewpoint); 7271 if p1 = 0 then 7272 m.Caption := Phrases.Lookup('SUPER') 7273 else 7274 m.Caption := Tribe[p1].TString(Phrases2.Lookup('BELONG')); 7275 m.Tag := p1; 7276 m.OnClick := ViewpointClick; 7277 if p1 < 10 then 7278 m.ShortCut := ShortCut(48 + p1, [ssCtrl]); 7279 m.RadioItem := true; 7280 if p1 = me then 7281 m.Checked := true; 7282 mViewpoint.Add(m); 7283 end 7284 end; 7285 mDebugMap.Visible := (ClientMode <> cEditMap) and supervising; 7286 if supervising then 7287 begin 7288 EmptyMenu(mDebugMap); 7289 for p1 := 0 to nPl - 1 do 7290 if (p1 = 0) or (1 shl p1 and G.RO[0].Alive <> 0) then 7291 begin 7292 m := TMenuItem.Create(mDebugMap); 7293 if p1 = 0 then 7294 m.Caption := Phrases2.Lookup('MENU_DEBUGMAPOFF') 7295 else 7296 m.Caption := Tribe[p1].TString(Phrases2.Lookup('BELONG')); 7297 if p1 = 0 then 7298 m.Tag := -1 7299 else 7300 m.Tag := p1; 7301 m.OnClick := DebugMapClick; 7302 if p1 < 10 then 7303 m.ShortCut := ShortCut(48 + p1, [ssAlt]); 7304 m.RadioItem := true; 7305 if m.Tag = IsoEngine.pDebugMap then 7306 m.Checked := true; 7307 mDebugMap.Add(m); 7308 end 7309 end; 7310 mSmallTiles.Checked := xxt = 33; 7311 mNormalTiles.Checked := xxt = 48; 7312 end 7313 else if Popup = StatPopup then 7314 begin 7315 mEmpire.Visible := NoSuper; 7316 mEmpire.Enabled := MyRO.Government <> gAnarchy; 7317 mRevolution.Visible := NoSuper; 7318 mRevolution.Enabled := (MyRO.Government <> gAnarchy) and 7319 (ClientMode < scContact); 7320 mUnitStat.Enabled := NoSuper or (MyRO.Turn > 0); 7321 mCityStat.Visible := 1 shl me and MyRO.Alive <> 0; 7322 mCityStat.Enabled := HaveCities; 7323 mScienceStat.Visible := true; 7324 mScienceStat.Enabled := not NoSuper or (MyRO.ResearchTech >= 0) or 7325 (MyRO.Happened and phTech <> 0) or (MyRO.Happened and phGameEnd <> 0) 7326 // no researchtech in case just completed 7327 or (MyRO.TestFlags and (tfAllTechs or tfUncover or 7328 tfAllContact) <> 0); 7329 mEUnitStat.Enabled := MyRO.nEnemyModel > 0; 7330 { mWonders.Enabled:= false; 7331 for i:=0 to 27 do if MyRO.Wonder[i].CityID<>-1 then 7332 mWonders.Enabled:=true; } 7333 mDiagram.Enabled := MyRO.Turn >= 2; 7334 mShips.Enabled := false; 7335 for p1 := 0 to nPl - 1 do 7336 if MyRO.Ship[p1].Parts[spComp] + MyRO.Ship[p1].Parts[spPow] + 7337 MyRO.Ship[p1].Parts[spHab] > 0 then 7338 mShips.Enabled := true; 7339 end 7340 else if Popup = UnitPopup then 7341 begin 7342 mox := @MyModel[MyUn[UnFocus].mix]; 7343 Tile := MyMap[MyUn[UnFocus].Loc]; 7344 extended := Tile and fCity = 0; 7345 if extended then 7346 begin 7347 mCity.Caption := Phrases.Lookup('BTN_FOUND'); 7348 mHome.Caption := Phrases.Lookup('BTN_MOVEHOME') 7349 end 2729 7350 else 7351 begin 7352 mCity.Caption := Phrases.Lookup('BTN_ADD'); 7353 mHome.Caption := Phrases.Lookup('BTN_SETHOME') 7354 end; 7355 7356 extended := extended and 7357 ((mox.Kind = mkSettler) or (mox.Kind = mkSlaves) and 7358 (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) and 7359 (MyUn[UnFocus].Master < 0) and (Tile and fDeadLands = 0); 7360 if (mox.Kind = mkFreight) and (Tile and fCity <> 0) and 7361 not Phrases2FallenBackToEnglish or 7362 (Server(sRemoveUnit - sExecute, me, UnFocus, nil^) = eUtilized) then 7363 begin 7364 mDisband.Visible := false; 7365 mUtilize.Visible := true; 7366 if mox.Kind = mkFreight then 7367 mUtilize.Caption := Phrases.Lookup('UTILIZE') 7368 else 7369 mUtilize.Caption := Phrases.Lookup('INTEGRATE') 7370 end 7371 else 7372 begin 7373 mDisband.Visible := true; 7374 mUtilize.Visible := false 7375 end; 7376 mGoOn.Visible := MyUn[UnFocus].Status and (usGoto or usWaiting) 7377 = usGoto or usWaiting; 7378 mHome.Visible := HaveCities; 7379 mRecover.Visible := (MyUn[UnFocus].Health < 100) and 7380 (Tile and fTerrain >= fGrass) and 7381 ((MyRO.Wonder[woGardens].EffectiveOwner = me) or 7382 (Tile and fTerrain <> fArctic) and (Tile and fTerrain <> fDesert)) and 7383 not((mox.Domain = dAir) and (Tile and fCity = 0) and 7384 (Tile and fTerImp <> tiBase)); 7385 mStay.Visible := not((mox.Domain = dAir) and (Tile and fCity = 0) and 7386 (Tile and fTerImp <> tiBase)); 7387 mCity.Visible := extended and (mox.Kind = mkSettler) or 7388 (Tile and fCity <> 0) and ((mox.Kind in [mkSettler, mkSlaves]) or 7389 (MyUn[UnFocus].Flags and unConscripts <> 0)); 7390 mPillage.Visible := (Tile and (fRoad or fRR or fCanal or fTerImp) <> 0) 7391 and (MyUn[UnFocus].Master < 0) and (mox.Domain = dGround); 7392 mCancel.Visible := (MyUn[UnFocus].Job > jNone) or 7393 (MyUn[UnFocus].Status and (usRecover or usGoto) <> 0); 7394 7395 Test := Server(sLoadUnit - sExecute, me, UnFocus, nil^); 7396 mLoad.Visible := (Test >= rExecuted) or (Test = eNoTime_Load); 7397 mUnload.Visible := (MyUn[UnFocus].Master >= 0) or 7398 (MyUn[UnFocus].TroopLoad + MyUn[UnFocus].AirLoad > 0); 7399 mSelectTransport.Visible := Server(sSelectTransport - sExecute, me, 7400 UnFocus, nil^) >= rExecuted; 7401 end 7402 else { if Popup=TerrainPopup then } 7403 begin 7404 mox := @MyModel[MyUn[UnFocus].mix]; 7405 Tile := MyMap[MyUn[UnFocus].Loc]; 7406 extended := Tile and fCity = 0; 7407 7408 if (Tile and fRiver <> 0) and 7409 (MyRO.Tech[adBridgeBuilding] >= tsApplicable) then 7410 begin 7411 mRoad.Caption := Phrases.Lookup('BTN_BUILDBRIDGE'); 7412 mRR.Caption := Phrases.Lookup('BTN_BUILDRRBRIDGE'); 7413 end 7414 else 7415 begin 7416 mRoad.Caption := Phrases.Lookup('BTN_BUILDROAD'); 7417 mRR.Caption := Phrases.Lookup('BTN_BUILDRR'); 7418 end; 7419 if Tile and fTerrain = fForest then 7420 mClear.Caption := Phrases.Lookup('BTN_CLEAR') 7421 else if Tile and fTerrain = fDesert then 7422 mClear.Caption := Phrases.Lookup('BTN_UNDESERT') 7423 else 7424 mClear.Caption := Phrases.Lookup('BTN_DRAIN'); 7425 7426 extended := extended and 7427 ((mox.Kind = mkSettler) or (mox.Kind = mkSlaves) and 7428 (MyRO.Wonder[woPyramids].EffectiveOwner >= 0)) and 7429 (MyUn[UnFocus].Master < 0); 7430 if extended then 7431 begin 7432 mRoad.Visible := JobTest(UnFocus, jRoad, 7433 [eNoBridgeBuilding, eTreaty]); 7434 mRR.Visible := JobTest(UnFocus, jRR, [eNoBridgeBuilding, eTreaty]); 7435 mClear.Visible := JobTest(UnFocus, jClear, [eTreaty]); 7436 mIrrigation.Visible := JobTest(UnFocus, jIrr, [eTreaty]); 7437 mFarm.Visible := JobTest(UnFocus, jFarm, [eTreaty]); 7438 mAfforest.Visible := JobTest(UnFocus, jAfforest, [eTreaty]); 7439 mMine.Visible := JobTest(UnFocus, jMine, [eTreaty]); 7440 MTrans.Visible := JobTest(UnFocus, jTrans, [eTreaty]); 7441 mCanal.Visible := JobTest(UnFocus, jCanal, [eTreaty]); 7442 mFort.Visible := JobTest(UnFocus, jFort, [eTreaty]); 7443 mAirBase.Visible := JobTest(UnFocus, jBase, [eTreaty]); 7444 mPollution.Visible := JobTest(UnFocus, jPoll, [eTreaty]); 7445 mEnhance.Visible := (Tile and fDeadLands = 0) and 7446 (MyData.EnhancementJobs[MyMap[MyUn[UnFocus].Loc] and fTerrain, 0] 7447 <> jNone); 7448 end 7449 else 7450 begin 7451 for i := 0 to Popup.Items.Count - 1 do 7452 Popup.Items[i].Visible := false; 7453 end; 7454 end; 7455 7456 // set menu seperators 7457 LastSep := nil; 7458 NeedSep := false; 7459 for i := 0 to Popup.Items.Count - 1 do 7460 if Popup.Items[i].Caption = '-' then 7461 begin 7462 Popup.Items[i].Visible := NeedSep; 7463 if NeedSep then 7464 LastSep := Popup.Items[i]; 7465 NeedSep := false 7466 end 7467 else if Popup.Items[i].Visible then 7468 NeedSep := true; 7469 if (LastSep <> nil) and not NeedSep then 7470 LastSep.Visible := false 7471 end; 7472 7473 procedure TMainScreen.PanelBtnClick(Sender: TObject); 7474 var 7475 Popup: TPopupMenu; 7476 begin 7477 if Sender = UnitBtn then 7478 Popup := UnitPopup 7479 else { if Sender=TerrainBtn then } 7480 Popup := TerrainPopup; 7481 InitPopup(Popup); 7482 if FullScreen then 7483 Popup.Popup(Left + TControl(Sender).Left, Top + TControl(Sender).Top) 7484 else 7485 Popup.Popup(Left + TControl(Sender).Left + 4, Top + TControl(Sender).Top 7486 + GetSystemMetrics(SM_CYCAPTION) + 4); 7487 end; 7488 7489 procedure TMainScreen.CityClosed(Activateuix: integer; StepFocus: boolean; 7490 SelectFocus: boolean); 7491 begin 7492 if supervising then 7493 begin 7494 SetTroopLoc(-1); 7495 PanelPaint 7496 end 7497 else 7498 begin 7499 if Activateuix >= 0 then 7500 begin 7501 SetUnFocus(Activateuix); 7502 SetTroopLoc(MyUn[Activateuix].Loc); 7503 if SelectFocus then 7504 FocusOnLoc(TroopLoc, flRepaintPanel) 7505 else 7506 PanelPaint 7507 end 7508 else if StepFocus then 7509 NextUnit(TroopLoc, true) 7510 else 7511 begin 7512 SetTroopLoc(-1); 7513 PanelPaint 7514 end 7515 end 7516 end; 7517 7518 procedure TMainScreen.Toggle(Sender: TObject); 7519 begin 7520 TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked 7521 end; 7522 7523 procedure TMainScreen.PanelBoxMouseMove(Sender: TObject; Shift: TShiftState; 7524 x, y: integer); 7525 var 7526 xCentre, yCentre: integer; 7527 begin 7528 if Tracking and (ssLeft in Shift) then 7529 begin 7530 if (x >= xMini + 2) and (y >= yMini + 2) and (x < xMini + 2 + 2 * G.lx) 7531 and (y < yMini + 2 + G.ly) then 7532 begin 7533 xCentre := (xwMini + (x - xMini - 2) div 2 + G.lx div 2 + 7534 MapWidth div (xxt * 4)) mod G.lx; 7535 yCentre := (y - yMini - 2); 7536 xw := (xCentre - MapWidth div (xxt * 4) + G.lx) mod G.lx; 7537 if ywmax <= 0 then 7538 yw := ywcenter 7539 else 2730 7540 begin 2731 CurrentMoveInfo.IsAlly:= MyRO.Treaty[Owner]=trAlliance; 2732 if GameMode=cMovie then 2733 CurrentMoveInfo.DoShow:=true 2734 else if CurrentMoveInfo.IsAlly then 2735 CurrentMoveInfo.DoShow:=not mAlNoMoves.Checked 2736 and not(mAlEffectiveMovesOnly.Checked and (Command<>cShowCapturing)) 2737 else CurrentMoveInfo.DoShow:=not mEnNoMoves.Checked 2738 and not(mEnAttacks.Checked and (Command<>cShowCapturing)); 2739 if CurrentMoveInfo.DoShow then 2740 begin 2741 if Command=cShowCapturing then 2742 begin // show capture message 2743 if MyMap[ToLoc] and fOwned<>0 then 2744 begin // own city, search 2745 cix:=MyRO.nCity-1; 2746 while (cix>=0) and (MyCity[cix].Loc<>ToLoc) do 2747 dec(cix); 2748 s:=CityName(MyCity[cix].ID); 2749 end 2750 else 2751 begin // foreign city, search 2752 ecix:=MyRO.nEnemyCity-1; 2753 while (ecix>=0) and (MyRO.EnemyCity[ecix].Loc<>ToLoc) do 2754 dec(ecix); 2755 s:=CityName(MyRO.EnemyCity[ecix].ID); 2756 end; 2757 TribeMessage(Owner, Format(Tribe[Owner].TPhrase('CAPTURE'),[s]), ''); 2758 Update; // remove message box from screen 2759 end; 2760 2761 if CurrentMoveInfo.IsAlly then 2762 begin // allied unit -- make discovered land visible 2763 if mAlFastMoves.Checked then AnimationSpeed:=8 2764 else AnimationSpeed:=16; 2765 with MyRO.EnemyModel[emix] do 2766 if (Kind=mkDiplomat) or (Domain=dAir) or (ATrans_Fuel>0) 2767 or (Cap and (1 shl (mcRadar-mcFirstNonCap) or 1 shl (mcAcademy-mcFirstNonCap))<>0) 2768 or (MyMap[ToLoc] and fTerrain=fMountains) 2769 or (MyMap[ToLoc] and fTerImp=tiFort) 2770 or (MyMap[ToLoc] and fTerImp=tiBase) then 2771 CurrentMoveInfo.AfterMovePaintRadius:=2 2772 else CurrentMoveInfo.AfterMovePaintRadius:=1 2773 end 7541 yw := (yCentre - MapHeight div (yyt * 2) + 1) and not 1; 7542 if yw < 0 then 7543 yw := 0 7544 else if yw > ywmax then 7545 yw := ywmax; 7546 end; 7547 BitBlt(Buffer.Canvas.Handle, 0, 0, G.lx * 2, G.ly, Mini.Canvas.Handle, 7548 0, 0, SRCCOPY); 7549 if ywmax <= 0 then 7550 Frame(Buffer.Canvas, x - xMini - 2 - MapWidth div (xxt * 2), 0, 7551 x - xMini - 2 + MapWidth div (xxt * 2) - 1, G.ly - 1, 7552 MainTexture.clMark, MainTexture.clMark) 7553 else 7554 Frame(Buffer.Canvas, x - xMini - 2 - MapWidth div (xxt * 2), yw, 7555 x - xMini - 2 + MapWidth div (xxt * 2) - 1, 7556 yw + MapHeight div yyt - 2, MainTexture.clMark, 7557 MainTexture.clMark); 7558 BitBlt(Panel.Canvas.Handle, xMini + 2, yMini + 2, G.lx * 2, G.ly, 7559 Buffer.Canvas.Handle, 0, 0, SRCCOPY); 7560 MainOffscreenPaint; 7561 RectInvalidate(xMini + 2, TopBarHeight + MapHeight - overlap + yMini + 7562 2, xMini + 2 + G.lx * 2, TopBarHeight + MapHeight - overlap + yMini 7563 + 2 + G.ly); 7564 Update; 7565 end 7566 end 7567 else 7568 Tracking := false 7569 end; 7570 7571 procedure TMainScreen.PanelBoxMouseUp(Sender: TObject; Button: TMouseButton; 7572 Shift: TShiftState; x, y: integer); 7573 begin 7574 if Tracking then 7575 begin 7576 Tracking := false; 7577 xwMini := xw; 7578 ywMini := yw; 7579 MiniPaint; 7580 PanelPaint; 7581 end 7582 end; 7583 7584 procedure TMainScreen.MapBoxMouseMove(Sender: TObject; Shift: TShiftState; 7585 x, y: integer); 7586 var 7587 MouseLoc: integer; 7588 begin 7589 xMouse := x; 7590 yMouse := y; 7591 if (ClientMode = cEditMap) and (ssLeft in Shift) and not Tracking then 7592 begin 7593 MouseLoc := LocationOfScreenPixel(x, y); 7594 if MouseLoc <> BrushLoc then 7595 MapBoxMouseDown(nil, mbLeft, Shift, x, y); 7596 end 7597 (* else if idle and (UnFocus>=0) then 7598 begin 7599 qx:=(xMouse*32+yMouse*66+16*66) div(32*66)-1; 7600 qy:=(yMouse*66-xMouse*32-16*66+2000*33*32) div(32*66)-999; 7601 MouseLoc:=(xw+(qx-qy+2048) div 2-1024+G.lx) mod G.lx+G.lx*(yw+qx+qy); 7602 ShowMoveHint(MouseLoc); 7603 end *) 7604 end; 7605 7606 procedure TMainScreen.mShowClick(Sender: TObject); 7607 begin 7608 TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked; 7609 SetMapOptions; 7610 MapValid := false; 7611 PaintAllMaps; 7612 end; 7613 7614 procedure TMainScreen.mNamesClick(Sender: TObject); 7615 var 7616 p1: integer; 7617 begin 7618 mNames.Checked := not mNames.Checked; 7619 GenerateNames := mNames.Checked; 7620 for p1 := 0 to nPl - 1 do 7621 if Tribe[p1] <> nil then 7622 if GenerateNames then 7623 Tribe[p1].NumberName := -1 7624 else 7625 Tribe[p1].NumberName := p1; 7626 MapValid := false; 7627 PaintAll; 7628 end; 7629 7630 function TMainScreen.IsPanelPixel(x, y: integer): boolean; 7631 begin 7632 result := (y >= TopBarHeight + MapHeight) or 7633 (y >= ClientHeight - PanelHeight) and 7634 ((x < xMidPanel) or (x >= xRightPanel)) 7635 end; 7636 7637 procedure TMainScreen.FormMouseDown(Sender: TObject; Button: TMouseButton; 7638 Shift: TShiftState; x, y: integer); 7639 begin 7640 if idle then 7641 if (x < 40) and (y < 40) then 7642 begin 7643 if GameMode <> cMovie then 7644 begin 7645 InitPopup(GamePopup); 7646 if FullScreen then 7647 GamePopup.Popup(Left, Top + TopBarHeight - 1) 2774 7648 else 2775 begin 2776 if mEnFastMoves.Checked then AnimationSpeed:=8 2777 else AnimationSpeed:=16; 2778 CurrentMoveInfo.AfterMovePaintRadius:=0; // enemy unit, nothing discovered 2779 end; 2780 if GameMode=cMovie then 2781 begin 2782 if MovieSpeed=3 then AnimationSpeed:=4 2783 else if MovieSpeed=2 then AnimationSpeed:=8 2784 else AnimationSpeed:=16; 2785 end; 2786 ShowMoveDomain:=MyRO.EnemyModel[emix].Domain; 2787 IsAlpine:= MyRO.EnemyModel[emix].Cap and (1 shl (mcAlpine-mcFirstNonCap))<>0; 2788 end 2789 end; 2790 2791 if CurrentMoveInfo.DoShow then 2792 begin 2793 if Command=cShowCapturing then Play('MOVE_CAPTURE') 2794 else if EndHealth<=0 then Play('MOVE_DIE') 2795 else if Flags and umSpyMission<>0 then Play('MOVE_COVERT') 2796 else if Flags and umShipLoading<>0 then 2797 if ShowMoveDomain=dAir then Play('MOVE_PLANELANDING') 2798 else Play('MOVE_LOAD') 2799 else if Flags and umPlaneLoading<>0 then Play('MOVE_LOAD') 2800 else if Flags and umShipUnloading<>0 then 2801 if ShowMoveDomain=dAir then Play('MOVE_PLANESTART') 2802 else Play('MOVE_UNLOAD') 2803 else if Flags and umPlaneUnloading<>0 then 2804 if (MyMap[FromLoc] and fCity=0) 2805 and (MyMap[FromLoc] and fTerImp<>tiBase) then 2806 Play('MOVE_PARACHUTE') 2807 else Play('MOVE_UNLOAD') 2808 else if (ShowMoveDomain=dGround) and not IsAlpine 2809 and (MyMap[ToLoc] and fTerrain=fMountains) 2810 and ((MyMap[FromLoc] and (fRoad or fRR or fCity)=0) 2811 or (MyMap[ToLoc] and (fRoad or fRR or fCity)=0)) then 2812 Play('MOVE_MOUNTAIN'); 2813 2814 FocusOnLoc(FromLoc,flImmUpdate); 2815 PaintLoc_BeforeMove(FromLoc); 2816 if Command=cShowCapturing then 2817 MoveOnScreen(TShowMove(Data),1,32,32) 2818 else MoveOnScreen(TShowMove(Data),1,AnimationSpeed,AnimationSpeed) 2819 end // if CurrentMoveInfo.DoShow 2820 else MapValid:=false; 2821 end 2822 end; 2823 2824 cShowAttacking: 2825 if (idle and (NewPlayer=me) 2826 or not idle and not skipped and (TShowMove(Data).emix<>$FFFF)) 2827 and not ((GameMode=cMovie) and (MovieSpeed=4)) then 2828 begin 2829 assert(NewPlayer=me); 2830 if not idle or (GameMode=cMovie) then 2831 Application.ProcessMessages; 2832 with TShowMove(Data) do 2833 begin 2834 CurrentMoveInfo.AfterAttackExpeller:=-1; 2835 CurrentMoveInfo.DoShow:=false; 2836 if idle then 2837 CurrentMoveInfo.DoShow:=true // own unit -- always show attacks 2838 else 2839 begin 2840 CurrentMoveInfo.IsAlly:= MyRO.Treaty[Owner]=trAlliance; 2841 if CurrentMoveInfo.IsAlly then 2842 CurrentMoveInfo.DoShow:=not mAlNoMoves.Checked 2843 else CurrentMoveInfo.DoShow:=not mEnNoMoves.Checked; 2844 end; 2845 if CurrentMoveInfo.DoShow then 2846 begin 2847 ToLoc:=dLoc(FromLoc,dx,dy); 2848 if Tribe[Owner].ModelPicture[mix].HGr=0 then 2849 InitEnemyModel(emix); 2850 2851 if (MyMap[ToLoc] and (fCity or fUnit or fOwned) = fCity or fOwned) then 2852 begin // tell about bombardment 2853 cix:=MyRO.nCity-1; 2854 while (cix>=0) and (MyCity[cix].Loc<>ToLoc) do 2855 dec(cix); 2856 if MyCity[cix].Status and csToldBombard=0 then 2857 begin 2858 if not supervising then 2859 MyCity[cix].Status:=MyCity[cix].Status or csToldBombard; 2860 s:=CityName(MyCity[cix].ID); 2861 SoundMessageEx(Format(Tribe[Owner].TPhrase('BOMBARD'),[s]),''); 2862 Update; // remove message box from screen 2863 end; 2864 end 2865 else if Flags and umExpelling<>0 then 2866 CurrentMoveInfo.AfterAttackExpeller:=Owner; 2867 2868 if Flags and umExpelling<>0 then Play('MOVE_EXPEL') 2869 else if Owner=me then 2870 begin 2871 MakeModelInfo(me,mix,MyModel[mix],mi); 2872 Play(AttackSound(ModelCode(mi))); 2873 end 2874 else Play(AttackSound(ModelCode(MyRO.EnemyModel[emix]))); 2875 2876 FocusOnLoc(FromLoc,flImmUpdate); 2877 2878 // before combat 2879 MainMap.AttackBegin(TShowMove(Data)); 2880 if MyMap[ToLoc] and fCity<>0 then PaintLoc(ToLoc); 2881 PaintLoc(FromLoc); 2882 MoveOnScreen(TShowMove(Data),1,9,16); 2883 MoveOnScreen(TShowMove(Data),17,12,32); 2884 MoveOnScreen(TShowMove(Data),7,11,16); 2885 2886 // after combat 2887 MainMap.AttackEffect(TShowMove(Data)); 2888 PaintLoc(ToLoc); 2889 if EndHealth>0 then 2890 begin 2891 Health:=EndHealth; 2892 MoveOnScreen(TShowMove(Data),10,0,16); 2893 end 2894 else if not idle then 2895 Sleep(MoveTime div 2); 2896 MainMap.AttackEnd; 2897 end // if CurrentMoveInfo.DoShow 2898 else MapValid:=false; 2899 end 2900 end; 2901 2902 cShowMissionResult: 2903 if Cardinal(Data)=0 then 2904 SoundMessageEx(Phrases.Lookup('NOFOREIGNINFO'),'') 2905 else 2906 begin 2907 s:=Phrases.Lookup('FOREIGNINFO'); 2908 for p1:=0 to nPl-1 do if 3 shl (p1*2) and Cardinal(Data)<>0 then 2909 s:=s+'\'+Tribe[p1].TPhrase('SHORTNAME'); 2910 SoundMessageEx(s,'') 2911 end; 2912 2913 cShowShipChange: 2914 if not IsMultiPlayerGame and (Jump[0]=0) then 2915 ShowEnemyShipChange(TShowShipChange(Data)); 2916 2917 cShowGreatLibTech: 2918 if not IsMultiPlayerGame and (Jump[0]=0) then with MessgExDlg do 2919 begin 2920 MessgText:=Format(Phrases.Lookup('GRLIB_GENERAL'), 2921 [Phrases.Lookup('ADVANCES',integer(Data))]); 2922 OpenSound:='NEWADVANCE_GRLIB'; 2923 Kind:=mkOK; 2924 IconKind:=mikImp; 2925 IconIndex:=woGrLibrary; 2926 ShowModal; 2927 end; 2928 2929 cRefreshDebugMap: 2930 begin 2931 if integer(data)=IsoEngine.pDebugMap then 2932 begin 2933 MapValid:=false; 2934 MainOffscreenPaint; 2935 Update; 2936 end 2937 end; 2938 2939 else if Command>=cClientEx then case Command and $FFF0 of 2940 2941 cSetTribe: with TTribeInfo(Data) do 2942 begin 2943 i:=UnusedTribeFiles.Count-1; 2944 while (i>=0) and (AnsiCompareFileName(UnusedTribeFiles[i],FileName)<>0) do 2945 dec(i); 2946 if i>=0 then UnusedTribeFiles.Delete(i); 2947 CreateTribe(trix,FileName,true); 2948 end; 2949 2950 cSetNewModelPicture, cSetModelPicture: 2951 if TribeOriginal[TModelPictureInfo(Data).trix] then 2952 Tribe[TModelPictureInfo(Data).trix].SetModelPicture( 2953 TModelPictureInfo(Data),Command and $FFF0=cSetNewModelPicture); 2954 2955 cSetSlaveIndex and $FFF0: 2956 Tribe[integer(data) shr 16].mixSlaves:=integer(data) and $FFFF; 2957 2958 cSetCityName: with TCityNameInfo(Data) do 2959 if TribeOriginal[ID shr 12] then 2960 Tribe[ID shr 12].SetCityName(ID and $FFF,NewName); 2961 2962 cSetModelName: with TModelNameInfo(Data) do 2963 if TribeOriginal[NewPlayer] then 2964 Tribe[NewPlayer].ModelName[mix]:=NewName; 2965 end 2966 end 2967 end;{<<<client} 2968 2969 {*** main part ***} 2970 2971 procedure TMainScreen.CreateParams (var p: TCreateParams); 2972 var 2973 DefaultOptionChecked: integer; 2974 Reg: TRegistry; 2975 doinit: boolean; 2976 begin 2977 inherited; 2978 2979 // define which menu settings to save 2980 SaveOption[0]:=mAlEffectiveMovesOnly.Tag; 2981 SaveOption[1]:=mEnMoves.Tag; 2982 SaveOption[2]:=mEnAttacks.Tag; 2983 SaveOption[3]:=mEnNoMoves.Tag; 2984 SaveOption[4]:=mWaitTurn.Tag; 2985 SaveOption[5]:=mEffectiveMovesOnly.Tag; 2986 SaveOption[6]:=mEnFastMoves.Tag; 2987 SaveOption[7]:=mSlowMoves.Tag; 2988 SaveOption[8]:=mFastMoves.Tag; 2989 SaveOption[9]:=mVeryFastMoves.Tag; 2990 SaveOption[10]:=mNames.Tag; 2991 SaveOption[11]:=mRepList.Tag; 2992 SaveOption[12]:=mRepScreens.Tag; 2993 SaveOption[13]:=mSoundOff.Tag; 2994 SaveOption[14]:=mSoundOn.Tag; 2995 SaveOption[15]:=mSoundOnAlt.Tag; 2996 SaveOption[16]:=mScrollSlow.Tag; 2997 SaveOption[17]:=mScrollFast.Tag; 2998 SaveOption[18]:=mScrollOff.Tag; 2999 SaveOption[19]:=mAlSlowMoves.Tag; 3000 SaveOption[20]:=mAlFastMoves.Tag; 3001 SaveOption[21]:=mAlNoMoves.Tag; 3002 DefaultOptionChecked:= 1 shl 1 + 1 shl 7 + 1 shl 10 + 1 shl 12 + 1 shl 14 + 1 shl 18 + 1 shl 19; 3003 3004 Reg:=TRegistry.Create; 3005 doinit:=true; 3006 if Reg.KeyExists('SOFTWARE\cevo\RegVer9') then 3007 begin 3008 doinit:=false; 3009 Reg.OpenKey('SOFTWARE\cevo\RegVer9',false); 3010 try 3011 xxt:=Reg.ReadInteger('TileWidth') div 2; 3012 yyt:=Reg.ReadInteger('TileHeight') div 2; 3013 OptionChecked:=Reg.ReadInteger('OptionChecked'); 3014 MapOptionChecked:=Reg.ReadInteger('MapOptionChecked'); 3015 CityRepMask:=cardinal(Reg.ReadInteger('CityReport')); 3016 except 3017 doinit:=true; 3018 end; 3019 Reg.closekey; 3020 if OptionChecked and (7 shl 16)=0 then 3021 OptionChecked:=OptionChecked or (1 shl 16); // old regver with no scrolling 3022 end; 3023 Reg.Free; 3024 if doinit then 3025 begin 3026 xxt:=48; 3027 yyt:=24; 3028 OptionChecked:=DefaultOptionChecked; 3029 MapOptionChecked:=1 shl moCityNames; 3030 CityRepMask:=cardinal(not chPopIncrease and not chNoGrowthWarning and not chCaptured); 3031 end; 3032 3033 if FullScreen then 3034 begin 3035 p.Style:=$87000000; 3036 BorderStyle:=bsNone; 3037 BorderIcons:=[]; 3038 end; 3039 3040 if 1 shl 13 and OptionChecked<>0 then SoundMode:=smOff 3041 else if 1 shl 15 and OptionChecked<>0 then SoundMode:=smOnAlt 3042 else SoundMode:=smOn 3043 end; 3044 3045 procedure TMainScreen.FormCreate(Sender:TObject); 3046 var 3047 i,j: integer; 3048 begin 3049 Screen.Cursors[crImpDrag]:=LoadCursor(HInstance,'DRAG'); 3050 Screen.Cursors[crFlatHand]:=LoadCursor(HInstance,'FLATHAND'); 3051 3052 // tag-controlled language 3053 for i:=0 to ComponentCount-1 do 3054 if Components[i].Tag and $FF<>0 then 3055 if Components[i] is TMenuItem then 3056 begin 3057 TMenuItem(Components[i]).Caption:= 3058 Phrases.Lookup('CONTROLS',-1+Components[i].Tag and $FF); 3059 for j:=0 to nSaveOption-1 do 3060 if Components[i].Tag and $FF=SaveOption[j] then 3061 TMenuItem(Components[i]).Checked:= 1 shl j and OptionChecked<>0; 3062 end 3063 else if Components[i] is TButtonBase then 3064 begin 3065 TButtonBase(Components[i]).Hint:= 3066 Phrases.Lookup('CONTROLS',-1+Components[i].Tag and $FF); 3067 if (Components[i] is TButtonC) and (TButtonC(Components[i]).ButtonIndex<>1) then 3068 TButtonC(Components[i]).ButtonIndex:= 3069 MapOptionChecked shr (Components[i].Tag shr 8) and 1 +2 3070 end; 3071 3072 // non-tag-controlled language 3073 mTechTree.Caption:=Phrases2.Lookup('MENU_ADVTREE'); 3074 mViewpoint.Caption:=Phrases2.Lookup('MENU_VIEWPOINT'); 3075 if not Phrases2FallenBackToEnglish then 3076 begin 3077 MenuArea.Hint:=Phrases2.Lookup('BTN_MENU'); 3078 TreasuryArea.Hint:=Phrases2.Lookup('TIP_TREASURY'); 3079 ResearchArea.Hint:=Phrases.Lookup('SCIENCE'); 3080 ManagementArea.Hint:=Phrases2.Lookup('BTN_MANAGE'); 3081 end; 3082 for i:=0 to mRep.Count-1 do 3083 begin 3084 j:=mRep[i].Tag shr 8; 3085 mRep[i].Caption:=CityEventName(j); 3086 mRep[i].Checked:= CityRepMask and (1 shl j)<>0; 3087 end; 3088 3089 Mini:=TBitmap.Create; 3090 Mini.PixelFormat:=pf24bit; 3091 Panel:=TBitmap.Create; 3092 Panel.PixelFormat:=pf24bit; 3093 Panel.Canvas.Font.Assign(UniFont[ftSmall]); 3094 Panel.Canvas.Brush.Style:=bsClear; 3095 TopBar:=TBitmap.Create; 3096 TopBar.PixelFormat:=pf24bit; 3097 TopBar.Canvas.Font.Assign(UniFont[ftNormal]); 3098 TopBar.Canvas.Brush.Style:=bsClear; 3099 Buffer:=TBitmap.Create; 3100 Buffer.PixelFormat:=pf24bit; 3101 if 2*lxmax>3*xSizeBig then 3102 Buffer.Width:=2*lxmax 3103 else Buffer.Width:=3*xSizeBig; 3104 if lymax>3*ySizeBig then 3105 Buffer.Height:=lymax 3106 else Buffer.Height:=3*ySizeBig; 3107 Buffer.Canvas.Font.Assign(UniFont[ftSmall]); 3108 for i:=0 to nPl-1 do AILogo[i]:=nil; 3109 Canvas.Font.Assign(UniFont[ftSmall]); 3110 InitButtons(); 3111 EOT.Template:=Templates; 3112 end; 3113 3114 procedure TMainScreen.FormDestroy(Sender:TObject); 3115 var 3116 i: integer; 3117 begin 3118 Mini.Free;Buffer.Free;Panel.Free; 3119 for i:=0 to nPl-1 do if AILogo[i]<>nil then 3120 AILogo[i].Free; 3121 end; 3122 3123 procedure TMainScreen.FormResize(Sender:TObject); 3124 var 3125 MiniFrame,MaxMapWidth: integer; 3126 begin 3127 SmallScreen:= ClientWidth<1024; 3128 MaxMapWidth:=(G.lx*2-3)*xxt; // avoide the same tile being visible left and right 3129 if ClientWidth<=MaxMapWidth then 3130 begin 3131 MapWidth:=ClientWidth; 3132 MapOffset:=0; 3133 end 3134 else 3135 begin 3136 MapWidth:=MaxMapWidth; 3137 MapOffset:=(ClientWidth-MapWidth) div 2; 3138 end; 3139 MapHeight:=ClientHeight-TopBarHeight-PanelHeight+overlap; 3140 Panel.Width:=ClientWidth; Panel.Height:=PanelHeight; 3141 TopBar.Width:=ClientWidth; TopBar.Height:=TopBarHeight; 3142 MiniFrame:=(lxmax_xxx-G.ly) div 2; 3143 xMidPanel:=(G.lx+MiniFrame)*2+1; 3144 xRightPanel:=ClientWidth-LeftPanelWidth-10; 3145 if ClientMode=cEditMap then 3146 TrPitch:=2*xxt 3147 else TrPitch:=66; 3148 xMini:=MiniFrame-5; yMini:=(PanelHeight-26-lxmax_xxx) div 2+MiniFrame; 3149 ywmax:=(G.ly-MapHeight div yyt+1) and not 1; 3150 ywcenter:=-((MapHeight-yyt*(G.ly-1)) div (4*yyt))*2; // only for ywmax<=0 3151 if ywmax<=0 then yw:=ywcenter 3152 else if yw<0 then yw:=0 3153 else if yw>ywmax then yw:=ywmax; 3154 UnitInfoBtn.Top:=ClientHeight-29; 3155 UnitInfoBtn.Left:=xMidPanel+7+99; 3156 UnitBtn.Top:=ClientHeight-29; 3157 UnitBtn.Left:=xMidPanel+7+99+31; 3158 TerrainBtn.Top:=ClientHeight-29; 3159 TerrainBtn.Left:=xMidPanel+7+99+62; 3160 MovieSpeed1Btn.Top:=ClientHeight-91; 3161 MovieSpeed1Btn.Left:=ClientWidth div 2-62; 3162 MovieSpeed2Btn.Top:=ClientHeight-91; 3163 MovieSpeed2Btn.Left:=ClientWidth div 2-62+29; 3164 MovieSpeed3Btn.Top:=ClientHeight-91; 3165 MovieSpeed3Btn.Left:=ClientWidth div 2-62+2*29; 3166 MovieSpeed4Btn.Top:=ClientHeight-91; 3167 MovieSpeed4Btn.Left:=ClientWidth div 2-62+3*29+12; 3168 EOT.Top:=ClientHeight-64; 3169 EOT.Left:=ClientWidth-62; 3170 SetWindowPos(sb.h,0,xRightPanel+10-14-GetSystemMetrics(SM_CXVSCROLL), 3171 ClientHeight-MidPanelHeight+8,0,0,SWP_NOSIZE or SWP_NOZORDER); 3172 MapBtn0.Left:=xMini+G.lx-44; 3173 MapBtn0.Top:=ClientHeight-15; 3174 MapBtn1.Left:=xMini+G.lx-28; 3175 MapBtn1.Top:=ClientHeight-15; 3176 {MapBtn2.Left:=xMini+G.lx-20; 3177 MapBtn2.Top:=ClientHeight-15; 3178 MapBtn3.Left:=xMini+G.lx-4; 3179 MapBtn3.Top:=ClientHeight-15;} 3180 MapBtn5.Left:=xMini+G.lx-12; 3181 MapBtn5.Top:=ClientHeight-15; 3182 MapBtn4.Left:=xMini+G.lx+20; 3183 MapBtn4.Top:=ClientHeight-15; 3184 MapBtn6.Left:=xMini+G.lx+36; 3185 MapBtn6.Top:=ClientHeight-15; 3186 TreasuryArea.Left:=ClientWidth div 2-172; 3187 ResearchArea.Left:=ClientWidth div 2; 3188 ManagementArea.Left:=ClientWidth-xPalace; 3189 ManagementArea.Top:=TopBarHeight+MapHeight-overlap+yPalace; 3190 ArrangeMidPanel; 3191 if RepaintOnResize then 3192 begin 3193 RectInvalidate(0,TopBarHeight,ClientWidth,TopBarHeight+MapHeight); 3194 MapValid:=false; 3195 PaintAll 3196 end 3197 end; 3198 3199 procedure TMainScreen.FormCloseQuery(Sender: TObject; var CanClose: boolean); 3200 begin 3201 CanClose:=Closable; 3202 if not Closable and idle and (me=0) and (ClientMode<scContact) then 3203 MenuClick(mResign) 3204 end; 3205 3206 procedure TMainScreen.OnScroll(var m:TMessage); 3207 begin 3208 if ProcessPVSB(sb,m) then begin PanelPaint; Update end 3209 end; 3210 3211 procedure TMainScreen.OnEOT(var Msg:TMessage); 3212 begin 3213 EndTurn 3214 end; 3215 3216 procedure TMainScreen.EOTClick(Sender:TObject); 3217 begin 3218 if GameMode=cMovie then 3219 begin 3220 MessgExDlg.CancelMovie; 3221 Server(sBreak,me,0,nil^) 3222 end 3223 else if ClientMode<0 then 3224 skipped:=true 3225 else if ClientMode>=scContact then 3226 NegoDlg.ShowNewContent(wmPersistent) 3227 else if Jump[pTurn]>0 then 3228 begin Jump[pTurn]:=0; StartRunning:=false end 3229 else EndTurn 3230 end; 3231 3232 // set xTerrain, xTroop, and TrRow 3233 procedure TMainScreen.ArrangeMidPanel; 3234 begin 3235 if ClientMode=cEditMap then 3236 xTroop:=xMidPanel+15 3237 else 3238 begin 3239 if supervising then 3240 xTerrain:=xMidPanel+2*xxt+14 3241 else if ClientWidth<1280 then 3242 xTerrain:=ClientWidth div 2+(1280-ClientWidth) div 3 3243 else xTerrain:=ClientWidth div 2; 3244 xTroop:=xTerrain+2*xxt+12; 3245 if SmallScreen and not supervising then 3246 xTroop:=xRightPanel+10-3*66-GetSystemMetrics(SM_CXVSCROLL)-19-4; 3247 // not perfect but we assume almost no one is still playing on a 800x600 screen 3248 end; 3249 TrRow:=(xRightPanel+10-xTroop-GetSystemMetrics(SM_CXVSCROLL)-19) div TrPitch; 3250 end; 3251 3252 function TMainScreen.EndTurn(WasSkipped: boolean): boolean; 3253 3254 function IsResourceUnused(cix, NeedFood, NeedProd: integer): boolean; 3255 var 3256 dx,dy,fix: integer; 3257 CityAreaInfo: TCityAreaInfo; 3258 TileInfo: TTileInfo; 3259 begin 3260 Server(sGetCityAreaInfo,me,cix,CityAreaInfo); 3261 for dy:=-3 to 3 do for dx:=-3 to 3 do 3262 if ((dx+dy) and 1=0) and (dx*dx*dy*dy<81) then 3263 begin 3264 fix:=(dy+3) shl 2+(dx+3) shr 1; 3265 if (MyCity[cix].Tiles and (1 shl fix)=0) // not used yet 3266 and (CityAreaInfo.Available[fix]=faAvailable) then // usable 3267 begin 3268 TileInfo.ExplCity:=cix; 3269 Server(sGetHypoCityTileInfo, me, dLoc(MyCity[cix].Loc,dx,dy), TileInfo); 3270 if (TileInfo.Food>=NeedFood) and (TileInfo.Prod>=NeedProd) then 3271 begin result:=true; exit end; 3272 end 3273 end; 3274 result:=false; 3275 end; 3276 3277 var 3278 i,p1,uix,cix,CenterLoc: integer; 3279 MsgItem: string; 3280 CityReport: TCityReport; 3281 PlaneReturnData: TPlaneReturnData; 3282 Zoom: boolean; 3283 begin 3284 result:=false; 3285 if ClientMode>=scDipOffer then exit; 3286 3287 if supervising and (me<>0) then 3288 begin 3289 for i:=0 to Screen.FormCount-1 do 3290 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 3291 Screen.Forms[i].Close; // close windows 3292 ItsMeAgain(0); 3293 end; 3294 3295 CityOptimizer_EndOfTurn; 3296 3297 if not WasSkipped then // check warnings 3298 begin 3299 // need to move planes home? 3300 for uix:=0 to MyRO.nUn-1 do with MyUn[uix] do 3301 if (Loc>=0) and (MyModel[mix].Domain=dAir) 3302 and (Status and usToldNoReturn=0) and (Master<0) 3303 and (MyMap[Loc] and fCity=0) and (MyMap[Loc] and fTerImp<>tiBase) then 3304 begin 3305 PlaneReturnData.Fuel:=Fuel; 3306 PlaneReturnData.Loc:=Loc; 3307 PlaneReturnData.Movement:=0; // end turn without further movement? 3308 if Server(sGetPlaneReturn, me, uix, PlaneReturnData)=eNoWay then 3309 begin 3310 CenterLoc:=Loc+G.lx*6; // centering the unit itself would make it covered by the query dialog 3311 while CenterLoc>=G.lx*G.ly do 3312 dec(CenterLoc, G.lx*2); 3313 Centre(CenterLoc); 3314 SetTroopLoc(-1); 3315 PaintAll; 3316 3317 if MyModel[mix].Kind=mkSpecial_Glider then 3318 MsgItem:='LOWFUEL_GLIDER' 3319 else MsgItem:='LOWFUEL'; 3320 if SimpleQuery(mkYesNo,Phrases.Lookup(MsgItem),'WARNING_LOWSUPPORT')<>mrOk then 3321 begin 3322 SetUnFocus(uix); 3323 SetTroopLoc(Loc); 3324 PanelPaint; 3325 exit; 3326 end; 3327 MyUn[uix].Status:=MyUn[uix].Status or usToldNoReturn; 3328 end 3329 end; 3330 3331 if not supervising and (MyRO.TestFlags and tfImmImprove=0) 3332 and (MyRO.Government<>gAnarchy) 3333 and (MyRO.Money+TaxSum<0) and (MyRO.TaxRate<100) then // low funds! 3334 with MessgExDlg do 3335 begin 3336 OpenSound:='WARNING_LOWFUNDS'; 3337 MessgText:=Phrases.Lookup('LOWFUNDS'); 3338 Kind:=mkYesNo; 3339 IconKind:=mikImp; 3340 IconIndex:=imTrGoods; 3341 ShowModal; 3342 if ModalResult<>mrOK then exit 3343 end; 3344 3345 if MyRO.Government<>gAnarchy then 3346 for cix:=0 to MyRO.nCity-1 do with MyCity[cix] do 3347 if (Loc>=0) and (Flags and chCaptured=0) then 3348 begin 3349 Zoom:=false; 3350 CityReport.HypoTiles:=-1; 3351 CityReport.HypoTax:=-1; 3352 CityReport.HypoLux:=-1; 3353 Server(sGetCityReport,me,cix,CityReport); 3354 3355 if (CityReport.Working-CityReport.Happy>Size shr 1) 3356 and (Flags and chCaptured<=$10000) then 3357 with MessgExDlg do 3358 begin 3359 OpenSound:='WARNING_DISORDER'; 3360 if Status and csResourceWeightsMask=0 then 3361 MsgItem:='DISORDER' 3362 else MsgItem:='DISORDER_UNREST'; 3363 MessgText:=Format(Phrases.Lookup(MsgItem),[CityName(ID)]); 3364 Kind:=mkYesNo; 3365 // BigIcon:=29; 3366 ShowModal; 3367 Zoom:= ModalResult<>mrOK; 3368 end; 3369 if not Zoom and (Food+CityReport.FoodRep-CityReport.Eaten<0) then 3370 with MessgExDlg do 3371 begin 3372 OpenSound:='WARNING_FAMINE'; 3373 if Status and csResourceWeightsMask=0 then 3374 MsgItem:='FAMINE' 3375 else if (CityReport.Deployed<>0) and IsResourceUnused(cix,1,0) then 3376 MsgItem:='FAMINE_UNREST' 3377 else MsgItem:='FAMINE_TILES'; 3378 MessgText:=Format(Phrases.Lookup(MsgItem),[CityName(ID)]); 3379 Kind:=mkYesNo; 3380 IconKind:=mikImp; 3381 IconIndex:=22; 3382 ShowModal; 3383 Zoom:= ModalResult<>mrOK; 3384 end; 3385 if not Zoom and (CityReport.ProdRep<CityReport.Support) then 3386 with MessgExDlg do 3387 begin 3388 OpenSound:='WARNING_LOWSUPPORT'; 3389 if Status and csResourceWeightsMask=0 then 3390 MsgItem:='LOWSUPPORT' 3391 else if (CityReport.Deployed<>0) and IsResourceUnused(cix,0,1) then 3392 MsgItem:='LOWSUPPORT_UNREST' 3393 else MsgItem:='LOWSUPPORT_TILES'; 3394 MessgText:=Format(Phrases.Lookup(MsgItem),[CityName(ID)]); 3395 Kind:=mkYesNo; 3396 IconKind:=mikImp; 3397 IconIndex:=29; 3398 ShowModal; 3399 Zoom:= ModalResult<>mrOK; 3400 end; 3401 if Zoom then 3402 begin // zoom to city 3403 ZoomToCity(Loc); 3404 exit 3405 end 3406 end; 3407 3408 if (MyRO.Happened and phTech<>0) and (MyRO.ResearchTech<0) 3409 and (MyData.FarTech<>adNexus) then 3410 if not ChooseResearch then 3411 exit; 3412 end; 3413 3414 RememberPeaceViolation; 3415 3416 SetUnFocus(-1); 3417 for uix:=0 to MyRO.nUn-1 do 3418 MyUn[uix].Status:=MyUn[uix].Status and usPersistent; 3419 3420 CityDlg.CloseAction:=None; 3421 if IsMultiPlayerGame then 3422 begin // close windows for next player 3423 for i:=0 to Screen.FormCount-1 do 3424 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 3425 Screen.Forms[i].Close; 3426 end 3427 else 3428 begin 3429 if CityDlg.Visible then CityDlg.Close; 3430 if UnitStatDlg.Visible then UnitStatDlg.Close; 3431 end; 3432 for i:=0 to Screen.FormCount-1 do 3433 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 3434 Screen.Forms[i].Enabled:=false; 3435 3436 if Server(sTurn,pTurn,0,nil^)>=rExecuted then 3437 begin 3438 if Jump[pTurn]>0 then EOT.Hint:=Phrases.Lookup('BTN_STOP') 3439 else EOT.Hint:=Phrases.Lookup('BTN_SKIP'); 3440 result:=true; 3441 SetTroopLoc(-1); 3442 pTurn:=-1; 3443 pLogo:=-1; 3444 UnitInfoBtn.Visible:=false; 3445 UnitBtn.Visible:=false; 3446 TerrainBtn.Visible:=false; 3447 EOT.ButtonIndex:=eotCancel; 3448 EOT.Visible:=true; 3449 MapValid:=false; 3450 PanelPaint; 3451 Update; 3452 ClientMode:=-1; 3453 idle:=false; 3454 skipped:=WasSkipped; 3455 for p1:=1 to nPl-1 do 3456 if G.RO[p1]<>nil then skipped:=true; // don't show enemy moves in hotseat mode 3457 end 3458 else PanelPaint 3459 end; // EndTurn 3460 3461 procedure TMainScreen.EndNego; 3462 begin 3463 if NegoDlg.Visible then NegoDlg.Close; 3464 HaveStrategyAdvice:=false; 3465 // AdvisorDlg.HaveStrategyAdvice; 3466 // negotiation might have changed advices 3467 EOT.ButtonIndex:=eotCancel; 3468 EOT.Visible:=true; 3469 PanelPaint; 3470 Update; 3471 ClientMode:=-1; 3472 idle:=false; 3473 end; 3474 3475 procedure TMainScreen.ProcessRect(x0,y0,nx,ny,Options: integer); 3476 var 3477 xs,ys,xl,yl: integer; 3478 begin 3479 xl:=nx*xxt+xxt; 3480 yl:=ny*yyt+yyt*2; 3481 xs:=(x0-xw)*(xxt*2)+y0 and 1*xxt-G.lx*(xxt*2); 3482 // |xs+xl/2-MapWidth/2| -> min 3483 while abs(2*(xs+G.lx*(xxt*2))+xl-MapWidth)<abs(2*xs+xl-MapWidth) do 3484 inc(xs,G.lx*(xxt*2)); 3485 ys:=(y0-yw)*yyt-yyt; 3486 if xs+xl>MapWidth then xl:=MapWidth-xs; 3487 if ys+yl>MapHeight then yl:=MapHeight-ys; 3488 if (xl<=0) or (yl<=0) then exit; 3489 if Options and prPaint<>0 then 3490 begin 3491 if Options and prAutoBounds<>0 then 3492 MainMap.SetPaintBounds(xs,ys,xs+xl,ys+yl); 3493 MainMap.Paint(xs,ys,x0+G.lx*y0,nx,ny,-1,-1); 3494 end; 3495 if Options and prInvalidate<>0 then 3496 RectInvalidate(MapOffset+xs,TopBarHeight+ys,MapOffset+xs+xl,TopBarHeight+ys+yl) 3497 end; 3498 3499 procedure TMainScreen.PaintLoc(Loc: integer; Radius: integer = 0); 3500 var 3501 yLoc,x0: integer; 3502 begin 3503 if MapValid then 3504 begin 3505 yLoc:=(Loc+G.lx*1024) div G.lx -1024; 3506 x0:=(Loc+(yLoc and 1-2*Radius+G.lx*1024) div 2) mod G.lx; 3507 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3508 ProcessRect(x0,yLoc-2*Radius,4*Radius+1,4*Radius+1, 3509 prPaint or prAutoBounds or prInvalidate); 3510 Update; 3511 end 3512 end; 3513 3514 procedure TMainScreen.PaintLocTemp(Loc, Style: integer); 3515 var 3516 y0,x0,xMap,yMap: integer; 3517 begin 3518 if not MapValid then exit; 3519 Buffer.Canvas.Font.Assign(UniFont[ftSmall]); 3520 y0:=Loc div G.lx; 3521 x0:=Loc mod G.lx; 3522 xMap:=(x0-xw)*(xxt*2)+y0 and 1*xxt-G.lx*(xxt*2); 3523 // |xMap+xxt-MapWidth/2| -> min 3524 while abs(2*(xMap+G.lx*(xxt*2))+2*xxt-MapWidth)<abs(2*xMap+2*xxt-MapWidth) do 3525 inc(xMap,G.lx*(xxt*2)); 3526 yMap:=(y0-yw)*yyt-yyt; 3527 NoMap.SetOutput(Buffer); 3528 NoMap.SetPaintBounds(0,0,2*xxt,3*yyt); 3529 NoMap.Paint(0,0,Loc,1,1,-1,-1,Style=pltsBlink); 3530 PaintBufferToScreen(xMap,yMap,2*xxt,3*yyt); 3531 end; 3532 3533 // paint content of buffer directly to screen instead of offscreen 3534 // panel protusions are added 3535 // NoMap must be set to buffer and bounds before 3536 procedure TMainScreen.PaintBufferToScreen(xMap,yMap,width,height: integer); 3537 begin 3538 if xMap+width>MapWidth then 3539 width:=MapWidth-xMap; 3540 if yMap+height>MapHeight then 3541 height:=MapHeight-yMap; 3542 if (width<=0) or (height<=0) or (width+xMap<=0) or (height+yMap<=0) then 3543 exit; 3544 3545 NoMap.BitBlt(Panel,-xMap-MapOffset,-yMap+MapHeight-overlap,xMidPanel,overlap, 3546 0,0,SRCCOPY); 3547 NoMap.BitBlt(Panel,-xMap-MapOffset+xRightPanel,-yMap+MapHeight-overlap, 3548 Panel.Width-xRightPanel,overlap,xRightPanel,0,SRCCOPY); 3549 if yMap<0 then 3550 begin 3551 if xMap<0 then 3552 BitBlt(Canvas.Handle,MapOffset,TopBarHeight,width+xMap,height+yMap, 3553 Buffer.Canvas.Handle,-xMap,-yMap,SRCCOPY) 3554 else BitBlt(Canvas.Handle,xMap+MapOffset,TopBarHeight,width,height+yMap, 3555 Buffer.Canvas.Handle,0,-yMap,SRCCOPY) 3556 end 3557 else 3558 begin 3559 if xMap<0 then 3560 BitBlt(Canvas.Handle,MapOffset,TopBarHeight+yMap,width+xMap,height, 3561 Buffer.Canvas.Handle,-xMap,0,SRCCOPY) 3562 else BitBlt(Canvas.Handle,xMap+MapOffset,TopBarHeight+yMap,width,height, 3563 Buffer.Canvas.Handle,0,0,SRCCOPY); 3564 end 3565 end; 3566 3567 procedure TMainScreen.PaintLoc_BeforeMove(FromLoc: integer); 3568 var 3569 yLoc,x0: integer; 3570 begin 3571 if MapValid then 3572 begin 3573 yLoc:=(FromLoc+G.lx*1024) div G.lx -1024; 3574 x0:=(FromLoc+(yLoc and 1+G.lx*1024) div 2) mod G.lx; 3575 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3576 ProcessRect(x0,yLoc,1,1,prPaint or prAutoBounds); 3577 end 3578 end; 3579 3580 procedure TMainScreen.PaintDestination; 3581 var 3582 Destination: integer; 3583 begin 3584 if (UnFocus>=0) and (MyUn[UnFocus].Status and usGoto<>0) then 3585 begin 3586 Destination:=MyUn[UnFocus].Status shr 16; 3587 if (Destination<>$7FFF) and (Destination<>MyUn[UnFocus].Loc) then 3588 PaintLocTemp(Destination,pltsBlink); 3589 end; 3590 end; 3591 3592 procedure TMainScreen.MiniPaint; 3593 type 3594 TLine=array[0..99999999,0..2] of Byte; 3595 var 3596 uix,cix,x,y,Loc,i,hw,xm,cm,cmPolOcean,cmPolNone:integer; 3597 PrevMiniLine,MiniLine:^TLine; 3598 begin 3599 cmPolOcean:=GrExt[HGrSystem].Data.Canvas.Pixels[101,67]; 3600 cmPolNone:=GrExt[HGrSystem].Data.Canvas.Pixels[102,67]; 3601 hw:=MapWidth div (xxt*2); 3602 with Mini.Canvas do 3603 begin 3604 Brush.Color:=$000000; 3605 FillRect(Rect(0,0,Mini.Width,Mini.Height)); 3606 end; 3607 MiniLine:=nil; 3608 for y:=0 to G.ly-1 do 3609 begin 3610 PrevMiniLine:=MiniLine; 3611 MiniLine:=Mini.ScanLine[y]; 3612 for x:=0 to G.lx-1 do if MyMap[x+G.lx*y] and fTerrain<>fUNKNOWN then 3613 begin 3614 Loc:=x+G.lx*y; 3615 for i:=0 to 1 do 3616 begin 3617 xm:=((x-xwMini)*2+i+y and 1-hw+G.lx*5) mod (G.lx*2); 3618 cm:=MiniColors[MyMap[Loc] and fTerrain,i]; 3619 if ClientMode=cEditMap then 3620 begin 3621 if MyMap[Loc] and (fPrefStartPos or fStartPos)<>0 then 3622 cm:=$FFFFFF; 3623 end 3624 else if MyMap[Loc] and fCity<>0 then 3625 begin 3626 cix:=MyRO.nCity-1; 3627 while (cix>=0) and (MyCity[cix].Loc<>Loc) do dec(cix); 3628 if cix>=0 then cm:=Tribe[me].Color 3629 else 3630 begin 3631 cix:=MyRO.nEnemyCity-1; 3632 while (cix>=0) and (MyRO.EnemyCity[cix].Loc<>Loc) do dec(cix); 3633 if cix>=0 then cm:=Tribe[MyRO.EnemyCity[cix].Owner].Color 3634 end; 3635 cm:=$808080 or cm shr 1; {increase brightness} 3636 if PrevMiniLine<>nil then 3637 begin // 2x2 city dot covers two scanlines 3638 PrevMiniLine[xm,0]:=cm shr 16; 3639 PrevMiniLine[xm,1]:=cm shr 8 and $FF; 3640 PrevMiniLine[xm,2]:=cm and $FF; 7649 GamePopup.Popup(Left + 4, Top + GetSystemMetrics(SM_CYCAPTION) + 4 7650 + TopBarHeight - 1); 3641 7651 end 3642 7652 end 3643 else if (i=0) and (MyMap[Loc] and fUnit<>0) then 3644 begin 3645 uix:=MyRO.nUn-1; 3646 while (uix>=0) and (MyUn[uix].Loc<>Loc) do dec(uix); 3647 if uix>=0 then cm:=Tribe[me].Color 7653 else if IsPanelPixel(x, y) then 7654 PanelBoxMouseDown(Sender, Button, Shift, x, 7655 y - (ClientHeight - PanelHeight)) 7656 else if (y >= TopBarHeight) and (x >= MapOffset) and 7657 (x < MapOffset + MapWidth) then 7658 MapBoxMouseDown(Sender, Button, Shift, x - MapOffset, 7659 y - TopBarHeight) 7660 end; 7661 7662 procedure TMainScreen.FormMouseMove(Sender: TObject; Shift: TShiftState; 7663 x, y: integer); 7664 begin 7665 if idle then 7666 if IsPanelPixel(x, y) then 7667 PanelBoxMouseMove(Sender, Shift, x, y - (ClientHeight - PanelHeight)) 7668 else if (y >= TopBarHeight) and (x >= MapOffset) and 7669 (x < MapOffset + MapWidth) then 7670 MapBoxMouseMove(Sender, Shift, x - MapOffset, y - TopBarHeight); 7671 end; 7672 7673 procedure TMainScreen.FormMouseUp(Sender: TObject; Button: TMouseButton; 7674 Shift: TShiftState; x, y: integer); 7675 begin 7676 if idle then 7677 PanelBoxMouseUp(Sender, Button, Shift, x, 7678 y - (ClientHeight - PanelHeight)); 7679 end; 7680 7681 procedure TMainScreen.FormPaint(Sender: TObject); 7682 begin 7683 MainOffscreenPaint; 7684 if (MapOffset > 0) or (MapOffset + MapWidth < ClientWidth) then 7685 with Canvas do 7686 begin // pillarbox, make left and right border black 7687 if me < 0 then 7688 Brush.Color := $000000 7689 else 7690 Brush.Color := EmptySpaceColor; 7691 if xMidPanel > MapOffset then 7692 FillRect(Rect(0, TopBarHeight, MapOffset, TopBarHeight + MapHeight 7693 - overlap)) 7694 else 7695 begin 7696 FillRect(Rect(0, TopBarHeight, xMidPanel, TopBarHeight + MapHeight - 7697 overlap)); 7698 FillRect(Rect(xMidPanel, TopBarHeight, MapOffset, 7699 TopBarHeight + MapHeight)); 7700 end; 7701 if xRightPanel < MapOffset + MapWidth then 7702 FillRect(Rect(MapOffset + MapWidth, TopBarHeight, ClientWidth, 7703 TopBarHeight + MapHeight - overlap)) 7704 else 7705 begin 7706 FillRect(Rect(MapOffset + MapWidth, TopBarHeight, xRightPanel, 7707 TopBarHeight + MapHeight)); 7708 FillRect(Rect(xRightPanel, TopBarHeight, ClientWidth, 7709 TopBarHeight + MapHeight - overlap)); 7710 end; 7711 Brush.Style := bsClear; 7712 end; 7713 BitBlt(Canvas.Handle, MapOffset, TopBarHeight, MapWidth, 7714 MapHeight - overlap, offscreen.Canvas.Handle, 0, 0, SRCCOPY); 7715 BitBlt(Canvas.Handle, 0, 0, ClientWidth, TopBarHeight, 7716 TopBar.Canvas.Handle, 0, 0, SRCCOPY); 7717 if xMidPanel > MapOffset then 7718 BitBlt(Canvas.Handle, xMidPanel, TopBarHeight + MapHeight - overlap, 7719 ClientWidth div 2 - xMidPanel, overlap, offscreen.Canvas.Handle, 7720 xMidPanel - MapOffset, MapHeight - overlap, SRCCOPY) 7721 else 7722 BitBlt(Canvas.Handle, MapOffset, TopBarHeight + MapHeight - overlap, 7723 ClientWidth div 2 - MapOffset, overlap, offscreen.Canvas.Handle, 0, 7724 MapHeight - overlap, SRCCOPY); 7725 if xRightPanel < MapOffset + MapWidth then 7726 BitBlt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight - 7727 overlap, xRightPanel - ClientWidth div 2, overlap, 7728 offscreen.Canvas.Handle, ClientWidth div 2 - MapOffset, 7729 MapHeight - overlap, SRCCOPY) 7730 else 7731 BitBlt(Canvas.Handle, ClientWidth div 2, TopBarHeight + MapHeight - 7732 overlap, MapOffset + MapWidth - ClientWidth div 2, overlap, 7733 offscreen.Canvas.Handle, ClientWidth div 2 - MapOffset, 7734 MapHeight - overlap, SRCCOPY); 7735 BitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight - overlap, xMidPanel, 7736 overlap, Panel.Canvas.Handle, 0, 0, SRCCOPY); 7737 BitBlt(Canvas.Handle, xRightPanel, TopBarHeight + MapHeight - overlap, 7738 Panel.width - xRightPanel, overlap, Panel.Canvas.Handle, xRightPanel, 7739 0, SRCCOPY); 7740 BitBlt(Canvas.Handle, 0, TopBarHeight + MapHeight, Panel.width, 7741 PanelHeight - overlap, Panel.Canvas.Handle, 0, overlap, SRCCOPY); 7742 if (pLogo >= 0) and (G.RO[pLogo] = nil) and (AILogo[pLogo] <> nil) then 7743 BitBlt(Canvas.Handle, xRightPanel + 10 - (16 + 64), 7744 ClientHeight - PanelHeight, 64, 64, AILogo[pLogo].Canvas.Handle, 0, 0, 7745 SRCCOPY); 7746 end; 7747 7748 procedure TMainScreen.RectInvalidate(Left, Top, Rigth, Bottom: integer); 7749 var 7750 r0: HRgn; 7751 begin 7752 r0 := CreateRectRgn(Left, Top, Rigth, Bottom); 7753 InvalidateRgn(Handle, r0, false); 7754 DeleteObject(r0); 7755 end; 7756 7757 procedure TMainScreen.SmartRectInvalidate(Left, Top, Rigth, 7758 Bottom: integer); 7759 var 7760 i: integer; 7761 r0, r1: HRgn; 7762 begin 7763 r0 := CreateRectRgn(Left, Top, Rigth, Bottom); 7764 for i := 0 to ControlCount - 1 do 7765 if not(Controls[i] is TArea) and Controls[i].Visible then 7766 begin 7767 with Controls[i].BoundsRect do 7768 r1 := CreateRectRgn(Left, Top, Right, Bottom); 7769 CombineRgn(r0, r0, r1, RGN_DIFF); 7770 DeleteObject(r1); 7771 end; 7772 InvalidateRgn(Handle, r0, false); 7773 DeleteObject(r0); 7774 end; 7775 7776 procedure TMainScreen.mRepClicked(Sender: TObject); 7777 begin 7778 with TMenuItem(Sender) do 7779 begin 7780 Checked := not Checked; 7781 if Checked then 7782 CityRepMask := CityRepMask or (1 shl (Tag shr 8)) 3648 7783 else 7784 CityRepMask := CityRepMask and not(1 shl (Tag shr 8)) 7785 end 7786 end; 7787 7788 procedure TMainScreen.mLogClick(Sender: TObject); 7789 begin 7790 LogDlg.Show 7791 end; 7792 7793 procedure TMainScreen.FormShow(Sender: TObject); 7794 begin 7795 Timer1.Enabled := true 7796 end; 7797 7798 procedure TMainScreen.FormClose(Sender: TObject; var Action: TCloseAction); 7799 begin 7800 Timer1.Enabled := false 7801 end; 7802 7803 procedure TMainScreen.Radio(Sender: TObject); 7804 begin 7805 TMenuItem(Sender).Checked := true 7806 end; 7807 7808 procedure TMainScreen.mManipClick(Sender: TObject); 7809 var 7810 Flag: integer; 7811 begin 7812 with TMenuItem(Sender) do 7813 begin 7814 Flag := 1 shl (Tag shr 8); 7815 if Checked then 7816 Server(sClearTestFlag, 0, Flag, nil^) 7817 else 7818 begin 7819 Server(sSetTestFlag, 0, Flag, nil^); 7820 Play('CHEAT'); 7821 end; 7822 if not supervising then 7823 begin 7824 if Flag = tfUncover then 3649 7825 begin 3650 uix:=MyRO.nEnemyUn-1; 3651 while (uix>=0) and (MyRO.EnemyUn[uix].Loc<>Loc) do dec(uix); 3652 if uix>=0 then cm:=Tribe[MyRO.EnemyUn[uix].Owner].Color 3653 end; 3654 cm:=$808080 or cm shr 1; {increase brightness} 3655 end 3656 else if MapOptionChecked and (1 shl moPolitical)<>0 then 3657 begin 3658 if MyMap[Loc] and fTerrain<fGrass then cm:=cmPolOcean 3659 else if MyRO.Territory[Loc]<0 then cm:=cmPolNone 3660 else cm:=Tribe[MyRO.Territory[Loc]].Color; 3661 end; 3662 MiniLine[xm,0]:=cm shr 16; 3663 MiniLine[xm,1]:=cm shr 8 and $FF; 3664 MiniLine[xm,2]:=cm and $FF; 3665 end; 3666 end 3667 end; 3668 end; 3669 3670 procedure TMainScreen.MainOffscreenPaint; 3671 var 3672 ProcessOptions: integer; 3673 rec:TRect; 3674 DoInvalidate: boolean; 3675 begin 3676 if me<0 then 3677 with offscreen.Canvas do 3678 begin 3679 Brush.Color:=$000000; 3680 FillRect(Rect(0,0,MapWidth,MapHeight)); 3681 Brush.Style:=bsClear; 3682 OffscreenUser:=self; 3683 exit 3684 end; 3685 3686 MainMap.SetPaintBounds(0,0,MapWidth,MapHeight); 3687 if OffscreenUser<>self then 3688 begin 3689 if OffscreenUser<>nil then OffscreenUser.Update; 3690 // complete working with old owner to prevent rebound 3691 if MapValid and (xwd=xw) and (ywd=yw) then 3692 MainMap.SetPaintBounds(0,0,UsedOffscreenWidth,UsedOffscreenHeight); 3693 MapValid:=false; 3694 OffscreenUser:=self; 3695 end; 3696 3697 if xw-xwd>G.lx div 2 then xwd:=xwd+G.lx 3698 else if xwd-xw>G.lx div 2 then xwd:=xwd-G.lx; 3699 if not MapValid or (xw-xwd>MapWidth div (xxt*2)) or (xwd-xw>MapWidth div (xxt*2)) 3700 or (yw-ywd>MapHeight div yyt) or (ywd-yw>MapHeight div yyt) then 3701 begin 3702 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3703 ProcessRect(xw,yw,MapWidth div xxt,MapHeight div yyt,prPaint or prInvalidate) 3704 end 3705 else 3706 begin 3707 if (xwd=xw) and (ywd=yw) then exit; {map window not moved} 3708 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 3709 rec:=Rect(0,0,MapWidth,MapHeight); 3710 ScrollDC(offscreen.Canvas.Handle,(xwd-xw)*(xxt*2),(ywd-yw)*yyt,rec,rec,0,nil); 3711 for DoInvalidate:=false to FastScrolling do 3712 begin 3713 if DoInvalidate then 3714 begin 3715 rec.bottom:=MapHeight-overlap; 3716 ScrollDC(Canvas.Handle,(xwd-xw)*(xxt*2),(ywd-yw)*yyt,rec,rec,0,nil); 3717 ProcessOptions:=prInvalidate; 3718 end 3719 else ProcessOptions:=prPaint or prAutoBounds; 3720 if yw<ywd then 3721 begin 3722 ProcessRect(xw,yw,MapWidth div xxt,ywd-yw-1,ProcessOptions); 3723 if xw<xwd then 3724 ProcessRect(xw,ywd,(xwd-xw)*2-1,MapHeight div yyt-ywd+yw,ProcessOptions) 3725 else if xw>xwd then 3726 ProcessRect((xwd+MapWidth div (xxt*2)) mod G.lx,ywd,(xw-xwd)*2+1, 3727 MapHeight div yyt-ywd+yw,ProcessOptions) 3728 end 3729 else if yw>ywd then 3730 begin 3731 if DoInvalidate then 3732 RectInvalidate(MapOffset,TopBarHeight+MapHeight-overlap-(yw-ywd)*yyt,MapOffset+MapWidth, 3733 TopBarHeight+MapHeight-overlap) 3734 else ProcessRect(xw,(ywd+MapHeight div (yyt*2) *2),MapWidth div xxt, 3735 yw-ywd+1,ProcessOptions); 3736 if xw<xwd then 3737 ProcessRect(xw,yw,(xwd-xw)*2-1,MapHeight div yyt-yw+ywd-2, 3738 ProcessOptions) 3739 else if xw>xwd then 3740 ProcessRect((xwd+MapWidth div (xxt*2)) mod G.lx,yw,(xw-xwd)*2+1, 3741 MapHeight div yyt-yw+ywd-2,ProcessOptions) 3742 end 3743 else 3744 if xw<xwd then 3745 ProcessRect(xw,yw,(xwd-xw)*2-1,MapHeight div yyt,ProcessOptions) 3746 else if xw>xwd then 3747 ProcessRect((xwd+MapWidth div (xxt*2)) mod G.lx,yw,(xw-xwd)*2+1, 3748 MapHeight div yyt,ProcessOptions); 3749 end; 3750 if not FastScrolling then 3751 RectInvalidate(MapOffset,TopBarHeight,MapOffset+MapWidth,TopBarHeight+MapHeight-overlap); 3752 RectInvalidate(xMidPanel,TopBarHeight+MapHeight-overlap,xRightPanel,TopBarHeight+MapHeight) 3753 end; 3754 //if (xwd<>xw) or (ywd<>yw) then 3755 // Server(sChangeSuperView,me,yw*G.lx+xw,nil^); // for synchronizing client side viewer, not used currently 3756 xwd:=xw;ywd:=yw; 3757 MapValid:=true; 3758 end; 3759 3760 procedure TMainScreen.PaintAll; 3761 begin 3762 MainOffscreenPaint; 3763 xwMini:=xw; ywMini:=yw; 3764 MiniPaint; 3765 PanelPaint; 3766 end; 3767 3768 procedure TMainScreen.PaintAllMaps; 3769 begin 3770 MainOffscreenPaint; 3771 xwMini:=xw; ywMini:=yw; 3772 MiniPaint; 3773 CopyMiniToPanel; 3774 RectInvalidate(xMini+2,TopBarHeight+MapHeight-overlap+yMini+2,xMini+2+G.lx*2, 3775 TopBarHeight+MapHeight-overlap+yMini+2+G.ly); 3776 end; 3777 3778 procedure TMainScreen.CopyMiniToPanel; 3779 begin 3780 BitBlt(Panel.Canvas.Handle,xMini+2,yMini+2,G.lx*2,G.ly,Mini.Canvas.Handle,0,0,SRCCOPY); 3781 if MarkCityLoc>=0 then 3782 Sprite(Panel, HGrSystem, xMini-2+(4*G.lx+2*(MarkCityLoc mod G.lx) 3783 +(G.lx-MapWidth div (xxt*2))-2*xwd) mod (2*G.lx) +MarkCityLoc div G.lx and 1, 3784 yMini-3+MarkCityLoc div G.lx,10,10,77,47) 3785 else if ywmax<=0 then 3786 Frame(Panel.Canvas,xMini+2+G.lx-MapWidth div (xxt*2),yMini+2, 3787 xMini+1+G.lx+MapWidth div (xxt*2), 3788 yMini+2+G.ly-1,MainTexture.clMark,MainTexture.clMark) 3789 else Frame(Panel.Canvas,xMini+2+G.lx-MapWidth div (xxt*2),yMini+2+yw, 3790 xMini+1+G.lx+MapWidth div (xxt*2), 3791 yMini+yw+MapHeight div yyt,MainTexture.clMark,MainTexture.clMark); 3792 end; 3793 3794 procedure TMainScreen.PanelPaint; 3795 3796 function MovementToString(var Un: TUn): string; 3797 begin 3798 result:=ScreenTools.MovementToString(Un.Movement); 3799 if Un.Master>=0 then 3800 result:='('+result+')' 3801 else if (MyModel[Un.mix].Domain=dAir) 3802 and (MyModel[Un.mix].Kind<>mkSpecial_Glider) then 3803 result:=Format('%s(%d)',[result,Un.Fuel]); 3804 end; 3805 3806 var 3807 i,uix,uixDefender,x,xSrc,ySrc,xSrcBase,ySrcBase,CostFactor,Count,mixShow, 3808 xTreasurySection,xResearchSection,JobFocus,TrueMoney, 3809 TrueResearch: integer; 3810 Tile: cardinal; 3811 s: string; 3812 unx:TUn; 3813 UnitInfo: TUnitInfo; 3814 JobProgressData: TJobProgressData; 3815 Prio: boolean; 3816 begin 3817 with Panel.Canvas do 3818 begin 3819 Fill(Panel.Canvas,0,3,xMidPanel+7-10,PanelHeight-3, 3820 wMainTexture-(xMidPanel+7-10),hMainTexture-PanelHeight); 3821 Fill(Panel.Canvas,xRightPanel+10-7,3,Panel.Width-xRightPanel-10+7,PanelHeight-3, 3822 -(xRightPanel+10-7),hMainTexture-PanelHeight); 3823 FillLarge(Panel.Canvas,xMidPanel-2,PanelHeight-MidPanelHeight,xRightPanel+2,PanelHeight, 3824 ClientWidth div 2); 3825 3826 Brush.Style:=bsClear; 3827 Pen.Color:=$000000; 3828 MoveTo(0,0);LineTo(xMidPanel+7-8,0); LineTo(xMidPanel+7-8,PanelHeight-MidPanelHeight); 3829 LineTo(xRightPanel,PanelHeight-MidPanelHeight); LineTo(xRightPanel,0); 3830 LineTo(ClientWidth,0); 3831 Pen.Color:=MainTexture.clBevelLight; 3832 MoveTo(xMidPanel+7-9,PanelHeight-MidPanelHeight+2); 3833 LineTo(xRightPanel+10-8,PanelHeight-MidPanelHeight+2); 3834 Pen.Color:=MainTexture.clBevelLight; 3835 MoveTo(0,1);LineTo(xMidPanel+7-9,1); Pen.Color:=MainTexture.clBevelShade; 3836 LineTo(xMidPanel+7-9,PanelHeight-MidPanelHeight+1); Pen.Color:=MainTexture.clBevelLight; 3837 LineTo(xRightPanel+10-9,PanelHeight-MidPanelHeight+1); Pen.Color:=MainTexture.clBevelLight; 3838 LineTo(xRightPanel+10-9,1); LineTo(ClientWidth,1); 3839 MoveTo(ClientWidth,2); LineTo(xRightPanel+10-8,2); LineTo(xRightPanel+10-8,PanelHeight); 3840 MoveTo(0,2);LineTo(xMidPanel+7-10,2); Pen.Color:=MainTexture.clBevelShade; 3841 LineTo(xMidPanel+7-10,PanelHeight); 3842 Corner(Panel.Canvas,xMidPanel+7-16,1,1,MainTexture); 3843 Corner(Panel.Canvas,xRightPanel+10-9,1,0,MainTexture); 3844 if ClientMode<>cEditMap then 3845 begin 3846 if supervising then 3847 begin 3848 Frame(Panel.Canvas, ClientWidth-xPalace-1, yPalace-1, 3849 ClientWidth-xPalace+xSizeBig, yPalace+ySizeBig, $B0B0B0, $FFFFFF); 3850 RFrame(Panel.Canvas, ClientWidth-xPalace-2, yPalace-2, 3851 ClientWidth-xPalace+xSizeBig+1, yPalace+ySizeBig+1, $FFFFFF, $B0B0B0); 3852 BitBlt(Panel.Canvas.Handle, ClientWidth-xPalace, yPalace, xSizeBig, 3853 ySizeBig, GrExt[HGrSystem2].Data.Canvas.Handle, 70, 123, SRCCOPY); 3854 end 3855 else if MyRO.NatBuilt[imPalace]>0 then 3856 ImpImage(Panel.Canvas, ClientWidth-xPalace, yPalace, imPalace, -1, GameMode<>cMovie 3857 {(GameMode<>cMovie) and (MyRO.Government<>gAnarchy)}) 3858 else ImpImage(Panel.Canvas, ClientWidth-xPalace, yPalace, 21, -1, GameMode<>cMovie 3859 {(GameMode<>cMovie) and (MyRO.Government<>gAnarchy)}); 3860 end; 3861 3862 if GameMode=cMovie then 3863 Frame(Panel.Canvas,xMini+1,yMini+1,xMini+2+G.lx*2,yMini+2+G.ly,$000000,$000000) 3864 else 3865 begin 3866 Frame(Panel.Canvas,xMini+1,yMini+1,xMini+2+G.lx*2,yMini+2+G.ly,$B0B0B0,$FFFFFF); 3867 RFrame(Panel.Canvas,xMini,yMini,xMini+3+G.lx*2,yMini+3+G.ly,$FFFFFF,$B0B0B0); 3868 end; 3869 CopyMiniToPanel; 3870 if ClientMode<>cEditMap then // MapBtn icons 3871 for i:=0 to 5 do if i<>3 then 3872 Dump(Panel,HGrSystem,xMini+G.lx-42+16*i,PanelHeight-26,8,8,121+i*9,61); 3873 3874 if ClientMode=cEditMap then 3875 begin 3876 for i:=0 to TrRow-1 do trix[i]:=-1; 3877 Count:=0; 3878 for i:=0 to nBrushTypes-1 do 3879 begin // display terrain types 3880 if (Count>=TrRow*sb.si.npos) and (Count<TrRow*(sb.si.npos+1)) then 3881 begin 3882 trix[Count-TrRow*sb.si.npos]:=BrushTypes[i]; 3883 x:=(Count-TrRow*sb.si.npos)*TrPitch; 3884 xSrcBase:=-1; 3885 case BrushTypes[i] of 3886 0..8: begin xSrc:=BrushTypes[i]; ySrc:=0 end; 3887 9..30: 3888 begin 3889 xSrcBase:=2; ySrcBase:=2; 3890 xSrc:=0; ySrc:=2*integer(BrushTypes[i])-15 3891 end; 3892 fRiver: begin xSrc:=7; ySrc:=14 end; 3893 fRoad: begin xSrc:=0; ySrc:=9 end; 3894 fRR: begin xSrc:=0; ySrc:=10 end; 3895 fCanal: begin xSrc:=0; ySrc:=11 end; 3896 fPoll: begin xSrc:=6; ySrc:=12 end; 3897 fDeadLands,fDeadLands or fCobalt,fDeadLands or fUranium, 3898 fDeadLands or fMercury: 3899 begin 3900 xSrcBase:=6; ySrcBase:=2; 3901 xSrc:=8; ySrc:=12+BrushTypes[i] shr 25; 3902 end; 3903 tiIrrigation, tiFarm, tiMine, tiBase: 3904 begin xSrc:=BrushTypes[i] shr 12-1; ySrc:=12 end; 3905 tiFort: 3906 begin xSrc:=3; ySrc:=12; xSrcBase:=7; ySrcBase:=12 end; 3907 fPrefStartPos: begin xSrc:=0; ySrc:=1 end; 3908 fStartPos: begin xSrc:=0; ySrc:=2 end; 3909 end; 3910 if xSrcBase>=0 then 3911 Sprite(Panel,HGrTerrain,xTroop+2+x,yTroop+9-yyt,xxt*2,yyt*3, 3912 1+xSrcBase*(xxt*2+1),1+ySrcBase*(yyt*3+1)); 3913 Sprite(Panel,HGrTerrain,xTroop+2+x,yTroop+9-yyt,xxt*2,yyt*3, 3914 1+xSrc*(xxt*2+1),1+ySrc*(yyt*3+1)); 3915 if BrushTypes[i]=BrushType then 3916 begin 3917 Frame(Panel.Canvas,xTroop+2+x,yTroop+7-yyt div 2,xTroop+2*xxt+x, 3918 yTroop+2*yyt+11,$000000,$000000); 3919 Frame(Panel.Canvas,xTroop+1+x,yTroop+6-yyt div 2,xTroop+2*xxt-1+x, 3920 yTroop+2*yyt+10,MainTexture.clMark,MainTexture.clMark); 7826 MapValid := false; 7827 PaintAllMaps; 3921 7828 end 3922 end; 3923 inc(Count) 3924 end; 3925 case BrushType of 3926 fDesert, fPrairie, fTundra, fArctic, fSwamp, fHills, fMountains: 3927 s:=Phrases.Lookup('TERRAIN',BrushType); 3928 fShore: s:=Format(Phrases.Lookup('TWOTERRAINS'), 3929 [Phrases.Lookup('TERRAIN',fOcean),Phrases.Lookup('TERRAIN',fShore)]); 3930 fGrass: s:=Format(Phrases.Lookup('TWOTERRAINS'), 3931 [Phrases.Lookup('TERRAIN',fGrass),Phrases.Lookup('TERRAIN',fGrass+12)]); 3932 fForest: s:=Format(Phrases.Lookup('TWOTERRAINS'), 3933 [Phrases.Lookup('TERRAIN',fForest),Phrases.Lookup('TERRAIN',fJungle)]); 3934 fRiver: s:=Phrases.Lookup('RIVER'); 3935 fDeadLands,fDeadLands or fCobalt,fDeadLands or fUranium, 3936 fDeadLands or fMercury: 3937 s:=Phrases.Lookup('TERRAIN',3*12+BrushType shr 25); 3938 fPrefStartPos: s:=Phrases.Lookup('MAP_PREFSTART'); 3939 fStartPos: s:=Phrases.Lookup('MAP_START'); 3940 fPoll: s:=Phrases.Lookup('POLL'); 3941 else // terrain improvements 3942 begin 3943 case BrushType of 3944 fRoad: i:=1; 3945 fRR: i:=2; 3946 tiIrrigation: i:=4; 3947 tiFarm: i:=5; 3948 tiMine: i:=7; 3949 fCanal: i:=8; 3950 tiFort: i:=10; 3951 tiBase: i:=12; 3952 end; 3953 s:=Phrases.Lookup('JOBRESULT',i); 3954 end 3955 end; 3956 LoweredTextOut(Panel.Canvas,-1,MainTexture,xTroop+1,PanelHeight-19,s); 3957 end 3958 else if TroopLoc>=0 then 3959 begin 3960 Brush.Style:=bsClear; 3961 if UnFocus>=0 then with MyUn[UnFocus],MyModel[mix] do 3962 begin {display info about selected unit} 3963 if Job=jCity then 3964 mixShow:=-1 // building site 3965 else mixShow:=mix; 3966 with Tribe[me].ModelPicture[mixShow] do 3967 begin 3968 Sprite(Panel,HGr,xMidPanel+7+12,yTroop+1,64,48, 3969 pix mod 10 *65+1,pix div 10 *49+1); 3970 if MyUn[UnFocus].Flags and unFortified<>0 then 3971 Sprite(Panel,HGrStdUnits,xMidPanel+7+12,yTroop+1,xxu*2,yyu*2,1+6*(xxu*2+1),1); 3972 end; 3973 3974 MakeBlue(Panel,xMidPanel+7+12+10,yTroop-13,44,12); 3975 s:=MovementToString(MyUn[UnFocus]); 3976 RisedTextOut(Panel.Canvas,xMidPanel+7+12+32-BiColorTextWidth(Panel.Canvas,s) div 2, 3977 yTroop-16,s); 3978 3979 s:=IntToStr(Health)+'%'; 3980 LightGradient(Panel.Canvas,xMidPanel+7+12+7,PanelHeight-22,(Health+1) div 2, 3981 (ColorOfHealth(Health) and $FEFEFE shr 2)*3); 3982 if Health<100 then 3983 LightGradient(Panel.Canvas,xMidPanel+7+12+7+(Health+1) div 2, 3984 PanelHeight-22,50-(Health+1) div 2,$000000); 3985 RisedTextOut(Panel.Canvas,xMidPanel+7+12+32-BiColorTextWidth(Panel.Canvas,s) div 2, 3986 PanelHeight-23,s); 3987 3988 FrameImage(Panel.Canvas,GrExt[HGrSystem].Data,xMidPanel+7+xUnitText,yTroop+15,12,14, 3989 121+Exp div ExpCost *13,28); 3990 if Job=jCity then s:=Tribe[me].ModelName[-1] 3991 else s:=Tribe[me].ModelName[mix]; 3992 if Home>=0 then 3993 begin 3994 LoweredTextOut(Panel.Canvas,-1,MainTexture,xMidPanel+7+xUnitText+18,yTroop+5,s); 3995 LoweredTextOut(Panel.Canvas,-1,MainTexture,xMidPanel+7+xUnitText+18,yTroop+21, 3996 '('+CityName(MyCity[Home].ID)+')'); 3997 end 3998 else LoweredTextOut(Panel.Canvas,-1,MainTexture,xMidPanel+7+xUnitText+18,yTroop+13,s); 3999 end; 4000 4001 if (UnFocus>=0) and (MyUn[UnFocus].Loc<>TroopLoc) then 4002 begin // divide panel 4003 if SmallScreen and not supervising then 4004 x:=xTroop-8 4005 else x:=xTroop-152; 4006 Pen.Color:=MainTexture.clBevelShade; 4007 MoveTo(x-1,PanelHeight-MidPanelHeight+2); 4008 LineTo(x-1,PanelHeight); 4009 Pen.Color:=MainTexture.clBevelLight; 4010 MoveTo(x,PanelHeight-MidPanelHeight+2); 4011 LineTo(x,PanelHeight); 4012 end; 4013 4014 for i:=0 to 23 do trix[i]:=-1; 4015 if MyMap[TroopLoc] and fUnit<>0 then 4016 begin 4017 if MyMap[TroopLoc] and fOwned<>0 then 4018 begin 4019 if (TrCnt>1) or (UnFocus<0) or (MyUn[UnFocus].Loc<>TroopLoc) then 4020 begin 4021 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop+10, PanelHeight-24, 4022 Phrases.Lookup('PRESENT')); 4023 Server(sGetDefender,me,TroopLoc,uixDefender); 4024 Count:=0; 4025 for Prio:=true downto false do 4026 for uix:=0 to MyRO.nUn-1 do if (uix=uixDefender)=Prio then 4027 begin // display own units 4028 unx:=MyUn[uix]; 4029 if unx.Loc=TroopLoc then 4030 begin 4031 if (Count>=TrRow*sb.si.npos) and (Count<TrRow*(sb.si.npos+1)) then 4032 begin 4033 trix[Count-TrRow*sb.si.npos]:=uix; 4034 MakeUnitInfo(me,unx,UnitInfo); 4035 x:=(Count-TrRow*sb.si.npos)*TrPitch; 4036 if uix=UnFocus then 4037 begin 4038 Frame(Panel.Canvas,xTroop+4+x,yTroop+3,xTroop+64+x, 4039 yTroop+47,$000000,$000000); 4040 Frame(Panel.Canvas,xTroop+3+x,yTroop+2,xTroop+63+x, 4041 yTroop+46,MainTexture.clMark,MainTexture.clMark); 4042 end 4043 else if (unx.Master>=0) and (unx.Master=UnFocus) then 4044 begin 4045 CFrame(Panel.Canvas,xTroop+4+x,yTroop+3,xTroop+64+x, 4046 yTroop+47,8,$000000); 4047 CFrame(Panel.Canvas,xTroop+3+x,yTroop+2,xTroop+63+x, 4048 yTroop+46,8,MainTexture.clMark); 4049 end; 4050 NoMap.SetOutput(Panel); 4051 NoMap.PaintUnit(xTroop+2+x,yTroop+1,UnitInfo,unx.Status); 4052 if (ClientMode<scContact) 4053 and ((unx.Job>jNone) 4054 or (unx.Status and (usStay or usRecover or usGoto)<>0)) then 4055 Sprite(Panel, HGrSystem, xTroop+2+60-20+x, yTroop+35, 4056 20, 20, 81, 25); 4057 4058 if not supervising then 4059 begin 4060 MakeBlue(Panel,xTroop+2+10+x,yTroop-13,44,12); 4061 s:=MovementToString(unx); 4062 RisedTextOut(Panel.Canvas,xTroop+x+34-BiColorTextWidth(Panel.Canvas,s) div 2, 4063 yTroop-16,s); 4064 end 4065 end; 4066 inc(Count) 4067 end; 4068 end; // for uix:=0 to MyRO.nUn-1 4069 assert(Count=TrCnt); 4070 end 4071 end 4072 else 4073 begin 4074 LoweredTextOut(Panel.Canvas, -1, MainTexture, xTroop+8, PanelHeight-24, 4075 Phrases.Lookup('PRESENT')); 4076 Server(sGetUnits,me,TroopLoc,Count); 4077 for i:=0 to Count-1 do 4078 if (i>=TrRow*sb.si.npos) and (i<TrRow*(sb.si.npos+1)) then 4079 begin // display enemy units 4080 trix[i-TrRow*sb.si.npos]:=i; 4081 x:=(i-TrRow*sb.si.npos)*TrPitch; 4082 NoMap.SetOutput(Panel); 4083 NoMap.PaintUnit(xTroop+2+x,yTroop+1,MyRO.EnemyUn[MyRO.nEnemyUn+i],0); 4084 end; 4085 end; 4086 end; 4087 if not SmallScreen or supervising then 4088 begin // show terrain and improvements 4089 PaintZoomedTile(Panel, xTerrain-xxt*2, 110-yyt*3, TroopLoc); 4090 if (UnFocus>=0) and (MyUn[UnFocus].Job<>jNone) then 4091 begin 4092 JobFocus:=MyUn[UnFocus].Job; 4093 Server(sGetJobProgress, me, MyUn[UnFocus].Loc, JobProgressData); 4094 MakeBlue(Panel,xTerrain-72,148-17,144,31); 4095 PaintRelativeProgressBar(Panel.Canvas,3,xTerrain-68,148+3,63, 4096 JobProgressData[JobFocus].Done, 4097 JobProgressData[JobFocus].NextTurnPlus, 4098 JobProgressData[JobFocus].Required,true,MainTexture); 4099 s:=Format('%s/%s',[ScreenTools.MovementToString(JobProgressData[JobFocus].Done), 4100 ScreenTools.MovementToString(JobProgressData[JobFocus].Required)]); 4101 RisedTextOut(Panel.Canvas,xTerrain+6,148-3,s); 4102 Tile:=MyMap[MyUn[UnFocus].Loc]; 4103 if (JobFocus=jRoad) and (Tile and fRiver<>0) then 4104 JobFocus:=nJob+0 4105 else if (JobFocus=jRR) and (Tile and fRiver<>0) then 4106 JobFocus:=nJob+1 4107 else if JobFocus=jClear then 4108 begin 4109 if Tile and fTerrain=fForest then 4110 JobFocus:=nJob+2 4111 else if Tile and fTerrain=fDesert then 4112 JobFocus:=nJob+3 4113 else JobFocus:=nJob+4 4114 end; 4115 s:=Phrases.Lookup('JOBRESULT', JobFocus); 4116 RisedTextOut(Panel.Canvas,xTerrain-BiColorTextWidth(Panel.Canvas,s) div 2, 4117 148-19,s); 4118 end; 4119 if MyMap[TroopLoc] and (fTerrain or fSpecial)=fGrass or fSpecial1 then 4120 s:=Phrases.Lookup('TERRAIN',fGrass+12) 4121 else if MyMap[TroopLoc] and fDeadlands<>0 then 4122 s:=Phrases.Lookup('TERRAIN',3*12) 4123 else if (MyMap[TroopLoc] and fTerrain=fForest) 4124 and IsJungle(TroopLoc div G.lx) then 4125 s:=Phrases.Lookup('TERRAIN',fJungle) 4126 else s:=Phrases.Lookup('TERRAIN',MyMap[TroopLoc] and fTerrain); 4127 RisedTextOut(Panel.Canvas,xTerrain-BiColorTextWidth(Panel.Canvas,s) div 2, 4128 99,s); 4129 end; 4130 4131 if TerrainBtn.Visible then with TerrainBtn do 4132 RFrame(Panel.Canvas,Left-1,Top-self.ClientHeight+(PanelHeight-1), 4133 Left+Width,Top+Height-self.ClientHeight+PanelHeight, 4134 MainTexture.clBevelShade,MainTexture.clBevelLight) 4135 end {if TroopLoc>=0} 4136 end; 4137 4138 for i:=0 to ControlCount-1 do 4139 if Controls[i] is TButtonB then with TButtonB(Controls[i]) do 4140 begin 4141 if Visible then 4142 begin 4143 Dump(Panel,HGrSystem,Left,Top-self.ClientHeight+PanelHeight,25,25,169,243); 4144 Sprite(Panel,HGrSystem,Left,Top-self.ClientHeight+PanelHeight,25,25, 4145 1+26*ButtonIndex,337); 4146 RFrame(Panel.Canvas,Left-1,Top-self.ClientHeight+(PanelHeight-1), 4147 Left+Width,Top+Height-self.ClientHeight+PanelHeight, 4148 MainTexture.clBevelShade,MainTexture.clBevelLight); 4149 end; 4150 end; 4151 4152 if ClientMode<>cEditMap then 4153 begin 4154 for i:=0 to ControlCount-1 do 4155 if Controls[i] is TButtonC then with TButtonC(Controls[i]) do 4156 begin 4157 Dump(Panel,HGrSystem,Left,Top-self.ClientHeight+PanelHeight,12,12, 4158 169,178+13*ButtonIndex); 4159 RFrame(Panel.Canvas,Left-1,Top-self.ClientHeight+(PanelHeight-1), 4160 Left+Width,Top+Height-self.ClientHeight+PanelHeight, 4161 MainTexture.clBevelShade,MainTexture.clBevelLight); 4162 end 4163 end; 4164 EOT.SetBack(Panel.Canvas,EOT.Left,EOT.Top-(ClientHeight-PanelHeight)); 4165 SmartRectInvalidate(0,ClientHeight-PanelHeight,ClientWidth,ClientHeight); 4166 4167 // topbar 4168 xTreasurySection:=ClientWidth div 2-172; 4169 xResearchSection:=ClientWidth div 2; //ClientWidth div 2+68 = maximum to right 4170 FillLarge(TopBar.Canvas,0,0,ClientWidth,TopBarHeight-3,ClientWidth div 2); 4171 with TopBar.Canvas do 4172 begin 4173 Pen.Color:=$000000; 4174 MoveTo(0,TopBarHeight-1); LineTo(ClientWidth, TopBarHeight-1); 4175 Pen.Color:=MainTexture.clBevelShade; 4176 MoveTo(0,TopBarHeight-2); LineTo(ClientWidth, TopBarHeight-2); 4177 MoveTo(0,TopBarHeight-3); LineTo(ClientWidth, TopBarHeight-3); 4178 Pen.Color:=MainTexture.clBevelLight; 4179 frame(TopBar.Canvas,40,-1,xTreasurySection-1,TopBarHeight-7, 4180 MainTexture.clBevelShade,MainTexture.clBevelLight); 4181 frame(TopBar.Canvas,xResearchSection+332,-1,ClientWidth,TopBarHeight-7, 4182 MainTexture.clBevelShade,MainTexture.clBevelLight); 4183 end; 4184 if GameMode<>cMovie then 4185 ImageOp_BCC(TopBar,Templates,2,1,145,38,36,36,$BFBF20,$4040DF); 4186 if MyRO.nCity>0 then 4187 begin 4188 TrueMoney:=MyRO.Money; 4189 TrueResearch:=MyRO.Research; 4190 if supervising then 4191 begin // normalize values from after-turn state 4192 dec(TrueMoney,TaxSum); 4193 if TrueMoney<0 then 4194 TrueMoney:=0; // shouldn't happen 4195 dec(TrueResearch,ScienceSum); 4196 if TrueResearch<0 then 4197 TrueResearch:=0; // shouldn't happen 4198 end; 4199 4200 // treasury section 4201 ImageOp_BCC(TopBar,Templates,xTreasurySection+8,1,145,1,36,36,$40A040,$4030C0); 4202 s:=IntToStr(TrueMoney); 4203 LoweredTextOut(TopBar.Canvas,-1,MainTexture,xTreasurySection+48,0,s+'%c'); 4204 if MyRO.Government<>gAnarchy then 4205 begin 4206 ImageOp_BCC(TopBar,Templates,xTreasurySection+48,22,124,1,14,14,$0000C0, $0080C0); 4207 if TaxSum>=0 then 4208 s:=Format(Phrases.Lookup('MONEYGAINPOS'),[TaxSum]) 4209 else s:=Format(Phrases.Lookup('MONEYGAINNEG'),[TaxSum]); 4210 LoweredTextOut(TopBar.Canvas,-1,MainTexture,xTreasurySection+48+15,18,s); 4211 end; 4212 4213 // research section 4214 ImageOp_BCC(TopBar,Templates,xResearchSection+8,1,145,75,36,36,$FF0000,$00FFE0); 4215 if MyData.FarTech<>adNexus then 4216 begin 4217 if MyRO.ResearchTech<0 then 4218 CostFactor:=2 4219 else if (MyRO.ResearchTech=adMilitary) or (MyRO.Tech[MyRO.ResearchTech]=tsSeen) then 4220 CostFactor:=1 4221 else if MyRO.ResearchTech in FutureTech then 4222 if MyRO.Government=gFuture then 4223 CostFactor:=4 4224 else CostFactor:=8 4225 else CostFactor:=2; 4226 Server(sGetTechCost,me,0,i); 4227 CostFactor:=CostFactor*22; // length of progress bar 4228 PaintRelativeProgressBar(TopBar.Canvas,2,xResearchSection+48+1,26, 4229 CostFactor,TrueResearch,ScienceSum,i,true,MainTexture); 4230 4231 if MyRO.ResearchTech<0 then 4232 s:=Phrases.Lookup('SCIENCE') 4233 else if MyRO.ResearchTech=adMilitary then 4234 s:=Phrases.Lookup('INITUNIT') 4235 else 4236 begin 4237 s:=Phrases.Lookup('ADVANCES', MyRO.ResearchTech); 4238 if MyRO.ResearchTech in FutureTech then 4239 if MyRO.Tech[MyRO.ResearchTech]>=1 then 4240 s:=s+' '+IntToStr(MyRO.Tech[MyRO.ResearchTech]+1) 4241 else s:=s+' 1'; 4242 end; 4243 if ScienceSum>0 then 4244 begin 4245 { j:=(i-MyRO.Research-1) div ScienceSum +1; 4246 if j<1 then j:=1; 4247 if j>1 then 4248 s:=Format(Phrases.Lookup('TECHWAIT'),[s,j]);} 4249 LoweredTextOut(TopBar.Canvas,-1,MainTexture,xResearchSection+48,0,s); 4250 end 4251 else LoweredTextOut(TopBar.Canvas,-1,MainTexture,xResearchSection+48,0,s); 4252 end 4253 else CostFactor:=0; 4254 if (MyData.FarTech<>adNexus) and (ScienceSum>0) then 4255 begin 4256 ImageOp_BCC(TopBar,Templates,xResearchSection+48+CostFactor+11,22,124,1,14,14,$0000C0, $0080C0); 4257 s:=Format(Phrases.Lookup('TECHGAIN'),[ScienceSum]); 4258 LoweredTextOut(TopBar.Canvas,-1,MainTexture,xResearchSection+48+CostFactor+26,18,s); 4259 end 4260 end; 4261 if ClientMode<>cEditMap then 4262 begin 4263 TopBar.Canvas.Font.Assign(UniFont[ftCaption]); 4264 s:=TurnToString(MyRO.Turn); 4265 RisedTextOut(TopBar.Canvas,40+(xTreasurySection-40-BiColorTextWidth(TopBar.Canvas,s)) div 2,6,s); 4266 TopBar.Canvas.Font.Assign(UniFont[ftNormal]); 4267 end; 4268 RectInvalidate(0,0,ClientWidth,TopBarHeight); 4269 end;{PanelPaint} 4270 4271 procedure TMainScreen.FocusOnLoc(Loc:integer; Options: integer = 0); 4272 var 4273 dx: integer; 4274 Outside, Changed: boolean; 4275 begin 4276 dx:=G.lx+1-(xw-Loc+G.lx*1024+1) mod G.lx; 4277 Outside:=(dx>=(MapWidth+1) div (xxt*2)-2) 4278 or (ywmax>0) and ((yw>0) and (Loc div G.lx<=yw+1) 4279 or (yw<ywmax) and (Loc div G.lx>=yw+(MapHeight-1) div yyt-2)); 4280 Changed:=true; 4281 if Outside then 4282 begin Centre(Loc); PaintAllMaps end 4283 else if not MapValid then 4284 PaintAllMaps 4285 else Changed:=false; 4286 if Options and flRepaintPanel<>0 then 4287 PanelPaint; 4288 if Changed and (Options and flImmUpdate<>0) then Update; 4289 end; 4290 4291 procedure TMainScreen.NextUnit(NearLoc:integer;AutoTurn:boolean); 4292 var 4293 Dist,TestDist:single; 4294 i,uix,NewFocus:integer; 4295 GotoOnly: boolean; 4296 begin 4297 if ClientMode>=scContact then exit; 4298 DestinationMarkON:=false; 4299 PaintDestination; 4300 for GotoOnly:=GoOnPhase downto false do 4301 begin 4302 NewFocus:=-1; 4303 for i:=1 to MyRO.nUn do 4304 begin 4305 uix:=(UnFocus+i) mod MyRO.nUn; 4306 if (MyUn[uix].Loc>=0) and (MyUn[uix].Job=jNone) 4307 and (MyUn[uix].Status and (usStay or usRecover or usWaiting)=usWaiting) 4308 and (not GotoOnly or (MyUn[uix].Status and usGoto<>0)) then 4309 if NearLoc<0 then begin NewFocus:=uix; Break end 4310 else 4311 begin 4312 TestDist:=Distance(NearLoc,MyUn[uix].Loc); 4313 if (NewFocus<0) or (TestDist<Dist) then 4314 begin NewFocus:=uix; Dist:=TestDist end 4315 end 4316 end; 4317 if GotoOnly then 4318 if NewFocus<0 then GoOnPhase:=false 4319 else break; 4320 end; 4321 if NewFocus>=0 then 4322 begin 4323 SetUnFocus(NewFocus); 4324 SetTroopLoc(MyUn[NewFocus].Loc); 4325 FocusOnLoc(TroopLoc,flRepaintPanel) 4326 end 4327 else if AutoTurn and not mWaitTurn.Checked then 4328 begin 4329 TurnComplete:=true; 4330 SetUnFocus(-1); 4331 SetTroopLoc(-1); 4332 PostMessage(Handle,WM_EOT,0,0) 4333 end 4334 else 4335 begin 4336 if {(UnFocus>=0) and} not TurnComplete and EOT.Visible then Play('TURNEND'); 4337 TurnComplete:=true; 4338 SetUnFocus(-1); 4339 SetTroopLoc(-1); 4340 PanelPaint; 4341 end; 4342 end;{NextUnit} 4343 4344 procedure TMainScreen.Scroll(dx,dy: integer); 4345 begin 4346 xw:=(xw+G.lx+dx) mod G.lx; 4347 if ywmax>0 then 4348 begin 4349 yw:=yw+2*dy; 4350 if yw<0 then yw:=0 4351 else if yw>ywmax then yw:=ywmax; 4352 end; 4353 MainOffscreenPaint; 4354 xwMini:=xw; ywMini:=yw; 4355 MiniPaint; 4356 CopyMiniToPanel; 4357 RectInvalidate(xMini+2,TopBarHeight+MapHeight-overlap+yMini+2,xMini+2+G.lx*2, 4358 TopBarHeight+MapHeight-overlap+yMini+2+G.ly); 4359 Update; 4360 end; 4361 4362 procedure TMainScreen.Timer1Timer(Sender:TObject); 4363 var 4364 dx, dy, speed: integer; 4365 begin 4366 if idle and (me>=0) and (GameMode<>cMovie) then 4367 if (fsModal in Screen.ActiveForm.FormState) 4368 or (Screen.ActiveForm is TBufferedDrawDlg) 4369 and (TBufferedDrawDlg(Screen.ActiveForm).WindowMode<>wmPersistent) then 4370 begin 4371 BlinkTime:=BlinkOnTime+BlinkOffTime-1; 4372 if not BlinkON then 4373 begin 4374 BlinkON:=true; 4375 if UnFocus>=0 then 4376 PaintLocTemp(MyUn[UnFocus].Loc) 4377 else if TurnComplete and not supervising then 4378 EOT.SetButtonIndexFast(eotBlinkOn) 4379 end 4380 end 4381 else 4382 begin 4383 if Application.Active and not mScrollOff.Checked then 4384 begin 4385 if mScrollFast.Checked then Speed:=2 4386 else Speed:=1; 4387 dx:=0; 4388 dy:=0; 4389 if Mouse.CursorPos.y<Screen.Height-PanelHeight then 4390 if Mouse.CursorPos.x=0 then dx:=-Speed // scroll left 4391 else if Mouse.CursorPos.x=Screen.Width-1 then dx:=Speed; // scroll right 4392 if Mouse.CursorPos.y=0 then dy:=-Speed // scroll up 4393 else if (Mouse.CursorPos.y=Screen.Height-1) 4394 and (Mouse.CursorPos.x>=TerrainBtn.Left+TerrainBtn.Width) 4395 and (Mouse.CursorPos.x<xRightPanel+10-8) then dy:=Speed; // scroll down 4396 if (dx<>0) or (dy<>0) then 4397 begin 4398 if (Screen.ActiveForm<>MainScreen) 4399 and (@Screen.ActiveForm.OnDeactivate<>nil) then 4400 Screen.ActiveForm.OnDeactivate(nil); 4401 Scroll(dx,dy); 4402 end 4403 end; 4404 4405 BlinkTime:=(BlinkTime+1) mod (BlinkOnTime+BlinkOffTime); 4406 BlinkON:= BlinkTime>=BlinkOffTime; 4407 DestinationMarkON:=true; 4408 if UnFocus>=0 then 4409 begin 4410 if (BlinkTime=0) or (BlinkTime=BlinkOffTime) then 4411 begin 4412 PaintLocTemp(MyUn[UnFocus].Loc,pltsBlink); 4413 PaintDestination; 4414 // if MoveHintToLoc>=0 then 4415 // ShowMoveHint(MoveHintToLoc, true); 7829 else if Flag = tfAllTechs then 7830 TellNewModels 4416 7831 end 4417 7832 end 4418 else if TurnComplete and not supervising then 4419 begin 4420 if BlinkTime=0 then EOT.SetButtonIndexFast(eotBlinkOff) 4421 else if BlinkTime=BlinkOffTime then EOT.SetButtonIndexFast(eotBlinkOn) 7833 end; 7834 7835 procedure TMainScreen.MapBtnClick(Sender: TObject); 7836 begin 7837 with TButtonC(Sender) do 7838 begin 7839 MapOptionChecked := MapOptionChecked xor (1 shl (Tag shr 8)); 7840 SetMapOptions; 7841 ButtonIndex := MapOptionChecked shr (Tag shr 8) and 1 + 2 7842 end; 7843 if Sender = MapBtn0 then 7844 begin 7845 MiniPaint; 7846 PanelPaint 7847 end // update mini map only 7848 else 7849 begin 7850 MapValid := false; 7851 PaintAllMaps; 7852 end; // update main map 7853 end; 7854 7855 procedure TMainScreen.GrWallBtnDownChanged(Sender: TObject); 7856 begin 7857 if TButtonBase(Sender).Down then 7858 begin 7859 MapOptionChecked := MapOptionChecked or (1 shl moGreatWall); 7860 TButtonBase(Sender).Hint := ''; 4422 7861 end 4423 end 4424 end; 4425 4426 procedure TMainScreen.Centre(Loc:integer); 4427 begin 4428 if FastScrolling and MapValid then update; 4429 // necessary because ScrollDC for form canvas is called after 4430 xw:=(Loc mod G.lx-(MapWidth-xxt*2*((Loc div G.lx) and 1)) div (xxt*4)+G.lx) mod G.lx; 4431 if ywmax<=0 then yw:=ywcenter 4432 else 4433 begin 4434 yw:=(Loc div G.lx-MapHeight div (yyt*2)+1) and not 1; 4435 if yw<0 then yw:=0 4436 else if yw>ywmax then yw:=ywmax; 4437 end 4438 end; 4439 4440 function TMainScreen.ZoomToCity(Loc: integer; NextUnitOnClose: boolean = false; 4441 ShowEvent: integer = 0): boolean; 4442 begin 4443 result:= MyMap[Loc] and (fOwned or fSpiedOut)<>0; 4444 if result then with CityDlg do 4445 begin 4446 if ClientMode>=scContact then 4447 begin 4448 CloseAction:=None; 4449 RestoreUnFocus:=-1; 4450 end 4451 else if NextUnitOnClose then 4452 begin 4453 CloseAction:=StepFocus; 4454 RestoreUnFocus:=-1; 4455 end 4456 else if not Visible then 4457 begin 4458 CloseAction:=RestoreFocus; 4459 RestoreUnFocus:=UnFocus; 4460 end; 4461 SetUnFocus(-1); 4462 SetTroopLoc(Loc); 4463 MarkCityLoc:=Loc; 4464 PanelPaint; 4465 ShowNewContent(wmPersistent, Loc, ShowEvent); 4466 end 4467 end; 4468 4469 function TMainScreen.LocationOfScreenPixel(x,y: integer): integer; 4470 var 4471 qx,qy: integer; 4472 begin 4473 qx:=(x*(yyt*2)+y*(xxt*2)+xxt*yyt*2) div (xxt*yyt*4)-1; 4474 qy:=(y*(xxt*2)-x*(yyt*2)-xxt*yyt*2+4000*xxt*yyt) div (xxt*yyt*4)-999; 4475 result:=(xw+(qx-qy+2048) div 2-1024+G.lx) mod G.lx+G.lx*(yw+qx+qy); 4476 end; 4477 4478 procedure TMainScreen.MapBoxMouseDown(Sender:TObject; 4479 Button:TMouseButton;Shift:TShiftState;x,y:integer); 4480 var 4481 i,uix,emix,p1,dx,dy,MouseLoc:integer; 4482 EditTileData: TEditTileData; 4483 m,m2: TMenuItem; 4484 MoveAdviceData: TMoveAdviceData; 4485 DoCenter: boolean; 4486 begin 4487 if GameMode=cMovie then 4488 exit; 4489 4490 if CityDlg.Visible then CityDlg.Close; 4491 if UnitStatDlg.Visible then UnitStatDlg.Close; 4492 MouseLoc:=LocationOfScreenPixel(x,y); 4493 if (MouseLoc<0) or (MouseLoc>=G.lx*G.ly) then exit; 4494 if (Button=mbLeft) and not(ssShift in Shift) then 4495 begin 4496 DoCenter:=true; 4497 if ClientMode=cEditMap then 4498 begin 4499 DoCenter:=false; 4500 EditTileData.Loc:=MouseLoc; 4501 if ssCtrl in Shift then // toggle special resource 4502 case MyMap[MouseLoc] and fTerrain of 4503 fOcean: EditTileData.NewTile:=MyMap[MouseLoc]; 4504 fGrass, fArctic: EditTileData.NewTile:=MyMap[MouseLoc] and not fSpecial 4505 or ((MyMap[MouseLoc] shr 5 and 3+1) mod 2 shl 5); 4506 else EditTileData.NewTile:=MyMap[MouseLoc] and not fSpecial 4507 or ((MyMap[MouseLoc] shr 5 and 3+1) mod 3 shl 5) 4508 end 4509 else if BrushType<=fTerrain then 4510 EditTileData.NewTile:=MyMap[MouseLoc] and not fTerrain or fSpecial or BrushType 4511 else if BrushType and fDeadLands<>0 then 4512 if MyMap[MouseLoc] and (fDeadLands or fModern) 4513 =BrushType and (fDeadLands or fModern) then 4514 EditTileData.NewTile:=MyMap[MouseLoc] and not (fDeadLands or fModern) 4515 else EditTileData.NewTile:=MyMap[MouseLoc] and not (fDeadLands or fModern) 4516 or BrushType 4517 else if BrushType and fTerImp<>0 then 4518 if MyMap[MouseLoc] and fTerImp=BrushType then 4519 EditTileData.NewTile:=MyMap[MouseLoc] and not fTerImp 4520 else EditTileData.NewTile:=MyMap[MouseLoc] and not fTerImp or BrushType 4521 else if BrushType and (fPrefStartPos or fStartPos)<>0 then 4522 if MyMap[MouseLoc] and (fPrefStartPos or fStartPos) 4523 =BrushType and (fPrefStartPos or fStartPos) then 4524 EditTileData.NewTile:=MyMap[MouseLoc] and not (fPrefStartPos or fStartPos) 4525 else EditTileData.NewTile:=MyMap[MouseLoc] 4526 and not (fPrefStartPos or fStartPos) or BrushType 4527 else EditTileData.NewTile:=MyMap[MouseLoc] xor BrushType; 4528 Server(sEditTile,me,0,EditTileData); 4529 Edited:=true; 4530 BrushLoc:=MouseLoc; 4531 PaintLoc(MouseLoc,2); 4532 MiniPaint; 4533 BitBlt(Panel.Canvas.Handle,xMini+2,yMini+2,G.lx*2,G.ly,Mini.Canvas.Handle, 4534 0,0,SRCCOPY); 4535 if ywmax<=0 then 4536 Frame(Panel.Canvas,xMini+2+G.lx-MapWidth div (2*xxt),yMini+2, 4537 xMini+1+G.lx+MapWidth div (2*xxt), 4538 yMini+2+G.ly-1,MainTexture.clMark,MainTexture.clMark) 4539 else Frame(Panel.Canvas,xMini+2+G.lx-MapWidth div (2*xxt),yMini+2+yw, 4540 xMini+2+G.lx+MapWidth div (2*xxt)-1, 4541 yMini+2+yw+MapHeight div yyt-2,MainTexture.clMark,MainTexture.clMark); 4542 RectInvalidate(xMini+2,TopBarHeight+MapHeight-overlap+yMini+2,xMini+2+G.lx*2, 4543 TopBarHeight+MapHeight-overlap+yMini+2+G.ly) 4544 end 4545 else if MyMap[MouseLoc] and fCity<>0 then {city clicked} 4546 begin 4547 if MyMap[MouseLoc] and (fOwned or fSpiedOut)<>0 then 4548 begin 4549 ZoomToCity(MouseLoc); 4550 DoCenter:=false; 7862 else 7863 begin 7864 MapOptionChecked := MapOptionChecked and not(1 shl moGreatWall); 7865 TButtonBase(Sender).Hint := Phrases.Lookup('CONTROLS', 7866 -1 + TButtonBase(Sender).Tag and $FF); 7867 end; 7868 SetMapOptions; 7869 MapValid := false; 7870 PaintAllMaps; 7871 end; 7872 7873 procedure TMainScreen.BareBtnDownChanged(Sender: TObject); 7874 begin 7875 if TButtonBase(Sender).Down then 7876 begin 7877 MapOptionChecked := MapOptionChecked or (1 shl moBareTerrain); 7878 TButtonBase(Sender).Hint := ''; 4551 7879 end 4552 else 4553 begin 4554 UnitStatDlg.ShowNewContent_EnemyCity(wmPersistent, MouseLoc); 4555 DoCenter:=false; 4556 end 4557 end 4558 else if MyMap[MouseLoc] and fUnit<>0 then {unit clicked} 4559 if MyMap[MouseLoc] and fOwned<>0 then 4560 begin 4561 DoCenter:=false; 4562 if not supervising and (ClientMode<scContact) then 4563 begin // not in negotiation mode 4564 if (UnFocus>=0) and (MyUn[UnFocus].Loc=MouseLoc) then 4565 begin // rotate 4566 uix:=(UnFocus+1) mod MyRO.nUn; 4567 i:=MyRO.nUn-1; 4568 while i>0 do 4569 begin 4570 if (MyUn[uix].Loc=MouseLoc) and (MyUn[uix].Job=jNone) 4571 and (MyUn[uix].Status and (usStay or usRecover or usEnhance or usWaiting)=usWaiting) then 4572 break; 4573 dec(i); 4574 uix:=(uix+1) mod MyRO.nUn; 4575 end; 4576 if i=0 then uix:=UnFocus 4577 end 4578 else Server(sGetDefender,me,MouseLoc,uix); 4579 if uix<>UnFocus then 4580 SetUnFocus(uix); 4581 TurnComplete:=false; 4582 EOT.ButtonIndex:=eotGray; 4583 end; 4584 SetTroopLoc(MouseLoc); 4585 PanelPaint; 4586 end // own unit 4587 else if (MyMap[MouseLoc] and fSpiedOut<>0) and not(ssCtrl in Shift) then 4588 begin 4589 DoCenter:=false; 4590 SetTroopLoc(MouseLoc); 4591 PanelPaint; 4592 end 4593 else 4594 begin 4595 DoCenter:=false; 4596 UnitStatDlg.ShowNewContent_EnemyLoc(wmPersistent, MouseLoc); 7880 else 7881 begin 7882 MapOptionChecked := MapOptionChecked and not(1 shl moBareTerrain); 7883 TButtonBase(Sender).Hint := Phrases.Lookup('CONTROLS', 7884 -1 + TButtonBase(Sender).Tag and $FF); 4597 7885 end; 4598 if DoCenter then begin Centre(MouseLoc); PaintAllMaps end 4599 end 4600 else if (ClientMode<>cEditMap) and (Button=mbRight) and not(ssShift in Shift) then 4601 begin 4602 if supervising then 4603 begin 4604 EditLoc:=MouseLoc; 4605 Server(sGetModels,me,0,nil^); 4606 EmptyMenu(mCreateUnit); 4607 for p1:=0 to nPl-1 do if 1 shl p1 and MyRO.Alive<>0 then 4608 begin 4609 m:=TMenuItem.Create(mCreateUnit); 4610 m.Caption:=Tribe[p1].TPhrase('SHORTNAME'); 4611 for emix:=MyRO.nEnemyModel-1 downto 0 do 4612 if (MyRO.EnemyModel[emix].Owner=p1) and 4613 (Server(sCreateUnit-sExecute+p1 shl 4,me,MyRO.EnemyModel[emix].mix,MouseLoc)>=rExecuted) then 4614 begin 4615 if Tribe[p1].ModelPicture[MyRO.EnemyModel[emix].mix].HGr=0 then 4616 InitEnemyModel(emix); 4617 m2:=TMenuItem.Create(m); 4618 m2.Caption:=Tribe[p1].ModelName[MyRO.EnemyModel[emix].mix]; 4619 m2.Tag:=p1 shl 16 + MyRO.EnemyModel[emix].mix; 4620 m2.OnClick:=CreateUnitClick; 4621 m.Add(m2); 4622 end; 4623 m.Visible:= m.Count>0; 4624 mCreateUnit.Add(m); 4625 end; 4626 if FullScreen then EditPopup.Popup(Left+x, Top+y) 4627 else EditPopup.Popup(Left+x+4, Top+y+GetSystemMetrics(SM_CYCAPTION)+4); 4628 end 4629 else if (UnFocus>=0) and (MyUn[UnFocus].Loc<>MouseLoc) then with MyUn[UnFocus] do 4630 begin 4631 dx:=((MouseLoc mod G.lx *2 +MouseLoc div G.lx and 1) 4632 -(Loc mod G.lx *2 +Loc div G.lx and 1)+3*G.lx) mod (2*G.lx) -G.lx; 4633 dy:=MouseLoc div G.lx-Loc div G.lx; 4634 if abs(dx)+abs(dy)<3 then 7886 SetMapOptions; 7887 MapValid := false; 7888 PaintAllMaps; 7889 end; 7890 7891 procedure TMainScreen.FormKeyUp(Sender: TObject; var Key: word; 7892 Shift: TShiftState); 7893 begin 7894 if idle and (Key = VK_APPS) then 7895 begin 7896 InitPopup(GamePopup); 7897 if FullScreen then 7898 GamePopup.Popup(Left, Top + TopBarHeight - 1) 7899 else 7900 GamePopup.Popup(Left + 4, Top + GetSystemMetrics(SM_CYCAPTION) + 4 + 7901 TopBarHeight - 1); 7902 exit 7903 end // windows menu button calls game menu 7904 end; 7905 7906 procedure TMainScreen.CreateUnitClick(Sender: TObject); 7907 var 7908 p1, mix: integer; 7909 begin 7910 p1 := TComponent(Sender).Tag shr 16; 7911 mix := TComponent(Sender).Tag and $FFFF; 7912 if Server(sCreateUnit + p1 shl 4, me, mix, EditLoc) >= rExecuted then 7913 PaintLoc(EditLoc); 7914 end; 7915 7916 procedure TMainScreen.mSoundOffClick(Sender: TObject); 7917 begin 7918 SoundMode := smOff; 7919 end; 7920 7921 procedure TMainScreen.mSoundOnClick(Sender: TObject); 7922 begin 7923 SoundMode := smOn; 7924 end; 7925 7926 procedure TMainScreen.mSoundOnAltClick(Sender: TObject); 7927 begin 7928 SoundMode := smOnAlt; 7929 end; 7930 7931 { procedure TMainScreen.AdviceBtnClick; 7932 var 7933 OldAdviceLoc: integer; 4635 7934 begin 4636 7935 DestinationMarkON:=false; 4637 7936 PaintDestination; 4638 Status:=Status and ($FFFF-usStay-usRecover-usGoto-usEnhance) or usWaiting; 4639 MoveUnit(dx,dy,muAutoNext) {simple move} 4640 end 4641 else if GetMoveAdvice(UnFocus,MouseLoc,MoveAdviceData)>=rExecuted then 4642 begin 4643 if MyMap[MouseLoc] and (fUnit or fOwned)=fUnit then 4644 begin // check for suicide mission before movement 4645 with MyUn[UnFocus],BattleDlg.Forecast do 4646 begin 4647 pAtt:=me; 4648 mixAtt:=mix; 4649 HealthAtt:=Health; 4650 ExpAtt:=Exp; 4651 FlagsAtt:=Flags; 4652 end; 4653 BattleDlg.Forecast.Movement:=MyUn[UnFocus].Movement; 4654 if (Server(sGetBattleForecastEx,me,MouseLoc,BattleDlg.Forecast)>=rExecuted) 4655 and (BattleDlg.Forecast.EndHealthAtt<=0) then 4656 begin 4657 BattleDlg.uix:=UnFocus; 4658 BattleDlg.ToLoc:=MouseLoc; 4659 BattleDlg.IsSuicideQuery:=true; 4660 BattleDlg.ShowModal; 4661 if BattleDlg.ModalResult<>mrOK then 4662 exit; 4663 end 4664 end; 4665 DestinationMarkON:=false; 4666 PaintDestination; 4667 Status:=Status and not (usStay or usRecover or usEnhance) or usWaiting; 4668 MoveToLoc(MouseLoc,false); {goto} 4669 end 4670 end 4671 end 4672 else if (Button=mbMiddle) and (UnFocus>=0) 4673 and (MyModel[MyUn[UnFocus].mix].Kind in [mkSettler,mkSlaves]) then 4674 begin 4675 DestinationMarkON:=false; 4676 PaintDestination; 4677 MyUn[UnFocus].Status:=MyUn[UnFocus].Status and ($FFFF-usStay-usRecover-usGoto) or usEnhance; 4678 uix:=UnFocus; 4679 if MouseLoc<>MyUn[uix].Loc then MoveToLoc(MouseLoc,true); {goto} 4680 if (UnFocus=uix) and (MyUn[uix].Loc=MouseLoc) then MenuClick(mEnhance) 4681 end 4682 else if (Button=mbLeft) and (ssShift in Shift) 4683 and (MyMap[MouseLoc] and fTerrain<>fUNKNOWN) then 4684 HelpOnTerrain(MouseLoc, wmPersistent) 4685 else if (ClientMode<=cContinue) and (Button=mbRight) and (ssShift in Shift) 4686 and (UnFocus>=0) and (MyMap[MouseLoc] and (fUnit or fOwned)=fUnit) then 4687 begin // battle forecast 4688 with MyUn[UnFocus],BattleDlg.Forecast do 4689 begin 4690 pAtt:=me; 4691 mixAtt:=mix; 4692 HealthAtt:=Health; 4693 ExpAtt:=Exp; 4694 FlagsAtt:=Flags; 4695 end; 4696 BattleDlg.Forecast.Movement:=MyUn[UnFocus].Movement; 4697 if Server(sGetBattleForecastEx,me,MouseLoc,BattleDlg.Forecast)>=rExecuted then 4698 begin 4699 BattleDlg.uix:=UnFocus; 4700 BattleDlg.ToLoc:=MouseLoc; 4701 BattleDlg.Left:=x-BattleDlg.Width div 2; 4702 if BattleDlg.Left<0 then 4703 BattleDlg.Left:=0 4704 else if BattleDlg.Left+BattleDlg.Width>Screen.Width then 4705 BattleDlg.Left:=Screen.Width-BattleDlg.Width; 4706 BattleDlg.Top:=y-BattleDlg.Height div 2; 4707 if BattleDlg.Top<0 then 4708 BattleDlg.Top:=0 4709 else if BattleDlg.Top+BattleDlg.Height>Screen.Height then 4710 BattleDlg.Top:=Screen.Height-BattleDlg.Height; 4711 BattleDlg.IsSuicideQuery:=false; 4712 BattleDlg.Show; 4713 end 4714 end 4715 end; 4716 4717 function TMainScreen.MoveUnit(dx,dy:integer; Options: integer): integer; 4718 // move focused unit to adjacent tile 4719 var 4720 i,cix,uix,euix,FromLoc,ToLoc,DirCode,UnFocus0,Defender,Mission,p1, 4721 NewTiles,cixChanged: integer; 4722 OldToTile: cardinal; 4723 CityCaptured, IsAttack, OldUnrest, NewUnrest, NeedEcoUpdate, NeedRepaintPanel, 4724 ToTransport, ToShip: boolean; 4725 PlaneReturnData: TPlaneReturnData; 4726 QueryItem: string; 4727 begin 4728 result:=eInvalid; 4729 UnFocus0:=UnFocus; 4730 FromLoc:=MyUn[UnFocus].Loc; 4731 ToLoc:=dLoc(FromLoc,dx,dy); 4732 if (ToLoc<0) or (ToLoc>=G.lx*G.ly) then begin result:=eInvalid; exit; end; 4733 if MyMap[ToLoc] and fStealthUnit<>0 then 4734 begin 4735 SoundMessage(Phrases.LookUp('ATTACKSTEALTH'),''); 4736 exit; 4737 end; 4738 if MyMap[ToLoc] and fHiddenUnit<>0 then 4739 begin 4740 SoundMessage(Phrases.LookUp('ATTACKSUB'),''); 4741 exit; 4742 end; 4743 4744 if MyMap[ToLoc] and (fUnit or fOwned)=fUnit then 4745 begin // attack -- search enemy unit 4746 if (MyModel[MyUn[UnFocus].mix].Attack=0) 4747 and not ((MyModel[MyUn[UnFocus].mix].Cap[mcBombs]>0) 4748 and (MyUn[UnFocus].Flags and unBombsLoaded<>0)) then 4749 begin 4750 SoundMessage(Phrases.LookUp('NOATTACKER'),''); 4751 exit; 4752 end; 4753 euix:=MyRO.nEnemyUn-1; 4754 while (euix>=0) and (MyRO.EnemyUn[euix].Loc<>ToLoc) do dec(euix); 4755 end; 4756 4757 DirCode:=dx and 7 shl 4+dy and 7 shl 7; 4758 result:=Server(sMoveUnit-sExecute+DirCode,me,UnFocus,nil^); 4759 if (result<rExecuted) and (MyUn[UnFocus].Job>jNone) then 4760 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 4761 if (result<rExecuted) and (result<>eNoTime_Move) then 4762 begin 4763 case result of 4764 eNoTime_Load: 4765 if MyModel[MyUn[UnFocus].mix].Domain=dAir then 4766 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'),'NOMOVE_TIME') 4767 else 4768 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 4769 [MovementToString(MyModel[MyUn[UnFocus].mix].Speed)]),'NOMOVE_TIME'); 4770 eNoTime_Bombard: SoundMessage(Phrases.Lookup('NOTIMEBOMBARD'),'NOMOVE_TIME'); 4771 eNoTime_Expel: SoundMessage(Phrases.Lookup('NOTIMEEXPEL'),'NOMOVE_TIME'); 4772 eNoRoad: SoundMessage(Phrases.Lookup('NOROAD'),'NOMOVE_DEFAULT'); 4773 eNoNav: SoundMessage(Phrases.Lookup('NONAV'),'NOMOVE_DEFAULT'); 4774 eNoCapturer: SoundMessage(Phrases.Lookup('NOCAPTURER'),'NOMOVE_DEFAULT'); 4775 eNoBombarder: SoundMessage(Phrases.Lookup('NOBOMBARDER'),'NOMOVE_DEFAULT'); 4776 eZOC: ContextMessage(Phrases.Lookup('ZOC'), 'NOMOVE_ZOC', hkText, HelpDlg.TextIndex('MOVEMENT')); 4777 eTreaty: 4778 if MyMap[ToLoc] and (fUnit or fOwned)<>fUnit then {no enemy unit -- move} 4779 SoundMessage(Tribe[MyRO.Territory[ToLoc]].TPhrase('PEACE_NOMOVE'), 4780 'NOMOVE_TREATY') 4781 else SoundMessage(Tribe[MyRO.EnemyUn[euix].Owner].TPhrase 4782 ('PEACE_NOATTACK'),'NOMOVE_TREATY'); 4783 eDomainMismatch: 4784 begin 4785 if (MyModel[MyUn[UnFocus].mix].Domain<dSea) 4786 and (MyMap[ToLoc] and (fUnit or fOwned)=fUnit or fOwned) then 4787 begin // false load attempt 4788 ToShip:=false; 4789 ToTransport:=false; 4790 for uix:=0 to MyRo.nUn-1 do 4791 if (MyUn[uix].Loc=ToLoc) and (MyModel[MyUn[uix].mix].Domain=dSea) then 4792 begin 4793 ToShip:=true; 4794 if MyModel[MyUn[uix].mix].Cap[mcSeaTrans]>0 then 4795 ToTransport:=true; 4796 end; 4797 if ToTransport then 4798 SoundMessage(Phrases.Lookup('FULLTRANSPORT'),'NOMOVE_DEFAULT') 4799 else if ToShip then 4800 SoundMessage(Phrases.Lookup('NOTRANSPORT'),'NOMOVE_DEFAULT') 4801 else Play('NOMOVE_DOMAIN'); 4802 end 4803 else Play('NOMOVE_DOMAIN'); 4804 end 4805 else Play('NOMOVE_DEFAULT'); 4806 end; 4807 exit; 4808 end; 4809 4810 if ((result=eWon) or (result=eLost) or (result=eBloody)) 4811 and (MyUn[UnFocus].Movement<100) 4812 and (MyModel[MyUn[UnFocus].mix].Cap[mcWill]=0) then 4813 begin 4814 if SimpleQuery(mkYesNo,Format(Phrases.Lookup('FASTATTACK'), 4815 [MyUn[UnFocus].Movement]),'NOMOVE_TIME')<>mrOk then 4816 begin result:=eInvalid; exit; end; 4817 Update; // remove message box from screen 4818 end; 4819 4820 OldUnrest:=false; 4821 NewUnrest:=false; 4822 if (result>=rExecuted) and (result and rUnitRemoved=0) 4823 and (MyMap[ToLoc] and (fUnit or fOwned)<>fUnit) then 4824 begin 4825 OldUnrest:=UnrestAtLoc(UnFocus,FromLoc); 4826 NewUnrest:=UnrestAtLoc(UnFocus,ToLoc); 4827 if NewUnrest>OldUnrest then 4828 begin 4829 if MyRO.Government=gDemocracy then 4830 begin 4831 QueryItem:='UNREST_NOTOWN'; 4832 p1:=me; 4833 end 4834 else 4835 begin 4836 QueryItem:='UNREST_FOREIGN'; 4837 p1:=MyRO.Territory[ToLoc]; 7937 AdvisorDlg.GiveStrategyAdvice; 7938 OldAdviceLoc:=MainMap.AdviceLoc; 7939 MainMap.AdviceLoc:=-1; 7940 PaintLoc(OldAdviceLoc); 7941 end; } 7942 7943 { procedure TMainScreen.SetAdviceLoc(Loc: integer; AvoidRect: TRect); 7944 var 7945 OldAdviceLoc,x,y: integer; 7946 begin 7947 if Loc<>MainMap.AdviceLoc then 7948 begin 7949 if Loc>=0 then 7950 begin // center 7951 y:=Loc div G.lx; 7952 x:=(Loc+G.lx - AvoidRect.Right div (2*66)) mod G.lx; 7953 Centre(y*G.lx+x); 7954 PaintAllMaps; 4838 7955 end; 4839 with MessgExDlg do 4840 begin 4841 MessgText:=Format(Tribe[p1].TPhrase(QueryItem),[Phrases.Lookup('GOVERNMENT',MyRO.Government)]); 4842 Kind:=mkYesNo; 4843 IconKind:=mikImp; 4844 IconIndex:=imPalace; 4845 ShowModal; 4846 if ModalResult<>mrOk then 4847 begin result:=eInvalid; exit; end; 7956 OldAdviceLoc:=MainMap.AdviceLoc; 7957 MainMap.AdviceLoc:=Loc; 7958 PaintLoc(OldAdviceLoc); 7959 PaintLoc(MainMap.AdviceLoc); 4848 7960 end; 4849 Update; // remove message box from screen 4850 end 4851 end; 4852 4853 if (result>=rExecuted) 4854 and (MyModel[MyUn[UnFocus].mix].Domain=dAir) 4855 and (MyUn[UnFocus].Status and usToldNoReturn=0) then 4856 begin // can plane return? 4857 PlaneReturnData.Fuel:=MyUn[UnFocus].Fuel; 4858 if (MyMap[ToLoc] and (fUnit or fOwned)=fUnit) 4859 or (MyMap[ToLoc] and (fCity or fOwned)=fCity) then 4860 begin // attack/expel/bombard -> 100MP 4861 PlaneReturnData.Loc:=FromLoc; 4862 PlaneReturnData.Movement:=MyUn[UnFocus].Movement-100; 4863 if PlaneReturnData.Movement<0 then PlaneReturnData.Movement:=0; 4864 end 4865 else // move 4866 begin 4867 PlaneReturnData.Loc:=ToLoc; 4868 if dx and 1<>0 then PlaneReturnData.Movement:=MyUn[UnFocus].Movement-100 4869 else PlaneReturnData.Movement:=MyUn[UnFocus].Movement-150; 4870 end; 4871 if Server(sGetPlaneReturn, me, UnFocus, PlaneReturnData)=eNoWay then 4872 begin 4873 if MyModel[MyUn[UnFocus].mix].Kind=mkSpecial_Glider then 4874 QueryItem:='LOWFUEL_GLIDER' 4875 else QueryItem:='LOWFUEL'; 4876 if SimpleQuery(mkYesNo,Phrases.Lookup(QueryItem),'WARNING_LOWSUPPORT')<>mrOk then 4877 begin result:=eInvalid; exit; end; 4878 Update; // remove message box from screen 4879 MyUn[UnFocus].Status:=MyUn[UnFocus].Status or usToldNoReturn; 4880 end 4881 end; 4882 4883 if result=eMissionDone then 4884 begin 4885 ModalSelectDlg.ShowNewContent(wmModal,kMission); 4886 Update; // dialog still on screen 4887 Mission:=ModalSelectDlg.result; 4888 if Mission<0 then exit; 4889 Server(sSetSpyMission+Mission shl 4, me, 0, nil^); 4890 end; 4891 4892 CityCaptured:=false; 4893 if result=eNoTime_Move then Play('NOMOVE_TIME') 4894 else 4895 begin 4896 NeedEcoUpdate:=false; 4897 DestinationMarkON:=false; 4898 PaintDestination; 4899 if result and rUnitRemoved<>0 then 4900 CityOptimizer_BeforeRemoveUnit(UnFocus); 4901 IsAttack:= (result=eBombarded) 4902 or (result<>eMissionDone) and (MyMap[ToLoc] and (fUnit or fOwned)=fUnit); 4903 if not IsAttack then 4904 begin // move 4905 cix:=MyRO.nCity-1; {look for own city at dest location} 4906 while (cix>=0) and (MyCity[cix].Loc<>ToLoc) do dec(cix); 4907 if (result<>eMissionDone) and (MyMap[ToLoc] and fCity<>0) and (cix<0) then 4908 CityCaptured:=true; 4909 result:=Server(sMoveUnit+DirCode,me,UnFocus,nil^); 4910 case result of 4911 eHiddenUnit: 4912 begin Play('NOMOVE_SUBMARINE'); PaintLoc(ToLoc) end; 4913 eStealthUnit: 4914 begin Play('NOMOVE_STEALTH'); PaintLoc(ToLoc) end; 4915 eZOC_EnemySpotted: 4916 begin Play('NOMOVE_ZOC'); PaintLoc(ToLoc,1) end; 4917 rExecuted..maxint: 4918 begin 4919 if result and rUnitRemoved<>0 then UnFocus:=-1 // unit died 4920 else 4921 begin 4922 assert(UnFocus>=0); 4923 MyUn[UnFocus].Status:=MyUn[UnFocus].Status and not (usStay or usRecover); 4924 for uix:=0 to MyRO.nUn-1 do if MyUn[uix].Master=UnFocus then 4925 MyUn[uix].Status:=MyUn[uix].Status and not usWaiting; 4926 if CityCaptured 4927 and (MyRO.Government in [gRepublic,gDemocracy,gFuture]) then 4928 begin // borders have moved, unrest might have changed in any city 4929 CityOptimizer_BeginOfTurn; 4930 NeedEcoUpdate:=true; 4931 end 4932 else 4933 begin 4934 if OldUnrest<>NewUnrest then 4935 begin 4936 CityOptimizer_CityChange(MyUn[UnFocus].Home); 4937 for uix:=0 to MyRO.nUn-1 do if MyUn[uix].Master=UnFocus then 4938 CityOptimizer_CityChange(MyUn[uix].Home); 4939 NeedEcoUpdate:=true; 4940 end; 4941 if (MyRO.Government=gDespotism) 4942 and (MyModel[MyUn[UnFocus].mix].Kind=mkSpecial_TownGuard) then 4943 begin 4944 if MyMap[FromLoc] and fCity<>0 then 4945 begin // town guard moved out of city in despotism -- reoptimize! 4946 cixChanged:=MyRO.nCity-1; 4947 while (cixChanged>=0) and (MyCity[cixChanged].Loc<>FromLoc) do 4948 dec(cixChanged); 4949 assert(cixChanged>=0); 4950 if cixChanged>=0 then 4951 begin 4952 CityOptimizer_CityChange(cixChanged); 4953 NeedEcoUpdate:=true; 4954 end; 4955 end; 4956 if (MyMap[ToLoc] and fCity<>0) and not CityCaptured then 4957 begin // town guard moved into city in despotism -- reoptimize! 4958 cixChanged:=MyRO.nCity-1; 4959 while (cixChanged>=0) and (MyCity[cixChanged].Loc<>ToLoc) do 4960 dec(cixChanged); 4961 assert(cixChanged>=0); 4962 if cixChanged>=0 then 4963 begin 4964 CityOptimizer_CityChange(cixChanged); 4965 NeedEcoUpdate:=true; 4966 end 4967 end 4968 end 4969 end 4970 end; 4971 end; 4972 else 4973 assert(false); 4974 end; 4975 SetTroopLoc(ToLoc); 4976 end 4977 else 4978 begin {enemy unit -- attack} 4979 if result=eBombarded then Defender:=MyRO.Territory[ToLoc] 4980 else Defender:=MyRO.EnemyUn[euix].Owner; 4981 {if MyRO.Treaty[Defender]=trCeaseFire then 4982 if SimpleQuery(mkYesNo,Phrases.Lookup('FRCANCELQUERY_CEASEFIRE'), 4983 'MSG_DEFAULT')<>mrOK then 4984 exit;} 4985 if (Options and muNoSuicideCheck=0) 4986 and (result and rUnitRemoved<>0) and (result<>eMissionDone) then 4987 begin // suicide query 4988 with MyUn[UnFocus],BattleDlg.Forecast do 4989 begin 4990 pAtt:=me; 4991 mixAtt:=mix; 4992 HealthAtt:=Health; 4993 ExpAtt:=Exp; 4994 FlagsAtt:=Flags; 4995 end; 4996 BattleDlg.Forecast.Movement:=MyUn[UnFocus].Movement; 4997 Server(sGetBattleForecastEx,me,ToLoc,BattleDlg.Forecast); 4998 BattleDlg.uix:=UnFocus; 4999 BattleDlg.ToLoc:=ToLoc; 5000 BattleDlg.IsSuicideQuery:=true; 5001 BattleDlg.ShowModal; 5002 if BattleDlg.ModalResult<>mrOK then 5003 exit; 5004 end; 5005 5006 cixChanged:=-1; 5007 if (result and rUnitRemoved<>0) and (MyRO.Government=gDespotism) 5008 and (MyModel[MyUn[UnFocus].mix].Kind=mkSpecial_TownGuard) 5009 and (MyMap[FromLoc] and fCity<>0) then 5010 begin // town guard died in city in despotism -- reoptimize! 5011 cixChanged:=MyRO.nCity-1; 5012 while (cixChanged>=0) and (MyCity[cixChanged].Loc<>FromLoc) do 5013 dec(cixChanged); 5014 assert(cixChanged>=0); 5015 end; 5016 5017 for i:=0 to MyRO.nEnemyModel-1 do 5018 LostArmy[i]:=MyRO.EnemyModel[i].Lost; 5019 OldToTile:=MyMap[ToLoc]; 5020 result:=Server(sMoveUnit+DirCode,me,UnFocus,nil^); 5021 nLostArmy:=0; 5022 for i:=0 to MyRO.nEnemyModel-1 do 5023 begin 5024 LostArmy[i]:=MyRO.EnemyModel[i].Lost-LostArmy[i]; 5025 inc(nLostArmy,LostArmy[i]) 5026 end; 5027 if result and rUnitRemoved<>0 then 5028 begin 5029 UnFocus:=-1; 5030 SetTroopLoc(FromLoc); 5031 end; 5032 if (OldToTile and not MyMap[ToLoc] and fCity<>0) 5033 and (MyRO.Government in [gRepublic,gDemocracy,gFuture]) then 5034 begin // city was destroyed, borders have moved, unrest might have changed in any city 5035 CityOptimizer_BeginOfTurn; 5036 NeedEcoUpdate:=true; 5037 end 5038 else 5039 begin 5040 if cixChanged>=0 then 5041 begin 5042 CityOptimizer_CityChange(cixChanged); 5043 NeedEcoUpdate:=true; 5044 end; 5045 if (result=eWon) or (result=eBloody) or (result=eExpelled) then 5046 begin 5047 CityOptimizer_TileBecomesAvailable(ToLoc); 5048 NeedEcoUpdate:=true; 5049 end; 5050 end; 5051 if nLostArmy>1 then 5052 begin 5053 with MessgExDlg do 5054 begin 5055 Kind:=mkOk; 5056 IconKind:=mikEnemyArmy; 5057 MessgText:=Tribe[Defender].TString(Phrases.Lookup('ARMYLOST', 5058 MyRO.EnemyModel[MyRO.EnemyUn[euix].emix].Domain)); 5059 ShowModal; 5060 end 5061 end 5062 end; 5063 if result and rUnitRemoved<>0 then 5064 begin 5065 CityOptimizer_AfterRemoveUnit; 5066 ListDlg.RemoveUnit; 5067 NeedEcoUpdate:=true; 5068 end; 5069 if NeedEcoUpdate then 5070 begin 5071 UpdateViews(true); 5072 Update 5073 end 5074 end; 5075 5076 if result=eMissionDone then 5077 begin 5078 p1:=MyRO.Territory[ToLoc]; 5079 case Mission of 5080 smStealMap: 5081 begin MapValid:=false; PaintAllMaps end; 5082 smStealCivilReport: 5083 TribeMessage(p1,Tribe[p1].TPhrase('DOSSIER_PREPARED'),''); 5084 smStealMilReport: 5085 ListDlg.ShowNewContent_MilReport(wmPersistent,p1); 5086 end; 5087 end; 5088 5089 if UnFocus>=0 then 5090 CheckToldNoReturn(UnFocus); 5091 5092 NeedRepaintPanel:=false; 5093 if result>=rExecuted then 5094 begin 5095 if CityCaptured and (MyMap[ToLoc] and fCity=0) then 5096 begin // city destroyed 5097 for i:=0 to 27 do {tell about destroyed wonders} 5098 if (MyRO.Wonder[i].CityID=-2) and (MyData.ToldWonders[i].CityID<>-2) then 5099 with MessgExDlg do 5100 begin 5101 if WondersDlg.Visible then 5102 WondersDlg.SmartUpdateContent(false); 5103 OpenSound:='WONDER_DESTROYED'; 5104 MessgText:=Format(Phrases.Lookup('WONDERDEST'), 5105 [Phrases.Lookup('IMPROVEMENTS',i)]); 5106 Kind:=mkOkHelp; 5107 HelpKind:=hkImp; 5108 HelpNo:=i; 5109 IconKind:=mikImp; 5110 IconIndex:=i; 5111 ShowModal; 5112 MyData.ToldWonders[i]:=MyRO.Wonder[i]; 5113 end 5114 end; 5115 if CityCaptured and (MyMap[ToLoc] and fCity<>0) then 5116 begin // city captured 5117 ListDlg.AddCity; 5118 for i:=0 to 27 do {tell about capture of wonders} 5119 if MyRO.City[MyRO.nCity-1].Built[i]>0 then with MessgExDlg do 5120 begin 5121 if WondersDlg.Visible then 5122 WondersDlg.SmartUpdateContent(false); 5123 OpenSound:='WONDER_CAPTURED'; 5124 MessgText:=Format(Tribe[me].TPhrase('WONDERCAPTOWN'), 5125 [Phrases.Lookup('IMPROVEMENTS',i)]); 5126 Kind:=mkOkHelp; 5127 HelpKind:=hkImp; 5128 HelpNo:=i; 5129 IconKind:=mikImp; 5130 IconIndex:=i; 5131 ShowModal; 5132 MyData.ToldWonders[i]:=MyRO.Wonder[i]; 5133 end; 5134 5135 if MyRO.Happened and phStealTech<>0 then 5136 begin {Temple of Zeus -- choose advance to steal} 5137 ModalSelectDlg.ShowNewContent(wmModal,kStealTech); 5138 Server(sStealTech,me,ModalSelectDlg.result,nil^); 5139 end; 5140 TellNewModels; 5141 5142 cix:=MyRO.nCity-1; 5143 while (cix>=0) and (MyCity[cix].Loc<>ToLoc) do 5144 dec(cix); 5145 assert(cix>=0); 5146 MyCity[cix].Status:=MyCity[cix].Status 5147 and not csResourceWeightsMask or (3 shl 4); // captured city, set to maximum growth 5148 NewTiles:=1 shl 13; {exploit central tile only} 5149 Server(sSetCityTiles,me,cix,NewTiles); 5150 end 5151 else NeedRepaintPanel:=true; 5152 end; 5153 TellNewContacts; 5154 5155 if (UnFocus>=0) and (MyUn[UnFocus].Master>=0) then 5156 with MyUn[MyUn[UnFocus].Master] do 5157 if Status and usStay<>0 then 5158 begin 5159 Status:=Status and not usStay; 5160 if (Movement>=100) and (Status and (usRecover or usGoto)=0) then 5161 Status:=Status or usWaiting; 5162 end; 5163 if Options and (muAutoNoWait or muAutoNext)<>0 then 5164 begin 5165 if (UnFocus>=0) and ((result=eNoTime_Move) or UnitExhausted(UnFocus) 5166 or (MyUn[UnFocus].Master>=0) 5167 or (MyModel[MyUn[UnFocus].mix].Domain=dAir) 5168 and ((MyMap[MyUn[UnFocus].Loc] and fCity<>0) {aircrafts stop in cities} 5169 or (MyMap[MyUn[UnFocus].Loc] and fTerImp=tiBase))) then 5170 begin 5171 MyUn[UnFocus].Status:=MyUn[UnFocus].Status and not usWaiting; 5172 if Options and muAutoNext<>0 then 5173 if CityCaptured and (MyMap[ToLoc] and fCity<>0) then 5174 begin 5175 UnFocus:=-1; 5176 PaintLoc(ToLoc); // don't show unit in city if not selected 5177 end 5178 else NextUnit(UnStartLoc,true) 5179 end 5180 else if (UnFocus<0) and (Options and muAutoNext<>0) then 5181 NextUnit(UnStartLoc,result<>eMissionDone); 5182 end; 5183 5184 if NeedRepaintPanel and (UnFocus=UnFocus0) then 5185 if IsAttack then PanelPaint 5186 else 5187 begin 5188 assert(result<>eMissionDone); 5189 CheckTerrainBtnVisible; 5190 FocusOnLoc(ToLoc,flRepaintPanel or flImmUpdate) 5191 end; 5192 5193 if (result>=rExecuted) and CityCaptured and (MyMap[ToLoc] and fCity<>0) then 5194 ZoomToCity(ToLoc,UnFocus<0,chCaptured); // show captured city 5195 end; // moveunit 5196 5197 procedure TMainScreen.MoveOnScreen(ShowMove: TShowMove; Step0,Step1,nStep: integer; 5198 Restore: boolean = true); 5199 var 5200 ToLoc,xFromLoc,yFromLoc,xToLoc,yToLoc,xFrom,yFrom,xTo,yTo,xMin,yMin,xRange,yRange, 5201 xw1,Step,xMoving,yMoving,yl,SliceCount:integer; 5202 UnitInfo: TUnitInfo; 5203 Ticks0,Ticks: int64; 5204 begin 5205 Timer1.Enabled:=false; 5206 QueryPerformanceCounter(Ticks0); 5207 with ShowMove do 5208 begin 5209 UnitInfo.Owner:=Owner; 5210 UnitInfo.mix:=mix; 5211 UnitInfo.Health:=Health; 5212 UnitInfo.Job:=jNone; 5213 UnitInfo.Flags:=Flags; 5214 if Owner<>me then 5215 UnitInfo.emix:=emix; 5216 5217 ToLoc:=dLoc(FromLoc,dx,dy); 5218 xToLoc:=ToLoc mod G.lx; yToLoc:=ToLoc div G.lx; 5219 xFromLoc:=FromLoc mod G.lx; yFromLoc:=FromLoc div G.lx; 5220 if xToLoc>xFromLoc+2 then xToLoc:=xToLoc-G.lx 5221 else if xToLoc<xFromLoc-2 then xToLoc:=xToLoc+G.lx; 5222 5223 xw1:=xw+G.lx; 5224 // ((xFromLoc-xw1)*2+yFromLoc and 1+1)*xxt+dx*xxt/2-MapWidth/2 -> min 5225 while abs(((xFromLoc-xw1+G.lx)*2+yFromLoc and 1+1)*xxt*2+dx*xxt-MapWidth) 5226 <abs(((xFromLoc-xw1)*2+yFromLoc and 1+1)*xxt*2+dx*xxt-MapWidth) do 5227 dec(xw1,G.lx); 5228 5229 xTo:=(xToLoc-xw1)*(xxt*2) + yToLoc and 1 *xxt +(xxt-xxu); 5230 yTo:=(yToLoc-yw)*yyt +(yyt-yyu_anchor); 5231 xFrom:=(xFromLoc-xw1)*(xxt*2) + yFromLoc and 1 *xxt +(xxt-xxu); 5232 yFrom:=(yFromLoc-yw)*yyt +(yyt-yyu_anchor); 5233 if xFrom<xTo then begin xMin:=xFrom;xRange:=xTo-xFrom end 5234 else begin xMin:=xTo;xRange:=xFrom-xTo end; 5235 if yFrom<yTo then begin yMin:=yFrom;yRange:=yTo-yFrom end 5236 else begin yMin:=yTo;yRange:=yFrom-yTo end; 5237 inc(xRange,xxt*2); 5238 inc(yRange,yyt*3); 5239 5240 MainOffscreenPaint; 5241 NoMap.SetOutput(Buffer); 5242 NoMap.SetPaintBounds(0,0,xRange,yRange); 5243 for Step:=0 to abs(Step1-Step0) do 5244 begin 5245 BitBlt(Buffer.Canvas.Handle,0,0,xRange,yRange, 5246 offscreen.Canvas.Handle,xMin,yMin,SRCCOPY); 5247 if Step1<>Step0 then 5248 begin 5249 xMoving:=xFrom+Round((Step0+Step*(Step1-Step0) div abs(Step1-Step0)) 5250 *(xTo-xFrom)/nStep); 5251 yMoving:=yFrom+Round((Step0+Step*(Step1-Step0) div abs(Step1-Step0)) 5252 *(yTo-yFrom)/nStep); 5253 end 5254 else begin xMoving:=xFrom; yMoving:=yFrom; end; 5255 NoMap.PaintUnit(xMoving-xMin,yMoving-yMin,UnitInfo,0); 5256 PaintBufferToScreen(xMin,yMin,xRange,yRange); 5257 5258 SliceCount:=0; 5259 Ticks:=Ticks0; 5260 repeat 5261 if (SliceCount=0) or ((Ticks-Ticks0)*12000 *(SliceCount+1) 5262 div SliceCount<MoveTime*PerfFreq) then 5263 begin 5264 if not idle or (GameMode=cMovie) then 5265 Application.ProcessMessages; 5266 Sleep(1); 5267 inc(SliceCount) 5268 end; 5269 QueryPerformanceCounter(Ticks); 5270 until (Ticks-Ticks0)*12000>=MoveTime*PerfFreq; 5271 Ticks0:=Ticks 5272 end; 5273 end; 5274 if Restore then 5275 begin 5276 BitBlt(Buffer.Canvas.Handle,0,0,xRange,yRange,offscreen.Canvas.Handle,xMin, 5277 yMin,SRCCOPY); 5278 PaintBufferToScreen(xMin,yMin,xRange,yRange); 5279 end; 5280 BlinkTime:=-1; 5281 Timer1.Enabled:=true; 5282 end; 5283 5284 procedure TMainScreen.MoveToLoc(Loc: integer; CheckSuicide: boolean); 5285 // path finder: move focused unit to loc, start multi-turn goto if too far 5286 var 5287 uix,i,MoveOptions,NextLoc,MoveResult: integer; 5288 MoveAdviceData: TMoveAdviceData; 5289 StopReason: (None, Arrived, Dead, NoTime, EnemySpotted, MoveError); 5290 begin 5291 if MyUn[UnFocus].Job>jNone then 5292 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 5293 if GetMoveAdvice(UnFocus,Loc,MoveAdviceData)>=rExecuted then 5294 begin 5295 uix:=UnFocus; 5296 StopReason:=None; 5297 repeat 5298 for i:=0 to MoveAdviceData.nStep-1 do 5299 begin 5300 if i=MoveAdviceData.nStep-1 then MoveOptions:=muAutoNext 5301 else MoveOptions:=0; 5302 NextLoc:=dLoc(MyUn[uix].Loc,MoveAdviceData.dx[i],MoveAdviceData.dy[i]); 5303 if (NextLoc=Loc) 5304 or (Loc=maNextCity) and (MyMap[NextLoc] and fCity<>0) then 5305 StopReason:=Arrived; 5306 if not CheckSuicide and (NextLoc=Loc) then 5307 MoveOptions:=MoveOptions or muNoSuicideCheck; 5308 MoveResult:=MoveUnit(MoveAdviceData.dx[i],MoveAdviceData.dy[i],MoveOptions); 5309 if MoveResult<rExecuted then StopReason:=MoveError 5310 else if MoveResult and rUnitRemoved<>0 then StopReason:=Dead 5311 else if (StopReason=None) and (MoveResult and rEnemySpotted<>0) then 5312 StopReason:=EnemySpotted; 5313 if StopReason<>None then break; 5314 end; 5315 if (StopReason=None) and ((MoveAdviceData.nStep<25) 5316 or (MyRO.Wonder[woShinkansen].EffectiveOwner<>me)) then 5317 StopReason:=NoTime; 5318 if StopReason<>None then break; 5319 if GetMoveAdvice(UnFocus,Loc,MoveAdviceData)<rExecuted then 5320 begin assert(false); break end 5321 until false; 5322 5323 case StopReason of 5324 None: assert(false); 5325 Arrived: MyUn[uix].Status:=MyUn[uix].Status and ($FFFF-usGoto); 5326 Dead: if UnFocus<0 then NextUnit(UnStartLoc,false); 5327 else 5328 begin // multi-turn goto 5329 if Loc=maNextCity then 5330 MyUn[uix].Status:=MyUn[uix].Status and ($FFFF-usStay-usRecover) or usGoto +$7FFF shl 16 5331 else MyUn[uix].Status:=MyUn[uix].Status and ($FFFF-usStay-usRecover) or usGoto +Loc shl 16; 5332 PaintLoc(MyUn[uix].Loc); 5333 if (StopReason=NoTime) and (UnFocus=uix) then 5334 begin 5335 MyUn[uix].Status:=MyUn[uix].Status and not usWaiting; 5336 NextUnit(UnStartLoc,true) 5337 end; 5338 end 5339 end 5340 end 5341 end; 5342 5343 procedure TMainScreen.PanelBoxMouseDown(Sender:TObject; 5344 Button:TMouseButton;Shift:TShiftState;x,y:integer); 5345 var 5346 i,xMouse,MouseLoc,p1: integer; 5347 begin 5348 if GameMode=cMovie then 5349 exit; 5350 5351 if Button=mbLeft then 5352 begin 5353 if (x>=xMini+2) and (y>=yMini+2) and (x<xMini+2+2*G.lx) and (y<yMini+2+G.ly) then 5354 if ssShift in Shift then 5355 begin 5356 xMouse:=(xwMini+(x-(xMini+2)+MapWidth div (xxt*2)+G.lx) div 2) mod G.lx; 5357 MouseLoc:=xMouse+G.lx*(y-(yMini+2)); 5358 if MyMap[MouseLoc] and fTerrain<>fUNKNOWN then 5359 begin 5360 p1:=MyRO.Territory[MouseLoc]; 5361 if (p1=me) or (p1>=0) and (MyRO.Treaty[p1]>=trNone) then 5362 NatStatDlg.ShowNewContent(wmPersistent, p1); 5363 end 5364 end 5365 else 5366 begin 5367 if CityDlg.Visible then CityDlg.Close; 5368 if UnitStatDlg.Visible then UnitStatDlg.Close; 5369 Tracking:=true; 5370 PanelBoxMouseMove(Sender,Shift+[ssLeft],x,y); 5371 end 5372 else if (ClientMode<>cEditMap) and (x>=ClientWidth-xPalace) and (y>=yPalace) 5373 and (x<ClientWidth-xPalace+xSizeBig) and (y<yPalace+ySizeBig) then 5374 begin 5375 InitPopup(StatPopup); 5376 if FullScreen then 5377 StatPopup.Popup(Left+ClientWidth-xPalace+xSizeBig+2, 5378 Top+ClientHeight-PanelHeight+yPalace-1) 5379 else StatPopup.Popup(Left+ClientWidth-xPalace+6, 5380 Top+ClientHeight-PanelHeight+yPalace+ySizeBig+GetSystemMetrics(SM_CYCAPTION)+3) 5381 end 5382 (* else if (x>=xAdvisor-3) and (y>=yAdvisor-3) 5383 and (x<xAdvisor+16+3) and (y<yAdvisor+16+3) and HaveStrategyAdvice then 5384 AdviceBtnClick*) 5385 else if (x>=xTroop+1) and (y>=yTroop+1) 5386 and (x<xTroop+TrRow*TrPitch) and (y<=yTroop+55) then 5387 begin 5388 i:=(x-xTroop-1) div TrPitch; 5389 if trix[i]>=0 then 5390 if ClientMode=cEditMap then begin BrushType:=trix[i]; PanelPaint end 5391 else if (TroopLoc>=0) then 5392 if MyMap[TroopLoc] and fOwned<>0 then 5393 begin 5394 if ssShift in Shift then 5395 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, MyUn[trix[i]].mix) 5396 else if not supervising and (ClientMode<scContact) 5397 and (x-xTroop-1-i*TrPitch>=60-20) and (y>=yTroop+35) 5398 and ((MyUn[trix[i]].Job>jNone) 5399 or (MyUn[trix[i]].Status and (usStay or usRecover or usGoto)<>0)) then 5400 begin // wake up 5401 MyUn[trix[i]].Status:=MyUn[trix[i]].Status 5402 and ($FFFF-usStay-usRecover-usGoto-usEnhance) or usWaiting; 5403 if MyUn[trix[i]].Job>jNone then 5404 Server(sStartJob+jNone shl 4,me,trix[i],nil^); 5405 if (UnFocus<0) and not CityDlg.Visible then 5406 begin 5407 SetUnFocus(trix[i]); 5408 SetTroopLoc(MyUn[trix[i]].Loc); 5409 FocusOnLoc(TroopLoc,flRepaintPanel) 5410 end 5411 else 5412 begin 5413 if CityDlg.Visible and (CityDlg.RestoreUnFocus<0) then 5414 CityDlg.RestoreUnFocus:=trix[i]; 5415 PanelPaint; 5416 end 5417 end 5418 else if (ClientMode<scContact) then 5419 begin 5420 if supervising then 5421 UnitStatDlg.ShowNewContent_OwnUnit(wmPersistent, trix[i]) 5422 else if CityDlg.Visible then 5423 begin 5424 CityDlg.CloseAction:=None; 5425 CityDlg.Close; 5426 SumCities(TaxSum,ScienceSum); 5427 SetUnFocus(trix[i]); 5428 end 5429 else 5430 begin 5431 DestinationMarkON:=false; 5432 PaintDestination; 5433 UnFocus:=trix[i]; 5434 UnStartLoc:=TroopLoc; 5435 BlinkTime:=0; 5436 BlinkOn:=false; 5437 PaintLoc(TroopLoc); 5438 end; 5439 if UnFocus>=0 then 5440 begin 5441 UnitInfoBtn.Visible:=true; 5442 UnitBtn.Visible:=true; 5443 TurnComplete:=false; 5444 EOT.ButtonIndex:=eotGray; 5445 end; 5446 CheckTerrainBtnVisible; 5447 PanelPaint; 5448 end 5449 end 5450 else if Server(sGetUnits,me,TroopLoc,TrCnt)>=rExecuted then 5451 if ssShift in Shift then 5452 UnitStatDlg.ShowNewContent_EnemyModel(wmPersistent, 5453 MyRO.EnemyUn[MyRO.nEnemyUn+trix[i]].emix) // model info 5454 else UnitStatDlg.ShowNewContent_EnemyUnit(wmPersistent, 5455 MyRO.nEnemyUn+trix[i]); // unit info 5456 end 5457 end 5458 end; 5459 5460 procedure TMainScreen.SetTroopLoc(Loc:integer); 5461 var 5462 trixFocus,uix,uixDefender: integer; 5463 Prio: boolean; 5464 begin 5465 TroopLoc:=Loc; 5466 TrRow:=(xRightPanel+10-xTroop-GetSystemMetrics(SM_CXVSCROLL)-19) div TrPitch; 5467 TrCnt:=0; 5468 trixFocus:=-1; 5469 if ClientMode=cEditMap then TrCnt:=nBrushTypes 5470 else if (Loc>=0) and (MyMap[Loc] and fUnit<>0) then 5471 if MyMap[Loc] and fOwned<>0 then 5472 begin // count own units here 5473 Server(sGetDefender,me,TroopLoc,uixDefender); 5474 for Prio:=true downto false do 5475 for uix:=0 to MyRO.nUn-1 do 5476 if ((uix=uixDefender)=Prio) and (MyUn[uix].Loc=Loc) then 5477 begin 5478 if uix=UnFocus then trixFocus:=TrCnt; 5479 inc(TrCnt); 5480 end 5481 end 5482 else // count enemy units here 5483 Server(sGetUnits,me,Loc,TrCnt); 5484 if TrCnt=0 then InitPVSB(sb,0,1) 5485 else 5486 begin 5487 InitPVSB(sb,(TrCnt+TrRow-1) div TrRow-1,1); 5488 with sb.si do if (nMax>=integer(nPage)) and (trixFocus>=0) then 5489 begin 5490 sb.si.npos:=trixFocus div TrRow; 5491 sb.si.FMask:=SIF_POS; 5492 SetScrollInfo(sb.h,SB_CTL,sb.si,true); 5493 end 5494 end 5495 end; 5496 5497 (*procedure TMainScreen.ShowMoveHint(ToLoc: integer; Force: boolean = false); 5498 var 5499 Step,Loc,x0,y0,xs,ys: integer; 5500 Info: string; 5501 InfoSize: TSize; 5502 MoveAdvice: TMoveAdviceData; 5503 begin 5504 if (ToLoc<0) or (ToLoc>=G.lx*G.ly) 5505 or (UnFocus<0) or (MyUn[UnFocus].Loc=ToLoc) then 5506 ToLoc:=-1 5507 else 5508 begin 5509 MoveAdvice.ToLoc:=ToLoc; 5510 MoveAdvice.MoreTurns:=0; 5511 MoveAdvice.MaxHostile_MovementLeft:=MyUn[UnFocus].Health-50; 5512 if Server(sGetMoveAdvice,me,UnFocus,MoveAdvice)<rExecuted then 5513 ToLoc:=-1 5514 end; 5515 if (ToLoc=MoveHintToLoc) and not Force then exit; 5516 if (ToLoc<>MoveHintToLoc) and (MoveHintToLoc>=0) then 5517 begin invalidate; update end; // clear old hint from screen 5518 MoveHintToLoc:=ToLoc; 5519 if ToLoc<0 then exit; 5520 5521 with canvas do 5522 begin 5523 Pen.Color:=$80C0FF; 5524 Pen.Width:=3; 5525 Loc:=MyUn[UnFocus].Loc; 5526 for Step:=0 to MoveAdvice.nStep do 5527 begin 5528 y0:=(Loc+G.lx*1024) div G.lx -1024; 5529 x0:=(Loc+(y0 and 1+G.lx*1024) div 2) mod G.lx; 5530 xs:=(x0-xw)*66+y0 and 1*33-G.lx*66; 5531 while abs(2*(xs+G.lx*66)-MapWidth)<abs(2*xs-MapWidth) do 5532 inc(xs,G.lx*66); 5533 ys:=(y0-yw)*16; 5534 if Step=0 then moveto(xs+33,ys+16) 5535 else lineto(xs+33,ys+16); 5536 if Step<MoveAdvice.nStep then 5537 Loc:=dLoc(Loc,MoveAdvice.dx[Step],MoveAdvice.dy[Step]); 5538 end; 5539 Brush.Color:=$80C0FF; 5540 Info:=' '+inttostr(88)+' '; 5541 InfoSize:=TextExtent(Info); 5542 TextOut(xs+33-InfoSize.cx div 2, ys+16-InfoSize.cy div 2, Info); 5543 Brush.Style:=bsClear; 5544 end 5545 end;*) 5546 5547 procedure TMainScreen.SetDebugMap(p: integer); 5548 begin 5549 IsoEngine.pDebugMap:=p; 5550 IsoEngine.Options:=IsoEngine.Options and not (1 shl moLocCodes); 5551 mLocCodes.Checked:=false; 5552 MapValid:=false; 5553 MainOffscreenPaint; 5554 end; 5555 5556 procedure TMainScreen.SetViewpoint(p: integer); 5557 var 5558 i: integer; 5559 begin 5560 if supervising and (G.RO[0].Turn>0) 5561 and ((p=0) or (1 shl p and G.RO[0].Alive<>0)) then 5562 begin 5563 for i:=0 to Screen.FormCount-1 do 5564 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 5565 Screen.Forms[i].Close; // close windows 5566 ItsMeAgain(p); 5567 SumCities(TaxSum,ScienceSum); 5568 for i:=0 to MyRO.nModel-1 do 5569 if Tribe[me].ModelPicture[i].HGr=0 then 5570 InitMyModel(i,true); 5571 5572 SetTroopLoc(-1); 5573 PanelPaint; 5574 MapValid:=false; 5575 PaintAllMaps; 5576 end 5577 end; 5578 5579 procedure TMainScreen.FormKeyDown(Sender:TObject;var Key:word; 5580 Shift:TShiftState); 5581 5582 procedure MenuClick_Check(Popup: TPopupMenu; Item: TMenuItem); 5583 begin 5584 InitPopup(Popup); 5585 if Item.Visible and Item.Enabled then MenuClick(Item); 5586 end; 5587 5588 var 5589 dx,dy: integer; 5590 time0,time1: int64; 5591 begin 5592 if GameMode=cMovie then 5593 begin 5594 case Key of 5595 VK_F4: MenuClick_Check(StatPopup,mScienceStat); 5596 VK_F6: MenuClick_Check(StatPopup,mDiagram); 5597 VK_F7: MenuClick_Check(StatPopup,mWonders); 5598 VK_F8: MenuClick_Check(StatPopup,mShips); 5599 end; 5600 exit; 5601 end; 5602 5603 if not idle then exit; 5604 5605 if ClientMode=cEditMap then 5606 begin 5607 if Shift=[ssCtrl] then 5608 case char(Key) of 5609 (* 'A': 5610 begin // auto symmetry 5611 Server($7F0,me,0,nil^); 5612 MapValid:=false; 5613 PaintAll; 5614 end; 5615 'B': 5616 begin // land mass 5617 dy:=0; 5618 for dx:=G.lx to G.lx*(G.ly-1)-1 do 5619 if MyMap[dx] and fTerrain>=fGrass then inc(dy); 5620 dy:=dy 5621 end;*) 5622 'Q':MenuClick(mResign); 5623 'R':MenuClick(mRandomMap); 5624 end 5625 else if Shift=[] then 5626 case char(Key) of 5627 char(VK_F1): MenuClick(mHelp); 5628 end; 5629 exit; 5630 end; 5631 5632 if Shift=[ssAlt] then 5633 case char(Key) of 5634 '0': SetDebugMap(-1); 5635 '1'..'9': SetDebugMap(ord(Key)-48); 5636 end 5637 else if Shift=[ssCtrl] then 5638 case char(Key) of 5639 'J':MenuClick(mJump); 5640 'K':mShowClick(mDebugMap); 5641 'L':mShowClick(mLocCodes); 5642 'M':if LogDlg.Visible then LogDlg.Close else LogDlg.Show; 5643 'N':mNamesClick(mNames); 5644 'Q':MenuClick_Check(GamePopup,mResign); 5645 'R':MenuClick(mRun); 5646 '0'..'9': 5647 begin 5648 if ord(Key)-48=me then 5649 SetViewpoint(0) 5650 else SetViewpoint(ord(Key)-48); 5651 end; 5652 ' ': 5653 begin // test map repaint time 5654 QueryPerformanceCounter(time0); 5655 MapValid:=false; 5656 MainOffscreenPaint; 5657 QueryPerformanceCounter(time1); 5658 SimpleMessage(Format('Map repaint time: %.3f ms',[{$IFDEF VER100}(time1.LowPart-time0.LowPart) 5659 {$ELSE}(time1-time0){$ENDIF}*1000.0/PerfFreq])); 5660 end 5661 end 5662 else if Shift=[] then 5663 case char(Key) of 5664 char(VK_F1): MenuClick(mHelp); 5665 char(VK_F2):MenuClick_Check(StatPopup,mUnitStat); 5666 char(VK_F3):MenuClick_Check(StatPopup,mCityStat); 5667 char(VK_F4):MenuClick_Check(StatPopup,mScienceStat); 5668 char(VK_F5):MenuClick_Check(StatPopup,mEUnitStat); 5669 char(VK_F6):MenuClick_Check(StatPopup,mDiagram); 5670 char(VK_F7):MenuClick_Check(StatPopup,mWonders); 5671 char(VK_F8):MenuClick_Check(StatPopup,mShips); 5672 char(VK_F9):MenuClick_Check(StatPopup,mNations); 5673 char(VK_F10):MenuClick_Check(StatPopup,mEmpire); 5674 char(VK_ADD): EndTurn; 5675 '1':MapBtnClick(MapBtn0); 5676 '2':MapBtnClick(MapBtn1); 5677 '3':MapBtnClick(MapBtn4); 5678 '4':MapBtnClick(MapBtn5); 5679 '5':MapBtnClick(MapBtn6); 5680 'T':MenuClick(mTechTree); 5681 'W':MenuClick(mWait); 5682 end; 5683 5684 if UnFocus>=0 then 5685 if Shift=[ssCtrl] then 5686 case char(Key) of 5687 'C':MenuClick_Check(UnitPopup,mCancel); 5688 'D':MenuClick(mDisband); 5689 'P':MenuClick_Check(UnitPopup,mPillage); 5690 'T':MenuClick_Check(UnitPopup,mSelectTransport); 5691 end 5692 else if Shift=[] then 5693 case char(Key) of 5694 ' ':MenuClick(mNoOrders); 5695 'A':MenuClick_Check(TerrainPopup,mAirBase); 5696 'B':MenuClick_Check(UnitPopup,mCity); 5697 'C':MenuClick(mCentre); 5698 'E': 5699 begin 5700 InitPopup(TerrainPopup); 5701 if mEnhance.Visible and mEnhance.Enabled then MenuClick(mEnhance) 5702 else MenuClick(mEnhanceDef) 5703 end; 5704 'F':MenuClick_Check(TerrainPopup,mFort); 5705 'G':MenuClick_Check(UnitPopup,mGoOn); 5706 'H':MenuClick_Check(UnitPopup,mHome); 5707 'I': 5708 if JobTest(UnFocus,jFarm,[eTreaty]) then MenuClick(mFarm) 5709 else if JobTest(UnFocus,jClear,[eTreaty]) then MenuClick(mClear) 5710 else MenuClick_Check(TerrainPopup,mIrrigation); 5711 'L':MenuClick_Check(UnitPopup,mLoad); 5712 'M': 5713 if JobTest(UnFocus,jAfforest,[eTreaty]) then MenuClick(mAfforest) 5714 else MenuClick_Check(TerrainPopup,mMine); 5715 'N':MenuClick_Check(TerrainPopup,mCanal); 5716 'O':MenuClick_Check(TerrainPopup,mTrans); 5717 'P':MenuClick_Check(TerrainPopup,mPollution); 5718 'R': 5719 if JobTest(UnFocus,jRR,[eTreaty]) then MenuClick(mRR) 5720 else MenuClick_Check(TerrainPopup,mRoad); 5721 'S':MenuClick(mStay); 5722 'U':MenuClick_Check(UnitPopup,mUnload); 5723 'V':MenuClick_Check(UnitPopup,mRecover); 5724 'Z':MenuClick_Check(UnitPopup,mUtilize); 5725 #33..#40,#97..#100,#102..#105: 5726 begin {arrow keys} 5727 DestinationMarkON:=false; 5728 PaintDestination; 5729 MyUn[UnFocus].Status:=MyUn[UnFocus].Status 5730 and ($FFFF-usStay-usRecover-usGoto-usEnhance) or usWaiting; 5731 case Key of 5732 VK_NUMPAD1,VK_END: begin dx:=-1; dy:=1 end; 5733 VK_NUMPAD2,VK_DOWN: begin dx:=0; dy:=2 end; 5734 VK_NUMPAD3,VK_NEXT: begin dx:=1; dy:=1 end; 5735 VK_NUMPAD4,VK_LEFT: begin dx:=-2; dy:=0 end; 5736 VK_NUMPAD6,VK_RIGHT: begin dx:=2; dy:=0 end; 5737 VK_NUMPAD7,VK_HOME: begin dx:=-1; dy:=-1 end; 5738 VK_NUMPAD8,VK_UP: begin dx:=0; dy:=-2 end; 5739 VK_NUMPAD9,VK_PRIOR: begin dx:=1; dy:=-1 end; 5740 end; 5741 MoveUnit(dx,dy,muAutoNext) 5742 end; 5743 end 5744 end; 5745 5746 procedure TMainScreen.MenuClick(Sender:TObject); 5747 5748 function DoJob(j0:integer): integer; 5749 var 5750 Loc0, Movement0: integer; 5751 begin 5752 with MyUn[UnFocus] do 5753 begin 5754 DestinationMarkON:=false; 5755 PaintDestination; 5756 Loc0:=Loc; 5757 Movement0:=Movement; 5758 if j0<0 then result:=ProcessEnhancement(UnFocus,MyData.EnhancementJobs) // terrain enhancement 5759 else result:=Server(sStartJob+j0 shl 4,me,UnFocus,nil^); 5760 if result>=rExecuted then 5761 begin 5762 if result=eDied then UnFocus:=-1; 5763 PaintLoc(Loc0); 5764 if UnFocus>=0 then 5765 begin 5766 if (j0<0) and (result<>eJobDone) then // multi-turn terrain enhancement 5767 Status:=Status and ($FFFF-usStay-usRecover-usGoto) or usEnhance 5768 else Status:=Status and ($FFFF-usStay-usRecover-usGoto-usEnhance); 5769 if (Job<>jNone) or (Movement0<100) then 5770 begin 5771 Status:=Status and not usWaiting; 5772 NextUnit(UnStartLoc,true); 5773 end 5774 else PanelPaint 5775 end 5776 else NextUnit(UnStartLoc,true); 5777 end 5778 end; 5779 case result of 5780 eNoBridgeBuilding: SoundMessage(Phrases.Lookup('NOBB'),'INVALID'); 5781 eNoCityTerrain: SoundMessage(Phrases.Lookup('NOCITY'),'INVALID'); 5782 eTreaty: SoundMessage(Tribe[MyRO.Territory[Loc0]].TPhrase('PEACE_NOWORK'),'NOMOVE_TREATY'); 5783 else if result<rExecuted then Play('INVALID') 5784 end 5785 end; 5786 5787 var 5788 i,uix,NewFocus,Loc0,OldMaster,Destination,cix,cixOldHome,ServerResult: integer; 5789 AltGovs,changed: boolean; 5790 QueryText: string; 5791 5792 begin 5793 if Sender=mResign then 5794 if ClientMode=cEditMap then 5795 begin 5796 if Edited then 5797 begin 5798 QueryText:=Phrases.Lookup('MAP_CLOSE'); 5799 case SimpleQuery(mkYesNoCancel,QueryText,'') of 5800 mrIgnore: 5801 Server(sAbandonMap,me,0,nil^); 5802 mrOK: 5803 Server(sSaveMap,me,0,nil^); 5804 end 5805 end 5806 else Server(sAbandonMap,me,0,nil^) 5807 end 5808 else 5809 begin 5810 if Server(sGetGameChanged,0,0,nil^)=eOK then 5811 begin 5812 QueryText:=Phrases.Lookup('RESIGN'); 5813 case SimpleQuery(mkYesNoCancel,QueryText,'') of 5814 mrIgnore: 5815 Server(sResign,0,0,nil^); 5816 mrOK: 5817 Server(sBreak,0,0,nil^) 5818 end 5819 end 5820 else Server(sResign,0,0,nil^) 5821 end 5822 else if Sender=mEmpire then 5823 RatesDlg.ShowNewContent(wmPersistent) 5824 else if Sender=mRevolution then 5825 begin 5826 AltGovs:=false; 5827 for i:=2 to nGov-1 do 5828 if (GovPreq[i]<>preNA) and ((GovPreq[i]=preNone) 5829 or (MyRO.Tech[GovPreq[i]]>=tsApplicable)) then 5830 AltGovs:=true; 5831 5832 if not AltGovs then 5833 SoundMessage(Phrases.Lookup('NOALTGOVS'),'MSG_DEFAULT') 5834 else 5835 begin 5836 changed:=false; 5837 if MyRO.Happened and phChangeGov<>0 then 5838 begin 5839 ModalSelectDlg.ShowNewContent(wmModal,kGov); 5840 if ModalSelectDlg.result>=0 then 5841 begin 5842 Play('NEWGOV'); 5843 Server(sSetGovernment,me,ModalSelectDlg.result,nil^); 5844 CityOptimizer_BeginOfTurn; 5845 changed:=true; 5846 end 5847 end 5848 else with MessgExDlg do 5849 begin // revolution! 5850 MessgText:=Tribe[me].TPhrase('REVOLUTION'); 5851 Kind:=mkYesNo; 5852 IconKind:=mikPureIcon; 5853 IconIndex:=72; // anarchy palace 5854 ShowModal; 5855 if ModalResult=mrOK then 5856 begin 5857 Play('REVOLUTION'); 5858 Server(sRevolution,me,0,nil^); 5859 changed:=true; 5860 if NatStatDlg.Visible then NatStatDlg.Close; 5861 if CityDlg.Visible then CityDlg.Close; 5862 end 5863 end; 5864 if changed then 5865 UpdateViews(true); 5866 end 5867 end 5868 else if Sender=mWebsite then 5869 ShellExecute(Handle,'open','http://c-evo.org','','',SW_SHOWNORMAL) 5870 else if Sender=mRandomMap then 5871 begin 5872 if not Edited or (SimpleQuery(mkYesNo,Phrases.Lookup('MAP_RANDOM'),'')=mrOK) then 5873 begin 5874 Server(sRandomMap,me,0,nil^); 5875 Edited:=true; 5876 MapValid:=false; 5877 PaintAllMaps; 5878 end 5879 end 5880 else if Sender=mJump then 5881 begin 5882 if supervising then 5883 Jump[0]:=20 5884 else Jump[me]:=20; 5885 EndTurn(true); 5886 end 5887 else if Sender=mRun then 5888 begin 5889 if supervising then 5890 Jump[0]:=999999 5891 else Jump[me]:=999999; 5892 EndTurn(true); 5893 end 5894 else if Sender=mEnhanceDef then 5895 begin 5896 if UnFocus>=0 then 5897 EnhanceDlg.ShowNewContent(wmPersistent, MyMap[MyUn[UnFocus].Loc] and fTerrain) 5898 else EnhanceDlg.ShowNewContent(wmPersistent) 5899 end 5900 else if Sender=mCityTypes then 5901 CityTypeDlg.ShowNewContent(wmModal) // must be modal because types are not saved before closing 5902 else if Sender=mUnitStat then 5903 begin 5904 if G.Difficulty[me]>0 then 5905 ListDlg.ShowNewContent_MilReport(wmPersistent,me) 5906 else 5907 begin 5908 i:=1; 5909 while (i<nPl) and (1 shl i and MyRO.Alive=0) do inc(i); 5910 if i<nPl then 5911 ListDlg.ShowNewContent_MilReport(wmPersistent,i); 5912 end; 5913 end 5914 else if Sender=mEUnitStat then 5915 begin 5916 if MyRO.nEnemyModel>0 then 5917 ListDlg.ShowNewContent(wmPersistent,kAllEModels); 5918 end 5919 else if Sender=mCityStat then 5920 ListDlg.ShowNewContent(wmPersistent,kCities) 5921 else if Sender=mScienceStat then 5922 ListDlg.ShowNewContent(wmPersistent,kScience) 5923 else if Sender=mNations then 5924 NatStatDlg.ShowNewContent(wmPersistent) 5925 else if Sender=mHelp then 5926 if ClientMode=cEditMap then 5927 HelpDlg.ShowNewContent(wmPersistent, hkText, HelpDlg.TextIndex('MAPEDIT')) 5928 else HelpDlg.ShowNewContent(wmPersistent, hkMisc, miscMain) 5929 else if Sender=mTechTree then 5930 TechTreeDlg.ShowModal 5931 else if Sender=mWonders then 5932 WondersDlg.ShowNewContent(wmPersistent) 5933 else if Sender=mDiagram then 5934 DiaDlg.ShowNewContent_Charts(wmPersistent) 5935 else if Sender=mShips then 5936 DiaDlg.ShowNewContent_Ship(wmPersistent) 5937 else if Sender=mWait then 5938 begin 5939 if UnFocus>=0 then 5940 begin 5941 DestinationMarkON:=false; 5942 PaintDestination; 5943 MyUn[UnFocus].Status:=MyUn[UnFocus].Status and ($FFFF-usStay-usRecover-usGoto-usEnhance) or usWaiting; 5944 end; 5945 NextUnit(-1,false); 5946 end 5947 else if UnFocus>=0 then with MyUn[UnFocus] do 5948 if Sender=mGoOn then 5949 begin 5950 if Status shr 16=$7FFF then Destination:=maNextCity 5951 else Destination:=Status shr 16; 5952 Status:=Status and not (usStay or usRecover) or usWaiting; 5953 MoveToLoc(Destination,true); 5954 end 5955 else if Sender=mHome then 5956 if MyMap[Loc] and fCity<>0 then 5957 begin 5958 cixOldHome:=Home; 5959 if Server(sSetUnitHome,me,UnFocus,nil^)>=rExecuted then 5960 begin 5961 CityOptimizer_CityChange(cixOldHome); 5962 CityOptimizer_CityChange(Home); 5963 UpdateViews(true); 5964 end 5965 else Play('INVALID'); 5966 end 5967 else 5968 begin 5969 Status:=Status and not (usStay or usRecover or usEnhance); 5970 MoveToLoc(maNextCity,true) 5971 end 5972 else if Sender=mCentre then begin Centre(Loc); PaintAllMaps end 5973 else if Sender=mCity then 5974 begin 5975 Loc0:=Loc; 5976 if MyMap[Loc] and fCity=0 then 5977 begin // build city 5978 if DoJob(jCity)=eCity then 5979 begin 5980 MapValid:=false; 5981 PaintAll; 5982 ZoomToCity(Loc0,true,chFounded); 5983 end 5984 end 5985 else 5986 begin 5987 CityOptimizer_BeforeRemoveUnit(UnFocus); 5988 ServerResult:=Server(sAddToCity,me,UnFocus,nil^); 5989 if ServerResult>=rExecuted then 5990 begin 5991 cix:=MyRO.nCity-1; 5992 while (cix>=0) and (MyCity[cix].Loc<>Loc0) do 5993 dec(cix); 5994 assert(cix>=0); 5995 CityOptimizer_CityChange(cix); 5996 CityOptimizer_AfterRemoveUnit; // does nothing here 5997 SetTroopLoc(Loc0); 5998 UpdateViews(true); 5999 DestinationMarkON:=false; 6000 PaintDestination; 6001 UnFocus:=-1; 6002 PaintLoc(Loc0); 6003 NextUnit(UnStartLoc,true); 6004 end 6005 else if ServerResult=eMaxSize then 6006 SimpleMessage(Phrases.Lookup('ADDTOMAXSIZE')); 6007 end 6008 end 6009 else if Sender=mRoad then DoJob(jRoad) 6010 else if Sender=mRR then DoJob(jRR) 6011 else if Sender=mClear then DoJob(jClear) 6012 else if Sender=mIrrigation then DoJob(jIrr) 6013 else if Sender=mFarm then DoJob(jFarm) 6014 else if Sender=mAfforest then DoJob(jAfforest) 6015 else if Sender=mMine then DoJob(jMine) 6016 else if Sender=mCanal then DoJob(jCanal) 6017 else if Sender=MTrans then DoJob(jTrans) 6018 else if Sender=mFort then DoJob(jFort) 6019 else if Sender=mAirBase then DoJob(jBase) 6020 else if Sender=mPollution then DoJob(jPoll) 6021 else if Sender=mPillage then DoJob(jPillage) 6022 else if Sender=mEnhance then DoJob(-1) 6023 else if Sender=mStay then 6024 begin 6025 DestinationMarkON:=false; 6026 PaintDestination; 6027 Status:=Status and ($FFFF-usRecover-usGoto-usEnhance) or usStay; 6028 if Job>jNone then 6029 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 6030 NextUnit(UnStartLoc,true) 6031 end 6032 else if Sender=mRecover then 6033 begin 6034 DestinationMarkON:=false; 6035 PaintDestination; 6036 Status:=Status and ($FFFF-usStay-usGoto-usEnhance) or usRecover; 6037 if Job>jNone then 6038 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 6039 NextUnit(UnStartLoc,true) 6040 end 6041 else if Sender=mNoOrders then 6042 begin 6043 Status:=Status and not usWaiting; 6044 NextUnit(UnStartLoc,true) 6045 end 6046 else if Sender=mCancel then 6047 begin 6048 DestinationMarkON:=false; 6049 PaintDestination; 6050 Status:=Status and ($FFFF-usRecover-usGoto-usEnhance); 6051 if Job>jNone then 6052 Server(sStartJob+jNone shl 4,me,UnFocus,nil^); 6053 end 6054 else if (Sender=mDisband) or (Sender=mUtilize) then 6055 begin 6056 if (Sender=mUtilize) 6057 and not (Server(sRemoveUnit-sExecute,me,UnFocus,nil^)=eUtilized) then 6058 begin 6059 SimpleMessage(Phrases2.Lookup('SHIP_UTILIZE')); 6060 // freight for colony ship is the only case in which the command is 6061 // available to player though not valid 6062 exit 6063 end; 6064 if (Sender=mUtilize) and (Health<100) then 6065 if SimpleQuery(mkYesNo,Phrases.Lookup('DAMAGED_UTILIZE'),'')<>mrOK then 6066 exit; 6067 Loc0:=Loc; 6068 CityOptimizer_BeforeRemoveUnit(UnFocus); 6069 if Server(sRemoveUnit,me,UnFocus,nil^)=eUtilized then Play('CITY_UTILIZE') 6070 else Play('DISBAND'); 6071 CityOptimizer_AfterRemoveUnit; 6072 SetTroopLoc(Loc0); 6073 UpdateViews(true); 6074 DestinationMarkON:=false; 6075 PaintDestination; 6076 UnFocus:=-1; 6077 PaintLoc(Loc0); 6078 NextUnit(UnStartLoc,true); 6079 end 6080 else if Sender=mLoad then 6081 begin 6082 i:=Server(sLoadUnit,me,UnFocus,nil^); 6083 if i>=rExecuted then 6084 begin 6085 if MyModel[mix].Domain=dAir then Play('MOVE_PLANELANDING') 6086 else Play('MOVE_LOAD'); 6087 DestinationMarkON:=false; 6088 PaintDestination; 6089 Status:=Status and ($FFFF-usWaiting-usStay-usRecover-usGoto-usEnhance); 6090 NextUnit(UnStartLoc,true); 6091 end 6092 else if i=eNoTime_Load then 6093 if MyModel[mix].Domain=dAir then 6094 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'),'NOMOVE_TIME') 6095 else 6096 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 6097 [MovementToString(MyModel[mix].Speed)]),'NOMOVE_TIME'); 6098 end 6099 else if Sender=mUnload then 6100 if Master>=0 then 6101 begin 6102 OldMaster:=Master; 6103 i:=Server(sUnloadUnit,me,UnFocus,nil^); 6104 if i>=rExecuted then 6105 begin 6106 if MyModel[mix].Domain=dAir then Play('MOVE_PLANESTART') 6107 else if (MyModel[MyUn[OldMaster].mix].Domain=dAir) 6108 and (MyMap[Loc] and fCity=0) and (MyMap[Loc] and fTerImp<>tiBase) then 6109 Play('MOVE_PARACHUTE') 6110 else Play('MOVE_UNLOAD'); 6111 Status:=Status and not usWaiting; 6112 if MyModel[mix].Domain<>dAir then NextUnit(Loc,true) 6113 else PanelPaint 6114 end 6115 else if i=eNoTime_Load then 6116 if MyModel[mix].Domain=dAir then 6117 SoundMessage(Phrases.Lookup('NOTIMELOADAIR'),'NOMOVE_TIME') 6118 else 6119 SoundMessage(Format(Phrases.Lookup('NOTIMELOADGROUND'), 6120 [MovementToString(MyModel[mix].Speed)]),'NOMOVE_TIME'); 6121 end 6122 else 6123 begin 6124 NewFocus:=-1; 6125 uix:=UnFocus; 6126 for i:=1 to MyRo.nUn-1 do 6127 begin 6128 uix:=(uix+MyRO.nUn-1) mod MyRO.nUn; 6129 if (MyUn[uix].Master=UnFocus) 6130 and (MyUn[uix].Movement=integer(MyModel[MyUn[uix].mix].Speed)) then 6131 begin 6132 MyUn[uix].Status:=MyUn[uix].Status or usWaiting; 6133 NewFocus:=uix 6134 end; 6135 end; 6136 if NewFocus>=0 then 6137 begin 6138 SetUnFocus(NewFocus); 6139 SetTroopLoc(Loc); 6140 PanelPaint 6141 end 6142 end 6143 else if Sender=mSelectTransport then 6144 Server(sSelectTransport,me,UnFocus,nil^) 6145 end; 6146 6147 procedure TMainScreen.InitPopup(Popup: TPopupMenu); 6148 var 6149 i,p1,Tile,Test: integer; 6150 NoSuper,extended,Multi,NeedSep,HaveCities: boolean; 6151 LastSep,m: TMenuItem; 6152 mox: ^TModel; 6153 begin 6154 NoSuper:=not supervising and (1 shl me and MyRO.Alive<>0); 6155 HaveCities:=false; 6156 for i:=0 to MyRO.nCity-1 do if MyCity[i].Loc>=0 then 6157 begin HaveCities:=true; Break end; 6158 if Popup=GamePopup then 6159 begin 6160 mTechTree.Visible:= ClientMode<>cEditMap; 6161 mResign.Enabled:= supervising or (me=0) and (ClientMode<scContact); 6162 mRandomMap.Visible:= (ClientMode=cEditMap) 6163 and (Server(sMapGeneratorRequest,me,0,nil^)=eOk); 6164 mOptions.Visible:= ClientMode<>cEditMap; 6165 mManip.Visible:= ClientMode<>cEditMap; 6166 if ClientMode<>cEditMap then 6167 begin 6168 mWaitTurn.Visible:= NoSuper; 6169 mRep.Visible:= NoSuper; 6170 mRepList.Visible:= NoSuper; 6171 mRepScreens.Visible:= NoSuper; 6172 N10.Visible:= NoSuper; 6173 mOwnMovement.Visible:= NoSuper; 6174 mAllyMovement.Visible:= NoSuper; 6175 case SoundMode of 6176 smOff: mSoundOff.Checked:=true; 6177 smOn: mSoundOn.Checked:=true; 6178 smOnAlt: mSoundOnAlt.Checked:=true; 6179 end; 6180 6181 for i:=0 to nTestFlags-1 do 6182 mManip[i].Checked:= MyRO.TestFlags and (1 shl i)<>0; 6183 mManip.Enabled:= supervising or (me=0); 6184 6185 Multi:=false; 6186 for p1:=1 to nPl-1 do 6187 if G.RO[p1]<>nil then Multi:=true; 6188 mEnemyMovement.Visible:=not Multi; 6189 end; 6190 mMacro.Visible:= NoSuper and (ClientMode<scContact); 6191 if NoSuper and (ClientMode<scContact) then 6192 begin 6193 mCityTypes.Enabled:=false; 6194 // check if city types already usefull: 6195 if MyRO.nCity>0 then 6196 for i:=28 to nImp-1 do 6197 if (i<>imTrGoods) and (Imp[i].Kind=ikCommon) and (Imp[i].Preq<>preNA) 6198 and ((Imp[i].Preq=preNone) or (MyRO.Tech[Imp[i].Preq]>=tsApplicable)) then 6199 begin mCityTypes.Enabled:=true; Break end; 6200 end; 6201 mViewpoint.visible:=(ClientMode<>cEditMap) and supervising; 6202 mViewpoint.enabled:= G.RO[0].Turn>0; 6203 if supervising then 6204 begin 6205 EmptyMenu(mViewpoint); 6206 for p1:=0 to nPl-1 do 6207 if (p1=0) or (1 shl p1 and G.RO[0].Alive<>0) then 6208 begin 6209 m:=TMenuItem.Create(mViewpoint); 6210 if p1=0 then 6211 m.Caption:=Phrases.Lookup('SUPER') 6212 else m.Caption:=Tribe[p1].TString(Phrases2.Lookup('BELONG')); 6213 m.Tag:=p1; 6214 m.OnClick:=ViewPointClick; 6215 if p1<10 then 6216 m.ShortCut:=Shortcut(48+p1, [ssCtrl]); 6217 m.RadioItem:=true; 6218 if p1=me then 6219 m.Checked:=true; 6220 mViewPoint.Add(m); 6221 end 6222 end; 6223 mDebugMap.visible:=(ClientMode<>cEditMap) and supervising; 6224 if supervising then 6225 begin 6226 EmptyMenu(mDebugMap); 6227 for p1:=0 to nPl-1 do 6228 if (p1=0) or (1 shl p1 and G.RO[0].Alive<>0) then 6229 begin 6230 m:=TMenuItem.Create(mDebugMap); 6231 if p1=0 then 6232 m.Caption:=Phrases2.Lookup('MENU_DEBUGMAPOFF') 6233 else m.Caption:=Tribe[p1].TString(Phrases2.Lookup('BELONG')); 6234 if p1=0 then 6235 m.Tag:=-1 6236 else m.Tag:=p1; 6237 m.OnClick:=DebugMapClick; 6238 if p1<10 then 6239 m.ShortCut:=Shortcut(48+p1, [ssAlt]); 6240 m.RadioItem:=true; 6241 if m.Tag=IsoEngine.pDebugMap then 6242 m.Checked:=true; 6243 mDebugMap.Add(m); 6244 end 6245 end; 6246 mSmallTiles.Checked:= xxt=33; 6247 mNormalTiles.Checked:= xxt=48; 6248 end 6249 else if Popup=StatPopup then 6250 begin 6251 mEmpire.Visible:= NoSuper; 6252 mEmpire.Enabled:= MyRO.Government<>gAnarchy; 6253 mRevolution.Visible:= NoSuper; 6254 mRevolution.Enabled:= (MyRO.Government<>gAnarchy) and (ClientMode<scContact); 6255 mUnitStat.Enabled:= NoSuper or (MyRO.Turn>0); 6256 mCityStat.Visible:= 1 shl me and MyRO.Alive<>0; 6257 mCityStat.Enabled:= HaveCities; 6258 mScienceStat.Visible:= true; 6259 mScienceStat.Enabled:= not NoSuper or (MyRO.ResearchTech>=0) 6260 or (MyRO.Happened and phTech<>0) 6261 or (MyRO.Happened and phGameEnd<>0) // no researchtech in case just completed 6262 or (MyRO.TestFlags and (tfAllTechs or tfUncover or tfAllContact)<>0); 6263 mEUnitStat.Enabled:= MyRO.nEnemyModel>0; 6264 { mWonders.Enabled:= false; 6265 for i:=0 to 27 do if MyRO.Wonder[i].CityID<>-1 then 6266 mWonders.Enabled:=true;} 6267 mDiagram.Enabled:= MyRO.Turn>=2; 6268 mShips.Enabled:=false; 6269 for p1:=0 to nPl-1 do 6270 if MyRO.Ship[p1].Parts[spComp]+MyRO.Ship[p1].Parts[spPow] 6271 +MyRO.Ship[p1].Parts[spHab]>0 then 6272 mShips.Enabled:=true; 6273 end 6274 else if Popup=UnitPopup then 6275 begin 6276 mox:=@MyModel[MyUn[UnFocus].mix]; 6277 Tile:=MyMap[MyUn[UnFocus].Loc]; 6278 extended:=Tile and fCity=0; 6279 if extended then 6280 begin 6281 mCity.Caption:=Phrases.Lookup('BTN_FOUND'); 6282 mHome.Caption:=Phrases.Lookup('BTN_MOVEHOME') 6283 end 6284 else 6285 begin 6286 mCity.Caption:=Phrases.Lookup('BTN_ADD'); 6287 mHome.Caption:=Phrases.Lookup('BTN_SETHOME') 6288 end; 6289 6290 extended:=extended and ((mox.Kind=mkSettler) or (mox.Kind=mkSlaves) 6291 and (MyRO.Wonder[woPyramids].EffectiveOwner>=0)) 6292 and (MyUn[UnFocus].Master<0) and (Tile and fDeadLands=0); 6293 if (mox.Kind=mkFreight) and (Tile and fCity<>0) and not Phrases2FallenBackToEnglish 6294 or (Server(sRemoveUnit-sExecute,me,UnFocus,nil^)=eUtilized) then 6295 begin 6296 mDisband.Visible:=false; 6297 mUtilize.Visible:=true; 6298 if mox.Kind=mkFreight then 6299 mUtilize.Caption:=Phrases.Lookup('UTILIZE') 6300 else mUtilize.Caption:=Phrases.Lookup('INTEGRATE') 6301 end 6302 else begin mDisband.Visible:=true; mUtilize.Visible:=false end; 6303 mGoOn.Visible:= MyUn[UnFocus].Status and (usGoto or usWaiting)=usGoto or usWaiting; 6304 mHome.Visible:=HaveCities; 6305 mRecover.Visible:= (MyUn[UnFocus].Health<100) and (Tile and fTerrain>=fGrass) 6306 and ((MyRO.Wonder[woGardens].EffectiveOwner=me) 6307 or (Tile and fTerrain<>fArctic) and (Tile and fTerrain<>fDesert)) 6308 and not ((mox.Domain=dAir) and (Tile and fCity=0) and (Tile and fTerImp<>tiBase)); 6309 mStay.Visible:= not ((mox.Domain=dAir) and (Tile and fCity=0) and (Tile and fTerImp<>tiBase)); 6310 mCity.Visible:=extended and (mox.Kind=mkSettler) or (Tile and fCity<>0) 6311 and ((mox.Kind in [mkSettler,mkSlaves]) or (MyUn[UnFocus].Flags and unConscripts<>0)); 6312 mPillage.Visible:=(Tile and (fRoad or fRR or fCanal or fTerImp)<>0) 6313 and (MyUn[UnFocus].Master<0) and (mox.Domain=dGround); 6314 mCancel.Visible:=(MyUn[UnFocus].Job>jNone) or (MyUn[UnFocus].Status and (usRecover or usGoto)<>0); 6315 6316 Test:=Server(sLoadUnit-sExecute,me,UnFocus,nil^); 6317 mLoad.Visible:= (Test>=rExecuted) or (Test=eNoTime_Load); 6318 mUnload.Visible:= (MyUn[UnFocus].Master>=0) 6319 or (MyUn[UnFocus].TroopLoad+MyUn[UnFocus].AirLoad>0); 6320 mSelectTransport.Visible:= 6321 Server(sSelectTransport-sExecute,me,UnFocus,nil^)>=rExecuted; 6322 end 6323 else {if Popup=TerrainPopup then} 6324 begin 6325 mox:=@MyModel[MyUn[UnFocus].mix]; 6326 Tile:=MyMap[MyUn[UnFocus].Loc]; 6327 extended:=Tile and fCity=0; 6328 6329 if (Tile and fRiver<>0) and (MyRO.Tech[adBridgeBuilding]>=tsApplicable) then 6330 begin 6331 mRoad.Caption:=Phrases.Lookup('BTN_BUILDBRIDGE'); 6332 mRR.Caption:=Phrases.Lookup('BTN_BUILDRRBRIDGE'); 6333 end 6334 else 6335 begin 6336 mRoad.Caption:=Phrases.Lookup('BTN_BUILDROAD'); 6337 mRR.Caption:=Phrases.Lookup('BTN_BUILDRR'); 6338 end; 6339 if Tile and fTerrain=fForest then 6340 mClear.Caption:=Phrases.Lookup('BTN_CLEAR') 6341 else if Tile and fTerrain=fDesert then 6342 mClear.Caption:=Phrases.Lookup('BTN_UNDESERT') 6343 else mClear.Caption:=Phrases.Lookup('BTN_DRAIN'); 6344 6345 extended:=extended and ((mox.Kind=mkSettler) or (mox.Kind=mkSlaves) 6346 and (MyRO.Wonder[woPyramids].EffectiveOwner>=0)) 6347 and (MyUn[UnFocus].Master<0); 6348 if extended then 6349 begin 6350 mRoad.Visible:= JobTest(UnFocus,jRoad,[eNoBridgeBuilding,eTreaty]); 6351 mRR.Visible:= JobTest(UnFocus,jRR,[eNoBridgeBuilding,eTreaty]); 6352 mClear.Visible:= JobTest(UnFocus,jClear,[eTreaty]); 6353 mIrrigation.Visible:= JobTest(UnFocus,jIrr,[eTreaty]); 6354 mFarm.Visible:= JobTest(UnFocus,jFarm,[eTreaty]); 6355 mAfforest.Visible:= JobTest(UnFocus,jAfforest,[eTreaty]); 6356 mMine.Visible:= JobTest(UnFocus,jMine,[eTreaty]); 6357 MTrans.Visible:= JobTest(UnFocus,jTrans,[eTreaty]); 6358 mCanal.Visible:= JobTest(UnFocus,jCanal,[eTreaty]); 6359 mFort.Visible:= JobTest(UnFocus,jFort,[eTreaty]); 6360 mAirBase.Visible:= JobTest(UnFocus,jBase,[eTreaty]); 6361 mPollution.Visible:=JobTest(UnFocus,jPoll,[eTreaty]); 6362 mEnhance.Visible:= (Tile and fDeadLands=0) 6363 and (MyData.EnhancementJobs[MyMap[MyUn[UnFocus].Loc] and fTerrain,0]<>jNone); 6364 end 6365 else 6366 begin 6367 for i:=0 to Popup.Items.Count-1 do Popup.Items[i].Visible:=false; 6368 end; 6369 end; 6370 6371 // set menu seperators 6372 LastSep:=nil; 6373 needsep:=false; 6374 for i:=0 to Popup.Items.Count-1 do 6375 if Popup.Items[i].Caption='-' then 6376 begin 6377 Popup.Items[i].Visible:=needsep; 6378 if needsep then LastSep:=Popup.Items[i]; 6379 needsep:=false 6380 end 6381 else if Popup.Items[i].Visible then needsep:=true; 6382 if (LastSep<>nil) and not NeedSep then LastSep.Visible:=false 6383 end; 6384 6385 procedure TMainScreen.PanelBtnClick(Sender: TObject); 6386 var 6387 Popup: TPopupMenu; 6388 begin 6389 if Sender=UnitBtn then Popup:=UnitPopup 6390 else {if Sender=TerrainBtn then} Popup:=TerrainPopup; 6391 InitPopup(Popup); 6392 if FullScreen then 6393 Popup.Popup(Left+TControl(Sender).Left,Top+TControl(Sender).Top) 6394 else Popup.Popup(Left+TControl(Sender).Left+4,Top+TControl(Sender).Top 6395 +GetSystemMetrics(SM_CYCAPTION)+4); 6396 end; 6397 6398 procedure TMainScreen.CityClosed(Activateuix: integer; StepFocus: boolean; 6399 SelectFocus: boolean); 6400 begin 6401 if supervising then 6402 begin 6403 SetTroopLoc(-1); 6404 PanelPaint 6405 end 6406 else 6407 begin 6408 if Activateuix>=0 then 6409 begin 6410 SetUnFocus(Activateuix); 6411 SetTroopLoc(MyUn[Activateuix].Loc); 6412 if SelectFocus then FocusOnLoc(TroopLoc,flRepaintPanel) 6413 else PanelPaint 6414 end 6415 else if StepFocus then NextUnit(TroopLoc,true) 6416 else 6417 begin 6418 SetTroopLoc(-1); 6419 PanelPaint 6420 end 6421 end 6422 end; 6423 6424 procedure TMainScreen.Toggle(Sender: TObject); 6425 begin 6426 TMenuItem(Sender).Checked:=not TMenuItem(Sender).Checked 6427 end; 6428 6429 procedure TMainScreen.PanelBoxMouseMove(Sender: TObject; 6430 Shift: TShiftState; x, y: integer); 6431 var 6432 xCentre,yCentre: integer; 6433 begin 6434 if Tracking and (ssLeft in Shift) then 6435 begin 6436 if (x>=xMini+2) and (y>=yMini+2) and (x<xMini+2+2*G.lx) and (y<yMini+2+G.ly) then 6437 begin 6438 xCentre:=(xwMini+(x-xMini-2) div 2+G.lx div 2+MapWidth div (xxt*4)) mod G.lx; 6439 yCentre:=(y-yMini-2); 6440 xw:=(xCentre-MapWidth div (xxt*4)+G.lx) mod G.lx; 6441 if ywmax<=0 then yw:=ywcenter 6442 else 6443 begin 6444 yw:=(yCentre-MapHeight div (yyt*2)+1) and not 1; 6445 if yw<0 then yw:=0 6446 else if yw>ywmax then yw:=ywmax; 6447 end; 6448 BitBlt(Buffer.Canvas.Handle,0,0,G.lx*2,G.ly,Mini.Canvas.Handle,0,0,SRCCOPY); 6449 if ywmax<=0 then 6450 Frame(Buffer.Canvas,x-xMini-2-MapWidth div (xxt*2),0, 6451 x-xMini-2+MapWidth div (xxt*2)-1, 6452 G.ly-1,MainTexture.clMark,MainTexture.clMark) 6453 else Frame(Buffer.Canvas,x-xMini-2-MapWidth div (xxt*2),yw, 6454 x-xMini-2+MapWidth div (xxt*2)-1, 6455 yw+MapHeight div yyt-2,MainTexture.clMark,MainTexture.clMark); 6456 BitBlt(Panel.Canvas.Handle,xMini+2,yMini+2,G.lx*2,G.ly,Buffer.Canvas.Handle, 6457 0,0,SRCCOPY); 6458 MainOffscreenPaint; 6459 RectInvalidate(xMini+2,TopBarHeight+MapHeight-overlap+yMini+2, 6460 xMini+2+G.lx*2,TopBarHeight+MapHeight-overlap+yMini+2+G.ly); 6461 Update; 6462 end 6463 end 6464 else Tracking:=false 6465 end; 6466 6467 procedure TMainScreen.PanelBoxMouseUp(Sender: TObject; 6468 Button: TMouseButton; Shift: TShiftState; x, y: integer); 6469 begin 6470 if Tracking then 6471 begin 6472 Tracking:=false; 6473 xwMini:=xw; ywMini:=yw; 6474 MiniPaint; 6475 PanelPaint; 6476 end 6477 end; 6478 6479 procedure TMainScreen.MapBoxMouseMove(Sender: TObject; Shift: TShiftState; x, 6480 y: integer); 6481 var 6482 MouseLoc: integer; 6483 begin 6484 xMouse:=x; yMouse:=y; 6485 if (ClientMode=cEditMap) and (ssLeft in Shift) and not tracking then 6486 begin 6487 MouseLoc:=LocationOfScreenPixel(x,y); 6488 if MouseLoc<>BrushLoc then 6489 MapBoxMouseDown(nil, mbLeft, Shift, x, y); 6490 end 6491 (*else if idle and (UnFocus>=0) then 6492 begin 6493 qx:=(xMouse*32+yMouse*66+16*66) div(32*66)-1; 6494 qy:=(yMouse*66-xMouse*32-16*66+2000*33*32) div(32*66)-999; 6495 MouseLoc:=(xw+(qx-qy+2048) div 2-1024+G.lx) mod G.lx+G.lx*(yw+qx+qy); 6496 ShowMoveHint(MouseLoc); 6497 end*) 6498 end; 6499 6500 procedure TMainScreen.mShowClick(Sender: TObject); 6501 begin 6502 TMenuItem(Sender).Checked:=not TMenuItem(Sender).Checked; 6503 SetMapOptions; 6504 MapValid:=false; 6505 PaintAllMaps; 6506 end; 6507 6508 procedure TMainScreen.mNamesClick(Sender: TObject); 6509 var 6510 p1: integer; 6511 begin 6512 mNames.Checked:=not mNames.Checked; 6513 GenerateNames:=mNames.Checked; 6514 for p1:=0 to nPl-1 do if Tribe[p1]<>nil then 6515 if GenerateNames then Tribe[p1].NumberName:=-1 6516 else Tribe[p1].NumberName:=p1; 6517 MapValid:=false; 6518 PaintAll; 6519 end; 6520 6521 function TMainScreen.IsPanelPixel(x,y: integer): boolean; 6522 begin 6523 result:= (y>=TopBarHeight+MapHeight) 6524 or (y>=ClientHeight-PanelHeight) and ((x<xMidPanel) or (x>=xRightPanel)) 6525 end; 6526 6527 procedure TMainScreen.FormMouseDown(Sender: TObject; Button: TMouseButton; 6528 Shift: TShiftState; x, y: integer); 6529 begin 6530 if idle then 6531 if (x<40) and (y<40) then 6532 begin 6533 if GameMode<>cMovie then 6534 begin 6535 InitPopup(GamePopup); 6536 if FullScreen then 6537 GamePopup.Popup(Left,Top+TopBarHeight-1) 6538 else GamePopup.Popup(Left+4,Top+GetSystemMetrics(SM_CYCAPTION)+4+TopBarHeight-1); 6539 end 6540 end 6541 else if IsPanelPixel(x,y) then 6542 PanelBoxMouseDown(Sender,Button,Shift,x,y-(ClientHeight-PanelHeight)) 6543 else if (y>=TopBarHeight) and (x>=MapOffset) and (x<MapOffset+MapWidth) then 6544 MapBoxMouseDown(Sender,Button,Shift,x-MapOffset,y-TopBarHeight) 6545 end; 6546 6547 procedure TMainScreen.FormMouseMove(Sender: TObject; Shift: TShiftState; x, 6548 y: integer); 6549 begin 6550 if idle then 6551 if IsPanelPixel(x,y) then 6552 PanelBoxMouseMove(Sender,Shift,x,y-(ClientHeight-PanelHeight)) 6553 else if (y>=TopBarHeight) and (x>=MapOffset) and (x<MapOffset+MapWidth) then 6554 MapBoxMouseMove(Sender,Shift,x-MapOffset,y-TopBarHeight); 6555 end; 6556 6557 procedure TMainScreen.FormMouseUp(Sender: TObject; Button: TMouseButton; 6558 Shift: TShiftState; x, y: integer); 6559 begin 6560 if idle then 6561 PanelBoxMouseUp(Sender,Button,Shift,x,y-(ClientHeight-PanelHeight)); 6562 end; 6563 6564 procedure TMainScreen.FormPaint(Sender: TObject); 6565 begin 6566 MainOffscreenPaint; 6567 if (MapOffset>0) or (MapOffset+MapWidth<ClientWidth) then with canvas do 6568 begin // pillarbox, make left and right border black 6569 if me<0 then 6570 brush.color:=$000000 6571 else brush.color:=EmptySpaceColor; 6572 if xMidPanel>MapOffset then 6573 FillRect(Rect(0,TopBarHeight,MapOffset,TopBarHeight+MapHeight-overlap)) 6574 else 6575 begin 6576 FillRect(Rect(0,TopBarHeight,xMidPanel,TopBarHeight+MapHeight-overlap)); 6577 FillRect(Rect(xMidPanel,TopBarHeight,MapOffset,TopBarHeight+MapHeight)); 6578 end; 6579 if xRightPanel<MapOffset+MapWidth then 6580 FillRect(Rect(MapOffset+MapWidth,TopBarHeight,ClientWidth,TopBarHeight+MapHeight-overlap)) 6581 else 6582 begin 6583 FillRect(Rect(MapOffset+MapWidth,TopBarHeight,xRightPanel,TopBarHeight+MapHeight)); 6584 FillRect(Rect(xRightPanel,TopBarHeight,ClientWidth,TopBarHeight+MapHeight-overlap)); 6585 end; 6586 Brush.Style:=bsClear; 6587 end; 6588 BitBlt(Canvas.Handle,MapOffset,TopBarHeight,MapWidth,MapHeight-overlap,offscreen.Canvas.Handle, 6589 0,0,SRCCOPY); 6590 BitBlt(Canvas.Handle,0,0,ClientWidth,TopBarHeight,TopBar.Canvas.Handle, 6591 0,0,SRCCOPY); 6592 if xMidPanel>MapOffset then 6593 BitBlt(Canvas.Handle,xMidPanel,TopBarHeight+MapHeight-overlap, 6594 ClientWidth div 2-xMidPanel,overlap, 6595 offscreen.Canvas.Handle,xMidPanel-MapOffset,MapHeight-overlap,SRCCOPY) 6596 else BitBlt(Canvas.Handle,MapOffset,TopBarHeight+MapHeight-overlap, 6597 ClientWidth div 2-MapOffset,overlap, 6598 offscreen.Canvas.Handle,0,MapHeight-overlap,SRCCOPY); 6599 if xRightPanel<MapOffset+MapWidth then 6600 BitBlt(Canvas.Handle,ClientWidth div 2,TopBarHeight+MapHeight-overlap, 6601 xRightPanel-ClientWidth div 2,overlap, 6602 offscreen.Canvas.Handle,ClientWidth div 2-MapOffset,MapHeight-overlap,SRCCOPY) 6603 else BitBlt(Canvas.Handle,ClientWidth div 2,TopBarHeight+MapHeight-overlap, 6604 MapOffset+MapWidth-ClientWidth div 2,overlap, 6605 offscreen.Canvas.Handle,ClientWidth div 2-MapOffset,MapHeight-overlap,SRCCOPY); 6606 BitBlt(Canvas.Handle,0,TopBarHeight+MapHeight-overlap,xMidPanel,overlap, 6607 Panel.Canvas.Handle,0,0,SRCCOPY); 6608 BitBlt(Canvas.Handle,xRightPanel,TopBarHeight+MapHeight-overlap,Panel.Width-xRightPanel, 6609 overlap,Panel.Canvas.Handle,xRightPanel,0,SRCCOPY); 6610 BitBlt(Canvas.Handle,0,TopBarHeight+MapHeight,Panel.Width,PanelHeight-overlap, 6611 Panel.Canvas.Handle,0,overlap,SRCCOPY); 6612 if (pLogo>=0) and (G.RO[pLogo]=nil) and (AILogo[pLogo]<>nil) then 6613 BitBlt(Canvas.Handle, xRightPanel+10-(16+64), ClientHeight-PanelHeight, 64,64, 6614 AILogo[pLogo].Canvas.Handle,0,0,SRCCOPY); 6615 end; 6616 6617 procedure TMainScreen.RectInvalidate(Left,Top,Rigth,Bottom: integer); 6618 var 6619 r0: HRgn; 6620 begin 6621 r0:=CreateRectRgn(Left,Top,Rigth,Bottom); 6622 InvalidateRgn(Handle,r0,false); 6623 DeleteObject(r0); 6624 end; 6625 6626 procedure TMainScreen.SmartRectInvalidate(Left,Top,Rigth,Bottom: integer); 6627 var 6628 i: integer; 6629 r0,r1: HRgn; 6630 begin 6631 r0:=CreateRectRgn(Left,Top,Rigth,Bottom); 6632 for i:=0 to ControlCount-1 do 6633 if not (Controls[i] is TArea) and Controls[i].Visible then 6634 begin 6635 with Controls[i].BoundsRect do 6636 r1:=CreateRectRgn(Left,Top,Right,Bottom); 6637 CombineRgn(r0,r0,r1,RGN_DIFF); 6638 DeleteObject(r1); 6639 end; 6640 InvalidateRgn(Handle,r0,false); 6641 DeleteObject(r0); 6642 end; 6643 6644 procedure TMainScreen.mRepClicked(Sender: TObject); 6645 begin 6646 with TMenuItem(Sender) do 6647 begin 6648 Checked:=not Checked; 6649 if Checked then CityRepMask:=CityRepMask or (1 shl (Tag shr 8)) 6650 else CityRepMask:=CityRepMask and not (1 shl (Tag shr 8)) 6651 end 6652 end; 6653 6654 procedure TMainScreen.mLogClick(Sender: TObject); 6655 begin 6656 LogDlg.Show 6657 end; 6658 6659 procedure TMainScreen.FormShow(Sender: TObject); 6660 begin 6661 Timer1.Enabled:=true 6662 end; 6663 6664 procedure TMainScreen.FormClose(Sender: TObject; var Action: TCloseAction); 6665 begin 6666 Timer1.Enabled:=false 6667 end; 6668 6669 procedure TMainScreen.Radio(Sender: TObject); 6670 begin 6671 TMenuItem(Sender).Checked:=true 6672 end; 6673 6674 procedure TMainScreen.mManipClick(Sender: TObject); 6675 var 6676 Flag: integer; 6677 begin 6678 with TMenuItem(Sender) do 6679 begin 6680 Flag:=1 shl (Tag shr 8); 6681 if Checked then Server(sClearTestFlag,0,Flag,nil^) 6682 else 6683 begin 6684 Server(sSetTestFlag,0,Flag,nil^); 6685 Play('CHEAT'); 6686 end; 6687 if not supervising then 6688 begin 6689 if Flag=tfUncover then 6690 begin MapValid:=false; PaintAllMaps; end 6691 else if Flag=tfAllTechs then 6692 TellNewModels 6693 end 6694 end 6695 end; 6696 6697 procedure TMainScreen.MapBtnClick(Sender: TObject); 6698 begin 6699 with TButtonC(Sender) do 6700 begin 6701 MapOptionChecked:=MapOptionChecked xor (1 shl (Tag shr 8)); 6702 SetMapOptions; 6703 ButtonIndex:=MapOptionChecked shr (Tag shr 8) and 1 +2 6704 end; 6705 if Sender=MapBtn0 then 6706 begin MiniPaint; PanelPaint end // update mini map only 6707 else begin MapValid:=false; PaintAllMaps; end; // update main map 6708 end; 6709 6710 procedure TMainScreen.GrWallBtnDownChanged(Sender: TObject); 6711 begin 6712 if TButtonBase(Sender).Down then 6713 begin 6714 MapOptionChecked:=MapOptionChecked or (1 shl moGreatWall); 6715 TButtonBase(Sender).Hint:=''; 6716 end 6717 else 6718 begin 6719 MapOptionChecked:=MapOptionChecked and not (1 shl moGreatWall); 6720 TButtonBase(Sender).Hint:=Phrases.Lookup('CONTROLS',-1+TButtonBase(Sender).Tag and $FF); 6721 end; 6722 SetMapOptions; 6723 MapValid:=false; 6724 PaintAllMaps; 6725 end; 6726 6727 procedure TMainScreen.BareBtnDownChanged(Sender: TObject); 6728 begin 6729 if TButtonBase(Sender).Down then 6730 begin 6731 MapOptionChecked:=MapOptionChecked or (1 shl moBareTerrain); 6732 TButtonBase(Sender).Hint:=''; 6733 end 6734 else 6735 begin 6736 MapOptionChecked:=MapOptionChecked and not (1 shl moBareTerrain); 6737 TButtonBase(Sender).Hint:=Phrases.Lookup('CONTROLS',-1+TButtonBase(Sender).Tag and $FF); 6738 end; 6739 SetMapOptions; 6740 MapValid:=false; 6741 PaintAllMaps; 6742 end; 6743 6744 procedure TMainScreen.FormKeyUp(Sender: TObject; var Key: Word; 6745 Shift: TShiftState); 6746 begin 6747 if idle and (Key=VK_APPS) then 6748 begin 6749 InitPopup(GamePopup); 6750 if FullScreen then 6751 GamePopup.Popup(Left,Top+TopBarHeight-1) 6752 else GamePopup.Popup(Left+4,Top+GetSystemMetrics(SM_CYCAPTION)+4+TopBarHeight-1); 6753 exit 6754 end // windows menu button calls game menu 6755 end; 6756 6757 procedure TMainScreen.CreateUnitClick(Sender: TObject); 6758 var 6759 p1,mix: integer; 6760 begin 6761 p1:=TComponent(Sender).Tag shr 16; 6762 mix:=TComponent(Sender).Tag and $FFFF; 6763 if Server(sCreateUnit+p1 shl 4,me,mix,EditLoc)>=rExecuted then 6764 PaintLoc(EditLoc); 6765 end; 6766 6767 procedure TMainScreen.mSoundOffClick(Sender: TObject); 6768 begin 6769 SoundMode:=smOff; 6770 end; 6771 6772 procedure TMainScreen.mSoundOnClick(Sender: TObject); 6773 begin 6774 SoundMode:=smOn; 6775 end; 6776 6777 procedure TMainScreen.mSoundOnAltClick(Sender: TObject); 6778 begin 6779 SoundMode:=smOnAlt; 6780 end; 6781 6782 {procedure TMainScreen.AdviceBtnClick; 6783 var 6784 OldAdviceLoc: integer; 6785 begin 6786 DestinationMarkON:=false; 6787 PaintDestination; 6788 AdvisorDlg.GiveStrategyAdvice; 6789 OldAdviceLoc:=MainMap.AdviceLoc; 6790 MainMap.AdviceLoc:=-1; 6791 PaintLoc(OldAdviceLoc); 6792 end;} 6793 6794 {procedure TMainScreen.SetAdviceLoc(Loc: integer; AvoidRect: TRect); 6795 var 6796 OldAdviceLoc,x,y: integer; 6797 begin 6798 if Loc<>MainMap.AdviceLoc then 6799 begin 6800 if Loc>=0 then 6801 begin // center 6802 y:=Loc div G.lx; 6803 x:=(Loc+G.lx - AvoidRect.Right div (2*66)) mod G.lx; 6804 Centre(y*G.lx+x); 6805 PaintAllMaps; 6806 end; 6807 OldAdviceLoc:=MainMap.AdviceLoc; 6808 MainMap.AdviceLoc:=Loc; 6809 PaintLoc(OldAdviceLoc); 6810 PaintLoc(MainMap.AdviceLoc); 6811 end; 6812 end;} 6813 6814 procedure TMainScreen.UnitInfoBtnClick(Sender: TObject); 6815 begin 6816 if UnFocus>=0 then 6817 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, MyUn[UnFocus].mix) 6818 end; 6819 6820 procedure TMainScreen.ViewpointClick(Sender: TObject); 6821 begin 6822 SetViewpoint(TMenuItem(Sender).Tag); 6823 end; 6824 6825 procedure TMainScreen.DebugMapClick(Sender: TObject); 6826 begin 6827 SetDebugMap(TMenuItem(Sender).Tag); 6828 end; 6829 6830 procedure TMainScreen.mSmallTilesClick(Sender: TObject); 6831 begin 6832 SetTileSize(33,16); 6833 end; 6834 6835 procedure TMainScreen.mNormalTilesClick(Sender: TObject); 6836 begin 6837 SetTileSize(48,24); 6838 end; 6839 6840 procedure TMainScreen.SetTileSize(x,y: integer); 6841 var 6842 i,CenterLoc: integer; 6843 begin 6844 CenterLoc:=(xw+MapWidth div (xxt*4)) mod G.lx+(yw+MapHeight div (yyt*2))*G.lx; 6845 IsoEngine.ApplyTileSize(x,y); 6846 FormResize(nil); 6847 Centre(CenterLoc); 6848 PaintAllMaps; 6849 for i:=0 to Screen.FormCount-1 do 6850 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) then 6851 TBufferedDrawDlg(Screen.Forms[i]).SmartUpdateContent(false); 6852 end; 6853 6854 procedure TMainScreen.SaveSettings; 6855 var 6856 i,j: integer; 6857 Reg: TRegistry; 6858 begin 6859 OptionChecked:=OptionChecked and soExtraMask; 6860 for i:=0 to ComponentCount-1 do if Components[i] is TMenuItem then 6861 for j:=0 to nSaveOption-1 do 6862 if TMenuItem(Components[i]).Checked 6863 and (TMenuItem(Components[i]).Tag=SaveOption[j]) then 6864 inc(OptionChecked,1 shl j); 6865 6866 Reg:=TRegistry.Create; 6867 Reg.OpenKey('SOFTWARE\cevo\RegVer9',true); 6868 Reg.WriteInteger('TileWidth',xxt*2); 6869 Reg.WriteInteger('TileHeight',yyt*2); 6870 Reg.WriteInteger('OptionChecked', OptionChecked); 6871 Reg.WriteInteger('MapOptionChecked', MapOptionChecked); 6872 Reg.WriteInteger('CityReport',integer(CityRepMask)); 6873 Reg.closekey; 6874 Reg.Free; 6875 end; 6876 6877 procedure TMainScreen.MovieSpeedBtnClick(Sender: TObject); 6878 begin 6879 MovieSpeed:=TButtonB(Sender).Tag shr 8; 6880 CheckMovieSpeedBtnState; 6881 end; 7961 end; } 7962 7963 procedure TMainScreen.UnitInfoBtnClick(Sender: TObject); 7964 begin 7965 if UnFocus >= 0 then 7966 UnitStatDlg.ShowNewContent_OwnModel(wmPersistent, MyUn[UnFocus].mix) 7967 end; 7968 7969 procedure TMainScreen.ViewpointClick(Sender: TObject); 7970 begin 7971 SetViewpoint(TMenuItem(Sender).Tag); 7972 end; 7973 7974 procedure TMainScreen.DebugMapClick(Sender: TObject); 7975 begin 7976 SetDebugMap(TMenuItem(Sender).Tag); 7977 end; 7978 7979 procedure TMainScreen.mSmallTilesClick(Sender: TObject); 7980 begin 7981 SetTileSize(33, 16); 7982 end; 7983 7984 procedure TMainScreen.mNormalTilesClick(Sender: TObject); 7985 begin 7986 SetTileSize(48, 24); 7987 end; 7988 7989 procedure TMainScreen.SetTileSize(x, y: integer); 7990 var 7991 i, CenterLoc: integer; 7992 begin 7993 CenterLoc := (xw + MapWidth div (xxt * 4)) mod G.lx + 7994 (yw + MapHeight div (yyt * 2)) * G.lx; 7995 IsoEngine.ApplyTileSize(x, y); 7996 FormResize(nil); 7997 Centre(CenterLoc); 7998 PaintAllMaps; 7999 for i := 0 to Screen.FormCount - 1 do 8000 if Screen.Forms[i].Visible and (Screen.Forms[i] is TBufferedDrawDlg) 8001 then 8002 TBufferedDrawDlg(Screen.Forms[i]).SmartUpdateContent(false); 8003 end; 8004 8005 procedure TMainScreen.SaveSettings; 8006 var 8007 i, j: integer; 8008 Reg: TRegistry; 8009 begin 8010 OptionChecked := OptionChecked and soExtraMask; 8011 for i := 0 to ComponentCount - 1 do 8012 if Components[i] is TMenuItem then 8013 for j := 0 to nSaveOption - 1 do 8014 if TMenuItem(Components[i]).Checked and 8015 (TMenuItem(Components[i]).Tag = SaveOption[j]) then 8016 inc(OptionChecked, 1 shl j); 8017 8018 Reg := TRegistry.Create; 8019 Reg.OpenKey('SOFTWARE\cevo\RegVer9', true); 8020 Reg.WriteInteger('TileWidth', xxt * 2); 8021 Reg.WriteInteger('TileHeight', yyt * 2); 8022 Reg.WriteInteger('OptionChecked', OptionChecked); 8023 Reg.WriteInteger('MapOptionChecked', MapOptionChecked); 8024 Reg.WriteInteger('CityReport', integer(CityRepMask)); 8025 Reg.closekey; 8026 Reg.free; 8027 end; 8028 8029 procedure TMainScreen.MovieSpeedBtnClick(Sender: TObject); 8030 begin 8031 MovieSpeed := TButtonB(Sender).Tag shr 8; 8032 CheckMovieSpeedBtnState; 8033 end; 6882 8034 6883 8035 initialization 8036 6884 8037 QueryPerformanceFrequency(PerfFreq); 6885 8038 6886 8039 end. 6887 -
trunk/LocalPlayer/Tribes.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Tribes; 4 3 … … 6 5 7 6 uses 8 Protocol, ScreenTools,9 10 Classes, Graphics,SysUtils;7 Protocol, ScreenTools, 8 9 Classes, Graphics, SysUtils; 11 10 12 11 type 13 TCityPicture=record 14 xShield,yShield:integer; 15 end; 16 TModelPicture=record 17 HGr,pix,xShield,yShield:integer; 18 end; 19 TModelPictureInfo=record 20 trix,mix,pix,Hash: integer; 21 GrName: ShortString 22 end; 23 24 TTribe=class 25 symHGr, sympix, faceHGr, facepix, cHGr, cpix, //symbol and city graphics 26 cAge, mixSlaves: integer; 27 Color: TColor; 28 NumberName: integer; 29 CityPicture: array[0..3] of TCityPicture; 30 ModelPicture: array[-1..256] of TModelPicture; // -1 is building site 31 ModelName: array[-1..256] of string; 32 constructor Create(FileName: string); 33 destructor Destroy; override; 34 function GetCityName(i: integer): string; 35 {$IFNDEF SCR}procedure SetCityName(i: integer; NewName: string);{$ENDIF} 36 {$IFNDEF SCR}function TString(Template: string): string; 37 function TPhrase(Item: string): string;{$ENDIF} 38 procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean); 39 function ChooseModelPicture(var Picture: TModelPictureInfo; 40 code,Turn: integer; ForceNew: boolean): boolean; 41 procedure InitAge(Age: integer); 42 protected 43 CityLine0,nCityLines: integer; 44 Name: array['a'..'z'] of string; 45 Script: tstringlist; 12 TCityPicture = record 13 xShield, yShield: integer; 14 end; 15 16 TModelPicture = record 17 HGr, pix, xShield, yShield: integer; 18 end; 19 20 TModelPictureInfo = record 21 trix, mix, pix, Hash: integer; 22 GrName: ShortString end; 23 24 TTribe = class symHGr, sympix, faceHGr, facepix, cHGr, cpix, 25 // symbol and city graphics 26 cAge, mixSlaves: integer; 27 Color: TColor; 28 NumberName: integer; 29 CityPicture: array [0 .. 3] of TCityPicture; 30 ModelPicture: array [-1 .. 256] of TModelPicture; // -1 is building site 31 ModelName: array [-1 .. 256] of string; 32 constructor Create(FileName: string); 33 destructor Destroy; override; 34 function GetCityName(i: integer): string; 35 {$IFNDEF SCR} procedure SetCityName(i: integer; NewName: string); {$ENDIF} 36 {$IFNDEF SCR} function TString(Template: string): string; 37 function TPhrase(Item: string): string; {$ENDIF} 38 procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean); 39 function ChooseModelPicture(var Picture: TModelPictureInfo; 40 code, Turn: integer; ForceNew: boolean): boolean; 41 procedure InitAge(Age: integer); 42 protected 43 CityLine0, nCityLines: integer; 44 Name: array ['a' .. 'z'] of string; 45 Script: tstringlist; 46 46 end; 47 47 48 48 var 49 Tribe: array[0..nPl-1] of TTribe;50 HGrStdUnits: integer;49 Tribe: array [0 .. nPl - 1] of TTribe; 50 HGrStdUnits: integer; 51 51 52 52 procedure Init; … … 56 56 procedure FindStdModelPicture(code: integer; var pix: integer; 57 57 var Name: string); 58 function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): boolean; 59 procedure FindPosition(HGr,x,y,xmax,ymax: integer; Mark: TColor; var xp,yp: integer); 60 58 function GetTribeInfo(FileName: string; var Name: string; 59 var Color: TColor): boolean; 60 procedure FindPosition(HGr, x, y, xmax, ymax: integer; Mark: TColor; 61 var xp, yp: integer); 61 62 62 63 implementation 63 64 64 65 uses 65 Directories; 66 66 Directories; 67 67 68 68 type 69 TChosenModelPictureInfo=record 70 Hash,HGr,pix: integer; 71 ModelName: ShortString 72 end; 73 74 TPictureList=array[0..99999] of TChosenModelPictureInfo; 75 76 var 77 StdUnitScript: tstringlist; 78 PictureList: ^TPictureList; 79 nPictureList: integer; 80 81 82 procedure Init; 83 begin 84 StdUnitScript:=tstringlist.Create; 85 StdUnitScript.LoadFromFile(LocalizedFilePath('Tribes\StdUnits.txt')); 86 nPictureList:=0; 87 PictureList:=nil; 88 end; 89 90 procedure Done; 91 begin 92 ReallocMem(PictureList,0); 93 StdUnitScript.Free; 94 end; 95 96 function CityName(Founder: integer): string; 97 begin 98 if not GenerateNames then 99 result:=Format('%d.%d',[Founder shr 12, Founder and $FFF]) 100 else result:=Tribe[Founder shr 12].GetCityName(Founder and $FFF); 101 end; 102 103 function ModelCode(const ModelInfo: TModelInfo): integer; 104 begin 105 with ModelInfo do 106 begin 107 case Kind of 108 mkSelfDeveloped, mkEnemyDeveloped: 109 case Domain of {age determination} 110 dGround: 111 if (Attack>=Defense*4) 112 or (Attack>0) and (MaxUpgrade<10) 113 and (Cap and (1 shl (mcArtillery-mcFirstNonCap))<>0) then 114 begin 115 result:=170; 116 if MaxUpgrade>=12 then inc(result,3) 117 else if (MaxUpgrade>=10) or (Weight>7) then inc(result,2) 118 else if MaxUpgrade>=4 then inc(result,1) 69 TChosenModelPictureInfo = record 70 Hash, HGr, pix: integer; 71 ModelName: ShortString end; 72 73 TPictureList = array [0 .. 99999] of TChosenModelPictureInfo; 74 75 var 76 StdUnitScript: tstringlist; 77 PictureList: ^TPictureList; 78 nPictureList: integer; 79 80 procedure Init; 81 begin 82 StdUnitScript := tstringlist.Create; 83 StdUnitScript.LoadFromFile(LocalizedFilePath('Tribes\StdUnits.txt')); 84 nPictureList := 0; 85 PictureList := nil; 86 end; 87 88 procedure Done; 89 begin 90 ReallocMem(PictureList, 0); 91 StdUnitScript.Free; 92 end; 93 94 function CityName(Founder: integer): string; 95 begin 96 if not GenerateNames then 97 result := Format('%d.%d', [Founder shr 12, Founder and $FFF]) 98 else 99 result := Tribe[Founder shr 12].GetCityName(Founder and $FFF); 100 end; 101 102 function ModelCode(const ModelInfo: TModelInfo): integer; 103 begin 104 with ModelInfo do 105 begin 106 case Kind of 107 mkSelfDeveloped, mkEnemyDeveloped: 108 case Domain of { age determination } 109 dGround: 110 if (Attack >= Defense * 4) or (Attack > 0) and (MaxUpgrade < 10) 111 and (Cap and (1 shl (mcArtillery - mcFirstNonCap)) <> 0) then 112 begin 113 result := 170; 114 if MaxUpgrade >= 12 then 115 inc(result, 3) 116 else if (MaxUpgrade >= 10) or (Weight > 7) then 117 inc(result, 2) 118 else if MaxUpgrade >= 4 then 119 inc(result, 1) 120 end 121 else 122 begin 123 result := 100; 124 if MaxUpgrade >= 12 then 125 inc(result, 6) 126 else if (MaxUpgrade >= 10) or (Weight > 7) then 127 inc(result, 5) 128 else if MaxUpgrade >= 6 then 129 inc(result, 4) 130 else if MaxUpgrade >= 4 then 131 inc(result, 3) 132 else if MaxUpgrade >= 2 then 133 inc(result, 2) 134 else if MaxUpgrade >= 1 then 135 inc(result, 1); 136 if Speed >= 250 then 137 if (result >= 105) and (Attack <= Defense) then 138 result := 110 139 else 140 inc(result, 30) 141 end; 142 dSea: 143 begin 144 result := 200; 145 if MaxUpgrade >= 8 then 146 inc(result, 3) 147 else if MaxUpgrade >= 6 then 148 inc(result, 2) 149 else if MaxUpgrade >= 3 then 150 inc(result, 1); 151 if Cap and (1 shl (mcSub - mcFirstNonCap)) <> 0 then 152 result := 240 153 else if ATrans_Fuel > 0 then 154 result := 220 155 else if (result >= 202) and (Attack = 0) and (TTrans > 0) then 156 result := 210; 157 end; 158 dAir: 159 begin 160 result := 300; 161 if (Bombs > 0) or (TTrans > 0) then 162 inc(result, 10); 163 if Speed > 850 then 164 inc(result, 1) 165 end; 166 end; 167 mkSpecial_TownGuard: 168 result := 41; 169 mkSpecial_Boat: 170 result := 64; 171 mkSpecial_SubCabin: 172 result := 71; 173 mkSpecial_Glider: 174 result := 73; 175 mkSlaves: 176 result := 74; 177 mkSettler: 178 if Speed > 150 then 179 result := 11 180 else 181 result := 10; 182 mkDiplomat: 183 result := 21; 184 mkCaravan: 185 result := 30; 186 end; 187 end; 188 end; 189 190 var 191 Input: string; 192 193 function Get: string; 194 195 var 196 p: integer; 197 begin 198 while (Input <> '') and ((Input[1] = ' ') or (Input[1] = #9)) do 199 Delete(Input, 1, 1); 200 p := pos(',', Input); 201 if p = 0 then 202 p := Length(Input) + 1; 203 result := Copy(Input, 1, p - 1); 204 Delete(Input, 1, p) 205 end; 206 207 function GetNum: integer; 208 209 var 210 i: integer; 211 begin 212 val(Get, result, i); 213 if i <> 0 then 214 result := 0 215 end; 216 217 procedure FindStdModelPicture(code: integer; var pix: integer; 218 var Name: string); 219 220 var 221 i: integer; 222 begin 223 for i := 0 to StdUnitScript.Count - 1 do 224 begin // look through StdUnits 225 Input := StdUnitScript[i]; 226 pix := GetNum; 227 if code = GetNum then 228 begin 229 Name := Get; 230 exit; 231 end 232 end; 233 pix := -1 234 end; 235 236 function GetTribeInfo(FileName: string; var Name: string; 237 var Color: TColor): boolean; 238 239 var 240 found: integer; 241 TribeScript: TextFile; 242 begin 243 Name := ''; 244 Color := $FFFFFF; 245 found := 0; 246 AssignFile(TribeScript, LocalizedFilePath('Tribes\' + FileName + 247 '.tribe.txt')); 248 Reset(TribeScript); 249 while not EOF(TribeScript) do 250 begin 251 ReadLn(TribeScript, Input); 252 if Copy(Input, 1, 7) = '#CHOOSE' then 253 begin 254 Name := Copy(Input, 9, 255); 255 found := found or 1; 256 if found = 3 then 257 break 258 end 259 else if Copy(Input, 1, 6) = '#COLOR' then 260 begin 261 Color := HexStringToColor(Copy(Input, 7, 255)); 262 found := found or 2; 263 if found = 3 then 264 break 265 end 266 end; 267 CloseFile(TribeScript); 268 result := found = 3; 269 end; 270 271 constructor TTribe.Create(FileName: string); 272 273 var 274 line: integer; 275 variant: char; 276 Item: string; 277 begin 278 inherited Create; 279 for variant := 'a' to 'z' do 280 Name[variant] := ''; 281 Script := tstringlist.Create; 282 Script.LoadFromFile(LocalizedFilePath('Tribes\' + FileName + '.tribe.txt')); 283 CityLine0 := 0; 284 nCityLines := 0; 285 for line := 0 to Script.Count - 1 do 286 begin 287 Input := Script[line]; 288 if (CityLine0 > 0) and (nCityLines = 0) and 289 ((Input = '') or (Input[1] = '#')) then 290 nCityLines := line - CityLine0; 291 if (Length(Input) >= 3) and (Input[1] = '#') and (Input[2] in ['a' .. 'z'] 292 ) and (Input[3] = ' ') then 293 Name[Input[2]] := Copy(Input, 4, 255) 294 else if Copy(Input, 1, 6) = '#COLOR' then 295 Color := HexStringToColor(Copy(Input, 7, 255)) 296 else if Copy(Input, 1, 7) = '#CITIES' then 297 CityLine0 := line + 1 298 else if Copy(Input, 1, 8) = '#SYMBOLS' then 299 begin 300 Delete(Input, 1, 9); 301 Item := Get; 302 sympix := GetNum; 303 symHGr := LoadGraphicSet(Item); 304 end 305 end; 306 FillChar(ModelPicture, SizeOf(ModelPicture), 0); 307 NumberName := -1; 308 cAge := -1; 309 mixSlaves := -1; 310 end; 311 312 destructor TTribe.Destroy; 313 begin 314 Script.Free; 315 inherited Destroy; 316 end; 317 318 procedure FindPosition(HGr, x, y, xmax, ymax: integer; Mark: TColor; 319 var xp, yp: integer); 320 begin 321 xp := 0; 322 while (xp < xmax) and (GrExt[HGr].Data.Canvas.Pixels[x + 1 + xp, y] 323 <> Mark) do 324 inc(xp); 325 yp := 0; 326 while (yp < ymax) and (GrExt[HGr].Data.Canvas.Pixels[x, y + 1 + yp] 327 <> Mark) do 328 inc(yp); 329 end; 330 331 function TTribe.GetCityName(i: integer): string; 332 begin 333 result := ''; 334 if nCityLines > i then 335 begin 336 result := Script[CityLine0 + i]; 337 while (result <> '') and ((result[1] = ' ') or (result[1] = #9)) do 338 Delete(result, 1, 1); 339 end 340 {$IFNDEF SCR} else 341 result := Format(TPhrase('GENCITY'), [i + 1]){$ENDIF} 342 end; 343 344 {$IFNDEF SCR} 345 procedure TTribe.SetCityName(i: integer; NewName: string); 346 begin 347 while nCityLines <= i do 348 begin 349 Script.Insert(CityLine0 + nCityLines, Format(TPhrase('GENCITY'), 350 [nCityLines + 1])); 351 inc(nCityLines); 352 end; 353 Script[CityLine0 + i] := NewName; 354 end; 355 356 function TTribe.TString(Template: string): string; 357 358 var 359 p: integer; 360 variant: char; 361 CaseUp: boolean; 362 begin 363 repeat 364 p := pos('#', Template); 365 if (p = 0) or (p = Length(Template)) then 366 break; 367 variant := Template[p + 1]; 368 CaseUp := variant in ['A' .. 'Z']; 369 if CaseUp then 370 inc(variant, 32); 371 Delete(Template, p, 2); 372 if variant in ['a' .. 'z'] then 373 begin 374 if NumberName < 0 then 375 Insert(Name[variant], Template, p) 376 else 377 Insert(Format('P%d', [NumberName]), Template, p); 378 if CaseUp and (Length(Template) >= p) and 379 (Template[p] in ['a' .. 'z', #$E0 .. #$FF]) then 380 dec(Template[p], 32); 381 end 382 until false; 383 result := Template; 384 end; 385 386 function TTribe.TPhrase(Item: string): string; 387 begin 388 result := TString(Phrases.Lookup(Item)); 389 end; 390 {$ENDIF} 391 392 procedure TTribe.InitAge(Age: integer); 393 type 394 TLine = array [0 .. 649, 0 .. 2] of Byte; 395 var 396 i, x, gray: integer; 397 Item: string; 398 begin 399 if Age = cAge then 400 exit; 401 cAge := Age; 402 with Script do 403 begin 404 i := 0; 405 while (i < Count) and 406 (Copy(Strings[i], 1, 6) <> '#AGE' + char(48 + Age) + ' ') do 407 inc(i); 408 if i < Count then 409 begin 410 Input := Strings[i]; 411 system.Delete(Input, 1, 6); 412 Item := Get; 413 cpix := GetNum; 414 // init city graphics 415 if Age < 2 then 416 begin 417 if CompareText(Item, 'stdcities') = 0 then 418 case cpix of 419 3: 420 cpix := 0; 421 6: 422 begin 423 cpix := 0; 424 Item := 'Nation2'; 425 end 426 end; 427 cHGr := LoadGraphicSet(Item); 428 for x := 0 to 3 do 429 with CityPicture[x] do 430 begin 431 FindPosition(cHGr, x * 65, cpix * 49, 63, 47, $00FFFF, 432 xShield, yShield); 433 // FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf); 434 end 435 end 436 else 437 cHGr := -1; 438 439 {$IFNDEF SCR} 440 Get; 441 GetNum; 442 Item := Get; 443 if Item = '' then 444 faceHGr := -1 445 else 446 begin 447 faceHGr := LoadGraphicSet(Item); 448 facepix := GetNum; 449 if GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65, 450 facepix div 10 * 49 + 48] = $00FFFF then 451 begin // generate shield picture 452 GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65, 453 facepix div 10 * 49 + 48] := $000000; 454 gray := $B8B8B8; 455 ImageOp_BCC(GrExt[faceHGr].Data, Templates, 456 facepix mod 10 * 65 + 1, facepix div 10 * 49 + 1, 1, 25, 64, 48, 457 gray, Color); 119 458 end 120 else121 begin122 result:=100;123 if MaxUpgrade>=12 then inc(result,6)124 else if (MaxUpgrade>=10) or (Weight>7) then inc(result,5)125 else if MaxUpgrade>=6 then inc(result,4)126 else if MaxUpgrade>=4 then inc(result,3)127 else if MaxUpgrade>=2 then inc(result,2)128 else if MaxUpgrade>=1 then inc(result,1);129 if Speed>=250 then130 if (result>=105) and (Attack<=Defense) then result:=110131 else inc(result,30)132 end;133 dSea:134 begin135 result:=200;136 if MaxUpgrade>=8 then inc(result,3)137 else if MaxUpgrade>=6 then inc(result,2)138 else if MaxUpgrade>=3 then inc(result,1);139 if Cap and (1 shl (mcSub-mcFirstNonCap))<>0 then result:=240140 else if ATrans_Fuel>0 then result:=220141 else if (result>=202) and (Attack=0) and (TTrans>0) then result:=210;142 459 end; 143 dAir:144 begin145 result:=300;146 if (Bombs>0) or (TTrans>0) then inc(result,10);147 if Speed>850 then inc(result,1)148 end;149 end;150 mkSpecial_TownGuard: result:=41;151 mkSpecial_Boat: result:=64;152 mkSpecial_SubCabin: result:=71;153 mkSpecial_Glider: result:=73;154 mkSlaves: result:=74;155 mkSettler: if Speed>150 then result:=11 else result:=10;156 mkDiplomat: result:=21;157 mkCaravan: result:=30;158 end;159 end;160 end;161 162 var163 Input: string;164 165 function Get: string;166 var167 p:integer;168 begin169 while (Input<>'') and ((Input[1]=' ') or (Input[1]=#9)) do Delete(Input,1,1);170 p:=pos(',',Input);if p=0 then p:=Length(Input)+1;171 result:=Copy(Input,1,p-1);172 Delete(Input,1,p)173 end;174 175 function GetNum: integer;176 var177 i:integer;178 begin179 val(Get,result,i);180 if i<>0 then result:=0181 end;182 183 procedure FindStdModelPicture(code: integer; var pix: integer;184 var Name: string);185 var186 i: integer;187 begin188 for i:=0 to StdUnitScript.Count-1 do189 begin // look through StdUnits190 Input:=StdUnitScript[i];191 pix:=GetNum;192 if code=GetNum then begin Name:=Get; exit; end193 end;194 pix:=-1195 end;196 197 function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): boolean;198 var199 found: integer;200 TribeScript: TextFile;201 begin202 Name:='';203 Color:=$FFFFFF;204 found:=0;205 AssignFile(TribeScript,LocalizedFilePath('Tribes\'+FileName+'.tribe.txt'));206 Reset(TribeScript);207 while not EOF(TribeScript) do208 begin209 ReadLn(TribeScript,Input);210 if Copy(Input,1,7)='#CHOOSE' then211 begin212 Name:=Copy(Input,9,255);213 found:=found or 1;214 if found=3 then break215 end216 else if Copy(Input,1,6)='#COLOR' then217 begin218 Color:=HexStringToColor(Copy(Input,7,255));219 found:=found or 2;220 if found=3 then break221 end222 end;223 CloseFile(TribeScript);224 result:= found=3;225 end;226 227 constructor TTribe.Create(FileName: string);228 var229 line:integer;230 variant: char;231 Item:string;232 begin233 inherited Create;234 for variant:='a' to 'z' do Name[variant]:='';235 Script:=tstringlist.Create;236 Script.LoadFromFile(LocalizedFilePath('Tribes\'+FileName+'.tribe.txt'));237 CityLine0:=0;238 nCityLines:=0;239 for line:=0 to Script.Count-1 do240 begin241 Input:=Script[line];242 if (CityLine0>0) and (nCityLines=0) and ((Input='') or (Input[1]='#')) then243 nCityLines:=line-CityLine0;244 if (Length(Input)>=3) and (Input[1]='#') and (Input[2] in ['a'..'z'])245 and (Input[3]=' ') then246 Name[Input[2]]:=Copy(Input,4,255)247 else if Copy(Input,1,6)='#COLOR' then248 Color:=HexStringToColor(Copy(Input,7,255))249 else if Copy(Input,1,7)='#CITIES' then CityLine0:=line+1250 else if Copy(Input,1,8)='#SYMBOLS' then251 begin252 Delete(Input,1,9);253 Item:=Get;254 sympix:=GetNum;255 symHGr:=LoadGraphicSet(Item);256 end257 end;258 FillChar(ModelPicture,SizeOf(ModelPicture),0);259 NumberName:=-1;260 cAge:=-1;261 mixSlaves:=-1;262 end;263 264 destructor TTribe.Destroy;265 begin266 Script.Free;267 inherited Destroy;268 end;269 270 procedure FindPosition(HGr,x,y,xmax,ymax: integer; Mark: TColor;271 var xp,yp: integer);272 begin273 xp:=0;274 while (xp<xmax) and (GrExt[HGr].Data.Canvas.Pixels[x+1+xp,y]<>Mark) do275 inc(xp);276 yp:=0;277 while (yp<ymax) and (GrExt[HGr].Data.Canvas.Pixels[x,y+1+yp]<>Mark) do278 inc(yp);279 end;280 281 function TTribe.GetCityName(i: integer): string;282 begin283 result:='';284 if nCityLines>i then285 begin286 result:=Script[CityLine0+i];287 while (result<>'') and ((result[1]=' ') or (result[1]=#9)) do288 Delete(result,1,1);289 end290 {$IFNDEF SCR}else result:=Format(TPhrase('GENCITY'),[i+1]){$ENDIF}291 end;292 293 {$IFNDEF SCR}294 procedure TTribe.SetCityName(i: integer; NewName: string);295 begin296 while nCityLines<=i do297 begin298 Script.Insert(CityLine0+nCityLines, Format(TPhrase('GENCITY'),299 [nCityLines+1]));300 inc(nCityLines);301 end;302 Script[CityLine0+i]:=NewName;303 end;304 305 function TTribe.TString(Template: string): string;306 var307 p: integer;308 variant: char;309 CaseUp: boolean;310 begin311 repeat312 p:=pos('#',Template);313 if (p=0) or (p=Length(Template)) then Break;314 variant:=Template[p+1];315 CaseUp:= variant in ['A'..'Z'];316 if CaseUp then inc(variant,32);317 Delete(Template,p,2);318 if variant in ['a'..'z'] then319 begin320 if NumberName<0 then Insert(Name[variant],Template,p)321 else Insert(Format('P%d',[NumberName]),Template,p);322 if CaseUp and (Length(Template)>=p) and (Template[p] in ['a'..'z',#$E0..#$FF]) then323 dec(Template[p],32);324 end325 until false;326 result:=Template;327 end;328 329 function TTribe.TPhrase(Item: string): string;330 begin331 result:=TString(Phrases.Lookup(Item));332 end;333 460 {$ENDIF} 334 335 procedure TTribe.InitAge(Age: integer);336 type337 TLine=array[0..649,0..2] of Byte;338 var339 i,x,gray: integer;340 Item: string;341 begin342 if Age=cAge then exit;343 cAge:=Age;344 with Script do345 begin346 i:=0;347 while (i<Count) and (Copy(Strings[i],1,6)<>'#AGE'+char(48+Age)+' ') do348 inc(i);349 if i<Count then350 begin351 Input:=Strings[i];352 system.Delete(Input,1,6);353 Item:=Get;354 cpix:=GetNum;355 // init city graphics356 if age<2 then357 begin358 if CompareText(Item,'stdcities')=0 then359 case cpix of360 3: cpix:=0;361 6: begin cpix:=0; Item:='Nation2'; end362 end;363 cHGr:=LoadGraphicSet(Item);364 for x:=0 to 3 do with CityPicture[x] do365 begin366 FindPosition(cHGr,x*65,cpix*49,63,47,$00FFFF,xShield,yShield);367 //FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf);368 461 end 369 462 end 370 else cHGr:=-1; 371 372 {$IFNDEF SCR} 373 Get; 374 GetNum; 375 Item:=Get; 376 if Item='' then faceHGr:=-1 377 else 378 begin 379 faceHGr:=LoadGraphicSet(Item); 380 facepix:=GetNum; 381 if GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10*65,facepix div 10*49+48]=$00FFFF then 382 begin // generate shield picture 383 GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10*65,facepix div 10*49+48]:=$000000; 384 gray:=$B8B8B8; 385 ImageOp_BCC(GrExt[faceHGr].Data,Templates,facepix mod 10*65+1, 386 facepix div 10*49+1,1,25,64,48,gray,Color); 463 end; 464 465 procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; 466 IsNew: boolean); 467 var 468 i: integer; 469 ok: boolean; 470 begin 471 with Info do 472 begin 473 if not IsNew then 474 begin 475 i := nPictureList - 1; 476 while (i >= 0) and (PictureList[i].Hash <> Info.Hash) do 477 dec(i); 478 assert(i >= 0); 479 assert(PictureList[i].HGr = LoadGraphicSet(GrName)); 480 assert(PictureList[i].pix = pix); 481 ModelPicture[mix].HGr := PictureList[i].HGr; 482 ModelPicture[mix].pix := PictureList[i].pix; 483 ModelName[mix] := PictureList[i].ModelName; 484 end 485 else 486 begin 487 with ModelPicture[mix] do 488 begin 489 HGr := LoadGraphicSet(GrName); 490 pix := Info.pix; 491 inc(GrExt[HGr].pixUsed[pix]); 492 end; 493 ModelName[mix] := ''; 494 495 // read model name from tribe script 496 ok := false; 497 for i := 0 to Script.Count - 1 do 498 begin 499 Input := Script[i]; 500 if Input = '#UNITS ' + GrName then 501 ok := true 502 else if (Input <> '') and (Input[1] = '#') then 503 ok := false 504 else if ok and (GetNum = pix) then 505 begin 506 Get; 507 ModelName[mix] := Get 508 end 509 end; 510 511 if ModelName[mix] = '' then 512 begin // read model name from StdUnits.txt 513 for i := 0 to StdUnitScript.Count - 1 do 514 begin 515 Input := StdUnitScript[i]; 516 if GetNum = pix then 517 begin 518 Get; 519 ModelName[mix] := Get 520 end 521 end 522 end; 523 524 if Hash <> 0 then 525 begin 526 if nPictureList = 0 then 527 ReallocMem(PictureList, 64 * SizeOf(TChosenModelPictureInfo)) 528 else if (nPictureList >= 64) and 529 (nPictureList and (nPictureList - 1) = 0) then 530 ReallocMem(PictureList, 531 nPictureList * (2 * SizeOf(TChosenModelPictureInfo))); 532 PictureList[nPictureList].Hash := Info.Hash; 533 PictureList[nPictureList].HGr := ModelPicture[mix].HGr; 534 PictureList[nPictureList].pix := Info.pix; 535 PictureList[nPictureList].ModelName := ModelName[mix]; 536 inc(nPictureList); 537 end 538 end; 539 540 with ModelPicture[mix] do 541 FindPosition(HGr, pix mod 10 * 65, pix div 10 * 49, 63, 47, $FFFFFF, 542 xShield, yShield); 543 end; 544 end; 545 546 function TTribe.ChooseModelPicture(var Picture: TModelPictureInfo; 547 code, Turn: integer; ForceNew: boolean): boolean; 548 var 549 i, Cnt, HGr, used, LeastUsed: integer; 550 TestPic: TModelPictureInfo; 551 ok: boolean; 552 553 procedure check; 554 begin 555 TestPic.pix := GetNum; 556 if code = GetNum then 557 begin 558 if ForceNew or (HGr < 0) then 559 used := 0 560 else 561 begin 562 used := 4 * GrExt[HGr].pixUsed[TestPic.pix]; 563 if HGr = HGrStdUnits then 564 inc(used, 2); // prefer units not from StdUnits 565 end; 566 if used < LeastUsed then 567 begin 568 Cnt := 0; 569 LeastUsed := used 570 end; 571 if used = LeastUsed then 572 begin 573 inc(Cnt); 574 if Turn mod Cnt = 0 then 575 Picture := TestPic 576 end; 387 577 end 388 578 end; 389 {$ENDIF} 390 end 391 end 392 end; 393 394 procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean); 395 var 396 i: integer; 397 ok: boolean; 398 begin 399 with Info do 400 begin 401 if not IsNew then 402 begin 403 i:=nPictureList-1; 404 while (i>=0) and (PictureList[i].Hash<>Info.Hash) do dec(i); 405 assert(i>=0); 406 assert(PictureList[i].HGr = LoadGraphicSet(GrName)); 407 assert(PictureList[i].pix = pix); 408 ModelPicture[mix].HGr:=PictureList[i].HGr; 409 ModelPicture[mix].pix:=PictureList[i].pix; 410 ModelName[mix]:=PictureList[i].ModelName; 411 end 412 else 413 begin 414 with ModelPicture[mix] do 415 begin 416 HGr:=LoadGraphicSet(GrName); 417 pix:=Info.pix; 418 inc(GrExt[HGr].pixUsed[pix]); 579 580 begin 581 // look for identical model to assign same picture again 582 if not ForceNew and (Picture.Hash > 0) then 583 begin 584 for i := 0 to nPictureList - 1 do 585 if PictureList[i].Hash = Picture.Hash then 586 begin 587 Picture.GrName := GrExt[PictureList[i].HGr].Name; 588 Picture.pix := PictureList[i].pix; 589 result := false; 590 exit; 591 end 419 592 end; 420 ModelName[mix]:=''; 421 422 // read model name from tribe script423 ok:=false;424 for i:=0 to Script.Count-1 do 425 begin426 Input:=Script[i];427 if Input='#UNITS '+GrName then ok:=true428 else if (Input<>'') and (Input[1]='#') then ok:=false429 else if ok and (GetNum=pix) then430 begin Get; ModelName[mix]:=Get end593 594 Picture.pix := 0; 595 TestPic := Picture; 596 LeastUsed := MaxInt; 597 598 TestPic.GrName := 'StdUnits'; 599 HGr := HGrStdUnits; 600 for i := 0 to StdUnitScript.Count - 1 do 601 begin // look through StdUnits 602 Input := StdUnitScript[i]; 603 check; 431 604 end; 432 605 433 if ModelName[mix]='' then 434 begin // read model name from StdUnits.txt 435 for i:=0 to StdUnitScript.Count-1 do 606 ok := false; 607 for i := 0 to Script.Count - 1 do 608 begin // look through units defined in tribe script 609 Input := Script[i]; 610 if Copy(Input, 1, 6) = '#UNITS' then 436 611 begin 437 Input:=StdUnitScript[i]; 438 if GetNum=pix then 439 begin Get; ModelName[mix]:=Get end 612 ok := true; 613 TestPic.GrName := Copy(Input, 8, 255); 614 HGr := nGrExt - 1; 615 while (HGr >= 0) and (GrExt[HGr].Name <> TestPic.GrName) do 616 dec(HGr); 440 617 end 618 else if (Input <> '') and (Input[1] = '#') then 619 ok := false 620 else if ok then 621 check; 441 622 end; 442 443 if Hash<>0 then 444 begin 445 if nPictureList=0 then 446 ReallocMem(PictureList, 64*sizeof(TChosenModelPictureInfo)) 447 else if (nPictureList>=64) and (nPictureList and (nPictureList-1)=0) then 448 ReallocMem(PictureList, nPictureList*(2*sizeof(TChosenModelPictureInfo))); 449 PictureList[nPictureList].Hash:=Info.Hash; 450 PictureList[nPictureList].HGr:=ModelPicture[mix].HGr; 451 PictureList[nPictureList].pix:=Info.pix; 452 PictureList[nPictureList].ModelName:=ModelName[mix]; 453 inc(nPictureList); 454 end 455 end; 456 457 with ModelPicture[mix] do 458 FindPosition(HGr,pix mod 10 *65,pix div 10 *49,63,47,$FFFFFF,xShield,yShield); 459 end; 460 end; 461 462 function TTribe.ChooseModelPicture(var Picture: TModelPictureInfo; 463 code,Turn: integer; ForceNew: boolean): boolean; 464 var 465 i,Cnt,HGr,used,LeastUsed: integer; 466 TestPic: TModelPictureInfo; 467 ok: boolean; 468 469 procedure check; 470 begin 471 TestPic.pix:=GetNum; 472 if code=GetNum then 473 begin 474 if ForceNew or (HGr<0) then used:=0 475 else 476 begin 477 used:=4*GrExt[HGr].pixUsed[TestPic.pix]; 478 if HGr=HGrStdUnits then inc(used,2); // prefer units not from StdUnits 479 end; 480 if used<LeastUsed then begin Cnt:=0; LeastUsed:=used end; 481 if used=LeastUsed then 482 begin 483 inc(Cnt); 484 if Turn mod Cnt=0 then Picture:=TestPic 485 end; 486 end 487 end; 488 489 begin 490 // look for identical model to assign same picture again 491 if not ForceNew and (Picture.Hash>0) then 492 begin 493 for i:=0 to nPictureList-1 do 494 if PictureList[i].Hash=Picture.Hash then 495 begin 496 Picture.GrName:=GrExt[PictureList[i].HGr].Name; 497 Picture.pix:=PictureList[i].pix; 498 result:=false; 499 exit; 500 end 501 end; 502 503 Picture.pix:=0; 504 TestPic:=Picture; 505 LeastUsed:=MaxInt; 506 507 TestPic.GrName:='StdUnits'; 508 HGr:=HGrStdUnits; 509 for i:=0 to StdUnitScript.Count-1 do 510 begin // look through StdUnits 511 Input:=StdUnitScript[i]; 512 check; 513 end; 514 515 ok:=false; 516 for i:=0 to Script.Count-1 do 517 begin // look through units defined in tribe script 518 Input:=Script[i]; 519 if Copy(Input,1,6)='#UNITS' then 520 begin 521 ok:=true; 522 TestPic.GrName:=Copy(Input,8,255); 523 HGr:=nGrExt-1; 524 while (HGr>=0) and (GrExt[HGr].Name<>TestPic.GrName) do dec(HGr); 525 end 526 else if (Input<>'') and (Input[1]='#') then ok:=false 527 else if ok then check; 528 end; 529 result:=true; 530 end; 623 result := true; 624 end; 531 625 532 626 end. 533 -
trunk/LocalPlayer/UnitStat.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit UnitStat; 4 3 … … 6 5 7 6 uses 8 Protocol,ClientTools,Term,ScreenTools,BaseWin, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ButtonA,ButtonB, 7 Protocol, ClientTools, Term, ScreenTools, BaseWin, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonA, 10 ButtonB, 11 11 ButtonBase, ButtonC; 12 12 … … 38 38 protected 39 39 mixShow, // for dkOwnModel 40 uixShow, euixShow,ecixShow,41 UnitLoc,AgePrepared: integer;// for dkEnemyUnit, euixShow=-1 ->40 uixShow, euixShow, ecixShow, UnitLoc, AgePrepared: integer; 41 // for dkEnemyUnit, euixShow=-1 -> 42 42 mox: ^TModelInfo; // for dkEnemyModel 43 Kind:(dkOwnModel,dkOwnUnit,dkEnemyModel,dkEnemyUnit,dkEnemyCityDefense,dkEnemyCity); 43 Kind: (dkOwnModel, dkOwnUnit, dkEnemyModel, dkEnemyUnit, dkEnemyCityDefense, 44 dkEnemyCity); 44 45 Back, Template: TBitmap; 45 46 procedure OffscreenPaint; override; … … 56 57 57 58 const 58 xView=71; 59 xTotal=20; StatDown=112; 60 yImp=133; 61 62 // window size 63 wCommon=208; hOwnModel=293; hEnemyModel=236; hEnemyUnit=212; 64 hEnemyCityDefense=320; hEnemyCity=166; hMax=320; 65 59 xView = 71; 60 xTotal = 20; 61 StatDown = 112; 62 yImp = 133; 63 64 // window size 65 wCommon = 208; 66 hOwnModel = 293; 67 hEnemyModel = 236; 68 hEnemyUnit = 212; 69 hEnemyCityDefense = 320; 70 hEnemyCity = 166; 71 hMax = 320; 66 72 67 73 procedure TUnitStatDlg.FormCreate(Sender: TObject); 68 74 begin 69 inherited; 70 AgePrepared:=-2; 71 TitleHeight:=Screen.Height; 72 InitButtons(); 73 74 Back:=TBitmap.Create; 75 Back.PixelFormat:=pf24bit; 76 Back.Width:=5*wCommon; Back.Height:=hMax; 77 Template:=TBitmap.Create; 78 LoadGraphicFile(Template, HomeDir+'Graphics\Unit', gfNoGamma); 79 Template.PixelFormat:=pf8bit; 75 inherited; 76 AgePrepared := -2; 77 TitleHeight := Screen.Height; 78 InitButtons(); 79 80 Back := TBitmap.Create; 81 Back.PixelFormat := pf24bit; 82 Back.Width := 5 * wCommon; 83 Back.Height := hMax; 84 Template := TBitmap.Create; 85 LoadGraphicFile(Template, HomeDir + 'Graphics\Unit', gfNoGamma); 86 Template.PixelFormat := pf8bit; 80 87 end; 81 88 82 89 procedure TUnitStatDlg.FormDestroy(Sender: TObject); 83 90 begin 84 Template.Free;85 Back.Free;91 Template.Free; 92 Back.Free; 86 93 end; 87 94 88 95 procedure TUnitStatDlg.CheckAge; 89 96 begin 90 if MainTextureAge<>AgePrepared then91 begin 92 AgePrepared:=MainTextureAge;93 bitblt(Back.Canvas.Handle,0,0,wCommon,hOwnModel,94 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,95 (hMainTexture-hOwnModel) div 2,SRCCOPY);96 bitblt(Back.Canvas.Handle,wCommon,0,wCommon,hEnemyModel,97 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,98 (hMainTexture-hEnemyModel) div 2,SRCCOPY);99 bitblt(Back.Canvas.Handle,2*wCommon,0,wCommon,hEnemyUnit,100 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,101 (hMainTexture-hEnemyUnit) div 2,SRCCOPY);102 bitblt(Back.Canvas.Handle,3*wCommon,0,wCommon,hEnemyCityDefense,103 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,104 (hMainTexture-hEnemyCityDefense) div 2,SRCCOPY);105 bitblt(Back.Canvas.Handle,4*wCommon,0,wCommon,hEnemyCity,106 MainTexture.Image.Canvas.Handle,(wMainTexture-wCommon) div 2,107 (hMainTexture-hEnemyCity) div 2,SRCCOPY);108 ImageOp_B(Back,Template,0,0,0,0,5*wCommon,hMax);97 if MainTextureAge <> AgePrepared then 98 begin 99 AgePrepared := MainTextureAge; 100 bitblt(Back.Canvas.Handle, 0, 0, wCommon, hOwnModel, 101 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 102 (hMainTexture - hOwnModel) div 2, SRCCOPY); 103 bitblt(Back.Canvas.Handle, wCommon, 0, wCommon, hEnemyModel, 104 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 105 (hMainTexture - hEnemyModel) div 2, SRCCOPY); 106 bitblt(Back.Canvas.Handle, 2 * wCommon, 0, wCommon, hEnemyUnit, 107 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 108 (hMainTexture - hEnemyUnit) div 2, SRCCOPY); 109 bitblt(Back.Canvas.Handle, 3 * wCommon, 0, wCommon, hEnemyCityDefense, 110 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 111 (hMainTexture - hEnemyCityDefense) div 2, SRCCOPY); 112 bitblt(Back.Canvas.Handle, 4 * wCommon, 0, wCommon, hEnemyCity, 113 MainTexture.Image.Canvas.Handle, (wMainTexture - wCommon) div 2, 114 (hMainTexture - hEnemyCity) div 2, SRCCOPY); 115 ImageOp_B(Back, Template, 0, 0, 0, 0, 5 * wCommon, hMax); 109 116 end 110 117 end; … … 112 119 procedure TUnitStatDlg.FormShow(Sender: TObject); 113 120 var 114 owner, mix: integer;115 IsSpecialUnit: boolean;116 begin 117 if Kind in [dkEnemyUnit,dkEnemyCityDefense,dkEnemyCity] then118 begin 119 if MyMap[UnitLoc] and fUnit<>0 then121 owner, mix: integer; 122 IsSpecialUnit: boolean; 123 begin 124 if Kind in [dkEnemyUnit, dkEnemyCityDefense, dkEnemyCity] then 125 begin 126 if MyMap[UnitLoc] and fUnit <> 0 then 120 127 begin // find model 121 if euixShow<0 then 122 begin 123 euixShow:=MyRO.nEnemyUn-1; 124 while (euixShow>=0) and (MyRO.EnemyUn[euixShow].Loc<>UnitLoc) do dec(euixShow); 125 assert(euixShow>=0); 126 end; 127 with MyRO.EnemyUn[euixShow] do 128 begin 129 mox:=@MyRO.EnemyModel[emix]; 130 if Tribe[Owner].ModelPicture[mix].HGr=0 then 131 InitEnemyModel(emix); 128 if euixShow < 0 then 129 begin 130 euixShow := MyRO.nEnemyUn - 1; 131 while (euixShow >= 0) and (MyRO.EnemyUn[euixShow].Loc <> UnitLoc) do 132 dec(euixShow); 133 assert(euixShow >= 0); 134 end; 135 with MyRO.EnemyUn[euixShow] do 136 begin 137 mox := @MyRO.EnemyModel[emix]; 138 if Tribe[owner].ModelPicture[mix].HGr = 0 then 139 InitEnemyModel(emix); 132 140 end 133 141 end 134 else mox:=nil; 135 if Kind in [dkEnemyCityDefense,dkEnemyCity] then 142 else 143 mox := nil; 144 if Kind in [dkEnemyCityDefense, dkEnemyCity] then 136 145 begin 137 ecixShow:=MyRO.nEnemyCity-1; 138 while (ecixShow>=0) and (MyRO.EnemyCity[ecixShow].Loc<>UnitLoc) do dec(ecixShow); 139 assert(ecixShow>=0); 146 ecixShow := MyRO.nEnemyCity - 1; 147 while (ecixShow >= 0) and (MyRO.EnemyCity[ecixShow].Loc <> UnitLoc) do 148 dec(ecixShow); 149 assert(ecixShow >= 0); 140 150 end 141 151 end; 142 case Kind of143 dkOwnModel: ClientHeight:=hOwnModel;144 dkOwnUnit: ClientHeight:=hEnemyUnit;145 dkEnemyModel: ClientHeight:=hEnemyModel;146 dkEnemyUnit: ClientHeight:=hEnemyUnit;147 dkEnemyCityDefense: ClientHeight:=hEnemyCityDefense;148 dkEnemyCity: ClientHeight:=hEnemyCity;149 end;150 151 if Kind in [dkOwnModel,dkEnemyModel] then152 begin153 Left:=UserLeft;154 Top:=UserTop;155 end156 else157 begin158 Left:=(Screen.Width-Width) div 2;159 Top:=(Screen.Height-Height) div 2;160 end;161 162 SwitchBtn.Visible:= not supervising and (Kind=dkOwnModel);163 ConscriptsBtn.Visible:= not supervising and (Kind=dkOwnModel)164 and (MyRO.Tech[adConscription]>=tsApplicable)165 and (MyModel[mixShow].Domain=dGround) and (MyModel[mixShow].Kind<mkScout);166 IsSpecialUnit:=false;167 if Kind in [dkEnemyCity,dkEnemyCityDefense] then168 Caption:=CityName(MyRO.EnemyCity[ecixShow].ID)169 else170 begin171 152 case Kind of 172 153 dkOwnModel: 173 begin 174 owner:=me; 175 mix:=mixShow; 176 IsSpecialUnit:= MyModel[mix].Kind>=$10; 177 end; 154 ClientHeight := hOwnModel; 178 155 dkOwnUnit: 179 begin 180 owner:=me; 181 mix:=MyUn[uixShow].mix; 182 IsSpecialUnit:= MyModel[mix].Kind>=$10; 183 end 156 ClientHeight := hEnemyUnit; 157 dkEnemyModel: 158 ClientHeight := hEnemyModel; 159 dkEnemyUnit: 160 ClientHeight := hEnemyUnit; 161 dkEnemyCityDefense: 162 ClientHeight := hEnemyCityDefense; 163 dkEnemyCity: 164 ClientHeight := hEnemyCity; 165 end; 166 167 if Kind in [dkOwnModel, dkEnemyModel] then 168 begin 169 Left := UserLeft; 170 Top := UserTop; 171 end 172 else 173 begin 174 Left := (Screen.Width - Width) div 2; 175 Top := (Screen.Height - Height) div 2; 176 end; 177 178 SwitchBtn.Visible := not supervising and (Kind = dkOwnModel); 179 ConscriptsBtn.Visible := not supervising and (Kind = dkOwnModel) and 180 (MyRO.Tech[adConscription] >= tsApplicable) and 181 (MyModel[mixShow].Domain = dGround) and (MyModel[mixShow].Kind < mkScout); 182 IsSpecialUnit := false; 183 if Kind in [dkEnemyCity, dkEnemyCityDefense] then 184 Caption := CityName(MyRO.EnemyCity[ecixShow].ID) 185 else 186 begin 187 case Kind of 188 dkOwnModel: 189 begin 190 owner := me; 191 mix := mixShow; 192 IsSpecialUnit := MyModel[mix].Kind >= $10; 193 end; 194 dkOwnUnit: 195 begin 196 owner := me; 197 mix := MyUn[uixShow].mix; 198 IsSpecialUnit := MyModel[mix].Kind >= $10; 199 end 184 200 else 185 201 begin 186 owner:=mox.owner;187 mix:=mox.mix;188 IsSpecialUnit:= mox.Kind>=$10;202 owner := mox.owner; 203 mix := mox.mix; 204 IsSpecialUnit := mox.Kind >= $10; 189 205 end; 190 206 end; 191 if MainScreen.mNames.Checked then 192 Caption:=Tribe[Owner].ModelName[mix] 193 else Caption:=Format(Tribe[Owner].TPhrase('GENMODEL'),[mix]) 194 end; 195 if IsSpecialUnit then 196 HelpBtn.Hint:=Phrases.Lookup('CONTROLS',6); 197 HelpBtn.Visible:=IsSpecialUnit; 198 OffscreenPaint; 207 if MainScreen.mNames.Checked then 208 Caption := Tribe[owner].ModelName[mix] 209 else 210 Caption := Format(Tribe[owner].TPhrase('GENMODEL'), [mix]) 211 end; 212 if IsSpecialUnit then 213 HelpBtn.Hint := Phrases.Lookup('CONTROLS', 6); 214 HelpBtn.Visible := IsSpecialUnit; 215 OffscreenPaint; 199 216 end; 200 217 201 218 procedure TUnitStatDlg.ShowNewContent_OwnModel(NewMode, mix: integer); 202 219 begin 203 Kind:=dkOwnModel;204 mixShow:=mix;205 inherited ShowNewContent(NewMode);220 Kind := dkOwnModel; 221 mixShow := mix; 222 inherited ShowNewContent(NewMode); 206 223 end; 207 224 208 225 procedure TUnitStatDlg.ShowNewContent_OwnUnit(NewMode, uix: integer); 209 226 begin 210 Kind:=dkOwnUnit;211 uixShow:=uix;212 inherited ShowNewContent(NewMode);227 Kind := dkOwnUnit; 228 uixShow := uix; 229 inherited ShowNewContent(NewMode); 213 230 end; 214 231 215 232 procedure TUnitStatDlg.ShowNewContent_EnemyUnit(NewMode, euix: integer); 216 233 begin 217 Kind:=dkEnemyUnit;218 euixShow:=euix;219 UnitLoc:=MyRO.EnemyUn[euix].Loc;220 inherited ShowNewContent(NewMode);234 Kind := dkEnemyUnit; 235 euixShow := euix; 236 UnitLoc := MyRO.EnemyUn[euix].Loc; 237 inherited ShowNewContent(NewMode); 221 238 end; 222 239 223 240 procedure TUnitStatDlg.ShowNewContent_EnemyLoc(NewMode, Loc: integer); 224 241 begin 225 Kind:=dkEnemyUnit;226 UnitLoc:=Loc;227 euixShow:=-1;228 inherited ShowNewContent(NewMode);242 Kind := dkEnemyUnit; 243 UnitLoc := Loc; 244 euixShow := -1; 245 inherited ShowNewContent(NewMode); 229 246 end; 230 247 231 248 procedure TUnitStatDlg.ShowNewContent_EnemyModel(NewMode, emix: integer); 232 249 begin 233 Kind:=dkEnemyModel;234 mox:=@MyRO.EnemyModel[emix];235 inherited ShowNewContent(NewMode);250 Kind := dkEnemyModel; 251 mox := @MyRO.EnemyModel[emix]; 252 inherited ShowNewContent(NewMode); 236 253 end; 237 254 238 255 procedure TUnitStatDlg.ShowNewContent_EnemyCity(NewMode, Loc: integer); 239 256 begin 240 if MyMap[Loc] and fUnit<>0 then 241 Kind:=dkEnemyCityDefense 242 else Kind:=dkEnemyCity; 243 UnitLoc:=Loc; 244 euixShow:=-1; 245 inherited ShowNewContent(NewMode); 246 end; 247 248 procedure TUnitStatDlg.FormClose(Sender: TObject; 249 var Action: TCloseAction); 250 begin 251 if Kind in [dkOwnModel,dkEnemyModel] then 252 begin UserLeft:=Left; UserTop:=Top end; 253 if OffscreenUser=self then OffscreenUser:=nil; 257 if MyMap[Loc] and fUnit <> 0 then 258 Kind := dkEnemyCityDefense 259 else 260 Kind := dkEnemyCity; 261 UnitLoc := Loc; 262 euixShow := -1; 263 inherited ShowNewContent(NewMode); 264 end; 265 266 procedure TUnitStatDlg.FormClose(Sender: TObject; var Action: TCloseAction); 267 begin 268 if Kind in [dkOwnModel, dkEnemyModel] then 269 begin 270 UserLeft := Left; 271 UserTop := Top 272 end; 273 if OffscreenUser = self then 274 OffscreenUser := nil; 254 275 end; 255 276 256 277 procedure TUnitStatDlg.CloseBtnClick(Sender: TObject); 257 278 begin 258 Close279 Close 259 280 end; 260 281 261 282 procedure TUnitStatDlg.OffscreenPaint; 262 283 var 263 PPicture: ^TModelPicture;284 PPicture: ^TModelPicture; 264 285 265 286 function IsToCount(emix: integer): boolean; 266 287 var 267 PTestPicture: ^TModelPicture;268 begin 269 if MainScreen.mNames.Checked then288 PTestPicture: ^TModelPicture; 289 begin 290 if MainScreen.mNames.Checked then 270 291 begin 271 PTestPicture:=@Tribe[MyRO.EnemyModel[emix].Owner].ModelPicture[MyRO.EnemyModel[emix].mix]; 272 result:= (PPicture.HGr=PTestPicture.HGr) and (PPicture.pix=PTestPicture.pix) 273 and (ModelHash(mox^)=ModelHash(MyRO.EnemyModel[emix])) 292 PTestPicture := @Tribe[MyRO.EnemyModel[emix].owner].ModelPicture 293 [MyRO.EnemyModel[emix].mix]; 294 result := (PPicture.HGr = PTestPicture.HGr) and 295 (PPicture.pix = PTestPicture.pix) and 296 (ModelHash(mox^) = ModelHash(MyRO.EnemyModel[emix])) 274 297 end 275 else result:= (MyRO.EnemyModel[emix].Owner=mox.Owner) 276 and (MyRO.EnemyModel[emix].mix=mox.mix) 277 end; 278 279 procedure FeatureBar(dst: TBitmap; x,y: integer; const mi: TModelInfo; 298 else 299 result := (MyRO.EnemyModel[emix].owner = mox.owner) and 300 (MyRO.EnemyModel[emix].mix = mox.mix) 301 end; 302 303 procedure FeatureBar(dst: TBitmap; x, y: integer; const mi: TModelInfo; 280 304 const T: TTexture); 281 305 var 282 i,w,dx,num: integer;283 s: string;284 begin 285 DarkGradient(dst.Canvas,x-6,y+1,180,1);286 with dst.Canvas do287 if mi.Kind>=$10 then288 begin 289 s:=Phrases.Lookup('UNITSPECIAL');290 Font.Color:=$000000;291 Textout(x-1,y+1,s);292 Font.Color:=$B0B0B0;293 Textout(x-2,y,s);306 i, w, dx, num: integer; 307 s: string; 308 begin 309 DarkGradient(dst.Canvas, x - 6, y + 1, 180, 1); 310 with dst.Canvas do 311 if mi.Kind >= $10 then 312 begin 313 s := Phrases.Lookup('UNITSPECIAL'); 314 Font.Color := $000000; 315 Textout(x - 1, y + 1, s); 316 Font.Color := $B0B0B0; 317 Textout(x - 2, y, s); 294 318 end 295 else 296 begin 297 Font.Color:=$000000; 298 dx:=2; 299 for i:=3 to nFeature-1 do 300 begin 301 num:=0; 302 case i of 303 mcSeaTrans: if mi.Domain=dSea then num:=mi.TTrans; 304 mcCarrier: if mi.Domain=dSea then num:=mi.ATrans_Fuel; 305 mcBombs: num:=mi.Bombs; 306 mcFuel: if mi.Domain=dAir then num:=mi.ATrans_Fuel; 307 mcAirTrans: if mi.Domain=dAir then num:=mi.TTrans; 308 mcFirstNonCap..nFeature-1: 309 if mi.Cap and (1 shl (i-mcFirstNonCap))<>0 then num:=1 319 else 320 begin 321 Font.Color := $000000; 322 dx := 2; 323 for i := 3 to nFeature - 1 do 324 begin 325 num := 0; 326 case i of 327 mcSeaTrans: 328 if mi.Domain = dSea then 329 num := mi.TTrans; 330 mcCarrier: 331 if mi.Domain = dSea then 332 num := mi.ATrans_Fuel; 333 mcBombs: 334 num := mi.Bombs; 335 mcFuel: 336 if mi.Domain = dAir then 337 num := mi.ATrans_Fuel; 338 mcAirTrans: 339 if mi.Domain = dAir then 340 num := mi.TTrans; 341 mcFirstNonCap .. nFeature - 1: 342 if mi.Cap and (1 shl (i - mcFirstNonCap)) <> 0 then 343 num := 1 310 344 end; 311 if (num>0) and ((i<>mcSE) or (mi.Cap and (1 shl (mcNP-mcFirstNonCap))=0)) then 345 if (num > 0) and 346 ((i <> mcSE) or (mi.Cap and (1 shl (mcNP - mcFirstNonCap)) = 0)) 347 then 312 348 begin 313 if num>1 then349 if num > 1 then 314 350 begin 315 s:=IntToStr(num);316 w:=TextWidth(s);317 Brush.Color:=$FFFFFF;318 FillRect(Rect(x-3+dx,y+2,x+w-1+dx,y+16));319 Brush.Style:=bsClear;320 Textout(x-3+dx+1,y,s);321 inc(dx,w+1)351 s := IntToStr(num); 352 w := TextWidth(s); 353 Brush.Color := $FFFFFF; 354 FillRect(Rect(x - 3 + dx, y + 2, x + w - 1 + dx, y + 16)); 355 Brush.Style := bsClear; 356 Textout(x - 3 + dx + 1, y, s); 357 inc(dx, w + 1) 322 358 end; 323 Brush.Color:=$C0C0C0; 324 FrameRect(Rect(x-3+dx,y+2,x+11+dx,y+16)); 325 Brush.Style:=bsClear; 326 Sprite(dst,HGrSystem,x-1+dx,y+4,10,10,66+i mod 11 *11,137+i div 11 *11); 327 inc(dx,15) 359 Brush.Color := $C0C0C0; 360 FrameRect(Rect(x - 3 + dx, y + 2, x + 11 + dx, y + 16)); 361 Brush.Style := bsClear; 362 Sprite(dst, HGrSystem, x - 1 + dx, y + 4, 10, 10, 363 66 + i mod 11 * 11, 137 + i div 11 * 11); 364 inc(dx, 15) 328 365 end; 329 366 end 330 367 end 331 end; {featurebar}332 333 procedure NumberBarS(dst: TBitmap; x,y:integer;334 Cap,s: string;const T: TTexture);335 begin 336 DLine(dst.Canvas,x-2,x+170,y+16,T.clBevelShade,T.clBevelLight);337 LoweredTextOut(dst.Canvas,-1,T,x-2,y,Cap);338 RisedTextout(dst.canvas,x+170-BiColorTextWidth(dst.Canvas,s),y,s);368 end; { featurebar } 369 370 procedure NumberBarS(dst: TBitmap; x, y: integer; Cap, s: string; 371 const T: TTexture); 372 begin 373 DLine(dst.Canvas, x - 2, x + 170, y + 16, T.clBevelShade, T.clBevelLight); 374 LoweredTextOut(dst.Canvas, -1, T, x - 2, y, Cap); 375 RisedTextout(dst.Canvas, x + 170 - BiColorTextWidth(dst.Canvas, s), y, s); 339 376 end; 340 377 341 378 var 342 i,j,x,y,cix,uix,emix,InProd,Available,Destroyed,Loc,Cnt,yView,yTotal, 343 yCaption: integer; 344 s: string; 345 ui: TUnitInfo; 346 mi: TModelInfo; 347 begin 348 inherited; 349 350 case Kind of 351 dkOwnModel: 352 begin 353 bitblt(offscreen.canvas.handle,0,0,wCommon,hOwnModel,Back.Canvas.handle,0,0,SRCCOPY); 354 yView:=13; 355 yTotal:=92; 356 end; 357 dkEnemyModel: 358 begin 359 bitblt(offscreen.canvas.handle,0,0,wCommon,hEnemyModel,Back.Canvas.handle,wCommon,0,SRCCOPY); 360 yView:=13; 361 yTotal:=92; 362 end; 363 dkEnemyUnit,dkOwnUnit: 364 begin 365 bitblt(offscreen.canvas.handle,0,0,wCommon,hEnemyUnit,Back.Canvas.handle,2*wCommon,0,SRCCOPY); 366 yView:=13; 367 yTotal:=123; 368 end; 369 dkEnemyCityDefense: 370 begin 371 bitblt(offscreen.canvas.handle,0,0,wCommon,hEnemyCityDefense,Back.Canvas.handle,3*wCommon,0,SRCCOPY); 372 yView:=171; 373 yTotal:=231; 374 end; 375 dkEnemyCity: 376 begin 377 bitblt(offscreen.canvas.handle,0,0,wCommon,hEnemyCity,Back.Canvas.handle,4*wCommon,0,SRCCOPY); 378 end; 379 end; 380 MarkUsedOffscreen(ClientWidth,ClientHeight); 381 HelpBtn.Top:=yTotal+22; 382 383 if Kind in [dkEnemyCityDefense,dkEnemyCity] then 379 i, j, x, y, cix, uix, emix, InProd, Available, Destroyed, Loc, Cnt, yView, 380 yTotal, yCaption: integer; 381 s: string; 382 ui: TUnitInfo; 383 mi: TModelInfo; 384 begin 385 inherited; 386 387 case Kind of 388 dkOwnModel: 389 begin 390 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hOwnModel, 391 Back.Canvas.Handle, 0, 0, SRCCOPY); 392 yView := 13; 393 yTotal := 92; 394 end; 395 dkEnemyModel: 396 begin 397 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyModel, 398 Back.Canvas.Handle, wCommon, 0, SRCCOPY); 399 yView := 13; 400 yTotal := 92; 401 end; 402 dkEnemyUnit, dkOwnUnit: 403 begin 404 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyUnit, 405 Back.Canvas.Handle, 2 * wCommon, 0, SRCCOPY); 406 yView := 13; 407 yTotal := 123; 408 end; 409 dkEnemyCityDefense: 410 begin 411 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyCityDefense, 412 Back.Canvas.Handle, 3 * wCommon, 0, SRCCOPY); 413 yView := 171; 414 yTotal := 231; 415 end; 416 dkEnemyCity: 417 begin 418 bitblt(offscreen.Canvas.Handle, 0, 0, wCommon, hEnemyCity, 419 Back.Canvas.Handle, 4 * wCommon, 0, SRCCOPY); 420 end; 421 end; 422 MarkUsedOffscreen(ClientWidth, ClientHeight); 423 HelpBtn.Top := yTotal + 22; 424 425 if Kind in [dkEnemyCityDefense, dkEnemyCity] then 384 426 begin // show city defense facilities 385 cnt:=0; 386 for i:=0 to 3 do 387 if MyRO.EnemyCity[ecixShow].Flags and (2 shl i)<>0 then 388 inc(cnt); 389 x:=(wCommon-cnt*xSizeSmall) div 2 -(cnt-1)*2; 390 for i:=0 to 3 do 391 if MyRO.EnemyCity[ecixShow].Flags and (2 shl i)<>0 then 392 begin 393 case i of 394 0: j:=imWalls; 395 1: j:=imCoastalFort; 396 2: j:=imMissileBat; 397 3: j:=imBunker 427 Cnt := 0; 428 for i := 0 to 3 do 429 if MyRO.EnemyCity[ecixShow].Flags and (2 shl i) <> 0 then 430 inc(Cnt); 431 x := (wCommon - Cnt * xSizeSmall) div 2 - (Cnt - 1) * 2; 432 for i := 0 to 3 do 433 if MyRO.EnemyCity[ecixShow].Flags and (2 shl i) <> 0 then 434 begin 435 case i of 436 0: 437 j := imWalls; 438 1: 439 j := imCoastalFort; 440 2: 441 j := imMissileBat; 442 3: 443 j := imBunker 398 444 end; 399 Frame(offscreen.Canvas,x-1,yImp-1,x+xSizeSmall,yImp+ySizeSmall, 400 MainTexture.clBevelLight,MainTexture.clBevelShade); 401 BitBlt(offscreen.Canvas.Handle,x,yImp,xSizeSmall,ySizeSmall, 402 SmallImp.Canvas.Handle,j mod 7*xSizeSmall, 403 (j+SystemIconLines*7) div 7*ySizeSmall,SRCCOPY); 404 inc(x,xSizeSmall+4) 405 end; 406 end; 407 408 if Kind=dkEnemyModel then 409 begin 410 PPicture:=@Tribe[mox.Owner].ModelPicture[mox.mix]; 411 Available:=0; 412 if G.Difficulty[me]=0 then // supervisor -- count stacked units too 413 for Loc:=0 to G.lx*G.ly-1 do 414 begin 415 if MyMap[Loc] and fUnit<>0 then 416 begin 417 Server(sGetUnits,me,Loc,Cnt); 418 for uix:=0 to Cnt-1 do 419 if IsToCount(MyRO.EnemyUn[MyRO.nEnemyUn+uix].emix) then 420 inc(Available); 445 Frame(offscreen.Canvas, x - 1, yImp - 1, x + xSizeSmall, 446 yImp + ySizeSmall, MainTexture.clBevelLight, 447 MainTexture.clBevelShade); 448 bitblt(offscreen.Canvas.Handle, x, yImp, xSizeSmall, ySizeSmall, 449 SmallImp.Canvas.Handle, j mod 7 * xSizeSmall, 450 (j + SystemIconLines * 7) div 7 * ySizeSmall, SRCCOPY); 451 inc(x, xSizeSmall + 4) 452 end; 453 end; 454 455 if Kind = dkEnemyModel then 456 begin 457 PPicture := @Tribe[mox.owner].ModelPicture[mox.mix]; 458 Available := 0; 459 if G.Difficulty[me] = 0 then // supervisor -- count stacked units too 460 for Loc := 0 to G.lx * G.ly - 1 do 461 begin 462 if MyMap[Loc] and fUnit <> 0 then 463 begin 464 Server(sGetUnits, me, Loc, Cnt); 465 for uix := 0 to Cnt - 1 do 466 if IsToCount(MyRO.EnemyUn[MyRO.nEnemyUn + uix].emix) then 467 inc(Available); 421 468 end 422 469 end 423 else // no supervisor -- can only count stack top units 424 for uix:=0 to MyRO.nEnemyUn-1 do 425 if (MyRO.EnemyUn[uix].Loc>=0) and IsToCount(MyRO.EnemyUn[uix].emix) then 470 else // no supervisor -- can only count stack top units 471 for uix := 0 to MyRO.nEnemyUn - 1 do 472 if (MyRO.EnemyUn[uix].Loc >= 0) and IsToCount(MyRO.EnemyUn[uix].emix) 473 then 474 inc(Available); 475 Destroyed := 0; 476 for emix := 0 to MyRO.nEnemyModel - 1 do 477 if IsToCount(emix) then 478 inc(Destroyed, MyRO.EnemyModel[emix].Lost); 479 end 480 else 481 begin 482 Available := 0; 483 for uix := 0 to MyRO.nUn - 1 do 484 if (MyUn[uix].Loc >= 0) and (MyUn[uix].mix = mixShow) then 426 485 inc(Available); 427 Destroyed:=0; 428 for emix:=0 to MyRO.nEnemyModel-1 do if IsToCount(emix) then 429 inc(Destroyed,MyRO.EnemyModel[emix].Lost); 430 end 431 else 432 begin 433 Available:=0; 434 for uix:=0 to MyRO.nUn-1 do 435 if (MyUn[uix].Loc>=0) and (MyUn[uix].mix=mixShow) then inc(Available); 436 InProd:=0; 437 for cix:=0 to MyRO.nCity-1 do 438 if (MyCity[cix].Loc>=0) and (MyCity[cix].Project and (cpImp+cpIndex)=mixShow) then 439 inc(InProd); 440 end; 441 442 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 443 if Kind in [dkEnemyCityDefense,dkEnemyCity] then 444 begin 445 NoMap.SetOutput(offscreen); 446 NoMap.PaintCity(ClientWidth div 2,53,MyRO.EnemyCity[ecixShow],false); 447 448 s:=Tribe[MyRO.EnemyCity[ecixShow].Owner].TPhrase('UNITOWNER'); 449 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 450 (ClientWidth-BiColorTextWidth(offscreen.Canvas,s)) div 2, 105, s); 451 end; 452 453 if Kind<>dkEnemyCity then 486 InProd := 0; 487 for cix := 0 to MyRO.nCity - 1 do 488 if (MyCity[cix].Loc >= 0) and 489 (MyCity[cix].Project and (cpImp + cpIndex) = mixShow) then 490 inc(InProd); 491 end; 492 493 offscreen.Canvas.Font.Assign(UniFont[ftSmall]); 494 if Kind in [dkEnemyCityDefense, dkEnemyCity] then 495 begin 496 NoMap.SetOutput(offscreen); 497 NoMap.PaintCity(ClientWidth div 2, 53, MyRO.EnemyCity[ecixShow], false); 498 499 s := Tribe[MyRO.EnemyCity[ecixShow].owner].TPhrase('UNITOWNER'); 500 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 501 (ClientWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2, 105, s); 502 end; 503 504 if Kind <> dkEnemyCity then 454 505 begin // show unit stats 455 if Kind=dkOwnModel then456 MakeModelInfo(me,mixShow,MyModel[mixShow],mi)457 else if Kind=dkOwnUnit then506 if Kind = dkOwnModel then 507 MakeModelInfo(me, mixShow, MyModel[mixShow], mi) 508 else if Kind = dkOwnUnit then 458 509 begin 459 MakeUnitInfo(me,MyUn[uixShow],ui);460 MakeModelInfo(me,MyUn[uixShow].mix,MyModel[MyUn[uixShow].mix],mi)510 MakeUnitInfo(me, MyUn[uixShow], ui); 511 MakeModelInfo(me, MyUn[uixShow].mix, MyModel[MyUn[uixShow].mix], mi) 461 512 end 462 else513 else 463 514 begin 464 mi:=mox^;465 if Kind in [dkEnemyUnit,dkEnemyCityDefense] then466 ui:=MyRO.EnemyUn[euixShow]515 mi := mox^; 516 if Kind in [dkEnemyUnit, dkEnemyCityDefense] then 517 ui := MyRO.EnemyUn[euixShow] 467 518 end; 468 519 469 with Tribe[mi.Owner].ModelPicture[mi.mix] do520 with Tribe[mi.owner].ModelPicture[mi.mix] do 470 521 begin 471 if Kind in [dkOwnUnit,dkEnemyUnit,dkEnemyCityDefense] then with ui do 472 begin 473 {Frame(offscreen.canvas,xView-1,yView-1,xView+64,yView+48, 474 MainTexture.clBevelShade,MainTexture.clBevelLight); 475 RFrame(offscreen.canvas,xView-2,yView-2,xView+65,yView+49, 476 MainTexture.clBevelShade,MainTexture.clBevelLight);} 477 with offscreen.canvas do 478 begin 479 Brush.Color:=GrExt[HGrSystem].Data.Canvas.Pixels[98,67]; 480 offscreen.canvas.FillRect(Rect(xView,yView,xView+64,yView+16)); 481 Brush.Style:=bsClear; 522 if Kind in [dkOwnUnit, dkEnemyUnit, dkEnemyCityDefense] then 523 with ui do 524 begin 525 { Frame(offscreen.canvas,xView-1,yView-1,xView+64,yView+48, 526 MainTexture.clBevelShade,MainTexture.clBevelLight); 527 RFrame(offscreen.canvas,xView-2,yView-2,xView+65,yView+49, 528 MainTexture.clBevelShade,MainTexture.clBevelLight); } 529 with offscreen.Canvas do 530 begin 531 Brush.Color := GrExt[HGrSystem].Data.Canvas.Pixels[98, 67]; 532 offscreen.Canvas.FillRect(Rect(xView, yView, xView + 64, 533 yView + 16)); 534 Brush.Style := bsClear; 535 end; 536 537 if MyMap[Loc] and fTerrain >= fForest then 538 begin 539 x := 1 + 2 * (xxt * 2 + 1); 540 y := 1 + yyt + 2 * (yyt * 3 + 1) 541 end 542 else 543 begin 544 x := integer(MyMap[Loc] and fTerrain) * (xxt * 2 + 1) + 1; 545 y := 1 + yyt 546 end; 547 for j := -1 to 1 do 548 for i := -1 to 1 do 549 if (i + j) and 1 = 0 then 550 begin 551 Sprite(Buffer, HGrTerrain, i * xxt, j * yyt, xxt * 2, 552 yyt * 2, x, y); 553 if MyMap[Loc] and (fTerrain or fSpecial) = fGrass or fSpecial1 554 then 555 Sprite(Buffer, HGrTerrain, i * xxt, j * yyt, xxt * 2, yyt * 2, 556 1 + 2 * (xxt * 2 + 1), 1 + yyt + 1 * (yyt * 3 + 1)) 557 else if (MyMap[Loc] and fTerrain = fForest) and 558 IsJungle(Loc div G.lx) then 559 Sprite(Buffer, HGrTerrain, i * xxt, j * yyt, xxt * 2, yyt * 2, 560 1 + 7 * (xxt * 2 + 1), 1 + yyt + 19 * (yyt * 3 + 1)) 561 else if MyMap[Loc] and fTerrain >= fForest then 562 Sprite(Buffer, HGrTerrain, i * xxt, j * yyt, xxt * 2, yyt * 2, 563 1 + 7 * (xxt * 2 + 1), 564 1 + yyt + 2 * integer(2 + MyMap[Loc] and fTerrain - fForest) 565 * (yyt * 3 + 1)); 566 end; 567 bitblt(offscreen.Canvas.Handle, xView, yView + 16, 64, 32, 568 Buffer.Canvas.Handle, 1, 0, SRCCOPY); 569 570 // show unit, experience and health 571 Sprite(offscreen, HGr, xView, yView, 64, 48, pix mod 10 * 65 + 1, 572 pix div 10 * 49 + 1); 573 if Flags and unFortified <> 0 then 574 Sprite(offscreen, HGrStdUnits, xView, yView, xxu * 2, yyu * 2, 575 1 + 6 * (xxu * 2 + 1), 1); 576 FrameImage(offscreen.Canvas, GrExt[HGrSystem].Data, xView - 20, 577 yView + 5, 12, 14, 121 + Exp div ExpCost * 13, 28); 578 if Health < 100 then 579 begin 580 s := IntToStr(Health) + '%'; 581 LightGradient(offscreen.Canvas, xView - 45, yView + 24, 38, 582 (ColorOfHealth(Health) and $FEFEFE shr 2) * 3); 583 RisedTextout(offscreen.Canvas, xView - 45 + 20 - 584 BiColorTextWidth(offscreen.Canvas, s) div 2, yView + 23, s); 585 end; 586 587 if Kind = dkEnemyUnit then 588 begin 589 s := Tribe[mox.owner].TPhrase('UNITOWNER'); 590 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 591 (ClientWidth - BiColorTextWidth(offscreen.Canvas, s)) div 2, 592 yView + 80, s); 593 end 594 end 595 else 596 begin 597 FrameImage(offscreen.Canvas, BigImp, xView + 4, yView, 56, 40, 0, 0); 598 Sprite(offscreen, HGr, xView, yView - 4, 64, 44, pix mod 10 * 65 + 1, 599 pix div 10 * 49 + 1); 600 end; 601 602 DarkGradient(offscreen.Canvas, xTotal - 6, yTotal + 1, 180, 2); 603 RisedTextout(offscreen.Canvas, xTotal - 2, yTotal, 604 Phrases.Lookup('UNITSTRENGTH')); 605 s := IntToStr(mi.Attack) + '/' + IntToStr(mi.Defense); 606 RisedTextout(offscreen.Canvas, 607 xTotal + 170 - BiColorTextWidth(offscreen.Canvas, s), yTotal, s); 608 FeatureBar(offscreen, xTotal, yTotal + 19, mi, MainTexture); 609 NumberBarS(offscreen, xTotal, yTotal + 38, Phrases.Lookup('UNITSPEED'), 610 MovementToString(mi.Speed), MainTexture); 611 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, yTotal + 57, 612 Phrases.Lookup('UNITCOST')); 613 DLine(offscreen.Canvas, xTotal - 2, xTotal + 170, yTotal + 57 + 16, 614 MainTexture.clBevelShade, MainTexture.clBevelLight); 615 if G.Difficulty[me] = 0 then 616 s := IntToStr(mi.cost) 617 else 618 s := IntToStr(mi.cost * BuildCostMod[G.Difficulty[me]] div 12); 619 RisedTextout(offscreen.Canvas, 620 xTotal + 159 - BiColorTextWidth(offscreen.Canvas, s), yTotal + 57, s); 621 Sprite(offscreen, HGrSystem, xTotal + 160, yTotal + 57 + 5, 10, 622 10, 88, 115); 623 624 if Kind = dkOwnModel then 625 begin 626 if MyModel[mixShow].IntroTurn > 0 then 627 begin 628 if MyModel[mixShow].Kind = mkEnemyDeveloped then 629 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, 630 (yTotal + StatDown - 19), Phrases.Lookup('UNITADOPT')) 631 else 632 LoweredTextOut(offscreen.Canvas, -1, MainTexture, xTotal - 2, 633 (yTotal + StatDown - 19), Phrases.Lookup('UNITINTRO')); 634 DLine(offscreen.Canvas, xTotal - 2, xTotal + 170, 635 (yTotal + StatDown - 19) + 16, MainTexture.clTextShade, 636 MainTexture.clTextLight); 637 s := TurnToString(MyModel[mixShow].IntroTurn); 638 RisedTextout(offscreen.Canvas, 639 xTotal + 170 - BiColorTextWidth(offscreen.Canvas, s), 640 (yTotal + StatDown - 19), s); 482 641 end; 483 642 484 if MyMap[Loc] and fTerrain>=fForest then 485 begin x:=1+2*(xxt*2+1); y:=1+yyt+2*(yyt*3+1) end 486 else begin x:=integer(MyMap[Loc] and fTerrain) *(xxt*2+1)+1; y:=1+yyt end; 487 for j:=-1 to 1 do for i:=-1 to 1 do if (i+j) and 1=0 then 488 begin 489 Sprite(Buffer,HGrTerrain,i*xxt,j*yyt,xxt*2,yyt*2,x,y); 490 if MyMap[Loc] and (fTerrain or fSpecial)=fGrass or fSpecial1 then 491 Sprite(Buffer,HGrTerrain,i*xxt,j*yyt,xxt*2,yyt*2,1+2*(xxt*2+1), 492 1+yyt+1*(yyt*3+1)) 493 else if (MyMap[Loc] and fTerrain=fForest) 494 and IsJungle(Loc div G.lx) then 495 Sprite(Buffer,HGrTerrain,i*xxt,j*yyt,xxt*2,yyt*2,1+7*(xxt*2+1), 496 1+yyt+19*(yyt*3+1)) 497 else if MyMap[Loc] and fTerrain>=fForest then 498 Sprite(Buffer,HGrTerrain,i*xxt,j*yyt,xxt*2,yyt*2,1+7*(xxt*2+1), 499 1+yyt+2*integer(2+MyMap[Loc] and fTerrain-fForest)*(yyt*3+1)); 643 NumberBar(offscreen, xTotal, yTotal + StatDown, 644 Phrases.Lookup('UNITBUILT'), MyModel[mixShow].Built, MainTexture); 645 if MyModel[mixShow].Lost > 0 then 646 NumberBar(offscreen, xTotal, yTotal + StatDown + 19, 647 Phrases.Lookup('UNITLOST'), MyModel[mixShow].Lost, MainTexture); 648 if InProd > 0 then 649 NumberBar(offscreen, xTotal, yTotal + StatDown + 57, 650 Phrases.Lookup('UNITINPROD'), InProd, MainTexture); 651 if Available > 0 then 652 NumberBar(offscreen, xTotal, yTotal + StatDown + 38, 653 Phrases.Lookup('UNITAVAILABLE'), Available, MainTexture); 654 655 if MyModel[mixShow].Status and msObsolete <> 0 then 656 begin 657 SwitchBtn.ButtonIndex := 12; 658 SwitchBtn.Hint := Phrases.Lookup('BTN_OBSOLETE'); 659 end 660 else 661 begin 662 SwitchBtn.ButtonIndex := 11; 663 SwitchBtn.Hint := Phrases.Lookup('BTN_NONOBSOLETE'); 500 664 end; 501 BitBlt(offscreen.canvas.handle,xView,yView+16,64,32,Buffer.Canvas.Handle,1,0, 502 SRCCOPY); 503 504 // show unit, experience and health 505 Sprite(offscreen,HGr,xView,yView,64,48,pix mod 10 *65+1,pix div 10*49+1); 506 if Flags and unFortified<>0 then 507 Sprite(offscreen,HGrStdUnits,xView,yView,xxu*2,yyu*2,1+6*(xxu*2+1),1); 508 FrameImage(offscreen.canvas,GrExt[HGrSystem].Data,xView-20,yView+5,12,14, 509 121+Exp div ExpCost *13,28); 510 if Health<100 then 511 begin 512 s:=IntToStr(Health)+'%'; 513 LightGradient(offscreen.canvas,xView-45,yView+24,38, 514 (ColorOfHealth(Health) and $FEFEFE shr 2)*3); 515 RisedTextOut(offscreen.canvas,xView-45+20-BiColorTextWidth(offscreen.Canvas,s) div 2, 516 yView+23,s); 517 end; 518 519 if Kind=dkEnemyUnit then 520 begin 521 s:=Tribe[mox.Owner].TPhrase('UNITOWNER'); 522 LoweredTextOut(offscreen.Canvas, -1, MainTexture, 523 (ClientWidth-BiColorTextWidth(offscreen.Canvas,s)) div 2, yView+80, s); 665 if MyModel[mixShow].Status and msAllowConscripts = 0 then 666 begin 667 ConscriptsBtn.ButtonIndex := 30; 668 ConscriptsBtn.Hint := Phrases.Lookup('BTN_NOCONSCRIPTS'); 669 end 670 else 671 begin 672 ConscriptsBtn.ButtonIndex := 29; 673 ConscriptsBtn.Hint := Phrases.Lookup('BTN_ALLOWCONSCRIPTS'); 524 674 end 525 675 end 526 else 527 begin 528 FrameImage(offscreen.canvas,BigImp,xView+4,yView,56,40,0,0); 529 Sprite(offscreen,HGr,xView,yView-4,64,44,pix mod 10 *65+1,pix div 10*49+1); 530 end; 531 532 DarkGradient(offscreen.Canvas,xTotal-6,yTotal+1,180,2); 533 RisedTextOut(offscreen.Canvas,xTotal-2,yTotal,Phrases.Lookup('UNITSTRENGTH')); 534 s:=IntToStr(mi.Attack)+'/'+IntToStr(mi.Defense); 535 RisedTextOut(offscreen.Canvas,xTotal+170-BiColorTextWidth(Offscreen.Canvas,s),yTotal,s); 536 FeatureBar(offscreen,xTotal,yTotal+19,mi,MainTexture); 537 NumberBarS(offscreen,xTotal,yTotal+38,Phrases.Lookup('UNITSPEED'),MovementToString(mi.Speed),MainTexture); 538 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,yTotal+57,Phrases.Lookup('UNITCOST')); 539 DLine(offscreen.Canvas,xTotal-2,xTotal+170,yTotal+57+16, 540 MainTexture.clBevelShade,MainTexture.clBevelLight); 541 if G.Difficulty[me]=0 then s:=IntToStr(mi.cost) 542 else s:=IntToStr(mi.cost*BuildCostMod[G.Difficulty[me]] div 12); 543 RisedTextout(offscreen.Canvas,xTotal+159-BiColorTextWidth(Offscreen.Canvas,s),yTotal+57,s); 544 Sprite(offscreen,HGrSystem,xTotal+160,yTotal+57+5,10,10,88,115); 545 546 if Kind=dkOwnModel then 547 begin 548 if MyModel[mixShow].IntroTurn>0 then 549 begin 550 if MyModel[mixShow].Kind=mkEnemyDeveloped then 551 LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,(yTotal+StatDown-19),Phrases.Lookup('UNITADOPT')) 552 else LoweredTextOut(offscreen.Canvas,-1,MainTexture,xTotal-2,(yTotal+StatDown-19),Phrases.Lookup('UNITINTRO')); 553 DLine(offscreen.Canvas,xTotal-2,xTotal+170,(yTotal+StatDown-19)+16, 554 MainTexture.clTextShade,MainTexture.clTextLight); 555 s:=TurnToString(MyModel[mixShow].IntroTurn); 556 RisedTextOut(offscreen.Canvas,xTotal+170-BiColorTextWidth(Offscreen.Canvas,s),(yTotal+StatDown-19),s); 557 end; 558 559 NumberBar(offscreen,xTotal,yTotal+StatDown,Phrases.Lookup('UNITBUILT'),MyModel[mixShow].Built,MainTexture); 560 if MyModel[mixShow].Lost>0 then 561 NumberBar(offscreen,xTotal,yTotal+StatDown+19,Phrases.Lookup('UNITLOST'),MyModel[mixShow].Lost,MainTexture); 562 if InProd>0 then 563 NumberBar(offscreen,xTotal,yTotal+StatDown+57,Phrases.Lookup('UNITINPROD'),InProd,MainTexture); 564 if Available>0 then 565 NumberBar(offscreen,xTotal,yTotal+StatDown+38,Phrases.Lookup('UNITAVAILABLE'),Available,MainTexture); 566 567 if MyModel[mixShow].Status and msObsolete<>0 then 568 begin 569 SwitchBtn.ButtonIndex:=12; 570 SwitchBtn.Hint:=Phrases.Lookup('BTN_OBSOLETE'); 571 end 572 else 573 begin 574 SwitchBtn.ButtonIndex:=11; 575 SwitchBtn.Hint:=Phrases.Lookup('BTN_NONOBSOLETE'); 576 end; 577 if MyModel[mixShow].Status and msAllowConscripts=0 then 578 begin 579 ConscriptsBtn.ButtonIndex:=30; 580 ConscriptsBtn.Hint:=Phrases.Lookup('BTN_NOCONSCRIPTS'); 581 end 582 else 583 begin 584 ConscriptsBtn.ButtonIndex:=29; 585 ConscriptsBtn.Hint:=Phrases.Lookup('BTN_ALLOWCONSCRIPTS'); 586 end 587 end 588 else if Kind=dkEnemyModel then 589 begin 590 if Destroyed>0 then 591 NumberBar(offscreen,xTotal,yTotal+StatDown-19,Phrases.Lookup('UNITDESTROYED'),Destroyed,MainTexture); 592 if Available>0 then 593 NumberBar(offscreen,xTotal,yTotal+StatDown,Phrases.Lookup('UNITKNOWN'),Available,MainTexture); 676 else if Kind = dkEnemyModel then 677 begin 678 if Destroyed > 0 then 679 NumberBar(offscreen, xTotal, yTotal + StatDown - 19, 680 Phrases.Lookup('UNITDESTROYED'), Destroyed, MainTexture); 681 if Available > 0 then 682 NumberBar(offscreen, xTotal, yTotal + StatDown, 683 Phrases.Lookup('UNITKNOWN'), Available, MainTexture); 594 684 end 595 685 end; 596 686 end; 597 687 598 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 599 case Kind of 600 dkOwnModel,dkEnemyModel: yCaption:=yView+46; 601 dkEnemyUnit,dkOwnUnit: yCaption:=yView+54; 602 dkEnemyCityDefense,dkEnemyCity: yCaption:=79; 603 end; 604 RisedTextOut(offscreen.Canvas, (ClientWidth-BiColorTextWidth(offscreen.Canvas,caption)) div 2, yCaption, caption); 605 end; {OffscreenPaint} 688 offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 689 case Kind of 690 dkOwnModel, dkEnemyModel: 691 yCaption := yView + 46; 692 dkEnemyUnit, dkOwnUnit: 693 yCaption := yView + 54; 694 dkEnemyCityDefense, dkEnemyCity: 695 yCaption := 79; 696 end; 697 RisedTextout(offscreen.Canvas, 698 (ClientWidth - BiColorTextWidth(offscreen.Canvas, Caption)) div 2, 699 yCaption, Caption); 700 end; { OffscreenPaint } 606 701 607 702 procedure TUnitStatDlg.ModelBoxChange(Sender: TObject); 608 703 begin 609 SmartUpdateContent704 SmartUpdateContent 610 705 end; 611 706 612 707 procedure TUnitStatDlg.SwitchBtnClick(Sender: TObject); 613 708 begin 614 MyModel[mixShow].Status:=MyModel[mixShow].Status xor msObsolete;615 if MyModel[mixShow].Status and msObsolete<>0 then616 begin 617 SwitchBtn.ButtonIndex:=12;618 SwitchBtn.Hint:=Phrases.Lookup('BTN_OBSOLETE');709 MyModel[mixShow].Status := MyModel[mixShow].Status xor msObsolete; 710 if MyModel[mixShow].Status and msObsolete <> 0 then 711 begin 712 SwitchBtn.ButtonIndex := 12; 713 SwitchBtn.Hint := Phrases.Lookup('BTN_OBSOLETE'); 619 714 end 620 else621 begin 622 SwitchBtn.ButtonIndex:=11;623 SwitchBtn.Hint:=Phrases.Lookup('BTN_NONOBSOLETE');715 else 716 begin 717 SwitchBtn.ButtonIndex := 11; 718 SwitchBtn.Hint := Phrases.Lookup('BTN_NONOBSOLETE'); 624 719 end 625 720 end; … … 627 722 procedure TUnitStatDlg.ConscriptsBtnClick(Sender: TObject); 628 723 begin 629 MyModel[mixShow].Status:=MyModel[mixShow].Status xor msAllowConscripts;630 if MyModel[mixShow].Status and msAllowConscripts=0 then631 begin 632 ConscriptsBtn.ButtonIndex:=30;633 ConscriptsBtn.Hint:=Phrases.Lookup('BTN_NOCONSCRIPTS');724 MyModel[mixShow].Status := MyModel[mixShow].Status xor msAllowConscripts; 725 if MyModel[mixShow].Status and msAllowConscripts = 0 then 726 begin 727 ConscriptsBtn.ButtonIndex := 30; 728 ConscriptsBtn.Hint := Phrases.Lookup('BTN_NOCONSCRIPTS'); 634 729 end 635 else636 begin 637 ConscriptsBtn.ButtonIndex:=29;638 ConscriptsBtn.Hint:=Phrases.Lookup('BTN_ALLOWCONSCRIPTS');730 else 731 begin 732 ConscriptsBtn.ButtonIndex := 29; 733 ConscriptsBtn.Hint := Phrases.Lookup('BTN_ALLOWCONSCRIPTS'); 639 734 end 640 735 end; … … 642 737 procedure TUnitStatDlg.HelpBtnClick(Sender: TObject); 643 738 begin 644 HelpDlg.ShowNewContent(wmPersistent, hkModel, 0)739 HelpDlg.ShowNewContent(wmPersistent, hkModel, 0) 645 740 end; 646 741 647 742 end. 648 -
trunk/LocalPlayer/Wonders.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Wonders; 4 3 … … 6 5 7 6 uses 8 ScreenTools, BaseWin,Protocol,7 ScreenTools, BaseWin, Protocol, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 16 15 procedure FormCreate(Sender: TObject); 17 16 procedure CloseBtnClick(Sender: TObject); 18 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, 19 Y: Integer); 17 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); 20 18 procedure FormShow(Sender: TObject); 21 19 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; … … 24 22 public 25 23 procedure OffscreenPaint; override; 26 procedure ShowNewContent(NewMode: integer);24 procedure ShowNewContent(NewMode: Integer); 27 25 28 26 private 29 xm, ym,Selection: integer;27 xm, ym, Selection: Integer; 30 28 end; 31 29 … … 36 34 37 35 uses 38 Term, ClientTools, Help,Tribes;36 Term, ClientTools, Help, Tribes; 39 37 40 38 {$R *.DFM} 41 39 42 40 const 43 RingPosition: array[0..20,0..1] of integer= 44 ((-80,-32), // Pyramids 45 (80,-32), // Zeus 46 (0,-64), // Gardens 47 (0,0), // Colossus 48 (0,64), // Lighthouse 49 (-80,32), // GrLibrary 50 (-90,114), // Oracle 51 (80,32), // Sun 52 (90,-114), // Leo 53 (-180,0), // Magellan 54 (90,114), // Mich 55 (0,0), //{11;} 56 (180,0), // Newton 57 (-90,-114), // Bach 58 (0,0), //{14;} 59 (-160,-64), // Liberty 60 (0,128), // Eiffel 61 (160,-64), // Hoover 62 (-160,64), // Shinkansen 63 (0,-128), // Manhattan 64 (160,64)); // Mir 65 41 RingPosition: array [0 .. 20, 0 .. 1] of Integer = ((-80, -32), // Pyramids 42 (80, -32), // Zeus 43 (0, -64), // Gardens 44 (0, 0), // Colossus 45 (0, 64), // Lighthouse 46 (-80, 32), // GrLibrary 47 (-90, 114), // Oracle 48 (80, 32), // Sun 49 (90, -114), // Leo 50 (-180, 0), // Magellan 51 (90, 114), // Mich 52 (0, 0), // {11;} 53 (180, 0), // Newton 54 (-90, -114), // Bach 55 (0, 0), // {14;} 56 (-160, -64), // Liberty 57 (0, 128), // Eiffel 58 (160, -64), // Hoover 59 (-160, 64), // Shinkansen 60 (0, -128), // Manhattan 61 (160, 64)); // Mir 66 62 67 63 procedure TWondersDlg.FormCreate(Sender: TObject); 68 64 begin 69 Canvas.Font.Assign(UniFont[ftNormal]);70 Canvas.Brush.Style:=bsClear;71 InitButtons();65 Canvas.Font.Assign(UniFont[ftNormal]); 66 Canvas.Brush.Style := bsClear; 67 InitButtons(); 72 68 end; 73 69 74 70 procedure TWondersDlg.FormShow(Sender: TObject); 75 71 begin 76 Selection:=-1;77 OffscreenPaint;78 end; 79 80 procedure TWondersDlg.ShowNewContent(NewMode: integer);81 begin 82 inherited ShowNewContent(NewMode);72 Selection := -1; 73 OffscreenPaint; 74 end; 75 76 procedure TWondersDlg.ShowNewContent(NewMode: Integer); 77 begin 78 inherited ShowNewContent(NewMode); 83 79 end; 84 80 85 81 procedure TWondersDlg.OffscreenPaint; 86 82 type 87 TLine=array[0..649,0..2] of Byte;88 89 procedure DarkIcon(i: integer);83 TLine = array [0 .. 649, 0 .. 2] of Byte; 84 85 procedure DarkIcon(i: Integer); 90 86 var 91 x,y,ch,x0Dst,y0Dst,x0Src,y0Src,darken,c: integer;92 Src,Dst: ^TLine;93 begin 94 x0Dst:=ClientWidth div 2-xSizeBig div 2+RingPosition[i,0];95 y0Dst:=ClientHeight div 2-ySizeBig div 2+RingPosition[i,1];96 x0Src:=(i mod 7)*xSizeBig;97 y0Src:=(i div 7+SystemIconLines)*ySizeBig;98 for y:=0 to ySizeBig-1 do99 begin 100 Src:=BigImp.ScanLine[y0Src+y];101 Dst:=Offscreen.ScanLine[y0Dst+y];102 for x:=0 to xSizeBig-1 do87 X, Y, ch, x0Dst, y0Dst, x0Src, y0Src, darken, c: Integer; 88 Src, Dst: ^TLine; 89 begin 90 x0Dst := ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 0]; 91 y0Dst := ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1]; 92 x0Src := (i mod 7) * xSizeBig; 93 y0Src := (i div 7 + SystemIconLines) * ySizeBig; 94 for Y := 0 to ySizeBig - 1 do 95 begin 96 Src := BigImp.ScanLine[y0Src + Y]; 97 Dst := Offscreen.ScanLine[y0Dst + Y]; 98 for X := 0 to xSizeBig - 1 do 103 99 begin 104 darken:=((255-Src[x0Src+x][0])*3 105 +(255-Src[x0Src+x][1])*15 106 +(255-Src[x0Src+x][2])*9) div 128; 107 for ch:=0 to 2 do 100 darken := ((255 - Src[x0Src + X][0]) * 3 + (255 - Src[x0Src + X][1]) * 101 15 + (255 - Src[x0Src + X][2]) * 9) div 128; 102 for ch := 0 to 2 do 108 103 begin 109 c:=Dst[x0Dst+x][ch]-darken; 110 if c<0 then Dst[x0Dst+x][ch]:=0 111 else Dst[x0Dst+x][ch]:=c; 104 c := Dst[x0Dst + X][ch] - darken; 105 if c < 0 then 106 Dst[x0Dst + X][ch] := 0 107 else 108 Dst[x0Dst + X][ch] := c; 112 109 end 113 110 end … … 115 112 end; 116 113 117 procedure Glow(i, GlowColor: integer);118 begin 119 GlowFrame(Offscreen, ClientWidth div 2-xSizeBig div 2+RingPosition[i,0],120 ClientHeight div 2-ySizeBig div 2+RingPosition[i,1],121 xSizeBig,ySizeBig, GlowColor);114 procedure Glow(i, GlowColor: Integer); 115 begin 116 GlowFrame(Offscreen, ClientWidth div 2 - xSizeBig div 2 + RingPosition[i, 117 0], ClientHeight div 2 - ySizeBig div 2 + RingPosition[i, 1], xSizeBig, 118 ySizeBig, GlowColor); 122 119 end; 123 120 124 121 const 125 darken=24;126 // space=pi/120;127 amax0=15734; // 1 shl 16*tan(pi/12-space);128 amin1=19413; // 1 shl 16*tan(pi/12+space);129 amax1=62191; // 1 shl 16*tan(pi/4-space);130 amin2=69061; // 1 shl 16*tan(pi/4+space);131 amax2=221246; // 1 shl 16*tan(5*pi/12-space);132 amin3=272977; // 1 shl 16*tan(5*pi/12+space);122 darken = 24; 123 // space=pi/120; 124 amax0 = 15734; // 1 shl 16*tan(pi/12-space); 125 amin1 = 19413; // 1 shl 16*tan(pi/12+space); 126 amax1 = 62191; // 1 shl 16*tan(pi/4-space); 127 amin2 = 69061; // 1 shl 16*tan(pi/4+space); 128 amax2 = 221246; // 1 shl 16*tan(5*pi/12-space); 129 amin3 = 272977; // 1 shl 16*tan(5*pi/12+space); 133 130 var 134 i,x,y,r,ax,ch,c: integer; 135 HaveWonder: boolean; 136 Line: array[0..1] of ^TLine; 137 s: string; 138 begin 139 if (OffscreenUser<>nil) and (OffscreenUser<>self) then OffscreenUser.Update; 131 i, X, Y, r, ax, ch, c: Integer; 132 HaveWonder: boolean; 133 Line: array [0 .. 1] of ^TLine; 134 s: string; 135 begin 136 if (OffscreenUser <> nil) and (OffscreenUser <> self) then 137 OffscreenUser.Update; 140 138 // complete working with old owner to prevent rebound 141 OffscreenUser:=self; 142 143 Fill(Offscreen.Canvas,3,3,ClientWidth-6,ClientHeight-6, 144 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 145 Frame(Offscreen.Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 146 Frame(Offscreen.Canvas,1,1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight,MainTexture.clBevelShade); 147 Frame(Offscreen.Canvas,2,2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight,MainTexture.clBevelShade); 148 Corner(Offscreen.Canvas,1,1,0,MainTexture); 149 Corner(Offscreen.Canvas,ClientWidth-9,1,1,MainTexture); 150 Corner(Offscreen.Canvas,1,ClientHeight-9,2,MainTexture); 151 Corner(Offscreen.Canvas,ClientWidth-9,ClientHeight-9,3,MainTexture); 152 153 BtnFrame(Offscreen.Canvas,CloseBtn.BoundsRect,MainTexture); 154 155 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 156 s:=Phrases.Lookup('TITLE_WONDERS'); 157 RisedTextOut(Offscreen.Canvas,(ClientWidth-BiColorTextWidth(Offscreen.Canvas,s)) div 2-1,7,s); 158 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 159 160 xm:=ClientWidth div 2; 161 ym:=ClientHeight div 2; 162 for y:=0 to 127 do 163 begin 164 Line[0]:=Offscreen.Scanline[ym+y]; 165 Line[1]:=Offscreen.Scanline[ym-1-y]; 166 for x:=0 to 179 do 167 begin 168 r:=x*x*(32*32)+y*y*(45*45); 169 ax:=((1 shl 16 div 32)*45)*y; 170 if (r<8*128*180*180) 171 and ((r>=32*64*90*90) and (ax<amax2*x) and ((ax<amax0*x) or (ax>amin2*x)) 172 or (ax>amin1*x) and ((ax<amax1*x) or (ax>amin3*x))) then 173 for i:=0 to 1 do for ch:=0 to 2 do 139 OffscreenUser := self; 140 141 Fill(Offscreen.Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6, 142 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2); 143 Frame(Offscreen.Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 144 Frame(Offscreen.Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 145 MainTexture.clBevelLight, MainTexture.clBevelShade); 146 Frame(Offscreen.Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 147 MainTexture.clBevelLight, MainTexture.clBevelShade); 148 Corner(Offscreen.Canvas, 1, 1, 0, MainTexture); 149 Corner(Offscreen.Canvas, ClientWidth - 9, 1, 1, MainTexture); 150 Corner(Offscreen.Canvas, 1, ClientHeight - 9, 2, MainTexture); 151 Corner(Offscreen.Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture); 152 153 BtnFrame(Offscreen.Canvas, CloseBtn.BoundsRect, MainTexture); 154 155 Offscreen.Canvas.Font.Assign(UniFont[ftCaption]); 156 s := Phrases.Lookup('TITLE_WONDERS'); 157 RisedTextOut(Offscreen.Canvas, 158 (ClientWidth - BiColorTextWidth(Offscreen.Canvas, s)) div 2 - 1, 7, s); 159 Offscreen.Canvas.Font.Assign(UniFont[ftNormal]); 160 161 xm := ClientWidth div 2; 162 ym := ClientHeight div 2; 163 for Y := 0 to 127 do 164 begin 165 Line[0] := Offscreen.ScanLine[ym + Y]; 166 Line[1] := Offscreen.ScanLine[ym - 1 - Y]; 167 for X := 0 to 179 do 168 begin 169 r := X * X * (32 * 32) + Y * Y * (45 * 45); 170 ax := ((1 shl 16 div 32) * 45) * Y; 171 if (r < 8 * 128 * 180 * 180) and 172 ((r >= 32 * 64 * 90 * 90) and (ax < amax2 * X) and 173 ((ax < amax0 * X) or (ax > amin2 * X)) or (ax > amin1 * X) and 174 ((ax < amax1 * X) or (ax > amin3 * X))) then 175 for i := 0 to 1 do 176 for ch := 0 to 2 do 174 177 begin 175 c:=Line[i][xm+x][ch]-darken; 176 if c<0 then Line[i][xm+x][ch]:=0 177 else Line[i][xm+x][ch]:=c; 178 c:=Line[i][xm-1-x][ch]-darken; 179 if c<0 then Line[i][xm-1-x][ch]:=0 180 else Line[i][xm-1-x][ch]:=c; 178 c := Line[i][xm + X][ch] - darken; 179 if c < 0 then 180 Line[i][xm + X][ch] := 0 181 else 182 Line[i][xm + X][ch] := c; 183 c := Line[i][xm - 1 - X][ch] - darken; 184 if c < 0 then 185 Line[i][xm - 1 - X][ch] := 0 186 else 187 Line[i][xm - 1 - X][ch] := c; 181 188 end 182 189 end; 183 190 end; 184 191 185 HaveWonder:=false; 186 for i:=0 to 20 do if Imp[i].Preq<>preNA then 187 begin 188 case MyRO.Wonder[i].CityID of 189 -1: // not built yet 192 HaveWonder := false; 193 for i := 0 to 20 do 194 if Imp[i].Preq <> preNA then 195 begin 196 case MyRO.Wonder[i].CityID of 197 - 1: // not built yet 198 begin 199 Fill(Offscreen.Canvas, xm - xSizeBig div 2 + RingPosition[i, 0] - 3, 200 ym - ySizeBig div 2 + RingPosition[i, 1] - 3, xSizeBig + 6, 201 ySizeBig + 6, (wMaintexture - ClientWidth) div 2, 202 (hMaintexture - ClientHeight) div 2); 203 DarkIcon(i); 204 end; 205 -2: // destroyed 206 begin 207 HaveWonder := true; 208 Glow(i, $000000); 209 BitBlt(Offscreen.Canvas.Handle, xm - xSizeBig div 2 + RingPosition 210 [i, 0], ym - ySizeBig div 2 + RingPosition[i, 1], xSizeBig, 211 ySizeBig, BigImp.Canvas.Handle, 0, (SystemIconLines + 3) * 212 ySizeBig, SRCCOPY); 213 end; 214 else 215 begin 216 HaveWonder := true; 217 if MyRO.Wonder[i].EffectiveOwner >= 0 then 218 Glow(i, Tribe[MyRO.Wonder[i].EffectiveOwner].Color) 219 else 220 Glow(i, $000000); 221 BitBlt(Offscreen.Canvas.Handle, xm - xSizeBig div 2 + RingPosition[i, 222 0], ym - ySizeBig div 2 + RingPosition[i, 1], xSizeBig, ySizeBig, 223 BigImp.Canvas.Handle, (i mod 7) * xSizeBig, 224 (i div 7 + SystemIconLines) * ySizeBig, SRCCOPY); 225 end 226 end 227 end; 228 229 if not HaveWonder then 230 begin 231 s := Phrases.Lookup('NOWONDER'); 232 RisedTextOut(Offscreen.Canvas, xm - BiColorTextWidth(Offscreen.Canvas, s) 233 div 2, ym - Offscreen.Canvas.TextHeight(s) div 2, s); 234 end; 235 236 MarkUsedOffscreen(ClientWidth, ClientHeight); 237 end; { OffscreenPaint } 238 239 procedure TWondersDlg.CloseBtnClick(Sender: TObject); 240 begin 241 Close 242 end; 243 244 procedure TWondersDlg.FormMouseMove(Sender: TObject; Shift: TShiftState; 245 X, Y: Integer); 246 var 247 i, OldSelection: Integer; 248 s: string; 249 begin 250 OldSelection := Selection; 251 Selection := -1; 252 for i := 0 to 20 do 253 if (Imp[i].Preq <> preNA) and (X >= xm - xSizeBig div 2 + RingPosition[i, 0] 254 ) and (X < xm + xSizeBig div 2 + RingPosition[i, 0]) and 255 (Y >= ym - ySizeBig div 2 + RingPosition[i, 1]) and 256 (Y < ym + ySizeBig div 2 + RingPosition[i, 1]) then 257 begin 258 Selection := i; 259 break 260 end; 261 if Selection <> OldSelection then 262 begin 263 Fill(Canvas, 9, ClientHeight - 3 - 46, ClientWidth - 18, 44, 264 (wMaintexture - ClientWidth) div 2, (hMaintexture - ClientHeight) div 2); 265 if Selection >= 0 then 266 begin 267 if MyRO.Wonder[Selection].CityID = -1 then 268 begin // not built yet 269 { s:=Phrases.Lookup('IMPROVEMENTS',Selection); 270 Canvas.Font.Color:=$000000; 271 Canvas.TextOut( 272 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2+1, 273 ClientHeight-3-36+1, s); 274 Canvas.Font.Color:=MainTexture.clBevelLight; 275 Canvas.TextOut( 276 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 277 ClientHeight-3-36, s); } 278 end 279 else 190 280 begin 191 Fill(Offscreen.Canvas, 192 xm-xSizeBig div 2+RingPosition[i,0]-3, 193 ym-ySizeBig div 2+RingPosition[i,1]-3, 194 xSizeBig+6, ySizeBig+6, 195 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 196 DarkIcon(i); 197 end; 198 -2: // destroyed 199 begin 200 HaveWonder:=true; 201 Glow(i,$000000); 202 BitBlt(Offscreen.Canvas.Handle, xm-xSizeBig div 2+RingPosition[i,0], 203 ym-ySizeBig div 2+RingPosition[i,1], xSizeBig, ySizeBig, 204 BigImp.Canvas.Handle, 0, (SystemIconLines+3)*ySizeBig, SRCCOPY); 205 end; 206 else 207 begin 208 HaveWonder:=true; 209 if MyRO.Wonder[i].EffectiveOwner>=0 then 210 Glow(i,Tribe[MyRO.Wonder[i].EffectiveOwner].Color) 211 else Glow(i,$000000); 212 BitBlt(Offscreen.Canvas.Handle, xm-xSizeBig div 2+RingPosition[i,0], 213 ym-ySizeBig div 2+RingPosition[i,1], xSizeBig, ySizeBig, 214 BigImp.Canvas.Handle, (i mod 7)*xSizeBig, 215 (i div 7+SystemIconLines)*ySizeBig, SRCCOPY); 216 end 217 end 218 end; 219 220 if not HaveWonder then 221 begin 222 s:=Phrases.Lookup('NOWONDER'); 223 RisedTextout(Offscreen.Canvas,xm-BiColorTextWidth(Offscreen.Canvas,s) div 2, 224 ym-Offscreen.Canvas.TextHeight(s) div 2, s); 225 end; 226 227 MarkUsedOffscreen(ClientWidth,ClientHeight); 228 end; {OffscreenPaint} 229 230 procedure TWondersDlg.CloseBtnClick(Sender: TObject); 231 begin 232 Close 233 end; 234 235 procedure TWondersDlg.FormMouseMove(Sender: TObject; Shift: TShiftState; X, 236 Y: Integer); 237 var 238 i,OldSelection: integer; 239 s: string; 240 begin 241 OldSelection:=Selection; 242 Selection:=-1; 243 for i:=0 to 20 do 244 if (Imp[i].Preq<>preNA) and (x>=xm-xSizeBig div 2+RingPosition[i,0]) 245 and (x<xm+xSizeBig div 2+RingPosition[i,0]) 246 and (y>=ym-ySizeBig div 2+RingPosition[i,1]) 247 and (y<ym+ySizeBig div 2+RingPosition[i,1]) then 248 begin Selection:=i; break end; 249 if Selection<>OldSelection then 250 begin 251 Fill(Canvas,9,ClientHeight-3-46,ClientWidth-18,44, 252 (wMaintexture-ClientWidth) div 2,(hMaintexture-ClientHeight) div 2); 253 if Selection>=0 then 254 begin 255 if MyRO.Wonder[Selection].CityID=-1 then 256 begin // not built yet 257 { s:=Phrases.Lookup('IMPROVEMENTS',Selection); 258 Canvas.Font.Color:=$000000; 259 Canvas.TextOut( 260 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2+1, 261 ClientHeight-3-36+1, s); 262 Canvas.Font.Color:=MainTexture.clBevelLight; 263 Canvas.TextOut( 264 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 265 ClientHeight-3-36, s);} 266 end 267 else 268 begin 269 s:=Phrases.Lookup('IMPROVEMENTS',Selection); 270 if MyRO.Wonder[Selection].CityID<>-2 then 271 s:=Format(Phrases.Lookup('WONDEROF'), 272 [s,CityName(MyRO.Wonder[Selection].CityID)]); 273 LoweredTextOut(Canvas, -1, MainTexture, (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 274 ClientHeight-3-36-10, s); 275 if MyRO.Wonder[Selection].CityID=-2 then 276 s:=Phrases.Lookup('DESTROYED') 277 else if MyRO.Wonder[Selection].EffectiveOwner<0 then 278 s:=Phrases.Lookup('EXPIRED') 279 else s:=Tribe[MyRO.Wonder[Selection].EffectiveOwner].TPhrase('WONDEROWNER'); 280 LoweredTextOut(Canvas, -1, MainTexture, (ClientWidth-BiColorTextWidth(Canvas,s)) div 2, 281 ClientHeight-3-36+10, s); 281 s := Phrases.Lookup('IMPROVEMENTS', Selection); 282 if MyRO.Wonder[Selection].CityID <> -2 then 283 s := Format(Phrases.Lookup('WONDEROF'), 284 [s, CityName(MyRO.Wonder[Selection].CityID)]); 285 LoweredTextOut(Canvas, -1, MainTexture, 286 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 287 ClientHeight - 3 - 36 - 10, s); 288 if MyRO.Wonder[Selection].CityID = -2 then 289 s := Phrases.Lookup('DESTROYED') 290 else if MyRO.Wonder[Selection].EffectiveOwner < 0 then 291 s := Phrases.Lookup('EXPIRED') 292 else 293 s := Tribe[MyRO.Wonder[Selection].EffectiveOwner] 294 .TPhrase('WONDEROWNER'); 295 LoweredTextOut(Canvas, -1, MainTexture, 296 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 297 ClientHeight - 3 - 36 + 10, s); 282 298 end 283 299 end; … … 288 304 Shift: TShiftState; X, Y: Integer); 289 305 begin 290 if Selection>=0 then291 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Selection);306 if Selection >= 0 then 307 HelpDlg.ShowNewContent(FWindowMode or wmPersistent, hkImp, Selection); 292 308 end; 293 309 294 310 end. 295 -
trunk/Log.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit log; 4 3 … … 28 27 procedure mClearClick(Sender: TObject); 29 28 procedure mSlotClick(Sender: TObject); 30 procedure FormKeyDown(Sender: TObject; var Key: word; 31 Shift: TShiftState); 29 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 32 30 procedure Toggle(Sender: TObject); 33 31 procedure ListMouseDown(Sender: TObject; Button: TMouseButton; 34 32 Shift: TShiftState; X, Y: Integer); 35 procedure FormKeyUp(Sender: TObject; var Key: Word; 36 Shift: TShiftState); 33 procedure FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState); 37 34 public 38 35 Host: TForm; 39 procedure Add(Level, Turn: integer; Text: pchar);36 procedure Add(Level, Turn: Integer; Text: pchar); 40 37 private 41 MaxLevel: integer;38 MaxLevel: Integer; 42 39 end; 43 40 … … 48 45 49 46 uses 50 ClientTools,Tribes;47 ClientTools, Tribes; 51 48 52 49 {$R *.DFM} 53 50 54 51 const 55 MaxLines=1000;52 MaxLines = 1000; 56 53 57 54 procedure TLogDlg.FormCreate(Sender: TObject); 58 55 begin 59 MaxLevel:=0;56 MaxLevel := 0; 60 57 end; 61 58 62 59 procedure TLogDlg.mLogClick(Sender: TObject); 63 60 begin 64 MaxLevel:=TMenuItem(Sender).Tag;65 TMenuItem(Sender).Checked:=true;61 MaxLevel := TMenuItem(Sender).Tag; 62 TMenuItem(Sender).Checked := true; 66 63 end; 67 64 68 procedure TLogDlg.Add(Level, Turn: integer; Text: pchar);65 procedure TLogDlg.Add(Level, Turn: Integer; Text: pchar); 69 66 begin 70 if (MaxLevel>0) and (Level<=MaxLevel) 71 or (Level=1 shl 16+1) and mInvalid.Checked 72 or (Level=1 shl 16+2) and mTime.Checked 73 or (Level=1 shl 16+3) and mNegotiation.Checked then 67 if (MaxLevel > 0) and (Level <= MaxLevel) or (Level = 1 shl 16 + 1) and 68 mInvalid.Checked or (Level = 1 shl 16 + 2) and mTime.Checked or 69 (Level = 1 shl 16 + 3) and mNegotiation.Checked then 74 70 begin 75 if List.Lines.Count=MaxLines then List.Lines.Delete(0); 76 List.Lines.Add(char(48+Turn div 100 mod 10) 77 +char(48+Turn div 10 mod 10)+char(48+Turn mod 10)+' '+Text); 78 PostMessage(List.Handle,WM_VSCROLL,SB_BOTTOM,0); 79 Update; 71 if List.Lines.Count = MaxLines then 72 List.Lines.Delete(0); 73 List.Lines.Add(char(48 + Turn div 100 mod 10) + 74 char(48 + Turn div 10 mod 10) + char(48 + Turn mod 10) + ' ' + Text); 75 PostMessage(List.Handle, WM_VSCROLL, SB_BOTTOM, 0); 76 Update; 80 77 end; 81 78 end; … … 83 80 procedure TLogDlg.mClearClick(Sender: TObject); 84 81 begin 85 List.Clear;82 List.Clear; 86 83 end; 87 84 88 85 procedure TLogDlg.mSlotClick(Sender: TObject); 89 86 const 90 SlotNo: array[0..2,0..2] of integer=((8,1,2),(7,0,3),(6,5,4));87 SlotNo: array [0 .. 2, 0 .. 2] of Integer = ((8, 1, 2), (7, 0, 3), (6, 5, 4)); 91 88 var 92 x,y: integer;93 s: string;89 X, Y: Integer; 90 s: string; 94 91 begin 95 for y:=0 to 2 do92 for Y := 0 to 2 do 96 93 begin 97 s:='| '; 98 for x:=0 to 2 do 99 if G.Difficulty[SlotNo[y,x]]=0 then s:=s+'SUP |' 100 else if G.Difficulty[SlotNo[y,x]]<0 then s:=s+'--- |' 101 else 94 s := '| '; 95 for X := 0 to 2 do 96 if G.Difficulty[SlotNo[Y, X]] = 0 then 97 s := s + 'SUP |' 98 else if G.Difficulty[SlotNo[Y, X]] < 0 then 99 s := s + '--- |' 100 else 102 101 begin 103 if SlotNo[y,x] in [6..8] then102 if SlotNo[Y, X] in [6 .. 8] then 104 103 begin // check multi control 105 if G.Difficulty[SlotNo[y,x]+3]>=0 then106 s:=s+Tribe[SlotNo[y,x]+3].TPhrase('SHORTNAME')+'+';107 if G.Difficulty[SlotNo[y,x]+6]>=0 then108 s:=s+Tribe[SlotNo[y,x]+6].TPhrase('SHORTNAME')+'+';104 if G.Difficulty[SlotNo[Y, X] + 3] >= 0 then 105 s := s + Tribe[SlotNo[Y, X] + 3].TPhrase('SHORTNAME') + '+'; 106 if G.Difficulty[SlotNo[Y, X] + 6] >= 0 then 107 s := s + Tribe[SlotNo[Y, X] + 6].TPhrase('SHORTNAME') + '+'; 109 108 end; 110 s:=s+Tribe[SlotNo[y,x]].TPhrase('SHORTNAME')+' | ';109 s := s + Tribe[SlotNo[Y, X]].TPhrase('SHORTNAME') + ' | '; 111 110 end; 112 List.Lines.Add(s)111 List.Lines.Add(s) 113 112 end; 114 PostMessage(List.Handle,WM_VSCROLL,SB_BOTTOM,0);113 PostMessage(List.Handle, WM_VSCROLL, SB_BOTTOM, 0); 115 114 end; 116 115 … … 118 117 Shift: TShiftState); 119 118 begin 120 if Host<>nil then121 Host.OnKeyDown(Sender, Key, Shift);119 if Host <> nil then 120 Host.OnKeyDown(Sender, Key, Shift); 122 121 end; 123 122 124 123 procedure TLogDlg.Toggle(Sender: TObject); 125 124 begin 126 TMenuItem(Sender).Checked:=not TMenuItem(Sender).Checked;125 TMenuItem(Sender).Checked := not TMenuItem(Sender).Checked; 127 126 end; 128 127 … … 130 129 Shift: TShiftState; X, Y: Integer); 131 130 begin 132 if Button=mbRight then LogPopup.Popup(Left+x,Top+y); 131 if Button = mbRight then 132 LogPopup.Popup(Left + X, Top + Y); 133 133 end; 134 134 135 procedure TLogDlg.FormKeyUp(Sender: TObject; var Key: Word; 136 Shift: TShiftState); 135 procedure TLogDlg.FormKeyUp(Sender: TObject; var Key: word; Shift: TShiftState); 137 136 begin 138 if Host<>nil then139 Host.OnKeyUp(Sender, Key, Shift);137 if Host <> nil then 138 Host.OnKeyUp(Sender, Key, Shift); 140 139 end; 141 140 142 141 end. 143 -
trunk/Messg.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit Messg; 4 3 … … 8 7 ScreenTools, 9 8 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,ButtonBase,ButtonA, 11 ButtonB,Area; 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, ButtonBase, 10 ButtonA, 11 ButtonB, Area; 12 12 13 13 const 14 WM_PLAYSOUND=WM_USER;14 WM_PLAYSOUND = WM_USER; 15 15 16 16 type … … 20 20 procedure SmartInvalidate; virtual; 21 21 protected 22 TitleHeight: integer; // defines area to grip the window for moving (from top) 22 TitleHeight: integer; 23 // defines area to grip the window for moving (from top) 23 24 procedure InitButtons(); 24 procedure OnEraseBkgnd(var m: TMessage); message WM_ERASEBKGND;25 procedure OnHitTest(var Msg: TMessage); message WM_NCHITTEST;25 procedure OnEraseBkgnd(var m: TMessage); message WM_ERASEBKGND; 26 procedure OnHitTest(var Msg: TMessage); message WM_NCHITTEST; 26 27 end; 27 28 28 29 TBaseMessgDlg = class(TDrawDlg) 29 30 procedure FormCreate(Sender: TObject); 30 procedure FormPaint(Sender: TObject);31 procedure FormPaint(Sender: TObject); 31 32 public 32 33 MessgText: string; … … 40 41 Button1: TButtonA; 41 42 Button2: TButtonA; 42 procedure FormCreate(Sender: TObject);43 procedure FormPaint(Sender: TObject);43 procedure FormCreate(Sender: TObject); 44 procedure FormPaint(Sender: TObject); 44 45 procedure FormShow(Sender: TObject); 45 46 procedure Button1Click(Sender: TObject); … … 50 51 OpenSound: string; 51 52 private 52 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND;53 procedure OnPlaySound(var Msg: TMessage); message WM_PLAYSOUND; 53 54 end; 54 55 55 56 const 56 // message kinds 57 mkOK=1; mkOKCancel=2; mkYesNo=3; 58 59 Border=3; 60 MessageLineSpacing=20; 61 62 var 63 MessgDlg:TMessgDlg; 57 // message kinds 58 mkOK = 1; 59 mkOKCancel = 2; 60 mkYesNo = 3; 61 62 Border = 3; 63 MessageLineSpacing = 20; 64 65 var 66 MessgDlg: TMessgDlg; 64 67 65 68 procedure SimpleMessage(SimpleText: string); 66 69 procedure SoundMessage(SimpleText, SoundItem: string); 67 70 68 69 71 implementation 70 72 … … 73 75 constructor TDrawDlg.Create(AOwner: TComponent); 74 76 begin 75 inherited; 76 TitleHeight:=0; 77 end; 78 79 procedure TDrawDlg.OnEraseBkgnd(var m:TMessage); 80 begin 81 end; 82 83 procedure TDrawDlg.OnHitTest(var Msg:TMessage); 84 var 85 i: integer; 86 ControlBounds: TRect; 87 begin 88 if BorderStyle<>bsNone then 89 inherited 90 else 91 begin 92 if integer(Msg.LParamHi)>=Top+TitleHeight then 93 Msg.result:=HTCLIENT 77 inherited; 78 TitleHeight := 0; 79 end; 80 81 procedure TDrawDlg.OnEraseBkgnd(var m: TMessage); 82 begin 83 end; 84 85 procedure TDrawDlg.OnHitTest(var Msg: TMessage); 86 var 87 i: integer; 88 ControlBounds: TRect; 89 begin 90 if BorderStyle <> bsNone then 91 inherited 94 92 else 95 begin 96 for i:=0 to ControlCount-1 do if Controls[i].Visible then 97 begin 98 ControlBounds:=Controls[i].BoundsRect; 99 if (integer(Msg.LParamLo)>=Left+ControlBounds.Left) 100 and (integer(Msg.LParamLo)<Left+ControlBounds.Right) 101 and (integer(Msg.LParamHi)>=Top+ControlBounds.Top) 102 and (integer(Msg.LParamHi)<Top+ControlBounds.Bottom) then 93 begin 94 if integer(Msg.LParamHi) >= Top + TitleHeight then 95 Msg.result := HTCLIENT 96 else 97 begin 98 for i := 0 to ControlCount - 1 do 99 if Controls[i].Visible then 103 100 begin 104 Msg.result:=HTCLIENT; 105 exit; 101 ControlBounds := Controls[i].BoundsRect; 102 if (integer(Msg.LParamLo) >= Left + ControlBounds.Left) and 103 (integer(Msg.LParamLo) < Left + ControlBounds.Right) and 104 (integer(Msg.LParamHi) >= Top + ControlBounds.Top) and 105 (integer(Msg.LParamHi) < Top + ControlBounds.Bottom) then 106 begin 107 Msg.result := HTCLIENT; 108 exit; 109 end; 106 110 end; 107 end; 108 Msg.result:=HTCAPTION 111 Msg.result := HTCAPTION 109 112 end; 110 113 end … … 113 116 procedure TDrawDlg.InitButtons(); 114 117 var 115 cix: integer;116 //ButtonDownSound, ButtonUpSound: string;117 begin 118 //ButtonDownSound:=Sounds.Lookup('BUTTON_DOWN');119 //ButtonUpSound:=Sounds.Lookup('BUTTON_UP');120 for cix:=0 to ComponentCount-1 do121 if Components[cix] is TButtonBase then122 begin 123 TButtonBase(Components[cix]).Graphic:=GrExt[HGrSystem].Data;124 //if ButtonDownSound<>'*' then125 //DownSound:=HomeDir+'Sounds\'+ButtonDownSound+'.wav';126 //if ButtonUpSound<>'*' then127 //UpSound:=HomeDir+'Sounds\'+ButtonUpSound+'.wav';128 if Components[cix] is TButtonA then129 TButtonA(Components[cix]).Font:=UniFont[ftButton];130 if Components[cix] is TButtonB then131 TButtonB(Components[cix]).Mask:=GrExt[HGrSystem].Mask;118 cix: integer; 119 // ButtonDownSound, ButtonUpSound: string; 120 begin 121 // ButtonDownSound:=Sounds.Lookup('BUTTON_DOWN'); 122 // ButtonUpSound:=Sounds.Lookup('BUTTON_UP'); 123 for cix := 0 to ComponentCount - 1 do 124 if Components[cix] is TButtonBase then 125 begin 126 TButtonBase(Components[cix]).Graphic := GrExt[HGrSystem].Data; 127 // if ButtonDownSound<>'*' then 128 // DownSound:=HomeDir+'Sounds\'+ButtonDownSound+'.wav'; 129 // if ButtonUpSound<>'*' then 130 // UpSound:=HomeDir+'Sounds\'+ButtonUpSound+'.wav'; 131 if Components[cix] is TButtonA then 132 TButtonA(Components[cix]).Font := UniFont[ftButton]; 133 if Components[cix] is TButtonB then 134 TButtonB(Components[cix]).Mask := GrExt[HGrSystem].Mask; 132 135 end; 133 136 end; … … 135 138 procedure TDrawDlg.SmartInvalidate; 136 139 var 137 i: integer;138 r0,r1: HRgn;139 begin 140 r0:=CreateRectRgn(0,0,ClientWidth,ClientHeight);141 for i:=0 to ControlCount-1 do142 if not(Controls[i] is TArea) and Controls[i].Visible then143 begin 144 with Controls[i].BoundsRect do145 r1:=CreateRectRgn(Left,Top,Right,Bottom);146 CombineRgn(r0,r0,r1,RGN_DIFF);147 DeleteObject(r1);148 end; 149 InvalidateRgn(Handle,r0,false);150 DeleteObject(r0);140 i: integer; 141 r0, r1: HRgn; 142 begin 143 r0 := CreateRectRgn(0, 0, ClientWidth, ClientHeight); 144 for i := 0 to ControlCount - 1 do 145 if not(Controls[i] is TArea) and Controls[i].Visible then 146 begin 147 with Controls[i].BoundsRect do 148 r1 := CreateRectRgn(Left, Top, Right, Bottom); 149 CombineRgn(r0, r0, r1, RGN_DIFF); 150 DeleteObject(r1); 151 end; 152 InvalidateRgn(Handle, r0, false); 153 DeleteObject(r0); 151 154 end; 152 155 153 156 procedure TBaseMessgDlg.FormCreate(Sender: TObject); 154 157 begin 155 Left:=(Screen.Width-ClientWidth) div 2; 156 Canvas.Font.Assign(UniFont[ftNormal]); 157 Canvas.Brush.Style:=bsClear; 158 MessgText:=''; 159 TopSpace:=0; 160 TitleHeight:=Screen.Height; 161 InitButtons(); 162 end; 163 164 procedure TBaseMessgDlg.FormPaint(Sender:TObject); 165 var 166 i,cix: integer; 167 begin 168 PaintBackground(self,3+Border,3+Border,ClientWidth-(6+2*Border), 169 ClientHeight-(6+2*Border)); 170 for i:=0 to Border do 171 Frame(Canvas,i,i,ClientWidth-1-i,ClientHeight-1-i, 172 $000000,$000000); 173 Frame(Canvas,Border+1,Border+1,ClientWidth-(2+Border),ClientHeight-(2+Border), 174 MainTexture.clBevelLight,MainTexture.clBevelShade); 175 Frame(Canvas,2+Border,2+Border,ClientWidth-(3+Border),ClientHeight-(3+Border), 176 MainTexture.clBevelLight,MainTexture.clBevelShade); 177 SplitText(false); 178 179 for cix:=0 to ControlCount-1 do 180 if (Controls[cix].Visible) and (Controls[cix] is TButtonBase) then 181 BtnFrame(Canvas,Controls[cix].BoundsRect,MainTexture); 158 Left := (Screen.Width - ClientWidth) div 2; 159 Canvas.Font.Assign(UniFont[ftNormal]); 160 Canvas.Brush.Style := bsClear; 161 MessgText := ''; 162 TopSpace := 0; 163 TitleHeight := Screen.Height; 164 InitButtons(); 165 end; 166 167 procedure TBaseMessgDlg.FormPaint(Sender: TObject); 168 var 169 i, cix: integer; 170 begin 171 PaintBackground(self, 3 + Border, 3 + Border, ClientWidth - (6 + 2 * Border), 172 ClientHeight - (6 + 2 * Border)); 173 for i := 0 to Border do 174 Frame(Canvas, i, i, ClientWidth - 1 - i, ClientHeight - 1 - i, 175 $000000, $000000); 176 Frame(Canvas, Border + 1, Border + 1, ClientWidth - (2 + Border), 177 ClientHeight - (2 + Border), MainTexture.clBevelLight, 178 MainTexture.clBevelShade); 179 Frame(Canvas, 2 + Border, 2 + Border, ClientWidth - (3 + Border), 180 ClientHeight - (3 + Border), MainTexture.clBevelLight, 181 MainTexture.clBevelShade); 182 SplitText(false); 183 184 for cix := 0 to ControlCount - 1 do 185 if (Controls[cix].Visible) and (Controls[cix] is TButtonBase) then 186 BtnFrame(Canvas, Controls[cix].BoundsRect, MainTexture); 182 187 end; 183 188 184 189 procedure TBaseMessgDlg.SplitText(preview: boolean); 185 190 var 186 Start,Stop,OrdinaryStop,LinesCount: integer; 187 s: string; 188 begin 189 Start:=1; 190 LinesCount:=0; 191 while Start<Length(MessgText) do 192 begin 193 Stop:=Start; 194 while(Stop<Length(MessgText)) and (MessgText[Stop]<>'\') 195 and (BiColorTextWidth(Canvas,Copy(MessgText,Start,Stop-Start+1)) 196 <ClientWidth-56) do 197 inc(Stop); 198 if Stop<>Length(MessgText) then 199 begin 200 OrdinaryStop:=Stop; 201 repeat dec(OrdinaryStop) 202 until (MessgText[OrdinaryStop+1]=' ') or (MessgText[OrdinaryStop+1]='\'); 203 if (OrdinaryStop+1-Start)*2>=Stop-Start then 204 Stop:=OrdinaryStop 205 end; 206 if not preview then 207 begin 208 s:=Copy(MessgText,Start,Stop-Start+1); 209 LoweredTextOut(Canvas,-1,MainTexture, 210 (ClientWidth-BiColorTextWidth(Canvas,s)) div 2,19+Border+TopSpace+LinesCount*MessageLineSpacing,s); 211 end; 212 Start:=Stop+2; 213 inc(LinesCount) 214 end; 215 if preview then Lines:=LinesCount; 191 Start, Stop, OrdinaryStop, LinesCount: integer; 192 s: string; 193 begin 194 Start := 1; 195 LinesCount := 0; 196 while Start < Length(MessgText) do 197 begin 198 Stop := Start; 199 while (Stop < Length(MessgText)) and (MessgText[Stop] <> '\') and 200 (BiColorTextWidth(Canvas, Copy(MessgText, Start, Stop - Start + 1)) < 201 ClientWidth - 56) do 202 inc(Stop); 203 if Stop <> Length(MessgText) then 204 begin 205 OrdinaryStop := Stop; 206 repeat 207 dec(OrdinaryStop) 208 until (MessgText[OrdinaryStop + 1] = ' ') or 209 (MessgText[OrdinaryStop + 1] = '\'); 210 if (OrdinaryStop + 1 - Start) * 2 >= Stop - Start then 211 Stop := OrdinaryStop 212 end; 213 if not preview then 214 begin 215 s := Copy(MessgText, Start, Stop - Start + 1); 216 LoweredTextOut(Canvas, -1, MainTexture, 217 (ClientWidth - BiColorTextWidth(Canvas, s)) div 2, 218 19 + Border + TopSpace + LinesCount * MessageLineSpacing, s); 219 end; 220 Start := Stop + 2; 221 inc(LinesCount) 222 end; 223 if preview then 224 Lines := LinesCount; 216 225 end; 217 226 218 227 procedure TBaseMessgDlg.CorrectHeight; 219 228 var 220 i: integer;221 begin 222 ClientHeight:=72+Border+TopSpace+Lines*MessageLineSpacing;223 Top:=(Screen.Height-ClientHeight) div 2;224 for i:=0 to ControlCount-1 do225 Controls[i].Top:=ClientHeight-(34+Border);226 end; 227 228 procedure TMessgDlg.FormCreate(Sender: TObject);229 begin 230 inherited;231 OpenSound:='';229 i: integer; 230 begin 231 ClientHeight := 72 + Border + TopSpace + Lines * MessageLineSpacing; 232 Top := (Screen.Height - ClientHeight) div 2; 233 for i := 0 to ControlCount - 1 do 234 Controls[i].Top := ClientHeight - (34 + Border); 235 end; 236 237 procedure TMessgDlg.FormCreate(Sender: TObject); 238 begin 239 inherited; 240 OpenSound := ''; 232 241 end; 233 242 234 243 procedure TMessgDlg.FormShow(Sender: TObject); 235 244 begin 236 Button1.Visible:=true; 237 Button2.Visible:= not (Kind in [mkOK]); 238 if Button2.Visible then Button1.Left:=101 239 else Button1.Left:=159; 240 if Kind=mkYesNo then 241 begin 242 Button1.Caption:=Phrases.Lookup('BTN_YES'); 243 Button2.Caption:=Phrases.Lookup('BTN_NO') 245 Button1.Visible := true; 246 Button2.Visible := not(Kind in [mkOK]); 247 if Button2.Visible then 248 Button1.Left := 101 249 else 250 Button1.Left := 159; 251 if Kind = mkYesNo then 252 begin 253 Button1.Caption := Phrases.Lookup('BTN_YES'); 254 Button2.Caption := Phrases.Lookup('BTN_NO') 244 255 end 245 else 246 begin 247 Button1.Caption:=Phrases.Lookup('BTN_OK'); 248 Button2.Caption:=Phrases.Lookup('BTN_CANCEL'); 249 end; 250 251 SplitText(true); 252 CorrectHeight; 253 end; 254 255 procedure TMessgDlg.FormPaint(Sender:TObject); 256 begin 257 inherited; 258 if OpenSound<>'' then PostMessage(Handle, WM_PLAYSOUND, 0, 0); 259 end; {FormPaint} 256 else 257 begin 258 Button1.Caption := Phrases.Lookup('BTN_OK'); 259 Button2.Caption := Phrases.Lookup('BTN_CANCEL'); 260 end; 261 262 SplitText(true); 263 CorrectHeight; 264 end; 265 266 procedure TMessgDlg.FormPaint(Sender: TObject); 267 begin 268 inherited; 269 if OpenSound <> '' then 270 PostMessage(Handle, WM_PLAYSOUND, 0, 0); 271 end; { FormPaint } 260 272 261 273 procedure TMessgDlg.Button1Click(Sender: TObject); 262 274 begin 263 ModalResult:=mrOK;275 ModalResult := mrOK; 264 276 end; 265 277 266 278 procedure TMessgDlg.Button2Click(Sender: TObject); 267 279 begin 268 ModalResult:=mrIgnore;280 ModalResult := mrIgnore; 269 281 end; 270 282 271 283 procedure TMessgDlg.FormKeyPress(Sender: TObject; var Key: char); 272 284 begin 273 if Key=#13 then ModalResult:=mrOK 274 //else if (Key=#27) and (Button2.Visible) then ModalResult:=mrCancel 285 if Key = #13 then 286 ModalResult := mrOK 287 // else if (Key=#27) and (Button2.Visible) then ModalResult:=mrCancel 275 288 end; 276 289 277 290 procedure SimpleMessage(SimpleText: string); 278 291 begin 279 with MessgDlg do280 begin 281 MessgText:=SimpleText;282 Kind:=mkOK;283 ShowModal;292 with MessgDlg do 293 begin 294 MessgText := SimpleText; 295 Kind := mkOK; 296 ShowModal; 284 297 end 285 298 end; … … 287 300 procedure SoundMessage(SimpleText, SoundItem: string); 288 301 begin 289 with MessgDlg do290 begin 291 MessgText:=SimpleText;292 OpenSound:=SoundItem;293 Kind:=mkOK;294 ShowModal;302 with MessgDlg do 303 begin 304 MessgText := SimpleText; 305 OpenSound := SoundItem; 306 Kind := mkOK; 307 ShowModal; 295 308 end 296 309 end; 297 310 298 procedure TMessgDlg.OnPlaySound(var Msg: TMessage);299 begin 300 Play(OpenSound);301 OpenSound:='';311 procedure TMessgDlg.OnPlaySound(var Msg: TMessage); 312 begin 313 Play(OpenSound); 314 OpenSound := ''; 302 315 end; 303 316 304 317 end. 305 -
trunk/NoTerm.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit NoTerm; 4 3 … … 6 5 7 6 uses 8 ScreenTools, Protocol,Messg,7 ScreenTools, Protocol, Messg, 9 8 10 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, … … 19 18 procedure FormPaint(Sender: TObject); 20 19 procedure FormCreate(Sender: TObject); 21 procedure FormKeyDown(Sender: TObject; var Key: word; 22 Shift: TShiftState); 20 procedure FormKeyDown(Sender: TObject; var Key: word; Shift: TShiftState); 23 21 public 24 22 procedure Client(Command, Player: integer; var Data); 25 23 private 26 24 me, Active, ToldAlive, Round: integer; 27 PerfFreq, LastShowYearTime,LastShowTurnChange,LastNewTurn: int64;28 TurnTime, TotalStatTime: extended;25 PerfFreq, LastShowYearTime, LastShowTurnChange, LastNewTurn: int64; 26 TurnTime, TotalStatTime: extended; 29 27 G: TNewGameData; 30 28 Server: TServerCall; 31 29 Shade, State: TBitmap; 32 WinStat, ExtStat, AloneStat: array [0..nPl-1] of integer;33 DisallowShowActive: array [0..nPl-1] of boolean;34 TimeStat: array [0..nPl-1] of extended;30 WinStat, ExtStat, AloneStat: array [0 .. nPl - 1] of integer; 31 DisallowShowActive: array [0 .. nPl - 1] of boolean; 32 TimeStat: array [0 .. nPl - 1] of extended; 35 33 Mode: (Stop, Stopped, Running, Quit); 36 34 procedure NewStat; … … 43 41 NoTermDlg: TNoTermDlg; 44 42 45 procedure Client(Command, Player:integer;var Data); stdcall;43 procedure Client(Command, Player: integer; var Data); stdcall; 46 44 47 45 implementation … … 52 50 53 51 const 54 UpdateInterval=0.1; // seconds 55 ShowActiveThreshold=0.05; // seconds 56 57 nPlOffered=9; 58 x0Brain=109+48+23; y0Brain=124+48+7+16; 59 dxBrain=128; dyBrain=128; 60 xBrain: array[0..nPlOffered-1] of integer = 61 (x0Brain,x0Brain,x0Brain+dxBrain,x0Brain+dxBrain,x0Brain+dxBrain,x0Brain, 62 x0Brain-dxBrain,x0Brain-dxBrain,x0Brain-dxBrain); 63 yBrain: array[0..nPlOffered-1] of integer = 64 (y0Brain,y0Brain-dyBrain,y0Brain-dyBrain,y0Brain,y0Brain+dyBrain, 65 y0Brain+dyBrain,y0Brain+dyBrain,y0Brain,y0Brain-dyBrain); 66 xActive: array[0..nPlOffered-1] of integer = (0,0,36,51,36,0,-36,-51,-36); 67 yActive: array[0..nPlOffered-1] of integer = (0,-51,-36,0,36,51,36,0,-36); 68 69 var 70 FormsCreated: boolean; 52 UpdateInterval = 0.1; // seconds 53 ShowActiveThreshold = 0.05; // seconds 54 55 nPlOffered = 9; 56 x0Brain = 109 + 48 + 23; 57 y0Brain = 124 + 48 + 7 + 16; 58 dxBrain = 128; 59 dyBrain = 128; 60 xBrain: array [0 .. nPlOffered - 1] of integer = (x0Brain, x0Brain, 61 x0Brain + dxBrain, x0Brain + dxBrain, x0Brain + dxBrain, x0Brain, 62 x0Brain - dxBrain, x0Brain - dxBrain, x0Brain - dxBrain); 63 yBrain: array [0 .. nPlOffered - 1] of integer = (y0Brain, y0Brain - dyBrain, 64 y0Brain - dyBrain, y0Brain, y0Brain + dyBrain, y0Brain + dyBrain, 65 y0Brain + dyBrain, y0Brain, y0Brain - dyBrain); 66 xActive: array [0 .. nPlOffered - 1] of integer = (0, 0, 36, 51, 36, 0, 67 -36, -51, -36); 68 yActive: array [0 .. nPlOffered - 1] of integer = (0, -51, -36, 0, 36, 51, 69 36, 0, -36); 70 71 var 72 FormsCreated: boolean; 71 73 72 74 procedure TNoTermDlg.FormCreate(Sender: TObject); 73 75 begin 74 Left:=Screen.Width-Width-8; Top:=8; 75 Caption:=Phrases.Lookup('AIT'); 76 Canvas.Brush.Style:=bsClear; 77 Canvas.Font.Assign(UniFont[ftSmall]); 78 TitleHeight:=36; 79 InitButtons(); 80 QueryPerformanceFrequency(PerfFreq); 81 LastShowYearTime:=0; 76 Left := Screen.Width - Width - 8; 77 Top := 8; 78 Caption := Phrases.Lookup('AIT'); 79 Canvas.Brush.Style := bsClear; 80 Canvas.Font.Assign(UniFont[ftSmall]); 81 TitleHeight := 36; 82 InitButtons(); 83 QueryPerformanceFrequency(PerfFreq); 84 LastShowYearTime := 0; 82 85 end; 83 86 84 87 procedure TNoTermDlg.NewStat; 85 88 begin 86 Round:=0;87 FillChar(WinStat,SizeOf(WinStat),0);88 FillChar(ExtStat,SizeOf(ExtStat),0);89 FillChar(AloneStat,SizeOf(AloneStat),0);90 FillChar(TimeStat,SizeOf(TimeStat),0);91 TotalStatTime:=0;92 Mode:=Stop;89 Round := 0; 90 FillChar(WinStat, SizeOf(WinStat), 0); 91 FillChar(ExtStat, SizeOf(ExtStat), 0); 92 FillChar(AloneStat, SizeOf(AloneStat), 0); 93 FillChar(TimeStat, SizeOf(TimeStat), 0); 94 TotalStatTime := 0; 95 Mode := Stop; 93 96 end; 94 97 95 98 procedure TNoTermDlg.EndPlaying; 96 99 var 97 EndCommand: integer; 98 begin 99 NewStat; 100 if G.RO[me].Turn>0 then with MessgDlg do 100 EndCommand: integer; 101 begin 102 NewStat; 103 if G.RO[me].Turn > 0 then 104 with MessgDlg do 105 begin 106 MessgText := Phrases.Lookup('ENDTOUR'); 107 Kind := mkYesNo; 108 ShowModal; 109 if ModalResult = mrIgnore then 110 EndCommand := sResign 111 else 112 EndCommand := sBreak 113 end 114 else 115 EndCommand := sResign; 116 Server(EndCommand, me, 0, nil^) 117 end; 118 119 procedure TNoTermDlg.ShowActive(p: integer; Active: boolean); 120 begin 121 if p < nPlOffered then 122 Sprite(Canvas, HGrSystem, x0Brain + 28 + xActive[p], 123 y0Brain + 28 + yActive[p], 8, 8, 81 + 9 * Byte(Active), 16); 124 end; 125 126 procedure TNoTermDlg.ShowYear; 127 begin 128 Fill(State.Canvas, 0, 0, 192, 20, 64, 287 + 138); 129 RisedTextOut(State.Canvas, 0, 0, Format(Phrases.Lookup('AIT_ROUND'), [Round]) 130 + ' ' + TurnToString(G.RO[me].Turn)); 131 BitBlt(Canvas.Handle, 64, 287 + 138, 192, 20, State.Canvas.Handle, 0, 132 0, SRCCOPY); 133 end; 134 135 procedure TNoTermDlg.Client(Command, Player: integer; var Data); 136 var 137 i, x, y, p: integer; 138 ActiveDuration: extended; 139 ShipComplete: boolean; 140 r: TRect; 141 now: int64; 142 begin 143 case Command of 144 cDebugMessage: 145 LogDlg.Add(Player, G.RO[0].Turn, pchar(@Data)); 146 147 cInitModule: 148 begin 149 Server := TInitModuleData(Data).Server; 150 TInitModuleData(Data).Flags := aiThreaded; 151 Shade := TBitmap.Create; 152 Shade.Width := 64; 153 Shade.Height := 64; 154 for x := 0 to 63 do 155 for y := 0 to 63 do 156 if Odd(x + y) then 157 Shade.Canvas.Pixels[x, y] := $FFFFFF 158 else 159 Shade.Canvas.Pixels[x, y] := $000000; 160 State := TBitmap.Create; 161 State.Width := 192; 162 State.Height := 20; 163 State.Canvas.Brush.Style := bsClear; 164 State.Canvas.Font.Assign(UniFont[ftSmall]); 165 NewStat; 166 end; 167 168 cReleaseModule: 169 begin 170 Shade.Free; 171 State.Free 172 end; 173 174 cNewGame, cLoadGame: 175 begin 176 inc(Round); 177 if Mode = Running then 178 begin 179 Invalidate; 180 Update 181 end 182 else 183 Show; 184 G := TNewGameData(Data); 185 LogDlg.mSlot.Visible := false; 186 LogDlg.Host := nil; 187 ToldAlive := G.RO[me].Alive; 188 Active := -1; 189 FillChar(DisallowShowActive, SizeOf(DisallowShowActive), 0); // false 190 LastShowTurnChange := 0; 191 LastNewTurn := 0; 192 TurnTime := 1.0; 193 end; 194 195 cBreakGame: 196 begin 197 LogDlg.List.Clear; 198 if Mode <> Running then 199 begin 200 if LogDlg.Visible then 201 LogDlg.Close; 202 Close; 203 end 204 end; 205 206 cTurn, cResume, cContinue: 207 begin 208 me := Player; 209 if Active >= 0 then 210 begin 211 ShowActive(Active, false); 212 Active := -1 213 end; // should not happen 214 215 QueryPerformanceCounter(now); 216 if {$IFDEF VER100}(now.LowPart - LastShowYearTime.LowPart){$ELSE}(now - LastShowYearTime){$ENDIF} / PerfFreq >= UpdateInterval then 217 begin 218 ShowYear; 219 LastShowYearTime := now; 220 end; 221 TurnTime := 222 {$IFDEF VER100}(now.LowPart - LastNewTurn.LowPart){$ELSE}(now - LastNewTurn){$ENDIF} / PerfFreq; 223 LastNewTurn := now; 224 if (G.RO[me].Alive <> ToldAlive) then 225 begin 226 for p := 1 to nPlOffered - 1 do 227 if 1 shl p and (G.RO[me].Alive xor ToldAlive) <> 0 then 228 begin 229 r := Rect(xBrain[p], yBrain[p] - 16, xBrain[p] + 64, 230 yBrain[p] - 16 + 64); 231 InvalidateRect(Handle, @r, false); 232 end; 233 ToldAlive := G.RO[me].Alive; 234 end; 235 Application.ProcessMessages; 236 if Mode = Quit then 237 EndPlaying 238 else if G.RO[me].Happened and phGameEnd <> 0 then 239 begin // game ended, update statistics 240 for p := 1 to nPlOffered - 1 do 241 if bixView[p] >= 0 then 242 if 1 shl p and G.RO[me].Alive = 0 then 243 inc(ExtStat[p]) // extinct 244 else if G.RO[me].Alive = 1 shl p then 245 inc(AloneStat[p]) // only player alive 246 else 247 begin // alive but not alone -- check colony ship 248 ShipComplete := true; 249 for i := 0 to nShipPart - 1 do 250 if G.RO[me].Ship[p].Parts[i] < ShipNeed[i] then 251 ShipComplete := false; 252 if ShipComplete then 253 inc(WinStat[p]) 254 end; 255 if Mode = Running then 256 Server(sNextRound, me, 0, nil^) 257 end 258 else if Mode = Running then 259 Server(sTurn, me, 0, nil^); 260 if Mode = Stop then 261 begin 262 GoBtn.ButtonIndex := 22; 263 Mode := Stopped 264 end 265 end; 266 267 cShowTurnChange: 268 begin 269 QueryPerformanceCounter(now); 270 if Active >= 0 then 271 begin 272 ActiveDuration := 273 {$IFDEF VER100}(now.LowPart - LastShowTurnChange.LowPart){$ELSE}(now - LastShowTurnChange){$ENDIF} / PerfFreq; 274 TimeStat[Active] := TimeStat[Active] + ActiveDuration; 275 TotalStatTime := TotalStatTime + ActiveDuration; 276 if not DisallowShowActive[Active] then 277 ShowActive(Active, false); 278 DisallowShowActive[Active] := (ActiveDuration < TurnTime * 0.25) and 279 (ActiveDuration < ShowActiveThreshold); 280 end; 281 LastShowTurnChange := now; 282 283 Active := integer(Data); 284 if (Active >= 0) and not DisallowShowActive[Active] then 285 ShowActive(Active, true); 286 end 287 288 end 289 end; 290 291 procedure TNoTermDlg.GoBtnClick(Sender: TObject); 292 begin 293 if Mode = Running then 294 Mode := Stop 295 else if Mode = Stopped then 101 296 begin 102 MessgText:=Phrases.Lookup('ENDTOUR'); 103 Kind:=mkYesNo; 104 ShowModal; 105 if ModalResult=mrIgnore then EndCommand:=sResign 106 else EndCommand:=sBreak 297 Mode := Running; 298 GoBtn.ButtonIndex := 23; 299 GoBtn.Update; 300 Server(sTurn, me, 0, nil^); 107 301 end 108 else EndCommand:=sResign; 109 Server(EndCommand,me,0,nil^) 110 end; 111 112 procedure TNoTermDlg.ShowActive(p: integer; Active: boolean); 113 begin 114 if p<nPlOffered then 115 Sprite(Canvas,HGrSystem,x0Brain+28+xActive[p],y0Brain+28+yActive[p],8,8, 116 81+9*Byte(Active),16); 117 end; 118 119 procedure TNoTermDlg.ShowYear; 120 begin 121 Fill(State.Canvas,0,0,192,20,64,287+138); 122 RisedTextOut(State.Canvas,0,0,Format(Phrases.Lookup('AIT_ROUND'),[Round])+' ' 123 +TurnToString(G.RO[me].Turn)); 124 BitBlt(Canvas.Handle,64,287+138,192,20,State.Canvas.Handle,0,0,SRCCOPY); 125 end; 126 127 procedure TNoTermDlg.Client(Command, Player: integer; var Data); 128 var 129 i,x,y,p: integer; 130 ActiveDuration: extended; 131 ShipComplete: boolean; 132 r: TRect; 133 now: int64; 134 begin 135 case Command of 136 cDebugMessage: 137 LogDlg.Add(Player, G.RO[0].Turn, pchar(@Data)); 138 139 cInitModule: 302 end; 303 304 procedure TNoTermDlg.QuitBtnClick(Sender: TObject); 305 begin 306 if Mode = Stopped then 307 EndPlaying 308 else 309 Mode := Quit 310 end; 311 312 procedure TNoTermDlg.FormPaint(Sender: TObject); 313 var 314 i, TimeShare: integer; 315 begin 316 Fill(Canvas, 3, 3, ClientWidth - 6, ClientHeight - 6, 0, 0); 317 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, $000000, $000000); 318 Frame(Canvas, 1, 1, ClientWidth - 2, ClientHeight - 2, 319 MainTexture.clBevelLight, MainTexture.clBevelShade); 320 Frame(Canvas, 2, 2, ClientWidth - 3, ClientHeight - 3, 321 MainTexture.clBevelLight, MainTexture.clBevelShade); 322 Corner(Canvas, 1, 1, 0, MainTexture); 323 Corner(Canvas, ClientWidth - 9, 1, 1, MainTexture); 324 Corner(Canvas, 1, ClientHeight - 9, 2, MainTexture); 325 Corner(Canvas, ClientWidth - 9, ClientHeight - 9, 3, MainTexture); 326 Canvas.Font.Assign(UniFont[ftCaption]); 327 RisedTextOut(Canvas, (ClientWidth - BiColorTextWidth(Canvas, Caption)) div 2, 328 7, Caption); 329 Canvas.Font.Assign(UniFont[ftSmall]); 330 for i := 1 to nPlOffered - 1 do 331 if bixView[i] >= 0 then 140 332 begin 141 Server:=TInitModuleData(Data).Server; 142 TInitModuleData(Data).Flags:=aiThreaded; 143 Shade:=TBitmap.Create; 144 Shade.Width:=64; Shade.Height:=64; 145 for x:=0 to 63 do for y:=0 to 63 do 146 if Odd(x+y) then Shade.Canvas.Pixels[x,y]:=$FFFFFF 147 else Shade.Canvas.Pixels[x,y]:=$000000; 148 State:=TBitmap.Create; 149 State.Width:=192; State.Height:=20; 150 State.Canvas.Brush.Style:=bsClear; 151 State.Canvas.Font.Assign(UniFont[ftSmall]); 152 NewStat; 333 Frame(Canvas, xBrain[i] - 24, yBrain[i] - 8 - 16, xBrain[i] - 24 + 111, 334 yBrain[i] - 8 - 16 + 111, MainTexture.clBevelShade, 335 MainTexture.clBevelShade); 336 FrameImage(Canvas, StartDlg.BrainPicture[bixView[i]], xBrain[i], 337 yBrain[i] - 16, 64, 64, 0, 0); 338 if 1 shl i and G.RO[me].Alive = 0 then 339 BitBlt(Canvas.Handle, xBrain[i], yBrain[i] - 16, 64, 64, 340 Shade.Canvas.Handle, 0, 0, SRCAND); 341 Sprite(Canvas, HGrSystem, xBrain[i] + 30 - 14, yBrain[i] + 53, 14, 342 14, 1, 316); 343 RisedTextOut(Canvas, xBrain[i] + 30 - 16 - BiColorTextWidth(Canvas, 344 IntToStr(WinStat[i])), yBrain[i] + 51, IntToStr(WinStat[i])); 345 Sprite(Canvas, HGrSystem, xBrain[i] + 34, yBrain[i] + 53, 14, 14, 346 1 + 15, 316); 347 RisedTextOut(Canvas, xBrain[i] + 34 + 16, yBrain[i] + 51, 348 IntToStr(AloneStat[i])); 349 Sprite(Canvas, HGrSystem, xBrain[i] + 30 - 14, yBrain[i] + 53 + 16, 14, 350 14, 1 + 30, 316); 351 RisedTextOut(Canvas, xBrain[i] + 30 - 16 - BiColorTextWidth(Canvas, 352 IntToStr(ExtStat[i])), yBrain[i] + 51 + 16, IntToStr(ExtStat[i])); 353 Sprite(Canvas, HGrSystem, xBrain[i] + 34, yBrain[i] + 53 + 16, 14, 14, 354 1 + 45, 316); 355 if TotalStatTime > 0 then 356 begin 357 TimeShare := trunc(TimeStat[i] / TotalStatTime * 100 + 0.5); 358 RisedTextOut(Canvas, xBrain[i] + 34 + 16, yBrain[i] + 51 + 16, 359 IntToStr(TimeShare) + '%'); 360 end; 361 ShowActive(i, i = Active); 153 362 end; 154 155 cReleaseModule: 156 begin 157 Shade.Free; 158 State.Free 159 end; 160 161 cNewGame,cLoadGame: 162 begin 163 inc(Round); 164 if Mode=Running then 165 begin Invalidate; Update end 166 else Show; 167 G:=TNewGameData(Data); 168 LogDlg.mSlot.Visible:=false; 169 LogDlg.Host:=nil; 170 ToldAlive:=G.RO[me].Alive; 171 Active:=-1; 172 fillchar(DisallowShowActive, sizeof(DisallowShowActive), 0); // false 173 LastShowTurnChange:=0; 174 LastNewTurn:=0; 175 TurnTime:=1.0; 176 end; 177 178 cBreakGame: 179 begin 180 LogDlg.List.Clear; 181 if Mode<>Running then 182 begin 183 if LogDlg.Visible then LogDlg.Close; 184 Close; 185 end 186 end; 187 188 cTurn,cResume,cContinue: 189 begin 190 me:=Player; 191 if Active>=0 then 192 begin ShowActive(Active,false); Active:=-1 end; // should not happen 193 194 QueryPerformanceCounter(now); 195 if {$IFDEF VER100}(now.LowPart-LastShowYearTime.LowPart){$ELSE}(now-LastShowYearTime){$ENDIF}/PerfFreq>=UpdateInterval then 196 begin 197 ShowYear; 198 LastShowYearTime:=now; 199 end; 200 TurnTime:={$IFDEF VER100}(now.LowPart-LastNewTurn.LowPart){$ELSE}(now-LastNewTurn){$ENDIF}/PerfFreq; 201 LastNewTurn:=now; 202 if (G.RO[me].Alive<>ToldAlive) then 203 begin 204 for p:=1 to nPlOffered-1 do 205 if 1 shl p and (G.RO[me].Alive xor ToldAlive)<>0 then 206 begin 207 r:=Rect(xBrain[p],yBrain[p]-16,xBrain[p]+64,yBrain[p]-16+64); 208 InvalidateRect(Handle,@r,false); 209 end; 210 ToldAlive:=G.RO[me].Alive; 211 end; 212 Application.ProcessMessages; 213 if Mode=Quit then EndPlaying 214 else if G.RO[me].Happened and phGameEnd<>0 then 215 begin // game ended, update statistics 216 for p:=1 to nPlOffered-1 do if bixView[p]>=0 then 217 if 1 shl p and G.RO[me].Alive=0 then inc(ExtStat[p]) // extinct 218 else if G.RO[me].Alive=1 shl p then inc(AloneStat[p]) // only player alive 219 else 220 begin // alive but not alone -- check colony ship 221 ShipComplete:=true; 222 for i:=0 to nShipPart-1 do 223 if G.RO[me].Ship[p].Parts[i]<ShipNeed[i] then 224 ShipComplete:=false; 225 if ShipComplete then inc(WinStat[p]) 226 end; 227 if Mode=Running then Server(sNextRound,me,0,nil^) 228 end 229 else if Mode=Running then Server(sTurn,me,0,nil^); 230 if Mode=Stop then 231 begin 232 GoBtn.ButtonIndex:=22; 233 Mode:=Stopped 234 end 235 end; 236 237 cShowTurnChange: 238 begin 239 QueryPerformanceCounter(now); 240 if Active>=0 then 241 begin 242 ActiveDuration:={$IFDEF VER100}(now.LowPart-LastShowTurnChange.LowPart){$ELSE}(now-LastShowTurnChange){$ENDIF}/PerfFreq; 243 TimeStat[Active]:=TimeStat[Active]+ActiveDuration; 244 TotalStatTime:=TotalStatTime+ActiveDuration; 245 if not DisallowShowActive[Active] then 246 ShowActive(Active,false); 247 DisallowShowActive[Active]:= (ActiveDuration<TurnTime*0.25) and (ActiveDuration<ShowActiveThreshold); 248 end; 249 LastShowTurnChange:=now; 250 251 Active:=integer(Data); 252 if (Active>=0) and not DisallowShowActive[Active] then 253 ShowActive(Active,true); 254 end 255 256 end 257 end; 258 259 procedure TNoTermDlg.GoBtnClick(Sender: TObject); 260 begin 261 if Mode=Running then Mode:=Stop 262 else if Mode=Stopped then 363 Sprite(Canvas, HGrSystem2, x0Brain + 32 - 20, y0Brain + 32 - 20, 40, 364 40, 115, 1); 365 ShowYear; 366 BtnFrame(Canvas, GoBtn.BoundsRect, MainTexture); 367 BtnFrame(Canvas, QuitBtn.BoundsRect, MainTexture); 368 // BtnFrame(Canvas,StatBtn.BoundsRect,MainTexture); 369 end; 370 371 procedure Client; 372 begin 373 if not FormsCreated then 263 374 begin 264 Mode:=Running; 265 GoBtn.ButtonIndex:=23; 266 GoBtn.Update; 267 Server(sTurn,me,0,nil^); 268 end 269 end; 270 271 procedure TNoTermDlg.QuitBtnClick(Sender: TObject); 272 begin 273 if Mode=Stopped then EndPlaying 274 else Mode:=Quit 275 end; 276 277 procedure TNoTermDlg.FormPaint(Sender: TObject); 278 var 279 i,TimeShare: integer; 280 begin 281 Fill(Canvas,3,3,ClientWidth-6, ClientHeight-6, 0,0); 282 Frame(Canvas,0,0,ClientWidth-1,ClientHeight-1, $000000,$000000); 283 Frame(Canvas,1,1,ClientWidth-2,ClientHeight-2, 284 MainTexture.clBevelLight,MainTexture.clBevelShade); 285 Frame(Canvas,2,2,ClientWidth-3,ClientHeight-3, 286 MainTexture.clBevelLight,MainTexture.clBevelShade); 287 Corner(Canvas,1,1,0,MainTexture); 288 Corner(Canvas,ClientWidth-9,1,1,MainTexture); 289 Corner(Canvas,1,ClientHeight-9,2,MainTexture); 290 Corner(Canvas,ClientWidth-9,ClientHeight-9,3,MainTexture); 291 Canvas.Font.Assign(UniFont[ftCaption]); 292 RisedTextOut(Canvas,(ClientWidth-BiColorTextWidth(Canvas,Caption)) div 2,7,Caption); 293 Canvas.Font.Assign(UniFont[ftSmall]); 294 for i:=1 to nPlOffered-1 do if bixView[i]>=0 then 295 begin 296 Frame(Canvas,xBrain[i]-24,yBrain[i]-8-16,xBrain[i]-24+111,yBrain[i]-8-16+111, 297 MainTexture.clBevelShade,MainTexture.clBevelShade); 298 FrameImage(Canvas,StartDlg.BrainPicture[bixView[i]],xBrain[i],yBrain[i]-16,64,64,0,0); 299 if 1 shl i and G.RO[me].Alive=0 then 300 BitBlt(Canvas.Handle,xBrain[i],yBrain[i]-16,64,64, 301 Shade.Canvas.Handle,0,0,SRCAND); 302 Sprite(Canvas,HGrSystem,xBrain[i]+30-14,yBrain[i]+53,14,14,1,316); 303 RisedTextout(Canvas,xBrain[i]+30-16-BiColorTextWidth(Canvas,IntToStr(WinStat[i])),yBrain[i]+51,IntToStr(WinStat[i])); 304 Sprite(Canvas,HGrSystem,xBrain[i]+34,yBrain[i]+53,14,14,1+15,316); 305 RisedTextout(Canvas,xBrain[i]+34+16,yBrain[i]+51,IntToStr(AloneStat[i])); 306 Sprite(Canvas,HGrSystem,xBrain[i]+30-14,yBrain[i]+53+16,14,14,1+30,316); 307 RisedTextout(Canvas,xBrain[i]+30-16-BiColorTextWidth(Canvas,IntToStr(ExtStat[i])),yBrain[i]+51+16,IntToStr(ExtStat[i])); 308 Sprite(Canvas,HGrSystem,xBrain[i]+34,yBrain[i]+53+16,14,14,1+45,316); 309 if TotalStatTime>0 then 310 begin 311 TimeShare:=trunc(TimeStat[i]/TotalStatTime*100+0.5); 312 RisedTextout(Canvas,xBrain[i]+34+16,yBrain[i]+51+16,IntToStr(TimeShare)+'%'); 313 end; 314 ShowActive(i, i=Active); 375 FormsCreated := true; 376 Application.CreateForm(TNoTermDlg, NoTermDlg); 315 377 end; 316 Sprite(Canvas,HGrSystem2,x0Brain+32-20,y0Brain+32-20,40,40,115,1); 317 ShowYear; 318 BtnFrame(Canvas,GoBtn.BoundsRect,MainTexture); 319 BtnFrame(Canvas,QuitBtn.BoundsRect,MainTexture); 320 //BtnFrame(Canvas,StatBtn.BoundsRect,MainTexture); 321 end; 322 323 procedure Client; 324 begin 325 if not FormsCreated then 326 begin 327 FormsCreated:=true; 328 Application.CreateForm(TNoTermDlg, NoTermDlg); 329 end; 330 NoTermDlg.Client(Command,Player,Data); 378 NoTermDlg.Client(Command, Player, Data); 331 379 end; 332 380 … … 334 382 Shift: TShiftState); 335 383 begin 336 if (char(Key)='M') and (ssCtrl in Shift) then 337 if LogDlg.Visible then LogDlg.Close else LogDlg.Show; 384 if (char(Key) = 'M') and (ssCtrl in Shift) then 385 if LogDlg.Visible then 386 LogDlg.Close 387 else 388 LogDlg.Show; 338 389 end; 339 390 340 391 initialization 341 FormsCreated:=false; 392 393 FormsCreated := false; 342 394 343 395 end. 344 -
trunk/Protocol.pas
r2 r6 1 1 {$INCLUDE switches.pas} 2 2 {$HINTS OFF} 3 4 3 unit Protocol; 5 4 … … 7 6 8 7 const 9 lxmax=100; lymax=96; 10 nAdv=94; {number of advances} 11 nImp=70; {number of improvements} 12 nPl=15; {max number of players, don't change!} 13 nUmax=4096; {max units/player, don't set above 4096} 14 nCmax=1024; {max cities/player, don't set above 4096} 15 nMmax=256; {max models/player, don't set above 1024} 16 nExp=5; // number of experience levels 17 ExpCost=50; {received damage required for next experience level} 18 MaxFutureTech=25; // maximum number of future techs of one kind except computing technology 19 MaxFutureTech_Computing=100; // maximum number of computing technology future techs 20 CountryRadius=9; 21 MaxCitySize=30; 22 BasicHappy=2; {basically happy citizens} 23 MaxPollution=240; 24 NeedAqueductSize=8; 25 NeedSewerSize=12; 26 ColossusEffect=75; // percent wonder building cost 27 UniversityFutureBonus=5; // percent per tech 28 ResLabFutureBonus=10; // percent per tech 29 FactoryFutureBonus=5; // percent per tech 30 MfgPlantFutureBonus=10; // percent per tech 31 AnarchyTurns=3; 32 CaptureTurns=3; 33 CancelTreatyTurns=3; 34 PeaceEvaTurns=5; // should be less then 2*CancelTreatyTurns, so that you can't attack an ally without re-entering 35 ColdWarTurns=40; 36 DesertThurst=20; // damage for turn in desert 37 ArcticThurst=20; // damage for turn in arctic 38 FastRecovery=50; 39 CityRecovery=20; 40 NoCityRecovery=8; 41 MaxMoneyPrice=$FFFF; 42 MaxShipPartPrice=100; 43 BombardmentDestroysCity=false; 44 StartMoney=0; 45 InitialCredibility=95; 46 47 // ai module flags (for TInitModuleData.Flags) 48 aiThreaded=$01; 49 50 //difficulty settings 51 MaxDiff=4; {maximum difficulty level} 52 StorageSize: array[1..MaxDiff] of integer=(30,40,50,60); 53 TechFormula_M: array[1..MaxDiff] of single =(2.0,2.3,2.6,4.0); 54 TechFormula_D: array[1..MaxDiff] of single =(102.0,80.0,64.0,64.0); 55 BuildCostMod: array[1..MaxDiff] of integer =(9,12,15,18); // in 1/12 56 57 // test flags 58 nTestFlags=7; // max. 11 59 tfAllTechs=$001; {all nations get all techs} 60 tfImmImprove=$002; {city projects complete each turn} 61 tfImmAdvance=$004; {research complete each turn} 62 tfImmGrow=$008; {all cities grow in each turn} 63 tfUncover=$010; // all players see like supervisor 64 tfAllContact=$020; // all nations can contact each other 65 tfNoRareNeed=$040; // producing colony ship requires no modern resources 66 tfTested=$800; // at least one test flag was set 67 68 {server commands 69 IMPORTANT: lowest 4 bits must indicate size in DWORDS of data parameter, 70 except for request commands} 71 72 sctMask=$3800; // server command type 73 sExecute=$4000; {call command-sExecute to request return value without 74 execution} 75 cClientEx=$8000; 76 77 // Info Request Commands 78 sctInfo=$0000; 79 sMessage=$0000; sSetDebugMap=$0010; sGetDebugMap=$0020; 80 {sChangeSuperView=$0030;} sRefreshDebugMap=$0040; 81 sGetChart=$0100; // + type shl 4 82 sGetTechCost=$0180; 83 sGetAIInfo=$01C0;sGetAICredits=$01D0;sGetVersion=$01E0;sGetGameChanged=$01F0; 84 sGetTileInfo=$0200;sGetCityTileInfo=$0210;sGetHypoCityTileInfo=$0220; 85 sGetJobProgress=$0230; 86 sGetModels=$0270; 87 sGetUnits=$0280;sGetDefender=$0290;sGetBattleForecast=$02A0; 88 sGetUnitReport=$02B0;sGetMoveAdvice=$02C0;sGetPlaneReturn=$02D0; 89 sGetBattleForecastEx=$02E0; 90 sGetCity=$0300;sGetCityReport=$0310;sGetCityAreaInfo=$0320; 91 sGetEnemyCityReport=$0330;sGetEnemyCityAreaInfo=$0340; 92 sGetCityTileAdvice=$0350;sGetCityReportNew=$0360; 93 sGetEnemyCityReportNew=$0370; 94 95 // Map Editor Commands 96 sEditTile=$0710;sRandomMap=$0780;sMapGeneratorRequest=$0790; 97 98 // Server Internal Commands 99 sctInternal=sctInfo; // sctInfo - without sExecute flag, sctInternal - with sExecute flag 100 sIntTellAboutNation=$4000; sIntHaveContact=$4010; sIntCancelTreaty=$4020; 101 sIntTellAboutModel=$4100; {+told player shl 4} 102 sIntDiscoverZOC=$4201; sIntExpandTerritory=$4218; 103 sIntBuyMaterial=$4301; 104 sIntPayPrices=$4402; 105 sIntSetDevModel=$450D; 106 sIntSetModelStatus=$4601;sIntSetUnitStatus=$4611;sIntSetCityStatus=$4621; 107 sIntSetECityStatus=$4631; 108 sIntDataChange=$4700; 109 110 // Client Deactivation Commands 111 sctEndClient=$0800; 112 sTurn=$4800;sBreak=$4810;sResign=$4820;sNextRound=$4830;sReload=$4841; 113 sSaveMap=$4880;sAbandonMap=$4890; 114 // diplomacy commands equal to client, see below 115 116 // General Commands 117 sctGeneral=$1000; 118 sClearTestFlag=$5000;sSetTestFlag=$5010; 119 sSetGovernment=$5100;sSetRates=$5110;sRevolution=$5120; 120 sSetResearch=$5200;sStealTech=$5210; 121 sSetAttitude=$5300; // + concerned player shl 4 122 sCancelTreaty=$5400; 123 124 // Model Related Commands 125 sctModel=$1800; 126 sCreateDevModel=$5800; 127 sSetDevModelCap=$5C00; {+value shl 4} 128 {reserves $5CXX, $5DXX, $5EXX, $5FXX} 129 130 // Unit Related Commands 131 sctUnit=$2000; 132 sRemoveUnit=$6000;sSetUnitHome=$6010; 133 sSetSpyMission=$6100; // + mission shl 4 134 sLoadUnit=$6200;sUnloadUnit=$6210;sSelectTransport=$6220; 135 sCreateUnit=$6301; // + player shl 4 136 sMoveUnit=$6400; {+dx and 7 shl 4 +dy and 7 shl 7} 137 {reserves $64XX, $65XX, $66XX, $67XX} 138 139 // Settlers Related Commands 140 sctSettlers=$2800; 141 sAddToCity=$6810; 142 sStartJob=$6C00; {+job shl 4} 143 {reserves $6CXX, $6DXX, $6EXX, $6FXX} 144 145 // City Related Commands 146 sctCity=$3000; 147 sSetCityProject=$7001;sBuyCityProject=$7010;sSellCityProject=$7020; 148 sSellCityImprovement=$7101;sRebuildCityImprovement=$7111; 149 sSetCityTiles=$7201; 150 151 // free command space 152 sctUnused=$3800; 153 154 {client commands} 155 cInitModule=$0000;cReleaseModule=$0100;cBroadcast=$0200; 156 cHelpOnly=$0700;cStartHelp=$0710; cStartCredits=$0720; 157 158 cNewGame=$0800;cLoadGame=$0810;cMovie=$0820; 159 cNewGameEx=$0840;cLoadGameEx=$0850; 160 cNewMap=$0880;cReplay=$08E0;cGetReady=$08F0;cBreakGame=$0900; 161 162 cTurn=$2000;cResume=$2010;cContinue=$2080; 163 cMovieTurn=$2100; cMovieEndTurn=$2110; 164 cEditMap=$2800; 165 166 //cShowTileM=$3000;cShowTileA=$3010;cShowFoundCity=$3020; 167 cShowUnitChanged=$3030; cShowAfterMove=$3040; cShowAfterAttack=$3050; 168 cShowCityChanged=$3090; 169 //cShowMove=$3100;cShowCapture=$3110; 170 //cShowAttackBegin=$3200;cShowAttackWon=$3210;cShowAttackLost=$3220; 171 cShowMoving=$3140; cShowCapturing=$3150; cShowAttacking=$3240; 172 cShowMissionResult=$3300; 173 cShowShipChange=$3400; 174 cShowGreatLibTech=$3500; 175 cShowTurnChange=$3700; 176 cShowCancelTreaty=$3800; cShowEndContact=$3810; 177 cShowCancelTreatyByAlliance=$3820; cShowSupportAllianceAgainst=$3830; 178 cShowPeaceViolation=$3880; 179 cShowGame=$3F00; {cShowSuperView=$3F80;} cRefreshDebugMap=$3F90; 180 181 // diplomacy commands equal to server, see below 182 183 cDebugMessage=$7000; 184 cShowNego=$7010; 185 186 // commands same for server and client 187 scContact=$4900; // + concerned player shl 4 for server call 188 scReject=$4A00; 189 scDipStart=$4B00; 190 scDipNotice=$4B10; 191 scDipAccept=$4B20; 192 scDipCancelTreaty=$4B30; 193 scDipOffer=$4B4E; 194 scDipBreak=$4BF0; 195 196 {server return codes: flags} 197 rExecuted= $40000000; 198 rEffective= $20000000; 199 rUnitRemoved= $10000000; 200 rEnemySpotted= $08000000; 201 202 {server return codes: command executed} 203 // note: the same return code might have a different meaning for different server functions! 204 eOK= $60000000; // ok 205 eEnemySpotted= $68000000; // unit move ok, new enemy unit/city spotted 206 eDied= $70000000; // move executed, unit died due to hostile terrain 207 eEnemySpotted_Died= $78000000; // unit move ok, new enemy unit/city spotted, unit died due to hostile terrain 208 eLoaded= $60000002; // unit move caused loading to transport ship 209 eLost= $70000004; // attack executed, battle lost, unit is dead 210 eWon= $60000005; // attack executed, battle won, defender destroyed 211 eBloody= $70000005; // attack executed, defender destroyed, unit is dead 212 eBombarded= $60000006; // empty enemy city bombarded 213 eExpelled= $60000007; // friendly unit expelled 214 eMissionDone= $70000008; // spy moved into city: mission done, spy no longer exists 215 eJobDone= $60000001; // settler job started and already done 216 eJobDone_Died= $70000001; // settler job started and already done, unit died due to hostile terrain 217 eCity= $70000002; // city founded, settler no more exists 218 eRemoved= $70000000; // sRemoveUnit: unit removed 219 eUtilized= $70000001; // sRemoveUnit: unit utilized for city project 220 221 eNotChanged= $40000000; // ok, but no effect (e.g. current city project set again) 222 223 {server return codes: command not executed} 224 eHiddenUnit= $20000013; // unit move: not possible, destination tile occupied by hidden foreign submarine 225 eStealthUnit= $2000001A; // unit move: not possible, destination tile occupied by foreign stealth unit 226 eZOC_EnemySpotted= $28000014; // unit move: not possible, new enemy unit spotted, ZOC violation 227 228 eInvalid= $0000; // command not allowed now or parameter out of allowed range 229 eUnknown= $0001; // unknown command 230 eNoTurn= $0002; // command only allowed during player's turn 231 eViolation= $0003; // general violation of game rules 232 eNoPreq= $0004; // the prerequisites for this command are not fully met 233 234 eNoTime_Move= $0008; // normal unit move: too few movement points left 235 eNoTime_Load= $0009; // load unit: too few movement points left 236 eNoTime_Attack= $000A; // attack: no movement points left 237 eNoTime_Bombard= $000B; // bombard city: too few movement points left 238 eNoTime_Expel= $000C; // expel spy: too few movement points left 239 240 eDomainMismatch= $0011; // move/attack: action not allowed for this unit domain 241 eNoCapturer= $0012; // unit move: this type of unit is not allowed to capture a city 242 eZOC= $0014; // unit move: not possible, ZOC violation 243 eTreaty= $0015; // move/attack: not possible, peace treaty violation 244 eDeadLands= $0016; // sStartJob: not possible, dead lands 245 eNoRoad= $0017; // unit move: not possible, no road 246 eNoNav= $0019; // unit move: not possible, open sea without navigation 247 eNoLoadCapacity= $001B; // load to transport: no more transport capacity 248 eNoBombarder= $001C; // bombardment impossible because no attack power 249 250 eMaxSize= $0020; // add to city: bigger size not allowed due to missing aqueduct/sewer 251 eNoCityTerrain= $0022; // found city: not possible in this terrain 252 eNoBridgeBuilding= $0023; 253 eInvalidOffer= $0030; 254 eOfferNotAcceptable= $0031; 255 eCancelTreatyRush= $0032; 256 eAnarchy= $0038; // no negotiation in anarchy 257 eColdWar= $003F; 258 eNoModel= $0040; // sCreateDevModel must be called before! 259 eTileNotAvailable= $0050; 260 eNoWorkerAvailable= $0051; 261 eOnlyOnce= $0058; // sell/rebuild city improvement: only once per city and turn! 262 eObsolete= $0059; // city project: more advanced improvement already exists 263 eOutOfControl= $005A; // buy/sell/rebuild improvement: not in anarchy, not in captured cities 264 265 eNoWay= $0100; // sGetMoveAdvice: no way found 266 267 // chart types 268 nStat=6; 269 stPop=0; stTerritory=1; stMil=2; stScience=3; stExplore=4; stWork=5; 270 271 {tile flags: terrain type} 272 fTerrain=$1F; // mask for terrain type 273 fOcean=$00;fShore=$01;fGrass=$02;fDesert=$03;fPrairie=$04; 274 fTundra=$05;fArctic=$06;fSwamp=$07;fForest=$09;fHills=$0A;fMountains=$0B; 275 fUNKNOWN=fTerrain; 276 277 {tile flags: terrain improvements} 278 fTerImp=$0000F000; // mask for terrain improvement 279 tiNone=$00000000;tiIrrigation=$00001000;tiFarm=$00002000;tiMine=$00003000; 280 tiFort=$00004000;tiBase=$00005000; 281 282 {tile flags: add ons} 283 fSpecial=$00000060;fSpecial1=$00000020;fSpecial2=$00000040; 284 fRiver=$00000080; 285 fRoad=$00000100;fRR=$00000200;fCanal=$00000400;fPoll=$00000800; 286 fPrefStartPos=$00200000;fStartPos=$00400000; // map editor only 287 fDeadLands=$01000000; 288 fModern=$06000000;fCobalt=$02000000;fUranium=$04000000;fMercury=$06000000; 289 290 {tile flags: redundant helper info} 291 fGrWall=$00010000; // tile protected by great wall 292 fSpiedOut=$00020000;fStealthUnit=$00040000;fHiddenUnit=$00080000; 293 fObserved=$00100000; // set if tile information is from this turn 294 fOwned=$00200000; // set if unit/city here is own one 295 fUnit=$00400000;fCity=$00800000; 296 fOwnZoCUnit=$10000000; // own ZoC unit present at this tile 297 fInEnemyZoC=$20000000; // tile is adjacent to known foreign ZoC unit (not allied) 298 fPeace=$40000000; // tile belongs to territory of nation that we are in peace with but not allied 299 300 // city project flags 301 cpIndex=$1FF; 302 cpConscripts=$200; // produce unit as conscripts 303 cpDisbandCity=$400; // allow to disband city when settlers/conscripts are produced 304 cpImp=$800; // 0: index refers to model, 1: index refers to city improvement 305 cpRepeat=$1000; cpCompleted=$2000; cpAuto=$F000; // for internal use only 306 307 // tech status indicators 308 tsNA=-2;tsSeen=-1;tsResearched=0;tsGrLibrary=1;tsCheat=15; 309 tsApplicable=tsResearched; 310 311 // nation treaties 312 trNoContact=-1; trNone=0; trPeace=2; trFriendlyContact=3; 313 trAlliance=4; 314 315 // attitudes 316 nAttitude=7; 317 atHostile=0;atIcy=1;atUncoop=2;atNeutral=3;atReceptive=4;atCordial=5;atEnth=6; 318 319 // offer prices 320 opChoose= $00000000; 321 opCivilReport= $11000000; // + turn + concerned player shl 16 322 opMilReport= $12000000; // + turn + concerned player shl 16 323 opMap= $1F000000; 324 opTreaty= $20000000; // + suggested nation treaty 325 opShipParts= $30000000; // + number + part type shl 16 326 opMoney= $40000000; // + value 327 opTribute= $48000000; // obsolete 328 opTech= $50000000; // + advance 329 opAllTech= $51000000; 330 opModel= $58000000; // + model index 331 opAllModel= $59000000; 332 333 opMask= $FF000000; 334 335 // improvement kinds 336 ikTrGoods=0; ikCommon=1; ikNatLocal=2; ikNatGlobal=3; ikWonder=4; ikShipPart=5; 337 ikNA=$7F; 338 339 {model domains} 340 nDomains=3;dGround=0;dSea=1;dAir=2; 341 342 {model kinds} 343 mkSelfDeveloped=$00;mkEnemyDeveloped=$01; 344 mkSpecial_Boat=$08;mkSpecial_SubCabin=$0A; 345 mkSpecial_TownGuard=$10;mkSpecial_Glider=$11; 346 mkScout=$20;mkSlaves=$21;mkSettler=$22;mkCommando=$23;mkFreight=$24; 347 348 {unit flags} 349 unFortified=$01; unBombsLoaded=$02; unMountainDelay=$04; unConscripts=$08; 350 unWithdrawn=$10; 351 unMulti=$80; 352 353 // unit report flags 354 urfAlwaysSupport=$01; urfDeployed=$02; 355 356 // unit moves 357 umCapturing=$0100; umSpyMission=$0200; umBombarding=$0400; umExpelling=$0800; 358 umShipLoading=$1000; umShipUnloading=$2000; 359 umPlaneLoading=$4000; umPlaneUnloading=$8000; 360 361 {model flags} 362 mdZOC=$01; mdCivil=$02; mdDoubleSupport=$04; 363 364 {player happened flags} 365 phTech=$01; phStealTech=$02; phChangeGov=$08; 366 phGliderLost=$100; phPlaneLost=$200; phPeaceViolation=$400; 367 phPeaceEvacuation=$800; 368 phShipComplete=$2000; phTimeUp=$4000; phExtinct=$8000; phGameEnd=$F000; 369 370 {city happened flags} 371 chDisorder=$01;chProduction=$02;chPopIncrease=$04;chPopDecrease=$08; 372 chUnitLost=$10;chImprovementLost=$20;chProductionSabotaged=$40; 373 chNoGrowthWarning=$80; 374 chPollution=$100;chSiege=$200;chOldWonder=$400;chNoSettlerProd=$800; 375 chFounded=$1000;chAfterCapture=$2000;chCaptured=$F0000; 376 chImprovementSold=$80000000; 377 378 {city info flags} 379 ciCapital=$01; ciWalled=$02; ciCoastalFort=$04; ciMissileBat=$08; 380 ciBunker=$10; ciSpacePort=$20; 381 382 {city tile available values} 383 faAvailable=0; faNotAvailable=1; faSiege=2; faTreaty=4; faInvalid=$FF; 384 385 // battle history flags 386 bhEnemyAttack=$01; bhMyUnitLost=$02; bhEnemyUnitLost=$04; 387 388 {move advice special destinations} 389 maNextCity=-1; 390 391 {goverment forms} 392 nGov=8; 393 gAnarchy=0;gDespotism=1;gMonarchy=2;gRepublic=3;gFundamentalism=4;gCommunism=5; 394 gDemocracy=6;gFuture=7; 395 396 // ship change reasons 397 scrProduction=0; scrDestruction=1; scrTrade=2; scrCapture=3; 398 399 {unit jobs} 400 nJob=15; 401 jNone=0;jRoad=1;jRR=2;jClear=3;jIrr=4;jFarm=5;jAfforest=6;jMine=7;jCanal=8; 402 jTrans=9;jFort=10;jPoll=11;jBase=12;jPillage=13;jCity=14; 403 404 // job preconditions are: 405 // technology JobPreq is available, no city, plus the following: 406 // jRoad: no river when bridge building unavailable 407 // jRR: road 408 // jClear: Terrain.ClearTerrain, Hanging Gardens for desert 409 // jIrr: Terrain.IrrEff 410 // jFarm: irrigation 411 // jAfforest: Terrain.AfforestTerrain 412 // jMine: Terrain.MineEff 413 // jCanal: no Mountains, no Arctic 414 // jTrans: Terrain.TransWork 415 // jPoll: pollution 416 // jPillage: any tile improvement 417 // jCity, jFort, jBase: none 418 419 420 // spy mission 421 nSpyMission=5; 422 smSabotageProd=0;smStealMap=1;smStealForeignReports=2; 423 smStealCivilReport=3;smStealMilReport=4; 424 425 // resource weights 426 rwOff=$00000000; 427 rwMaxGrowth=$3F514141; // 120*F + 1/8*P + 1/16*T + 1/16*S 428 rwMaxProd=$413F1F01; // 1/16*F + 120*P + 30*T + 1*S 429 rwMaxScience=$41040408; // 1/16*F + 4*P + 4*T + 8*S 430 rwForceProd=$F1080201; // F^1/2 * (8*P + 2*T + 1*S) 431 rwForceScience=$F1010101; // F^1/2 * (1*P + 1*T + 1*S) 432 433 {advances} 434 adAdvancedFlight=0;adAmphibiousWarfare=1;adAstronomy=2;adAtomicTheory=3;adAutomobile=4; 435 adBallistics=5;adBanking=6;adBridgeBuilding=7;adBronzeWorking=8;adCeremonialBurial=9; 436 adChemistry=10;adChivalry=11;adComposites=12;adCodeOfLaws=13;adCombinedArms=14; 437 adCombustionEngine=15;adCommunism=16;adComputers=17;adConscription=18;adConstruction=19; 438 adTheCorporation=20;adSpaceFlight=21;adCurrency=22;adDemocracy=23;adEconomics=24; 439 adElectricity=25;adElectronics=26;adEngineering=27;adEnvironmentalism=28;adWheel=29; 440 adExplosives=30;adFlight=31;adIntelligence=32;adGunpowder=33;adHorsebackRiding=34; 441 adImpulseDrive=35;adIndustrialization=36;adSmartWeapons=37;adInvention=38;adIronWorking=39; 442 adTheLaser=40;adNuclearPower=41;adLiterature=42;adInternet=43;adMagnetism=44; 443 adMapMaking=45;adMasonry=46;adMassProduction=47;adMathematics=48;adMedicine=49; 444 adMetallurgy=50;adMin=51;adMobileWarfare=52;adMonarchy=53;adMysticism=54; 445 adNavigation=55;adNuclearFission=56;adPhilosophy=57;adPhysics=58;adPlastics=59; 446 adPoetry=60;adPottery=61;adRadio=62;adRecycling=63;adRefrigeration=64; 447 adMonotheism=65;adTheRepublic=66;adRobotics=67;adRocketry=68;adRailroad=69; 448 adSanitation=70;adScience=71;adWriting=72;adSeafaring=73;adSelfContainedEnvironment=74; 449 adStealth=75;adSteamEngine=76;adSteel=77;adSyntheticFood=78;adTactics=79; 450 adTheology=80;adTheoryOfGravity=81;adTrade=82;adTransstellarColonization=83;adUniversity=84; 451 adAdvancedRocketry=85;adWarriorCode=86;adAlphabet=87;adPolytheism=88;adRefining=89; 452 futComputingTechnology=90;futNanoTechnology=91;futMaterialTechnology=92;futArtificialIntelligence=93; 453 454 FutureTech=[futComputingTechnology,futNanoTechnology,futMaterialTechnology, 455 futArtificialIntelligence]; 456 457 adMilitary=$800; // Military Research 458 459 460 {wonders} 461 woPyramids=00;woZeus=01;woGardens=02;woColossus=03;woLighthouse=04;woGrLibrary=05;woOracle=06; 462 woSun=07;woLeo=08;woMagellan=09;woMich=10;{11;}woNewton=12;woBach=13; 463 {14;}woLiberty=15;woEiffel=16;woHoover=17;woShinkansen=18;woManhattan=19;woMir=20; 464 465 {city improvements} 466 imTrGoods=28;imBarracks=29;imGranary=30;imTemple=31;imMarket=32;imLibrary=33;imCourt=34; 467 imWalls=35;imAqueduct=36;imBank=37;imCathedral=38;imUniversity=39;imHarbor=40;imTheater=41; 468 imFactory=42;imMfgPlant=43;imRecycling=44;imPower=45;imHydro=46;imNuclear=47;imPlatform=48; 469 imTownHall=49;imSewer=50;imSupermarket=51;imHighways=52;imResLab=53;imMissileBat=54;imCoastalFort=55; 470 imAirport=56;imDockyard=57;imPalace=58;imGrWall=59;imColosseum=60;imObservatory=61;imMilAcademy=62; 471 imBunker=63;imAlgae=64;imStockEx=65;imSpacePort=66;imShipComp=67;imShipPow=68;imShipHab=69; 472 473 474 SettlerFood:array[0..nGov-1] of integer=(1,1,1,2,1,2,2,2); 475 CorrLevel:array[0..nGov-1] of integer=(3,3,1,2,1,0,0,0); 476 SupportFree:array[0..nGov-1] of integer=(2,2,1,0,2,1,0,0); // in 1/2*city size 477 478 // special prerequisite values 479 preNone=-1; preLighthouse=-2; preSun=-3; preLeo=-4; preBuilder=-5; preNA=-$FF; 480 481 JobPreq: array[0..nJob-1] of integer= 482 (preNone,preNone,adRailroad,preNone,preNone,adRefrigeration,preNone,preNone,adExplosives,adExplosives, 483 adConstruction,preNone,adMedicine,preNone,preNone); 484 485 AdvPreq: array[0..nAdv-1,0..2] of integer= {advance prerequisites} 486 ((adFlight,adRobotics,preNone), //adAdvancedFlight 487 (adNavigation,adTactics,preNone), //adAmphibiousWarfare 488 (adMysticism,adAlphabet,preNone), //adAstronomy 489 (adTheoryOfGravity,preNone,preNone), //adAtomicTheory 490 (adCombustionEngine,adSteel,preNone), //adAutomobile 491 (adMathematics,adMetallurgy,preNone), //adBallistics 492 (adCurrency,adEngineering,preNone), //adBanking 493 (adConstruction,adWheel,preNone), //adBridgeBuilding 494 (preNone,preNone,preNone), //adBronzeWorking 495 (preNone,preNone,preNone), //adCeremonialBurial 496 (adScience,preNone,preNone), //adChemistry 497 (adMonarchy,adWarriorCode,preNone), //adChivalry 498 (adMetallurgy,adPlastics,preNone), //adComposites 499 (adWriting,preNone,preNone), //adCodeOfLaws 500 (adAdvancedFlight,adMobileWarfare,preNone), //adCombinedArms 501 (adRefining,adExplosives,preNone), //adCombustionEngine 502 (adPhilosophy,adIndustrialization,preNone), //adCommunism 503 (adMin,preNone,preNone), //adComputers 504 (adTheRepublic,adTactics,preNone), //adConscription 505 (adMasonry,adAlphabet,preNone), //adConstruction 506 (adEconomics,adDemocracy,preNone), //adTheCorporation 507 (adAdvancedFlight,adAdvancedRocketry,preNone), //adSpaceFlight 508 (adBronzeWorking,preNone,preNone), //adCurrency 509 (adConscription,adIndustrialization,preNone), //adDemocracy 510 (adBanking,adUniversity,preNone), //adEconomics 511 (adMagnetism,preNone,preNone), //adElectricity 512 (adRadio,adAtomicTheory,preNone), //adElectronics 513 (adConstruction,adBronzeWorking,preNone), //adEngineering 514 (adIndustrialization,preNone,preNone), //adEnvironmentalism 515 (preNone,preNone,preNone), //adWheel 516 (adChemistry,adEngineering,preNone), //adExplosives 517 (adCombustionEngine,adPhysics,preNone), //adFlight 518 (adTactics,adInvention,preNone), //adIntelligence 519 (adMedicine,adIronWorking,preNone), //adGunpowder 520 (preNone,preNone,preNone), //adHorsebackRiding 521 (adSpaceFlight,adNuclearPower,preNone), //adImpulseDrive 522 (adRailroad,adBanking,preNone), //adIndustrialization 523 (adAdvancedRocketry,adTheLaser,preNone), //adIntelligenArms 524 (adWriting,adWheel,preNone), //adInvention 525 (adBronzeWorking,adInvention,preNone), //adIronWorking 526 (adMin,adPhysics,preNone), //adTheLaser 527 (adNuclearFission,preNone,preNone), //adNuclearPower 528 (adPoetry,adTrade,preNone), //adLiterature 529 (adDemocracy,adComputers,preNone), //adLybertarianism 530 (adPhysics,adIronWorking,preNone), //adMagnetism 531 (adAlphabet,preNone,preNone), //adMapMaking 532 (preNone,preNone,preNone), //adMasonry 533 (adAutomobile,adElectronics,adTheCorporation), //adMassProduction 534 (adCurrency,adAlphabet,preNone), //adMathematics 535 (adMysticism,adPottery,preNone), //adMedicine 536 (adGunpowder,preNone,preNone), //adMetallurgy 537 (adRobotics,adPlastics,preNone), //adMin 538 (adAutomobile,adTactics,preNone), //adMobileWarfare 539 (adPolytheism,preNone,preNone), //adMonarchy 540 (adCeremonialBurial,preNone,preNone), //adMysticism 541 (adSeafaring,adAstronomy,preNone), //adNavigation 542 (adAtomicTheory,adMassProduction,preNone), //adNuclearFission 543 (adMathematics,adLiterature,preNone), //adPhilosophy 544 (adScience,preNone,preNone), //adPhysics 545 (adMassProduction,adRefining,preNone), //adPlastics 546 (adMysticism,adWarriorCode,preNone), //adPoetry 547 (preNone,preNone,preNone), //adPottery 548 (adElectricity,adEngineering,preNone), //adRadio 549 (adEnvironmentalism,adPlastics,preNone), //adRecycling 550 (adElectricity,preNone,preNone), //adRefrigeration 551 (adPolytheism,adAstronomy,preNone), //adMonotheism 552 (adLiterature,preNone,preNone), //adTheRepublic 553 (adMassProduction,adEconomics,preNone), //adRobotics 554 (adBallistics,adExplosives,preNone), //adRocketry 555 (adSteamEngine,adBridgeBuilding,preNone), //adRailroad 556 (adEnvironmentalism,adMedicine,preNone), //adSanitation 557 (adMetallurgy,adTheology,adPhilosophy), //adScience 558 (adAlphabet,preNone,preNone), //adWriting 559 (adPottery,adMapMaking,preNone), //adSeafaring 560 (adRecycling,adSyntheticFood,preNone), //adSelfContainedEnvironment 561 (adComposites,adRadio,preNone), //adStealth 562 (adScience,adEngineering,preNone), //adSteamEngine 563 (adIronWorking,adRailroad,preNone), //adSteel 564 (adChemistry,adRefrigeration,preNone), //adSyntheticFood 565 (adWarriorCode,adUniversity,preNone), //adTactics 566 (adMonotheism,adPoetry,preNone), //adTheology 567 (adAstronomy,adPhysics,preNone), //adTheoryOfGravity 568 (adCurrency,adCodeOfLaws,preNone), //adTrade 569 (adImpulseDrive,adSelfContainedEnvironment,preNone), //adTransstellarColonization 570 (adScience,preNone,preNone), //adUniversity 571 (adComputers,adRocketry,preNone), //adAdvancedRocketry 572 (preNone,preNone,preNone), //adWarriorCode 573 (preNone,preNone,preNone), //adAlphabet 574 (adCeremonialBurial,adHorsebackRiding,preNone), //adPolytheism 575 (adChemistry,preNone,preNone), //adRefining 576 (adComputers,preNone,preNone), //futResearchTechnology 577 (adRobotics,preNone,preNone), //futProductionTechnology 578 (adComposites,preNone,preNone), //futArmorTechnology 579 (adSmartWeapons,preNone,preNone)); //futMissileTechnology 580 581 Imp: array[0..nImp-1] of // city improvements 582 record Kind,Preq,Cost,Maint,Expiration:integer; end= 583 ((Kind:ikWonder;Preq:adMathematics;Cost:400;Maint:0;Expiration:adDemocracy), //woPyramids 584 (Kind:ikWonder;Preq:adPolytheism;Cost:200;Maint:0;Expiration:adElectronics), //woZeus 585 (Kind:ikWonder;Preq:adInvention;Cost:200;Maint:0;Expiration:adNuclearFission), //woGardens 586 (Kind:ikWonder;Preq:adBronzeWorking;Cost:200;Maint:0;Expiration:-1), //woColossus 587 (Kind:ikWonder;Preq:adMapMaking;Cost:200;Maint:0;Expiration:adSteel), //woLighthouse 588 (Kind:ikWonder;Preq:adLiterature;Cost:400;Maint:0;Expiration:adPlastics), //woGrLibrary 589 (Kind:ikWonder;Preq:adMysticism;Cost:200;Maint:0;Expiration:-1), //woOracle 590 (Kind:ikWonder;Preq:adChivalry;Cost:300;Maint:0;Expiration:adSpaceFlight), //woSun 591 (Kind:ikWonder;Preq:adPhilosophy;Cost:500;Maint:0;Expiration:-1), //woLeo 592 (Kind:ikWonder;Preq:adNavigation;Cost:300;Maint:0;Expiration:-1), //woMagellan 593 (Kind:ikWonder;Preq:adMonotheism;Cost:400;Maint:0;Expiration:-1), //woMich 594 (Kind:ikNA;Preq:preNA), //{11} 595 (Kind:ikWonder;Preq:adTheoryOfGravity;Cost:400;Maint:0;Expiration:-1), //woNewton 596 (Kind:ikWonder;Preq:adTheology;Cost:400;Maint:0;Expiration:-1), //woBach 597 (Kind:ikNA;Preq:preNA), //{14} 598 (Kind:ikWonder;Preq:adDemocracy;Cost:500;Maint:0;Expiration:-1), //woLiberty 599 (Kind:ikWonder;Preq:adSteel;Cost:800;Maint:0;Expiration:-1), //woEiffel 600 (Kind:ikWonder;Preq:adElectronics;Cost:800;Maint:0;Expiration:-1), //woHoover 601 (Kind:ikWonder;Preq:adPlastics;Cost:500;Maint:0;Expiration:-1), //woShinkansen 602 (Kind:ikWonder;Preq:adNuclearFission;Cost:400;Maint:0;Expiration:-1), //woManhattan 603 (Kind:ikWonder;Preq:adSpaceFlight;Cost:800;Maint:0;Expiration:-1), //woMir 604 (Kind:ikNA;Preq:preNA), //{21} 605 (Kind:ikNA;Preq:preNA), //{22} 606 (Kind:ikNA;Preq:preNA), //{23} 607 (Kind:ikNA;Preq:preNA), //{24} 608 (Kind:ikNA;Preq:preNA), //{25} 609 (Kind:ikNA;Preq:preNA), //{26} 610 (Kind:ikNA;Preq:preNA), //{27} 611 (Kind:ikTrGoods;Preq:preNone;Cost:0;Maint:0), //imTrGoods 612 (Kind:ikCommon;Preq:adWarriorCode;Cost:40;Maint:1), //imBarracks 613 (Kind:ikCommon;Preq:adPottery;Cost:60;Maint:1), //imGranary 614 (Kind:ikCommon;Preq:adCeremonialBurial;Cost:40;Maint:1), //imTemple 615 (Kind:ikCommon;Preq:adCurrency;Cost:60;Maint:1), //imMarket 616 (Kind:ikCommon;Preq:adWriting;Cost:80;Maint:3), //imLibrary 617 (Kind:ikCommon;Preq:adCodeOfLaws;Cost:80;Maint:2), //imCourt 618 (Kind:ikCommon;Preq:adMasonry;Cost:80;Maint:1), //imWalls 619 (Kind:ikCommon;Preq:adConstruction;Cost:80;Maint:1), //imAqueduct 620 (Kind:ikCommon;Preq:adBanking;Cost:120;Maint:2), //imBank 621 (Kind:ikCommon;Preq:adMonotheism;Cost:100;Maint:1), //imCathedral 622 (Kind:ikCommon;Preq:adUniversity;Cost:160;Maint:5), //imUniversity 623 (Kind:ikCommon;Preq:adSeafaring;Cost:60;Maint:1), //imHarbor 624 (Kind:ikCommon;Preq:adPoetry;Cost:60;Maint:2), //imTheater 625 (Kind:ikCommon;Preq:adIndustrialization;Cost:200;Maint:3), //imFactory 626 (Kind:ikCommon;Preq:adRobotics;Cost:320;Maint:5), //imMfgPlant 627 (Kind:ikCommon;Preq:adRecycling;Cost:320;Maint:4), //imRecycling 628 (Kind:ikCommon;Preq:adElectricity;Cost:120;Maint:2), //imPower 629 (Kind:ikCommon;Preq:adEnvironmentalism;Cost:120;Maint:1), //imHydro 630 (Kind:ikCommon;Preq:adNuclearPower;Cost:240;Maint:2), //imNuclear 631 (Kind:ikCommon;Preq:adRefining;Cost:160;Maint:2), //imPlatform 632 (Kind:ikCommon;Preq:preNone;Cost:40;Maint:1), //imTownHall 633 (Kind:ikCommon;Preq:adSanitation;Cost:120;Maint:2), //imSewer 634 (Kind:ikCommon;Preq:adRefrigeration;Cost:80;Maint:2), //imSupermarket 635 (Kind:ikCommon;Preq:adAutomobile;Cost:160;Maint:4), //imHighways 636 (Kind:ikCommon;Preq:adComputers;Cost:240;Maint:7), //imResLab 637 (Kind:ikCommon;Preq:adAdvancedRocketry;Cost:100;Maint:1), //imMissileBat 638 (Kind:ikCommon;Preq:adMetallurgy;Cost:80;Maint:1), //imCoastalFort 639 (Kind:ikCommon;Preq:adAdvancedFlight;Cost:160;Maint:1), //imAirport 640 (Kind:ikCommon;Preq:adAmphibiousWarfare;Cost:80;Maint:1), //imDockyard 641 (Kind:ikNatLocal;Preq:preNone;Cost:100;Maint:0), //imPalace 642 (Kind:ikNatLocal;Preq:adEngineering;Cost:400;Maint:4), //imGrWall 643 (Kind:ikNatLocal;Preq:adConstruction;Cost:200;Maint:4), //imColosseum 644 (Kind:ikNatLocal;Preq:adAstronomy;Cost:300;Maint:4), //imObservatory 645 (Kind:ikNatLocal;Preq:adTactics;Cost:100;Maint:4), //imMilAcademy 646 (Kind:ikNatLocal;Preq:adSteel;Cost:200;Maint:2), //imBunker 647 (Kind:ikNatLocal;Preq:adSyntheticFood;Cost:120;Maint:2), //imAlgae 648 (Kind:ikNatGlobal;Preq:adTheCorporation;Cost:320;Maint:4), //imStockEx 649 (Kind:ikNatLocal;Preq:adSpaceFlight;Cost:400;Maint:0), //imSpacePort 650 (Kind:ikShipPart;Preq:adTransstellarColonization;Cost:240;Maint:0), //imShipComp 651 (Kind:ikShipPart;Preq:adImpulseDrive;Cost:600;Maint:0), //imShipPow 652 (Kind:ikShipPart;Preq:adSelfContainedEnvironment;Cost:800;Maint:0)); //imShipHab 653 654 nImpReplacement=5; 655 ImpReplacement: array[0..nImpReplacement-1] of 656 record NewImp,OldImp: integer; end= 657 ((NewImp:imSewer;OldImp:imAqueduct), 658 (NewImp:imCourt;OldImp:imTownHall), 659 (NewImp:imPalace;OldImp:imTownHall), 660 (NewImp:imPalace;OldImp:imCourt), 661 (NewImp:imMilAcademy;OldImp:imBarracks)); 8 lxmax = 100; 9 lymax = 96; 10 nAdv = 94; { number of advances } 11 nImp = 70; { number of improvements } 12 nPl = 15; { max number of players, don't change! } 13 nUmax = 4096; { max units/player, don't set above 4096 } 14 nCmax = 1024; { max cities/player, don't set above 4096 } 15 nMmax = 256; { max models/player, don't set above 1024 } 16 nExp = 5; // number of experience levels 17 ExpCost = 50; { received damage required for next experience level } 18 MaxFutureTech = 25; 19 // maximum number of future techs of one kind except computing technology 20 MaxFutureTech_Computing = 100; 21 // maximum number of computing technology future techs 22 CountryRadius = 9; 23 MaxCitySize = 30; 24 BasicHappy = 2; { basically happy citizens } 25 MaxPollution = 240; 26 NeedAqueductSize = 8; 27 NeedSewerSize = 12; 28 ColossusEffect = 75; // percent wonder building cost 29 UniversityFutureBonus = 5; // percent per tech 30 ResLabFutureBonus = 10; // percent per tech 31 FactoryFutureBonus = 5; // percent per tech 32 MfgPlantFutureBonus = 10; // percent per tech 33 AnarchyTurns = 3; 34 CaptureTurns = 3; 35 CancelTreatyTurns = 3; 36 PeaceEvaTurns = 5; 37 // should be less then 2*CancelTreatyTurns, so that you can't attack an ally without re-entering 38 ColdWarTurns = 40; 39 DesertThurst = 20; // damage for turn in desert 40 ArcticThurst = 20; // damage for turn in arctic 41 FastRecovery = 50; 42 CityRecovery = 20; 43 NoCityRecovery = 8; 44 MaxMoneyPrice = $FFFF; 45 MaxShipPartPrice = 100; 46 BombardmentDestroysCity = false; 47 StartMoney = 0; 48 InitialCredibility = 95; 49 50 // ai module flags (for TInitModuleData.Flags) 51 aiThreaded = $01; 52 53 // difficulty settings 54 MaxDiff = 4; { maximum difficulty level } 55 StorageSize: array [1 .. MaxDiff] of integer = (30, 40, 50, 60); 56 TechFormula_M: array [1 .. MaxDiff] of single = (2.0, 2.3, 2.6, 4.0); 57 TechFormula_D: array [1 .. MaxDiff] of single = (102.0, 80.0, 64.0, 64.0); 58 BuildCostMod: array [1 .. MaxDiff] of integer = (9, 12, 15, 18); // in 1/12 59 60 // test flags 61 nTestFlags = 7; // max. 11 62 tfAllTechs = $001; { all nations get all techs } 63 tfImmImprove = $002; { city projects complete each turn } 64 tfImmAdvance = $004; { research complete each turn } 65 tfImmGrow = $008; { all cities grow in each turn } 66 tfUncover = $010; // all players see like supervisor 67 tfAllContact = $020; // all nations can contact each other 68 tfNoRareNeed = $040; // producing colony ship requires no modern resources 69 tfTested = $800; // at least one test flag was set 70 71 { server commands 72 IMPORTANT: lowest 4 bits must indicate size in DWORDS of data parameter, 73 except for request commands } 74 75 sctMask = $3800; // server command type 76 sExecute = $4000; { call command-sExecute to request return value without 77 execution } 78 cClientEx = $8000; 79 80 // Info Request Commands 81 sctInfo = $0000; 82 sMessage = $0000; 83 sSetDebugMap = $0010; 84 sGetDebugMap = $0020; 85 { sChangeSuperView=$0030; } sRefreshDebugMap = $0040; 86 sGetChart = $0100; // + type shl 4 87 sGetTechCost = $0180; 88 sGetAIInfo = $01C0; 89 sGetAICredits = $01D0; 90 sGetVersion = $01E0; 91 sGetGameChanged = $01F0; 92 sGetTileInfo = $0200; 93 sGetCityTileInfo = $0210; 94 sGetHypoCityTileInfo = $0220; 95 sGetJobProgress = $0230; 96 sGetModels = $0270; 97 sGetUnits = $0280; 98 sGetDefender = $0290; 99 sGetBattleForecast = $02A0; 100 sGetUnitReport = $02B0; 101 sGetMoveAdvice = $02C0; 102 sGetPlaneReturn = $02D0; 103 sGetBattleForecastEx = $02E0; 104 sGetCity = $0300; 105 sGetCityReport = $0310; 106 sGetCityAreaInfo = $0320; 107 sGetEnemyCityReport = $0330; 108 sGetEnemyCityAreaInfo = $0340; 109 sGetCityTileAdvice = $0350; 110 sGetCityReportNew = $0360; 111 sGetEnemyCityReportNew = $0370; 112 113 // Map Editor Commands 114 sEditTile = $0710; 115 sRandomMap = $0780; 116 sMapGeneratorRequest = $0790; 117 118 // Server Internal Commands 119 sctInternal = sctInfo; 120 // sctInfo - without sExecute flag, sctInternal - with sExecute flag 121 sIntTellAboutNation = $4000; 122 sIntHaveContact = $4010; 123 sIntCancelTreaty = $4020; 124 sIntTellAboutModel = $4100; { +told player shl 4 } 125 sIntDiscoverZOC = $4201; 126 sIntExpandTerritory = $4218; 127 sIntBuyMaterial = $4301; 128 sIntPayPrices = $4402; 129 sIntSetDevModel = $450D; 130 sIntSetModelStatus = $4601; 131 sIntSetUnitStatus = $4611; 132 sIntSetCityStatus = $4621; 133 sIntSetECityStatus = $4631; 134 sIntDataChange = $4700; 135 136 // Client Deactivation Commands 137 sctEndClient = $0800; 138 sTurn = $4800; 139 sBreak = $4810; 140 sResign = $4820; 141 sNextRound = $4830; 142 sReload = $4841; 143 sSaveMap = $4880; 144 sAbandonMap = $4890; 145 // diplomacy commands equal to client, see below 146 147 // General Commands 148 sctGeneral = $1000; 149 sClearTestFlag = $5000; 150 sSetTestFlag = $5010; 151 sSetGovernment = $5100; 152 sSetRates = $5110; 153 sRevolution = $5120; 154 sSetResearch = $5200; 155 sStealTech = $5210; 156 sSetAttitude = $5300; // + concerned player shl 4 157 sCancelTreaty = $5400; 158 159 // Model Related Commands 160 sctModel = $1800; 161 sCreateDevModel = $5800; 162 sSetDevModelCap = $5C00; { +value shl 4 } 163 { reserves $5CXX, $5DXX, $5EXX, $5FXX } 164 165 // Unit Related Commands 166 sctUnit = $2000; 167 sRemoveUnit = $6000; 168 sSetUnitHome = $6010; 169 sSetSpyMission = $6100; // + mission shl 4 170 sLoadUnit = $6200; 171 sUnloadUnit = $6210; 172 sSelectTransport = $6220; 173 sCreateUnit = $6301; // + player shl 4 174 sMoveUnit = $6400; { +dx and 7 shl 4 +dy and 7 shl 7 } 175 { reserves $64XX, $65XX, $66XX, $67XX } 176 177 // Settlers Related Commands 178 sctSettlers = $2800; 179 sAddToCity = $6810; 180 sStartJob = $6C00; { +job shl 4 } 181 { reserves $6CXX, $6DXX, $6EXX, $6FXX } 182 183 // City Related Commands 184 sctCity = $3000; 185 sSetCityProject = $7001; 186 sBuyCityProject = $7010; 187 sSellCityProject = $7020; 188 sSellCityImprovement = $7101; 189 sRebuildCityImprovement = $7111; 190 sSetCityTiles = $7201; 191 192 // free command space 193 sctUnused = $3800; 194 195 { client commands } 196 cInitModule = $0000; 197 cReleaseModule = $0100; 198 cBroadcast = $0200; 199 cHelpOnly = $0700; 200 cStartHelp = $0710; 201 cStartCredits = $0720; 202 203 cNewGame = $0800; 204 cLoadGame = $0810; 205 cMovie = $0820; 206 cNewGameEx = $0840; 207 cLoadGameEx = $0850; 208 cNewMap = $0880; 209 cReplay = $08E0; 210 cGetReady = $08F0; 211 cBreakGame = $0900; 212 213 cTurn = $2000; 214 cResume = $2010; 215 cContinue = $2080; 216 cMovieTurn = $2100; 217 cMovieEndTurn = $2110; 218 cEditMap = $2800; 219 220 // cShowTileM=$3000;cShowTileA=$3010;cShowFoundCity=$3020; 221 cShowUnitChanged = $3030; 222 cShowAfterMove = $3040; 223 cShowAfterAttack = $3050; 224 cShowCityChanged = $3090; 225 // cShowMove=$3100;cShowCapture=$3110; 226 // cShowAttackBegin=$3200;cShowAttackWon=$3210;cShowAttackLost=$3220; 227 cShowMoving = $3140; 228 cShowCapturing = $3150; 229 cShowAttacking = $3240; 230 cShowMissionResult = $3300; 231 cShowShipChange = $3400; 232 cShowGreatLibTech = $3500; 233 cShowTurnChange = $3700; 234 cShowCancelTreaty = $3800; 235 cShowEndContact = $3810; 236 cShowCancelTreatyByAlliance = $3820; 237 cShowSupportAllianceAgainst = $3830; 238 cShowPeaceViolation = $3880; 239 cShowGame = $3F00; { cShowSuperView=$3F80; } 240 cRefreshDebugMap = $3F90; 241 242 // diplomacy commands equal to server, see below 243 244 cDebugMessage = $7000; 245 cShowNego = $7010; 246 247 // commands same for server and client 248 scContact = $4900; // + concerned player shl 4 for server call 249 scReject = $4A00; 250 scDipStart = $4B00; 251 scDipNotice = $4B10; 252 scDipAccept = $4B20; 253 scDipCancelTreaty = $4B30; 254 scDipOffer = $4B4E; 255 scDipBreak = $4BF0; 256 257 { server return codes: flags } 258 rExecuted = $40000000; 259 rEffective = $20000000; 260 rUnitRemoved = $10000000; 261 rEnemySpotted = $08000000; 262 263 { server return codes: command executed } 264 // note: the same return code might have a different meaning for different server functions! 265 eOK = $60000000; // ok 266 eEnemySpotted = $68000000; // unit move ok, new enemy unit/city spotted 267 eDied = $70000000; // move executed, unit died due to hostile terrain 268 eEnemySpotted_Died = $78000000; 269 // unit move ok, new enemy unit/city spotted, unit died due to hostile terrain 270 eLoaded = $60000002; // unit move caused loading to transport ship 271 eLost = $70000004; // attack executed, battle lost, unit is dead 272 eWon = $60000005; // attack executed, battle won, defender destroyed 273 eBloody = $70000005; // attack executed, defender destroyed, unit is dead 274 eBombarded = $60000006; // empty enemy city bombarded 275 eExpelled = $60000007; // friendly unit expelled 276 eMissionDone = $70000008; 277 // spy moved into city: mission done, spy no longer exists 278 eJobDone = $60000001; // settler job started and already done 279 eJobDone_Died = $70000001; 280 // settler job started and already done, unit died due to hostile terrain 281 eCity = $70000002; // city founded, settler no more exists 282 eRemoved = $70000000; // sRemoveUnit: unit removed 283 eUtilized = $70000001; // sRemoveUnit: unit utilized for city project 284 285 eNotChanged = $40000000; 286 // ok, but no effect (e.g. current city project set again) 287 288 { server return codes: command not executed } 289 eHiddenUnit = $20000013; 290 // unit move: not possible, destination tile occupied by hidden foreign submarine 291 eStealthUnit = $2000001A; 292 // unit move: not possible, destination tile occupied by foreign stealth unit 293 eZOC_EnemySpotted = $28000014; 294 // unit move: not possible, new enemy unit spotted, ZOC violation 295 296 eInvalid = $0000; // command not allowed now or parameter out of allowed range 297 eUnknown = $0001; // unknown command 298 eNoTurn = $0002; // command only allowed during player's turn 299 eViolation = $0003; // general violation of game rules 300 eNoPreq = $0004; // the prerequisites for this command are not fully met 301 302 eNoTime_Move = $0008; // normal unit move: too few movement points left 303 eNoTime_Load = $0009; // load unit: too few movement points left 304 eNoTime_Attack = $000A; // attack: no movement points left 305 eNoTime_Bombard = $000B; // bombard city: too few movement points left 306 eNoTime_Expel = $000C; // expel spy: too few movement points left 307 308 eDomainMismatch = $0011; 309 // move/attack: action not allowed for this unit domain 310 eNoCapturer = $0012; 311 // unit move: this type of unit is not allowed to capture a city 312 eZOC = $0014; // unit move: not possible, ZOC violation 313 eTreaty = $0015; // move/attack: not possible, peace treaty violation 314 eDeadLands = $0016; // sStartJob: not possible, dead lands 315 eNoRoad = $0017; // unit move: not possible, no road 316 eNoNav = $0019; // unit move: not possible, open sea without navigation 317 eNoLoadCapacity = $001B; // load to transport: no more transport capacity 318 eNoBombarder = $001C; // bombardment impossible because no attack power 319 320 eMaxSize = $0020; 321 // add to city: bigger size not allowed due to missing aqueduct/sewer 322 eNoCityTerrain = $0022; // found city: not possible in this terrain 323 eNoBridgeBuilding = $0023; 324 eInvalidOffer = $0030; 325 eOfferNotAcceptable = $0031; 326 eCancelTreatyRush = $0032; 327 eAnarchy = $0038; // no negotiation in anarchy 328 eColdWar = $003F; 329 eNoModel = $0040; // sCreateDevModel must be called before! 330 eTileNotAvailable = $0050; 331 eNoWorkerAvailable = $0051; 332 eOnlyOnce = $0058; 333 // sell/rebuild city improvement: only once per city and turn! 334 eObsolete = $0059; // city project: more advanced improvement already exists 335 eOutOfControl = $005A; 336 // buy/sell/rebuild improvement: not in anarchy, not in captured cities 337 338 eNoWay = $0100; // sGetMoveAdvice: no way found 339 340 // chart types 341 nStat = 6; 342 stPop = 0; 343 stTerritory = 1; 344 stMil = 2; 345 stScience = 3; 346 stExplore = 4; 347 stWork = 5; 348 349 { tile flags: terrain type } 350 fTerrain = $1F; // mask for terrain type 351 fOcean = $00; 352 fShore = $01; 353 fGrass = $02; 354 fDesert = $03; 355 fPrairie = $04; 356 fTundra = $05; 357 fArctic = $06; 358 fSwamp = $07; 359 fForest = $09; 360 fHills = $0A; 361 fMountains = $0B; 362 fUNKNOWN = fTerrain; 363 364 { tile flags: terrain improvements } 365 fTerImp = $0000F000; // mask for terrain improvement 366 tiNone = $00000000; 367 tiIrrigation = $00001000; 368 tiFarm = $00002000; 369 tiMine = $00003000; 370 tiFort = $00004000; 371 tiBase = $00005000; 372 373 { tile flags: add ons } 374 fSpecial = $00000060; 375 fSpecial1 = $00000020; 376 fSpecial2 = $00000040; 377 fRiver = $00000080; 378 fRoad = $00000100; 379 fRR = $00000200; 380 fCanal = $00000400; 381 fPoll = $00000800; 382 fPrefStartPos = $00200000; 383 fStartPos = $00400000; // map editor only 384 fDeadLands = $01000000; 385 fModern = $06000000; 386 fCobalt = $02000000; 387 fUranium = $04000000; 388 fMercury = $06000000; 389 390 { tile flags: redundant helper info } 391 fGrWall = $00010000; // tile protected by great wall 392 fSpiedOut = $00020000; 393 fStealthUnit = $00040000; 394 fHiddenUnit = $00080000; 395 fObserved = $00100000; // set if tile information is from this turn 396 fOwned = $00200000; // set if unit/city here is own one 397 fUnit = $00400000; 398 fCity = $00800000; 399 fOwnZoCUnit = $10000000; // own ZoC unit present at this tile 400 fInEnemyZoC = $20000000; 401 // tile is adjacent to known foreign ZoC unit (not allied) 402 fPeace = $40000000; 403 // tile belongs to territory of nation that we are in peace with but not allied 404 405 // city project flags 406 cpIndex = $1FF; 407 cpConscripts = $200; // produce unit as conscripts 408 cpDisbandCity = $400; 409 // allow to disband city when settlers/conscripts are produced 410 cpImp = $800; // 0: index refers to model, 1: index refers to city improvement 411 cpRepeat = $1000; 412 cpCompleted = $2000; 413 cpAuto = $F000; // for internal use only 414 415 // tech status indicators 416 tsNA = -2; 417 tsSeen = -1; 418 tsResearched = 0; 419 tsGrLibrary = 1; 420 tsCheat = 15; 421 tsApplicable = tsResearched; 422 423 // nation treaties 424 trNoContact = -1; 425 trNone = 0; 426 trPeace = 2; 427 trFriendlyContact = 3; 428 trAlliance = 4; 429 430 // attitudes 431 nAttitude = 7; 432 atHostile = 0; 433 atIcy = 1; 434 atUncoop = 2; 435 atNeutral = 3; 436 atReceptive = 4; 437 atCordial = 5; 438 atEnth = 6; 439 440 // offer prices 441 opChoose = $00000000; 442 opCivilReport = $11000000; // + turn + concerned player shl 16 443 opMilReport = $12000000; // + turn + concerned player shl 16 444 opMap = $1F000000; 445 opTreaty = $20000000; // + suggested nation treaty 446 opShipParts = $30000000; // + number + part type shl 16 447 opMoney = $40000000; // + value 448 opTribute = $48000000; // obsolete 449 opTech = $50000000; // + advance 450 opAllTech = $51000000; 451 opModel = $58000000; // + model index 452 opAllModel = $59000000; 453 454 opMask = $FF000000; 455 456 // improvement kinds 457 ikTrGoods = 0; 458 ikCommon = 1; 459 ikNatLocal = 2; 460 ikNatGlobal = 3; 461 ikWonder = 4; 462 ikShipPart = 5; 463 ikNA = $7F; 464 465 { model domains } 466 nDomains = 3; 467 dGround = 0; 468 dSea = 1; 469 dAir = 2; 470 471 { model kinds } 472 mkSelfDeveloped = $00; 473 mkEnemyDeveloped = $01; 474 mkSpecial_Boat = $08; 475 mkSpecial_SubCabin = $0A; 476 mkSpecial_TownGuard = $10; 477 mkSpecial_Glider = $11; 478 mkScout = $20; 479 mkSlaves = $21; 480 mkSettler = $22; 481 mkCommando = $23; 482 mkFreight = $24; 483 484 { unit flags } 485 unFortified = $01; 486 unBombsLoaded = $02; 487 unMountainDelay = $04; 488 unConscripts = $08; 489 unWithdrawn = $10; 490 unMulti = $80; 491 492 // unit report flags 493 urfAlwaysSupport = $01; 494 urfDeployed = $02; 495 496 // unit moves 497 umCapturing = $0100; 498 umSpyMission = $0200; 499 umBombarding = $0400; 500 umExpelling = $0800; 501 umShipLoading = $1000; 502 umShipUnloading = $2000; 503 umPlaneLoading = $4000; 504 umPlaneUnloading = $8000; 505 506 { model flags } 507 mdZOC = $01; 508 mdCivil = $02; 509 mdDoubleSupport = $04; 510 511 { player happened flags } 512 phTech = $01; 513 phStealTech = $02; 514 phChangeGov = $08; 515 phGliderLost = $100; 516 phPlaneLost = $200; 517 phPeaceViolation = $400; 518 phPeaceEvacuation = $800; 519 phShipComplete = $2000; 520 phTimeUp = $4000; 521 phExtinct = $8000; 522 phGameEnd = $F000; 523 524 { city happened flags } 525 chDisorder = $01; 526 chProduction = $02; 527 chPopIncrease = $04; 528 chPopDecrease = $08; 529 chUnitLost = $10; 530 chImprovementLost = $20; 531 chProductionSabotaged = $40; 532 chNoGrowthWarning = $80; 533 chPollution = $100; 534 chSiege = $200; 535 chOldWonder = $400; 536 chNoSettlerProd = $800; 537 chFounded = $1000; 538 chAfterCapture = $2000; 539 chCaptured = $F0000; 540 chImprovementSold = $80000000; 541 542 { city info flags } 543 ciCapital = $01; 544 ciWalled = $02; 545 ciCoastalFort = $04; 546 ciMissileBat = $08; 547 ciBunker = $10; 548 ciSpacePort = $20; 549 550 { city tile available values } 551 faAvailable = 0; 552 faNotAvailable = 1; 553 faSiege = 2; 554 faTreaty = 4; 555 faInvalid = $FF; 556 557 // battle history flags 558 bhEnemyAttack = $01; 559 bhMyUnitLost = $02; 560 bhEnemyUnitLost = $04; 561 562 { move advice special destinations } 563 maNextCity = -1; 564 565 { goverment forms } 566 nGov = 8; 567 gAnarchy = 0; 568 gDespotism = 1; 569 gMonarchy = 2; 570 gRepublic = 3; 571 gFundamentalism = 4; 572 gCommunism = 5; 573 gDemocracy = 6; 574 gFuture = 7; 575 576 // ship change reasons 577 scrProduction = 0; 578 scrDestruction = 1; 579 scrTrade = 2; 580 scrCapture = 3; 581 582 { unit jobs } 583 nJob = 15; 584 jNone = 0; 585 jRoad = 1; 586 jRR = 2; 587 jClear = 3; 588 jIrr = 4; 589 jFarm = 5; 590 jAfforest = 6; 591 jMine = 7; 592 jCanal = 8; 593 jTrans = 9; 594 jFort = 10; 595 jPoll = 11; 596 jBase = 12; 597 jPillage = 13; 598 jCity = 14; 599 600 // job preconditions are: 601 // technology JobPreq is available, no city, plus the following: 602 // jRoad: no river when bridge building unavailable 603 // jRR: road 604 // jClear: Terrain.ClearTerrain, Hanging Gardens for desert 605 // jIrr: Terrain.IrrEff 606 // jFarm: irrigation 607 // jAfforest: Terrain.AfforestTerrain 608 // jMine: Terrain.MineEff 609 // jCanal: no Mountains, no Arctic 610 // jTrans: Terrain.TransWork 611 // jPoll: pollution 612 // jPillage: any tile improvement 613 // jCity, jFort, jBase: none 614 615 // spy mission 616 nSpyMission = 5; 617 smSabotageProd = 0; 618 smStealMap = 1; 619 smStealForeignReports = 2; 620 smStealCivilReport = 3; 621 smStealMilReport = 4; 622 623 // resource weights 624 rwOff = $00000000; 625 rwMaxGrowth = $3F514141; // 120*F + 1/8*P + 1/16*T + 1/16*S 626 rwMaxProd = $413F1F01; // 1/16*F + 120*P + 30*T + 1*S 627 rwMaxScience = $41040408; // 1/16*F + 4*P + 4*T + 8*S 628 rwForceProd = $F1080201; // F^1/2 * (8*P + 2*T + 1*S) 629 rwForceScience = $F1010101; // F^1/2 * (1*P + 1*T + 1*S) 630 631 { advances } 632 adAdvancedFlight = 0; 633 adAmphibiousWarfare = 1; 634 adAstronomy = 2; 635 adAtomicTheory = 3; 636 adAutomobile = 4; 637 adBallistics = 5; 638 adBanking = 6; 639 adBridgeBuilding = 7; 640 adBronzeWorking = 8; 641 adCeremonialBurial = 9; 642 adChemistry = 10; 643 adChivalry = 11; 644 adComposites = 12; 645 adCodeOfLaws = 13; 646 adCombinedArms = 14; 647 adCombustionEngine = 15; 648 adCommunism = 16; 649 adComputers = 17; 650 adConscription = 18; 651 adConstruction = 19; 652 adTheCorporation = 20; 653 adSpaceFlight = 21; 654 adCurrency = 22; 655 adDemocracy = 23; 656 adEconomics = 24; 657 adElectricity = 25; 658 adElectronics = 26; 659 adEngineering = 27; 660 adEnvironmentalism = 28; 661 adWheel = 29; 662 adExplosives = 30; 663 adFlight = 31; 664 adIntelligence = 32; 665 adGunpowder = 33; 666 adHorsebackRiding = 34; 667 adImpulseDrive = 35; 668 adIndustrialization = 36; 669 adSmartWeapons = 37; 670 adInvention = 38; 671 adIronWorking = 39; 672 adTheLaser = 40; 673 adNuclearPower = 41; 674 adLiterature = 42; 675 adInternet = 43; 676 adMagnetism = 44; 677 adMapMaking = 45; 678 adMasonry = 46; 679 adMassProduction = 47; 680 adMathematics = 48; 681 adMedicine = 49; 682 adMetallurgy = 50; 683 adMin = 51; 684 adMobileWarfare = 52; 685 adMonarchy = 53; 686 adMysticism = 54; 687 adNavigation = 55; 688 adNuclearFission = 56; 689 adPhilosophy = 57; 690 adPhysics = 58; 691 adPlastics = 59; 692 adPoetry = 60; 693 adPottery = 61; 694 adRadio = 62; 695 adRecycling = 63; 696 adRefrigeration = 64; 697 adMonotheism = 65; 698 adTheRepublic = 66; 699 adRobotics = 67; 700 adRocketry = 68; 701 adRailroad = 69; 702 adSanitation = 70; 703 adScience = 71; 704 adWriting = 72; 705 adSeafaring = 73; 706 adSelfContainedEnvironment = 74; 707 adStealth = 75; 708 adSteamEngine = 76; 709 adSteel = 77; 710 adSyntheticFood = 78; 711 adTactics = 79; 712 adTheology = 80; 713 adTheoryOfGravity = 81; 714 adTrade = 82; 715 adTransstellarColonization = 83; 716 adUniversity = 84; 717 adAdvancedRocketry = 85; 718 adWarriorCode = 86; 719 adAlphabet = 87; 720 adPolytheism = 88; 721 adRefining = 89; 722 futComputingTechnology = 90; 723 futNanoTechnology = 91; 724 futMaterialTechnology = 92; 725 futArtificialIntelligence = 93; 726 727 FutureTech = [futComputingTechnology, futNanoTechnology, 728 futMaterialTechnology, futArtificialIntelligence]; 729 730 adMilitary = $800; // Military Research 731 732 { wonders } 733 woPyramids = 00; 734 woZeus = 01; 735 woGardens = 02; 736 woColossus = 03; 737 woLighthouse = 04; 738 woGrLibrary = 05; 739 woOracle = 06; 740 woSun = 07; 741 woLeo = 08; 742 woMagellan = 09; 743 woMich = 10; { 11; } 744 woNewton = 12; 745 woBach = 13; 746 { 14; } woLiberty = 15; 747 woEiffel = 16; 748 woHoover = 17; 749 woShinkansen = 18; 750 woManhattan = 19; 751 woMir = 20; 752 753 { city improvements } 754 imTrGoods = 28; 755 imBarracks = 29; 756 imGranary = 30; 757 imTemple = 31; 758 imMarket = 32; 759 imLibrary = 33; 760 imCourt = 34; 761 imWalls = 35; 762 imAqueduct = 36; 763 imBank = 37; 764 imCathedral = 38; 765 imUniversity = 39; 766 imHarbor = 40; 767 imTheater = 41; 768 imFactory = 42; 769 imMfgPlant = 43; 770 imRecycling = 44; 771 imPower = 45; 772 imHydro = 46; 773 imNuclear = 47; 774 imPlatform = 48; 775 imTownHall = 49; 776 imSewer = 50; 777 imSupermarket = 51; 778 imHighways = 52; 779 imResLab = 53; 780 imMissileBat = 54; 781 imCoastalFort = 55; 782 imAirport = 56; 783 imDockyard = 57; 784 imPalace = 58; 785 imGrWall = 59; 786 imColosseum = 60; 787 imObservatory = 61; 788 imMilAcademy = 62; 789 imBunker = 63; 790 imAlgae = 64; 791 imStockEx = 65; 792 imSpacePort = 66; 793 imShipComp = 67; 794 imShipPow = 68; 795 imShipHab = 69; 796 797 SettlerFood: array [0 .. nGov - 1] of integer = (1, 1, 1, 2, 1, 2, 2, 2); 798 CorrLevel: array [0 .. nGov - 1] of integer = (3, 3, 1, 2, 1, 0, 0, 0); 799 SupportFree: array [0 .. nGov - 1] of integer = (2, 2, 1, 0, 2, 1, 0, 0); 800 // in 1/2*city size 801 802 // special prerequisite values 803 preNone = -1; 804 preLighthouse = -2; 805 preSun = -3; 806 preLeo = -4; 807 preBuilder = -5; 808 preNA = -$FF; 809 810 JobPreq: array [0 .. nJob - 1] of integer = (preNone, preNone, adRailroad, 811 preNone, preNone, adRefrigeration, preNone, preNone, adExplosives, 812 adExplosives, adConstruction, preNone, adMedicine, preNone, preNone); 813 814 AdvPreq: array [0 .. nAdv - 1, 0 .. 2] of integer = { advance prerequisites } 815 ((adFlight, adRobotics, preNone), // adAdvancedFlight 816 (adNavigation, adTactics, preNone), // adAmphibiousWarfare 817 (adMysticism, adAlphabet, preNone), // adAstronomy 818 (adTheoryOfGravity, preNone, preNone), // adAtomicTheory 819 (adCombustionEngine, adSteel, preNone), // adAutomobile 820 (adMathematics, adMetallurgy, preNone), // adBallistics 821 (adCurrency, adEngineering, preNone), // adBanking 822 (adConstruction, adWheel, preNone), // adBridgeBuilding 823 (preNone, preNone, preNone), // adBronzeWorking 824 (preNone, preNone, preNone), // adCeremonialBurial 825 (adScience, preNone, preNone), // adChemistry 826 (adMonarchy, adWarriorCode, preNone), // adChivalry 827 (adMetallurgy, adPlastics, preNone), // adComposites 828 (adWriting, preNone, preNone), // adCodeOfLaws 829 (adAdvancedFlight, adMobileWarfare, preNone), // adCombinedArms 830 (adRefining, adExplosives, preNone), // adCombustionEngine 831 (adPhilosophy, adIndustrialization, preNone), // adCommunism 832 (adMin, preNone, preNone), // adComputers 833 (adTheRepublic, adTactics, preNone), // adConscription 834 (adMasonry, adAlphabet, preNone), // adConstruction 835 (adEconomics, adDemocracy, preNone), // adTheCorporation 836 (adAdvancedFlight, adAdvancedRocketry, preNone), // adSpaceFlight 837 (adBronzeWorking, preNone, preNone), // adCurrency 838 (adConscription, adIndustrialization, preNone), // adDemocracy 839 (adBanking, adUniversity, preNone), // adEconomics 840 (adMagnetism, preNone, preNone), // adElectricity 841 (adRadio, adAtomicTheory, preNone), // adElectronics 842 (adConstruction, adBronzeWorking, preNone), // adEngineering 843 (adIndustrialization, preNone, preNone), // adEnvironmentalism 844 (preNone, preNone, preNone), // adWheel 845 (adChemistry, adEngineering, preNone), // adExplosives 846 (adCombustionEngine, adPhysics, preNone), // adFlight 847 (adTactics, adInvention, preNone), // adIntelligence 848 (adMedicine, adIronWorking, preNone), // adGunpowder 849 (preNone, preNone, preNone), // adHorsebackRiding 850 (adSpaceFlight, adNuclearPower, preNone), // adImpulseDrive 851 (adRailroad, adBanking, preNone), // adIndustrialization 852 (adAdvancedRocketry, adTheLaser, preNone), // adIntelligenArms 853 (adWriting, adWheel, preNone), // adInvention 854 (adBronzeWorking, adInvention, preNone), // adIronWorking 855 (adMin, adPhysics, preNone), // adTheLaser 856 (adNuclearFission, preNone, preNone), // adNuclearPower 857 (adPoetry, adTrade, preNone), // adLiterature 858 (adDemocracy, adComputers, preNone), // adLybertarianism 859 (adPhysics, adIronWorking, preNone), // adMagnetism 860 (adAlphabet, preNone, preNone), // adMapMaking 861 (preNone, preNone, preNone), // adMasonry 862 (adAutomobile, adElectronics, adTheCorporation), // adMassProduction 863 (adCurrency, adAlphabet, preNone), // adMathematics 864 (adMysticism, adPottery, preNone), // adMedicine 865 (adGunpowder, preNone, preNone), // adMetallurgy 866 (adRobotics, adPlastics, preNone), // adMin 867 (adAutomobile, adTactics, preNone), // adMobileWarfare 868 (adPolytheism, preNone, preNone), // adMonarchy 869 (adCeremonialBurial, preNone, preNone), // adMysticism 870 (adSeafaring, adAstronomy, preNone), // adNavigation 871 (adAtomicTheory, adMassProduction, preNone), // adNuclearFission 872 (adMathematics, adLiterature, preNone), // adPhilosophy 873 (adScience, preNone, preNone), // adPhysics 874 (adMassProduction, adRefining, preNone), // adPlastics 875 (adMysticism, adWarriorCode, preNone), // adPoetry 876 (preNone, preNone, preNone), // adPottery 877 (adElectricity, adEngineering, preNone), // adRadio 878 (adEnvironmentalism, adPlastics, preNone), // adRecycling 879 (adElectricity, preNone, preNone), // adRefrigeration 880 (adPolytheism, adAstronomy, preNone), // adMonotheism 881 (adLiterature, preNone, preNone), // adTheRepublic 882 (adMassProduction, adEconomics, preNone), // adRobotics 883 (adBallistics, adExplosives, preNone), // adRocketry 884 (adSteamEngine, adBridgeBuilding, preNone), // adRailroad 885 (adEnvironmentalism, adMedicine, preNone), // adSanitation 886 (adMetallurgy, adTheology, adPhilosophy), // adScience 887 (adAlphabet, preNone, preNone), // adWriting 888 (adPottery, adMapMaking, preNone), // adSeafaring 889 (adRecycling, adSyntheticFood, preNone), // adSelfContainedEnvironment 890 (adComposites, adRadio, preNone), // adStealth 891 (adScience, adEngineering, preNone), // adSteamEngine 892 (adIronWorking, adRailroad, preNone), // adSteel 893 (adChemistry, adRefrigeration, preNone), // adSyntheticFood 894 (adWarriorCode, adUniversity, preNone), // adTactics 895 (adMonotheism, adPoetry, preNone), // adTheology 896 (adAstronomy, adPhysics, preNone), // adTheoryOfGravity 897 (adCurrency, adCodeOfLaws, preNone), // adTrade 898 (adImpulseDrive, adSelfContainedEnvironment, preNone), 899 // adTransstellarColonization 900 (adScience, preNone, preNone), // adUniversity 901 (adComputers, adRocketry, preNone), // adAdvancedRocketry 902 (preNone, preNone, preNone), // adWarriorCode 903 (preNone, preNone, preNone), // adAlphabet 904 (adCeremonialBurial, adHorsebackRiding, preNone), // adPolytheism 905 (adChemistry, preNone, preNone), // adRefining 906 (adComputers, preNone, preNone), // futResearchTechnology 907 (adRobotics, preNone, preNone), // futProductionTechnology 908 (adComposites, preNone, preNone), // futArmorTechnology 909 (adSmartWeapons, preNone, preNone)); // futMissileTechnology 910 911 Imp: 912 array [0 .. nImp - 1] of // city improvements 913 record Kind, Preq, Cost, Maint, Expiration: integer; 914 end 915 = ((Kind: ikWonder; Preq: adMathematics; Cost: 400; Maint: 0; 916 Expiration: adDemocracy), // woPyramids 917 (Kind: ikWonder; Preq: adPolytheism; Cost: 200; Maint: 0; 918 Expiration: adElectronics), // woZeus 919 (Kind: ikWonder; Preq: adInvention; Cost: 200; Maint: 0; 920 Expiration: adNuclearFission), // woGardens 921 (Kind: ikWonder; Preq: adBronzeWorking; Cost: 200; Maint: 0; Expiration: - 1), 922 // woColossus 923 (Kind: ikWonder; Preq: adMapMaking; Cost: 200; Maint: 0; Expiration: adSteel), 924 // woLighthouse 925 (Kind: ikWonder; Preq: adLiterature; Cost: 400; Maint: 0; 926 Expiration: adPlastics), // woGrLibrary 927 (Kind: ikWonder; Preq: adMysticism; Cost: 200; Maint: 0; Expiration: - 1), 928 // woOracle 929 (Kind: ikWonder; Preq: adChivalry; Cost: 300; Maint: 0; 930 Expiration: adSpaceFlight), // woSun 931 (Kind: ikWonder; Preq: adPhilosophy; Cost: 500; Maint: 0; Expiration: - 1), 932 // woLeo 933 (Kind: ikWonder; Preq: adNavigation; Cost: 300; Maint: 0; Expiration: - 1), 934 // woMagellan 935 (Kind: ikWonder; Preq: adMonotheism; Cost: 400; Maint: 0; Expiration: - 1), 936 // woMich 937 (Kind: ikNA; Preq: preNA), // {11} 938 (Kind: ikWonder; Preq: adTheoryOfGravity; Cost: 400; Maint: 0; 939 Expiration: - 1), // woNewton 940 (Kind: ikWonder; Preq: adTheology; Cost: 400; Maint: 0; Expiration: - 1), 941 // woBach 942 (Kind: ikNA; Preq: preNA), // {14} 943 (Kind: ikWonder; Preq: adDemocracy; Cost: 500; Maint: 0; Expiration: - 1), 944 // woLiberty 945 (Kind: ikWonder; Preq: adSteel; Cost: 800; Maint: 0; Expiration: - 1), 946 // woEiffel 947 (Kind: ikWonder; Preq: adElectronics; Cost: 800; Maint: 0; Expiration: - 1), 948 // woHoover 949 (Kind: ikWonder; Preq: adPlastics; Cost: 500; Maint: 0; Expiration: - 1), 950 // woShinkansen 951 (Kind: ikWonder; Preq: adNuclearFission; Cost: 400; Maint: 0; 952 Expiration: - 1), // woManhattan 953 (Kind: ikWonder; Preq: adSpaceFlight; Cost: 800; Maint: 0; Expiration: - 1), 954 // woMir 955 (Kind: ikNA; Preq: preNA), // {21} 956 (Kind: ikNA; Preq: preNA), // {22} 957 (Kind: ikNA; Preq: preNA), // {23} 958 (Kind: ikNA; Preq: preNA), // {24} 959 (Kind: ikNA; Preq: preNA), // {25} 960 (Kind: ikNA; Preq: preNA), // {26} 961 (Kind: ikNA; Preq: preNA), // {27} 962 (Kind: ikTrGoods; Preq: preNone; Cost: 0; Maint: 0), // imTrGoods 963 (Kind: ikCommon; Preq: adWarriorCode; Cost: 40; Maint: 1), // imBarracks 964 (Kind: ikCommon; Preq: adPottery; Cost: 60; Maint: 1), // imGranary 965 (Kind: ikCommon; Preq: adCeremonialBurial; Cost: 40; Maint: 1), // imTemple 966 (Kind: ikCommon; Preq: adCurrency; Cost: 60; Maint: 1), // imMarket 967 (Kind: ikCommon; Preq: adWriting; Cost: 80; Maint: 3), // imLibrary 968 (Kind: ikCommon; Preq: adCodeOfLaws; Cost: 80; Maint: 2), // imCourt 969 (Kind: ikCommon; Preq: adMasonry; Cost: 80; Maint: 1), // imWalls 970 (Kind: ikCommon; Preq: adConstruction; Cost: 80; Maint: 1), // imAqueduct 971 (Kind: ikCommon; Preq: adBanking; Cost: 120; Maint: 2), // imBank 972 (Kind: ikCommon; Preq: adMonotheism; Cost: 100; Maint: 1), // imCathedral 973 (Kind: ikCommon; Preq: adUniversity; Cost: 160; Maint: 5), // imUniversity 974 (Kind: ikCommon; Preq: adSeafaring; Cost: 60; Maint: 1), // imHarbor 975 (Kind: ikCommon; Preq: adPoetry; Cost: 60; Maint: 2), // imTheater 976 (Kind: ikCommon; Preq: adIndustrialization; Cost: 200; Maint: 3), // imFactory 977 (Kind: ikCommon; Preq: adRobotics; Cost: 320; Maint: 5), // imMfgPlant 978 (Kind: ikCommon; Preq: adRecycling; Cost: 320; Maint: 4), // imRecycling 979 (Kind: ikCommon; Preq: adElectricity; Cost: 120; Maint: 2), // imPower 980 (Kind: ikCommon; Preq: adEnvironmentalism; Cost: 120; Maint: 1), // imHydro 981 (Kind: ikCommon; Preq: adNuclearPower; Cost: 240; Maint: 2), // imNuclear 982 (Kind: ikCommon; Preq: adRefining; Cost: 160; Maint: 2), // imPlatform 983 (Kind: ikCommon; Preq: preNone; Cost: 40; Maint: 1), // imTownHall 984 (Kind: ikCommon; Preq: adSanitation; Cost: 120; Maint: 2), // imSewer 985 (Kind: ikCommon; Preq: adRefrigeration; Cost: 80; Maint: 2), // imSupermarket 986 (Kind: ikCommon; Preq: adAutomobile; Cost: 160; Maint: 4), // imHighways 987 (Kind: ikCommon; Preq: adComputers; Cost: 240; Maint: 7), // imResLab 988 (Kind: ikCommon; Preq: adAdvancedRocketry; Cost: 100; Maint: 1), 989 // imMissileBat 990 (Kind: ikCommon; Preq: adMetallurgy; Cost: 80; Maint: 1), // imCoastalFort 991 (Kind: ikCommon; Preq: adAdvancedFlight; Cost: 160; Maint: 1), // imAirport 992 (Kind: ikCommon; Preq: adAmphibiousWarfare; Cost: 80; Maint: 1), // imDockyard 993 (Kind: ikNatLocal; Preq: preNone; Cost: 100; Maint: 0), // imPalace 994 (Kind: ikNatLocal; Preq: adEngineering; Cost: 400; Maint: 4), // imGrWall 995 (Kind: ikNatLocal; Preq: adConstruction; Cost: 200; Maint: 4), // imColosseum 996 (Kind: ikNatLocal; Preq: adAstronomy; Cost: 300; Maint: 4), // imObservatory 997 (Kind: ikNatLocal; Preq: adTactics; Cost: 100; Maint: 4), // imMilAcademy 998 (Kind: ikNatLocal; Preq: adSteel; Cost: 200; Maint: 2), // imBunker 999 (Kind: ikNatLocal; Preq: adSyntheticFood; Cost: 120; Maint: 2), // imAlgae 1000 (Kind: ikNatGlobal; Preq: adTheCorporation; Cost: 320; Maint: 4), // imStockEx 1001 (Kind: ikNatLocal; Preq: adSpaceFlight; Cost: 400; Maint: 0), // imSpacePort 1002 (Kind: ikShipPart; Preq: adTransstellarColonization; Cost: 240; Maint: 0), 1003 // imShipComp 1004 (Kind: ikShipPart; Preq: adImpulseDrive; Cost: 600; Maint: 0), // imShipPow 1005 (Kind: ikShipPart; Preq: adSelfContainedEnvironment; Cost: 800; Maint: 0)); 1006 // imShipHab 1007 1008 nImpReplacement = 5; 1009 ImpReplacement: 1010 array [0 .. nImpReplacement - 1] of record NewImp, OldImp: integer; 1011 end 1012 = ((NewImp: imSewer; OldImp: imAqueduct), (NewImp: imCourt; OldImp: imTownHall), 1013 (NewImp: imPalace; OldImp: imTownHall), (NewImp: imPalace; OldImp: imCourt), 1014 (NewImp: imMilAcademy; OldImp: imBarracks)); 662 1015 663 1016 // colony ship 664 nShipPart=3; 665 spComp=0; spPow=1; spHab=2; 666 ShipNeed: array[0..nShipPart-1] of integer=(6,4,2); 667 ShipImpIndex: array[0..nShipPart-1] of integer=(imShipComp,imShipPow,imShipHab); 668 669 GovPreq:array[1..nGov-1] of integer= {government prerequisites} 670 (preNone,adMonarchy,adTheRepublic,adTheology,adCommunism,adDemocracy,adInternet); 671 672 AgePreq:array[1..3] of integer= (adScience,adMassProduction,adTransstellarColonization); 673 674 Terrain:array[0..11] of record 675 MoveCost,Defense,ClearTerrain,IrrEff,IrrClearWork,AfforestTerrain,MineEff, 676 MineAfforestWork,TransTerrain,TransWork:integer; 677 FoodRes,ProdRes,TradeRes:array[0..2] of integer; 678 Filler: array[0..12] of integer; 679 end= 680 ((MoveCost:1;Defense:4;ClearTerrain:-1;IrrEff:0;IrrClearWork:0; 681 AfforestTerrain:-1;MineEff:0;MineAfforestWork:0;TransTerrain:-1; 682 TransWork:0;FoodRes:(0,0,0);ProdRes:(0,0,0);TradeRes:(0,0,0)), {Ocn} 683 (MoveCost:1;Defense:4;ClearTerrain:-1;IrrEff:0;IrrClearWork:0; 684 AfforestTerrain:-1;MineEff:0;MineAfforestWork:0;TransTerrain:-1; 685 TransWork:0;FoodRes:(1,5,1);ProdRes:(0,0,5);TradeRes:(3,3,3)), {Sho} 686 (MoveCost:1;Defense:4;ClearTerrain:-1;IrrEff:1;IrrClearWork:600; 687 AfforestTerrain:fForest;MineEff:0;MineAfforestWork:1800;TransTerrain:fHills; 688 TransWork:3000;FoodRes:(3,2,2);ProdRes:(0,1,0);TradeRes:(1,1,1)), {Gra} 689 (MoveCost:1;Defense:4;ClearTerrain:fGrass;IrrEff:0;IrrClearWork:1800; 690 AfforestTerrain:-1;MineEff:1;MineAfforestWork:600;TransTerrain:fPrairie; 691 TransWork:3000;FoodRes:(0,3,0);ProdRes:(1,1,4);TradeRes:(1,1,1)), {Dst} 692 (MoveCost:1;Defense:4;ClearTerrain:-1;IrrEff:1;IrrClearWork:600; 693 AfforestTerrain:fForest;MineEff:0;MineAfforestWork:2400;TransTerrain:-1; 694 TransWork:0;FoodRes:(1,3,1);ProdRes:(1,1,3);TradeRes:(1,1,1)), {Pra} 695 (MoveCost:1;Defense:4;ClearTerrain:-1;IrrEff:1;IrrClearWork:600; 696 AfforestTerrain:-1;MineEff:0;MineAfforestWork:0;TransTerrain:fGrass; 697 TransWork:3000;FoodRes:(1,1,1);ProdRes:(0,0,4);TradeRes:(1,6,1)), {Tun} 698 (MoveCost:2;Defense:4;ClearTerrain:-1;IrrEff:0;IrrClearWork:0; 699 AfforestTerrain:-1;MineEff:3;MineAfforestWork:1800;TransTerrain:-1; 700 TransWork:0;FoodRes:(0,3,0);ProdRes:(1,1,0);TradeRes:(0,4,0)), {Arc} 701 (MoveCost:2;Defense:6;ClearTerrain:fGrass;IrrEff:0;IrrClearWork:2400; 702 AfforestTerrain:fForest;MineEff:0;MineAfforestWork:2400;TransTerrain:fHills; 703 TransWork:3000;FoodRes:(1,1,1);ProdRes:(0,4,1);TradeRes:(1,1,5)), {Swa} 704 (), {-} 705 (MoveCost:2;Defense:6;ClearTerrain:fPrairie;IrrEff:0;IrrClearWork:600; 706 AfforestTerrain:-1;MineEff:0;MineAfforestWork:0;TransTerrain:-1; 707 TransWork:0;FoodRes:(1,3,1);ProdRes:(2,2,2);TradeRes:(1,1,4)), {For} 708 (MoveCost:2;Defense:8;ClearTerrain:-1;IrrEff:1;IrrClearWork:600; 709 AfforestTerrain:-1;MineEff:3;MineAfforestWork:1200;TransTerrain:fGrass; 710 TransWork:6000;FoodRes:(1,1,1);ProdRes:(0,0,2);TradeRes:(0,4,0)), {Hil} 711 (MoveCost:3;Defense:12;ClearTerrain:-1;IrrEff:0;IrrClearWork:0; 712 AfforestTerrain:-1;MineEff:2;MineAfforestWork:1200;TransTerrain:-1; 713 TransWork:0;FoodRes:(0,0,0);ProdRes:(1,4,1);TradeRes:(0,0,7))); {Mou} 714 715 //settler work required MP 716 PillageWork=100; 717 CityWork=900; 718 FarmWork=3; // *IrrClearWork 719 RoadWork=300; // *MoveCost 720 RoadBridgeWork=900; 721 RRWork=600; // *MoveCost 722 RRBridgeWork=900; 723 CanalWork=1800; 724 FortWork=600; // *MoveCost 725 BaseWork=600; // *MoveCost 726 PollWork=1800; 1017 nShipPart = 3; 1018 spComp = 0; 1019 spPow = 1; 1020 spHab = 2; 1021 ShipNeed: 1022 array [0 .. nShipPart - 1] of integer = (6, 4, 2); 1023 ShipImpIndex: 1024 array [0 .. nShipPart - 1] of integer = (imShipComp, imShipPow, imShipHab); 1025 1026 GovPreq: 1027 array [1 .. nGov - 1] of integer = { government prerequisites } 1028 (preNone, adMonarchy, adTheRepublic, adTheology, adCommunism, adDemocracy, 1029 adInternet); 1030 1031 AgePreq: 1032 array [1 .. 3] of integer = (adScience, adMassProduction, 1033 adTransstellarColonization); 1034 1035 Terrain: 1036 array [0 .. 11] of record MoveCost, Defense, ClearTerrain, IrrEff, IrrClearWork, 1037 AfforestTerrain, MineEff, MineAfforestWork, TransTerrain, TransWork: integer; 1038 FoodRes, ProdRes, TradeRes: array [0 .. 2] of integer; 1039 Filler: 1040 array [0 .. 12] of integer; 1041 end 1042 = ((MoveCost: 1; Defense: 4; ClearTerrain: - 1; IrrEff: 0; IrrClearWork: 0; 1043 AfforestTerrain: - 1; MineEff: 0; MineAfforestWork: 0; TransTerrain: - 1; 1044 TransWork: 0; FoodRes: (0, 0, 0); ProdRes: (0, 0, 0); 1045 TradeRes: (0, 0, 0)), { Ocn } 1046 (MoveCost: 1; Defense: 4; ClearTerrain: - 1; IrrEff: 0; IrrClearWork: 0; 1047 AfforestTerrain: - 1; MineEff: 0; MineAfforestWork: 0; TransTerrain: - 1; 1048 TransWork: 0; FoodRes: (1, 5, 1); ProdRes: (0, 0, 5); 1049 TradeRes: (3, 3, 3)), { Sho } 1050 (MoveCost: 1; Defense: 4; ClearTerrain: - 1; IrrEff: 1; IrrClearWork: 600; 1051 AfforestTerrain: fForest; MineEff: 0; MineAfforestWork: 1800; 1052 TransTerrain: fHills; TransWork: 3000; FoodRes: (3, 2, 2); ProdRes: (0, 1, 0); 1053 TradeRes: (1, 1, 1)), { Gra } 1054 (MoveCost: 1; Defense: 4; ClearTerrain: fGrass; IrrEff: 0; IrrClearWork: 1800; 1055 AfforestTerrain: - 1; MineEff: 1; MineAfforestWork: 600; 1056 TransTerrain: fPrairie; TransWork: 3000; FoodRes: (0, 3, 0); 1057 ProdRes: (1, 1, 4); TradeRes: (1, 1, 1)), { Dst } 1058 (MoveCost: 1; Defense: 4; ClearTerrain: - 1; IrrEff: 1; IrrClearWork: 600; 1059 AfforestTerrain: fForest; MineEff: 0; MineAfforestWork: 2400; 1060 TransTerrain: - 1; TransWork: 0; FoodRes: (1, 3, 1); ProdRes: (1, 1, 3); 1061 TradeRes: (1, 1, 1)), { Pra } 1062 (MoveCost: 1; Defense: 4; ClearTerrain: - 1; IrrEff: 1; IrrClearWork: 600; 1063 AfforestTerrain: - 1; MineEff: 0; MineAfforestWork: 0; TransTerrain: fGrass; 1064 TransWork: 3000; FoodRes: (1, 1, 1); ProdRes: (0, 0, 4); 1065 TradeRes: (1, 6, 1)), { Tun } 1066 (MoveCost: 2; Defense: 4; ClearTerrain: - 1; IrrEff: 0; IrrClearWork: 0; 1067 AfforestTerrain: - 1; MineEff: 3; MineAfforestWork: 1800; TransTerrain: - 1; 1068 TransWork: 0; FoodRes: (0, 3, 0); ProdRes: (1, 1, 0); 1069 TradeRes: (0, 4, 0)), { Arc } 1070 (MoveCost: 2; Defense: 6; ClearTerrain: fGrass; IrrEff: 0; IrrClearWork: 2400; 1071 AfforestTerrain: fForest; MineEff: 0; MineAfforestWork: 2400; 1072 TransTerrain: fHills; TransWork: 3000; FoodRes: (1, 1, 1); ProdRes: (0, 4, 1); 1073 TradeRes: (1, 1, 5)), { Swa } 1074 (), { - } 1075 (MoveCost: 2; Defense: 6; ClearTerrain: fPrairie; IrrEff: 0; 1076 IrrClearWork: 600; AfforestTerrain: - 1; MineEff: 0; MineAfforestWork: 0; 1077 TransTerrain: - 1; TransWork: 0; FoodRes: (1, 3, 1); ProdRes: (2, 2, 2); 1078 TradeRes: (1, 1, 4)), { For } 1079 (MoveCost: 2; Defense: 8; ClearTerrain: - 1; IrrEff: 1; IrrClearWork: 600; 1080 AfforestTerrain: - 1; MineEff: 3; MineAfforestWork: 1200; 1081 TransTerrain: fGrass; TransWork: 6000; FoodRes: (1, 1, 1); ProdRes: (0, 0, 2); 1082 TradeRes: (0, 4, 0)), { Hil } 1083 (MoveCost: 3; Defense: 12; ClearTerrain: - 1; IrrEff: 0; IrrClearWork: 0; 1084 AfforestTerrain: - 1; MineEff: 2; MineAfforestWork: 1200; TransTerrain: - 1; 1085 TransWork: 0; FoodRes: (0, 0, 0); ProdRes: (1, 4, 1); 1086 TradeRes: (0, 0, 7))); { Mou } 1087 1088 // settler work required MP 1089 PillageWork = 100; 1090 CityWork = 900; 1091 FarmWork = 3; // *IrrClearWork 1092 RoadWork = 300; // *MoveCost 1093 RoadBridgeWork = 900; 1094 RRWork = 600; // *MoveCost 1095 RRBridgeWork = 900; 1096 CanalWork = 1800; 1097 FortWork = 600; // *MoveCost 1098 BaseWork = 600; // *MoveCost 1099 PollWork = 1800; 727 1100 728 1101 // upgrades for new unit models 729 1102 // upgrade[domain,0].preq is domain precondition advance 730 1103 // cost values accumulate if prerequisite is future tech / are maximized if not 731 nUpgrade=15; 732 upgrade: array [0..nDomains-1,0..nUpgrade-1] of 733 record Preq,Strength,Trans,Cost: integer end= 734 (((Preq:adWarriorCode;Strength:4;Trans:0;Cost:3), 735 (Preq:adBronzeWorking;Strength:2;Trans:0;Cost:4), 736 (Preq:adIronWorking;Strength:2;Trans:0;Cost:5), 737 (Preq:adChivalry;Strength:2;Trans:0;Cost:5), 738 (Preq:adMonotheism;Strength:3;Trans:0;Cost:7), 739 (Preq:adGunpowder;Strength:3;Trans:0;Cost:8), 740 (Preq:adExplosives;Strength:4;Trans:0;Cost:9), 741 (Preq:adTactics;Strength:5;Trans:0;Cost:10), 742 (Preq:adRadio;Strength:6;Trans:0;Cost:11), 743 (Preq:adDemocracy;Strength:6;Trans:0;Cost:5), 744 (Preq:adMobileWarfare;Strength:7;Trans:0;Cost:12), 745 (Preq:adRobotics;Strength:8;Trans:0;Cost:15), 746 (Preq:adComposites;Strength:8;Trans:0;Cost:15), 747 (Preq:adTheLaser;Strength:8;Trans:0;Cost:14), 748 (Preq:futMaterialTechnology;Strength:10;Trans:0;Cost:2)), 749 ((Preq:adMapMaking;Strength:4;Trans:1;Cost:8), 750 (Preq:adNavigation;Strength:4;Trans:0;Cost:10), 751 (Preq:adEngineering;Strength:0;Trans:1;Cost:8), 752 (Preq:adGunpowder;Strength:8;Trans:0;Cost:12), 753 (Preq:adMagnetism;Strength:12;Trans:1;Cost:20), 754 (Preq:adExplosives;Strength:16;Trans:0;Cost:24), 755 (Preq:adSteamEngine;Strength:24;Trans:0;Cost:28), 756 (Preq:adAmphibiousWarfare;Strength:24;Trans:1;Cost:18), 757 (Preq:adAdvancedRocketry;Strength:32;Trans:0;Cost:38), 758 (Preq:futMaterialTechnology;Strength:14;Trans:0;Cost:4), 759 (Preq:futArtificialIntelligence;Strength:14;Trans:0;Cost:4), 760 (Preq:preNA),(Preq:preNA),(Preq:preNA),(Preq:preNA)), 761 ((Preq:adFlight;Strength:12;Trans:1;Cost:14), 762 (Preq:adTactics;Strength:6;Trans:0;Cost:17), 763 (Preq:adElectronics;Strength:6;Trans:0;Cost:20), 764 (Preq:adMin;Strength:8;Trans:0;Cost:24), 765 (Preq:adComposites;Strength:8;Trans:0;Cost:26), 766 (Preq:adSmartWeapons;Strength:11;Trans:0;Cost:32), 767 (Preq:futArtificialIntelligence;Strength:7;Trans:0;Cost:4), 768 (Preq:preNA),(Preq:preNA),(Preq:preNA),(Preq:preNA),(Preq:preNA),(Preq:preNA), 769 (Preq:preNA),(Preq:preNA))); 770 771 {model features} 772 nFeature=27; 773 mcWeapons=0;mcArmor=1;mcMob=2;mcSeaTrans=3;mcCarrier=4;mcTurbines=5; 774 mcBombs=6;mcFuel=7;mcAirTrans=8;mcNav=9;mcRadar=10;mcSub=11;mcArtillery=12; 775 mcAlpine=13;mcSupplyShip=14;mcOver=15;mcAirDef=16;mcSpy=17;mcSE=18;mcNP=19; 776 mcJet=20;mcStealth=21;mcFanatic=22;mcFirst=23;mcWill=24;mcAcademy=25;mcLine=26; 777 mcFirstNonCap=mcNav; 778 AutoFeature: Set of mcFirstNonCap..nFeature-1 = 779 [mcNav,mcSE,mcNP,mcJet,mcAcademy]; // unit class advances, automatically applied if available 780 781 Feature:array [0..nFeature-1] of {unit model features} 782 record Domains,Preq,Weight,Cost: integer; end= 783 ((Domains:7;Preq:preNone;Weight:1;Cost:1), {mcOffense} 784 (Domains:7;Preq:preNone;Weight:1;Cost:1), {mcDefense} 785 (Domains:1;Preq:adHorsebackRiding;Weight:1;Cost:1), {mcMob} 786 (Domains:2;Preq:preNone;Weight:2;Cost:1), {mcSeaTrans} 787 (Domains:2;Preq:adAdvancedFlight;Weight:2;Cost:2), {mcCarrier} 788 (Domains:2;Preq:adPhysics;Weight:3;Cost:1), {mcTurbines} 789 (Domains:4;Preq:adAdvancedFlight;Weight:1;Cost:1), {mcBombs} 790 (Domains:4;Preq:preNone;Weight:1;Cost:1), {mcFuel} 791 (Domains:4;Preq:adCombinedArms;Weight:2;Cost:1), {mcAirTrans} 792 (Domains:2;Preq:adNavigation;Weight:0;Cost:0), {mcNav} 793 (Domains:2;Preq:adRadio;Weight:0;Cost:1), {mcRadar} 794 (Domains:2;Preq:adCombustionEngine;Weight:2;Cost:1), {mcSub} 795 (Domains:3;Preq:adBallistics;Weight:1;Cost:1), {mcArtillery} 796 (Domains:1;Preq:adTactics;Weight:2;Cost:1), {mcAlpine} 797 (Domains:2;Preq:adMedicine;Weight:1;Cost:1), {mcSupplyShip} 798 (Domains:1;Preq:adBridgeBuilding;Weight:0;Cost:2), {mcOver} 799 (Domains:2;Preq:adAdvancedRocketry;Weight:1;Cost:1), {mcAirDef} 800 (Domains:4;Preq:adIntelligence;Weight:2;Cost:1), {mcSpy} 801 (Domains:2;Preq:adSteamEngine;Weight:0;Cost:0), {mcSE} 802 (Domains:2;Preq:adNuclearPower;Weight:0;Cost:0), {mcNP} 803 (Domains:4;Preq:adRocketry;Weight:0;Cost:0), {mcJet} 804 (Domains:4;Preq:adStealth;Weight:1;Cost:2), {mcStealth} 805 (Domains:5;Preq:adCommunism;Weight:0;Cost:1), {mcFanatic} 806 (Domains:1;Preq:preSun;Weight:0;Cost:1), {mcFirst} 807 (Domains:1;Preq:preSun;Weight:0;Cost:1), {mcWill} 808 (Domains:1;Preq:preSun;Weight:0;Cost:0), {mcAcademy} 809 (Domains:7;Preq:adMassProduction;Weight:0;Cost:0)); {mcLine} 810 811 WeightPreq7: array[0..nDomains-1] of integer= 812 (adHorsebackRiding,adSeafaring,adAdvancedFlight); 813 WeightPreq10: array[0..nDomains-1] of integer= 814 (adAutomobile,adSteel,preNA); 815 816 INFIN=999999; 817 1104 nUpgrade = 15; 1105 upgrade: 1106 array [0 .. nDomains - 1, 0 .. nUpgrade - 1] of record Preq, Strength, Trans, 1107 Cost: integer 1108 end 1109 = (((Preq: adWarriorCode; Strength: 4; Trans: 0; 1110 Cost: 3), (Preq: adBronzeWorking; Strength: 2; Trans: 0; 1111 Cost: 4), (Preq: adIronWorking; Strength: 2; Trans: 0; 1112 Cost: 5), (Preq: adChivalry; Strength: 2; Trans: 0; 1113 Cost: 5), (Preq: adMonotheism; Strength: 3; Trans: 0; 1114 Cost: 7), (Preq: adGunpowder; Strength: 3; Trans: 0; 1115 Cost: 8), (Preq: adExplosives; Strength: 4; Trans: 0; 1116 Cost: 9), (Preq: adTactics; Strength: 5; Trans: 0; Cost: 10), (Preq: adRadio; 1117 Strength: 6; Trans: 0; Cost: 11), (Preq: adDemocracy; Strength: 6; Trans: 0; 1118 Cost: 5), (Preq: adMobileWarfare; Strength: 7; Trans: 0; 1119 Cost: 12), (Preq: adRobotics; Strength: 8; Trans: 0; 1120 Cost: 15), (Preq: adComposites; Strength: 8; Trans: 0; 1121 Cost: 15), (Preq: adTheLaser; Strength: 8; Trans: 0; 1122 Cost: 14), (Preq: futMaterialTechnology; Strength: 10; Trans: 0; Cost: 2)), 1123 ((Preq: adMapMaking; Strength: 4; Trans: 1; Cost: 8), (Preq: adNavigation; 1124 Strength: 4; Trans: 0; Cost: 10), (Preq: adEngineering; Strength: 0; Trans: 1; 1125 Cost: 8), (Preq: adGunpowder; Strength: 8; Trans: 0; 1126 Cost: 12), (Preq: adMagnetism; Strength: 12; Trans: 1; 1127 Cost: 20), (Preq: adExplosives; Strength: 16; Trans: 0; 1128 Cost: 24), (Preq: adSteamEngine; Strength: 24; Trans: 0; 1129 Cost: 28), (Preq: adAmphibiousWarfare; Strength: 24; Trans: 1; 1130 Cost: 18), (Preq: adAdvancedRocketry; Strength: 32; Trans: 0; 1131 Cost: 38), (Preq: futMaterialTechnology; Strength: 14; Trans: 0; 1132 Cost: 4), (Preq: futArtificialIntelligence; Strength: 14; Trans: 0; 1133 Cost: 4), (Preq: preNA), (Preq: preNA), (Preq: preNA), (Preq: preNA)), 1134 ((Preq: adFlight; Strength: 12; Trans: 1; Cost: 14), (Preq: adTactics; 1135 Strength: 6; Trans: 0; Cost: 17), (Preq: adElectronics; Strength: 6; Trans: 0; 1136 Cost: 20), (Preq: adMin; Strength: 8; Trans: 0; Cost: 24), 1137 (Preq: adComposites; Strength: 8; Trans: 0; Cost: 26), (Preq: adSmartWeapons; 1138 Strength: 11; Trans: 0; Cost: 32), (Preq: futArtificialIntelligence; 1139 Strength: 7; Trans: 0; Cost: 4), (Preq: preNA), (Preq: preNA), (Preq: preNA), 1140 (Preq: preNA), (Preq: preNA), (Preq: preNA), (Preq: preNA), (Preq: preNA))); 1141 1142 { model features } 1143 nFeature = 27; 1144 mcWeapons = 0; 1145 mcArmor = 1; 1146 mcMob = 2; 1147 mcSeaTrans = 3; 1148 mcCarrier = 4; 1149 mcTurbines = 5; 1150 mcBombs = 6; 1151 mcFuel = 7; 1152 mcAirTrans = 8; 1153 mcNav = 9; 1154 mcRadar = 10; 1155 mcSub = 11; 1156 mcArtillery = 12; 1157 mcAlpine = 13; 1158 mcSupplyShip = 14; 1159 mcOver = 15; 1160 mcAirDef = 16; 1161 mcSpy = 17; 1162 mcSE = 18; 1163 mcNP = 19; 1164 mcJet = 20; 1165 mcStealth = 21; 1166 mcFanatic = 22; 1167 mcFirst = 23; 1168 mcWill = 24; 1169 mcAcademy = 25; 1170 mcLine = 26; 1171 mcFirstNonCap = mcNav; 1172 AutoFeature: 1173 Set of mcFirstNonCap .. nFeature - 1 = [mcNav, mcSE, mcNP, mcJet, mcAcademy]; 1174 // unit class advances, automatically applied if available 1175 1176 Feature: 1177 array [0 .. nFeature - 1] of { unit model features } 1178 record Domains, Preq, Weight, Cost: integer; 1179 end 1180 = ((Domains: 7; Preq: preNone; Weight: 1; Cost: 1), { mcOffense } 1181 (Domains: 7; Preq: preNone; Weight: 1; Cost: 1), { mcDefense } 1182 (Domains: 1; Preq: adHorsebackRiding; Weight: 1; Cost: 1), { mcMob } 1183 (Domains: 2; Preq: preNone; Weight: 2; Cost: 1), { mcSeaTrans } 1184 (Domains: 2; Preq: adAdvancedFlight; Weight: 2; Cost: 2), { mcCarrier } 1185 (Domains: 2; Preq: adPhysics; Weight: 3; Cost: 1), { mcTurbines } 1186 (Domains: 4; Preq: adAdvancedFlight; Weight: 1; Cost: 1), { mcBombs } 1187 (Domains: 4; Preq: preNone; Weight: 1; Cost: 1), { mcFuel } 1188 (Domains: 4; Preq: adCombinedArms; Weight: 2; Cost: 1), { mcAirTrans } 1189 (Domains: 2; Preq: adNavigation; Weight: 0; Cost: 0), { mcNav } 1190 (Domains: 2; Preq: adRadio; Weight: 0; Cost: 1), { mcRadar } 1191 (Domains: 2; Preq: adCombustionEngine; Weight: 2; Cost: 1), { mcSub } 1192 (Domains: 3; Preq: adBallistics; Weight: 1; Cost: 1), { mcArtillery } 1193 (Domains: 1; Preq: adTactics; Weight: 2; Cost: 1), { mcAlpine } 1194 (Domains: 2; Preq: adMedicine; Weight: 1; Cost: 1), { mcSupplyShip } 1195 (Domains: 1; Preq: adBridgeBuilding; Weight: 0; Cost: 2), { mcOver } 1196 (Domains: 2; Preq: adAdvancedRocketry; Weight: 1; Cost: 1), { mcAirDef } 1197 (Domains: 4; Preq: adIntelligence; Weight: 2; Cost: 1), { mcSpy } 1198 (Domains: 2; Preq: adSteamEngine; Weight: 0; Cost: 0), { mcSE } 1199 (Domains: 2; Preq: adNuclearPower; Weight: 0; Cost: 0), { mcNP } 1200 (Domains: 4; Preq: adRocketry; Weight: 0; Cost: 0), { mcJet } 1201 (Domains: 4; Preq: adStealth; Weight: 1; Cost: 2), { mcStealth } 1202 (Domains: 5; Preq: adCommunism; Weight: 0; Cost: 1), { mcFanatic } 1203 (Domains: 1; Preq: preSun; Weight: 0; Cost: 1), { mcFirst } 1204 (Domains: 1; Preq: preSun; Weight: 0; Cost: 1), { mcWill } 1205 (Domains: 1; Preq: preSun; Weight: 0; Cost: 0), { mcAcademy } 1206 (Domains: 7; Preq: adMassProduction; Weight: 0; Cost: 0)); { mcLine } 1207 1208 WeightPreq7: 1209 array [0 .. nDomains - 1] of integer = (adHorsebackRiding, adSeafaring, 1210 adAdvancedFlight); 1211 WeightPreq10: 1212 array [0 .. nDomains - 1] of integer = (adAutomobile, adSteel, preNA); 1213 1214 INFIN = 999999; 818 1215 819 1216 // for backward compatibility 820 fRare=fDeadLands;fRare1=fCobalt;fRare2=fUranium; 821 mkCaravan=mkFreight;mkDiplomat=mkCommando; 822 gLybertarianism=gFuture; 823 trCeaseFire=1; 824 adIntelligenArms=adSmartWeapons;adIntelligentArms=adSmartWeapons; 825 adRadioCommunication=adRadio;adLybertarianism=adInternet; 826 futResearchTechnology=futComputingTechnology; 827 futProductionTechnology=futNanoTechnology; 828 futArmorTechnology=futMaterialTechnology; 829 futMissileTechnology=futArtificialIntelligence; 830 imNatObs=imObservatory;imElite=imMilAcademy; 831 mcOffense=mcWeapons;mcDefense=mcArmor;mcLongRange=mcArtillery; 832 mcHospital=mcSupplyShip; 833 1217 fRare = fDeadLands; 1218 fRare1 = fCobalt; 1219 fRare2 = fUranium; 1220 mkCaravan = mkFreight; 1221 mkDiplomat = mkCommando; 1222 gLybertarianism = gFuture; 1223 trCeaseFire = 1; 1224 adIntelligenArms = adSmartWeapons; 1225 adIntelligentArms = adSmartWeapons; 1226 adRadioCommunication = adRadio; 1227 adLybertarianism = adInternet; 1228 futResearchTechnology = futComputingTechnology; 1229 futProductionTechnology = futNanoTechnology; 1230 futArmorTechnology = futMaterialTechnology; 1231 futMissileTechnology = futArtificialIntelligence; 1232 imNatObs = imObservatory; 1233 imElite = imMilAcademy; 1234 mcOffense = mcWeapons; 1235 mcDefense = mcArmor; 1236 mcLongRange = mcArtillery; 1237 mcHospital = mcSupplyShip; 834 1238 835 1239 type 836 TServerCall=function(Command,Player,Subject:integer;var Data): integer; stdcall; 837 TClientCall=procedure(Command,Player:integer;var Data); stdcall; 838 839 TUn=packed record 840 Loc, {location} 841 Status, // free for AI use 842 SavedStatus: LongInt; // for server internal use only 843 ID: word; // unit number, never changes, unique within this nation 844 mix, {model index} 845 Home, {home city index, -1 if none} 846 Master, {index of transporting unit, -1 if none} 847 Movement: SmallInt; {movement left for this turn} 848 Health, // = 100-Damage 849 Fuel: ShortInt; 850 Job, {current terrain improvement job} 851 Exp, {micro experience, the level is Exp div ExpCost} 852 TroopLoad, {number of transported ground units} 853 AirLoad: Byte; //number of transported air units 854 Flags: Cardinal; 1240 TServerCall = function(Command, Player, Subject: integer; var Data) 1241 : integer; stdcall; 1242 TClientCall = procedure(Command, Player: integer; var Data); stdcall; 1243 1244 TUn = packed record 1245 Loc, { location } 1246 Status, // free for AI use 1247 SavedStatus: LongInt; // for server internal use only 1248 ID: word; // unit number, never changes, unique within this nation 1249 mix, { model index } 1250 Home, { home city index, -1 if none } 1251 Master, { index of transporting unit, -1 if none } 1252 Movement: SmallInt; { movement left for this turn } 1253 Health, // = 100-Damage 1254 Fuel: ShortInt; 1255 Job, { current terrain improvement job } 1256 Exp, { micro experience, the level is Exp div ExpCost } 1257 TroopLoad, { number of transported ground units } 1258 AirLoad: Byte; // number of transported air units 1259 Flags: Cardinal; 855 1260 end; 856 1261 857 TCity=packed record 858 Loc, {location} 859 Status, // free for AI use 860 SavedStatus: LongInt; // for server internal use only 861 ID, // founding player shl 12 + number, never changes, unique within the whole game 862 Size: word; 863 Project, // current production project, see city project flags 864 Project0, // for server use only 865 Food, //collected food in storage 866 Pollution, //collected pollution in dump 867 Prod, //for project collected production points 868 Prod0: SmallInt; //for project collected production points in the beginning of the turn 869 Flags, //what happened within the last turnaround 870 Tiles, {currently by city exploited tiles, bitset with index 871 (dy+3) shl 2+(dx+3) shr 1, (dx,dy) relative to central tile} 872 N1: Cardinal; // reserved for future use 873 Built: array[0..(nImp+3) div 4 *4 -1] of ShortInt; //array value =1 indicates built improvement 1262 TCity = packed record 1263 Loc, { location } 1264 Status, // free for AI use 1265 SavedStatus: LongInt; // for server internal use only 1266 ID, // founding player shl 12 + number, never changes, unique within the whole game 1267 Size: word; 1268 Project, // current production project, see city project flags 1269 Project0, // for server use only 1270 Food, // collected food in storage 1271 Pollution, // collected pollution in dump 1272 Prod, // for project collected production points 1273 Prod0: SmallInt; 1274 // for project collected production points in the beginning of the turn 1275 Flags, // what happened within the last turnaround 1276 Tiles, { currently by city exploited tiles, bitset with index 1277 (dy+3) shl 2+(dx+3) shr 1, (dx,dy) relative to central tile } 1278 N1: Cardinal; // reserved for future use 1279 Built: array [0 .. (nImp + 3) div 4 * 4 - 1] of ShortInt; 1280 // array value =1 indicates built improvement 874 1281 end; 875 1282 876 TModel=packed record 877 Status, // free for AI use 878 SavedStatus: LongInt; // for server internal use only 879 ID, // developing player shl 12 + number, never changes, unique within the whole game 880 IntroTurn, 881 Built, //units built with this model 882 Lost: word; //units of this model lost in combat 883 Kind, 884 Domain: Byte; 885 Attack, 886 Defense, 887 Speed, 888 Cost, 889 MStrength: word; // construction time multipliers, only valid if kind is mkSelfDeveloped or mkEnemyDeveloped 890 MTrans, 891 MCost, 892 Weight, MaxWeight: Byte; // weight and maximum weight (construction time) 893 Upgrades, //bitarray indicating all upgrades 894 Flags: Cardinal; 895 Cap: array [0..(nFeature+3) div 4 *4 -1] of Byte; //special features 1283 TModel = packed record 1284 Status, // free for AI use 1285 SavedStatus: LongInt; // for server internal use only 1286 ID, // developing player shl 12 + number, never changes, unique within the whole game 1287 IntroTurn, Built, // units built with this model 1288 Lost: word; // units of this model lost in combat 1289 Kind, Domain: Byte; 1290 Attack, Defense, Speed, Cost, MStrength: word; 1291 // construction time multipliers, only valid if kind is mkSelfDeveloped or mkEnemyDeveloped 1292 MTrans, MCost, Weight, MaxWeight: Byte; 1293 // weight and maximum weight (construction time) 1294 Upgrades, // bitarray indicating all upgrades 1295 Flags: Cardinal; 1296 Cap: array [0 .. (nFeature + 3) div 4 * 4 - 1] of Byte; // special features 896 1297 end; 897 1298 898 TUnitInfo=packed record 899 Loc: LongInt; 900 mix, // index of unit model for its owner 901 emix: word; // index in enemy model list 902 Owner: Byte; 903 Health, // = 100-Damage 904 Fuel: ShortInt; 905 Job, //current terrain improvement job 906 Exp, {micro experience, the level is Exp div ExpCost} 907 Load: Byte; {number of transported units} 908 Flags: word 1299 TUnitInfo = packed record 1300 Loc: LongInt; 1301 mix, // index of unit model for its owner 1302 emix: word; // index in enemy model list 1303 Owner: Byte; 1304 Health, // = 100-Damage 1305 Fuel: ShortInt; 1306 Job, // current terrain improvement job 1307 Exp, { micro experience, the level is Exp div ExpCost } 1308 Load: Byte; { number of transported units } 1309 Flags: word end; 1310 1311 TCityInfo = packed record Loc, Status, // free for AI use 1312 SavedStatus: LongInt; // for server internal use only 1313 Owner, // last known owner, even if not alive anymore! 1314 ID, // founding player <<12 + number, never changes, unique within the whole game 1315 Size, Flags: word; 909 1316 end; 910 1317 911 TCityInfo=packed record 912 Loc, 913 Status, // free for AI use 914 SavedStatus: LongInt; // for server internal use only 915 Owner, // last known owner, even if not alive anymore! 916 ID, // founding player <<12 + number, never changes, unique within the whole game 917 Size, 918 Flags: word; 1318 TModelInfo = packed record 1319 Owner, // Player which owns the model 1320 mix, // index of unit model for its owner 1321 ID: word; // developing player shl 12 + number, never changes, unique within the whole game 1322 Kind, Domain: Byte; 1323 Attack, Defense, Speed, Cost: word; 1324 TTrans, // ground unit transport capability 1325 ATrans_Fuel: Byte; // air unit transport capability resp. fuel 1326 Bombs: word; // additional attack with bombs 1327 Cap: Cardinal; // special features, bitset with index Feature-mcFirstNonCap 1328 MaxUpgrade, // maximum used upgrade 1329 Weight: Byte; 1330 Lost: word; 919 1331 end; 920 1332 921 TModelInfo=packed record 922 Owner, //Player which owns the model 923 mix, //index of unit model for its owner 924 ID: word; // developing player shl 12 + number, never changes, unique within the whole game 925 Kind, 926 Domain: Byte; 927 Attack, 928 Defense, 929 Speed, 930 Cost: word; 931 TTrans, //ground unit transport capability 932 ATrans_Fuel: Byte; //air unit transport capability resp. fuel 933 Bombs: word; //additional attack with bombs 934 Cap: Cardinal; //special features, bitset with index Feature-mcFirstNonCap 935 MaxUpgrade, //maximum used upgrade 936 Weight: Byte; 937 Lost: word; 1333 TBattle = packed record 1334 Enemy, Flags: Byte; 1335 Turn, mix, mixEnemy: word; 1336 ToLoc, FromLoc: integer; 938 1337 end; 939 1338 940 TBattle=packed record 941 Enemy, Flags: byte; 942 Turn, mix, mixEnemy: word; 943 ToLoc, FromLoc: integer; 1339 TWonderInfo = record 1340 CityID, // -2 if destroyed, -1 if never completed, >=0 ID of city 1341 EffectiveOwner: integer 1342 // owning player if effective, -1 if expired or not built 1343 end; 1344 1345 TShipInfo = record Parts: array [0 .. nShipPart - 1] of integer; 944 1346 end; 945 1347 946 TWonderInfo=record 947 CityID, // -2 if destroyed, -1 if never completed, >=0 ID of city 948 EffectiveOwner: integer // owning player if effective, -1 if expired or not built 949 end; 950 951 TShipInfo=record 952 Parts: array[0..nShipPart-1] of integer; 953 end; 954 955 TEnemyReport=record 956 TurnOfContact, TurnOfCivilReport, TurnOfMilReport, 957 Attitude, 958 Credibility: integer; // 0..100, last update: ToC 959 Treaty: array[0..nPl-1] of integer; 1348 TEnemyReport = record 1349 TurnOfContact, TurnOfCivilReport, TurnOfMilReport, Attitude, 1350 Credibility: integer; // 0..100, last update: ToC 1351 Treaty: array [0 .. nPl - 1] of integer; 960 1352 // diplomatic status with other nations, last update: ToCR 961 Government, // gAnarchy..gDemocracy, last update: ToCR962 Money, // last update: ToCR963 ResearchTech, ResearchDone: integer; // last update: ToCR964 Tech: array[0..(nAdv+3) div 4 *4 -1] of ShortInt;1353 Government, // gAnarchy..gDemocracy, last update: ToCR 1354 Money, // last update: ToCR 1355 ResearchTech, ResearchDone: integer; // last update: ToCR 1356 Tech: array [0 .. (nAdv + 3) div 4 * 4 - 1] of ShortInt; 965 1357 // tech status indicator, last update: ToCR 966 nModelCounted: integer;1358 nModelCounted: integer; 967 1359 // number of models with info in UnCount, last update: ToMR 968 UnCount: array[0..INFIN] of word;1360 UnCount: array [0 .. INFIN] of word; 969 1361 // number of available units for each model, last update: ToMR 970 1362 end; 971 1363 972 TMoveAdviceData=record973 ToLoc,nStep,MoreTurns,MaxHostile_MovementLeft: integer;974 dx,dy: array[0..24] of integer;1364 TMoveAdviceData = record 1365 ToLoc, nStep, MoreTurns, MaxHostile_MovementLeft: integer; 1366 dx, dy: array [0 .. 24] of integer; 975 1367 end; 976 TPlaneReturnData=record 977 Loc,Fuel,Movement: integer; 1368 1369 TPlaneReturnData = record 1370 Loc, Fuel, Movement: integer; 978 1371 end; 979 TTileInfo=record 980 Food,Prod,Trade,ExplCity:integer 1372 1373 TTileInfo = record 1374 Food, Prod, Trade, ExplCity: integer end; 1375 TCityReport = record HypoTiles, HypoTax, HypoLux, Working, Happy, FoodRep, 1376 ProdRep, Trade, PollRep, Corruption, Tax, Lux, Science, Support, Eaten, 1377 ProdCost, Storage, Deployed: integer; 981 1378 end; 982 TCityReport=record 983 HypoTiles,HypoTax,HypoLux,Working,Happy,FoodRep,ProdRep,Trade,PollRep, 984 Corruption,Tax,Lux,Science,Support,Eaten,ProdCost,Storage,Deployed:integer; 1379 1380 TCityReportNew = record 1381 HypoTiles, 1382 // tiles that should be considered as exploited (for the current adjustment, set this to -1 or to TCity.Tiles of the city) 1383 HypoTaxRate, HypoLuxuryRate, 1384 // tax and luxury rate that should be assumed (for current rates, set this to -1 or to RO.TaxRate resp. RO.LuxRate) 1385 Morale, FoodSupport, MaterialSupport, 1386 // food and material taken for unit support 1387 ProjectCost, // material cost of current project 1388 Storage, // size of food storage 1389 Deployed, // number of units causing unrest (unrest=2*deployed) 1390 CollectedControl, CollectedFood, CollectedMaterial, CollectedTrade, 1391 // raw control, food, material and trade as collected by the citizens 1392 Working, // number of exploited tiles including city tile 1393 FoodSurplus, Production, AddPollution, 1394 // food surplus, production gain and pollution after all effects 1395 Corruption, Tax, Science, Luxury, 1396 // corruption, tax, science and wealth after all effects 1397 HappinessBalance: integer; 1398 // = (Morale+Wealth+Control) - (Size+Unrest), value < 0 means disorder 985 1399 end; 986 TCityReportNew=record 987 HypoTiles, // tiles that should be considered as exploited (for the current adjustment, set this to -1 or to TCity.Tiles of the city) 988 HypoTaxRate,HypoLuxuryRate, // tax and luxury rate that should be assumed (for current rates, set this to -1 or to RO.TaxRate resp. RO.LuxRate) 989 Morale, 990 FoodSupport,MaterialSupport, // food and material taken for unit support 991 ProjectCost, // material cost of current project 992 Storage, // size of food storage 993 Deployed, // number of units causing unrest (unrest=2*deployed) 994 CollectedControl,CollectedFood,CollectedMaterial,CollectedTrade, // raw control, food, material and trade as collected by the citizens 995 Working, // number of exploited tiles including city tile 996 FoodSurplus,Production,AddPollution, // food surplus, production gain and pollution after all effects 997 Corruption,Tax,Science,Luxury, // corruption, tax, science and wealth after all effects 998 HappinessBalance: integer; // = (Morale+Wealth+Control) - (Size+Unrest), value < 0 means disorder 1400 1401 TCityTileAdviceData = record 1402 ResourceWeights, Tiles: Cardinal; 1403 CityReport: TCityReport; 999 1404 end; 1000 TCityTileAdviceData=record 1001 ResourceWeights, Tiles: cardinal; 1002 CityReport: TCityReport; 1405 1406 TGetCityData = record 1407 Owner: integer; 1408 c: TCity end; 1409 TCityAreaInfo = record Available: array [0 .. 26] of integer; 1003 1410 end; 1004 TGetCityData=record 1005 Owner: integer;1006 c: TCity1411 1412 TUnitReport = record 1413 FoodSupport, ProdSupport, ReportFlags: integer; 1007 1414 end; 1008 TCityAreaInfo=record 1009 Available: array [0..26] of integer; 1010 end; 1011 TUnitReport=record 1012 FoodSupport, ProdSupport, ReportFlags: integer; 1013 end; 1014 TJobProgressData=array[0..nJob-1] of record 1015 Required, Done, NextTurnPlus: integer; 1016 end; 1017 TBattleForecast=record 1018 pAtt,mixAtt,HealthAtt,ExpAtt,FlagsAtt,Movement,EndHealthDef, 1019 EndHealthAtt: integer; 1020 end; 1021 TBattleForecastEx=record 1022 pAtt,mixAtt,HealthAtt,ExpAtt,FlagsAtt,Movement,EndHealthDef, 1023 EndHealthAtt: integer; // must be same as in TBattleForecast 1024 AStr,DStr,ABaseDamage,DBaseDamage: integer; 1025 end; 1026 TShowMove=record 1027 Owner,Health,mix,emix,Flags,FromLoc,dx,dy,EndHealth,EndHealthDef, 1028 Fuel,Exp,Load: integer; 1029 end; 1030 TShowShipChange=record 1031 Reason, Ship1Owner, Ship2Owner: integer; 1032 Ship1Change, Ship2Change: array[0..nShipPart-1] of integer; 1033 end; 1034 TOffer=record 1035 nDeliver, nCost: integer; 1036 Price: array[0..11] of Cardinal; 1037 end; 1038 TChart=array [0..INFIN] of integer; 1039 TEditTileData=record 1040 Loc, NewTile: integer 1041 end; 1042 TCreateUnitData=record 1043 Loc, p, mix: integer; 1044 end; 1045 1046 TTileList= array[0..INFIN] of Cardinal; 1047 TTileObservedLastList= array[0..INFIN] of SmallInt; 1048 TOwnerList= array[0..INFIN] of ShortInt; 1049 TByteList= array[0..INFIN] of Byte; 1050 TIntList=array[0..INFIN] of integer; 1051 TCityList= array[0..INFIN] of TCity; 1052 TUnList= array[0..INFIN] of TUn; 1053 TModelList= array[0..INFIN] of TModel; 1054 TEnemyUnList=array[0..INFIN] of TUnitInfo; 1055 TEnemyCityList=array[0..INFIN] of TCityInfo; 1056 TEnemyModelList=array[0..INFIN] of TModelInfo; 1057 TBattleList=array[0..INFIN] of TBattle; 1058 1059 TPlayerContext=record 1060 Data: pointer; 1061 Map:^TTileList; {the playground, a list of tiles with index = location, see tile flags} 1062 MapObservedLast:^TTileObservedLastList; 1063 // turn in which the tile was observed last, index = location 1064 Territory:^TOwnerList; // nation to which's territory a tile belongs, -1 indicates none 1065 Un:^TUnList; {units} 1066 City:^TCityList; {cities} 1067 Model:^TModelList; {unit models} 1068 EnemyUn:^TEnemyUnList; //known units of enemy players 1069 EnemyCity:^TEnemyCityList; //known cities of enemy players 1070 EnemyModel:^TEnemyModelList; //known unit models of enemy players 1071 EnemyReport: array[0..nPl-1] of ^TEnemyReport; 1072 1073 TestFlags, //options turned on in the "Manipulation" menu 1074 Turn, //current turn 1075 Alive, {bitset of IDs of players still alive, flag 1 shl p for player p} 1076 Happened, //flags indicate what happened within the last turnaround 1077 AnarchyStart, // start turn of anarchy, <0 if not in anarchy 1078 Credibility, // own credibility 1079 MaxCredibility, // maximum credibility still to achieve 1080 nUn, {number of units} 1081 nCity, {number of cities} 1082 nModel, {number of developed unit models} 1083 nEnemyUn,nEnemyCity,nEnemyModel, 1084 Government, {gAnarchy..gDemocracy} 1085 Money,TaxRate,LuxRate, 1086 Research, {collected research points for currently researched tech} 1087 ResearchTech: integer; //currently researched tech 1088 DevModel: TModel; {unit model currently under development} 1089 Tech: array[0..(nAdv+3) div 4 *4 -1] of ShortInt; {tech status indicator} 1090 Attitude: array[0..nPl-1] of integer; // attitude to other nations 1091 Treaty: array[0..nPl-1] of integer; // treaty with other nations 1092 EvaStart: array[0..nPl-1] of integer; // peace treaty: start of evacuation period 1093 Tribute: array[0..nPl-1] of integer; // no longer in use 1094 TributePaid: array[0..nPl-1] of integer; // no longer in use 1095 Wonder: array[0..27] of TWonderInfo; 1096 Ship: array[0..nPl-1] of TShipInfo; 1097 NatBuilt: array[28..(nImp+3) div 4 *4 -1] of ShortInt; 1098 nBattleHistory: integer; 1099 BattleHistory:^TBattleList; // complete list of all my battles in the whole game 1100 BorderHelper:^TByteList; 1101 LastCancelTreaty: array[0..nPl-1] of integer; // turn of last treaty cancel 1102 OracleIncome: integer; 1103 DefaultDebugMap:^TIntList; 1104 Filler: array[0..879] of byte; 1105 end; 1106 1107 TInitModuleData=record 1108 Server: TServerCall; 1109 DataVersion, DataSize, Flags: integer; 1110 end; 1111 TNewGameData=record 1112 lx,ly,LandMass,MaxTurn: integer; 1113 Difficulty: array[0..nPl-1] of integer; 1114 {difficulty levels of the players, if it's 0 this player is the supervisor, 1115 -1 for unused slots} 1116 RO: array[0..nPl-1] of ^TPlayerContext; 1117 AssemblyPath: array[0..255] of char; 1118 SuperVisorRO: array[0..nPl-1] of ^TPlayerContext; 1119 end; 1120 TNewGameExData=record 1121 lx,ly,LandMass,MaxTurn,RND: integer; 1122 Difficulty: array[0..nPl-1] of integer; 1123 {difficulty levels of the players, if it's 0 this player is the supervisor, 1124 -1 for unused slots} 1125 Controlled: integer; 1126 end; 1127 TShowNegoData=record 1128 pSender, pTarget, Action: integer; 1129 Offer: TOffer; 1130 end; 1415 1416 TJobProgressData = array [0 .. nJob - 1] of record Required, Done, 1417 NextTurnPlus: integer; 1418 end; 1419 TBattleForecast = record pAtt, mixAtt, HealthAtt, ExpAtt, FlagsAtt, Movement, 1420 EndHealthDef, EndHealthAtt: integer; 1421 end; 1422 TBattleForecastEx = record pAtt, mixAtt, HealthAtt, ExpAtt, FlagsAtt, Movement, 1423 EndHealthDef, EndHealthAtt: integer; // must be same as in TBattleForecast 1424 AStr, DStr, ABaseDamage, DBaseDamage: integer; 1425 end; 1426 TShowMove = record Owner, Health, mix, emix, Flags, FromLoc, dx, dy, EndHealth, 1427 EndHealthDef, Fuel, Exp, Load: integer; 1428 end; 1429 TShowShipChange = record Reason, Ship1Owner, Ship2Owner: integer; 1430 Ship1Change, Ship2Change: array [0 .. nShipPart - 1] of integer; 1431 end; 1432 TOffer = record nDeliver, nCost: integer; 1433 Price: 1434 array [0 .. 11] of Cardinal; 1435 end; 1436 TChart = array [0 .. INFIN] of integer; 1437 TEditTileData = record Loc, NewTile: integer 1438 end; 1439 TCreateUnitData = record Loc, p, mix: integer; 1440 end; 1441 1442 TTileList = array [0 .. INFIN] of Cardinal; 1443 TTileObservedLastList = array [0 .. INFIN] of SmallInt; 1444 TOwnerList = array [0 .. INFIN] of ShortInt; 1445 TByteList = array [0 .. INFIN] of Byte; 1446 TIntList = array [0 .. INFIN] of integer; 1447 TCityList = array [0 .. INFIN] of TCity; 1448 TUnList = array [0 .. INFIN] of TUn; 1449 TModelList = array [0 .. INFIN] of TModel; 1450 TEnemyUnList = array [0 .. INFIN] of TUnitInfo; 1451 TEnemyCityList = array [0 .. INFIN] of TCityInfo; 1452 TEnemyModelList = array [0 .. INFIN] of TModelInfo; 1453 TBattleList = array [0 .. INFIN] of TBattle; 1454 1455 TPlayerContext = record Data: pointer; 1456 Map: 1457 ^TTileList; 1458 { the playground, a list of tiles with index = location, see tile flags } 1459 MapObservedLast: 1460 ^TTileObservedLastList; 1461 // turn in which the tile was observed last, index = location 1462 Territory: 1463 ^TOwnerList; // nation to which's territory a tile belongs, -1 indicates none 1464 Un: 1465 ^TUnList; { units } 1466 City: 1467 ^TCityList; { cities } 1468 Model: 1469 ^TModelList; { unit models } 1470 EnemyUn: 1471 ^TEnemyUnList; // known units of enemy players 1472 EnemyCity: 1473 ^TEnemyCityList; // known cities of enemy players 1474 EnemyModel: 1475 ^TEnemyModelList; // known unit models of enemy players 1476 EnemyReport: 1477 array [0 .. nPl - 1] of ^TEnemyReport; 1478 1479 TestFlags, // options turned on in the "Manipulation" menu 1480 Turn, // current turn 1481 Alive, { bitset of IDs of players still alive, flag 1 shl p for player p } 1482 Happened, // flags indicate what happened within the last turnaround 1483 AnarchyStart, // start turn of anarchy, <0 if not in anarchy 1484 Credibility, // own credibility 1485 MaxCredibility, // maximum credibility still to achieve 1486 nUn, { number of units } 1487 nCity, { number of cities } 1488 nModel, { number of developed unit models } 1489 nEnemyUn, nEnemyCity, nEnemyModel, Government, { gAnarchy..gDemocracy } 1490 Money, TaxRate, LuxRate, Research, 1491 { collected research points for currently researched tech } 1492 ResearchTech: integer; // currently researched tech 1493 DevModel: 1494 TModel; { unit model currently under development } 1495 Tech: 1496 array [0 .. (nAdv + 3) div 4 * 4 - 1] of ShortInt; { tech status indicator } 1497 Attitude: 1498 array [0 .. nPl - 1] of integer; // attitude to other nations 1499 Treaty: 1500 array [0 .. nPl - 1] of integer; // treaty with other nations 1501 EvaStart: 1502 array [0 .. nPl - 1] of integer; // peace treaty: start of evacuation period 1503 Tribute: 1504 array [0 .. nPl - 1] of integer; // no longer in use 1505 TributePaid: 1506 array [0 .. nPl - 1] of integer; // no longer in use 1507 Wonder: 1508 array [0 .. 27] of TWonderInfo; 1509 Ship: 1510 array [0 .. nPl - 1] of TShipInfo; 1511 NatBuilt: 1512 array [28 .. (nImp + 3) div 4 * 4 - 1] of ShortInt; 1513 nBattleHistory: 1514 integer; 1515 BattleHistory: 1516 ^TBattleList; // complete list of all my battles in the whole game 1517 BorderHelper: 1518 ^TByteList; 1519 LastCancelTreaty: 1520 array [0 .. nPl - 1] of integer; // turn of last treaty cancel 1521 OracleIncome: 1522 integer; 1523 DefaultDebugMap: 1524 ^TIntList; 1525 Filler: 1526 array [0 .. 879] of Byte; 1527 end; 1528 1529 TInitModuleData = record Server: TServerCall; 1530 DataVersion, DataSize, Flags: integer; 1531 end; 1532 TNewGameData = record lx, ly, LandMass, MaxTurn: integer; 1533 Difficulty: 1534 array [0 .. nPl - 1] of integer; 1535 { difficulty levels of the players, if it's 0 this player is the supervisor, 1536 -1 for unused slots } 1537 RO: 1538 array [0 .. nPl - 1] of ^TPlayerContext; 1539 AssemblyPath: 1540 array [0 .. 255] of char; 1541 SuperVisorRO: 1542 array [0 .. nPl - 1] of ^TPlayerContext; 1543 end; 1544 TNewGameExData = record lx, ly, LandMass, MaxTurn, RND: integer; 1545 Difficulty: 1546 array [0 .. nPl - 1] of integer; 1547 { difficulty levels of the players, if it's 0 this player is the supervisor, 1548 -1 for unused slots } 1549 Controlled: 1550 integer; 1551 end; 1552 TShowNegoData = record pSender, pTarget, Action: integer; 1553 Offer: 1554 TOffer; 1555 end; 1131 1556 1132 1557 const 1133 {predefined unit models:} 1134 nSpecialModel=9; 1135 SpecialModel: array[0..nSpecialModel-1] of TModel= 1136 ((Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1137 Kind:mkSettler;Domain:dGround;Attack:0;Defense:10;Speed:150;Cost:40; 1138 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1139 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), {Settlers} 1140 (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1141 Kind:mkSettler;Domain:dGround;Attack:0;Defense:20;Speed:300;Cost:40; 1142 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1143 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), {Engineers} 1144 (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1145 Kind:mkSelfDeveloped;Domain:dGround;Attack:6;Defense:6;Speed:150;Cost:10; 1146 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1147 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), {Militia} 1148 (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1149 Kind:mkSpecial_TownGuard;Domain:dGround;Attack:4;Defense:6;Speed:150;Cost:20; 1150 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1151 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), {Town Guard} 1152 (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1153 Kind:mkDiplomat;Domain:dGround;Attack:12;Defense:12;Speed:250;Cost:20; 1154 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1155 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), {Special Commando} 1156 (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1157 Kind:mkCaravan;Domain:dGround;Attack:0;Defense:6;Speed:150;Cost:60; 1158 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1159 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), {Freight} 1160 (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1161 Kind:mkSpecial_Boat;Domain:dSea;Attack:0;Defense:3;Speed:250;Cost:20; 1162 MStrength:0;MTrans:1;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1163 Cap:(0,0,0,2,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), {Longboat} 1164 (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1165 Kind:mkSlaves;Domain:dGround;Attack:0;Defense:15;Speed:150;Cost:40; 1166 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1167 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), {Slaves} 1168 {(Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1169 Kind:mkSpecial_Carriage;Domain:dGround;Attack:50;Defense:30;Speed:250;Cost:50; 1170 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1171 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)),} 1172 {(Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1173 Kind:mkSpecial_SubCabin;Domain:dSea;Attack:16;Defense:1;Speed:350;Cost:40; 1174 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1175 Cap:(0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)),} 1176 (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1177 Kind:mkSpecial_Glider;Domain:dAir;Attack:6;Defense:6;Speed:450;Cost:30; 1178 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1179 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0))); 1180 1181 SpecialModelPreq: array[0..nSpecialModel-1] of integer= 1182 (preNone,adExplosives,preNone,preNone,(*adWri,*)adIntelligence,adTrade, 1183 (*adTheCorporation,adHorsebackRiding,adAutomobile,adNavigation, 1184 adCombustionEngine,*)adMapMaking,preBuilder,{preLeo,preLighthouse,}preLeo); 1185 1558 { predefined unit models: } 1559 nSpecialModel = 9; 1560 SpecialModel: array [0 .. nSpecialModel - 1] of TModel = ((Status: 0; 1561 SavedStatus: 0; ID: 0; IntroTurn: 0; Built: 0; Lost: 0; Kind: mkSettler; 1562 Domain: dGround; Attack: 0; Defense: 10; Speed: 150; Cost: 40; MStrength: 0; 1563 MTrans: 0; MCost: 0; Weight: 0; MaxWeight: 0; Upgrades: 0; Flags: 0; 1564 Cap: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1565 0, 0, 0, 0, 0)), { Settlers } 1566 (Status: 0; SavedStatus: 0; ID: 0; IntroTurn: 0; Built: 0; Lost: 0; 1567 Kind: mkSettler; Domain: dGround; Attack: 0; Defense: 20; Speed: 300; 1568 Cost: 40; MStrength: 0; MTrans: 0; MCost: 0; Weight: 0; MaxWeight: 0; 1569 Upgrades: 0; Flags: 0; Cap: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1570 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), { Engineers } 1571 (Status: 0; SavedStatus: 0; ID: 0; IntroTurn: 0; Built: 0; Lost: 0; 1572 Kind: mkSelfDeveloped; Domain: dGround; Attack: 6; Defense: 6; Speed: 150; 1573 Cost: 10; MStrength: 0; MTrans: 0; MCost: 0; Weight: 0; MaxWeight: 0; 1574 Upgrades: 0; Flags: 0; Cap: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1575 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), { Militia } 1576 (Status: 0; SavedStatus: 0; ID: 0; IntroTurn: 0; Built: 0; Lost: 0; 1577 Kind: mkSpecial_TownGuard; Domain: dGround; Attack: 4; Defense: 6; 1578 Speed: 150; Cost: 20; MStrength: 0; MTrans: 0; MCost: 0; Weight: 0; 1579 MaxWeight: 0; Upgrades: 0; Flags: 0; 1580 Cap: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1581 0, 0, 0, 0, 0)), { Town Guard } 1582 (Status: 0; SavedStatus: 0; ID: 0; IntroTurn: 0; Built: 0; Lost: 0; 1583 Kind: mkDiplomat; Domain: dGround; Attack: 12; Defense: 12; Speed: 250; 1584 Cost: 20; MStrength: 0; MTrans: 0; MCost: 0; Weight: 0; MaxWeight: 0; 1585 Upgrades: 0; Flags: 0; Cap: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1586 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), { Special Commando } 1587 (Status: 0; SavedStatus: 0; ID: 0; IntroTurn: 0; Built: 0; Lost: 0; 1588 Kind: mkCaravan; Domain: dGround; Attack: 0; Defense: 6; Speed: 150; 1589 Cost: 60; MStrength: 0; MTrans: 0; MCost: 0; Weight: 0; MaxWeight: 0; 1590 Upgrades: 0; Flags: 0; Cap: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1591 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), { Freight } 1592 (Status: 0; SavedStatus: 0; ID: 0; IntroTurn: 0; Built: 0; Lost: 0; 1593 Kind: mkSpecial_Boat; Domain: dSea; Attack: 0; Defense: 3; Speed: 250; 1594 Cost: 20; MStrength: 0; MTrans: 1; MCost: 0; Weight: 0; MaxWeight: 0; 1595 Upgrades: 0; Flags: 0; Cap: (0, 0, 0, 2, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1596 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), { Longboat } 1597 (Status: 0; SavedStatus: 0; ID: 0; IntroTurn: 0; Built: 0; Lost: 0; 1598 Kind: mkSlaves; Domain: dGround; Attack: 0; Defense: 15; Speed: 150; 1599 Cost: 40; MStrength: 0; MTrans: 0; MCost: 0; Weight: 0; MaxWeight: 0; 1600 Upgrades: 0; Flags: 0; Cap: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1601 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0)), { Slaves } 1602 { (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1603 Kind:mkSpecial_Carriage;Domain:dGround;Attack:50;Defense:30;Speed:250;Cost:50; 1604 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1605 Cap:(0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), } 1606 { (Status:0;SavedStatus:0;ID:0;IntroTurn:0;Built:0;Lost:0; 1607 Kind:mkSpecial_SubCabin;Domain:dSea;Attack:16;Defense:1;Speed:350;Cost:40; 1608 MStrength:0;MTrans:0;MCost:0;Weight:0;MaxWeight:0;Upgrades:0;Flags:0; 1609 Cap:(0,0,0,0,0,0,0,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0)), } 1610 (Status: 0; SavedStatus: 0; ID: 0; IntroTurn: 0; Built: 0; Lost: 0; 1611 Kind: mkSpecial_Glider; Domain: dAir; Attack: 6; Defense: 6; Speed: 450; 1612 Cost: 30; MStrength: 0; MTrans: 0; MCost: 0; Weight: 0; MaxWeight: 0; 1613 Upgrades: 0; Flags: 0; Cap: (0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1614 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0))); 1615 1616 SpecialModelPreq: array [0 .. nSpecialModel - 1] of integer = (preNone, 1617 adExplosives, preNone, preNone, (* adWri, *) adIntelligence, adTrade, 1618 (* adTheCorporation,adHorsebackRiding,adAutomobile,adNavigation, 1619 adCombustionEngine, *) adMapMaking, preBuilder, 1620 { preLeo,preLighthouse, } preLeo); 1186 1621 1187 1622 procedure MakeUnitInfo(p: integer; const u: TUn; var ui: TUnitInfo); 1188 procedure MakeModelInfo(p, mix: integer; const m: TModel; var mi: TModelInfo); 1189 function IsSameModel(const mi1,mi2: TModelInfo): boolean; 1190 function SpecialTile(Loc,TerrType,lx: integer): integer; 1191 1623 procedure MakeModelInfo(p, mix: integer; const m: TModel; var mi: TModelInfo); 1624 function IsSameModel(const mi1, mi2: TModelInfo): boolean; 1625 function SpecialTile(Loc, TerrType, lx: integer): integer; 1192 1626 1193 1627 implementation … … 1195 1629 procedure MakeUnitInfo(p: integer; const u: TUn; var ui: TUnitInfo); 1196 1630 begin 1197 ui.Owner:=p;1198 ui.Loc:=u.Loc;1199 ui.Health:=u.Health;1200 ui.Fuel:=u.Fuel;1201 ui.Job:=u.Job;1202 ui.Exp:=u.Exp;1203 ui.Load:=u.TroopLoad+u.AirLoad;1204 ui.mix:=u.mix;1205 ui.Flags:=u.Flags;1631 ui.Owner := p; 1632 ui.Loc := u.Loc; 1633 ui.Health := u.Health; 1634 ui.Fuel := u.Fuel; 1635 ui.Job := u.Job; 1636 ui.Exp := u.Exp; 1637 ui.Load := u.TroopLoad + u.AirLoad; 1638 ui.mix := u.mix; 1639 ui.Flags := u.Flags; 1206 1640 end; 1207 1641 1208 1642 procedure MakeModelInfo(p, mix: integer; const m: TModel; var mi: TModelInfo); 1209 1643 var 1210 i: integer;1644 i: integer; 1211 1645 begin 1212 mi.Owner:=p; 1213 mi.mix:=mix; 1214 mi.ID:=m.ID; 1215 mi.Domain:=m.Domain; 1216 if m.Kind=mkEnemyDeveloped then mi.Kind:=mkSelfDeveloped // important for IsSameModel() 1217 else mi.Kind:=m.Kind; 1218 mi.Attack:=m.Attack; 1219 mi.Defense:=m.Defense; 1220 mi.Speed:=m.Speed; 1221 mi.Cost:=m.Cost; 1222 if mi.Domain=dAir then 1646 mi.Owner := p; 1647 mi.mix := mix; 1648 mi.ID := m.ID; 1649 mi.Domain := m.Domain; 1650 if m.Kind = mkEnemyDeveloped then 1651 mi.Kind := mkSelfDeveloped // important for IsSameModel() 1652 else 1653 mi.Kind := m.Kind; 1654 mi.Attack := m.Attack; 1655 mi.Defense := m.Defense; 1656 mi.Speed := m.Speed; 1657 mi.Cost := m.Cost; 1658 if mi.Domain = dAir then 1223 1659 begin 1224 mi.TTrans:=m.Cap[mcAirTrans]*m.MTrans;1225 mi.ATrans_Fuel:=m.Cap[mcFuel];1660 mi.TTrans := m.Cap[mcAirTrans] * m.MTrans; 1661 mi.ATrans_Fuel := m.Cap[mcFuel]; 1226 1662 end 1227 else1663 else 1228 1664 begin 1229 mi.TTrans:=m.Cap[mcSeaTrans]*m.MTrans;1230 mi.ATrans_Fuel:=m.Cap[mcCarrier]*m.MTrans;1665 mi.TTrans := m.Cap[mcSeaTrans] * m.MTrans; 1666 mi.ATrans_Fuel := m.Cap[mcCarrier] * m.MTrans; 1231 1667 end; 1232 mi.Bombs:=m.Cap[mcBombs]*m.MStrength*2; 1233 mi.Cap:=0; 1234 for i:=mcFirstNonCap to nFeature-1 do if m.Cap[i]>0 then 1235 mi.Cap:=mi.Cap or (1 shl (i-mcFirstNonCap)); 1236 mi.MaxUpgrade:=0; 1237 for i:=1 to nUpgrade-1 do if m.Upgrades and (1 shl i)<>0 then 1238 mi.MaxUpgrade:=i; 1239 mi.Weight:=m.Weight; 1240 mi.Lost:=0; 1668 mi.Bombs := m.Cap[mcBombs] * m.MStrength * 2; 1669 mi.Cap := 0; 1670 for i := mcFirstNonCap to nFeature - 1 do 1671 if m.Cap[i] > 0 then 1672 mi.Cap := mi.Cap or (1 shl (i - mcFirstNonCap)); 1673 mi.MaxUpgrade := 0; 1674 for i := 1 to nUpgrade - 1 do 1675 if m.Upgrades and (1 shl i) <> 0 then 1676 mi.MaxUpgrade := i; 1677 mi.Weight := m.Weight; 1678 mi.Lost := 0; 1241 1679 end; 1242 1680 1243 function IsSameModel(const mi1, mi2: TModelInfo): boolean;1681 function IsSameModel(const mi1, mi2: TModelInfo): boolean; 1244 1682 type 1245 TModelInfo_Compare=array[0..5] of Cardinal;1683 TModelInfo_Compare = array [0 .. 5] of Cardinal; 1246 1684 var 1247 Compare1, Compare2: ^TModelInfo_Compare;1685 Compare1, Compare2: ^TModelInfo_Compare; 1248 1686 begin 1249 Compare1:=@mi1; Compare2:=@mi2; 1250 result:=(Compare1[1] and $FFFF0000=Compare2[1] and $FFFF0000) 1251 and (Compare1[2]=Compare2[2]) and (Compare1[3]=Compare2[3]) 1252 and (Compare1[4]=Compare2[4]) and (Compare1[5]=Compare2[5]) 1687 Compare1 := @mi1; 1688 Compare2 := @mi2; 1689 result := (Compare1[1] and $FFFF0000 = Compare2[1] and $FFFF0000) and 1690 (Compare1[2] = Compare2[2]) and (Compare1[3] = Compare2[3]) and 1691 (Compare1[4] = Compare2[4]) and (Compare1[5] = Compare2[5]) 1253 1692 end; 1254 1693 1255 function SpecialTile(Loc, TerrType,lx: integer): integer;1694 function SpecialTile(Loc, TerrType, lx: integer): integer; 1256 1695 var 1257 x,y,qx,qy,a: integer;1696 x, y, qx, qy, a: integer; 1258 1697 begin 1259 if TerrType=fOcean then result:=0 1260 else 1698 if TerrType = fOcean then 1699 result := 0 1700 else 1261 1701 begin 1262 y:=Loc div lx; 1263 x:=Loc-y*lx; 1264 if TerrType=fGrass then {formula for productive grassland} 1265 if Odd((lymax+x-y shr 1) shr 1+x+(y+1) shr 1) then result:=1 1266 else result:=0 1267 else {formula for special resources} 1702 y := Loc div lx; 1703 x := Loc - y * lx; 1704 if TerrType = fGrass then { formula for productive grassland } 1705 if Odd((lymax + x - y shr 1) shr 1 + x + (y + 1) shr 1) then 1706 result := 1 1707 else 1708 result := 0 1709 else { formula for special resources } 1268 1710 begin 1269 a:=4*x-y+9980;1270 qx:=a div 10;1271 if (qx*10=a) and (qx and 3<>0) then1711 a := 4 * x - y + 9980; 1712 qx := a div 10; 1713 if (qx * 10 = a) and (qx and 3 <> 0) then 1272 1714 begin 1273 qy:=(y+x) div 5; 1274 if qy and 3<>qx shr 2 and 1 *2 then 1275 if (TerrType=fArctic) or (TerrType=fSwamp) then result:=1 1276 else if TerrType=fShore then 1715 qy := (y + x) div 5; 1716 if qy and 3 <> qx shr 2 and 1 * 2 then 1717 if (TerrType = fArctic) or (TerrType = fSwamp) then 1718 result := 1 1719 else if TerrType = fShore then 1277 1720 begin 1278 if (qx+qy) and 1=0 then 1279 if qx and 3=2 then result:=2 1280 else result:=1 1281 else result:=0 1721 if (qx + qy) and 1 = 0 then 1722 if qx and 3 = 2 then 1723 result := 2 1724 else 1725 result := 1 1726 else 1727 result := 0 1282 1728 end 1283 else result:=(qx+qy) and 1+1 1284 else result:=0; 1729 else 1730 result := (qx + qy) and 1 + 1 1731 else 1732 result := 0; 1285 1733 end 1286 else result:=0; 1734 else 1735 result := 0; 1287 1736 end 1288 1737 end; … … 1290 1739 1291 1740 begin 1292 assert(sizeof(TPlayerContext)=2048); 1293 assert(sizeof(TModel)-2*sizeof(LongInt)-4*sizeof(word)=sIntSetDevModel and $F *4); 1741 assert(sizeof(TPlayerContext) = 2048); 1742 assert(sizeof(TModel) - 2 * sizeof(LongInt) - 4 * sizeof(word) 1743 = sIntSetDevModel and $F * 4); 1744 1294 1745 end. 1295 -
trunk/ScreenTools.pas
r2 r6 1 1 {$INCLUDE switches} 2 3 2 unit ScreenTools; 4 3 … … 8 7 StringTables, 9 8 10 11 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,Menus; 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Menus; 12 10 13 11 type 14 TTexture=record 15 Image: TBitmap; 16 clBevelLight,clBevelShade,clTextLight,clTextShade,clLitText,clMark,clPage,clCover: TColor 17 end; 18 19 function ChangeResolution(x,y,bpp,freq: integer): boolean; 20 procedure RestoreResolution; 21 function Play(Item: string; Index: integer =-1): boolean; 22 procedure PreparePlay(Item: string; Index: integer =-1); 23 procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0); 24 function turntoyear(Turn: integer): integer; 25 function TurnToString(Turn: integer): string; 26 function MovementToString(Movement: integer): string; 27 procedure BtnFrame(ca:TCanvas;p:TRect;const T: TTexture); 28 procedure EditFrame(ca:TCanvas;p:TRect;const T: TTexture); 29 function HexStringToColor(s: string): integer; 30 function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer= 0): boolean; 31 function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string; Options: integer= 0): boolean; 32 function LoadGraphicSet(Name: string): integer; 33 procedure Dump(dst:TBitmap; HGr,xDst,yDst,Width,Height,xGr,yGr:integer); 34 procedure Sprite(Canvas: TCanvas; HGr,xDst,yDst,Width,Height,xGr,yGr: integer); overload; 35 procedure Sprite(dst:TBitmap; HGr,xDst,yDst,Width,Height,xGr,yGr:integer); overload; 36 procedure MakeBlue(Dst: TBitmap; x,y,w,h: integer); 37 procedure ImageOp_B(Dst,Src: TBitmap; xDst,yDst,xSrc,ySrc,w,h: integer); 38 procedure ImageOp_BCC(Dst,Src: TBitmap; xDst,yDst,xSrc,ySrc,w,h,Color1,Color2: integer); 39 procedure ImageOp_CCC(Bmp: TBitmap; x,y,w,h,Color0,Color1,Color2: integer); 40 procedure SLine(ca: TCanvas; x0,x1,y: integer; cl: TColor); 41 procedure DLine(ca: TCanvas; x0,x1,y: integer; cl0,cl1: TColor); 42 procedure Frame(ca: TCanvas;x0,y0,x1,y1:integer;cl0,cl1:TColor); 43 procedure RFrame(ca: TCanvas;x0,y0,x1,y1:integer;cl0,cl1:TColor); 44 procedure CFrame(ca: TCanvas; x0,y0,x1,y1,Corner: integer; cl: TColor); 45 procedure FrameImage(ca: TCanvas; src:TBitmap; x,y,width,height,xSrc,ySrc: integer; IsControl: boolean = false); 46 procedure GlowFrame(dst: TBitmap; x0,y0,width,height: integer; cl: TColor); 47 procedure InitOrnament; 48 procedure InitCityMark(const T: TTexture); 49 procedure Fill(ca: TCanvas;Left,Top,Width,Height,xOffset,yOffset: integer); 50 procedure FillLarge(ca: TCanvas; x0,y0,x1,y1,xm: integer); 51 procedure FillSeamless(ca: TCanvas;Left,Top,Width,Height,xOffset,yOffset: integer;const Texture: TBitmap); 52 procedure FillRectSeamless(ca: TCanvas;x0,y0,x1,y1,xOffset,yOffset: integer; 53 const Texture: TBitmap); 54 procedure PaintBackground(Form: TForm; Left,Top,Width,Height: integer); 55 procedure Corner(ca: TCanvas; x,y,Kind:integer; const T: TTexture); 56 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; 57 x,y:integer; s:string); 58 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture; 59 x,y:integer; s:string); 60 function BiColorTextWidth(ca: TCanvas; s: string): integer; 61 procedure RisedTextOut(ca: TCanvas; x,y:integer; s:string); 62 procedure LightGradient(ca: TCanvas; x,y,width,Color:integer); 63 procedure DarkGradient(ca: TCanvas; x,y,width,Kind:integer); 64 procedure VLightGradient(ca: TCanvas; x,y,height,Color:integer); 65 procedure VDarkGradient(ca: TCanvas; x,y,height,Kind:integer); 66 procedure NumberBar(dst:TBitmap; x,y:integer; Cap:string; val: integer; 67 const T: TTexture); 68 procedure CountBar(dst:TBitmap; x,y,w:integer; Kind:integer; Cap:string; 69 val: integer; const T: TTexture); 70 procedure PaintProgressBar(ca: TCanvas; Kind,x,y,pos,Growth,max: integer; 71 const T: TTexture); 72 procedure PaintRelativeProgressBar(ca: TCanvas; Kind,x,y,size,pos,Growth, 73 max: integer; IndicateComplete: boolean; const T: TTexture); 74 procedure PaintLogo(ca: TCanvas; x,y,clLight,clShade: integer); 75 function SetMainTextureByAge(Age: integer): boolean; 76 77 const 78 nGrExtmax=64; 79 wMainTexture=640; hMainTexture=480; 80 81 // template positions in Template.bmp 82 xLogo=1; yLogo=1; wLogo=122; hLogo=23; // logo 83 xBBook=1; yBBook=74; wBBook=143; hBBook=73; // big book 84 xSBook=72; ySBook=37; wSBook=72; hSBook=36; // small book 85 xNation=1; yNation=25; 86 xCoal=1; yCoal=148; 87 88 // Icons.bmp structure 89 xSizeBig=56; ySizeBig=40; 90 91 GlowRange=8; 92 93 EmptySpaceColor=$101010; 94 95 // template positions in System2.bmp 96 xOrna=156; yOrna=1; wOrna=27; hOrna=26; // ornament 97 98 // sound modes 99 smOff=0; smOn=1; smOnAlt=2; 100 101 // color matrix 102 clkAge0=1; cliTexture=0; cliBevelLight=cliTexture+1; cliBevelShade=cliTexture+2; 103 cliTextLight=cliTexture+3; cliTextShade=cliTexture+4; cliLitText=cliTexture+5; 104 cliMark=cliTexture+6; cliDimmedText=cliTexture+7; 105 cliRoad=8; cliHouse=cliRoad+1; cliImp=cliRoad+2; cliImpProject=cliRoad+3; 106 cliPage=13; cliCover=cliPage+1; 107 clkMisc=5; cliPaper=0; cliPaperText=1; cliPaperCaption=2; 108 clkCity=6; cliPlains=0; cliPrairie=1; cliHills=2; cliTundra=3; cliWater=4; 109 110 // LoadGraphicFile options 111 gfNoError=$01; gfNoGamma=$02; gfJPG=$04; 112 113 type 114 TGrExtDescr=record {don't use dynamic strings here!} 115 Name:string[31]; 116 Data,Mask:TBitmap; 117 pixUsed: array[Byte] of Byte; 118 end; 119 TGrExtDescrSize=record {for size calculation only - must be the same as 120 TGrExtDescr, but without pixUsed} 121 Name:string[31]; 122 Data,Mask:TBitmap; 123 end; 124 125 TFontType=(ftNormal, ftSmall, ftTiny, ftCaption, ftButton); 126 127 var 128 Phrases, Phrases2, Sounds: TStringTable; 129 nGrExt: integer; 130 GrExt:array[0..nGrExtmax-1] of ^TGrExtDescr; 131 HGrSystem, HGrSystem2, ClickFrameColor,SoundMode, MainTextureAge: integer; 132 MainTexture: TTexture; 133 Templates,Colors,Paper,BigImp,LogoBuffer: TBitmap; 134 FullScreen,GenerateNames,InitOrnamentDone,Phrases2FallenBackToEnglish: boolean; 135 136 UniFont: array[TFontType] of TFont; 12 TTexture = record 13 Image: TBitmap; 14 clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark, 15 clPage, clCover: TColor end; 16 17 function ChangeResolution(x, y, bpp, freq: integer): boolean; 18 procedure RestoreResolution; 19 function Play(Item: string; Index: integer = -1): boolean; 20 procedure PreparePlay(Item: string; Index: integer = -1); 21 procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0); 22 function turntoyear(Turn: integer): integer; 23 function TurnToString(Turn: integer): string; 24 function MovementToString(Movement: integer): string; 25 procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture); 26 procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture); 27 function HexStringToColor(s: string): integer; 28 function LoadGraphicFile(bmp: TBitmap; Path: string; 29 Options: integer = 0): boolean; 30 function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string; 31 Options: integer = 0): boolean; 32 function LoadGraphicSet(Name: string): integer; 33 procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, 34 yGr: integer); 35 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, 36 yGr: integer); overload; 37 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, 38 yGr: integer); overload; 39 procedure MakeBlue(dst: TBitmap; x, y, w, h: integer); 40 procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, 41 h: integer); 42 procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h, 43 Color1, Color2: integer); 44 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, 45 Color2: integer); 46 procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor); 47 procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor); 48 procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor); 49 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor); 50 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor); 51 procedure FrameImage(ca: TCanvas; Src: TBitmap; 52 x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false); 53 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; 54 cl: TColor); 55 procedure InitOrnament; 56 procedure InitCityMark(const T: TTexture); 57 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, 58 yOffset: integer); 59 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer); 60 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, 61 yOffset: integer; const Texture: TBitmap); 62 procedure FillRectSeamless(ca: TCanvas; 63 x0, y0, x1, y1, xOffset, yOffset: integer; const Texture: TBitmap); 64 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer); 65 procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture); 66 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer; 67 s: string); 68 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture; 69 x, y: integer; s: string); 70 function BiColorTextWidth(ca: TCanvas; s: string): integer; 71 procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string); 72 procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer); 73 procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer); 74 procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer); 75 procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer); 76 procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer; 77 const T: TTexture); 78 procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer; 79 Cap: string; val: integer; const T: TTexture); 80 procedure PaintProgressBar(ca: TCanvas; 81 Kind, x, y, pos, Growth, max: integer; const T: TTexture); 82 procedure PaintRelativeProgressBar(ca: TCanvas; 83 Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean; 84 const T: TTexture); 85 procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer); 86 function SetMainTextureByAge(Age: integer): boolean; 87 88 const 89 nGrExtmax = 64; 90 wMainTexture = 640; 91 hMainTexture = 480; 92 93 // template positions in Template.bmp 94 xLogo = 1; 95 yLogo = 1; 96 wLogo = 122; 97 hLogo = 23; // logo 98 xBBook = 1; 99 yBBook = 74; 100 wBBook = 143; 101 hBBook = 73; // big book 102 xSBook = 72; 103 ySBook = 37; 104 wSBook = 72; 105 hSBook = 36; // small book 106 xNation = 1; 107 yNation = 25; 108 xCoal = 1; 109 yCoal = 148; 110 111 // Icons.bmp structure 112 xSizeBig = 56; 113 ySizeBig = 40; 114 115 GlowRange = 8; 116 117 EmptySpaceColor = $101010; 118 119 // template positions in System2.bmp 120 xOrna = 156; 121 yOrna = 1; 122 wOrna = 27; 123 hOrna = 26; // ornament 124 125 // sound modes 126 smOff = 0; 127 smOn = 1; 128 smOnAlt = 2; 129 130 // color matrix 131 clkAge0 = 1; 132 cliTexture = 0; 133 cliBevelLight = cliTexture + 1; 134 cliBevelShade = cliTexture + 2; 135 cliTextLight = cliTexture + 3; 136 cliTextShade = cliTexture + 4; 137 cliLitText = cliTexture + 5; 138 cliMark = cliTexture + 6; 139 cliDimmedText = cliTexture + 7; 140 cliRoad = 8; 141 cliHouse = cliRoad + 1; 142 cliImp = cliRoad + 2; 143 cliImpProject = cliRoad + 3; 144 cliPage = 13; 145 cliCover = cliPage + 1; 146 clkMisc = 5; 147 cliPaper = 0; 148 cliPaperText = 1; 149 cliPaperCaption = 2; 150 clkCity = 6; 151 cliPlains = 0; 152 cliPrairie = 1; 153 cliHills = 2; 154 cliTundra = 3; 155 cliWater = 4; 156 157 // LoadGraphicFile options 158 gfNoError = $01; 159 gfNoGamma = $02; 160 gfJPG = $04; 161 162 type 163 TGrExtDescr = record { don't use dynamic strings here! } 164 Name: string[31]; 165 Data, Mask: TBitmap; 166 pixUsed: array [Byte] of Byte; 167 end; 168 169 TGrExtDescrSize = record { for size calculation only - must be the same as 170 TGrExtDescr, but without pixUsed } 171 Name: string[31]; 172 Data, Mask: TBitmap; 173 end; 174 175 TFontType = (ftNormal, ftSmall, ftTiny, ftCaption, ftButton); 176 177 var 178 Phrases, Phrases2, Sounds: TStringTable; 179 nGrExt: integer; 180 GrExt: array [0 .. nGrExtmax - 1] of ^TGrExtDescr; 181 HGrSystem, HGrSystem2, ClickFrameColor, SoundMode, MainTextureAge: integer; 182 MainTexture: TTexture; 183 Templates, Colors, Paper, BigImp, LogoBuffer: TBitmap; 184 FullScreen, GenerateNames, InitOrnamentDone, 185 Phrases2FallenBackToEnglish: boolean; 186 187 UniFont: array [TFontType] of TFont; 137 188 138 189 implementation … … 141 192 Directories, Sound, ButtonBase, ButtonA, ButtonB, 142 193 143 Registry,JPEG; 144 145 var 146 StartResolution: TDeviceMode; 147 ResolutionChanged: boolean; 148 149 Gamma: integer; // global gamma correction (cent) 150 GammaLUT: array[0..255] of byte; 151 152 153 function ChangeResolution(x,y,bpp,freq: integer): boolean; 154 var 155 DevMode: TDeviceMode; 156 begin 157 EnumDisplaySettings(nil, 0, DevMode); 158 DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL 159 or DM_DISPLAYFREQUENCY; 160 DevMode.dmPelsWidth:=x; 161 DevMode.dmPelsHeight:=y; 162 DevMode.dmBitsPerPel:=bpp; 163 DevMode.dmDisplayFrequency:=freq; 164 result:= ChangeDisplaySettings(DevMode,0)=DISP_CHANGE_SUCCESSFUL; 165 if result then 166 ResolutionChanged:=true; 194 Registry, JPEG; 195 196 var 197 StartResolution: TDeviceMode; 198 ResolutionChanged: boolean; 199 200 Gamma: integer; // global gamma correction (cent) 201 GammaLUT: array [0 .. 255] of Byte; 202 203 function ChangeResolution(x, y, bpp, freq: integer): boolean; 204 var 205 DevMode: TDeviceMode; 206 begin 207 EnumDisplaySettings(nil, 0, DevMode); 208 DevMode.dmFields := DM_PELSWIDTH or DM_PELSHEIGHT or DM_BITSPERPEL or 209 DM_DISPLAYFREQUENCY; 210 DevMode.dmPelsWidth := x; 211 DevMode.dmPelsHeight := y; 212 DevMode.dmBitsPerPel := bpp; 213 DevMode.dmDisplayFrequency := freq; 214 result := ChangeDisplaySettings(DevMode, 0) = DISP_CHANGE_SUCCESSFUL; 215 if result then 216 ResolutionChanged := true; 167 217 end; 168 218 169 219 procedure RestoreResolution; 170 220 begin 171 if ResolutionChanged then172 ChangeDisplaySettings(StartResolution,0);173 ResolutionChanged:=false;174 end; 175 176 function Play(Item: string; Index: integer = -1): boolean;221 if ResolutionChanged then 222 ChangeDisplaySettings(StartResolution, 0); 223 ResolutionChanged := false; 224 end; 225 226 function Play(Item: string; Index: integer = -1): boolean; 177 227 {$IFNDEF DEBUG} 178 228 var 179 WAVFileName: string;229 WAVFileName: string; 180 230 {$ENDIF} 181 231 begin 182 232 {$IFNDEF DEBUG} 183 if (Sounds=nil) or (SoundMode=smOff) or (Item='') then 184 begin result:=true; exit; end; 185 WAVFileName:=Sounds.Lookup(Item, Index); 186 assert(WAVFileName[1]<>'['); 187 result:=(WAVFileName<>'') and (WAVFileName[1]<>'[') and (WAVFileName<>'*'); 188 if result then 189 // SndPlaySound(pchar(HomeDir+'Sounds\'+WAVFileName+'.wav'),SND_ASYNC) 190 PlaySound(HomeDir+'Sounds\'+WAVFileName) 233 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then 234 begin 235 result := true; 236 exit; 237 end; 238 WAVFileName := Sounds.Lookup(Item, Index); 239 assert(WAVFileName[1] <> '['); 240 result := (WAVFileName <> '') and (WAVFileName[1] <> '[') and 241 (WAVFileName <> '*'); 242 if result then 243 // SndPlaySound(pchar(HomeDir+'Sounds\'+WAVFileName+'.wav'),SND_ASYNC) 244 PlaySound(HomeDir + 'Sounds\' + WAVFileName) 191 245 {$ENDIF} 192 246 end; 193 247 194 procedure PreparePlay(Item: string; Index: integer = -1);248 procedure PreparePlay(Item: string; Index: integer = -1); 195 249 {$IFNDEF DEBUG} 196 250 var 197 WAVFileName: string;251 WAVFileName: string; 198 252 {$ENDIF} 199 253 begin 200 254 {$IFNDEF DEBUG} 201 if (Sounds=nil) or (SoundMode=smOff) or (Item='') then exit; 202 WAVFileName:=Sounds.Lookup(Item, Index); 203 assert(WAVFileName[1]<>'['); 204 if (WAVFileName<>'') and (WAVFileName[1]<>'[') and (WAVFileName<>'*') then 205 PrepareSound(HomeDir+'Sounds\'+WAVFileName) 255 if (Sounds = nil) or (SoundMode = smOff) or (Item = '') then 256 exit; 257 WAVFileName := Sounds.Lookup(Item, Index); 258 assert(WAVFileName[1] <> '['); 259 if (WAVFileName <> '') and (WAVFileName[1] <> '[') and (WAVFileName <> '*') 260 then 261 PrepareSound(HomeDir + 'Sounds\' + WAVFileName) 206 262 {$ENDIF} 207 263 end; … … 209 265 procedure EmptyMenu(MenuItems: TMenuItem; Keep: integer = 0); 210 266 var 211 m: TMenuItem;212 begin 213 while MenuItems.Count>Keep do214 begin 215 m:=MenuItems[MenuItems.Count-1];216 MenuItems.Delete(MenuItems.Count-1);217 m.Free;267 m: TMenuItem; 268 begin 269 while MenuItems.Count > Keep do 270 begin 271 m := MenuItems[MenuItems.Count - 1]; 272 MenuItems.Delete(MenuItems.Count - 1); 273 m.Free; 218 274 end; 219 275 end; … … 221 277 function turntoyear(Turn: integer): integer; 222 278 var 223 i: integer; 224 begin 225 result:=-4000; 226 for i:=1 to Turn do 227 if result<-1000 then inc(result,50) // 0..60 228 else if result<0 then inc(result,25) // 60..100 229 else if result<1500 then inc(result,20) // 100..175 230 else if result<1750 then inc(result,10) // 175..200 231 else if result<1850 then inc(result,2) // 200..250 232 else inc(result); 279 i: integer; 280 begin 281 result := -4000; 282 for i := 1 to Turn do 283 if result < -1000 then 284 inc(result, 50) // 0..60 285 else if result < 0 then 286 inc(result, 25) // 60..100 287 else if result < 1500 then 288 inc(result, 20) // 100..175 289 else if result < 1750 then 290 inc(result, 10) // 175..200 291 else if result < 1850 then 292 inc(result, 2) // 200..250 293 else 294 inc(result); 233 295 end; 234 296 235 297 function TurnToString(Turn: integer): string; 236 298 var 237 year: integer; 238 begin 239 if GenerateNames then 240 begin 241 year:=turntoyear(Turn); 242 if year<0 then result:=Format(Phrases.Lookup('BC'),[-year]) 243 else result:=Format(Phrases.Lookup('AD'),[year]); 244 end 245 else result:=IntToStr(Turn) 299 year: integer; 300 begin 301 if GenerateNames then 302 begin 303 year := turntoyear(Turn); 304 if year < 0 then 305 result := Format(Phrases.Lookup('BC'), [-year]) 306 else 307 result := Format(Phrases.Lookup('AD'), [year]); 308 end 309 else 310 result := IntToStr(Turn) 246 311 end; 247 312 248 313 function MovementToString(Movement: integer): string; 249 314 begin 250 if Movement>=1000 then 251 begin 252 result:=char(48+Movement div 1000); 253 Movement:=Movement mod 1000; 254 end 255 else result:=''; 256 result:=result+char(48+Movement div 100); 257 Movement:=Movement mod 100; 258 if Movement>0 then 259 begin 260 result:=result+'.'+char(48+Movement div 10); 261 Movement:=Movement mod 10; 262 if Movement>0 then 263 result:=result+char(48+Movement); 264 end 265 end; 266 267 procedure BtnFrame(ca:TCanvas;p:TRect;const T: TTexture); 268 begin 269 RFrame(ca,p.Left-1,p.Top-1,p.Right,p.Bottom,T.clBevelShade,T.clBevelLight) 270 end; 271 272 procedure EditFrame(ca:TCanvas;p:TRect;const T: TTexture); 273 begin 274 Frame(ca,p.Left-1,p.Top-1,p.Right,p.Bottom,$000000,$000000); 275 Frame(ca,p.Left-2,p.Top-2,p.Right+1,p.Bottom+1,$000000,$000000); 276 Frame(ca,p.Left-3,p.Top-3,p.Right+2,p.Bottom+1,$000000,$000000); 277 RFrame(ca,p.Left-4,p.Top-4,p.Right+3,p.Bottom+2,T.clBevelShade,T.clBevelLight) 315 if Movement >= 1000 then 316 begin 317 result := char(48 + Movement div 1000); 318 Movement := Movement mod 1000; 319 end 320 else 321 result := ''; 322 result := result + char(48 + Movement div 100); 323 Movement := Movement mod 100; 324 if Movement > 0 then 325 begin 326 result := result + '.' + char(48 + Movement div 10); 327 Movement := Movement mod 10; 328 if Movement > 0 then 329 result := result + char(48 + Movement); 330 end 331 end; 332 333 procedure BtnFrame(ca: TCanvas; p: TRect; const T: TTexture); 334 begin 335 RFrame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, T.clBevelShade, 336 T.clBevelLight) 337 end; 338 339 procedure EditFrame(ca: TCanvas; p: TRect; const T: TTexture); 340 begin 341 Frame(ca, p.Left - 1, p.Top - 1, p.Right, p.Bottom, $000000, $000000); 342 Frame(ca, p.Left - 2, p.Top - 2, p.Right + 1, p.Bottom + 1, $000000, $000000); 343 Frame(ca, p.Left - 3, p.Top - 3, p.Right + 2, p.Bottom + 1, $000000, $000000); 344 RFrame(ca, p.Left - 4, p.Top - 4, p.Right + 3, p.Bottom + 2, T.clBevelShade, 345 T.clBevelLight) 278 346 end; 279 347 … … 282 350 function HexCharToInt(x: char): integer; 283 351 begin 284 case x of 285 '0'..'9': result:=ord(x)-48; 286 'A'..'F': result:=ord(x)-65+10; 287 'a'..'f': result:=ord(x)-97+10; 288 else result:=0 352 case x of 353 '0' .. '9': 354 result := ord(x) - 48; 355 'A' .. 'F': 356 result := ord(x) - 65 + 10; 357 'a' .. 'f': 358 result := ord(x) - 97 + 10; 359 else 360 result := 0 289 361 end 290 362 end; 291 363 292 364 begin 293 while (Length(s)>0) and (s[1]=' ') do Delete(s,1,1); 294 s:=s+'000000'; 295 if Gamma=100 then 296 result:=$10*HexCharToInt(s[1])+$1*HexCharToInt(s[2]) 297 +$1000*HexCharToInt(s[3])+$100*HexCharToInt(s[4]) 298 +$100000*HexCharToInt(s[5])+$10000*HexCharToInt(s[6]) 299 else result:=GammaLUT[$10*HexCharToInt(s[1])+HexCharToInt(s[2])] 300 +$100*GammaLUT[$10*HexCharToInt(s[3])+HexCharToInt(s[4])] 301 +$10000*GammaLUT[$10*HexCharToInt(s[5])+HexCharToInt(s[6])]; 365 while (Length(s) > 0) and (s[1] = ' ') do 366 Delete(s, 1, 1); 367 s := s + '000000'; 368 if Gamma = 100 then 369 result := $10 * HexCharToInt(s[1]) + $1 * HexCharToInt(s[2]) + $1000 * 370 HexCharToInt(s[3]) + $100 * HexCharToInt(s[4]) + $100000 * 371 HexCharToInt(s[5]) + $10000 * HexCharToInt(s[6]) 372 else 373 result := GammaLUT[$10 * HexCharToInt(s[1]) + HexCharToInt(s[2])] + $100 * 374 GammaLUT[$10 * HexCharToInt(s[3]) + HexCharToInt(s[4])] + $10000 * 375 GammaLUT[$10 * HexCharToInt(s[5]) + HexCharToInt(s[6])]; 302 376 end; 303 377 304 378 procedure ApplyGamma(Start, Stop: pbyte); 305 379 begin 306 while integer(Start)<integer(Stop) do 307 begin Start^:=GammaLUT[Start^]; inc(Start); end; 380 while integer(Start) < integer(Stop) do 381 begin 382 Start^ := GammaLUT[Start^]; 383 inc(Start); 384 end; 308 385 end; 309 386 310 387 function LoadGraphicFile(bmp: TBitmap; Path: string; Options: integer): boolean; 311 388 type 312 TLine=array[0..9999,0..2] of Byte; 313 var 314 FirstLine, LastLine: ^TLine; 315 jtex: tjpegimage; 316 begin 317 result:=true; 318 if Options and gfJPG<>0 then 319 begin 320 jtex:=tjpegimage.create; 321 try 322 jtex.loadfromfile(Path+'.jpg'); 323 except 324 result:=false; 325 end; 326 if result then 327 begin 328 if Options and gfNoGamma=0 then 329 bmp.PixelFormat:=pf24bit; 330 bmp.width:=jtex.width; bmp.height:=jtex.height; 331 bmp.canvas.draw(0,0,jtex); 332 end; 333 jtex.free; 334 end 335 else 336 begin 337 try 338 bmp.LoadFromFile(Path+'.bmp'); 339 except 340 result:=false; 341 end; 342 if result then 343 begin 344 if Options and gfNoGamma=0 then 345 bmp.PixelFormat:=pf24bit; 389 TLine = array [0 .. 9999, 0 .. 2] of Byte; 390 var 391 FirstLine, LastLine: ^TLine; 392 jtex: tjpegimage; 393 begin 394 result := true; 395 if Options and gfJPG <> 0 then 396 begin 397 jtex := tjpegimage.create; 398 try 399 jtex.loadfromfile(Path + '.jpg'); 400 except 401 result := false; 402 end; 403 if result then 404 begin 405 if Options and gfNoGamma = 0 then 406 bmp.PixelFormat := pf24bit; 407 bmp.Width := jtex.Width; 408 bmp.Height := jtex.Height; 409 bmp.Canvas.draw(0, 0, jtex); 410 end; 411 jtex.Free; 412 end 413 else 414 begin 415 try 416 bmp.loadfromfile(Path + '.bmp'); 417 except 418 result := false; 419 end; 420 if result then 421 begin 422 if Options and gfNoGamma = 0 then 423 bmp.PixelFormat := pf24bit; 346 424 end 347 425 end; 348 if not result then 349 begin 350 if Options and gfNoError=0 then 351 Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'),[Path])), 'C-evo', 0); 352 exit; 353 end; 354 if (Options and gfNoGamma=0) and (Gamma<>100) then 355 begin 356 FirstLine:=bmp.ScanLine[0]; 357 LastLine:=bmp.ScanLine[bmp.Height-1]; 358 if integer(FirstLine)<integer(LastLine) then 359 ApplyGamma(pointer(FirstLine), @LastLine[bmp.Width]) 360 else ApplyGamma(pointer(LastLine), @FirstLine[bmp.Width]) 361 end 362 end; 363 364 function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string; Options: integer): boolean; 426 if not result then 427 begin 428 if Options and gfNoError = 0 then 429 Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'), 430 [Path])), 'C-evo', 0); 431 exit; 432 end; 433 if (Options and gfNoGamma = 0) and (Gamma <> 100) then 434 begin 435 FirstLine := bmp.ScanLine[0]; 436 LastLine := bmp.ScanLine[bmp.Height - 1]; 437 if integer(FirstLine) < integer(LastLine) then 438 ApplyGamma(pointer(FirstLine), @LastLine[bmp.Width]) 439 else 440 ApplyGamma(pointer(LastLine), @FirstLine[bmp.Width]) 441 end 442 end; 443 444 function LoadLocalizedGraphicFile(bmp: TBitmap; Path: string; 445 Options: integer): boolean; 365 446 type 366 TLine=array[0..9999,0..2] of Byte; 367 var 368 FirstLine, LastLine: ^TLine; 369 jtex: tjpegimage; 370 begin 371 result:=true; 372 if Options and gfJPG<>0 then 373 begin 374 jtex:=tjpegimage.create; 375 try 376 jtex.loadfromfile(LocalizedFilePath(Path+'.jpg')); 377 except 378 result:=false; 379 end; 380 if result then 381 begin 382 if Options and gfNoGamma=0 then 383 bmp.PixelFormat:=pf24bit; 384 bmp.width:=jtex.width; bmp.height:=jtex.height; 385 bmp.canvas.draw(0,0,jtex); 386 end; 387 jtex.free; 388 end 389 else 390 begin 391 try 392 bmp.LoadFromFile(LocalizedFilePath(Path+'.bmp')); 393 except 394 result:=false; 395 end; 396 if result then 397 begin 398 if Options and gfNoGamma=0 then 399 bmp.PixelFormat:=pf24bit; 447 TLine = array [0 .. 9999, 0 .. 2] of Byte; 448 var 449 FirstLine, LastLine: ^TLine; 450 jtex: tjpegimage; 451 begin 452 result := true; 453 if Options and gfJPG <> 0 then 454 begin 455 jtex := tjpegimage.create; 456 try 457 jtex.loadfromfile(LocalizedFilePath(Path + '.jpg')); 458 except 459 result := false; 460 end; 461 if result then 462 begin 463 if Options and gfNoGamma = 0 then 464 bmp.PixelFormat := pf24bit; 465 bmp.Width := jtex.Width; 466 bmp.Height := jtex.Height; 467 bmp.Canvas.draw(0, 0, jtex); 468 end; 469 jtex.Free; 470 end 471 else 472 begin 473 try 474 bmp.loadfromfile(LocalizedFilePath(Path + '.bmp')); 475 except 476 result := false; 477 end; 478 if result then 479 begin 480 if Options and gfNoGamma = 0 then 481 bmp.PixelFormat := pf24bit; 400 482 end 401 483 end; 402 if not result then 403 begin 404 if Options and gfNoError=0 then 405 Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'),[Path])), 'C-evo', 0); 406 exit; 407 end; 408 if (Options and gfNoGamma=0) and (Gamma<>100) then 409 begin 410 FirstLine:=bmp.ScanLine[0]; 411 LastLine:=bmp.ScanLine[bmp.Height-1]; 412 if integer(FirstLine)<integer(LastLine) then 413 ApplyGamma(pointer(FirstLine), @LastLine[bmp.Width]) 414 else ApplyGamma(pointer(LastLine), @FirstLine[bmp.Width]) 484 if not result then 485 begin 486 if Options and gfNoError = 0 then 487 Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'), 488 [Path])), 'C-evo', 0); 489 exit; 490 end; 491 if (Options and gfNoGamma = 0) and (Gamma <> 100) then 492 begin 493 FirstLine := bmp.ScanLine[0]; 494 LastLine := bmp.ScanLine[bmp.Height - 1]; 495 if integer(FirstLine) < integer(LastLine) then 496 ApplyGamma(pointer(FirstLine), @LastLine[bmp.Width]) 497 else 498 ApplyGamma(pointer(LastLine), @FirstLine[bmp.Width]) 415 499 end 416 500 end; … … 418 502 function LoadGraphicSet(Name: string): integer; 419 503 type 420 TLine=array[0..999,0..2] of Byte; 421 var 422 i,x,y,xmax,OriginalColor: integer; 423 FileName: string; 424 Source: TBitmap; 425 DataLine, MaskLine: ^TLine; 426 begin 427 i:=0; 428 while (i<nGrExt) and (GrExt[i].Name<>Name) do inc(i); 429 result:=i; 430 if i=nGrExt then 431 begin 432 FileName:=HomeDir+'Graphics\'+Name; 433 Source:=TBitmap.Create; 434 try 435 Source.LoadFromFile(FileName+'.bmp') 436 except 437 result:=-1; 438 Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'),['Graphics\'+Name])), 'C-evo', 0); 439 exit; 440 end; 441 442 GetMem(GrExt[nGrExt],SizeOf(TGrExtDescrSize)+Source.Height div 49 *10); 443 GrExt[nGrExt].Name:=Name; 444 445 xmax:=Source.Width-1; // allows 4-byte access even for last pixel 446 if xmax>970 then xmax:=970; 447 448 GrExt[nGrExt].Data:=Source; 449 GrExt[nGrExt].Data.PixelFormat:=pf24bit; 450 GrExt[nGrExt].Mask:=TBitmap.Create; 451 GrExt[nGrExt].Mask.PixelFormat:=pf24bit; 452 GrExt[nGrExt].Mask.Width:=Source.Width; 453 GrExt[nGrExt].Mask.Height:=Source.Height; 454 455 for y:=0 to Source.Height-1 do 456 begin 457 DataLine:=GrExt[nGrExt].Data.ScanLine[y]; 458 MaskLine:=GrExt[nGrExt].Mask.ScanLine[y]; 459 for x:=0 to xmax-1 do 504 TLine = array [0 .. 999, 0 .. 2] of Byte; 505 var 506 i, x, y, xmax, OriginalColor: integer; 507 FileName: string; 508 Source: TBitmap; 509 DataLine, MaskLine: ^TLine; 510 begin 511 i := 0; 512 while (i < nGrExt) and (GrExt[i].Name <> Name) do 513 inc(i); 514 result := i; 515 if i = nGrExt then 516 begin 517 FileName := HomeDir + 'Graphics\' + Name; 518 Source := TBitmap.create; 519 try 520 Source.loadfromfile(FileName + '.bmp') 521 except 522 result := -1; 523 Application.MessageBox(PChar(Format(Phrases.Lookup('FILENOTFOUND'), 524 ['Graphics\' + Name])), 'C-evo', 0); 525 exit; 526 end; 527 528 GetMem(GrExt[nGrExt], SizeOf(TGrExtDescrSize) + Source.Height div 49 * 10); 529 GrExt[nGrExt].Name := Name; 530 531 xmax := Source.Width - 1; // allows 4-byte access even for last pixel 532 if xmax > 970 then 533 xmax := 970; 534 535 GrExt[nGrExt].Data := Source; 536 GrExt[nGrExt].Data.PixelFormat := pf24bit; 537 GrExt[nGrExt].Mask := TBitmap.create; 538 GrExt[nGrExt].Mask.PixelFormat := pf24bit; 539 GrExt[nGrExt].Mask.Width := Source.Width; 540 GrExt[nGrExt].Mask.Height := Source.Height; 541 542 for y := 0 to Source.Height - 1 do 543 begin 544 DataLine := GrExt[nGrExt].Data.ScanLine[y]; 545 MaskLine := GrExt[nGrExt].Mask.ScanLine[y]; 546 for x := 0 to xmax - 1 do 460 547 begin 461 OriginalColor:=Cardinal((@DataLine[x])^) and $FFFFFF;462 if (OriginalColor=$FF00FF) or (OriginalColor=$7F007F) then548 OriginalColor := Cardinal((@DataLine[x])^) and $FFFFFF; 549 if (OriginalColor = $FF00FF) or (OriginalColor = $7F007F) then 463 550 begin // transparent 464 Cardinal((@MaskLine[x])^):=$FFFFFF;465 Cardinal((@DataLine[x])^):=Cardinal((@DataLine[x])^) and $FF000000551 Cardinal((@MaskLine[x])^) := $FFFFFF; 552 Cardinal((@DataLine[x])^) := Cardinal((@DataLine[x])^) and $FF000000 466 553 end 467 else554 else 468 555 begin 469 Cardinal((@MaskLine[x])^):=$000000; // non-transparent470 if Gamma<>100 then556 Cardinal((@MaskLine[x])^) := $000000; // non-transparent 557 if Gamma <> 100 then 471 558 begin 472 DataLine[x,0]:=GammaLUT[DataLine[x,0]];473 DataLine[x,1]:=GammaLUT[DataLine[x,1]];474 DataLine[x,2]:=GammaLUT[DataLine[x,2]];559 DataLine[x, 0] := GammaLUT[DataLine[x, 0]]; 560 DataLine[x, 1] := GammaLUT[DataLine[x, 1]]; 561 DataLine[x, 2] := GammaLUT[DataLine[x, 2]]; 475 562 end 476 563 end … … 478 565 end; 479 566 480 FillChar(GrExt[nGrExt].pixUsed,GrExt[nGrExt].Data.Height div 49 *10,0);481 inc(nGrExt)482 end 483 end; 484 485 procedure Dump(dst: TBitmap; HGr,xDst,yDst,Width,Height,xGr,yGr: integer);486 begin 487 BitBlt(dst.Canvas.Handle,xDst,yDst,Width,Height,488 GrExt[HGr].Data.Canvas.Handle,xGr,yGr,SRCCOPY);489 end; 490 491 procedure MakeBlue( Dst: TBitmap; x,y,w,h: integer);567 FillChar(GrExt[nGrExt].pixUsed, GrExt[nGrExt].Data.Height div 49 * 10, 0); 568 inc(nGrExt) 569 end 570 end; 571 572 procedure Dump(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, yGr: integer); 573 begin 574 BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height, 575 GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCCOPY); 576 end; 577 578 procedure MakeBlue(dst: TBitmap; x, y, w, h: integer); 492 579 type 493 TLine=array[0..99999,0..2] of Byte;494 PLine=^TLine;495 496 procedure BlueLine(line: PLine; length: integer);580 TLine = array [0 .. 99999, 0 .. 2] of Byte; 581 PLine = ^TLine; 582 583 procedure BlueLine(line: PLine; Length: integer); 497 584 var 585 i: integer; 586 begin 587 for i := 0 to Length - 1 do 588 begin 589 line[i, 0] := line[i, 0] div 2; 590 line[i, 1] := line[i, 1] div 2; 591 line[i, 2] := line[i, 2] div 2; 592 end 593 end; 594 595 var 498 596 i: integer; 499 begin 500 for i:=0 to length-1 do 501 begin 502 line[i,0]:=line[i,0] div 2; 503 line[i,1]:=line[i,1] div 2; 504 line[i,2]:=line[i,2] div 2; 505 end 506 end; 507 508 var 509 i: integer; 510 begin 511 for i:=0 to h-1 do 512 BlueLine(@(PLine(Dst.ScanLine[y+i])[x]),w) 513 end; 514 515 procedure ImageOp_B(Dst,Src: TBitmap; xDst,yDst,xSrc,ySrc,w,h: integer); 597 begin 598 for i := 0 to h - 1 do 599 BlueLine(@(PLine(dst.ScanLine[y + i])[x]), w) 600 end; 601 602 procedure ImageOp_B(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h: integer); 516 603 // Src is template 517 604 // X channel = background amp (old Dst content), 128=original brightness 518 605 type 519 TPixel=array[0..2] of Byte; 520 var 521 i,Brightness,test: integer; 522 PixelSrc: ^byte; 523 PixelDst: ^TPixel; 524 begin 525 assert(Src.PixelFormat=pf8bit); 526 assert(Dst.PixelFormat=pf24bit); 527 if xDst<0 then 528 begin w:=w+xDst; xSrc:=xSrc-xDst; xDst:=0; end; 529 if yDst<0 then 530 begin h:=h+yDst; ySrc:=ySrc-yDst; yDst:=0; end; 531 if xDst+w>Dst.Width then 532 w:=Dst.Width-xDst; 533 if yDst+h>Dst.Height then 534 h:=Dst.Height-yDst; 535 if (w<0) or (h<0) then 536 exit; 537 538 h:=yDst+h; 539 while yDst<h do 540 begin 541 PixelDst:=pointer(integer(Dst.ScanLine[yDst])+3*xDst); 542 PixelSrc:=pointer(integer(Src.ScanLine[ySrc])+xSrc); 543 for i:=0 to w-1 do 544 begin 545 Brightness:=PixelSrc^; 546 test:=(PixelDst[2]*Brightness) shr 7; 547 if test>=256 then PixelDst[2]:=255 548 else PixelDst[2]:=test; // Red 549 test:=(PixelDst[1]*Brightness) shr 7; 550 if test>=256 then PixelDst[1]:=255 551 else PixelDst[1]:=test; // Green 552 test:=(PixelDst[0]*Brightness) shr 7; 553 if test>=256 then PixelDst[2]:=255 554 else PixelDst[0]:=test; // Blue 555 PixelDst:=pointer(integer(PixelDst)+3); 556 PixelSrc:=pointer(integer(PixelSrc)+1); 557 end; 558 inc(yDst); 559 inc(ySrc); 560 end 561 end; 562 563 procedure ImageOp_BCC(Dst,Src: TBitmap; xDst,yDst,xSrc,ySrc,w,h,Color1,Color2: integer); 606 TPixel = array [0 .. 2] of Byte; 607 var 608 i, Brightness, test: integer; 609 PixelSrc: ^Byte; 610 PixelDst: ^TPixel; 611 begin 612 assert(Src.PixelFormat = pf8bit); 613 assert(dst.PixelFormat = pf24bit); 614 if xDst < 0 then 615 begin 616 w := w + xDst; 617 xSrc := xSrc - xDst; 618 xDst := 0; 619 end; 620 if yDst < 0 then 621 begin 622 h := h + yDst; 623 ySrc := ySrc - yDst; 624 yDst := 0; 625 end; 626 if xDst + w > dst.Width then 627 w := dst.Width - xDst; 628 if yDst + h > dst.Height then 629 h := dst.Height - yDst; 630 if (w < 0) or (h < 0) then 631 exit; 632 633 h := yDst + h; 634 while yDst < h do 635 begin 636 PixelDst := pointer(integer(dst.ScanLine[yDst]) + 3 * xDst); 637 PixelSrc := pointer(integer(Src.ScanLine[ySrc]) + xSrc); 638 for i := 0 to w - 1 do 639 begin 640 Brightness := PixelSrc^; 641 test := (PixelDst[2] * Brightness) shr 7; 642 if test >= 256 then 643 PixelDst[2] := 255 644 else 645 PixelDst[2] := test; // Red 646 test := (PixelDst[1] * Brightness) shr 7; 647 if test >= 256 then 648 PixelDst[1] := 255 649 else 650 PixelDst[1] := test; // Green 651 test := (PixelDst[0] * Brightness) shr 7; 652 if test >= 256 then 653 PixelDst[2] := 255 654 else 655 PixelDst[0] := test; // Blue 656 PixelDst := pointer(integer(PixelDst) + 3); 657 PixelSrc := pointer(integer(PixelSrc) + 1); 658 end; 659 inc(yDst); 660 inc(ySrc); 661 end 662 end; 663 664 procedure ImageOp_BCC(dst, Src: TBitmap; xDst, yDst, xSrc, ySrc, w, h, Color1, 665 Color2: integer); 564 666 // Src is template 565 667 // B channel = background amp (old Dst content), 128=original brightness … … 567 669 // R channel = Color2 amp, 128=original brightness 568 670 type 569 TLine=array[0..9999,0..2] of Byte; 570 var 571 ix,iy,amp1,amp2,trans,Value: integer; 572 SrcLine,DstLine: ^TLine; 573 begin 574 if xDst<0 then 575 begin w:=w+xDst; xSrc:=xSrc-xDst; xDst:=0; end; 576 if yDst<0 then 577 begin h:=h+yDst; ySrc:=ySrc-yDst; yDst:=0; end; 578 if xDst+w>Dst.Width then 579 w:=Dst.Width-xDst; 580 if yDst+h>Dst.Height then 581 h:=Dst.Height-yDst; 582 if (w<0) or (h<0) then 583 exit; 584 585 for iy:=0 to h-1 do 586 begin 587 SrcLine:=Src.ScanLine[ySrc+iy]; 588 DstLine:=Dst.ScanLine[yDst+iy]; 589 for ix:=0 to w-1 do 590 begin 591 trans:=SrcLine[xSrc+ix,0]*2; // green channel = transparency 592 amp1:=SrcLine[xSrc+ix,1]*2; 593 amp2:=SrcLine[xSrc+ix,2]*2; 594 if trans<>$FF then 671 TLine = array [0 .. 9999, 0 .. 2] of Byte; 672 var 673 ix, iy, amp1, amp2, trans, Value: integer; 674 SrcLine, DstLine: ^TLine; 675 begin 676 if xDst < 0 then 677 begin 678 w := w + xDst; 679 xSrc := xSrc - xDst; 680 xDst := 0; 681 end; 682 if yDst < 0 then 683 begin 684 h := h + yDst; 685 ySrc := ySrc - yDst; 686 yDst := 0; 687 end; 688 if xDst + w > dst.Width then 689 w := dst.Width - xDst; 690 if yDst + h > dst.Height then 691 h := dst.Height - yDst; 692 if (w < 0) or (h < 0) then 693 exit; 694 695 for iy := 0 to h - 1 do 696 begin 697 SrcLine := Src.ScanLine[ySrc + iy]; 698 DstLine := dst.ScanLine[yDst + iy]; 699 for ix := 0 to w - 1 do 700 begin 701 trans := SrcLine[xSrc + ix, 0] * 2; // green channel = transparency 702 amp1 := SrcLine[xSrc + ix, 1] * 2; 703 amp2 := SrcLine[xSrc + ix, 2] * 2; 704 if trans <> $FF then 595 705 begin 596 Value:=(DstLine[xDst+ix][0]*trans+(Color2 shr 16 and $FF)*amp2+(Color1 shr 16 and $FF)*amp1) div $FF; 597 if Value<256 then 598 DstLine[xDst+ix][0]:=Value 599 else DstLine[xDst+ix][0]:=255; 600 Value:=(DstLine[xDst+ix][1]*trans+(Color2 shr 8 and $FF)*amp2+(Color1 shr 8 and $FF)*amp1) div $FF; 601 if Value<256 then 602 DstLine[xDst+ix][1]:=Value 603 else DstLine[xDst+ix][1]:=255; 604 Value:=(DstLine[xDst+ix][2]*trans+(Color2 and $FF)*amp2+(Color1 and $FF)*amp1) div $FF; 605 if Value<256 then 606 DstLine[xDst+ix][2]:=Value 607 else DstLine[xDst+ix][2]:=255; 706 Value := (DstLine[xDst + ix][0] * trans + (Color2 shr 16 and $FF) * amp2 707 + (Color1 shr 16 and $FF) * amp1) div $FF; 708 if Value < 256 then 709 DstLine[xDst + ix][0] := Value 710 else 711 DstLine[xDst + ix][0] := 255; 712 Value := (DstLine[xDst + ix][1] * trans + (Color2 shr 8 and $FF) * amp2 713 + (Color1 shr 8 and $FF) * amp1) div $FF; 714 if Value < 256 then 715 DstLine[xDst + ix][1] := Value 716 else 717 DstLine[xDst + ix][1] := 255; 718 Value := (DstLine[xDst + ix][2] * trans + (Color2 and $FF) * amp2 + 719 (Color1 and $FF) * amp1) div $FF; 720 if Value < 256 then 721 DstLine[xDst + ix][2] := Value 722 else 723 DstLine[xDst + ix][2] := 255; 608 724 end 609 725 end … … 611 727 end; 612 728 613 procedure ImageOp_CCC(Bmp: TBitmap; x,y,w,h,Color0,Color1,Color2: integer); 729 procedure ImageOp_CCC(bmp: TBitmap; x, y, w, h, Color0, Color1, 730 Color2: integer); 614 731 // Bmp is template 615 732 // B channel = Color0 amp, 128=original brightness … … 617 734 // R channel = Color2 amp, 128=original brightness 618 735 type 619 TPixel=array[0..2] of Byte; 620 var 621 i,Red,Green: integer; 622 Pixel: ^TPixel; 623 begin 624 assert(Bmp.PixelFormat=pf24bit); 625 h:=y+h; 626 while y<h do 627 begin 628 Pixel:=pointer(integer(Bmp.ScanLine[y])+3*x); 629 for i:=0 to w-1 do 630 begin 631 Red:= (Pixel[0]*(Color0 and $0000FF) 632 +Pixel[1]*(Color1 and $0000FF) 633 +Pixel[2]*(Color2 and $0000FF)) shr 8; 634 Green:= (Pixel[0]*(Color0 shr 8 and $0000FF) 635 +Pixel[1]*(Color1 shr 8 and $0000FF) 636 +Pixel[2]*(Color2 shr 8 and $0000FF)) shr 8; 637 Pixel[0]:= (Pixel[0]*(Color0 shr 16 and $0000FF) 638 +Pixel[1]*(Color1 shr 16 and $0000FF) 639 +Pixel[2]*(Color2 shr 16 and $0000FF)) shr 8; // Blue 640 Pixel[1]:=Green; 641 Pixel[2]:=Red; 642 Pixel:=pointer(integer(pixel)+3); 643 end; 644 inc(y); 645 end 646 end; 647 648 procedure Sprite(Canvas: TCanvas; HGr,xDst,yDst,Width,Height,xGr,yGr: integer); 649 begin 650 BitBlt(Canvas.Handle,xDst,yDst,Width,Height, 651 GrExt[HGr].Mask.Canvas.Handle,xGr,yGr,SRCAND); 652 BitBlt(Canvas.Handle,xDst,yDst,Width,Height, 653 GrExt[HGr].Data.Canvas.Handle,xGr,yGr,SRCPAINT); 654 end; 655 656 procedure Sprite(dst:TBitmap; HGr,xDst,yDst,Width,Height,xGr,yGr: integer); 657 begin 658 BitBlt(dst.Canvas.Handle,xDst,yDst,Width,Height, 659 GrExt[HGr].Mask.Canvas.Handle,xGr,yGr,SRCAND); 660 BitBlt(dst.Canvas.Handle,xDst,yDst,Width,Height, 661 GrExt[HGr].Data.Canvas.Handle,xGr,yGr,SRCPAINT); 662 end; 663 664 procedure SLine(ca: TCanvas; x0,x1,y: integer; cl: TColor); 665 begin 666 with ca do 667 begin 668 Pen.Color:=cl; MoveTo(x0,y); LineTo(x1+1,y); 669 end 670 end; 671 672 procedure DLine(ca: TCanvas; x0,x1,y: integer; cl0,cl1: TColor); 673 begin 674 with ca do 675 begin 676 Pen.Color:=cl0; MoveTo(x0,y); LineTo(x1,y); 677 Pen.Color:=cl1; MoveTo(x0+1,y+1); LineTo(x1+1,y+1); 678 Pixels[x0,y+1]:=cl0; Pixels[x1,y]:=cl1; 679 end 680 end; 681 682 procedure Frame(ca: TCanvas;x0,y0,x1,y1:integer;cl0,cl1:TColor); 683 begin 684 with ca do 685 begin 686 MoveTo(x0,y1); 687 Pen.Color:=cl0;LineTo(x0,y0);LineTo(x1,y0); 688 Pen.Color:=cl1;LineTo(x1,y1);LineTo(x0,y1); 689 end 690 end; 691 692 procedure RFrame(ca: TCanvas;x0,y0,x1,y1:integer;cl0,cl1:TColor); 693 begin 694 with ca do 695 begin 696 Pen.Color:=cl0; 697 MoveTo(x0,y0+1);LineTo(x0,y1); 698 MoveTo(x0+1,y0);LineTo(x1,y0); 699 Pen.Color:=cl1; 700 MoveTo(x1,y0+1);LineTo(x1,y1); 701 MoveTo(x0+1,y1);LineTo(x1,y1); 702 end 703 end; 704 705 procedure CFrame(ca: TCanvas; x0,y0,x1,y1,Corner: integer; cl: TColor); 706 begin 707 with ca do 708 begin 709 Pen.Color:=cl; 710 MoveTo(x0,y0+Corner-1);LineTo(x0,y0);LineTo(x0+Corner,y0); 711 MoveTo(x1,y0+Corner-1);LineTo(x1,y0);LineTo(x1-Corner,y0); 712 MoveTo(x1,y1-Corner+1);LineTo(x1,y1);LineTo(x1-Corner,y1); 713 MoveTo(x0,y1-Corner+1);LineTo(x0,y1);LineTo(x0+Corner,y1); 714 end 715 end; 716 717 procedure FrameImage(ca: TCanvas; src:TBitmap; x,y,width,height,xSrc,ySrc: integer; 718 IsControl: boolean = false); 719 begin 720 if IsControl then 721 begin 722 Frame(ca,x-1,y-1,x+width,y+height,$B0B0B0,$FFFFFF); 723 RFrame(ca,x-2,y-2,x+width+1,y+height+1,$FFFFFF,$B0B0B0); 724 end 725 else Frame(ca,x-1,y-1,x+width,y+height,$000000,$000000); 726 BitBlt(ca.Handle,x,y,width,height,src.Canvas.Handle,xSrc,ySrc,SRCCOPY); 727 end; 728 729 procedure GlowFrame(dst: TBitmap; x0,y0,width,height: integer; cl: TColor); 736 TPixel = array [0 .. 2] of Byte; 737 var 738 i, Red, Green: integer; 739 Pixel: ^TPixel; 740 begin 741 assert(bmp.PixelFormat = pf24bit); 742 h := y + h; 743 while y < h do 744 begin 745 Pixel := pointer(integer(bmp.ScanLine[y]) + 3 * x); 746 for i := 0 to w - 1 do 747 begin 748 Red := (Pixel[0] * (Color0 and $0000FF) + Pixel[1] * (Color1 and $0000FF) 749 + Pixel[2] * (Color2 and $0000FF)) shr 8; 750 Green := (Pixel[0] * (Color0 shr 8 and $0000FF) + Pixel[1] * 751 (Color1 shr 8 and $0000FF) + Pixel[2] * (Color2 shr 8 and 752 $0000FF)) shr 8; 753 Pixel[0] := (Pixel[0] * (Color0 shr 16 and $0000FF) + Pixel[1] * 754 (Color1 shr 16 and $0000FF) + Pixel[2] * (Color2 shr 16 and $0000FF)) 755 shr 8; // Blue 756 Pixel[1] := Green; 757 Pixel[2] := Red; 758 Pixel := pointer(integer(Pixel) + 3); 759 end; 760 inc(y); 761 end 762 end; 763 764 procedure Sprite(Canvas: TCanvas; HGr, xDst, yDst, Width, Height, xGr, 765 yGr: integer); 766 begin 767 BitBlt(Canvas.Handle, xDst, yDst, Width, Height, 768 GrExt[HGr].Mask.Canvas.Handle, xGr, yGr, SRCAND); 769 BitBlt(Canvas.Handle, xDst, yDst, Width, Height, 770 GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCPAINT); 771 end; 772 773 procedure Sprite(dst: TBitmap; HGr, xDst, yDst, Width, Height, xGr, 774 yGr: integer); 775 begin 776 BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height, 777 GrExt[HGr].Mask.Canvas.Handle, xGr, yGr, SRCAND); 778 BitBlt(dst.Canvas.Handle, xDst, yDst, Width, Height, 779 GrExt[HGr].Data.Canvas.Handle, xGr, yGr, SRCPAINT); 780 end; 781 782 procedure SLine(ca: TCanvas; x0, x1, y: integer; cl: TColor); 783 begin 784 with ca do 785 begin 786 Pen.Color := cl; 787 MoveTo(x0, y); 788 LineTo(x1 + 1, y); 789 end 790 end; 791 792 procedure DLine(ca: TCanvas; x0, x1, y: integer; cl0, cl1: TColor); 793 begin 794 with ca do 795 begin 796 Pen.Color := cl0; 797 MoveTo(x0, y); 798 LineTo(x1, y); 799 Pen.Color := cl1; 800 MoveTo(x0 + 1, y + 1); 801 LineTo(x1 + 1, y + 1); 802 Pixels[x0, y + 1] := cl0; 803 Pixels[x1, y] := cl1; 804 end 805 end; 806 807 procedure Frame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor); 808 begin 809 with ca do 810 begin 811 MoveTo(x0, y1); 812 Pen.Color := cl0; 813 LineTo(x0, y0); 814 LineTo(x1, y0); 815 Pen.Color := cl1; 816 LineTo(x1, y1); 817 LineTo(x0, y1); 818 end 819 end; 820 821 procedure RFrame(ca: TCanvas; x0, y0, x1, y1: integer; cl0, cl1: TColor); 822 begin 823 with ca do 824 begin 825 Pen.Color := cl0; 826 MoveTo(x0, y0 + 1); 827 LineTo(x0, y1); 828 MoveTo(x0 + 1, y0); 829 LineTo(x1, y0); 830 Pen.Color := cl1; 831 MoveTo(x1, y0 + 1); 832 LineTo(x1, y1); 833 MoveTo(x0 + 1, y1); 834 LineTo(x1, y1); 835 end 836 end; 837 838 procedure CFrame(ca: TCanvas; x0, y0, x1, y1, Corner: integer; cl: TColor); 839 begin 840 with ca do 841 begin 842 Pen.Color := cl; 843 MoveTo(x0, y0 + Corner - 1); 844 LineTo(x0, y0); 845 LineTo(x0 + Corner, y0); 846 MoveTo(x1, y0 + Corner - 1); 847 LineTo(x1, y0); 848 LineTo(x1 - Corner, y0); 849 MoveTo(x1, y1 - Corner + 1); 850 LineTo(x1, y1); 851 LineTo(x1 - Corner, y1); 852 MoveTo(x0, y1 - Corner + 1); 853 LineTo(x0, y1); 854 LineTo(x0 + Corner, y1); 855 end 856 end; 857 858 procedure FrameImage(ca: TCanvas; Src: TBitmap; 859 x, y, Width, Height, xSrc, ySrc: integer; IsControl: boolean = false); 860 begin 861 if IsControl then 862 begin 863 Frame(ca, x - 1, y - 1, x + Width, y + Height, $B0B0B0, $FFFFFF); 864 RFrame(ca, x - 2, y - 2, x + Width + 1, y + Height + 1, $FFFFFF, $B0B0B0); 865 end 866 else 867 Frame(ca, x - 1, y - 1, x + Width, y + Height, $000000, $000000); 868 BitBlt(ca.Handle, x, y, Width, Height, Src.Canvas.Handle, xSrc, ySrc, 869 SRCCOPY); 870 end; 871 872 procedure GlowFrame(dst: TBitmap; x0, y0, Width, Height: integer; cl: TColor); 730 873 type 731 TLine=array[0..649,0..2] of Byte; 732 var 733 x,y,ch,r: integer; 734 DstLine: ^TLine; 735 begin 736 for y:=-GlowRange+1 to height-1+GlowRange-1 do 737 begin 738 DstLine:=dst.ScanLine[y0+y]; 739 for x:=-GlowRange+1 to width-1+GlowRange-1 do 740 begin 741 if x<0 then 742 if y<0 then r:=round(sqrt(sqr(x)+sqr(y))) 743 else if y>=height then r:=round(sqrt(sqr(x)+sqr(y-(height-1)))) 744 else r:=-x 745 else if x>=width then 746 if y<0 then r:=round(sqrt(sqr(x-(width-1))+sqr(y))) 747 else if y>=height then r:=round(sqrt(sqr(x-(width-1))+sqr(y-(height-1)))) 748 else r:=x-(width-1) 749 else if y<0 then r:=-y 750 else if y>=height then r:=y-(height-1) 751 else continue; 752 if r=0 then r:=1; 753 if r<GlowRange then 754 for ch:=0 to 2 do 755 DstLine[x0+x][2-ch]:=(DstLine[x0+x][2-ch]*(r-1) 756 +(cl shr (8*ch) and $FF)*(GlowRange-r)) div (GlowRange-1); 874 TLine = array [0 .. 649, 0 .. 2] of Byte; 875 var 876 x, y, ch, r: integer; 877 DstLine: ^TLine; 878 begin 879 for y := -GlowRange + 1 to Height - 1 + GlowRange - 1 do 880 begin 881 DstLine := dst.ScanLine[y0 + y]; 882 for x := -GlowRange + 1 to Width - 1 + GlowRange - 1 do 883 begin 884 if x < 0 then 885 if y < 0 then 886 r := round(sqrt(sqr(x) + sqr(y))) 887 else if y >= Height then 888 r := round(sqrt(sqr(x) + sqr(y - (Height - 1)))) 889 else 890 r := -x 891 else if x >= Width then 892 if y < 0 then 893 r := round(sqrt(sqr(x - (Width - 1)) + sqr(y))) 894 else if y >= Height then 895 r := round(sqrt(sqr(x - (Width - 1)) + sqr(y - (Height - 1)))) 896 else 897 r := x - (Width - 1) 898 else if y < 0 then 899 r := -y 900 else if y >= Height then 901 r := y - (Height - 1) 902 else 903 continue; 904 if r = 0 then 905 r := 1; 906 if r < GlowRange then 907 for ch := 0 to 2 do 908 DstLine[x0 + x][2 - ch] := 909 (DstLine[x0 + x][2 - ch] * (r - 1) + (cl shr (8 * ch) and $FF) * 910 (GlowRange - r)) div (GlowRange - 1); 757 911 end; 758 912 end … … 761 915 procedure InitOrnament; 762 916 var 763 x,y,p,light,shade: integer; 764 begin 765 if InitOrnamentDone then exit; 766 light:=MainTexture.clBevelLight; // and $FCFCFC shr 2*3+MainTexture.clBevelShade and $FCFCFC shr 2; 767 shade:=MainTexture.clBevelShade and $FCFCFC shr 2*3+MainTexture.clBevelLight and $FCFCFC shr 2; 768 for x:=0 to wOrna-1 do for y:=0 to hOrna-1 do 769 begin 770 p:=GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna+x,yOrna+y]; 771 if p=$0000FF then 772 GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna+x,yOrna+y]:=light 773 else if p=$FF0000 then 774 GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna+x,yOrna+y]:=shade 775 end; 776 InitOrnamentDone:=true 917 x, y, p, light, shade: integer; 918 begin 919 if InitOrnamentDone then 920 exit; 921 light := MainTexture.clBevelLight; 922 // and $FCFCFC shr 2*3+MainTexture.clBevelShade and $FCFCFC shr 2; 923 shade := MainTexture.clBevelShade and $FCFCFC shr 2 * 3 + 924 MainTexture.clBevelLight and $FCFCFC shr 2; 925 for x := 0 to wOrna - 1 do 926 for y := 0 to hOrna - 1 do 927 begin 928 p := GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y]; 929 if p = $0000FF then 930 GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := light 931 else if p = $FF0000 then 932 GrExt[HGrSystem2].Data.Canvas.Pixels[xOrna + x, yOrna + y] := shade 933 end; 934 InitOrnamentDone := true 777 935 end; 778 936 779 937 procedure InitCityMark(const T: TTexture); 780 938 var 781 x,y,intensity: integer; 782 begin 783 for x:=0 to 9 do for y:=0 to 9 do 784 if GrExt[HGrSystem].Mask.Canvas.Pixels[66+x,47+y]=0 then 785 begin 786 intensity:=GrExt[HGrSystem].Data.Canvas.Pixels[66+x,47+y] and $FF; 787 GrExt[HGrSystem].Data.Canvas.Pixels[77+x,47+y]:= 788 T.clMark and $FF *intensity div $FF 789 +T.clMark shr 8 and $FF *intensity div $FF shl 8 790 +T.clMark shr 16 and $FF *intensity div $FF shl 16 791 end; 792 bitblt(GrExt[HGrSystem].Mask.Canvas.Handle,77,47,10,10, 793 GrExt[HGrSystem].Mask.Canvas.Handle,66,47,SRCCOPY); 794 end; 795 796 procedure Fill(ca: TCanvas;Left,Top,Width,Height,xOffset,yOffset: integer); 797 begin 798 assert((left+xOffset>=0) and (left+xOffset+width<=wMainTexture) 799 and (top+yOffset>=0) and (top+yOffset+height<=hMainTexture)); 800 bitblt(ca.handle,left,top,width,height,MainTexture.Image.Canvas.Handle,left+xOffset,top+yOffset,SRCCOPY); 801 end; 802 803 procedure FillLarge(ca: TCanvas; x0,y0,x1,y1,xm: integer); 939 x, y, intensity: integer; 940 begin 941 for x := 0 to 9 do 942 for y := 0 to 9 do 943 if GrExt[HGrSystem].Mask.Canvas.Pixels[66 + x, 47 + y] = 0 then 944 begin 945 intensity := GrExt[HGrSystem].Data.Canvas.Pixels 946 [66 + x, 47 + y] and $FF; 947 GrExt[HGrSystem].Data.Canvas.Pixels[77 + x, 47 + y] := T.clMark and 948 $FF * intensity div $FF + T.clMark shr 8 and 949 $FF * intensity div $FF shl 8 + T.clMark shr 16 and 950 $FF * intensity div $FF shl 16 951 end; 952 BitBlt(GrExt[HGrSystem].Mask.Canvas.Handle, 77, 47, 10, 10, 953 GrExt[HGrSystem].Mask.Canvas.Handle, 66, 47, SRCCOPY); 954 end; 955 956 procedure Fill(ca: TCanvas; Left, Top, Width, Height, xOffset, 957 yOffset: integer); 958 begin 959 assert((Left + xOffset >= 0) and (Left + xOffset + Width <= wMainTexture) and 960 (Top + yOffset >= 0) and (Top + yOffset + Height <= hMainTexture)); 961 BitBlt(ca.Handle, Left, Top, Width, Height, MainTexture.Image.Canvas.Handle, 962 Left + xOffset, Top + yOffset, SRCCOPY); 963 end; 964 965 procedure FillLarge(ca: TCanvas; x0, y0, x1, y1, xm: integer); 804 966 805 967 function band(i: integer): integer; 806 968 var 807 n: integer; 808 begin 809 n:=((hMainTexture div 2) div (y1-y0))*2; 810 while hMainTexture div 2+(i+1)*(y1-y0)>hMainTexture do 811 dec(i,n); 812 while hMainTexture div 2+i*(y1-y0)<0 do 813 inc(i,n); 814 result:=i; 815 end; 816 817 var 818 i: integer; 819 begin 820 for i:=0 to (x1-xm) div wMainTexture-1 do 821 bitblt(ca.handle,xm+i*wMainTexture,y0,wMainTexture,y1-y0, 822 MainTexture.Image.canvas.handle,0,hMainTexture div 2+band(i)*(y1-y0),SRCCOPY); 823 bitblt(ca.handle,xm+((x1-xm) div wMainTexture)*wMainTexture,y0, 824 x1-(xm+((x1-xm) div wMainTexture)*wMainTexture),y1-y0, 825 MainTexture.Image.canvas.handle,0, 826 hMainTexture div 2+band((x1-xm) div wMainTexture)*(y1-y0),SRCCOPY); 827 for i:=0 to (xm-x0) div wMainTexture-1 do 828 bitblt(ca.handle,xm-(i+1)*wMainTexture,y0,wMainTexture,y1-y0, 829 MainTexture.Image.canvas.handle,0,hMainTexture div 2+band(-i-1)*(y1-y0),SRCCOPY); 830 bitblt(ca.handle,x0,y0,xm-((xm-x0) div wMainTexture)*wMainTexture-x0,y1-y0, 831 MainTexture.Image.canvas.handle,((xm-x0) div wMainTexture+1)*wMainTexture-(xm-x0), 832 hMainTexture div 2+band(-(xm-x0) div wMainTexture-1)*(y1-y0),SRCCOPY); 833 end; 834 835 procedure FillSeamless(ca: TCanvas;Left,Top,Width,Height,xOffset,yOffset: integer; 836 const Texture: TBitmap); 837 var 838 x,y,x0cut,y0cut,x1cut,y1cut: integer; 839 begin 840 while xOffset<0 do inc(xOffset,Texture.Width); 841 while yOffset<0 do inc(yOffset,Texture.Height); 842 for y:=(Top+yOffset) div Texture.Height to (Top+yOffset+Height-1) div Texture.Height do 843 begin 844 y0cut:=Top+yOffset-y*Texture.Height; 845 if y0cut<0 then y0cut:=0; 846 y1cut:=(y+1)*Texture.Height-(Top+yOffset+Height); 847 if y1cut<0 then y1cut:=0; 848 for x:=(Left+xOffset) div Texture.Width to (Left+xOffset+Width-1) div Texture.Width do 849 begin 850 x0cut:=Left+xOffset-x*Texture.Width; 851 if x0cut<0 then x0cut:=0; 852 x1cut:=(x+1)*Texture.Width-(Left+xOffset+Width); 853 if x1cut<0 then x1cut:=0; 854 BitBlt(ca.Handle,x*Texture.Width+x0cut-xOffset,y*Texture.Height+y0cut-yOffset, 855 Texture.Width-x0cut-x1cut,Texture.Height-y0cut-y1cut, 856 Texture.Canvas.Handle,x0cut,y0cut,SRCCOPY); 969 n: integer; 970 begin 971 n := ((hMainTexture div 2) div (y1 - y0)) * 2; 972 while hMainTexture div 2 + (i + 1) * (y1 - y0) > hMainTexture do 973 dec(i, n); 974 while hMainTexture div 2 + i * (y1 - y0) < 0 do 975 inc(i, n); 976 result := i; 977 end; 978 979 var 980 i: integer; 981 begin 982 for i := 0 to (x1 - xm) div wMainTexture - 1 do 983 BitBlt(ca.Handle, xm + i * wMainTexture, y0, wMainTexture, y1 - y0, 984 MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + band(i) * 985 (y1 - y0), SRCCOPY); 986 BitBlt(ca.Handle, xm + ((x1 - xm) div wMainTexture) * wMainTexture, y0, 987 x1 - (xm + ((x1 - xm) div wMainTexture) * wMainTexture), y1 - y0, 988 MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + 989 band((x1 - xm) div wMainTexture) * (y1 - y0), SRCCOPY); 990 for i := 0 to (xm - x0) div wMainTexture - 1 do 991 BitBlt(ca.Handle, xm - (i + 1) * wMainTexture, y0, wMainTexture, y1 - y0, 992 MainTexture.Image.Canvas.Handle, 0, hMainTexture div 2 + band(-i - 1) * 993 (y1 - y0), SRCCOPY); 994 BitBlt(ca.Handle, x0, y0, xm - ((xm - x0) div wMainTexture) * wMainTexture - 995 x0, y1 - y0, MainTexture.Image.Canvas.Handle, 996 ((xm - x0) div wMainTexture + 1) * wMainTexture - (xm - x0), 997 hMainTexture div 2 + band(-(xm - x0) div wMainTexture - 1) * 998 (y1 - y0), SRCCOPY); 999 end; 1000 1001 procedure FillSeamless(ca: TCanvas; Left, Top, Width, Height, xOffset, 1002 yOffset: integer; const Texture: TBitmap); 1003 var 1004 x, y, x0cut, y0cut, x1cut, y1cut: integer; 1005 begin 1006 while xOffset < 0 do 1007 inc(xOffset, Texture.Width); 1008 while yOffset < 0 do 1009 inc(yOffset, Texture.Height); 1010 for y := (Top + yOffset) div Texture.Height to (Top + yOffset + Height - 1) 1011 div Texture.Height do 1012 begin 1013 y0cut := Top + yOffset - y * Texture.Height; 1014 if y0cut < 0 then 1015 y0cut := 0; 1016 y1cut := (y + 1) * Texture.Height - (Top + yOffset + Height); 1017 if y1cut < 0 then 1018 y1cut := 0; 1019 for x := (Left + xOffset) div Texture.Width to (Left + xOffset + Width - 1) 1020 div Texture.Width do 1021 begin 1022 x0cut := Left + xOffset - x * Texture.Width; 1023 if x0cut < 0 then 1024 x0cut := 0; 1025 x1cut := (x + 1) * Texture.Width - (Left + xOffset + Width); 1026 if x1cut < 0 then 1027 x1cut := 0; 1028 BitBlt(ca.Handle, x * Texture.Width + x0cut - xOffset, 1029 y * Texture.Height + y0cut - yOffset, Texture.Width - x0cut - x1cut, 1030 Texture.Height - y0cut - y1cut, Texture.Canvas.Handle, x0cut, 1031 y0cut, SRCCOPY); 857 1032 end 858 1033 end; 859 1034 end; 860 1035 861 procedure FillRectSeamless(ca: TCanvas;x0,y0,x1,y1,xOffset,yOffset: integer; 862 const Texture: TBitmap); 863 begin 864 FillSeamless(ca,x0,y0,x1-x0,y1-y0,xOffset,yOffset,Texture); 865 end; 866 867 procedure PaintBackground(Form: TForm; Left,Top,Width,Height: integer); 868 begin 869 Fill(Form.Canvas,Left,Top,Width,Height,(wMaintexture-Form.ClientWidth) div 2, 870 (hMaintexture-Form.ClientHeight) div 2); 871 end; 872 873 procedure Corner(ca: TCanvas; x,y,Kind:integer; const T: TTexture); 874 begin 875 {BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle, 876 T.xGr+29+Kind*9,T.yGr+89,SRCAND); 877 BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Data.Canvas.Handle, 878 T.xGr+29+Kind*9,T.yGr+89,SRCPAINT);} 879 end; 880 881 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; 882 x,y:integer; s:string); 883 884 procedure PaintIcon(x,y,Kind: integer); 885 begin 886 BitBlt(ca.Handle,x,y+6,10,10,GrExt[HGrSystem].Mask.Canvas.Handle, 887 66+Kind mod 11 *11,115+Kind div 11 *11,SRCAND); 888 BitBlt(ca.Handle,x,y+6,10,10,GrExt[HGrSystem].Data.Canvas.Handle, 889 66+Kind mod 11 *11,115+Kind div 11 *11,SRCPAINT); 890 end; 891 892 var 893 p,xp: integer; 894 sp: string; 895 shadow: boolean; 896 begin 897 inc(x); inc(y); 898 for shadow:=true downto false do with ca do 899 if not shadow or (clBack<>$7F007F) then 900 begin 901 if shadow then Font.Color:=clBack 902 else Font.Color:=clMain; 903 sp:=s; 904 xp:=x; 1036 procedure FillRectSeamless(ca: TCanvas; x0, y0, x1, y1, xOffset, 1037 yOffset: integer; const Texture: TBitmap); 1038 begin 1039 FillSeamless(ca, x0, y0, x1 - x0, y1 - y0, xOffset, yOffset, Texture); 1040 end; 1041 1042 procedure PaintBackground(Form: TForm; Left, Top, Width, Height: integer); 1043 begin 1044 Fill(Form.Canvas, Left, Top, Width, Height, (wMainTexture - Form.ClientWidth) 1045 div 2, (hMainTexture - Form.ClientHeight) div 2); 1046 end; 1047 1048 procedure Corner(ca: TCanvas; x, y, Kind: integer; const T: TTexture); 1049 begin 1050 { BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Mask.Canvas.Handle, 1051 T.xGr+29+Kind*9,T.yGr+89,SRCAND); 1052 BitBlt(ca.Handle,x,y,8,8,GrExt[T.HGr].Data.Canvas.Handle, 1053 T.xGr+29+Kind*9,T.yGr+89,SRCPAINT); } 1054 end; 1055 1056 procedure BiColorTextOut(ca: TCanvas; clMain, clBack: TColor; x, y: integer; 1057 s: string); 1058 1059 procedure PaintIcon(x, y, Kind: integer); 1060 begin 1061 BitBlt(ca.Handle, x, y + 6, 10, 10, GrExt[HGrSystem].Mask.Canvas.Handle, 1062 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCAND); 1063 BitBlt(ca.Handle, x, y + 6, 10, 10, GrExt[HGrSystem].Data.Canvas.Handle, 1064 66 + Kind mod 11 * 11, 115 + Kind div 11 * 11, SRCPAINT); 1065 end; 1066 1067 var 1068 p, xp: integer; 1069 sp: string; 1070 shadow: boolean; 1071 begin 1072 inc(x); 1073 inc(y); 1074 for shadow := true downto false do 1075 with ca do 1076 if not shadow or (clBack <> $7F007F) then 1077 begin 1078 if shadow then 1079 Font.Color := clBack 1080 else 1081 Font.Color := clMain; 1082 sp := s; 1083 xp := x; 1084 repeat 1085 p := pos('%', sp); 1086 if (p = 0) or (p + 1 > Length(sp)) or 1087 not(sp[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) 1088 then 1089 begin 1090 ca.Textout(xp, y, sp); 1091 break 1092 end 1093 else 1094 begin 1095 Textout(xp, y, copy(sp, 1, p - 1)); 1096 inc(xp, ca.TextWidth(copy(sp, 1, p - 1))); 1097 if not shadow then 1098 case sp[p + 1] of 1099 'c': 1100 PaintIcon(xp + 1, y, 6); 1101 'f': 1102 PaintIcon(xp + 1, y, 0); 1103 'l': 1104 PaintIcon(xp + 1, y, 8); 1105 'm': 1106 PaintIcon(xp + 1, y, 17); 1107 'n': 1108 PaintIcon(xp + 1, y, 7); 1109 'o': 1110 PaintIcon(xp + 1, y, 16); 1111 'p': 1112 PaintIcon(xp + 1, y, 2); 1113 'r': 1114 PaintIcon(xp + 1, y, 12); 1115 't': 1116 PaintIcon(xp + 1, y, 4); 1117 'w': 1118 PaintIcon(xp + 1, y, 13); 1119 end; 1120 inc(xp, 10); 1121 Delete(sp, 1, p + 1); 1122 end 1123 until false; 1124 dec(x); 1125 dec(y); 1126 end 1127 end; 1128 1129 function BiColorTextWidth(ca: TCanvas; s: string): integer; 1130 var 1131 p: integer; 1132 begin 1133 result := 1; 905 1134 repeat 906 p:=pos('%',sp); 907 if (p=0) or (p+1>length(sp)) 908 or not (sp[p+1] in ['c','f','l','m','n','o','p','r','t','w']) then 909 begin ca.Textout(xp,y,sp); break end 1135 p := pos('%', s); 1136 if (p = 0) or (p = Length(s)) then 1137 begin 1138 inc(result, ca.TextWidth(s)); 1139 break 1140 end 910 1141 else 1142 begin 1143 if not(s[p + 1] in ['c', 'f', 'l', 'm', 'n', 'o', 'p', 'r', 't', 'w']) 1144 then 1145 inc(result, ca.TextWidth(copy(s, 1, p + 1))) 1146 else 1147 inc(result, ca.TextWidth(copy(s, 1, p - 1)) + 10); 1148 Delete(s, 1, p + 1); 1149 end 1150 until false; 1151 end; 1152 1153 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture; 1154 x, y: integer; s: string); 1155 begin 1156 if cl = -2 then 1157 BiColorTextOut(ca, (T.clBevelShade and $FEFEFE) shr 1, 1158 T.clBevelLight, x, y, s) 1159 else if cl < 0 then 1160 BiColorTextOut(ca, T.clTextShade, T.clTextLight, x, y, s) 1161 else 1162 BiColorTextOut(ca, cl, T.clTextLight, x, y, s) 1163 end; 1164 1165 procedure RisedTextOut(ca: TCanvas; x, y: integer; s: string); 1166 begin 1167 BiColorTextOut(ca, $FFFFFF, $000000, x, y, s) 1168 end; 1169 1170 procedure Gradient(ca: TCanvas; x, y, dx, dy, Width, Height, Color: integer; 1171 Brightness: array of integer); 1172 var 1173 i, r, g, b: integer; 1174 begin 1175 with ca do 1176 begin 1177 for i := 0 to 15 do 1178 begin // gradient 1179 r := Color and $FF + Brightness[i]; 1180 if r < 0 then 1181 r := 0 1182 else if r >= 256 then 1183 r := 255; 1184 g := Color shr 8 and $FF + Brightness[i]; 1185 if g < 0 then 1186 g := 0 1187 else if g >= 256 then 1188 g := 255; 1189 b := Color shr 16 and $FF + Brightness[i]; 1190 if b < 0 then 1191 b := 0 1192 else if b >= 256 then 1193 b := 255; 1194 Pen.Color := r + g shl 8 + b shl 16; 1195 MoveTo(x + dx * i, y + dy * i); 1196 LineTo(x + dx * i + Width, y + dy * i + Height); 1197 end; 1198 Pen.Color := $000000; 1199 MoveTo(x + 1, y + 16 * dy + Height); 1200 LineTo(x + 16 * dx + Width, y + 16 * dy + Height); 1201 LineTo(x + 16 * dx + Width, y); 1202 end 1203 end; 1204 1205 procedure LightGradient(ca: TCanvas; x, y, Width, Color: integer); 1206 const 1207 Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8, -12, 1208 -16, -20, -24, -28, -32, -36, -40, -44); 1209 begin 1210 Gradient(ca, x, y, 0, 1, Width, 0, Color, Brightness) 1211 end; 1212 1213 procedure DarkGradient(ca: TCanvas; x, y, Width, Kind: integer); 1214 const 1215 Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8, 1216 -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44); 1217 begin 1218 Gradient(ca, x, y, 0, 1, Width, 0, GrExt[HGrSystem].Data.Canvas.Pixels 1219 [187, 137 + Kind], Brightness) 1220 end; 1221 1222 procedure VLightGradient(ca: TCanvas; x, y, Height, Color: integer); 1223 const 1224 Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8, -12, 1225 -16, -20, -24, -28, -32, -36, -40, -44); 1226 begin 1227 Gradient(ca, x, y, 1, 0, 0, Height, Color, Brightness) 1228 end; 1229 1230 procedure VDarkGradient(ca: TCanvas; x, y, Height, Kind: integer); 1231 const 1232 Brightness: array [0 .. 15] of integer = (16, 12, 8, 4, 0, -4, -8, 1233 -12 - 24, -16 + 16, -20, -24, -28, -32, -36, -40, -44); 1234 begin 1235 Gradient(ca, x, y, 1, 0, 0, Height, GrExt[HGrSystem].Data.Canvas.Pixels 1236 [187, 137 + Kind], Brightness) 1237 end; 1238 1239 procedure NumberBar(dst: TBitmap; x, y: integer; Cap: string; val: integer; 1240 const T: TTexture); 1241 var 1242 s: string; 1243 begin 1244 if val > 0 then 1245 begin 1246 DLine(dst.Canvas, x - 2, x + 170, y + 16, T.clBevelShade, 1247 T.clBevelLight); 1248 LoweredTextOut(dst.Canvas, -1, T, x - 2, y, Cap); 1249 s := IntToStr(val); 1250 RisedTextOut(dst.Canvas, x + 170 - BiColorTextWidth(dst.Canvas, 1251 s), y, s); 1252 end 1253 end; 1254 1255 procedure CountBar(dst: TBitmap; x, y, w: integer; Kind: integer; 1256 Cap: string; val: integer; const T: TTexture); 1257 var 1258 i, sd, ld, cl, xIcon, yIcon: integer; 1259 s: string; 1260 begin 1261 // val:=random(40); //!!! 1262 if val = 0 then 1263 exit; 1264 assert(Kind >= 0); 1265 with dst.Canvas do 1266 begin 1267 // xIcon:=x+100; 1268 // yIcon:=y; 1269 // DLine(dst.Canvas,x-2,x+170+32,y+16,T.clBevelShade,T.clBevelLight); 1270 1271 xIcon := x - 5; 1272 yIcon := y + 15; 1273 DLine(dst.Canvas, x - 2, xIcon + w + 2, yIcon + 16, T.clBevelShade, 1274 T.clBevelLight); 1275 1276 s := IntToStr(val); 1277 if val < 0 then 1278 cl := $0000FF 1279 else 1280 cl := -1; 1281 LoweredTextOut(dst.Canvas, cl, T, x - 2, y, Cap); 1282 LoweredTextOut(dst.Canvas, cl, T, 1283 xIcon + w + 2 - BiColorTextWidth(dst.Canvas, s), yIcon, s); 1284 1285 if (Kind = 12) and (val >= 100) then 1286 begin // science with symbol for 100 1287 val := val div 10; 1288 sd := 14 * (val div 10 + val mod 10 - 1); 1289 if sd = 0 then 1290 sd := 1; 1291 if sd < w - 44 then 1292 ld := sd 1293 else 1294 ld := w - 44; 1295 for i := 0 to val mod 10 - 1 do 1296 begin 1297 BitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 2 + 1, 14, 1298 14, GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15, 1299 70 + Kind div 8 * 15, SRCAND); 1300 Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2, 1301 14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15); 1302 end; 1303 for i := 0 to val div 10 - 1 do 1304 begin 1305 BitBlt(dst.Canvas.Handle, xIcon + 4 + (val mod 10) * 1306 (14 * ld div sd) + i * (14 * ld div sd), yIcon + 3, 14, 14, 1307 GrExt[HGrSystem].Mask.Canvas.Handle, 67 + 7 mod 8 * 15, 1308 70 + 7 div 8 * 15, SRCAND); 1309 Sprite(dst, HGrSystem, xIcon + 3 + (val mod 10) * (14 * ld div sd) + 1310 i * (14 * ld div sd), yIcon + 2, 14, 14, 67 + 7 mod 8 * 15, 1311 70 + 7 div 8 * 15); 1312 end; 1313 end 1314 else 911 1315 begin 912 Textout(xp,y,copy(sp,1,p-1)); 913 inc(xp,ca.TextWidth(copy(sp,1,p-1))); 914 if not shadow then 915 case sp[p+1] of 916 'c': PaintIcon(xp+1,y,6); 917 'f': PaintIcon(xp+1,y,0); 918 'l': PaintIcon(xp+1,y,8); 919 'm': PaintIcon(xp+1,y,17); 920 'n': PaintIcon(xp+1,y,7); 921 'o': PaintIcon(xp+1,y,16); 922 'p': PaintIcon(xp+1,y,2); 923 'r': PaintIcon(xp+1,y,12); 924 't': PaintIcon(xp+1,y,4); 925 'w': PaintIcon(xp+1,y,13); 926 end; 927 inc(xp,10); 928 delete(sp,1,p+1); 1316 val := abs(val); 1317 if val mod 10 = 0 then 1318 sd := 14 * (val div 10 - 1) 1319 else 1320 sd := 10 * (val mod 10 - 1) + 14 * (val div 10); 1321 if sd = 0 then 1322 sd := 1; 1323 if sd < w - 44 then 1324 ld := sd 1325 else 1326 ld := w - 44; 1327 for i := 0 to val div 10 - 1 do 1328 begin 1329 BitBlt(Handle, xIcon + 4 + i * (14 * ld div sd), yIcon + 3, 14, 14, 1330 GrExt[HGrSystem].Mask.Canvas.Handle, 67 + Kind mod 8 * 15, 1331 70 + Kind div 8 * 15, SRCAND); 1332 Sprite(dst, HGrSystem, xIcon + 3 + i * (14 * ld div sd), yIcon + 2, 1333 14, 14, 67 + Kind mod 8 * 15, 70 + Kind div 8 * 15); 1334 end; 1335 for i := 0 to val mod 10 - 1 do 1336 begin 1337 BitBlt(dst.Canvas.Handle, xIcon + 4 + (val div 10) * 1338 (14 * ld div sd) + i * (10 * ld div sd), yIcon + 7, 10, 10, 1339 GrExt[HGrSystem].Mask.Canvas.Handle, 66 + Kind mod 11 * 11, 1340 115 + Kind div 11 * 11, SRCAND); 1341 Sprite(dst, HGrSystem, xIcon + 3 + (val div 10) * (14 * ld div sd) + 1342 i * (10 * ld div sd), yIcon + 6, 10, 10, 66 + Kind mod 11 * 11, 1343 115 + Kind div 11 * 11) 1344 end; 929 1345 end 930 until false; 931 dec(x); dec(y); 932 end 933 end; 934 935 function BiColorTextWidth(ca: TCanvas; s: string): integer; 936 var 937 p: integer; 938 begin 939 result:=1; 940 repeat 941 p:=pos('%',s); 942 if (p=0) or (p=Length(s)) then 943 begin inc(result,ca.TextWidth(s)); break end 944 else 945 begin 946 if not (s[p+1] in ['c','f','l','m','n','o','p','r','t','w']) then 947 inc(result,ca.TextWidth(copy(s,1,p+1))) 948 else inc(result,ca.TextWidth(copy(s,1,p-1))+10); 949 delete(s,1,p+1); 950 end 951 until false; 952 end; 953 954 procedure LoweredTextOut(ca: TCanvas; cl: TColor; const T: TTexture; 955 x,y:integer; s:string); 956 begin 957 if cl=-2 then 958 BiColorTextOut(ca, (T.clBevelShade and $FEFEFE) shr 1, T.clBevelLight, x, y, s) 959 else if cl<0 then 960 BiColorTextOut(ca, T.clTextShade, T.clTextLight, x, y, s) 961 else BiColorTextOut(ca, cl, T.clTextLight, x, y, s) 962 end; 963 964 procedure RisedTextOut(ca: TCanvas; x,y:integer; s:string); 965 begin 966 BiColorTextOut(ca, $FFFFFF, $000000, x, y, s) 967 end; 968 969 procedure Gradient(ca: TCanvas; x,y,dx,dy,width,height,Color:integer; Brightness: array of integer); 970 var 971 i,r,g,b: integer; 972 begin 973 with ca do 974 begin 975 for i:=0 to 15 do 976 begin // gradient 977 r:=Color and $FF+Brightness[i]; 978 if r<0 then r:=0 979 else if r>=256 then r:=255; 980 g:=Color shr 8 and $FF+Brightness[i]; 981 if g<0 then g:=0 982 else if g>=256 then g:=255; 983 b:=Color shr 16 and $FF+Brightness[i]; 984 if b<0 then b:=0 985 else if b>=256 then b:=255; 986 pen.color:=r+g shl 8+b shl 16; 987 MoveTo(x+dx*i,y+dy*i); 988 LineTo(x+dx*i+width,y+dy*i+height); 989 end; 990 pen.color:=$000000; 991 MoveTo(x+1,y+16*dy+height); 992 LineTo(x+16*dx+width,y+16*dy+height); 993 LineTo(x+16*dx+width,y); 994 end 995 end; 996 997 procedure LightGradient(ca: TCanvas; x,y,width,Color:integer); 998 const 999 Brightness: array[0..15] of integer= 1000 (16,12,8,4,0,-4,-8,-12,-16,-20,-24,-28,-32,-36,-40,-44); 1001 begin 1002 Gradient(ca,x,y,0,1,width,0,Color,Brightness) 1003 end; 1004 1005 procedure DarkGradient(ca: TCanvas; x,y,width,Kind:integer); 1006 const 1007 Brightness: array[0..15] of integer= 1008 (16,12,8,4,0,-4,-8,-12-24,-16+16,-20,-24,-28,-32,-36,-40,-44); 1009 begin 1010 Gradient(ca,x,y,0,1,width,0, 1011 GrExt[HGrSystem].Data.Canvas.Pixels[187,137+Kind],Brightness) 1012 end; 1013 1014 procedure VLightGradient(ca: TCanvas; x,y,height,Color:integer); 1015 const 1016 Brightness: array[0..15] of integer= 1017 (16,12,8,4,0,-4,-8,-12,-16,-20,-24,-28,-32,-36,-40,-44); 1018 begin 1019 Gradient(ca,x,y,1,0,0,height,Color,Brightness) 1020 end; 1021 1022 procedure VDarkGradient(ca: TCanvas; x,y,height,Kind:integer); 1023 const 1024 Brightness: array[0..15] of integer= 1025 (16,12,8,4,0,-4,-8,-12-24,-16+16,-20,-24,-28,-32,-36,-40,-44); 1026 begin 1027 Gradient(ca,x,y,1,0,0,height, 1028 GrExt[HGrSystem].Data.Canvas.Pixels[187,137+Kind],Brightness) 1029 end; 1030 1031 procedure NumberBar(dst:TBitmap; x,y:integer; 1032 Cap:string; val: integer; const T: TTexture); 1033 var 1034 s:string; 1035 begin 1036 if val>0 then 1037 begin 1038 DLine(dst.Canvas,x-2,x+170,y+16,T.clBevelShade,T.clBevelLight); 1039 LoweredTextOut(dst.Canvas,-1,T,x-2,y,Cap); 1040 s:=IntToStr(val); 1041 RisedTextout(dst.canvas,x+170-BiColorTextWidth(dst.Canvas,s),y,s); 1042 end 1043 end; 1044 1045 procedure CountBar(dst:TBitmap; x,y,w:integer; Kind:integer; 1046 Cap:string; val: integer; const T: TTexture); 1047 var 1048 i,sd,ld,cl,xIcon,yIcon: integer; 1049 s:string; 1050 begin 1051 //val:=random(40); //!!! 1052 if val=0 then exit; 1053 assert(Kind>=0); 1054 with dst.Canvas do 1055 begin 1056 // xIcon:=x+100; 1057 // yIcon:=y; 1058 // DLine(dst.Canvas,x-2,x+170+32,y+16,T.clBevelShade,T.clBevelLight); 1059 1060 xIcon:=x-5; 1061 yIcon:=y+15; 1062 DLine(dst.Canvas,x-2,xIcon+w+2,yIcon+16,T.clBevelShade,T.clBevelLight); 1063 1064 s:=IntToStr(val); 1065 if val<0 then cl:=$0000FF 1066 else cl:=-1; 1067 LoweredTextOut(dst.Canvas,cl,T,x-2,y,Cap); 1068 LoweredTextout(dst.canvas,cl,T,xIcon+w+2-BiColorTextWidth(dst.Canvas,s),yIcon,s); 1069 1070 if (Kind=12) and (val>=100) then 1071 begin // science with symbol for 100 1072 val:=val div 10; 1073 sd:=14*(val div 10+val mod 10-1); 1074 if sd=0 then sd:=1; 1075 if sd<w-44 then ld:=sd else ld:=w-44; 1076 for i:=0 to val mod 10-1 do 1346 end 1347 end; // CountBar 1348 1349 procedure PaintProgressBar(ca: TCanvas; 1350 Kind, x, y, pos, Growth, max: integer; const T: TTexture); 1351 var 1352 i: integer; 1353 begin 1354 if pos > max then 1355 pos := max; 1356 if Growth < 0 then 1077 1357 begin 1078 BitBlt(Handle,xIcon+4+i*(14*ld div sd),yIcon+2+1,14,14, 1079 GrExt[HGrSystem].Mask.Canvas.Handle, 1080 67+Kind mod 8 *15,70+Kind div 8 *15,SRCAND); 1081 Sprite(dst,HGrSystem,xIcon+3+i*(14*ld div sd),yIcon+2,14,14, 1082 67+Kind mod 8 *15,70+Kind div 8 *15); 1083 end; 1084 for i:=0 to val div 10-1 do 1358 pos := pos + Growth; 1359 if pos < 0 then 1360 begin 1361 Growth := Growth - pos; 1362 pos := 0 1363 end 1364 end 1365 else if pos + Growth > max then 1366 Growth := max - pos; 1367 Frame(ca, x - 1, y - 1, x + max, y + 7, $000000, $000000); 1368 RFrame(ca, x - 2, y - 2, x + max + 1, y + 8, T.clBevelShade, 1369 T.clBevelLight); 1370 with ca do 1085 1371 begin 1086 BitBlt(dst.Canvas.Handle,xIcon+4+(val mod 10)*(14*ld div sd) 1087 +i*(14*ld div sd),yIcon+3,14,14, 1088 GrExt[HGrSystem].Mask.Canvas.Handle,67+7 mod 8 *15,70+7 div 8 *15, 1089 SRCAND); 1090 Sprite(dst,HGrSystem,xIcon+3+(val mod 10)*(14*ld div sd) 1091 +i*(14*ld div sd),yIcon+2,14,14,67+7 mod 8 *15,70+7 div 8 *15); 1092 end; 1093 end 1094 else 1095 begin 1096 val:=abs(val); 1097 if val mod 10=0 then sd:=14*(val div 10-1) 1098 else sd:=10*(val mod 10-1)+14*(val div 10); 1099 if sd=0 then sd:=1; 1100 if sd<w-44 then ld:=sd else ld:=w-44; 1101 for i:=0 to val div 10-1 do 1102 begin 1103 BitBlt(Handle,xIcon+4+i*(14*ld div sd),yIcon+3,14,14, 1104 GrExt[HGrSystem].Mask.Canvas.Handle,67+Kind mod 8 *15,70+Kind div 8 *15,SRCAND); 1105 Sprite(dst,HGrSystem,xIcon+3+i*(14*ld div sd),yIcon+2,14,14,67+Kind mod 8 *15, 1106 70+Kind div 8 *15); 1107 end; 1108 for i:=0 to val mod 10-1 do 1109 begin 1110 BitBlt(dst.Canvas.Handle,xIcon+4+(val div 10)*(14*ld div sd) 1111 +i*(10*ld div sd),yIcon+7,10,10,GrExt[HGrSystem].Mask.Canvas.Handle, 1112 66+Kind mod 11 *11,115+Kind div 11 *11,SRCAND); 1113 Sprite(dst,HGrSystem,xIcon+3+(val div 10)*(14*ld div sd) 1114 +i*(10*ld div sd),yIcon+6,10,10,66+Kind mod 11 *11,115+Kind div 11 *11) 1115 end; 1116 end 1117 end 1118 end; //CountBar 1119 1120 procedure PaintProgressBar(ca: TCanvas; Kind,x,y,pos,Growth,max: integer; 1121 const T: TTexture); 1122 var 1123 i: integer; 1124 begin 1125 if pos>max then pos:=max; 1126 if Growth<0 then 1127 begin 1128 pos:=pos+Growth; 1129 if pos<0 then begin Growth:=Growth-pos; pos:=0 end 1130 end 1131 else if pos+Growth>max then Growth:=max-pos; 1132 Frame(ca,x-1,y-1,x+max,y+7,$000000,$000000); 1133 RFrame(ca,x-2,y-2,x+max+1,y+8,T.clBevelShade,T.clBevelLight); 1134 with ca do 1135 begin 1136 for i:=0 to pos div 8-1 do 1137 BitBlt(Handle,x+i*8,y,8,7,GrExt[HGrSystem].Data.Canvas.Handle,104, 1138 9+8*Kind,SRCCOPY); 1139 BitBlt(Handle,x+8*(pos div 8),y, 1140 pos-8*(pos div 8),7,GrExt[HGrSystem].Data.Canvas.Handle,104,9+8*Kind,SRCCOPY); 1141 if Growth>0 then 1142 begin 1143 for i:=0 to Growth div 8-1 do 1144 BitBlt(Handle,x+pos+i*8,y,8,7,GrExt[HGrSystem].Data.Canvas.Handle,112, 1145 9+8*Kind,SRCCOPY); 1146 BitBlt(Handle,x+pos+8*(Growth div 8),y, 1147 Growth-8*(Growth div 8),7,GrExt[HGrSystem].Data.Canvas.Handle,112, 1148 9+8*Kind,SRCCOPY); 1149 end 1150 else if Growth<0 then 1151 begin 1152 for i:=0 to -Growth div 8-1 do 1153 BitBlt(Handle,x+pos+i*8,y,8,7,GrExt[HGrSystem].Data.Canvas.Handle,104,1, 1154 SRCCOPY); 1155 BitBlt(Handle,x+pos+8*(-Growth div 8),y, 1156 -Growth-8*(-Growth div 8),7,GrExt[HGrSystem].Data.Canvas.Handle,104,1, 1157 SRCCOPY); 1158 end; 1159 Brush.Color:=$000000; 1160 FillRect(Rect(x+pos+abs(Growth),y,x+max,y+7)); 1161 Brush.Style:=bsClear; 1162 end 1163 end; 1164 1165 // pos and growth are relative to max, set size independent 1166 procedure PaintRelativeProgressBar(ca: TCanvas; Kind,x,y,size,pos,Growth, 1167 max: integer; IndicateComplete: boolean; const T: TTexture); 1168 begin 1169 if Growth>0 then 1170 PaintProgressBar(ca,Kind,x,y,pos*size div max, 1171 (Growth*size+max div 2) div max,size,T) 1172 else PaintProgressBar(ca,Kind,x,y,pos*size div max, 1173 (Growth*size-max div 2) div max,size,T); 1174 if IndicateComplete and (pos+Growth>=max) then 1175 Sprite(ca, HGrSystem, x+size-10, y-7, 23, 16, 1, 129); 1176 end; 1177 1178 procedure PaintLogo(ca: TCanvas; x,y,clLight,clShade: integer); 1179 begin 1180 BitBlt(LogoBuffer.Canvas.Handle,0,0,wLogo,hLogo,ca.handle,x,y,SRCCOPY); 1181 ImageOp_BCC(LogoBuffer,Templates,0,0,1,1,wLogo,hLogo,clLight,clShade); 1182 BitBlt(ca.handle,x,y,wLogo,hLogo,LogoBuffer.Canvas.Handle,0,0,SRCCOPY); 1183 end; 1184 1185 function SetMainTextureByAge(Age: integer): boolean; 1186 begin 1187 if Age<>MainTextureAge then with MainTexture do 1188 begin 1189 MainTextureAge:=Age; 1190 LoadGraphicFile(Image,HomeDir+'Graphics\Texture'+inttostr(Age+1), gfJPG); 1191 clBevelLight:=Colors.Canvas.Pixels[clkAge0+Age,cliBevelLight]; 1192 clBevelShade:=Colors.Canvas.Pixels[clkAge0+Age,cliBevelShade]; 1193 clTextLight:=Colors.Canvas.Pixels[clkAge0+Age,cliTextLight]; 1194 clTextShade:=Colors.Canvas.Pixels[clkAge0+Age,cliTextShade]; 1195 clLitText:=Colors.Canvas.Pixels[clkAge0+Age,cliLitText]; 1196 clMark:=Colors.Canvas.Pixels[clkAge0+Age,cliMark]; 1197 clPage:=Colors.Canvas.Pixels[clkAge0+Age,cliPage]; 1198 clCover:=Colors.Canvas.Pixels[clkAge0+Age,cliCover]; 1199 result:=true 1200 end 1201 else result:=false 1202 end; 1203 1204 1205 var 1206 i,p,size: integer; 1207 s: string; 1208 fontscript: TextFile; 1209 section: TFontType; 1210 Reg: TRegistry; 1372 for i := 0 to pos div 8 - 1 do 1373 BitBlt(Handle, x + i * 8, y, 8, 7, 1374 GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY); 1375 BitBlt(Handle, x + 8 * (pos div 8), y, pos - 8 * (pos div 8), 7, 1376 GrExt[HGrSystem].Data.Canvas.Handle, 104, 9 + 8 * Kind, SRCCOPY); 1377 if Growth > 0 then 1378 begin 1379 for i := 0 to Growth div 8 - 1 do 1380 BitBlt(Handle, x + pos + i * 8, y, 8, 7, 1381 GrExt[HGrSystem].Data.Canvas.Handle, 112, 9 + 8 * Kind, SRCCOPY); 1382 BitBlt(Handle, x + pos + 8 * (Growth div 8), y, 1383 Growth - 8 * (Growth div 8), 7, GrExt[HGrSystem].Data.Canvas.Handle, 1384 112, 9 + 8 * Kind, SRCCOPY); 1385 end 1386 else if Growth < 0 then 1387 begin 1388 for i := 0 to -Growth div 8 - 1 do 1389 BitBlt(Handle, x + pos + i * 8, y, 8, 7, 1390 GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY); 1391 BitBlt(Handle, x + pos + 8 * (-Growth div 8), y, 1392 -Growth - 8 * (-Growth div 8), 7, 1393 GrExt[HGrSystem].Data.Canvas.Handle, 104, 1, SRCCOPY); 1394 end; 1395 Brush.Color := $000000; 1396 FillRect(Rect(x + pos + abs(Growth), y, x + max, y + 7)); 1397 Brush.Style := bsClear; 1398 end 1399 end; 1400 1401 // pos and growth are relative to max, set size independent 1402 procedure PaintRelativeProgressBar(ca: TCanvas; 1403 Kind, x, y, size, pos, Growth, max: integer; IndicateComplete: boolean; 1404 const T: TTexture); 1405 begin 1406 if Growth > 0 then 1407 PaintProgressBar(ca, Kind, x, y, pos * size div max, 1408 (Growth * size + max div 2) div max, size, T) 1409 else 1410 PaintProgressBar(ca, Kind, x, y, pos * size div max, 1411 (Growth * size - max div 2) div max, size, T); 1412 if IndicateComplete and (pos + Growth >= max) then 1413 Sprite(ca, HGrSystem, x + size - 10, y - 7, 23, 16, 1, 129); 1414 end; 1415 1416 procedure PaintLogo(ca: TCanvas; x, y, clLight, clShade: integer); 1417 begin 1418 BitBlt(LogoBuffer.Canvas.Handle, 0, 0, wLogo, hLogo, ca.Handle, x, 1419 y, SRCCOPY); 1420 ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 1, wLogo, hLogo, 1421 clLight, clShade); 1422 BitBlt(ca.Handle, x, y, wLogo, hLogo, LogoBuffer.Canvas.Handle, 0, 1423 0, SRCCOPY); 1424 end; 1425 1426 function SetMainTextureByAge(Age: integer): boolean; 1427 begin 1428 if Age <> MainTextureAge then 1429 with MainTexture do 1430 begin 1431 MainTextureAge := Age; 1432 LoadGraphicFile(Image, HomeDir + 'Graphics\Texture' + 1433 IntToStr(Age + 1), gfJPG); 1434 clBevelLight := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelLight]; 1435 clBevelShade := Colors.Canvas.Pixels[clkAge0 + Age, cliBevelShade]; 1436 clTextLight := Colors.Canvas.Pixels[clkAge0 + Age, cliTextLight]; 1437 clTextShade := Colors.Canvas.Pixels[clkAge0 + Age, cliTextShade]; 1438 clLitText := Colors.Canvas.Pixels[clkAge0 + Age, cliLitText]; 1439 clMark := Colors.Canvas.Pixels[clkAge0 + Age, cliMark]; 1440 clPage := Colors.Canvas.Pixels[clkAge0 + Age, cliPage]; 1441 clCover := Colors.Canvas.Pixels[clkAge0 + Age, cliCover]; 1442 result := true 1443 end 1444 else 1445 result := false 1446 end; 1447 1448 var 1449 i, p, size: integer; 1450 s: string; 1451 fontscript: TextFile; 1452 section: TFontType; 1453 Reg: TRegistry; 1211 1454 1212 1455 initialization 1213 Reg:=TRegistry.Create; 1214 Reg.OpenKey('SOFTWARE\cevo\RegVer9',true); 1456 1457 Reg := TRegistry.create; 1458 Reg.OpenKey('SOFTWARE\cevo\RegVer9', true); 1215 1459 try 1216 Gamma :=Reg.ReadInteger('Gamma');1460 Gamma := Reg.ReadInteger('Gamma'); 1217 1461 except 1218 Gamma :=100;1219 Reg.WriteInteger('Gamma', Gamma);1220 1462 Gamma := 100; 1463 Reg.WriteInteger('Gamma', Gamma); 1464 end; 1221 1465 Reg.closekey; 1222 1466 Reg.Free; 1223 1467 1224 if Gamma <>100 then1225 1226 GammaLUT[0] :=0;1227 for i :=1 to 255 do1228 1229 p :=round(255.0*exp(ln(i/255.0)*100.0/Gamma));1230 assert((p >=0) and (p<256));1231 GammaLUT[i] :=p;1232 1233 1468 if Gamma <> 100 then 1469 begin 1470 GammaLUT[0] := 0; 1471 for i := 1 to 255 do 1472 begin 1473 p := round(255.0 * exp(ln(i / 255.0) * 100.0 / Gamma)); 1474 assert((p >= 0) and (p < 256)); 1475 GammaLUT[i] := p; 1476 end; 1477 end; 1234 1478 1235 1479 EnumDisplaySettings(nil, $FFFFFFFF, StartResolution); 1236 ResolutionChanged :=false;1237 1238 Phrases :=TStringTable.Create;1239 Phrases2 :=TStringTable.Create;1240 Phrases2FallenBackToEnglish :=false;1241 if FileExists(DataDir +'Localization\Language.txt') then1242 1243 Phrases. LoadFromFile(DataDir+'Localization\Language.txt');1244 if FileExists(DataDir +'Localization\Language2.txt') then1245 Phrases2. LoadFromFile(DataDir+'Localization\Language2.txt')1480 ResolutionChanged := false; 1481 1482 Phrases := TStringTable.create; 1483 Phrases2 := TStringTable.create; 1484 Phrases2FallenBackToEnglish := false; 1485 if FileExists(DataDir + 'Localization\Language.txt') then 1486 begin 1487 Phrases.loadfromfile(DataDir + 'Localization\Language.txt'); 1488 if FileExists(DataDir + 'Localization\Language2.txt') then 1489 Phrases2.loadfromfile(DataDir + 'Localization\Language2.txt') 1246 1490 else 1247 1248 Phrases2. LoadFromFile(HomeDir+'Language2.txt');1249 Phrases2FallenBackToEnglish :=true;1250 1251 1491 begin 1492 Phrases2.loadfromfile(HomeDir + 'Language2.txt'); 1493 Phrases2FallenBackToEnglish := true; 1494 end 1495 end 1252 1496 else 1253 begin 1254 Phrases.LoadFromFile(HomeDir+'Language.txt'); 1255 Phrases2.LoadFromFile(HomeDir+'Language2.txt'); 1256 end; 1257 Sounds:=TStringTable.Create; 1258 if not Sounds.LoadFromFile(HomeDir+'Sounds\sound.txt') then 1259 begin Sounds.Free; Sounds:=nil end; 1260 1261 for section:=Low(TFontType) to High(TFontType) do 1262 UniFont[section]:=TFont.Create; 1263 1264 LogoBuffer:=TBitmap.Create; 1265 LogoBuffer.PixelFormat:=pf24bit; 1266 LogoBuffer.Width:=wBBook; 1267 LogoBuffer.Height:=hBBook; 1268 1269 section:=ftNormal; 1270 AssignFile(fontscript,LocalizedFilePath('Fonts.txt')); 1497 begin 1498 Phrases.loadfromfile(HomeDir + 'Language.txt'); 1499 Phrases2.loadfromfile(HomeDir + 'Language2.txt'); 1500 end; 1501 Sounds := TStringTable.create; 1502 if not Sounds.loadfromfile(HomeDir + 'Sounds\sound.txt') then 1503 begin 1504 Sounds.Free; 1505 Sounds := nil 1506 end; 1507 1508 for section := Low(TFontType) to High(TFontType) do 1509 UniFont[section] := TFont.create; 1510 1511 LogoBuffer := TBitmap.create; 1512 LogoBuffer.PixelFormat := pf24bit; 1513 LogoBuffer.Width := wBBook; 1514 LogoBuffer.Height := hBBook; 1515 1516 section := ftNormal; 1517 AssignFile(fontscript, LocalizedFilePath('Fonts.txt')); 1271 1518 try 1272 1519 Reset(fontscript); 1273 1520 while not eof(fontscript) do 1274 begin 1275 ReadLn(fontscript,s); 1276 if s<>'' then 1277 if s[1]='#' then 1521 begin 1522 ReadLn(fontscript, s); 1523 if s <> '' then 1524 if s[1] = '#' then 1525 begin 1526 s := TrimRight(s); 1527 if s = '#SMALL' then 1528 section := ftSmall 1529 else if s = '#TINY' then 1530 section := ftTiny 1531 else if s = '#CAPTION' then 1532 section := ftCaption 1533 else if s = '#BUTTON' then 1534 section := ftButton 1535 else 1536 section := ftNormal; 1537 end 1538 else 1539 begin 1540 p := pos(',', s); 1541 if p > 0 then 1278 1542 begin 1279 s:=TrimRight(s); 1280 if s='#SMALL' then section:=ftSmall 1281 else if s='#TINY' then section:=ftTiny 1282 else if s='#CAPTION' then section:=ftCaption 1283 else if s='#BUTTON' then section:=ftButton 1284 else section:=ftNormal; 1543 UniFont[section].Name := Trim(copy(s, 1, p - 1)); 1544 size := 0; 1545 for i := p + 1 to Length(s) do 1546 case s[i] of 1547 '0' .. '9': 1548 size := size * 10 + Byte(s[i]) - 48; 1549 'B', 'b': 1550 UniFont[section].Style := UniFont[section].Style + [fsBold]; 1551 'I', 'i': 1552 UniFont[section].Style := UniFont[section].Style + [fsItalic]; 1553 end; 1554 UniFont[section].size := 1555 round(size * 72 / UniFont[section].PixelsPerInch); 1285 1556 end 1286 else 1287 begin 1288 p:=pos(',',s); 1289 if p>0 then 1290 begin 1291 UniFont[section].Name:=Trim(copy(s,1,p-1)); 1292 size:=0; 1293 for i:=p+1 to length(s) do 1294 case s[i] of 1295 '0'..'9': size:=size*10+byte(s[i])-48; 1296 'B','b': UniFont[section].Style:=UniFont[section].Style+[fsBold]; 1297 'I','i': UniFont[section].Style:=UniFont[section].Style+[fsItalic]; 1298 end; 1299 UniFont[section].Size:=Round(size * 72/UniFont[section].PixelsPerInch); 1300 end 1301 end 1302 end; 1557 end 1558 end; 1303 1559 CloseFile(fontscript); 1304 1560 except 1305 1306 1307 nGrExt :=0;1308 HGrSystem :=LoadGraphicSet('System');1309 HGrSystem2 :=LoadGraphicSet('System2');1310 Templates :=TBitmap.Create;1311 LoadGraphicFile(Templates, HomeDir +'Graphics\Templates', gfNoGamma);1312 Templates.PixelFormat :=pf24bit;1313 Colors :=TBitmap.Create;1314 LoadGraphicFile(Colors, HomeDir+'Graphics\Colors');1315 Paper :=TBitmap.Create;1316 LoadGraphicFile(Paper, HomeDir+'Graphics\Paper',gfJPG);1317 BigImp :=TBitmap.Create;1318 LoadGraphicFile(BigImp, HomeDir +'Graphics\Icons');1319 MainTexture.Image :=TBitmap.Create;1320 MainTextureAge :=-2;1321 ClickFrameColor :=GrExt[HGrSystem].Data.Canvas.Pixels[187,175];1322 InitOrnamentDone :=false;1323 GenerateNames :=true;1561 end; 1562 1563 nGrExt := 0; 1564 HGrSystem := LoadGraphicSet('System'); 1565 HGrSystem2 := LoadGraphicSet('System2'); 1566 Templates := TBitmap.create; 1567 LoadGraphicFile(Templates, HomeDir + 'Graphics\Templates', gfNoGamma); 1568 Templates.PixelFormat := pf24bit; 1569 Colors := TBitmap.create; 1570 LoadGraphicFile(Colors, HomeDir + 'Graphics\Colors'); 1571 Paper := TBitmap.create; 1572 LoadGraphicFile(Paper, HomeDir + 'Graphics\Paper', gfJPG); 1573 BigImp := TBitmap.create; 1574 LoadGraphicFile(BigImp, HomeDir + 'Graphics\Icons'); 1575 MainTexture.Image := TBitmap.create; 1576 MainTextureAge := -2; 1577 ClickFrameColor := GrExt[HGrSystem].Data.Canvas.Pixels[187, 175]; 1578 InitOrnamentDone := false; 1579 GenerateNames := true; 1324 1580 1325 1581 finalization 1582 1326 1583 RestoreResolution; 1327 for i:=0 to nGrExt-1 do 1328 begin 1329 GrExt[i].Data.Free; GrExt[i].Mask.Free; 1584 for i := 0 to nGrExt - 1 do 1585 begin 1586 GrExt[i].Data.Free; 1587 GrExt[i].Mask.Free; 1330 1588 FreeMem(GrExt[i]); 1331 1332 for section :=Low(TFontType) to High(TFontType) do1589 end; 1590 for section := Low(TFontType) to High(TFontType) do 1333 1591 UniFont[section].Free; 1334 1592 Phrases.Free; 1335 if Sounds<>nil then Sounds.Free; 1593 if Sounds <> nil then 1594 Sounds.Free; 1336 1595 LogoBuffer.Free; 1337 1596 BigImp.Free; … … 1342 1601 1343 1602 end. 1344 -
trunk/Sound.pas
r2 r6 4 4 5 5 uses 6 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,MMSystem; 7 6 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, MMSystem; 8 7 9 8 function PrepareSound(FileName: string): integer; 10 9 procedure PlaySound(FileName: string); 11 10 12 13 11 type 14 TSoundPlayer = class(TForm)15 private16 procedure OnMCI(var m:TMessage); message MM_MCINOTIFY;12 TSoundPlayer = class(TForm) 13 private 14 procedure OnMCI(var m: TMessage); message MM_MCINOTIFY; 17 15 end; 18 19 16 20 17 implementation … … 22 19 {$R *.DFM} 23 20 24 25 21 type 26 TSound = class27 public28 FDeviceID: word;29 FFileName: string;30 constructor Create(const FileName: string);31 destructor Destroy; override;32 procedure Play(HWND: DWORD);33 procedure Stop;34 procedure Reset;22 TSound = class 23 public 24 FDeviceID: word; 25 FFileName: string; 26 constructor Create(const FileName: string); 27 destructor Destroy; override; 28 procedure Play(HWND: DWORD); 29 procedure Stop; 30 procedure Reset; 35 31 end; 36 37 32 38 33 constructor TSound.Create(const FileName: string); 39 34 var 40 OpenParm: TMCI_Open_Parms;35 OpenParm: TMCI_Open_Parms; 41 36 begin 42 FDeviceID:=0;43 FFileName:=FileName;44 if FileExists(FFileName) then37 FDeviceID := 0; 38 FFileName := FileName; 39 if FileExists(FFileName) then 45 40 begin 46 OpenParm.dwCallback:=0;47 OpenParm.lpstrDeviceType:='WaveAudio';48 OpenParm.lpstrElementName:=PChar(FFileName);49 mciSendCommand(0, MCI_Open,50 MCI_WAIT or MCI_OPEN_ELEMENT orMCI_OPEN_SHAREABLE, integer(@OpenParm));51 FDeviceID:=OpenParm.wDeviceID;41 OpenParm.dwCallback := 0; 42 OpenParm.lpstrDeviceType := 'WaveAudio'; 43 OpenParm.lpstrElementName := PChar(FFileName); 44 mciSendCommand(0, MCI_Open, MCI_WAIT or MCI_OPEN_ELEMENT or 45 MCI_OPEN_SHAREABLE, integer(@OpenParm)); 46 FDeviceID := OpenParm.wDeviceID; 52 47 end 53 48 end; … … 55 50 destructor TSound.Destroy; 56 51 begin 57 if FDeviceID<>0 then58 mciSendCommand(FDeviceID, MCI_CLOSE, MCI_WAIT, 0);59 inherited Destroy;52 if FDeviceID <> 0 then 53 mciSendCommand(FDeviceID, MCI_CLOSE, MCI_WAIT, 0); 54 inherited Destroy; 60 55 end; 61 56 62 procedure TSound.Play(HWND: dword);57 procedure TSound.Play(HWND: DWORD); 63 58 var 64 PlayParm: TMCI_Play_Parms;59 PlayParm: TMCI_Play_Parms; 65 60 begin 66 if FDeviceID<>0 then61 if FDeviceID <> 0 then 67 62 begin 68 PlayParm.dwCallback:=HWND;69 mciSendCommand(FDeviceID, MCI_PLAY, MCI_NOTIFY, integer(@PlayParm));63 PlayParm.dwCallback := HWND; 64 mciSendCommand(FDeviceID, MCI_PLAY, MCI_NOTIFY, integer(@PlayParm)); 70 65 end 71 66 end; … … 73 68 procedure TSound.Stop; 74 69 begin 75 mciSendCommand(FDeviceID, MCI_STOP, 0, 0);70 mciSendCommand(FDeviceID, MCI_STOP, 0, 0); 76 71 end; 77 72 78 73 procedure TSound.Reset; 79 74 begin 80 mciSendCommand(FDeviceID, MCI_SEEK, MCI_SEEK_TO_START, 0);75 mciSendCommand(FDeviceID, MCI_SEEK, MCI_SEEK_TO_START, 0); 81 76 end; 82 77 83 84 78 type 85 TSoundList=array[0..99999] of TSound;79 TSoundList = array [0 .. 99999] of TSound; 86 80 87 81 var 88 nSoundList: integer; 89 SoundPlayer: TSoundPlayer; 90 SoundList: ^TSoundList; 91 PlayingSound: TSound; 92 82 nSoundList: integer; 83 SoundPlayer: TSoundPlayer; 84 SoundList: ^TSoundList; 85 PlayingSound: TSound; 93 86 94 87 procedure TSoundPlayer.OnMCI(var m: TMessage); 95 88 begin 96 if (m.wParam=MCI_Notify_Successful) and (PlayingSound<>nil) then89 if (m.wParam = MCI_Notify_Successful) and (PlayingSound <> nil) then 97 90 begin 98 PlayingSound.Reset;99 PlayingSound:=nil;91 PlayingSound.Reset; 92 PlayingSound := nil; 100 93 end; 101 94 end; 102 95 103 104 96 function PrepareSound(FileName: string): integer; 105 97 begin 106 for result:=1 to Length(FileName) do107 FileName[result]:=upcase(FileName[result]);108 result:=0;109 while (result<nSoundList) and (SoundList[result].FFileName<>FileName) do110 inc(result);111 if result=nSoundList then98 for result := 1 to Length(FileName) do 99 FileName[result] := upcase(FileName[result]); 100 result := 0; 101 while (result < nSoundList) and (SoundList[result].FFileName <> FileName) do 102 inc(result); 103 if result = nSoundList then 112 104 begin // first time this sound is played 113 if nSoundList=0 then114 ReallocMem(SoundList, 16*4)115 else if (nSoundList>=16) and (nSoundList and (nSoundList-1)=0) then116 ReallocMem(SoundList, nSoundList*(2*4));117 inc(nSoundList);118 SoundList[result]:=TSound.Create(FileName);105 if nSoundList = 0 then 106 ReallocMem(SoundList, 16 * 4) 107 else if (nSoundList >= 16) and (nSoundList and (nSoundList - 1) = 0) then 108 ReallocMem(SoundList, nSoundList * (2 * 4)); 109 inc(nSoundList); 110 SoundList[result] := TSound.Create(FileName); 119 111 end; 120 112 end; … … 122 114 procedure PlaySound(FileName: string); 123 115 begin 124 if PlayingSound<>nil then 125 exit; 126 if SoundPlayer=nil then 127 Application.CreateForm(TSoundPlayer, SoundPlayer); 128 PlayingSound:=SoundList[PrepareSound(FileName)]; 129 if PlayingSound.FDeviceID=0 then PlayingSound:=nil 130 else PlayingSound.Play(SoundPlayer.Handle); 116 if PlayingSound <> nil then 117 exit; 118 if SoundPlayer = nil then 119 Application.CreateForm(TSoundPlayer, SoundPlayer); 120 PlayingSound := SoundList[PrepareSound(FileName)]; 121 if PlayingSound.FDeviceID = 0 then 122 PlayingSound := nil 123 else 124 PlayingSound.Play(SoundPlayer.Handle); 131 125 end; 132 126 133 127 var 134 i: integer;128 i: integer; 135 129 136 130 initialization 137 nSoundList:=0; 138 SoundList:=nil; 139 PlayingSound:=nil; 140 SoundPlayer:=nil; 131 132 nSoundList := 0; 133 SoundList := nil; 134 PlayingSound := nil; 135 SoundPlayer := nil; 141 136 142 137 finalization 143 if PlayingSound<>nil then 144 begin 138 139 if PlayingSound <> nil then 140 begin 145 141 PlayingSound.Stop; 146 142 Sleep(222); 147 148 for i :=0 to nSoundList-1 do143 end; 144 for i := 0 to nSoundList - 1 do 149 145 SoundList[i].Free; 150 ReallocMem(SoundList, 0);146 ReallocMem(SoundList, 0); 151 147 152 148 end. 153 -
trunk/Start.pas
r4 r6 1 1 {$INCLUDE switches} 2 3 2 unit Start; 4 3 … … 6 5 7 6 uses 8 GameServer,Messg,ButtonBase,ButtonA,ButtonC,ButtonB,Area, 9 10 Windows,Messages,SysUtils,Classes,Graphics,Controls,Forms,StdCtrls, 11 Menus,Registry; 12 7 GameServer, Messg, ButtonBase, ButtonA, ButtonC, ButtonB, Area, 8 9 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, StdCtrls, 10 Menus, Registry; 13 11 14 12 const 15 // main actions 16 nMainActions=5; maConfig=0; maManual=1; maCredits=2; maAIDev=3; maWeb=4; 17 13 // main actions 14 nMainActions = 5; 15 maConfig = 0; 16 maManual = 1; 17 maCredits = 2; 18 maAIDev = 3; 19 maWeb = 4; 18 20 19 21 type … … 35 37 AutoEnemyDownBtn: TButtonC; 36 38 ReplayBtn: TButtonB; 37 procedure StartBtnClick(Sender: TObject);38 procedure FormPaint(Sender: TObject);39 procedure FormShow(Sender: TObject);40 procedure FormDestroy(Sender: TObject);41 procedure FormCreate(Sender: TObject);39 procedure StartBtnClick(Sender: TObject); 40 procedure FormPaint(Sender: TObject); 41 procedure FormShow(Sender: TObject); 42 procedure FormDestroy(Sender: TObject); 43 procedure FormCreate(Sender: TObject); 42 44 procedure BrainClick(Sender: TObject); 43 45 procedure FormMouseDown(Sender: TObject; Button: TMouseButton; … … 55 57 procedure FormHide(Sender: TObject); 56 58 procedure QuitBtnClick(Sender: TObject); 57 procedure FormKeyDown(Sender: TObject; var Key: Word; 58 Shift: TShiftState); 59 procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); 59 60 procedure CustomizeBtnClick(Sender: TObject); 60 61 procedure AutoDiffUpBtnClick(Sender: TObject); 61 62 procedure AutoDiffDownBtnClick(Sender: TObject); 62 63 procedure FormMouseUp(Sender: TObject; Button: TMouseButton; 63 Shift: TShiftState; X, Y: Integer); 64 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, 65 Y: Integer); 64 Shift: TShiftState; x, y: integer); 65 procedure FormMouseMove(Sender: TObject; Shift: TShiftState; x, y: integer); 66 66 procedure AutoEnemyUpBtnClick(Sender: TObject); 67 67 procedure AutoEnemyDownBtnClick(Sender: TObject); 68 68 procedure ReplayBtnClick(Sender: TObject); 69 69 public 70 BrainPicture: array [0..maxBrain-1] of TBitmap;70 BrainPicture: array [0 .. maxBrain - 1] of TBitmap; 71 71 EmptyPicture: TBitmap; 72 72 procedure UpdateFormerGames; … … 74 74 private 75 75 WorldSize, StartLandMass, MaxTurn, AutoEnemies, AutoDiff, MultiControl, 76 MiniWidth, MiniHeight, SelectedAction, 77 Page, ShowTab, Tab, Diff0, bixDefault, 78 nMapLandTiles,nMapStartPositions, 79 LoadTurn, LastTurn, {last turn of selected former game} 80 SlotAvailable, 81 bixPopup: integer; {brain concerned by brain context menu} 82 ListIndex: array[0..3] of integer; 76 MiniWidth, MiniHeight, SelectedAction, Page, ShowTab, Tab, Diff0, 77 bixDefault, nMapLandTiles, nMapStartPositions, LoadTurn, LastTurn, 78 { last turn of selected former game } 79 SlotAvailable, bixPopup: integer; { brain concerned by brain context menu } 80 ListIndex: array [0 .. 3] of integer; 83 81 MapFileName: string; 84 82 FormerGames, Maps: TStringList; 85 LogoBuffer, 86 Mini:TBitmap; {game world sample preview} 87 MiniColors: array[0..11,0..1] of TColor; 88 // BookDate: string; 89 DiffUpBtn: array[0..8] of TButtonC; 90 DiffDownBtn: array[0..8] of TButtonC; 91 MultiBtn: array[6..8] of TButtonC; 92 MiniMode: (mmNone,mmPicture,mmMultiPlayer); 93 ActionsOffered: set of 0..nMainActions-1; 83 LogoBuffer, Mini: TBitmap; { game world sample preview } 84 MiniColors: array [0 .. 11, 0 .. 1] of TColor; 85 // BookDate: string; 86 DiffUpBtn: array [0 .. 8] of TButtonC; 87 DiffDownBtn: array [0 .. 8] of TButtonC; 88 MultiBtn: array [6 .. 8] of TButtonC; 89 MiniMode: (mmNone, mmPicture, mmMultiPlayer); 90 ActionsOffered: set of 0 .. nMainActions - 1; 94 91 TurnValid, Tracking: boolean; 95 92 procedure InitPopup(PopupIndex: integer); … … 98 95 procedure ChangeTab(NewTab: integer); 99 96 procedure UnlistBackupFile(FileName: string); 100 procedure SmartInvalidate(x0,y0,x1,y1: integer; invalidateTab0: boolean = false); 101 end; 102 103 var 104 StartDlg:TStartDlg; 97 procedure SmartInvalidate(x0, y0, x1, y1: integer; 98 invalidateTab0: boolean = false); 99 end; 100 101 var 102 StartDlg: TStartDlg; 105 103 106 104 implementation 107 105 108 106 uses 109 Directories, Protocol, Direct, ScreenTools, Inp, Back,110 111 ShellAPI;107 Directories, Protocol, Direct, ScreenTools, Inp, Back, 108 109 ShellAPI; 112 110 113 111 {$R *.DFM} 114 112 115 113 const 116 // predefined world size 117 // attention: lx*ly+1 must be prime! 118 {nWorldSize=8; 119 lxpre: array[0..nWorldSize-1] of integer =(30,40,50,60,70,90,110,130); 120 lypre: array[0..nWorldSize-1] of integer =(46,52,60,70,84,94,110,130); 121 DefaultWorldTiles=4200;} 122 nWorldSize=6; 123 lxpre: array[0..nWorldSize-1] of integer =(30,40,50,60,75,100); 124 lypre: array[0..nWorldSize-1] of integer =(46,52,60,70,82,96); 125 DefaultWorldTiles=4150; 126 DefaultWorldSize=3; 127 DefaultLandMass=30; 128 129 nPlOffered=9; 130 yMain=14; 131 xActionIcon=55; xAction=111; yAction=60; ActionPitch=56; ActionSideBorder=24; 132 ActionBottomBorder=10; 133 wBuffer=91; 134 x0Mini=437; y0Mini=178; 135 xTurnSlider=346; yTurnSlider=262; wTurnSlider=168; 136 yLogo=74; 137 xDefault=234; yDefault=148; 138 x0Brain=146; y0Brain=148; 139 dxBrain=104; dyBrain=80; 140 xBrain: array[0..nPlOffered-1] of integer = 141 (x0Brain,x0Brain,x0Brain+dxBrain,x0Brain+dxBrain,x0Brain+dxBrain,x0Brain, 142 x0Brain-dxBrain,x0Brain-dxBrain,x0Brain-dxBrain); 143 yBrain: array[0..nPlOffered-1] of integer = 144 (y0Brain,y0Brain-dyBrain,y0Brain-dyBrain,y0Brain,y0Brain+dyBrain, 145 y0Brain+dyBrain,y0Brain+dyBrain,y0Brain,y0Brain-dyBrain); 146 TabOffset=-115; TabSize=159; TabHeight=40; 147 148 MaxWidthMapLogo=96; MaxHeightMapLogo=96; 149 150 InitAlive: array[1..nPl] of integer= 151 (1,1+2,1+2+32,1+2+8+128,1+2+8+32+128,1+2+8+16+64+128,1+2+4+16+32+64+256, 152 511-32,511,511-32,511,511-32,511,511-32,511); 153 InitMulti: array[nPlOffered+1..nPl] of integer= 154 (256,256,256+128,256+128,256+128+64,256+128+64); 155 156 pgStartRandom=0; pgStartMap=1; pgNoLoad=2; pgLoad=3; pgEditRandom=4; 157 pgEditMap=5; pgMain=6; 158 159 OfferMultiple=[6,7,8]; 160 161 PlayerAutoDiff: array[1..5] of integer=(1,1,2,2,3); 162 EnemyAutoDiff: array[1..5] of integer=(4,3,2,1,1); 163 164 165 procedure TStartDlg.FormCreate(Sender:TObject); 166 var 167 x,y,i,ResolutionX,ResolutionY,ResolutionBPP,ResolutionFreq,ScreenMode: integer; 168 DefaultAI,s: string; 169 r0,r1: HRgn; 170 Reg: TRegistry; 171 FirstStart: boolean; 172 begin 173 Reg:=TRegistry.Create; 174 FirstStart:=not Reg.KeyExists('SOFTWARE\cevo\RegVer9\Start'); 175 176 if FirstStart then 177 begin 178 // initialize AI assignment 179 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start',true); 180 for i:=0 to nPlOffered-1 do 181 begin 182 if i=0 then s:=':StdIntf' 183 else s:='StdAI'; 184 Reg.WriteString('Control'+IntToStr(i),s); 185 Reg.WriteInteger('Diff'+IntToStr(i),2); 114 // predefined world size 115 // attention: lx*ly+1 must be prime! 116 { nWorldSize=8; 117 lxpre: array[0..nWorldSize-1] of integer =(30,40,50,60,70,90,110,130); 118 lypre: array[0..nWorldSize-1] of integer =(46,52,60,70,84,94,110,130); 119 DefaultWorldTiles=4200; } 120 nWorldSize = 6; 121 lxpre: array [0 .. nWorldSize - 1] of integer = (30, 40, 50, 60, 75, 100); 122 lypre: array [0 .. nWorldSize - 1] of integer = (46, 52, 60, 70, 82, 96); 123 DefaultWorldTiles = 4150; 124 DefaultWorldSize = 3; 125 DefaultLandMass = 30; 126 127 nPlOffered = 9; 128 yMain = 14; 129 xActionIcon = 55; 130 xAction = 111; 131 yAction = 60; 132 ActionPitch = 56; 133 ActionSideBorder = 24; 134 ActionBottomBorder = 10; 135 wBuffer = 91; 136 x0Mini = 437; 137 y0Mini = 178; 138 xTurnSlider = 346; 139 yTurnSlider = 262; 140 wTurnSlider = 168; 141 yLogo = 74; 142 xDefault = 234; 143 yDefault = 148; 144 x0Brain = 146; 145 y0Brain = 148; 146 dxBrain = 104; 147 dyBrain = 80; 148 xBrain: array [0 .. nPlOffered - 1] of integer = (x0Brain, x0Brain, 149 x0Brain + dxBrain, x0Brain + dxBrain, x0Brain + dxBrain, x0Brain, 150 x0Brain - dxBrain, x0Brain - dxBrain, x0Brain - dxBrain); 151 yBrain: array [0 .. nPlOffered - 1] of integer = (y0Brain, y0Brain - dyBrain, 152 y0Brain - dyBrain, y0Brain, y0Brain + dyBrain, y0Brain + dyBrain, 153 y0Brain + dyBrain, y0Brain, y0Brain - dyBrain); 154 TabOffset = -115; 155 TabSize = 159; 156 TabHeight = 40; 157 158 MaxWidthMapLogo = 96; 159 MaxHeightMapLogo = 96; 160 161 InitAlive: array [1 .. nPl] of integer = (1, 1 + 2, 1 + 2 + 32, 162 1 + 2 + 8 + 128, 1 + 2 + 8 + 32 + 128, 1 + 2 + 8 + 16 + 64 + 128, 163 1 + 2 + 4 + 16 + 32 + 64 + 256, 511 - 32, 511, 511 - 32, 511, 511 - 32, 511, 164 511 - 32, 511); 165 InitMulti: array [nPlOffered + 1 .. nPl] of integer = (256, 256, 256 + 128, 166 256 + 128, 256 + 128 + 64, 256 + 128 + 64); 167 168 pgStartRandom = 0; 169 pgStartMap = 1; 170 pgNoLoad = 2; 171 pgLoad = 3; 172 pgEditRandom = 4; 173 pgEditMap = 5; 174 pgMain = 6; 175 176 OfferMultiple = [6, 7, 8]; 177 178 PlayerAutoDiff: array [1 .. 5] of integer = (1, 1, 2, 2, 3); 179 EnemyAutoDiff: array [1 .. 5] of integer = (4, 3, 2, 1, 1); 180 181 procedure TStartDlg.FormCreate(Sender: TObject); 182 var 183 x, y, i, ResolutionX, ResolutionY, ResolutionBPP, ResolutionFreq, 184 ScreenMode: integer; 185 DefaultAI, s: string; 186 r0, r1: HRgn; 187 Reg: TRegistry; 188 FirstStart: boolean; 189 begin 190 Reg := TRegistry.Create; 191 FirstStart := not Reg.KeyExists('SOFTWARE\cevo\RegVer9\Start'); 192 193 if FirstStart then 194 begin 195 // initialize AI assignment 196 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start', true); 197 for i := 0 to nPlOffered - 1 do 198 begin 199 if i = 0 then 200 s := ':StdIntf' 201 else 202 s := 'StdAI'; 203 Reg.WriteString('Control' + IntToStr(i), s); 204 Reg.WriteInteger('Diff' + IntToStr(i), 2); 186 205 end; 187 Reg.WriteInteger('MultiControl',0); 188 Reg.closekey; 189 190 // register file type: "cevo Book" -- fails with no administrator rights! 191 try 192 Reg.RootKey:=HKEY_CLASSES_ROOT; 193 Reg.OpenKey ('.cevo',true); 194 Reg.WriteString ('','cevoBook'); 206 Reg.WriteInteger('MultiControl', 0); 195 207 Reg.closekey; 196 Reg.OpenKey ('cevoBook',true); 197 Reg.WriteString ('','cevo Book'); 208 209 // register file type: "cevo Book" -- fails with no administrator rights! 210 try 211 Reg.RootKey := HKEY_CLASSES_ROOT; 212 Reg.OpenKey('.cevo', true); 213 Reg.WriteString('', 'cevoBook'); 214 Reg.closekey; 215 Reg.OpenKey('cevoBook', true); 216 Reg.WriteString('', 'cevo Book'); 217 Reg.closekey; 218 Reg.OpenKey('cevoBook\DefaultIcon', true); 219 Reg.WriteString('', ParamStr(0) + ',0'); 220 Reg.closekey; 221 Reg.OpenKey('cevoBook\shell\open\command', true); 222 Reg.WriteString('', ParamStr(0) + ' "%1"'); 223 Reg.closekey; 224 except 225 end; 226 end 227 else 228 begin 229 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start', false); 230 try 231 WorldSize := Reg.ReadInteger('WorldSize'); 232 StartLandMass := Reg.ReadInteger('LandMass'); 233 MaxTurn := Reg.ReadInteger('MaxTurn'); 234 DefaultAI := Reg.ReadString('DefaultAI'); 235 AutoEnemies := Reg.ReadInteger('AutoEnemies'); 236 AutoDiff := Reg.ReadInteger('AutoDiff'); 237 except 238 FirstStart := true; 239 end; 198 240 Reg.closekey; 199 Reg.OpenKey ('cevoBook\DefaultIcon',true); 200 Reg.WriteString ('',ParamStr(0)+',0'); 241 end; 242 243 FullScreen := true; 244 if FirstStart then 245 begin 246 WorldSize := DefaultWorldSize; 247 StartLandMass := DefaultLandMass; 248 MaxTurn := 800; 249 DefaultAI := 'StdAI'; 250 AutoEnemies := 8; 251 AutoDiff := 1; 252 end 253 else 254 begin 255 Reg.OpenKey('SOFTWARE\cevo\RegVer9', false); 256 try 257 ScreenMode := Reg.ReadInteger('ScreenMode'); 258 FullScreen := ScreenMode > 0; 259 if Reg.ValueExists('ResolutionX') then 260 ResolutionX := Reg.ReadInteger('ResolutionX'); 261 if Reg.ValueExists('ResolutionY') then 262 ResolutionY := Reg.ReadInteger('ResolutionY'); 263 if Reg.ValueExists('ResolutionBPP') then 264 ResolutionBPP := Reg.ReadInteger('ResolutionBPP'); 265 if Reg.ValueExists('ResolutionFreq') then 266 ResolutionFreq := Reg.ReadInteger('ResolutionFreq'); 267 if ScreenMode = 2 then 268 ChangeResolution(ResolutionX, ResolutionY, ResolutionBPP, 269 ResolutionFreq); 270 except 271 end; 201 272 Reg.closekey; 202 Reg.OpenKey ('cevoBook\shell\open\command',true); 203 Reg.WriteString ('',ParamStr(0)+' "%1"'); 204 Reg.closekey; 205 except 206 end; 207 end 208 else 209 begin 210 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start',false); 211 try 212 WorldSize:=Reg.ReadInteger('WorldSize'); 213 StartLandMass:=Reg.ReadInteger('LandMass'); 214 MaxTurn:=Reg.ReadInteger('MaxTurn'); 215 DefaultAI:=Reg.ReadString('DefaultAI'); 216 AutoEnemies:=Reg.ReadInteger('AutoEnemies'); 217 AutoDiff:=Reg.ReadInteger('AutoDiff'); 218 except 219 FirstStart:=true; 220 end; 221 Reg.closekey; 222 end; 223 224 FullScreen:=true; 225 if FirstStart then 226 begin 227 WorldSize:=DefaultWorldSize; 228 StartLandMass:=DefaultLandMass; 229 MaxTurn:=800; 230 DefaultAI:='StdAI'; 231 AutoEnemies:=8; 232 AutoDiff:=1; 233 end 234 else 235 begin 236 Reg.OpenKey('SOFTWARE\cevo\RegVer9',false); 237 try 238 ScreenMode:=Reg.ReadInteger('ScreenMode'); 239 FullScreen:= ScreenMode>0; 240 if Reg.ValueExists('ResolutionX') then 241 ResolutionX:=Reg.ReadInteger('ResolutionX'); 242 if Reg.ValueExists('ResolutionY') then 243 ResolutionY:=Reg.ReadInteger('ResolutionY'); 244 if Reg.ValueExists('ResolutionBPP') then 245 ResolutionBPP:=Reg.ReadInteger('ResolutionBPP'); 246 if Reg.ValueExists('ResolutionFreq') then 247 ResolutionFreq:=Reg.ReadInteger('ResolutionFreq'); 248 if ScreenMode=2 then 249 ChangeResolution(ResolutionX,ResolutionY,ResolutionBPP,ResolutionFreq); 250 except 251 end; 252 Reg.closekey; 253 end; 254 Reg.Free; 255 256 ActionsOffered:=[maManual,maCredits,maWeb]; 257 if FileExists(HomeDir+'Configurator.exe') then 258 include(ActionsOffered,maConfig); 259 if FileExists(HomeDir+'AI Template\AI development manual.html') then 260 include(ActionsOffered,maAIDev); 261 262 bixDefault:=-1; 263 for i:=bixRandom to nBrain-1 do 264 if AnsiCompareFileName(DefaultAI,Brain[i].FileName)=0 then bixDefault:=i; 265 if (bixDefault=bixRandom) and (nBrain<bixFirstAI+2) then 266 bixDefault:=-1; 267 if (bixDefault<0) and (nBrain>bixFirstAI) then bixDefault:=bixFirstAI; // default AI not found, use any 268 269 DirectDlg.left:=(screen.width-DirectDlg.width) div 2; 270 DirectDlg.top:=(screen.height-DirectDlg.height) div 2; 271 272 if FullScreen then 273 begin 274 Left:=(Screen.Width-800)*3 div 8; 275 Top:=Screen.Height-ClientHeight-(Screen.Height-600) div 3; 276 277 r0:=CreateRectRgn(0,0,ClientWidth,ClientHeight); 278 r1:=CreateRectRgn(TabOffset+4*TabSize+2,0,ClientWidth,TabHeight); 279 CombineRgn(r0,r0,r1,RGN_DIFF); 280 //DeleteObject(r1); 281 r1:=CreateRectRgn(QuitBtn.left,QuitBtn.Top,QuitBtn.left+QuitBtn.Width, 282 QuitBtn.Top+QuitBtn.Height); 283 CombineRgn(r0,r0,r1,RGN_OR); 284 //DeleteObject(r1); 285 SetWindowRgn(Handle,r0,false); 286 //DeleteObject(r0); // causes crash with Windows 95 287 end 288 else 289 begin 290 Left:=(Screen.Width-Width) div 2; 291 Top:=(Screen.Height-Height) div 2; 292 end; 293 294 Canvas.Font.Assign(UniFont[ftNormal]); 295 Canvas.Brush.Style:=bsClear; 296 297 QuitBtn.Hint:=Phrases.Lookup('STARTCONTROLS',0); 298 ReplayBtn.Hint:=Phrases.Lookup('BTN_REPLAY'); 299 for i:=0 to nPlOffered-1 do 300 begin 301 DiffUpBtn[i]:=TButtonC.Create(self); 302 DiffUpBtn[i].Graphic:=GrExt[HGrSystem].Data; 303 DiffUpBtn[i].Left:=xBrain[i]-18; 304 DiffUpBtn[i].Top:=yBrain[i]+39; 305 DiffUpBtn[i].ButtonIndex:=1; 306 DiffUpBtn[i].Parent:=self; 307 DiffUpBtn[i].OnClick:=DiffBtnClick; 308 DiffDownBtn[i]:=TButtonC.Create(self); 309 DiffDownBtn[i].Graphic:=GrExt[HGrSystem].Data; 310 DiffDownBtn[i].Left:=xBrain[i]-18; 311 DiffDownBtn[i].Top:=yBrain[i]+51; 312 DiffDownBtn[i].ButtonIndex:=0; 313 DiffDownBtn[i].Parent:=self; 314 DiffDownBtn[i].OnClick:=DiffBtnClick; 315 end; 316 for i:=6 to 8 do 317 begin 318 MultiBtn[i]:=TButtonC.Create(self); 319 MultiBtn[i].Graphic:=GrExt[HGrSystem].Data; 320 MultiBtn[i].Left:=xBrain[i]-18; 321 MultiBtn[i].Top:=yBrain[i]; 322 MultiBtn[i].Parent:=self; 323 MultiBtn[i].OnClick:=MultiBtnClick; 324 end; 325 326 x:=BiColorTextWidth(Canvas,Phrases.Lookup('STARTCONTROLS',7)) div 2; 327 CustomizeBtn.Left:=x0Brain+32-16-x; 328 if AutoDiff<0 then CustomizeBtn.ButtonIndex:=3 329 else CustomizeBtn.ButtonIndex:=2; 330 331 BrainPicture[0]:=TBitmap.Create; 332 BrainPicture[0].Width:=64; BrainPicture[0].Height:=64; 333 BitBlt(BrainPicture[0].Canvas.Handle,0,0,64,64, 334 GrExt[HGrSystem2].Data.Canvas.Handle,1,111,SRCCOPY); 335 BrainPicture[1]:=TBitmap.Create; 336 BrainPicture[1].Width:=64; BrainPicture[1].Height:=64; 337 BitBlt(BrainPicture[1].Canvas.Handle,0,0,64,64, 338 GrExt[HGrSystem2].Data.Canvas.Handle,66,111,SRCCOPY); 339 BrainPicture[2]:=TBitmap.Create; 340 BrainPicture[2].Width:=64; BrainPicture[2].Height:=64; 341 BitBlt(BrainPicture[2].Canvas.Handle,0,0,64,64, 342 GrExt[HGrSystem2].Data.Canvas.Handle,131,111,SRCCOPY); 343 BrainPicture[3]:=TBitmap.Create; 344 BrainPicture[3].Width:=64; BrainPicture[3].Height:=64; 345 BitBlt(BrainPicture[3].Canvas.Handle,0,0,64,64, 346 GrExt[HGrSystem2].Data.Canvas.Handle,131,46,SRCCOPY); 347 for i:=bixFirstAI to nBrain-1 do 348 begin 349 BrainPicture[i]:=TBitmap.Create; 350 if not LoadGraphicFile(BrainPicture[i], HomeDir+Brain[i].FileName, gfNoError) then 351 begin 352 BrainPicture[i].Width:=64; BrainPicture[i].Height:=64; 353 with BrainPicture[i].Canvas do 354 begin 355 Brush.Color:=$904830; 356 FillRect(Rect(0,0,64,64)); 357 Font.Assign(UniFont[ftTiny]); 358 Font.Style:=[]; 359 Font.Color:=$5FDBFF; 360 Textout(32-TextWidth(Brain[i].FileName) div 2, 361 32-TextHeight(Brain[i].FileName) div 2,Brain[i].FileName); 273 end; 274 Reg.Free; 275 276 ActionsOffered := [maManual, maCredits, maWeb]; 277 if FileExists(HomeDir + 'Configurator.exe') then 278 include(ActionsOffered, maConfig); 279 if FileExists(HomeDir + 'AI Template\AI development manual.html') then 280 include(ActionsOffered, maAIDev); 281 282 bixDefault := -1; 283 for i := bixRandom to nBrain - 1 do 284 if AnsiCompareFileName(DefaultAI, Brain[i].FileName) = 0 then 285 bixDefault := i; 286 if (bixDefault = bixRandom) and (nBrain < bixFirstAI + 2) then 287 bixDefault := -1; 288 if (bixDefault < 0) and (nBrain > bixFirstAI) then 289 bixDefault := bixFirstAI; // default AI not found, use any 290 291 DirectDlg.left := (screen.width - DirectDlg.width) div 2; 292 DirectDlg.top := (screen.height - DirectDlg.height) div 2; 293 294 if FullScreen then 295 begin 296 left := (screen.width - 800) * 3 div 8; 297 top := screen.height - ClientHeight - (screen.height - 600) div 3; 298 299 r0 := CreateRectRgn(0, 0, ClientWidth, ClientHeight); 300 r1 := CreateRectRgn(TabOffset + 4 * TabSize + 2, 0, ClientWidth, TabHeight); 301 CombineRgn(r0, r0, r1, RGN_DIFF); 302 // DeleteObject(r1); 303 r1 := CreateRectRgn(QuitBtn.left, QuitBtn.top, QuitBtn.left + QuitBtn.width, 304 QuitBtn.top + QuitBtn.height); 305 CombineRgn(r0, r0, r1, RGN_OR); 306 // DeleteObject(r1); 307 SetWindowRgn(Handle, r0, false); 308 // DeleteObject(r0); // causes crash with Windows 95 309 end 310 else 311 begin 312 left := (screen.width - width) div 2; 313 top := (screen.height - height) div 2; 314 end; 315 316 Canvas.Font.Assign(UniFont[ftNormal]); 317 Canvas.Brush.Style := bsClear; 318 319 QuitBtn.Hint := Phrases.Lookup('STARTCONTROLS', 0); 320 ReplayBtn.Hint := Phrases.Lookup('BTN_REPLAY'); 321 for i := 0 to nPlOffered - 1 do 322 begin 323 DiffUpBtn[i] := TButtonC.Create(self); 324 DiffUpBtn[i].Graphic := GrExt[HGrSystem].Data; 325 DiffUpBtn[i].left := xBrain[i] - 18; 326 DiffUpBtn[i].top := yBrain[i] + 39; 327 DiffUpBtn[i].ButtonIndex := 1; 328 DiffUpBtn[i].Parent := self; 329 DiffUpBtn[i].OnClick := DiffBtnClick; 330 DiffDownBtn[i] := TButtonC.Create(self); 331 DiffDownBtn[i].Graphic := GrExt[HGrSystem].Data; 332 DiffDownBtn[i].left := xBrain[i] - 18; 333 DiffDownBtn[i].top := yBrain[i] + 51; 334 DiffDownBtn[i].ButtonIndex := 0; 335 DiffDownBtn[i].Parent := self; 336 DiffDownBtn[i].OnClick := DiffBtnClick; 337 end; 338 for i := 6 to 8 do 339 begin 340 MultiBtn[i] := TButtonC.Create(self); 341 MultiBtn[i].Graphic := GrExt[HGrSystem].Data; 342 MultiBtn[i].left := xBrain[i] - 18; 343 MultiBtn[i].top := yBrain[i]; 344 MultiBtn[i].Parent := self; 345 MultiBtn[i].OnClick := MultiBtnClick; 346 end; 347 348 x := BiColorTextWidth(Canvas, Phrases.Lookup('STARTCONTROLS', 7)) div 2; 349 CustomizeBtn.left := x0Brain + 32 - 16 - x; 350 if AutoDiff < 0 then 351 CustomizeBtn.ButtonIndex := 3 352 else 353 CustomizeBtn.ButtonIndex := 2; 354 355 BrainPicture[0] := TBitmap.Create; 356 BrainPicture[0].width := 64; 357 BrainPicture[0].height := 64; 358 BitBlt(BrainPicture[0].Canvas.Handle, 0, 0, 64, 64, 359 GrExt[HGrSystem2].Data.Canvas.Handle, 1, 111, SRCCOPY); 360 BrainPicture[1] := TBitmap.Create; 361 BrainPicture[1].width := 64; 362 BrainPicture[1].height := 64; 363 BitBlt(BrainPicture[1].Canvas.Handle, 0, 0, 64, 64, 364 GrExt[HGrSystem2].Data.Canvas.Handle, 66, 111, SRCCOPY); 365 BrainPicture[2] := TBitmap.Create; 366 BrainPicture[2].width := 64; 367 BrainPicture[2].height := 64; 368 BitBlt(BrainPicture[2].Canvas.Handle, 0, 0, 64, 64, 369 GrExt[HGrSystem2].Data.Canvas.Handle, 131, 111, SRCCOPY); 370 BrainPicture[3] := TBitmap.Create; 371 BrainPicture[3].width := 64; 372 BrainPicture[3].height := 64; 373 BitBlt(BrainPicture[3].Canvas.Handle, 0, 0, 64, 64, 374 GrExt[HGrSystem2].Data.Canvas.Handle, 131, 46, SRCCOPY); 375 for i := bixFirstAI to nBrain - 1 do 376 begin 377 BrainPicture[i] := TBitmap.Create; 378 if not LoadGraphicFile(BrainPicture[i], HomeDir + Brain[i].FileName, 379 gfNoError) then 380 begin 381 BrainPicture[i].width := 64; 382 BrainPicture[i].height := 64; 383 with BrainPicture[i].Canvas do 384 begin 385 Brush.Color := $904830; 386 FillRect(Rect(0, 0, 64, 64)); 387 Font.Assign(UniFont[ftTiny]); 388 Font.Style := []; 389 Font.Color := $5FDBFF; 390 Textout(32 - TextWidth(Brain[i].FileName) div 2, 391 32 - TextHeight(Brain[i].FileName) div 2, Brain[i].FileName); 362 392 end 363 393 end 364 394 end; 365 395 366 EmptyPicture:=TBitmap.Create; 367 EmptyPicture.PixelFormat:=pf24bit; 368 EmptyPicture.Width:=64; EmptyPicture.Height:=64; 369 LogoBuffer:=TBitmap.Create; 370 LogoBuffer.PixelFormat:=pf24bit; 371 LogoBuffer.Width:=wBuffer; LogoBuffer.Height:=56; 372 373 Mini:=TBitmap.Create; 374 for x:=0 to 11 do for y:=0 to 1 do 375 MiniColors[x,y]:=GrExt[HGrSystem].Data.Canvas.Pixels[66+x,67+y]; 376 InitButtons(); 377 378 bixView[0]:=bixTerm; 379 SlotAvailable:=-1; 380 Tab:=2; 381 Diff0:=2; 382 TurnValid:=false; 383 Tracking:=false; 384 FormerGames:=TStringList.Create; 385 UpdateFormerGames; 386 ShowTab:=2; // always start with new book page 387 MapFileName:=''; 388 Maps:=TStringList.Create; 389 UpdateMaps; 390 end; 391 392 procedure TStartDlg.FormDestroy(Sender:TObject); 393 var 394 i: integer; 395 begin 396 FormerGames.Free; 397 Maps.Free; 398 Mini.Free; 399 EmptyPicture.Free; 400 LogoBuffer.Free; 401 for i:=0 to nBrain-1 do 402 BrainPicture[i].Free; 403 end; 404 405 procedure TStartDlg.SmartInvalidate(x0,y0,x1,y1: integer; InvalidateTab0: boolean); 406 var 407 i: integer; 408 r0,r1: HRgn; 409 begin 410 r0:=CreateRectRgn(x0,y0,x1,y1); 411 for i:=0 to ControlCount-1 do 412 if not (Controls[i] is TArea) and Controls[i].Visible then 413 begin 414 with Controls[i].BoundsRect do 415 r1:=CreateRectRgn(Left,Top,Right,Bottom); 416 CombineRgn(r0,r0,r1,RGN_DIFF); 396 EmptyPicture := TBitmap.Create; 397 EmptyPicture.PixelFormat := pf24bit; 398 EmptyPicture.width := 64; 399 EmptyPicture.height := 64; 400 LogoBuffer := TBitmap.Create; 401 LogoBuffer.PixelFormat := pf24bit; 402 LogoBuffer.width := wBuffer; 403 LogoBuffer.height := 56; 404 405 Mini := TBitmap.Create; 406 for x := 0 to 11 do 407 for y := 0 to 1 do 408 MiniColors[x, y] := GrExt[HGrSystem].Data.Canvas.Pixels[66 + x, 67 + y]; 409 InitButtons(); 410 411 bixView[0] := bixTerm; 412 SlotAvailable := -1; 413 Tab := 2; 414 Diff0 := 2; 415 TurnValid := false; 416 Tracking := false; 417 FormerGames := TStringList.Create; 418 UpdateFormerGames; 419 ShowTab := 2; // always start with new book page 420 MapFileName := ''; 421 Maps := TStringList.Create; 422 UpdateMaps; 423 end; 424 425 procedure TStartDlg.FormDestroy(Sender: TObject); 426 var 427 i: integer; 428 begin 429 FormerGames.Free; 430 Maps.Free; 431 Mini.Free; 432 EmptyPicture.Free; 433 LogoBuffer.Free; 434 for i := 0 to nBrain - 1 do 435 BrainPicture[i].Free; 436 end; 437 438 procedure TStartDlg.SmartInvalidate(x0, y0, x1, y1: integer; 439 invalidateTab0: boolean); 440 var 441 i: integer; 442 r0, r1: HRgn; 443 begin 444 r0 := CreateRectRgn(x0, y0, x1, y1); 445 for i := 0 to ControlCount - 1 do 446 if not(Controls[i] is TArea) and Controls[i].Visible then 447 begin 448 with Controls[i].BoundsRect do 449 r1 := CreateRectRgn(left, top, Right, Bottom); 450 CombineRgn(r0, r0, r1, RGN_DIFF); 451 DeleteObject(r1); 452 end; 453 if not invalidateTab0 then 454 begin 455 r1 := CreateRectRgn(0, 0, 6 + 36, 3 + 38); // tab 0 icon 456 CombineRgn(r0, r0, r1, RGN_DIFF); 417 457 DeleteObject(r1); 458 end; 459 InvalidateRgn(Handle, r0, false); 460 DeleteObject(r0); 461 end; 462 463 procedure TStartDlg.FormPaint(Sender: TObject); 464 const 465 TabNames: array [0 .. 3] of integer = (0, 11, 3, 4); 466 467 procedure DrawAction(y, IconIndex: integer; HeaderItem, TextItem: string); 468 begin 469 Canvas.Font.Assign(UniFont[ftCaption]); 470 Canvas.Font.Style := Canvas.Font.Style + [fsUnderline]; 471 RisedTextOut(Canvas, xAction, y - 3, Phrases2.Lookup(HeaderItem)); 472 Canvas.Font.Assign(UniFont[ftNormal]); 473 BiColorTextOut(Canvas, Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText], 474 $000000, xAction, y + 21, Phrases2.Lookup(TextItem)); 475 BitBlt(LogoBuffer.Canvas.Handle, 0, 0, 50, 50, Canvas.Handle, 476 xActionIcon - 2, y - 2, SRCCOPY); 477 GlowFrame(LogoBuffer, 8, 8, 34, 34, $202020); 478 BitBlt(Canvas.Handle, xActionIcon - 2, y - 2, 50, 50, 479 LogoBuffer.Canvas.Handle, 0, 0, SRCCOPY); 480 BitBlt(Canvas.Handle, xActionIcon, y, 40, 40, BigImp.Canvas.Handle, 481 (IconIndex mod 7) * xSizeBig + 8, (IconIndex div 7) * ySizeBig, SRCCOPY); 482 RFrame(Canvas, xActionIcon - 1, y - 1, xActionIcon + 40, y + 40, 483 $000000, $000000); 484 end; 485 486 var 487 i, w, h, xMini, yMini, y: integer; 488 s: string; 489 begin 490 PaintBackground(self, 3, 3, TabOffset + 4 * TabSize - 4, TabHeight - 3); 491 PaintBackground(self, 3, TabHeight + 3, ClientWidth - 6, 492 ClientHeight - TabHeight - 6); 493 with Canvas do 494 begin 495 Brush.Color := $000000; 496 FillRect(Rect(0, 1, ClientWidth, 3)); 497 FillRect(Rect(TabOffset + 4 * TabSize + 2, 0, ClientWidth, TabHeight)); 498 Brush.Style := bsClear; 499 end; 500 if Page in [pgStartRandom, pgStartMap] then 501 begin 502 Frame(Canvas, 328, yMain + 112 - 15, ClientWidth, Up2Btn.top + 38, 503 MainTexture.clBevelShade, MainTexture.clBevelLight); 504 if AutoDiff > 0 then 505 begin 506 Frame(Canvas, -1 { x0Brain-dxBrain } , 507 yMain + 112 - 15 { Up1Btn.Top-12 }{ y0Brain-dyBrain } , 508 x0Brain + dxBrain + 64, Up2Btn.top + 38 { y0Brain+dyBrain+64 } , 509 MainTexture.clBevelShade, MainTexture.clBevelLight); 510 end 511 end 512 else if Page <> pgMain then 513 Frame(Canvas, 328, Up1Btn.top - 15, ClientWidth, Up2Btn.top + 38, 514 MainTexture.clBevelShade, MainTexture.clBevelLight); 515 Frame(Canvas, 0, 0, ClientWidth - 1, ClientHeight - 1, 0, 0); 516 517 // draw tabs 518 Frame(Canvas, 2, 2 + 2 * integer(Tab <> 0), TabOffset + (0 + 1) * TabSize - 1, 519 TabHeight, MainTexture.clBevelLight, MainTexture.clBevelShade); 520 Frame(Canvas, 1, 1 + 2 * integer(Tab <> 0), TabOffset + (0 + 1) * TabSize, 521 TabHeight, MainTexture.clBevelLight, MainTexture.clBevelShade); 522 Canvas.Pixels[1, 1 + 2 * integer(Tab <> 0)] := MainTexture.clBevelShade; 523 for i := 1 to 3 do 524 begin 525 Frame(Canvas, TabOffset + i * TabSize + 2, 2 + 2 * integer(Tab <> i), 526 TabOffset + (i + 1) * TabSize - 1, TabHeight, MainTexture.clBevelLight, 527 MainTexture.clBevelShade); 528 Frame(Canvas, TabOffset + i * TabSize + 1, 1 + 2 * integer(Tab <> i), 529 TabOffset + (i + 1) * TabSize, TabHeight, MainTexture.clBevelLight, 530 MainTexture.clBevelShade); 531 Canvas.Pixels[TabOffset + i * TabSize + 1, 1 + 2 * integer(Tab <> i)] := 532 MainTexture.clBevelShade; 533 end; 534 Canvas.Font.Assign(UniFont[ftNormal]); 535 for i := 1 to 3 do 536 begin 537 s := Phrases.Lookup('STARTCONTROLS', TabNames[i]); 538 RisedTextOut(Canvas, TabOffset + i * TabSize + 1 + 539 (TabSize - BiColorTextWidth(Canvas, s)) div 2, 540 10 + 2 * integer(Tab <> i), s); 541 end; 542 Frame(Canvas, TabOffset + 4 * TabSize + 1, -1, ClientWidth, TabHeight, 543 $000000, $000000); 544 Frame(Canvas, 1, TabHeight + 1, ClientWidth - 2, ClientHeight - 2, 545 MainTexture.clBevelLight, MainTexture.clBevelShade); 546 Frame(Canvas, 2, TabHeight + 2, ClientWidth - 3, ClientHeight - 3, 547 MainTexture.clBevelLight, MainTexture.clBevelShade); 548 if Tab = 0 then 549 begin 550 PaintBackground(self, 3, TabHeight - 1, TabSize - 4 - 3 + TabOffset + 3, 4); 551 Canvas.Pixels[2, TabHeight] := MainTexture.clBevelLight; 552 end 553 else 554 begin 555 PaintBackground(self, TabOffset + 3 + Tab * TabSize, TabHeight - 1, 556 TabSize - 4, 4); 557 Canvas.Pixels[TabOffset + Tab * TabSize + 2, TabHeight] := 558 MainTexture.clBevelLight; 559 end; 560 Canvas.Pixels[TabOffset + (Tab + 1) * TabSize - 1, TabHeight + 1] := 561 MainTexture.clBevelShade; 562 if Tab < 3 then 563 Frame(Canvas, TabOffset + (Tab + 1) * TabSize + 1, 3, 564 TabOffset + (Tab + 1) * TabSize + 2, TabHeight, MainTexture.clBevelShade, 565 MainTexture.clBevelShade); // Tab shadow 566 BitBlt(LogoBuffer.Canvas.Handle, 0, 0, 36, 36, Canvas.Handle, 6, 567 3 + 2 * integer(Tab <> 0), SRCCOPY); 568 ImageOp_BCC(LogoBuffer, Templates, 0, 0, 145, 38, 36, 27, $BFBF20, $4040DF); 569 // logo part 1 570 ImageOp_BCC(LogoBuffer, Templates, 10, 27, 155, 38 + 27, 26, 9, $BFBF20, 571 $4040DF); // logo part 2 572 BitBlt(Canvas.Handle, 6, 3 + 2 * integer(Tab <> 0), 36, 36, 573 LogoBuffer.Canvas.Handle, 0, 0, SRCCOPY); 574 575 if Page = pgMain then 576 begin 577 if SelectedAction >= 0 then // mark selected action 578 for i := 0 to (ClientWidth - 2 * ActionSideBorder) div wBuffer + 1 do 579 begin 580 w := ClientWidth - 2 * ActionSideBorder - i * wBuffer; 581 if w > wBuffer then 582 w := wBuffer; 583 h := ActionPitch; 584 if yAction + SelectedAction * ActionPitch - 8 + h > ClientHeight - ActionBottomBorder 585 then 586 h := ClientHeight - ActionBottomBorder - 587 (yAction + SelectedAction * ActionPitch - 8); 588 BitBlt(LogoBuffer.Canvas.Handle, 0, 0, w, h, Canvas.Handle, 589 ActionSideBorder + i * wBuffer, yAction + SelectedAction * ActionPitch 590 - 8, SRCCOPY); 591 MakeBlue(LogoBuffer, 0, 0, w, h); 592 BitBlt(Canvas.Handle, ActionSideBorder + i * wBuffer, 593 yAction + SelectedAction * ActionPitch - 8, w, h, 594 LogoBuffer.Canvas.Handle, 0, 0, SRCCOPY); 595 end; 596 y := yAction; 597 for i := 0 to nMainActions - 1 do 598 begin 599 if i in ActionsOffered then 600 case i of 601 maConfig: 602 DrawAction(y, 25, 'ACTIONHEADER_CONFIG', 'ACTION_CONFIG'); 603 maManual: 604 DrawAction(y, 19, 'ACTIONHEADER_MANUAL', 'ACTION_MANUAL'); 605 maCredits: 606 DrawAction(y, 22, 'ACTIONHEADER_CREDITS', 'ACTION_CREDITS'); 607 maAIDev: 608 DrawAction(y, 24, 'ACTIONHEADER_AIDEV', 'ACTION_AIDEV'); 609 maWeb: 610 begin 611 Canvas.Font.Assign(UniFont[ftCaption]); 612 // Canvas.Font.Style:=Canvas.Font.Style+[fsUnderline]; 613 RisedTextOut(Canvas, xActionIcon + 99, y, 614 Phrases2.Lookup('ACTIONHEADER_WEB')); 615 Canvas.Font.Assign(UniFont[ftNormal]); 616 BitBlt(LogoBuffer.Canvas.Handle, 0, 0, 91, 25, Canvas.Handle, 617 xActionIcon, y + 2, SRCCOPY); 618 ImageOp_BCC(LogoBuffer, Templates, 0, 0, 1, 400, 91, 25, 0, 619 Colors.Canvas.Pixels[clkAge0 - 1, cliDimmedText]); 620 BitBlt(Canvas.Handle, xActionIcon, y + 2, 91, 25, 621 LogoBuffer.Canvas.Handle, 0, 0, SRCCOPY); 622 end; 623 end; 624 inc(y, ActionPitch); 625 end 626 end 627 else if Page in [pgStartRandom, pgStartMap] then 628 begin 629 DLine(Canvas, 344, 514, y0Mini + 61 + 19, MainTexture.clBevelLight, 630 MainTexture.clBevelShade); 631 RisedTextOut(Canvas, 344, y0Mini + 61, Phrases.Lookup('STARTCONTROLS', 10)); 632 s := TurnToString(MaxTurn); 633 RisedTextOut(Canvas, 514 - BiColorTextWidth(Canvas, s), y0Mini + 61, s); 634 s := Phrases.Lookup('STARTCONTROLS', 7); 635 w := Canvas.TextWidth(s); 636 LoweredTextOut(Canvas, -2, MainTexture, x0Brain + 32 - w div 2, 637 y0Brain + dyBrain + 69, s); 638 639 InitOrnament; 640 if AutoDiff < 0 then 641 begin 642 for i := 12 to 19 do 643 if (i < 13) or (i > 17) then 644 begin 645 BitBlt(Canvas.Handle, 9 + i * 27, yLogo - 2, wOrna, hOrna, 646 GrExt[HGrSystem2].Mask.Canvas.Handle, xOrna, yOrna, SRCAND); 647 BitBlt(Canvas.Handle, 9 + i * 27, yLogo - 2, wOrna, hOrna, 648 GrExt[HGrSystem2].Data.Canvas.Handle, xOrna, yOrna, SRCPAINT); 649 end; 650 PaintLogo(Canvas, 69 + 11 * 27, yLogo, MainTexture.clBevelLight, 651 MainTexture.clBevelShade); 652 653 for i := 0 to nPlOffered - 1 do 654 if 1 shl i and SlotAvailable <> 0 then 655 begin 656 if bixView[i] >= 0 then 657 FrameImage(Canvas, BrainPicture[bixView[i]], xBrain[i], yBrain[i], 658 64, 64, 0, 0, true) 659 else 660 FrameImage(Canvas, EmptyPicture, xBrain[i], yBrain[i], 64, 64, 661 0, 0, true); 662 if bixView[i] >= bixTerm then 663 begin 664 BitBlt(Canvas.Handle, xBrain[i] - 18, yBrain[i] + 19, 12, 14, 665 GrExt[HGrSystem].Data.Canvas.Handle, 134 + (Difficulty[i] - 1) * 666 13, 28, SRCCOPY); 667 Frame(Canvas, xBrain[i] - 19, yBrain[i] + 18, xBrain[i] - 18 + 12, 668 yBrain[i] + (19 + 14), $000000, $000000); 669 RFrame(Canvas, DiffUpBtn[i].left - 1, DiffUpBtn[i].top - 1, 670 DiffUpBtn[i].left + 12, DiffUpBtn[i].top + 24, 671 MainTexture.clBevelShade, MainTexture.clBevelLight); 672 with Canvas do 673 begin 674 Brush.Color := $000000; 675 FillRect(Rect(xBrain[i] - 5, yBrain[i] + 25, xBrain[i] - 2, 676 yBrain[i] + 27)); 677 Brush.Style := bsClear; 678 end; 679 if i in OfferMultiple then 680 begin 681 RFrame(Canvas, MultiBtn[i].left - 1, MultiBtn[i].top - 1, 682 MultiBtn[i].left + 12, MultiBtn[i].top + 12, 683 MainTexture.clBevelShade, MainTexture.clBevelLight); 684 BitBlt(Canvas.Handle, xBrain[i] - 31, yBrain[i], 13, 12, 685 GrExt[HGrSystem].Data.Canvas.Handle, 88, 47, SRCCOPY); 686 end 687 end; 688 if bixView[i] >= 0 then 689 begin 690 DiffUpBtn[i].Hint := Format(Phrases.Lookup('STARTCONTROLS', 9), 691 [Brain[bixView[i]].Name]); 692 DiffDownBtn[i].Hint := DiffUpBtn[i].Hint; 693 end 694 end; 695 end 696 else 697 begin 698 DLine(Canvas, 24, 198, yMain + 140 + 19, MainTexture.clBevelLight, 699 MainTexture.clBevelShade); 700 RisedTextOut(Canvas, 24 { x0Brain+32-BiColorTextWidth(Canvas,s) div 2 } , 701 yMain + 140 { y0Mini-77 } , Phrases.Lookup('STARTCONTROLS', 15)); 702 if Page = pgStartRandom then 703 s := IntToStr(AutoEnemies) 704 else if nMapStartPositions = 0 then 705 s := '0' 706 else 707 s := IntToStr(nMapStartPositions - 1); 708 RisedTextOut(Canvas, 198 - BiColorTextWidth(Canvas, s), yMain + 140, s); 709 DLine(Canvas, 24, xDefault - 6, yMain + 164 + 19, 710 MainTexture.clBevelLight, MainTexture.clBevelShade); 711 RisedTextOut(Canvas, 24 { x0Brain+32-BiColorTextWidth(Canvas,s) div 2 } , 712 yMain + 164 { y0Mini-77 } , Phrases.Lookup('STARTCONTROLS', 16)); 713 if AutoDiff = 1 then 714 FrameImage(Canvas, BrainPicture[bixBeginner], xDefault, yDefault, 64, 715 64, 0, 0, false) 716 else 717 FrameImage(Canvas, BrainPicture[bixDefault], xDefault, yDefault, 64, 64, 718 0, 0, true); 719 DLine(Canvas, 56, 272, y0Mini + 61 + 19, MainTexture.clBevelLight, 720 MainTexture.clBevelShade); 721 RisedTextOut(Canvas, 56, y0Mini + 61, 722 Phrases.Lookup('STARTCONTROLS', 14)); 723 s := Phrases.Lookup('AUTODIFF', AutoDiff - 1); 724 RisedTextOut(Canvas, 272 - BiColorTextWidth(Canvas, s), y0Mini + 61, s); 725 726 for i := 0 to 19 do 727 if (i < 2) or (i > 6) then 728 begin 729 BitBlt(Canvas.Handle, 9 + i * 27, yLogo - 2, wOrna, hOrna, 730 GrExt[HGrSystem2].Mask.Canvas.Handle, xOrna, yOrna, SRCAND); 731 BitBlt(Canvas.Handle, 9 + i * 27, yLogo - 2, wOrna, hOrna, 732 GrExt[HGrSystem2].Data.Canvas.Handle, xOrna, yOrna, SRCPAINT); 733 end; 734 PaintLogo(Canvas, 69, yLogo, MainTexture.clBevelLight, 735 MainTexture.clBevelShade); 736 end 737 end 738 else if Page = pgLoad then 739 begin 740 // RisedTextOut(Canvas,x0Mini+2-BiColorTextWidth(Canvas,BookDate) div 2,y0Mini-73,BookDate); 741 if LastTurn > 0 then 742 begin 743 PaintProgressBar(Canvas, 6, xTurnSlider, yTurnSlider, 0, 744 LoadTurn * wTurnSlider div LastTurn, wTurnSlider, MainTexture); 745 Frame(Canvas, xTurnSlider - 2, yTurnSlider - 2, xTurnSlider + wTurnSlider 746 + 1, yTurnSlider + 8, $B0B0B0, $FFFFFF); 747 RFrame(Canvas, xTurnSlider - 3, yTurnSlider - 3, xTurnSlider + wTurnSlider 748 + 2, yTurnSlider + 9, $FFFFFF, $B0B0B0); 749 end 750 else 751 DLine(Canvas, 344, 514, y0Mini + 61 + 19, MainTexture.clBevelLight, 752 MainTexture.clBevelShade); 753 RisedTextOut(Canvas, 344, y0Mini + 61, Phrases.Lookup('STARTCONTROLS', 8)); 754 s := TurnToString(LoadTurn); 755 RisedTextOut(Canvas, 514 - BiColorTextWidth(Canvas, s), y0Mini + 61, s); 756 end 757 else if Page = pgEditRandom then 758 begin 759 DLine(Canvas, 344, 514, y0Mini - 77 + 19, MainTexture.clBevelLight, 760 MainTexture.clBevelShade); 761 RisedTextOut(Canvas, 344, y0Mini - 77, Phrases.Lookup('STARTCONTROLS', 5)); 762 s := IntToStr((lxpre[WorldSize] * lypre[WorldSize] * 20 + 763 DefaultWorldTiles div 2) div DefaultWorldTiles * 5) + '%'; 764 RisedTextOut(Canvas, 514 - BiColorTextWidth(Canvas, s), y0Mini - 77, s); 765 DLine(Canvas, 344, 514, y0Mini + 61 + 19, MainTexture.clBevelLight, 766 MainTexture.clBevelShade); 767 RisedTextOut(Canvas, 344, y0Mini + 61, Phrases.Lookup('STARTCONTROLS', 6)); 768 s := IntToStr(StartLandMass) + '%'; 769 RisedTextOut(Canvas, 514 - BiColorTextWidth(Canvas, s), y0Mini + 61, s); 770 end 771 else if Page = pgEditMap then 772 begin 773 // DLine(Canvas,344,514,y0Mini+61+19,MainTexture.clBevelLight,MainTexture.clBevelShade); 774 s := Format(Phrases2.Lookup('MAPPROP'), 775 [(nMapLandTiles * 100 + 556) div 1112, 776 // 1112 is typical for world with 100% size and default land mass 777 nMapStartPositions]); 778 RisedTextOut(Canvas, x0Mini - BiColorTextWidth(Canvas, s) div 2, 779 y0Mini + 61, s); 780 end; 781 782 if StartBtn.Visible then 783 BtnFrame(Canvas, StartBtn.BoundsRect, MainTexture); 784 if Up2Btn.Visible then 785 RFrame(Canvas, Up2Btn.left - 1, Up2Btn.top - 1, Up2Btn.left + 12, 786 Up2Btn.top + 24, MainTexture.clBevelShade, MainTexture.clBevelLight); 787 if Up1Btn.Visible then 788 RFrame(Canvas, Up1Btn.left - 1, Up1Btn.top - 1, Up1Btn.left + 12, 789 Up1Btn.top + 24, MainTexture.clBevelShade, MainTexture.clBevelLight); 790 if AutoDiffUpBtn.Visible then 791 RFrame(Canvas, AutoDiffUpBtn.left - 1, AutoDiffUpBtn.top - 1, 792 AutoDiffUpBtn.left + 12, AutoDiffUpBtn.top + 24, MainTexture.clBevelShade, 793 MainTexture.clBevelLight); 794 if AutoEnemyUpBtn.Visible then 795 RFrame(Canvas, AutoEnemyUpBtn.left - 1, AutoEnemyUpBtn.top - 1, 796 AutoEnemyUpBtn.left + 12, AutoEnemyUpBtn.top + 24, 797 MainTexture.clBevelShade, MainTexture.clBevelLight); 798 if CustomizeBtn.Visible then 799 RFrame(Canvas, CustomizeBtn.left - 1, CustomizeBtn.top - 1, 800 CustomizeBtn.left + 12, CustomizeBtn.top + 12, MainTexture.clBevelShade, 801 MainTexture.clBevelLight); 802 if List.Visible then 803 EditFrame(Canvas, List.BoundsRect, MainTexture); 804 if RenameBtn.Visible then 805 BtnFrame(Canvas, RenameBtn.BoundsRect, MainTexture); 806 if DeleteBtn.Visible then 807 BtnFrame(Canvas, DeleteBtn.BoundsRect, MainTexture); 808 if Page = pgLoad then 809 BtnFrame(Canvas, ReplayBtn.BoundsRect, MainTexture); 810 811 if not(Page in [pgMain, pgNoLoad]) then 812 begin 813 xMini := x0Mini - MiniWidth; 814 yMini := y0Mini - MiniHeight div 2; 815 Frame(Canvas, xMini, yMini, xMini + 3 + MiniWidth * 2, 816 yMini + 3 + MiniHeight, MainTexture.clBevelLight, 817 MainTexture.clBevelShade); 818 Frame(Canvas, xMini + 1, yMini + 1, xMini + 2 + MiniWidth * 2, 819 yMini + 2 + MiniHeight, MainTexture.clBevelShade, 820 MainTexture.clBevelLight); 821 end; 822 s := ''; 823 if MiniMode = mmPicture then 824 begin 825 BitBlt(Canvas.Handle, xMini + 2, yMini + 2, MiniWidth * 2, MiniHeight, 826 Mini.Canvas.Handle, 0, 0, SRCCOPY); 827 if Page = pgStartRandom then 828 s := Phrases.Lookup('RANMAP') 829 end 830 else if MiniMode = mmMultiPlayer then 831 s := Phrases.Lookup('MPMAP') 832 else if Page = pgStartMap then 833 s := Copy(MapFileName, 1, Length(MapFileName) - 9) 834 else if Page = pgEditMap then 835 s := List.Items[List.ItemIndex] 836 else if Page = pgNoLoad then 837 s := Phrases.Lookup('NOGAMES'); 838 if s <> '' then 839 RisedTextOut(Canvas, x0Mini + 2 - BiColorTextWidth(Canvas, s) div 2, 840 y0Mini - 8, s); 841 end; 842 843 procedure TStartDlg.FormShow(Sender: TObject); 844 type 845 TLine = array [0 .. 99999999] of Byte; 846 var 847 i, x, y: integer; 848 PictureLine: ^TLine; 849 begin 850 SetMainTextureByAge(-1); 851 List.Font.Color := MainTexture.clMark; 852 Fill(EmptyPicture.Canvas, 0, 0, 64, 64, (wMaintexture - 64) div 2, 853 (hMaintexture - 64) div 2); 854 for y := 0 to 63 do 855 begin // darken texture for empty slot 856 PictureLine := EmptyPicture.ScanLine[y]; 857 for x := 0 to 64 * 3 - 1 do 858 begin 859 i := integer(PictureLine[x]) - 28; 860 if i < 0 then 861 i := 0; 862 PictureLine[x] := i; 863 end 864 end; 865 866 Difficulty[0] := Diff0; 867 868 SelectedAction := -1; 869 if ShowTab = 3 then 870 PreviewMap(StartLandMass); // avoid delay on first TabX change 871 ChangeTab(ShowTab); 872 Background.Enabled := false; 873 end; 874 875 procedure TStartDlg.UnlistBackupFile(FileName: string); 876 var 877 i: integer; 878 begin 879 if FileName[1] <> '~' then 880 FileName := '~' + FileName; 881 i := FormerGames.Count - 1; 882 while (i >= 0) and (AnsiCompareFileName(FormerGames[i], FileName) <> 0) do 883 dec(i); 884 if i >= 0 then 885 begin 886 FormerGames.Delete(i); 887 if ListIndex[2] = i then 888 ListIndex[2] := 0 889 end 890 end; 891 892 procedure TStartDlg.StartBtnClick(Sender: TObject); 893 var 894 i, GameCount, MapCount: integer; 895 FileName: string; 896 Reg: TRegistry; 897 begin 898 case Page of 899 pgLoad: 900 begin // load 901 FileName := List.Items[List.ItemIndex]; 902 if LoadGame(DataDir + 'Saved\', FileName + '.cevo', LoadTurn, false) 903 then 904 UnlistBackupFile(FileName) 905 else 906 SimpleMessage(Phrases.Lookup('LOADERR')); 907 SlotAvailable := -1; 908 end; 909 910 pgStartRandom, pgStartMap: 911 if bixView[0] >= 0 then 912 begin 913 if (Page = pgStartMap) and (nMapStartPositions = 0) and (AutoDiff > 0) 914 then 915 begin 916 SimpleMessage(Phrases.Lookup('NOSTARTPOS')); 917 exit 918 end; 919 920 Reg := TRegistry.Create; 921 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start', true); 922 try 923 GameCount := Reg.ReadInteger('GameCount'); 924 except 925 GameCount := 0; 926 end; 927 928 if (AutoDiff < 0) and (bixView[0] = bixNoTerm) then 929 FileName := 'Round' + IntToStr(GetCurrentProcessID()) 930 else 931 begin 932 inc(GameCount); 933 FileName := Format(Phrases.Lookup('GAME'), [GameCount]); 934 end; 935 936 // save settings and AI assignment 937 if Page = pgStartRandom then 938 begin 939 Reg.WriteInteger('WorldSize', WorldSize); 940 Reg.WriteInteger('LandMass', StartLandMass); 941 if AutoDiff < 0 then 942 for i := 0 to nPlOffered - 1 do 943 begin 944 if bixView[i] = -1 then 945 Reg.WriteString('Control' + IntToStr(i), '') 946 else 947 Reg.WriteString('Control' + IntToStr(i), 948 Brain[bixView[i]].FileName); 949 Reg.WriteInteger('Diff' + IntToStr(i), Difficulty[i]); 950 end; 951 Reg.WriteInteger('MultiControl', MultiControl); 952 end; 953 954 if AutoDiff > 0 then 955 begin 956 Reg.WriteString('DefaultAI', Brain[bixDefault].FileName); 957 SlotAvailable := 0; // bixView will be invalid hereafter 958 bixView[0] := bixTerm; 959 Difficulty[0] := PlayerAutoDiff[AutoDiff]; 960 for i := 1 to nPl - 1 do 961 if (Page = pgStartRandom) and (i <= AutoEnemies) or 962 (Page = pgStartMap) and (i < nMapStartPositions) then 963 begin 964 if AutoDiff = 1 then 965 bixView[i] := bixBeginner 966 else 967 bixView[i] := bixDefault; 968 Difficulty[i] := EnemyAutoDiff[AutoDiff]; 969 end 970 else 971 bixView[i] := -1; 972 end 973 else 974 begin 975 for i := 6 to 8 do 976 if (bixView[0] <> bixNoTerm) and (MultiControl and (1 shl i) <> 0) 977 then 978 begin 979 bixView[i + 3] := bixView[i]; 980 Difficulty[i + 3] := Difficulty[i]; 981 bixView[i + 6] := bixView[i]; 982 Difficulty[i + 6] := Difficulty[i]; 983 end 984 else 985 begin 986 bixView[i + 3] := -1; 987 bixView[i + 6] := -1; 988 end 989 end; 990 991 Reg.WriteInteger('AutoDiff', AutoDiff); 992 Reg.WriteInteger('AutoEnemies', AutoEnemies); 993 Reg.WriteInteger('MaxTurn', MaxTurn); 994 Reg.WriteInteger('GameCount', GameCount); 995 Reg.closekey; 996 Reg.Free; 997 998 StartNewGame(DataDir + 'Saved\', FileName + '.cevo', MapFileName, 999 lxpre[WorldSize], lypre[WorldSize], StartLandMass, MaxTurn); 1000 UnlistBackupFile(FileName); 1001 end; 1002 1003 pgEditMap: 1004 EditMap(MapFileName, lxmax, lymax, StartLandMass); 1005 1006 pgEditRandom: // new map 1007 begin 1008 Reg := TRegistry.Create; 1009 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start', true); 1010 try 1011 MapCount := Reg.ReadInteger('MapCount'); 1012 except 1013 MapCount := 0; 1014 end; 1015 inc(MapCount); 1016 Reg.WriteInteger('MapCount', MapCount); 1017 Reg.closekey; 1018 Reg.Free; 1019 MapFileName := Format(Phrases.Lookup('MAP'), [MapCount]) + '.cevo map'; 1020 EditMap(MapFileName, lxpre[WorldSize], lypre[WorldSize], StartLandMass); 1021 end 1022 end 1023 end; 1024 1025 procedure TStartDlg.PaintInfo; 1026 1027 procedure PaintRandomMini(Brightness: integer); 1028 type 1029 TLine = array [0 .. lxmax * 2, 0 .. 2] of Byte; 1030 var 1031 i, x, y, xm, cm: integer; 1032 MiniLine: ^TLine; 1033 Map: ^TTileList; 1034 begin 1035 Map := PreviewMap(StartLandMass); 1036 MiniWidth := lxpre[WorldSize]; 1037 MiniHeight := lypre[WorldSize]; 1038 1039 Mini.PixelFormat := pf24bit; 1040 Mini.width := MiniWidth * 2; 1041 Mini.height := MiniHeight; 1042 for y := 0 to MiniHeight - 1 do 1043 begin 1044 MiniLine := Mini.ScanLine[y]; 1045 for x := 0 to MiniWidth - 1 do 1046 for i := 0 to 1 do 1047 begin 1048 xm := (x * 2 + i + y and 1) mod (MiniWidth * 2); 1049 cm := MiniColors 1050 [Map[x * lxmax div MiniWidth + lxmax * 1051 ((y * (lymax - 1) + MiniHeight div 2) div (MiniHeight - 1))] and 1052 fTerrain, i]; 1053 MiniLine[xm, 0] := cm shr 16 * Brightness div 3; 1054 MiniLine[xm, 1] := cm shr 8 and $FF * Brightness div 3; 1055 MiniLine[xm, 2] := cm and $FF * Brightness div 3; 1056 end; 418 1057 end; 419 if not invalidateTab0 then 420 begin 421 r1:=CreateRectRgn(0,0,6+36,3+38); // tab 0 icon 422 CombineRgn(r0,r0,r1,RGN_DIFF); 423 DeleteObject(r1); 424 end; 425 InvalidateRgn(Handle,r0,false); 426 DeleteObject(r0); 427 end; 428 429 procedure TStartDlg.FormPaint(Sender:TObject); 430 const 431 TabNames: array[0..3] of integer=(0,11,3,4); 432 433 procedure DrawAction(y,IconIndex: integer; HeaderItem, TextItem: string); 434 begin 435 Canvas.Font.Assign(UniFont[ftCaption]); 436 Canvas.Font.Style:=Canvas.Font.Style+[fsUnderline]; 437 RisedTextOut(Canvas,xAction,y-3,Phrases2.Lookup(HeaderItem)); 438 Canvas.Font.Assign(UniFont[ftNormal]); 439 BiColorTextOut(Canvas,Colors.Canvas.Pixels[clkAge0-1,cliDimmedText], 440 $000000,xAction,y+21,Phrases2.Lookup(TextItem)); 441 BitBlt(LogoBuffer.Canvas.Handle,0,0,50,50,Canvas.Handle,xActionIcon-2,y-2,SRCCOPY); 442 GlowFrame(LogoBuffer,8,8,34,34,$202020); 443 BitBlt(Canvas.Handle,xActionIcon-2,y-2,50,50,LogoBuffer.Canvas.Handle,0,0,SRCCOPY); 444 BitBlt(Canvas.Handle,xActionIcon,y,40,40,BigImp.Canvas.Handle,(IconIndex mod 7)*xSizeBig+8, 445 (IconIndex div 7)*ySizeBig, SRCCOPY); 446 RFrame(Canvas,xActionIcon-1,y-1,xActionIcon+40,y+40,$000000,$000000); 447 end; 448 449 var 450 i,w,h,xMini,yMini,y:integer; 451 s: string; 452 begin 453 PaintBackground(self,3,3,TabOffset+4*TabSize-4,TabHeight-3); 454 PaintBackground(self,3,TabHeight+3,ClientWidth-6,ClientHeight-TabHeight-6); 455 with Canvas do 456 begin 457 Brush.Color:=$000000; 458 FillRect(Rect(0,1,ClientWidth,3)); 459 FillRect(Rect(TabOffset+4*TabSize+2,0,ClientWidth,TabHeight)); 460 Brush.Style:=bsClear; 461 end; 462 if Page in [pgStartRandom,pgStartMap] then 463 begin 464 Frame(Canvas,328,yMain+112-15,ClientWidth,Up2Btn.Top+38, 465 MainTexture.clBevelShade,MainTexture.clBevelLight); 466 if AutoDiff>0 then 467 begin 468 Frame(Canvas,-1{x0Brain-dxBrain},yMain+112-15{Up1Btn.Top-12}{y0Brain-dyBrain},x0Brain+dxBrain+64, 469 Up2Btn.Top+38{y0Brain+dyBrain+64}, MainTexture.clBevelShade,MainTexture.clBevelLight); 470 end 471 end 472 else if Page<>pgMain then 473 Frame(Canvas,328,Up1Btn.Top-15,ClientWidth,Up2Btn.Top+38, 474 MainTexture.clBevelShade,MainTexture.clBevelLight); 475 Frame(Canvas,0,0,ClientWidth-1,ClientHeight-1,0,0); 476 477 // draw tabs 478 Frame(Canvas,2,2+2*integer(Tab<>0),TabOffset+(0+1)*TabSize-1,TabHeight,MainTexture.clBevelLight,MainTexture.clBevelShade); 479 Frame(Canvas,1,1+2*integer(Tab<>0),TabOffset+(0+1)*TabSize,TabHeight,MainTexture.clBevelLight,MainTexture.clBevelShade); 480 Canvas.Pixels[1,1+2*integer(Tab<>0)]:=MainTexture.clBevelShade; 481 for i:=1 to 3 do 482 begin 483 Frame(Canvas,TabOffset+i*TabSize+2,2+2*integer(Tab<>i),TabOffset+(i+1)*TabSize-1,TabHeight,MainTexture.clBevelLight,MainTexture.clBevelShade); 484 Frame(Canvas,TabOffset+i*TabSize+1,1+2*integer(Tab<>i),TabOffset+(i+1)*TabSize,TabHeight,MainTexture.clBevelLight,MainTexture.clBevelShade); 485 Canvas.Pixels[TabOffset+i*TabSize+1,1+2*integer(Tab<>i)]:=MainTexture.clBevelShade; 486 end; 487 Canvas.Font.Assign(UniFont[ftNormal]); 488 for i:=1 to 3 do 489 begin 490 s:=Phrases.Lookup('STARTCONTROLS',TabNames[i]); 491 RisedTextOut(Canvas,TabOffset+i*TabSize+1+(TabSize-BiColorTextWidth(Canvas,s)) div 2, 492 10+2*integer(Tab<>i),s); 493 end; 494 Frame(Canvas,TabOffset+4*TabSize+1,-1,ClientWidth,TabHeight,$000000,$000000); 495 Frame(Canvas,1,TabHeight+1,ClientWidth-2,ClientHeight-2,MainTexture.clBevelLight, 496 MainTexture.clBevelShade); 497 Frame(Canvas,2,TabHeight+2,ClientWidth-3,ClientHeight-3,MainTexture.clBevelLight, 498 MainTexture.clBevelShade); 499 if Tab=0 then 500 begin 501 PaintBackground(self,3,TabHeight-1,TabSize-4-3+TabOffset+3,4); 502 Canvas.Pixels[2,TabHeight]:=MainTexture.clBevelLight; 503 end 504 else 505 begin 506 PaintBackground(self,TabOffset+3+Tab*TabSize,TabHeight-1,TabSize-4,4); 507 Canvas.Pixels[TabOffset+Tab*TabSize+2,TabHeight]:=MainTexture.clBevelLight; 508 end; 509 Canvas.Pixels[TabOffset+(Tab+1)*TabSize-1,TabHeight+1]:=MainTexture.clBevelShade; 510 if Tab<3 then 511 Frame(Canvas,TabOffset+(Tab+1)*TabSize+1,3,TabOffset+(Tab+1)*TabSize+2,TabHeight, 512 MainTexture.clBevelShade,MainTexture.clBevelShade); // Tab shadow 513 BitBlt(LogoBuffer.Canvas.Handle,0,0,36,36,Canvas.Handle,6,3+2*integer(Tab<>0),SRCCOPY); 514 ImageOp_BCC(LogoBuffer,Templates,0,0,145,38,36,27,$BFBF20,$4040DF); // logo part 1 515 ImageOp_BCC(LogoBuffer,Templates,10,27,155,38+27,26,9,$BFBF20,$4040DF); // logo part 2 516 BitBlt(Canvas.Handle,6,3+2*integer(Tab<>0),36,36,LogoBuffer.Canvas.Handle,0,0,SRCCOPY); 517 518 if page=pgMain then 519 begin 520 if SelectedAction>=0 then // mark selected action 521 for i:=0 to (ClientWidth-2*ActionSideBorder) div wBuffer+1 do 522 begin 523 w:=ClientWidth-2*ActionSideBorder-i*wBuffer; 524 if w>wBuffer then 525 w:=wBuffer; 526 h:=ActionPitch; 527 if yAction+SelectedAction*ActionPitch-8+h>ClientHeight-ActionBottomBorder then 528 h:=ClientHeight-ActionBottomBorder-(yAction+SelectedAction*ActionPitch-8); 529 BitBlt(LogoBuffer.Canvas.Handle,0,0,w,h,Canvas.Handle, 530 ActionSideBorder+i*wBuffer,yAction+SelectedAction*ActionPitch-8,SRCCOPY); 531 MakeBlue(LogoBuffer,0,0,w,h); 532 BitBlt(Canvas.Handle,ActionSideBorder+i*wBuffer, 533 yAction+SelectedAction*ActionPitch-8,w,h, 534 LogoBuffer.Canvas.Handle,0,0,SRCCOPY); 1058 end; 1059 1060 var 1061 SaveMap: array [0 .. lxmax * lymax - 1] of Byte; 1062 1063 procedure PaintFileMini; 1064 type 1065 TLine = array [0 .. 99999999, 0 .. 2] of Byte; 1066 var 1067 i, x, y, xm, cm, Tile, OwnColor, EnemyColor: integer; 1068 MiniLine, PrevMiniLine: ^TLine; 1069 begin 1070 OwnColor := GrExt[HGrSystem].Data.Canvas.Pixels[95, 67]; 1071 EnemyColor := GrExt[HGrSystem].Data.Canvas.Pixels[96, 67]; 1072 Mini.PixelFormat := pf24bit; 1073 Mini.width := MiniWidth * 2; 1074 Mini.height := MiniHeight; 1075 if MiniMode = mmPicture then 1076 begin 1077 MiniLine := nil; 1078 for y := 0 to MiniHeight - 1 do 1079 begin 1080 PrevMiniLine := MiniLine; 1081 MiniLine := Mini.ScanLine[y]; 1082 for x := 0 to MiniWidth - 1 do 1083 for i := 0 to 1 do 1084 begin 1085 xm := (x * 2 + i + y and 1) mod (MiniWidth * 2); 1086 Tile := SaveMap[x + MiniWidth * y]; 1087 if Tile and fTerrain = fUNKNOWN then 1088 cm := $000000 1089 else if Tile and smCity <> 0 then 1090 begin 1091 if Tile and smOwned <> 0 then 1092 cm := OwnColor 1093 else 1094 cm := EnemyColor; 1095 if PrevMiniLine <> nil then 1096 begin // 2x2 city dot covers two scanlines 1097 PrevMiniLine[xm, 0] := cm shr 16; 1098 PrevMiniLine[xm, 1] := cm shr 8 and $FF; 1099 PrevMiniLine[xm, 2] := cm and $FF; 1100 end 1101 end 1102 else if (i = 0) and (Tile and smUnit <> 0) then 1103 if Tile and smOwned <> 0 then 1104 cm := OwnColor 1105 else 1106 cm := EnemyColor 1107 else 1108 cm := MiniColors[Tile and fTerrain, i]; 1109 MiniLine[xm, 0] := cm shr 16; 1110 MiniLine[xm, 1] := cm shr 8 and $FF; 1111 MiniLine[xm, 2] := cm and $FF; 1112 end; 1113 end 1114 end; 1115 end; 1116 1117 var 1118 x, y, dummy, FileLandMass, lxFile, lyFile: integer; 1119 LogFile, MapFile: file; 1120 s: string[255]; 1121 MapRow: array [0 .. lxmax - 1] of Cardinal; 1122 1123 begin 1124 case Page of 1125 pgStartRandom: 1126 begin 1127 MiniMode := mmPicture; 1128 PaintRandomMini(3); 535 1129 end; 536 y:=yAction; 537 for i:=0 to nMainActions-1 do 538 begin 539 if i in ActionsOffered then 540 case i of 541 maConfig: 542 DrawAction(y,25,'ACTIONHEADER_CONFIG','ACTION_CONFIG'); 543 maManual: 544 DrawAction(y,19,'ACTIONHEADER_MANUAL','ACTION_MANUAL'); 545 maCredits: 546 DrawAction(y,22,'ACTIONHEADER_CREDITS','ACTION_CREDITS'); 547 maAIDev: 548 DrawAction(y,24,'ACTIONHEADER_AIDEV','ACTION_AIDEV'); 549 maWeb: 1130 1131 pgNoLoad: 1132 begin 1133 MiniWidth := lxpre[DefaultWorldSize]; 1134 MiniHeight := lypre[DefaultWorldSize]; 1135 MiniMode := mmNone; 1136 end; 1137 1138 pgLoad: 1139 begin 1140 AssignFile(LogFile, DataDir + 'Saved\' + List.Items[List.ItemIndex] 1141 + '.cevo'); 1142 try 1143 Reset(LogFile, 4); 1144 BlockRead(LogFile, s[1], 2); { file id } 1145 BlockRead(LogFile, dummy, 1); { format id } 1146 if dummy >= $000E01 then 1147 BlockRead(LogFile, dummy, 1); { item stored since 0.14.1 } 1148 BlockRead(LogFile, MiniWidth, 1); 1149 BlockRead(LogFile, MiniHeight, 1); 1150 BlockRead(LogFile, FileLandMass, 1); 1151 if FileLandMass = 0 then 1152 for y := 0 to MiniHeight - 1 do 1153 BlockRead(LogFile, MapRow, MiniWidth); 1154 BlockRead(LogFile, dummy, 1); 1155 BlockRead(LogFile, dummy, 1); 1156 BlockRead(LogFile, LastTurn, 1); 1157 BlockRead(LogFile, SaveMap, 1); 1158 if SaveMap[0] = $80 then 1159 MiniMode := mmMultiPlayer 1160 else 1161 MiniMode := mmPicture; 1162 if MiniMode = mmPicture then 1163 BlockRead(LogFile, SaveMap[4], (MiniWidth * MiniHeight - 1) div 4); 1164 CloseFile(LogFile); 1165 except 1166 CloseFile(LogFile); 1167 LastTurn := 0; 1168 MiniWidth := lxpre[DefaultWorldSize]; 1169 MiniHeight := lypre[DefaultWorldSize]; 1170 MiniMode := mmNone; 1171 end; 1172 // BookDate:=DateToStr(FileDateToDateTime(FileAge(FileName))); 1173 PaintFileMini; 1174 if not TurnValid then 1175 begin 1176 LoadTurn := LastTurn; 1177 SmartInvalidate(xTurnSlider - 2, y0Mini + 61, 1178 xTurnSlider + wTurnSlider + 2, yTurnSlider + 9); 1179 end; 1180 TurnValid := true; 1181 end; 1182 1183 pgEditRandom: 1184 begin 1185 MapFileName := ''; 1186 MiniMode := mmPicture; 1187 PaintRandomMini(4); 1188 end; 1189 1190 pgStartMap, pgEditMap: 1191 begin 1192 MiniMode := mmPicture; 1193 if Page = pgEditMap then 1194 MapFileName := List.Items[List.ItemIndex] + '.cevo map'; 1195 if LoadGraphicFile(Mini, DataDir + 'Maps\' + Copy(MapFileName, 1, 1196 Length(MapFileName) - 9), gfNoError) then 1197 begin 1198 if Mini.width div 2 > MaxWidthMapLogo then 1199 Mini.width := MaxWidthMapLogo * 2; 1200 if Mini.height > MaxHeightMapLogo then 1201 Mini.height := MaxHeightMapLogo; 1202 MiniWidth := Mini.width div 2; 1203 MiniHeight := Mini.height; 1204 end 1205 else 1206 begin 1207 MiniMode := mmNone; 1208 MiniWidth := MaxWidthMapLogo; 1209 MiniHeight := MaxHeightMapLogo; 1210 end; 1211 1212 AssignFile(MapFile, DataDir + 'Maps\' + MapFileName); 1213 try 1214 Reset(MapFile, 4); 1215 BlockRead(MapFile, s[1], 2); { file id } 1216 BlockRead(MapFile, x, 1); { format id } 1217 BlockRead(MapFile, x, 1); // MaxTurn 1218 BlockRead(MapFile, lxFile, 1); 1219 BlockRead(MapFile, lyFile, 1); 1220 nMapLandTiles := 0; 1221 nMapStartPositions := 0; 1222 for y := 0 to lyFile - 1 do 550 1223 begin 551 Canvas.Font.Assign(UniFont[ftCaption]); 552 //Canvas.Font.Style:=Canvas.Font.Style+[fsUnderline]; 553 RisedTextOut(Canvas,xActionIcon+99,y,Phrases2.Lookup('ACTIONHEADER_WEB')); 554 Canvas.Font.Assign(UniFont[ftNormal]); 555 BitBlt(LogoBuffer.Canvas.Handle,0,0,91,25,Canvas.Handle,xActionIcon,y+2,SRCCOPY); 556 ImageOp_BCC(LogoBuffer,Templates,0,0,1,400,91,25,0, 557 Colors.Canvas.Pixels[clkAge0-1,cliDimmedText]); 558 BitBlt(Canvas.Handle,xActionIcon,y+2,91,25,LogoBuffer.Canvas.Handle,0,0,SRCCOPY); 1224 BlockRead(MapFile, MapRow, lxFile); 1225 for x := 0 to lxFile - 1 do 1226 begin 1227 if (MapRow[x] and fTerrain) in [fGrass, fPrairie, fTundra, fSwamp, 1228 fForest, fHills] then 1229 inc(nMapLandTiles); 1230 if MapRow[x] and (fPrefStartPos or fStartPos) <> 0 then 1231 inc(nMapStartPositions); 1232 end 559 1233 end; 560 end; 561 inc(y,ActionPitch); 562 end 563 end 564 else if Page in [pgStartRandom,pgStartMap] then 565 begin 566 DLine(Canvas,344,514,y0Mini+61+19,MainTexture.clBevelLight,MainTexture.clBevelShade); 567 RisedTextOut(Canvas,344,y0Mini+61,Phrases.Lookup('STARTCONTROLS',10)); 568 s:=TurnToString(MaxTurn); 569 RisedTextOut(Canvas,514-BiColorTextWidth(Canvas,s),y0Mini+61,s); 570 s:=Phrases.Lookup('STARTCONTROLS',7); 571 w:=Canvas.TextWidth(s); 572 LoweredTextOut(Canvas,-2,MainTexture,x0Brain+32-w div 2,y0Brain+dyBrain+69,s); 573 574 InitOrnament; 575 if AutoDiff<0 then 576 begin 577 for i:=12 to 19 do if (i<13) or (i>17) then 578 begin 579 BitBlt(Canvas.Handle,9+i*27,yLogo-2,wOrna,hOrna, 580 GrExt[HGrSystem2].Mask.Canvas.Handle,xOrna,yOrna,SRCAND); 581 BitBlt(Canvas.Handle,9+i*27,yLogo-2,wOrna,hOrna, 582 GrExt[HGrSystem2].Data.Canvas.Handle,xOrna,yOrna,SRCPAINT); 1234 if nMapStartPositions > nPl then 1235 nMapStartPositions := nPl; 1236 CloseFile(MapFile); 1237 except 1238 CloseFile(MapFile); 1239 end; 1240 if Page = pgEditMap then 1241 SmartInvalidate(x0Mini - 112, y0Mini + 61, x0Mini + 112, y0Mini + 91); 1242 end 1243 end; 1244 SmartInvalidate(x0Mini - lxmax, y0Mini - lymax div 2, 1245 x0Mini - lxmax + 2 * lxmax + 4, y0Mini - lymax div 2 + lymax + 4); 1246 end; 1247 1248 procedure TStartDlg.BrainClick(Sender: TObject); 1249 var 1250 i: integer; 1251 begin 1252 // Play('BUTTON_UP'); 1253 if bixPopup < 0 then 1254 begin // change default AI 1255 bixDefault := TMenuItem(Sender).Tag; 1256 SmartInvalidate(xDefault, yDefault, xDefault + 64, yDefault + 64); 1257 end 1258 else 1259 begin 1260 Brain[bixView[bixPopup]].Flags := Brain[bixView[bixPopup]].Flags and 1261 not fUsed; 1262 bixView[bixPopup] := TMenuItem(Sender).Tag; 1263 DiffUpBtn[bixPopup].Visible := bixView[bixPopup] >= bixTerm; 1264 DiffDownBtn[bixPopup].Visible := bixView[bixPopup] >= bixTerm; 1265 if bixPopup in OfferMultiple then 1266 begin 1267 MultiBtn[bixPopup].Visible := bixView[bixPopup] >= bixTerm; 1268 MultiBtn[bixPopup].ButtonIndex := 2 + (MultiControl shr bixPopup) and 1; 1269 end; 1270 Brain[bixView[bixPopup]].Flags := Brain[bixView[bixPopup]].Flags or fUsed; 1271 if bixView[bixPopup] < bixTerm then 1272 Difficulty[bixPopup] := 0 { supervisor } 1273 else 1274 Difficulty[bixPopup] := 2; 1275 if (Page = pgStartRandom) and (bixPopup in OfferMultiple) and 1276 (bixView[bixPopup] < 0) then 1277 MultiControl := MultiControl and not(1 shl bixPopup); 1278 if (bixPopup = 0) and (MapFileName <> '') then 1279 ChangePage(Page); 1280 if bixView[bixPopup] = bixNoTerm then 1281 begin // turn all local players off 1282 for i := 1 to nPlOffered - 1 do 1283 if bixView[i] = bixTerm then 1284 begin 1285 bixView[i] := -1; 1286 DiffUpBtn[i].Visible := false; 1287 DiffUpBtn[i].Tag := 0; 1288 DiffDownBtn[i].Visible := false; 1289 DiffDownBtn[i].Tag := 0; 1290 if i in OfferMultiple then 1291 begin 1292 MultiBtn[i].Visible := false; 1293 MultiBtn[i].Tag := 0; 1294 end; 1295 SmartInvalidate(xBrain[i] - 31, yBrain[i] - 1, xBrain[i] + 64, 1296 DiffUpBtn[i].top + 25); 1297 end; 1298 Brain[bixTerm].Flags := Brain[bixTerm].Flags and not fUsed; 1299 end; 1300 SmartInvalidate(xBrain[bixPopup] - 31, yBrain[bixPopup] - 1, 1301 xBrain[bixPopup] + 64, DiffUpBtn[bixPopup].top + 25); 1302 end 1303 end; 1304 1305 procedure TStartDlg.InitPopup(PopupIndex: integer); 1306 var 1307 i, FixedLines: integer; 1308 m: TMenuItem; 1309 1310 procedure OfferBrain(Index: integer); 1311 var 1312 j: integer; 1313 begin 1314 m := TMenuItem.Create(PopupMenu1); 1315 if Index < 0 then 1316 m.Caption := Phrases.Lookup('NOMOD') 1317 else 1318 m.Caption := Brain[Index].Name; 1319 m.Tag := Index; 1320 m.OnClick := BrainClick; 1321 j := FixedLines; 1322 while (j < PopupMenu1.Items.Count) and 1323 (StrIComp(pchar(m.Caption), pchar(PopupMenu1.Items[j].Caption)) > 0) do 1324 inc(j); 1325 m.RadioItem := true; 1326 if bixPopup < 0 then 1327 m.Checked := bixDefault = Index 1328 else 1329 m.Checked := bixView[bixPopup] = Index; 1330 PopupMenu1.Items.Insert(j, m); 1331 end; 1332 1333 begin 1334 bixPopup := PopupIndex; 1335 EmptyMenu(PopupMenu1.Items); 1336 if bixPopup < 0 then 1337 begin // select default AI 1338 FixedLines := 0; 1339 if nBrain >= bixFirstAI + 2 then 1340 begin 1341 OfferBrain(bixRandom); 1342 inc(FixedLines) 1343 end; 1344 for i := bixFirstAI to nBrain - 1 do // offer available AIs 1345 if Brain[i].Flags and fMultiple <> 0 then 1346 OfferBrain(i); 1347 end 1348 else 1349 begin 1350 FixedLines := 0; 1351 if bixPopup > 0 then 1352 begin 1353 OfferBrain(-1); 1354 inc(FixedLines); 1355 end; 1356 for i := bixTerm downto 0 do // offer game interfaces 1357 if (bixPopup = 0) or (i = bixTerm) and (bixView[0] <> bixNoTerm) then 1358 begin 1359 OfferBrain(i); 1360 inc(FixedLines); 583 1361 end; 584 PaintLogo(Canvas,69+11*27,yLogo,MainTexture.clBevelLight,MainTexture.clBevelShade); 585 586 for i:=0 to nPlOffered-1 do if 1 shl i and SlotAvailable<>0 then 587 begin 588 if bixView[i]>=0 then 589 FrameImage(Canvas,BrainPicture[bixView[i]],xBrain[i],yBrain[i],64,64,0,0,true) 590 else FrameImage(Canvas,EmptyPicture,xBrain[i],yBrain[i],64,64,0,0,true); 591 if bixView[i]>=bixTerm then 1362 if bixPopup > 0 then 1363 begin 1364 m := TMenuItem.Create(PopupMenu1); 1365 m.Caption := '-'; 1366 PopupMenu1.Items.Add(m); 1367 inc(FixedLines); 1368 if nBrain >= bixFirstAI + 2 then 1369 begin 1370 OfferBrain(bixRandom); 1371 inc(FixedLines); 1372 end; 1373 for i := bixFirstAI to nBrain - 1 do // offer available AIs 1374 if (Brain[i].Flags and fMultiple <> 0) or (Brain[i].Flags and fUsed = 0) 1375 or (i = bixView[bixPopup]) then 1376 OfferBrain(i); 1377 end; 1378 end 1379 end; 1380 1381 procedure TStartDlg.UpdateFormerGames; 1382 var 1383 i: integer; 1384 f: TSearchRec; 1385 begin 1386 FormerGames.Clear; 1387 if FindFirst(DataDir + 'Saved\*.cevo', $21, f) = 0 then 1388 repeat 1389 i := FormerGames.Count; 1390 while (i > 0) and (f.Time < integer(FormerGames.Objects[i - 1])) do 1391 dec(i); 1392 FormerGames.InsertObject(i, Copy(f.Name, 1, Length(f.Name) - 5), 1393 TObject(f.Time)); 1394 until FindNext(f) <> 0; 1395 ListIndex[2] := FormerGames.Count - 1; 1396 if (ShowTab = 2) and (FormerGames.Count > 0) then 1397 ShowTab := 3; 1398 TurnValid := false; 1399 end; 1400 1401 procedure TStartDlg.UpdateMaps; 1402 var 1403 f: TSearchRec; 1404 begin 1405 Maps.Clear; 1406 if FindFirst(DataDir + 'Maps\*.cevo map', $21, f) = 0 then 1407 repeat 1408 Maps.Add(Copy(f.Name, 1, Length(f.Name) - 9)); 1409 until FindNext(f) <> 0; 1410 Maps.Sort; 1411 Maps.Insert(0, Phrases.Lookup('RANMAP')); 1412 ListIndex[0] := Maps.IndexOf(Copy(MapFileName, 1, Length(MapFileName) - 9)); 1413 if ListIndex[0] < 0 then 1414 ListIndex[0] := 0; 1415 end; 1416 1417 procedure TStartDlg.ChangePage(NewPage: integer); 1418 var 1419 i, j, p1: integer; 1420 s: string; 1421 Reg: TRegistry; 1422 invalidateTab0: boolean; 1423 begin 1424 invalidateTab0 := (Page = pgMain) or (NewPage = pgMain); 1425 Page := NewPage; 1426 case Page of 1427 pgStartRandom, pgStartMap: 1428 begin 1429 StartBtn.Caption := Phrases.Lookup('STARTCONTROLS', 1); 1430 if Page = pgStartRandom then 1431 i := nPlOffered 1432 else 592 1433 begin 593 BitBlt(Canvas.Handle,xBrain[i]-18,yBrain[i]+19,12,14, 594 GrExt[HGrSystem].Data.Canvas.Handle,134+(Difficulty[i]-1)*13,28,SRCCOPY); 595 Frame(Canvas,xBrain[i]-19,yBrain[i]+18,xBrain[i]-18+12,yBrain[i]+(19+14), 596 $000000,$000000); 597 RFrame(Canvas,DiffUpBtn[i].Left-1,DiffUpBtn[i].Top-1,DiffUpBtn[i].Left+12, 598 DiffUpBtn[i].Top+24,MainTexture.clBevelShade,MainTexture.clBevelLight); 599 with Canvas do 1434 i := nMapStartPositions; 1435 if i = 0 then 600 1436 begin 601 Brush.Color:=$000000; 602 FillRect(Rect(xBrain[i]-5,yBrain[i]+25,xBrain[i]-2,yBrain[i]+27)); 603 Brush.Style:=bsClear; 1437 bixView[0] := bixSuper_Virtual; 1438 Difficulty[0] := 0 604 1439 end; 605 if i in OfferMultiple then 1440 if bixView[0] < bixTerm then 1441 inc(i); 1442 if i > nPl then 1443 i := nPl; 1444 if i <= nPlOffered then 1445 MultiControl := 0 1446 else 1447 MultiControl := InitMulti[i]; 1448 end; 1449 if InitAlive[i] <> SlotAvailable then 1450 if Page = pgStartRandom then 1451 begin // restore AI assignment of last start 1452 Reg := TRegistry.Create; 1453 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start', false); 1454 for p1 := 0 to nPlOffered - 1 do 1455 begin 1456 bixView[p1] := -1; 1457 s := Reg.ReadString('Control' + IntToStr(p1)); 1458 Difficulty[p1] := Reg.ReadInteger('Diff' + IntToStr(p1)); 1459 if s <> '' then 1460 for j := 0 to nBrain - 1 do 1461 if AnsiCompareFileName(s, Brain[j].FileName) = 0 then 1462 bixView[p1] := j; 1463 end; 1464 MultiControl := Reg.ReadInteger('MultiControl'); 1465 Reg.closekey; 1466 Reg.Free; 1467 end 1468 else 1469 for p1 := 1 to nPl - 1 do 1470 if 1 shl p1 and InitAlive[i] <> 0 then 1471 begin 1472 bixView[p1] := bixDefault; 1473 Difficulty[p1] := 2; 1474 end 1475 else 1476 bixView[p1] := -1; 1477 SlotAvailable := InitAlive[i]; 1478 for i := 0 to nPlOffered - 1 do 1479 if (AutoDiff < 0) and (bixView[i] >= bixTerm) then 606 1480 begin 607 RFrame(Canvas,MultiBtn[i].Left-1,MultiBtn[i].Top-1,MultiBtn[i].Left+12, 608 MultiBtn[i].Top+12,MainTexture.clBevelShade,MainTexture.clBevelLight); 609 BitBlt(Canvas.Handle,xBrain[i]-31,yBrain[i],13,12, 610 GrExt[HGrSystem].Data.Canvas.Handle,88,47,SRCCOPY); 1481 DiffUpBtn[i].Tag := 768; 1482 DiffDownBtn[i].Tag := 768; 611 1483 end 612 end; 613 if bixView[i]>=0 then 1484 else 1485 begin 1486 DiffUpBtn[i].Tag := 0; 1487 DiffDownBtn[i].Tag := 0; 1488 end; 1489 for i := 6 to 8 do 1490 if (AutoDiff < 0) and (bixView[i] >= bixTerm) then 1491 begin 1492 MultiBtn[i].Tag := 768; 1493 MultiBtn[i].ButtonIndex := 2 + (MultiControl shr i) and 1; 1494 MultiBtn[i].Enabled := Page = pgStartRandom 1495 end 1496 else 1497 MultiBtn[i].Tag := 0; 1498 if (AutoDiff > 0) and (Page <> pgStartMap) then 614 1499 begin 615 DiffUpBtn[i].Hint:=Format(Phrases.Lookup('STARTCONTROLS',9), 616 [Brain[bixView[i]].Name]); 617 DiffDownBtn[i].Hint:=DiffUpBtn[i].Hint; 1500 AutoEnemyUpBtn.Tag := 768; 1501 AutoEnemyDownBtn.Tag := 768; 1502 end 1503 else 1504 begin 1505 AutoEnemyUpBtn.Tag := 0; 1506 AutoEnemyDownBtn.Tag := 0; 1507 end; 1508 if AutoDiff > 0 then 1509 begin 1510 AutoDiffUpBtn.Tag := 768; 1511 AutoDiffDownBtn.Tag := 768; 1512 end 1513 else 1514 begin 1515 AutoDiffUpBtn.Tag := 0; 1516 AutoDiffDownBtn.Tag := 0; 618 1517 end 619 1518 end; 620 end 621 else 622 begin 623 DLine(Canvas,24,198,yMain+140+19,MainTexture.clBevelLight,MainTexture.clBevelShade); 624 RisedTextOut(Canvas,24{x0Brain+32-BiColorTextWidth(Canvas,s) div 2},yMain+140{y0Mini-77}, 625 Phrases.Lookup('STARTCONTROLS',15)); 626 if Page=pgStartRandom then s:=IntToStr(AutoEnemies) 627 else if nMapStartPositions=0 then s:='0' 628 else s:=IntToStr(nMapStartPositions-1); 629 RisedTextOut(Canvas,198-BiColorTextWidth(Canvas,s),yMain+140,s); 630 DLine(Canvas,24,xDefault-6,yMain+164+19,MainTexture.clBevelLight,MainTexture.clBevelShade); 631 RisedTextOut(Canvas,24{x0Brain+32-BiColorTextWidth(Canvas,s) div 2},yMain+164{y0Mini-77}, 632 Phrases.Lookup('STARTCONTROLS',16)); 633 if AutoDiff=1 then 634 FrameImage(Canvas,BrainPicture[bixBeginner],xDefault,yDefault,64,64,0,0,false) 635 else FrameImage(Canvas,BrainPicture[bixDefault],xDefault,yDefault,64,64,0,0,true); 636 DLine(Canvas,56,272,y0Mini+61+19,MainTexture.clBevelLight,MainTexture.clBevelShade); 637 RisedTextOut(Canvas,56,y0Mini+61,Phrases.Lookup('STARTCONTROLS',14)); 638 s:=Phrases.Lookup('AUTODIFF',AutoDiff-1); 639 RisedTextOut(Canvas,272-BiColorTextWidth(Canvas,s),y0Mini+61,s); 640 641 for i:=0 to 19 do if (i<2) or (i>6) then 642 begin 643 BitBlt(Canvas.Handle,9+i*27,yLogo-2,wOrna,hOrna, 644 GrExt[HGrSystem2].Mask.Canvas.Handle,xOrna,yOrna,SRCAND); 645 BitBlt(Canvas.Handle,9+i*27,yLogo-2,wOrna,hOrna, 646 GrExt[HGrSystem2].Data.Canvas.Handle,xOrna,yOrna,SRCPAINT); 1519 1520 pgNoLoad, pgLoad: 1521 begin 1522 StartBtn.Caption := Phrases.Lookup('STARTCONTROLS', 2); 1523 RenameBtn.Hint := Phrases.Lookup('BTN_RENGAME'); 1524 DeleteBtn.Hint := Phrases.Lookup('BTN_DELGAME'); 647 1525 end; 648 PaintLogo(Canvas,69,yLogo,MainTexture.clBevelLight,MainTexture.clBevelShade); 649 end 650 end 651 else if Page=pgLoad then 652 begin 653 // RisedTextOut(Canvas,x0Mini+2-BiColorTextWidth(Canvas,BookDate) div 2,y0Mini-73,BookDate); 654 if LastTurn>0 then 655 begin 656 PaintProgressBar(canvas,6,xTurnSlider,yTurnSlider,0, 657 LoadTurn*wTurnSlider div LastTurn,wTurnSlider,MainTexture); 658 Frame(canvas,xTurnSlider-2,yTurnSlider-2,xTurnSlider+wTurnSlider+1, 659 yTurnSlider+8,$B0B0B0,$FFFFFF); 660 RFrame(canvas,xTurnSlider-3,yTurnSlider-3,xTurnSlider+wTurnSlider+2, 661 yTurnSlider+9,$FFFFFF,$B0B0B0); 662 end 663 else DLine(Canvas,344,514,y0Mini+61+19,MainTexture.clBevelLight,MainTexture.clBevelShade); 664 RisedTextOut(Canvas,344,y0Mini+61,Phrases.Lookup('STARTCONTROLS',8)); 665 s:=TurnToString(LoadTurn); 666 RisedTextOut(Canvas,514-BiColorTextWidth(Canvas,s),y0Mini+61,s); 667 end 668 else if Page=pgEditRandom then 669 begin 670 DLine(Canvas,344,514,y0Mini-77+19,MainTexture.clBevelLight,MainTexture.clBevelShade); 671 RisedTextOut(Canvas,344,y0Mini-77,Phrases.Lookup('STARTCONTROLS',5)); 672 s:=IntToStr((lxpre[WorldSize]*lypre[WorldSize]*20 + DefaultWorldTiles div 2) 673 div DefaultWorldTiles *5)+'%'; 674 RisedTextOut(Canvas,514-BiColorTextWidth(Canvas,s),y0Mini-77,s); 675 DLine(Canvas,344,514,y0Mini+61+19,MainTexture.clBevelLight,MainTexture.clBevelShade); 676 RisedTextOut(Canvas,344,y0Mini+61,Phrases.Lookup('STARTCONTROLS',6)); 677 s:=IntToStr(StartLandMass)+'%'; 678 RisedTextOut(Canvas,514-BiColorTextWidth(Canvas,s),y0Mini+61,s); 679 end 680 else if Page=pgEditMap then 681 begin 682 //DLine(Canvas,344,514,y0Mini+61+19,MainTexture.clBevelLight,MainTexture.clBevelShade); 683 s:=Format(Phrases2.Lookup('MAPPROP'), [(nMapLandTiles*100+556) div 1112, 684 // 1112 is typical for world with 100% size and default land mass 685 nMapStartPositions]); 686 RisedTextOut(Canvas,x0Mini-BiColorTextWidth(Canvas,s) div 2,y0Mini+61,s); 687 end; 688 689 if StartBtn.Visible then 690 BtnFrame(Canvas,StartBtn.BoundsRect,MainTexture); 691 if Up2Btn.Visible then 692 RFrame(Canvas,Up2Btn.Left-1,Up2Btn.Top-1,Up2Btn.Left+12, 693 Up2Btn.Top+24,MainTexture.clBevelShade,MainTexture.clBevelLight); 694 if Up1Btn.Visible then 695 RFrame(Canvas,Up1Btn.Left-1,Up1Btn.Top-1,Up1Btn.Left+12, 696 Up1Btn.Top+24,MainTexture.clBevelShade,MainTexture.clBevelLight); 697 if AutoDiffUpBtn.Visible then 698 RFrame(Canvas,AutoDiffUpBtn.Left-1,AutoDiffUpBtn.Top-1,AutoDiffUpBtn.Left+12, 699 AutoDiffUpBtn.Top+24,MainTexture.clBevelShade,MainTexture.clBevelLight); 700 if AutoEnemyUpBtn.Visible then 701 RFrame(Canvas,AutoEnemyUpBtn.Left-1,AutoEnemyUpBtn.Top-1,AutoEnemyUpBtn.Left+12, 702 AutoEnemyUpBtn.Top+24,MainTexture.clBevelShade,MainTexture.clBevelLight); 703 if CustomizeBtn.Visible then 704 RFrame(Canvas,CustomizeBtn.Left-1,CustomizeBtn.Top-1,CustomizeBtn.Left+12, 705 CustomizeBtn.Top+12,MainTexture.clBevelShade,MainTexture.clBevelLight); 706 if List.Visible then 707 EditFrame(Canvas,List.BoundsRect,MainTexture); 708 if RenameBtn.Visible then 709 BtnFrame(Canvas,RenameBtn.BoundsRect,MainTexture); 710 if DeleteBtn.Visible then 711 BtnFrame(Canvas,DeleteBtn.BoundsRect,MainTexture); 712 if Page=pgLoad then 713 BtnFrame(Canvas,ReplayBtn.BoundsRect,MainTexture); 714 715 if not (Page in [pgMain,pgNoLoad]) then 716 begin 717 xMini:=x0Mini-MiniWidth; 718 yMini:=y0Mini-MiniHeight div 2; 719 Frame(Canvas,xMini,yMini,xMini+3+MiniWidth*2,yMini+3+MiniHeight,MainTexture.clBevelLight, 720 MainTexture.clBevelShade); 721 Frame(Canvas,xMini+1,yMini+1,xMini+2+MiniWidth*2,yMini+2+MiniHeight,MainTexture.clBevelShade, 722 MainTexture.clBevelLight); 723 end; 724 s:=''; 725 if MiniMode=mmPicture then 726 begin 727 BitBlt(Canvas.Handle,xMini+2,yMini+2,MiniWidth*2,MiniHeight,Mini.Canvas.Handle,0,0,SRCCOPY); 728 if page=pgStartRandom then s:=Phrases.Lookup('RANMAP') 729 end 730 else if MiniMode=mmMultiPlayer then s:=Phrases.Lookup('MPMAP') 731 else if page=pgStartMap then s:=Copy(MapFileName,1,Length(MapFileName)-9) 732 else if page=pgEditMap then s:=List.Items[List.ItemIndex] 733 else if page=pgNoLoad then s:=Phrases.Lookup('NOGAMES'); 734 if s<>'' then 735 RisedTextOut(Canvas,x0Mini+2-BiColorTextWidth(Canvas,s) div 2,y0Mini-8,s); 736 end; 737 738 procedure TStartDlg.FormShow(Sender:TObject); 739 type 740 TLine=array[0..99999999] of Byte; 741 var 742 i,x,y: integer; 743 PictureLine: ^TLine; 744 begin 745 SetMainTextureByAge(-1); 746 List.Font.Color:=MainTexture.clMark; 747 Fill(EmptyPicture.Canvas,0,0,64,64,(wMaintexture-64) div 2, 748 (hMaintexture-64) div 2); 749 for y:=0 to 63 do 750 begin // darken texture for empty slot 751 PictureLine:=EmptyPicture.ScanLine[y]; 752 for x:=0 to 64*3-1 do 753 begin 754 i:=integer(PictureLine[x])-28; 755 if i<0 then i:=0; 756 PictureLine[x]:=i; 757 end 758 end; 759 760 Difficulty[0]:=Diff0; 761 762 SelectedAction:=-1; 763 if ShowTab=3 then PreviewMap(StartLandMass); // avoid delay on first TabX change 764 ChangeTab(ShowTab); 765 Background.Enabled:=false; 766 end; 767 768 procedure TStartDlg.UnlistBackupFile(FileName: string); 769 var 770 i: integer; 771 begin 772 if FileName[1]<>'~' then FileName:='~'+FileName; 773 i:=FormerGames.Count-1; 774 while (i>=0) and (AnsiCompareFileName(FormerGames[i],FileName)<>0) do dec(i); 775 if i>=0 then 776 begin 777 FormerGames.Delete(i); 778 if ListIndex[2]=i then ListIndex[2]:=0 779 end 780 end; 781 782 procedure TStartDlg.StartBtnClick(Sender:TObject); 783 var 784 i,GameCount,MapCount: integer; 785 FileName: string; 786 Reg: TRegistry; 787 begin 788 case Page of 789 pgLoad: 790 begin //load 791 FileName:=List.Items[List.ItemIndex]; 792 if LoadGame(DataDir+'Saved\', FileName+'.cevo', LoadTurn,false) then 793 UnlistBackupFile(FileName) 794 else SimpleMessage(Phrases.Lookup('LOADERR')); 795 SlotAvailable:=-1; 796 end; 797 798 pgStartRandom,pgStartMap: if bixView[0]>=0 then 799 begin 800 if (page=pgStartMap) and (nMapStartPositions=0) and (AutoDiff>0) then 801 begin 802 SimpleMessage(Phrases.Lookup('NOSTARTPOS')); 803 exit 1526 1527 pgEditRandom, pgEditMap: 1528 begin 1529 StartBtn.Caption := Phrases.Lookup('STARTCONTROLS', 12); 1530 RenameBtn.Hint := Phrases.Lookup('BTN_RENMAP'); 1531 DeleteBtn.Hint := Phrases.Lookup('BTN_DELMAP'); 804 1532 end; 805 806 Reg:=TRegistry.Create; 807 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start',true); 808 try 809 GameCount:=Reg.ReadInteger('GameCount'); 810 except 811 GameCount:=0; 812 end; 813 814 if (AutoDiff<0) and (bixView[0]=bixNoTerm) then 815 FileName:='Round'+IntToStr(GetCurrentProcessID()) 1533 end; 1534 1535 PaintInfo; 1536 for i := 0 to ControlCount - 1 do 1537 Controls[i].Visible := Controls[i].Tag and (256 shl Page) <> 0; 1538 if Page = pgLoad then 1539 ReplayBtn.Visible := MiniMode <> mmMultiPlayer; 1540 List.Invalidate; 1541 SmartInvalidate(0, 0, ClientWidth, ClientHeight, invalidateTab0); 1542 end; 1543 1544 procedure TStartDlg.ChangeTab(NewTab: integer); 1545 begin 1546 Tab := NewTab; 1547 case Tab of 1548 1: 1549 List.Items.Assign(Maps); 1550 3: 1551 List.Items.Assign(FormerGames); 1552 end; 1553 if Tab <> 2 then 1554 if ListIndex[Tab] >= 0 then 1555 List.ItemIndex := ListIndex[Tab] 816 1556 else 817 begin 818 inc(GameCount); 819 FileName:=Format(Phrases.Lookup('GAME'),[GameCount]); 820 end; 821 822 // save settings and AI assignment 823 if page=pgStartRandom then 824 begin 825 Reg.WriteInteger('WorldSize',WorldSize); 826 Reg.WriteInteger('LandMass',StartLandMass); 827 if AutoDiff<0 then 828 for i:=0 to nPlOffered-1 do 829 begin 830 if bixView[i]=-1 then Reg.WriteString('Control'+IntToStr(i),'') 831 else Reg.WriteString('Control'+IntToStr(i),Brain[bixView[i]].FileName); 832 Reg.WriteInteger('Diff'+IntToStr(i),Difficulty[i]); 833 end; 834 Reg.WriteInteger('MultiControl',MultiControl); 835 end; 836 837 if AutoDiff>0 then 838 begin 839 Reg.WriteString('DefaultAI',Brain[bixDefault].FileName); 840 SlotAvailable:=0; // bixView will be invalid hereafter 841 bixView[0]:=bixTerm; 842 Difficulty[0]:=PlayerAutoDiff[AutoDiff]; 843 for i:=1 to nPl-1 do 844 if (Page=pgStartRandom) and (i<=AutoEnemies) 845 or (Page=pgStartMap) and (i<nMapStartPositions) then 846 begin 847 if AutoDiff=1 then 848 bixView[i]:=bixBeginner 849 else bixView[i]:=bixDefault; 850 Difficulty[i]:=EnemyAutoDiff[AutoDiff]; 851 end 852 else bixView[i]:=-1; 853 end 854 else 855 begin 856 for i:=6 to 8 do 857 if (bixView[0]<>bixNoTerm) and (MultiControl and (1 shl i)<>0) then 858 begin 859 bixView[i+3]:=bixView[i]; 860 Difficulty[i+3]:=Difficulty[i]; 861 bixView[i+6]:=bixView[i]; 862 Difficulty[i+6]:=Difficulty[i]; 863 end 864 else 865 begin 866 bixView[i+3]:=-1; 867 bixView[i+6]:=-1; 868 end 869 end; 870 871 Reg.WriteInteger('AutoDiff',AutoDiff); 872 Reg.WriteInteger('AutoEnemies',AutoEnemies); 873 Reg.WriteInteger('MaxTurn',MaxTurn); 874 Reg.WriteInteger('GameCount',GameCount); 875 Reg.closekey; 876 Reg.Free; 877 878 StartNewGame(DataDir+'Saved\', FileName+'.cevo', MapFileName, 879 lxpre[WorldSize], lypre[WorldSize], StartLandMass, MaxTurn); 880 UnlistBackupFile(FileName); 881 end; 882 883 pgEditMap: EditMap(MapFileName, lxmax, lymax, StartLandMass); 884 885 pgEditRandom: // new map 886 begin 887 Reg:=TRegistry.Create; 888 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start',true); 889 try 890 MapCount:=Reg.ReadInteger('MapCount'); 891 except 892 MapCount:=0; 893 end; 894 inc(MapCount); 895 Reg.WriteInteger('MapCount',MapCount); 896 Reg.closekey; 897 Reg.Free; 898 MapFileName:=Format(Phrases.Lookup('MAP'),[MapCount])+'.cevo map'; 899 EditMap(MapFileName, lxpre[WorldSize], lypre[WorldSize], StartLandMass); 900 end 901 end 902 end; 903 904 procedure TStartDlg.PaintInfo; 905 906 procedure PaintRandomMini(Brightness: integer); 907 type 908 TLine=array[0..lxmax*2,0..2] of Byte; 909 var 910 i,x,y,xm,cm:integer; 911 MiniLine:^TLine; 912 Map: ^TTileList; 913 begin 914 Map:=PreviewMap(StartLandMass); 915 MiniWidth:=lxpre[WorldSize]; MiniHeight:=lypre[WorldSize]; 916 917 Mini.PixelFormat:=pf24bit; 918 Mini.Width:=MiniWidth*2;Mini.Height:=MiniHeight; 919 for y:=0 to MiniHeight-1 do 920 begin 921 MiniLine:=Mini.ScanLine[y]; 922 for x:=0 to MiniWidth-1 do for i:=0 to 1 do 923 begin 924 xm:=(x*2+i+y and 1) mod (MiniWidth*2); 925 cm:=MiniColors[Map[x*lxmax div MiniWidth 926 +lxmax*((y*(lymax-1)+MiniHeight div 2) div (MiniHeight-1))] and fTerrain,i]; 927 MiniLine[xm,0]:=cm shr 16 *Brightness div 3; 928 MiniLine[xm,1]:=cm shr 8 and $FF *Brightness div 3; 929 MiniLine[xm,2]:=cm and $FF *Brightness div 3; 930 end; 931 end; 932 end; 933 934 var 935 SaveMap: array[0..lxmax*lymax-1] of Byte; 936 937 procedure PaintFileMini; 938 type 939 TLine=array[0..99999999,0..2] of Byte; 940 var 941 i,x,y,xm,cm,Tile,OwnColor,EnemyColor: integer; 942 MiniLine,PrevMiniLine:^TLine; 943 begin 944 OwnColor:=GrExt[HGrSystem].Data.Canvas.Pixels[95,67]; 945 EnemyColor:=GrExt[HGrSystem].Data.Canvas.Pixels[96,67]; 946 Mini.PixelFormat:=pf24bit; 947 Mini.Width:=MiniWidth*2;Mini.Height:=MiniHeight; 948 if MiniMode=mmPicture then 949 begin 950 MiniLine:=nil; 951 for y:=0 to MiniHeight-1 do 952 begin 953 PrevMiniLine:=MiniLine; 954 MiniLine:=Mini.ScanLine[y]; 955 for x:=0 to MiniWidth-1 do for i:=0 to 1 do 956 begin 957 xm:=(x*2+i+y and 1) mod (MiniWidth*2); 958 Tile:=SaveMap[x+MiniWidth*y]; 959 if Tile and fTerrain=fUNKNOWN then cm:=$000000 960 else if Tile and smCity<>0 then 961 begin 962 if Tile and smOwned<>0 then cm:=OwnColor 963 else cm:=EnemyColor; 964 if PrevMiniLine<>nil then 965 begin // 2x2 city dot covers two scanlines 966 PrevMiniLine[xm,0]:=cm shr 16; 967 PrevMiniLine[xm,1]:=cm shr 8 and $FF; 968 PrevMiniLine[xm,2]:=cm and $FF; 969 end 970 end 971 else if (i=0) and (Tile and smUnit<>0) then 972 if Tile and smOwned<>0 then cm:=OwnColor 973 else cm:=EnemyColor 974 else cm:=MiniColors[Tile and fTerrain,i]; 975 MiniLine[xm,0]:=cm shr 16; 976 MiniLine[xm,1]:=cm shr 8 and $FF; 977 MiniLine[xm,2]:=cm and $FF; 978 end; 979 end 980 end; 981 end; 982 983 var 984 x,y,dummy, FileLandMass, lxFile, lyFile: integer; 985 LogFile, MapFile: file; 986 s: string[255]; 987 MapRow: array[0..lxmax-1] of Cardinal; 988 989 begin 990 case Page of 991 pgStartRandom: 992 begin 993 MiniMode:=mmPicture; 994 PaintRandomMini(3); 995 end; 996 997 pgNoLoad: 998 begin 999 MiniWidth:=lxpre[DefaultWorldSize]; MiniHeight:=lypre[DefaultWorldSize]; 1000 MiniMode:=mmNone; 1001 end; 1002 1003 pgLoad: 1004 begin 1005 AssignFile(LogFile,DataDir+'Saved\'+List.Items[List.ItemIndex]+'.cevo'); 1006 try 1007 Reset(LogFile,4); 1008 BlockRead(LogFile,s[1],2); {file id} 1009 BlockRead(LogFile,dummy,1); {format id} 1010 if dummy>=$000E01 then 1011 BlockRead(LogFile,dummy,1); {item stored since 0.14.1} 1012 BlockRead(LogFile,MiniWidth,1); 1013 BlockRead(LogFile,MiniHeight,1); 1014 BlockRead(LogFile,FileLandMass,1); 1015 if FileLandMass=0 then 1016 for y:=0 to MiniHeight-1 do BlockRead(LogFile,MapRow,MiniWidth); 1017 BlockRead(LogFile,dummy,1); 1018 BlockRead(LogFile,dummy,1); 1019 BlockRead(LogFile,LastTurn,1); 1020 BlockRead(LogFile,SaveMap,1); 1021 if SaveMap[0]=$80 then MiniMode:=mmMultiPlayer 1022 else MiniMode:=mmPicture; 1023 if MiniMode=mmPicture then BlockRead(LogFile,SaveMap[4],(MiniWidth*MiniHeight-1) div 4); 1024 CloseFile(LogFile); 1025 except 1026 CloseFile(LogFile); 1027 LastTurn:=0; 1028 MiniWidth:=lxpre[DefaultWorldSize]; MiniHeight:=lypre[DefaultWorldSize]; 1029 MiniMode:=mmNone; 1030 end; 1031 //BookDate:=DateToStr(FileDateToDateTime(FileAge(FileName))); 1032 PaintFileMini; 1033 if not TurnValid then 1034 begin 1035 LoadTurn:=LastTurn; 1036 SmartInvalidate(xTurnSlider-2,y0Mini+61,xTurnSlider+wTurnSlider+2,yTurnSlider+9); 1037 end; 1038 TurnValid:=true; 1039 end; 1040 1041 pgEditRandom: 1042 begin 1043 MapFileName:=''; 1044 MiniMode:=mmPicture; 1045 PaintRandomMini(4); 1046 end; 1047 1048 pgStartMap,pgEditMap: 1049 begin 1050 MiniMode:=mmPicture; 1051 if Page=pgEditMap then MapFileName:=List.Items[List.ItemIndex]+'.cevo map'; 1052 if LoadGraphicFile(Mini, DataDir+'Maps\'+Copy(MapFileName,1,Length(MapFileName)-9), gfNoError) then 1053 begin 1054 if Mini.Width div 2>MaxWidthMapLogo then Mini.Width:=MaxWidthMapLogo*2; 1055 if Mini.Height>MaxHeightMapLogo then Mini.Height:=MaxHeightMapLogo; 1056 MiniWidth:=Mini.Width div 2; 1057 MiniHeight:=Mini.Height; 1058 end 1059 else 1060 begin 1061 MiniMode:=mmNone; 1062 MiniWidth:=MaxWidthMapLogo; MiniHeight:=MaxHeightMapLogo; 1063 end; 1064 1065 AssignFile(MapFile,DataDir+'Maps\'+MapFileName); 1066 try 1067 Reset(MapFile,4); 1068 BlockRead(MapFile,s[1],2); {file id} 1069 BlockRead(MapFile,x,1); {format id} 1070 BlockRead(MapFile,x,1); //MaxTurn 1071 BlockRead(MapFile,lxFile,1); 1072 BlockRead(MapFile,lyFile,1); 1073 nMapLandTiles:=0; 1074 nMapStartPositions:=0; 1075 for y:=0 to lyFile-1 do 1076 begin 1077 BlockRead(MapFile,MapRow,lxFile); 1078 for x:=0 to lxFile-1 do 1079 begin 1080 if (MapRow[x] and fTerrain) in 1081 [fGrass,fPrairie,fTundra,fSwamp,fForest,fHills] then 1082 inc(nMapLandTiles); 1083 if MapRow[x] and (fPrefStartPos or fStartPos)<>0 then 1084 inc(nMapStartPositions); 1085 end 1086 end; 1087 if nMapStartPositions>nPl then nMapStartPositions:=nPl; 1088 CloseFile(MapFile); 1089 except 1090 CloseFile(MapFile); 1091 end; 1092 if Page=pgEditMap then 1093 SmartInvalidate(x0Mini-112,y0Mini+61,x0Mini+112,y0Mini+91); 1094 end 1095 end; 1096 SmartInvalidate(x0Mini-lxmax,y0Mini-lymax div 2, 1097 x0Mini-lxmax+2*lxmax+4,y0Mini-lymax div 2+lymax+4); 1098 end; 1099 1100 procedure TStartDlg.BrainClick(Sender: TObject); 1101 var 1102 i: integer; 1103 begin 1104 //Play('BUTTON_UP'); 1105 if bixPopup<0 then 1106 begin // change default AI 1107 bixDefault:=TMenuItem(Sender).Tag; 1108 SmartInvalidate(xDefault,yDefault,xDefault+64,yDefault+64); 1109 end 1110 else 1111 begin 1112 Brain[bixView[bixPopup]].Flags:=Brain[bixView[bixPopup]].Flags and not fUsed; 1113 bixView[bixPopup]:=TMenuItem(Sender).Tag; 1114 DiffUpBtn[bixPopup].Visible:= bixView[bixPopup]>=bixTerm; 1115 DiffDownBtn[bixPopup].Visible:= bixView[bixPopup]>=bixTerm; 1116 if bixPopup in OfferMultiple then 1117 begin 1118 MultiBtn[bixPopup].Visible:= bixView[bixPopup]>=bixTerm; 1119 MultiBtn[bixPopup].ButtonIndex:=2+(MultiControl shr bixPopup) and 1; 1120 end; 1121 Brain[bixView[bixPopup]].Flags:=Brain[bixView[bixPopup]].Flags or fUsed; 1122 if bixView[bixPopup]<bixTerm then Difficulty[bixPopup]:=0 {supervisor} 1123 else Difficulty[bixPopup]:=2; 1124 if (Page=pgStartRandom) and (bixPopup in OfferMultiple) 1125 and (bixView[bixPopup]<0) then 1126 MultiControl:=MultiControl and not (1 shl bixPopup); 1127 if (bixPopup=0) and (MapFileName<>'') then ChangePage(Page); 1128 if bixView[bixPopup]=bixNoTerm then 1129 begin // turn all local players off 1130 for i:=1 to nPlOffered-1 do if bixView[i]=bixTerm then 1131 begin 1132 bixView[i]:=-1; 1133 DiffUpBtn[i].Visible:=false; 1134 DiffUpBtn[i].Tag:=0; 1135 DiffDownBtn[i].Visible:=false; 1136 DiffDownBtn[i].Tag:=0; 1137 if i in OfferMultiple then 1138 begin 1139 MultiBtn[i].Visible:=false; 1140 MultiBtn[i].Tag:=0; 1141 end; 1142 SmartInvalidate(xBrain[i]-31,yBrain[i]-1,xBrain[i]+64,DiffUpBtn[i].Top+25); 1143 end; 1144 Brain[bixTerm].Flags:=Brain[bixTerm].Flags and not fUsed; 1145 end; 1146 SmartInvalidate(xBrain[bixPopup]-31,yBrain[bixPopup]-1,xBrain[bixPopup]+64, 1147 DiffUpBtn[bixPopup].Top+25); 1148 end 1149 end; 1150 1151 procedure TStartDlg.InitPopup(PopupIndex: integer); 1152 var 1153 i, FixedLines: integer; 1154 m: TMenuItem; 1155 1156 procedure OfferBrain(Index: integer); 1157 var 1158 j: integer; 1159 begin 1160 m:=TMenuItem.Create(PopupMenu1); 1161 if Index<0 then m.Caption:=Phrases.Lookup('NOMOD') 1162 else m.Caption:=Brain[Index].Name; 1163 m.Tag:=Index; 1164 m.OnClick:=BrainClick; 1165 j:=FixedLines; 1166 while (j<PopupMenu1.Items.Count) and (StrIComp(pchar(m.Caption), 1167 pchar(PopupMenu1.Items[j].Caption))>0) do inc(j); 1168 m.RadioItem:=true; 1169 if bixPopup<0 then m.Checked:= bixDefault=Index 1170 else m.Checked:= bixView[bixPopup]=Index; 1171 PopupMenu1.Items.Insert(j,m); 1172 end; 1173 1174 begin 1175 bixPopup:=PopupIndex; 1176 EmptyMenu(PopupMenu1.Items); 1177 if bixPopup<0 then 1178 begin // select default AI 1179 FixedLines:=0; 1180 if nBrain>=bixFirstAI+2 then 1181 begin OfferBrain(bixRandom); inc(FixedLines) end; 1182 for i:=bixFirstAI to nBrain-1 do // offer available AIs 1183 if Brain[i].Flags and fMultiple<>0 then 1184 OfferBrain(i); 1185 end 1186 else 1187 begin 1188 FixedLines:=0; 1189 if bixPopup>0 then begin OfferBrain(-1); inc(FixedLines); end; 1190 for i:=bixTerm downto 0 do // offer game interfaces 1191 if (bixPopup=0) or (i=bixTerm) and (bixView[0]<>bixNoTerm) then 1192 begin OfferBrain(i); inc(FixedLines); end; 1193 if bixPopup>0 then 1194 begin 1195 m:=TMenuItem.Create(PopupMenu1); 1196 m.Caption:='-'; 1197 PopupMenu1.Items.Add(m); 1198 inc(FixedLines); 1199 if nBrain>=bixFirstAI+2 then 1200 begin OfferBrain(bixRandom); inc(FixedLines); end; 1201 for i:=bixFirstAI to nBrain-1 do // offer available AIs 1202 if (Brain[i].Flags and fMultiple<>0) or (Brain[i].Flags and fUsed=0) 1203 or (i=bixView[bixPopup]) then 1204 OfferBrain(i); 1205 end; 1206 end 1207 end; 1208 1209 procedure TStartDlg.UpdateFormerGames; 1210 var 1211 i: integer; 1212 f: TSearchRec; 1213 begin 1214 FormerGames.Clear; 1215 if FindFirst(DataDir+'Saved\*.cevo',$21,f)=0 then 1216 repeat 1217 i:=FormerGames.Count; 1218 while (i>0) and (f.Time<integer(FormerGames.Objects[i-1])) do 1219 dec(i); 1220 FormerGames.InsertObject(i,Copy(f.Name,1,Length(f.Name)-5), 1221 TObject(f.Time)); 1222 until FindNext(f)<>0; 1223 ListIndex[2]:=FormerGames.Count-1; 1224 if (ShowTab=2) and (FormerGames.Count>0) then ShowTab:=3; 1225 TurnValid:=false; 1226 end; 1227 1228 procedure TStartDlg.UpdateMaps; 1229 var 1230 f: TSearchRec; 1231 begin 1232 Maps.Clear; 1233 if FindFirst(DataDir+'Maps\*.cevo map',$21,f)=0 then 1234 repeat 1235 Maps.Add(Copy(f.Name,1,Length(f.Name)-9)); 1236 until FindNext(f)<>0; 1237 Maps.Sort; 1238 Maps.Insert(0,Phrases.Lookup('RANMAP')); 1239 ListIndex[0]:=Maps.IndexOf(Copy(MapFileName,1,Length(MapFileName)-9)); 1240 if ListIndex[0]<0 then ListIndex[0]:=0; 1241 end; 1242 1243 procedure TStartDlg.ChangePage(NewPage: integer); 1244 var 1245 i,j,p1: integer; 1246 s: string; 1247 Reg: TRegistry; 1248 invalidateTab0: boolean; 1249 begin 1250 invalidateTab0:= (Page=pgMain) or (NewPage=pgMain); 1251 Page:=NewPage; 1252 case Page of 1253 pgStartRandom, pgStartMap: 1254 begin 1255 StartBtn.Caption:=Phrases.Lookup('STARTCONTROLS',1); 1256 if Page=pgStartRandom then i:=nPlOffered 1257 else 1258 begin 1259 i:=nMapStartPositions; 1260 if i=0 then begin bixView[0]:=bixSuper_Virtual; Difficulty[0]:=0 end; 1261 if bixView[0]<bixTerm then inc(i); 1262 if i>nPl then i:=nPl; 1263 if i<=nPlOffered then MultiControl:=0 1264 else MultiControl:=InitMulti[i]; 1265 end; 1266 if InitAlive[i]<>SlotAvailable then 1267 if Page=pgStartRandom then 1268 begin // restore AI assignment of last start 1269 Reg:=TRegistry.Create; 1270 Reg.OpenKey('SOFTWARE\cevo\RegVer9\Start',false); 1271 for p1:=0 to nPlOffered-1 do 1272 begin 1273 bixView[p1]:=-1; 1274 s:=Reg.ReadString('Control'+IntToStr(p1)); 1275 Difficulty[p1]:=Reg.ReadInteger('Diff'+IntToStr(p1)); 1276 if s<>'' then 1277 for j:=0 to nBrain-1 do 1278 if AnsiCompareFileName(s,Brain[j].FileName)=0 then bixView[p1]:=j; 1279 end; 1280 MultiControl:=Reg.ReadInteger('MultiControl'); 1281 Reg.closekey; 1282 Reg.Free; 1283 end 1557 List.ItemIndex := 0; 1558 case Tab of 1559 0: 1560 ChangePage(pgMain); 1561 1: 1562 if List.ItemIndex = 0 then 1563 ChangePage(pgEditRandom) 1284 1564 else 1285 for p1:=1 to nPl-1 do 1286 if 1 shl p1 and InitAlive[i]<>0 then 1287 begin bixView[p1]:=bixDefault; Difficulty[p1]:=2; end 1288 else bixView[p1]:=-1; 1289 SlotAvailable:=InitAlive[i]; 1290 for i:=0 to nPlOffered-1 do 1291 if (AutoDiff<0) and (bixView[i]>=bixTerm) then 1292 begin DiffUpBtn[i].Tag:=768; DiffDownBtn[i].Tag:=768; end 1293 else begin DiffUpBtn[i].Tag:=0; DiffDownBtn[i].Tag:=0; end; 1294 for i:=6 to 8 do 1295 if (AutoDiff<0) and (bixView[i]>=bixTerm) then 1296 begin 1297 MultiBtn[i].Tag:=768; 1298 MultiBtn[i].ButtonIndex:=2+(MultiControl shr i) and 1; 1299 MultiBtn[i].Enabled:=Page=pgStartRandom 1300 end 1301 else MultiBtn[i].Tag:=0; 1302 if (AutoDiff>0) and (Page<>pgStartMap) then 1303 begin 1304 AutoEnemyUpBtn.Tag:=768; 1305 AutoEnemyDownBtn.Tag:=768; 1306 end 1307 else 1308 begin 1309 AutoEnemyUpBtn.Tag:=0; 1310 AutoEnemyDownBtn.Tag:=0; 1311 end; 1312 if AutoDiff>0 then 1313 begin 1314 AutoDiffUpBtn.Tag:=768; 1315 AutoDiffDownBtn.Tag:=768; 1316 end 1317 else 1318 begin 1319 AutoDiffUpBtn.Tag:=0; 1320 AutoDiffDownBtn.Tag:=0; 1321 end 1322 end; 1323 1324 pgNoLoad,pgLoad: 1325 begin 1326 StartBtn.Caption:=Phrases.Lookup('STARTCONTROLS',2); 1327 RenameBtn.Hint:=Phrases.Lookup('BTN_RENGAME'); 1328 DeleteBtn.Hint:=Phrases.Lookup('BTN_DELGAME'); 1329 end; 1330 1331 pgEditRandom,pgEditMap: 1332 begin 1333 StartBtn.Caption:=Phrases.Lookup('STARTCONTROLS',12); 1334 RenameBtn.Hint:=Phrases.Lookup('BTN_RENMAP'); 1335 DeleteBtn.Hint:=Phrases.Lookup('BTN_DELMAP'); 1336 end; 1337 end; 1338 1339 PaintInfo; 1340 for i:=0 to ControlCount-1 do 1341 Controls[i].Visible:= Controls[i].Tag and (256 shl Page)<>0; 1342 if Page=pgLoad then 1343 ReplayBtn.Visible:= MiniMode<>mmMultiPlayer; 1344 List.Invalidate; 1345 SmartInvalidate(0,0,ClientWidth,ClientHeight,invalidateTab0); 1346 end; 1347 1348 procedure TStartDlg.ChangeTab(NewTab: integer); 1349 begin 1350 Tab:=NewTab; 1351 case Tab of 1352 1: List.Items.Assign(Maps); 1353 3: List.Items.Assign(FormerGames); 1354 end; 1355 if Tab<>2 then 1356 if ListIndex[Tab]>=0 then List.ItemIndex:=ListIndex[Tab] 1357 else List.ItemIndex:=0; 1358 case Tab of 1359 0: ChangePage(pgMain); 1360 1: 1361 if List.ItemIndex=0 then ChangePage(pgEditRandom) 1362 else ChangePage(pgEditMap); 1363 2: 1364 if MapFileName='' then ChangePage(pgStartRandom) 1365 else ChangePage(pgStartMap); 1366 3: 1367 if FormerGames.Count=0 then ChangePage(pgNoLoad) 1368 else ChangePage(pgLoad); 1565 ChangePage(pgEditMap); 1566 2: 1567 if MapFileName = '' then 1568 ChangePage(pgStartRandom) 1569 else 1570 ChangePage(pgStartMap); 1571 3: 1572 if FormerGames.Count = 0 then 1573 ChangePage(pgNoLoad) 1574 else 1575 ChangePage(pgLoad); 1369 1576 end; 1370 1577 end; … … 1373 1580 Shift: TShiftState; x, y: integer); 1374 1581 var 1375 i: integer; 1376 begin 1377 if (y<TabHeight+1) and (x-TabOffset<TabSize*4) and ((x-TabOffset) div TabSize<>Tab) then 1378 begin 1379 // Play('BUTTON_DOWN'); 1380 ListIndex[Tab]:=List.ItemIndex; 1381 ChangeTab((x-TabOffset) div TabSize); 1382 end 1383 else if page=pgMain then 1384 begin 1385 case SelectedAction of 1386 maConfig: 1387 begin 1388 ShellExecute(Handle,'open',pchar(HomeDir+'Configurator.exe'), 1389 pchar('-r"'+paramstr(0)+'"'),'',SW_SHOWNORMAL); 1390 Close 1391 end; 1392 maManual: DirectHelp(cStartHelp); 1393 maCredits: DirectHelp(cStartCredits); 1394 maAIDev: ShellExecute(Handle,'open', 1395 pchar(HomeDir+'AI Template\AI development manual.html'),'','', 1396 SW_SHOWNORMAL); 1397 maWeb:ShellExecute(Handle,'open','http://c-evo.org','','',SW_SHOWNORMAL) 1582 i: integer; 1583 begin 1584 if (y < TabHeight + 1) and (x - TabOffset < TabSize * 4) and 1585 ((x - TabOffset) div TabSize <> Tab) then 1586 begin 1587 // Play('BUTTON_DOWN'); 1588 ListIndex[Tab] := List.ItemIndex; 1589 ChangeTab((x - TabOffset) div TabSize); 1590 end 1591 else if Page = pgMain then 1592 begin 1593 case SelectedAction of 1594 maConfig: 1595 begin 1596 ShellExecute(Handle, 'open', pchar(HomeDir + 'Configurator.exe'), 1597 pchar('-r"' + ParamStr(0) + '"'), '', SW_SHOWNORMAL); 1598 Close 1599 end; 1600 maManual: 1601 DirectHelp(cStartHelp); 1602 maCredits: 1603 DirectHelp(cStartCredits); 1604 maAIDev: 1605 ShellExecute(Handle, 'open', 1606 pchar(HomeDir + 'AI Template\AI development manual.html'), '', '', 1607 SW_SHOWNORMAL); 1608 maWeb: 1609 ShellExecute(Handle, 'open', 'http://c-evo.org', '', '', SW_SHOWNORMAL) 1398 1610 end; 1399 1611 end 1400 else if (AutoDiff<0) and ((page=pgStartRandom) 1401 or (page=pgStartMap) and (nMapStartPositions>0)) then 1402 begin 1403 for i:=0 to nPlOffered-1 do 1404 if (1 shl i and SlotAvailable<>0) and (x>=xBrain[i]) and (y>=yBrain[i]) 1405 and (x<xBrain[i]+64) and (y<yBrain[i]+64) then 1406 begin 1407 InitPopup(i); 1408 if yBrain[i]>y0Brain then 1409 PopupMenu1.Popup(Left+xBrain[i]+4,Top+yBrain[i]+60) 1410 else PopupMenu1.Popup(Left+xBrain[i]+4,Top+yBrain[i]+4); 1612 else if (AutoDiff < 0) and ((Page = pgStartRandom) or (Page = pgStartMap) and 1613 (nMapStartPositions > 0)) then 1614 begin 1615 for i := 0 to nPlOffered - 1 do 1616 if (1 shl i and SlotAvailable <> 0) and (x >= xBrain[i]) and 1617 (y >= yBrain[i]) and (x < xBrain[i] + 64) and (y < yBrain[i] + 64) then 1618 begin 1619 InitPopup(i); 1620 if yBrain[i] > y0Brain then 1621 PopupMenu1.Popup(left + xBrain[i] + 4, top + yBrain[i] + 60) 1622 else 1623 PopupMenu1.Popup(left + xBrain[i] + 4, top + yBrain[i] + 4); 1411 1624 end 1412 1625 end 1413 else if (AutoDiff>1) and ((page=pgStartRandom) or (page=pgStartMap)) 1414 and (x>=xDefault) and (y>=yDefault) and (x<xDefault+64) and (y<yDefault+64) then 1415 if nBrain<bixFirstAI+2 then 1626 else if (AutoDiff > 1) and ((Page = pgStartRandom) or (Page = pgStartMap)) and 1627 (x >= xDefault) and (y >= yDefault) and (x < xDefault + 64) and 1628 (y < yDefault + 64) then 1629 if nBrain < bixFirstAI + 2 then 1416 1630 SimpleMessage(Phrases.Lookup('NOALTAI')) 1417 1631 else 1418 1632 begin 1419 1633 InitPopup(-1); 1420 PopupMenu1.Popup(Left+xDefault+4,Top+yDefault+4); 1634 PopupMenu1.Popup(left + xDefault + 4, top + yDefault + 4); 1635 end 1636 else if (Page = pgLoad) and (LastTurn > 0) and (y >= yTurnSlider) and 1637 (y < yTurnSlider + 7) and (x >= xTurnSlider) and 1638 (x <= xTurnSlider + wTurnSlider) then 1639 begin 1640 LoadTurn := LastTurn * (x - xTurnSlider) div wTurnSlider; 1641 SmartInvalidate(xTurnSlider - 2, y0Mini + 61, xTurnSlider + wTurnSlider + 2, 1642 yTurnSlider + 9); 1643 Tracking := true 1644 end 1645 end; 1646 1647 procedure TStartDlg.Up2BtnClick(Sender: TObject); 1648 begin 1649 case Page of 1650 pgStartRandom, pgStartMap: 1651 if MaxTurn < 1400 then 1652 begin 1653 inc(MaxTurn, 200); 1654 SmartInvalidate(344, y0Mini + 61, 514, y0Mini + 82); 1655 end; 1656 pgLoad: 1657 if LoadTurn < LastTurn then 1658 begin 1659 inc(LoadTurn); 1660 SmartInvalidate(xTurnSlider - 2, y0Mini + 61, xTurnSlider + wTurnSlider 1661 + 2, yTurnSlider + 9); 1662 end; 1663 pgEditRandom: 1664 if StartLandMass < 96 then 1665 begin 1666 inc(StartLandMass, 5); 1667 PaintInfo; 1668 SmartInvalidate(344, y0Mini + 61, 514, y0Mini + 61 + 21); 1669 end; 1670 end 1671 end; 1672 1673 procedure TStartDlg.Down2BtnClick(Sender: TObject); 1674 begin 1675 case Page of 1676 pgStartRandom, pgStartMap: 1677 if MaxTurn > 400 then 1678 begin 1679 dec(MaxTurn, 200); 1680 SmartInvalidate(344, y0Mini + 61, 514, y0Mini + 82); 1681 end; 1682 pgLoad: 1683 if LoadTurn > 0 then 1684 begin 1685 dec(LoadTurn); 1686 SmartInvalidate(xTurnSlider - 2, y0Mini + 61, xTurnSlider + wTurnSlider 1687 + 2, yTurnSlider + 9); 1688 end; 1689 pgEditRandom: 1690 if StartLandMass > 10 then 1691 begin 1692 dec(StartLandMass, 5); 1693 PaintInfo; 1694 SmartInvalidate(344, y0Mini + 61, 514, y0Mini + 61 + 21); 1421 1695 end 1422 else if (page=pgLoad) and (LastTurn>0) and (y>=yTurnSlider) and (y<yTurnSlider+7) 1423 and (x>=xTurnSlider) and (x<=xTurnSlider+wTurnSlider) then 1424 begin 1425 LoadTurn:=LastTurn*(x-xTurnSlider) div wTurnSlider; 1426 SmartInvalidate(xTurnSlider-2,y0Mini+61,xTurnSlider+wTurnSlider+2,yTurnSlider+9); 1427 Tracking:=true 1428 end 1429 end; 1430 1431 procedure TStartDlg.Up2BtnClick(Sender: TObject); 1432 begin 1433 case Page of 1434 pgStartRandom,pgStartMap: 1435 if MaxTurn<1400 then 1436 begin 1437 inc(MaxTurn,200); 1438 SmartInvalidate(344,y0Mini+61,514,y0Mini+82); 1696 end 1697 end; 1698 1699 procedure TStartDlg.Up1BtnClick(Sender: TObject); 1700 begin 1701 if WorldSize < nWorldSize - 1 then 1702 begin 1703 inc(WorldSize); 1704 PaintInfo; 1705 SmartInvalidate(344, y0Mini - 77, 510, y0Mini - 77 + 21); 1706 end 1707 end; 1708 1709 procedure TStartDlg.Down1BtnClick(Sender: TObject); 1710 begin 1711 if WorldSize > 0 then 1712 begin 1713 dec(WorldSize); 1714 PaintInfo; 1715 SmartInvalidate(344, y0Mini - 77, 510, y0Mini - 77 + 21); 1716 end 1717 end; 1718 1719 procedure TStartDlg.FormClose(Sender: TObject; var Action: TCloseAction); 1720 begin 1721 DirectDlg.Close 1722 end; 1723 1724 procedure TStartDlg.ListClick(Sender: TObject); 1725 var 1726 i: integer; 1727 begin 1728 if (Tab = 1) and ((List.ItemIndex = 0) <> (Page = pgEditRandom)) then 1729 begin 1730 if List.ItemIndex = 0 then 1731 Page := pgEditRandom 1732 else 1733 Page := pgEditMap; 1734 for i := 0 to ControlCount - 1 do 1735 Controls[i].Visible := Controls[i].Tag and (256 shl Page) <> 0; 1736 SmartInvalidate(328, Up1Btn.top - 12, ClientWidth, Up2Btn.top + 35); 1737 end; 1738 if Page = pgLoad then 1739 TurnValid := false; 1740 PaintInfo; 1741 if Page = pgLoad then 1742 ReplayBtn.Visible := MiniMode <> mmMultiPlayer; 1743 end; 1744 1745 procedure TStartDlg.RenameBtnClick(Sender: TObject); 1746 var 1747 i: integer; 1748 NewName: string; 1749 f: file; 1750 ok: boolean; 1751 begin 1752 if List.ItemIndex >= 0 then 1753 begin 1754 if Page = pgLoad then 1755 InputDlg.Caption := Phrases.Lookup('TITLE_BOOKNAME') 1756 else 1757 InputDlg.Caption := Phrases.Lookup('TITLE_MAPNAME'); 1758 InputDlg.EInput.Text := List.Items[List.ItemIndex]; 1759 InputDlg.CenterToRect(BoundsRect); 1760 InputDlg.ShowModal; 1761 NewName := InputDlg.EInput.Text; 1762 while (NewName <> '') and (NewName[1] = '~') do 1763 Delete(NewName, 1, 1); 1764 if (InputDlg.ModalResult = mrOK) and (NewName <> '') and 1765 (NewName <> List.Items[List.ItemIndex]) then 1766 begin 1767 for i := 1 to Length(NewName) do 1768 if NewName[i] in ['\', '/', ':', '*', '?', '"', '<', '>', '|'] then 1769 begin 1770 SimpleMessage(Format(Phrases.Lookup('NOFILENAME'), [NewName[i]])); 1771 exit 1772 end; 1773 if Page = pgLoad then 1774 AssignFile(f, DataDir + 'Saved\' + List.Items[List.ItemIndex] + '.cevo') 1775 else 1776 AssignFile(f, DataDir + 'Maps\' + List.Items[List.ItemIndex] + 1777 '.cevo map'); 1778 ok := true; 1779 try 1780 if Page = pgLoad then 1781 Rename(f, DataDir + 'Saved\' + NewName + '.cevo') 1782 else 1783 Rename(f, DataDir + 'Maps\' + NewName + '.cevo map'); 1784 except 1785 // Play('INVALID'); 1786 ok := false 1439 1787 end; 1440 pgLoad: 1441 if LoadTurn<LastTurn then 1442 begin 1443 inc(LoadTurn); 1444 SmartInvalidate(xTurnSlider-2,y0Mini+61,xTurnSlider+wTurnSlider+2,yTurnSlider+9); 1445 end; 1446 pgEditRandom: 1447 if StartLandMass<96 then 1448 begin 1449 inc(StartLandMass,5); 1450 PaintInfo; 1451 SmartInvalidate(344,y0Mini+61,514,y0Mini+61+21); 1452 end; 1453 end 1454 end; 1455 1456 procedure TStartDlg.Down2BtnClick(Sender: TObject); 1457 begin 1458 case Page of 1459 pgStartRandom,pgStartMap: 1460 if MaxTurn>400 then 1461 begin 1462 dec(MaxTurn,200); 1463 SmartInvalidate(344,y0Mini+61,514,y0Mini+82); 1464 end; 1465 pgLoad: 1466 if LoadTurn>0 then 1467 begin 1468 dec(LoadTurn); 1469 SmartInvalidate(xTurnSlider-2,y0Mini+61,xTurnSlider+wTurnSlider+2,yTurnSlider+9); 1470 end; 1471 pgEditRandom: 1472 if StartLandMass>10 then 1473 begin 1474 dec(StartLandMass,5); 1475 PaintInfo; 1476 SmartInvalidate(344,y0Mini+61,514,y0Mini+61+21); 1477 end 1478 end 1479 end; 1480 1481 procedure TStartDlg.Up1BtnClick(Sender: TObject); 1482 begin 1483 if WorldSize<nWorldSize-1 then 1484 begin 1485 inc(WorldSize); 1486 PaintInfo; 1487 SmartInvalidate(344,y0Mini-77,510,y0Mini-77+21); 1488 end 1489 end; 1490 1491 procedure TStartDlg.Down1BtnClick(Sender: TObject); 1492 begin 1493 if WorldSize>0 then 1494 begin 1495 dec(WorldSize); 1496 PaintInfo; 1497 SmartInvalidate(344,y0Mini-77,510,y0Mini-77+21); 1498 end 1499 end; 1500 1501 procedure TStartDlg.FormClose(Sender: TObject; var Action: TCloseAction); 1502 begin 1503 DirectDlg.Close 1504 end; 1505 1506 procedure TStartDlg.ListClick(Sender: TObject); 1507 var 1508 i: integer; 1509 begin 1510 if (Tab=1) and ((List.ItemIndex=0)<>(Page=pgEditRandom)) then 1511 begin 1512 if List.ItemIndex=0 then Page:=pgEditRandom 1513 else Page:=pgEditMap; 1514 for i:=0 to ControlCount-1 do 1515 Controls[i].Visible:= Controls[i].Tag and (256 shl Page)<>0; 1516 SmartInvalidate(328,Up1Btn.Top-12,ClientWidth,Up2Btn.Top+35); 1517 end; 1518 if Page=pgLoad then TurnValid:=false; 1519 PaintInfo; 1520 if Page=pgLoad then 1521 ReplayBtn.Visible:= MiniMode<>mmMultiPlayer; 1522 end; 1523 1524 procedure TStartDlg.RenameBtnClick(Sender: TObject); 1525 var 1526 i: integer; 1527 NewName: string; 1528 f: file; 1529 ok: boolean; 1530 begin 1531 if List.ItemIndex>=0 then 1532 begin 1533 if Page=pgLoad then InputDlg.Caption:=Phrases.Lookup('TITLE_BOOKNAME') 1534 else InputDlg.Caption:=Phrases.Lookup('TITLE_MAPNAME'); 1535 InputDlg.EInput.Text:=List.Items[List.ItemIndex]; 1536 InputDlg.CenterToRect(BoundsRect); 1537 InputDlg.ShowModal; 1538 NewName:=InputDlg.EInput.Text; 1539 while (NewName<>'') and (NewName[1]='~') do delete(NewName,1,1); 1540 if (InputDlg.ModalResult=mrOK) and (NewName<>'') 1541 and (NewName<>List.Items[List.ItemIndex]) then 1542 begin 1543 for i:=1 to Length(NewName) do 1544 if NewName[i] in ['\','/',':','*','?','"','<','>','|'] then 1545 begin 1546 SimpleMessage(Format(Phrases.Lookup('NOFILENAME'),[NewName[i]])); 1547 exit 1548 end; 1549 if Page=pgLoad then 1550 AssignFile(f,DataDir+'Saved\'+List.Items[List.ItemIndex]+'.cevo') 1551 else AssignFile(f,DataDir+'Maps\'+List.Items[List.ItemIndex]+'.cevo map'); 1552 ok:=true; 1553 try 1554 if Page=pgLoad then 1555 Rename(f,DataDir+'Saved\'+NewName+'.cevo') 1556 else Rename(f,DataDir+'Maps\'+NewName+'.cevo map'); 1557 except 1558 // Play('INVALID'); 1559 ok:=false 1560 end; 1561 if Page<>pgLoad then 1562 try // rename map picture 1563 AssignFile(f,DataDir+'Maps\'+List.Items[List.ItemIndex]+'.bmp'); 1564 Rename(f,DataDir+'Maps\'+NewName+'.bmp'); 1565 except 1566 end; 1567 if ok then 1568 begin 1569 if Page=pgLoad then 1570 FormerGames[List.ItemIndex]:=NewName 1571 else Maps[List.ItemIndex]:=NewName; 1572 List.Items[List.ItemIndex]:=NewName; 1573 if Page=pgEditMap then PaintInfo; 1574 List.Invalidate; 1788 if Page <> pgLoad then 1789 try // rename map picture 1790 AssignFile(f, DataDir + 'Maps\' + List.Items[List.ItemIndex] 1791 + '.bmp'); 1792 Rename(f, DataDir + 'Maps\' + NewName + '.bmp'); 1793 except 1794 end; 1795 if ok then 1796 begin 1797 if Page = pgLoad then 1798 FormerGames[List.ItemIndex] := NewName 1799 else 1800 Maps[List.ItemIndex] := NewName; 1801 List.Items[List.ItemIndex] := NewName; 1802 if Page = pgEditMap then 1803 PaintInfo; 1804 List.Invalidate; 1575 1805 end 1576 1806 end … … 1580 1810 procedure TStartDlg.DeleteBtnClick(Sender: TObject); 1581 1811 var 1582 iDel: integer; 1583 f: file; 1584 begin 1585 if List.ItemIndex>=0 then 1586 begin 1587 if Page=pgLoad then MessgDlg.MessgText:=Phrases.Lookup('DELETEQUERY') 1588 else MessgDlg.MessgText:=Phrases.Lookup('MAPDELETEQUERY'); 1589 MessgDlg.Kind:=mkOKCancel; 1590 MessgDlg.ShowModal; 1591 if MessgDlg.ModalResult=mrOK then 1592 begin 1593 if Page=pgLoad then 1594 AssignFile(f,DataDir+'Saved\'+List.Items[List.ItemIndex]+'.cevo') 1595 else AssignFile(f,DataDir+'Maps\'+List.Items[List.ItemIndex]+'.cevo map'); 1596 Erase(f); 1597 iDel:=List.ItemIndex; 1598 if Page=pgLoad then FormerGames.Delete(iDel) 1599 else Maps.Delete(iDel); 1600 List.Items.Delete(iDel); 1601 if List.Items.Count=0 then ChangePage(pgNoLoad) 1812 iDel: integer; 1813 f: file; 1814 begin 1815 if List.ItemIndex >= 0 then 1816 begin 1817 if Page = pgLoad then 1818 MessgDlg.MessgText := Phrases.Lookup('DELETEQUERY') 1602 1819 else 1603 begin 1604 if iDel=0 then List.ItemIndex:=0 1605 else List.ItemIndex:=iDel-1; 1606 if (Page=pgEditMap) and (List.ItemIndex=0) then ChangePage(pgEditRandom) 1820 MessgDlg.MessgText := Phrases.Lookup('MAPDELETEQUERY'); 1821 MessgDlg.Kind := mkOKCancel; 1822 MessgDlg.ShowModal; 1823 if MessgDlg.ModalResult = mrOK then 1824 begin 1825 if Page = pgLoad then 1826 AssignFile(f, DataDir + 'Saved\' + List.Items[List.ItemIndex] + '.cevo') 1607 1827 else 1608 begin List.Invalidate; 1609 if Page=pgLoad then TurnValid:=false; 1610 PaintInfo; 1611 if Page=pgLoad then 1612 ReplayBtn.Visible:= MiniMode<>mmMultiPlayer; 1828 AssignFile(f, DataDir + 'Maps\' + List.Items[List.ItemIndex] + 1829 '.cevo map'); 1830 Erase(f); 1831 iDel := List.ItemIndex; 1832 if Page = pgLoad then 1833 FormerGames.Delete(iDel) 1834 else 1835 Maps.Delete(iDel); 1836 List.Items.Delete(iDel); 1837 if List.Items.Count = 0 then 1838 ChangePage(pgNoLoad) 1839 else 1840 begin 1841 if iDel = 0 then 1842 List.ItemIndex := 0 1843 else 1844 List.ItemIndex := iDel - 1; 1845 if (Page = pgEditMap) and (List.ItemIndex = 0) then 1846 ChangePage(pgEditRandom) 1847 else 1848 begin 1849 List.Invalidate; 1850 if Page = pgLoad then 1851 TurnValid := false; 1852 PaintInfo; 1853 if Page = pgLoad then 1854 ReplayBtn.Visible := MiniMode <> mmMultiPlayer; 1613 1855 end; 1614 1856 end … … 1619 1861 procedure TStartDlg.DiffBtnClick(Sender: TObject); 1620 1862 var 1621 i: integer; 1622 begin 1623 for i:=0 to nPlOffered-1 do 1624 if (Sender=DiffUpBtn[i]) and (Difficulty[i]<3) 1625 or (Sender=DiffDownBtn[i]) and (Difficulty[i]>1) then 1626 begin 1627 if Sender=DiffUpBtn[i] then inc(Difficulty[i]) 1628 else dec(Difficulty[i]); 1629 SmartInvalidate(xBrain[i]-18,yBrain[i]+19,xBrain[i]-18+12,yBrain[i]+(19+14)); 1863 i: integer; 1864 begin 1865 for i := 0 to nPlOffered - 1 do 1866 if (Sender = DiffUpBtn[i]) and (Difficulty[i] < 3) or 1867 (Sender = DiffDownBtn[i]) and (Difficulty[i] > 1) then 1868 begin 1869 if Sender = DiffUpBtn[i] then 1870 inc(Difficulty[i]) 1871 else 1872 dec(Difficulty[i]); 1873 SmartInvalidate(xBrain[i] - 18, yBrain[i] + 19, xBrain[i] - 18 + 12, 1874 yBrain[i] + (19 + 14)); 1630 1875 end 1631 1876 end; … … 1633 1878 procedure TStartDlg.MultiBtnClick(Sender: TObject); 1634 1879 var 1635 i: integer; 1636 begin 1637 for i:=6 to 8 do if Sender=MultiBtn[i] then 1638 begin 1639 MultiControl:=MultiControl xor (1 shl i); 1640 TButtonC(Sender).ButtonIndex:=2+(MultiControl shr i) and 1; 1641 end 1880 i: integer; 1881 begin 1882 for i := 6 to 8 do 1883 if Sender = MultiBtn[i] then 1884 begin 1885 MultiControl := MultiControl xor (1 shl i); 1886 TButtonC(Sender).ButtonIndex := 2 + (MultiControl shr i) and 1; 1887 end 1642 1888 end; 1643 1889 1644 1890 procedure TStartDlg.FormHide(Sender: TObject); 1645 1891 begin 1646 Diff0:=Difficulty[0];1647 ListIndex[Tab]:=List.ItemIndex;1648 ShowTab:=Tab;1649 Background.Enabled:=true;1892 Diff0 := Difficulty[0]; 1893 ListIndex[Tab] := List.ItemIndex; 1894 ShowTab := Tab; 1895 Background.Enabled := true; 1650 1896 end; 1651 1897 1652 1898 procedure TStartDlg.QuitBtnClick(Sender: TObject); 1653 1899 begin 1654 Close1900 Close 1655 1901 end; 1656 1902 … … 1658 1904 Shift: TShiftState); 1659 1905 begin 1660 if (Shift=[]) and (Key=VK_F1) then DirectHelp(cStartHelp); 1906 if (Shift = []) and (Key = VK_F1) then 1907 DirectHelp(cStartHelp); 1661 1908 end; 1662 1909 1663 1910 procedure TStartDlg.CustomizeBtnClick(Sender: TObject); 1664 1911 begin 1665 AutoDiff:=-AutoDiff;1666 CustomizeBtn.ButtonIndex:=CustomizeBtn.ButtonIndex xor 1;1667 ChangePage(Page)1912 AutoDiff := -AutoDiff; 1913 CustomizeBtn.ButtonIndex := CustomizeBtn.ButtonIndex xor 1; 1914 ChangePage(Page) 1668 1915 end; 1669 1916 1670 1917 procedure TStartDlg.AutoDiffUpBtnClick(Sender: TObject); 1671 1918 begin 1672 if AutoDiff<5 then 1673 begin 1674 inc(AutoDiff); 1675 SmartInvalidate(120,y0Mini+61,272,y0Mini+61+21); 1676 SmartInvalidate(xDefault-2,yDefault-2,xDefault+64+2,yDefault+64+2); 1919 if AutoDiff < 5 then 1920 begin 1921 inc(AutoDiff); 1922 SmartInvalidate(120, y0Mini + 61, 272, y0Mini + 61 + 21); 1923 SmartInvalidate(xDefault - 2, yDefault - 2, xDefault + 64 + 2, 1924 yDefault + 64 + 2); 1677 1925 end 1678 1926 end; … … 1680 1928 procedure TStartDlg.AutoDiffDownBtnClick(Sender: TObject); 1681 1929 begin 1682 if AutoDiff>1 then 1683 begin 1684 dec(AutoDiff); 1685 SmartInvalidate(120,y0Mini+61,272,y0Mini+61+21); 1686 SmartInvalidate(xDefault-2,yDefault-2,xDefault+64+2,yDefault+64+2); 1930 if AutoDiff > 1 then 1931 begin 1932 dec(AutoDiff); 1933 SmartInvalidate(120, y0Mini + 61, 272, y0Mini + 61 + 21); 1934 SmartInvalidate(xDefault - 2, yDefault - 2, xDefault + 64 + 2, 1935 yDefault + 64 + 2); 1687 1936 end 1688 1937 end; 1689 1938 1690 1939 procedure TStartDlg.FormMouseUp(Sender: TObject; Button: TMouseButton; 1691 Shift: TShiftState; X, Y: Integer); 1692 begin 1693 Tracking:=false 1694 end; 1695 1696 procedure TStartDlg.FormMouseMove(Sender: TObject; Shift: TShiftState; X, 1697 Y: Integer); 1698 var 1699 OldLoadTurn,NewSelectedAction: integer; 1700 begin 1701 if Tracking then 1702 begin 1703 x:=x-xTurnSlider; 1704 if x<0 then x:=0 1705 else if x>wTurnSlider then x:=wTurnSlider; 1706 OldLoadTurn:=LoadTurn; 1707 LoadTurn:=LastTurn*x div wTurnSlider; 1708 if LoadTurn<OldLoadTurn then 1709 begin 1710 SmartInvalidate(xTurnSlider+LoadTurn*wTurnSlider div LastTurn,yTurnSlider, 1711 xTurnSlider+OldLoadTurn*wTurnSlider div LastTurn+1,yTurnSlider+7); 1712 SmartInvalidate(344,y0Mini+61,514,y0Mini+82); 1940 Shift: TShiftState; x, y: integer); 1941 begin 1942 Tracking := false 1943 end; 1944 1945 procedure TStartDlg.FormMouseMove(Sender: TObject; Shift: TShiftState; 1946 x, y: integer); 1947 var 1948 OldLoadTurn, NewSelectedAction: integer; 1949 begin 1950 if Tracking then 1951 begin 1952 x := x - xTurnSlider; 1953 if x < 0 then 1954 x := 0 1955 else if x > wTurnSlider then 1956 x := wTurnSlider; 1957 OldLoadTurn := LoadTurn; 1958 LoadTurn := LastTurn * x div wTurnSlider; 1959 if LoadTurn < OldLoadTurn then 1960 begin 1961 SmartInvalidate(xTurnSlider + LoadTurn * wTurnSlider div LastTurn, 1962 yTurnSlider, xTurnSlider + OldLoadTurn * wTurnSlider div LastTurn + 1, 1963 yTurnSlider + 7); 1964 SmartInvalidate(344, y0Mini + 61, 514, y0Mini + 82); 1713 1965 end 1714 else if LoadTurn>OldLoadTurn then 1715 begin 1716 SmartInvalidate(xTurnSlider+OldLoadTurn*wTurnSlider div LastTurn,yTurnSlider, 1717 xTurnSlider+LoadTurn*wTurnSlider div LastTurn+1,yTurnSlider+7); 1718 SmartInvalidate(344,y0Mini+61,514,y0Mini+82); 1966 else if LoadTurn > OldLoadTurn then 1967 begin 1968 SmartInvalidate(xTurnSlider + OldLoadTurn * wTurnSlider div LastTurn, 1969 yTurnSlider, xTurnSlider + LoadTurn * wTurnSlider div LastTurn + 1, 1970 yTurnSlider + 7); 1971 SmartInvalidate(344, y0Mini + 61, 514, y0Mini + 82); 1719 1972 end; 1720 1973 end 1721 else if Page=pgMain then1722 begin 1723 if (x>=ActionSideBorder) and (x<ClientWidth-ActionSideBorder)1724 and (y>=yAction-8) and (y<ClientHeight-ActionBottomBorder) then1725 begin 1726 NewSelectedAction:=(y-(yAction-8)) div ActionPitch;1727 if not(NewSelectedAction in ActionsOffered) then1728 NewSelectedAction:=-1;1974 else if Page = pgMain then 1975 begin 1976 if (x >= ActionSideBorder) and (x < ClientWidth - ActionSideBorder) and 1977 (y >= yAction - 8) and (y < ClientHeight - ActionBottomBorder) then 1978 begin 1979 NewSelectedAction := (y - (yAction - 8)) div ActionPitch; 1980 if not(NewSelectedAction in ActionsOffered) then 1981 NewSelectedAction := -1; 1729 1982 end 1730 else NewSelectedAction:=-1; 1731 if NewSelectedAction<>SelectedAction then 1732 begin 1733 if SelectedAction>=0 then 1734 SmartInvalidate(ActionSideBorder,yAction+SelectedAction*ActionPitch-8, 1735 ClientWidth-ActionSideBorder,yAction+(SelectedAction+1)*ActionPitch-8); 1736 SelectedAction:=NewSelectedAction; 1737 if SelectedAction>=0 then 1738 SmartInvalidate(ActionSideBorder,yAction+SelectedAction*ActionPitch-8, 1739 ClientWidth-ActionSideBorder,yAction+(SelectedAction+1)*ActionPitch-8); 1983 else 1984 NewSelectedAction := -1; 1985 if NewSelectedAction <> SelectedAction then 1986 begin 1987 if SelectedAction >= 0 then 1988 SmartInvalidate(ActionSideBorder, yAction + SelectedAction * ActionPitch 1989 - 8, ClientWidth - ActionSideBorder, yAction + (SelectedAction + 1) * 1990 ActionPitch - 8); 1991 SelectedAction := NewSelectedAction; 1992 if SelectedAction >= 0 then 1993 SmartInvalidate(ActionSideBorder, yAction + SelectedAction * ActionPitch 1994 - 8, ClientWidth - ActionSideBorder, yAction + (SelectedAction + 1) * 1995 ActionPitch - 8); 1740 1996 end 1741 1997 end … … 1744 2000 procedure TStartDlg.AutoEnemyUpBtnClick(Sender: TObject); 1745 2001 begin 1746 if AutoEnemies<nPl-1 then1747 begin 1748 inc(AutoEnemies);1749 SmartInvalidate(160,yMain+140,198,yMain+140+21);2002 if AutoEnemies < nPl - 1 then 2003 begin 2004 inc(AutoEnemies); 2005 SmartInvalidate(160, yMain + 140, 198, yMain + 140 + 21); 1750 2006 end 1751 2007 end; … … 1753 2009 procedure TStartDlg.AutoEnemyDownBtnClick(Sender: TObject); 1754 2010 begin 1755 if AutoEnemies>0 then1756 begin 1757 dec(AutoEnemies);1758 SmartInvalidate(160,yMain+140,198,yMain+140+21);2011 if AutoEnemies > 0 then 2012 begin 2013 dec(AutoEnemies); 2014 SmartInvalidate(160, yMain + 140, 198, yMain + 140 + 21); 1759 2015 end 1760 2016 end; … … 1762 2018 procedure TStartDlg.ReplayBtnClick(Sender: TObject); 1763 2019 begin 1764 LoadGame(DataDir+'Saved\', List.Items[List.ItemIndex]+'.cevo', LastTurn, true); 1765 SlotAvailable:=-1; 2020 LoadGame(DataDir + 'Saved\', List.Items[List.ItemIndex] + '.cevo', 2021 LastTurn, true); 2022 SlotAvailable := -1; 1766 2023 end; 1767 2024 1768 2025 end. 1769 -
trunk/StringTables.pas
r5 r6 1 1 {$INCLUDE switches} 2 3 2 unit StringTables; 4 3 … … 6 5 7 6 const 8 MaxCount=4000;7 MaxCount = 4000; 9 8 10 9 type 11 TCharList=array[0..9999999] of AnsiChar; 12 13 TStringTable=class 14 constructor Create; 15 destructor Destroy; override; 16 function LoadFromFile(const FileName: String): boolean; 17 function GetHandle(const Item: AnsiString): integer; 18 function LookupByHandle(Handle: integer; Index: integer =-1): string; 19 function Lookup(const Item: string; Index: integer =-1): string; 20 function Search(const Content: string; var Handle, Index: integer): boolean; 21 protected 22 Count: integer; 23 Data: ^TCharList; 24 Lines: array[0..MaxCount-1] of PAnsiChar; 25 end; 26 10 TCharList = array [0 .. 9999999] of AnsiChar; 11 12 TStringTable = class 13 constructor Create; 14 destructor Destroy; override; 15 function LoadFromFile(const FileName: String): boolean; 16 function GetHandle(const Item: AnsiString): integer; 17 function LookupByHandle(Handle: integer; Index: integer = -1): string; 18 function Lookup(const Item: string; Index: integer = -1): string; 19 function Search(const Content: string; var Handle, Index: integer): boolean; 20 protected 21 Count: integer; 22 Data: ^TCharList; 23 Lines: array [0 .. MaxCount - 1] of PAnsiChar; 24 end; 27 25 28 26 implementation 29 27 30 28 uses 31 Classes,SysUtils; 32 29 Classes, SysUtils; 33 30 34 31 constructor TStringTable.Create; 35 32 begin 36 Data:=nil;33 Data := nil; 37 34 end; 38 35 39 36 destructor TStringTable.Destroy; 40 37 begin 41 if Data<>nil then FreeMem(Data); 42 end; 43 44 function TStringTable.LoadFromFile(const FileName:string): boolean; 45 var 46 nData, i: integer; 47 f: TFileStream; 48 begin 49 if Data<>nil then FreeMem(Data); 50 try 51 f:=TFileStream.Create(FileName, fmOpenRead or fmShareExclusive); 52 except 53 result:=false; 54 exit; 55 end; 56 result:=true; 57 nData:=f.Size; 58 GetMem(Data,nData+1); 59 f.read(Data^,nData); 60 f.Free; 61 i:=0; 62 Count:=0; 63 while (i<nData) and (Count<MaxCount) do 64 begin 65 Lines[Count]:=@Data[i]; 66 while (i<nData) and (Data[i]<>#13) do inc(i); 67 Data[i]:=#0; 68 inc(i,2); 69 inc(Count); 38 if Data <> nil then 39 FreeMem(Data); 40 end; 41 42 function TStringTable.LoadFromFile(const FileName: string): boolean; 43 var 44 nData, i: integer; 45 f: TFileStream; 46 begin 47 if Data <> nil then 48 FreeMem(Data); 49 try 50 f := TFileStream.Create(FileName, fmOpenRead or fmShareExclusive); 51 except 52 result := false; 53 exit; 54 end; 55 result := true; 56 nData := f.Size; 57 GetMem(Data, nData + 1); 58 f.read(Data^, nData); 59 f.Free; 60 i := 0; 61 Count := 0; 62 while (i < nData) and (Count < MaxCount) do 63 begin 64 Lines[Count] := @Data[i]; 65 while (i < nData) and (Data[i] <> #13) do 66 inc(i); 67 Data[i] := #0; 68 inc(i, 2); 69 inc(Count); 70 70 end; 71 71 end; … … 73 73 function TStringTable.GetHandle(const Item: AnsiString): integer; 74 74 var 75 i,l: integer; 76 begin 77 l:=Length(Item); 78 i:=Count-1; 79 while (i>=0) and ((Lines[i][0]<>'#') 80 or (StrLComp(Lines[i]+1,@Item[1],l)<>0) 81 or (Lines[i][l+1]<>#0) and (Lines[i][l+1]<>' ')) do 82 dec(i); 83 result:=i 84 end; 85 86 function TStringTable.LookupByHandle(Handle: Integer; Index: integer): string; 87 var 88 s: string; 89 begin 90 if Index<0 then 91 if Handle<0 then begin result:=''; exit end 92 else 93 begin 94 if pos(' ',Lines[Handle])=0 then s:='' 95 else s:=copy(Lines[Handle],pos(' ',Lines[Handle])+1,MaxInt); 96 while (Handle+1<Count) and (Lines[Handle+1][0]<>'#') do 75 i, l: integer; 76 begin 77 l := Length(Item); 78 i := Count - 1; 79 while (i >= 0) and ((Lines[i][0] <> '#') or (StrLComp(Lines[i] + 1, @Item[1], 80 l) <> 0) or (Lines[i][l + 1] <> #0) and (Lines[i][l + 1] <> ' ')) do 81 dec(i); 82 result := i 83 end; 84 85 function TStringTable.LookupByHandle(Handle: integer; Index: integer): string; 86 var 87 s: string; 88 begin 89 if Index < 0 then 90 if Handle < 0 then 91 begin 92 result := ''; 93 exit 94 end 95 else 96 begin 97 if pos(' ', Lines[Handle]) = 0 then 98 s := '' 99 else 100 s := copy(Lines[Handle], pos(' ', Lines[Handle]) + 1, MaxInt); 101 while (Handle + 1 < Count) and (Lines[Handle + 1][0] <> '#') do 97 102 begin 98 inc(Handle);99 if (Lines[Handle][0]<>#0) and (Lines[Handle][0]<>'''') then103 inc(Handle); 104 if (Lines[Handle][0] <> #0) and (Lines[Handle][0] <> '''') then 100 105 begin 101 if (s<>'') and (s[Length(s)]<>'\') then s:=s+' '; 102 s:=s+Lines[Handle]; 106 if (s <> '') and (s[Length(s)] <> '\') then 107 s := s + ' '; 108 s := s + Lines[Handle]; 103 109 end 104 110 end; 105 result:=s111 result := s 106 112 end 107 else if Handle+Index+1>=Count then begin result:=''; exit end 108 else result:=Lines[Handle+Index+1]; 109 while (result<>'') and ((result[1]=' ') or (result[1]=#9)) do 110 Delete(result,1,1); 111 while (result<>'') 112 and ((result[Length(result)]=' ') or (result[Length(result)]=#9)) do 113 Delete(result,Length(result),1); 114 if result='' then result:='*'; 113 else if Handle + Index + 1 >= Count then 114 begin 115 result := ''; 116 exit 117 end 118 else 119 result := Lines[Handle + Index + 1]; 120 while (result <> '') and ((result[1] = ' ') or (result[1] = #9)) do 121 Delete(result, 1, 1); 122 while (result <> '') and ((result[Length(result)] = ' ') or 123 (result[Length(result)] = #9)) do 124 Delete(result, Length(result), 1); 125 if result = '' then 126 result := '*'; 115 127 end; 116 128 117 129 function TStringTable.Lookup(const Item: string; Index: integer): string; 118 130 var 119 Handle: integer; 120 begin 121 Handle:=Gethandle(Item); 122 if Handle>=0 then result:=LookupByHandle(Handle, Index) 123 else result:=''; 124 if result='' then 125 if Index<0 then result:=Format('[%s]',[Item]) 126 else result:=Format('[%s %d]',[Item,Index]) 127 end; 128 129 {might become necessary for 1.3 130 131 function TStringTable.Lookup(const Fallback: TStringTable; const Item: string; Index: integer): string; 132 var 133 Handle: integer; 134 begin 135 Handle:=Gethandle(Item); 136 if Handle>=0 then result:=LookupByHandle(Handle, Index) 137 else result:=''; 138 if result='' then 131 Handle: integer; 132 begin 133 Handle := GetHandle(Item); 134 if Handle >= 0 then 135 result := LookupByHandle(Handle, Index) 136 else 137 result := ''; 138 if result = '' then 139 if Index < 0 then 140 result := Format('[%s]', [Item]) 141 else 142 result := Format('[%s %d]', [Item, Index]) 143 end; 144 145 { might become necessary for 1.3 146 147 function TStringTable.Lookup(const Fallback: TStringTable; const Item: string; Index: integer): string; 148 var 149 Handle: integer; 150 begin 151 Handle:=Gethandle(Item); 152 if Handle>=0 then result:=LookupByHandle(Handle, Index) 153 else result:=''; 154 if result='' then 139 155 result:=Fallback.Lookup(Item, Index); 140 end; 141 142 function TStringTable.TryLookup(const Item: string; Index: integer): string; 143 var 144 Handle: integer; 145 begin 146 Handle:=Gethandle(Item); 147 if Handle>=0 then result:=LookupByHandle(Handle, Index) 148 else result:=''; 149 end;} 150 151 function TStringTable.Search(const Content: string; var Handle, Index: integer): boolean; 152 var 153 h,i: integer; 154 UContent: string; 155 begin 156 UContent:=UpperCase(Content); 157 h:=Handle; 158 if h<0 then i:=0 159 else i:=Index+1; 160 repeat 161 if h+i+1>=Count then 162 begin result:=false; exit end; 163 if Lines[h+i+1][0]='#' then 164 begin h:=h+i+1; i:=-1 end; 165 if (h>=0) and not (Lines[h+i+1][0] in ['#',':',';']) 166 and (pos(UContent, UpperCase(Lines[h+i+1]))>0) then 167 begin Index:=i; Handle:=h; result:=true; exit end; 168 inc(i); 169 until false; 156 end; 157 158 function TStringTable.TryLookup(const Item: string; Index: integer): string; 159 var 160 Handle: integer; 161 begin 162 Handle:=Gethandle(Item); 163 if Handle>=0 then result:=LookupByHandle(Handle, Index) 164 else result:=''; 165 end; } 166 167 function TStringTable.Search(const Content: string; 168 var Handle, Index: integer): boolean; 169 var 170 h, i: integer; 171 UContent: string; 172 begin 173 UContent := UpperCase(Content); 174 h := Handle; 175 if h < 0 then 176 i := 0 177 else 178 i := Index + 1; 179 repeat 180 if h + i + 1 >= Count then 181 begin 182 result := false; 183 exit 184 end; 185 if Lines[h + i + 1][0] = '#' then 186 begin 187 h := h + i + 1; 188 i := -1 189 end; 190 if (h >= 0) and not(Lines[h + i + 1][0] in ['#', ':', ';']) and 191 (pos(UContent, UpperCase(Lines[h + i + 1])) > 0) then 192 begin 193 Index := i; 194 Handle := h; 195 result := true; 196 exit 197 end; 198 inc(i); 199 until false; 170 200 end; 171 201 172 202 end. 173 -
trunk/UnitProcessing.pas
r2 r6 5 5 6 6 uses 7 Protocol, Database;7 Protocol, Database; 8 8 9 9 type 10 TMoveType = (mtInvalid, mtMove, mtCapture, mtSpyMission, mtAttack, mtBombard, mtExpel); 11 12 TMoveInfo=record 13 MoveType: TMoveType; 14 Cost, 15 ToMaster, 16 EndHealth, 17 Defender, 18 Dcix, 19 Duix, 20 EndHealthDef: integer; 21 MountainDelay: boolean; 10 TMoveType = (mtInvalid, mtMove, mtCapture, mtSpyMission, mtAttack, 11 mtBombard, mtExpel); 12 13 TMoveInfo = record 14 MoveType: TMoveType; 15 Cost, ToMaster, EndHealth, Defender, Dcix, Duix, EndHealthDef: integer; 16 MountainDelay: boolean; 22 17 end; 23 18 24 19 var 25 uixSelectedTransport: integer; 26 Worked: array[0..nPl-1] of integer; {settler work statistics} 27 28 29 //Moving/Combat 20 uixSelectedTransport: integer; 21 Worked: array [0 .. nPl - 1] of integer; { settler work statistics } 22 23 // Moving/Combat 30 24 function HostileDamage(p, mix, Loc, MP: integer): integer; 31 function CalculateMove(p, uix,ToLoc,MoveLength: integer; TestOnly: boolean;25 function CalculateMove(p, uix, ToLoc, MoveLength: integer; TestOnly: boolean; 32 26 var MoveInfo: TMoveInfo): integer; 33 27 function GetBattleForecast(Loc: integer; var BattleForecast: TBattleForecast; 34 var Duix,Dcix,AStr,DStr,ABaseDamage,DBaseDamage: integer): integer; 35 function LoadUnit(p,uix: integer; TestOnly: boolean): integer; 36 function UnloadUnit(p,uix: integer; TestOnly: boolean): integer; 37 procedure Recover(p,uix: integer); 38 function GetMoveAdvice(p,uix: integer; var a: TMoveAdviceData): integer; 39 function CanPlaneReturn(p,uix: integer; PlaneReturnData: TPlaneReturnData): boolean; 28 var Duix, Dcix, AStr, DStr, ABaseDamage, DBaseDamage: integer): integer; 29 function LoadUnit(p, uix: integer; TestOnly: boolean): integer; 30 function UnloadUnit(p, uix: integer; TestOnly: boolean): integer; 31 procedure Recover(p, uix: integer); 32 function GetMoveAdvice(p, uix: integer; var a: TMoveAdviceData): integer; 33 function CanPlaneReturn(p, uix: integer; 34 PlaneReturnData: TPlaneReturnData): boolean; 40 35 41 36 // Terrain Improvement 42 function StartJob(p,uix,NewJob: integer; TestOnly: boolean): integer; 43 function Work(p,uix: integer): boolean; 44 function GetJobProgress(p,Loc: integer; var JobProgressData: TJobProgressData): integer; 37 function StartJob(p, uix, NewJob: integer; TestOnly: boolean): integer; 38 function Work(p, uix: integer): boolean; 39 function GetJobProgress(p, Loc: integer; 40 var JobProgressData: TJobProgressData): integer; 45 41 46 42 // Start/End Game … … 48 44 procedure ReleaseGame; 49 45 50 51 46 implementation 52 47 53 48 uses 54 IPQ;49 IPQ; 55 50 56 51 const 57 eMountains=$6000FFFF; // additional return code for server internal use58 59 // tile control flags60 coKnown=$02; coTrue=$04;61 62 ContraJobs: array[0..nJob-1] of Set of 0..nJob-1= 63 ([], //jNone64 [jCity], //jRoad65 [jCity], //jRR66 [jCity,jTrans], //jClear67 [jCity,jFarm,jAfforest,jMine,jBase,jFort], //jIrr68 [jCity,jIrr,jAfforest,jMine,jBase,jFort], //jFarm69 [jCity,jIrr,jFarm,jTrans], //jAfforest70 [jCity,jTrans,jIrr,jFarm,jBase,jFort], //jMine71 [jCity,jTrans], //jCanal72 [jCity,jClear,jAfforest,jMine,jCanal], //jTrans73 [jCity,jIrr,jFarm,jMine,jBase], //jFort74 [jCity], //jPoll75 [jCity,jIrr,jFarm,jMine,jFort], //jBase76 [jCity], //jPillage77 [jRoad..jPillage]); //jCity52 eMountains = $6000FFFF; // additional return code for server internal use 53 54 // tile control flags 55 coKnown = $02; 56 coTrue = $04; 57 58 ContraJobs: array [0 .. nJob - 1] of Set of 0 .. nJob - 1 = ([], // jNone 59 [jCity], // jRoad 60 [jCity], // jRR 61 [jCity, jTrans], // jClear 62 [jCity, jFarm, jAfforest, jMine, jBase, jFort], // jIrr 63 [jCity, jIrr, jAfforest, jMine, jBase, jFort], // jFarm 64 [jCity, jIrr, jFarm, jTrans], // jAfforest 65 [jCity, jTrans, jIrr, jFarm, jBase, jFort], // jMine 66 [jCity, jTrans], // jCanal 67 [jCity, jClear, jAfforest, jMine, jCanal], // jTrans 68 [jCity, jIrr, jFarm, jMine, jBase], // jFort 69 [jCity], // jPoll 70 [jCity, jIrr, jFarm, jMine, jFort], // jBase 71 [jCity], // jPillage 72 [jRoad .. jPillage]); // jCity 78 73 79 74 type 80 TToWorkList = array[0..INFIN,0..nJob-1] of word; 81 82 var 83 ToWork: ^TToWorkList; {work left for each tile and job} 84 85 86 { 87 Moving/Combat 88 ____________________________________________________________________ 89 } 75 TToWorkList = array [0 .. INFIN, 0 .. nJob - 1] of word; 76 77 var 78 ToWork: ^TToWorkList; { work left for each tile and job } 79 80 { 81 Moving/Combat 82 ____________________________________________________________________ 83 } 90 84 function HostileDamage(p, mix, Loc, MP: integer): integer; 91 85 var 92 Tile: integer; 93 begin 94 Tile:=RealMap[Loc]; 95 if (RW[p].Model[mix].Domain>=dSea) 96 or (RW[p].Model[mix].Kind=mkSettler) and (RW[p].Model[mix].Speed>=200) 97 or (Tile and (fCity or fRiver or fCanal)<>0) 98 or (Tile and fTerImp=tiBase) 99 or (GWonder[woGardens].EffectiveOwner=p) then 100 result:=0 101 else if (Tile and fTerrain=fDesert) 102 and (Tile and fSpecial<>fSpecial1{Oasis}) then 103 begin 104 assert((Tile and fTerImp<>tiIrrigation) and (Tile and fTerImp<>tiFarm)); 105 result:=(DesertThurst*MP-1) div RW[p].Model[mix].Speed +1 86 Tile: integer; 87 begin 88 Tile := RealMap[Loc]; 89 if (RW[p].Model[mix].Domain >= dSea) or (RW[p].Model[mix].Kind = mkSettler) 90 and (RW[p].Model[mix].Speed >= 200) or 91 (Tile and (fCity or fRiver or fCanal) <> 0) or (Tile and fTerImp = tiBase) 92 or (GWonder[woGardens].EffectiveOwner = p) then 93 result := 0 94 else if (Tile and fTerrain = fDesert) and 95 (Tile and fSpecial <> fSpecial1 { Oasis } ) then 96 begin 97 assert((Tile and fTerImp <> tiIrrigation) and (Tile and fTerImp <> tiFarm)); 98 result := (DesertThurst * MP - 1) div RW[p].Model[mix].Speed + 1 106 99 end 107 else if Tile and fTerrain=fArctic then108 begin 109 assert((Tile and fTerImp<>tiIrrigation) and (Tile and fTerImp<>tiFarm));110 result:=(ArcticThurst*MP-1) div RW[p].Model[mix].Speed +1100 else if Tile and fTerrain = fArctic then 101 begin 102 assert((Tile and fTerImp <> tiIrrigation) and (Tile and fTerImp <> tiFarm)); 103 result := (ArcticThurst * MP - 1) div RW[p].Model[mix].Speed + 1 111 104 end 112 else result:=0 105 else 106 result := 0 113 107 end; 114 108 115 function Controlled(p,Loc: integer; IsDest: boolean): integer; 116 {whether tile at Loc is in control zone of enemy unit 117 returns combination of tile control flags} 118 var 119 Loc1,V8: integer; 120 Adjacent: TVicinity8Loc; 121 begin 122 result:=0; 123 if IsDest and (Occupant[Loc]=p) and (ZoCMap[Loc]>0) then exit; 109 function Controlled(p, Loc: integer; IsDest: boolean): integer; 110 { whether tile at Loc is in control zone of enemy unit 111 returns combination of tile control flags } 112 var 113 Loc1, V8: integer; 114 Adjacent: TVicinity8Loc; 115 begin 116 result := 0; 117 if IsDest and (Occupant[Loc] = p) and (ZoCMap[Loc] > 0) then 118 exit; 124 119 // destination tile, not controlled if already occupied 125 120 126 if (RealMap[Loc] and fCity=0) 127 or (integer(RealMap[Loc] shr 27)<>p) and (ServerVersion[p]>=$000EF0) then121 if (RealMap[Loc] and fCity = 0) or (integer(RealMap[Loc] shr 27) <> p) and 122 (ServerVersion[p] >= $000EF0) then 128 123 begin // not own city 129 V8_to_Loc(Loc,Adjacent); 130 for V8:=0 to 7 do 131 begin 132 Loc1:=Adjacent[V8]; 133 if (Loc1>=0) and (Loc1<MapSize) 134 and (ZoCMap[Loc1]>0) 135 and (Occupant[Loc1]>=0) and (Occupant[Loc1]<>p) 136 and (RW[p].Treaty[Occupant[Loc1]]<trAlliance) then 137 if ObserveLevel[Loc1] and (3 shl (p*2))>0 then 124 V8_to_Loc(Loc, Adjacent); 125 for V8 := 0 to 7 do 126 begin 127 Loc1 := Adjacent[V8]; 128 if (Loc1 >= 0) and (Loc1 < MapSize) and (ZoCMap[Loc1] > 0) and 129 (Occupant[Loc1] >= 0) and (Occupant[Loc1] <> p) and 130 (RW[p].Treaty[Occupant[Loc1]] < trAlliance) then 131 if ObserveLevel[Loc1] and (3 shl (p * 2)) > 0 then 138 132 begin // p observes tile 139 result:=coKnown or coTrue; 140 exit 141 end 142 else result:=coTrue; // p does not observe tile 133 result := coKnown or coTrue; 134 exit 135 end 136 else 137 result := coTrue; // p does not observe tile 143 138 end; 144 139 end 145 140 end; 146 141 147 function GetMoveCost(p,mix,FromLoc,ToLoc,MoveLength: integer; var MoveCost: integer): integer; 142 function GetMoveCost(p, mix, FromLoc, ToLoc, MoveLength: integer; 143 var MoveCost: integer): integer; 148 144 // MoveLength - 2 for short move, 3 for long move 149 145 var 150 FromTile,ToTile: integer; 151 begin 152 result:=eOK; 153 FromTile:=RealMap[FromLoc]; 154 ToTile:=RealMap[ToLoc]; 155 with RW[p].Model[mix] do 156 begin 157 case Domain of 158 dGround: 159 if (ToTile and fTerrain>=fGrass) then {domain ok} 160 // if (Flags and mdCivil<>0) and (ToTile and fDeadLands<>0) then result:=eEerie 161 // else 162 begin {valid move} 163 if (FromTile and (fRR or fCity)<>0) 164 and (ToTile and (fRR or fCity)<>0) then 165 if GWonder[woShinkansen].EffectiveOwner=p then MoveCost:=0 166 else MoveCost:=Speed*(4*1311) shr 17 //move along railroad 167 else if (FromTile and (fRoad or fRR or fCity)<>0) 168 and (ToTile and (fRoad or fRR or fCity)<>0) 169 or (FromTile and ToTile and (fRiver or fCanal)<>0) 170 or (Cap[mcAlpine]>0) then 171 //move along road, river or canal 172 if Cap[mcOver]>0 then MoveCost:=40 173 else MoveCost:=20 174 else if Cap[mcOver]>0 then result:=eNoRoad 175 else case Terrain[ToTile and fTerrain].MoveCost of 176 1: MoveCost:=50; // plain terrain 177 2: 178 begin 179 assert(Speed-150<=600); 180 MoveCost:=50+(Speed-150)*13 shr 7; // heavy terrain 181 end; 182 3: 183 begin 184 MoveCost:=Speed; 185 result:=eMountains; 186 exit 187 end; 146 FromTile, ToTile: integer; 147 begin 148 result := eOK; 149 FromTile := RealMap[FromLoc]; 150 ToTile := RealMap[ToLoc]; 151 with RW[p].Model[mix] do 152 begin 153 case Domain of 154 dGround: 155 if (ToTile and fTerrain >= fGrass) then { domain ok } 156 // if (Flags and mdCivil<>0) and (ToTile and fDeadLands<>0) then result:=eEerie 157 // else 158 begin { valid move } 159 if (FromTile and (fRR or fCity) <> 0) and 160 (ToTile and (fRR or fCity) <> 0) then 161 if GWonder[woShinkansen].EffectiveOwner = p then 162 MoveCost := 0 163 else 164 MoveCost := Speed * (4 * 1311) shr 17 // move along railroad 165 else if (FromTile and (fRoad or fRR or fCity) <> 0) and 166 (ToTile and (fRoad or fRR or fCity) <> 0) or 167 (FromTile and ToTile and (fRiver or fCanal) <> 0) or 168 (Cap[mcAlpine] > 0) then 169 // move along road, river or canal 170 if Cap[mcOver] > 0 then 171 MoveCost := 40 172 else 173 MoveCost := 20 174 else if Cap[mcOver] > 0 then 175 result := eNoRoad 176 else 177 case Terrain[ToTile and fTerrain].MoveCost of 178 1: 179 MoveCost := 50; // plain terrain 180 2: 181 begin 182 assert(Speed - 150 <= 600); 183 MoveCost := 50 + (Speed - 150) * 13 shr 7; // heavy terrain 184 end; 185 3: 186 begin 187 MoveCost := Speed; 188 result := eMountains; 189 exit 190 end; 188 191 end; 189 MoveCost:=MoveCost*MoveLength; 190 end 191 else result:=eDomainMismatch; 192 193 dSea: 194 if (ToTile and (fCity or fCanal)<>0) 195 or (ToTile and fTerrain<fGrass) then {domain ok} 196 if (ToTile and fTerrain<>fOcean) or (Cap[mcNav]>0) then 197 MoveCost:=50*MoveLength {valid move} 198 else result:=eNoNav {navigation required for open sea} 199 else result:=eDomainMismatch; 200 201 dAir: 202 MoveCost:=50*MoveLength; {always valid move} 192 MoveCost := MoveCost * MoveLength; 193 end 194 else 195 result := eDomainMismatch; 196 197 dSea: 198 if (ToTile and (fCity or fCanal) <> 0) or (ToTile and fTerrain < fGrass) 199 then { domain ok } 200 if (ToTile and fTerrain <> fOcean) or (Cap[mcNav] > 0) then 201 MoveCost := 50 * MoveLength { valid move } 202 else 203 result := eNoNav { navigation required for open sea } 204 else 205 result := eDomainMismatch; 206 207 dAir: 208 MoveCost := 50 * MoveLength; { always valid move } 203 209 end 204 210 end 205 211 end; 206 212 207 function CalculateMove(p, uix,ToLoc,MoveLength: integer; TestOnly: boolean;213 function CalculateMove(p, uix, ToLoc, MoveLength: integer; TestOnly: boolean; 208 214 var MoveInfo: TMoveInfo): integer; 209 215 var 210 uix1,p1,FromLoc,DestControlled,AStr,DStr,ABaseDamage,DBaseDamage: integer; 211 PModel: ^TModel; 212 BattleForecast: TBattleForecast; 213 begin 214 with RW[p],Un[uix] do 215 begin 216 PModel:=@Model[mix]; 217 FromLoc:=Loc; 218 219 BattleForecast.pAtt:=p; 220 BattleForecast.mixAtt:=mix; 221 BattleForecast.HealthAtt:=Health; 222 BattleForecast.ExpAtt:=Exp; 223 BattleForecast.FlagsAtt:=Flags; 224 BattleForecast.Movement:=Movement; 225 result:=GetBattleForecast(ToLoc,BattleForecast,MoveInfo.Duix,MoveInfo.Dcix,AStr,DStr,ABaseDamage,DBaseDamage); 226 227 if result=eHiddenUnit then 228 if TestOnly then result:=eOK // behave just like unit was moving 229 else if Mode>moLoading_Fast then 230 Map[ToLoc]:=Map[ToLoc] or fHiddenUnit; 231 if result=eStealthUnit then 232 if TestOnly then result:=eOK // behave just like unit was moving 233 else if Mode>moLoading_Fast then 234 Map[ToLoc]:=Map[ToLoc] or fStealthUnit; 235 if result<rExecuted then exit; 236 237 case result of 238 eOk: MoveInfo.MoveType:=mtMove; 239 eExpelled: MoveInfo.MoveType:=mtExpel; 240 else MoveInfo.MoveType:=mtAttack; 241 end; 242 243 if MoveInfo.MoveType=mtMove then 244 begin 245 if Mode=moPlaying then 246 begin 247 p1:=RealMap[ToLoc] shr 27; 248 if (p1<nPl) and (p1<>p) 249 and ((RealMap[Loc] shr 27<>Cardinal(p1)) 250 and (PModel.Kind<>mkDiplomat) 251 and (Treaty[p1]>=trPeace) and (Treaty[p1]<trAlliance) 252 or (RealMap[ToLoc] and fCity<>0) and (Treaty[p1]>=trPeace)) then 253 begin result:=eTreaty; exit end; // keep peace treaty! 216 uix1, p1, FromLoc, DestControlled, AStr, DStr, ABaseDamage, 217 DBaseDamage: integer; 218 PModel: ^TModel; 219 BattleForecast: TBattleForecast; 220 begin 221 with RW[p], Un[uix] do 222 begin 223 PModel := @Model[mix]; 224 FromLoc := Loc; 225 226 BattleForecast.pAtt := p; 227 BattleForecast.mixAtt := mix; 228 BattleForecast.HealthAtt := Health; 229 BattleForecast.ExpAtt := Exp; 230 BattleForecast.FlagsAtt := Flags; 231 BattleForecast.Movement := Movement; 232 result := GetBattleForecast(ToLoc, BattleForecast, MoveInfo.Duix, 233 MoveInfo.Dcix, AStr, DStr, ABaseDamage, DBaseDamage); 234 235 if result = eHiddenUnit then 236 if TestOnly then 237 result := eOK // behave just like unit was moving 238 else if Mode > moLoading_Fast then 239 Map[ToLoc] := Map[ToLoc] or fHiddenUnit; 240 if result = eStealthUnit then 241 if TestOnly then 242 result := eOK // behave just like unit was moving 243 else if Mode > moLoading_Fast then 244 Map[ToLoc] := Map[ToLoc] or fStealthUnit; 245 if result < rExecuted then 246 exit; 247 248 case result of 249 eOK: 250 MoveInfo.MoveType := mtMove; 251 eExpelled: 252 MoveInfo.MoveType := mtExpel; 253 else 254 MoveInfo.MoveType := mtAttack; 255 end; 256 257 if MoveInfo.MoveType = mtMove then 258 begin 259 if Mode = moPlaying then 260 begin 261 p1 := RealMap[ToLoc] shr 27; 262 if (p1 < nPl) and (p1 <> p) and 263 ((RealMap[Loc] shr 27 <> Cardinal(p1)) and (PModel.Kind <> mkDiplomat) 264 and (Treaty[p1] >= trPeace) and (Treaty[p1] < trAlliance) or 265 (RealMap[ToLoc] and fCity <> 0) and (Treaty[p1] >= trPeace)) then 266 begin 267 result := eTreaty; 268 exit 269 end; // keep peace treaty! 254 270 end; 255 if (RealMap[ToLoc] and fCity<>0) 256 and (RealMap[ToLoc] shr 27<>Cardinal(p)) then // empty enemy city 257 if PModel.Kind=mkDiplomat then 258 begin 259 MoveInfo.MoveType:=mtSpyMission; 260 end 261 else if PModel.Domain=dGround then 262 begin 263 if PModel.Flags and mdCivil<>0 then 264 begin result:=eNoCapturer; exit end; 265 MoveInfo.MoveType:=mtCapture; 266 end 271 if (RealMap[ToLoc] and fCity <> 0) and 272 (RealMap[ToLoc] shr 27 <> Cardinal(p)) then // empty enemy city 273 if PModel.Kind = mkDiplomat then 274 begin 275 MoveInfo.MoveType := mtSpyMission; 276 end 277 else if PModel.Domain = dGround then 278 begin 279 if PModel.Flags and mdCivil <> 0 then 280 begin 281 result := eNoCapturer; 282 exit 283 end; 284 MoveInfo.MoveType := mtCapture; 285 end 286 else 287 begin 288 if (PModel.Domain = dSea) and (PModel.Cap[mcArtillery] = 0) then 289 begin 290 result := eDomainMismatch; 291 exit 292 end 293 else if (PModel.Attack = 0) and 294 not((PModel.Cap[mcBombs] > 0) and (Flags and unBombsLoaded <> 0)) 295 then 296 begin 297 result := eNoBombarder; 298 exit 299 end 300 else if Movement < 100 then 301 begin 302 result := eNoTime_Bombard; 303 exit 304 end; 305 MoveInfo.MoveType := mtBombard; 306 result := eBombarded; 307 end 308 end; 309 310 MoveInfo.MountainDelay := false; 311 if MoveInfo.MoveType in [mtAttack, mtBombard, mtExpel] then 312 begin 313 if (Master >= 0) or (PModel.Domain = dSea) and 314 (RealMap[Loc] and fTerrain >= fGrass) or (PModel.Domain = dAir) and 315 ((RealMap[Loc] and fCity <> 0) or (RealMap[Loc] and fTerImp = tiBase)) 316 then 317 begin 318 result := eViolation; 319 exit 320 end; 321 if MoveInfo.MoveType = mtBombard then 322 begin 323 MoveInfo.EndHealth := Health; 324 MoveInfo.EndHealthDef := -1; 325 end 267 326 else 268 begin 269 if (PModel.Domain=dSea) and (PModel.Cap[mcArtillery]=0) then 270 begin result:=eDomainMismatch; exit end 271 else if (PModel.Attack=0) 272 and not ((PModel.Cap[mcBombs]>0) and (Flags and unBombsLoaded<>0)) then 273 begin result:=eNoBombarder; exit end 274 else if Movement<100 then 275 begin result:=eNoTime_Bombard; exit end; 276 MoveInfo.MoveType:=mtBombard; 277 result:=eBombarded; 278 end 279 end; 280 281 MoveInfo.MountainDelay:=false; 282 if MoveInfo.MoveType in [mtAttack,mtBombard,mtExpel] then 283 begin 284 if (Master>=0) 285 or (PModel.Domain=dSea) and (RealMap[Loc] and fTerrain>=fGrass) 286 or (PModel.Domain=dAir) and ((RealMap[Loc] and fCity<>0) 287 or (RealMap[Loc] and fTerImp=tiBase)) then 288 begin result:=eViolation; exit end; 289 if MoveInfo.MoveType=mtBombard then 290 begin 291 MoveInfo.EndHealth:=Health; 292 MoveInfo.EndHealthDef:=-1; 293 end 294 else 295 begin 296 MoveInfo.EndHealth:=BattleForecast.EndHealthAtt; 297 MoveInfo.EndHealthDef:=BattleForecast.EndHealthDef; 327 begin 328 MoveInfo.EndHealth := BattleForecast.EndHealthAtt; 329 MoveInfo.EndHealthDef := BattleForecast.EndHealthDef; 298 330 end 299 331 end 300 else // if MoveInfo.MoveType in [mtMove,mtCapture,mtSpyMission] then301 begin 302 if (Master>=0) and (PModel.Domain<dSea) then332 else // if MoveInfo.MoveType in [mtMove,mtCapture,mtSpyMission] then 333 begin 334 if (Master >= 0) and (PModel.Domain < dSea) then 303 335 begin // transport unload 304 MoveInfo.Cost:=PModel.Speed;305 if RealMap[ToLoc] and fTerrain<fGrass then306 result:=eDomainMismatch;336 MoveInfo.Cost := PModel.Speed; 337 if RealMap[ToLoc] and fTerrain < fGrass then 338 result := eDomainMismatch; 307 339 end 308 else 309 begin 310 result:=GetMoveCost(p,mix,FromLoc,ToLoc,MoveLength,MoveInfo.Cost); 311 if result=eMountains then 312 begin result:=eOk; MoveInfo.MountainDelay:=true end; 340 else 341 begin 342 result := GetMoveCost(p, mix, FromLoc, ToLoc, MoveLength, 343 MoveInfo.Cost); 344 if result = eMountains then 345 begin 346 result := eOK; 347 MoveInfo.MountainDelay := true 348 end; 313 349 end; 314 if (result>=rExecuted) and (MoveInfo.MoveType=mtSpyMission) then 315 result:=eMissionDone; 316 317 MoveInfo.ToMaster:=-1; 318 if (result=eDomainMismatch) and (PModel.Domain<dSea) 319 and (PModel.Cap[mcOver]=0) then 320 begin 321 for uix1:=0 to nUn-1 do with Un[uix1] do // check load to transport 322 if (Loc=ToLoc) 323 and (TroopLoad<Model[mix].MTrans*Model[mix].Cap[mcSeaTrans]) then 324 begin 325 result:=eLoaded; 326 MoveInfo.Cost:=PModel.Speed; 327 MoveInfo.ToMaster:=uix1; 328 if (uixSelectedTransport>=0) and (uix1=uixSelectedTransport) then 329 Break; 330 end; 350 if (result >= rExecuted) and (MoveInfo.MoveType = mtSpyMission) then 351 result := eMissionDone; 352 353 MoveInfo.ToMaster := -1; 354 if (result = eDomainMismatch) and (PModel.Domain < dSea) and 355 (PModel.Cap[mcOver] = 0) then 356 begin 357 for uix1 := 0 to nUn - 1 do 358 with Un[uix1] do // check load to transport 359 if (Loc = ToLoc) and 360 (TroopLoad < Model[mix].MTrans * Model[mix].Cap[mcSeaTrans]) then 361 begin 362 result := eLoaded; 363 MoveInfo.Cost := PModel.Speed; 364 MoveInfo.ToMaster := uix1; 365 if (uixSelectedTransport >= 0) and (uix1 = uixSelectedTransport) 366 then 367 Break; 368 end; 331 369 end 332 else if (PModel.Domain=dAir) and (PModel.Cap[mcAirTrans]=0) 333 and (RealMap[ToLoc] and fCity=0) and (RealMap[ToLoc] and fTerImp<>tiBase) then 334 begin 335 for uix1:=0 to nUn-1 do with Un[uix1] do 336 if (Loc=ToLoc) 337 and (AirLoad<Model[mix].MTrans*Model[mix].Cap[mcCarrier]) then 338 begin// load plane to ship 339 result:=eLoaded; 340 MoveInfo.ToMaster:=uix1; 341 if (uixSelectedTransport>=0) and (uix1=uixSelectedTransport) then 342 Break; 343 end 370 else if (PModel.Domain = dAir) and (PModel.Cap[mcAirTrans] = 0) and 371 (RealMap[ToLoc] and fCity = 0) and (RealMap[ToLoc] and fTerImp <> tiBase) 372 then 373 begin 374 for uix1 := 0 to nUn - 1 do 375 with Un[uix1] do 376 if (Loc = ToLoc) and 377 (AirLoad < Model[mix].MTrans * Model[mix].Cap[mcCarrier]) then 378 begin // load plane to ship 379 result := eLoaded; 380 MoveInfo.ToMaster := uix1; 381 if (uixSelectedTransport >= 0) and (uix1 = uixSelectedTransport) 382 then 383 Break; 384 end 344 385 end; 345 if result<rExecuted then exit; 346 347 if (Master<0) and (MoveInfo.ToMaster<0) then 348 MoveInfo.EndHealth:=Health-HostileDamage(p,mix,ToLoc,MoveInfo.Cost) 349 else MoveInfo.EndHealth:=Health; 350 351 if (Mode=moPlaying) 352 and (PModel.Flags and mdZOC<>0) 353 and (Master<0) and (MoveInfo.ToMaster<0) 354 and (Controlled(p,FromLoc,false)>=coTrue) then 355 begin 356 DestControlled:=Controlled(p,ToLoc,true); 357 if DestControlled>=coTrue+coKnown then 358 begin result:=eZOC; exit end 359 else if not TestOnly and (DestControlled>=coTrue) then 360 begin result:=eZOC_EnemySpotted; exit end 386 if result < rExecuted then 387 exit; 388 389 if (Master < 0) and (MoveInfo.ToMaster < 0) then 390 MoveInfo.EndHealth := Health - HostileDamage(p, mix, ToLoc, 391 MoveInfo.Cost) 392 else 393 MoveInfo.EndHealth := Health; 394 395 if (Mode = moPlaying) and (PModel.Flags and mdZOC <> 0) and (Master < 0) 396 and (MoveInfo.ToMaster < 0) and (Controlled(p, FromLoc, false) >= coTrue) 397 then 398 begin 399 DestControlled := Controlled(p, ToLoc, true); 400 if DestControlled >= coTrue + coKnown then 401 begin 402 result := eZOC; 403 exit 404 end 405 else if not TestOnly and (DestControlled >= coTrue) then 406 begin 407 result := eZOC_EnemySpotted; 408 exit 409 end 361 410 end; 362 if (Movement=0) and (ServerVersion[p]>=$0100F1) or (MoveInfo.Cost>Movement) then 363 if (Master>=0) or (MoveInfo.ToMaster>=0) then 364 begin result:=eNoTime_Load; exit end 365 else begin result:=eNoTime_Move; exit end; 366 if (MoveInfo.EndHealth<=0) or (MoveInfo.MoveType=mtSpyMission) then 367 result:=result or rUnitRemoved; // spy mission or victim of HostileDamage 411 if (Movement = 0) and (ServerVersion[p] >= $0100F1) or 412 (MoveInfo.Cost > Movement) then 413 if (Master >= 0) or (MoveInfo.ToMaster >= 0) then 414 begin 415 result := eNoTime_Load; 416 exit 417 end 418 else 419 begin 420 result := eNoTime_Move; 421 exit 422 end; 423 if (MoveInfo.EndHealth <= 0) or (MoveInfo.MoveType = mtSpyMission) then 424 result := result or rUnitRemoved; 425 // spy mission or victim of HostileDamage 368 426 369 427 end; // if MoveInfo.MoveType in [mtMove,mtCapture,mtSpyMission] 370 428 371 if MoveInfo.MoveType in [mtAttack,mtExpel] then372 MoveInfo.Defender:=Occupant[ToLoc]373 else if RealMap[ToLoc] and fCity<>0 then429 if MoveInfo.MoveType in [mtAttack, mtExpel] then 430 MoveInfo.Defender := Occupant[ToLoc] 431 else if RealMap[ToLoc] and fCity <> 0 then 374 432 begin // MoveInfo.Dcix not set yet 375 MoveInfo.Defender:=RealMap[ToLoc] shr 27;376 SearchCity(ToLoc,MoveInfo.Defender,MoveInfo.Dcix);433 MoveInfo.Defender := RealMap[ToLoc] shr 27; 434 SearchCity(ToLoc, MoveInfo.Defender, MoveInfo.Dcix); 377 435 end 378 436 end 379 end; // CalculateMove437 end; // CalculateMove 380 438 381 439 function GetBattleForecast(Loc: integer; var BattleForecast: TBattleForecast; 382 var Duix,Dcix,AStr,DStr,ABaseDamage,DBaseDamage: integer): integer; 383 var 384 Time,Defender,ABon,DBon,DCnt,MultiDamage: integer; 385 PModel,DModel: ^TModel; 386 begin 387 with BattleForecast do 388 begin 389 Defender:=Occupant[Loc]; 390 if (Defender<0) or (Defender=pAtt) then 391 begin result:=eOK; exit end; // no attack, simple move 392 393 PModel:=@RW[pAtt].Model[mixAtt]; 394 Strongest(Loc,Duix,DStr,DBon,DCnt); {get defense strength and bonus} 395 if (PModel.Kind=mkDiplomat) and (RealMap[Loc] and fCity<>0) then 440 var Duix, Dcix, AStr, DStr, ABaseDamage, DBaseDamage: integer): integer; 441 var 442 Time, Defender, ABon, DBon, DCnt, MultiDamage: integer; 443 PModel, DModel: ^TModel; 444 begin 445 with BattleForecast do 446 begin 447 Defender := Occupant[Loc]; 448 if (Defender < 0) or (Defender = pAtt) then 449 begin 450 result := eOK; 451 exit 452 end; // no attack, simple move 453 454 PModel := @RW[pAtt].Model[mixAtt]; 455 Strongest(Loc, Duix, DStr, DBon, DCnt); { get defense strength and bonus } 456 if (PModel.Kind = mkDiplomat) and (RealMap[Loc] and fCity <> 0) then 396 457 begin // spy mission -- return as if move was possible 397 EndHealthAtt:=HealthAtt; 398 EndHealthDef:=RW[Defender].Un[Duix].Health; 399 result:=eOk; 400 exit 401 end; 402 403 DModel:=@RW[Defender].Model[RW[Defender].Un[Duix].mix]; 404 if (RealMap[Loc] and fCity=0) and (RealMap[Loc] and fTerImp<>tiBase) then 405 begin 406 if (DModel.Cap[mcSub]>0) 407 and (RealMap[Loc] and fTerrain<fGrass) 408 and (ObserveLevel[Loc] shr (2*pAtt) and 3<lObserveAll) then 409 begin result:=eHiddenUnit; exit; end; //attacking submarine not allowed 410 if (DModel.Cap[mcStealth]>0) 411 and (ObserveLevel[Loc] shr (2*pAtt) and 3<>lObserveSuper) then 412 begin result:=eStealthUnit; exit; end; //attacking stealth aircraft not allowed 413 if (DModel.Domain=dAir) and (DModel.Kind<>mkSpecial_Glider) 414 and (PModel.Domain<>dAir) then 415 begin result:=eDomainMismatch; exit end; //can't attack plane 416 end; 417 if ((PModel.Cap[mcArtillery]=0) 418 or ((ServerVersion[pAtt]>=$010200) and (RealMap[Loc] and fTerrain<fGrass) 419 and (DModel.Cap[mcSub]>0))) // ground units can't attack submarines 420 and ((PModel.Domain=dGround) and (RealMap[Loc] and fTerrain<fGrass) 421 or (PModel.Domain=dSea) and (RealMap[Loc] and fTerrain>=fGrass)) then 422 begin result:=eDomainMismatch; exit end; 423 if (PModel.Attack=0) 424 and not ((PModel.Cap[mcBombs]>0) and (FlagsAtt and unBombsLoaded<>0) 425 and (DModel.Domain<dAir)) then 426 begin result:=eInvalid; exit end; 427 428 if Movement=0 then 429 begin result:=eNoTime_Attack; exit end; 430 431 {$IFOPT O-}assert(InvalidTreatyMap=0);{$ENDIF} 432 if RW[pAtt].Treaty[Defender]>=trPeace then 433 begin 434 if (PModel.Domain<>dAir) 435 and (PModel.Attack>0) and (integer(RealMap[Loc] shr 27)=pAtt) then 436 if Movement>=100 then 458 EndHealthAtt := HealthAtt; 459 EndHealthDef := RW[Defender].Un[Duix].Health; 460 result := eOK; 461 exit 462 end; 463 464 DModel := @RW[Defender].Model[RW[Defender].Un[Duix].mix]; 465 if (RealMap[Loc] and fCity = 0) and (RealMap[Loc] and fTerImp <> tiBase) 466 then 467 begin 468 if (DModel.Cap[mcSub] > 0) and (RealMap[Loc] and fTerrain < fGrass) and 469 (ObserveLevel[Loc] shr (2 * pAtt) and 3 < lObserveAll) then 470 begin 471 result := eHiddenUnit; 472 exit; 473 end; // attacking submarine not allowed 474 if (DModel.Cap[mcStealth] > 0) and 475 (ObserveLevel[Loc] shr (2 * pAtt) and 3 <> lObserveSuper) then 476 begin 477 result := eStealthUnit; 478 exit; 479 end; // attacking stealth aircraft not allowed 480 if (DModel.Domain = dAir) and (DModel.Kind <> mkSpecial_Glider) and 481 (PModel.Domain <> dAir) then 482 begin 483 result := eDomainMismatch; 484 exit 485 end; // can't attack plane 486 end; 487 if ((PModel.Cap[mcArtillery] = 0) or ((ServerVersion[pAtt] >= $010200) and 488 (RealMap[Loc] and fTerrain < fGrass) and (DModel.Cap[mcSub] > 0))) 489 // ground units can't attack submarines 490 and ((PModel.Domain = dGround) and (RealMap[Loc] and fTerrain < fGrass) or 491 (PModel.Domain = dSea) and (RealMap[Loc] and fTerrain >= fGrass)) then 492 begin 493 result := eDomainMismatch; 494 exit 495 end; 496 if (PModel.Attack = 0) and not((PModel.Cap[mcBombs] > 0) and 497 (FlagsAtt and unBombsLoaded <> 0) and (DModel.Domain < dAir)) then 498 begin 499 result := eInvalid; 500 exit 501 end; 502 503 if Movement = 0 then 504 begin 505 result := eNoTime_Attack; 506 exit 507 end; 508 509 {$IFOPT O-}assert(InvalidTreatyMap = 0); {$ENDIF} 510 if RW[pAtt].Treaty[Defender] >= trPeace then 511 begin 512 if (PModel.Domain <> dAir) and (PModel.Attack > 0) and 513 (integer(RealMap[Loc] shr 27) = pAtt) then 514 if Movement >= 100 then 437 515 begin // expel friendly unit 438 EndHealthDef:=RW[Defender].Un[Duix].Health; 439 EndHealthAtt:=HealthAtt; 440 result:=eExpelled 441 end 442 else result:=eNoTime_Expel 443 else result:=eTreaty; 444 exit; 445 end; 446 447 // calculate defender strength 448 if RealMap[Loc] and fCity<>0 then 516 EndHealthDef := RW[Defender].Un[Duix].Health; 517 EndHealthAtt := HealthAtt; 518 result := eExpelled 519 end 520 else 521 result := eNoTime_Expel 522 else 523 result := eTreaty; 524 exit; 525 end; 526 527 // calculate defender strength 528 if RealMap[Loc] and fCity <> 0 then 449 529 begin // consider city improvements 450 SearchCity(Loc,Defender,Dcix); 451 if (PModel.Domain<dSea) and (PModel.Cap[mcArtillery]=0) 452 and ((RW[Defender].City[Dcix].Built[imWalls]=1) 453 or (Continent[RW[Defender].City[Dcix].Loc]=GrWallContinent[Defender])) then 454 inc(DBon,8) 455 else if (PModel.Domain=dSea) 456 and (RW[Defender].City[Dcix].Built[imCoastalFort]=1) then 457 inc(DBon,4) 458 else if (PModel.Domain=dAir) 459 and (RW[Defender].City[Dcix].Built[imMissileBat]=1) then 460 inc(DBon,4); 461 if RW[Defender].City[Dcix].Built[imBunker]=1 then 462 inc(DBon,4) 463 end; 464 if (PModel.Domain=dAir) and (DModel.Cap[mcAirDef]>0) then 465 inc(DBon,4); 466 DStr:=DModel.Defense*DBon*100; 467 if (DModel.Domain=dAir) and ((RealMap[Loc] and fCity<>0) 468 or (RealMap[Loc] and fTerImp=tiBase)) then 469 DStr:=0; 470 if (DModel.Domain=dSea) and (RealMap[Loc] and fTerrain>=fGrass) then 471 DStr:=DStr shr 1; 472 473 // calculate attacker strength 474 if PModel.Cap[mcWill]>0 then Time:=100 475 else begin Time:=Movement; if Time>100 then Time:=100; end; 476 ABon:=4+ExpAtt div ExpCost; 477 AStr:=PModel.Attack; 478 if (FlagsAtt and unBombsLoaded<>0) and (DModel.Domain<dAir) then // use bombs 479 AStr:=AStr+PModel.Cap[mcBombs]*PModel.MStrength*2; 480 AStr:=Time*AStr*ABon; 481 482 // calculate base damage for defender 483 if DStr=0 then 484 DBaseDamage:=RW[Defender].Un[Duix].Health 485 else 486 begin 487 DBaseDamage:=HealthAtt*AStr div DStr; 488 if DBaseDamage=0 then 489 DBaseDamage:=1; 490 if DBaseDamage>RW[Defender].Un[Duix].Health then 491 DBaseDamage:=RW[Defender].Un[Duix].Health 492 end; 493 494 // calculate base damage for attacker 495 if AStr=0 then 496 ABaseDamage:=HealthAtt 497 else 498 begin 499 ABaseDamage:=RW[Defender].Un[Duix].Health*DStr div AStr; 500 if ABaseDamage=0 then 501 ABaseDamage:=1; 502 if ABaseDamage>HealthAtt then 503 ABaseDamage:=HealthAtt 504 end; 505 506 // calculate final damage for defender 507 MultiDamage:=2; 508 if (ABaseDamage=HealthAtt) and (PModel.Cap[mcFanatic]>0) 509 and not (RW[pAtt].Government in [gRepublic,gDemocracy,gFuture]) then 510 MultiDamage:=MultiDamage*2; // fanatic attacker died 511 EndHealthDef:=RW[Defender].Un[Duix].Health-MultiDamage*DBaseDamage div 2; 512 if EndHealthDef<0 then EndHealthDef:=0; 513 514 // calculate final damage for attacker 515 MultiDamage:=2; 516 if DBaseDamage=RW[Defender].Un[Duix].Health then 517 begin 518 if (DModel.Cap[mcFanatic]>0) 519 and not (RW[Defender].Government in [gRepublic,gDemocracy,gFuture]) then 520 MultiDamage:=MultiDamage*2; // fanatic defender died 521 if PModel.Cap[mcFirst]>0 then 522 MultiDamage:=MultiDamage shr 1; // first strike unit wins 523 end; 524 Time:=Movement; if Time>100 then Time:=100; 525 EndHealthAtt:=HealthAtt-MultiDamage*ABaseDamage div 2-HostileDamage(pAtt,mixAtt,Loc,Time); 526 if EndHealthAtt<0 then EndHealthAtt:=0; 527 528 if EndHealthDef>0 then result:=eLost 529 else if EndHealthAtt>0 then result:=eWon 530 else result:=eBloody 530 SearchCity(Loc, Defender, Dcix); 531 if (PModel.Domain < dSea) and (PModel.Cap[mcArtillery] = 0) and 532 ((RW[Defender].City[Dcix].Built[imWalls] = 1) or 533 (Continent[RW[Defender].City[Dcix].Loc] = GrWallContinent[Defender])) 534 then 535 inc(DBon, 8) 536 else if (PModel.Domain = dSea) and 537 (RW[Defender].City[Dcix].Built[imCoastalFort] = 1) then 538 inc(DBon, 4) 539 else if (PModel.Domain = dAir) and 540 (RW[Defender].City[Dcix].Built[imMissileBat] = 1) then 541 inc(DBon, 4); 542 if RW[Defender].City[Dcix].Built[imBunker] = 1 then 543 inc(DBon, 4) 544 end; 545 if (PModel.Domain = dAir) and (DModel.Cap[mcAirDef] > 0) then 546 inc(DBon, 4); 547 DStr := DModel.Defense * DBon * 100; 548 if (DModel.Domain = dAir) and ((RealMap[Loc] and fCity <> 0) or 549 (RealMap[Loc] and fTerImp = tiBase)) then 550 DStr := 0; 551 if (DModel.Domain = dSea) and (RealMap[Loc] and fTerrain >= fGrass) then 552 DStr := DStr shr 1; 553 554 // calculate attacker strength 555 if PModel.Cap[mcWill] > 0 then 556 Time := 100 557 else 558 begin 559 Time := Movement; 560 if Time > 100 then 561 Time := 100; 562 end; 563 ABon := 4 + ExpAtt div ExpCost; 564 AStr := PModel.Attack; 565 if (FlagsAtt and unBombsLoaded <> 0) and (DModel.Domain < dAir) then 566 // use bombs 567 AStr := AStr + PModel.Cap[mcBombs] * PModel.MStrength * 2; 568 AStr := Time * AStr * ABon; 569 570 // calculate base damage for defender 571 if DStr = 0 then 572 DBaseDamage := RW[Defender].Un[Duix].Health 573 else 574 begin 575 DBaseDamage := HealthAtt * AStr div DStr; 576 if DBaseDamage = 0 then 577 DBaseDamage := 1; 578 if DBaseDamage > RW[Defender].Un[Duix].Health then 579 DBaseDamage := RW[Defender].Un[Duix].Health 580 end; 581 582 // calculate base damage for attacker 583 if AStr = 0 then 584 ABaseDamage := HealthAtt 585 else 586 begin 587 ABaseDamage := RW[Defender].Un[Duix].Health * DStr div AStr; 588 if ABaseDamage = 0 then 589 ABaseDamage := 1; 590 if ABaseDamage > HealthAtt then 591 ABaseDamage := HealthAtt 592 end; 593 594 // calculate final damage for defender 595 MultiDamage := 2; 596 if (ABaseDamage = HealthAtt) and (PModel.Cap[mcFanatic] > 0) and 597 not(RW[pAtt].Government in [gRepublic, gDemocracy, gFuture]) then 598 MultiDamage := MultiDamage * 2; // fanatic attacker died 599 EndHealthDef := RW[Defender].Un[Duix].Health - MultiDamage * 600 DBaseDamage div 2; 601 if EndHealthDef < 0 then 602 EndHealthDef := 0; 603 604 // calculate final damage for attacker 605 MultiDamage := 2; 606 if DBaseDamage = RW[Defender].Un[Duix].Health then 607 begin 608 if (DModel.Cap[mcFanatic] > 0) and 609 not(RW[Defender].Government in [gRepublic, gDemocracy, gFuture]) then 610 MultiDamage := MultiDamage * 2; // fanatic defender died 611 if PModel.Cap[mcFirst] > 0 then 612 MultiDamage := MultiDamage shr 1; // first strike unit wins 613 end; 614 Time := Movement; 615 if Time > 100 then 616 Time := 100; 617 EndHealthAtt := HealthAtt - MultiDamage * ABaseDamage div 2 - 618 HostileDamage(pAtt, mixAtt, Loc, Time); 619 if EndHealthAtt < 0 then 620 EndHealthAtt := 0; 621 622 if EndHealthDef > 0 then 623 result := eLost 624 else if EndHealthAtt > 0 then 625 result := eWon 626 else 627 result := eBloody 531 628 end 532 end; //GetBattleForecast 533 534 function LoadUnit(p,uix: integer; TestOnly: boolean): integer; 535 var 536 uix1,d,Cost,ToMaster: integer; 537 begin 538 result:=eOk; 539 with RW[p].Un[uix] do 540 begin 541 d:=RW[p].Model[mix].Domain; 542 if (Master>=0) or (d=dSea) 543 or (RW[p].Model[mix].Cap[mcAirTrans] 544 +RW[p].Model[mix].Cap[mcOver]>0) then 545 result:=eViolation 546 else 547 begin 548 ToMaster:=-1; 549 for uix1:=0 to RW[p].nUn-1 do if RW[p].Un[uix1].Loc=Loc then 550 with RW[p].Un[uix1], RW[p].Model[mix] do 551 if (d<dSea) and (TroopLoad<MTrans*(Cap[mcSeaTrans]+Cap[mcAirTrans])) 552 or (d=dAir) and (AirLoad<MTrans*Cap[mcCarrier]) then 553 begin {load onto unit uix1} 554 if (uixSelectedTransport<0) or (uix1=uixSelectedTransport) then 555 begin ToMaster:=uix1; Break end 556 else if ToMaster<0 then 557 ToMaster:=uix1; 558 end; 559 if ToMaster<0 then result:=eNoLoadCapacity 629 end; // GetBattleForecast 630 631 function LoadUnit(p, uix: integer; TestOnly: boolean): integer; 632 var 633 uix1, d, Cost, ToMaster: integer; 634 begin 635 result := eOK; 636 with RW[p].Un[uix] do 637 begin 638 d := RW[p].Model[mix].Domain; 639 if (Master >= 0) or (d = dSea) or 640 (RW[p].Model[mix].Cap[mcAirTrans] + RW[p].Model[mix].Cap[mcOver] > 0) then 641 result := eViolation 560 642 else 561 begin 562 if d=dAir then Cost:=100 563 else Cost:=RW[p].Model[mix].Speed; 564 if Movement<Cost then result:=eNoTime_Load 565 else if not TestOnly then 566 begin 567 FreeUnit(p,uix); 568 dec(Movement,Cost); 569 if d=dAir then inc(RW[p].Un[ToMaster].AirLoad) 570 else inc(RW[p].Un[ToMaster].TroopLoad); 571 Master:=ToMaster; 572 UpdateUnitMap(Loc); 643 begin 644 ToMaster := -1; 645 for uix1 := 0 to RW[p].nUn - 1 do 646 if RW[p].Un[uix1].Loc = Loc then 647 with RW[p].Un[uix1], RW[p].Model[mix] do 648 if (d < dSea) and 649 (TroopLoad < MTrans * (Cap[mcSeaTrans] + Cap[mcAirTrans])) or 650 (d = dAir) and (AirLoad < MTrans * Cap[mcCarrier]) then 651 begin { load onto unit uix1 } 652 if (uixSelectedTransport < 0) or (uix1 = uixSelectedTransport) 653 then 654 begin 655 ToMaster := uix1; 656 Break 657 end 658 else if ToMaster < 0 then 659 ToMaster := uix1; 660 end; 661 if ToMaster < 0 then 662 result := eNoLoadCapacity 663 else 664 begin 665 if d = dAir then 666 Cost := 100 667 else 668 Cost := RW[p].Model[mix].Speed; 669 if Movement < Cost then 670 result := eNoTime_Load 671 else if not TestOnly then 672 begin 673 FreeUnit(p, uix); 674 dec(Movement, Cost); 675 if d = dAir then 676 inc(RW[p].Un[ToMaster].AirLoad) 677 else 678 inc(RW[p].Un[ToMaster].TroopLoad); 679 Master := ToMaster; 680 UpdateUnitMap(Loc); 573 681 end 574 682 end … … 577 685 end; 578 686 579 function UnloadUnit(p,uix: integer; TestOnly: boolean): integer; 580 var 581 Cost: integer; 582 begin 583 result:=eOk; 584 with RW[p].Un[uix] do 585 if Master<0 then result:=eNotChanged 586 else if (RW[p].Model[mix].Domain<dSea) 587 and (RealMap[Loc] and fTerrain<fGrass) then result:=eDomainMismatch 588 // else if (RW[p].Model[mix].Domain<dSea) 589 // and (RW[p].Model[mix].Flags and mdCivil<>0) 590 // and (RealMap[Loc] and fDeadLands<>0) then result:=eEerie 591 else 592 begin 593 if RW[p].Model[mix].Domain=dAir then Cost:=100 594 else Cost:=RW[p].Model[mix].Speed; 595 if Movement<Cost then result:=eNoTime_Load 596 else if not TestOnly then 597 begin 598 dec(Movement,Cost); 599 if RW[p].Model[mix].Domain=dAir then 600 dec(RW[p].Un[Master].AirLoad) 687 function UnloadUnit(p, uix: integer; TestOnly: boolean): integer; 688 var 689 Cost: integer; 690 begin 691 result := eOK; 692 with RW[p].Un[uix] do 693 if Master < 0 then 694 result := eNotChanged 695 else if (RW[p].Model[mix].Domain < dSea) and 696 (RealMap[Loc] and fTerrain < fGrass) then 697 result := eDomainMismatch 698 // else if (RW[p].Model[mix].Domain<dSea) 699 // and (RW[p].Model[mix].Flags and mdCivil<>0) 700 // and (RealMap[Loc] and fDeadLands<>0) then result:=eEerie 701 else 702 begin 703 if RW[p].Model[mix].Domain = dAir then 704 Cost := 100 601 705 else 602 begin 603 dec(RW[p].Un[Master].TroopLoad); 604 // Movement:=0 // no more movement after unload 706 Cost := RW[p].Model[mix].Speed; 707 if Movement < Cost then 708 result := eNoTime_Load 709 else if not TestOnly then 710 begin 711 dec(Movement, Cost); 712 if RW[p].Model[mix].Domain = dAir then 713 dec(RW[p].Un[Master].AirLoad) 714 else 715 begin 716 dec(RW[p].Un[Master].TroopLoad); 717 // Movement:=0 // no more movement after unload 605 718 end; 606 Master:=-1;607 PlaceUnit(p,uix);608 UpdateUnitMap(Loc);719 Master := -1; 720 PlaceUnit(p, uix); 721 UpdateUnitMap(Loc); 609 722 end; 610 723 end 611 724 end; 612 725 613 procedure Recover(p,uix: integer); 614 var 615 cix,Recovery: integer; 616 begin 617 with RW[p],Un[uix] do 618 begin 619 if (Master>=0) and (Model[Un[Master].mix].Cap[mcSupplyShip]>0) then 620 Recovery:=FastRecovery {hospital ship} 621 else if RealMap[Loc] and fTerImp=tiBase then 622 Recovery:=CityRecovery 623 else if RealMap[Loc] and fCity<>0 then 624 begin {unit in city} 625 cix:=nCity-1; 626 while (cix>=0) and (City[cix].Loc<>Loc) do dec(cix); 627 if City[cix].Flags and chDisorder<>0 then 628 Recovery:=NoCityRecovery 629 else if (Model[mix].Domain=dGround) 630 and (City[cix].Built[imBarracks]+City[cix].Built[imElite]>0) 631 or (Model[mix].Domain=dSea) and (City[cix].Built[imDockyard]=1) 632 or (Model[mix].Domain=dAir) and (City[cix].Built[imAirport]=1) then 633 Recovery:=FastRecovery {city has baracks/shipyard/airport} 634 else Recovery:=CityRecovery 726 procedure Recover(p, uix: integer); 727 var 728 cix, Recovery: integer; 729 begin 730 with RW[p], Un[uix] do 731 begin 732 if (Master >= 0) and (Model[Un[Master].mix].Cap[mcSupplyShip] > 0) then 733 Recovery := FastRecovery { hospital ship } 734 else if RealMap[Loc] and fTerImp = tiBase then 735 Recovery := CityRecovery 736 else if RealMap[Loc] and fCity <> 0 then 737 begin { unit in city } 738 cix := nCity - 1; 739 while (cix >= 0) and (City[cix].Loc <> Loc) do 740 dec(cix); 741 if City[cix].Flags and chDisorder <> 0 then 742 Recovery := NoCityRecovery 743 else if (Model[mix].Domain = dGround) and 744 (City[cix].Built[imBarracks] + City[cix].Built[imElite] > 0) or 745 (Model[mix].Domain = dSea) and (City[cix].Built[imDockyard] = 1) or 746 (Model[mix].Domain = dAir) and (City[cix].Built[imAirport] = 1) then 747 Recovery := FastRecovery { city has baracks/shipyard/airport } 748 else 749 Recovery := CityRecovery 635 750 end 636 else if (RealMap[Loc] and fTerrain>=fGrass) and (Model[mix].Domain<>dAir) then 637 Recovery:=NoCityRecovery 638 else Recovery:=0; 639 640 Recovery:=Recovery*Movement div Model[mix].Speed; {recovery depends on movement unused} 641 if Recovery>Health then Recovery:=Health; // health max. doubled each turn 642 if Recovery>100-Health then Recovery:=100-Health; 643 inc(Health,Recovery); 751 else if (RealMap[Loc] and fTerrain >= fGrass) and (Model[mix].Domain <> dAir) 752 then 753 Recovery := NoCityRecovery 754 else 755 Recovery := 0; 756 757 Recovery := Recovery * Movement div Model[mix].Speed; 758 { recovery depends on movement unused } 759 if Recovery > Health then 760 Recovery := Health; // health max. doubled each turn 761 if Recovery > 100 - Health then 762 Recovery := 100 - Health; 763 inc(Health, Recovery); 644 764 end; 645 765 end; 646 766 647 function GetMoveAdvice(p, uix: integer; var a: TMoveAdviceData): integer;767 function GetMoveAdvice(p, uix: integer; var a: TMoveAdviceData): integer; 648 768 const 649 //domains 650 gmaAir=0; gmaSea=1; gmaGround_NoZoC=2; gmaGround_ZoC=3; 651 //flags 652 gmaNav=4; gmaOver=4; gmaAlpine=8; 653 var 654 i,FromLoc,EndLoc,T,T1,maxmov,initmov,Loc,Loc1,FromTile,ToTile,V8, 655 MoveInfo,HeavyCost,RailCost,MoveCost,AddDamage,MaxDamage,MovementLeft: integer; 656 Map: ^TTileList; 657 Q: TIPQ; 658 Adjacent: TVicinity8Loc; 659 From: array[0..lxmax*lymax-1] of integer; 660 Time: array[0..lxmax*lymax-1] of integer; 661 Damage: array[0..lxmax*lymax-1] of integer; 662 MountainDelay, Resistant: boolean; 663 // tt,tt0: int64; 664 begin 665 // QueryPerformanceCounter(tt0); 666 667 MaxDamage:=RW[p].Un[uix].Health-1; 668 if MaxDamage>a.MaxHostile_MovementLeft then 669 if a.MaxHostile_MovementLeft>=0 then 670 MaxDamage:=a.MaxHostile_MovementLeft 671 else MaxDamage:=0; 672 673 Map:=@(RW[p].Map^); 674 if (a.ToLoc<>maNextCity) and ((a.ToLoc<0) or (a.ToLoc>=MapSize)) then 675 begin result:=eInvalid; exit end; 676 if (a.ToLoc<>maNextCity) and (Map[a.ToLoc] and fTerrain=fUNKNOWN) then 677 begin result:=eNoWay; exit end; 678 679 with RW[p].Model[RW[p].Un[uix].mix] do 680 case Domain of 681 dGround: 682 if (a.ToLoc<>maNextCity) and (Map[a.ToLoc] and fTerrain=fOcean) then 683 begin result:=eDomainMismatch; exit end 684 else 685 begin 686 if Flags and mdZOC<>0 then MoveInfo:=gmaGround_ZoC 687 else MoveInfo:=gmaGround_NoZoC; 688 if Cap[mcOver]>0 then inc(MoveInfo,gmaOver); 689 if Cap[mcAlpine]>0 then inc(MoveInfo,gmaAlpine); 690 HeavyCost:=50+(Speed-150)*13 shr 7; 691 if GWonder[woShinkansen].EffectiveOwner=p then RailCost:=0 692 else RailCost:=Speed*(4*1311) shr 17; 693 maxmov:=Speed; 694 initmov:=0; 695 Resistant:= (GWonder[woGardens].EffectiveOwner=p) or 696 (Kind=mkSettler) and (Speed>=200); 769 // domains 770 gmaAir = 0; 771 gmaSea = 1; 772 gmaGround_NoZoC = 2; 773 gmaGround_ZoC = 3; 774 // flags 775 gmaNav = 4; 776 gmaOver = 4; 777 gmaAlpine = 8; 778 var 779 i, FromLoc, EndLoc, T, T1, maxmov, initmov, Loc, Loc1, FromTile, ToTile, V8, 780 MoveInfo, HeavyCost, RailCost, MoveCost, AddDamage, MaxDamage, 781 MovementLeft: integer; 782 Map: ^TTileList; 783 Q: TIPQ; 784 Adjacent: TVicinity8Loc; 785 From: array [0 .. lxmax * lymax - 1] of integer; 786 Time: array [0 .. lxmax * lymax - 1] of integer; 787 Damage: array [0 .. lxmax * lymax - 1] of integer; 788 MountainDelay, Resistant: boolean; 789 // tt,tt0: int64; 790 begin 791 // QueryPerformanceCounter(tt0); 792 793 MaxDamage := RW[p].Un[uix].Health - 1; 794 if MaxDamage > a.MaxHostile_MovementLeft then 795 if a.MaxHostile_MovementLeft >= 0 then 796 MaxDamage := a.MaxHostile_MovementLeft 797 else 798 MaxDamage := 0; 799 800 Map := @(RW[p].Map^); 801 if (a.ToLoc <> maNextCity) and ((a.ToLoc < 0) or (a.ToLoc >= MapSize)) then 802 begin 803 result := eInvalid; 804 exit 805 end; 806 if (a.ToLoc <> maNextCity) and (Map[a.ToLoc] and fTerrain = fUNKNOWN) then 807 begin 808 result := eNoWay; 809 exit 810 end; 811 812 with RW[p].Model[RW[p].Un[uix].mix] do 813 case Domain of 814 dGround: 815 if (a.ToLoc <> maNextCity) and (Map[a.ToLoc] and fTerrain = fOcean) then 816 begin 817 result := eDomainMismatch; 818 exit 819 end 820 else 821 begin 822 if Flags and mdZOC <> 0 then 823 MoveInfo := gmaGround_ZoC 824 else 825 MoveInfo := gmaGround_NoZoC; 826 if Cap[mcOver] > 0 then 827 inc(MoveInfo, gmaOver); 828 if Cap[mcAlpine] > 0 then 829 inc(MoveInfo, gmaAlpine); 830 HeavyCost := 50 + (Speed - 150) * 13 shr 7; 831 if GWonder[woShinkansen].EffectiveOwner = p then 832 RailCost := 0 833 else 834 RailCost := Speed * (4 * 1311) shr 17; 835 maxmov := Speed; 836 initmov := 0; 837 Resistant := (GWonder[woGardens].EffectiveOwner = p) or 838 (Kind = mkSettler) and (Speed >= 200); 697 839 end; 698 dSea: 699 if (a.ToLoc<>maNextCity) and (Map[a.ToLoc] and fTerrain>=fGrass) 700 and (Map[a.ToLoc] and (fCity or fUnit or fCanal)=0) then 701 begin result:=eDomainMismatch; exit end 702 else 703 begin 704 MoveInfo:=gmaSea; 705 if Cap[mcNav]>0 then inc(MoveInfo,gmaNav); 706 maxmov:=UnitSpeed(p,RW[p].Un[uix].mix,100); 707 initmov:=maxmov-UnitSpeed(p,RW[p].Un[uix].mix, 708 RW[p].Un[uix].Health); 840 dSea: 841 if (a.ToLoc <> maNextCity) and (Map[a.ToLoc] and fTerrain >= fGrass) and 842 (Map[a.ToLoc] and (fCity or fUnit or fCanal) = 0) then 843 begin 844 result := eDomainMismatch; 845 exit 846 end 847 else 848 begin 849 MoveInfo := gmaSea; 850 if Cap[mcNav] > 0 then 851 inc(MoveInfo, gmaNav); 852 maxmov := UnitSpeed(p, RW[p].Un[uix].mix, 100); 853 initmov := maxmov - UnitSpeed(p, RW[p].Un[uix].mix, 854 RW[p].Un[uix].Health); 709 855 end; 710 dAir: 711 begin 712 MoveInfo:=gmaAir; 713 maxmov:=Speed; 714 initmov:=0; 715 end 716 end; 717 718 FromLoc:=RW[p].Un[uix].Loc; 719 FillChar(Time,SizeOf(Time),255); {-1} 720 Damage[FromLoc]:=0; 721 Q:=TIPQ.Create(MapSize); 722 Q.Put(FromLoc,(maxmov-RW[p].Un[uix].Movement) shl 8); 723 while Q.Get(Loc,T) do 724 begin 725 Time[Loc]:=T; 726 if T>=(a.MoreTurns+1) shl 20 then begin Loc:=-1; Break end; 727 FromTile:=Map[Loc]; 728 if (Loc=a.ToLoc) or (a.ToLoc=maNextCity) and (FromTile and fCity<>0) then 729 Break; 730 if T and $FFF00=$FFF00 then inc(T,$100000); // indicates mountain delay 731 V8_to_Loc(Loc,Adjacent); 732 for V8:=0 to 7 do 733 begin 734 Loc1:=Adjacent[V8]; 735 if (Loc1>=0) and (Loc1<MapSize) and (Time[Loc1]<0) then 736 begin 737 ToTile:=Map[Loc1]; 738 if (Loc1=a.ToLoc) and (ToTile and (fUnit or fOwned)=fUnit) 739 and not ((MoveInfo and 3=gmaSea) and (FromTile and fTerrain>=fGrass)) 740 and not ((MoveInfo and 3=gmaAir) and ((FromTile and fCity<>0) 741 or (FromTile and fTerImp=tiBase))) then 856 dAir: 857 begin 858 MoveInfo := gmaAir; 859 maxmov := Speed; 860 initmov := 0; 861 end 862 end; 863 864 FromLoc := RW[p].Un[uix].Loc; 865 FillChar(Time, SizeOf(Time), 255); { -1 } 866 Damage[FromLoc] := 0; 867 Q := TIPQ.Create(MapSize); 868 Q.Put(FromLoc, (maxmov - RW[p].Un[uix].Movement) shl 8); 869 while Q.Get(Loc, T) do 870 begin 871 Time[Loc] := T; 872 if T >= (a.MoreTurns + 1) shl 20 then 873 begin 874 Loc := -1; 875 Break 876 end; 877 FromTile := Map[Loc]; 878 if (Loc = a.ToLoc) or (a.ToLoc = maNextCity) and (FromTile and fCity <> 0) 879 then 880 Break; 881 if T and $FFF00 = $FFF00 then 882 inc(T, $100000); // indicates mountain delay 883 V8_to_Loc(Loc, Adjacent); 884 for V8 := 0 to 7 do 885 begin 886 Loc1 := Adjacent[V8]; 887 if (Loc1 >= 0) and (Loc1 < MapSize) and (Time[Loc1] < 0) then 888 begin 889 ToTile := Map[Loc1]; 890 if (Loc1 = a.ToLoc) and (ToTile and (fUnit or fOwned) = fUnit) and 891 not((MoveInfo and 3 = gmaSea) and (FromTile and fTerrain >= fGrass)) 892 and not((MoveInfo and 3 = gmaAir) and ((FromTile and fCity <> 0) or 893 (FromTile and fTerImp = tiBase))) then 742 894 begin // attack position found 743 if Q.Put(Loc1,T+1) then From[Loc1]:=Loc; 744 end 745 else if (ToTile and fTerrain<>fUNKNOWN) 746 and ((Loc1=a.ToLoc) or (ToTile and (fCity or fOwned)<>fCity)) // don't move through enemy cities 747 and ((Loc1=a.ToLoc) or (ToTile and (fUnit or fOwned)<>fUnit)) // way is blocked 748 and (ToTile and not FromTile and fPeace=0) 749 and ((MoveInfo and 3<gmaGround_ZoC) 750 or (ToTile and FromTile and fInEnemyZoc=0) 751 or (ToTile and fOwnZoCUnit<>0) 752 or (FromTile and fCity<>0) 753 or (ToTile and (fCity or fOwned)=fCity or fOwned)) then 754 begin 755 // calculate move cost, must be identic to GetMoveCost function 756 AddDamage:=0; 757 MountainDelay:=false; 758 case MoveInfo of 759 760 gmaAir: 761 MoveCost:=50; {always valid move} 762 763 gmaSea: 764 if (ToTile and (fCity or fCanal)<>0) 765 or (ToTile and fTerrain=fShore) then {domain ok} 766 MoveCost:=50 {valid move} 767 else MoveCost:=-1; 768 769 gmaSea+gmaNav: 770 if (ToTile and (fCity or fCanal)<>0) 771 or (ToTile and fTerrain<fGrass) then {domain ok} 772 MoveCost:=50 {valid move} 773 else MoveCost:=-1; 895 if Q.Put(Loc1, T + 1) then 896 From[Loc1] := Loc; 897 end 898 else if (ToTile and fTerrain <> fUNKNOWN) and 899 ((Loc1 = a.ToLoc) or (ToTile and (fCity or fOwned) <> fCity)) 900 // don't move through enemy cities 901 and ((Loc1 = a.ToLoc) or (ToTile and (fUnit or fOwned) <> fUnit)) 902 // way is blocked 903 and (ToTile and not FromTile and fPeace = 0) and 904 ((MoveInfo and 3 < gmaGround_ZoC) or (ToTile and FromTile and 905 fInEnemyZoc = 0) or (ToTile and fOwnZoCUnit <> 0) or 906 (FromTile and fCity <> 0) or (ToTile and (fCity or fOwned) = fCity or 907 fOwned)) then 908 begin 909 // calculate move cost, must be identic to GetMoveCost function 910 AddDamage := 0; 911 MountainDelay := false; 912 case MoveInfo of 913 914 gmaAir: 915 MoveCost := 50; { always valid move } 916 917 gmaSea: 918 if (ToTile and (fCity or fCanal) <> 0) or 919 (ToTile and fTerrain = fShore) then { domain ok } 920 MoveCost := 50 { valid move } 921 else 922 MoveCost := -1; 923 924 gmaSea + gmaNav: 925 if (ToTile and (fCity or fCanal) <> 0) or 926 (ToTile and fTerrain < fGrass) then { domain ok } 927 MoveCost := 50 { valid move } 928 else 929 MoveCost := -1; 774 930 775 931 else // ground unit 776 if (ToTile and fTerrain>=fGrass) then {domain ok} 777 begin {valid move} 778 if (FromTile and (fRR or fCity)<>0) 779 and (ToTile and (fRR or fCity)<>0) then 780 MoveCost:=RailCost //move along railroad 781 else if (FromTile and (fRoad or fRR or fCity)<>0) 782 and (ToTile and (fRoad or fRR or fCity)<>0) 783 or (FromTile and ToTile and (fRiver or fCanal)<>0) 784 or (MoveInfo and gmaAlpine<>0) then 785 //move along road, river or canal 786 if MoveInfo and gmaOver<>0 then MoveCost:=40 787 else MoveCost:=20 788 else if MoveInfo and gmaOver<>0 then MoveCost:=-1 789 else case Terrain[ToTile and fTerrain].MoveCost of 790 1: MoveCost:=50; // plain terrain 791 2: MoveCost:=HeavyCost; // heavy terrain 792 3: 793 begin 794 MoveCost:=maxmov; 795 MountainDelay:=true; 796 end; 932 if (ToTile and fTerrain >= fGrass) then { domain ok } 933 begin { valid move } 934 if (FromTile and (fRR or fCity) <> 0) and 935 (ToTile and (fRR or fCity) <> 0) then 936 MoveCost := RailCost // move along railroad 937 else if (FromTile and (fRoad or fRR or fCity) <> 0) and 938 (ToTile and (fRoad or fRR or fCity) <> 0) or 939 (FromTile and ToTile and (fRiver or fCanal) <> 0) or 940 (MoveInfo and gmaAlpine <> 0) then 941 // move along road, river or canal 942 if MoveInfo and gmaOver <> 0 then 943 MoveCost := 40 944 else 945 MoveCost := 20 946 else if MoveInfo and gmaOver <> 0 then 947 MoveCost := -1 948 else 949 case Terrain[ToTile and fTerrain].MoveCost of 950 1: 951 MoveCost := 50; // plain terrain 952 2: 953 MoveCost := HeavyCost; // heavy terrain 954 3: 955 begin 956 MoveCost := maxmov; 957 MountainDelay := true; 958 end; 797 959 end; 798 960 799 961 // calculate HostileDamage 800 if not resistant and (ToTile and fTerImp<>tiBase) then 801 if ToTile and (fTerrain or fCity or fRiver or fCanal or fSpecial1{Oasis})=fDesert then 802 begin 803 if V8 and 1<>0 then 804 AddDamage:=((DesertThurst*3)*MoveCost-1) div maxmov +1 805 else AddDamage:=((DesertThurst*2)*MoveCost-1) div maxmov +1 806 end 807 else if ToTile and (fTerrain or fCity or fRiver or fCanal)=fArctic then 808 begin 809 if V8 and 1<>0 then 810 AddDamage:=((ArcticThurst*3)*MoveCost-1) div maxmov +1 811 else AddDamage:=((ArcticThurst*2)*MoveCost-1) div maxmov +1 812 end; 813 end 814 else MoveCost:=-1; 962 if not Resistant and (ToTile and fTerImp <> tiBase) then 963 if ToTile and (fTerrain or fCity or fRiver or fCanal or 964 fSpecial1 { Oasis } ) = fDesert then 965 begin 966 if V8 and 1 <> 0 then 967 AddDamage := ((DesertThurst * 3) * MoveCost - 1) 968 div maxmov + 1 969 else 970 AddDamage := ((DesertThurst * 2) * MoveCost - 1) 971 div maxmov + 1 972 end 973 else if ToTile and (fTerrain or fCity or fRiver or fCanal) = fArctic 974 then 975 begin 976 if V8 and 1 <> 0 then 977 AddDamage := ((ArcticThurst * 3) * MoveCost - 1) 978 div maxmov + 1 979 else 980 AddDamage := ((ArcticThurst * 2) * MoveCost - 1) 981 div maxmov + 1 982 end; 983 end 984 else 985 MoveCost := -1; 815 986 816 987 end; 817 988 818 if (MoveCost>0) and not MountainDelay then 819 if V8 and 1<>0 then inc(MoveCost,MoveCost*2) 820 else inc(MoveCost,MoveCost); 821 822 if (MoveInfo and 2<>0) // ground unit, check transport load/unload 823 and ((MoveCost<0) 824 and (ToTile and (fUnit or fOwned)=fUnit or fOwned) // assume ship/airplane is transport -- load! 825 or (MoveCost>=0) and (FromTile and fTerrain<fGrass)) then 826 MoveCost:=maxmov; // transport load or unload 827 828 if MoveCost>=0 then 829 begin {valid move} 830 MovementLeft:=maxmov-T shr 8 and $FFF-MoveCost; 831 if (MovementLeft<0) or ((MoveCost=0) and (MovementLeft=0)) then 989 if (MoveCost > 0) and not MountainDelay then 990 if V8 and 1 <> 0 then 991 inc(MoveCost, MoveCost * 2) 992 else 993 inc(MoveCost, MoveCost); 994 995 if (MoveInfo and 2 <> 0) // ground unit, check transport load/unload 996 and ((MoveCost < 0) and (ToTile and (fUnit or fOwned) = fUnit or 997 fOwned) // assume ship/airplane is transport -- load! 998 or (MoveCost >= 0) and (FromTile and fTerrain < fGrass)) then 999 MoveCost := maxmov; // transport load or unload 1000 1001 if MoveCost >= 0 then 1002 begin { valid move } 1003 MovementLeft := maxmov - T shr 8 and $FFF - MoveCost; 1004 if (MovementLeft < 0) or ((MoveCost = 0) and (MovementLeft = 0)) 1005 then 832 1006 begin // must wait for next turn 833 // calculate HostileDamage 834 if (MoveInfo and 2<>0){ground unit} 835 and not resistant and (FromTile and fTerImp<>tiBase) then 836 if FromTile and (fTerrain or fCity or fRiver or fCanal or fSpecial1{Oasis})=fDesert then 837 inc(AddDamage, (DesertThurst*(maxmov-T shr 8 and $FFF)-1) div maxmov +1) 838 else if FromTile and (fTerrain or fCity or fRiver or fCanal)=fArctic then 839 inc(AddDamage, (ArcticThurst*(maxmov-T shr 8 and $FFF)-1) div maxmov +1); 840 841 T1:=T and $7FF000FF +$100000+(initmov+MoveCost) shl 8; 1007 // calculate HostileDamage 1008 if (MoveInfo and 2 <> 0) { ground unit } 1009 and not Resistant and (FromTile and fTerImp <> tiBase) then 1010 if FromTile and (fTerrain or fCity or fRiver or fCanal or 1011 fSpecial1 { Oasis } ) = fDesert then 1012 inc(AddDamage, (DesertThurst * (maxmov - T shr 8 and $FFF) - 1013 1) div maxmov + 1) 1014 else if FromTile and (fTerrain or fCity or fRiver or fCanal) = fArctic 1015 then 1016 inc(AddDamage, (ArcticThurst * (maxmov - T shr 8 and $FFF) - 1017 1) div maxmov + 1); 1018 1019 T1 := T and $7FF000FF + $100000 + (initmov + MoveCost) shl 8; 842 1020 end 843 else T1:=T+MoveCost shl 8+1; 844 if MountainDelay then T1:=T1 or $FFF00; 845 if (Damage[Loc]+AddDamage<=MaxDamage) and (T1 and $FF<$FF) then 846 if Q.Put(Loc1,T1) then 1021 else 1022 T1 := T + MoveCost shl 8 + 1; 1023 if MountainDelay then 1024 T1 := T1 or $FFF00; 1025 if (Damage[Loc] + AddDamage <= MaxDamage) and (T1 and $FF < $FF) 1026 then 1027 if Q.Put(Loc1, T1) then 847 1028 begin 848 From[Loc1]:=Loc;849 Damage[Loc1]:=Damage[Loc]+AddDamage;1029 From[Loc1] := Loc; 1030 Damage[Loc1] := Damage[Loc] + AddDamage; 850 1031 end 851 1032 end … … 854 1035 end 855 1036 end; 856 Q.Free; 857 if (Loc=a.ToLoc) or (a.ToLoc=maNextCity) and (Loc>=0) 858 and (Map[Loc] and fCity<>0) then 859 begin 860 a.MoreTurns:=T shr 20; 861 EndLoc:=Loc; 862 a.nStep:=0; 863 while Loc<>FromLoc do 864 begin 865 if Time[Loc]<$100000 then inc(a.nStep); 866 Loc:=From[Loc]; 867 end; 868 Loc:=EndLoc; 869 i:=a.nStep; 870 while Loc<>FromLoc do 871 begin 872 if Time[Loc]<$100000 then 873 begin 874 dec(i); 875 if i<25 then 876 begin 877 a.dx[i]:=((Loc mod lx *2 +Loc div lx and 1) 878 -(From[Loc] mod lx *2 +From[Loc] div lx and 1)+3*lx) mod (2*lx) -lx; 879 a.dy[i]:=Loc div lx-From[Loc] div lx; 1037 Q.Free; 1038 if (Loc = a.ToLoc) or (a.ToLoc = maNextCity) and (Loc >= 0) and 1039 (Map[Loc] and fCity <> 0) then 1040 begin 1041 a.MoreTurns := T shr 20; 1042 EndLoc := Loc; 1043 a.nStep := 0; 1044 while Loc <> FromLoc do 1045 begin 1046 if Time[Loc] < $100000 then 1047 inc(a.nStep); 1048 Loc := From[Loc]; 1049 end; 1050 Loc := EndLoc; 1051 i := a.nStep; 1052 while Loc <> FromLoc do 1053 begin 1054 if Time[Loc] < $100000 then 1055 begin 1056 dec(i); 1057 if i < 25 then 1058 begin 1059 a.dx[i] := ((Loc mod lx * 2 + Loc div lx and 1) - 1060 (From[Loc] mod lx * 2 + From[Loc] div lx and 1) + 3 * lx) 1061 mod (2 * lx) - lx; 1062 a.dy[i] := Loc div lx - From[Loc] div lx; 880 1063 end 881 1064 end; 882 Loc:=From[Loc]; 883 end; 884 a.MaxHostile_MovementLeft:=maxmov-Time[EndLoc] shr 8 and $FFF; 885 if a.nStep>25 then a.nStep:=25; 886 result:=eOK 1065 Loc := From[Loc]; 1066 end; 1067 a.MaxHostile_MovementLeft := maxmov - Time[EndLoc] shr 8 and $FFF; 1068 if a.nStep > 25 then 1069 a.nStep := 25; 1070 result := eOK 887 1071 end 888 else result:=eNoWay; 889 890 // QueryPerformanceCounter(tt);{time in s is: (tt-tt0)/PerfFreq} 1072 else 1073 result := eNoWay; 1074 1075 // QueryPerformanceCounter(tt);{time in s is: (tt-tt0)/PerfFreq} 891 1076 end; // GetMoveAdvice 892 1077 893 function CanPlaneReturn(p,uix: integer; PlaneReturnData: TPlaneReturnData): boolean; 1078 function CanPlaneReturn(p, uix: integer; 1079 PlaneReturnData: TPlaneReturnData): boolean; 894 1080 const 895 mfEnd=1; mfReached=2; 896 var 897 uix1,T,T1,Loc,Loc1,FromTile,ToTile,V8,MoveCost,maxmov: integer; 898 Map: ^TTileList; 899 Q: TIPQ; 900 Adjacent: TVicinity8Loc; 901 MapFlags: array[0..lxmax*lymax-1] of byte; 902 begin 903 Map:=@(RW[p].Map^); 904 905 // calculate possible return points 906 FillChar(MapFlags,SizeOf(MapFlags),0); 907 if RW[p].Model[RW[p].Un[uix].mix].Kind=mkSpecial_Glider then 908 begin 909 for Loc:=0 to MapSize-1 do 910 if Map[Loc] and fTerrain>=fGrass then 911 MapFlags[Loc]:=MapFlags[Loc] or mfEnd; 1081 mfEnd = 1; 1082 mfReached = 2; 1083 var 1084 uix1, T, T1, Loc, Loc1, FromTile, ToTile, V8, MoveCost, maxmov: integer; 1085 Map: ^TTileList; 1086 Q: TIPQ; 1087 Adjacent: TVicinity8Loc; 1088 MapFlags: array [0 .. lxmax * lymax - 1] of byte; 1089 begin 1090 Map := @(RW[p].Map^); 1091 1092 // calculate possible return points 1093 FillChar(MapFlags, SizeOf(MapFlags), 0); 1094 if RW[p].Model[RW[p].Un[uix].mix].Kind = mkSpecial_Glider then 1095 begin 1096 for Loc := 0 to MapSize - 1 do 1097 if Map[Loc] and fTerrain >= fGrass then 1098 MapFlags[Loc] := MapFlags[Loc] or mfEnd; 912 1099 end 913 else 914 begin 915 for Loc:=0 to MapSize-1 do 916 if (Map[Loc] and (fCity or fOwned)=fCity or fOwned) 917 or (Map[Loc] and fTerImp=tiBase) and (Map[Loc] and fObserved<>0) 918 and (Map[Loc] and (fUnit or fOwned)<>fUnit) then 919 MapFlags[Loc]:=MapFlags[Loc] or mfEnd; 920 if RW[p].Model[RW[p].Un[uix].mix].Cap[mcAirTrans]=0 then // plane can land on carriers 921 for uix1:=0 to RW[p].nUn-1 do 922 with RW[p].Un[uix1], RW[p].Model[mix] do 923 if AirLoad<MTrans*Cap[mcCarrier] then 924 MapFlags[Loc]:=MapFlags[Loc] or mfEnd; 1100 else 1101 begin 1102 for Loc := 0 to MapSize - 1 do 1103 if (Map[Loc] and (fCity or fOwned) = fCity or fOwned) or 1104 (Map[Loc] and fTerImp = tiBase) and (Map[Loc] and fObserved <> 0) and 1105 (Map[Loc] and (fUnit or fOwned) <> fUnit) then 1106 MapFlags[Loc] := MapFlags[Loc] or mfEnd; 1107 if RW[p].Model[RW[p].Un[uix].mix].Cap[mcAirTrans] = 0 then 1108 // plane can land on carriers 1109 for uix1 := 0 to RW[p].nUn - 1 do 1110 with RW[p].Un[uix1], RW[p].Model[mix] do 1111 if AirLoad < MTrans * Cap[mcCarrier] then 1112 MapFlags[Loc] := MapFlags[Loc] or mfEnd; 925 1113 end; 926 1114 927 with RW[p].Un[uix] do928 begin 929 if Master>=0 then // can return to same carrier, even if full now930 MapFlags[Loc]:=MapFlags[Loc] or mfEnd;931 maxmov:=RW[p].Model[mix].Speed;1115 with RW[p].Un[uix] do 1116 begin 1117 if Master >= 0 then // can return to same carrier, even if full now 1118 MapFlags[Loc] := MapFlags[Loc] or mfEnd; 1119 maxmov := RW[p].Model[mix].Speed; 932 1120 end; 933 1121 934 result:=false; 935 Q:=TIPQ.Create(MapSize); 936 Q.Put(PlaneReturnData.Loc,(maxmov-PlaneReturnData.Movement) shl 8); 937 while Q.Get(Loc,T) do 938 begin 939 MapFlags[Loc]:=MapFlags[Loc] or mfReached; 940 if T>=(PlaneReturnData.Fuel+1) shl 20 then 941 begin result:=false; break end; 942 if MapFlags[Loc] and mfEnd<>0 then 943 begin result:=true; break end; 944 FromTile:=Map[Loc]; 945 V8_to_Loc(Loc,Adjacent); 946 for V8:=0 to 7 do 947 begin 948 Loc1:=Adjacent[V8]; 949 if (Loc1>=0) and (Loc1<MapSize) and (MapFlags[Loc1] and mfReached=0) then 950 begin 951 ToTile:=Map[Loc1]; 952 if (ToTile and fTerrain<>fUNKNOWN) 953 and (ToTile and (fCity or fOwned)<>fCity) // don't move through enemy cities 954 and (ToTile and (fUnit or fOwned)<>fUnit) // way is blocked 955 and (ToTile and not FromTile and fPeace=0) then 956 begin 957 if V8 and 1<>0 then MoveCost:=150 958 else MoveCost:=100; 959 if MoveCost+T shr 8 and $FFF>maxmov then // must wait for next turn 960 T1:=T and $7FF000FF +$100000+MoveCost shl 8 961 else T1:=T+MoveCost shl 8; 962 Q.Put(Loc1,T1); 1122 result := false; 1123 Q := TIPQ.Create(MapSize); 1124 Q.Put(PlaneReturnData.Loc, (maxmov - PlaneReturnData.Movement) shl 8); 1125 while Q.Get(Loc, T) do 1126 begin 1127 MapFlags[Loc] := MapFlags[Loc] or mfReached; 1128 if T >= (PlaneReturnData.Fuel + 1) shl 20 then 1129 begin 1130 result := false; 1131 Break 1132 end; 1133 if MapFlags[Loc] and mfEnd <> 0 then 1134 begin 1135 result := true; 1136 Break 1137 end; 1138 FromTile := Map[Loc]; 1139 V8_to_Loc(Loc, Adjacent); 1140 for V8 := 0 to 7 do 1141 begin 1142 Loc1 := Adjacent[V8]; 1143 if (Loc1 >= 0) and (Loc1 < MapSize) and (MapFlags[Loc1] and mfReached = 0) 1144 then 1145 begin 1146 ToTile := Map[Loc1]; 1147 if (ToTile and fTerrain <> fUNKNOWN) and 1148 (ToTile and (fCity or fOwned) <> fCity) 1149 // don't move through enemy cities 1150 and (ToTile and (fUnit or fOwned) <> fUnit) // way is blocked 1151 and (ToTile and not FromTile and fPeace = 0) then 1152 begin 1153 if V8 and 1 <> 0 then 1154 MoveCost := 150 1155 else 1156 MoveCost := 100; 1157 if MoveCost + T shr 8 and $FFF > maxmov then 1158 // must wait for next turn 1159 T1 := T and $7FF000FF + $100000 + MoveCost shl 8 1160 else 1161 T1 := T + MoveCost shl 8; 1162 Q.Put(Loc1, T1); 963 1163 end 964 1164 end 965 1165 end 966 1166 end; 967 Q.Free;1167 Q.Free; 968 1168 end; // CanPlaneReturn 969 1169 970 1170 { 971 972 ____________________________________________________________________1171 Terrain Improvement 1172 ____________________________________________________________________ 973 1173 } 974 function CalculateJobWork(p,Loc,Job: integer; var JobWork: integer): integer; 975 var 976 TerrType: integer; 977 begin 978 result:=eOK; 979 TerrType:=RealMap[Loc] and fTerrain; 980 with Terrain[TerrType] do case Job of 981 jCity: 982 if RealMap[Loc] and fCity<>0 then result:=eInvalid 983 else if IrrEff=0 then result:=eNoCityTerrain 984 else JobWork:=CityWork; 985 jRoad: 986 if RealMap[Loc] and (fRoad or fRR)=0 then 987 begin 988 JobWork:=MoveCost*RoadWork; 989 if RealMap[Loc] and fRiver<>0 then 990 if RW[p].Tech[adBridgeBuilding]>=tsApplicable then 991 inc(JobWork,RoadBridgeWork) {across river} 992 else result:=eNoBridgeBuilding 993 end 994 else result:=eInvalid; 995 jRR: 996 if RealMap[Loc] and fRoad=0 then result:=eNoPreq 997 else if RealMap[Loc] and fRR<>0 then result:=eInvalid 998 else 999 begin 1000 JobWork:=MoveCost*RRWork; 1001 if RealMap[Loc] and fRiver<>0 then 1002 inc(JobWork,RRBridgeWork); {across river} 1003 end; 1004 jClear: 1005 if (TerrType=fDesert) 1006 and (GWonder[woGardens].EffectiveOwner<>p) then 1007 result:=eInvalid 1008 else if ClearTerrain>=0 then 1009 JobWork:=IrrClearWork 1010 else result:=eInvalid; 1011 jIrr: 1012 begin 1013 JobWork:=IrrClearWork; 1014 if (IrrEff=0) 1015 or (RealMap[Loc] and fTerImp=tiIrrigation) 1016 or (RealMap[Loc] and fTerImp=tiFarm) then 1017 result:=eInvalid 1018 end; 1019 jFarm: 1020 if RealMap[Loc] and fTerImp<>tiIrrigation then result:=eNoPreq 1021 else 1022 begin 1023 JobWork:=IrrClearWork*FarmWork; 1024 if (JobWork<=0) or (RealMap[Loc] and fTerImp=tiFarm) then 1025 result:=eInvalid 1026 end; 1027 jAfforest: 1028 if AfforestTerrain>=0 then 1029 JobWork:=MineAfforestWork 1030 else result:=eInvalid; 1031 jMine: 1032 begin 1033 JobWork:=MineAfforestWork; 1034 if (MineEff=0) 1035 or (RealMap[Loc] and fTerImp=tiMine) then 1036 result:=eInvalid 1037 end; 1038 jFort: 1039 if RealMap[Loc] and fTerImp<>tiFort then 1040 JobWork:=MoveCost*FortWork 1041 else result:=eInvalid; 1042 jCanal: 1043 if (RealMap[Loc] and fCanal=0) and (TerrType in TerrType_Canalable) then 1044 JobWork:=CanalWork 1045 else result:=eInvalid; 1046 jTrans: 1047 begin 1048 JobWork:=TransWork; 1049 if JobWork<=0 then result:=eInvalid 1050 end; 1051 jPoll: 1052 if RealMap[Loc] and fPoll<>0 then JobWork:=PollWork 1053 else result:=eInvalid; 1054 jBase: 1055 if RealMap[Loc] and fTerImp<>tiBase then 1056 JobWork:=MoveCost*BaseWork 1057 else result:=eInvalid; 1058 jPillage: 1059 if RealMap[Loc] and (fRoad or fRR or fCanal or fTerImp)<>0 then 1060 JobWork:=PillageWork 1061 else result:=eInvalid; 1062 end; 1063 end; //CalculateJobWork 1064 1065 function StartJob(p,uix,NewJob: integer; TestOnly: boolean): integer; 1066 var 1067 JobWork, Loc0, p1, uix1, TerrType: integer; 1068 begin 1069 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap=0);{$ENDIF} 1070 result:=eOK; 1071 with RW[p].Un[uix] do 1072 begin 1073 if NewJob=Job then 1074 begin result:=eNotChanged; exit end; 1075 if NewJob=jNone then 1076 begin if not TestOnly then Job:=jNone; exit end; 1077 Loc0:=Loc; 1078 if (RealMap[Loc0] and fDeadLands<>0) and (NewJob<>jRoad) and (NewJob<>jRR) then 1079 begin result:=eDeadLands; exit end; 1080 TerrType:=RealMap[Loc0] and fTerrain; 1081 if (RealMap[Loc0] and fCity<>0) or (TerrType<fGrass) 1082 or (Master>=0) 1083 or not ((NewJob=jPillage) and (RW[p].Model[mix].Domain=dGround) 1084 or (RW[p].Model[mix].Kind=mkSettler) 1085 or (NewJob<>jCity) and (RW[p].Model[mix].Kind=mkSlaves) 1086 and (GWonder[woPyramids].EffectiveOwner>=0)) then 1087 begin result:=eInvalid; exit end; 1088 if (JobPreq[NewJob]<>preNone) 1089 and (RW[p].Tech[JobPreq[NewJob]]<tsApplicable) then 1090 begin result:=eNoPreq; exit end; 1091 1092 result:=CalculateJobWork(p,Loc0,NewJob,JobWork); 1093 if (Mode=moPlaying) and (result=eOk) and (NewJob<>jPoll) then 1174 function CalculateJobWork(p, Loc, Job: integer; var JobWork: integer): integer; 1175 var 1176 TerrType: integer; 1177 begin 1178 result := eOK; 1179 TerrType := RealMap[Loc] and fTerrain; 1180 with Terrain[TerrType] do 1181 case Job of 1182 jCity: 1183 if RealMap[Loc] and fCity <> 0 then 1184 result := eInvalid 1185 else if IrrEff = 0 then 1186 result := eNoCityTerrain 1187 else 1188 JobWork := CityWork; 1189 jRoad: 1190 if RealMap[Loc] and (fRoad or fRR) = 0 then 1191 begin 1192 JobWork := MoveCost * RoadWork; 1193 if RealMap[Loc] and fRiver <> 0 then 1194 if RW[p].Tech[adBridgeBuilding] >= tsApplicable then 1195 inc(JobWork, RoadBridgeWork) { across river } 1196 else 1197 result := eNoBridgeBuilding 1198 end 1199 else 1200 result := eInvalid; 1201 jRR: 1202 if RealMap[Loc] and fRoad = 0 then 1203 result := eNoPreq 1204 else if RealMap[Loc] and fRR <> 0 then 1205 result := eInvalid 1206 else 1207 begin 1208 JobWork := MoveCost * RRWork; 1209 if RealMap[Loc] and fRiver <> 0 then 1210 inc(JobWork, RRBridgeWork); { across river } 1211 end; 1212 jClear: 1213 if (TerrType = fDesert) and (GWonder[woGardens].EffectiveOwner <> p) 1214 then 1215 result := eInvalid 1216 else if ClearTerrain >= 0 then 1217 JobWork := IrrClearWork 1218 else 1219 result := eInvalid; 1220 jIrr: 1221 begin 1222 JobWork := IrrClearWork; 1223 if (IrrEff = 0) or (RealMap[Loc] and fTerImp = tiIrrigation) or 1224 (RealMap[Loc] and fTerImp = tiFarm) then 1225 result := eInvalid 1226 end; 1227 jFarm: 1228 if RealMap[Loc] and fTerImp <> tiIrrigation then 1229 result := eNoPreq 1230 else 1231 begin 1232 JobWork := IrrClearWork * FarmWork; 1233 if (JobWork <= 0) or (RealMap[Loc] and fTerImp = tiFarm) then 1234 result := eInvalid 1235 end; 1236 jAfforest: 1237 if AfforestTerrain >= 0 then 1238 JobWork := MineAfforestWork 1239 else 1240 result := eInvalid; 1241 jMine: 1242 begin 1243 JobWork := MineAfforestWork; 1244 if (MineEff = 0) or (RealMap[Loc] and fTerImp = tiMine) then 1245 result := eInvalid 1246 end; 1247 jFort: 1248 if RealMap[Loc] and fTerImp <> tiFort then 1249 JobWork := MoveCost * FortWork 1250 else 1251 result := eInvalid; 1252 jCanal: 1253 if (RealMap[Loc] and fCanal = 0) and (TerrType in TerrType_Canalable) 1254 then 1255 JobWork := CanalWork 1256 else 1257 result := eInvalid; 1258 jTrans: 1259 begin 1260 JobWork := TransWork; 1261 if JobWork <= 0 then 1262 result := eInvalid 1263 end; 1264 jPoll: 1265 if RealMap[Loc] and fPoll <> 0 then 1266 JobWork := PollWork 1267 else 1268 result := eInvalid; 1269 jBase: 1270 if RealMap[Loc] and fTerImp <> tiBase then 1271 JobWork := MoveCost * BaseWork 1272 else 1273 result := eInvalid; 1274 jPillage: 1275 if RealMap[Loc] and (fRoad or fRR or fCanal or fTerImp) <> 0 then 1276 JobWork := PillageWork 1277 else 1278 result := eInvalid; 1279 end; 1280 end; // CalculateJobWork 1281 1282 function StartJob(p, uix, NewJob: integer; TestOnly: boolean): integer; 1283 var 1284 JobWork, Loc0, p1, uix1, TerrType: integer; 1285 begin 1286 {$IFOPT O-}assert(1 shl p and InvalidTreatyMap = 0); {$ENDIF} 1287 result := eOK; 1288 with RW[p].Un[uix] do 1289 begin 1290 if NewJob = Job then 1291 begin 1292 result := eNotChanged; 1293 exit 1294 end; 1295 if NewJob = jNone then 1296 begin 1297 if not TestOnly then 1298 Job := jNone; 1299 exit 1300 end; 1301 Loc0 := Loc; 1302 if (RealMap[Loc0] and fDeadLands <> 0) and (NewJob <> jRoad) and 1303 (NewJob <> jRR) then 1304 begin 1305 result := eDeadLands; 1306 exit 1307 end; 1308 TerrType := RealMap[Loc0] and fTerrain; 1309 if (RealMap[Loc0] and fCity <> 0) or (TerrType < fGrass) or (Master >= 0) or 1310 not((NewJob = jPillage) and (RW[p].Model[mix].Domain = dGround) or 1311 (RW[p].Model[mix].Kind = mkSettler) or (NewJob <> jCity) and 1312 (RW[p].Model[mix].Kind = mkSlaves) and (GWonder[woPyramids].EffectiveOwner 1313 >= 0)) then 1314 begin 1315 result := eInvalid; 1316 exit 1317 end; 1318 if (JobPreq[NewJob] <> preNone) and 1319 (RW[p].Tech[JobPreq[NewJob]] < tsApplicable) then 1320 begin 1321 result := eNoPreq; 1322 exit 1323 end; 1324 1325 result := CalculateJobWork(p, Loc0, NewJob, JobWork); 1326 if (Mode = moPlaying) and (result = eOK) and (NewJob <> jPoll) then 1094 1327 begin // not allowed in territory of friendly nation 1095 p1:=RealMap[Loc0] shr 27; // owner of territory 1096 if (p1<nPl) and (p1<>p) and (RW[p].Treaty[p1]>=trPeace) then 1097 result:=eTreaty; // keep peace treaty! 1098 end; 1099 if TestOnly or (result<rExecuted) then exit; 1100 1101 if (ToWork[Loc0,NewJob]=0) or (ToWork[Loc0,NewJob]>JobWork) then 1102 ToWork[Loc0,NewJob]:=JobWork; 1103 Job:=NewJob; 1104 Flags:=Flags and not unFortified; 1105 for uix1:=0 to RW[p].nUn-1 do 1106 if (RW[p].Un[uix1].Loc=Loc) 1107 and (RW[p].Un[uix1].Job in ContraJobs[NewJob]) then 1108 RW[p].Un[uix1].Job:=jNone; // stop contradictive jobs 1109 if ServerVersion[p]<$000EF0 then 1110 if Work(p,uix) then result:=eJobDone; 1111 if (NewJob=jCity) and (result=eJobDone) then 1112 begin 1113 RemoveUnit_UpdateMap(p,uix); 1114 result:=eCity 1328 p1 := RealMap[Loc0] shr 27; // owner of territory 1329 if (p1 < nPl) and (p1 <> p) and (RW[p].Treaty[p1] >= trPeace) then 1330 result := eTreaty; // keep peace treaty! 1331 end; 1332 if TestOnly or (result < rExecuted) then 1333 exit; 1334 1335 if (ToWork[Loc0, NewJob] = 0) or (ToWork[Loc0, NewJob] > JobWork) then 1336 ToWork[Loc0, NewJob] := JobWork; 1337 Job := NewJob; 1338 Flags := Flags and not unFortified; 1339 for uix1 := 0 to RW[p].nUn - 1 do 1340 if (RW[p].Un[uix1].Loc = Loc) and 1341 (RW[p].Un[uix1].Job in ContraJobs[NewJob]) then 1342 RW[p].Un[uix1].Job := jNone; // stop contradictive jobs 1343 if ServerVersion[p] < $000EF0 then 1344 if Work(p, uix) then 1345 result := eJobDone; 1346 if (NewJob = jCity) and (result = eJobDone) then 1347 begin 1348 RemoveUnit_UpdateMap(p, uix); 1349 result := eCity 1115 1350 end 1116 else if Health<=0 then1351 else if Health <= 0 then 1117 1352 begin // victim of HostileDamage 1118 RemoveUnit_UpdateMap(p,uix);1119 result:=result or rUnitRemoved;1120 end; 1121 if Mode>moLoading_Fast then1122 begin 1123 if result=eCity then1124 begin 1125 ObserveLevel[Loc0]:=ObserveLevel[Loc0] and not (3 shl (2*p));1126 Discover21(Loc0,p,lObserveUnhidden,true,true);1127 //CheckContact;1353 RemoveUnit_UpdateMap(p, uix); 1354 result := result or rUnitRemoved; 1355 end; 1356 if Mode > moLoading_Fast then 1357 begin 1358 if result = eCity then 1359 begin 1360 ObserveLevel[Loc0] := ObserveLevel[Loc0] and not(3 shl (2 * p)); 1361 Discover21(Loc0, p, lObserveUnhidden, true, true); 1362 // CheckContact; 1128 1363 end 1129 1364 end 1130 1365 end; // with 1131 end; //StartJob 1132 1133 function Work(p,uix: integer): boolean; 1134 var 1135 uix1,j0: integer; 1136 begin 1137 result:=false; 1138 with RW[p].Un[uix] do if Movement>=100 then 1139 begin 1140 assert(ToWork[Loc,Job]<$FFFF); // should have been set by StartJob 1141 if Job>=jRoad then 1142 if integer(Movement)>=integer(ToWork[Loc,Job]) then {work complete} 1143 begin 1144 result:=true; 1145 if Job<>jIrr then 1146 Health:=Health-HostileDamage(p,mix,Loc,ToWork[Loc,Job]); 1147 dec(Movement,ToWork[Loc,Job]); 1148 if not (Job in [jCity,jPillage,jPoll]) then 1149 inc(Worked[p],ToWork[Loc,Job]); 1150 if Job=jCity then 1151 begin // found new city 1152 FoundCity(p,Loc); 1153 inc(Founded[p]); 1154 with RW[p].City[RW[p].nCity-1] do 1155 begin 1156 ID:=p shl 12+Founded[p]-1; 1157 Flags:=chFounded; 1158 end; 1159 if Mode=moPlaying then 1160 begin 1161 LogCheckBorders(p,RW[p].nCity-1); 1162 RecalcPeaceMap(p); 1163 end; 1164 {$IFOPT O-}if Mode<moPlaying then InvalidTreatyMap:=not(1 shl p);{$ENDIF} 1165 // territory should not be considered for the rest of the command 1166 // execution, because during loading a game it's incorrect before 1167 // subsequent sIntExpandTerritory is processed 1168 RW[p].Un[uix].Health:=0; // causes unit to be removed later 1169 end 1170 else CompleteJob(p,Loc,Job); 1171 ToWork[Loc,Job]:=0; 1172 j0:=Job; 1173 for uix1:=0 to RW[p].nUn-1 do 1174 if (RW[p].Un[uix1].Loc=Loc) and (RW[p].Un[uix1].Job=j0) then 1175 RW[p].Un[uix1].Job:=jNone 1176 end 1366 end; // StartJob 1367 1368 function Work(p, uix: integer): boolean; 1369 var 1370 uix1, j0: integer; 1371 begin 1372 result := false; 1373 with RW[p].Un[uix] do 1374 if Movement >= 100 then 1375 begin 1376 assert(ToWork[Loc, Job] < $FFFF); // should have been set by StartJob 1377 if Job >= jRoad then 1378 if integer(Movement) >= integer(ToWork[Loc, Job]) then { work complete } 1379 begin 1380 result := true; 1381 if Job <> jIrr then 1382 Health := Health - HostileDamage(p, mix, Loc, ToWork[Loc, Job]); 1383 dec(Movement, ToWork[Loc, Job]); 1384 if not(Job in [jCity, jPillage, jPoll]) then 1385 inc(Worked[p], ToWork[Loc, Job]); 1386 if Job = jCity then 1387 begin // found new city 1388 FoundCity(p, Loc); 1389 inc(Founded[p]); 1390 with RW[p].City[RW[p].nCity - 1] do 1391 begin 1392 ID := p shl 12 + Founded[p] - 1; 1393 Flags := chFounded; 1394 end; 1395 if Mode = moPlaying then 1396 begin 1397 LogCheckBorders(p, RW[p].nCity - 1); 1398 RecalcPeaceMap(p); 1399 end; 1400 {$IFOPT O-} if Mode < moPlaying then 1401 InvalidTreatyMap := not(1 shl p); {$ENDIF} 1402 // territory should not be considered for the rest of the command 1403 // execution, because during loading a game it's incorrect before 1404 // subsequent sIntExpandTerritory is processed 1405 RW[p].Un[uix].Health := 0; // causes unit to be removed later 1406 end 1407 else 1408 CompleteJob(p, Loc, Job); 1409 ToWork[Loc, Job] := 0; 1410 j0 := Job; 1411 for uix1 := 0 to RW[p].nUn - 1 do 1412 if (RW[p].Un[uix1].Loc = Loc) and (RW[p].Un[uix1].Job = j0) then 1413 RW[p].Un[uix1].Job := jNone 1414 end 1415 else 1416 begin 1417 dec(ToWork[Loc, Job], Movement); 1418 if not(Job in [jCity, jPillage, jPoll]) then 1419 inc(Worked[p], Movement); 1420 Health := Health - HostileDamage(p, mix, Loc, Movement); 1421 Movement := 0; 1422 end 1423 end 1424 end; // work 1425 1426 function GetJobProgress(p, Loc: integer; 1427 var JobProgressData: TJobProgressData): integer; 1428 var 1429 Job, JobResult, uix: integer; 1430 begin 1431 for Job := 0 to nJob - 1 do 1432 begin 1433 JobResult := CalculateJobWork(p, Loc, Job, JobProgressData[Job].Required); 1434 if JobResult = eOK then 1435 begin 1436 if ToWork[Loc, Job] = $FFFF then // not calculated yet 1437 JobProgressData[Job].Done := 0 1438 else 1439 JobProgressData[Job].Done := JobProgressData[Job].Required - 1440 ToWork[Loc, Job] 1441 end 1177 1442 else 1178 begin 1179 dec(ToWork[Loc,Job],Movement); 1180 if not (Job in [jCity,jPillage,jPoll]) then 1181 inc(Worked[p],Movement); 1182 Health:=Health-HostileDamage(p,mix,Loc,Movement); 1183 Movement:=0; 1184 end 1185 end 1186 end; // work 1187 1188 function GetJobProgress(p,Loc: integer; var JobProgressData: TJobProgressData): integer; 1189 var 1190 Job,JobResult,uix: integer; 1191 begin 1192 for Job:=0 to nJob-1 do 1193 begin 1194 JobResult:=CalculateJobWork(p,Loc,Job,JobProgressData[Job].Required); 1195 if JobResult=eOk then 1196 begin 1197 if ToWork[Loc,Job]=$FFFF then // not calculated yet 1198 JobProgressData[Job].Done:=0 1199 else JobProgressData[Job].Done:=JobProgressData[Job].Required-ToWork[Loc,Job] 1200 end 1201 else 1202 begin 1203 JobProgressData[Job].Required:=0; 1204 JobProgressData[Job].Done:=0; 1205 end; 1206 JobProgressData[Job].NextTurnPlus:=0; 1443 begin 1444 JobProgressData[Job].Required := 0; 1445 JobProgressData[Job].Done := 0; 1446 end; 1447 JobProgressData[Job].NextTurnPlus := 0; 1207 1448 end; 1208 for uix:=0 to RW[p].nUn-1 do 1209 if (RW[p].Un[uix].Loc=Loc) and (RW[p].Un[uix].Movement>=100) then 1210 inc(JobProgressData[RW[p].Un[uix].Job].NextTurnPlus, RW[p].Un[uix].Movement); 1211 result:=eOk; 1449 for uix := 0 to RW[p].nUn - 1 do 1450 if (RW[p].Un[uix].Loc = Loc) and (RW[p].Un[uix].Movement >= 100) then 1451 inc(JobProgressData[RW[p].Un[uix].Job].NextTurnPlus, 1452 RW[p].Un[uix].Movement); 1453 result := eOK; 1212 1454 end; 1213 1455 1214 1215 1456 { 1216 1217 ____________________________________________________________________1457 Start/End Game 1458 ____________________________________________________________________ 1218 1459 } 1219 1460 procedure InitGame; 1220 1461 begin 1221 GetMem(ToWork,2*MapSize*nJob);1222 FillChar(ToWork^,2*MapSize*nJob,$FF);1462 GetMem(ToWork, 2 * MapSize * nJob); 1463 FillChar(ToWork^, 2 * MapSize * nJob, $FF); 1223 1464 end; 1224 1465 1225 1466 procedure ReleaseGame; 1226 1467 begin 1227 FreeMem(ToWork);1468 FreeMem(ToWork); 1228 1469 end; 1229 1470 1230 1471 end. 1231
Note:
See TracChangeset
for help on using the changeset viewer.