CentrED/Server/ULandscape.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 ULandscape;

{$mode objfpc}{$H+}

interface

uses
  SysUtils, Classes, math, UGenericIndex, UMap, UStatics, UWorldItem,
  UTileDataProvider, URadarMap,
  UCacheManager, ULinkedList, UBufferedStreams,
  UEnhancedMemoryStream, UPacketHandlers, UPackets, UNetState, UEnums;

type
  PRadarBlock = ^TRadarBlock;
  TRadarBlock = array[0..7, 0..7] of Word;
  TBlockSubscriptions = array of TLinkedList;

  { TSeperatedStaticBlock }

  TSeperatedStaticBlock = class(TStaticBlock)
    constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
    constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
    destructor Destroy; override;
  protected
    FTiledataProvider: TTiledataProvider;
  public
    { Fields }
    Cells: array[0..63] of TStaticItemList;
    property TiledataProvider: TTiledataProvider read FTiledataProvider
      write FTiledataProvider;

    { Methods }
    function Clone: TSeperatedStaticBlock; override;
    function GetSize: Integer; override;
    procedure RebuildList;
  end;
  
  { TBlock }

  TBlock = class
    constructor Create(AMap: TMapBlock; AStatics: TSeperatedStaticBlock);
    destructor Destroy; override;
  protected
    FMapBlock: TMapBlock;
    FStaticBlock: TSeperatedStaticBlock;
  public
    property Map: TMapBlock read FMapBlock;
    property Static: TSeperatedStaticBlock read FStaticBlock;
  end;

  TBlockCache = specialize TCacheManager<TBlock>;

  { TLandscape }

  TLandscape = class
    constructor Create(AMap, AStatics, AStaIdx, ATiledata, ARadarCol: string;
      AWidth, AHeight: Word; var AValid: Boolean);
    constructor Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
      ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
    destructor Destroy; override;
  protected
    FWidth: Word;
    FHeight: Word;
    FCellWidth: Word;
    FCellHeight: Word;
    FMap: TStream;
    FStatics: TStream;
    FStaIdx: TStream;
    FTiledata: TStream;
    FTiledataProvider: TTiledataProvider;
    FOwnsStreams: Boolean;
    FRadarMap: TRadarMap;
    FBlockCache: TBlockCache;
    FBlockSubscriptions: TBlockSubscriptions;
    procedure OnRemoveCachedObject(ABlock: TBlock);
    function GetMapCell(AX, AY: Word): TMapCell;
    function GetStaticList(AX, AY: Word): TStaticItemList;
    function GetBlockSubscriptions(AX, AY: Word): TLinkedList;

    procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream;
      ANetState: TNetState);
    procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream;
      ANetState: TNetState);
    procedure OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream;
      ANetState: TNetState);
    procedure OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream;
      ANetState: TNetState);
    procedure OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream;
      ANetState: TNetState);
    procedure OnHueStaticPacket(ABuffer: TEnhancedMemoryStream;
      ANetState: TNetState);
    procedure OnLargeScaleCommandPacket(ABuffer: TEnhancedMemoryStream;
      ANetState: TNetState);
  public
    property Width: Word read FWidth;
    property Height: Word read FHeight;
    property CellWidth: Word read FCellWidth;
    property CellHeight: Word read FCellHeight;
    property MapCell[X, Y: Word]: TMapCell read GetMapCell;
    property StaticList[X, Y: Word]: TStaticItemList read GetStaticList;
    property BlockSubscriptions[X, Y: Word]: TLinkedList read GetBlockSubscriptions;
    property TiledataProvider: TTiledataProvider read FTiledataProvider;

    function GetMapBlock(AX, AY: Word): TMapBlock;
    function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
    function LoadBlock(AX, AY: Word): TBlock;

    procedure UpdateRadar(AX, AY: Word);
    function GetEffectiveAltitude(ATile: TMapCell): ShortInt;
    function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
    procedure SortStaticsList(AStatics: TStaticItemList);

    procedure Flush;
    procedure SaveBlock(AWorldBlock: TWorldBlock);
    function Validate: Boolean;
  end;
  
  TStaticInfo = packed record
    X: Word;
    Y: Word;
    Z: ShortInt;
    TileID: Word;
    Hue: Word;
  end;
  TAreaInfo = packed record
    Left: Word;
    Top: Word;
    Right: Word;
    Bottom: Word;
  end;
  TWorldPoint = packed record
    X: Word;
    Y: Word;
  end;
  
function PointInArea(AArea: TAreaInfo; AX, AY: Word): Boolean; inline;

implementation

uses
  UCEDServer, UConnectionHandling, UConfig, ULargeScaleOperations, Logging;

