CentrED/Server/ULandscape.pas

1102 lines
34 KiB
Plaintext

(*
* 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 2007 Andreas Schneider
*)
unit ULandscape;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, contnrs, UGenericIndex, UMap, UStatics, UTileData,
UWorldItem, UMulBlock, math,
UTileDataProvider, URadarMap,
UListSort, UCacheManager, ULinkedList, UBufferedStreams,
UEnhancedMemoryStream, UPacketHandlers, UPackets, UNetState, UEnums;
type
PRadarBlock = ^TRadarBlock;
TRadarBlock = array[0..7, 0..7] of Word;
TBlockSubscriptions = array of TLinkedList;
{ TBlock }
TBlock = class(TObject)
constructor Create(AMap: TMapBlock; AStatics: TStaticBlock);
destructor Destroy; override;
protected
FMapBlock: TMapBlock;
FStaticBlock: TStaticBlock;
public
property Map: TMapBlock read FMapBlock;
property Static: TStaticBlock read FStaticBlock;
end;
{ TLandscape }
TLandscape = class(TObject)
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: TCacheManager;
FBlockSubscriptions: TBlockSubscriptions;
function Compare(left, right: TObject): Integer;
procedure OnBlockChanged(ABlock: TMulBlock);
procedure OnRemoveCachedObject(AObject: TObject);
function GetMapCell(AX, AY: Word): TMapCell;
function GetStaticList(AX, AY: Word): TList;
function GetBlockSubscriptions(AX, AY: Word): TLinkedList;
procedure UpdateStaticsPriority(AStaticItem: TStaticItem;
APrioritySolver: Integer);
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]: TList 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: TList);
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;
const
mMap = 0;
mStatics = 1;
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;
{ TBlock }
constructor TBlock.Create(AMap: TMapBlock; AStatics: TStaticBlock);
begin
inherited Create;
FMapBlock := AMap;
FStaticBlock := AStatics;
end;
destructor TBlock.Destroy;
begin
if FMapBlock <> nil then FreeAndNil(FMapBlock);
if FStaticBlock <> nil then FreeAndNil(FStaticBlock);
inherited Destroy;
end;
{ TLandscape }
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata,
ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
begin
Create(TFileStream.Create(AMap, fmOpenReadWrite),
TFileStream.Create(AStatics, fmOpenReadWrite),
TBufferedReader.Create(TFileStream.Create(AStaIdx, fmOpenReadWrite), True),
TFileStream.Create(ATiledata, fmOpenRead or fmShareDenyWrite),
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, blockType: 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
FBlockCache := TCacheManager.Create(256);
FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
FTiledataProvider := TTiledataProvider.Create(ATiledata);
SetLength(FBlockSubscriptions, AWidth * AHeight);
for blockID := 0 to AWidth * AHeight - 1 do
FBlockSubscriptions[blockID] := TLinkedList.Create;
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
if FBlockSubscriptions[i] <> nil then FreeAndNil(FBlockSubscriptions[i]);
if FBlockCache <> nil then FreeAndNil(FBlockCache);
if FTiledataProvider <> nil then FreeAndNil(FTiledataProvider);
if FRadarMap <> nil then FreeAndNil(FRadarMap);
if FOwnsStreams then
begin
if FMap <> nil then FreeAndNil(FMap);
if FStatics <> nil then FreeAndNil(FStatics);
if FStaIdx <> nil then FreeAndNil(FStaIdx);
if FTiledata <> nil then 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): TList;
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;
function TLandscape.Compare(left, right: TObject): Integer;
begin
Result := TWorldItem(right).Priority - TWorldItem(left).Priority;
if Result = 0 then
begin
if (left is TMapCell) and (right is TStaticItem) then
Result := 1
else if (left is TStaticItem) and (right is TMapCell) then
Result := -1;
end;
if Result = 0 then
Result := TWorldItem(right).PriorityBonus - TWorldItem(left).PriorityBonus;
if Result = 0 then
Result := TWorldItem(right).PrioritySolver - TWorldItem(left).PrioritySolver;
end;
procedure TLandscape.UpdateRadar(AX, AY: Word);
var
mapTile: TMapCell;
tile: TWorldItem;
staticItems, tiles: TList;
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 := TList.Create;
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
UpdateStaticsPriority(TStaticItem(staticItems.Items[i]), i + 1);
tiles.Add(staticItems.Items[i]);
end;
ListSort(tiles, @Compare);
if tiles.Count > 0 then
begin
tile := TWorldItem(tiles.Items[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: TList);
var
i: Integer;
begin
for i := 0 to AStatics.Count - 1 do
UpdateStaticsPriority(TStaticItem(AStatics.Items[i]), i + 1);
ListSort(AStatics, @Compare);
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.OnBlockChanged(ABlock: TMulBlock);
begin
// Do nothing for now
end;
procedure TLandscape.OnRemoveCachedObject(AObject: TObject);
var
block: TBlock;
begin
block := AObject as TBlock;
if block <> nil then
begin
if block.Map.Changed then SaveBlock(block.Map);
if block.Static.Changed then SaveBlock(block.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), TObject(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), TObject(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: TStaticBlock;
index: TGenericIndex;
begin
FMap.Position := ((AX * FHeight) + AY) * 196;
map := TMapBlock.Create(FMap, AX, AY);
map.OnChanged := @OnBlockChanged;
FStaIdx.Position := ((AX * FHeight) + AY) * 12;
index := TGenericIndex.Create(FStaIdx);
statics := TSeperatedStaticBlock.Create(FStatics, index, AX, AY);
statics.OnChanged := @OnBlockChanged;
index.Free;
Result := TBlock.Create(map, statics);
FBlockCache.StoreID(GetID(AX, AY), Result);
end;
//Intelligent write: replace if possible, otherwise extend
procedure TLandscape.Flush;
{var
blockID, blockType: Integer;
worldBlock: TWorldBlock;
index: TGenericIndex;
i, j, size: Integer;}
begin
{for blockID := 0 to FWidth * FHeight - 1 do
begin
for blockType := 0 to 1 do
begin
worldBlock := FPersistentBlocks[blockID][blockType];
if Assigned(worldBlock) and worldBlock.Changed then
begin
if worldBlock is TMapBlock then
begin
FMap.Position := ((worldBlock.X * FHeight) + worldBlock.Y) * 196;
worldBlock.Write(FMap);
for i := 0 to 63 do
TMapBlock(worldBlock).Cells[i].InitOriginalState;
worldBlock.CleanUp;
end else if worldBlock is TStaticBlock then
begin
FStaIdx.Position := ((worldBlock.X * FHeight) + worldBlock.Y) * 12;
index := TGenericIndex.Create(FStaIdx);
size := worldBlock.GetSize;
if (size > index.Size) or (index.Lookup = LongInt($FFFFFFFF)) then
begin
FStatics.Position := FStatics.Size;
index.Lookup := FStatics.Position;
end;
if size = 0 then
index.Lookup := LongInt($FFFFFFFF)
else
begin
index.Size := size;
FStatics.Position := index.Lookup;
worldBlock.Write(FStatics);
end;
FStaIdx.Seek(-12, soFromCurrent);
index.Write(FStaIdx);
index.Free;
for i := 0 to 63 do
for j := 0 to TSeperatedStaticBlock(worldBlock).Cells[i].Count - 1 do
TStaticItem(TSeperatedStaticBlock(worldBlock).Cells[i].Items[j]).InitOriginalState;
worldBlock.CleanUp;
end;
end;
end;
end;}
FBlockCache.Clear;
end;
procedure TLandscape.SaveBlock(AWorldBlock: TWorldBlock);
var
i, j, size: Integer;
index: TGenericIndex;
begin
if AWorldBlock is TMapBlock then
begin
FMap.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 196;
AWorldBlock.Write(FMap);
for i := 0 to 63 do
TMapBlock(AWorldBlock).Cells[i].InitOriginalState;
AWorldBlock.CleanUp;
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 = LongInt($FFFFFFFF)) then
begin
FStatics.Position := FStatics.Size;
index.Lookup := FStatics.Position;
end;
if size = 0 then
index.Lookup := LongInt($FFFFFFFF)
else
begin
index.Size := size;
FStatics.Position := index.Lookup;
AWorldBlock.Write(FStatics);
end;
FStaIdx.Seek(-12, soFromCurrent);
index.Write(FStaIdx);
index.Free;
for i := 0 to 63 do
for j := 0 to TSeperatedStaticBlock(AWorldBlock).Cells[i].Count - 1 do
TStaticItem(TSeperatedStaticBlock(AWorldBlock).Cells[i].Items[j]).InitOriginalState;
AWorldBlock.CleanUp;
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.UpdateStaticsPriority(AStaticItem: TStaticItem;
APrioritySolver: Integer);
var
staticTileData: TStaticTileData;
begin
staticTileData := FTiledataProvider.StaticTiles[AStaticItem.TileID];
AStaticItem.PriorityBonus := 0;
if not ((staticTileData.Flags and tdfBackground) = tdfBackground) then
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;
if staticTileData.Height > 0 then
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;
AStaticItem.Priority := AStaticItem.Z + AStaticItem.PriorityBonus;
AStaticItem.PrioritySolver := APrioritySolver;
end;
procedure TLandscape.OnDrawMapPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
x, y: Word;
cell: TMapCell;
subscriptions: TLinkedList;
item: PLinkedItem;
packet: TDrawMapPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
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)];
item := nil;
while subscriptions.Iterate(item) do
CEDServerInstance.SendPacket(TNetState(item^.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: TList;
i: Integer;
subscriptions: TLinkedList;
item: PLinkedItem;
packet: TInsertStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
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)];
item := nil;
while subscriptions.Iterate(item) do
CEDServerInstance.SendPacket(TNetState(item^.Data), packet, False);
packet.Free;
UpdateRadar(x, y);
end;
end;
procedure TLandscape.OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
block: TSeperatedStaticBlock;
i: Integer;
statics: TList;
staticInfo: TStaticInfo;
staticItem: TStaticItem;
subscriptions: TLinkedList;
item: PLinkedItem;
packet: TDeleteStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
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 := TStaticItem(statics.Items[i]);
if (staticItem.Z = staticInfo.Z) and
(staticItem.TileID = staticInfo.TileID) and
(staticItem.Hue = staticInfo.Hue) then
begin
packet := TDeleteStaticPacket.Create(staticItem);
statics.Delete(i);
staticItem.Delete;
subscriptions := FBlockSubscriptions[(staticInfo.Y div 8) * FWidth + (staticInfo.X div 8)];
item := nil;
while subscriptions.Iterate(item) do
CEDServerInstance.SendPacket(TNetState(item^.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, j: Integer;
statics: TList;
staticInfo: TStaticInfo;
staticItem: TStaticItem;
newZ: ShortInt;
subscriptions: TLinkedList;
item: PLinkedItem;
packet: TElevateStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
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 := TStaticItem(statics.Items[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)];
item := nil;
while subscriptions.Iterate(item) do
CEDServerInstance.SendPacket(TNetState(item^.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: TList;
staticInfo: TStaticInfo;
staticItem: TStaticItem;
newX, newY: Word;
subscriptions: TLinkedList;
item: PLinkedItem;
insertPacket: TInsertStaticPacket;
deletePacket: TDeleteStaticPacket;
movePacket: TMoveStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
staticItem := nil;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 1);
newY := EnsureRange(ABuffer.ReadWord, 0, FCellHeight - 1);
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 := TStaticItem(statics.Items[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.Remove(staticItem);
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)];
item := nil;
while subscriptions.Iterate(item) do
sourceSubscriptions.Add(item^.Data);
targetSubscriptions := TList.Create;
subscriptions := FBlockSubscriptions[(newY div 8) * FWidth + (newX div 8)];
item := nil;
while subscriptions.Iterate(item) do
targetSubscriptions.Add(item^.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;
end;
end;
end;
procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream;
ANetState: TNetState);
var
block: TSeperatedStaticBlock;
i, j: Integer;
statics: TList;
staticInfo: TStaticInfo;
staticItem: TStaticItem;
newHue: Word;
subscriptions: TLinkedList;
item: PLinkedItem;
packet: THueStaticPacket;
begin
if not ValidateAccess(ANetState, alNormal) then Exit;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
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 := TStaticItem(statics.Items[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)];
item := nil;
while subscriptions.Iterate(item) do
CEDServerInstance.SendPacket(TNetState(item^.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: TList;
operations: TList;
clients: array of record
NetState: TNetState;
Blocks: TBlockCoordsArray;
end;
netState: TNetState;
subscriptions: TLinkedList;
item: 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 := 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;
subscriptions := FBlockSubscriptions[realBlockY * FWidth + realBlockX];
for i := Low(clients) to High(clients) do
begin
item := nil;
while subscriptions.Iterate(item) do
begin
if TNetState(item^.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
subscriptions := FBlockSubscriptions[blockY * FWidth + blockX];
for i := Low(clients) to High(clients) do
begin
item := nil;
while subscriptions.Iterate(item) do
begin
if TNetState(item^.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.