Revision 152:2c10e1ad6647 UOLib/UStatics.pas

b/UOLib/UStatics.pas
1
(*
2
 * CDDL HEADER START
3
 *
4
 * The contents of this file are subject to the terms of the
5
 * Common Development and Distribution License, Version 1.0 only
6
 * (the "License").  You may not use this file except in compliance
7
 * with the License.
8
 *
9
 * You can obtain a copy of the license at
10
 * http://www.opensource.org/licenses/cddl1.php.
11
 * See the License for the specific language governing permissions
12
 * and limitations under the License.
13
 *
14
 * When distributing Covered Code, include this CDDL HEADER in each
15
 * file and include the License file at
16
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
17
 * add the following below this CDDL HEADER, with the fields enclosed
18
 * by brackets "[]" replaced with your own identifying * information:
19
 *      Portions Copyright [yyyy] [name of copyright owner]
20
 *
21
 * CDDL HEADER END
22
 *
23
 *
24
 *      Portions Copyright 2009 Andreas Schneider
25
 *)
26
unit UStatics;
27

  
28
{$mode objfpc}{$H+}
29

  
30
interface
31

  
32
uses
33
  SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata;
34

  
35
type
36
  { TStaticItem }
37

  
38
  TStaticItem = class(TWorldItem)
39
    constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
40
      ABlockY: Word); overload;
41
    constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
42
  protected
43
    { Members }
44
    FHue: Word;
45
    FOrgHue: Word;
46

  
47
    { Methods }
48
    function HasChanged: Boolean; override;
49
    procedure SetHue(AHue: Word);
50
  public
51
    { Fields }
52
    property Hue: Word read FHue write SetHue;
53

  
54
    { Methods }
55
    function Clone: TStaticItem; override;
56
    function GetSize: Integer; override;
57
    procedure InitOriginalState; override;
58
    procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer);
59
    procedure Write(AData: TStream); override;
60
  end;
61

  
62
  TStaticItemList = specialize TFPGObjectList<TStaticItem>;
63

  
64
  { TStaticBlock}
65

  
66
  TStaticBlock = class(TWorldBlock)
67
    constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
68
      overload;
69
    constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
70
    destructor Destroy; override;
71
  protected
72
    { Members }
73
    FItems: TStaticItemList;
74
  public
75
    { Fields }
76
    property Items: TStaticItemList read FItems write FItems;
77

  
78
    { Methods }
79
    function Clone: TStaticBlock; override;
80
    function GetSize: Integer; override;
81
    procedure ReverseWrite(AData: TStream);
82
    procedure Sort;
83
    procedure Write(AData: TStream); override;
84
  end;
85

  
86
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
87

  
88
implementation
89

  
90
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
91
begin
92
  Result := CompareWorldItems(AStatic1, AStatic2);
93
end;
94

  
95
{ TStaticItem }
96

  
97
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
98
  ABlockY: Word);
99
var
100
  iX, iY: Byte;
101
begin
102
  inherited Create(AOwner);
103

  
104
  if AData <> nil then
105
  begin
106
    AData.Read(FTileID, SizeOf(SmallInt));
107
    AData.Read(iX, SizeOf(Byte));
108
    AData.Read(iY, SizeOf(Byte));
109
    AData.Read(FZ, SizeOf(ShortInt));
110
    AData.Read(FHue, SizeOf(SmallInt));
111

  
112
    FX := ABlockX * 8 + iX;
113
    FY := ABlockY * 8 + iY;
114
  end;
115

  
116
  InitOriginalState;
117
end;
118

  
119
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
120
begin
121
  Create(AOwner, AData, 0, 0);
122
end;
123

  
124
function TStaticItem.HasChanged: Boolean;
125
begin
126
  Result := (FHue <> FOrgHue) or inherited HasChanged;
127
end;
128

  
129
procedure TStaticItem.SetHue(AHue: Word);
130
begin
131
  FHue := AHue;
132
  DoChanged;
133
end;
134

  
135
function TStaticItem.Clone: TStaticItem;
136
begin
137
  Result := TStaticItem.Create(nil, nil);
138
  Result.FTileID := FTileID;
139
  Result.FX := FX;
140
  Result.FY := FY;
141
  Result.FZ := FZ;
142
  Result.FHue := FHue;
143
end;
144

  
145
function TStaticItem.GetSize: Integer;
146
begin
147
  Result := 7;
148
end;
149

  
150
procedure TStaticItem.InitOriginalState;
151
begin
152
  FOrgHue := FHue;
153
  inherited InitOriginalState;
154
end;
155

  
156
procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata;
157
  ASolver: Integer);
158
begin
159
  FPriorityBonus := 0;
160
  if not (tdfBackground in ATileData.Flags) or (ATileData.Height > 0) then
161
    Inc(FPriorityBonus);
162
  FPriority := Z + FPriorityBonus;
163
  FPrioritySolver := ASolver;
164
end;
165

  
166
procedure TStaticItem.Write(AData: TStream);
167
var
168
  iX, iY: Byte;
