- Initial import from internal repository

This commit is contained in:
2007-12-21 21:31:58 +01:00
commit c0a125042b
194 changed files with 86503 additions and 0 deletions

149
UOLib/UAnimData.pas Normal file
View File

@@ -0,0 +1,149 @@
(*
* 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 UAnimData;
interface
uses
Classes, UMulBlock;
const
AnimDataSize = 68;
AnimDataGroupSize = 4 + (8 * AnimDataSize);
type
TAnimData = class(TMulBlock)
constructor Create(Data: TStream);
function GetSize: Integer; override;
procedure Write(Data: TStream); override;
private
FOffset: Int64;
FUnknown: Byte;
FFrameCount: Byte;
FFrameInterval: Byte;
FFrameStart: Byte;
public
FrameData: array[0..63] of ShortInt;
published
property Offset: Int64 read FOffset write FOffset;
property Unknown: Byte read FUnknown write FUnknown;
property FrameCount: Byte read FFrameCount write FFrameCount;
property FrameInterval: Byte read FFrameInterval write FFrameInterval;
property FrameStart: Byte read FFrameStart write FFrameStart;
end;
TAnimDataGroup = class(TMulBlock)
constructor Create(Data: TStream);
destructor Destroy; override;
function GetSize: Integer; override;
procedure Write(Data: TStream); override;
private
FOffset: Int64;
FUnknown: LongInt;
public
AnimData: array[0..7] of TAnimData;
published
property Offset: Int64 read FOffset write FOffset;
property Unknown: LongInt read FUnknown write FUnknown;
end;
function GetAnimDataOffset(Block: Integer): Integer;
implementation
function GetAnimDataOffset;
var
group, tile: Integer;
begin
group := Block div 8;
tile := Block mod 8;
Result := group * AnimDataGroupSize + 4 + tile * AnimDataSize;
end;
constructor TAnimData.Create;
begin
if assigned(Data) then
begin
FOffset := Data.Position;
Data.Read(FrameData, 64);
Data.Read(FUnknown, SizeOf(Byte));
Data.Read(FFrameCount, SizeOf(Byte));
Data.Read(FFrameInterval, SizeOf(Byte));
Data.Read(FFrameStart, SizeOf(Byte));
end;
end;
procedure TAnimData.Write;
begin
Data.Write(FrameData, 64);
Data.Write(FUnknown, SizeOf(Byte));
Data.Write(FFrameCount, SizeOf(Byte));
Data.Write(FFrameInterval, SizeOf(Byte));
Data.Write(FFrameStart, SizeOf(Byte));
end;
function TAnimData.GetSize;
begin
GetSize := AnimDataSize;
end;
constructor TAnimDataGroup.Create;
var
i: Integer;
begin
if assigned(Data) then
begin
FOffset := Data.Position;
Data.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 7 do
AnimData[i] := TAnimData.Create(Data);
end;
destructor TAnimDataGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 7 do
AnimData[i].Free;
end;
procedure TAnimDataGroup.Write;
var
i: Integer;
begin
Data.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 7 do
AnimData[i].Write(Data);
end;
function TAnimDataGroup.GetSize;
begin
GetSize := AnimDataGroupSize;
end;
end.

323
UOLib/UArt.pas Normal file
View File

@@ -0,0 +1,323 @@
(*
* 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 UArt;
{$mode objfpc}{$H+}
interface
uses
Classes, Imaging, ImagingTypes, ImagingCanvases, ImagingClasses,
UMulBlock, UGenericIndex, UHue;
type
TArtType = (atLand, atStatic, atLandFlat);
TArt = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload;
destructor Destroy; override;
function Clone: TArt; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
procedure RefreshBuffer;
protected
FArtType: TArtType;
FHeader: LongInt;
FGraphic: TSingleImage;
FBuffer: TStream;
public
property ArtType: TArtType read FArtType write FArtType;
property Header: LongInt read FHeader write FHeader;
property Graphic: TSingleImage read FGraphic;
property Buffer: TStream read FBuffer;
end;
implementation
type
PWordArray = ^TWordArray;
TWordArray = array[0..16383] of Word;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType);
begin
Create(AData, AIndex, AArtType, 0, nil, False);
end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean);
begin
Create(AData, AIndex, AArtType, 0, AHue, APartialHue);
end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean);
var
i, x, y, start: Integer;
iCurrentHeight, iCurrentWidth: Integer;
width, height: SmallInt;
lookup: array of integer;
color, run, offset: Word;
block: TMemoryStream;
P: PWordArray;
r, g, b: Byte;
begin
FBuffer := TMemoryStream.Create;
FArtType := AArtType;
AArtColor := AArtColor or $8000; //set alpha bit on background
if Assigned(AData) and (AIndex.Lookup <> LongInt($FFFFFFFF)) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
if AArtType = atLand then
begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
FillWord(FGraphic.Bits^, 44 * 44, AArtColor);
for y := 0 to 21 do
begin
P := FGraphic.Bits + y * 44 * 2;
block.Read(P^[22 - (y + 1)], (y + 1) * 4);
end;
for y := 0 to 21 do
begin
P := FGraphic.Bits + (22 + y) * 44 * 2;
block.Read(P^[y], (22 - y) * 4);
end;
for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atLandFlat then
begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
for i := 1 to 22 do
begin
for x := 0 to i * 2 - 1 do
begin
y := i * 2 - x - 1;
block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + y * 44 * 2)^[x] := color;
if y > 0 then
PWordArray(FGraphic.Bits + (y - 1) * 44 * 2)^[x] := color;
end;
end;
for i := 22 to 43 do
begin
for y := 0 to (44 - i) * 2 - 1 do
begin
x := 42 - (43 - i) * 2 + y;
block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + (43 - y) * 44 * 2)^[x] := color;
if y > 0 then
PWordArray(FGraphic.Bits + (44 - y) * 44 * 2)^[x] := color;
end;
end;
for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atStatic then
begin
block.Read(FHeader, SizeOf(LongInt));
block.Read(width, SizeOf(SmallInt));
block.Read(height, SizeOf(SmallInt));
FGraphic:= TSingleImage.CreateFromParams(width, height, ifA1R5G5B5);
FillWord(FGraphic.Bits^, width * height, AArtColor);
SetLength(lookup, height);
start := block.Position + (height * 2);
for i := 0 to height - 1 do
begin
block.Read(offset, SizeOf(Word));
lookup[i] := start + (offset * 2);
end;
for iCurrentHeight := 0 to height - 1 do
begin
block.Position := lookup[iCurrentHeight];
iCurrentWidth := 0;
P := FGraphic.Bits + iCurrentHeight * width * 2;
while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and (block.Read(run, SizeOf(Word)) = SizeOf(Word)) and (offset + run <> 0) do
begin
inc(iCurrentWidth, offset);
for i := 0 to run - 1 do
begin
block.Read(color, SizeOf(Word));
P^[iCurrentWidth + i] := color;
end;
inc(iCurrentWidth, run);
end;
end;
if AHue <> nil then
begin
for i := 0 to width * height - 1 do
begin
color := PWordArray(FGraphic.Bits)^[i];
if color <> AArtColor then
begin
r := (color and $7C00) shr 10;
if APartialHue then
begin
g := (color and $3E0) shr 5;
b := color and $1F;
if (r = g) and (g = b) then
color := AHue.ColorTable[r];
end else
color := AHue.ColorTable[r];
end;
PWordArray(FGraphic.Bits)^[i] := color;
end;
end;
for i := 0 to width * height - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else
FGraphic:= TSingleImage.Create;
if Assigned(block) then block.Free;
end else
begin
FHeader := 1;
FGraphic := TSingleImage.Create;
end;
FGraphic.Format := ifA8R8G8B8;
end;
destructor TArt.Destroy;
begin
if assigned(FGraphic) then FGraphic.Free;
if assigned(FBuffer) then FBuffer.Free;
inherited;
end;
function TArt.Clone: TArt;
begin
Result := TArt.Create(nil, nil, FArtType);
Result.FHeader := FHeader;
Result.FGraphic.Assign(FGraphic);
end;
procedure TArt.Write(AData: TStream);
begin
FBuffer.Position := 0;
AData.CopyFrom(FBuffer, FBuffer.Size);
end;
function TArt.GetSize: Integer;
begin
RefreshBuffer;
Result := FBuffer.Size
end;
procedure TArt.RefreshBuffer;
var
argbGraphic: TSingleImage;
i, j, x, y, lineWidth, start: Integer;
iCurrentHeight, iCurrentWidth: Integer;
width, height: SmallInt;
color, run, offset: Word;
lookup: array of SmallInt;
begin
argbGraphic := TSingleImage.CreateFromImage(FGraphic);
argbGraphic.Format := ifA1R5G5B5;
for i := 0 to argbGraphic.Width * argbGraphic.Height - 1 do
PWordArray(argbGraphic.Bits)^[i] := PWordArray(argbGraphic.Bits)^[i] xor $8000; //invert alpha bit
FBuffer.Size := 0;
if FArtType = atLand then
begin
if (argbGraphic.Height <> 44) or (argbGraphic.Width <> 44) then Exit;
x := 21;
y := 0;
lineWidth := 2;
for i := 1 to 22 do
begin
Dec(x);
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth);
Inc(y);
Inc(lineWidth, 2);
end;
for i := 1 to 22 do
begin
Dec(lineWidth, 2);
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth);
Inc(x);
Inc(y);
end;
end else if FArtType = atStatic then
begin
if (argbGraphic.Height = 0) or (argbGraphic.Width = 0) then Exit;
width := argbGraphic.Width;
height := argbGraphic.Height;
FBuffer.Write(FHeader, SizeOf(LongInt));
FBuffer.Write(width, SizeOf(SmallInt));
FBuffer.Write(height, SizeOf(SmallInt));
SetLength(lookup, height);
for i := 0 to height - 1 do
FBuffer.Write(lookup[i], SizeOf(SmallInt)); //placeholders for the lookup table
start := FBuffer.Position;
for iCurrentHeight := 0 to height - 1 do
begin
lookup[iCurrentHeight] := SmallInt((FBuffer.Position - start) div 2); //remember the lookup offset for the current line
offset := 0;
run := 0;
for iCurrentWidth := 0 to width - 1 do //process every pixel on the current line
begin
color := PWordArray(FGraphic.Bits + iCurrentHeight * width * 2)^[iCurrentWidth];
if (color and $8000 = 0) and (run = 0) then //new visible pixel found
begin
FBuffer.Write(offset, SizeOf(Word));
FBuffer.Write(offset, SizeOf(Word)); //just a placeholder for the "run length"
run := 1;
FBuffer.Write(color, SizeOf(Word));
end else if (color and $8000 = 0) and (run > 0) then //another visible pixel found
begin
inc(run);
FBuffer.Write(color, SizeOf(Word));
end else if (color and $8000 = $8000) and (run > 0) then //after some visible pixels this one is invisible, so stop the current run
begin
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); //jump back ...
FBuffer.Write(run, SizeOf(Word)); //... to write the actual "run length" ...
FBuffer.Seek(Integer(run * 2), soFromCurrent); //... and jump forth again to proceed
run := 0;
offset := 1;
end else
inc(offset);
end;
if run > 0 then //no more pixels but the "run" didn't end yet ;-)
begin
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent);
FBuffer.Write(run, SizeOf(Word));
FBuffer.Seek(Integer(run * 2), soFromCurrent);
run := 0;
end;
FBuffer.Write(run, SizeOf(Word)); //just write "0"
FBuffer.Write(run, SizeOf(Word)); //... two times, to indicate the end of that line
end;
FBuffer.Position := start - (height * 2); //now update the lookup table with our new values
for i := 0 to height - 1 do
FBuffer.Write(lookup[i], SizeOf(SmallInt));
end;
argbGraphic.Free;
end;
end.

