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, FOrgOwner: TWorldBlock;
    FTileID, FOrgTileID: Word;
    FX, FOrgX: Word;
    FY, FOrgY: Word;
    FZ, FOrgZ: ShortInt;
    FSelected: Boolean;
    FCanBeEdited: Boolean;
    FLocked: Boolean;
    FChanged: Boolean;
    FPriority: Integer;
    FPriorityBonus: ShortInt;
    FPrioritySolver: Integer;
    procedure SetTileID(ATileID: Word);
    procedure SetX(AX: Word);
    procedure SetY(AY: Word);
    procedure SetZ(AZ: ShortInt);
    procedure SetSelected(ASelected: Boolean);
    procedure SetOwner(AOwner: TWorldBlock);
    procedure SetLocked(ALocked: Boolean);
    procedure DoChanged;
    function HasChanged: Boolean; virtual;
  public
    procedure UpdatePos(AX, AY: Word; AZ: ShortInt);
    procedure Delete;
    procedure InitOriginalState; virtual;
    property Owner: TWorldBlock read FOwner write SetOwner;
    property TileID: Word read FTileID write SetTileID;
    property X: Word read FX write SetX;
    property Y: Word read FY write SetY;
    property Z: ShortInt read FZ write SetZ;
    property Selected: Boolean read FSelected write SetSelected;
    property CanBeEdited: Boolean read FCanBeEdited write FCanBeEdited;
    property Locked: Boolean read FLocked write SetLocked;
    property Changed: Boolean read FChanged;
    property Priority: Integer read FPriority write FPriority;
    property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus;
    property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver;
  end;

  TWorldItemList = specialize TFPGObjectList<TWorldItem>;

  { TWorldBlock }

  TWorldBlock = class(TMulBlock)
    constructor Create;
  protected
    FX: Word;
    FY: Word;
    FRefCount: Integer;
    FChanges: Integer;
    function GetChanged: Boolean;
    procedure SetChanged(AChanged: Boolean);
    procedure DoStateChanged;
  public
    property X: Word read FX write FX;
    property Y: Word read FY write FY;
    property RefCount: Integer read FRefCount;
    property Changed: Boolean read GetChanged write SetChanged;
    procedure AddRef;
    procedure RemoveRef;
    procedure CleanUp;
  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.PriorityBonus - AItem2.PriorityBonus;

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

{ TWorldItem }

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

procedure TWorldItem.Delete;
begin
  SetSelected(False);
  SetLocked(False);
  if (FOwner <> FOrgOwner) then
    FOwner.Changed := False
  else if Assigned(FOrgOwner) and (not FChanged) then
    FOrgOwner.Changed := True;
  Free;
end;

procedure TWorldItem.DoChanged;
var
  blockChanged: Boolean;
begin
  blockChanged := HasChanged;
  if Assigned(FOwner) then
  begin
    if FChanged and (not blockChanged) then
      FOwner.Changed := False
    else if (not FChanged) and blockChanged then
      FOwner.Changed := True;
  end;
  FChanged := blockChanged;
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

function TWorldItem.HasChanged: Boolean;
begin
  Result := (FX <> FOrgX) or (FY <> FOrgY) or (FZ <> FOrgZ) or
    (FTileID <> FOrgTileID) or (FOrgOwner <> FOwner);
end;

procedure TWorldItem.InitOriginalState;
begin
  {if Assigned(FOrgOwner) and (FOwner <> FOrgOwner) then
    FOrgOwner.Changed := False;}
  FOrgOwner := FOwner;
  FOrgTileID := FTileID;
  FOrgX := FX;
  FOrgY := FY;
  FOrgZ := FZ;
  DoChanged;
end;

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

procedure TWorldItem.SetOwner(AOwner: TWorldBlock);
begin
  if FOwner <> AOwner then
  begin
    if Assigned(FOwner) then
    begin
      if FOwner <> FOrgOwner then
        FOwner.Changed := False;
      if FLocked then FOwner.RemoveRef;
      if FSelected then FOwner.RemoveRef;
    end;
    FOwner := AOwner;
    if Assigned(FOwner) then
    begin
      if FOwner <> FOrgOwner then
        FOwner.Changed := True;
      if FLocked then FOwner.AddRef;
      if FSelected then FOwner.AddRef;
    end;
    DoChanged;
  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(ATileID: Word);
begin
  FTileID := ATileID;
  DoChanged;
end;

procedure TWorldItem.SetX(AX: Word);
begin
  FX := AX;
  DoChanged;
end;

procedure TWorldItem.SetY(AY: Word);
begin
  FY := AY;
  DoChanged
end;

procedure TWorldItem.SetZ(AZ: ShortInt);
begin
  FZ := AZ;
  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);
  DoStateChanged;
end;

procedure TWorldBlock.CleanUp;
begin
  FChanges := 0;
  DoStateChanged;
end;

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

procedure TWorldBlock.DoStateChanged;
begin
  if Assigned(FOnChanged) then
    FOnChanged(Self);
end;

function TWorldBlock.GetChanged: Boolean;
begin
  Result := (FChanges <> 0);
end;

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

procedure TWorldBlock.SetChanged(AChanged: Boolean);
begin
  if AChanged then
    Inc(FChanges)
  else
    Dec(FChanges);
  DoStateChanged;
end;

end.