(* * 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 2008 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); 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, 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 Write(TimeStamp, 'Creating Cache'); FBlockCache := TCacheManager.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 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; begin FBlockCache.Clear; //Clear writes modified blocks before removing them from the cache 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; index.Size := size; if size = 0 then index.Lookup := LongInt($FFFFFFFF) else begin 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 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)]; 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 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)]; 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 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 := 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 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 := 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 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 := 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 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 := 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.