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

- Changed TWorldItem and TWorldBlock Change-tracking 

- Reverted TStaticItem.UpdatePriorities
- Fixed vdtTiles' HintCanvas to use the desired font when drawing
- Fixed UpdateFilter to no longer call ForceUpdateCurrentTile
- Several code cleanups
This commit is contained in:
Andreas Schneider 2009-12-23 16:39:24 +01:00
parent 34b62f6cd0
commit cf4c155858
8 changed files with 4915 additions and 5013 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Client/CentrED.lpi
View File

@ -6,12 +6,12 @@
<Flags> <Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/> <MainUnitHasUsesSectionForAllUnits Value="False"/>
<AlwaysBuild Value="False"/> <AlwaysBuild Value="False"/>
<LRSInOutputDirectory Value="False"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<TargetFileExt Value=".exe"/> <TargetFileExt Value=".exe"/>
<Title Value="CentrED"/> <Title Value="CentrED"/>
<LFMResourceType Value="res"/>
<Icon Value="0"/> <Icon Value="0"/>
</General> </General>
<LazDoc Paths="../doc"/> <LazDoc Paths="../doc"/>

131
Client/UfrmMain.lfm
View File

@ -5,7 +5,7 @@ object frmMain: TfrmMain
Width = 755 Width = 755
ActiveControl = oglGameWindow ActiveControl = oglGameWindow
Caption = 'UO CentrED' Caption = 'UO CentrED'
ClientHeight = 556 ClientHeight = 559
ClientWidth = 755 ClientWidth = 755
Constraints.MinHeight = 500 Constraints.MinHeight = 500
Constraints.MinWidth = 750 Constraints.MinWidth = 750
@ -23,7 +23,7 @@ object frmMain: TfrmMain
object pnlBottom: TPanel object pnlBottom: TPanel
Left = 0 Left = 0
Height = 31 Height = 31
Top = 525 Top = 528
Width = 755 Width = 755
Align = alBottom Align = alBottom
BevelOuter = bvNone BevelOuter = bvNone
@ -34,7 +34,7 @@ object frmMain: TfrmMain
Left = 11 Left = 11
Height = 14 Height = 14
Top = 7 Top = 7
Width = 11 Width = 10
Caption = 'X:' Caption = 'X:'
ParentColor = False ParentColor = False
end end
@ -42,7 +42,7 @@ object frmMain: TfrmMain
Left = 88 Left = 88
Height = 14 Height = 14
Top = 7 Top = 7
Width = 10 Width = 9
Caption = 'Y:' Caption = 'Y:'
ParentColor = False ParentColor = False
end end
@ -55,10 +55,10 @@ object frmMain: TfrmMain
ParentColor = False ParentColor = False
end end
object lblTip: TLabel object lblTip: TLabel
Left = 517 Left = 523
Height = 31 Height = 31
Top = 0 Top = 0
Width = 230 Width = 224
Align = alRight Align = alRight
Alignment = taRightJustify Alignment = taRightJustify
BorderSpacing.Right = 8 BorderSpacing.Right = 8
@ -67,10 +67,10 @@ object frmMain: TfrmMain
ParentColor = False ParentColor = False
end end
object lblTipC: TLabel object lblTipC: TLabel
Left = 487 Left = 500
Height = 31 Height = 31
Top = 0 Top = 0
Width = 30 Width = 23
Align = alRight Align = alRight
Caption = 'Tip: ' Caption = 'Tip: '
Font.Height = -11 Font.Height = -11
@ -81,7 +81,7 @@ object frmMain: TfrmMain
end end
object edX: TSpinEdit object edX: TSpinEdit
Left = 24 Left = 24
Height = 19 Height = 21
Top = 3 Top = 3
Width = 55 Width = 55
MaxValue = 100000 MaxValue = 100000
@ -89,7 +89,7 @@ object frmMain: TfrmMain
end end
object edY: TSpinEdit object edY: TSpinEdit
Left = 104 Left = 104
Height = 19 Height = 21
Top = 3 Top = 3
Width = 52 Width = 52
MaxValue = 100000 MaxValue = 100000
@ -108,7 +108,7 @@ object frmMain: TfrmMain
end end
object pcLeft: TPageControl object pcLeft: TPageControl
Left = 0 Left = 0
Height = 501 Height = 504
Top = 24 Top = 24
Width = 224 Width = 224
ActivePage = tsTiles ActivePage = tsTiles
@ -117,13 +117,13 @@ object frmMain: TfrmMain
TabOrder = 1 TabOrder = 1
object tsTiles: TTabSheet object tsTiles: TTabSheet
Caption = 'Tiles' Caption = 'Tiles'
ClientHeight = 468 ClientHeight = 478
ClientWidth = 218 ClientWidth = 216
object lblFilter: TLabel object lblFilter: TLabel
AnchorSideLeft.Control = cbTerrain AnchorSideLeft.Control = cbTerrain
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = cbTerrain AnchorSideTop.Control = cbTerrain
Left = 81 Left = 75
Height = 14 Height = 14
Top = 8 Top = 8
Width = 30 Width = 30
@ -140,10 +140,10 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = spTileList AnchorSideBottom.Control = spTileList
Left = 4 Left = 4
Height = 218 Height = 234
Hint = '-' Hint = '-'
Top = 56 Top = 50
Width = 210 Width = 208
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 4 BorderSpacing.Top = 4
@ -197,13 +197,13 @@ object frmMain: TfrmMain
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 0 Left = 0
Height = 189 Height = 189
Top = 279 Top = 289
Width = 218 Width = 216
Align = alBottom Align = alBottom
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
Caption = 'Random pool' Caption = 'Random pool'
ClientHeight = 175 ClientHeight = 171
ClientWidth = 216 ClientWidth = 212
TabOrder = 1 TabOrder = 1
object btnAddRandom: TSpeedButton object btnAddRandom: TSpeedButton
AnchorSideLeft.Control = gbRandom AnchorSideLeft.Control = gbRandom
@ -363,10 +363,10 @@ object frmMain: TfrmMain
object btnRandomPresetSave: TSpeedButton object btnRandomPresetSave: TSpeedButton
AnchorSideTop.Control = cbRandomPreset AnchorSideTop.Control = cbRandomPreset
AnchorSideRight.Control = btnRandomPresetDelete AnchorSideRight.Control = btnRandomPresetDelete
Left = 164 Left = 160
Height = 22 Height = 22
Hint = 'Save Preset' Hint = 'Save Preset'
Top = 142 Top = 146
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -417,10 +417,10 @@ object frmMain: TfrmMain
AnchorSideTop.Control = btnRandomPresetSave AnchorSideTop.Control = btnRandomPresetSave
AnchorSideRight.Control = gbRandom AnchorSideRight.Control = gbRandom
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 190 Left = 186
Height = 22 Height = 22
Hint = 'Delete Preset' Hint = 'Delete Preset'
Top = 142 Top = 146
Width = 22 Width = 22
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -477,9 +477,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = cbRandomPreset AnchorSideBottom.Control = cbRandomPreset
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 114 Height = 118
Top = 24 Top = 24
Width = 208 Width = 204
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 2 BorderSpacing.Top = 2
@ -525,14 +525,14 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = gbRandom AnchorSideBottom.Control = gbRandom
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 4 Left = 4
Height = 29 Height = 21
Top = 142 Top = 146
Width = 156 Width = 152
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Right = 4 BorderSpacing.Right = 4
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
ItemHeight = 0 ItemHeight = 13
OnChange = cbRandomPresetChange OnChange = cbRandomPresetChange
Sorted = True Sorted = True
Style = csDropDownList Style = csDropDownList
@ -546,8 +546,8 @@ object frmMain: TfrmMain
Cursor = crVSplit Cursor = crVSplit
Left = 0 Left = 0
Height = 5 Height = 5
Top = 274 Top = 284
Width = 218 Width = 216
Align = alNone Align = alNone
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
ResizeAnchor = akBottom ResizeAnchor = akBottom
@ -557,10 +557,10 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = vdtTiles AnchorSideBottom.Control = vdtTiles
AnchorSideBottom.Side = asrBottom AnchorSideBottom.Side = asrBottom
Left = 110 Left = 108
Height = 19 Height = 21
Hint = 'Append S or T to restrict the search to Statics or Terrain.' Hint = 'Append S or T to restrict the search to Statics or Terrain.'
Top = 247 Top = 255
Width = 96 Width = 96
Anchors = [akRight, akBottom] Anchors = [akRight, akBottom]
BorderSpacing.Right = 8 BorderSpacing.Right = 8
@ -579,10 +579,10 @@ object frmMain: TfrmMain
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
AnchorSideRight.Control = tsTiles AnchorSideRight.Control = tsTiles
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
Left = 81 Left = 75
Height = 19 Height = 21
Top = 22 Top = 22
Width = 121 Width = 125
Anchors = [akTop, akLeft, akRight] Anchors = [akTop, akLeft, akRight]
BorderSpacing.Right = 16 BorderSpacing.Right = 16
OnEditingDone = edFilterEditingDone OnEditingDone = edFilterEditingDone
@ -593,10 +593,10 @@ object frmMain: TfrmMain
AnchorSideLeft.Side = asrCenter AnchorSideLeft.Side = asrCenter
AnchorSideTop.Control = cbTerrain AnchorSideTop.Control = cbTerrain
AnchorSideTop.Side = asrBottom AnchorSideTop.Side = asrBottom
Left = 4 Left = 5
Height = 22 Height = 19
Top = 30 Top = 27
Width = 60 Width = 53
Caption = 'Statics' Caption = 'Statics'
Checked = True Checked = True
OnChange = cbStaticsChange OnChange = cbStaticsChange
@ -607,9 +607,9 @@ object frmMain: TfrmMain
AnchorSideLeft.Control = tsTiles AnchorSideLeft.Control = tsTiles
AnchorSideTop.Control = tsTiles AnchorSideTop.Control = tsTiles
Left = 4 Left = 4
Height = 22 Height = 19
Top = 8 Top = 8
Width = 61 Width = 55
BorderSpacing.Left = 4 BorderSpacing.Left = 4
BorderSpacing.Top = 8 BorderSpacing.Top = 8
Caption = 'Terrain' Caption = 'Terrain'
@ -621,26 +621,25 @@ object frmMain: TfrmMain
end end
object tsClients: TTabSheet object tsClients: TTabSheet
Caption = 'Clients' Caption = 'Clients'
ClientHeight = 468 ClientHeight = 478
ClientWidth = 218 ClientWidth = 216
object lbClients: TListBox object lbClients: TListBox
Left = 0 Left = 0
Height = 468 Height = 478
Top = 0 Top = 0
Width = 218 Width = 216
Align = alClient Align = alClient
ItemHeight = 0 ItemHeight = 0
OnDblClick = mnuGoToClientClick OnDblClick = mnuGoToClientClick
PopupMenu = pmClients PopupMenu = pmClients
Sorted = True Sorted = True
TabOrder = 0 TabOrder = 0
TopIndex = -1
end end
end end
object tsLocations: TTabSheet object tsLocations: TTabSheet
Caption = 'Locations' Caption = 'Locations'
ClientHeight = 468 ClientHeight = 478
ClientWidth = 218 ClientWidth = 216
object btnClearLocations: TSpeedButton object btnClearLocations: TSpeedButton
AnchorSideLeft.Control = btnDeleteLocation AnchorSideLeft.Control = btnDeleteLocation
AnchorSideLeft.Side = asrBottom AnchorSideLeft.Side = asrBottom
@ -648,7 +647,7 @@ object frmMain: TfrmMain
Left = 125 Left = 125
Height = 22 Height = 22
Hint = 'Clear' Hint = 'Clear'
Top = 442 Top = 452
Width = 23 Width = 23
BorderSpacing.Left = 4 BorderSpacing.Left = 4
Color = clBtnFace Color = clBtnFace
@ -701,7 +700,7 @@ object frmMain: TfrmMain
Left = 98 Left = 98
Height = 22 Height = 22
Hint = 'Delete' Hint = 'Delete'
Top = 442 Top = 452
Width = 23 Width = 23
Anchors = [akLeft, akBottom] Anchors = [akLeft, akBottom]
BorderSpacing.Bottom = 4 BorderSpacing.Bottom = 4
@ -753,7 +752,7 @@ object frmMain: TfrmMain
Left = 71 Left = 71
Height = 22 Height = 22
Hint = 'Add' Hint = 'Add'
Top = 442 Top = 452
Width = 23 Width = 23
Anchors = [akTop, akRight] Anchors = [akTop, akRight]
BorderSpacing.Right = 4 BorderSpacing.Right = 4
@ -807,9 +806,9 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = btnDeleteLocation AnchorSideBottom.Control = btnDeleteLocation
Cursor = 63 Cursor = 63
Left = 4 Left = 4
Height = 434 Height = 444
Top = 4 Top = 4
Width = 210 Width = 208
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BorderSpacing.Around = 4 BorderSpacing.Around = 4
DefaultText = 'Node' DefaultText = 'Node'
@ -823,7 +822,7 @@ object frmMain: TfrmMain
item item
Position = 1 Position = 1
Text = 'Name' Text = 'Name'
Width = 135 Width = 133
end> end>
Header.DefaultHeight = 17 Header.DefaultHeight = 17
Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible]
@ -1036,7 +1035,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = spChat AnchorSideBottom.Control = spChat
Left = 224 Left = 224
Height = 22 Height = 22
Top = 389 Top = 392
Width = 531 Width = 531
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
BevelInner = bvRaised BevelInner = bvRaised
@ -1049,7 +1048,7 @@ object frmMain: TfrmMain
Left = 10 Left = 10
Height = 18 Height = 18
Top = 2 Top = 2
Width = 104 Width = 101
Align = alLeft Align = alLeft
BorderSpacing.Left = 8 BorderSpacing.Left = 8
Caption = 'Chat and Messages' Caption = 'Chat and Messages'
@ -1070,7 +1069,7 @@ object frmMain: TfrmMain
AnchorSideBottom.Control = pnlBottom AnchorSideBottom.Control = pnlBottom
Left = 224 Left = 224
Height = 109 Height = 109
Top = 416 Top = 419
Width = 531 Width = 531
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]
BevelOuter = bvNone BevelOuter = bvNone
@ -1081,7 +1080,7 @@ object frmMain: TfrmMain
object vstChat: TVirtualStringTree object vstChat: TVirtualStringTree
Cursor = 63 Cursor = 63
Left = 0 Left = 0
Height = 90 Height = 88
Top = 0 Top = 0
Width = 531 Width = 531
Align = alClient Align = alClient
@ -1119,8 +1118,8 @@ object frmMain: TfrmMain
end end
object edChat: TEdit object edChat: TEdit
Left = 0 Left = 0
Height = 19 Height = 21
Top = 90 Top = 88
Width = 531 Width = 531
Align = alBottom Align = alBottom
OnKeyPress = edChatKeyPress OnKeyPress = edChatKeyPress
@ -1135,7 +1134,7 @@ object frmMain: TfrmMain
Cursor = crVSplit Cursor = crVSplit
Left = 224 Left = 224
Height = 5 Height = 5
Top = 411 Top = 414
Width = 531 Width = 531
Align = alNone Align = alNone
Anchors = [akLeft, akRight, akBottom] Anchors = [akLeft, akRight, akBottom]
@ -1152,7 +1151,7 @@ object frmMain: TfrmMain
AnchorSideRight.Side = asrBottom AnchorSideRight.Side = asrBottom
AnchorSideBottom.Control = pnlChatHeader AnchorSideBottom.Control = pnlChatHeader
Left = 224 Left = 224
Height = 365 Height = 368
Top = 24 Top = 24
Width = 531 Width = 531
Anchors = [akTop, akLeft, akRight, akBottom] Anchors = [akTop, akLeft, akRight, akBottom]

