source: tags/1.3.0/LocalPlayer/Tribes.pas

Last change on this file was 315, checked in by chronos, 3 years ago
  • Fixed: Gamma was incorrectly applied to images with transparency colors.
  • Modified: Change Templates to GraphicSet so it can also have description of its items.
  • Modified: Use TextExtent instead of both TextWidth and TextHeight.
File size: 16.3 KB
Line 
1{$INCLUDE Switches.inc}
2unit Tribes;
3
4interface
5
6uses
7 Protocol, ScreenTools, LazFileUtils, Classes, Graphics, SysUtils, Global,
8 UGraphicSet;
9
10type
11 TCityPicture = record
12 xShield: Integer;
13 yShield: Integer;
14 end;
15
16 TModelPicture = record
17 HGr: TGraphicSet;
18 pix: Integer;
19 xShield: Integer;
20 yShield: Integer;
21 end;
22
23 TModelPictureInfo = record
24 trix: Integer;
25 mix: Integer;
26 pix: Integer;
27 Hash: Integer;
28 GrName: ShortString;
29 end;
30
31 TTribe = class
32 symHGr: TGraphicSet;
33 sympix: Integer;
34 faceHGr: TGraphicSet;
35 facepix: Integer;
36 cHGr: TGraphicSet;
37 cpix: Integer;
38 // symbol and city graphics
39 cAge: Integer;
40 mixSlaves: Integer;
41 Color: TColor;
42 NumberName: Integer;
43 CityPicture: array [0 .. 3] of TCityPicture;
44 ModelPicture: array [-1 .. 256] of TModelPicture; // -1 is building site
45 ModelName: array [-1 .. 256] of string;
46 constructor Create(FileName: string);
47 destructor Destroy; override;
48 function GetCityName(i: Integer): string;
49{$IFNDEF SCR} procedure SetCityName(i: Integer; NewName: string); {$ENDIF}
50{$IFNDEF SCR} function TString(Template: string): string;
51 function TPhrase(Item: string): string; {$ENDIF}
52 procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: Boolean);
53 function ChooseModelPicture(var Picture: TModelPictureInfo;
54 Code, Turn: Integer; ForceNew: Boolean): Boolean;
55 procedure InitAge(Age: Integer);
56 protected
57 CityLine0: Integer;
58 nCityLines: Integer;
59 Name: array ['a' .. 'z'] of string;
60 Script: TStringList;
61 end;
62
63var
64 Tribe: array [0 .. nPl - 1] of TTribe;
65 HGrStdUnits: TGraphicSet;
66
67procedure Init;
68procedure Done;
69function CityName(Founder: Integer): string;
70function ModelCode(const ModelInfo: TModelInfo): Integer;
71procedure FindStdModelPicture(Code: Integer; var pix: Integer; var Name: string);
72function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): Boolean;
73procedure FindPosition(HGr: TGraphicSet; x, y, xmax, ymax: Integer; Mark: TColor;
74 var xp, yp: Integer);
75
76
77implementation
78
79uses
80 Directories;
81
82type
83 TChosenModelPictureInfo = record
84 Hash: Integer;
85 HGr: TGraphicSet;
86 pix: Integer;
87 ModelName: ShortString;
88 end;
89
90 TPictureList = array [0 .. 99999] of TChosenModelPictureInfo;
91
92var
93 StdUnitScript: TStringList;
94 PictureList: ^TPictureList;
95 nPictureList: Integer;
96
97procedure Init;
98begin
99 StdUnitScript := TStringList.Create;
100 StdUnitScript.LoadFromFile(LocalizedFilePath('Tribes' +
101 DirectorySeparator + 'StdUnits.txt'));
102 nPictureList := 0;
103 PictureList := nil;
104end;
105
106procedure Done;
107begin
108 ReallocMem(PictureList, 0);
109 FreeAndNil(StdUnitScript);
110end;
111
112function CityName(Founder: Integer): string;
113begin
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);
118end;
119
120function ModelCode(const ModelInfo: TModelInfo): Integer;
121begin
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;
207end;
208
209var
210 Input: string;
211
212function Get: string;
213var
214 p: Integer;
215begin
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);
223end;
224
225function GetNum: Integer;
226var
227 i: Integer;
228begin
229 Val(Get, Result, i);
230 if i <> 0 then
231 Result := 0;
232end;
233
234procedure FindStdModelPicture(Code: Integer; var pix: Integer; var Name: string);
235var
236 i: Integer;
237begin
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;
249end;
250
251function GetTribeInfo(FileName: string; var Name: string;
252 var Color: TColor): Boolean;
253var
254 Found: Integer;
255 TribeScript: TextFile;
256begin
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;
283end;
284
285constructor TTribe.Create(FileName: string);
286var
287 Line: Integer;
288 Variant: Char;
289 Item: string;
290begin
291 inherited Create;
292 for Variant := 'a' to 'z' do
293 Name[Variant] := '';
294 Script := TStringList.Create;
295 Script.LoadFromFile(FileName);
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: TGraphicSet; x, y, xmax, ymax: Integer; Mark: TColor;
332 var xp, yp: Integer);
333begin
334 xp := 0;
335 while (xp < xmax) and (HGr.Data.Canvas.Pixels[x + 1 + xp, y] <> Mark) do
336 Inc(xp);
337 yp := 0;
338 while (yp < ymax) and (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);
406type
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';
438 end
439 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 := nil;
451
452{$IFNDEF SCR}
453 Get;
454 GetNum;
455 Item := Get;
456 if Item = '' then
457 faceHGr := nil
458 else
459 begin
460 faceHGr := LoadGraphicSet(Item + '.png');
461 facepix := GetNum;
462 if faceHGr.Data.Canvas.Pixels[facepix mod 10 * 65,
463 facepix div 10 * 49 + 48] = $00FFFF then
464 begin // generate shield picture
465 faceHGr.Data.Canvas.Pixels[facepix mod 10 * 65,
466 facepix div 10 * 49 + 48] := $000000;
467 Gray := $B8B8B8;
468 ImageOp_BCC(faceHGr.Data, Templates.Data,
469 facepix mod 10 * 65 + 1, facepix div 10 * 49 + 1, 1, 25, 64, 48,
470 Gray, Color);
471 end;
472 end;
473{$ENDIF}
474 end;
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(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
517 begin
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
526 begin
527 Input := StdUnitScript[i];
528 if GetNum = pix then
529 begin
530 Get;
531 ModelName[mix] := Get;
532 end;
533 end;
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);
549 end;
550 end;
551
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: Integer;
562 Cnt: Integer;
563 HGr: TGraphicSet;
564 Used: Integer;
565 LeastUsed: Integer;
566 TestPic: TModelPictureInfo;
567 ok: Boolean;
568
569 procedure Check;
570 begin
571 TestPic.pix := GetNum;
572 if Code = GetNum then
573 begin
574 if ForceNew or (not Assigned(HGr)) then
575 Used := 0
576 else
577 begin
578 Used := 4 * HGr.pixUsed[TestPic.pix];
579 if HGr = HGrStdUnits then
580 Inc(Used, 2); // prefer units not from StdUnits
581 end;
582 if Used < LeastUsed then
583 begin
584 Cnt := 0;
585 LeastUsed := Used;
586 end;
587 if Used = LeastUsed then
588 begin
589 Inc(Cnt);
590 if Turn mod Cnt = 0 then
591 Picture := TestPic;
592 end;
593 end;
594 end;
595
596begin
597 // look for identical model to assign same picture again
598 if not ForceNew and (Picture.Hash > 0) then
599 begin
600 for i := 0 to nPictureList - 1 do
601 if PictureList[i].Hash = Picture.Hash then
602 begin
603 Picture.GrName := PictureList[i].HGr.Name;
604 Picture.pix := PictureList[i].pix;
605 Result := False;
606 Exit;
607 end;
608 end;
609
610 Picture.pix := 0;
611 TestPic := Picture;
612 LeastUsed := MaxInt;
613
614 TestPic.GrName := 'StdUnits.png';
615 HGr := HGrStdUnits;
616 for i := 0 to StdUnitScript.Count - 1 do
617 begin // look through StdUnits
618 Input := StdUnitScript[i];
619 Check;
620 end;
621
622 ok := False;
623 for i := 0 to Script.Count - 1 do
624 begin // look through units defined in tribe script
625 Input := Script[i];
626 if Copy(Input, 1, 6) = '#UNITS' then
627 begin
628 ok := True;
629 TestPic.GrName := Copy(Input, 8, 255) + '.png';
630 HGr := GrExt.SearchByName(TestPic.GrName);
631 end
632 else if (Input <> '') and (Input[1] = '#') then
633 ok := False
634 else if ok then
635 Check;
636 end;
637 Result := True;
638end;
639
640end.
Note: See TracBrowser for help on using the repository browser.