83
UOLib/UGenericIndex.pas Normal file
View File

@@ -0,0 +1,83 @@
(*
* 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 UGenericIndex;
{$mode objfpc}{$H+}
interface
uses
Classes, UMulBlock;
type
TGenericIndex = class(TMulBlock)
constructor Create(Data: TStream);
function Clone: TGenericIndex; override;
function GetSize: Integer; override;
procedure Write(Data: TStream); override;
protected
FLookup: LongInt;
FSize: LongInt;
FVarious: LongInt;
published
property Lookup: LongInt read FLookup write FLookup;
property Size: LongInt read FSize write FSize;
property Various: LongInt read FVarious write FVarious;
end;
implementation
constructor TGenericIndex.Create(Data: TStream);
begin
if assigned(Data) then
begin
Data.Read(FLookup, SizeOf(LongInt));
Data.Read(FSize, SizeOf(LongInt));
Data.Read(FVarious, SizeOf(LongInt));
end;
end;
function TGenericIndex.Clone: TGenericIndex;
begin
Result := TGenericIndex.Create(nil);
Result.FLookup := FLookup;
Result.FSize := FSize;
Result.FVarious := FVarious;
end;
procedure TGenericIndex.Write(Data: TStream);
begin
Data.Write(FLookup, SizeOf(LongInt));
Data.Write(FSize, SizeOf(LongInt));
Data.Write(FVarious, SizeOf(LongInt));
end;
function TGenericIndex.GetSize: Integer;
begin
Result := 12;
end;
end.

85
UOLib/UGraphicHelper.pas Normal file
View File

@@ -0,0 +1,85 @@
(*
* 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 UGraphicHelper;
{$mode objfpc}{$H+}
interface
function ARGB2RGB(Value: Word): Integer;
function RGB2ARGB(Value: Integer): Word;
//New functions for Vampyre Imaging Lib
function DecodeUOColor(Value: Word): Integer;
function EncodeUOColor(Value: Integer): Word;
implementation
function ARGB2RGB(Value: Word): Integer;
var
R, G, B: Byte;
begin
R := ((Value shr 10) and $1F) * 8;
G := ((Value shr 5) and $1F) * 8;
B := (Value and $1F) * 8;
Result := R + G shl 8 + B shl 16;
end;
function RGB2ARGB(Value: Integer): Word;
var
R, G, B: Byte;
begin
R := (Value and $FF) div 8;
G := ((Value shr 8) and $FF) div 8;
B := ((Value shr 16) and $FF) div 8;
Result := (R shl 10) + (G shl 5) + B;
end;
function DecodeUOColor(Value: Word): Integer;
var
R, G, B: Byte;
begin
R := ((Value shr 10) and $1F) * 8;
G := ((Value shr 5) and $1F) * 8;
B := (Value and $1F) * 8;
Result := B + G shl 8 + R shl 16;
end;
function EncodeUOColor(Value: Integer): Word;
var
R, G, B: Byte;
begin
B := (Value and $FF) div 8;
G := ((Value shr 8) and $FF) div 8;
R := ((Value shr 16) and $FF) div 8;
Result := (R shl 10) + (G shl 5) + B;
end;
end.

233
UOLib/UGump.pas Normal file
View File

@@ -0,0 +1,233 @@
(*
* 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 UGump;
{$mode objfpc}{$H+}
interface
uses
Classes, Imaging, ImagingTypes, ImagingClasses, UMulBlock, UGenericIndex;
type
TGumpIndex = class(TGenericIndex)
protected
function GetWidth: SmallInt;
function GetHeight: SmallInt;
procedure SetWidth(AValue: SmallInt);
procedure SetHeight(AValue: SmallInt);
published
property Width: SmallInt read GetWidth write SetWidth;
property Height: SmallInt read GetHeight write SetHeight;
end;
TGump = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGumpIndex); overload;
constructor Create(AWidth, AHeight: Integer); overload;
destructor Destroy; override;
function Clone: TGump; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
procedure RefreshBuffer;
protected
FGraphic: TSingleImage;
FBuffer: TStream;
published
property Graphic: TSingleImage read FGraphic;
end;
implementation
type
PWordArray = ^TWordArray;
TWordArray = array[0..16383] of Word;
{ TGumpIndex }
function TGumpIndex.GetHeight: SmallInt;
var
sizeInfo: LongInt;
sizeInfoW: array[0..1] of SmallInt absolute sizeInfo;
begin
sizeInfo := FVarious;
Result := sizeInfoW[0];
end;
function TGumpIndex.GetWidth: SmallInt;
var
sizeInfo: LongInt;
sizeInfoW: array[0..1] of SmallInt absolute sizeInfo;
begin
sizeInfo := FVarious;
Result := sizeInfoW[1];
end;
procedure TGumpIndex.SetHeight(AValue: SmallInt);
var
sizeInfo: LongInt;
sizeInfoW: array[0..1] of SmallInt absolute sizeInfo;
begin
sizeInfo := FVarious;
sizeInfoW[0] := AValue;
FVarious := sizeInfo;
end;
procedure TGumpIndex.SetWidth(AValue: SmallInt);
var
sizeInfo: LongInt;
sizeInfoW: array[0..1] of SmallInt absolute sizeInfo;
begin
sizeInfo := FVarious;
sizeInfoW[1] := AValue;
FVarious := sizeInfo;
end;
{ TGump }
constructor TGump.Create(AData: TStream; AIndex: TGumpIndex);
var
iCurrentHeight, iCurrentWidth, i: Integer;
RowLookup: array of integer;
Offset: Integer;
Value, Run: Word;
block: TMemoryStream;
begin
inherited Create;
FGraphic := TSingleImage.CreateFromParams(AIndex.Width, AIndex.Height, ifA1R5G5B5);
FBuffer := TMemoryStream.Create;
SetLength(RowLookup, AIndex.Height);
if assigned(AData) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
for i := 0 to AIndex.Height - 1 do
begin
block.Read(Offset, SizeOf(Integer));
RowLookup[i] := Offset * 4;
end;
for iCurrentHeight := 0 to AIndex.Height - 1 do
begin
block.Position := RowLookup[iCurrentHeight];
iCurrentWidth := 0;
while iCurrentWidth < AIndex.Width do
begin
block.Read(Value, SizeOf(Word));
block.Read(Run, SizeOf(Word));
if Value > 0 then Value := Value or $8000; //Set alpha bit of non-black colors
for i := 0 to Run - 1 do
PWordArray(FGraphic.Bits + iCurrentHeight * AIndex.Width * 2)^[iCurrentWidth + i] := Value;
inc(iCurrentWidth, Run);
end;
end;
block.Free;
end;
FGraphic.Format := ifA8R8G8B8;
end;
constructor TGump.Create(AWidth, AHeight: Integer);
begin
{TODO : WARNING! Width and Height got switched since MulEditor!}
inherited Create;
FGraphic := TSingleImage.CreateFromParams(AWidth, AHeight, ifA8R8G8B8);
FBuffer := TMemoryStream.Create;
end;
destructor TGump.Destroy;
begin
if assigned(FGraphic) then FGraphic.Free;
if assigned(FBuffer) then FBuffer.Free;
inherited Destroy;
end;
function TGump.Clone: TGump;
begin
Result := TGump.Create(FGraphic.Width, FGraphic.Height);
Result.FGraphic.Assign(FGraphic);
end;
procedure TGump.Write(AData: TStream);
begin
FBuffer.Position := 0;
AData.CopyFrom(FBuffer, FBuffer.Size);
end;
function TGump.GetSize: Integer;
begin
RefreshBuffer;
Result := FBuffer.Size;
end;
procedure TGump.RefreshBuffer;
var
argbGraphic: TSingleImage;
colorBuffer: PWordArray;
runBuffer: array of Word;
offsetBuffer: array of Integer;
currentColor, currentRun: Integer;
iCurrentHeight, i: Integer;
begin
argbGraphic := TSingleImage.CreateFromImage(FGraphic);
argbGraphic.Format := ifA1R5G5B5;
SetLength(runBuffer, argbGraphic.Width);
SetLength(offsetBuffer, argbGraphic.Height);
FBuffer.Size := argbGraphic.Height * SizeOf(Integer);
FBuffer.Position := FBuffer.Size;
for iCurrentHeight := 0 to argbGraphic.Height - 1 do
begin
colorBuffer := argbGraphic.Bits + iCurrentHeight * argbGraphic.Width * 2;
for i := 0 to argbGraphic.Width - 1 do
begin
runBuffer[i] := 1;
colorBuffer^[i] := colorBuffer^[i] and not $8000; //eleminate alpha bit
end;
currentRun := 0;
currentColor := colorBuffer^[0];
for i := 1 to argbGraphic.Width - 1 do
begin
if colorBuffer^[i] = currentColor then
Inc(runBuffer[currentRun])
else
Inc(currentRun);
currentColor := colorBuffer^[i];
end;
offsetBuffer[iCurrentHeight] := FBuffer.Position div 4;
currentColor := 0;
for i := 0 to currentRun do
begin
FBuffer.Write(colorBuffer^[currentColor], SizeOf(Word));
FBuffer.Write(runBuffer[i], SizeOf(Word));
Inc(currentColor, runBuffer[i]);
end;
end;
FBuffer.Position := 0;
for i := 0 to argbGraphic.Height - 1 do FBuffer.Write(offsetBuffer[i], SizeOf(Integer));
argbGraphic.Free;
end;
end.

212
UOLib/UHue.pas Normal file
View File

@@ -0,0 +1,212 @@
(*
* 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 UHue;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, Graphics, UMulBlock, UGraphicHelper;
type
TColorTable = array[0..31] of Word;
THue = class(TMulBlock)
constructor Create(AData: TStream);
function Clone: THue; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FColorTable: TColorTable;
FTableStart: Word;
FTableEnd: Word;
FName: string;
procedure SetName(AValue: string);
function GetName: string;
public
property ColorTable: TColorTable read FColorTable write FColorTable;
property TableStart: Word read FTableStart write FTableStart;
property TableEnd: Word read FTableEnd write FTableEnd;
property Name: string read GetName write SetName;
end;
THueEntries = array[0..7] of THue;
THueGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: THueGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FHeader: LongWord;
FHueEntries: THueEntries;
function GetHueEntry(AIndex: Integer): THue;
procedure SetHueEntry(AIndex: Integer; AValue: THue);
public
property Header: LongWord read FHeader write FHeader;
property HueEntries[Index: Integer]: THue read GetHueEntry write SetHueEntry;
end;
implementation
{ THue }
function THue.Clone: THue;
var
i: Integer;
begin
Result := THue.Create(nil);
for i := 0 to 31 do
Result.FColorTable[i] := FColorTable[i];
Result.FTableStart := FTableStart;
Result.FTableEnd := FTableEnd;
Result.FName := FName;
end;
constructor THue.Create(AData: TStream);
var
i: Integer;
buffer: TMemoryStream;
color: Word;
begin
SetLength(FName, 20);
if Assigned(AData) then
begin
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 88);
buffer.Position := 0;
for i := 0 to 31 do
begin
buffer.Read(color, SizeOf(Word));
FColorTable[i] := color;
end;
buffer.Read(FTableStart, SizeOf(Word));
buffer.Read(FTableEnd, SizeOf(Word));
buffer.Read(PChar(FName)^, 20);
buffer.Free;
end;
end;
function THue.GetName: string;
begin
Result := Trim(FName);
end;
function THue.GetSize: Integer;
begin
Result := 88;
end;
procedure THue.SetName(AValue: string);
begin
FName := AValue;
SetLength(FName, 20);
end;
procedure THue.Write(AData: TStream);
var
i: Integer;
color: Word;
begin
SetLength(FName, 20);
for i := 0 to 31 do
begin
color := FColorTable[i];
AData.Write(color, SizeOf(Word));
end;
AData.Write(FTableStart, SizeOf(Word));
AData.Write(FTableEnd, SizeOf(Word));
AData.Write(PChar(FName)^, 20);
end;
{ THueGroup }
function THueGroup.Clone: THueGroup;
var
i: Integer;
begin
Result := THueGroup.Create(nil);
Result.FHeader := FHeader;
for i := 0 to 7 do
Result.SetHueEntry(i, FHueEntries[i].Clone);
end;
constructor THueGroup.Create(AData: TStream);
var
i: Integer;
buffer: TMemoryStream;
begin
if Assigned(AData) then
begin
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 708);
buffer.Position := 0;
buffer.Read(FHeader, SizeOf(LongWord));
end else
buffer := nil;
for i := 0 to 7 do
FHueEntries[i] := THue.Create(buffer);
if Assigned(buffer) then FreeAndNil(buffer);
end;
destructor THueGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 7 do
if Assigned(FHueEntries[i]) then
FreeAndNil(FHueEntries[i]);
inherited;
end;
function THueGroup.GetHueEntry(AIndex: Integer): THue;
begin
Result := FHueEntries[AIndex];
end;
function THueGroup.GetSize: Integer;
begin
Result := 708;
end;
procedure THueGroup.SetHueEntry(AIndex: Integer; AValue: THue);
begin
if Assigned(FHueEntries[AIndex]) then FreeAndNil(FHueEntries[AIndex]);
FHueEntries[AIndex] := AValue;
end;
procedure THueGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FHeader, SizeOf(LongWord));
for i := 0 to 7 do
FHueEntries[i].Write(AData);
end;
end.