function GetID(AX, AY: Word): Integer;
begin
  Result := ((AX and $7FFF) shl 15) or (AY and $7FFF);
end;

function PointInArea(AArea: TAreaInfo; AX, AY: Word): Boolean;
begin
  Result := InRange(AX, AArea.Left, AArea.Right) and
            InRange(AY, AArea.Top, AArea.Bottom);
end;

{ TSeperatedStaticBlock }

constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
  AX, AY: Word);
var
  i: Integer;
  item: TStaticItem;
  block: TMemoryStream;
begin
  inherited Create;
  FItems := TStaticItemList.Create(False);

  FX := AX;
  FY := AY;

  for i := 0 to 63 do
    Cells[i] := TStaticItemList.Create(True);

  if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
  begin
    AData.Position := AIndex.Lookup;
    block := TMemoryStream.Create;
    block.CopyFrom(AData, AIndex.Size);
    block.Position := 0;
    for i := 1 to (AIndex.Size div 7) do
    begin
      item := TStaticItem.Create(Self, block, AX, AY);
      Cells[(item.Y mod 8) * 8 + (item.X mod 8)].Add(item);
    end;
    block.Free;
  end;
  FChanged := False;
end;

constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
begin
  Create(AData, AIndex, 0, 0);
end;

destructor TSeperatedStaticBlock.Destroy;
var
  i: Integer;
begin
  FreeAndNil(FItems);

  for i := 0 to 63 do
    FreeAndNil(Cells[i]);

  inherited Destroy;
end;

function TSeperatedStaticBlock.Clone: TSeperatedStaticBlock;
begin
  raise Exception.Create('TSeperatedStaticBlock.Clone is not implemented (yet).');
  Result := nil;
end;

function TSeperatedStaticBlock.GetSize: Integer;
begin
  RebuildList;
  Result := inherited GetSize;
end;

procedure TSeperatedStaticBlock.RebuildList;
var
  i, j, solver: Integer;
begin
  FItems.Clear;
  solver := 0;
  for i := 0 to 63 do
  begin
    if Cells[i] <> nil then
    begin
      for j := 0 to Cells[i].Count - 1 do
      begin
        FItems.Add(Cells[i].Items[j]);
        if Cells[i].Items[j].TileID < FTiledataProvider.StaticCount then
        begin
          Cells[i].Items[j].UpdatePriorities(
            FTiledataProvider.StaticTiles[Cells[i].Items[j].TileID], solver);
        end else
          Logger.Send([lcLandscape, lcServer, lcError], 'Cannot find Tiledata ' +
            'for the Static Item with ID $%x.', [Cells[i].Items[j].TileID]);
        Inc(solver);
      end;
    end;
  end;
  Sort;
end;

{ TBlock }

constructor TBlock.Create(AMap: TMapBlock; AStatics: TSeperatedStaticBlock);
begin
  inherited Create;
  FMapBlock := AMap;
  FStaticBlock := AStatics;
end;

destructor TBlock.Destroy;
begin
  FreeAndNil(FMapBlock);
  FreeAndNil(FStaticBlock);
  inherited Destroy;
end;

{ TLandscape }

constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata,
  ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
var
  map, statics, staidx, tiledata: TStream;
begin
  Write(TimeStamp, 'Loading Map');
  map := TFileStream.Create(AMap, fmOpenReadWrite);
  Write(', Statics');
  statics := TFileStream.Create(AStatics, fmOpenReadWrite);
  Write(', StaIdx');
  staidx := TBufferedReader.Create(TFileStream.Create(AStaIdx, fmOpenReadWrite), True);
  Writeln(', Tiledata');
  tiledata := TFileStream.Create(ATiledata, fmOpenRead or fmShareDenyWrite);
  Create(map, statics, staidx, tiledata, ARadarCol, AWidth, AHeight, AValid);
  FOwnsStreams := True;
end;

constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
  ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
var
  blockID: Integer;
