aksdb
/
CentrED
1
0
Fork 0
Code Issues 2 Pull Requests Releases Wiki Activity

- Some cleanups in UArt.pas 

- Changed the console command for the cedserver project
This commit is contained in:
Andreas Schneider 2009-05-15 22:10:51 +02:00
parent 7e86c7400c
commit c20a160543
2 changed files with 324 additions and 324 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Server/cedserver.lpi
View File

@ -21,7 +21,7 @@
<RunParams> <RunParams>
<local> <local>
<FormatVersion Value="1"/> <FormatVersion Value="1"/>
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication Use="True" PathPlusParams="/usr/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="1"> <RequiredPackages Count="1">

646
UOLib/UArt.pas
View File

@ -1,323 +1,323 @@
(* (*
* CDDL HEADER START * CDDL HEADER START
* *
* The contents of this file are subject to the terms of the * The contents of this file are subject to the terms of the
* Common Development and Distribution License, Version 1.0 only * Common Development and Distribution License, Version 1.0 only
* (the "License"). You may not use this file except in compliance * (the "License"). You may not use this file except in compliance
* with the License. * with the License.
* *
* You can obtain a copy of the license at * You can obtain a copy of the license at
* http://www.opensource.org/licenses/cddl1.php. * http://www.opensource.org/licenses/cddl1.php.
* See the License for the specific language governing permissions * See the License for the specific language governing permissions
* and limitations under the License. * and limitations under the License.
* *
* When distributing Covered Code, include this CDDL HEADER in each * When distributing Covered Code, include this CDDL HEADER in each
* file and include the License file at * file and include the License file at
* http://www.opensource.org/licenses/cddl1.php. If applicable, * http://www.opensource.org/licenses/cddl1.php. If applicable,
* add the following below this CDDL HEADER, with the fields enclosed * add the following below this CDDL HEADER, with the fields enclosed
* by brackets "[]" replaced with your own identifying * information: * by brackets "[]" replaced with your own identifying * information:
* Portions Copyright [yyyy] [name of copyright owner] * Portions Copyright [yyyy] [name of copyright owner]
* *
* CDDL HEADER END * CDDL HEADER END
* *
* *
* Portions Copyright 2007 Andreas Schneider * Portions Copyright 2009 Andreas Schneider
*) *)
unit UArt; unit UArt;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
interface interface
uses uses
Classes, Imaging, ImagingTypes, ImagingCanvases, ImagingClasses, Classes, Imaging, ImagingTypes, ImagingCanvases, ImagingClasses,
UMulBlock, UGenericIndex, UHue; UMulBlock, UGenericIndex, UHue;
type type
TArtType = (atLand, atStatic, atLandFlat); TArtType = (atLand, atStatic, atLandFlat);
TArt = class(TMulBlock) TArt = class(TMulBlock)
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); overload; 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; AHue: THue; APartialHue: Boolean); overload;
constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload; constructor Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); overload;
destructor Destroy; override; destructor Destroy; override;
function Clone: TArt; override; function Clone: TArt; override;
function GetSize: Integer; override; function GetSize: Integer; override;
procedure Write(AData: TStream); override; procedure Write(AData: TStream); override;
procedure RefreshBuffer; procedure RefreshBuffer;
protected protected
FArtType: TArtType; FArtType: TArtType;
FHeader: LongInt; FHeader: LongInt;
FGraphic: TSingleImage; FGraphic: TSingleImage;
FBuffer: TStream; FBuffer: TStream;
public public
property ArtType: TArtType read FArtType write FArtType; property ArtType: TArtType read FArtType write FArtType;
property Header: LongInt read FHeader write FHeader; property Header: LongInt read FHeader write FHeader;
property Graphic: TSingleImage read FGraphic; property Graphic: TSingleImage read FGraphic;
property Buffer: TStream read FBuffer; property Buffer: TStream read FBuffer;
end; end;
implementation implementation
type type
PWordArray = ^TWordArray; PWordArray = ^TWordArray;
TWordArray = array[0..16383] of Word; TWordArray = array[0..16383] of Word;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType); constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType);
begin begin
Create(AData, AIndex, AArtType, 0, nil, False); Create(AData, AIndex, AArtType, 0, nil, False);
end; end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean); constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AHue: THue; APartialHue: Boolean);
begin begin
Create(AData, AIndex, AArtType, 0, AHue, APartialHue); Create(AData, AIndex, AArtType, 0, AHue, APartialHue);
end; end;
constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean); constructor TArt.Create(AData: TStream; AIndex: TGenericIndex; AArtType: TArtType; AArtColor: Word; AHue: THue; APartialHue: Boolean);
var var
i, x, y, start: Integer; i, x, y, start: Integer;
iCurrentHeight, iCurrentWidth: Integer; iCurrentHeight, iCurrentWidth: Integer;
width, height: SmallInt; width, height: SmallInt;
lookup: array of integer; lookup: array of integer;
color, run, offset: Word; color, run, offset: Word;
block: TMemoryStream; block: TMemoryStream;
P: PWordArray; P: PWordArray;
r, g, b: Byte; r, g, b: Byte;
begin begin
FBuffer := TMemoryStream.Create; FBuffer := TMemoryStream.Create;
FArtType := AArtType; FArtType := AArtType;
AArtColor := AArtColor or $8000; //set alpha bit on background AArtColor := AArtColor or $8000; //set alpha bit on background
if Assigned(AData) and (AIndex.Lookup <> LongInt($FFFFFFFF)) then if Assigned(AData) and (AIndex.Lookup > -1) then
begin begin
AData.Position := AIndex.Lookup; AData.Position := AIndex.Lookup;
block := TMemoryStream.Create; block := TMemoryStream.Create;
block.CopyFrom(AData, AIndex.Size); block.CopyFrom(AData, AIndex.Size);
block.Position := 0; block.Position := 0;
if AArtType = atLand then if AArtType = atLand then
begin begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
FillWord(FGraphic.Bits^, 44 * 44, AArtColor); FillWord(FGraphic.Bits^, 44 * 44, AArtColor);
for y := 0 to 21 do for y := 0 to 21 do
begin begin
P := FGraphic.Bits + y * 44 * 2; P := FGraphic.Bits + y * 44 * 2;
block.Read(P^[22 - (y + 1)], (y + 1) * 4); block.Read(P^[22 - (y + 1)], (y + 1) * 4);
end; end;
for y := 0 to 21 do for y := 0 to 21 do
begin begin
P := FGraphic.Bits + (22 + y) * 44 * 2; P := FGraphic.Bits + (22 + y) * 44 * 2;
block.Read(P^[y], (22 - y) * 4); block.Read(P^[y], (22 - y) * 4);
end; end;
for i := 0 to 44 * 44 - 1 do for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atLandFlat then end else if AArtType = atLandFlat then
begin begin
FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5); FGraphic:= TSingleImage.CreateFromParams(44, 44, ifA1R5G5B5);
for i := 1 to 22 do for i := 1 to 22 do
begin begin
for x := 0 to i * 2 - 1 do for x := 0 to i * 2 - 1 do
begin begin
y := i * 2 - x - 1; y := i * 2 - x - 1;
block.Read(color, SizeOf(Word)); block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + y * 44 * 2)^[x] := color; PWordArray(FGraphic.Bits + y * 44 * 2)^[x] := color;
if y > 0 then if y > 0 then
PWordArray(FGraphic.Bits + (y - 1) * 44 * 2)^[x] := color; PWordArray(FGraphic.Bits + (y - 1) * 44 * 2)^[x] := color;
end; end;
end; end;
for i := 22 to 43 do for i := 22 to 43 do
begin begin
for y := 0 to (44 - i) * 2 - 1 do for y := 0 to (44 - i) * 2 - 1 do
begin begin
x := 42 - (43 - i) * 2 + y; x := 42 - (43 - i) * 2 + y;
block.Read(color, SizeOf(Word)); block.Read(color, SizeOf(Word));
PWordArray(FGraphic.Bits + (43 - y) * 44 * 2)^[x] := color; PWordArray(FGraphic.Bits + (43 - y) * 44 * 2)^[x] := color;
if y > 0 then if y > 0 then
PWordArray(FGraphic.Bits + (44 - y) * 44 * 2)^[x] := color; PWordArray(FGraphic.Bits + (44 - y) * 44 * 2)^[x] := color;
end; end;
end; end;
for i := 0 to 44 * 44 - 1 do for i := 0 to 44 * 44 - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else if AArtType = atStatic then end else if AArtType = atStatic then
begin begin
block.Read(FHeader, SizeOf(LongInt)); block.Read(FHeader, SizeOf(LongInt));
block.Read(width, SizeOf(SmallInt)); block.Read(width, SizeOf(SmallInt));
block.Read(height, SizeOf(SmallInt)); block.Read(height, SizeOf(SmallInt));
FGraphic:= TSingleImage.CreateFromParams(width, height, ifA1R5G5B5); FGraphic:= TSingleImage.CreateFromParams(width, height, ifA1R5G5B5);
FillWord(FGraphic.Bits^, width * height, AArtColor); FillWord(FGraphic.Bits^, width * height, AArtColor);
SetLength(lookup, height); SetLength(lookup, height);
start := block.Position + (height * 2); start := block.Position + (height * 2);
for i := 0 to height - 1 do for i := 0 to height - 1 do
begin begin
block.Read(offset, SizeOf(Word)); block.Read(offset, SizeOf(Word));
lookup[i] := start + (offset * 2); lookup[i] := start + (offset * 2);
end; end;
for iCurrentHeight := 0 to height - 1 do for iCurrentHeight := 0 to height - 1 do
begin begin
block.Position := lookup[iCurrentHeight]; block.Position := lookup[iCurrentHeight];
iCurrentWidth := 0; iCurrentWidth := 0;
P := FGraphic.Bits + iCurrentHeight * width * 2; 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 while (block.Read(offset, SizeOf(Word)) = SizeOf(Word)) and (block.Read(run, SizeOf(Word)) = SizeOf(Word)) and (offset + run <> 0) do
begin begin
inc(iCurrentWidth, offset); inc(iCurrentWidth, offset);
for i := 0 to run - 1 do for i := 0 to run - 1 do
begin begin
block.Read(color, SizeOf(Word)); block.Read(color, SizeOf(Word));
P^[iCurrentWidth + i] := color; P^[iCurrentWidth + i] := color;
end; end;
inc(iCurrentWidth, run); inc(iCurrentWidth, run);
end; end;
end; end;
if AHue <> nil then if AHue <> nil then
begin begin
for i := 0 to width * height - 1 do for i := 0 to width * height - 1 do
begin begin
color := PWordArray(FGraphic.Bits)^[i]; color := PWordArray(FGraphic.Bits)^[i];
if color <> AArtColor then if color <> AArtColor then
begin begin
r := (color and $7C00) shr 10; r := (color and $7C00) shr 10;
if APartialHue then if APartialHue then
begin begin
g := (color and $3E0) shr 5; g := (color and $3E0) shr 5;
b := color and $1F; b := color and $1F;
if (r = g) and (g = b) then if (r = g) and (g = b) then
color := AHue.ColorTable[r]; color := AHue.ColorTable[r];
end else end else
color := AHue.ColorTable[r]; color := AHue.ColorTable[r];
end; end;
PWordArray(FGraphic.Bits)^[i] := color; PWordArray(FGraphic.Bits)^[i] := color;
end; end;
end; end;
for i := 0 to width * height - 1 do for i := 0 to width * height - 1 do
PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit PWordArray(FGraphic.Bits)^[i] := PWordArray(FGraphic.Bits)^[i] xor $8000; //invert alpha bit
end else end else
FGraphic:= TSingleImage.Create; FGraphic:= TSingleImage.Create;
if Assigned(block) then block.Free; if Assigned(block) then block.Free;
end else end else
begin begin
FHeader := 1; FHeader := 1;
FGraphic := TSingleImage.Create; FGraphic := TSingleImage.Create;
end; end;
FGraphic.Format := ifA8R8G8B8; FGraphic.Format := ifA8R8G8B8;
end; end;
destructor TArt.Destroy; destructor TArt.Destroy;
begin begin
if assigned(FGraphic) then FGraphic.Free; if assigned(FGraphic) then FGraphic.Free;
if assigned(FBuffer) then FBuffer.Free; if assigned(FBuffer) then FBuffer.Free;
inherited; inherited;
end; end;
function TArt.Clone: TArt; function TArt.Clone: TArt;
begin begin
Result := TArt.Create(nil, nil, FArtType); Result := TArt.Create(nil, nil, FArtType);
Result.FHeader := FHeader; Result.FHeader := FHeader;
Result.FGraphic.Assign(FGraphic); Result.FGraphic.Assign(FGraphic);
end; end;
procedure TArt.Write(AData: TStream); procedure TArt.Write(AData: TStream);
begin begin
FBuffer.Position := 0; FBuffer.Position := 0;
AData.CopyFrom(FBuffer, FBuffer.Size); AData.CopyFrom(FBuffer, FBuffer.Size);
end; end;
function TArt.GetSize: Integer; function TArt.GetSize: Integer;
begin begin
RefreshBuffer; RefreshBuffer;
Result := FBuffer.Size Result := FBuffer.Size
end; end;
procedure TArt.RefreshBuffer; procedure TArt.RefreshBuffer;
var var
argbGraphic: TSingleImage; argbGraphic: TSingleImage;
i, j, x, y, lineWidth, start: Integer; i, j, x, y, lineWidth, start: Integer;
iCurrentHeight, iCurrentWidth: Integer; iCurrentHeight, iCurrentWidth: Integer;
width, height: SmallInt; width, height: SmallInt;
color, run, offset: Word; color, run, offset: Word;
lookup: array of SmallInt; lookup: array of SmallInt;
begin begin
argbGraphic := TSingleImage.CreateFromImage(FGraphic); argbGraphic := TSingleImage.CreateFromImage(FGraphic);
argbGraphic.Format := ifA1R5G5B5; argbGraphic.Format := ifA1R5G5B5;
for i := 0 to argbGraphic.Width * argbGraphic.Height - 1 do for i := 0 to argbGraphic.Width * argbGraphic.Height - 1 do
PWordArray(argbGraphic.Bits)^[i] := PWordArray(argbGraphic.Bits)^[i] xor $8000; //invert alpha bit PWordArray(argbGraphic.Bits)^[i] := PWordArray(argbGraphic.Bits)^[i] xor $8000; //invert alpha bit
FBuffer.Size := 0; FBuffer.Size := 0;
if FArtType = atLand then if FArtType = atLand then
begin begin
if (argbGraphic.Height <> 44) or (argbGraphic.Width <> 44) then Exit; if (argbGraphic.Height <> 44) or (argbGraphic.Width <> 44) then Exit;
x := 21; x := 21;
y := 0; y := 0;
lineWidth := 2; lineWidth := 2;
for i := 1 to 22 do for i := 1 to 22 do
begin begin
Dec(x); Dec(x);
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth); FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth);
Inc(y); Inc(y);
Inc(lineWidth, 2); Inc(lineWidth, 2);
end; end;
for i := 1 to 22 do for i := 1 to 22 do
begin begin
Dec(lineWidth, 2); Dec(lineWidth, 2);
FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth); FBuffer.Write(PWordArray(argbGraphic.Bits + y * 44 * 2)^[x + j], lineWidth);
Inc(x); Inc(x);
Inc(y); Inc(y);
end; end;
end else if FArtType = atStatic then end else if FArtType = atStatic then
begin begin
if (argbGraphic.Height = 0) or (argbGraphic.Width = 0) then Exit; if (argbGraphic.Height = 0) or (argbGraphic.Width = 0) then Exit;
width := argbGraphic.Width; width := argbGraphic.Width;
height := argbGraphic.Height; height := argbGraphic.Height;
FBuffer.Write(FHeader, SizeOf(LongInt)); FBuffer.Write(FHeader, SizeOf(LongInt));
FBuffer.Write(width, SizeOf(SmallInt)); FBuffer.Write(width, SizeOf(SmallInt));
FBuffer.Write(height, SizeOf(SmallInt)); FBuffer.Write(height, SizeOf(SmallInt));
SetLength(lookup, height); SetLength(lookup, height);
for i := 0 to height - 1 do for i := 0 to height - 1 do
FBuffer.Write(lookup[i], SizeOf(SmallInt)); //placeholders for the lookup table FBuffer.Write(lookup[i], SizeOf(SmallInt)); //placeholders for the lookup table
start := FBuffer.Position; start := FBuffer.Position;
for iCurrentHeight := 0 to height - 1 do for iCurrentHeight := 0 to height - 1 do
begin begin
lookup[iCurrentHeight] := SmallInt((FBuffer.Position - start) div 2); //remember the lookup offset for the current line lookup[iCurrentHeight] := SmallInt((FBuffer.Position - start) div 2); //remember the lookup offset for the current line
offset := 0; offset := 0;
run := 0; run := 0;
for iCurrentWidth := 0 to width - 1 do //process every pixel on the current line for iCurrentWidth := 0 to width - 1 do //process every pixel on the current line
begin begin
color := PWordArray(FGraphic.Bits + iCurrentHeight * width * 2)^[iCurrentWidth]; color := PWordArray(FGraphic.Bits + iCurrentHeight * width * 2)^[iCurrentWidth];
if (color and $8000 = 0) and (run = 0) then //new visible pixel found if (color and $8000 = 0) and (run = 0) then //new visible pixel found
begin begin
FBuffer.Write(offset, SizeOf(Word)); FBuffer.Write(offset, SizeOf(Word));
FBuffer.Write(offset, SizeOf(Word)); //just a placeholder for the "run length" FBuffer.Write(offset, SizeOf(Word)); //just a placeholder for the "run length"
run := 1; run := 1;
FBuffer.Write(color, SizeOf(Word)); FBuffer.Write(color, SizeOf(Word));
end else if (color and $8000 = 0) and (run > 0) then //another visible pixel found end else if (color and $8000 = 0) and (run > 0) then //another visible pixel found
begin begin
inc(run); inc(run);
FBuffer.Write(color, SizeOf(Word)); 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 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 begin
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); //jump back ... FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); //jump back ...
FBuffer.Write(run, SizeOf(Word)); //... to write the actual "run length" ... FBuffer.Write(run, SizeOf(Word)); //... to write the actual "run length" ...
FBuffer.Seek(Integer(run * 2), soFromCurrent); //... and jump forth again to proceed FBuffer.Seek(Integer(run * 2), soFromCurrent); //... and jump forth again to proceed
run := 0; run := 0;
offset := 1; offset := 1;
end else end else
inc(offset); inc(offset);
end; end;
if run > 0 then //no more pixels but the "run" didn't end yet ;-) if run > 0 then //no more pixels but the "run" didn't end yet ;-)
begin begin
FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent); FBuffer.Seek(Integer(-((run + 1) * 2)), soFromCurrent);
FBuffer.Write(run, SizeOf(Word)); FBuffer.Write(run, SizeOf(Word));
FBuffer.Seek(Integer(run * 2), soFromCurrent); FBuffer.Seek(Integer(run * 2), soFromCurrent);
run := 0; run := 0;
end; end;
FBuffer.Write(run, SizeOf(Word)); //just write "0" FBuffer.Write(run, SizeOf(Word)); //just write "0"
FBuffer.Write(run, SizeOf(Word)); //... two times, to indicate the end of that line FBuffer.Write(run, SizeOf(Word)); //... two times, to indicate the end of that line
end; end;
FBuffer.Position := start - (height * 2); //now update the lookup table with our new values FBuffer.Position := start - (height * 2); //now update the lookup table with our new values
for i := 0 to height - 1 do for i := 0 to height - 1 do
FBuffer.Write(lookup[i], SizeOf(SmallInt)); FBuffer.Write(lookup[i], SizeOf(SmallInt));
end; end;
argbGraphic.Free; argbGraphic.Free;
end; end;
end. end.