- Added hgeol

- Fixed repository side eol to be LF
This commit is contained in:
2010-07-25 00:18:54 +02:00
parent 0d84ac4b5d
commit 49599fdcf4
110 changed files with 40208 additions and 40202 deletions

View File

@@ -1,325 +1,325 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit 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 > -1) 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, 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 + i], 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 + i], 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.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit 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 > -1) 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, 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 + i], 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 + i], 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.

View File

@@ -1,83 +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.
(*
* 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.

View File

@@ -1,85 +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.
(*
* 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.

View File

@@ -1,233 +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.
(*
* 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.

View File

@@ -1,219 +1,219 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UHue;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, Graphics, UMulBlock;
type
TColorTable = array[0..31] of Word;
{ THue }
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 }
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 AData <> nil 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 AData <> nil 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);
buffer.Free;
end;
destructor THueGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 7 do
FreeAndNil(FHueEntries[i]);
inherited Destroy;
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
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.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UHue;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes, Graphics, UMulBlock;
type
TColorTable = array[0..31] of Word;
{ THue }
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 }
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 AData <> nil 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 AData <> nil 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);
buffer.Free;
end;
destructor THueGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 7 do
FreeAndNil(FHueEntries[i]);
inherited Destroy;
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
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.

View File

@@ -1,121 +1,121 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit ULight;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Imaging, ImagingClasses, ImagingTypes, UMulBlock,
UGenericIndex;
type
{ TLight }
TLight = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex);
destructor Destroy; override;
function Clone: TLight; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FGraphic: TSingleImage;
public
property Graphic: TSingleImage read FGraphic;
end;
implementation
{ TLight }
constructor TLight.Create(AData: TStream; AIndex: TGenericIndex);
var
buffer: TMemoryStream;
Width, Height: Word;
color: Byte;
color32: TColor32Rec;
x, y: Integer;
begin
if (AIndex <> nil) and (AIndex.Lookup > -1) and (AIndex.Size > 0) then
begin
Width := word(AIndex.Various shr 16);
Height := AIndex.Various and $FFFF;
FGraphic := TSingleImage.CreateFromParams(Width, Height, ifA8R8G8B8);
if AData <> nil then
begin
AData.Position := AIndex.Lookup;
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, AIndex.Size);
buffer.Position := 0;
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
begin
buffer.Read(color, SizeOf(byte));
color32.R := color * 8;
color32.G := color32.R;
color32.B := color32.R;
if color > 0 then
color32.A := 255
else
color32.A := 0;
PColor32(FGraphic.PixelPointers[x, y])^ := color32.Color;
end;
buffer.Free;
end;
end;
if FGraphic = nil then
FGraphic := TSingleImage.CreateFromParams(0, 0, ifA8R8G8B8);
end;
destructor TLight.Destroy;
begin
FreeAndNil(FGraphic);
inherited Destroy;
end;
function TLight.Clone: TLight;
begin
Result := TLight.Create(nil, nil);
Result.Graphic.Assign(FGraphic);
end;
function TLight.GetSize: Integer;
begin
Result := 0;
raise Exception.Create('Not implemented: TLight.GetSize');
end;
procedure TLight.Write(AData: TStream);
begin
raise Exception.Create('Not implemented: TLight.Write');
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit ULight;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Imaging, ImagingClasses, ImagingTypes, UMulBlock,
UGenericIndex;
type
{ TLight }
TLight = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex);
destructor Destroy; override;
function Clone: TLight; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FGraphic: TSingleImage;
public
property Graphic: TSingleImage read FGraphic;
end;
implementation
{ TLight }
constructor TLight.Create(AData: TStream; AIndex: TGenericIndex);
var
buffer: TMemoryStream;
Width, Height: Word;
color: Byte;
color32: TColor32Rec;
x, y: Integer;
begin
if (AIndex <> nil) and (AIndex.Lookup > -1) and (AIndex.Size > 0) then
begin
Width := word(AIndex.Various shr 16);
Height := AIndex.Various and $FFFF;
FGraphic := TSingleImage.CreateFromParams(Width, Height, ifA8R8G8B8);
if AData <> nil then
begin
AData.Position := AIndex.Lookup;
buffer := TMemoryStream.Create;
buffer.CopyFrom(AData, AIndex.Size);
buffer.Position := 0;
for y := 0 to Height - 1 do
for x := 0 to Width - 1 do
begin
buffer.Read(color, SizeOf(byte));
color32.R := color * 8;
color32.G := color32.R;
color32.B := color32.R;
if color > 0 then
color32.A := 255
else
color32.A := 0;
PColor32(FGraphic.PixelPointers[x, y])^ := color32.Color;
end;
buffer.Free;
end;
end;
if FGraphic = nil then
FGraphic := TSingleImage.CreateFromParams(0, 0, ifA8R8G8B8);
end;
destructor TLight.Destroy;
begin
FreeAndNil(FGraphic);
inherited Destroy;
end;
function TLight.Clone: TLight;
begin
Result := TLight.Create(nil, nil);
Result.Graphic.Assign(FGraphic);
end;
function TLight.GetSize: Integer;
begin
Result := 0;
raise Exception.Create('Not implemented: TLight.GetSize');
end;
procedure TLight.Write(AData: TStream);
begin
raise Exception.Create('Not implemented: TLight.Write');
end;
end.