begin
  inherited Create;
  FWidth := AWidth;
  FHeight := AHeight;
  FCellWidth := FWidth * 8;
  FCellHeight := FHeight * 8;
  FMap := AMap;
  FStatics := AStatics;
  FStaIdx := AStaIdx;
  FTiledata := ATiledata;
  FOwnsStreams := False;
  AValid := Validate;
  if AValid then
  begin
    Write(TimeStamp, 'Creating Cache');
    FBlockCache := TBlockCache.Create(256);
    FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
    Write(', Tiledata');
    FTiledataProvider := TTiledataProvider.Create(ATiledata);
    Write(', Subscriptions');
    SetLength(FBlockSubscriptions, AWidth * AHeight);
    for blockID := 0 to AWidth * AHeight - 1 do
      FBlockSubscriptions[blockID] := TLinkedList.Create;

    Writeln(', RadarMap');
    FRadarMap := TRadarMap.Create(FMap, FStatics, FStaIdx, FWidth, FHeight,
      ARadarCol);

    RegisterPacketHandler($06, TPacketHandler.Create(8, @OnDrawMapPacket));
    RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket));
    RegisterPacketHandler($08, TPacketHandler.Create(10, @OnDeleteStaticPacket));
    RegisterPacketHandler($09, TPacketHandler.Create(11, @OnElevateStaticPacket));
    RegisterPacketHandler($0A, TPacketHandler.Create(14, @OnMoveStaticPacket));
    RegisterPacketHandler($0B, TPacketHandler.Create(12, @OnHueStaticPacket));
    RegisterPacketHandler($0E, TPacketHandler.Create(0, @OnLargeScaleCommandPacket));
  end;
end;

destructor TLandscape.Destroy;
var
  i: Integer;
begin
  for i := 0 to Length(FBlockSubscriptions) - 1 do
    FreeAndNil(FBlockSubscriptions[i]);
  FreeAndNil(FBlockCache);
  FreeAndNil(FTiledataProvider);
  FreeAndNil(FRadarMap);
  if FOwnsStreams then
  begin
    FreeAndNil(FMap);
    FreeAndNil(FStatics);
    FreeAndNil(FStaIdx);
    FreeAndNil(FTiledata);
  end;
  
  RegisterPacketHandler($06, nil);
  RegisterPacketHandler($07, nil);
  RegisterPacketHandler($08, nil);
  RegisterPacketHandler($09, nil);
  RegisterPacketHandler($0A, nil);
  RegisterPacketHandler($0B, nil);
  RegisterPacketHandler($0E, nil);
  
  inherited Destroy;
end;

function TLandscape.GetBlockSubscriptions(AX, AY: Word): TLinkedList;
begin
  if (AX >= 0) and (AX <= FWidth) and (AY >= 0) and (AY <= FHeight) then
    Result := FBlockSubscriptions[(AY * FWidth) + AX]
  else
    Result := nil;
end;

function TLandscape.GetMapCell(AX, AY: Word): TMapCell;
var
  block: TMapBlock;
begin
  Result := nil;
  if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then
  begin
    block := GetMapBlock(AX div 8, AY div 8);
    if block <> nil then
      Result := block.Cells[(AY mod 8) * 8 + AX mod 8];
  end;
end;

function TLandscape.GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
begin
  if (AX >= 0) and (AX < FCellWidth) and (AY >= 0) and (AY < FCellHeight) then
    Result := MapCell[AX, AY].Altitude
  else
    Result := ADefault;
end;

function TLandscape.GetStaticList(AX, AY: Word): TStaticItemList;
var
  block: TSeperatedStaticBlock;
begin
  Result := nil;
  if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then
  begin
    block := GetStaticBlock(AX div 8, AY div 8);
    if block <> nil then
      Result := block.Cells[(AY mod 8) * 8 + AX mod 8];
  end;
end;

procedure TLandscape.UpdateRadar(AX, AY: Word);
var
  mapTile: TMapCell;
  tile: TWorldItem;
  staticItems: TStaticItemList;
  tiles: TWorldItemList;
  i: Integer;
begin
  if (AX mod 8 = 0) and (AY mod 8 = 0) then
  begin
    staticItems := GetStaticList(AX, AY);
    if staticItems <> nil then
    begin
      tiles := TWorldItemList.Create(False);
      mapTile := GetMapCell(AX, AY);
      if mapTile <> nil then
      begin
        mapTile.Priority := GetEffectiveAltitude(mapTile);
        mapTile.PriorityBonus := 0;
        mapTile.PrioritySolver := 0;
        tiles.Add(mapTile);
      end;
      for i := 0 to staticItems.Count - 1 do
      begin
        if staticItems[i].TileID < FTiledataProvider.StaticCount then
        begin
          staticItems[i].UpdatePriorities(
            FTiledataProvider.StaticTiles[staticItems[i].TileID],
            i + 1);
        end else
          Logger.Send([lcLandscape, lcServer, lcError], 'Cannot find Tiledata ' +
            'for the Static Item with ID $%x.', [staticItems[i].TileID]);
        tiles.Add(staticItems[i]);
      end;
      tiles.Sort(@CompareWorldItems);

      if tiles.Count > 0 then
      begin
        tile := tiles[tiles.Count - 1];
        if tile is TStaticItem then
          FRadarMap.Update(AX div 8, AY div 8, tile.TileID + $4000)
        else
          FRadarMap.Update(AX div 8, AY div 8, tile.TileID)
      end;

      tiles.Free;
    end;
  end;
