Changeset 300 for trunk/LocalPlayer


Ignore:
Timestamp:
Mar 8, 2021, 9:23:32 PM (4 years ago)
Author:
chronos
Message:
  • Modified: Code cleanup.
Location:
trunk/LocalPlayer
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • trunk/LocalPlayer/Tribes.pas

    r290 r300  
    55
    66uses
    7   Protocol, ScreenTools, LazFileUtils,
    8   Classes, Graphics, SysUtils;
     7  Protocol, ScreenTools, LazFileUtils, Classes, Graphics, SysUtils;
    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}
    3951    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);
     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
     75
     76implementation
     77
     78uses
     79  Directories;
     80
     81type
     82  TChosenModelPictureInfo = record
     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;
     204    end;
     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;
     245    end;
     246  end;
     247  pix := -1;
     248end;
     249
    59250function GetTribeInfo(FileName: string; var Name: string;
    60251  var Color: TColor): boolean;
    61 procedure FindPosition(HGr, x, y, xmax, ymax: integer; Mark: TColor;
    62   var xp, yp: integer);
    63 
    64 implementation
    65 
    66 uses
    67   Directories;
    68 
     252var
     253  Found: Integer;
     254  TribeScript: TextFile;
     255begin
     256  Name := '';
     257  Color := $FFFFFF;
     258  Found := 0;
     259  AssignFile(TribeScript, LocalizedFilePath('Tribes' + DirectorySeparator +
     260    FileName + '.tribe.txt'));
     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(LocalizedFilePath('Tribes' + DirectorySeparator +
     295    FileName + '.tribe.txt'));
     296  CityLine0 := 0;
     297  nCityLines := 0;
     298  for Line := 0 to Script.Count - 1 do
     299  begin
     300    Input := Script[Line];
     301    if (CityLine0 > 0) and (nCityLines = 0) and
     302      ((Input = '') or (Input[1] = '#')) then
     303      nCityLines := Line - CityLine0;
     304    if (Length(Input) >= 3) and (Input[1] = '#') and
     305      (Input[2] in ['a' .. 'z']) and (Input[3] = ' ') then
     306      Name[Input[2]] := Copy(Input, 4, 255)
     307    else if Copy(Input, 1, 6) = '#COLOR' then
     308      Color := HexStringToColor(Copy(Input, 7, 255))
     309    else if Copy(Input, 1, 7) = '#CITIES' then
     310      CityLine0 := Line + 1
     311    else if Copy(Input, 1, 8) = '#SYMBOLS' then
     312    begin
     313      Delete(Input, 1, 9);
     314      Item := Get;
     315      sympix := GetNum;
     316      symHGr := LoadGraphicSet(Item + '.png');
     317    end;
     318  end;
     319  FillChar(ModelPicture, SizeOf(ModelPicture), 0);
     320  NumberName := -1;
     321  cAge := -1;
     322  mixSlaves := -1;
     323end;
     324
     325destructor TTribe.Destroy;
     326begin
     327  FreeAndNil(Script);
     328  inherited;
     329end;
     330
     331procedure FindPosition(HGr, x, y, xmax, ymax: Integer; Mark: TColor;
     332  var xp, yp: Integer);
     333begin
     334  xp := 0;
     335  while (xp < xmax) and (GrExt[HGr].Data.Canvas.Pixels[x + 1 + xp, y] <> Mark) do
     336    Inc(xp);
     337  yp := 0;
     338  while (yp < ymax) and (GrExt[HGr].Data.Canvas.Pixels[x, y + 1 + yp] <> Mark) do
     339    Inc(yp);
     340end;
     341
     342function TTribe.GetCityName(i: Integer): string;
     343begin
     344  Result := '';
     345  if nCityLines > i then
     346  begin
     347    Result := Script[CityLine0 + i];
     348    while (Result <> '') and ((Result[1] = ' ') or (Result[1] = #9)) do
     349      Delete(Result, 1, 1);
     350  end
     351{$IFNDEF SCR}
     352  else
     353    Result := Format(TPhrase('GENCITY'), [i + 1]);
     354{$ENDIF}
     355end;
     356
     357{$IFNDEF SCR}
     358procedure TTribe.SetCityName(i: Integer; NewName: string);
     359begin
     360  while nCityLines <= i do
     361  begin
     362    Script.Insert(CityLine0 + nCityLines, Format(TPhrase('GENCITY'),
     363      [nCityLines + 1]));
     364    Inc(nCityLines);
     365  end;
     366  Script[CityLine0 + i] := NewName;
     367end;
     368
     369function TTribe.TString(Template: string): string;
     370var
     371  p: Integer;
     372  Variant: Char;
     373  CaseUp: Boolean;
     374begin
     375  repeat
     376    p := pos('#', Template);
     377    if (p = 0) or (p = Length(Template)) then
     378      Break;
     379    Variant := Template[p + 1];
     380    CaseUp := Variant in ['A' .. 'Z'];
     381    if CaseUp then
     382      Inc(Variant, 32);
     383    Delete(Template, p, 2);
     384    if Variant in ['a' .. 'z'] then
     385    begin
     386      if NumberName < 0 then
     387        Insert(Name[Variant], Template, p)
     388      else
     389        Insert(Format('P%d', [NumberName]), Template, p);
     390      if CaseUp and (Length(Template) >= p) and
     391        (Template[p] in ['a' .. 'z', #$E0 .. #$FF]) then
     392        Dec(Template[p], 32);
     393    end
     394  until False;
     395  Result := Template;
     396end;
     397
     398function TTribe.TPhrase(Item: string): string;
     399begin
     400  Result := TString(Phrases.Lookup(Item));
     401end;
     402
     403{$ENDIF}
     404
     405procedure TTribe.InitAge(Age: Integer);
    69406type
    70   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;
    87     end;
    88 
    89     procedure Done;
    90     begin
    91       ReallocMem(PictureList, 0);
    92       FreeAndNil(StdUnitScript);
    93     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])
    99       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     FreeAndNil(Script);
    316     inherited;
    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);
    340     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;
    391 {$ENDIF}
    392 
    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);
     407  TLine = array [0 .. 649, 0 .. 2] of Byte;
     408var
     409  i, x, Gray: Integer;
     410  Item: string;
     411begin
     412  if Age = cAge then
     413    Exit;
     414  cAge := Age;
     415  with Script do
     416  begin
     417    i := 0;
     418    while (i < Count) and (Copy(Strings[i], 1, 6) <>
     419        '#AGE' + char(48 + Age) + ' ') do
     420      Inc(i);
     421    if i < Count then
     422    begin
     423      Input := Strings[i];
     424      system.Delete(Input, 1, 6);
     425      Item := Get;
     426      cpix := GetNum;
     427      // init city graphics
     428      if Age < 2 then
     429      begin
     430        if CompareText(Item, 'stdcities') = 0 then
     431          case cpix of
     432            3:
     433              cpix := 0;
     434            6:
     435            begin
     436              cpix := 0;
     437              Item := 'Nation2';
    459438            end
    460439          end;
     440        cHGr := LoadGraphicSet(Item + '.png');
     441        for x := 0 to 3 do
     442          with CityPicture[x] do
     443          begin
     444            FindPosition(cHGr, x * 65, cpix * 49, 63, 47, $00FFFF,
     445              xShield, yShield);
     446            // FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf);
     447          end;
     448      end
     449      else
     450        cHGr := -1;
     451
     452{$IFNDEF SCR}
     453      Get;
     454      GetNum;
     455      Item := Get;
     456      if Item = '' then
     457        faceHGr := -1
     458      else
     459      begin
     460        faceHGr := LoadGraphicSet(Item + '.png');
     461        facepix := GetNum;
     462        if GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65,
     463          facepix div 10 * 49 + 48] = $00FFFF then
     464        begin // generate shield picture
     465          GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10 * 65,
     466            facepix div 10 * 49 + 48] := $000000;
     467          Gray := $B8B8B8;
     468          ImageOp_BCC(GrExt[faceHGr].Data, Templates,
     469            facepix mod 10 * 65 + 1, facepix div 10 * 49 + 1, 1, 25, 64, 48,
     470            Gray, Color);
     471        end;
     472      end;
    461473{$ENDIF}
    462         end
    463       end
    464474    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
     475  end;
     476end;
     477
     478procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean);
     479var
     480  i: Integer;
     481  ok: Boolean;
     482begin
     483  with Info do
     484  begin
     485    if not IsNew then
     486    begin
     487      i := nPictureList - 1;
     488      while (i >= 0) and (PictureList[i].Hash <> Info.Hash) do
     489        Dec(i);
     490      assert(i >= 0);
     491      assert(PictureList[i].HGr = LoadGraphicSet(GrName));
     492      assert(PictureList[i].pix = pix);
     493      ModelPicture[mix].HGr := PictureList[i].HGr;
     494      ModelPicture[mix].pix := PictureList[i].pix;
     495      ModelName[mix] := PictureList[i].ModelName;
     496    end
     497    else
     498    begin
     499      with ModelPicture[mix] do
     500      begin
     501        HGr := LoadGraphicSet(GrName);
     502        pix := Info.pix;
     503        Inc(GrExt[HGr].pixUsed[pix]);
     504      end;
     505      ModelName[mix] := '';
     506
     507      // read model name from tribe script
     508      ok := False;
     509      for i := 0 to Script.Count - 1 do
     510      begin
     511        Input := Script[i];
     512        if Input = '#UNITS ' + ExtractFileNameOnly(GrName) then
     513          ok := True
     514        else if (Input <> '') and (Input[1] = '#') then
     515          ok := False
     516        else if ok and (GetNum = pix) then
    475517        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
     518          Get;
     519          ModelName[mix] := Get;
     520        end;
     521      end;
     522
     523      if ModelName[mix] = '' then
     524      begin // read model name from StdUnits.txt
     525        for i := 0 to StdUnitScript.Count - 1 do
    487526        begin
    488           with ModelPicture[mix] do
     527          Input := StdUnitScript[i];
     528          if GetNum = pix then
    489529          begin
    490             HGr := LoadGraphicSet(GrName);
    491             pix := Info.pix;
    492             inc(GrExt[HGr].pixUsed[pix]);
     530            Get;
     531            ModelName[mix] := Get;
    493532          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
    539533        end;
    540 
    541         with ModelPicture[mix] do
    542           FindPosition(HGr, pix mod 10 * 65, pix div 10 * 49, 63, 47, $FFFFFF,
    543             xShield, yShield);
     534      end;
     535
     536      if Hash <> 0 then
     537      begin
     538        if nPictureList = 0 then
     539          ReallocMem(PictureList, 64 * SizeOf(TChosenModelPictureInfo))
     540        else if (nPictureList >= 64) and (nPictureList and
     541          (nPictureList - 1) = 0) then
     542          ReallocMem(PictureList,
     543            nPictureList * (2 * SizeOf(TChosenModelPictureInfo)));
     544        PictureList[nPictureList].Hash := Info.Hash;
     545        PictureList[nPictureList].HGr := ModelPicture[mix].HGr;
     546        PictureList[nPictureList].pix := Info.pix;
     547        PictureList[nPictureList].ModelName := ModelName[mix];
     548        Inc(nPictureList);
    544549      end;
    545550    end;
    546551
    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;
     552    with ModelPicture[mix] do
     553      FindPosition(HGr, pix mod 10 * 65, pix div 10 * 49, 63, 47, $FFFFFF,
     554        xShield, yShield);
     555  end;
     556end;
     557
     558function TTribe.ChooseModelPicture(var Picture: TModelPictureInfo;
     559  Code, Turn: Integer; ForceNew: Boolean): Boolean;
     560var
     561  i, Cnt, HGr, Used, LeastUsed: Integer;
     562  TestPic: TModelPictureInfo;
     563  ok: Boolean;
     564
     565  procedure Check;
     566  begin
     567    TestPic.pix := GetNum;
     568    if Code = GetNum then
     569    begin
     570      if ForceNew or (HGr < 0) then
     571        Used := 0
     572      else
     573      begin
     574        Used := 4 * GrExt[HGr].pixUsed[TestPic.pix];
     575        if HGr = HGrStdUnits then
     576          Inc(Used, 2); // prefer units not from StdUnits
     577      end;
     578      if Used < LeastUsed then
     579      begin
     580        Cnt := 0;
     581        LeastUsed := Used;
     582      end;
     583      if Used = LeastUsed then
     584      begin
     585        Inc(Cnt);
     586        if Turn mod Cnt = 0 then
     587          Picture := TestPic;
     588      end;
    625589    end;
     590  end;
     591
     592begin
     593  // look for identical model to assign same picture again
     594  if not ForceNew and (Picture.Hash > 0) then
     595  begin
     596    for i := 0 to nPictureList - 1 do
     597      if PictureList[i].Hash = Picture.Hash then
     598      begin
     599        Picture.GrName := GrExt[PictureList[i].HGr].Name;
     600        Picture.pix := PictureList[i].pix;
     601        Result := False;
     602        Exit;
     603      end;
     604  end;
     605
     606  Picture.pix := 0;
     607  TestPic := Picture;
     608  LeastUsed := MaxInt;
     609
     610  TestPic.GrName := 'StdUnits.png';
     611  HGr := HGrStdUnits;
     612  for i := 0 to StdUnitScript.Count - 1 do
     613  begin // look through StdUnits
     614    Input := StdUnitScript[i];
     615    Check;
     616  end;
     617
     618  ok := False;
     619  for i := 0 to Script.Count - 1 do
     620  begin // look through units defined in tribe script
     621    Input := Script[i];
     622    if Copy(Input, 1, 6) = '#UNITS' then
     623    begin
     624      ok := True;
     625      TestPic.GrName := Copy(Input, 8, 255) + '.png';
     626      HGr := nGrExt - 1;
     627      while (HGr >= 0) and (GrExt[HGr].Name <> TestPic.GrName) do
     628        Dec(HGr);
     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;
     636end;
    626637
    627638end.

  • trunk/LocalPlayer/UnitStat.pas

    r295 r300  
    277277procedure TUnitStatDlg.CloseBtnClick(Sender: TObject);
    278278begin
    279   Close
     279  Close;
    280280end;
    281281
    … …  
    364364            inc(dx, 15)
    365365          end;
    366         end
    367       end
     366        end;
     367      end;
    368368  end; { featurebar }
    369369
Note: See TracChangeset for help on using the changeset viewer.