source: tags/1.3.1/LocalPlayer/Tribes.pas

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