- Changed TAnimDataProvider to load as much animdata as the input files provides

- Added TBufferedStream.GetSize
- Added TIndexedMulProvider.EntryCount
- Added TAnimDataProvider.AnimCount
- Added TLandscape.MaxStaticID
- Some more code cleanups
This commit is contained in:
Andreas Schneider 2009-12-18 00:17:42 +01:00
parent bdc97b89f5
commit 73e704e5fa
5 changed files with 541 additions and 511 deletions

View File

@ -183,6 +183,7 @@ type
FOnStaticHued: TStaticChangedEvent; FOnStaticHued: TStaticChangedEvent;
FOpenRequests: TBits; FOpenRequests: TBits;
FWriteMap: TBits; FWriteMap: TBits;
FMaxStaticID: Cardinal;
{ Methods } { Methods }
function GetMapBlock(AX, AY: Word): TMapBlock; function GetMapBlock(AX, AY: Word): TMapBlock;
function GetMapCell(AX, AY: Word): TMapCell; function GetMapCell(AX, AY: Word): TMapCell;
@ -207,6 +208,7 @@ type
property MapCell[X, Y: Word]: TMapCell read GetMapCell; property MapCell[X, Y: Word]: TMapCell read GetMapCell;
property StaticList[X, Y: Word]: TStaticItemList read GetStaticList; property StaticList[X, Y: Word]: TStaticItemList read GetStaticList;
property Normals[X, Y: Word]: TNormals read GetNormals; property Normals[X, Y: Word]: TNormals read GetNormals;
property MaxStaticID: Cardinal read FMaxStaticID;
property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange; property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange;
property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged; property OnMapChanged: TMapChangedEvent read FOnMapChanged write FOnMapChanged;
property OnNewBlock: TNewBlockEvent read FOnNewBlock write FOnNewBlock; property OnNewBlock: TNewBlockEvent read FOnNewBlock write FOnNewBlock;
@ -594,6 +596,11 @@ begin
for i := 0 to FWriteMap.Size - 1 do for i := 0 to FWriteMap.Size - 1 do
FWriteMap[i] := True; FWriteMap[i] := True;
FMaxStaticID := Min(Min(ResMan.Animdata.AnimCount, ResMan.Tiledata.StaticCount),
ResMan.Art.EntryCount - $4000);
Logger.Send([lcClient, lcInfo], 'Landscape recognizes $%x StaticTile IDs.',
[FMaxStaticId]);
RegisterPacketHandler($04, TPacketHandler.Create(0, @OnBlocksPacket)); RegisterPacketHandler($04, TPacketHandler.Create(0, @OnBlocksPacket));
RegisterPacketHandler($06, TPacketHandler.Create(8, @OnDrawMapPacket)); RegisterPacketHandler($06, TPacketHandler.Create(8, @OnDrawMapPacket));
RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket)); RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket));

View File