end;

procedure TLandscape.SortStaticsList(AStatics: TStaticItemList);
var
  i: Integer;
begin
  for i := 0 to AStatics.Count - 1 do
    if AStatics[i].TileID < FTiledataProvider.StaticCount then
    begin
      AStatics[i].UpdatePriorities(
        FTiledataProvider.StaticTiles[AStatics[i].TileID],
        i + 1);
    end else
      Logger.Send([lcLandscape, lcServer, lcError], 'Cannot find Tiledata ' +
        'for the Static Item with ID $%x.', [AStatics[i].TileID]);
  AStatics.Sort(@CompareStaticItems);
end;

function TLandscape.GetEffectiveAltitude(ATile: TMapCell): ShortInt;
var
  north, west, south, east: ShortInt;
begin
  north := ATile.Altitude;
  west := GetLandAlt(ATile.X, ATile.Y + 1, north);
  south := GetLandAlt(ATile.X + 1, ATile.Y + 1, north);
  east := GetLandAlt(ATile.X + 1, ATile.Y, north);

  if Abs(north - south) > Abs(west - east) then
    Result := (north + south) div 2
  else
    Result := (west + east) div 2;
end;

procedure TLandscape.OnRemoveCachedObject(ABlock: TBlock);
begin
  if ABlock <> nil then
  begin
    if ABlock.Map.Changed then SaveBlock(ABlock.Map);
    if ABlock.Static.Changed then SaveBlock(ABlock.Static);
  end;
end;

function TLandscape.GetMapBlock(AX, AY: Word): TMapBlock;
var
  block: TBlock;
begin
  Result := nil;
  if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then
  begin
    if FBlockCache.QueryID(GetID(AX, AY), block) then
      Result := block.Map
    else
      Result := LoadBlock(AX, AY).Map;
  end;
end;

function TLandscape.GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
var
  block: TBlock;
begin
  Result := nil;
  if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then
  begin
    if FBlockCache.QueryID(GetID(AX, AY), block) then
      Result := TSeperatedStaticBlock(block.Static)
    else
      Result := TSeperatedStaticBlock(LoadBlock(AX, AY).Static);
  end;
end;

function TLandscape.LoadBlock(AX, AY: Word): TBlock;
var
  map: TMapBlock;
  statics: TSeperatedStaticBlock;
  index: TGenericIndex;
begin
  FMap.Position := ((AX * FHeight) + AY) * 196;
  map := TMapBlock.Create(FMap, AX, AY);

  FStaIdx.Position := ((AX * FHeight) + AY) * 12;
  index := TGenericIndex.Create(FStaIdx);
  statics := TSeperatedStaticBlock.Create(FStatics, index, AX, AY);
  statics.TiledataProvider := FTiledataProvider;
  index.Free;
  
  Result := TBlock.Create(map, statics);
  FBlockCache.StoreID(GetID(AX, AY), Result);
end;

//Intelligent write: replace if possible, otherwise extend

procedure TLandscape.Flush;
begin
  FBlockCache.Clear; //Clear writes modified blocks before removing them from the cache
end;

procedure TLandscape.SaveBlock(AWorldBlock: TWorldBlock);
var
  size: Integer;
  index: TGenericIndex;
begin
  if AWorldBlock is TMapBlock then
  begin
    FMap.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 196;
    AWorldBlock.Write(FMap);
    AWorldBlock.Changed := False;
  end else if AWorldBlock is TStaticBlock then
  begin
    FStaIdx.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 12;
    index := TGenericIndex.Create(FStaIdx);
    size := AWorldBlock.GetSize;
    if (size > index.Size) or (index.Lookup < 0) then
    begin
      FStatics.Position := FStatics.Size;
      index.Lookup := FStatics.Position;
    end;
    index.Size := size;
    if size = 0 then
      index.Lookup := -1
    else
    begin
      FStatics.Position := index.Lookup;
      AWorldBlock.Write(FStatics);
    end;
    FStaIdx.Seek(-12, soFromCurrent);
    index.Write(FStaIdx);
    index.Free;
    AWorldBlock.Changed := False;
  end;
end;

function TLandscape.Validate: Boolean;
var
  blocks: Integer;
begin
  blocks := FWidth * FHeight;
  FStaIdx.Seek(0, soFromEnd); //workaround for TBufferedStream
  Result := (FMap.Size = (blocks * 196)) and (FStaIdx.Position = (blocks * 12));
end;