38
Client/UfrmMain.pas
View File

@ -1285,7 +1285,6 @@ procedure TfrmMain.edSearchIDExit(Sender: TObject);
begin begin
edSearchID.Visible := False; edSearchID.Visible := False;
edSearchID.Text := ''; edSearchID.Text := '';
//edSearchID.Font.Color := clWindowText;
end; end;
procedure TfrmMain.edSearchIDKeyPress(Sender: TObject; var Key: char); procedure TfrmMain.edSearchIDKeyPress(Sender: TObject; var Key: char);
@ -1316,7 +1315,6 @@ begin
tileID := 0; tileID := 0;
if not TryStrToInt(enteredText, tileID) then if not TryStrToInt(enteredText, tileID) then
begin begin
//edSearchID.Font.Color := clRed;
MessageDlg('Error', 'The specified TileID is invalid.', mtError, [mbOK], 0); MessageDlg('Error', 'The specified TileID is invalid.', mtError, [mbOK], 0);
vdtTiles.SetFocus; vdtTiles.SetFocus;
Exit; Exit;
@ -1341,18 +1339,15 @@ begin
if node = nil then if node = nil then
begin begin
//edSearchID.Font.Color := clRed;
MessageDlg('Error', 'The tile with the specified ID could not be found.' + MessageDlg('Error', 'The tile with the specified ID could not be found.' +
LineEnding + 'Check for conflicting filter settings.', mtError, [mbOK], 0); LineEnding + 'Check for conflicting filter settings.', mtError, [mbOK], 0);
vdtTiles.SetFocus; vdtTiles.SetFocus;
Exit; Exit;
end; end;
//edSearchID.Font.Color := clWindowText;
edSearchID.Visible := False; edSearchID.Visible := False;
end else if Key = #27 then end else if Key = #27 then
begin begin
edSearchID.Visible := False; edSearchID.Visible := False;
//edSearchID.Font.Color := clWindowText;
Key := #0; Key := #0;
end else if not (Key in ['$', '0'..'9', 'a'..'f', 'A'..'F', 's', 'S', end else if not (Key in ['$', '0'..'9', 'a'..'f', 'A'..'F', 's', 'S',
't', 'T', #8]) then 't', 'T', #8]) then
@ -1549,15 +1544,6 @@ end;
procedure TfrmMain.vdtTilesClick(Sender: TObject); procedure TfrmMain.vdtTilesClick(Sender: TObject);
begin begin
{if vdtTiles.GetFirstSelected <> nil then
begin
if not tbDrawTile.Down then
begin
frmDrawSettings.rbTileList.Checked := True;
tbDrawTileClick(Sender);
end else
ProcessToolState;
end;}
if acDraw.Checked then if acDraw.Checked then
ProcessToolState; ProcessToolState;
end; end;
@ -1566,6 +1552,7 @@ procedure TfrmMain.vdtTilesDrawHint(Sender: TBaseVirtualTree;
HintCanvas: TCanvas; Node: PVirtualNode; const R: TRect; Column: TColumnIndex HintCanvas: TCanvas; Node: PVirtualNode; const R: TRect; Column: TColumnIndex
); );
begin begin
HintCanvas.Font.Assign(Sender.Font);
HintCanvas.Font.Style := [fsBold]; HintCanvas.Font.Style := [fsBold];
DrawText(HintCanvas.Handle, PChar(FTileHint.Name), Length(FTileHint.Name), DrawText(HintCanvas.Handle, PChar(FTileHint.Name), Length(FTileHint.Name),
FTileHint.NameRect, 0); FTileHint.NameRect, 0);
@ -1941,9 +1928,13 @@ begin
lblTileInfo.Caption := Format('Terrain TileID: $%x, X: %d, Y: %d, Z: %d', lblTileInfo.Caption := Format('Terrain TileID: $%x, X: %d, Y: %d, Z: %d',
[FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z]) [FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z])
else if FCurrentTile is TStaticItem then else if FCurrentTile is TStaticItem then
lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x', {lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x',
[FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z, [FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z,
TStaticItem(FCurrentTile).Hue]); TStaticItem(FCurrentTile).Hue]);}
lblTileInfo.Caption := Format('Static TileID: $%x, X: %d, Y: %d, Z: %d, Hue: $%x, Priority: %d, Bonus: %d, Solver: %d',
[FCurrentTile.TileID, FCurrentTile.X, FCurrentTile.Y, FCurrentTile.Z,
TStaticItem(FCurrentTile).Hue, FCurrentTile.Priority, FCurrentTile.PriorityBonus,
FCurrentTile.PrioritySolver]);
end; end;
UpdateSelection; UpdateSelection;
@ -2446,7 +2437,8 @@ end;
procedure TfrmMain.OnMapChanged(AMapCell: TMapCell); procedure TfrmMain.OnMapChanged(AMapCell: TMapCell);
begin begin
PrepareMapCell(AMapCell); PrepareMapCell(AMapCell);
InvalidateFilter; ForceUpdateCurrentTile;
InvalidateFilter
end; end;
procedure TfrmMain.OnNewBlock(ABlock: TBlock); procedure TfrmMain.OnNewBlock(ABlock: TBlock);
@ -2457,9 +2449,9 @@ end;
procedure TfrmMain.OnStaticDeleted(AStaticItem: TStaticItem); procedure TfrmMain.OnStaticDeleted(AStaticItem: TStaticItem);
begin begin
FScreenBuffer.Delete(AStaticItem); FScreenBuffer.Delete(AStaticItem);
UpdateCurrentTile;
FRepaintNeeded := True; FRepaintNeeded := True;
ForceUpdateCurrentTile; ForceUpdateCurrentTile;
InvalidateFilter
end; end;
procedure TfrmMain.OnStaticElevated(AStaticItem: TStaticItem); procedure TfrmMain.OnStaticElevated(AStaticItem: TStaticItem);
@ -2472,7 +2464,8 @@ begin
begin begin
PrepareScreenBlock(blockInfo); PrepareScreenBlock(blockInfo);
Exclude(FScreenBufferState, sbsIndexed); Exclude(FScreenBufferState, sbsIndexed);
InvalidateFilter; ForceUpdateCurrentTile;
InvalidateFilter
end; end;
end; end;
@ -2487,7 +2480,7 @@ begin
begin begin
PrepareScreenBlock(blockInfo); PrepareScreenBlock(blockInfo);
FRepaintNeeded := True; FRepaintNeeded := True;
InvalidateFilter; ForceUpdateCurrentTile;
Break; Break;
end; end;
end; end;
@ -2503,7 +2496,8 @@ begin
AStaticItem.PrioritySolver := FScreenBuffer.GetSerial; AStaticItem.PrioritySolver := FScreenBuffer.GetSerial;
PrepareScreenBlock(FScreenBuffer.Insert(AStaticItem)); PrepareScreenBlock(FScreenBuffer.Insert(AStaticItem));
FRepaintNeeded := True; FRepaintNeeded := True;
InvalidateFilter; ForceUpdateCurrentTile;
InvalidateFilter
end; end;
end; end;
@ -2743,8 +2737,6 @@ begin
end; end;
Include(FScreenBufferState, sbsFiltered); Include(FScreenBufferState, sbsFiltered);
ForceUpdateCurrentTile;
if (FLightManager.LightLevel > 0) and not acFlat.Checked then if (FLightManager.LightLevel > 0) and not acFlat.Checked then
FLightManager.UpdateLightMap(FX + FLowOffsetX, FRangeX + 1, FY + FLowOffsetY, FLightManager.UpdateLightMap(FX + FLowOffsetX, FRangeX + 1, FY + FLowOffsetY,
FRangeY + 1, FScreenBuffer); FRangeY + 1, FScreenBuffer);