@ -1,123 +1,133 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2009 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UAnimDataProvider; unit UAnimDataProvider;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, SysUtils, UMulProvider, UMulBlock, UAnimData; Classes, SysUtils, UMulProvider, UMulBlock, UAnimData;
type type
TAnimDataArray = array[$0..$3FFF] of TAnimData; TAnimDataArray = array of TAnimData;
{ TAnimDataProvider } { TAnimDataProvider }
TAnimDataProvider = class(TMulProvider) TAnimDataProvider = class(TMulProvider)
constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; constructor Create(AData: TStream; AReadOnly: Boolean = False); overload;
override; override;
constructor Create(AData: string; AReadOnly: Boolean = False); overload; constructor Create(AData: string; AReadOnly: Boolean = False); overload;
override; override;
destructor Destroy; override; destructor Destroy; override;
protected protected
FAnimData: TAnimDataArray; FAnimData: TAnimDataArray;
function CalculateOffset(AID: Integer): Integer; override; FAnimCount: Cardinal;
function GetData(AID, AOffset: Integer): TAnimData; override; function CalculateOffset(AID: Integer): Integer; override;
procedure InitArray; function GetData(AID, AOffset: Integer): TAnimData; override;
procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override; procedure InitArray;
public procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); override;
property AnimData: TAnimDataArray read FAnimData; public
function GetBlock(AID: Integer): TAnimData; override; property AnimData: TAnimDataArray read FAnimData;
end; property AnimCount: Cardinal read FAnimCount;
function GetBlock(AID: Integer): TAnimData; override;
implementation end;
{ TAnimDataProvider } implementation
constructor TAnimDataProvider.Create(AData: TStream; AReadOnly: Boolean); uses
begin Logging;
inherited Create(AData, AReadOnly);
InitArray; { TAnimDataProvider }
end;
constructor TAnimDataProvider.Create(AData: TStream; AReadOnly: Boolean);
constructor TAnimDataProvider.Create(AData: string; AReadOnly: Boolean); begin
begin inherited Create(AData, AReadOnly);
inherited Create(AData, AReadOnly); InitArray;
InitArray; end;
end;
constructor TAnimDataProvider.Create(AData: string; AReadOnly: Boolean);
destructor TAnimDataProvider.Destroy; begin
var inherited Create(AData, AReadOnly);
i: Integer; InitArray;
begin end;
for i := 0 to Length(FAnimData) - 1 do
FreeAndNil(FAnimData[i]); destructor TAnimDataProvider.Destroy;
var
inherited Destroy; i: Integer;
end; begin
for i := 0 to Length(FAnimData) - 1 do
function TAnimDataProvider.CalculateOffset(AID: Integer): Integer; FreeAndNil(FAnimData[i]);
begin
Result := GetAnimDataOffset(AID); inherited Destroy;
end; end;
function TAnimDataProvider.GetData(AID, AOffset: Integer): TAnimData; function TAnimDataProvider.CalculateOffset(AID: Integer): Integer;
begin begin
Result := FAnimData[AID]; Result := GetAnimDataOffset(AID);
end; end;
procedure TAnimDataProvider.InitArray; function TAnimDataProvider.GetData(AID, AOffset: Integer): TAnimData;
var begin
i: Integer; Result := FAnimData[AID];
begin end;
for i := 0 to Length(FAnimData) - 1 do
begin procedure TAnimDataProvider.InitArray;
FData.Position := GetAnimDataOffset(i); var
FAnimData[i] := TAnimData.Create(FData); i: Integer;
end; begin
end; FData.Position := 0;
FAnimCount := (FData.Size div AnimDataGroupSize) * 8;
procedure TAnimDataProvider.SetData(AID, AOffset: Integer; ABlock: TMulBlock); Logger.Send([lcInfo], 'Loading $%x AnimData entries.', [FAnimCount]);
begin SetLength(FAnimData, FAnimCount);
FreeAndNil(FAnimData[AID]); for i := 0 to FAnimCount - 1 do
FAnimData[AID] := TAnimData(ABlock.Clone); begin
if i mod 8 = 0 then
if not FReadOnly then FData.Seek(4, soFromCurrent);
begin FAnimData[i] := TAnimData.Create(FData);
FData.Position := AOffset; end;
ABlock.Write(FData); end;
end;
end; procedure TAnimDataProvider.SetData(AID, AOffset: Integer; ABlock: TMulBlock);
begin
function TAnimDataProvider.GetBlock(AID: Integer): TAnimData; FreeAndNil(FAnimData[AID]);
begin FAnimData[AID] := TAnimData(ABlock.Clone);
Result := FAnimData[AID].Clone;
end; if not FReadOnly then
begin
end. FData.Position := AOffset;
ABlock.Write(FData);
end;
end;
function TAnimDataProvider.GetBlock(AID: Integer): TAnimData;
begin
Result := FAnimData[AID].Clone;
end;
end.

View File