87
UOLib/UListSort.pas Normal file
View File

@@ -0,0 +1,87 @@
(*
* 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 UListSort;
{$mode objfpc}{$H+}
interface
uses
Classes;
type
TListSortCompare = function(Left, Right: TObject): Integer of object;
procedure ListSort(List: TList; Compare: TListSortCompare);
implementation
procedure ListSort(List: TList; Compare: TListSortCompare);
var
iMin, iMax: Integer;
Temp: Pointer;
procedure sift;
var
i, j: integer;
begin
i := iMin;
j := 2 * i;
Temp := Pointer(List[i]);
while j <= iMax do
begin
if j < iMax then
if Compare(TObject(List[j]), TObject(List[j + 1])) > 0 then inc(j);
if Compare(TObject(Temp), TObject(List[j])) <= 0 then break;
List[i] := Pointer(List[j]);
i := j;
j := 2 * i;
end;
List[i] := Temp;
end;
begin
if List.Count > 0 then
begin
iMax := List.Count - 1;
iMin := iMax div 2 + 1;
while iMin > 0 do
begin
dec(iMin);
sift;
end;
while iMax > 0 do
begin
Temp := Pointer(List[iMin]);
List[iMin] := Pointer(List[iMax]);
List[iMax] := Temp;
dec(iMax);
sift;
end;
end;
end;
end.

92
UOLib/ULocalization.pas Normal file
View File

@@ -0,0 +1,92 @@
(*
* 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 ULocalization;
interface
uses
Classes;
type
TLocalizationEntry = class(TObject)
constructor Create;
constructor Deserialize(Data: TStream);
procedure Serialize(Data: TStream);
function GetSize: Integer;
private
FNumber: Integer;
FUnknown: Byte;
FText: string;
published
property Number: Integer read FNumber write FNumber;
property Unknown: Byte read FUnknown write FUnknown;
property Text: string read FText write FText;
end;
implementation
constructor TLocalizationEntry.Create;
begin
FNumber := 0;
FUnknown := 0;
FText := '';
end;
constructor TLocalizationEntry.Deserialize(Data: TStream);
var
length: SmallInt;
begin
if assigned(Data) then
begin
Data.Read(FNumber, SizeOf(Integer));
Data.Read(FUnknown, SizeOf(Byte));
Data.Read(length, SizeOf(SmallInt));
SetLength(FText, length);
Data.Read(PChar(FText)^, length);
FText := UTF8Decode(FText);
end;
end;
procedure TLocalizationEntry.Serialize(Data: TStream);
var
iLength: SmallInt;
text: string;
begin
Data.Write(FNumber, SizeOf(Integer));
Data.Write(FUnknown, SizeOf(Byte));
text := UTF8Encode(FText);
iLength := Length(text);
Data.Write(iLength, SizeOf(SmallInt));
Data.Write(PChar(text)^, iLength);
end;
function TLocalizationEntry.GetSize: Integer;
begin
Result := SizeOf(Integer) + SizeOf(Byte) + SizeOf(SmallInt) + Length(FText);
end;
end.

180
UOLib/UMap.pas Normal file
View File

@@ -0,0 +1,180 @@
(*
* 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 UMap;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, UMulBlock, UWorldItem;
const
MapCellSize = 3;
MapBlockSize = 4 + (64 * MapCellSize);
type
TMapCell = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
function Clone: TMapCell; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
public
property Altitude: ShortInt read FZ write FZ;
end;
TMapBlock = class(TWorldBlock)
constructor Create(AData: TStream; AX, AY: Word); overload;
constructor Create(AData: TStream); overload;
destructor Destroy; override;
function Clone: TMapBlock; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FHeader: LongInt;
public
Cells: array[0..63] of TMapCell;
property Header: LongInt read FHeader write FHeader;
end;
function GetMapCellOffset(ABlock: Integer): Integer;
implementation
function GetMapCellOffset(ABlock: Integer): Integer;
var
group, tile: Integer;
begin
group := ABlock div 64;
tile := ABlock mod 64;
Result := group * MapBlockSize + 4 + tile * MapCellSize;
end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
begin
inherited Create(AOwner);
FX := AX;
FY := AY;
if assigned(AData) then
begin
AData.Read(FTileID, SizeOf(Word));
AData.Read(FZ, SizeOf(ShortInt));
end;
InitOriginalState;
end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
end;
function TMapCell.Clone: TMapCell;
begin
Result := TMapCell.Create(nil, nil);
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FTileID := FTileID;
end;
procedure TMapCell.Write(AData: TStream);
begin
AData.Write(FTileID, SizeOf(Word));
AData.Write(FZ, SizeOf(ShortInt));
end;
function TMapCell.GetSize: Integer;
begin
Result := MapCellSize;
end;
constructor TMapBlock.Create(AData: TStream; AX, AY: Word);
var
iX, iY: Integer;
buffer: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
try
buffer := nil;
if Assigned(AData) then
begin
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, 196);
buffer.Position := 0;
buffer.Read(FHeader, SizeOf(LongInt));
end;
for iY := 0 to 7 do
for iX := 0 to 7 do
Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY);
finally
if Assigned(buffer) then FreeAndNil(buffer);
end;
end;
constructor TMapBlock.Create(AData: TStream);
begin
Create(AData, 0, 0);
end;
destructor TMapBlock.Destroy;
var
i: Integer;
begin
for i := 0 to 63 do
Cells[i].Free;
inherited;
end;
function TMapBlock.Clone: TMapBlock;
var
i: Integer;
begin
Result := TMapBlock.Create(nil);
Result.FX := FX;
Result.FY := FY;
for i := 0 to 63 do
Result.Cells[i] := Cells[i].Clone;
end;
procedure TMapBlock.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FHeader, SizeOf(LongInt));
for i := 0 to 63 do
Cells[i].Write(AData);
end;
function TMapBlock.GetSize: Integer;
begin
Result := MapBlockSize;
end;
end.

