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
uses
SysUtils, Classes, math, contnrs, LCLIntf, GL, GLU, ImagingOpenGL,
Imaging, ImagingClasses, ImagingTypes, ImagingUtility,
SysUtils, Classes, math, LCLIntf, GL, GLU, ImagingOpenGL, Imaging,
ImagingClasses, ImagingTypes, ImagingUtility,
UGenericIndex, UMap, UStatics, UArt, UTexture, UTiledata, UHue, UWorldItem,
UMulBlock,
UListSort, UVector, UEnhancedMemoryStream,
UCacheManager, ULinkedList;
UVector, UEnhancedMemoryStream,
UCacheManager;
type
TNormals = array[0..3] of TVector;
@ -97,6 +97,8 @@ type
TLandscapeChangeEvent = procedure of object;
TStaticFilter = function(AStatic: TStaticItem): Boolean of object;
TScreenBuffer = class;
{ TLandscape }
TLandscape = class(TObject)
@ -112,15 +114,13 @@ type
FOnChange: TLandscapeChangeEvent;
FOpenRequests: array of Boolean;
{ 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 GetMapCell(AX, AY: Word): TMapCell;
function GetNormals(AX, AY: Word): TNormals;
function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
procedure UpdateStaticsPriority(AStaticItem: TStaticItem;
APrioritySolver: Integer);
function GetStaticList(AX, AY: Word): TList;
{ Events }
procedure OnRemoveCachedObject(AObject: TObject);
procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream);
procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream);
procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream);
@ -139,21 +139,22 @@ type
property Normals[X, Y: Word]: TNormals read GetNormals;
property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange;
{ Methods }
function GetDrawList(AX, AY, AWidth, AHeight: Word; AMinZ, AMaxZ: ShortInt;
AGhostTile: TWorldItem; AVirtualLayer: TStaticItem; AMap,
AStatics: Boolean; ANoDraw:Boolean; AStaticsFilter: TStaticFilter): TList;
procedure UpdateDrawListItems(AList: TList);
procedure FillDrawList(ADrawList: TScreenBuffer; AX, AY, AWidth,
AHeight: Word; AMinZ, AMaxZ: ShortInt; AMap, AStatics: Boolean;
ANoDraw: Boolean; AStaticsFilter: TStaticFilter);
function GetEffectiveAltitude(ATile: TMapCell): ShortInt;
function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
procedure MoveStatic(AStatic: TStaticItem; AX, AY: Word);
procedure PrepareBlocks(AX1, AY1, AX2, AY2: Word);
procedure UpdateStaticsPriority(AStaticItem: TStaticItem;
APrioritySolver: Integer);
end;
PBlockInfo = ^TBlockInfo;
TBlockInfo = record
ScreenRect: TRect;
Item: TWorldItem;
Material: TMaterial;
Ghost: Boolean;
Next: PBlockInfo;
end;
@ -163,9 +164,11 @@ type
constructor Create; virtual;
destructor Destroy; override;
protected
{ Fields }
FFirst: PBlockInfo;
FLastBlock: PBlockInfo;
public
{ Methods }
procedure Clear; virtual;
function Iterate(var ABlockInfo: PBlockInfo): Boolean; virtual;
procedure Add(AItem: TWorldItem); virtual;
@ -176,11 +179,19 @@ type
{ TScreenBuffer }
TScreenBuffer = class(TTileList)
constructor Create; override;
protected
{ Members }
FSerial: Cardinal;
public
procedure OnTileRemoved(ATile: TMulBlock);
{ Methods }
procedure Clear; override;
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;
TStaticInfo = packed record
@ -190,7 +201,6 @@ type
TileID: Word;
Hue: Word;
end;
//operator=(AStaticItem: TStaticItem; AStaticInfo: TStaticInfo): Boolean;
implementation
@ -206,6 +216,30 @@ begin
Result := ((AX and $7FFF) shl 15) or (AY and $7FFF);
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 }
constructor TLandTextureManager.Create;
@ -346,8 +380,6 @@ begin
end;
destructor TLandscape.Destroy;
var
i: Integer;
begin
if FBlockCache <> nil then
begin
@ -366,6 +398,18 @@ begin
inherited Destroy;
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;
var
block: TMapBlock;
@ -379,154 +423,6 @@ begin
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;
var
cells: array[0..2, 0..2] of TNormals;
@ -609,74 +505,6 @@ begin
Result[3] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south));
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;
var
block: TBlock;
@ -689,19 +517,26 @@ begin
end;
end;
procedure TLandscape.UpdateStaticsPriority(AStaticItem: TStaticItem;
APrioritySolver: Integer);
function TLandscape.GetStaticList(AX, AY: Word): TList;
var
staticTileData: TStaticTileData;
block: TSeperatedStaticBlock;
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;
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;
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;
procedure TLandscape.OnBlocksPacket(ABuffer: TEnhancedMemoryStream);
@ -724,7 +559,7 @@ begin
if count > 0 then
index.Lookup := ABuffer.Position
else
index.Lookup := $FFFFFFFF;
index.Lookup := -1;
index.Size := count * 7;
statics := TSeperatedStaticBlock.Create(ABuffer, index, coords.X, coords.Y);
@ -776,8 +611,7 @@ begin
targetStaticList.Add(staticItem);
for i := 0 to targetStaticList.Count - 1 do
UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i);
targetStaticList.Sort(@Compare);
//ListSort(targetStaticList, @Compare);
targetStaticList.Sort(@CompareWorldItems);
staticItem.Owner := block;
if Assigned(FOnChange) then FOnChange;
end;
@ -835,8 +669,7 @@ begin
staticItem.Z := ABuffer.ReadShortInt;
for j := 0 to statics.Count - 1 do
UpdateStaticsPriority(TStaticItem(statics.Items[j]), j);
statics.Sort(@Compare);
//ListSort(statics, @Compare);
statics.Sort(@CompareWorldItems);
if Assigned(FOnChange) then FOnChange;
Break;
end;
@ -852,7 +685,6 @@ var
staticInfo: TStaticInfo;
staticItem: TStaticItem;
newX, newY: Word;
item: PLinkedItem;
begin
staticItem := nil;
ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
@ -896,8 +728,7 @@ begin
statics.Add(staticItem);
for i := 0 to statics.Count - 1 do
UpdateStaticsPriority(TStaticItem(statics.Items[i]), i);
statics.Sort(@Compare);
//ListSort(statics, @Compare);
statics.Sort(@CompareWorldItems);
staticItem.Owner := targetBlock;
end;
@ -907,7 +738,7 @@ end;
procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream);
var
block: TSeperatedStaticBlock;
i,j : Integer;
i : Integer;
statics: TList;
staticInfo: TStaticInfo;
staticItem: TStaticItem;
@ -932,13 +763,145 @@ begin
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
block: TBlock;
landAlt: ShortInt;
drawMapCell: TMapCell;
drawStatics: TList;
i, x, y: Integer;
begin
block := AObject as TBlock;
if block <> nil then
dmNetwork.Send(TFreeBlockPacket.Create(block.Map.X, block.Map.Y));
ADrawList.Clear;
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;
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;
{ TMaterial }
@ -993,8 +956,6 @@ begin
FTexture := CreateGLTextureFromImage(FGraphic.ImageDataPointer^, 0, 0, False, ifUnknown, @FWidth, @FHeight);
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_MIN_FILTER, GL_NEAREST);
glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP);
@ -1076,6 +1037,90 @@ end;
{ 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);
var
currentItem, lastItem, nextItem: PBlockInfo;
@ -1098,56 +1143,5 @@ begin
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.

2
Client/UfrmMain.lfm
View File

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

4
Client/UfrmMain.pas
View File

@ -1675,7 +1675,7 @@ begin
else
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,
nil, nil, tbTerrain.Down, tbStatics.Down, //TODO : ghost tile and virtual tile!
acNoDraw.Checked, nil); //TODO : statics filter!
@ -1871,7 +1871,7 @@ begin
glDisable(GL_COLOR_LOGIC_OP);
end;
draw.Free;
draw.Free;}
FOverlayUI.Draw(oglGameWindow);
end;