From 2f560a773846d8605d3a175b545e91e55d50039d Mon Sep 17 00:00:00 2001 From: Andreas Schneider Date: Fri, 15 May 2009 23:37:10 +0200 Subject: [PATCH] - Changed rendering to build the draw list for the whole range - Added CanBeEdited flag to TWorldItem - Changed list sorting from custom heap sort implementation to the FCL standard (QuickSort) --- Client/CentrED.lpi | 4 +- Client/ULandscape.pas | 208 ++++++------- Client/UfrmMain.lfm | 119 ++++---- Client/UfrmMain.pas | 376 +++++++++++------------ Client/UfrmRegionControl.lfm | 18 +- UOLib/UWorldItem.pas | 566 ++++++++++++++++++----------------- 6 files changed, 627 insertions(+), 664 deletions(-) diff --git a/Client/CentrED.lpi b/Client/CentrED.lpi index 0b95017..179f683 100644 --- a/Client/CentrED.lpi +++ b/Client/CentrED.lpi @@ -253,10 +253,8 @@ - - + - diff --git a/Client/ULandscape.pas b/Client/ULandscape.pas index 66165da..15ed362 100644 --- a/Client/ULandscape.pas +++ b/Client/ULandscape.pas @@ -21,7 +21,7 @@ * CDDL HEADER END * * - * Portions Copyright 2007 Andreas Schneider + * Portions Copyright 2009 Andreas Schneider *) unit ULandscape; @@ -103,6 +103,7 @@ type constructor Create(AWidth, AHeight: Word); destructor Destroy; override; protected + { Members } FWidth: Word; FHeight: Word; FCellWidth: Word; @@ -110,7 +111,7 @@ type FBlockCache: TCacheManager; FOnChange: TLandscapeChangeEvent; FOpenRequests: array of Boolean; - function Compare(left, right: TObject): Integer; + { Methods } function GetNormals(AX, AY: Word): TNormals; function GetMapCell(AX, AY: Word): TMapCell; function GetStaticList(AX, AY: Word): TList; @@ -118,7 +119,6 @@ type function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock; procedure UpdateStaticsPriority(AStaticItem: TStaticItem; APrioritySolver: Integer); - procedure OnBlockChanged(ABlock: TMulBlock); procedure OnRemoveCachedObject(AObject: TObject); procedure OnBlocksPacket(ABuffer: TEnhancedMemoryStream); @@ -129,6 +129,7 @@ type procedure OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream); procedure OnHueStaticPacket(ABuffer: TEnhancedMemoryStream); public + { Fields } property Width: Word read FWidth; property Height: Word read FHeight; property CellWidth: Word read FCellWidth; @@ -137,10 +138,11 @@ type property StaticList[X, Y: Word]: TList read GetStaticList; property Normals[X, Y: Word]: TNormals read GetNormals; property OnChange: TLandscapeChangeEvent read FOnChange write FOnChange; - - function GetDrawList(AX, AY: Word; AMinZ, AMaxZ: ShortInt; + { 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); function GetEffectiveAltitude(ATile: TMapCell): ShortInt; function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt; @@ -204,15 +206,6 @@ begin Result := ((AX and $7FFF) shl 15) or (AY and $7FFF); end; -{operator=(AStaticItem: TStaticItem; AStaticInfo: TStaticInfo): Boolean; -begin - Result := (AStaticItem.X = AStaticInfo.X) and - (AStaticItem.Y = AStaticInfo.Y) and - (AStaticItem.Z = AStaticInfo.Z) and - (AStaticItem.TileID = AStaticInfo.TileID) and - (AStaticItem.Hue = AStaticInfo.Hue); -end;} - { TLandTextureManager } constructor TLandTextureManager.Create; @@ -410,88 +403,113 @@ begin end; end; -function TLandscape.Compare(left, right: TObject): Integer; +function Compare(AItem1, AItem2: Pointer): Integer; begin - Result := TWorldItem(right).Priority - TWorldItem(left).Priority; + 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 (left is TMapCell) and (right is TStaticItem) then - Result := 1 - else if (left is TStaticItem) and (right is TMapCell) then - Result := -1; + 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(right).PriorityBonus - TWorldItem(left).PriorityBonus; + Result := TWorldItem(AItem1).PriorityBonus - TWorldItem(AItem2).PriorityBonus; if Result = 0 then - Result := TWorldItem(right).PrioritySolver - TWorldItem(left).PrioritySolver; + Result := TWorldItem(AItem1).PrioritySolver - TWorldItem(AItem2).PrioritySolver; end; -function TLandscape.GetDrawList(AX, AY: Word; AMinZ, AMaxZ: ShortInt; - AGhostTile: TWorldItem; AVirtualLayer: TStaticItem; AMap, - AStatics: Boolean; ANoDraw:Boolean; AStaticsFilter: TStaticFilter): TList; +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: Integer; + i, x, y: Integer; begin Result := TList.Create; - if AMap then - begin - landAlt := GetLandAlt(AX, AY, 0); - if (landAlt >= AMinZ) and (landAlt <= AMaxZ) then + for x := AX to AX + AWidth do + for y := AY to AY + AWidth do begin - drawMapCell := GetMapCell(AX, AY); - if (drawMapCell <> nil) and (ANoDraw or (drawMapCell.TileID > 2)) then + if AMap then begin - drawMapCell.Priority := GetEffectiveAltitude(drawMapCell); - drawMapCell.PriorityBonus := 0; - drawMapCell.PrioritySolver := 0; - Result.Add(drawMapCell); - end; - - if AGhostTile is TMapCell then - begin - AGhostTile.X := AX; - AGhostTile.Y := AY; - AGhostTile.Priority := GetEffectiveAltitude(TMapCell(AGhostTile)); - AGhostTile.PriorityBonus := 0; - AGhostTile.PrioritySolver := 0; - Result.Add(AGhostTile); - end; - end; - end; - - if AStatics then - begin - drawStatics := GetStaticList(AX, AY); - 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 + landAlt := GetLandAlt(x, y, 0); + if (landAlt >= AMinZ) and (landAlt <= AMaxZ) then begin - UpdateStaticsPriority(TStaticItem(drawStatics[i]), i + 1); - Result.Add(Pointer(drawStatics[i])); - end; - + 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 TStaticItem then - begin - UpdateStaticsPriority(TStaticItem(AGhostTile), MaxInt); - Result.Add(AGhostTile); + 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; - end; - - if AVirtualLayer <> nil then + + 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 - UpdateStaticsPriority(AVirtualLayer, MaxInt-1); - Result.Add(AVirtualLayer); + worldItem := TWorldItem(AList.Items[i]); + worldItem.CanBeEdited := dmNetwork.CanWrite(worldItem.X, worldItem.Y); end; - - ListSort(Result, @Compare); end; function TLandscape.GetEffectiveAltitude(ATile: TMapCell): ShortInt; @@ -591,37 +609,6 @@ begin Result[3] := VectorNorm(VectorAdd(VectorAdd(VectorAdd(north, west), east), south)); end; -procedure TLandscape.OnBlockChanged(ABlock: TMulBlock); -var - block, old: TWorldBlock; - mode: Byte; - id, blockID: Integer; -begin - {block := ABlock as TWorldBlock; - if block <> nil then - begin - if block is TSeperatedStaticBlock then - mode := mStatics - else - mode := mMap; - id := GetID(block.X, block.Y, mode); - blockID := (block.X * FHeight) + block.Y; - if block.Changed or (block.RefCount > 0) then - begin - if FPersistentBlocks[blockID][mode] = nil then - begin - FPersistentBlocks[blockID][mode] := block; - FBlockCache.DiscardID(id); - end; - end else - begin - FPersistentBlocks[blockID][mode] := nil; - if not FBlockCache.QueryID(id, TObject(old)) then - FBlockCache.StoreID(id, block); - end; - end;} -end; - procedure TLandscape.MoveStatic(AStatic: TStaticItem; AX, AY: Word); var sourceBlock, targetBlock: TSeperatedStaticBlock; @@ -639,7 +626,8 @@ begin targetStaticList.Add(AStatic); for i := 0 to targetStaticList.Count - 1 do UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i); - ListSort(targetStaticList, @Compare); + targetStaticList.Sort(@Compare); + //ListSort(targetStaticList, @Compare); AStatic.UpdatePos(AX, AY, AStatic.Z); AStatic.Owner := targetBlock; end; @@ -788,7 +776,8 @@ begin targetStaticList.Add(staticItem); for i := 0 to targetStaticList.Count - 1 do UpdateStaticsPriority(TStaticItem(targetStaticList.Items[i]), i); - ListSort(targetStaticList, @Compare); + targetStaticList.Sort(@Compare); + //ListSort(targetStaticList, @Compare); staticItem.Owner := block; if Assigned(FOnChange) then FOnChange; end; @@ -846,7 +835,8 @@ begin staticItem.Z := ABuffer.ReadShortInt; for j := 0 to statics.Count - 1 do UpdateStaticsPriority(TStaticItem(statics.Items[j]), j); - ListSort(statics, @Compare); + statics.Sort(@Compare); + //ListSort(statics, @Compare); if Assigned(FOnChange) then FOnChange; Break; end; @@ -906,7 +896,8 @@ begin statics.Add(staticItem); for i := 0 to statics.Count - 1 do UpdateStaticsPriority(TStaticItem(statics.Items[i]), i); - ListSort(statics, @Compare); + statics.Sort(@Compare); + //ListSort(statics, @Compare); staticItem.Owner := targetBlock; end; @@ -987,7 +978,6 @@ var pixel: TColor32Rec; begin Result := False; - //writeln(FGraphic.Width, ',', FGraphic.Height, ',', AX, ',', AY); if InRange(AX, 0, FGraphic.Width - 1) and InRange(AY, 0, FGraphic.Height - 1) then begin diff --git a/Client/UfrmMain.lfm b/Client/UfrmMain.lfm index 56c9b40..6253d41 100644 --- a/Client/UfrmMain.lfm +++ b/Client/UfrmMain.lfm @@ -1,7 +1,7 @@ object frmMain: TfrmMain - Left = 247 + Left = 236 Height = 603 - Top = 91 + Top = 126 Width = 766 ActiveControl = pcLeft Caption = 'UO CentrED' @@ -41,7 +41,7 @@ object frmMain: TfrmMain Left = 88 Height = 14 Top = 7 - Width = 11 + Width = 10 Caption = 'Y:' ParentColor = False end @@ -54,10 +54,10 @@ object frmMain: TfrmMain ParentColor = False end object lblTip: TLabel - Left = 554 + Left = 528 Height = 31 Top = 0 - Width = 204 + Width = 230 Align = alRight Alignment = taRightJustify BorderSpacing.Right = 8 @@ -66,10 +66,10 @@ object frmMain: TfrmMain ParentColor = False end object lblTipC: TLabel - Left = 530 + Left = 498 Height = 31 Top = 0 - Width = 24 + Width = 30 Align = alRight Caption = 'Tip: ' Font.Height = -11 @@ -80,7 +80,7 @@ object frmMain: TfrmMain end object edX: TSpinEdit Left = 24 - Height = 23 + Height = 19 Top = 3 Width = 55 MaxValue = 100000 @@ -88,7 +88,7 @@ object frmMain: TfrmMain end object edY: TSpinEdit Left = 104 - Height = 23 + Height = 19 Top = 3 Width = 52 MaxValue = 100000 @@ -116,31 +116,31 @@ object frmMain: TfrmMain TabOrder = 1 object tsTiles: TTabSheet Caption = 'Tiles' - ClientHeight = 492 - ClientWidth = 218 + ClientHeight = 500 + ClientWidth = 222 object pnlTileListSettings: TPanel Left = 0 Height = 56 Top = 0 - Width = 218 + Width = 222 Align = alTop BevelOuter = bvNone ClientHeight = 56 - ClientWidth = 218 + ClientWidth = 222 TabOrder = 0 object lblFilter: TLabel Left = 84 Height = 14 Top = 8 - Width = 29 + Width = 30 Caption = 'Filter:' ParentColor = False end object cbTerrain: TCheckBox Left = 4 - Height = 22 + Height = 18 Top = 8 - Width = 60 + Width = 57 Caption = 'Terrain' Checked = True OnChange = cbTerrainChange @@ -149,9 +149,9 @@ object frmMain: TfrmMain end object cbStatics: TCheckBox Left = 4 - Height = 22 + Height = 18 Top = 32 - Width = 60 + Width = 56 Caption = 'Statics' Checked = True OnChange = cbStaticsChange @@ -160,7 +160,7 @@ object frmMain: TfrmMain end object edFilter: TEdit Left = 84 - Height = 23 + Height = 19 Top = 24 Width = 112 OnEditingDone = edFilterEditingDone @@ -170,9 +170,9 @@ object frmMain: TfrmMain object vdtTiles: TVirtualDrawTree Tag = 1 Left = 0 - Height = 238 + Height = 246 Top = 56 - Width = 218 + Width = 222 Align = alClient DefaultNodeHeight = 44 DragMode = dmAutomatic @@ -193,6 +193,7 @@ object frmMain: TfrmMain Text = 'Name' Width = 100 end> + Header.DefaultHeight = 17 Header.MainColumn = 2 Header.Options = [hoVisible] Header.ParentFont = True @@ -215,12 +216,12 @@ object frmMain: TfrmMain object gbRandom: TGroupBox Left = 0 Height = 193 - Top = 299 - Width = 218 + Top = 307 + Width = 222 Align = alBottom Caption = 'Random pool' ClientHeight = 179 - ClientWidth = 216 + ClientWidth = 220 TabOrder = 2 object vdtRandom: TVirtualDrawTree Tag = 1 @@ -228,7 +229,7 @@ object frmMain: TfrmMain Left = 0 Height = 127 Top = 22 - Width = 216 + Width = 220 Align = alClient DefaultNodeHeight = 44 DragType = dtVCL @@ -248,6 +249,7 @@ object frmMain: TfrmMain Text = 'Name' Width = 100 end> + Header.DefaultHeight = 17 Header.Options = [hoColumnResize, hoDrag, hoVisible] Header.ParentFont = True Header.Style = hsFlatButtons @@ -265,11 +267,11 @@ object frmMain: TfrmMain Left = 0 Height = 22 Top = 0 - Width = 216 + Width = 220 Align = alTop BevelOuter = bvNone ClientHeight = 22 - ClientWidth = 216 + ClientWidth = 220 TabOrder = 1 object btnAddRandom: TSpeedButton Left = 2 @@ -420,12 +422,12 @@ object frmMain: TfrmMain Left = 4 Height = 22 Top = 153 - Width = 208 + Width = 212 Align = alBottom BorderSpacing.Around = 4 BevelOuter = bvNone ClientHeight = 22 - ClientWidth = 208 + ClientWidth = 212 TabOrder = 2 object btnRandomPresetSave: TSpeedButton Left = 158 @@ -527,7 +529,7 @@ object frmMain: TfrmMain end object cbRandomPreset: TComboBox Left = 0 - Height = 29 + Height = 25 Top = 0 Width = 152 AutoComplete = False @@ -543,14 +545,14 @@ object frmMain: TfrmMain Cursor = crVSplit Left = 0 Height = 5 - Top = 294 - Width = 218 + Top = 302 + Width = 222 Align = alBottom ResizeAnchor = akBottom end object edSearchID: TEdit Left = 118 - Height = 23 + Height = 19 Hint = 'Append S or T to restrict the search to Statics or Terrain.' Top = 256 Width = 96 @@ -565,13 +567,13 @@ object frmMain: TfrmMain end object tsClients: TTabSheet Caption = 'Clients' - ClientHeight = 492 - ClientWidth = 218 + ClientHeight = 500 + ClientWidth = 222 object lbClients: TListBox Left = 0 - Height = 492 + Height = 500 Top = 0 - Width = 218 + Width = 222 Align = alClient ItemHeight = 0 OnDblClick = mnuGoToClientClick @@ -583,14 +585,14 @@ object frmMain: TfrmMain end object tsLocations: TTabSheet Caption = 'Locations' - ClientHeight = 492 - ClientWidth = 218 + ClientHeight = 500 + ClientWidth = 222 object vstLocations: TVirtualStringTree Cursor = 63 Left = 4 - Height = 456 + Height = 464 Top = 4 - Width = 210 + Width = 214 Align = alClient BorderSpacing.Around = 4 BorderStyle = bsSingle @@ -607,6 +609,7 @@ object frmMain: TfrmMain Text = 'Name' Width = 135 end> + Header.DefaultHeight = 17 Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] Header.ParentFont = True Header.Style = hsFlatButtons @@ -624,13 +627,13 @@ object frmMain: TfrmMain object pnlLocationControls: TPanel Left = 4 Height = 24 - Top = 464 - Width = 210 + Top = 472 + Width = 214 Align = alBottom BorderSpacing.Around = 4 BevelOuter = bvNone ClientHeight = 24 - ClientWidth = 210 + ClientWidth = 214 TabOrder = 1 object btnClearLocations: TSpeedButton Left = 112 @@ -1010,7 +1013,7 @@ object frmMain: TfrmMain object vstChat: TVirtualStringTree Cursor = 63 Left = 0 - Height = 99 + Height = 103 Top = 0 Width = 542 Align = alClient @@ -1032,6 +1035,7 @@ object frmMain: TfrmMain Text = 'Message' Width = 392 end> + Header.DefaultHeight = 17 Header.MainColumn = 2 Header.Options = [hoAutoResize, hoColumnResize, hoDrag, hoVisible] Header.ParentFont = True @@ -1047,8 +1051,8 @@ object frmMain: TfrmMain end object edChat: TEdit Left = 0 - Height = 23 - Top = 99 + Height = 19 + Top = 103 Width = 542 Align = alBottom OnKeyPress = edChatKeyPress @@ -1343,7 +1347,6 @@ object frmMain: TfrmMain end end object ImageList1: TImageList - Masked = False left = 264 top = 32 Bitmap = { @@ -1991,7 +1994,7 @@ object frmMain: TfrmMain } end object pmTileList: TPopupMenu - left = 184 + left = 185 top = 128 object mnuAddToRandom: TMenuItem Caption = 'Add to random pool' @@ -1999,13 +2002,6 @@ object frmMain: TfrmMain end end object ApplicationProperties1: TApplicationProperties - CaptureExceptions = True - HintColor = clInfoBk - HintHidePause = 2500 - HintPause = 500 - HintShortCuts = True - HintShortPause = 0 - ShowHint = True OnIdle = ApplicationProperties1Idle left = 295 top = 33 @@ -2375,7 +2371,6 @@ object frmMain: TfrmMain Category = 'Tools' Caption = 'Select' Checked = True - DisableIfNoHandler = True GroupIndex = 1 Hint = 'Select' ImageIndex = 4 @@ -2385,7 +2380,6 @@ object frmMain: TfrmMain object acDraw: TAction Category = 'Tools' Caption = 'Draw tiles' - DisableIfNoHandler = True GroupIndex = 1 Hint = 'Draw tiles' ImageIndex = 5 @@ -2395,7 +2389,6 @@ object frmMain: TfrmMain object acMove: TAction Category = 'Tools' Caption = 'Move tiles' - DisableIfNoHandler = True GroupIndex = 1 Hint = 'Move tiles' ImageIndex = 6 @@ -2405,7 +2398,6 @@ object frmMain: TfrmMain object acElevate: TAction Category = 'Tools' Caption = 'Elevate tiles' - DisableIfNoHandler = True GroupIndex = 1 Hint = 'Elevate tiles' ImageIndex = 7 @@ -2415,7 +2407,6 @@ object frmMain: TfrmMain object acDelete: TAction Category = 'Tools' Caption = 'Delete tiles' - DisableIfNoHandler = True GroupIndex = 1 Hint = 'Delete tiles' ImageIndex = 8 @@ -2425,7 +2416,6 @@ object frmMain: TfrmMain object acHue: TAction Category = 'Tools' Caption = 'Hue tiles' - DisableIfNoHandler = True GroupIndex = 1 Hint = 'Hue tiles' ImageIndex = 12 @@ -2435,7 +2425,6 @@ object frmMain: TfrmMain object acBoundaries: TAction Category = 'Settings' Caption = 'Boundaries' - DisableIfNoHandler = True Hint = 'Boundaries' ImageIndex = 9 OnExecute = acBoundariesExecute @@ -2445,7 +2434,6 @@ object frmMain: TfrmMain Category = 'Settings' AutoCheck = True Caption = 'Filter' - DisableIfNoHandler = True Hint = 'Filter' ImageIndex = 16 OnExecute = acFilterExecute @@ -2453,7 +2441,6 @@ object frmMain: TfrmMain object acVirtualLayer: TAction Category = 'Settings' Caption = 'Virtual Layer' - DisableIfNoHandler = True Hint = 'Virtual Layer' ImageIndex = 15 OnExecute = acVirtualLayerExecute @@ -2462,7 +2449,6 @@ object frmMain: TfrmMain object acFlat: TAction Category = 'Settings' Caption = 'Flat view' - DisableIfNoHandler = True Hint = 'Flat view' ImageIndex = 17 OnExecute = acFlatExecute @@ -2471,7 +2457,6 @@ object frmMain: TfrmMain Category = 'Settings' Caption = 'NoDraw' Checked = True - DisableIfNoHandler = True Hint = 'Display "No Draw" tiles' ImageIndex = 18 OnExecute = acNoDrawExecute diff --git a/Client/UfrmMain.pas b/Client/UfrmMain.pas index 6b2fac1..9f252bf 100644 --- a/Client/UfrmMain.pas +++ b/Client/UfrmMain.pas @@ -21,7 +21,7 @@ * CDDL HEADER END * * - * Portions Copyright 2008 Andreas Schneider + * Portions Copyright 2009 Andreas Schneider *) unit UfrmMain; @@ -1624,7 +1624,6 @@ end; procedure TfrmMain.Render; var drawDistance: Integer; - offsetX, offsetY: Integer; lowOffX, lowOffY, highOffX, highOffY: Integer; z: ShortInt; mat: TMaterial; @@ -1645,6 +1644,7 @@ var staticsFilter: TStaticFilter; editing: Boolean; intensity: GLfloat; + item: TWorldItem; procedure GetMapDrawOffset(x, y: Integer; out drawX, drawY: Single); begin @@ -1670,223 +1670,209 @@ begin rangeX := highOffX - lowOffX; rangeY := highOffY - lowOffY; - if acFilter.Checked then + {if acFilter.Checked then staticsFilter := @frmFilter.Filter else - staticsFilter := nil; - - for j := 0 to rangeX + rangeY - 2 do + staticsFilter := nil;} //TODO : update list on change + + 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! + + for i := 0 to draw.Count - 1 do begin - if j > rangeY then + item := TWorldItem(draw[i]); + + GetMapDrawOffset(item.X - FX, item.Y - FY, drawX, drawY); + + singleTarget := (CurrentTile <> nil) and + (item.X = CurrentTile.X) and + (item.Y = CurrentTile.Y); + multiTarget := (CurrentTile <> nil) and + (SelectedTile <> nil) and + (CurrentTile <> SelectedTile) and + PtInRect(tileRect, Point(item.X, item.Y)); + + if acSelect.Checked or item.CanBeEdited then begin - startOffX := j - rangeY + 1; - endOffX := rangeX; + editing := True; + intensity := 1.0; + SetNormalLights; end else begin - startOffX := 0; - endOffX := j; + editing := False; + intensity := 0.5; + SetDarkLights; end; - for k := startOffX to endOffX do + + {if editing and acDraw.Checked and (singleTarget or multiTarget) then begin - offsetY := j - k + lowOffY; - offsetX := k + lowOffX; - GetMapDrawOffset(offsetX, offsetY, drawX, drawY); + ghostTile := FGhostTile; + if (ghostTile is TMapCell) and (not frmDrawSettings.cbForceAltitude.Checked) then + ghostTile.Z := FLandscape.MapCell[item.X, item.Y].Z; + end else + ghostTile := nil;} //TODO : re add Ghost Tile - singleTarget := (CurrentTile <> nil) and - (FX + offsetX = CurrentTile.X) and - (FY + offsetY = CurrentTile.Y); - multiTarget := (CurrentTile <> nil) and - (SelectedTile <> nil) and - (CurrentTile <> SelectedTile) and - PtInRect(tileRect, Point(FX + offsetX, FY + offsetY)); + {if frmVirtualLayer.cbShowLayer.Checked then + begin + virtualTile := FVirtualLayer[k, j - k]; + virtualTile.X := FX + offsetX; + virtualTile.Y := FY + offsetY; + virtualTile.Z := frmVirtualLayer.seZ.Value; + end else + virtualTile := nil;} - if acSelect.Checked or dmNetwork.CanWrite(FX + offsetX, FY + offsetY) then + if not editing then + highlight := False + {else if item = virtualTile then + highlight := False} //todo virtual tile + else if acDelete.Checked and multiTarget and (item is TStaticItem) then + highlight := True + else if ((acElevate.Checked) or (acMove.Checked)) and multiTarget then + highlight := True + else if (acHue.Checked and multiTarget and (item is TMapCell)) then + highlight := True + else + highlight := (not acSelect.Checked) and + (not acHue.Checked) and + (item = CurrentTile) or + ((item is TMapCell) and (item = ghostTile)); + + if highlight then + begin + glEnable(GL_COLOR_LOGIC_OP); + glLogicOp(GL_COPY_INVERTED); + end; + + if acFlat.Checked then + z := 0 + else + z := item.Z; + + glColor4f(intensity, intensity, intensity, 1.0); + + {if TObject(draw[i]) = virtualTile then + begin + glBindTexture(GL_TEXTURE_2D, FVLayerMaterial.Texture); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2d(drawX - 22, drawY - z * 4); + glTexCoord2f(1, 0); glVertex2d(drawX - 22 + FVLayerMaterial.Width, drawY - z * 4); + glTexCoord2f(1, 1); glVertex2d(drawX - 22 + FVLayerMaterial.Width, drawY + FVLayerMaterial.Height - z * 4); + glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + FVLayerMaterial.Height - z * 4); + glEnd; + + FScreenBuffer.Store(Bounds(Trunc(drawX - 22), Trunc(drawY - z * 4), 44, 44), virtualTile, FVLayerMaterial); + end else} if item is TMapCell then //TODO : virtual tile! + begin + cell := TMapCell(item); + + {if ResMan.Tiledata.LandTiles[cell.TileID].HasFlag(tdfTranslucent) then + glColor4f(intensity, intensity, intensity, 0.5);} //Possible, but probably not like the OSI client + + mat := nil; + + if not acFlat.Checked then begin - editing := True; - intensity := 1.0; - SetNormalLights; - end else - begin - editing := False; - intensity := 0.5; - SetDarkLights; + west := FLandscape.GetLandAlt(item.X, item.Y + 1, z); + south := FLandscape.GetLandAlt(item.X + 1, item.Y + 1, z); + east := FLandscape.GetLandAlt(item.X + 1, item.Y, z); + + if (west <> z) or (south <> z) or (east <> z) then + begin + mat := FTextureManager.GetTexMaterial(cell.TileID); + end; end; - if editing and acDraw.Checked and (singleTarget or multiTarget) then + if mat = nil then begin - ghostTile := FGhostTile; - if (ghostTile is TMapCell) and (not frmDrawSettings.cbForceAltitude.Checked) then - ghostTile.Z := FLandscape.MapCell[FX + offsetX, FY + offsetY].Z; - end else - ghostTile := nil; - - if frmVirtualLayer.cbShowLayer.Checked then - begin - virtualTile := FVirtualLayer[k, j - k]; - virtualTile.X := FX + offsetX; - virtualTile.Y := FY + offsetY; - virtualTile.Z := frmVirtualLayer.seZ.Value; - end else - virtualTile := nil; - - draw := FLandscape.GetDrawList(FX + offsetX, FY + offsetY, - frmBoundaries.tbMinZ.Position, frmBoundaries.tbMaxZ.Position, - ghostTile, virtualTile, tbTerrain.Down, tbStatics.Down, - acNoDraw.Checked, staticsFilter); - - for i := 0 to draw.Count - 1 do - begin - if not editing then - highlight := False - else if TObject(draw[i]) = virtualTile then - highlight := False - else if acDelete.Checked and multiTarget and (TObject(draw[i]) is TStaticItem) then - highlight := True - else if ((acElevate.Checked) or (acMove.Checked)) and multiTarget then - highlight := True - else if (acHue.Checked and multiTarget and (TObject(draw[i]) is TMapCell)) then - highlight := True - else - highlight := (not acSelect.Checked) and - (not acHue.Checked) and - ((TObject(draw[i]) = CurrentTile) or - ((TObject(draw[i]) is TMapCell) and (TObject(draw[i]) = ghostTile))); - - if highlight then + mat := FTextureManager.GetArtMaterial(cell.TileID); + if (not (ghostTile is TMapCell)) or + (item = ghostTile) then //when we have a ghosttile, only draw that, but still store the real one begin - glEnable(GL_COLOR_LOGIC_OP); - glLogicOp(GL_COPY_INVERTED); - end; - - if acFlat.Checked then - z := 0 - else - z := TWorldItem(draw[i]).Z; - - glColor4f(intensity, intensity, intensity, 1.0); - - if TObject(draw[i]) = virtualTile then - begin - glBindTexture(GL_TEXTURE_2D, FVLayerMaterial.Texture); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2d(drawX - 22, drawY - z * 4); - glTexCoord2f(1, 0); glVertex2d(drawX - 22 + FVLayerMaterial.Width, drawY - z * 4); - glTexCoord2f(1, 1); glVertex2d(drawX - 22 + FVLayerMaterial.Width, drawY + FVLayerMaterial.Height - z * 4); - glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + FVLayerMaterial.Height - z * 4); - glEnd; - - FScreenBuffer.Store(Bounds(Trunc(drawX - 22), Trunc(drawY - z * 4), 44, 44), virtualTile, FVLayerMaterial); - end else if TObject(draw[i]) is TMapCell then - begin - cell := TMapCell(draw[i]); - - {if ResMan.Tiledata.LandTiles[cell.TileID].HasFlag(tdfTranslucent) then - glColor4f(intensity, intensity, intensity, 0.5);} //Possible, but probably not like the OSI client - - mat := nil; - - if not acFlat.Checked then - begin - west := FLandscape.GetLandAlt(FX + offsetX, FY + offsetY + 1, z); - south := FLandscape.GetLandAlt(FX + offsetX + 1, FY + offsetY + 1, z); - east := FLandscape.GetLandAlt(FX + offsetX + 1, FY + offsetY, z); - - if (west <> z) or (south <> z) or (east <> z) then - begin - mat := FTextureManager.GetTexMaterial(cell.TileID); - end; - end; - - if mat = nil then - begin - mat := FTextureManager.GetArtMaterial(cell.TileID); - if (not (ghostTile is TMapCell)) or - (TObject(draw[i]) = ghostTile) then //when we have a ghosttile, only draw that, but still store the real one - begin - glBindTexture(GL_TEXTURE_2D, mat.Texture); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2d(drawX - 22, drawY - z * 4); - glTexCoord2f(1, 0); glVertex2d(drawX - 22 + mat.Width, drawY - z * 4); - glTexCoord2f(1, 1); glVertex2d(drawX - 22 + mat.Width, drawY + mat.Height - z * 4); - glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + mat.Height - z * 4); - glEnd; - end; - - if TObject(draw[i]) <> ghostTile then - FScreenBuffer.Store(Bounds(Trunc(drawX - 22), Trunc(drawY - z * 4), 44, 44), cell, mat); - end else // Texture found - begin - if (not (ghostTile is TMapCell)) or - (TObject(draw[i]) = ghostTile) then //when we have a ghosttile, only draw that, but still store the real one - begin - glBindTexture(GL_TEXTURE_2D, mat.Texture); - //if (not cell.Selected) and (intensity = 1.0) then - if not cell.Selected then - glEnable(GL_LIGHTING); - normals := FLandscape.Normals[offsetX, offsetY]; - glBegin(GL_TRIANGLES); - glNormal3f(normals[3].X, normals[3].Y, normals[3].Z); - glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + 22 - west * 4); - glNormal3f(normals[0].X, normals[0].Y, normals[0].Z); - glTexCoord2f(0, 0); glVertex2d(drawX, drawY - z * 4); - glNormal3f(normals[1].X, normals[1].Y, normals[1].Z); - glTexCoord2f(1, 0); glVertex2d(drawX + 22, drawY + 22 - east * 4); - glNormal3f(normals[1].X, normals[1].Y, normals[1].Z); - glTexCoord2f(1, 0); glVertex2d(drawX + 22, drawY + 22 - east * 4); - glNormal3f(normals[2].X, normals[2].Y, normals[2].Z); - glTexCoord2f(1, 1); glVertex2d(drawX, drawY + 44 - south * 4); - glNormal3f(normals[3].X, normals[3].Y, normals[3].Z); - glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + 22 - west * 4); - glEnd; - //if (not cell.Selected) and (intensity = 1.0) then - if not cell.Selected then - glDisable(GL_LIGHTING); - end; - - if TObject(draw[i]) <> ghostTile then - FScreenBuffer.Store(Rect(Trunc(drawX - 22), Trunc(drawY - z * 4), Trunc(drawX + 22), Trunc(drawY + 44 - south * 4)), cell, mat); - end; - end else if TObject(draw[i]) is TStaticItem then - begin - staticItem := TStaticItem(draw[i]); - - staticTileData := ResMan.Tiledata.StaticTiles[staticItem.TileID]; - if tbSetHue.Down and ((singleTarget and (TObject(draw[i]) = CurrentTile)) or multiTarget) then - begin - if frmHueSettings.lbHue.ItemIndex > 0 then - hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1] - else - hue := nil; - end else if staticItem.Hue > 0 then - hue := ResMan.Hue.Hues[staticItem.Hue - 1] - else - hue := nil; - - if staticTileData.HasFlag(tdfTranslucent) then - glColor4f(intensity, intensity, intensity, 0.5); - - mat := FTextureManager.GetArtMaterial($4000 + staticItem.TileID, hue, (staticTileData.Flags and tdfPartialHue) = tdfPartialHue); - south := mat.RealHeight; - east := mat.RealWidth div 2; glBindTexture(GL_TEXTURE_2D, mat.Texture); glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2d(drawX - east, drawY + 44 - south - z * 4); - glTexCoord2f(1, 0); glVertex2d(drawX - east + mat.Width, drawY + 44 - south - z * 4); - glTexCoord2f(1, 1); glVertex2d(drawX - east + mat.Width, drawY + 44 - south + mat.Height - z * 4); - glTexCoord2f(0, 1); glVertex2d(drawX - east, drawY + 44 - south + mat.Height - z * 4); + glTexCoord2f(0, 0); glVertex2d(drawX - 22, drawY - z * 4); + glTexCoord2f(1, 0); glVertex2d(drawX - 22 + mat.Width, drawY - z * 4); + glTexCoord2f(1, 1); glVertex2d(drawX - 22 + mat.Width, drawY + mat.Height - z * 4); + glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + mat.Height - z * 4); glEnd; - - if TObject(draw[i]) <> ghostTile then - FScreenBuffer.Store(Bounds(Trunc(drawX - east), Trunc(drawY + 44 - south - z * 4), mat.RealWidth, Trunc(south)), staticItem, mat); end; - if highlight then - glDisable(GL_COLOR_LOGIC_OP); + if item <> ghostTile then + FScreenBuffer.Store(Bounds(Trunc(drawX - 22), Trunc(drawY - z * 4), 44, 44), cell, mat); + end else // Texture found + begin + if (not (ghostTile is TMapCell)) or + (item = ghostTile) then //when we have a ghosttile, only draw that, but still store the real one + begin + glBindTexture(GL_TEXTURE_2D, mat.Texture); + //if (not cell.Selected) and (intensity = 1.0) then + if not cell.Selected then + glEnable(GL_LIGHTING); + normals := FLandscape.Normals[item.X, item.Y]; + glBegin(GL_TRIANGLES); + glNormal3f(normals[3].X, normals[3].Y, normals[3].Z); + glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + 22 - west * 4); + glNormal3f(normals[0].X, normals[0].Y, normals[0].Z); + glTexCoord2f(0, 0); glVertex2d(drawX, drawY - z * 4); + glNormal3f(normals[1].X, normals[1].Y, normals[1].Z); + glTexCoord2f(1, 0); glVertex2d(drawX + 22, drawY + 22 - east * 4); + glNormal3f(normals[1].X, normals[1].Y, normals[1].Z); + glTexCoord2f(1, 0); glVertex2d(drawX + 22, drawY + 22 - east * 4); + glNormal3f(normals[2].X, normals[2].Y, normals[2].Z); + glTexCoord2f(1, 1); glVertex2d(drawX, drawY + 44 - south * 4); + glNormal3f(normals[3].X, normals[3].Y, normals[3].Z); + glTexCoord2f(0, 1); glVertex2d(drawX - 22, drawY + 22 - west * 4); + glEnd; + //if (not cell.Selected) and (intensity = 1.0) then + if not cell.Selected then + glDisable(GL_LIGHTING); + end; + + if item <> ghostTile then + FScreenBuffer.Store(Rect(Trunc(drawX - 22), Trunc(drawY - z * 4), Trunc(drawX + 22), Trunc(drawY + 44 - south * 4)), cell, mat); end; - draw.Free; + end else if item is TStaticItem then + begin + staticItem := TStaticItem(item); + + staticTileData := ResMan.Tiledata.StaticTiles[staticItem.TileID]; + if tbSetHue.Down and ((singleTarget and (item = CurrentTile)) or multiTarget) then + begin + if frmHueSettings.lbHue.ItemIndex > 0 then + hue := ResMan.Hue.Hues[frmHueSettings.lbHue.ItemIndex - 1] + else + hue := nil; + end else if staticItem.Hue > 0 then + hue := ResMan.Hue.Hues[staticItem.Hue - 1] + else + hue := nil; + + if staticTileData.HasFlag(tdfTranslucent) then + glColor4f(intensity, intensity, intensity, 0.5); + + mat := FTextureManager.GetArtMaterial($4000 + staticItem.TileID, hue, (staticTileData.Flags and tdfPartialHue) = tdfPartialHue); + south := mat.RealHeight; + east := mat.RealWidth div 2; + glBindTexture(GL_TEXTURE_2D, mat.Texture); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2d(drawX - east, drawY + 44 - south - z * 4); + glTexCoord2f(1, 0); glVertex2d(drawX - east + mat.Width, drawY + 44 - south - z * 4); + glTexCoord2f(1, 1); glVertex2d(drawX - east + mat.Width, drawY + 44 - south + mat.Height - z * 4); + glTexCoord2f(0, 1); glVertex2d(drawX - east, drawY + 44 - south + mat.Height - z * 4); + glEnd; + + if TObject(draw[i]) <> ghostTile then + FScreenBuffer.Store(Bounds(Trunc(drawX - east), Trunc(drawY + 44 - south - z * 4), mat.RealWidth, Trunc(south)), staticItem, mat); end; + + if highlight then + glDisable(GL_COLOR_LOGIC_OP); end; + draw.Free; + FOverlayUI.Draw(oglGameWindow); end; diff --git a/Client/UfrmRegionControl.lfm b/Client/UfrmRegionControl.lfm index 7222ef0..5364521 100644 --- a/Client/UfrmRegionControl.lfm +++ b/Client/UfrmRegionControl.lfm @@ -48,7 +48,7 @@ object frmRegionControl: TfrmRegionControl TabOrder = 0 object lblX: TLabel Left = 4 - Height = 13 + Height = 14 Top = 32 Width = 8 Caption = 'X' @@ -57,7 +57,7 @@ object frmRegionControl: TfrmRegionControl end object lblY: TLabel Left = 4 - Height = 13 + Height = 14 Top = 60 Width = 8 Caption = 'Y' @@ -213,7 +213,7 @@ object frmRegionControl: TfrmRegionControl end object seX1: TSpinEdit Left = 20 - Height = 23 + Height = 19 Top = 29 Width = 50 Enabled = False @@ -222,7 +222,7 @@ object frmRegionControl: TfrmRegionControl end object seX2: TSpinEdit Left = 84 - Height = 23 + Height = 19 Top = 29 Width = 50 Enabled = False @@ -231,7 +231,7 @@ object frmRegionControl: TfrmRegionControl end object seY1: TSpinEdit Left = 20 - Height = 23 + Height = 19 Top = 56 Width = 50 Enabled = False @@ -240,7 +240,7 @@ object frmRegionControl: TfrmRegionControl end object seY2: TSpinEdit Left = 84 - Height = 23 + Height = 19 Top = 56 Width = 50 Enabled = False @@ -261,6 +261,7 @@ object frmRegionControl: TfrmRegionControl DefaultText = 'Node' Header.AutoSizeIndex = 0 Header.Columns = <> + Header.DefaultHeight = 17 Header.MainColumn = -1 Header.Options = [hoColumnResize, hoDrag] TabOrder = 1 @@ -304,6 +305,7 @@ object frmRegionControl: TfrmRegionControl Text = 'Regions' Width = 158 end> + Header.DefaultHeight = 17 Header.Options = [hoAutoResize, hoVisible] Header.ParentFont = True Header.Style = hsFlatButtons @@ -442,8 +444,8 @@ object frmRegionControl: TfrmRegionControl Top = 1 Width = 458 Align = alClient - ClientHeight = 378 - ClientWidth = 458 + ClientHeight = 374 + ClientWidth = 454 TabOrder = 0 object pbArea: TPaintBox Left = 0 diff --git a/UOLib/UWorldItem.pas b/UOLib/UWorldItem.pas index 202eefd..5cdd412 100644 --- a/UOLib/UWorldItem.pas +++ b/UOLib/UWorldItem.pas @@ -1,282 +1,284 @@ -(* - * CDDL HEADER START - * - * The contents of this file are subject to the terms of the - * Common Development and Distribution License, Version 1.0 only - * (the "License"). You may not use this file except in compliance - * with the License. - * - * You can obtain a copy of the license at - * http://www.opensource.org/licenses/cddl1.php. - * See the License for the specific language governing permissions - * and limitations under the License. - * - * When distributing Covered Code, include this CDDL HEADER in each - * file and include the License file at - * http://www.opensource.org/licenses/cddl1.php. If applicable, - * add the following below this CDDL HEADER, with the fields enclosed - * by brackets "[]" replaced with your own identifying * information: - * Portions Copyright [yyyy] [name of copyright owner] - * - * CDDL HEADER END - * - * - * Portions Copyright 2007 Andreas Schneider - *) -unit UWorldItem; - -{$mode objfpc}{$H+} - -interface - -uses - Classes, UMulBlock; - -type - TWorldBlock = class; - TWorldItem = class(TMulBlock) - constructor Create(AOwner: TWorldBlock); - protected - FOwner, FOrgOwner: TWorldBlock; - FTileID, FOrgTileID: Word; - FX, FOrgX: Word; - FY, FOrgY: Word; - FZ, FOrgZ: ShortInt; - FSelected: Boolean; - FLocked: Boolean; - FChanged: Boolean; - FPriority: Integer; - FPriorityBonus: ShortInt; - FPrioritySolver: Integer; - 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 DoChanged; - function HasChanged: Boolean; virtual; - public - procedure UpdatePos(AX, AY: Word; AZ: ShortInt); - procedure Delete; - procedure InitOriginalState; virtual; - property Owner: TWorldBlock read FOwner write SetOwner; - property TileID: Word read FTileID write SetTileID; - property X: Word read FX write SetX; - property Y: Word read FY write SetY; - property Z: ShortInt read FZ write SetZ; - property Selected: Boolean read FSelected write SetSelected; - property Locked: Boolean read FLocked write SetLocked; - property Changed: Boolean read FChanged; - property Priority: Integer read FPriority write FPriority; - property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus; - property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver; - end; - TWorldBlock = class(TMulBlock) - constructor Create; - protected - FX: Word; - FY: Word; - FRefCount: Integer; - FChanges: Integer; - function GetChanged: Boolean; - procedure SetChanged(AChanged: Boolean); - procedure DoStateChanged; - public - property X: Word read FX write FX; - property Y: Word read FY write FY; - property RefCount: Integer read FRefCount; - property Changed: Boolean read GetChanged write SetChanged; - procedure AddRef; - procedure RemoveRef; - procedure CleanUp; - end; - -implementation - -{ TWorldItem } - -constructor TWorldItem.Create(AOwner: TWorldBlock); -begin - inherited Create; - FSelected := False; - FLocked := False; - FChanged := False; - FOwner := AOwner; -end; - -procedure TWorldItem.Delete; -begin - SetSelected(False); - SetLocked(False); - if (FOwner <> FOrgOwner) then - FOwner.Changed := False - else if Assigned(FOrgOwner) and (not FChanged) then - FOrgOwner.Changed := True; - Free; -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; -end; - -procedure TWorldItem.SetLocked(ALocked: Boolean); -begin - if FLocked <> ALocked then - begin - FLocked := ALocked; - if Assigned(FOwner) then - if FLocked then - FOwner.AddRef - else - FOwner.RemoveRef; - end; -end; - -procedure TWorldItem.SetOwner(AOwner: TWorldBlock); -begin - if FOwner <> AOwner then - begin - if Assigned(FOwner) then - begin - if FOwner <> FOrgOwner then - FOwner.Changed := False; - if FLocked then FOwner.RemoveRef; - if FSelected then FOwner.RemoveRef; - end; - FOwner := AOwner; - if Assigned(FOwner) then - begin - if FOwner <> FOrgOwner then - FOwner.Changed := True; - if FLocked then FOwner.AddRef; - if FSelected then FOwner.AddRef; - end; - DoChanged; - end; -end; - -procedure TWorldItem.SetSelected(ASelected: Boolean); -begin - if (FOwner <> nil) and (ASelected <> FSelected) then - if ASelected then - FOwner.AddRef - else - FOwner.RemoveRef; - FSelected := ASelected; -end; - -procedure TWorldItem.SetTileID(ATileID: Word); -begin - FTileID := ATileID; - DoChanged; -end; - -procedure TWorldItem.SetX(AX: Word); -begin - FX := AX; - DoChanged; -end; - -procedure TWorldItem.SetY(AY: Word); -begin - FY := AY; - DoChanged -end; - -procedure TWorldItem.SetZ(AZ: ShortInt); -begin - FZ := AZ; - DoChanged; -end; - -procedure TWorldItem.UpdatePos(AX, AY: Word; AZ: ShortInt); -begin - FX := AX; - FY := AY; - FZ := AZ; - DoChanged; -end; - -{ TWorldBlock } - -procedure TWorldBlock.AddRef; -begin - Inc(FRefCount); - DoStateChanged; -end; - -procedure TWorldBlock.CleanUp; -begin - FChanges := 0; - DoStateChanged; -end; - -constructor TWorldBlock.Create; -begin - inherited Create; - FRefCount := 0; - FChanges := 0; -end; - -procedure TWorldBlock.DoStateChanged; -begin - if Assigned(FOnChanged) then - FOnChanged(Self); -end; - -function TWorldBlock.GetChanged: Boolean; -begin - Result := (FChanges <> 0); -end; - -procedure TWorldBlock.RemoveRef; -begin - if FRefCount > 0 then - Dec(FRefCount); - DoStateChanged; -end; - -procedure TWorldBlock.SetChanged(AChanged: Boolean); -begin - if AChanged then - Inc(FChanges) - else - Dec(FChanges); - DoStateChanged; -end; - -end. - +(* + * CDDL HEADER START + * + * The contents of this file are subject to the terms of the + * Common Development and Distribution License, Version 1.0 only + * (the "License"). You may not use this file except in compliance + * with the License. + * + * You can obtain a copy of the license at + * http://www.opensource.org/licenses/cddl1.php. + * See the License for the specific language governing permissions + * and limitations under the License. + * + * When distributing Covered Code, include this CDDL HEADER in each + * file and include the License file at + * http://www.opensource.org/licenses/cddl1.php. If applicable, + * add the following below this CDDL HEADER, with the fields enclosed + * by brackets "[]" replaced with your own identifying * information: + * Portions Copyright [yyyy] [name of copyright owner] + * + * CDDL HEADER END + * + * + * Portions Copyright 2007 Andreas Schneider + *) +unit UWorldItem; + +{$mode objfpc}{$H+} + +interface + +uses + Classes, UMulBlock; + +type + TWorldBlock = class; + TWorldItem = class(TMulBlock) + constructor Create(AOwner: TWorldBlock); + protected + FOwner, FOrgOwner: TWorldBlock; + FTileID, FOrgTileID: Word; + FX, FOrgX: Word; + FY, FOrgY: Word; + FZ, FOrgZ: ShortInt; + FSelected: Boolean; + FCanBeEdited: Boolean; + FLocked: Boolean; + FChanged: Boolean; + FPriority: Integer; + FPriorityBonus: ShortInt; + FPrioritySolver: Integer; + 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 DoChanged; + function HasChanged: Boolean; virtual; + public + procedure UpdatePos(AX, AY: Word; AZ: ShortInt); + procedure Delete; + procedure InitOriginalState; virtual; + property Owner: TWorldBlock read FOwner write SetOwner; + property TileID: Word read FTileID write SetTileID; + property X: Word read FX write SetX; + property Y: Word read FY write SetY; + property Z: ShortInt read FZ write SetZ; + property Selected: Boolean read FSelected write SetSelected; + property CanBeEdited: Boolean read FCanBeEdited write FCanBeEdited; + property Locked: Boolean read FLocked write SetLocked; + property Changed: Boolean read FChanged; + property Priority: Integer read FPriority write FPriority; + property PriorityBonus: ShortInt read FPriorityBonus write FPriorityBonus; + property PrioritySolver: Integer read FPrioritySolver write FPrioritySolver; + end; + TWorldBlock = class(TMulBlock) + constructor Create; + protected + FX: Word; + FY: Word; + FRefCount: Integer; + FChanges: Integer; + function GetChanged: Boolean; + procedure SetChanged(AChanged: Boolean); + procedure DoStateChanged; + public + property X: Word read FX write FX; + property Y: Word read FY write FY; + property RefCount: Integer read FRefCount; + property Changed: Boolean read GetChanged write SetChanged; + procedure AddRef; + procedure RemoveRef; + procedure CleanUp; + end; + +implementation + +{ TWorldItem } + +constructor TWorldItem.Create(AOwner: TWorldBlock); +begin + inherited Create; + FSelected := False; + FLocked := False; + FChanged := False; + FOwner := AOwner; +end; + +procedure TWorldItem.Delete; +begin + SetSelected(False); + SetLocked(False); + if (FOwner <> FOrgOwner) then + FOwner.Changed := False + else if Assigned(FOrgOwner) and (not FChanged) then + FOrgOwner.Changed := True; + Free; +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; +end; + +procedure TWorldItem.SetLocked(ALocked: Boolean); +begin + if FLocked <> ALocked then + begin + FLocked := ALocked; + if Assigned(FOwner) then + if FLocked then + FOwner.AddRef + else + FOwner.RemoveRef; + end; +end; + +procedure TWorldItem.SetOwner(AOwner: TWorldBlock); +begin + if FOwner <> AOwner then + begin + if Assigned(FOwner) then + begin + if FOwner <> FOrgOwner then + FOwner.Changed := False; + if FLocked then FOwner.RemoveRef; + if FSelected then FOwner.RemoveRef; + end; + FOwner := AOwner; + if Assigned(FOwner) then + begin + if FOwner <> FOrgOwner then + FOwner.Changed := True; + if FLocked then FOwner.AddRef; + if FSelected then FOwner.AddRef; + end; + DoChanged; + end; +end; + +procedure TWorldItem.SetSelected(ASelected: Boolean); +begin + if (FOwner <> nil) and (ASelected <> FSelected) then + if ASelected then + FOwner.AddRef + else + FOwner.RemoveRef; + FSelected := ASelected; +end; + +procedure TWorldItem.SetTileID(ATileID: Word); +begin + FTileID := ATileID; + DoChanged; +end; + +procedure TWorldItem.SetX(AX: Word); +begin + FX := AX; + DoChanged; +end; + +procedure TWorldItem.SetY(AY: Word); +begin + FY := AY; + DoChanged +end; + +procedure TWorldItem.SetZ(AZ: ShortInt); +begin + FZ := AZ; + DoChanged; +end; + +procedure TWorldItem.UpdatePos(AX, AY: Word; AZ: ShortInt); +begin + FX := AX; + FY := AY; + FZ := AZ; + DoChanged; +end; + +{ TWorldBlock } + +procedure TWorldBlock.AddRef; +begin + Inc(FRefCount); + DoStateChanged; +end; + +procedure TWorldBlock.CleanUp; +begin + FChanges := 0; + DoStateChanged; +end; + +constructor TWorldBlock.Create; +begin + inherited Create; + FRefCount := 0; + FChanges := 0; +end; + +procedure TWorldBlock.DoStateChanged; +begin + if Assigned(FOnChanged) then + FOnChanged(Self); +end; + +function TWorldBlock.GetChanged: Boolean; +begin + Result := (FChanges <> 0); +end; + +procedure TWorldBlock.RemoveRef; +begin + if FRefCount > 0 then + Dec(FRefCount); + DoStateChanged; +end; + +procedure TWorldBlock.SetChanged(AChanged: Boolean); +begin + if AChanged then + Inc(FChanges) + else + Dec(FChanges); + DoStateChanged; +end; + +end. +