17
Server/ULandscape.pas
View File

@ -97,7 +97,6 @@ type
FRadarMap: TRadarMap; FRadarMap: TRadarMap;
FBlockCache: TBlockCache; FBlockCache: TBlockCache;
FBlockSubscriptions: TBlockSubscriptions; FBlockSubscriptions: TBlockSubscriptions;
procedure OnBlockChanged(ABlock: TMulBlock);
procedure OnRemoveCachedObject(ABlock: TBlock); procedure OnRemoveCachedObject(ABlock: TBlock);
function GetMapCell(AX, AY: Word): TMapCell; function GetMapCell(AX, AY: Word): TMapCell;
function GetStaticList(AX, AY: Word): TStaticItemList; function GetStaticList(AX, AY: Word): TStaticItemList;
@ -494,11 +493,6 @@ begin
Result := (west + east) div 2; Result := (west + east) div 2;
end; end;
procedure TLandscape.OnBlockChanged(ABlock: TMulBlock);
begin
// Do nothing for now
end;
procedure TLandscape.OnRemoveCachedObject(ABlock: TBlock); procedure TLandscape.OnRemoveCachedObject(ABlock: TBlock);
begin begin
if ABlock <> nil then if ABlock <> nil then
@ -544,12 +538,10 @@ var
begin begin
FMap.Position := ((AX * FHeight) + AY) * 196; FMap.Position := ((AX * FHeight) + AY) * 196;
map := TMapBlock.Create(FMap, AX, AY); map := TMapBlock.Create(FMap, AX, AY);
map.OnChanged := @OnBlockChanged;
FStaIdx.Position := ((AX * FHeight) + AY) * 12; FStaIdx.Position := ((AX * FHeight) + AY) * 12;
index := TGenericIndex.Create(FStaIdx); index := TGenericIndex.Create(FStaIdx);
statics := TSeperatedStaticBlock.Create(FStatics, index, AX, AY); statics := TSeperatedStaticBlock.Create(FStatics, index, AX, AY);
statics.OnChanged := @OnBlockChanged;
statics.TiledataProvider := FTiledataProvider; statics.TiledataProvider := FTiledataProvider;
index.Free; index.Free;
@ -573,9 +565,7 @@ begin
begin begin
FMap.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 196; FMap.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 196;
AWorldBlock.Write(FMap); AWorldBlock.Write(FMap);
for i := 0 to 63 do AWorldBlock.Changed := False;
TMapBlock(AWorldBlock).Cells[i].InitOriginalState;
AWorldBlock.CleanUp;
end else if AWorldBlock is TStaticBlock then end else if AWorldBlock is TStaticBlock then
begin begin
FStaIdx.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 12; FStaIdx.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 12;
@ -597,10 +587,7 @@ begin
FStaIdx.Seek(-12, soFromCurrent); FStaIdx.Seek(-12, soFromCurrent);
index.Write(FStaIdx); index.Write(FStaIdx);
index.Free; index.Free;
for i := 0 to 63 do AWorldBlock.Changed := False;
for j := 0 to TSeperatedStaticBlock(AWorldBlock).Cells[i].Count - 1 do
TStaticItem(TSeperatedStaticBlock(AWorldBlock).Cells[i].Items[j]).InitOriginalState;
AWorldBlock.CleanUp;
end; end;
end; end;