171
UOLib/UMulBlock.pas Normal file
View File

@@ -0,0 +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 2007 Andreas Schneider
*)
unit UMulBlock;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes;
type
TMulBlock = class;
TMulBlockChanged = procedure(ABlock: TMulBlock) of object;
{ TMulBlockEventHandler }
TMulBlockEventHandler = class(TObject)
constructor Create;
destructor Destroy; override;
protected
FEvents: TList;
public
procedure RegisterEvent(AEvent: TMulBlockChanged);
procedure UnregisterEvent(AEvent: TMulBlockChanged);
procedure FireEvents(ABlock: TMulBlock);
end;
{ TMulBlock }
TMulBlock = class(TObject)
constructor Create;
destructor Destroy; override;
protected
FID: Integer;
FOnChanged: TMulBlockChanged;
FOnFinished: TMulBlockChanged;
FOnDestroy: TMulBlockEventHandler;
public
class procedure Change(ABlock: TMulBlock); virtual;
class procedure Finish(var ABlock: TMulBlock); virtual;
function Clone: TMulBlock; virtual; abstract;
function GetSize: Integer; virtual; abstract;
procedure Write(AData: TStream); virtual; abstract;
property ID: Integer read FID write FID;
property OnChanged: TMulBlockChanged read FOnChanged write FOnChanged;
property OnFinished: TMulBlockChanged read FOnFinished write FOnFinished;
property OnDestroy: TMulBlockEventHandler read FOnDestroy;
end;
implementation
type
PMethod = ^TMethod;
{ TMulBlockEventHandler }
constructor TMulBlockEventHandler.Create;
begin
inherited Create;
FEvents := TList.Create;
end;
destructor TMulBlockEventHandler.Destroy;
var
i: Integer;
begin
if FEvents <> nil then
begin
for i := 0 to FEvents.Count - 1 do
Dispose(PMethod(FEvents.Items[i]));
FreeAndNil(FEvents);
end;
inherited Destroy;
end;
procedure TMulBlockEventHandler.RegisterEvent(AEvent: TMulBlockChanged);
var
eventInfo: PMethod;
begin
//UnregisterEvent(AEvent);
New(eventInfo);
eventInfo^.Code := TMethod(AEvent).Code;
eventInfo^.Data := TMethod(AEvent).Data;
FEvents.Add(eventInfo);
end;
procedure TMulBlockEventHandler.UnregisterEvent(AEvent: TMulBlockChanged);
var
i: Integer;
function RemoveEntry: Boolean;
begin
Dispose(PMethod(FEvents.Items[i]));
FEvents.Delete(i);
Result := True;
end;
begin
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
Inc(i);
end;
procedure TMulBlockEventHandler.FireEvents(ABlock: TMulBlock);
var
i: Integer;
begin
for i := 0 to FEvents.Count - 1 do
TMulBlockChanged(FEvents.Items[i]^)(ABlock);
end;
{ TMulBlock }
constructor TMulBlock.Create;
begin
inherited Create;
FOnDestroy := TMulBlockEventHandler.Create;
end;
destructor TMulBlock.Destroy;
begin
if FOnDestroy <> nil then
begin
FOnDestroy.FireEvents(Self);
FreeAndNil(FOnDestroy);
end;
inherited Destroy;
end;
class procedure TMulBlock.Change(ABlock: TMulBlock);
begin
if ABlock <> nil then
begin
if ABlock.OnChanged <> nil then ABlock.OnChanged(ABlock);
end;
end;
class procedure TMulBlock.Finish(var ABlock: TMulBlock);
begin
if ABlock <> nil then
begin
if ABlock.OnFinished <> nil then ABlock.OnFinished(ABlock) else ABlock.Free;
ABlock := nil;
end;
end;
end.

