tribes.pas

类似文明的游戏源代码。

{$INCLUDE switches}

unit Tribes;

interface

uses
  ScreenTools,

  Classes,Graphics,SysUtils;

type
TCityPicture=record
  xShield,yShield,xf,yf:integer;
  end;
TModelPicture=record
  HGr,pix,xShield,yShield:integer;
  end;
TModelPictureInfo=record
  trix,mix,pix,Hash: integer;
  GrName: ShortString
  end;

TTribe=class
  symHGr, sympix, faceHGr, facepix, cHGr, cpix, //symbol and city graphics
  cAge, mixSlaves: integer;
  Color: TColor;
  NumberName: integer;
  CityPicture: array[0..3] of TCityPicture;
  ModelPicture: array[-1..256] of TModelPicture; // -1 is building site
  ModelName: array[-1..256] of string;
  constructor Create(FileName: string);
  destructor Destroy; override;
  function GetCityName(i: integer): string;
  procedure SetCityName(i: integer; NewName: string);
  function TPhrase(Item: string): string;
  procedure SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean);
  procedure ChooseModelPicture(var Picture: TModelPictureInfo;
    code,Turn: integer; var ForceNew: boolean);
  procedure InitAge(Age: integer);
  procedure InitAgeTextures(var OuterTex,InnerTex: TTexture; Age: integer);
protected
  CityLine0,nCityLines: integer;
  Name: array['a'..'z'] of string;
  Script: tstringlist;
  procedure FindPosition(HGr,x,y: integer; Mark: TColor; var xp,yp: integer);
  end;

var
HGrStdUnits: integer;

procedure Init;
procedure Done;
procedure FindStdModelPicture(code: integer; var pix: integer;
  var Name: string);
function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): boolean;


implementation

const
maxStdUnits=180;

function HexStringToColor(s: string): integer;

  function HexCharToInt(x: char): integer;
  begin
  case x of
    '0'..'9': result:=ord(x)-48;
    'A'..'F': result:=ord(x)-65+10;
    'a'..'f': result:=ord(x)-97+10;
    else result:=0
    end
  end;

begin
while (Length(s)>0) and (s[1]=' ') do Delete(s,1,1);
s:=s+'000000';
result:=$10*HexCharToInt(s[1])+$1*HexCharToInt(s[2])
  +$1000*HexCharToInt(s[3])+$100*HexCharToInt(s[4])
  +$100000*HexCharToInt(s[5])+$10000*HexCharToInt(s[6]);
end;

var
StdUnitScript: tstringlist;
StdUnitHash: array[0..maxStdUnits-1] of integer;

procedure Init;
begin
StdUnitScript:=tstringlist.Create;
StdUnitScript.LoadFromFile(HomeDir+'Tribes\StdUnits.txt');
FillChar(StdUnitHash,SizeOf(StdUnitHash),0);
end;

procedure Done;
begin
StdUnitScript.Free;
end;

var
Input: string;

