CentrED/UOLib/UArt.pas

347 lines
12 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

(*
* 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; OldFormat: Boolean = False); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean; OldFormat: Boolean = False); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean; OldFormat: Boolean = False); 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..(MaxInt div SizeOf(Word) - 1)] of Word; // а не перебор ли?
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; OldFormat: Boolean = False);
begin
Create(AData, AIndex, AArtType, 0, nil, False, OldFormat);
end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean; OldFormat: Boolean = False);
begin
Create(AData, AIndex, AArtType, 0, AHue, APartialHue, OldFormat);
end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean; OldFormat: Boolean = False);
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 // Lands
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 // Lands
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 // Items
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;
if not OldFormat then begin // General Clients
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;
end else begin // OldFormat (Pre-Alpha Client)
for iCurrentHeight := 0 to height - 1 do
begin
block.Position := lookup[iCurrentHeight];
iCurrentWidth := 0;
P := FGraphic.Bits + iCurrentHeight * width * 2;
if (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and
(block.Read(run, SizeOf(Word)) = SizeOf(Word)) then
begin
inc(iCurrentWidth, offset);
for i := 0 to run - 1 do
begin
block.Read(color, SizeOf(Word));
if color <> $0000 then
P^[iCurrentWidth + i] := color;
end;
inc(iCurrentWidth, run);
end;
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.