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

- Cleanup in ULandscape.pas 

- Removed unncessary virtual and ghost tile handling from FillDrawList
- Added serial generation and tracking to TScreenBuffer
- Added editing state tracking to TScreenBuffer
- Changed TScreenBuffer.Store to perform an InsertSort
- Changed TScreenBuffer.Store to handle only the most necessary parameters
This commit is contained in:
Andreas Schneider 2009-05-17 14:12:52 +02:00
parent 2f560a7738
commit 61db743ee5
3 changed files with 316 additions and 322 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

622
Client/ULandscape.pas
View File

@ -30,12 +30,12 @@ unit ULandscape;
interface interface
uses uses
SysUtils, Classes, math, contnrs, LCLIntf, GL, GLU, ImagingOpenGL, SysUtils, Classes, math, LCLIntf, GL, GLU, ImagingOpenGL, Imaging,
Imaging, ImagingClasses, ImagingTypes, ImagingUtility, ImagingClasses, ImagingTypes, ImagingUtility,
UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem, UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
UMulBlock, UMulBlock,
UListSort, UVector, UEnhancedMemoryStream, UVector, UEnhancedMemoryStream,
UCacheManager, ULinkedList; UCacheManager;
type type
TNormals = array[0..3] of TVector; TNormals = array[0..3] of TVector;
@ -97,6 +97,8 @@ type
TLandscapeChangeEvent = procedure of object; TLandscapeChangeEvent = procedure of object;
TStaticFilter = function(AStatic: TStaticItem): Boolean of object; TStaticFilter = function(AStatic: TStaticItem): Boolean of object;
TScreenBuffer = class;
{ TLandscape } { TLandscape }
TLandscape = class(TObject) TLandscape = class(TObject)
@ -112,15 +114,13 @@ type
FOnChange: TLandscapeChangeEvent; FOnChange: TLandscapeChangeEvent;
FOpenRequests: array of Boolean; FOpenRequests: array of Boolean;
{ Methods } { Methods }
function GetNormals(AX, AY: Word): TNormals;
function GetMapCell(AX, AY: Word): TMapCell;
function GetStaticList(AX, AY: Word): TList;
function GetMapBlock(AX, AY: Word): TMapBlock; function GetMapBlock(AX, AY: Word): TMapBlock;
function GetMapCell(AX, AY: Word): TMapCell;
function GetNormals(AX, AY: Word): TNormals;
function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
procedure UpdateStaticsPriority(AStaticItem: TStaticItem; function GetStaticList(AX, AY: Word): TList;
APrioritySolver: Integer); { Events }
procedure OnRemoveCachedObject(AObject: TObject); procedure OnRemoveCachedObject(AObject: TObject);
procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream); procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream);
procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream); procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream);
procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream); procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream);
@ -139,21 +139,22 @@ type
property Normals[X, Y: Word]: TNormals read GetNormals; property Normals[X, Y: Word]: TNormals read GetNormals;
property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange; property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange;
{ Methods } { Methods }
function GetDrawList(AX, AY, AWidth, AHeight: Word; AMinZ, AMaxZ: ShortInt; procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth,
AGhostTile: TWorldItem; AVirtualLayer: TStaticItem; AMap, AHeight: Word; AMinZ, AMaxZ: ShortInt; AMap, AStatics: Boolean;
AStatics: Boolean; ANoDraw:Boolean; AStaticsFilter: TStaticFilter): TList; ANoDraw: Boolean; AStaticsFilter: TStaticFilter);
procedure UpdateDrawListItems(AList: TList);
function GetEffectiveAltitude(ATile: TMapCell): ShortInt; function GetEffectiveAltitude(ATile: TMapCell): ShortInt;
function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt; function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word); procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word);
procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word); procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word);
procedure UpdateStaticsPriority(AStaticItem: TStaticItem;
APrioritySolver: Integer);
end; end;
PBlockInfo = ^TBlockInfo; PBlockInfo = ^TBlockInfo;
TBlockInfo = record TBlockInfo = record
ScreenRect: TRect; ScreenRect: TRect;
Item: TWorldItem; Item: TWorldItem;
Material: TMaterial; Material: TMaterial;
Ghost: Boolean;
Next: PBlockInfo; Next: PBlockInfo;
end; end;
@ -163,9 +164,11 @@ type
constructor Create; virtual; constructor Create; virtual;
destructor Destroy; override; destructor Destroy; override;
protected protected
{ Fields }
FFirst: PBlockInfo; FFirst: PBlockInfo;
FLastBlock: PBlockInfo; FLastBlock: PBlockInfo;
public public
{ Methods }
procedure Clear; virtual; procedure Clear; virtual;
function Iterate(var ABlockInfo: PBlockInfo): Boolean; virtual; function Iterate(var ABlockInfo: PBlockInfo): Boolean; virtual;
procedure Add(AItem: TWorldItem); virtual; procedure Add(AItem: TWorldItem); virtual;
@ -176,11 +179,19 @@ type
{ TScreenBuffer } { TScreenBuffer }
TScreenBuffer = class(TTileList) TScreenBuffer = class(TTileList)
constructor Create; override;
protected
{ Members }
FSerial: Cardinal;
public public
procedure OnTileRemoved(ATile: TMulBlock); { Methods }
procedure Clear; override; procedure Clear; override;
function Find(AScreenPosition: TPoint): PBlockInfo; function Find(AScreenPosition: TPoint): PBlockInfo;
procedure Store(AScreenRect: TRect; AItem: TWorldItem; AMaterial: TMaterial); function GetSerial: Cardinal;
procedure Store(AItem: TWorldItem; AMaterial: TMaterial = nil;
AGhost: Boolean = False);
{ Events }
procedure OnTileRemoved(ATile: TMulBlock);
end; end;
TStaticInfo = packed record TStaticInfo = packed record
@ -190,7 +201,6 @@ type
TileID: Word; TileID: Word;
Hue: Word; Hue: Word;
end; end;
//operator=(AStaticItem: TStaticItem; AStaticInfo: TStaticInfo): Boolean;
implementation implementation
@ -206,6 +216,30 @@ begin
Result := ((AX and $7FFF) shl 15) or (AY and $7FFF); Result := ((AX and $7FFF) shl 15) or (AY and $7FFF);
end; end;
function CompareWorldItems(AItem1, AItem2: Pointer): Integer;
begin
if TWorldItem(AItem1).X <> TWorldItem(AItem2).X then
Exit(TWorldItem(AItem1).X - TWorldItem(AItem2).X);
if TWorldItem(AItem1).Y <> TWorldItem(AItem2).Y then
Exit(TWorldItem(AItem1).Y - TWorldItem(AItem2).Y);
Result := TWorldItem(AItem1).Priority - TWorldItem(AItem2).Priority;
if Result = 0 then
begin
if (TObject(AItem1) is TMapCell) and (TObject(AItem2) is TStaticItem) then
Result := -1
else if (TObject(AItem1) is TStaticItem) and (TObject(AItem2) is TMapCell) then
Result := 1;
end;
if Result = 0 then
Result := TWorldItem(AItem1).PriorityBonus - TWorldItem(AItem2).PriorityBonus;
if Result = 0 then
Result := TWorldItem(AItem1).PrioritySolver - TWorldItem(AItem2).PrioritySolver;
end;
{ TLandTextureManager } { TLandTextureManager }
constructor TLandTextureManager.Create; constructor TLandTextureManager.Create;
@ -346,8 +380,6 @@ begin
end; end;
destructor TLandscape.Destroy; destructor TLandscape.Destroy;
var
i: Integer;
begin begin
if FBlockCache <> nil then if FBlockCache <> nil then
begin begin
@ -366,6 +398,18 @@ begin
inherited Destroy; inherited Destroy;
end; end;
function TLandscape.GetMapBlock(AX, AY: Word): TMapBlock;
var
block: TBlock;
begin
Result := nil;
if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then
begin
if FBlockCache.QueryID(GetID(AX, AY), TObject(block)) then
Result := block.Map;
end;
end;
function TLandscape.GetMapCell(AX, AY: Word): TMapCell; function TLandscape.GetMapCell(AX, AY: Word): TMapCell;
var var
block: TMapBlock; block: TMapBlock;
@ -379,154 +423,6 @@ begin
end; end;
end; end;
function TLandscape.GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
var
cell: TMapCell;
begin
cell := MapCell[AX, AY];
if cell <> nil then
Result := cell.Altitude
else
Result := ADefault;
end;
function TLandscape.GetStaticList(AX, AY: Word): TList;
var
block: TSeperatedStaticBlock;
begin
Result := nil;
if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then
begin
block := GetStaticBlock(AX div 8, AY div 8);
if block <> nil then
Result := block.Cells[(AY mod 8) * 8 + AX mod 8];
end;
end;
function Compare(AItem1, AItem2: Pointer): Integer;
begin
if TWorldItem(AItem1).X <> TWorldItem(AItem2).X then
Exit(TWorldItem(AItem1).X - TWorldItem(AItem2).X);
if TWorldItem(AItem1).Y <> TWorldItem(AItem2).Y then
Exit(TWorldItem(AItem1).Y - TWorldItem(AItem2).Y);
Result := TWorldItem(AItem1).Priority - TWorldItem(AItem2).Priority;
if Result = 0 then
begin
if (TObject(AItem1) is TMapCell) and (TObject(AItem2) is TStaticItem) then
Result := -1
else if (TObject(AItem1) is TStaticItem) and (TObject(AItem2) is TMapCell) then
Result := 1;
end;
if Result = 0 then
Result := TWorldItem(AItem1).PriorityBonus - TWorldItem(AItem2).PriorityBonus;
if Result = 0 then
Result := TWorldItem(AItem1).PrioritySolver - TWorldItem(AItem2).PrioritySolver;
end;
function TLandscape.GetDrawList(AX, AY, AWidth, AHeight: Word;
AMinZ, AMaxZ: ShortInt; AGhostTile: TWorldItem; AVirtualLayer: TStaticItem;
AMap, AStatics: Boolean; ANoDraw: Boolean;
AStaticsFilter: TStaticFilter): TList;
var
landAlt: ShortInt;
drawMapCell: TMapCell;
drawStatics: TList;
i, x, y: Integer;
begin
Result := TList.Create;
for x := AX to AX + AWidth do
for y := AY to AY + AWidth do
begin
if AMap then
begin
landAlt := GetLandAlt(x, y, 0);
if (landAlt >= AMinZ) and (landAlt <= AMaxZ) then
begin
drawMapCell := GetMapCell(x, y);
if (drawMapCell <> nil) and (ANoDraw or (drawMapCell.TileID > 2)) then
begin
drawMapCell.Priority := GetEffectiveAltitude(drawMapCell);
drawMapCell.PriorityBonus := 0;
drawMapCell.PrioritySolver := 0;
Result.Add(drawMapCell);
end;
if AGhostTile is TMapCell then
begin
AGhostTile.X := x;
AGhostTile.Y := y;
AGhostTile.Priority := GetEffectiveAltitude(TMapCell(AGhostTile));
AGhostTile.PriorityBonus := 0;
AGhostTile.PrioritySolver := 0;
Result.Add(AGhostTile);
end;
end;
end;
if AStatics then
begin
drawStatics := GetStaticList(x, y);
if drawStatics <> nil then
for i := 0 to drawStatics.Count - 1 do
if (TStaticItem(drawStatics[i]).Z >= AMinZ) and
(TStaticItem(drawStatics[i]).Z <= AMaxZ) and
((AStaticsFilter = nil) or AStaticsFilter(TStaticItem(drawStatics[i]))) then
begin
UpdateStaticsPriority(TStaticItem(drawStatics[i]), i + 1);
Result.Add(Pointer(drawStatics[i]));
end;
if AGhostTile is TStaticItem then
begin
UpdateStaticsPriority(TStaticItem(AGhostTile), MaxInt);
Result.Add(AGhostTile);
end;
end;
//TODO : re add virtual layer
{if AVirtualLayer <> nil then
begin
UpdateStaticsPriority(AVirtualLayer, MaxInt-1);
Result.Add(AVirtualLayer);
end;}
end;
Result.Sort(@Compare);
//ListSort(Result, @Compare);
end;
procedure TLandscape.UpdateDrawListItems(AList: TList);
var
worldItem: TWorldItem;
i: Integer;
begin
for i := 0 to AList.Count - 1 do
begin
worldItem := TWorldItem(AList.Items[i]);
worldItem.CanBeEdited := dmNetwork.CanWrite(worldItem.X, worldItem.Y);
end;
end;
function TLandscape.GetEffectiveAltitude(ATile: TMapCell): ShortInt;
var
north, west, south, east: ShortInt;
begin
north := ATile.Altitude;
west := GetLandAlt(ATile.X, ATile.Y + 1, north);
south := GetLandAlt(ATile.X + 1, ATile.Y + 1, north);
east := GetLandAlt(ATile.X + 1, ATile.Y, north);
if Abs(north - south) > Abs(west - east) then
Result := (north + south) div 2
else
Result := (west + east) div 2;
end;
function TLandscape.GetNormals(AX, AY: Word): TNormals; function TLandscape.GetNormals(AX, AY: Word): TNormals;
var var
cells: array[0..2, 0..2] of TNormals; cells: array[0..2, 0..2] of TNormals;
@ -609,74 +505,6 @@ begin
Result[3] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); Result[3] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south));
end; end;
procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word);
var
sourceBlock, targetBlock: TSeperatedStaticBlock;
targetStaticList: TList;
i: Integer;
begin
if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then
begin
sourceBlock := AStatic.Owner as TSeperatedStaticBlock;
targetBlock := GetStaticBlock(AX div 8, AY div 8);
if (sourceBlock <> nil) and (targetBlock <> nil) then
begin
sourceBlock.Cells[(AStatic.Y mod 8) * 8 + AStatic.X mod 8].Remove(AStatic);
targetStaticList := targetBlock.Cells[(AY mod 8) * 8 + AX mod 8];
targetStaticList.Add(AStatic);
for i := 0 to targetStaticList.Count - 1 do
UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i);
targetStaticList.Sort(@Compare);
//ListSort(targetStaticList, @Compare);
AStatic.UpdatePos(AX, AY, AStatic.Z);
AStatic.Owner := targetBlock;
end;
end;
end;
procedure TLandscape.PrepareBlocks(AX1, AY1, AX2, AY2: Word);
var
x, y, i, mapID, staticID: Integer;
coords: TBlockCoordsArray;
obj: TObject;
begin
AX1 := EnsureRange(AX1, 0, FWidth - 1);
AY1 := EnsureRange(AY1, 0, FHeight - 1);
AX2 := EnsureRange(AX2, 0, FWidth - 1);
AY2 := EnsureRange(AY2, 0, FHeight - 1);
SetLength(coords, 0);
for x := AX1 to AX2 do
begin
for y := AY1 to AY2 do
begin
if (not FOpenRequests[y * FWidth + x]) and
(not FBlockCache.QueryID(GetID(x, y), obj)) then
begin
SetLength(coords, Length(coords) + 1);
i := High(coords);
coords[i].X := x;
coords[i].Y := y;
FOpenRequests[y * FWidth + x] := True;
end;
end;
end;
if Length(coords) > 0 then
dmNetwork.Send(TRequestBlocksPacket.Create(coords));
end;
function TLandscape.GetMapBlock(AX, AY: Word): TMapBlock;
var
block: TBlock;
begin
Result := nil;
if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then
begin
if FBlockCache.QueryID(GetID(AX, AY), TObject(block)) then
Result := block.Map;
end;
end;
function TLandscape.GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; function TLandscape.GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
var var
block: TBlock; block: TBlock;
@ -689,19 +517,26 @@ begin
end; end;
end; end;
procedure TLandscape.UpdateStaticsPriority(AStaticItem: TStaticItem; function TLandscape.GetStaticList(AX, AY: Word): TList;
APrioritySolver: Integer);
var var
staticTileData: TStaticTileData; block: TSeperatedStaticBlock;
begin begin
staticTileData := ResMan.Tiledata.StaticTiles[AStaticItem.TileID]; Result := nil;
AStaticItem.PriorityBonus := 0; if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then
if not ((staticTileData.Flags and tdfBackground) = tdfBackground) then begin
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1; block := GetStaticBlock(AX div 8, AY div 8);
if staticTileData.Height > 0 then if block <> nil then
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1; Result := block.Cells[(AY mod 8) * 8 + AX mod 8];
AStaticItem.Priority := AStaticItem.Z + AStaticItem.PriorityBonus; end;
AStaticItem.PrioritySolver := APrioritySolver; end;
procedure TLandscape.OnRemoveCachedObject(AObject: TObject);
var
block: TBlock;
begin
block := AObject as TBlock;
if block <> nil then
dmNetwork.Send(TFreeBlockPacket.Create(block.Map.X, block.Map.Y));
end; end;
procedure TLandscape.OnBlocksPacket(ABuffer: TEnhancedMemoryStream); procedure TLandscape.OnBlocksPacket(ABuffer: TEnhancedMemoryStream);
@ -724,7 +559,7 @@ begin
if count > 0 then if count > 0 then
index.Lookup := ABuffer.Position index.Lookup := ABuffer.Position
else else
index.Lookup := $FFFFFFFF; index.Lookup := -1;
index.Size := count * 7; index.Size := count * 7;
statics := TSeperatedStaticBlock.Create(ABuffer, index, coords.X, coords.Y); statics := TSeperatedStaticBlock.Create(ABuffer, index, coords.X, coords.Y);
@ -776,8 +611,7 @@ begin
targetStaticList.Add(staticItem); targetStaticList.Add(staticItem);
for i := 0 to targetStaticList.Count - 1 do for i := 0 to targetStaticList.Count - 1 do
UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i); UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i);
targetStaticList.Sort(@Compare); targetStaticList.Sort(@CompareWorldItems);
//ListSort(targetStaticList, @Compare);
staticItem.Owner := block; staticItem.Owner := block;
if Assigned(FOnChange) then FOnChange; if Assigned(FOnChange) then FOnChange;
end; end;
@ -835,8 +669,7 @@ begin
staticItem.Z := ABuffer.ReadShortInt; staticItem.Z := ABuffer.ReadShortInt;
for j := 0 to statics.Count - 1 do for j := 0 to statics.Count - 1 do
UpdateStaticsPriority(TStaticItem(statics.Items[j]), j); UpdateStaticsPriority(TStaticItem(statics.Items[j]), j);
statics.Sort(@Compare); statics.Sort(@CompareWorldItems);
//ListSort(statics, @Compare);
if Assigned(FOnChange) then FOnChange; if Assigned(FOnChange) then FOnChange;
Break; Break;
end; end;
@ -852,7 +685,6 @@ var
staticInfo: TStaticInfo; staticInfo: TStaticInfo;
staticItem: TStaticItem; staticItem: TStaticItem;
newX, newY: Word; newX, newY: Word;
item: PLinkedItem;
begin begin
staticItem := nil; staticItem := nil;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo)); ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
@ -896,8 +728,7 @@ begin
statics.Add(staticItem); statics.Add(staticItem);
for i := 0 to statics.Count - 1 do for i := 0 to statics.Count - 1 do
UpdateStaticsPriority(TStaticItem(statics.Items[i]), i); UpdateStaticsPriority(TStaticItem(statics.Items[i]), i);
statics.Sort(@Compare); statics.Sort(@CompareWorldItems);
//ListSort(statics, @Compare);
staticItem.Owner := targetBlock; staticItem.Owner := targetBlock;
end; end;
@ -907,7 +738,7 @@ end;
procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream); procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream);
var var
block: TSeperatedStaticBlock; block: TSeperatedStaticBlock;
i,j : Integer; i : Integer;
statics: TList; statics: TList;
staticInfo: TStaticInfo; staticInfo: TStaticInfo;
staticItem: TStaticItem; staticItem: TStaticItem;
@ -932,13 +763,145 @@ begin
end; end;
end; end;
procedure TLandscape.OnRemoveCachedObject(AObject: TObject); procedure TLandscape.FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth,
AHeight: Word; AMinZ, AMaxZ: ShortInt; AMap, AStatics: Boolean;
ANoDraw: Boolean; AStaticsFilter: TStaticFilter);
var var
block: TBlock; landAlt: ShortInt;
drawMapCell: TMapCell;
drawStatics: TList;
i, x, y: Integer;
begin begin
block := AObject as TBlock; ADrawList.Clear;
if block <> nil then for x := AX to AX + AWidth do
dmNetwork.Send(TFreeBlockPacket.Create(block.Map.X, block.Map.Y)); for y := AY to AY + AWidth do
begin
if AMap then
begin
landAlt := GetLandAlt(x, y, 0);
if (landAlt >= AMinZ) and (landAlt <= AMaxZ) then
begin
drawMapCell := GetMapCell(x, y);
if (drawMapCell <> nil) and (ANoDraw or (drawMapCell.TileID > 2)) then
begin
drawMapCell.Priority := GetEffectiveAltitude(drawMapCell);
drawMapCell.PriorityBonus := 0;
drawMapCell.PrioritySolver := 0;
ADrawList.Store(drawMapCell);
end;
end;
end;
if AStatics then
begin
drawStatics := GetStaticList(x, y);
if drawStatics <> nil then
for i := 0 to drawStatics.Count - 1 do
if (TStaticItem(drawStatics[i]).Z >= AMinZ) and
(TStaticItem(drawStatics[i]).Z <= AMaxZ) and
((AStaticsFilter = nil) or AStaticsFilter(TStaticItem(drawStatics[i]))) then
begin
UpdateStaticsPriority(TStaticItem(drawStatics[i]), ADrawList.GetSerial);
ADrawList.Store(TWorldItem(drawStatics[i]));
end;
end;
end;
end;
function TLandscape.GetEffectiveAltitude(ATile: TMapCell): ShortInt;
var
north, west, south, east: ShortInt;
begin
north := ATile.Altitude;
west := GetLandAlt(ATile.X, ATile.Y + 1, north);
south := GetLandAlt(ATile.X + 1, ATile.Y + 1, north);
east := GetLandAlt(ATile.X + 1, ATile.Y, north);
if Abs(north - south) > Abs(west - east) then
Result := (north + south) div 2
else
Result := (west + east) div 2;
end;
function TLandscape.GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
var
cell: TMapCell;
begin
cell := MapCell[AX, AY];
if cell <> nil then
Result := cell.Altitude
else
Result := ADefault;
end;
procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word);
var
sourceBlock, targetBlock: TSeperatedStaticBlock;
targetStaticList: TList;
i: Integer;
begin
if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then
begin
sourceBlock := AStatic.Owner as TSeperatedStaticBlock;
targetBlock := GetStaticBlock(AX div 8, AY div 8);
if (sourceBlock <> nil) and (targetBlock <> nil) then
begin
sourceBlock.Cells[(AStatic.Y mod 8) * 8 + AStatic.X mod 8].Remove(AStatic);
targetStaticList := targetBlock.Cells[(AY mod 8) * 8 + AX mod 8];
targetStaticList.Add(AStatic);
for i := 0 to targetStaticList.Count - 1 do
UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i);
targetStaticList.Sort(@CompareWorldItems);
AStatic.UpdatePos(AX, AY, AStatic.Z);
AStatic.Owner := targetBlock;
end;
end;
end;
procedure TLandscape.PrepareBlocks(AX1, AY1, AX2, AY2: Word);
var
x, y, i: Integer;
coords: TBlockCoordsArray;
obj: TObject;
begin
AX1 := EnsureRange(AX1, 0, FWidth - 1);
AY1 := EnsureRange(AY1, 0, FHeight - 1);
AX2 := EnsureRange(AX2, 0, FWidth - 1);
AY2 := EnsureRange(AY2, 0, FHeight - 1);
SetLength(coords, 0);
for x := AX1 to AX2 do
begin
for y := AY1 to AY2 do
begin
if (not FOpenRequests[y * FWidth + x]) and
(not FBlockCache.QueryID(GetID(x, y), obj)) then
begin
SetLength(coords, Length(coords) + 1);
i := High(coords);
coords[i].X := x;
coords[i].Y := y;
FOpenRequests[y * FWidth + x] := True;
end;
end;
end;
if Length(coords) > 0 then
dmNetwork.Send(TRequestBlocksPacket.Create(coords));
end;
procedure TLandscape.UpdateStaticsPriority(AStaticItem: TStaticItem;
APrioritySolver: Integer);
var
staticTileData: TStaticTileData;
begin
staticTileData := ResMan.Tiledata.StaticTiles[AStaticItem.TileID];
AStaticItem.PriorityBonus := 0;
if not ((staticTileData.Flags and tdfBackground) = tdfBackground) then
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;
if staticTileData.Height > 0 then
AStaticItem.PriorityBonus := AStaticItem.PriorityBonus + 1;
AStaticItem.Priority := AStaticItem.Z + AStaticItem.PriorityBonus;
AStaticItem.PrioritySolver := APrioritySolver;
end; end;
{ TMaterial } { TMaterial }
@ -993,8 +956,6 @@ begin
FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False, ifUnknown, @FWidth, @FHeight); FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False, ifUnknown, @FWidth, @FHeight);
glBindTexture(GL_TEXTURE_2D, FTexture); glBindTexture(GL_TEXTURE_2D, FTexture);
{glGetTexLevelParameteriv(GL_TEXTURE_2D, 0, GL_TEXTURE_WIDTH, @FWidth);
glGetTexLevelParameteriv(GL_TEXTURE_2D, 0, GL_TEXTURE_HEIGHT, @FHeight);}
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_NEAREST);
glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_NEAREST);
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP); glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
@ -1076,6 +1037,90 @@ end;
{ TScreenBuffer } { TScreenBuffer }
constructor TScreenBuffer.Create;
begin
inherited Create;
FSerial := 0;
end;
procedure TScreenBuffer.Clear;
var
current, next: PBlockInfo;
begin
current := FFirst;
while current <> nil do
begin
next := current^.Next;
current^.Item.Locked := False;
current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved);
Dispose(current);
current := next;
end;
FFirst := nil;
FLastBlock := nil;
FSerial := 0;
end;
function TScreenBuffer.Find(AScreenPosition: TPoint): PBlockInfo;
var
current: PBlockInfo;
begin
Result := nil;
current := FFirst;
while (current <> nil) and (Result = nil) do
begin
if (not current^.Ghost) and PtInRect(current^.ScreenRect, AScreenPosition) and
current^.Material.HitTest(AScreenPosition.x - current^.ScreenRect.Left,
AScreenPosition.y - current^.ScreenRect.Top) then
begin
Result := current;
end;
current := current^.Next;
end;
end;
function TScreenBuffer.GetSerial: Cardinal;
begin
Result := FSerial
Inc(FSerial);
end;
procedure TScreenBuffer.Store(AItem: TWorldItem; AMaterial: TMaterial = nil;
AGhost: Boolean = False);
var
current, existing: PBlockInfo;
begin
New(current);
AItem.Locked := True;
AItem.OnDestroy.RegisterEvent(@OnTileRemoved);
current^.Item := AItem;
current^.Material := AMaterial;
current^.Ghost := AGhost;
if (FFirst = nil) or (CompareWorldItems(AItem, FFirst) > 0) then
begin
current^.Next := FFirst;
if FFirst = nil then
FLastBlock := current;
FFirst := current;
end else
begin
existing := FFirst;
while (existing^.Next = nil) and
(CompareWorldItems(AItem, existing^.Next^.Item) > 0) do
begin
existing := existing^.Next;
end;
if existing^.Next = nil then
FLastBlock := current;
current^.Next := existing^.Next;
existing^.Next := current;
end;
end;
procedure TScreenBuffer.OnTileRemoved(ATile: TMulBlock); procedure TScreenBuffer.OnTileRemoved(ATile: TMulBlock);
var var
currentItem, lastItem, nextItem: PBlockInfo; currentItem, lastItem, nextItem: PBlockInfo;
@ -1098,56 +1143,5 @@ begin
end; end;
end; end;
procedure TScreenBuffer.Clear;
var
current, next: PBlockInfo;
begin
current := FFirst;
while current <> nil do
begin
next := current^.Next;
current^.Item.Locked := False;
current^.Item.OnDestroy.UnregisterEvent(@OnTileRemoved);
Dispose(current);
current := next;
end;
FFirst := nil;
FLastBlock := nil;
end;
function TScreenBuffer.Find(AScreenPosition: TPoint): PBlockInfo;
var
current: PBlockInfo;
begin
Result := nil;
current := FFirst;
while (current <> nil) and (Result = nil) do
begin
if PtInRect(current^.ScreenRect, AScreenPosition) and
current^.Material.HitTest(AScreenPosition.x - current^.ScreenRect.Left,
AScreenPosition.y - current^.ScreenRect.Top) then
begin
Result := current;
end;
current := current^.Next;
end;
end;
procedure TScreenBuffer.Store(AScreenRect: TRect; AItem: TWorldItem;
AMaterial: TMaterial);
var
current: PBlockInfo;
begin
New(current);
AItem.Locked := True;
AItem.OnDestroy.RegisterEvent(@OnTileRemoved);
current^.ScreenRect := AScreenRect;
current^.Item := AItem;
current^.Material := AMaterial;
current^.Next := FFirst;
FFirst := current;
if FLastBlock = nil then FLastBlock := current;
end;
end. end.