@ -1,387 +1,391 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2009 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UMulProvider; unit UMulProvider;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
SysUtils, Classes, UBufferedStreams, UMulBlock, UGenericIndex; SysUtils, Classes, UBufferedStreams, UMulBlock, UGenericIndex;
type type
TOnProgressEvent = procedure(Total, Current: Integer) of object; TOnProgressEvent = procedure(Total, Current: Integer) of object;
{ TMulEventHandler } { TMulEventHandler }
TMulEventHandler = class TMulEventHandler = class
constructor Create; constructor Create;
destructor Destroy; override; destructor Destroy; override;
protected protected
FEvents: TList; FEvents: TList;
public public
procedure RegisterEvent(AEvent: TMulBlockChanged); procedure RegisterEvent(AEvent: TMulBlockChanged);
procedure UnregisterEvent(AEvent: TMulBlockChanged); procedure UnregisterEvent(AEvent: TMulBlockChanged);
procedure FireEvents(ABlock: TMulBlock); procedure FireEvents(ABlock: TMulBlock);
end; end;
{ TMulProvider } { TMulProvider }
TMulProvider = class TMulProvider = class
constructor Create; overload; virtual; constructor Create; overload; virtual;
constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual; constructor Create(AData: TStream; AReadOnly: Boolean = False); overload; virtual;
constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual; constructor Create(AData: string; AReadOnly: Boolean = False); overload; virtual;
destructor Destroy; override; destructor Destroy; override;
protected protected
FData: TStream; FData: TStream;
FOwnsData: Boolean; FOwnsData: Boolean;
FReadOnly: Boolean; FReadOnly: Boolean;
FChangeEvents: TMulEventHandler; FChangeEvents: TMulEventHandler;
FFinishedEvents: TMulEventHandler; FFinishedEvents: TMulEventHandler;
function CalculateOffset(AID: Integer): Integer; virtual; abstract; function CalculateOffset(AID: Integer): Integer; virtual; abstract;
function GetData(AID, AOffset: Integer): TMulBlock; virtual; abstract; function GetData(AID, AOffset: Integer): TMulBlock; virtual; abstract;
procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); virtual; procedure SetData(AID, AOffset: Integer; ABlock: TMulBlock); virtual;
procedure OnChanged(ABlock: TMulBlock); procedure OnChanged(ABlock: TMulBlock);
procedure OnFinished(ABlock: TMulBlock); procedure OnFinished(ABlock: TMulBlock);
public public
function GetBlock(AID: Integer): TMulBlock; virtual; function GetBlock(AID: Integer): TMulBlock; virtual;
procedure SetBlock(AID: Integer; ABlock: TMulBlock); virtual; procedure SetBlock(AID: Integer; ABlock: TMulBlock); virtual;
procedure RegisterOnChangeEvent(AEvent: TMulBlockChanged); procedure RegisterOnChangeEvent(AEvent: TMulBlockChanged);
procedure UnregisterOnChangeEvent(AEvent: TMulBlockChanged); procedure UnregisterOnChangeEvent(AEvent: TMulBlockChanged);
procedure RegisterOnFinishedEvent(AEvent: TMulBlockChanged); procedure RegisterOnFinishedEvent(AEvent: TMulBlockChanged);
procedure UnregisterOnFinishedEvent(AEvent: TMulBlockChanged); procedure UnregisterOnFinishedEvent(AEvent: TMulBlockChanged);
property Block[ID: Integer]: TMulBlock read GetBlock write SetBlock; property Block[ID: Integer]: TMulBlock read GetBlock write SetBlock;
property Data: TStream read FData; property Data: TStream read FData;
end; end;
{ TIndexedMulProvider } { TIndexedMulProvider }
TIndexedMulProvider = class(TMulProvider) TIndexedMulProvider = class(TMulProvider)
constructor Create(AData, AIndex: TStream; AReadOnly: Boolean = False); overload; virtual; constructor Create(AData, AIndex: TStream; AReadOnly: Boolean = False); overload; virtual;
constructor Create(AData, AIndex: string; AReadOnly: Boolean = False); overload; virtual; constructor Create(AData, AIndex: string; AReadOnly: Boolean = False); overload; virtual;
destructor Destroy; override; destructor Destroy; override;
protected protected
FIndex: TBufferedReader; FIndex: TBufferedReader;
function CalculateIndexOffset(AID: Integer): Integer; virtual; FEntryCount: Cardinal;
function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; reintroduce; virtual; abstract; function CalculateIndexOffset(AID: Integer): Integer; virtual;
procedure SetData(AID: Integer; AIndex: TGenericIndex; ABlock: TMulBlock); reintroduce; virtual; function GetData(AID: Integer; AIndex: TGenericIndex): TMulBlock; reintroduce; virtual; abstract;
function GetVarious(AID: Integer; ABlock: TMulBlock; ADefault: Integer): Integer; virtual; procedure SetData(AID: Integer; AIndex: TGenericIndex; ABlock: TMulBlock); reintroduce; virtual;
public function GetVarious(AID: Integer; ABlock: TMulBlock; ADefault: Integer): Integer; virtual;
function GetBlock(AID: Integer): TMulBlock; override; public
procedure GetBlockEx(AID: Integer; var ABlock: TMulBlock; var AIndex: TGenericIndex); virtual; function GetBlock(AID: Integer): TMulBlock; override;
procedure SetBlock(AID: Integer; ABlock: TMulBlock); override; procedure GetBlockEx(AID: Integer; var ABlock: TMulBlock; var AIndex: TGenericIndex); virtual;
function Exists(AID: Integer): Boolean; virtual; procedure SetBlock(AID: Integer; ABlock: TMulBlock); override;
procedure Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil); virtual; function Exists(AID: Integer): Boolean; virtual;
property Index: TBufferedReader read FIndex; procedure Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil); virtual;
end; property Index: TBufferedReader read FIndex;
property EntryCount: Cardinal read FEntryCount;
implementation end;
type implementation
PMethod = ^TMethod;
type
{ TMulEventHandler } PMethod = ^TMethod;
constructor TMulEventHandler.Create; { TMulEventHandler }
begin
inherited; constructor TMulEventHandler.Create;
FEvents := TList.Create; begin
end; inherited;
FEvents := TList.Create;
destructor TMulEventHandler.Destroy; end;
var
i: Integer; destructor TMulEventHandler.Destroy;
begin var
if Assigned(FEvents) then i: Integer;
begin begin
for i := 0 to FEvents.Count - 1 do if Assigned(FEvents) then
Dispose(PMethod(FEvents.Items[i])); begin
FreeAndNil(FEvents); for i := 0 to FEvents.Count - 1 do
end; Dispose(PMethod(FEvents.Items[i]));
inherited; FreeAndNil(FEvents);
end; end;
inherited Destroy;
procedure TMulEventHandler.FireEvents(ABlock: TMulBlock); end;
var
i: Integer; procedure TMulEventHandler.FireEvents(ABlock: TMulBlock);
begin var
for i := 0 to FEvents.Count - 1 do i: Integer;
TMulBlockChanged(FEvents.Items[i]^)(ABlock); begin
end; for i := 0 to FEvents.Count - 1 do
TMulBlockChanged(FEvents.Items[i]^)(ABlock);
procedure TMulEventHandler.RegisterEvent(AEvent: TMulBlockChanged); end;
var
eventInfo: PMethod; procedure TMulEventHandler.RegisterEvent(AEvent: TMulBlockChanged);
begin var
UnregisterEvent(AEvent); eventInfo: PMethod;
New(eventInfo); begin
eventInfo^.Code := TMethod(AEvent).Code; UnregisterEvent(AEvent);
eventInfo^.Data := TMethod(AEvent).Data; New(eventInfo);
FEvents.Add(eventInfo); eventInfo^.Code := TMethod(AEvent).Code;
end; eventInfo^.Data := TMethod(AEvent).Data;
FEvents.Add(eventInfo);
procedure TMulEventHandler.UnregisterEvent(AEvent: TMulBlockChanged); end;
var
i: Integer; procedure TMulEventHandler.UnregisterEvent(AEvent: TMulBlockChanged);
var
function RemoveEntry: Boolean; i: Integer;
begin
Dispose(PMethod(FEvents.Items[i])); function RemoveEntry: Boolean;
FEvents.Delete(i); begin
Result := True; Dispose(PMethod(FEvents.Items[i]));
end; FEvents.Delete(i);
Result := True;
begin end;
i := 0;
while (i < FEvents.Count) and ((TMethod(AEvent).Code <> TMethod(FEvents.Items[i]^).Code) or (TMethod(AEvent).Data <> TMethod(FEvents.Items[i]^).Data) or not RemoveEntry) do begin
Inc(i); i := 0;
end; while (i < FEvents.Count) and ((TMethod(AEvent).Code <> TMethod(FEvents.Items[i]^).Code) or (TMethod(AEvent).Data <> TMethod(FEvents.Items[i]^).Data) or not RemoveEntry) do
Inc(i);
{ TMulProvider } end;
constructor TMulProvider.Create(AData: TStream; AReadOnly: Boolean = False); { TMulProvider }
begin
Create; constructor TMulProvider.Create(AData: TStream; AReadOnly: Boolean = False);
FData := AData; begin
FOwnsData := False; Create;
FReadOnly := AReadOnly; FData := AData;
end; FOwnsData := False;
FReadOnly := AReadOnly;
constructor TMulProvider.Create(AData: string; AReadOnly: Boolean = False); end;
var
mode: Word; constructor TMulProvider.Create(AData: string; AReadOnly: Boolean = False);
begin var
Create; mode: Word;
if AReadOnly then begin
mode := fmOpenRead or fmShareDenyWrite Create;
else if AReadOnly then
mode := fmOpenReadWrite or fmShareDenyWrite; mode := fmOpenRead or fmShareDenyWrite
FData := TFileStream.Create(AData, mode); else
FOwnsData := True; mode := fmOpenReadWrite or fmShareDenyWrite;
FReadOnly := AReadOnly; FData := TFileStream.Create(AData, mode);
end; FOwnsData := True;
FReadOnly := AReadOnly;
constructor TMulProvider.Create; end;
begin
inherited; constructor TMulProvider.Create;
FChangeEvents := TMulEventHandler.Create; begin
FFinishedEvents := TMulEventHandler.Create; inherited;
end; FChangeEvents := TMulEventHandler.Create;
FFinishedEvents := TMulEventHandler.Create;
destructor TMulProvider.Destroy; end;
begin
if FOwnsData and Assigned(FData) then FreeAndNil(FData); destructor TMulProvider.Destroy;
if Assigned(FChangeEvents) then FreeAndNil(FChangeEvents); begin
if Assigned(FFinishedEvents) then FreeAndNil(FFinishedEvents); if FOwnsData and Assigned(FData) then FreeAndNil(FData);
inherited; if Assigned(FChangeEvents) then FreeAndNil(FChangeEvents);
end; if Assigned(FFinishedEvents) then FreeAndNil(FFinishedEvents);
inherited;
function TMulProvider.GetBlock(AID: Integer): TMulBlock; end;
begin
Result := GetData(AID, CalculateOffset(AID)); function TMulProvider.GetBlock(AID: Integer): TMulBlock;
Result.OnChanged := @OnChanged; begin
Result.OnFinished := @OnFinished; Result := GetData(AID, CalculateOffset(AID));
end; Result.OnChanged := @OnChanged;
Result.OnFinished := @OnFinished;
procedure TMulProvider.OnChanged(ABlock: TMulBlock); end;
begin
SetBlock(ABlock.ID, ABlock); procedure TMulProvider.OnChanged(ABlock: TMulBlock);
FChangeEvents.FireEvents(ABlock); begin
end; SetBlock(ABlock.ID, ABlock);
FChangeEvents.FireEvents(ABlock);
procedure TMulProvider.OnFinished(ABlock: TMulBlock); end;
begin
FFinishedEvents.FireEvents(ABlock); procedure TMulProvider.OnFinished(ABlock: TMulBlock);
ABlock.Free; begin
end; FFinishedEvents.FireEvents(ABlock);
ABlock.Free;
procedure TMulProvider.RegisterOnChangeEvent(AEvent: TMulBlockChanged); end;
begin
FChangeEvents.RegisterEvent(AEvent); procedure TMulProvider.RegisterOnChangeEvent(AEvent: TMulBlockChanged);
end; begin
FChangeEvents.RegisterEvent(AEvent);
procedure TMulProvider.RegisterOnFinishedEvent(AEvent: TMulBlockChanged); end;
begin
FFinishedEvents.RegisterEvent(AEvent); procedure TMulProvider.RegisterOnFinishedEvent(AEvent: TMulBlockChanged);
end; begin
FFinishedEvents.RegisterEvent(AEvent);
procedure TMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock); end;
begin
if FReadOnly then Exit; procedure TMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock);
SetData(AID, CalculateOffset(AID), ABlock); begin
end; if FReadOnly then Exit;
SetData(AID, CalculateOffset(AID), ABlock);
procedure TMulProvider.SetData(AID, AOffset: Integer; ABlock: TMulBlock); end;
begin
if FReadOnly then Exit; procedure TMulProvider.SetData(AID, AOffset: Integer; ABlock: TMulBlock);
FData.Position := AOffset; begin
ABlock.Write(FData); if FReadOnly then Exit;
end; FData.Position := AOffset;
ABlock.Write(FData);
procedure TMulProvider.UnregisterOnChangeEvent(AEvent: TMulBlockChanged); end;
begin
FChangeEvents.UnregisterEvent(AEvent); procedure TMulProvider.UnregisterOnChangeEvent(AEvent: TMulBlockChanged);
end; begin
FChangeEvents.UnregisterEvent(AEvent);
procedure TMulProvider.UnregisterOnFinishedEvent(AEvent: TMulBlockChanged); end;
begin
FFinishedEvents.UnregisterEvent(AEvent); procedure TMulProvider.UnregisterOnFinishedEvent(AEvent: TMulBlockChanged);
end; begin
FFinishedEvents.UnregisterEvent(AEvent);
{ TIndexedMulProvider } end;
function TIndexedMulProvider.CalculateIndexOffset(AID: Integer): Integer; { TIndexedMulProvider }
begin
Result := 12 * AID; function TIndexedMulProvider.CalculateIndexOffset(AID: Integer): Integer;
end; begin
Result := 12 * AID;
constructor TIndexedMulProvider.Create(AData, AIndex: TStream; AReadOnly: Boolean = False); end;
begin
inherited Create(AData, AReadOnly); constructor TIndexedMulProvider.Create(AData, AIndex: TStream; AReadOnly: Boolean = False);
FIndex := TBufferedReader.Create(AIndex); begin
end; inherited Create(AData, AReadOnly);
FIndex := TBufferedReader.Create(AIndex);
constructor TIndexedMulProvider.Create(AData, AIndex: string; AReadOnly: Boolean = False); FEntryCount := AIndex.Size div 12;
var end;
mode: Word;
begin constructor TIndexedMulProvider.Create(AData, AIndex: string; AReadOnly: Boolean = False);
inherited Create(AData, AReadOnly); var
if AReadOnly then mode: Word;
mode := fmOpenRead or fmShareDenyWrite begin
else inherited Create(AData, AReadOnly);
mode := fmOpenReadWrite or fmShareDenyWrite; if AReadOnly then
FIndex := TBufferedReader.Create(TFileStream.Create(AIndex, mode), True); mode := fmOpenRead or fmShareDenyWrite
end; else
mode := fmOpenReadWrite or fmShareDenyWrite;
procedure TIndexedMulProvider.Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil); FIndex := TBufferedReader.Create(TFileStream.Create(AIndex, mode), True);
var FEntryCount := FIndex.Size div 12;
genericIndex: TGenericIndex; end;
begin
if FReadOnly then Exit; procedure TIndexedMulProvider.Defragment(ATempStream: TStream; AOnProgress: TOnProgressEvent = nil);
ATempStream.Size := FData.Size; var
ATempStream.Position := 0; genericIndex: TGenericIndex;
FIndex.Position := 0; begin
while FIndex.Position < FIndex.Size do if FReadOnly then Exit;
begin ATempStream.Size := FData.Size;
genericIndex := TGenericIndex.Create(FIndex); ATempStream.Position := 0;
if genericIndex.Lookup <> LongInt($FFFFFFFF) then FIndex.Position := 0;
begin while FIndex.Position < FIndex.Size do
FData.Position := genericIndex.Lookup; begin
genericIndex.Lookup := ATempStream.Position; genericIndex := TGenericIndex.Create(FIndex);
ATempStream.CopyFrom(FData, genericIndex.Size); if genericIndex.Lookup > -1 then
FIndex.Seek(-12, soFromCurrent); begin
genericIndex.Write(FIndex); FData.Position := genericIndex.Lookup;
end; genericIndex.Lookup := ATempStream.Position;
genericIndex.Free; ATempStream.CopyFrom(FData, genericIndex.Size);
if Assigned(AOnProgress) and (FIndex.Position mod 1200 = 0) then FIndex.Seek(-12, soFromCurrent);
AOnProgress(FIndex.Size, FIndex.Position); genericIndex.Write(FIndex);
end; end;
FData.Size := ATempStream.Position; genericIndex.Free;
FData.Position := 0; if Assigned(AOnProgress) and (FIndex.Position mod 1200 = 0) then
ATempStream.Position := 0; AOnProgress(FIndex.Size, FIndex.Position);
FData.CopyFrom(ATempStream, FData.Size); end;
end; FData.Size := ATempStream.Position;
FData.Position := 0;
destructor TIndexedMulProvider.Destroy; ATempStream.Position := 0;
begin FData.CopyFrom(ATempStream, FData.Size);
if Assigned(FIndex) then FreeAndNil(FIndex); end;
inherited;
end; destructor TIndexedMulProvider.Destroy;
begin
function TIndexedMulProvider.Exists(AID: Integer): Boolean; FreeAndNil(FIndex);
var inherited Destroy;
genericIndex: TGenericIndex; end;
begin
FIndex.Position := CalculateIndexOffset(AID); function TIndexedMulProvider.Exists(AID: Integer): Boolean;
genericIndex := TGenericIndex.Create(FIndex); var
Result := (genericIndex.Lookup > -1) and (genericIndex.Size > 0); genericIndex: TGenericIndex;
genericIndex.Free; begin
end; FIndex.Position := CalculateIndexOffset(AID);
genericIndex := TGenericIndex.Create(FIndex);
function TIndexedMulProvider.GetBlock(AID: Integer): TMulBlock; Result := (genericIndex.Lookup > -1) and (genericIndex.Size > 0);
var genericIndex.Free;
genericIndex: TGenericIndex; end;
begin
GetBlockEx(AID, Result, genericIndex); function TIndexedMulProvider.GetBlock(AID: Integer): TMulBlock;
genericIndex.Free; var
end; genericIndex: TGenericIndex;
begin
procedure TIndexedMulProvider.GetBlockEx(AID: Integer; GetBlockEx(AID, Result, genericIndex);
var ABlock: TMulBlock; var AIndex: TGenericIndex); genericIndex.Free;
begin end;
FIndex.Position := CalculateIndexOffset(AID);
AIndex := TGenericIndex.Create(FIndex); procedure TIndexedMulProvider.GetBlockEx(AID: Integer;
ABlock := GetData(AID, AIndex); var ABlock: TMulBlock; var AIndex: TGenericIndex);
ABlock.OnChanged := @OnChanged; begin
ABlock.OnFinished := @OnFinished; FIndex.Position := CalculateIndexOffset(AID);
end; AIndex := TGenericIndex.Create(FIndex);
ABlock := GetData(AID, AIndex);
function TIndexedMulProvider.GetVarious(AID: Integer; ABlock: TMulBlock; ABlock.OnChanged := @OnChanged;
ADefault: Integer): Integer; ABlock.OnFinished := @OnFinished;
begin end;
Result := ADefault;
end; function TIndexedMulProvider.GetVarious(AID: Integer; ABlock: TMulBlock;
ADefault: Integer): Integer;
procedure TIndexedMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock); begin
var Result := ADefault;
genericIndex: TGenericIndex; end;
begin
if FReadOnly then Exit; procedure TIndexedMulProvider.SetBlock(AID: Integer; ABlock: TMulBlock);
FIndex.Position := CalculateIndexOffset(AID); var
genericIndex := TGenericIndex.Create(FIndex); genericIndex: TGenericIndex;
SetData(AID, genericIndex, ABlock); begin
FIndex.Position := CalculateIndexOffset(AID); if FReadOnly then Exit;
genericIndex.Various := GetVarious(AID, ABlock, genericIndex.Various); FIndex.Position := CalculateIndexOffset(AID);
genericIndex.Write(FIndex); genericIndex := TGenericIndex.Create(FIndex);
genericIndex.Free; SetData(AID, genericIndex, ABlock);
end; FIndex.Position := CalculateIndexOffset(AID);
genericIndex.Various := GetVarious(AID, ABlock, genericIndex.Various);
procedure TIndexedMulProvider.SetData(AID: Integer; AIndex: TGenericIndex; genericIndex.Write(FIndex);
ABlock: TMulBlock); genericIndex.Free;
var end;
size: Integer;
begin procedure TIndexedMulProvider.SetData(AID: Integer; AIndex: TGenericIndex;
if FReadOnly then Exit; ABlock: TMulBlock);
size := ABlock.GetSize; var
if size = 0 then size: Integer;
begin begin
AIndex.Lookup := LongInt($FFFFFFFF); if FReadOnly then Exit;
AIndex.Various := LongInt($FFFFFFFF); size := ABlock.GetSize;
end else if (size > AIndex.Size) or (AIndex.Lookup = LongInt($FFFFFFFF)) then if size = 0 then
begin begin
FData.Position := FData.Size; AIndex.Lookup := -1;
AIndex.Lookup := FData.Position; AIndex.Various := -1;
ABlock.Write(FData); end else if (size > AIndex.Size) or (AIndex.Lookup < 0) then
end else begin
begin FData.Position := FData.Size;
FData.Position := AIndex.Lookup; AIndex.Lookup := FData.Position;
ABlock.Write(FData); ABlock.Write(FData);
end; end else
AIndex.Size := size; begin
end; FData.Position := AIndex.Lookup;
ABlock.Write(FData);
end. end;
AIndex.Size := size;
end;
end.

