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