procedure TLandscape.OnDrawMapPacket(ABuffer: TEnhancedMemoryStream;
  ANetState: TNetState);
var
  x, y: Word;
  cell: TMapCell;
  subscriptions: TLinkedList;
  subscriptionItem: PLinkedItem;
  packet: TDrawMapPacket;
begin
  x := ABuffer.ReadWord;
  y := ABuffer.ReadWord;

  if not ValidateAccess(ANetState, alNormal, x, y) then Exit;

  cell := GetMapCell(x, y);
  if cell <> nil then
  begin
    cell.Altitude := ABuffer.ReadShortInt;
    cell.TileID := ABuffer.ReadWord;
    
    packet := TDrawMapPacket.Create(cell);
    subscriptions := FBlockSubscriptions[(y div 8) * FWidth + (x div 8)];
    subscriptionItem := nil;
    while subscriptions.Iterate(subscriptionItem) do
      CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data), packet, False);
    packet.Free;
    
    UpdateRadar(x, y);
  end;
end;

procedure TLandscape.OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream;
  ANetState: TNetState);
var
  x, y: Word;
  block: TSeperatedStaticBlock;
  staticItem: TStaticItem;
  targetStaticList: TStaticItemList;
  subscriptions: TLinkedList;
  subscriptionItem: PLinkedItem;
  packet: TInsertStaticPacket;
begin
  x := ABuffer.ReadWord;
  y := ABuffer.ReadWord;

  if not ValidateAccess(ANetState, alNormal, x, y) then Exit;

  block := GetStaticBlock(x div 8, y div 8);
  if block <> nil then
  begin
    staticItem := TStaticItem.Create(nil, nil, 0, 0);
    staticItem.X := x;
    staticItem.Y := y;
    staticItem.Z := ABuffer.ReadShortInt;
    staticItem.TileID := ABuffer.ReadWord;
    staticItem.Hue := ABuffer.ReadWord;
    targetStaticList := block.Cells[(y mod 8) * 8 + x mod 8];
    targetStaticList.Add(staticItem);
    SortStaticsList(targetStaticList);
    staticItem.Owner := block;
    
    packet := TInsertStaticPacket.Create(staticItem);
    subscriptions := FBlockSubscriptions[(y div 8) * FWidth + (x div 8)];
    subscriptionItem := nil;
    while subscriptions.Iterate(subscriptionItem) do
      CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data), packet, False);
    packet.Free;
    
    UpdateRadar(x, y);
  end;
end;

procedure TLandscape.OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream;
  ANetState: TNetState);
var
  block: TSeperatedStaticBlock;
  i: Integer;
  statics: TStaticItemList;
  staticInfo: TStaticInfo;
  staticItem: TStaticItem;
  subscriptions: TLinkedList;
  subscriptionItem: PLinkedItem;
  packet: TDeleteStaticPacket;
begin
  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));

  if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;

  block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
  if block <> nil then
  begin
    statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
    for i := 0 to statics.Count - 1 do
    begin
      staticItem := statics[i];
      if (staticItem.Z = staticInfo.Z) and
         (staticItem.TileID = staticInfo.TileID) and
         (staticItem.Hue = staticInfo.Hue) then
      begin
        packet := TDeleteStaticPacket.Create(staticItem);

        staticItem.Delete;
        statics.Delete(i);
        
        subscriptions := FBlockSubscriptions[(staticInfo.Y div 8) * FWidth +
          (staticInfo.X div 8)];
        subscriptionItem := nil;
        while subscriptions.Iterate(subscriptionItem) do
          CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data),
            packet, False);
        packet.Free;
        
        UpdateRadar(staticInfo.X, staticInfo.Y);
        
        Break;
      end;
    end;
  end;
end;

procedure TLandscape.OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream;
  ANetState: TNetState);
var
  block: TSeperatedStaticBlock;
  i: Integer;
  statics: TStaticItemList;
  staticInfo: TStaticInfo;
  staticItem: TStaticItem;
  newZ: ShortInt;
  subscriptions: TLinkedList;
  subscriptionItem: PLinkedItem;
  packet: TElevateStaticPacket;
begin
  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));

  if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;

  block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
  if block <> nil then
  begin
    statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
    for i := 0 to statics.Count - 1 do
    begin
      staticItem := statics[i];
      if (staticItem.Z = staticInfo.Z) and
         (staticItem.TileID = staticInfo.TileID) and
         (staticItem.Hue = staticInfo.Hue) then
      begin
        newZ := ABuffer.ReadShortInt;
        packet := TElevateStaticPacket.Create(staticItem, newZ);

        staticItem.Z := newZ;
        SortStaticsList(statics);

        subscriptions := FBlockSubscriptions[(staticInfo.Y div 8) * FWidth +
          (staticInfo.X div 8)];
        subscriptionItem := nil;
        while subscriptions.Iterate(subscriptionItem) do
          CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data),
            packet, False);
        packet.Free;
        
        UpdateRadar(staticInfo.X, staticInfo.Y);

        Break;
      end;
    end;
  end;