169
begin
170
  iX := FX mod 8;
171
  iY := FY mod 8;
172

  
173
  AData.Write(FTileID, SizeOf(SmallInt));
174
  AData.Write(iX, SizeOf(Byte));
175
  AData.Write(iY, SizeOf(Byte));
176
  AData.Write(FZ, SizeOf(ShortInt));
177
  AData.Write(FHue, SizeOf(SmallInt));
178
end;
179

  
180
{ TStaticBlock }
181

  
182
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
183
  AX, AY: Word);
184
var
185
  i: Integer;
186
  block: TMemoryStream;
187
begin
188
  inherited Create;
189
  FX := AX;
190
  FY := AY;
191

  
192
  FItems := TStaticItemList.Create(True);
193
  if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
194
  begin
195
    AData.Position := AIndex.Lookup;
196
    block := TMemoryStream.Create;
197
    block.CopyFrom(AData, AIndex.Size);
198
    block.Position := 0;
199
    for i := 1 to (AIndex.Size div 7) do
200
      FItems.Add(TStaticItem.Create(Self, block, AX, AY));
201
    block.Free;
202
  end;
203
end;
204

  
205
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
206
begin
207
  Create(AData, AIndex, 0, 0);
208
end;
209

  
210
destructor TStaticBlock.Destroy;
211
begin
212
  FreeAndNil(FItems);
213
  inherited;
214
end;
215

  
216
function TStaticBlock.Clone: TStaticBlock;
217
var
218
  i: Integer;
219
begin
220
  Result := TStaticBlock.Create(nil, nil, FX, FY);
221
  for i := 0 to FItems.Count - 1 do
222
    Result.FItems.Add(FItems.Items[i].Clone);
223
end;
224

  
225
function TStaticBlock.GetSize: Integer;
226
begin
227
  Result := FItems.Count * 7;
228
end;
229

  
230
procedure TStaticBlock.ReverseWrite(AData: TStream);
231
var
232
  i: Integer;
233
begin
234
  for i := FItems.Count - 1 downto 0 do
235
    FItems[i].Write(AData);
236
end;
237

  
238
procedure TStaticBlock.Sort;
239
begin
240
  FItems.Sort(@CompareStaticItems);
241
end;
242

  
243
procedure TStaticBlock.Write(AData: TStream);
244
var
245
  i: Integer;
246
begin
247
  for i := 0 to FItems.Count - 1 do
248
    FItems[i].Write(AData);
249
end;
250

  
251
end.
252

  
1
(*
2
 * CDDL HEADER START
3
 *
4
 * The contents of this file are subject to the terms of the
5
 * Common Development and Distribution License, Version 1.0 only
6
 * (the "License").  You may not use this file except in compliance
7
 * with the License.
8
 *
9
 * You can obtain a copy of the license at
10
 * http://www.opensource.org/licenses/cddl1.php.
11
 * See the License for the specific language governing permissions
12
 * and limitations under the License.
13
 *
14
 * When distributing Covered Code, include this CDDL HEADER in each
15
 * file and include the License file at
16
 * http://www.opensource.org/licenses/cddl1.php.  If applicable,
17
 * add the following below this CDDL HEADER, with the fields enclosed
18
 * by brackets "[]" replaced with your own identifying * information:
19
 *      Portions Copyright [yyyy] [name of copyright owner]
20
 *
21
 * CDDL HEADER END
22
 *
23
 *
24
 *      Portions Copyright 2009 Andreas Schneider
25
 *)
26
unit UStatics;
27

  
28
{$mode objfpc}{$H+}
29

  
30
interface
31

  
32
uses
33
  SysUtils, Classes, fgl, UGenericIndex, UWorldItem, UTiledata;
34

  
35
type
36
  { TStaticItem }
37

  
38
  TStaticItem = class(TWorldItem)
39
    constructor Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
40
      ABlockY: Word); overload;
41
    constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
42
  protected
43
    { Members }
44
    FHue: Word;
45

  
46
    { Methods }
47
    procedure SetHue(AValue: Word);
48
  public
49
    { Fields }
50
    property Hue: Word read FHue write SetHue;
51

  
52
    { Methods }
53
    function Clone: TStaticItem; override;
54
    function GetSize: Integer; override;
55
    procedure UpdatePriorities(ATileData: TStaticTiledata; ASolver: Integer);
56
    procedure Write(AData: TStream); override;
57
  end;
58

  
59
  TStaticItemList = specialize TFPGObjectList<TStaticItem>;
60

  
61
  { TStaticBlock}
62

  
63
  TStaticBlock = class(TWorldBlock)
64
    constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word);
65
      overload;
66
    constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
67
    destructor Destroy; override;
68
  protected
69
    { Members }
70
    FItems: TStaticItemList;
71
  public
72
    { Fields }
73
    property Items: TStaticItemList read FItems write FItems;
74

  
75
    { Methods }
76
    function Clone: TStaticBlock; override;
77
    function GetSize: Integer; override;
78
    procedure ReverseWrite(AData: TStream);
