- Added dynamic tiledata loading (everything after $4000 will be treated as static)

- Fixed server's TLandscape to validate statics and throw errors if no tiledata entry is found
This commit is contained in:
Andreas Schneider 2009-12-17 23:01:06 +01:00
parent b0b014f66a
commit bdc97b89f5
5 changed files with 2086 additions and 2054 deletions

View File

@ -1,156 +1,171 @@
(*
* 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 UTileDataProvider;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, UMulProvider, UMulBlock, UTiledata;
type
TLandTileDataArray = array[$0..$3FFF] of TLandTileData;
TStaticTileDataArray = array[$0..$3FFF] of TStaticTileData;
{ TTiledataProvider }
TTiledataProvider = class(TMulProvider)
constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; override;
constructor Create(AData: string; AReadOnly: Boolean = False); overload; override;
destructor Destroy; override;
protected
FLandTiles: TLandTileDataArray;
FStaticTiles: TStaticTileDataArray;
procedure InitArray;
function CalculateOffset(AID: Integer): Integer; override;
function GetData(AID, AOffset: Integer): TMulBlock; override;
procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override;
function GetTileData(AID: Integer): TTiledata;
public
function GetBlock(AID: Integer): TMulBlock; override;
property LandTiles: TLandTileDataArray read FLandTiles;
property StaticTiles: TStaticTileDataArray read FStaticTiles;
property TileData[AID: Integer]: TTiledata read GetTileData; //all tiles, no cloning
end;
implementation
{ TTiledataProvider }
function TTiledataProvider.CalculateOffset(AID: Integer): Integer;
begin
Result := GetTileDataOffset(AID);
end;
constructor TTiledataProvider.Create(AData: TStream; AReadOnly: Boolean = False);
begin
inherited;
InitArray;
end;
constructor TTiledataProvider.Create(AData: string; AReadOnly: Boolean = False);
begin
inherited;
InitArray;
end;
destructor TTiledataProvider.Destroy;
var
i: Integer;
begin
for i := $0 to $3FFF do
begin
FreeAndNil(FLandTiles[i]);
FreeAndNil(FStaticTiles[i]);
end;
inherited;
end;
function TTiledataProvider.GetBlock(AID: Integer): TMulBlock;
begin
Result := GetData(AID, 0);
end;
function TTiledataProvider.GetData(AID, AOffset: Integer): TMulBlock;
begin
if AID < $4000 then
Result := TMulBlock(FLandTiles[AID].Clone)
else
Result := TMulBlock(FStaticTiles[AID - $4000].Clone);
Result.ID := AID;
Result.OnChanged := @OnChanged;
Result.OnFinished := @OnFinished;
end;
procedure TTiledataProvider.InitArray;
var
i: Integer;
begin
for i := $0 to $3FFF do
begin
FData.Position := GetTileDataOffset(i);
FLandTiles[i] := TLandTileData.Create(FData);
end;
for i := $0 to $3FFF do
begin
FData.Position := GetTileDataOffset($4000 + i);
FStaticTiles[i] := TStaticTileData.Create(FData);
end;
end;
procedure TTiledataProvider.SetData(AID, AOffset: Integer;
ABlock: TMulBlock);
begin
if AID < $4000 then
begin
FreeAndNil(FLandTiles[AID]);
FLandTiles[AID] := TLandTileData(ABlock.Clone);
end else
begin
FreeAndNil(FStaticTiles[AID - $4000]);
FStaticTiles[AID - $4000] := TStaticTileData(ABlock.Clone);
end;
if not FReadOnly then
begin
FData.Position := AOffset;
ABlock.Write(FData);
end;
end;
function TTiledataProvider.GetTileData(AID: Integer): TTiledata;
begin
if AID < $4000 then
Result := FLandTiles[AID]
else
Result := FStaticTiles[AID - $4000];
end;
end.
(*
* 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 UTileDataProvider;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, UMulProvider, UMulBlock, UTiledata;
type
TLandTileDataArray = array[$0..$3FFF] of TLandTileData;
TStaticTileDataArray = array of TStaticTileData;
{ TTiledataProvider }
TTiledataProvider = class(TMulProvider)
constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; override;
constructor Create(AData: string; AReadOnly: Boolean = False); overload; override;
destructor Destroy; override;
protected
FLandTiles: TLandTileDataArray;
FStaticTiles: TStaticTileDataArray;
FStaticCount: Cardinal;
procedure InitArray;
function CalculateOffset(AID: Integer): Integer; override;
function GetData(AID, AOffset: Integer): TMulBlock; override;
procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override;
function GetTileData(AID: Integer): TTiledata;
public
function GetBlock(AID: Integer): TMulBlock; override;
property LandTiles: TLandTileDataArray read FLandTiles;
property StaticTiles: TStaticTileDataArray read FStaticTiles;
property TileData[AID: Integer]: TTiledata read GetTileData; //all tiles, no cloning
property StaticCount: Cardinal read FStaticCount;
end;
implementation
uses
Logging;
{ TTiledataProvider }
function TTiledataProvider.CalculateOffset(AID: Integer): Integer;
begin
Result := GetTileDataOffset(AID);
end;
constructor TTiledataProvider.Create(AData: TStream; AReadOnly: Boolean = False);
begin
inherited;
InitArray;
end;
constructor TTiledataProvider.Create(AData: string; AReadOnly: Boolean = False);
begin
inherited;
InitArray;
end;
destructor TTiledataProvider.Destroy;
var
i: Integer;
begin
for i := $0 to $3FFF do
FreeAndNil(FLandTiles[i]);
for i := 0 to FStaticCount - 1 do
FreeAndNil(FStaticTiles[i]);
inherited Destroy;
end;
function TTiledataProvider.GetBlock(AID: Integer): TMulBlock;
begin
Result := GetData(AID, 0);
end;
function TTiledataProvider.GetData(AID, AOffset: Integer): TMulBlock;
begin
if AID < $4000 then
Result := TMulBlock(FLandTiles[AID].Clone)
else
Result := TMulBlock(FStaticTiles[AID - $4000].Clone);
Result.ID := AID;
Result.OnChanged := @OnChanged;
Result.OnFinished := @OnFinished;
end;
procedure TTiledataProvider.InitArray;
var
i: Integer;
begin
FData.Position := 0;
Logger.Send([lcInfo], 'Loading $4000 LandTiledata Entries');
for i := $0 to $3FFF do
begin
if i mod 32 = 0 then
FData.Seek(4, soFromCurrent);
FLandTiles[i] := TLandTileData.Create(FData);
end;
FStaticCount := ((FData.Size - FData.Position) div StaticTileGroupSize) * 32;
Logger.Send([lcInfo], 'Loading $%x StaticTiledata Entries', [FStaticCount]);
SetLength(FStaticTiles, FStaticCount);
for i := 0 to FStaticCount - 1 do
begin
if i mod 32 = 0 then
FData.Seek(4, soFromCurrent);
FStaticTiles[i] := TStaticTileData.Create(FData);
end;
end;
procedure TTiledataProvider.SetData(AID, AOffset: Integer;
ABlock: TMulBlock);
begin
if AID >= $4000 + FStaticCount then
Exit;
if AID < $4000 then
begin
FreeAndNil(FLandTiles[AID]);
FLandTiles[AID] := TLandTileData(ABlock.Clone);
end else
begin
FreeAndNil(FStaticTiles[AID - $4000]);
FStaticTiles[AID - $4000] := TStaticTileData(ABlock.Clone);
end;
if not FReadOnly then
begin
FData.Position := AOffset;
ABlock.Write(FData);
end;
end;
function TTiledataProvider.GetTileData(AID: Integer): TTiledata;
begin
if AID < $4000 then
Result := FLandTiles[AID]
else
Result := FStaticTiles[AID - $4000];
end;
end.

File diff suppressed because it is too large Load Diff

View File

@ -1,218 +1,218 @@
(*
* 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 UPacketHandlers;
interface
uses
Classes, SysUtils, dzlib, math, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList, URegions;
type
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState) of object;
{ TPacketHandler }
TPacketHandler = class(TObject)
constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
procedure Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
protected
FLength: Cardinal;
FPacketProcessor: TPacketProcessor;
FPacketProcessorMethod: TPacketProcessorMethod;
published
property PacketLength: Cardinal read FLength;
end;
var
PacketHandlers: array[0..$FF] of TPacketHandler;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; overload;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean; overload;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
implementation
uses
UCEDServer, UPackets, UConnectionHandling, UAdminHandling, UClientHandling;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
begin
Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel);
end;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean;
var
i,j: Word;
region: TRegion;
rect: TRect;
begin
if not ValidateAccess(ANetState, ALevel) then Exit(False);
if (ANetState.Account.Regions.Count = 0) or
(ANetState.Account.AccessLevel >= alAdministrator) then Exit(True); //no restrictions
Result := False;
for i := 0 to ANetState.Account.Regions.Count - 1 do
begin
region := Config.Regions.Find(ANetState.Account.Regions[i]);
if region <> nil then
begin
for j := 0 to region.Areas.Count - 1 do
begin
rect := region.Areas.Rects[j];
if (AX >= rect.Left) and
(AX < rect.Right) and
(AY >= rect.Top) and
(AY < rect.Bottom) then
Exit(True);
end;
end;
end;
end;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
begin
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);
PacketHandlers[AID] := APacketHandler;
end;
{ TPacketHandler }
constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := APacketProcessor;
FPacketProcessorMethod := nil;
end;
constructor TPacketHandler.Create(ALength: Cardinal;
APacketProcessorMethod: TPacketProcessorMethod);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := nil;
FPacketProcessorMethod := APacketProcessorMethod;
end;
procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
if Assigned(FPacketProcessor) then
FPacketProcessor(ABuffer, ANetState)
else if Assigned(FPacketProcessorMethod) then
FPacketProcessorMethod(ABuffer, ANetState);
end;
procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
uncompStream: TEnhancedMemoryStream;
uncompBuffer: TDecompressionStream;
targetSize: Cardinal;
packetID: Byte;
begin
targetSize := ABuffer.ReadCardinal;
uncompBuffer := TDecompressionStream.Create(ABuffer);
uncompStream := TEnhancedMemoryStream.Create;
try
uncompStream.CopyFrom(uncompBuffer, targetSize);
uncompStream.Position := 0;
packetID := uncompStream.ReadByte;
if PacketHandlers[packetID] <> nil then
begin
if PacketHandlers[PacketID].PacketLength = 0 then
uncompStream.Position := uncompStream.Position + 4;
uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
PacketHandlers[PacketID].Process(uncompStream, ANetState);
uncompStream.Unlock;
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
ANetState.ReceiveQueue.Clear;
CEDServerInstance.Disconnect(ANetState.Socket);
end;
finally
if uncompBuffer <> nil then uncompBuffer.Free;
if uncompStream <> nil then uncompStream.Free;
end;
end;
procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
coords: TBlockCoordsArray;
begin
if not ValidateAccess(ANetState, alView) then Exit;
SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords));
ABuffer.Read(coords[0], Length(coords) * SizeOf(TBlockCoords));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TBlockPacket.Create(coords, ANetState)));
end;
procedure OnFreeBlockPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
x, y: Word;
blockSubscriptions: TLinkedList;
begin
if not ValidateAccess(ANetState, alView) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
blockSubscriptions := CEDServerInstance.Landscape.BlockSubscriptions[X, Y];
if blockSubscriptions <> nil then
begin
blockSubscriptions.Delete(ANetState);
ANetState.Subscriptions.Remove(blockSubscriptions);
end;
end;
procedure OnNoOpPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
//no operation
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
PacketHandlers[i] := nil;
PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlerPacket);
PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);
PacketHandlers[$04] := TPacketHandler.Create(0, @OnRequestBlocksPacket);
PacketHandlers[$05] := TPacketHandler.Create(5, @OnFreeBlockPacket);
//$06-$0B handled by landscape
PacketHandlers[$0C] := TPacketHandler.Create(0, @OnClientHandlerPacket);
//$0D handled by radarmap
//$0E handled by landscape
PacketHandlers[$FF] := TPacketHandler.Create(1, @OnNoOpPacket);
finalization
for i := 0 to $FF do
if PacketHandlers[i] <> nil then
PacketHandlers[i].Free;
{$WARNINGS ON}
end.
(*
* 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 UPacketHandlers;
interface
uses
Classes, SysUtils, dzlib, UConfig, UNetState, UEnhancedMemoryStream, UEnums,
ULinkedList, URegions;
type
TPacketProcessor = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
TPacketProcessorMethod = procedure(ABuffer: TEnhancedMemoryStream; ANetState: TNetState) of object;
{ TPacketHandler }
TPacketHandler = class(TObject)
constructor Create(ALength: Cardinal; APacketProcessor: TPacketProcessor); overload;
constructor Create(ALength: Cardinal; APacketProcessorMethod: TPacketProcessorMethod); overload;
procedure Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
protected
FLength: Cardinal;
FPacketProcessor: TPacketProcessor;
FPacketProcessorMethod: TPacketProcessorMethod;
published
property PacketLength: Cardinal read FLength;
end;
var
PacketHandlers: array[0..$FF] of TPacketHandler;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean; overload;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean; overload;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
implementation
uses
UCEDServer, UPackets, UConnectionHandling, UAdminHandling, UClientHandling;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel): Boolean;
begin
Result := (ANetState.Account <> nil) and (ANetState.Account.AccessLevel >= ALevel);
end;
function ValidateAccess(ANetState: TNetState; ALevel: TAccessLevel; AX, AY: Cardinal): Boolean;
var
i,j: Word;
region: TRegion;
rect: TRect;
begin
if not ValidateAccess(ANetState, ALevel) then Exit(False);
if (ANetState.Account.Regions.Count = 0) or
(ANetState.Account.AccessLevel >= alAdministrator) then Exit(True); //no restrictions
Result := False;
for i := 0 to ANetState.Account.Regions.Count - 1 do
begin
region := Config.Regions.Find(ANetState.Account.Regions[i]);
if region <> nil then
begin
for j := 0 to region.Areas.Count - 1 do
begin
rect := region.Areas.Rects[j];
if (AX >= rect.Left) and
(AX < rect.Right) and
(AY >= rect.Top) and
(AY < rect.Bottom) then
Exit(True);
end;
end;
end;
end;
procedure RegisterPacketHandler(AID: Byte; APacketHandler: TPacketHandler);
begin
if Assigned(PacketHandlers[AID]) then FreeAndNil(PacketHandlers[AID]);
PacketHandlers[AID] := APacketHandler;
end;
{ TPacketHandler }
constructor TPacketHandler.Create(ALength: Cardinal; APacketProcessor: TPacketProcessor);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := APacketProcessor;
FPacketProcessorMethod := nil;
end;
constructor TPacketHandler.Create(ALength: Cardinal;
APacketProcessorMethod: TPacketProcessorMethod);
begin
inherited Create;
FLength := ALength;
FPacketProcessor := nil;
FPacketProcessorMethod := APacketProcessorMethod;
end;
procedure TPacketHandler.Process(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
if Assigned(FPacketProcessor) then
FPacketProcessor(ABuffer, ANetState)
else if Assigned(FPacketProcessorMethod) then
FPacketProcessorMethod(ABuffer, ANetState);
end;
procedure OnCompressedPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
uncompStream: TEnhancedMemoryStream;
uncompBuffer: TDecompressionStream;
targetSize: Cardinal;
packetID: Byte;
begin
targetSize := ABuffer.ReadCardinal;
uncompBuffer := TDecompressionStream.Create(ABuffer);
uncompStream := TEnhancedMemoryStream.Create;
try
uncompStream.CopyFrom(uncompBuffer, targetSize);
uncompStream.Position := 0;
packetID := uncompStream.ReadByte;
if PacketHandlers[packetID] <> nil then
begin
if PacketHandlers[PacketID].PacketLength = 0 then
uncompStream.Position := uncompStream.Position + 4;
uncompStream.Lock(uncompStream.Position, uncompStream.Size - uncompStream.Position);
PacketHandlers[PacketID].Process(uncompStream, ANetState);
uncompStream.Unlock;
end else
begin
Writeln(TimeStamp, 'Dropping client due to unknown packet: ', ANetState.Socket.PeerAddress);
ANetState.ReceiveQueue.Clear;
CEDServerInstance.Disconnect(ANetState.Socket);
end;
finally
if uncompBuffer <> nil then uncompBuffer.Free;
if uncompStream <> nil then uncompStream.Free;
end;
end;
procedure OnRequestBlocksPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
coords: TBlockCoordsArray;
begin
if not ValidateAccess(ANetState, alView) then Exit;
SetLength(coords, (ABuffer.Size - ABuffer.Position) div SizeOf(TBlockCoords));
ABuffer.Read(coords[0], Length(coords) * SizeOf(TBlockCoords));
CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(TBlockPacket.Create(coords, ANetState)));
end;
procedure OnFreeBlockPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
var
x, y: Word;
blockSubscriptions: TLinkedList;
begin
if not ValidateAccess(ANetState, alView) then Exit;
x := ABuffer.ReadWord;
y := ABuffer.ReadWord;
blockSubscriptions := CEDServerInstance.Landscape.BlockSubscriptions[X, Y];
if blockSubscriptions <> nil then
begin
blockSubscriptions.Delete(ANetState);
ANetState.Subscriptions.Remove(blockSubscriptions);
end;
end;
procedure OnNoOpPacket(ABuffer: TEnhancedMemoryStream; ANetState: TNetState);
begin
//no operation
end;
{$WARNINGS OFF}
var
i: Integer;
initialization
for i := 0 to $FF do
PacketHandlers[i] := nil;
PacketHandlers[$01] := TPacketHandler.Create(0, @OnCompressedPacket);
PacketHandlers[$02] := TPacketHandler.Create(0, @OnConnectionHandlerPacket);
PacketHandlers[$03] := TPacketHandler.Create(0, @OnAdminHandlerPacket);
PacketHandlers[$04] := TPacketHandler.Create(0, @OnRequestBlocksPacket);
PacketHandlers[$05] := TPacketHandler.Create(5, @OnFreeBlockPacket);
//$06-$0B handled by landscape
PacketHandlers[$0C] := TPacketHandler.Create(0, @OnClientHandlerPacket);
//$0D handled by radarmap
//$0E handled by landscape
PacketHandlers[$FF] := TPacketHandler.Create(1, @OnNoOpPacket);
finalization
for i := 0 to $FF do
if PacketHandlers[i] <> nil then
PacketHandlers[i].Free;
{$WARNINGS ON}
end.