end;

procedure TLandscape.OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream;
  ANetState: TNetState);
var
  sourceBlock, targetBlock: TSeperatedStaticBlock;
  sourceSubscriptions, targetSubscriptions: TList;
  i: Integer;
  statics: TStaticItemList;
  staticInfo: TStaticInfo;
  staticItem: TStaticItem;
  newX, newY: Word;
  subscriptions: TLinkedList;
  subscriptionItem: PLinkedItem;
  insertPacket: TInsertStaticPacket;
  deletePacket: TDeleteStaticPacket;
  movePacket: TMoveStaticPacket;
begin
  staticItem := nil;
  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
  newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 1);
  newY := EnsureRange(ABuffer.ReadWord, 0, FCellHeight - 1);

  //Check, if both, source and target, are within a valid region
  if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
  if not ValidateAccess(ANetState, alNormal, newX, newY) then Exit;
  
  if (staticInfo.X = newX) and (staticInfo.Y = newY) then Exit;
  
  if ((abs(staticInfo.X - newX) > 8) or (abs(staticInfo.Y - newY) > 8)) and
     (not ValidateAccess(ANetState, alAdministrator)) then Exit;
  
  sourceBlock := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
  targetBlock := GetStaticBlock(newX div 8, newY div 8);
  if (sourceBlock <> nil) and (targetBlock <> nil) then
  begin
    statics := sourceBlock.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
    i := 0;
    while (i < statics.Count) and (staticItem = nil) do
    begin
      staticItem := statics[i];
      if (staticItem.Z <> staticInfo.Z) or
         (staticItem.TileID <> staticInfo.TileID) or
         (staticItem.Hue <> staticInfo.Hue) then
      begin
        staticItem := nil;
      end;
      Inc(i);
    end;
    
    if staticItem <> nil then
    begin
      deletePacket := TDeleteStaticPacket.Create(staticItem);
      movePacket := TMoveStaticPacket.Create(staticItem, newX, newY);

      statics.FreeObjects := False;
      i := statics.IndexOf(staticItem);
      statics.Delete(i);
      statics.FreeObjects := True;

      statics := targetBlock.Cells[(newY mod 8) * 8 + newX mod 8];
      statics.Add(staticItem);
      staticItem.UpdatePos(newX, newY, staticItem.Z);
      staticItem.Owner := targetBlock;

      insertPacket := TInsertStaticPacket.Create(staticItem);

      SortStaticsList(statics);

      sourceSubscriptions := TList.Create;
      subscriptions := FBlockSubscriptions[(staticInfo.Y div 8) * FWidth + (staticInfo.X div 8)];
      subscriptionItem := nil;
      while subscriptions.Iterate(subscriptionItem) do
        sourceSubscriptions.Add(subscriptionItem^.Data);

      targetSubscriptions := TList.Create;
      subscriptions := FBlockSubscriptions[(newY div 8) * FWidth + (newX div 8)];
      subscriptionItem := nil;
      while subscriptions.Iterate(subscriptionItem) do
        targetSubscriptions.Add(subscriptionItem^.Data);

      for i := 0 to sourceSubscriptions.Count - 1 do
      begin
        if targetSubscriptions.IndexOf(sourceSubscriptions.Items[i]) > -1 then
          CEDServerInstance.SendPacket(TNetState(sourceSubscriptions.Items[i]), movePacket, False)
        else
          CEDServerInstance.SendPacket(TNetState(sourceSubscriptions.Items[i]), deletePacket, False);
      end;

      for i := 0 to targetSubscriptions.Count - 1 do
      begin
        if sourceSubscriptions.IndexOf(targetSubscriptions.Items[i]) = -1 then
          CEDServerInstance.SendPacket(TNetState(sourceSubscriptions.Items[i]), insertPacket, False);
      end;
      
      UpdateRadar(staticInfo.X, staticInfo.Y);
      UpdateRadar(newX, newY);

      insertPacket.Free;
      deletePacket.Free;
      movePacket.Free;

      sourceSubscriptions.Free;
      targetSubscriptions.Free;
    end;
  end;
end;

procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream;
  ANetState: TNetState);
