Ignore:
Timestamp:
Mar 9, 2021, 9:19:49 AM (4 years ago)
Author:
chronos
Message:
  • Modified: Synced code with current trunk version.
File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/highdpi/LocalPlayer/Tribes.pas

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