Changeset 300
- Timestamp:
- Mar 8, 2021, 9:23:32 PM (4 years ago)
- Location:
- trunk
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/LocalPlayer/Tribes.pas
r290 r300 5 5 6 6 uses 7 Protocol, ScreenTools, LazFileUtils, 8 Classes, Graphics, SysUtils; 7 Protocol, ScreenTools, LazFileUtils, Classes, Graphics, SysUtils; 9 8 10 9 type 11 10 TCityPicture = record 12 xShield, yShield: integer; 11 xShield: Integer; 12 yShield: Integer; 13 13 end; 14 14 15 15 TModelPicture = record 16 HGr, pix, xShield, yShield: integer; 16 HGr: Integer; 17 pix: Integer; 18 xShield: Integer; 19 yShield: Integer; 17 20 end; 18 21 19 22 TModelPictureInfo = record 20 trix, mix, pix, Hash: integer; 23 trix: Integer; 24 mix: Integer; 25 pix: Integer; 26 Hash: Integer; 21 27 GrName: ShortString; 22 28 end; 23 29 24 30 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; 26 37 // symbol and city graphics 27 cAge, mixSlaves: integer; 38 cAge: Integer; 39 mixSlaves: Integer; 28 40 Color: TColor; 29 NumberName: integer;41 NumberName: Integer; 30 42 CityPicture: array [0 .. 3] of TCityPicture; 31 43 ModelPicture: array [-1 .. 256] of TModelPicture; // -1 is building site … … 33 45 constructor Create(FileName: string); 34 46 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} 37 49 {$IFNDEF SCR} function TString(Template: string): string; 38 50 function TPhrase(Item: string): string; {$ENDIF} 39 51 procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean); 40 52 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); 43 55 protected 44 CityLine0, nCityLines: integer; 56 CityLine0: Integer; 57 nCityLines: Integer; 45 58 Name: array ['a' .. 'z'] of string; 46 Script: tstringlist;59 Script: TStringList; 47 60 end; 48 61 49 62 var 50 63 Tribe: array [0 .. nPl - 1] of TTribe; 51 HGrStdUnits: integer;64 HGrStdUnits: Integer; 52 65 53 66 procedure Init; 54 67 procedure 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); 68 function CityName(Founder: Integer): string; 69 function ModelCode(const ModelInfo: TModelInfo): Integer; 70 procedure FindStdModelPicture(code: Integer; var pix: Integer; var Name: string); 71 function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): boolean; 72 procedure FindPosition(HGr, x, y, xmax, ymax: Integer; Mark: TColor; 73 var xp, yp: Integer); 74 75 76 implementation 77 78 uses 79 Directories; 80 81 type 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 91 var 92 StdUnitScript: TStringList; 93 PictureList: ^TPictureList; 94 nPictureList: Integer; 95 96 procedure Init; 97 begin 98 StdUnitScript := TStringList.Create; 99 StdUnitScript.LoadFromFile(LocalizedFilePath('Tribes' + 100 DirectorySeparator + 'StdUnits.txt')); 101 nPictureList := 0; 102 PictureList := nil; 103 end; 104 105 procedure Done; 106 begin 107 ReallocMem(PictureList, 0); 108 FreeAndNil(StdUnitScript); 109 end; 110 111 function CityName(Founder: Integer): string; 112 begin 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); 117 end; 118 119 function ModelCode(const ModelInfo: TModelInfo): Integer; 120 begin 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; 206 end; 207 208 var 209 Input: string; 210 211 function Get: string; 212 var 213 p: Integer; 214 begin 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); 222 end; 223 224 function GetNum: Integer; 225 var 226 i: Integer; 227 begin 228 Val(Get, Result, i); 229 if i <> 0 then 230 Result := 0; 231 end; 232 233 procedure FindStdModelPicture(code: Integer; var pix: Integer; var Name: string); 234 var 235 i: Integer; 236 begin 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; 248 end; 249 59 250 function GetTribeInfo(FileName: string; var Name: string; 60 251 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 252 var 253 Found: Integer; 254 TribeScript: TextFile; 255 begin 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; 282 end; 283 284 constructor TTribe.Create(FileName: string); 285 var 286 Line: Integer; 287 Variant: char; 288 Item: string; 289 begin 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; 323 end; 324 325 destructor TTribe.Destroy; 326 begin 327 FreeAndNil(Script); 328 inherited; 329 end; 330 331 procedure FindPosition(HGr, x, y, xmax, ymax: Integer; Mark: TColor; 332 var xp, yp: Integer); 333 begin 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); 340 end; 341 342 function TTribe.GetCityName(i: Integer): string; 343 begin 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} 355 end; 356 357 {$IFNDEF SCR} 358 procedure TTribe.SetCityName(i: Integer; NewName: string); 359 begin 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; 367 end; 368 369 function TTribe.TString(Template: string): string; 370 var 371 p: Integer; 372 Variant: Char; 373 CaseUp: Boolean; 374 begin 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; 396 end; 397 398 function TTribe.TPhrase(Item: string): string; 399 begin 400 Result := TString(Phrases.Lookup(Item)); 401 end; 402 403 {$ENDIF} 404 405 procedure TTribe.InitAge(Age: Integer); 69 406 type 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; 408 var 409 i, x, Gray: Integer; 410 Item: string; 411 begin 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'; 459 438 end 460 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 := -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; 461 473 {$ENDIF} 462 end463 end464 474 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; 476 end; 477 478 procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean); 479 var 480 i: Integer; 481 ok: Boolean; 482 begin 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 475 517 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 487 526 begin 488 with ModelPicture[mix] do 527 Input := StdUnitScript[i]; 528 if GetNum = pix then 489 529 begin 490 HGr := LoadGraphicSet(GrName); 491 pix := Info.pix; 492 inc(GrExt[HGr].pixUsed[pix]); 530 Get; 531 ModelName[mix] := Get; 493 532 end; 494 ModelName[mix] := '';495 496 // read model name from tribe script497 ok := false;498 for i := 0 to Script.Count - 1 do499 begin500 Input := Script[i];501 if Input = '#UNITS ' + ExtractFileNameOnly(GrName) then502 ok := true503 else if (Input <> '') and (Input[1] = '#') then504 ok := false505 else if ok and (GetNum = pix) then506 begin507 Get;508 ModelName[mix] := Get509 end510 end;511 512 if ModelName[mix] = '' then513 begin // read model name from StdUnits.txt514 for i := 0 to StdUnitScript.Count - 1 do515 begin516 Input := StdUnitScript[i];517 if GetNum = pix then518 begin519 Get;520 ModelName[mix] := Get521 end522 end523 end;524 525 if Hash <> 0 then526 begin527 if nPictureList = 0 then528 ReallocMem(PictureList, 64 * SizeOf(TChosenModelPictureInfo))529 else if (nPictureList >= 64) and530 (nPictureList and (nPictureList - 1) = 0) then531 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 end539 533 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); 544 549 end; 545 550 end; 546 551 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; 556 end; 557 558 function TTribe.ChooseModelPicture(var Picture: TModelPictureInfo; 559 Code, Turn: Integer; ForceNew: Boolean): Boolean; 560 var 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; 625 589 end; 590 end; 591 592 begin 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; 636 end; 626 637 627 638 end. -
trunk/LocalPlayer/UnitStat.pas
r295 r300 277 277 procedure TUnitStatDlg.CloseBtnClick(Sender: TObject); 278 278 begin 279 Close 279 Close; 280 280 end; 281 281 … … 364 364 inc(dx, 15) 365 365 end; 366 end 367 end 366 end; 367 end; 368 368 end; { featurebar } 369 369 -
trunk/Packages/CevoComponents/ScreenTools.pas
r296 r300 13 13 TTexture = record 14 14 Image: TBitmap; 15 clBevelLight, clBevelShade, clTextLight, clTextShade, clLitText, clMark, 16 clPage, clCover: TColor; 15 clBevelLight: TColor; 16 clBevelShade: TColor; 17 clTextLight: TColor; 18 clTextShade: TColor; 19 clLitText: TColor; 20 clMark: TColor; 21 clPage: TColor; 22 clCover: TColor; 17 23 end; 18 24 TLoadGraphicFileOption = (gfNoError, gfNoGamma); -
trunk/Packages/CevoComponents/StringTables.pas
r286 r300 22 22 function Search(const Content: string; var Handle, Index: integer): boolean; 23 23 end; 24 24 25 25 26 implementation … … 70 71 s: string; 71 72 begin 72 if Index < 0 then 73 if Index < 0 then begin 73 74 if Handle < 0 then begin 74 75 Result := ''; … … 86 87 end; 87 88 Result := S; 88 end else 89 if (Handle + Index + 1) >= Lines.Count then begin 90 Result := ''; 91 Exit; 92 end else Result := Lines[Handle + Index + 1]; 89 end; 90 end else 91 if (Handle + Index + 1) >= Lines.Count then begin 92 Result := ''; 93 Exit; 94 end else Result := Lines[Handle + Index + 1]; 93 95 while (Result <> '') and ((Result[1] = ' ') or (Result[1] = #9)) do 94 96 Delete(Result, 1, 1); … … 104 106 begin 105 107 Handle := GetHandle(Item); 106 if Handle >= 0 then 107 Result := LookupByHandle(Handle, Index) 108 else 109 Result := ''; 110 if Result = '' then 111 if Index < 0 then 112 Result := Format('[%s]', [Item]) 113 else 114 Result := Format('[%s %d]', [Item, Index]) 108 if Handle >= 0 then Result := LookupByHandle(Handle, Index) 109 else Result := ''; 110 if Result = '' then begin 111 if Index < 0 then Result := Format('[%s]', [Item]) 112 else Result := Format('[%s %d]', [Item, Index]); 113 end; 115 114 end; 116 115 … … 153 152 begin 154 153 result := false; 155 exit 154 exit; 156 155 end; 157 156 if Copy(Lines[h + i + 1], 1, 1) = '#' then 158 157 begin 159 158 h := h + i + 1; 160 i := -1 159 i := -1; 161 160 end; 162 161 if (h >= 0) and not ((Length(Lines[h + i + 1]) > 0) and (Lines[h + i + 1][1] in ['#', ':', ';'])) and
Note:
See TracChangeset
for help on using the changeset viewer.