source: tags/1.4.0/Building.pas

unit Building;

interface

uses
  Classes, SysUtils, ItemList;

type
  TBuildingSpecialType = (stNone, stCity);

  { TBuildingKind }

  TBuildingKind = class(TItem)
    Cost: Integer;
    SpecialType: TBuildingSpecialType;
    BonusAttack: Integer;
    BonusDefense: Integer;
    BonusViewRange: Integer;
    BonusGrow: Integer;
    class function GetFields: TItemFields; override;
    procedure GetValue(Index: Integer; out Value); override;
    procedure SetValue(Index: Integer; var Value); override;
    class function GetClassSysName: string; override;
    class function GetClassName: string; override;
  end;

  { TBuildingKinds }

  TBuildingKinds = class(TItemList<TBuildingKind>)
    function FindBySpecialType(SpecialType: TBuildingSpecialType): TBuildingKind;
  end;

  { TBuilding }

  TBuilding = class(TItem)
  private
    FMapCell: TObject;
    procedure SetMapCell(AValue: TObject);
  public
    Kind: TBuildingKind;
    Game: TObject; // TGame
    class function GetFields: TItemFields; override;
    procedure GetValue(Index: Integer; out Value); override;
    procedure SetValue(Index: Integer; var Value); override;
    function GetReferenceList(Index: Integer): TBaseItemList; override;
    procedure Assign(Source: TItem); override;
    property MapCell: TObject read FMapCell write SetMapCell; // TMapCell;
  end;

  { TBuildings }

  TBuildings = class(TItemList<TBuilding>)
    Game: TObject; // TGame;
    function CreateItem(Name: string = ''): TBuilding; override;
    procedure Assign(Source: TItemList<TBuilding>); override;
  end;

resourcestring
  SBuildingKind = 'Building';
  SCost = 'Cost';
  SSpecialType = 'Special type';
  SNone = 'None';
  SCity = 'City';
  SBonusAttack = 'Unit attack bonus';
  SBonusDefense = 'Unit defense bonus';
  SBonusViewRange = 'Unit view range bonus';
  SBonusGrow = 'Unit grow bonus';


implementation

uses
  Map, Game;

{ TBuilding }

procedure TBuilding.SetMapCell(AValue: TObject);
var
  OldValue: TCell;
begin
  if FMapCell = AValue then Exit;
  OldValue := TCell(FMapCell);
  FMapCell := nil;
  if Assigned(OldValue) then TCell(OldValue).Building := nil;
  FMapCell := AValue;
  if Assigned(FMapCell) then TCell(FMapCell).Building := Self;
end;

class function TBuilding.GetFields: TItemFields;
var
  Field: TItemField;
begin
  Result := inherited;
  Field := Result.AddField(2, 'Kind', SBuildingKind, dtReference);
end;

procedure TBuilding.GetValue(Index: Integer; out Value);
begin
  if Index = 1 then string(Value) := Name
  else if Index = 2 then TBuildingKind(Value) := Kind
  else inherited;
end;

procedure TBuilding.SetValue(Index: Integer; var Value);
begin
  if Index = 1 then Name := string(Value)
  else if Index = 2 then Kind := TBuildingKind(Value)
  else inherited;
end;

function TBuilding.GetReferenceList(Index: Integer): TBaseItemList;
begin
  if Index = 2 then Result := TGame(Game).GameSystem.BuildingKinds.BaseItemList
  else Result := nil;
end;

procedure TBuilding.Assign(Source: TItem);
begin
  inherited;
  Kind := TBuilding(Source).Kind;
end;

{ TBuildings }

function TBuildings.CreateItem(Name: string): TBuilding;
begin
  Result := inherited;
  Result.Game := Game;
end;

procedure TBuildings.Assign(Source: TItemList<TBuilding>);
var
  I: Integer;
begin
  inherited;
  for I := 0 to Count - 1 do
    Items[I].Game := Game;
end;

{ TBuildingKind }

class function TBuildingKind.GetFields: TItemFields;
var
  Field: TItemField;
begin
  Result := inherited;
  Result.AddField(2, 'Cost', SCost, dtInteger);
  Field := Result.AddField(3, 'SpecialType', SSpecialType, dtEnumeration);
  Field.EnumStates.Add(SNone);
  Field.EnumStates.Add(SCity);
  Result.AddField(4, 'BonusAttack', SBonusAttack, dtInteger);
  Result.AddField(5, 'BonusDefense', SBonusDefense, dtInteger);
  Result.AddField(6, 'BonusViewRange', SBonusViewRange, dtInteger);
  Result.AddField(7, 'BonusGrow', SBonusGrow, dtInteger);
end;

procedure TBuildingKind.GetValue(Index: Integer; out Value);
begin
  if Index = 1 then string(Value) := Name
  else if Index = 2 then Integer(Value) := Cost
  else if Index = 3 then TBuildingSpecialType(Value) := SpecialType
  else if Index = 4 then Integer(Value) := BonusAttack
  else if Index = 5 then Integer(Value) := BonusDefense
  else if Index = 6 then Integer(Value) := BonusViewRange
  else if Index = 7 then Integer(Value) := BonusGrow
  else inherited;
end;

procedure TBuildingKind.SetValue(Index: Integer; var Value);
begin
  if Index = 1 then Name := string(Value)
  else if Index = 2 then Cost := Integer(Value)
  else if Index = 3 then SpecialType := TBuildingSpecialType(Value)
  else if Index = 4 then BonusAttack := Integer(Value)
  else if Index = 5 then BonusDefense := Integer(Value)
  else if Index = 6 then BonusViewRange := Integer(Value)
  else if Index = 7 then BonusGrow := Integer(Value)
  else inherited;
end;

class function TBuildingKind.GetClassSysName: string;
begin
  Result := 'BuildingKind';
end;

class function TBuildingKind.GetClassName: string;
begin
  Result := SBuildingKind;
end;

{ TBuildingKinds }

function TBuildingKinds.FindBySpecialType(SpecialType: TBuildingSpecialType
  ): TBuildingKind;
var
  I: Integer;
begin
  I := 0;
  while (I < Count) and (Items[I].SpecialType <> SpecialType) do Inc(I);
  if I < Count then Result := Items[I]
    else Result := nil;
end;

end.