157
UOLib/UMultiMap.pas Normal file
View File

@@ -0,0 +1,157 @@
(*
* 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 UMultiMap;
interface
uses
Classes, Graphics, UProgress;
type
TMultiMap = class(TObject)
constructor Create(Data: TStream; OnProgress: TOnProgressEvent = nil); overload;
constructor Create(Height, Width: Integer; OnProgress: TOnProgressEvent = nil); overload;
destructor Destroy; override;
procedure Write(Data: TStream);
protected
FGraphic: TBitmap;
FOnProgress: TOnProgressEvent;
public
property Graphic: TBitmap read FGraphic;
property OnProgress: TOnProgressEvent read FOnProgress write FOnProgress;
end;
implementation
{ TMultiMap }
constructor TMultiMap.Create(Data: TStream; OnProgress: TOnProgressEvent = nil);
var
height, width: Integer;
x, y, run: Integer;
pixelData: Byte;
color: TColor;
begin
if Assigned(Data) then
begin
Data.Read(width, SizeOf(Integer));
Data.Read(height, SizeOf(Integer));
Create(height, width, OnProgress);
if Assigned(FGraphic) then
begin
if Assigned(FOnProgress) then FOnProgress(height, 0);
x := 0;
y := 0;
while y < height do
begin
while (x < width) and (y < height) do
begin
Data.Read(pixelData, SizeOf(Byte));
if (pixelData and $80) = $80 then color := clBlack else color := clWhite;
for run := 1 to (pixelData and $7F) do
begin
FGraphic.Canvas.Pixels[x,y] := color;
Inc(x);
if x = width then
begin
x := 0;
inc(y);
if Assigned(FOnProgress) then FOnProgress(height, y);
if y = height then Break;
end;
end; //for
end; //while x & y
Inc(y);
if Assigned(FOnProgress) then FOnProgress(height, y);
end; //while y
if Assigned(FOnProgress) then FOnProgress(0, 0);
end; //if assigned
end else
Create(0, 0, OnProgress);
end;
constructor TMultiMap.Create(Height, Width: Integer; OnProgress: TOnProgressEvent = nil);
begin
FGraphic := TBitmap.Create;
FGraphic.Height := Height;
FGraphic.Width := Width;
FGraphic.PixelFormat := pf1bit;
FGraphic.HandleType := bmDIB;
FOnProgress := OnProgress;
end;
destructor TMultiMap.Destroy;
begin
if Assigned(FGraphic) then FGraphic.Free;
inherited;
end;
procedure TMultiMap.Write(Data: TStream);
var
height, width, x, y: Integer;
run: Byte;
state, newState: Boolean;
procedure DoWrite;
var
pixelData: Byte;
begin
pixelData := run;
if state then pixelData := pixelData or $80;
Data.Write(pixelData, SizeOf(Byte));
end;
begin
height := FGraphic.Height;
width := FGraphic.Width;
Data.Write(width, SizeOf(Integer));
Data.Write(height, SizeOf(Integer));
run := 0;
state := not (FGraphic.Canvas.Pixels[0,0] = clWhite);
if Assigned(FOnProgress) then FOnProgress(0, 0);
for y := 0 to height - 1 do
begin
for x := 0 to width - 1 do
begin
newState := not (FGraphic.Canvas.Pixels[x,y] = clWhite);
if (state = newState) and (run < $7F) then
begin
inc(run);
end else
begin
DoWrite;
state := newState;
run := 1;
end;
end;
if Assigned(FOnProgress) then FOnProgress(height, y);
end;
if run > 0 then DoWrite;
if Assigned(FOnProgress) then FOnProgress(0, 0);
end;
end.

379
UOLib/UStatics.pas Normal file
View File

@@ -0,0 +1,379 @@
(*
* 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 UStatics;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, UMulBlock, UGenericIndex, UTiledata, UWorldItem;
type
TStaticItem = class(TWorldItem)
constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word); overload;
constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
function Clone: TStaticItem; override;
function GetIdentifier: Integer;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FHue, FOrgHue: Word;
procedure SetHue(AHue: Word);
function HasChanged: Boolean; override;
public
procedure InitOriginalState; override;
property Hue: Word read FHue write SetHue;
end;
TStaticBlock = class(TWorldBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override;
function Clone: TStaticBlock; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
procedure ReverseWrite(AData: TStream);
procedure Sort;
protected
FItems: TList;
public
property Items: TList read FItems write FItems;
end;
TSeperatedStaticBlock = class(TStaticBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
destructor Destroy; override;
function Clone: TSeperatedStaticBlock; override;
function GetSize: Integer; override;
protected
procedure RefreshList;
public
Cells: array[0..63] of TList;
end;
implementation
{ TStaticItem }
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX, ABlockY: Word);
var
iX, iY: Byte;
begin
inherited Create(AOwner);
if assigned(AData) then
begin
AData.Read(FTileID, SizeOf(SmallInt));
AData.Read(iX, SizeOf(Byte));
AData.Read(iY, SizeOf(Byte));
AData.Read(FZ, SizeOf(ShortInt));
AData.Read(FHue, SizeOf(SmallInt));
FX := ABlockX * 8 + iX;
FY := ABlockY * 8 + iY;
end;
InitOriginalState;
end;
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
begin
Create(AOwner, AData, 0, 0);
end;
function TStaticItem.Clone: TStaticItem;
begin
Result := TStaticItem.Create(nil, nil);
Result.FTileID := FTileID;
Result.FX := FX;
Result.FY := FY;
Result.FZ := FZ;
Result.FHue := FHue;
end;
function TStaticItem.GetIdentifier: Integer;
begin
Result := 0 or (((FX mod 8) shl 28) and $F0000000) or (((FY mod 8) shl 24) and $0F000000) or ((Byte(FZ) shl 16) and $00FF0000) or (Word(FTileID) and $0000FFFF);
end;
procedure TStaticItem.Write(AData: TStream);
var
iX, iY: Byte;
begin
iX := FX mod 8;
iY := FY mod 8;
AData.Write(FTileID, SizeOf(SmallInt));
AData.Write(iX, SizeOf(Byte));
AData.Write(iY, SizeOf(Byte));
AData.Write(FZ, SizeOf(ShortInt));
AData.Write(FHue, SizeOf(SmallInt));
end;
function TStaticItem.GetSize: Integer;
begin
Result := 7;
end;
function TStaticItem.HasChanged: Boolean;
begin
Result := (FHue <> FOrgHue) or inherited HasChanged;
end;
procedure TStaticItem.InitOriginalState;
begin
FOrgHue := FHue;
inherited InitOriginalState;
end;
procedure TStaticItem.SetHue(AHue: Word);
begin
FHue := AHue;
DoChanged;
end;
{ TStaticBlock }
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
var
i: Integer;
block: TMemoryStream;
begin
inherited Create;
FX := AX;
FY := AY;
FItems := TList.Create;
if assigned(AData) and (AIndex.Lookup <> LongInt($FFFFFFFF)) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
for i := 1 to (AIndex.Size div 7) do
FItems.Add(TStaticItem.Create(Self, block, AX, AY));
block.Free;
end;
end;
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
begin
Create(AData, AIndex, 0, 0);
end;
destructor TStaticBlock.Destroy;
var
i: Integer;
begin
if Assigned(FItems) then
begin
for i := 0 to FItems.Count - 1 do
if Assigned(FItems[i]) then
begin
TStaticItem(FItems[i]).Free;
FItems[i] := nil;
end;
FItems.Free;
FItems := nil;
end;
inherited;
end;
function TStaticBlock.Clone: TStaticBlock;
var
i: Integer;
begin
Result := TStaticBlock.Create(nil, nil, FX, FY);
for i := 0 to FItems.Count - 1 do
Result.FItems.Add(TStaticItem(FItems.Items[i]).Clone);
end;
function TStaticBlock.GetSize: Integer;
begin
Result := FItems.Count * 7;
end;
procedure TStaticBlock.Write(AData: TStream);
var
i: Integer;
begin
for i := 0 to FItems.Count - 1 do
begin
TStaticItem(FItems[i]).Write(AData);
end;
end;
procedure TStaticBlock.ReverseWrite(AData: TStream);
var
i: Integer;
begin
for i := FItems.Count - 1 downto 0 do
begin
TStaticItem(FItems[i]).Write(AData);
end;
end;
procedure TStaticBlock.Sort;
var
iMin, iMax: Integer;
procedure sift;
var
i, j: integer;
begin
i := iMin;
j := 2 * i;
FItems[0] := FItems[i];
while j <= iMax do
begin
if j < iMax then
if TStaticItem(FItems[j]).GetIdentifier < TStaticItem(FItems[j + 1]).GetIdentifier then inc(j);
if TStaticItem(FItems[0]).GetIdentifier >= TStaticItem(FItems[j]).GetIdentifier then break;
FItems[i] := FItems[j];
i := j;
j := 2 * i;
end;
FItems[i] := FItems[0];
end;
begin
if FItems.Count > 0 then
begin
iMax := FItems.Count;
iMin := iMax div 2 + 1;
FItems.Insert(0, nil);
while iMin > 1 do
begin
dec(iMin);
sift;
end;
while iMax > 1 do
begin
FItems[0] := FItems[iMin];
FItems[iMin] := FItems[iMax];
FItems[iMax] := FItems[0];
dec(iMax);
sift;
end;
FItems.Delete(0);
end;
end;
{ TSeperatedStaticBlock }
constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
var
i: Integer;
item: TStaticItem;
block: TMemoryStream;
begin
inherited Create;
FItems := TList.Create;
FX := AX;
FY := AY;
for i := 0 to 63 do
Cells[i] := TList.Create;
if (AData <> nil) and (AIndex.Lookup <> LongInt($FFFFFFFF)) then
begin
AData.Position := AIndex.Lookup;
block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size);
block.Position := 0;
for i := 1 to (AIndex.Size div 7) do
begin
item := TStaticItem.Create(Self, block, AX, AY);
Cells[(item.Y mod 8) * 8 + (item.X mod 8)].Add(item);
end;
block.Free;
end;
end;
constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
begin
Create(AData, AIndex, 0, 0);
end;
destructor TSeperatedStaticBlock.Destroy;
var
i, j: Integer;
begin
if Assigned(FItems) then FreeAndNil(FItems);
for i := 0 to 63 do
begin
if Cells[i] <> nil then
begin
for j := 0 to Cells[i].Count - 1 do
begin
if Cells[i][j] <> nil then
begin
TStaticItem(Cells[i][j]).Free;
Cells[i][j] := nil;
end;
end;
Cells[i].Free;
Cells[i] := nil;
end;
end;
inherited Destroy;
end;
function TSeperatedStaticBlock.Clone: TSeperatedStaticBlock;
var
i, j: Integer;
begin
Result := TSeperatedStaticBlock.Create(nil, nil, FX, FY);
for i := 0 to 63 do
for j := 0 to Cells[i].Count - 1 do
Result.Cells[i].Add(TSeperatedStaticBlock(Cells[i].Items[j]).Clone);
end;
function TSeperatedStaticBlock.GetSize: Integer;
begin
RefreshList;
Result := inherited GetSize;
end;
procedure TSeperatedStaticBlock.RefreshList;
var
i, j: Integer;
begin
FItems.Clear;
for i := 0 to 63 do
begin
if Cells[i] <> nil then
begin
for j := 0 to Cells[i].Count - 1 do
if Cells[i].Items[j] <> nil then
FItems.Add(Cells[i].Items[j]);
end;
end;
Sort;
end;
end.

136
UOLib/UTexture.pas Normal file
View File

@@ -0,0 +1,136 @@
(*
* 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 UTexture;
{$mode objfpc}{$H+}
interface
uses
Classes, Imaging, ImagingTypes, ImagingClasses, UMulBlock, UGenericIndex;
type
TTexture = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
constructor Create(AExtra: Integer); overload;
destructor Destroy; override;
function Clone: TTexture; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
procedure RefreshBuffer;
protected
FGraphic: TSingleImage;
FBuffer: TStream;
FExtra: Integer;
public
property Graphic: TSingleImage read FGraphic;
property Buffer: TStream read FBuffer;
property Extra: Integer read FExtra write FExtra;
end;
implementation
constructor TTexture.Create(AData: TStream; AIndex: TGenericIndex);
var
size: Integer;
begin
FExtra := AIndex.Various;
if FExtra = 0 then
size := 64
else
size := 128;
FGraphic := TSingleImage.CreateFromParams(size, size, ifX1R5G5B5);
if assigned(AData) then
begin
AData.Position := AIndex.Lookup;
AData.Read(FGraphic.Bits^, size * size * 2);
end;
FGraphic.Format := ifX8R8G8B8;
end;
constructor TTexture.Create(AExtra: Integer);
var
size: Integer;
begin
FExtra := AExtra;
if AExtra = 0 then
size := 64
else
size := 128;
FGraphic := TSingleImage.CreateFromParams(size, size, ifX8R8G8B8);
FBuffer := TMemoryStream.Create;
end;
destructor TTexture.Destroy;
begin
if FGraphic <> nil then FGraphic.Free;
if FBuffer <> nil then FBuffer.Free;
inherited;
end;
function TTexture.Clone: TTexture;
begin
Result := TTexture.Create(FExtra);
Result.FGraphic.Assign(Self.Graphic);
end;
procedure TTexture.Write(AData: TStream);
begin
FBuffer.Position := 0;
AData.CopyFrom(FBuffer, FBuffer.Size);
end;
function TTexture.GetSize: Integer;
begin
RefreshBuffer;
Result := FBuffer.Size
end;
procedure TTexture.RefreshBuffer;
var
argbGraphic: TSingleImage;
begin
argbGraphic := TSingleImage.CreateFromImage(FGraphic);
argbGraphic.Format := ifX1R5G5B5;
FBuffer.Size := 0;
if (argbGraphic.Height > 0) and (argbGraphic.Width > 0) then
begin
if (argbGraphic.Height < 128) or (argbGraphic.Width < 128) then
begin
FExtra := 0;
argbGraphic.Resize(64, 64, rfNearest);
end else
begin
FExtra := 1;
argbGraphic.Resize(128, 128, rfNearest);
end;
FBuffer.Write(argbGraphic.Bits^, argbGraphic.Height * argbGraphic.Width * 2);
end;
argbGraphic.Free;
end;
end.

386
UOLib/UTiledata.pas Normal file
View File

@@ -0,0 +1,386 @@
(*
* 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 UTiledata;
{$mode objfpc}{$H+}
interface
uses
Classes, UMulBlock;
const
tdfBackground = $00000001;
tdfWeapon = $00000002;
tdfTransparent = $00000004;
tdfTranslucent = $00000008;
tdfWall = $00000010;
tdfDamaging = $00000020;
tdfImpassable = $00000040;
tdfWet = $00000080;
tdfUnknown1 = $00000100;
tdfSurface = $00000200;
tdfBridge = $00000400;
tdfGeneric = $00000800;
tdfWindow = $00001000;
tdfNoShoot = $00002000;
tdfArticleA = $00004000;
tdfArticleAn = $00008000;
tdfInternal = $00010000;
tdfFoliage = $00020000;
tdfPartialHue = $00040000;
tdfUnknown2 = $00080000;
tdfMap = $00100000;
tdfContainer = $00200000;
tdfWearable = $00400000;
tdfLightSource = $00800000;
tdfAnimation = $01000000;
tdfNoDiagonal = $02000000;
tdfArtUsed = $04000000;
tdfArmor = $08000000;
tdfRoof = $10000000;
tdfDoor = $20000000;
tdfStairBack = $40000000;
tdfStairRight = $80000000;
LandTileDataSize = 26;
LandTileGroupSize = 4 + 32 * LandTileDataSize;
StaticTileDataSize = 37;
StaticTileGroupSize = 4 + 32 * StaticTileDataSize;
type
{ TTiledata }
TTiledata = class(TMulBlock)
protected
FFlags: LongWord;
FTileName: string;
public
property Flags: LongWord read FFlags write FFlags;
property TileName: string read FTileName write FTileName;
function HasFlag(AFlag: LongWord): Boolean;
end;
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 = 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 = 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 = 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;
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;
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;
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;
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;
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;
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;
{ TTiledata }
function TTiledata.HasFlag(AFlag: LongWord): Boolean;
begin
Result := (FFlags and AFlag) = AFlag;
end;
end.

92
UOLib/UVerdata.pas Normal file
View File

@@ -0,0 +1,92 @@
(*
* 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 UVerdata;
interface
uses
Classes, UGenericIndex;
type
TFileType = (map0 = $00, staidx0, statics0, artidx, art, animidx, anim,
soundidx, sound, texidx, texmaps, gumpidx, gumpart, multiidx, multi,
skillsidx, skills, tiledata = $1E, animdata);
TVerdataIndex = class(TGenericIndex)
constructor Create(Data: TStream);
function Clone: TVerdataIndex; override;
procedure Write(Data: TStream); override;
function GetSize: Integer; override;
protected
FFileID: TFileType;
FBlock: LongInt;
published
property FileID: TFileType read FFileID write FFileID;
property Block: LongInt read FBlock write FBlock;
end;
implementation
constructor TVerdataIndex.Create;
var
fileID: LongInt;
begin
if assigned(Data) then
begin
Data.Read(fileID, SizeOf(LongInt));
Data.Read(FBlock, SizeOf(LongInt));
FFileID := TFileType(fileID);
end;
inherited;
end;
function TVerdataIndex.Clone: TVerdataIndex;
begin
Result := TVerdataIndex.Create(nil);
Result.FFileID := FFileID;
Result.FBlock := FBlock;
Result.FLookup := FLookup;
Result.FSize := FSize;
Result.FVarious := FVarious;
end;
procedure TVerdataIndex.Write;
var
fileID: LongInt;
begin
fileID := LongInt(FFileID);
Data.Write(fileID, SizeOf(LongInt));
Data.Write(FBlock, SizeOf(LongInt));
inherited;
end;
function TVerdataIndex.GetSize: Integer;
begin
Result := inherited GetSize + 8;
end;
end.

282
UOLib/UWorldItem.pas Normal file
View File

@@ -0,0 +1,282 @@
(*
* 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 UWorldItem;
{$mode objfpc}{$H+}
interface
uses
Classes, UMulBlock;
type
TWorldBlock = class;
TWorldItem = class(TMulBlock)
constructor Create(AOwner: TWorldBlock);
protected
FOwner, FOrgOwner: TWorldBlock;
FTileID, FOrgTileID: Word;
FX, FOrgX: Word;
FY, FOrgY: Word;
FZ, FOrgZ: ShortInt;
FSelected: Boolean;
FLocked: Boolean;
FChanged: Boolean;
FPriority: Integer;
FPriorityBonus: ShortInt;
FPrioritySolver: Integer;
procedure SetTileID(ATileID: Word);
procedure SetX(AX: Word);
procedure SetY(AY: Word);
procedure SetZ(AZ: ShortInt);
procedure SetSelected(ASelected: Boolean);
procedure SetOwner(AOwner: TWorldBlock);
procedure SetLocked(ALocked: Boolean);
procedure DoChanged;
function HasChanged: Boolean; virtual;
public
procedure UpdatePos(AX, AY: Word; AZ: ShortInt);
procedure Delete;
procedure InitOriginalState; virtual;
property Owner: TWorldBlock read FOwner write SetOwner;
property TileID: Word read FTileID write SetTileID;
property X: Word read FX write SetX;
property Y: Word read FY write SetY;
property Z: ShortInt read FZ write SetZ;
property Selected: Boolean read FSelected write SetSelected;
property Locked: Boolean read FLocked write SetLocked;
property Changed: Boolean read FChanged;
property Priority: Integer read FPriority write FPriority;
property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus;
property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver;
end;
TWorldBlock = class(TMulBlock)
constructor Create;
protected
FX: Word;
FY: Word;
FRefCount: Integer;
FChanges: Integer;
function GetChanged: Boolean;
procedure SetChanged(AChanged: Boolean);
procedure DoStateChanged;
public
property X: Word read FX write FX;
property Y: Word read FY write FY;
property RefCount: Integer read FRefCount;
property Changed: Boolean read GetChanged write SetChanged;
procedure AddRef;
procedure RemoveRef;
procedure CleanUp;
end;
implementation
{ TWorldItem }
constructor TWorldItem.Create(AOwner: TWorldBlock);
begin
inherited Create;
FSelected := False;
FLocked := False;
FChanged := False;
FOwner := AOwner;
end;
procedure TWorldItem.Delete;
begin
SetSelected(False);
SetLocked(False);
if (FOwner <> FOrgOwner) then
FOwner.Changed := False
else if Assigned(FOrgOwner) and (not FChanged) then
FOrgOwner.Changed := True;
Free;
end;
procedure TWorldItem.DoChanged;
var
blockChanged: Boolean;
begin
blockChanged := HasChanged;
if Assigned(FOwner) then
begin
if FChanged and (not blockChanged) then
FOwner.Changed := False
else if (not FChanged) and blockChanged then
FOwner.Changed := True;
end;
FChanged := blockChanged;
if Assigned(FOnChanged) then
FOnChanged(Self);
end;
function TWorldItem.HasChanged: Boolean;
begin
Result := (FX <> FOrgX) or (FY <> FOrgY) or (FZ <> FOrgZ) or
(FTileID <> FOrgTileID) or (FOrgOwner <> FOwner);
end;
procedure TWorldItem.InitOriginalState;
begin
{if Assigned(FOrgOwner) and (FOwner <> FOrgOwner) then
FOrgOwner.Changed := False;}
FOrgOwner := FOwner;
FOrgTileID := FTileID;
FOrgX := FX;
FOrgY := FY;
FOrgZ := FZ;
DoChanged;
end;
procedure TWorldItem.SetLocked(ALocked: Boolean);
begin
if FLocked <> ALocked then
begin
FLocked := ALocked;
if Assigned(FOwner) then
if FLocked then
FOwner.AddRef
else
FOwner.RemoveRef;
end;
end;
procedure TWorldItem.SetOwner(AOwner: TWorldBlock);
begin
if FOwner <> AOwner then
begin
if Assigned(FOwner) then
begin
if FOwner <> FOrgOwner then
FOwner.Changed := False;
if FLocked then FOwner.RemoveRef;
if FSelected then FOwner.RemoveRef;
end;
FOwner := AOwner;
if Assigned(FOwner) then
begin
if FOwner <> FOrgOwner then
FOwner.Changed := True;
if FLocked then FOwner.AddRef;
if FSelected then FOwner.AddRef;
end;
DoChanged;
end;
end;
procedure TWorldItem.SetSelected(ASelected: Boolean);
begin
if (FOwner <> nil) and (ASelected <> FSelected) then
if ASelected then
FOwner.AddRef
else
FOwner.RemoveRef;
FSelected := ASelected;
end;
procedure TWorldItem.SetTileID(ATileID: Word);
begin
FTileID := ATileID;
DoChanged;
end;
procedure TWorldItem.SetX(AX: Word);
begin
FX := AX;
DoChanged;
end;
procedure TWorldItem.SetY(AY: Word);
begin
FY := AY;
DoChanged
end;
procedure TWorldItem.SetZ(AZ: ShortInt);
begin
FZ := AZ;
DoChanged;
end;
procedure TWorldItem.UpdatePos(AX, AY: Word; AZ: ShortInt);
begin
FX := AX;
FY := AY;
FZ := AZ;
DoChanged;
end;
{ TWorldBlock }
procedure TWorldBlock.AddRef;
begin
Inc(FRefCount);
DoStateChanged;
end;
procedure TWorldBlock.CleanUp;
begin
FChanges := 0;
DoStateChanged;
end;
constructor TWorldBlock.Create;
begin
inherited Create;
FRefCount := 0;
FChanges := 0;
end;
procedure TWorldBlock.DoStateChanged;
begin
if Assigned(FOnChanged) then
FOnChanged(Self);
end;
function TWorldBlock.GetChanged: Boolean;
begin
Result := (FChanges <> 0);
end;
procedure TWorldBlock.RemoveRef;
begin
if FRefCount > 0 then
Dec(FRefCount);
DoStateChanged;
end;
procedure TWorldBlock.SetChanged(AChanged: Boolean);
begin
if AChanged then
Inc(FChanges)
else
Dec(FChanges);
DoStateChanged;
end;
end.