8
Server/cedserver.lpi
View File

@ -4,6 +4,7 @@
<Version Value="7"/> <Version Value="7"/>
<General> <General>
<Flags> <Flags>
<MainUnitHasUsesSectionForAllUnits Value="False"/>
<LRSInOutputDirectory Value="False"/> <LRSInOutputDirectory Value="False"/>
</Flags> </Flags>
<SessionStorage Value="InProjectDir"/> <SessionStorage Value="InProjectDir"/>
@ -138,15 +139,14 @@
<CodeGeneration> <CodeGeneration>
<SmartLinkUnit Value="True"/> <SmartLinkUnit Value="True"/>
<Optimizations> <Optimizations>
<OptimizationLevel Value="3"/> <OptimizationLevel Value="0"/>
</Optimizations> </Optimizations>
</CodeGeneration> </CodeGeneration>
<Linking> <Linking>
<Debugging> <Debugging>
<UseLineInfoUnit Value="False"/> <GenerateDebugInfo Value="True"/>
<StripSymbols Value="True"/> <UseHeaptrc Value="True"/>
</Debugging> </Debugging>
<LinkSmart Value="True"/>
</Linking> </Linking>
<Other> <Other>
<CustomOptions Value="-FE../bin/ <CustomOptions Value="-FE../bin/