79
    procedure Sort;
80
    procedure Write(AData: TStream); override;
81
  end;
82

  
83
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
84

  
85
implementation
86

  
87
function CompareStaticItems(const AStatic1, AStatic2: TStaticItem): Integer;
88
begin
89
  Result := CompareWorldItems(AStatic1, AStatic2);
90
end;
91

  
92
{ TStaticItem }
93

  
94
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream; ABlockX,
95
  ABlockY: Word);
96
var
97
  iX, iY: Byte;
98
begin
99
  inherited Create(AOwner);
100

  
101
  if AData <> nil then
102
  begin
103
    AData.Read(FTileID, SizeOf(SmallInt));
104
    AData.Read(iX, SizeOf(Byte));
105
    AData.Read(iY, SizeOf(Byte));
106
    AData.Read(FZ, SizeOf(ShortInt));
107
    AData.Read(FHue, SizeOf(SmallInt));
108

  
109
    FX := ABlockX * 8 + iX;
110
    FY := ABlockY * 8 + iY;
111
  end;
112
end;
113

  
114
constructor TStaticItem.Create(AOwner: TWorldBlock; AData: TStream);
115
begin
116
  Create(AOwner, AData, 0, 0);
117
end;
118

  
119
procedure TStaticItem.SetHue(AValue: Word);
120
begin
121
  if FHue = AValue then
122
    Exit;
123

  
124
  FHue := AValue;
125
  DoChanged;
126
end;
127

  
128
function TStaticItem.Clone: TStaticItem;
129
begin
130
  Result := TStaticItem.Create(nil, nil);
131
  Result.FTileID := FTileID;
132
  Result.FX := FX;
133
  Result.FY := FY;
134
  Result.FZ := FZ;
135
  Result.FHue := FHue;
136
end;
137

  
138
function TStaticItem.GetSize: Integer;
139
begin
140
  Result := 7;
141
end;
142

  
143
procedure TStaticItem.UpdatePriorities(ATileData: TStaticTiledata;
144
  ASolver: Integer);
145
begin
146
  FPriorityBonus := 0;
147
  if not (tdfBackground in ATileData.Flags) then
148
    Inc(FPriorityBonus);
149
  if ATileData.Height > 0 then
150
    Inc(FPriorityBonus);
151
  FPriority := Z + FPriorityBonus;
152
  FPrioritySolver := ASolver;
153
end;
154

  
155
procedure TStaticItem.Write(AData: TStream);
156
var
157
  iX, iY: Byte;
158
begin
159
  iX := FX mod 8;
160
  iY := FY mod 8;
161

  
162
  AData.Write(FTileID, SizeOf(SmallInt));
163
  AData.Write(iX, SizeOf(Byte));
164
  AData.Write(iY, SizeOf(Byte));
165
  AData.Write(FZ, SizeOf(ShortInt));
166
  AData.Write(FHue, SizeOf(SmallInt));
167
end;
168

  
169
{ TStaticBlock }
170

  
171
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
172
  AX, AY: Word);
173
var
174
  i: Integer;
175
  block: TMemoryStream;
176
begin
177
  inherited Create;
178
  FX := AX;
179
  FY := AY;
180

  
181
  FItems := TStaticItemList.Create(True);
182
  if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
183
  begin
184
    AData.Position := AIndex.Lookup;
185
    block := TMemoryStream.Create;
186
    block.CopyFrom(AData, AIndex.Size);
187
    block.Position := 0;
188
    for i := 1 to (AIndex.Size div 7) do
189
      FItems.Add(TStaticItem.Create(Self, block, AX, AY));
190
    block.Free;
191
  end;
192
end;
193

  
194
constructor TStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
195
begin
196
  Create(AData, AIndex, 0, 0);
197
end;
198

  
199
destructor TStaticBlock.Destroy;
200
begin
201
  FreeAndNil(FItems);
202
  inherited;
203
end;
204

  
205
function TStaticBlock.Clone: TStaticBlock;
206
var
207
  i: Integer;
208
begin
209
  Result := TStaticBlock.Create(nil, nil, FX, FY);
210
  for i := 0 to FItems.Count - 1 do
211
    Result.FItems.Add(FItems.Items[i].Clone);
212
end;
213

  
214
function TStaticBlock.GetSize: Integer;
215
begin
216
  Result := FItems.Count * 7;
217
end;
218

  
219
procedure TStaticBlock.ReverseWrite(AData: TStream);
220
var
221
  i: Integer;
222
begin
223
  for i := FItems.Count - 1 downto 0 do
224
    FItems[i].Write(AData);
225
end;
226

  
227
procedure TStaticBlock.Sort;
228
begin
229
  FItems.Sort(@CompareStaticItems);
230
end;
231

  
232
procedure TStaticBlock.Write(AData: TStream);
233
var
234
  i: Integer;
235
begin
236
  for i := 0 to FItems.Count - 1 do
237
    FItems[i].Write(AData);
238
end;
239

  
240
end.
241

  

Also available in: Unified diff