From 7fdfd1ee233090b15ea975fc70f5a7351f6209e9 Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Wed, 20 May 2009 18:16:18 +0200 Subject: [PATCH] - Merged TTileList into TScreenBuffer - Added shortcuts to TScreenBuffer to speed up the InsertionSort - Renamed TScreenBuffer.Store to TScreenBuffer.Insert - Added TScreenBuffer.Add to append to the list - Added TScreenBuffer.Sort to sort the list using MergeSort - Changed TLandscape.FillDrawList to just append to the list and sort afterwards - Added screen buffer invalidation on TfrmMain.OnLandscapeChanged --- Client/ULandscape.pas | 313 +++++++++++++++++++++++++++--------------- Client/UfrmMain.lfm | 4 +- Client/UfrmMain.pas | 4 +- 3 files changed, 204 insertions(+), 117 deletions(-) diff --git a/Client/ULandscape.pas b/Client/ULandscape.pas index eaa8886..970726b 100644 --- a/Client/ULandscape.pas +++ b/Client/ULandscape.pas @@ -166,37 +166,28 @@ type Next: PBlockInfo; end; - { TTileList } + { TScreenBuffer } - TTileList = class(TObject) + TScreenBuffer = class(TObject) 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; - procedure Delete(AItem: TWorldItem); virtual; - property LastBlock: PBlockInfo read FLastBlock; - end; - - { TScreenBuffer } - - TScreenBuffer = class(TTileList) - constructor Create; override; protected { Members } + FCount: Cardinal; + FShortCuts: array[-1..10] of PBlockInfo; //-1 = last, 0 = first, 1..10 = other shortcuts + FShortCutsValid: Boolean; FSerial: Cardinal; public { Methods } - procedure Clear; override; + function Add(AItem: TWorldItem): PBlockInfo; + procedure Clear; + procedure Delete(AItem: TWorldItem); function Find(AScreenPosition: TPoint): PBlockInfo; function GetSerial: Cardinal; - function Store(AItem: TWorldItem): PBlockInfo; + function Iterate(var ABlockInfo: PBlockInfo): Boolean; + function Insert(AItem: TWorldItem): PBlockInfo; + procedure Sort; + procedure UpdateShortcuts; { Events } procedure OnTileRemoved(ATile: TMulBlock); end; @@ -704,6 +695,7 @@ var i, x, y: Integer; begin for x := AX to AX + AWidth do + begin for y := AY to AY + AWidth do begin if AMap then @@ -717,7 +709,7 @@ begin drawMapCell.Priority := GetEffectiveAltitude(drawMapCell); drawMapCell.PriorityBonus := 0; drawMapCell.PrioritySolver := 0; - ADrawList.Store(drawMapCell); + ADrawList.Add(drawMapCell); end; end; end; @@ -732,10 +724,12 @@ begin ((AStaticsFilter = nil) or AStaticsFilter(TStaticItem(drawStatics[i]))) then begin UpdateStaticsPriority(TStaticItem(drawStatics[i]), ADrawList.GetSerial); - ADrawList.Store(TWorldItem(drawStatics[i])); + ADrawList.Add(TWorldItem(drawStatics[i])); end; end; end; + end; + ADrawList.Sort; end; function TLandscape.GetEffectiveAltitude(ATile: TMapCell): ShortInt; @@ -974,96 +968,52 @@ begin glTexParameterf(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP); end; -{ TTileList } - -constructor TTileList.Create; -begin - inherited Create; - FFirst := nil; - FLastBlock := nil; -end; - -destructor TTileList.Destroy; -begin - Clear; - inherited Destroy; -end; - -procedure TTileList.Clear; -var - current, next: PBlockInfo; -begin - current := FFirst; - while current <> nil do - begin - next := current^.Next; - Dispose(current); - current := next; - end; - FFirst := nil; - FLastBlock := nil; -end; - -function TTileList.Iterate(var ABlockInfo: PBlockInfo): Boolean; -begin - if ABlockInfo = nil then - ABlockInfo := FFirst - else - ABlockInfo := ABlockInfo^.Next; - Result := ABlockInfo <> nil; -end; - -procedure TTileList.Add(AItem: TWorldItem); -var - current: PBlockInfo; -begin - New(current); - current^.Item := AItem; - current^.Next := nil; - if FFirst = nil then FFirst := current; - if FLastBlock <> nil then FLastBlock^.Next := current; - FLastBlock := current; -end; - -procedure TTileList.Delete(AItem: TWorldItem); -var - current, last, next: PBlockInfo; -begin - last := nil; - current := FFirst; - while current <> nil do - begin - if current^.Item = AItem then - begin - if FFirst = current then FFirst := current^.Next; - if FLastBlock = current then FLastBlock := last; - if last <> nil then last^.Next := current^.Next; - - if current^.Normals <> nil then Dispose(current^.Normals); - - Dispose(current); - next := nil; - end else - next := current^.Next; - - last := current; - current := next; - end; -end; - { TScreenBuffer } constructor TScreenBuffer.Create; begin inherited Create; + FCount := 0; FSerial := 0; + UpdateShortcuts; +end; + +destructor TScreenBuffer.Destroy; +begin + Clear; + inherited Destroy; +end; + +function TScreenBuffer.Add(AItem: TWorldItem): PBlockInfo; +begin + New(Result); + AItem.Locked := True; + AItem.OnDestroy.RegisterEvent(@OnTileRemoved); + Result^.Item := AItem; + Result^.HighRes := nil; + Result^.LowRes := nil; + Result^.Normals := nil; + Result^.State := ssNormal; + Result^.Next := nil; + + if FShortCuts[0] = nil then //First element + begin + FShortCuts[0] := Result; + FShortCuts[-1] := Result; //Last element + end else + begin + FShortCuts[-1]^.Next := Result; + FShortCuts[-1] := Result; + end; + + Inc(FCount); end; procedure TScreenBuffer.Clear; var current, next: PBlockInfo; begin - current := FFirst; + current := FShortCuts[0]; while current <> nil do begin next := current^.Next; @@ -1073,10 +1023,41 @@ begin Dispose(current); current := next; end; - FFirst := nil; - FLastBlock := nil; + FShortCuts[0] := nil; + FShortCuts[-1] := nil; + FCount := 0; FSerial := 0; + + UpdateShortcuts; +end; + +procedure TScreenBuffer.Delete(AItem: TWorldItem); +var + current, last, next: PBlockInfo; +begin + last := nil; + current := FShortCuts[0]; + while current <> nil do + begin + if current^.Item = AItem then + begin + if FShortCuts[-1] = current then FShortCuts[-1] := last; + if FShortCuts[0] = current then FShortCuts[0] := current^.Next; + if last <> nil then last^.Next := current^.Next; + + if current^.Normals <> nil then Dispose(current^.Normals); + + Dispose(current); + Dec(FCount); + FShortCutsValid := False; + next := nil; + end else + next := current^.Next; + + last := current; + current := next; + end; end; function TScreenBuffer.Find(AScreenPosition: TPoint): PBlockInfo; @@ -1084,7 +1065,7 @@ var current: PBlockInfo; begin Result := nil; - current := FFirst; + current := FShortCuts[0]; while (current <> nil) and (Result = nil) do begin if (current^.State = ssNormal) and @@ -1104,10 +1085,23 @@ begin Inc(FSerial); end; -function TScreenBuffer.Store(AItem: TWorldItem): PBlockInfo; +function TScreenBuffer.Iterate(var ABlockInfo: PBlockInfo): Boolean; +begin + if ABlockInfo = nil then + ABlockInfo := FShortCuts[0] + else + ABlockInfo := ABlockInfo^.Next; + Result := ABlockInfo <> nil; +end; + +function TScreenBuffer.Insert(AItem: TWorldItem): PBlockInfo; var current: PBlockInfo; + shortcut: Integer; begin + if not FShortCutsValid then + UpdateShortcuts; + New(Result); AItem.Locked := True; AItem.OnDestroy.RegisterEvent(@OnTileRemoved); @@ -1117,27 +1111,118 @@ begin Result^.Normals := nil; Result^.State := ssNormal; - if (FFirst = nil) or (CompareWorldItems(AItem, FFirst) > 0) then + if (FShortCuts[0] = nil) or (CompareWorldItems(AItem, FShortCuts[0]) > 0) then begin - Result^.Next := FFirst; - if FFirst = nil then - FLastBlock := Result; - FFirst := Result; + //TODO : update last element if necessary + Result^.Next := FShortCuts[0]; + FShortCuts[0] := Result; end else begin - current := FFirst; + //find best entry point + shortcut := 0; + while (shortcut <= 10) and (FShortCuts[shortcut] <> nil) and + (CompareWorldItems(AItem, FShortCuts[shortcut]) <= 0) do + begin + current := FShortCuts[shortcut]; + Inc(shortcut); + end; + + //now find the real match while (current^.Next <> nil) and (CompareWorldItems(AItem, current^.Next^.Item) > 0) do begin current := current^.Next; end; - - if current^.Next = nil then - FLastBlock := Result; + //TODO : update last element if necessary Result^.Next := current^.Next; current^.Next := Result; end; + + Inc(FCount); +end; + +//Mergesort +procedure TScreenBuffer.Sort; + + function Merge(AHead1, AHead2: PBlockInfo): PBlockInfo; + begin + if AHead1 = nil then + Exit(AHead2); + + if AHead2 = nil then + Exit(AHead1); + + if CompareWorldItems(AHead1^.Item, AHead2^.Item) < 0 then + begin + Result := AHead1; + Result^.Next := Merge(Result^.Next, AHead2); + end else + begin + Result := AHead2; + Result^.Next := Merge(AHead1, Result^.Next); + end; + end; + + function MergeSort(AHead: PBlockInfo): PBlockInfo; + var + head1, head2: PBlockInfo; + begin + if (AHead <> nil) and (AHead^.Next <> nil) then + begin + head1 := AHead; + head2 := AHead^.Next; + while (head2 <> nil) and (head2^.Next <> nil) do + begin + AHead := AHead^.Next; + head2 := AHead^.Next^.Next; + end; + head2 := AHead^.Next; + AHead^.Next := nil; + + Result := Merge(MergeSort(head1), MergeSort(head2)); + end else + Result := AHead; + end; + +begin + if FShortCuts[0] <> nil then + FShortCuts[0] := MergeSort(FShortCuts[0]); + UpdateShortcuts; +end; + +procedure TScreenBuffer.UpdateShortcuts; +var + shortcut, step, nextStep, stepSize: Integer; + blockInfo: PBlockInfo; +begin + if FCount < 10 then + begin + for shortcut := 1 to 10 do + FShortCuts[shortcut] := nil; + end + else if FShortCuts[0] <> nil then + begin + stepSize := FCount div 10; + nextStep := stepSize; + step := 0; + shortcut := 1; + blockInfo := FShortCuts[0]; + repeat + if step = nextStep then + begin + FShortCuts[shortcut] := blockInfo; + Inc(shortcut); + Inc(nextStep, stepSize); + end; + + Inc(step); + + FShortCuts[-1] := blockInfo; //update last known item + blockInfo := blockInfo^.Next; + until (blockInfo = nil); + end; + FShortCutsValid := True; end; procedure TScreenBuffer.OnTileRemoved(ATile: TMulBlock); diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm index 7c2f5a1..143ed3b 100644 --- a/Client/UfrmMain.lfm +++ b/Client/UfrmMain.lfm @@ -1,5 +1,5 @@ object frmMain: TfrmMain - Left = 232 + Left = 229 Height = 603 Top = 126 Width = 766 @@ -1076,7 +1076,7 @@ object frmMain: TfrmMain object MainMenu1: TMainMenu Images = ImageList1 left = 232 - top = 32 + top = 33 object mnuCentrED: TMenuItem Caption = '&CentrED' object mnuDisconnect: TMenuItem diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas index 626a395..5390626 100644 --- a/Client/UfrmMain.pas +++ b/Client/UfrmMain.pas @@ -838,6 +838,7 @@ begin oglGameWindow.Repaint; FLastDraw := Now; end; + Done := False; end; procedure TfrmMain.btnAddLocationClick(Sender: TObject); @@ -1540,7 +1541,6 @@ begin edY.Value := FY; dmNetwork.Send(TUpdateClientPosPacket.Create(AX, AY)); InvalidateScreenBuffer; - Repaint; if frmRadarMap <> nil then frmRadarMap.Repaint; end; end; @@ -1921,6 +1921,7 @@ end; procedure TfrmMain.OnLandscapeChanged; begin + InvalidateScreenBuffer; oglGameWindow.Repaint; UpdateCurrentTile; end; @@ -2155,6 +2156,7 @@ begin end; end; + FScreenBuffer.UpdateShortcuts; FScreenBufferValid := True; end;