2
UOLib/UMap.pas
View File

@ -107,8 +107,6 @@ begin
end; end;
FIsGhost := False; FIsGhost := False;
InitOriginalState;
end; end;
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream); constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream);

27
UOLib/UStatics.pas
View File

@ -42,11 +42,9 @@ type
protected protected
{ Members } { Members }
FHue: Word; FHue: Word;
FOrgHue: Word;
{ Methods } { Methods }
function HasChanged: Boolean; override; procedure SetHue(AValue: Word);
procedure SetHue(AHue: Word);
public public
{ Fields } { Fields }
property Hue: Word read FHue write SetHue; property Hue: Word read FHue write SetHue;
@ -54,7 +52,6 @@ type
{ Methods } { Methods }
function Clone: TStaticItem; override; function Clone: TStaticItem; override;
function GetSize: Integer; override; function GetSize: Integer; override;
procedure InitOriginalState; override;
procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer); procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer);
procedure Write(AData: TStream); override; procedure Write(AData: TStream); override;
end; end;
@ -112,8 +109,6 @@ begin
FX := ABlockX * 8 + iX; FX := ABlockX * 8 + iX;
FY := ABlockY * 8 + iY; FY := ABlockY * 8 + iY;
end; end;
InitOriginalState;
end; end;
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream); constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
@ -121,14 +116,12 @@ begin
Create(AOwner, AData, 0, 0); Create(AOwner, AData, 0, 0);
end; end;
function TStaticItem.HasChanged: Boolean; procedure TStaticItem.SetHue(AValue: Word);
begin begin
Result := (FHue <> FOrgHue) or inherited HasChanged; if FHue = AValue then
end; Exit;
procedure TStaticItem.SetHue(AHue: Word); FHue := AValue;
begin
FHue := AHue;
DoChanged; DoChanged;
end; end;
@ -147,17 +140,13 @@ begin
Result := 7; Result := 7;
end; end;
procedure TStaticItem.InitOriginalState;
begin
FOrgHue := FHue;
inherited InitOriginalState;
end;
procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata; procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata;
ASolver: Integer); ASolver: Integer);
begin begin
FPriorityBonus := 0; FPriorityBonus := 0;
if not (tdfBackground in ATileData.Flags) or (ATileData.Height > 0) then if not (tdfBackground in ATileData.Flags) then
Inc(FPriorityBonus);
if ATileData.Height > 0 then
Inc(FPriorityBonus); Inc(FPriorityBonus);
FPriority := Z + FPriorityBonus; FPriority := Z + FPriorityBonus;
FPrioritySolver := ASolver; FPrioritySolver := ASolver;