View File

@ -1,147 +1,148 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="multiloglaz"/>
</Item1>
<Item2>
<PackageName Value="lnetbase"/>
</Item2>
</RequiredPackages>
<Units Count="15">
<Unit0>
<Filename Value="cedserver.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="cedserver"/>
</Unit0>
<Unit1>
<Filename Value="UConfig.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UConfig"/>
</Unit1>
<Unit2>
<Filename Value="UCEDServer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UCEDServer"/>
</Unit2>
<Unit3>
<Filename Value="UNetState.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UNetState"/>
</Unit3>
<Unit4>
<Filename Value="UAccount.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UAccount"/>
</Unit4>
<Unit5>
<Filename Value="UConnectionHandling.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UConnectionHandling"/>
</Unit5>
<Unit6>
<Filename Value="URadarMap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="URadarMap"/>
</Unit6>
<Unit7>
<Filename Value="ULargeScaleOperations.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ULargeScaleOperations"/>
</Unit7>
<Unit8>
<Filename Value="../UInterfaces.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UInterfaces"/>
</Unit8>
<Unit9>
<Filename Value="UPacketHandlers.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UPacketHandlers"/>
</Unit9>
<Unit10>
<Filename Value="ULandscape.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ULandscape"/>
</Unit10>
<Unit11>
<Filename Value="UPackets.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UPackets"/>
</Unit11>
<Unit12>
<Filename Value="UAdminHandling.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UAdminHandling"/>
</Unit12>
<Unit13>
<Filename Value="UClientHandling.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UClientHandling"/>
</Unit13>
<Unit14>
<Filename Value="../UOLib/UStatics.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UStatics"/>
</Unit14>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Target>
<Filename Value="../bin/cedserver"/>
</Target>
<SearchPaths>
<IncludeFiles Value="../;../Imaging/"/>
<OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/>
<UnitOutputDirectory Value="../obj"/>
<SrcPath Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="0"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<UseHeaptrc Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-FE../bin/ "/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="7"/>
<General>
<Flags>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<TargetFileExt Value=".exe"/>
</General>
<VersionInfo>
<ProjectVersion Value=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="multiloglaz"/>
</Item1>
<Item2>
<PackageName Value="lnetbase"/>
</Item2>
</RequiredPackages>
<Units Count="15">
<Unit0>
<Filename Value="cedserver.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="cedserver"/>
</Unit0>
<Unit1>
<Filename Value="UConfig.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UConfig"/>
</Unit1>
<Unit2>
<Filename Value="UCEDServer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UCEDServer"/>
</Unit2>
<Unit3>
<Filename Value="UNetState.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UNetState"/>
</Unit3>
<Unit4>
<Filename Value="UAccount.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UAccount"/>
</Unit4>
<Unit5>
<Filename Value="UConnectionHandling.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UConnectionHandling"/>
</Unit5>
<Unit6>
<Filename Value="URadarMap.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="URadarMap"/>
</Unit6>
<Unit7>
<Filename Value="ULargeScaleOperations.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ULargeScaleOperations"/>
</Unit7>
<Unit8>
<Filename Value="../UInterfaces.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UInterfaces"/>
</Unit8>
<Unit9>
<Filename Value="UPacketHandlers.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UPacketHandlers"/>
</Unit9>
<Unit10>
<Filename Value="ULandscape.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="ULandscape"/>
</Unit10>
<Unit11>
<Filename Value="UPackets.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UPackets"/>
</Unit11>
<Unit12>
<Filename Value="UAdminHandling.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UAdminHandling"/>
</Unit12>
<Unit13>
<Filename Value="UClientHandling.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UClientHandling"/>
</Unit13>
<Unit14>
<Filename Value="../UOLib/UStatics.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="UStatics"/>
</Unit14>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="8"/>
<Target>
<Filename Value="../bin/cedserver"/>
</Target>
<SearchPaths>
<IncludeFiles Value="../;../Imaging/"/>
<OtherUnitFiles Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/>
<UnitOutputDirectory Value="../obj"/>
<SrcPath Value="../;../UOLib/;../MulProvider/;../Imaging/ZLib/"/>
</SearchPaths>
<Parsing>
<SyntaxOptions>
<CStyleOperator Value="False"/>
</SyntaxOptions>
</Parsing>
<CodeGeneration>
<SmartLinkUnit Value="True"/>
<Optimizations>
<OptimizationLevel Value="0"/>
</Optimizations>
</CodeGeneration>
<Linking>
<Debugging>
<GenerateDebugInfo Value="True"/>
<UseHeaptrc Value="True"/>
</Debugging>
<LinkSmart Value="True"/>
</Linking>
<Other>
<CustomOptions Value="-FE../bin/
"/>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
</CONFIG>