2
Client/UfrmMain.lfm
View File

@ -1,5 +1,5 @@
object frmMain: TfrmMain object frmMain: TfrmMain
Left = 236 Left = 232
Height = 603 Height = 603
Top = 126 Top = 126
Width = 766 Width = 766

4
Client/UfrmMain.pas
View File

@ -1675,7 +1675,7 @@ begin
else else
staticsFilter := nil;} //TODO : update list on change staticsFilter := nil;} //TODO : update list on change
draw := FLandscape.GetDrawList(FX + lowOffX, FY + lowOffY, rangeX, rangeY, {draw := FLandscape.GetDrawList(FX + lowOffX, FY + lowOffY, rangeX, rangeY,
frmBoundaries.tbMinZ.Position, frmBoundaries.tbMaxZ.Position, frmBoundaries.tbMinZ.Position, frmBoundaries.tbMaxZ.Position,
nil, nil, tbTerrain.Down, tbStatics.Down, //TODO : ghost tile and virtual tile! nil, nil, tbTerrain.Down, tbStatics.Down, //TODO : ghost tile and virtual tile!
acNoDraw.Checked, nil); //TODO : statics filter! acNoDraw.Checked, nil); //TODO : statics filter!
@ -1871,7 +1871,7 @@ begin
glDisable(GL_COLOR_LOGIC_OP); glDisable(GL_COLOR_LOGIC_OP);
end; end;
draw.Free; draw.Free;}
FOverlayUI.Draw(oglGameWindow); FOverlayUI.Draw(oglGameWindow);
end; end;