View File

@@ -1,92 +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.
(*
* 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.

View File

@@ -1,171 +1,171 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UMulBlock;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes;
type
TMulBlock = class;
TMulBlockChanged = procedure(ABlock: TMulBlock) of object;
{ TMulBlockEventHandler }
TMulBlockEventHandler = class
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
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.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UMulBlock;
{$mode objfpc}{$H+}
interface
uses
SysUtils, Classes;
type
TMulBlock = class;
TMulBlockChanged = procedure(ABlock: TMulBlock) of object;
{ TMulBlockEventHandler }
TMulBlockEventHandler = class
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
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.

View File

@@ -1,157 +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.
(*
* 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.

View File

@@ -1,136 +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.
(*
* 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.

View File

@@ -1,376 +1,376 @@
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UTiledata;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UMulBlock;
const
LandTileDataSize = 26;
LandTileGroupSize = 4 + 32 * LandTileDataSize;
StaticTileDataSize = 37;
StaticTileGroupSize = 4 + 32 * StaticTileDataSize;
type
TTileDataFlag = (tdfBackground, tdfWeapon, tdfTransparent, tdfTranslucent,
tdfWall, tdfDamaging, tdfImpassable, tdfWet, tdfUnknown1,
tdfSurface, tdfBridge, tdfGeneric, tdfWindow, tdfNoShoot,
tdfArticleA, tdfArticleAn, tdfInternal, tdfFoliage,
tdfPartialHue, tdfUnknown2, tdfMap, tdfContainer,
tdfWearable, tdfLightSource, tdfAnimation, tdfNoDiagonal,
tdfArtUsed, tdfArmor, tdfRoof, tdfDoor, tdfStairBack,
tdfStairRight);
TTileDataFlags = set of TTileDataFlag;
{ TTiledata }
TTiledata = class(TMulBlock)
protected
FFlags: TTileDataFlags;
FTileName: string;
public
property Flags: TTileDataFlags read FFlags write FFlags;
property TileName: string read FTileName write FTileName;
end;
{ TLandTiledata }
TLandTiledata = class(TTiledata)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TLandTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FTextureID: Word;
public
property TextureID: Word read FTextureID write FTextureID;
end;
{ TStaticTiledata }
TStaticTiledata = class(TTiledata)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TStaticTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FWeight: Byte;
FQuality: Byte;
FUnknown1: Word;
FUnknown2: Byte;
FQuantity: Byte;
FAnimID: Word;
FUnknown3: Byte;
FHue: Byte;
FUnknown4: Word;
FHeight: Byte;
public
property Weight: Byte read FWeight write FWeight;
property Quality: Byte read FQuality write FQuality;
property Unknown1: Word read FUnknown1 write FUnknown1;
property Unknown2: Byte read FUnknown2 write FUnknown2;
property Quantity: Byte read FQuantity write FQuantity;
property AnimID: Word read FAnimID write FAnimID;
property Unknown3: Byte read FUnknown3 write FUnknown3;
property Hue: Byte read FHue write FHue;
property Unknown4: Word read FUnknown4 write FUnknown4;
property Height: Byte read FHeight write FHeight;
end;
{ TLandTileGroup }
TLandTileGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TLandTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FUnknown: LongInt;
public
LandTileData: array[0..31] of TLandTiledata;
property Unknown: LongInt read FUnknown write FUnknown;
end;
{ TStaticTileGroup }
TStaticTileGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TStaticTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FUnknown: LongInt;
public
StaticTileData: array[0..31] of TStaticTiledata;
property Unknown: LongInt read FUnknown write FUnknown;
end;
function GetTileDataOffset(ABlock: Integer): Integer;
implementation
function GetTileDataOffset(ABlock: Integer): Integer;
var
group, tile: Integer;
begin
if ABlock > $3FFF then
begin
ABlock := ABlock - $4000;
group := ABlock div 32;
tile := ABlock mod 32;
Result := 512 * LandTileGroupSize + group * StaticTileGroupSize + 4
+ tile * StaticTileDataSize;
end else
begin
group := ABlock div 32;
tile := ABlock mod 32;
Result := group * LandTileGroupSize + 4 + tile * LandTileDataSize;
end;
end;
{ TLandTiledata }
constructor TLandTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if assigned(AData) then
begin
AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FTextureID, SizeOf(Word));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TLandTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TLandTiledata.Clone: TLandTiledata;
begin
Result := TLandTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FTextureID := FTextureID;
Result.FTileName := FTileName;
end;
procedure TLandTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FTextureID, SizeOf(Word));
AData.Write(PChar(FTileName)^, 20);
end;
function TLandTiledata.GetSize: Integer;
begin
GetSize := LandTileDataSize;
end;
{ TStaticTiledata}
constructor TStaticTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if AData <> nil then
begin
AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FWeight, SizeOf(Byte));
AData.Read(FQuality, SizeOf(Byte));
AData.Read(FUnknown1, SizeOf(Word));
AData.Read(FUnknown2, SizeOf(Byte));
AData.Read(FQuantity, SizeOf(Byte));
AData.Read(FAnimID, SizeOf(Word));
AData.Read(FUnknown3, SizeOf(Byte));
AData.Read(FHue, SizeOf(Byte));
AData.Read(FUnknown4, SizeOf(Word));
AData.Read(FHeight, SizeOf(Byte));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TStaticTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TStaticTiledata.Clone: TStaticTiledata;
begin
Result := TStaticTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FWeight := FWeight;
Result.FQuality := FQuality;
Result.FUnknown1 := FUnknown1;
Result.FUnknown2 := FUnknown2;
Result.FQuantity := FQuantity;
Result.FAnimID := FAnimID;
Result.FUnknown3 := FUnknown3;
Result.FHue := FHue;
Result.FUnknown4 := FUnknown4;
Result.FHeight := FHeight;
Result.FTileName := FTileName;
end;
procedure TStaticTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FWeight, SizeOf(Byte));
AData.Write(FQuality, SizeOf(Byte));
AData.Write(FUnknown1, SizeOf(Word));
AData.Write(FUnknown2, SizeOf(Byte));
AData.Write(FQuantity, SizeOf(Byte));
AData.Write(FAnimID, SizeOf(Word));
AData.Write(FUnknown3, SizeOf(Byte));
AData.Write(FHue, SizeOf(Byte));
AData.Write(FUnknown4, SizeOf(Word));
AData.Write(FHeight, SizeOf(Byte));
AData.Write(PChar(FTileName)^, 20);
end;
function TStaticTiledata.GetSize: Integer;
begin
GetSize := StaticTileDataSize;
end;
{ TLandTileGroup }
constructor TLandTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
LandTileData[i] := TLandTiledata.Create(AData);
end;
destructor TLandTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
LandTileData[i].Free;
inherited;
end;
function TLandTileGroup.Clone: TLandTileGroup;
var
i: Integer;
begin
Result := TLandTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.LandTileData[i] := LandTileData[i].Clone;
end;
procedure TLandTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
LandTileData[i].Write(AData);
end;
function TLandTileGroup.GetSize: Integer;
begin
GetSize := LandTileGroupSize;
end;
{ TStaticTileGroup }
constructor TStaticTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
StaticTileData[i] := TStaticTiledata.Create(AData);
end;
destructor TStaticTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
StaticTileData[i].Free;
inherited;
end;
function TStaticTileGroup.Clone: TStaticTileGroup;
var
i: Integer;
begin
Result := TStaticTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.StaticTileData[i] := StaticTileData[i].Clone;
end;
procedure TStaticTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
StaticTileData[i].Write(AData);
end;
function TStaticTileGroup.GetSize: Integer;
begin
GetSize := StaticTileGroupSize;
end;
end.
(*
* CDDL HEADER START
*
* The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance
* with the License.
*
* You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions
* and limitations under the License.
*
* When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner]
*
* CDDL HEADER END
*
*
* Portions Copyright 2009 Andreas Schneider
*)
unit UTiledata;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, UMulBlock;
const
LandTileDataSize = 26;
LandTileGroupSize = 4 + 32 * LandTileDataSize;
StaticTileDataSize = 37;
StaticTileGroupSize = 4 + 32 * StaticTileDataSize;
type
TTileDataFlag = (tdfBackground, tdfWeapon, tdfTransparent, tdfTranslucent,
tdfWall, tdfDamaging, tdfImpassable, tdfWet, tdfUnknown1,
tdfSurface, tdfBridge, tdfGeneric, tdfWindow, tdfNoShoot,
tdfArticleA, tdfArticleAn, tdfInternal, tdfFoliage,
tdfPartialHue, tdfUnknown2, tdfMap, tdfContainer,
tdfWearable, tdfLightSource, tdfAnimation, tdfNoDiagonal,
tdfArtUsed, tdfArmor, tdfRoof, tdfDoor, tdfStairBack,
tdfStairRight);
TTileDataFlags = set of TTileDataFlag;
{ TTiledata }
TTiledata = class(TMulBlock)
protected
FFlags: TTileDataFlags;
FTileName: string;
public
property Flags: TTileDataFlags read FFlags write FFlags;
property TileName: string read FTileName write FTileName;
end;
{ TLandTiledata }
TLandTiledata = class(TTiledata)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TLandTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FTextureID: Word;
public
property TextureID: Word read FTextureID write FTextureID;
end;
{ TStaticTiledata }
TStaticTiledata = class(TTiledata)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TStaticTiledata; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FWeight: Byte;
FQuality: Byte;
FUnknown1: Word;
FUnknown2: Byte;
FQuantity: Byte;
FAnimID: Word;
FUnknown3: Byte;
FHue: Byte;
FUnknown4: Word;
FHeight: Byte;
public
property Weight: Byte read FWeight write FWeight;
property Quality: Byte read FQuality write FQuality;
property Unknown1: Word read FUnknown1 write FUnknown1;
property Unknown2: Byte read FUnknown2 write FUnknown2;
property Quantity: Byte read FQuantity write FQuantity;
property AnimID: Word read FAnimID write FAnimID;
property Unknown3: Byte read FUnknown3 write FUnknown3;
property Hue: Byte read FHue write FHue;
property Unknown4: Word read FUnknown4 write FUnknown4;
property Height: Byte read FHeight write FHeight;
end;
{ TLandTileGroup }
TLandTileGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TLandTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FUnknown: LongInt;
public
LandTileData: array[0..31] of TLandTiledata;
property Unknown: LongInt read FUnknown write FUnknown;
end;
{ TStaticTileGroup }
TStaticTileGroup = class(TMulBlock)
constructor Create(AData: TStream);
destructor Destroy; override;
function Clone: TStaticTileGroup; override;
function GetSize: Integer; override;
procedure Write(AData: TStream); override;
protected
FUnknown: LongInt;
public
StaticTileData: array[0..31] of TStaticTiledata;
property Unknown: LongInt read FUnknown write FUnknown;
end;
function GetTileDataOffset(ABlock: Integer): Integer;
implementation
function GetTileDataOffset(ABlock: Integer): Integer;
var
group, tile: Integer;
begin
if ABlock > $3FFF then
begin
ABlock := ABlock - $4000;
group := ABlock div 32;
tile := ABlock mod 32;
Result := 512 * LandTileGroupSize + group * StaticTileGroupSize + 4
+ tile * StaticTileDataSize;
end else
begin
group := ABlock div 32;
tile := ABlock mod 32;
Result := group * LandTileGroupSize + 4 + tile * LandTileDataSize;
end;
end;
{ TLandTiledata }
constructor TLandTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if assigned(AData) then
begin
AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FTextureID, SizeOf(Word));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TLandTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TLandTiledata.Clone: TLandTiledata;
begin
Result := TLandTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FTextureID := FTextureID;
Result.FTileName := FTileName;
end;
procedure TLandTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FTextureID, SizeOf(Word));
AData.Write(PChar(FTileName)^, 20);
end;
function TLandTiledata.GetSize: Integer;
begin
GetSize := LandTileDataSize;
end;
{ TStaticTiledata}
constructor TStaticTiledata.Create(AData: TStream);
begin
SetLength(FTileName, 20);
if AData <> nil then
begin
AData.Read(FFlags, SizeOf(LongWord));
AData.Read(FWeight, SizeOf(Byte));
AData.Read(FQuality, SizeOf(Byte));
AData.Read(FUnknown1, SizeOf(Word));
AData.Read(FUnknown2, SizeOf(Byte));
AData.Read(FQuantity, SizeOf(Byte));
AData.Read(FAnimID, SizeOf(Word));
AData.Read(FUnknown3, SizeOf(Byte));
AData.Read(FHue, SizeOf(Byte));
AData.Read(FUnknown4, SizeOf(Word));
AData.Read(FHeight, SizeOf(Byte));
AData.Read(PChar(FTileName)^, 20);
end;
FTileName := Trim(FTileName);
end;
destructor TStaticTiledata.Destroy;
begin
SetLength(FTileName, 0);
inherited;
end;
function TStaticTiledata.Clone: TStaticTiledata;
begin
Result := TStaticTiledata.Create(nil);
Result.FFlags := FFlags;
Result.FWeight := FWeight;
Result.FQuality := FQuality;
Result.FUnknown1 := FUnknown1;
Result.FUnknown2 := FUnknown2;
Result.FQuantity := FQuantity;
Result.FAnimID := FAnimID;
Result.FUnknown3 := FUnknown3;
Result.FHue := FHue;
Result.FUnknown4 := FUnknown4;
Result.FHeight := FHeight;
Result.FTileName := FTileName;
end;
procedure TStaticTiledata.Write(AData: TStream);
var
i: Integer;
begin
if Length(FTileName) < 20 then
for i := Length(FTileName) to 20 do
FTileName := FTileName + #0;
AData.Write(FFlags, SizeOf(LongWord));
AData.Write(FWeight, SizeOf(Byte));
AData.Write(FQuality, SizeOf(Byte));
AData.Write(FUnknown1, SizeOf(Word));
AData.Write(FUnknown2, SizeOf(Byte));
AData.Write(FQuantity, SizeOf(Byte));
AData.Write(FAnimID, SizeOf(Word));
AData.Write(FUnknown3, SizeOf(Byte));
AData.Write(FHue, SizeOf(Byte));
AData.Write(FUnknown4, SizeOf(Word));
AData.Write(FHeight, SizeOf(Byte));
AData.Write(PChar(FTileName)^, 20);
end;
function TStaticTiledata.GetSize: Integer;
begin
GetSize := StaticTileDataSize;
end;
{ TLandTileGroup }
constructor TLandTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
LandTileData[i] := TLandTiledata.Create(AData);
end;
destructor TLandTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
LandTileData[i].Free;
inherited;
end;
function TLandTileGroup.Clone: TLandTileGroup;
var
i: Integer;
begin
Result := TLandTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.LandTileData[i] := LandTileData[i].Clone;
end;
procedure TLandTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
LandTileData[i].Write(AData);
end;
function TLandTileGroup.GetSize: Integer;
begin
GetSize := LandTileGroupSize;
end;
{ TStaticTileGroup }
constructor TStaticTileGroup.Create(AData: TStream);
var
i: Integer;
begin
if assigned(AData) then
begin
AData.Read(FUnknown, SizeOf(LongInt));
end;
for i := 0 to 31 do
StaticTileData[i] := TStaticTiledata.Create(AData);
end;
destructor TStaticTileGroup.Destroy;
var
i: Integer;
begin
for i := 0 to 31 do
StaticTileData[i].Free;
inherited;
end;
function TStaticTileGroup.Clone: TStaticTileGroup;
var
i: Integer;
begin
Result := TStaticTileGroup.Create(nil);
Result.FUnknown := FUnknown;
for i := 0 to 31 do
Result.StaticTileData[i] := StaticTileData[i].Clone;
end;
procedure TStaticTileGroup.Write(AData: TStream);
var
i: Integer;
begin
AData.Write(FUnknown, SizeOf(LongInt));
for i := 0 to 31 do
StaticTileData[i].Write(AData);
end;
function TStaticTileGroup.GetSize: Integer;
begin
GetSize := StaticTileGroupSize;
end;
end.

View File

@@ -1,92 +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.
(*
* 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.