var
  block: TSeperatedStaticBlock;
  i: Integer;
  statics: TStaticItemList;
  staticInfo: TStaticInfo;
  staticItem: TStaticItem;
  newHue: Word;
  subscriptions: TLinkedList;
  subscriptionItem: PLinkedItem;
  packet: THueStaticPacket;
begin
  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));

  if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;

  block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
  if block <> nil then
  begin
    statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
    for i := 0 to statics.Count - 1 do
    begin
      staticItem := statics[i];
      if (staticItem.Z = staticInfo.Z) and
         (staticItem.TileID = staticInfo.TileID) and
         (staticItem.Hue = staticInfo.Hue) then
      begin
        newHue := ABuffer.ReadWord;
        packet := THueStaticPacket.Create(staticItem, newHue);

        staticItem.Hue := newHue;

        subscriptions := FBlockSubscriptions[(staticInfo.Y div 8) * FWidth + (staticInfo.X div 8)];
        subscriptionItem := nil;
        while subscriptions.Iterate(subscriptionItem) do
          CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data), packet, False);
        packet.Free;

        Break;
      end;
    end;
  end;
end;

procedure TLandscape.OnLargeScaleCommandPacket(ABuffer: TEnhancedMemoryStream;
  ANetState: TNetState);
var
  areaInfo: array of TAreaInfo;
  areaCount: Byte;
  i: Integer;
  blockX, blockY, cellX, cellY, x, y: Word;
  realBlockX, realBlockY, realCellX, realCellY: Word;
  blockOffX, cellOffX, modX, blockOffY, cellOffY, modY: Integer;
  blockID, cellID: Cardinal;
  emptyBits: TBits;
  bitMask: array of TBits;
  mapTile: TMapCell;
  statics: TStaticItemList;
  operations: TList;
  clients: array of record
    NetState: TNetState;
    Blocks: TBlockCoordsArray;
  end;
  netState: TNetState;
  subscriptions: TLinkedList;
  subscriptionItem: PLinkedItem;
  cmOperation: TLSCopyMove;
  additionalAffectedBlocks: TBits;
