CentrED/UOLib/UWorldItem.pas

(*
 * CDDL HEADER START
 *
 * The contents of this file are subject to the terms of the
 * Common Development and Distribution License, Version 1.0 only
 * (the "License").  You may not use this file except in compliance
 * with the License.
 *
 * You can obtain a copy of the license at
 * http://www.opensource.org/licenses/cddl1.php.
 * See the License for the specific language governing permissions
 * and limitations under the License.
 *
 * When distributing Covered Code, include this CDDL HEADER in each
 * file and include the License file at
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
 * add the following below this CDDL HEADER, with the fields enclosed
 * by brackets "[]" replaced with your own identifying * information:
 *      Portions Copyright [yyyy] [name of copyright owner]
 *
 * CDDL HEADER END
 *
 *
 *      Portions Copyright 2009 Andreas Schneider
 *)
unit UWorldItem;

{$mode objfpc}{$H+}

interface

uses
  Classes, fgl, UMulBlock;

type
  TWorldBlock = class;

  { TWorldItem }

  TWorldItem = class(TMulBlock)
    constructor Create(AOwner: TWorldBlock);
  protected
    FOwner: TWorldBlock;
    FTileID: LongWord;
    FX: Word;
    FY: Word;
    FZ: ShortInt;
    FSelected: Boolean;
    FCanBeEdited: Boolean;
    FLocked: Boolean;
    FPriority: Integer;
    FPriorityBonus: ShortInt;
    FPrioritySolver: Integer;
    procedure DoChanged;
    function  GetTileID: LongWord; virtual;
    function  GetZ: ShortInt; virtual;
    procedure SetLocked(ALocked: Boolean);
    procedure SetOwner(AOwner: TWorldBlock);
    procedure SetSelected(ASelected: Boolean);
    procedure SetTileID(AValue: LongWord);
    procedure SetX(AValue: Word);
    procedure SetY(AValue: Word);
    procedure SetZ(AValue: ShortInt);
  public
    procedure UpdatePos(AX, AY: Word; AZ: ShortInt);
    procedure Delete;

    property Owner: TWorldBlock read FOwner write SetOwner;
    property TileID: LongWord read GetTileID write SetTileID;
    property X: Word read FX write SetX;
    property Y: Word read FY write SetY;
    property Z: ShortInt read GetZ write SetZ;
    property Selected: Boolean read FSelected write SetSelected;
    property CanBeEdited: Boolean read FCanBeEdited write FCanBeEdited;
    property Locked: Boolean read FLocked write SetLocked;
    property Priority: Integer read FPriority write FPriority;
    property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus;
    property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver;

    property RawTileID: LongWord read FTileID;
    property RawZ: ShortInt read FZ;
  end;

  TWorldItemList = specialize TFPGObjectList<TWorldItem>;

  { TWorldBlock }

  TWorldBlock = class(TMulBlock)
    constructor Create;
  protected
    FX: Word;
    FY: Word;
    FRefCount: Integer;
    FChanged: Boolean;
  public
    property X: Word read FX write FX;
    property Y: Word read FY write FY;
    property RefCount: Integer read FRefCount;
    property Changed: Boolean read FChanged write FChanged;
    procedure AddRef;
    procedure RemoveRef;
  end;

  TVirtualTile = class(TWorldItem);

function CompareWorldItems(const AItem1, AItem2: TWorldItem): Integer;

implementation

uses
  UMap, UStatics;

function CompareWorldItems(const AItem1, AItem2: TWorldItem): Integer;
begin
  if AItem1.X <> AItem2.X then
    Exit(AItem1.X - AItem2.X);

  if AItem1.Y <> AItem2.Y then
    Exit(AItem1.Y - AItem2.Y);

  Result := AItem1.Priority - AItem2.Priority;
  if Result = 0 then
  begin
    if (AItem1 is TMapCell) and (AItem2 is TStaticItem) then
      Result := -1
    else if (AItem1 is TStaticItem) and (AItem2 is TMapCell) then
      Result := 1
    else if (AItem1 is TMapCell) and (AItem2 is TVirtualTile) then
      Result := -1
    else if (AItem1 is TVirtualTile) and (AItem2 is TMapCell) then
      Result := 1;
  end;

  if Result = 0 then
    Result := AItem1.PrioritySolver - AItem2.PrioritySolver;
end;

{ TWorldItem }

constructor TWorldItem.Create(AOwner: TWorldBlock);
begin
  inherited Create;
  FSelected := False;
  FLocked := False;
  FOwner := AOwner;
end;

procedure TWorldItem.DoChanged;
begin
  if FOwner <> nil then
    FOwner.Changed := True;
end;

function TWorldItem.GetTileID: LongWord;
begin
  Result := FTileID;
end;

function TWorldItem.GetZ: ShortInt;
begin
  Result := FZ;
end;

procedure TWorldItem.Delete;
begin
  SetSelected(False);
  SetLocked(False);
  DoChanged;
end;

procedure TWorldItem.SetLocked(ALocked: Boolean);
begin
  if FLocked <> ALocked then
  begin
    FLocked := ALocked;
    if FOwner <> nil then
      if FLocked then
        FOwner.AddRef
      else
        FOwner.RemoveRef;
  end;
end;

procedure TWorldItem.SetOwner(AOwner: TWorldBlock);
begin
  if FOwner <> AOwner then
  begin
    if FOwner <> nil then
    begin
      FOwner.Changed := True;
      if FLocked then FOwner.RemoveRef;
      if FSelected then FOwner.RemoveRef;
    end;
    FOwner := AOwner;
    if FOwner <> nil then
    begin
      FOwner.Changed := True;
      if FLocked then FOwner.AddRef;
      if FSelected then FOwner.AddRef;
    end;
  end;
end;

procedure TWorldItem.SetSelected(ASelected: Boolean);
begin
  if (FOwner <> nil) and (ASelected <> FSelected) then
    if ASelected then
      FOwner.AddRef
    else
      FOwner.RemoveRef;
  FSelected := ASelected;
end;

procedure TWorldItem.SetTileID(AValue: LongWord);
begin
  if FTileID = AValue then
    Exit;

  FTileID := AValue;
  DoChanged;
end;

procedure TWorldItem.SetX(AValue: Word);
begin
  if FX = AValue then
    Exit;

  FX := AValue;
  DoChanged;
end;

procedure TWorldItem.SetY(AValue: Word);
begin
  if FY = AValue then
    Exit;

  FY := AValue;
  DoChanged;
end;

procedure TWorldItem.SetZ(AValue: ShortInt);
begin
  if FZ = AValue then
    Exit;

  FZ := AValue;
  DoChanged;
end;

procedure TWorldItem.UpdatePos(AX, AY: Word; AZ: ShortInt);
begin
  FX := AX;
  FY := AY;
  FZ := AZ;
  DoChanged;
end;

{ TWorldBlock }

procedure TWorldBlock.AddRef;
begin
  Inc(FRefCount);
end;

constructor TWorldBlock.Create;
begin
  inherited Create;
  FRefCount := 0;
  FChanged := False;
end;

procedure TWorldBlock.RemoveRef;
begin
  if FRefCount > 0 then
    Dec(FRefCount);
end;

end.