function Get: string;
var
p:integer;
begin
while (Input<>'') and ((Input[1]=' ') or (Input[1]=#9)) do Delete(Input,1,1);
p:=pos(',',Input);if p=0 then p:=Length(Input)+1;
result:=Copy(Input,1,p-1);
Delete(Input,1,p)
end;

function GetNum: integer;
var
i:integer;
begin
val(Get,result,i);
if i<>0 then result:=0
end;

procedure FindStdModelPicture(code: integer; var pix: integer;
  var Name: string);
var
i: integer;
begin
for i:=0 to StdUnitScript.Count-1 do
  begin // look through StdUnits
  Input:=StdUnitScript[i];
  pix:=GetNum;
  if code=GetNum then begin Name:=Get; exit; end
  end;
pix:=-1
end;

function GetTribeInfo(FileName: string; var Name: string; var Color: TColor): boolean;
var
found: integer;
TribeScript: TextFile;
begin
Name:='';
Color:=$FFFFFF;
found:=0;
AssignFile(TribeScript,HomeDir+'Tribes\'+FileName+'.tribe.txt');
Reset(TribeScript);
while not EOF(TribeScript) do
  begin
  ReadLn(TribeScript,Input);
  if Copy(Input,1,7)='#CHOOSE' then
    begin
    Name:=Copy(Input,9,255);
    found:=found or 1;
    if found=3 then break
    end
  else if Copy(Input,1,6)='#COLOR' then
    begin
    Color:=HexStringToColor(Copy(Input,7,255));
    found:=found or 2;
    if found=3 then break
    end
  end;
CloseFile(TribeScript);
result:= found=3;
end;

constructor TTribe.Create(FileName: string);
var
line:integer;
variant: char;
Item:string;
begin
inherited Create;
for variant:='a' to 'z' do Name[variant]:='';
Script:=tstringlist.Create;
Script.LoadFromFile(HomeDir+'Tribes\'+FileName+'.tribe.txt');
CityLine0:=0;
nCityLines:=0;
for line:=0 to Script.Count-1 do
  begin
  Input:=Script[line];
  if (CityLine0>0) and (nCityLines=0) and ((Input='') or (Input[1]='#')) then
    nCityLines:=line-CityLine0;
  if (Length(Input)>=3) and (Input[1]='#') and (Input[2] in ['a'..'z'])
    and (Input[3]=' ') then
    Name[Input[2]]:=Copy(Input,4,255)
  else if Copy(Input,1,6)='#COLOR' then
    Color:=HexStringToColor(Copy(Input,7,255))
  else if Copy(Input,1,7)='#CITIES' then CityLine0:=line+1
  else if Copy(Input,1,8)='#SYMBOLS' then
    begin
    Delete(Input,1,9);
    Item:=Get;
    sympix:=GetNum;
    symHGr:=LoadGraphicSet(Item);
    end
  end;
FillChar(ModelPicture,SizeOf(ModelPicture),0);
NumberName:=-1;
cAge:=-1;
mixSlaves:=-1;
end;

destructor TTribe.Destroy;
begin
Script.Free;
inherited Destroy;
end;

procedure TTribe.FindPosition(HGr,x,y: integer; Mark: TColor;
  var xp,yp: integer);
begin
xp:=0;
while (xp<63) and (GrExt[HGr].Data.Canvas.Pixels[x+1+xp,y]<>Mark) do
  inc(xp);
yp:=0;
while (yp<47) and (GrExt[HGr].Data.Canvas.Pixels[x,y+1+yp]<>Mark) do
  inc(yp);
end;

function TTribe.GetCityName(i: integer): string;
begin
if nCityLines>i then
  begin
  result:=Script[CityLine0+i];
  while (result<>'') and ((result[1]=' ') or (result[1]=#9)) do
    Delete(result,1,1);
  end
else result:=Format(TPhrase('GENCITY'),[i+1])
end;

procedure TTribe.SetCityName(i: integer; NewName: string);
begin
while nCityLines<=i do
  begin
  Script.Insert(CityLine0+nCityLines, Format(TPhrase('GENCITY'),
    [nCityLines+1]));
  inc(nCityLines);
  end;
Script[CityLine0+i]:=NewName;
end;

function TTribe.TPhrase(Item: string): string;
var
p: integer;
s: string;
variant: char;
CaseUp: boolean;
begin
s:=Phrases.Lookup(Item);
repeat
  p:=pos('#',s);
  if (p=0) or (p=Length(s)) then Break;
  variant:=s[p+1];
  CaseUp:= variant in ['A'..'Z'];
  if CaseUp then inc(variant,32);
  Delete(s,p,2);
  if variant in ['a'..'z'] then
    begin
    if NumberName<0 then Insert(Name[variant],s,p)
    else Insert(Format('P%d',[NumberName]),s,p);
    if CaseUp and (Length(s)>=p) and (s[p] in ['a'..'z',#$E0..#$FF]) then
      dec(s[p],32);
    end
until false;
result:=s;
end;

procedure TTribe.InitAge(Age: integer);
const
gray=$C0C0C0;
type
TLine=array[0..649,0..2] of Byte;
var
i,x,y,r,g,b: integer;
Item: string;
TemplateLine, TribeLine: ^TLine;
begin
if Age=cAge then exit;
cAge:=Age;
with Script do
  begin
  i:=0;
  while (i<Count) and (Copy(Strings[i],1,6)<>'#AGE'+char(48+Age)+' ') do
    inc(i);
  if i<Count then
    begin
    Input:=Strings[i];
    system.Delete(Input,1,6);
    Item:=Get;
    cpix:=GetNum;
    // init city graphics
    cHGr:=LoadGraphicSet(Item);
    for x:=0 to 3 do with CityPicture[x] do
      begin
      FindPosition(cHGr,x*65,cpix*49,$00FFFF,xShield,yShield);
      FindPosition(cHGr,x*65,cpix*49,$FFFFFF,xf,yf);
      end;
    Get;
    GetNum;
    Item:=Get;
    if Item='' then faceHGr:=-1
    else
      begin
      faceHGr:=LoadGraphicSet(Item);
      facepix:=GetNum;
      if (TrueColor=1)
        and (GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10*65,facepix div 10*49+48]=$00FFFF) then
        begin // generate shield picture
        GrExt[faceHGr].Data.Canvas.Pixels[facepix mod 10*65,facepix div 10*49+48]:=$000000;
        for y:=0 to 47 do
          begin
          TemplateLine:=GrExt[HGrSystem2].Data.ScanLine[62+y];
          TribeLine:=GrExt[faceHGr].Data.ScanLine[facepix div 10*49+1+y];
          for x:=0 to 63 do
            begin
            b:=TemplateLine[115+x,2]*(Color shr 16 and $FF) div 255
              +TemplateLine[115+x,1]*(gray shr 16 and $FF) div 255
              +TemplateLine[115+x,0]*TribeLine[facepix mod 10*65+1+x,0] div 255;
            g:=TemplateLine[115+x,2]*(Color shr 8 and $FF) div 255
              +TemplateLine[115+x,1]*(gray shr 8 and $FF) div 255
              +TemplateLine[115+x,0]*TribeLine[facepix mod 10*65+1+x,1] div 255;
            r:=TemplateLine[115+x,2]*(Color and $FF) div 255
              +TemplateLine[115+x,1]*(gray and $FF) div 255
              +TemplateLine[115+x,0]*TribeLine[facepix mod 10*65+1+x,2] div 255;
            TribeLine[facepix mod 10*65+1+x,0]:=b;
            TribeLine[facepix mod 10*65+1+x,1]:=g;
            TribeLine[facepix mod 10*65+1+x,2]:=r;
            end
          end;
        end
      end;
    end
  end
end;

procedure TTribe.InitAgeTextures(var OuterTex,InnerTex: TTexture; Age: integer);
var
i, Texpix: integer;
TexFileName: string;
begin
with Script do
  begin
  i:=0;
  while (i<Count) and (Copy(Strings[i],1,6)<>'#AGE'+char(48+Age)+' ') do
    inc(i);
  if i<Count then
    begin
    Input:=Strings[i];
    system.Delete(Input,1,6);
    Get;
    Get;
    TexFileName:=Get;
    Texpix:=GetNum;
    InitTexture(OuterTex,TexFileName,Texpix);
    InitTexture(InnerTex,TexFileName,Texpix+1);
    InitCityMark(OuterTex);
    end
  end
end;

procedure TTribe.SetModelPicture(const Info: TModelPictureInfo; IsNew: boolean);
var
i: integer;
ok: boolean;
begin
with Info do
  begin
  with ModelPicture[mix] do
    begin
    HGr:=LoadGraphicSet(GrName);
    pix:=Info.pix;
    FindPosition(HGr,pix mod 10 *65,pix div 10 *49,$FFFFFF,xShield,yShield);
    if IsNew then inc(GrExt[HGr].pixUsed[pix]);
    end;
  ModelName[mix]:='';

  if Hash<>0 then
    begin // read model name from StdUnits.txt
    StdUnitHash[pix]:=Hash;
    for i:=0 to StdUnitScript.Count-1 do
      begin
      Input:=StdUnitScript[i];
      if GetNum=pix then
        begin Get; ModelName[mix]:=Get end
      end
    end
  else
    begin // read model name from tribe script
    ok:=false;
    for i:=0 to Script.Count-1 do
      begin
      Input:=Script[i];
      if Input='#UNITS '+GrName then ok:=true
      else if (Input<>'') and (Input[1]='#') then ok:=false
      else if ok and (GetNum=pix) then
        begin Get; ModelName[mix]:=Get end
      end;
    end
  end;
end;

procedure TTribe.ChooseModelPicture(var Picture: TModelPictureInfo;
  code,Turn: integer; var ForceNew: boolean);
var
i,Cnt,HGr,used,LeastUsed: integer;
TestPic: TModelPictureInfo;
ok: boolean;

  procedure check;
  begin
  TestPic.pix:=GetNum;
  if code=GetNum then
    begin
    if HGr<0 then used:=0
    else used:=3*GrExt[HGr].pixUsed[TestPic.pix];
    if HGr=HGrStdUnits then
      if (TestPic.Hash>0) and (StdUnitHash[TestPic.pix]=TestPic.Hash) then
        // class with same properties and standard picture already exists
        // -- use the same picture
        if ForceNew then used:=1 else used:=-1
      else inc(used,2); // prefer units not from StdUnits
    if used<LeastUsed then begin Cnt:=0; LeastUsed:=used end;
    if used=LeastUsed then
      begin
      inc(Cnt);
      if Turn mod Cnt=0 then Picture:=TestPic
      end;
    end
  end;

begin
Picture.pix:=0;
TestPic:=Picture;
LeastUsed:=MaxInt;

TestPic.GrName:='StdUnits';
HGr:=HGrStdUnits;
for i:=0 to StdUnitScript.Count-1 do
  begin // look through StdUnits
  Input:=StdUnitScript[i];
  check;
  end;

TestPic.Hash:=0;
ok:=false;
for i:=0 to Script.Count-1 do
  begin // look through units defined in tribe script
  Input:=Script[i];
  if Copy(Input,1,6)='#UNITS' then
    begin
    ok:=true;
    TestPic.GrName:=Copy(Input,8,255);
    HGr:=nGrExt-1;
    while (HGr>=0) and (GrExt[HGr].Name<>TestPic.GrName) do dec(HGr);
    end
  else if (Input<>'') and (Input[1]='#') then ok:=false
  else if ok then check;
  end;
ForceNew:= LeastUsed>=0;
end;

end.