begin
  if not ValidateAccess(ANetState, alAdministrator) then Exit;
  Writeln(TimeStamp, ANetState.Account.Name, ' begins large scale operation');
  CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssOther,
    Format('%s is performing large scale operations ...', [ANetState.Account.Name])));

  //Bitmask
  emptyBits := TBits.Create(64);
  SetLength(bitMask, FWidth * FHeight);
  for i := Low(bitMask) to High(bitMask) do
    bitMask[i] := TBits.Create(64);
  //'additionalAffectedBlocks' is used to store whether a certain block was
  //touched during an operation which was designated to another block (for
  //example by moving items with an offset). This is (indirectly) merged later
  //on.
  additionalAffectedBlocks := TBits.Create(FWidth * FHeight);

  areaCount := ABuffer.ReadByte;
  SetLength(areaInfo, areaCount);
  for i := 0 to areaCount - 1 do
  begin
    areaInfo[i].Left := Max(ABuffer.ReadWord, 0);
    areaInfo[i].Top := Max(ABuffer.ReadWord, 0);
    areaInfo[i].Right := Min(ABuffer.ReadWord, FCellWidth - 1);
    areaInfo[i].Bottom := Min(ABuffer.ReadWord, FCellHeight - 1);
    for x := areaInfo[i].Left to areaInfo[i].Right do
      for y := areaInfo[i].Top to areaInfo[i].Bottom do
      begin
        blockID := (x div 8) * FHeight + (y div 8);
        cellID := (y mod 8) * 8 + (x mod 8);
        bitMask[blockID].Bits[cellID] := True;
      end;
  end;
  
  //client blocks
  SetLength(clients, 0);
  CEDServerInstance.TCPServer.IterReset;
  while CEDServerInstance.TCPServer.IterNext do
  begin
    netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
    if netState <> nil then
    begin
      SetLength(clients, Length(clients) + 1);
      clients[High(clients)].NetState := netState;
      SetLength(clients[High(clients)].Blocks, 0);
    end;
  end;

  operations := TList.Create;
  
  cmOperation := nil;
  if ABuffer.ReadBoolean then
  begin
    cmOperation := TLSCopyMove.Init(ABuffer, Self);
    if (cmOperation.OffsetX <> 0) or (cmOperation.OffsetY <> 0) then
    begin
      operations.Add(cmOperation);

      if cmOperation.OffsetX > 0 then
      begin
        blockOffX := FWidth - 1;
        cellOffX := 7;
        modX := -1;
      end else
      begin
        blockOffX := 0;
        cellOffX := 0;
        modX := 1;
      end;

      if cmOperation.OffsetY > 0 then
      begin
        blockOffY := FHeight - 1;
        cellOffY := 7;
        modY := -1;
      end else
      begin
        blockOffY := 0;
        cellOffY := 0;
        modY := 1;
      end;
    end else
      FreeAndNil(cmOperation);
  end;
  if cmOperation = nil then
  begin
    blockOffX := 0;
    cellOffX := 0;
    modX := 1;
    blockOffY := 0;
    cellOffY := 0;
    modY := 1;
  end;
  if ABuffer.ReadBoolean then operations.Add(TLSSetAltitude.Init(ABuffer, Self));
  if ABuffer.ReadBoolean then operations.Add(TLSDrawTerrain.Init(ABuffer, Self));
  if ABuffer.ReadBoolean then operations.Add(TLSDeleteStatics.Init(ABuffer, Self));
  if ABuffer.ReadBoolean then operations.Add(TLSInsertStatics.Init(ABuffer, Self));
  
  FRadarMap.BeginUpdate;
  for blockX := 0 to FWidth - 1 do
  begin
    realBlockX := blockOffX + modX * blockX;
    for blockY := 0 to FHeight - 1 do
    begin
      realBlockY := blockOffY + modY * blockY;
      blockID := (realBlockX * FHeight) + realBlockY;
      if bitMask[blockID].Equals(emptyBits) then Continue;
      
      for cellY := 0 to 7 do
      begin
        realCellY := cellOffY + modY * cellY;
        for cellX := 0 to 7 do
        begin
          realCellX := cellOffX + modX * cellX;
          if bitMask[blockID].Bits[(realCellY * 8) + realCellX] then
          begin
            x := realBlockX * 8 + realCellX;
            y := realBlockY * 8 + realCellY;
            mapTile := GetMapCell(x, y);
            statics := GetStaticList(x, y);
            for i := 0 to operations.Count - 1 do
              TLargeScaleOperation(operations.Items[i]).Apply(mapTile, statics,
                additionalAffectedBlocks);
            SortStaticsList(statics);
              
            UpdateRadar(x, y);
          end;
        end;
      end;

      //Find out, which clients are affected by which blocks.
      //This is used to efficiently update the block subscriptions.
      subscriptions := FBlockSubscriptions[realBlockY * FWidth + realBlockX];
      for i := Low(clients) to High(clients) do
      begin
        subscriptionItem := nil;
        while subscriptions.Iterate(subscriptionItem) do
        begin
          if TNetState(subscriptionItem^.Data) = clients[i].NetState then
          begin
            SetLength(clients[i].Blocks, Length(clients[i].Blocks) + 1);
            with clients[i].Blocks[High(clients[i].Blocks)] do
            begin
              X := realBlockX;
              Y := realBlockY;
            end;
            Break;
          end;
        end;
      end;
      
    end;
  end;
  
  //additional blocks
  for blockX := 0 to FWidth - 1 do
  begin
    for blockY := 0 to FHeight - 1 do
    begin
      blockID := (blockX * FHeight) + blockY;
      if bitMask[blockID].Equals(emptyBits) and additionalAffectedBlocks[blockID] then
      begin
        //Update the information, which client is affected on which subscribed
        //block.
        subscriptions := FBlockSubscriptions[blockY * FWidth + blockX];
        for i := Low(clients) to High(clients) do
        begin
          subscriptionItem := nil;
          while subscriptions.Iterate(subscriptionItem) do
          begin
            if TNetState(subscriptionItem^.Data) = clients[i].NetState then
            begin
              SetLength(clients[i].Blocks, Length(clients[i].Blocks) + 1);
              with clients[i].Blocks[High(clients[i].Blocks)] do
              begin
                X := blockX;
                Y := blockY;
              end;
              Break;
            end;
          end;
        end;
        
        UpdateRadar(blockX * 8, blockY * 8);
        
      end;
    end;
  end;
  
  //clean up
  for i := Low(bitMask) to High(bitMask) do
    bitMask[i].Free;
  emptyBits.Free;
  additionalAffectedBlocks.Free;
  
  for i := 0 to operations.Count - 1 do
    TLargeScaleOperation(operations.Items[i]).Free;
  operations.Free;
  
  //Update clients
  FRadarMap.EndUpdate;
  for i := Low(clients) to High(clients) do
  begin
    if Length(clients[i].Blocks) > 0 then
    begin
      CEDServerInstance.SendPacket(clients[i].NetState, TCompressedPacket.Create(
        TBlockPacket.Create(clients[i].Blocks, nil)));
      clients[i].NetState.LastAction := Now;
    end;
  end;

  CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssRunning));
  Writeln(TimeStamp, 'Large scale operation ended.');
end;

end.