| 1 | {$INCLUDE Switches.inc}
|
|---|
| 2 | unit Tribes;
|
|---|
| 3 |
|
|---|
| 4 | interface
|
|---|
| 5 |
|
|---|
| 6 | uses
|
|---|
| 7 | Protocol, ScreenTools, LazFileUtils, Classes, SysUtils, Global, GraphicSet,
|
|---|
| 8 | {$IFDEF DPI}Dpi.Graphics{$ELSE}Graphics{$ENDIF};
|
|---|
| 9 |
|
|---|
| 10 | type
|
|---|
| 11 | TCityPicture = record
|
|---|
| 12 | xShield: Integer;
|
|---|
| 13 | yShield: Integer;
|
|---|
| 14 | end;
|
|---|
| 15 |
|
|---|
| 16 | TModelPicture = record
|
|---|
| 17 | HGr: TGraphicSet;
|
|---|
| 18 | pix: Integer;
|
|---|
| 19 | xShield: Integer;
|
|---|
| 20 | yShield: Integer;
|
|---|
| 21 | end;
|
|---|
| 22 |
|
|---|
| 23 | { TModelPictureInfo }
|
|---|
| 24 |
|
|---|
| 25 | TModelPictureInfo = record
|
|---|
| 26 | trix: Integer;
|
|---|
| 27 | mix: Integer;
|
|---|
| 28 | pix: Integer;
|
|---|
| 29 | Hash: Integer;
|
|---|
| 30 | GrName: ShortString;
|
|---|
| 31 | function GetCommandDataSize: Byte;
|
|---|
| 32 | end;
|
|---|
| 33 |
|
|---|
| 34 | TTribe = class
|
|---|
| 35 | symHGr: TGraphicSet;
|
|---|
| 36 | sympix: Integer;
|
|---|
| 37 | faceHGr: TGraphicSet;
|
|---|
| 38 | facepix: Integer;
|
|---|
| 39 | cHGr: TGraphicSet;
|
|---|
| 40 | cpix: Integer;
|
|---|
| 41 | // symbol and city graphics
|
|---|
| 42 | cAge: Integer;
|
|---|
| 43 | mixSlaves: Integer;
|
|---|
| 44 | Color: TColor;
|
|---|
| 45 | NumberName: Integer;
|
|---|
| 46 | CityPicture: array [0 .. 3] of TCityPicture;
|
|---|
| 47 | ModelPicture: array [-1 .. 256] of TModelPicture; // -1 is building site
|
|---|
| 48 | ModelName: array [-1 .. 256] of string;
|
|---|
| 49 | constructor Create(FileName: string);
|
|---|
| 50 | destructor Destroy; override;
|
|---|
| 51 | function GetCityName(I: Integer): string;
|
|---|
| 52 | {$IFNDEF SCR} procedure SetCityName(I: Integer; NewName: string); {$ENDIF}
|
|---|
| 53 | {$IFNDEF SCR} function TString(Template: string): string;
|
|---|
| 54 | function TPhrase(Item: string): string; {$ENDIF}
|
|---|
| 55 | procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: Boolean);
|
|---|
| 56 | function ChooseModelPicture(var Picture: TModelPictureInfo;
|
|---|
| 57 | Code, Turn: Integer; ForceNew: Boolean): Boolean;
|
|---|
| 58 | procedure InitAge(Age: Integer);
|
|---|
| 59 | protected
|
|---|
| 60 | CityLine0: Integer;
|
|---|
| 61 | nCityLines: Integer;
|
|---|
| 62 | Name: array ['a' .. 'z'] of string;
|
|---|
| 63 | Script: TStringList;
|
|---|
| 64 | end;
|
|---|
| 65 |
|
|---|
| 66 | var
|
|---|
| 67 | Tribe: array [0 .. nPl - 1] of TTribe;
|
|---|
| 68 | HGrStdUnits: TGraphicSet;
|
|---|
| 69 |
|
|---|
| 70 | procedure Init;
|
|---|
| 71 | procedure Done;
|
|---|
| 72 | function CityName(Founder: Integer): string;
|
|---|
| 73 | function ModelCode(const ModelInfo: TModelInfo): Integer;
|
|---|
| 74 | procedure FindStdModelPicture(Code: Integer; out pix: Integer; out Name: string);
|
|---|
| 75 | function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): Boolean;
|
|---|
| 76 | procedure FindPosition(HGr: TGraphicSet; X, Y, xmax, ymax: Integer; Mark: TColor;
|
|---|
| 77 | var xp, yp: Integer);
|
|---|
| 78 |
|
|---|
| 79 |
|
|---|
| 80 | implementation
|
|---|
| 81 |
|
|---|
| 82 | uses
|
|---|
| 83 | Directories;
|
|---|
| 84 |
|
|---|
| 85 | type
|
|---|
| 86 | TChosenModelPictureInfo = record
|
|---|
| 87 | Hash: Integer;
|
|---|
| 88 | HGr: TGraphicSet;
|
|---|
| 89 | pix: Integer;
|
|---|
| 90 | ModelName: ShortString;
|
|---|
| 91 | end;
|
|---|
| 92 |
|
|---|
| 93 | TPictureList = array [0 .. 99999] of TChosenModelPictureInfo;
|
|---|
| 94 |
|
|---|
| 95 | var
|
|---|
| 96 | StdUnitScript: TStringList;
|
|---|
| 97 | PictureList: ^TPictureList;
|
|---|
| 98 | nPictureList: Integer;
|
|---|
| 99 |
|
|---|
| 100 | procedure Init;
|
|---|
| 101 | begin
|
|---|
| 102 | StdUnitScript := TStringList.Create;
|
|---|
| 103 | StdUnitScript.LoadFromFile(LocalizedFilePath('Tribes' +
|
|---|
| 104 | DirectorySeparator + 'StdUnits.txt'));
|
|---|
| 105 | nPictureList := 0;
|
|---|
| 106 | PictureList := nil;
|
|---|
| 107 | end;
|
|---|
| 108 |
|
|---|
| 109 | procedure Done;
|
|---|
| 110 | begin
|
|---|
| 111 | ReallocMem(PictureList, 0);
|
|---|
| 112 | FreeAndNil(StdUnitScript);
|
|---|
| 113 | end;
|
|---|
| 114 |
|
|---|
| 115 | function CityName(Founder: Integer): string;
|
|---|
| 116 | begin
|
|---|
| 117 | if not GenerateNames then
|
|---|
| 118 | Result := Format('%d.%d', [Founder shr 12, Founder and $FFF])
|
|---|
| 119 | else
|
|---|
| 120 | Result := Tribe[Founder shr 12].GetCityName(Founder and $FFF);
|
|---|
| 121 | end;
|
|---|
| 122 |
|
|---|
| 123 | function ModelCode(const ModelInfo: TModelInfo): Integer;
|
|---|
| 124 | begin
|
|---|
| 125 | with ModelInfo do
|
|---|
| 126 | begin
|
|---|
| 127 | case Kind of
|
|---|
| 128 | mkSelfDeveloped, mkEnemyDeveloped:
|
|---|
| 129 | case Domain of { age determination }
|
|---|
| 130 | dGround:
|
|---|
| 131 | if (Attack >= Defense * 4) or (Attack > 0) and
|
|---|
| 132 | (MaxUpgrade < 10) and
|
|---|
| 133 | (Cap and (1 shl (mcArtillery - mcFirstNonCap)) <> 0) then
|
|---|
| 134 | begin
|
|---|
| 135 | Result := 170;
|
|---|
| 136 | if MaxUpgrade >= 12 then
|
|---|
| 137 | Inc(Result, 3)
|
|---|
| 138 | else if (MaxUpgrade >= 10) or (Weight > 7) then
|
|---|
| 139 | Inc(Result, 2)
|
|---|
| 140 | else if MaxUpgrade >= 4 then
|
|---|
| 141 | Inc(Result, 1);
|
|---|
| 142 | end
|
|---|
| 143 | else
|
|---|
| 144 | begin
|
|---|
| 145 | Result := 100;
|
|---|
| 146 | if MaxUpgrade >= 12 then
|
|---|
| 147 | Inc(Result, 6)
|
|---|
| 148 | else if (MaxUpgrade >= 10) or (Weight > 7) then
|
|---|
| 149 | Inc(Result, 5)
|
|---|
| 150 | else if MaxUpgrade >= 6 then
|
|---|
| 151 | Inc(Result, 4)
|
|---|
| 152 | else if MaxUpgrade >= 4 then
|
|---|
| 153 | Inc(Result, 3)
|
|---|
| 154 | else if MaxUpgrade >= 2 then
|
|---|
| 155 | Inc(Result, 2)
|
|---|
| 156 | else if MaxUpgrade >= 1 then
|
|---|
| 157 | Inc(Result, 1);
|
|---|
| 158 | if Speed >= 250 then
|
|---|
| 159 | if (Result >= 105) and (Attack <= Defense) then
|
|---|
| 160 | Result := 110
|
|---|
| 161 | else
|
|---|
| 162 | Inc(Result, 30);
|
|---|
| 163 | end;
|
|---|
| 164 | dSea:
|
|---|
| 165 | begin
|
|---|
| 166 | Result := 200;
|
|---|
| 167 | if MaxUpgrade >= 8 then
|
|---|
| 168 | Inc(Result, 3)
|
|---|
| 169 | else if MaxUpgrade >= 6 then
|
|---|
| 170 | Inc(Result, 2)
|
|---|
| 171 | else if MaxUpgrade >= 3 then
|
|---|
| 172 | Inc(Result, 1);
|
|---|
| 173 | if Cap and (1 shl (mcSub - mcFirstNonCap)) <> 0 then
|
|---|
| 174 | Result := 240
|
|---|
| 175 | else if ATrans_Fuel > 0 then
|
|---|
| 176 | Result := 220
|
|---|
| 177 | else if (Result >= 202) and (Attack = 0) and (TTrans > 0) then
|
|---|
| 178 | Result := 210;
|
|---|
| 179 | end;
|
|---|
| 180 | dAir:
|
|---|
| 181 | begin
|
|---|
| 182 | Result := 300;
|
|---|
| 183 | if (Bombs > 0) or (TTrans > 0) then
|
|---|
| 184 | Inc(Result, 10);
|
|---|
| 185 | if Speed > 850 then
|
|---|
| 186 | Inc(Result, 1);
|
|---|
| 187 | end;
|
|---|
| 188 | end;
|
|---|
| 189 | mkSpecial_TownGuard:
|
|---|
| 190 | Result := 41;
|
|---|
| 191 | mkSpecial_Boat:
|
|---|
| 192 | Result := 64;
|
|---|
| 193 | mkSpecial_SubCabin:
|
|---|
| 194 | Result := 71;
|
|---|
| 195 | mkSpecial_Glider:
|
|---|
| 196 | Result := 73;
|
|---|
| 197 | mkSlaves:
|
|---|
| 198 | Result := 74;
|
|---|
| 199 | mkSettler:
|
|---|
| 200 | if Speed > 150 then
|
|---|
| 201 | Result := 11
|
|---|
| 202 | else
|
|---|
| 203 | Result := 10;
|
|---|
| 204 | mkDiplomat:
|
|---|
| 205 | Result := 21;
|
|---|
| 206 | mkCaravan:
|
|---|
| 207 | Result := 30;
|
|---|
| 208 | end;
|
|---|
| 209 | end;
|
|---|
| 210 | end;
|
|---|
| 211 |
|
|---|
| 212 | var
|
|---|
| 213 | Input: string;
|
|---|
| 214 |
|
|---|
| 215 | function Get: string;
|
|---|
| 216 | var
|
|---|
| 217 | P: Integer;
|
|---|
| 218 | begin
|
|---|
| 219 | while (Input <> '') and ((Input[1] = ' ') or (Input[1] = #9)) do
|
|---|
| 220 | Delete(Input, 1, 1);
|
|---|
| 221 | P := Pos(',', Input);
|
|---|
| 222 | if P = 0 then
|
|---|
| 223 | P := Length(Input) + 1;
|
|---|
| 224 | Result := Copy(Input, 1, P - 1);
|
|---|
| 225 | Delete(Input, 1, P);
|
|---|
| 226 | end;
|
|---|
| 227 |
|
|---|
| 228 | function GetNum: Integer;
|
|---|
| 229 | var
|
|---|
| 230 | I: Integer;
|
|---|
| 231 | begin
|
|---|
| 232 | Val(Get, Result, I);
|
|---|
| 233 | if I <> 0 then
|
|---|
| 234 | Result := 0;
|
|---|
| 235 | end;
|
|---|
| 236 |
|
|---|
| 237 | procedure FindStdModelPicture(Code: Integer; out pix: Integer; out Name: string);
|
|---|
| 238 | var
|
|---|
| 239 | I: Integer;
|
|---|
| 240 | begin
|
|---|
| 241 | for I := 0 to StdUnitScript.Count - 1 do
|
|---|
| 242 | begin // look through StdUnits
|
|---|
| 243 | Input := StdUnitScript[I];
|
|---|
| 244 | pix := GetNum;
|
|---|
| 245 | if Code = GetNum then
|
|---|
| 246 | begin
|
|---|
| 247 | Name := Get;
|
|---|
| 248 | Exit;
|
|---|
| 249 | end;
|
|---|
| 250 | end;
|
|---|
| 251 | pix := -1;
|
|---|
| 252 | end;
|
|---|
| 253 |
|
|---|
| 254 | function GetTribeInfo(FileName: string; var Name: string;
|
|---|
| 255 | var Color: TColor): Boolean;
|
|---|
| 256 | var
|
|---|
| 257 | Found: Integer;
|
|---|
| 258 | TribeScript: TextFile;
|
|---|
| 259 | begin
|
|---|
| 260 | Name := '';
|
|---|
| 261 | Color := $FFFFFF;
|
|---|
| 262 | Found := 0;
|
|---|
| 263 | AssignFile(TribeScript, LocalizedFilePath('Tribes' + DirectorySeparator +
|
|---|
| 264 | FileName + CevoTribeExt));
|
|---|
| 265 | Reset(TribeScript);
|
|---|
| 266 | while not EOF(TribeScript) do
|
|---|
| 267 | begin
|
|---|
| 268 | ReadLn(TribeScript, Input);
|
|---|
| 269 | if Copy(Input, 1, 7) = '#CHOOSE' then
|
|---|
| 270 | begin
|
|---|
| 271 | Name := Copy(Input, 9, 255);
|
|---|
| 272 | Found := Found or 1;
|
|---|
| 273 | if Found = 3 then
|
|---|
| 274 | Break;
|
|---|
| 275 | end
|
|---|
| 276 | else if Copy(Input, 1, 6) = '#COLOR' then
|
|---|
| 277 | begin
|
|---|
| 278 | Color := HexStringToColor(Copy(Input, 7, 255));
|
|---|
| 279 | Found := Found or 2;
|
|---|
| 280 | if Found = 3 then
|
|---|
| 281 | Break;
|
|---|
| 282 | end;
|
|---|
| 283 | end;
|
|---|
| 284 | CloseFile(TribeScript);
|
|---|
| 285 | Result := Found = 3;
|
|---|
| 286 | end;
|
|---|
| 287 |
|
|---|
| 288 | { TModelPictureInfo }
|
|---|
| 289 |
|
|---|
| 290 | function TModelPictureInfo.GetCommandDataSize: Byte;
|
|---|
| 291 | begin
|
|---|
| 292 | Result := SizeOf(trix) + SizeOf(mix) + SizeOf(pix) + SizeOf(Hash) + 1 +
|
|---|
| 293 | Length(GrName);
|
|---|
| 294 | end;
|
|---|
| 295 |
|
|---|
| 296 | constructor TTribe.Create(FileName: string);
|
|---|
| 297 | var
|
|---|
| 298 | Line: Integer;
|
|---|
| 299 | Variant: Char;
|
|---|
| 300 | Item: string;
|
|---|
| 301 | begin
|
|---|
| 302 | inherited Create;
|
|---|
| 303 | for Variant := 'a' to 'z' do
|
|---|
| 304 | Name[Variant] := '';
|
|---|
| 305 | Script := TStringList.Create;
|
|---|
| 306 | Script.LoadFromFile(FileName);
|
|---|
| 307 | CityLine0 := 0;
|
|---|
| 308 | nCityLines := 0;
|
|---|
| 309 | for Line := 0 to Script.Count - 1 do
|
|---|
| 310 | begin
|
|---|
| 311 | Input := Script[Line];
|
|---|
| 312 | if (CityLine0 > 0) and (nCityLines = 0) and
|
|---|
| 313 | ((Input = '') or (Input[1] = '#')) then
|
|---|
| 314 | nCityLines := Line - CityLine0;
|
|---|
| 315 | if (Length(Input) >= 3) and (Input[1] = '#') and
|
|---|
| 316 | (Input[2] in ['a' .. 'z']) and (Input[3] = ' ') then
|
|---|
| 317 | Name[Input[2]] := Copy(Input, 4, 255)
|
|---|
| 318 | else if Copy(Input, 1, 6) = '#COLOR' then
|
|---|
| 319 | Color := HexStringToColor(Copy(Input, 7, 255))
|
|---|
| 320 | else if Copy(Input, 1, 7) = '#CITIES' then
|
|---|
| 321 | CityLine0 := Line + 1
|
|---|
| 322 | else if Copy(Input, 1, 8) = '#SYMBOLS' then
|
|---|
| 323 | begin
|
|---|
| 324 | Delete(Input, 1, 9);
|
|---|
| 325 | Item := Get;
|
|---|
| 326 | sympix := GetNum;
|
|---|
| 327 | symHGr := LoadGraphicSet(Item + '.png');
|
|---|
| 328 | end;
|
|---|
| 329 | end;
|
|---|
| 330 | FillChar(ModelPicture, SizeOf(ModelPicture), 0);
|
|---|
| 331 | NumberName := -1;
|
|---|
| 332 | cAge := -1;
|
|---|
| 333 | mixSlaves := -1;
|
|---|
| 334 | end;
|
|---|
| 335 |
|
|---|
| 336 | destructor TTribe.Destroy;
|
|---|
| 337 | begin
|
|---|
| 338 | FreeAndNil(Script);
|
|---|
| 339 | inherited;
|
|---|
| 340 | end;
|
|---|
| 341 |
|
|---|
| 342 | procedure FindPosition(HGr: TGraphicSet; X, Y, xmax, ymax: Integer; Mark: TColor;
|
|---|
| 343 | var xp, yp: Integer);
|
|---|
| 344 | begin
|
|---|
| 345 | xp := 0;
|
|---|
| 346 | while (xp < xmax) and (HGr.Data.Canvas.Pixels[X + 1 + xp, Y] <> Mark) do
|
|---|
| 347 | Inc(xp);
|
|---|
| 348 | yp := 0;
|
|---|
| 349 | while (yp < ymax) and (HGr.Data.Canvas.Pixels[X, Y + 1 + yp] <> Mark) do
|
|---|
| 350 | Inc(yp);
|
|---|
| 351 | end;
|
|---|
| 352 |
|
|---|
| 353 | function TTribe.GetCityName(I: Integer): string;
|
|---|
| 354 | begin
|
|---|
| 355 | Result := '';
|
|---|
| 356 | if nCityLines > I then
|
|---|
| 357 | begin
|
|---|
| 358 | Result := Script[CityLine0 + I];
|
|---|
| 359 | while (Result <> '') and ((Result[1] = ' ') or (Result[1] = #9)) do
|
|---|
| 360 | Delete(Result, 1, 1);
|
|---|
| 361 | end
|
|---|
| 362 | {$IFNDEF SCR}
|
|---|
| 363 | else
|
|---|
| 364 | Result := Format(TPhrase('GENCITY'), [I + 1]);
|
|---|
| 365 | {$ENDIF}
|
|---|
| 366 | end;
|
|---|
| 367 |
|
|---|
| 368 | {$IFNDEF SCR}
|
|---|
| 369 | procedure TTribe.SetCityName(I: Integer; NewName: string);
|
|---|
| 370 | begin
|
|---|
| 371 | while nCityLines <= I do
|
|---|
| 372 | begin
|
|---|
| 373 | Script.Insert(CityLine0 + nCityLines, Format(TPhrase('GENCITY'),
|
|---|
| 374 | [nCityLines + 1]));
|
|---|
| 375 | Inc(nCityLines);
|
|---|
| 376 | end;
|
|---|
| 377 | Script[CityLine0 + I] := NewName;
|
|---|
| 378 | end;
|
|---|
| 379 |
|
|---|
| 380 | function TTribe.TString(Template: string): string;
|
|---|
| 381 | var
|
|---|
| 382 | P: Integer;
|
|---|
| 383 | Variant: Char;
|
|---|
| 384 | CaseUp: Boolean;
|
|---|
| 385 | begin
|
|---|
| 386 | repeat
|
|---|
| 387 | P := Pos('#', Template);
|
|---|
| 388 | if (P = 0) or (P = Length(Template)) then
|
|---|
| 389 | Break;
|
|---|
| 390 | Variant := Template[P + 1];
|
|---|
| 391 | CaseUp := Variant in ['A' .. 'Z'];
|
|---|
| 392 | if CaseUp then
|
|---|
| 393 | Inc(Variant, 32);
|
|---|
| 394 | Delete(Template, P, 2);
|
|---|
| 395 | if Variant in ['a' .. 'z'] then
|
|---|
| 396 | begin
|
|---|
| 397 | if NumberName < 0 then
|
|---|
| 398 | Insert(Name[Variant], Template, P)
|
|---|
| 399 | else
|
|---|
| 400 | Insert(Format('P%d', [NumberName]), Template, P);
|
|---|
| 401 | if CaseUp and (Length(Template) >= P) and
|
|---|
| 402 | (Template[P] in ['a' .. 'z', #$E0 .. #$FF]) then
|
|---|
| 403 | Dec(Template[P], 32);
|
|---|
| 404 | end
|
|---|
| 405 | until False;
|
|---|
| 406 | Result := Template;
|
|---|
| 407 | end;
|
|---|
| 408 |
|
|---|
| 409 | function TTribe.TPhrase(Item: string): string;
|
|---|
| 410 | begin
|
|---|
| 411 | Result := TString(Phrases.Lookup(Item));
|
|---|
| 412 | end;
|
|---|
| 413 |
|
|---|
| 414 | {$ENDIF}
|
|---|
| 415 |
|
|---|
| 416 | procedure TTribe.InitAge(Age: Integer);
|
|---|
| 417 | var
|
|---|
| 418 | I, X, Gray: Integer;
|
|---|
| 419 | Item: string;
|
|---|
| 420 | begin
|
|---|
| 421 | if Age = cAge then
|
|---|
| 422 | Exit;
|
|---|
| 423 | cAge := Age;
|
|---|
| 424 | with Script do
|
|---|
| 425 | begin
|
|---|
| 426 | I := 0;
|
|---|
| 427 | while (I < Count) and (Copy(Strings[I], 1, 6) <>
|
|---|
| 428 | '#AGE' + Char(48 + Age) + ' ') do
|
|---|
| 429 | Inc(I);
|
|---|
| 430 | if I < Count then
|
|---|
| 431 | begin
|
|---|
| 432 | Input := Strings[I];
|
|---|
| 433 | System.Delete(Input, 1, 6);
|
|---|
| 434 | Item := Get;
|
|---|
| 435 | cpix := GetNum;
|
|---|
| 436 | // init city graphics
|
|---|
| 437 | if Age < 2 then
|
|---|
| 438 | begin
|
|---|
| 439 | if CompareText(Item, 'stdcities') = 0 then
|
|---|
| 440 | case cpix of
|
|---|
| 441 | 3: cpix := 0;
|
|---|
| 442 | 6: begin
|
|---|
| 443 | cpix := 0;
|
|---|
| 444 | Item := 'Nation2';
|
|---|
| 445 | end;
|
|---|
| 446 | end;
|
|---|
| 447 | cHGr := LoadGraphicSet(Item + '.png');
|
|---|
| 448 | for X := 0 to 3 do
|
|---|
| 449 | with CityPicture[X] do begin
|
|---|
| 450 | FindPosition(cHGr, X * 65, cpix * 49, 63, 47, $00FFFF,
|
|---|
| 451 | xShield, yShield);
|
|---|
| 452 | // FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf);
|
|---|
| 453 | end;
|
|---|
| 454 | end
|
|---|
| 455 | else
|
|---|
| 456 | cHGr := nil;
|
|---|
| 457 |
|
|---|
| 458 | {$IFNDEF SCR}
|
|---|
| 459 | Get;
|
|---|
| 460 | GetNum;
|
|---|
| 461 | Item := Get;
|
|---|
| 462 | if Item = '' then
|
|---|
| 463 | faceHGr := nil
|
|---|
| 464 | else
|
|---|
| 465 | begin
|
|---|
| 466 | faceHGr := LoadGraphicSet(Item + '.png');
|
|---|
| 467 | facepix := GetNum;
|
|---|
| 468 | if faceHGr.Data.Canvas.Pixels[facepix mod 10 * 65,
|
|---|
| 469 | facepix div 10 * 49 + 48] = $00FFFF then
|
|---|
| 470 | begin // generate shield picture
|
|---|
| 471 | faceHGr.Data.Canvas.Pixels[facepix mod 10 * 65,
|
|---|
| 472 | facepix div 10 * 49 + 48] := $000000;
|
|---|
| 473 | Gray := $B8B8B8;
|
|---|
| 474 | ImageOp_BCC(faceHGr.Data, Templates.Data,
|
|---|
| 475 | facepix mod 10 * 65 + 1, facepix div 10 * 49 + 1, 1, 25, 64, 48,
|
|---|
| 476 | Gray, Color);
|
|---|
| 477 | end;
|
|---|
| 478 | end;
|
|---|
| 479 | {$ENDIF}
|
|---|
| 480 | end;
|
|---|
| 481 | end;
|
|---|
| 482 | end;
|
|---|
| 483 |
|
|---|
| 484 | procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; IsNew: Boolean);
|
|---|
| 485 | var
|
|---|
| 486 | I: Integer;
|
|---|
| 487 | Ok: Boolean;
|
|---|
| 488 | begin
|
|---|
| 489 | with Info do
|
|---|
| 490 | begin
|
|---|
| 491 | if not IsNew then
|
|---|
| 492 | begin
|
|---|
| 493 | I := nPictureList - 1;
|
|---|
| 494 | while (I >= 0) and (PictureList[I].Hash <> Info.Hash) do
|
|---|
| 495 | Dec(I);
|
|---|
| 496 | Assert(I >= 0);
|
|---|
| 497 | Assert(PictureList[I].HGr = LoadGraphicSet(GrName));
|
|---|
| 498 | Assert(PictureList[I].pix = pix);
|
|---|
| 499 | ModelPicture[mix].HGr := PictureList[I].HGr;
|
|---|
| 500 | ModelPicture[mix].pix := PictureList[I].pix;
|
|---|
| 501 | ModelName[mix] := PictureList[I].ModelName;
|
|---|
| 502 | end
|
|---|
| 503 | else
|
|---|
| 504 | begin
|
|---|
| 505 | with ModelPicture[mix] do
|
|---|
| 506 | begin
|
|---|
| 507 | HGr := LoadGraphicSet(GrName);
|
|---|
| 508 | pix := Info.pix;
|
|---|
| 509 | Inc(HGr.PixUsed[pix]);
|
|---|
| 510 | end;
|
|---|
| 511 | ModelName[mix] := '';
|
|---|
| 512 |
|
|---|
| 513 | // read model name from tribe script
|
|---|
| 514 | Ok := False;
|
|---|
| 515 | for I := 0 to Script.Count - 1 do
|
|---|
| 516 | begin
|
|---|
| 517 | Input := Script[I];
|
|---|
| 518 | if Input = '#UNITS ' + ExtractFileNameOnly(GrName) then
|
|---|
| 519 | Ok := True
|
|---|
| 520 | else if (Input <> '') and (Input[1] = '#') then
|
|---|
| 521 | Ok := False
|
|---|
| 522 | else if Ok and (GetNum = pix) then
|
|---|
| 523 | begin
|
|---|
| 524 | Get;
|
|---|
| 525 | ModelName[mix] := Get;
|
|---|
| 526 | end;
|
|---|
| 527 | end;
|
|---|
| 528 |
|
|---|
| 529 | if ModelName[mix] = '' then
|
|---|
| 530 | begin // read model name from StdUnits.txt
|
|---|
| 531 | for I := 0 to StdUnitScript.Count - 1 do
|
|---|
| 532 | begin
|
|---|
| 533 | Input := StdUnitScript[I];
|
|---|
| 534 | if GetNum = pix then
|
|---|
| 535 | begin
|
|---|
| 536 | Get;
|
|---|
| 537 | ModelName[mix] := Get;
|
|---|
| 538 | end;
|
|---|
| 539 | end;
|
|---|
| 540 | end;
|
|---|
| 541 |
|
|---|
| 542 | if Hash <> 0 then
|
|---|
| 543 | begin
|
|---|
| 544 | if nPictureList = 0 then
|
|---|
| 545 | ReallocMem(PictureList, 64 * SizeOf(TChosenModelPictureInfo))
|
|---|
| 546 | else if (nPictureList >= 64) and (nPictureList and
|
|---|
| 547 | (nPictureList - 1) = 0) then
|
|---|
| 548 | ReallocMem(PictureList,
|
|---|
| 549 | nPictureList * (2 * SizeOf(TChosenModelPictureInfo)));
|
|---|
| 550 | PictureList[nPictureList].Hash := Info.Hash;
|
|---|
| 551 | PictureList[nPictureList].HGr := ModelPicture[mix].HGr;
|
|---|
| 552 | PictureList[nPictureList].pix := Info.pix;
|
|---|
| 553 | PictureList[nPictureList].ModelName := ModelName[mix];
|
|---|
| 554 | Inc(nPictureList);
|
|---|
| 555 | end;
|
|---|
| 556 | end;
|
|---|
| 557 |
|
|---|
| 558 | with ModelPicture[mix] do
|
|---|
| 559 | FindPosition(HGr, pix mod 10 * 65, pix div 10 * 49, 63, 47, $FFFFFF,
|
|---|
| 560 | xShield, yShield);
|
|---|
| 561 | end;
|
|---|
| 562 | end;
|
|---|
| 563 |
|
|---|
| 564 | function TTribe.ChooseModelPicture(var Picture: TModelPictureInfo;
|
|---|
| 565 | Code, Turn: Integer; ForceNew: Boolean): Boolean;
|
|---|
| 566 | var
|
|---|
| 567 | I: Integer;
|
|---|
| 568 | Cnt: Integer;
|
|---|
| 569 | HGr: TGraphicSet;
|
|---|
| 570 | Used: Integer;
|
|---|
| 571 | LeastUsed: Integer;
|
|---|
| 572 | TestPic: TModelPictureInfo;
|
|---|
| 573 | Ok: Boolean;
|
|---|
| 574 |
|
|---|
| 575 | procedure Check;
|
|---|
| 576 | begin
|
|---|
| 577 | TestPic.pix := GetNum;
|
|---|
| 578 | if Code = GetNum then
|
|---|
| 579 | begin
|
|---|
| 580 | if ForceNew or (not Assigned(HGr)) then
|
|---|
| 581 | Used := 0
|
|---|
| 582 | else
|
|---|
| 583 | begin
|
|---|
| 584 | Used := 4 * HGr.PixUsed[TestPic.pix];
|
|---|
| 585 | if HGr = HGrStdUnits then
|
|---|
| 586 | Inc(Used, 2); // prefer units not from StdUnits
|
|---|
| 587 | end;
|
|---|
| 588 | if Used < LeastUsed then
|
|---|
| 589 | begin
|
|---|
| 590 | Cnt := 0;
|
|---|
| 591 | LeastUsed := Used;
|
|---|
| 592 | end;
|
|---|
| 593 | if Used = LeastUsed then
|
|---|
| 594 | begin
|
|---|
| 595 | Inc(Cnt);
|
|---|
| 596 | if Turn mod Cnt = 0 then
|
|---|
| 597 | Picture := TestPic;
|
|---|
| 598 | end;
|
|---|
| 599 | end;
|
|---|
| 600 | end;
|
|---|
| 601 |
|
|---|
| 602 | begin
|
|---|
| 603 | // look for identical model to assign same picture again
|
|---|
| 604 | if not ForceNew and (Picture.Hash > 0) then
|
|---|
| 605 | begin
|
|---|
| 606 | for I := 0 to nPictureList - 1 do
|
|---|
| 607 | if PictureList[I].Hash = Picture.Hash then
|
|---|
| 608 | begin
|
|---|
| 609 | Picture.GrName := PictureList[I].HGr.Name;
|
|---|
| 610 | Picture.pix := PictureList[I].pix;
|
|---|
| 611 | Result := False;
|
|---|
| 612 | Exit;
|
|---|
| 613 | end;
|
|---|
| 614 | end;
|
|---|
| 615 |
|
|---|
| 616 | Picture.pix := 0;
|
|---|
| 617 | TestPic := Picture;
|
|---|
| 618 | LeastUsed := MaxInt;
|
|---|
| 619 |
|
|---|
| 620 | TestPic.GrName := 'StdUnits.png';
|
|---|
| 621 | HGr := HGrStdUnits;
|
|---|
| 622 | for I := 0 to StdUnitScript.Count - 1 do
|
|---|
| 623 | begin // look through StdUnits
|
|---|
| 624 | Input := StdUnitScript[I];
|
|---|
| 625 | Check;
|
|---|
| 626 | end;
|
|---|
| 627 |
|
|---|
| 628 | Ok := False;
|
|---|
| 629 | for I := 0 to Script.Count - 1 do
|
|---|
| 630 | begin // look through units defined in tribe script
|
|---|
| 631 | Input := Script[I];
|
|---|
| 632 | if Copy(Input, 1, 6) = '#UNITS' then
|
|---|
| 633 | begin
|
|---|
| 634 | Ok := True;
|
|---|
| 635 | TestPic.GrName := Copy(Input, 8, 255) + '.png';
|
|---|
| 636 | HGr := GrExt.SearchByName(TestPic.GrName);
|
|---|
| 637 | end
|
|---|
| 638 | else if (Input <> '') and (Input[1] = '#') then
|
|---|
| 639 | Ok := False
|
|---|
| 640 | else if Ok then
|
|---|
| 641 | Check;
|
|---|
| 642 | end;
|
|---|
| 643 | Result := True;
|
|---|
| 644 | end;
|
|---|
| 645 |
|
|---|
| 646 | end.
|
|---|