View File

@ -141,7 +141,7 @@
</Linking> </Linking>
<Other> <Other>
<CustomOptions Value="-FE../bin/ <CustomOptions Value="-FE../bin/
"/> -dNoLogging"/>
<CompilerPath Value="$(CompPath)"/> <CompilerPath Value="$(CompPath)"/>
</Other> </Other>
</CompilerOptions> </CompilerOptions>

View File

@ -33,6 +33,9 @@ uses
SysUtils, Classes, UEnhancedMemoryStream; SysUtils, Classes, UEnhancedMemoryStream;
type type
{ TBufferedStream }
TBufferedStream = class(TEnhancedMemoryStream) TBufferedStream = class(TEnhancedMemoryStream)
constructor Create(ABaseStream: TStream; AOwnsBaseStream: Boolean = false); virtual; constructor Create(ABaseStream: TStream; AOwnsBaseStream: Boolean = false); virtual;
destructor Destroy; override; destructor Destroy; override;
@ -42,6 +45,7 @@ type
public public
procedure Refresh; virtual; procedure Refresh; virtual;
procedure Flush; virtual; procedure Flush; virtual;
function GetSize: Int64; override;
end; end;
TBufferedReader = class(TBufferedStream) TBufferedReader = class(TBufferedStream)
constructor Create(ABaseStream: TStream; AOwnsBaseStream: Boolean = false); override; constructor Create(ABaseStream: TStream; AOwnsBaseStream: Boolean = false); override;
@ -82,6 +86,11 @@ begin
FBaseStream.CopyFrom(Self, 0); FBaseStream.CopyFrom(Self, 0);
end; end;
function TBufferedStream.GetSize: Int64;
begin
Result := FBaseStream.Size;
end;
procedure TBufferedStream.Refresh; procedure TBufferedStream.Refresh;
begin begin
Size := FBaseStream.Size; Size := FBaseStream.Size;