View File

@ -1,376 +1,376 @@
(*
* 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 UTiledata;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UMulBlock;
const
LandTileDataSize = 26;
LandTileGroupSize = 4 + 32 * LandTileDataSize;
StaticTileDataSize = 37;
StaticTileGroupSize = 4 + 32 * StaticTileDataSize;
type
TTileDataFlag = (tdfBackground, tdfWeapon, tdfTransparent, tdfTranslucent,
tdfWall, tdfDamaging, tdfImpassable, tdfWet, tdfUnknown1,
tdfSurface, tdfBridge, tdfGeneric, tdfWindow, tdfNoShoot,
tdfArticleA, tdfArticleAn, tdfInternal, tdfFoliage,
tdfPartialHue, tdfUnknown2, tdfMap, tdfContainer,
tdfWearable, tdfLightSource, tdfAnimation, tdfNoDiagonal,
tdfArtUsed, tdfArmor, tdfRoof, tdfDoor, tdfStairBack,
tdfStairRight);
TTileDataFlags = set of TTileDataFlag;
{ TTiledata }
TTiledata = class(TMulBlock)
protected
FFlags: TTileDataFlags;
FTileName: string;
public
property Flags: TTileDataFlags read FFlags write FFlags;
property TileName: string read FTileName write FTileName;
end;
{ TLandTiledata }
TLandTiledata = class(TTiledata)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TLandTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FTextureID: Word;
public
property TextureID: Word read FTextureID write FTextureID;
end;
{ TStaticTiledata }
TStaticTiledata = class(TTiledata)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TStaticTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FWeight: Byte;
FQuality: Byte;
FUnknown1: Word;
FUnknown2: Byte;
FQuantity: Byte;
FAnimID: Word;
FUnknown3: Byte;
FHue: Byte;
FUnknown4: Word;
FHeight: Byte;
public
property Weight: Byte read FWeight write FWeight;
property Quality: Byte read FQuality write FQuality;
property Unknown1: Word read FUnknown1 write FUnknown1;
property Unknown2: Byte read FUnknown2 write FUnknown2;
property Quantity: Byte read FQuantity write FQuantity;
property AnimID: Word read FAnimID write FAnimID;
property Unknown3: Byte read FUnknown3 write FUnknown3;
property Hue: Byte read FHue write FHue;
property Unknown4: Word read FUnknown4 write FUnknown4;
property Height: Byte read FHeight write FHeight;
end;
{ TLandTileGroup }
TLandTileGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TLandTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FUnknown: LongInt;
public
LandTileData: array[0..31] of TLandTiledata;
property Unknown: LongInt read FUnknown write FUnknown;
end;
{ TStaticTileGroup }
TStaticTileGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TStaticTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FUnknown: LongInt;
public
StaticTileData: array[0..31] of TStaticTiledata;
property Unknown: LongInt read FUnknown write FUnknown;
end;
function GetTileDataOffset(ABlock: Integer): Integer;
implementation
function GetTileDataOffset(ABlock: Integer): Integer;
var
group, tile: Integer;
begin
if ABlock > $3FFF then
begin
ABlock := ABlock - $4000;
group := ABlock div 32;
tile := ABlock mod 32;
Result := 512 * LandTileGroupSize + group * StaticTileGroupSize + 4
+ tile * StaticTileDataSize;
end else
begin
group := ABlock div 32;
tile := ABlock mod 32;
Result := group * LandTileGroupSize + 4 + tile * LandTileDataSize;
end;
end;
{ TLandTiledata }
constructor TLandTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if assigned(AData) then
begin
AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FTextureID, SizeOf(Word));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TLandTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TLandTiledata.Clone: TLandTiledata;
begin
Result := TLandTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FTextureID := FTextureID;
Result.FTileName := FTileName;
end;
procedure TLandTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FTextureID, SizeOf(Word));
AData.Write(PChar(FTileName)^, 20);
end;
function TLandTiledata.GetSize: Integer;
begin
GetSize := LandTileDataSize;
end;
{ TStaticTiledata}
constructor TStaticTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if assigned(AData) then
begin
AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FWeight, SizeOf(Byte));
AData.Read(FQuality, SizeOf(Byte));
AData.Read(FUnknown1, SizeOf(Word));
AData.Read(FUnknown2, SizeOf(Byte));
AData.Read(FQuantity, SizeOf(Byte));
AData.Read(FAnimID, SizeOf(Word));
AData.Read(FUnknown3, SizeOf(Byte));
AData.Read(FHue, SizeOf(Byte));
AData.Read(FUnknown4, SizeOf(Word));
AData.Read(FHeight, SizeOf(Byte));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TStaticTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TStaticTiledata.Clone: TStaticTiledata;
begin
Result := TStaticTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FWeight := FWeight;
Result.FQuality := FQuality;
Result.FUnknown1 := FUnknown1;
Result.FUnknown2 := FUnknown2;
Result.FQuantity := FQuantity;
Result.FAnimID := FAnimID;
Result.FUnknown3 := FUnknown3;
Result.FHue := FHue;
Result.FUnknown4 := FUnknown4;
Result.FHeight := FHeight;
Result.FTileName := FTileName;
end;
procedure TStaticTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FWeight, SizeOf(Byte));
AData.Write(FQuality, SizeOf(Byte));
AData.Write(FUnknown1, SizeOf(Word));
AData.Write(FUnknown2, SizeOf(Byte));
AData.Write(FQuantity, SizeOf(Byte));
AData.Write(FAnimID, SizeOf(Word));
AData.Write(FUnknown3, SizeOf(Byte));
AData.Write(FHue, SizeOf(Byte));
AData.Write(FUnknown4, SizeOf(Word));
AData.Write(FHeight, SizeOf(Byte));
AData.Write(PChar(FTileName)^, 20);
end;
function TStaticTiledata.GetSize: Integer;
begin
GetSize := StaticTileDataSize;
end;
{ TLandTileGroup }
constructor TLandTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
LandTileData[i] := TLandTiledata.Create(AData);
end;
destructor TLandTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
LandTileData[i].Free;
inherited;
end;
function TLandTileGroup.Clone: TLandTileGroup;
var
i: Integer;
begin
Result := TLandTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.LandTileData[i] := LandTileData[i].Clone;
end;
procedure TLandTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
LandTileData[i].Write(AData);
end;
function TLandTileGroup.GetSize: Integer;
begin
GetSize := LandTileGroupSize;
end;
{ TStaticTileGroup }
constructor TStaticTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
StaticTileData[i] := TStaticTiledata.Create(AData);
end;
destructor TStaticTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
StaticTileData[i].Free;
inherited;
end;
function TStaticTileGroup.Clone: TStaticTileGroup;
var
i: Integer;
begin
Result := TStaticTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.StaticTileData[i] := StaticTileData[i].Clone;
end;
procedure TStaticTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
StaticTileData[i].Write(AData);
end;
function TStaticTileGroup.GetSize: Integer;
begin
GetSize := StaticTileGroupSize;
end;
end.
(*
* 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 UTiledata;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UMulBlock;
const
LandTileDataSize = 26;
LandTileGroupSize = 4 + 32 * LandTileDataSize;
StaticTileDataSize = 37;
StaticTileGroupSize = 4 + 32 * StaticTileDataSize;
type
TTileDataFlag = (tdfBackground, tdfWeapon, tdfTransparent, tdfTranslucent,
tdfWall, tdfDamaging, tdfImpassable, tdfWet, tdfUnknown1,
tdfSurface, tdfBridge, tdfGeneric, tdfWindow, tdfNoShoot,
tdfArticleA, tdfArticleAn, tdfInternal, tdfFoliage,
tdfPartialHue, tdfUnknown2, tdfMap, tdfContainer,
tdfWearable, tdfLightSource, tdfAnimation, tdfNoDiagonal,
tdfArtUsed, tdfArmor, tdfRoof, tdfDoor, tdfStairBack,
tdfStairRight);
TTileDataFlags = set of TTileDataFlag;
{ TTiledata }
TTiledata = class(TMulBlock)
protected
FFlags: TTileDataFlags;
FTileName: string;
public
property Flags: TTileDataFlags read FFlags write FFlags;
property TileName: string read FTileName write FTileName;
end;
{ TLandTiledata }
TLandTiledata = class(TTiledata)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TLandTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FTextureID: Word;
public
property TextureID: Word read FTextureID write FTextureID;
end;
{ TStaticTiledata }
TStaticTiledata = class(TTiledata)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TStaticTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FWeight: Byte;
FQuality: Byte;
FUnknown1: Word;
FUnknown2: Byte;
FQuantity: Byte;
FAnimID: Word;
FUnknown3: Byte;
FHue: Byte;
FUnknown4: Word;
FHeight: Byte;
public
property Weight: Byte read FWeight write FWeight;
property Quality: Byte read FQuality write FQuality;
property Unknown1: Word read FUnknown1 write FUnknown1;
property Unknown2: Byte read FUnknown2 write FUnknown2;
property Quantity: Byte read FQuantity write FQuantity;
property AnimID: Word read FAnimID write FAnimID;
property Unknown3: Byte read FUnknown3 write FUnknown3;
property Hue: Byte read FHue write FHue;
property Unknown4: Word read FUnknown4 write FUnknown4;
property Height: Byte read FHeight write FHeight;
end;
{ TLandTileGroup }
TLandTileGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TLandTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FUnknown: LongInt;
public
LandTileData: array[0..31] of TLandTiledata;
property Unknown: LongInt read FUnknown write FUnknown;
end;
{ TStaticTileGroup }
TStaticTileGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TStaticTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FUnknown: LongInt;
public
StaticTileData: array[0..31] of TStaticTiledata;
property Unknown: LongInt read FUnknown write FUnknown;
end;
function GetTileDataOffset(ABlock: Integer): Integer;
implementation
function GetTileDataOffset(ABlock: Integer): Integer;
var
group, tile: Integer;
begin
if ABlock > $3FFF then
begin
ABlock := ABlock - $4000;
group := ABlock div 32;
tile := ABlock mod 32;
Result := 512 * LandTileGroupSize + group * StaticTileGroupSize + 4
+ tile * StaticTileDataSize;
end else
begin
group := ABlock div 32;
tile := ABlock mod 32;
Result := group * LandTileGroupSize + 4 + tile * LandTileDataSize;
end;
end;
{ TLandTiledata }
constructor TLandTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if assigned(AData) then
begin
AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FTextureID, SizeOf(Word));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TLandTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TLandTiledata.Clone: TLandTiledata;
begin
Result := TLandTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FTextureID := FTextureID;
Result.FTileName := FTileName;
end;
procedure TLandTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FTextureID, SizeOf(Word));
AData.Write(PChar(FTileName)^, 20);
end;
function TLandTiledata.GetSize: Integer;
begin
GetSize := LandTileDataSize;
end;
{ TStaticTiledata}
constructor TStaticTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if AData <> nil then
begin
AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FWeight, SizeOf(Byte));
AData.Read(FQuality, SizeOf(Byte));
AData.Read(FUnknown1, SizeOf(Word));
AData.Read(FUnknown2, SizeOf(Byte));
AData.Read(FQuantity, SizeOf(Byte));
AData.Read(FAnimID, SizeOf(Word));
AData.Read(FUnknown3, SizeOf(Byte));
AData.Read(FHue, SizeOf(Byte));
AData.Read(FUnknown4, SizeOf(Word));
AData.Read(FHeight, SizeOf(Byte));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TStaticTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TStaticTiledata.Clone: TStaticTiledata;
begin
Result := TStaticTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FWeight := FWeight;
Result.FQuality := FQuality;
Result.FUnknown1 := FUnknown1;
Result.FUnknown2 := FUnknown2;
Result.FQuantity := FQuantity;
Result.FAnimID := FAnimID;
Result.FUnknown3 := FUnknown3;
Result.FHue := FHue;
Result.FUnknown4 := FUnknown4;
Result.FHeight := FHeight;
Result.FTileName := FTileName;
end;
procedure TStaticTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FWeight, SizeOf(Byte));
AData.Write(FQuality, SizeOf(Byte));
AData.Write(FUnknown1, SizeOf(Word));
AData.Write(FUnknown2, SizeOf(Byte));
AData.Write(FQuantity, SizeOf(Byte));
AData.Write(FAnimID, SizeOf(Word));
AData.Write(FUnknown3, SizeOf(Byte));
AData.Write(FHue, SizeOf(Byte));
AData.Write(FUnknown4, SizeOf(Word));
AData.Write(FHeight, SizeOf(Byte));
AData.Write(PChar(FTileName)^, 20);
end;
function TStaticTiledata.GetSize: Integer;
begin
GetSize := StaticTileDataSize;
end;
{ TLandTileGroup }
constructor TLandTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
LandTileData[i] := TLandTiledata.Create(AData);
end;
destructor TLandTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
LandTileData[i].Free;
inherited;
end;
function TLandTileGroup.Clone: TLandTileGroup;
var
i: Integer;
begin
Result := TLandTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.LandTileData[i] := LandTileData[i].Clone;
end;
procedure TLandTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
LandTileData[i].Write(AData);
end;
function TLandTileGroup.GetSize: Integer;
begin
GetSize := LandTileGroupSize;
end;
{ TStaticTileGroup }
constructor TStaticTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
StaticTileData[i] := TStaticTiledata.Create(AData);
end;
destructor TStaticTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
StaticTileData[i].Free;
inherited;
end;
function TStaticTileGroup.Clone: TStaticTileGroup;
var
i: Integer;
begin
Result := TStaticTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.StaticTileData[i] := StaticTileData[i].Clone;
end;
procedure TStaticTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
StaticTileData[i].Write(AData);
end;
function TStaticTileGroup.GetSize: Integer;
begin
GetSize := StaticTileGroupSize;
end;
end.