155
UOLib/UWorldItem.pas
View File

@ -40,33 +40,30 @@ type
TWorldItem = class(TMulBlock) TWorldItem = class(TMulBlock)
constructor Create(AOwner: TWorldBlock); constructor Create(AOwner: TWorldBlock);
protected protected
FOwner, FOrgOwner: TWorldBlock; FOwner: TWorldBlock;
FTileID, FOrgTileID: Word; FTileID: Word;
FX, FOrgX: Word; FX: Word;
FY, FOrgY: Word; FY: Word;
FZ, FOrgZ: ShortInt; FZ: ShortInt;
FSelected: Boolean; FSelected: Boolean;
FCanBeEdited: Boolean; FCanBeEdited: Boolean;
FLocked: Boolean; FLocked: Boolean;
FChanged: Boolean;
FPriority: Integer; FPriority: Integer;
FPriorityBonus: ShortInt; FPriorityBonus: ShortInt;
FPrioritySolver: Integer; FPrioritySolver: Integer;
procedure DoChanged;
function GetTileID: Word; virtual; function GetTileID: Word; virtual;
function GetZ: ShortInt; virtual; function GetZ: ShortInt; virtual;
procedure SetTileID(ATileID: Word);
procedure SetX(AX: Word);
procedure SetY(AY: Word);
procedure SetZ(AZ: ShortInt);
procedure SetSelected(ASelected: Boolean);
procedure SetOwner(AOwner: TWorldBlock);
procedure SetLocked(ALocked: Boolean); procedure SetLocked(ALocked: Boolean);
procedure DoChanged; procedure SetOwner(AOwner: TWorldBlock);
function HasChanged: Boolean; virtual; procedure SetSelected(ASelected: Boolean);
procedure SetTileID(AValue: Word);
procedure SetX(AValue: Word);
procedure SetY(AValue: Word);
procedure SetZ(AValue: ShortInt);
public public
procedure UpdatePos(AX, AY: Word; AZ: ShortInt); procedure UpdatePos(AX, AY: Word; AZ: ShortInt);
procedure Delete; procedure Delete;
procedure InitOriginalState; virtual;
property Owner: TWorldBlock read FOwner write SetOwner; property Owner: TWorldBlock read FOwner write SetOwner;
property TileID: Word read GetTileID write SetTileID; property TileID: Word read GetTileID write SetTileID;
@ -76,7 +73,6 @@ type
property Selected: Boolean read FSelected write SetSelected; property Selected: Boolean read FSelected write SetSelected;
property CanBeEdited: Boolean read FCanBeEdited write FCanBeEdited; property CanBeEdited: Boolean read FCanBeEdited write FCanBeEdited;
property Locked: Boolean read FLocked write SetLocked; property Locked: Boolean read FLocked write SetLocked;
property Changed: Boolean read FChanged;
property Priority: Integer read FPriority write FPriority; property Priority: Integer read FPriority write FPriority;
property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus; property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus;
property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver; property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver;
@ -95,18 +91,14 @@ type
FX: Word; FX: Word;
FY: Word; FY: Word;
FRefCount: Integer; FRefCount: Integer;
FChanges: Integer; FChanged: Boolean;
function GetChanged: Boolean;
procedure SetChanged(AChanged: Boolean);
procedure DoStateChanged;
public public
property X: Word read FX write FX; property X: Word read FX write FX;
property Y: Word read FY write FY; property Y: Word read FY write FY;
property RefCount: Integer read FRefCount; property RefCount: Integer read FRefCount;
property Changed: Boolean read GetChanged write SetChanged; property Changed: Boolean read FChanged write FChanged;
procedure AddRef; procedure AddRef;
procedure RemoveRef; procedure RemoveRef;
procedure CleanUp;
end; end;
TVirtualTile = class(TWorldItem); TVirtualTile = class(TWorldItem);
@ -139,9 +131,6 @@ begin
Result := 1; Result := 1;
end; end;
if Result = 0 then
Result := AItem1.PriorityBonus - AItem2.PriorityBonus;
if Result = 0 then if Result = 0 then
Result := AItem1.PrioritySolver - AItem2.PrioritySolver; Result := AItem1.PrioritySolver - AItem2.PrioritySolver;
end; end;
@ -153,10 +142,15 @@ begin
inherited Create; inherited Create;
FSelected := False; FSelected := False;
FLocked := False; FLocked := False;
FChanged := False;
FOwner := AOwner; FOwner := AOwner;
end; end;
procedure TWorldItem.DoChanged;
begin
if FOwner <> nil then
FOwner.Changed := True;
end;
function TWorldItem.GetTileID: Word; function TWorldItem.GetTileID: Word;
begin begin
Result := FTileID; Result := FTileID;
@ -171,44 +165,6 @@ procedure TWorldItem.Delete;
begin begin
SetSelected(False); SetSelected(False);
SetLocked(False); SetLocked(False);
if (FOwner <> FOrgOwner) then
FOwner.Changed := False
else if Assigned(FOrgOwner) and (not FChanged) then
FOrgOwner.Changed := True;
end;
procedure TWorldItem.DoChanged;
var
blockChanged: Boolean;
begin
blockChanged := HasChanged;
if Assigned(FOwner) then
begin
if FChanged and (not blockChanged) then
FOwner.Changed := False
else if (not FChanged) and blockChanged then
FOwner.Changed := True;
end;
FChanged := blockChanged;
if Assigned(FOnChanged) then
FOnChanged(Self);
end;
function TWorldItem.HasChanged: Boolean;
begin
Result := (FX <> FOrgX) or (FY <> FOrgY) or (FZ <> FOrgZ) or
(FTileID <> FOrgTileID) or (FOrgOwner <> FOwner);
end;
procedure TWorldItem.InitOriginalState;
begin
{if Assigned(FOrgOwner) and (FOwner <> FOrgOwner) then
FOrgOwner.Changed := False;}
FOrgOwner := FOwner;
FOrgTileID := FTileID;
FOrgX := FX;
FOrgY := FY;
FOrgZ := FZ;
DoChanged; DoChanged;
end; end;
@ -217,7 +173,7 @@ begin
if FLocked <> ALocked then if FLocked <> ALocked then
begin begin
FLocked := ALocked; FLocked := ALocked;
if Assigned(FOwner) then if FOwner <> nil then
if FLocked then if FLocked then
FOwner.AddRef FOwner.AddRef
else else
@ -229,22 +185,19 @@ procedure TWorldItem.SetOwner(AOwner: TWorldBlock);
begin begin
if FOwner <> AOwner then if FOwner <> AOwner then
begin begin
if Assigned(FOwner) then if FOwner <> nil then
begin begin
if FOwner <> FOrgOwner then FOwner.Changed := True;
FOwner.Changed := False;
if FLocked then FOwner.RemoveRef; if FLocked then FOwner.RemoveRef;
if FSelected then FOwner.RemoveRef; if FSelected then FOwner.RemoveRef;
end; end;
FOwner := AOwner; FOwner := AOwner;
if Assigned(FOwner) then if FOwner <> nil then
begin begin
if FOwner <> FOrgOwner then
FOwner.Changed := True; FOwner.Changed := True;
if FLocked then FOwner.AddRef; if FLocked then FOwner.AddRef;
if FSelected then FOwner.AddRef; if FSelected then FOwner.AddRef;
end; end;
DoChanged;
end; end;
end; end;
@ -258,27 +211,39 @@ begin
FSelected := ASelected; FSelected := ASelected;
end; end;
procedure TWorldItem.SetTileID(ATileID: Word); procedure TWorldItem.SetTileID(AValue: Word);
begin begin
FTileID := ATileID; if FTileID = AValue then
Exit;
FTileID := AValue;
DoChanged; DoChanged;
end; end;
procedure TWorldItem.SetX(AX: Word); procedure TWorldItem.SetX(AValue: Word);
begin begin
FX := AX; if FX = AValue then
Exit;
FX := AValue;
DoChanged; DoChanged;
end; end;
procedure TWorldItem.SetY(AY: Word); procedure TWorldItem.SetY(AValue: Word);
begin begin
FY := AY; if FY = AValue then
DoChanged Exit;
FY := AValue;
DoChanged;
end; end;
procedure TWorldItem.SetZ(AZ: ShortInt); procedure TWorldItem.SetZ(AValue: ShortInt);
begin begin
FZ := AZ; if FZ = AValue then
Exit;
FZ := AValue;
DoChanged; DoChanged;
end; end;
@ -295,47 +260,19 @@ end;
procedure TWorldBlock.AddRef; procedure TWorldBlock.AddRef;
begin begin
Inc(FRefCount); Inc(FRefCount);
DoStateChanged;
end;
procedure TWorldBlock.CleanUp;
begin
FChanges := 0;
DoStateChanged;
end; end;
constructor TWorldBlock.Create; constructor TWorldBlock.Create;
begin begin
inherited Create; inherited Create;
FRefCount := 0; FRefCount := 0;
FChanges := 0; FChanged := False;
end;
procedure TWorldBlock.DoStateChanged;
begin
if Assigned(FOnChanged) then
FOnChanged(Self);
end;
function TWorldBlock.GetChanged: Boolean;
begin
Result := (FChanges <> 0);
end; end;
procedure TWorldBlock.RemoveRef; procedure TWorldBlock.RemoveRef;
begin begin
if FRefCount > 0 then if FRefCount > 0 then
Dec(FRefCount); Dec(FRefCount);
DoStateChanged;
end;
procedure TWorldBlock.SetChanged(AChanged: Boolean);
begin
if AChanged then
Inc(FChanges)
else
Dec(FChanges);
DoStateChanged;
end; end;
end. end.