Revision 152:2c10e1ad6647 Server/ULandscape.pas

b/Server/ULandscape.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 ULandscape;
27

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

  
30
interface
31

  
32
uses
33
  SysUtils, Classes, math, UGenericIndex, UMap, UStatics, UWorldItem, UMulBlock,
34
  UTileDataProvider, URadarMap,
35
  UCacheManager, ULinkedList, UBufferedStreams,
36
  UEnhancedMemoryStream, UPacketHandlers, UPackets, UNetState, UEnums;
37

  
38
type
39
  PRadarBlock = ^TRadarBlock;
40
  TRadarBlock = array[0..7, 0..7] of Word;
41
  TBlockSubscriptions = array of TLinkedList;
42

  
43
  { TSeperatedStaticBlock }
44

  
45
  TSeperatedStaticBlock = class(TStaticBlock)
46
    constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
47
    constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
48
    destructor Destroy; override;
49
  protected
50
    FTiledataProvider: TTiledataProvider;
51
  public
52
    { Fields }
53
    Cells: array[0..63] of TStaticItemList;
54
    property TiledataProvider: TTiledataProvider read FTiledataProvider
55
      write FTiledataProvider;
56

  
57
    { Methods }
58
    function Clone: TSeperatedStaticBlock; override;
59
    function GetSize: Integer; override;
60
    procedure RebuildList;
61
  end;
62
  
63
  { TBlock }
64

  
65
  TBlock = class
66
    constructor Create(AMap: TMapBlock; AStatics: TSeperatedStaticBlock);
67
    destructor Destroy; override;
68
  protected
69
    FMapBlock: TMapBlock;
70
    FStaticBlock: TSeperatedStaticBlock;
71
  public
72
    property Map: TMapBlock read FMapBlock;
73
    property Static: TSeperatedStaticBlock read FStaticBlock;
74
  end;
75

  
76
  TBlockCache = specialize TCacheManager<TBlock>;
77

  
78
  { TLandscape }
79

  
80
  TLandscape = class
81
    constructor Create(AMap, AStatics, AStaIdx, ATiledata, ARadarCol: string;
82
      AWidth, AHeight: Word; var AValid: Boolean);
83
    constructor Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
84
      ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
85
    destructor Destroy; override;
86
  protected
87
    FWidth: Word;
88
    FHeight: Word;
89
    FCellWidth: Word;
90
    FCellHeight: Word;
91
    FMap: TStream;
92
    FStatics: TStream;
93
    FStaIdx: TStream;
94
    FTiledata: TStream;
95
    FTiledataProvider: TTiledataProvider;
96
    FOwnsStreams: Boolean;
97
    FRadarMap: TRadarMap;
98
    FBlockCache: TBlockCache;
99
    FBlockSubscriptions: TBlockSubscriptions;
100
    procedure OnBlockChanged(ABlock: TMulBlock);
101
    procedure OnRemoveCachedObject(ABlock: TBlock);
102
    function GetMapCell(AX, AY: Word): TMapCell;
103
    function GetStaticList(AX, AY: Word): TStaticItemList;
104
    function GetBlockSubscriptions(AX, AY: Word): TLinkedList;
105

  
106
    procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream;
107
      ANetState: TNetState);
108
    procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream;
109
      ANetState: TNetState);
110
    procedure OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream;
111
      ANetState: TNetState);
112
    procedure OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream;
113
      ANetState: TNetState);
114
    procedure OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream;
115
      ANetState: TNetState);
116
    procedure OnHueStaticPacket(ABuffer: TEnhancedMemoryStream;
117
      ANetState: TNetState);
118
    procedure OnLargeScaleCommandPacket(ABuffer: TEnhancedMemoryStream;
119
      ANetState: TNetState);
120
  public
121
    property Width: Word read FWidth;
122
    property Height: Word read FHeight;
123
    property CellWidth: Word read FCellWidth;
124
    property CellHeight: Word read FCellHeight;
125
    property MapCell[X, Y: Word]: TMapCell read GetMapCell;
126
    property StaticList[X, Y: Word]: TStaticItemList read GetStaticList;
127
    property BlockSubscriptions[X, Y: Word]: TLinkedList read GetBlockSubscriptions;
128
    property TiledataProvider: TTiledataProvider read FTiledataProvider;
129

  
130
    function GetMapBlock(AX, AY: Word): TMapBlock;
131
    function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
132
    function LoadBlock(AX, AY: Word): TBlock;
133

  
134
    procedure UpdateRadar(AX, AY: Word);
135
    function GetEffectiveAltitude(ATile: TMapCell): ShortInt;
136
    function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
137
    procedure SortStaticsList(AStatics: TStaticItemList);
138

  
139
    procedure Flush;
140
    procedure SaveBlock(AWorldBlock: TWorldBlock);
141
    function Validate: Boolean;
142
  end;
143
  
144
  TStaticInfo = packed record
145
    X: Word;
146
    Y: Word;
147
    Z: ShortInt;
148
    TileID: Word;
149
    Hue: Word;
150
  end;
151
  TAreaInfo = packed record
152
    Left: Word;
153
    Top: Word;
154
    Right: Word;
155
    Bottom: Word;
156
  end;
157
  TWorldPoint = packed record
158
    X: Word;
159
    Y: Word;
160
  end;
161
  
162
function PointInArea(AArea: TAreaInfo; AX, AY: Word): Boolean; inline;
163

  
164
implementation
165

  
166
uses
167
  UCEDServer, UConnectionHandling, UConfig, ULargeScaleOperations, Logging;
168

  
169
function GetID(AX, AY: Word): Integer;
170
begin
171
  Result := ((AX and $7FFF) shl 15) or (AY and $7FFF);
172
end;
173

  
174
function PointInArea(AArea: TAreaInfo; AX, AY: Word): Boolean;
175
begin
176
  Result := InRange(AX, AArea.Left, AArea.Right) and
177
            InRange(AY, AArea.Top, AArea.Bottom);
178
end;
179

  
180
{ TSeperatedStaticBlock }
181

  
182
constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
183
  AX, AY: Word);
184
var
185
  i: Integer;
186
  item: TStaticItem;
187
  block: TMemoryStream;
188
begin
189
  inherited Create;
190
  FItems := TStaticItemList.Create(False);
191

  
192
  FX := AX;
193
  FY := AY;
194

  
195
  for i := 0 to 63 do
196
    Cells[i] := TStaticItemList.Create(True);
197

  
198
  if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
199
  begin
200
    AData.Position := AIndex.Lookup;
201
    block := TMemoryStream.Create;
202
    block.CopyFrom(AData, AIndex.Size);
203
    block.Position := 0;
204
    for i := 1 to (AIndex.Size div 7) do
205
    begin
206
      item := TStaticItem.Create(Self, block, AX, AY);
207
      Cells[(item.Y mod 8) * 8 + (item.X mod 8)].Add(item);
208
    end;
209
    block.Free;
210
  end;
211
end;
212

  
213
constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
214
begin
215
  Create(AData, AIndex, 0, 0);
216
end;
217

  
218
destructor TSeperatedStaticBlock.Destroy;
219
var
220
  i: Integer;
221
begin
222
  FreeAndNil(FItems);
223

  
224
  for i := 0 to 63 do
225
    FreeAndNil(Cells[i]);
226

  
227
  inherited Destroy;
228
end;
229

  
230
function TSeperatedStaticBlock.Clone: TSeperatedStaticBlock;
231
begin
232
  raise Exception.Create('TSeperatedStaticBlock.Clone is not implemented (yet).');
233
  Result := nil;
234
end;
235

  
236
function TSeperatedStaticBlock.GetSize: Integer;
237
begin
238
  RebuildList;
239
  Result := inherited GetSize;
240
end;
241

  
242
procedure TSeperatedStaticBlock.RebuildList;
243
var
244
  i, j, solver: Integer;
245
begin
246
  FItems.Clear;
247
  solver := 0;
248
  for i := 0 to 63 do
249
  begin
250
    if Cells[i] <> nil then
251
    begin
252
      for j := 0 to Cells[i].Count - 1 do
253
      begin
254
        FItems.Add(Cells[i].Items[j]);
255
        if Cells[i].Items[j].TileID < FTiledataProvider.StaticCount then
256
        begin
257
          Cells[i].Items[j].UpdatePriorities(
258
            FTiledataProvider.StaticTiles[Cells[i].Items[j].TileID], solver);
259
        end else
260
          Logger.Send([lcLandscape, lcServer, lcError], 'Cannot find Tiledata ' +
261
            'for the Static Item with ID $%x.', [Cells[i].Items[j].TileID]);
262
        Inc(solver);
263
      end;
264
    end;
265
  end;
266
  Sort;
267
end;
268

  
269
{ TBlock }
270

  
271
constructor TBlock.Create(AMap: TMapBlock; AStatics: TSeperatedStaticBlock);
272
begin
273
  inherited Create;
274
  FMapBlock := AMap;
275
  FStaticBlock := AStatics;
276
end;
277

  
278
destructor TBlock.Destroy;
279
begin
280
  FreeAndNil(FMapBlock);
281
  FreeAndNil(FStaticBlock);
282
  inherited Destroy;
283
end;
284

  
285
{ TLandscape }
286

  
287
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata,
288
  ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
289
var
290
  map, statics, staidx, tiledata: TStream;
291
begin
292
  Write(TimeStamp, 'Loading Map');
293
  map := TFileStream.Create(AMap, fmOpenReadWrite);
294
  Write(', Statics');
295
  statics := TFileStream.Create(AStatics, fmOpenReadWrite);
296
  Write(', StaIdx');
297
  staidx := TBufferedReader.Create(TFileStream.Create(AStaIdx, fmOpenReadWrite), True);
298
  Writeln(', Tiledata');
299
  tiledata := TFileStream.Create(ATiledata, fmOpenRead or fmShareDenyWrite);
300
  Create(map, statics, staidx, tiledata, ARadarCol, AWidth, AHeight, AValid);
301
  FOwnsStreams := True;
302
end;
303

  
304
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
305
  ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
306
var
307
  blockID: Integer;
308
begin
309
  inherited Create;
310
  FWidth := AWidth;
311
  FHeight := AHeight;
312
  FCellWidth := FWidth * 8;
313
  FCellHeight := FHeight * 8;
314
  FMap := AMap;
315
  FStatics := AStatics;
316
  FStaIdx := AStaIdx;
317
  FTiledata := ATiledata;
318
  FOwnsStreams := False;
319
  AValid := Validate;
320
  if AValid then
321
  begin
322
    Write(TimeStamp, 'Creating Cache');
323
    FBlockCache := TBlockCache.Create(256);
324
    FBlockCache.OnRemoveObject := @OnRemoveCachedObject;
325
    Write(', Tiledata');
326
    FTiledataProvider := TTiledataProvider.Create(ATiledata);
327
    Write(', Subscriptions');
328
    SetLength(FBlockSubscriptions, AWidth * AHeight);
329
    for blockID := 0 to AWidth * AHeight - 1 do
330
      FBlockSubscriptions[blockID] := TLinkedList.Create;
331

  
332
    Writeln(', RadarMap');
333
    FRadarMap := TRadarMap.Create(FMap, FStatics, FStaIdx, FWidth, FHeight,
334
      ARadarCol);
335

  
336
    RegisterPacketHandler($06, TPacketHandler.Create(8, @OnDrawMapPacket));
337
    RegisterPacketHandler($07, TPacketHandler.Create(10, @OnInsertStaticPacket));
338
    RegisterPacketHandler($08, TPacketHandler.Create(10, @OnDeleteStaticPacket));
339
    RegisterPacketHandler($09, TPacketHandler.Create(11, @OnElevateStaticPacket));
340
    RegisterPacketHandler($0A, TPacketHandler.Create(14, @OnMoveStaticPacket));
341
    RegisterPacketHandler($0B, TPacketHandler.Create(12, @OnHueStaticPacket));
342
    RegisterPacketHandler($0E, TPacketHandler.Create(0, @OnLargeScaleCommandPacket));
343
  end;
344
end;
345

  
346
destructor TLandscape.Destroy;
347
var
348
  i: Integer;
349
begin
350
  for i := 0 to Length(FBlockSubscriptions) - 1 do
351
    FreeAndNil(FBlockSubscriptions[i]);
352
  FreeAndNil(FBlockCache);
353
  FreeAndNil(FTiledataProvider);
354
  FreeAndNil(FRadarMap);
355
  if FOwnsStreams then
356
  begin
357
    FreeAndNil(FMap);
358
    FreeAndNil(FStatics);
359
    FreeAndNil(FStaIdx);
360
    FreeAndNil(FTiledata);
361
  end;
362
  
363
  RegisterPacketHandler($06, nil);
364
  RegisterPacketHandler($07, nil);
365
  RegisterPacketHandler($08, nil);
366
  RegisterPacketHandler($09, nil);
367
  RegisterPacketHandler($0A, nil);
368
  RegisterPacketHandler($0B, nil);
369
  RegisterPacketHandler($0E, nil);
370
  
371
  inherited Destroy;
372
end;
373

  
374
function TLandscape.GetBlockSubscriptions(AX, AY: Word): TLinkedList;
375
begin
376
  if (AX >= 0) and (AX <= FWidth) and (AY >= 0) and (AY <= FHeight) then
377
    Result := FBlockSubscriptions[(AY * FWidth) + AX]
378
  else
379
    Result := nil;
380
end;
381

  
382
function TLandscape.GetMapCell(AX, AY: Word): TMapCell;
383
var
384
  block: TMapBlock;
385
begin
386
  Result := nil;
387
  if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then
388
  begin
389
    block := GetMapBlock(AX div 8, AY div 8);
390
    if block <> nil then
391
      Result := block.Cells[(AY mod 8) * 8 + AX mod 8];
392
  end;
393
end;
394

  
395
function TLandscape.GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
396
begin
397
  if (AX >= 0) and (AX < FCellWidth) and (AY >= 0) and (AY < FCellHeight) then
398
    Result := MapCell[AX, AY].Altitude
399
  else
400
    Result := ADefault;
401
end;
402

  
403
function TLandscape.GetStaticList(AX, AY: Word): TStaticItemList;
404
var
405
  block: TSeperatedStaticBlock;
406
begin
407
  Result := nil;
408
  if (AX >= 0) and (AX <= FCellWidth) and (AY >= 0) and (AY <= FCellHeight) then
409
  begin
410
    block := GetStaticBlock(AX div 8, AY div 8);
411
    if block <> nil then
412
      Result := block.Cells[(AY mod 8) * 8 + AX mod 8];
413
  end;
414
end;
415

  
416
procedure TLandscape.UpdateRadar(AX, AY: Word);
417
var
418
  mapTile: TMapCell;
419
  tile: TWorldItem;
420
  staticItems: TStaticItemList;
421
  tiles: TWorldItemList;
422
  i: Integer;
423
begin
424
  if (AX mod 8 = 0) and (AY mod 8 = 0) then
425
  begin
426
    staticItems := GetStaticList(AX, AY);
427
    if staticItems <> nil then
428
    begin
429
      tiles := TWorldItemList.Create(False);
430
      mapTile := GetMapCell(AX, AY);
431
      if mapTile <> nil then
432
      begin
433
        mapTile.Priority := GetEffectiveAltitude(mapTile);
434
        mapTile.PriorityBonus := 0;
435
        mapTile.PrioritySolver := 0;
436
        tiles.Add(mapTile);
437
      end;
438
      for i := 0 to staticItems.Count - 1 do
439
      begin
440
        if staticItems[i].TileID < FTiledataProvider.StaticCount then
441
        begin
442
          staticItems[i].UpdatePriorities(
443
            FTiledataProvider.StaticTiles[staticItems[i].TileID],
444
            i + 1);
445
        end else
446
          Logger.Send([lcLandscape, lcServer, lcError], 'Cannot find Tiledata ' +
447
            'for the Static Item with ID $%x.', [staticItems[i].TileID]);
448
        tiles.Add(staticItems[i]);
449
      end;
450
      tiles.Sort(@CompareWorldItems);
451

  
452
      if tiles.Count > 0 then
453
      begin
454
        tile := tiles[tiles.Count - 1];
455
        if tile is TStaticItem then
456
          FRadarMap.Update(AX div 8, AY div 8, tile.TileID + $4000)
457
        else
458
          FRadarMap.Update(AX div 8, AY div 8, tile.TileID)
459
      end;
460

  
461
      tiles.Free;
462
    end;
463
  end;
464
end;
465

  
466
procedure TLandscape.SortStaticsList(AStatics: TStaticItemList);
467
var
468
  i: Integer;
469
begin
470
  for i := 0 to AStatics.Count - 1 do
471
    if AStatics[i].TileID < FTiledataProvider.StaticCount then
472
    begin
473
      AStatics[i].UpdatePriorities(
474
        FTiledataProvider.StaticTiles[AStatics[i].TileID],
475
        i + 1);
476
    end else
477
      Logger.Send([lcLandscape, lcServer, lcError], 'Cannot find Tiledata ' +
478
        'for the Static Item with ID $%x.', [AStatics[i].TileID]);
479
  AStatics.Sort(@CompareStaticItems);
480
end;
481

  
482
function TLandscape.GetEffectiveAltitude(ATile: TMapCell): ShortInt;
483
var
484
  north, west, south, east: ShortInt;
485
begin
486
  north := ATile.Altitude;
487
  west := GetLandAlt(ATile.X, ATile.Y + 1, north);
488
  south := GetLandAlt(ATile.X + 1, ATile.Y + 1, north);
489
  east := GetLandAlt(ATile.X + 1, ATile.Y, north);
490

  
491
  if Abs(north - south) > Abs(west - east) then
492
    Result := (north + south) div 2
493
  else
494
    Result := (west + east) div 2;
495
end;
496

  
497
procedure TLandscape.OnBlockChanged(ABlock: TMulBlock);
498
begin
499
  // Do nothing for now
500
end;
501

  
502
procedure TLandscape.OnRemoveCachedObject(ABlock: TBlock);
503
begin
504
  if ABlock <> nil then
505
  begin
506
    if ABlock.Map.Changed then SaveBlock(ABlock.Map);
507
    if ABlock.Static.Changed then SaveBlock(ABlock.Static);
508
  end;
509
end;
510

  
511
function TLandscape.GetMapBlock(AX, AY: Word): TMapBlock;
512
var
513
  block: TBlock;
514
begin
515
  Result := nil;
516
  if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then
517
  begin
518
    if FBlockCache.QueryID(GetID(AX, AY), block) then
519
      Result := block.Map
520
    else
521
      Result := LoadBlock(AX, AY).Map;
522
  end;
523
end;
524

  
525
function TLandscape.GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
526
var
527
  block: TBlock;
528
begin
529
  Result := nil;
530
  if (AX >= 0) and (AX < FWidth) and (AY >= 0) and (AY < FHeight) then
531
  begin
532
    if FBlockCache.QueryID(GetID(AX, AY), block) then
533
      Result := TSeperatedStaticBlock(block.Static)
534
    else
535
      Result := TSeperatedStaticBlock(LoadBlock(AX, AY).Static);
536
  end;
537
end;
538

  
539
function TLandscape.LoadBlock(AX, AY: Word): TBlock;
540
var
541
  map: TMapBlock;
542
  statics: TSeperatedStaticBlock;
543
  index: TGenericIndex;
544
begin
545
  FMap.Position := ((AX * FHeight) + AY) * 196;
546
  map := TMapBlock.Create(FMap, AX, AY);
547
  map.OnChanged := @OnBlockChanged;
548

  
549
  FStaIdx.Position := ((AX * FHeight) + AY) * 12;
550
  index := TGenericIndex.Create(FStaIdx);
551
  statics := TSeperatedStaticBlock.Create(FStatics, index, AX, AY);
552
  statics.OnChanged := @OnBlockChanged;
553
  statics.TiledataProvider := FTiledataProvider;
554
  index.Free;
555
  
556
  Result := TBlock.Create(map, statics);
557
  FBlockCache.StoreID(GetID(AX, AY), Result);
558
end;
559

  
560
//Intelligent write: replace if possible, otherwise extend
561

  
562
procedure TLandscape.Flush;
563
begin
564
  FBlockCache.Clear; //Clear writes modified blocks before removing them from the cache
565
end;
566

  
567
procedure TLandscape.SaveBlock(AWorldBlock: TWorldBlock);
568
var
569
  i, j, size: Integer;
570
  index: TGenericIndex;
571
begin
572
  if AWorldBlock is TMapBlock then
573
  begin
574
    FMap.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 196;
575
    AWorldBlock.Write(FMap);
576
    for i := 0 to 63 do
577
      TMapBlock(AWorldBlock).Cells[i].InitOriginalState;
578
    AWorldBlock.CleanUp;
579
  end else if AWorldBlock is TStaticBlock then
580
  begin
581
    FStaIdx.Position := ((AWorldBlock.X * FHeight) + AWorldBlock.Y) * 12;
582
    index := TGenericIndex.Create(FStaIdx);
583
    size := AWorldBlock.GetSize;
584
    if (size > index.Size) or (index.Lookup < 0) then
585
    begin
586
      FStatics.Position := FStatics.Size;
587
      index.Lookup := FStatics.Position;
588
    end;
589
    index.Size := size;
590
    if size = 0 then
591
      index.Lookup := -1
592
    else
593
    begin
594
      FStatics.Position := index.Lookup;
595
      AWorldBlock.Write(FStatics);
596
    end;
597
    FStaIdx.Seek(-12, soFromCurrent);
598
    index.Write(FStaIdx);
599
    index.Free;
600
    for i := 0 to 63 do
601
      for j := 0 to TSeperatedStaticBlock(AWorldBlock).Cells[i].Count - 1 do
602
        TStaticItem(TSeperatedStaticBlock(AWorldBlock).Cells[i].Items[j]).InitOriginalState;
603
    AWorldBlock.CleanUp;
604
  end;
605
end;
606

  
607
function TLandscape.Validate: Boolean;
608
var
609
  blocks: Integer;
610
begin
611
  blocks := FWidth * FHeight;
612
  FStaIdx.Seek(0, soFromEnd); //workaround for TBufferedStream
613
  Result := (FMap.Size = (blocks * 196)) and (FStaIdx.Position = (blocks * 12));
614
end;
615

  
616
procedure TLandscape.OnDrawMapPacket(ABuffer: TEnhancedMemoryStream;
617
  ANetState: TNetState);
618
var
619
  x, y: Word;
620
  cell: TMapCell;
621
  subscriptions: TLinkedList;
622
  subscriptionItem: PLinkedItem;
623
  packet: TDrawMapPacket;
624
begin
625
  x := ABuffer.ReadWord;
626
  y := ABuffer.ReadWord;
627

  
628
  if not ValidateAccess(ANetState, alNormal, x, y) then Exit;
629

  
630
  cell := GetMapCell(x, y);
631
  if cell <> nil then
632
  begin
633
    cell.Altitude := ABuffer.ReadShortInt;
634
    cell.TileID := ABuffer.ReadWord;
635
    
636
    packet := TDrawMapPacket.Create(cell);
637
    subscriptions := FBlockSubscriptions[(y div 8) * FWidth + (x div 8)];
638
    subscriptionItem := nil;
639
    while subscriptions.Iterate(subscriptionItem) do
640
      CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data), packet, False);
641
    packet.Free;
642
    
643
    UpdateRadar(x, y);
644
  end;
645
end;
646

  
647
procedure TLandscape.OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream;
648
  ANetState: TNetState);
649
var
650
  x, y: Word;
651
  block: TSeperatedStaticBlock;
652
  staticItem: TStaticItem;
653
  targetStaticList: TStaticItemList;
654
  subscriptions: TLinkedList;
655
  subscriptionItem: PLinkedItem;
656
  packet: TInsertStaticPacket;
657
begin
658
  x := ABuffer.ReadWord;
659
  y := ABuffer.ReadWord;
660

  
661
  if not ValidateAccess(ANetState, alNormal, x, y) then Exit;
662

  
663
  block := GetStaticBlock(x div 8, y div 8);
664
  if block <> nil then
665
  begin
666
    staticItem := TStaticItem.Create(nil, nil, 0, 0);
667
    staticItem.X := x;
668
    staticItem.Y := y;
669
    staticItem.Z := ABuffer.ReadShortInt;
670
    staticItem.TileID := ABuffer.ReadWord;
671
    staticItem.Hue := ABuffer.ReadWord;
672
    targetStaticList := block.Cells[(y mod 8) * 8 + x mod 8];
673
    targetStaticList.Add(staticItem);
674
    SortStaticsList(targetStaticList);
675
    staticItem.Owner := block;
676
    
677
    packet := TInsertStaticPacket.Create(staticItem);
678
    subscriptions := FBlockSubscriptions[(y div 8) * FWidth + (x div 8)];
679
    subscriptionItem := nil;
680
    while subscriptions.Iterate(subscriptionItem) do
681
      CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data), packet, False);
682
    packet.Free;
683
    
684
    UpdateRadar(x, y);
685
  end;
686
end;
687

  
688
procedure TLandscape.OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream;
689
  ANetState: TNetState);
690
var
691
  block: TSeperatedStaticBlock;
692
  i: Integer;
693
  statics: TStaticItemList;
694
  staticInfo: TStaticInfo;
695
  staticItem: TStaticItem;
696
  subscriptions: TLinkedList;
697
  subscriptionItem: PLinkedItem;
698
  packet: TDeleteStaticPacket;
699
begin
700
  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
701

  
702
  if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
703

  
704
  block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
705
  if block <> nil then
706
  begin
707
    statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
708
    for i := 0 to statics.Count - 1 do
709
    begin
710
      staticItem := statics[i];
711
      if (staticItem.Z = staticInfo.Z) and
712
         (staticItem.TileID = staticInfo.TileID) and
713
         (staticItem.Hue = staticInfo.Hue) then
714
      begin
715
        packet := TDeleteStaticPacket.Create(staticItem);
716

  
717
        staticItem.Delete;
718
        statics.Delete(i);
719
        
720
        subscriptions := FBlockSubscriptions[(staticInfo.Y div 8) * FWidth +
721
          (staticInfo.X div 8)];
722
        subscriptionItem := nil;
723
        while subscriptions.Iterate(subscriptionItem) do
724
          CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data),
725
            packet, False);
726
        packet.Free;
727
        
728
        UpdateRadar(staticInfo.X, staticInfo.Y);
729
        
730
        Break;
731
      end;
732
    end;
733
  end;
734
end;
735

  
736
procedure TLandscape.OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream;
737
  ANetState: TNetState);
738
var
739
  block: TSeperatedStaticBlock;
740
  i: Integer;
741
  statics: TStaticItemList;
742
  staticInfo: TStaticInfo;
743
  staticItem: TStaticItem;
744
  newZ: ShortInt;
745
  subscriptions: TLinkedList;
746
  subscriptionItem: PLinkedItem;
747
  packet: TElevateStaticPacket;
748
begin
749
  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
750

  
751
  if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
752

  
753
  block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
754
  if block <> nil then
755
  begin
756
    statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
757
    for i := 0 to statics.Count - 1 do
758
    begin
759
      staticItem := statics[i];
760
      if (staticItem.Z = staticInfo.Z) and
761
         (staticItem.TileID = staticInfo.TileID) and
762
         (staticItem.Hue = staticInfo.Hue) then
763
      begin
764
        newZ := ABuffer.ReadShortInt;
765
        packet := TElevateStaticPacket.Create(staticItem, newZ);
766

  
767
        staticItem.Z := newZ;
768
        SortStaticsList(statics);
769

  
770
        subscriptions := FBlockSubscriptions[(staticInfo.Y div 8) * FWidth +
771
          (staticInfo.X div 8)];
772
        subscriptionItem := nil;
773
        while subscriptions.Iterate(subscriptionItem) do
774
          CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data),
775
            packet, False);
776
        packet.Free;
777
        
778
        UpdateRadar(staticInfo.X, staticInfo.Y);
779

  
780
        Break;
781
      end;
782
    end;
783
  end;
784
end;
785

  
786
procedure TLandscape.OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream;
787
  ANetState: TNetState);
788
var
789
  sourceBlock, targetBlock: TSeperatedStaticBlock;
790
  sourceSubscriptions, targetSubscriptions: TList;
791
  i: Integer;
792
  statics: TStaticItemList;
793
  staticInfo: TStaticInfo;
794
  staticItem: TStaticItem;
795
  newX, newY: Word;
796
  subscriptions: TLinkedList;
797
  subscriptionItem: PLinkedItem;
798
  insertPacket: TInsertStaticPacket;
799
  deletePacket: TDeleteStaticPacket;
800
  movePacket: TMoveStaticPacket;
801
begin
802
  staticItem := nil;
803
  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
804
  newX := EnsureRange(ABuffer.ReadWord, 0, FCellWidth - 1);
805
  newY := EnsureRange(ABuffer.ReadWord, 0, FCellHeight - 1);
806

  
807
  //Check, if both, source and target, are within a valid region
808
  if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
809
  if not ValidateAccess(ANetState, alNormal, newX, newY) then Exit;
810
  
811
  if (staticInfo.X = newX) and (staticInfo.Y = newY) then Exit;
812
  
813
  if ((abs(staticInfo.X - newX) > 8) or (abs(staticInfo.Y - newY) > 8)) and
814
     (not ValidateAccess(ANetState, alAdministrator)) then Exit;
815
  
816
  sourceBlock := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
817
  targetBlock := GetStaticBlock(newX div 8, newY div 8);
818
  if (sourceBlock <> nil) and (targetBlock <> nil) then
819
  begin
820
    statics := sourceBlock.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
821
    i := 0;
822
    while (i < statics.Count) and (staticItem = nil) do
823
    begin
824
      staticItem := statics[i];
825
      if (staticItem.Z <> staticInfo.Z) or
826
         (staticItem.TileID <> staticInfo.TileID) or
827
         (staticItem.Hue <> staticInfo.Hue) then
828
      begin
829
        staticItem := nil;
830
      end;
831
      Inc(i);
832
    end;
833
    
834
    if staticItem <> nil then
835
    begin
836
      deletePacket := TDeleteStaticPacket.Create(staticItem);
837
      movePacket := TMoveStaticPacket.Create(staticItem, newX, newY);
838

  
839
      i := statics.IndexOf(staticItem);
840
      statics[i] := nil;
841
      statics.Delete(i);
842

  
843
      statics := targetBlock.Cells[(newY mod 8) * 8 + newX mod 8];
844
      statics.Add(staticItem);
845
      staticItem.UpdatePos(newX, newY, staticItem.Z);
846
      staticItem.Owner := targetBlock;
847

  
848
      insertPacket := TInsertStaticPacket.Create(staticItem);
849

  
850
      SortStaticsList(statics);
851

  
852
      sourceSubscriptions := TList.Create;
853
      subscriptions := FBlockSubscriptions[(staticInfo.Y div 8) * FWidth + (staticInfo.X div 8)];
854
      subscriptionItem := nil;
855
      while subscriptions.Iterate(subscriptionItem) do
856
        sourceSubscriptions.Add(subscriptionItem^.Data);
857

  
858
      targetSubscriptions := TList.Create;
859
      subscriptions := FBlockSubscriptions[(newY div 8) * FWidth + (newX div 8)];
860
      subscriptionItem := nil;
861
      while subscriptions.Iterate(subscriptionItem) do
862
        targetSubscriptions.Add(subscriptionItem^.Data);
863

  
864
      for i := 0 to sourceSubscriptions.Count - 1 do
865
      begin
866
        if targetSubscriptions.IndexOf(sourceSubscriptions.Items[i]) > -1 then
867
          CEDServerInstance.SendPacket(TNetState(sourceSubscriptions.Items[i]), movePacket, False)
868
        else
869
          CEDServerInstance.SendPacket(TNetState(sourceSubscriptions.Items[i]), deletePacket, False);
870
      end;
871

  
872
      for i := 0 to targetSubscriptions.Count - 1 do
873
      begin
874
        if sourceSubscriptions.IndexOf(targetSubscriptions.Items[i]) = -1 then
875
          CEDServerInstance.SendPacket(TNetState(sourceSubscriptions.Items[i]), insertPacket, False);
876
      end;
877
      
878
      UpdateRadar(staticInfo.X, staticInfo.Y);
879
      UpdateRadar(newX, newY);
880

  
881
      insertPacket.Free;
882
      deletePacket.Free;
883
      movePacket.Free;
884

  
885
      sourceSubscriptions.Free;
886
      targetSubscriptions.Free;
887
    end;
888
  end;
889
end;
890

  
891
procedure TLandscape.OnHueStaticPacket(ABuffer: TEnhancedMemoryStream;
892
  ANetState: TNetState);
893
var
894
  block: TSeperatedStaticBlock;
895
  i: Integer;
896
  statics: TStaticItemList;
897
  staticInfo: TStaticInfo;
898
  staticItem: TStaticItem;
899
  newHue: Word;
900
  subscriptions: TLinkedList;
901
  subscriptionItem: PLinkedItem;
902
  packet: THueStaticPacket;
903
begin
904
  ABuffer.Read(staticInfo, SizeOf(TStaticInfo));
905

  
906
  if not ValidateAccess(ANetState, alNormal, staticInfo.X, staticInfo.Y) then Exit;
907

  
908
  block := GetStaticBlock(staticInfo.X div 8, staticInfo.Y div 8);
909
  if block <> nil then
910
  begin
911
    statics := block.Cells[(staticInfo.Y mod 8) * 8 + staticInfo.X mod 8];
912
    for i := 0 to statics.Count - 1 do
913
    begin
914
      staticItem := statics[i];
915
      if (staticItem.Z = staticInfo.Z) and
916
         (staticItem.TileID = staticInfo.TileID) and
917
         (staticItem.Hue = staticInfo.Hue) then
918
      begin
919
        newHue := ABuffer.ReadWord;
920
        packet := THueStaticPacket.Create(staticItem, newHue);
921

  
922
        staticItem.Hue := newHue;
923

  
924
        subscriptions := FBlockSubscriptions[(staticInfo.Y div 8) * FWidth + (staticInfo.X div 8)];
925
        subscriptionItem := nil;
926
        while subscriptions.Iterate(subscriptionItem) do
927
          CEDServerInstance.SendPacket(TNetState(subscriptionItem^.Data), packet, False);
928
        packet.Free;
929

  
930
        Break;
931
      end;
932
    end;
933
  end;
934
end;
935

  
936
procedure TLandscape.OnLargeScaleCommandPacket(ABuffer: TEnhancedMemoryStream;
937
  ANetState: TNetState);
938
var
939
  areaInfo: array of TAreaInfo;
940
  areaCount: Byte;
941
  i: Integer;
942
  blockX, blockY, cellX, cellY, x, y: Word;
943
  realBlockX, realBlockY, realCellX, realCellY: Word;
944
  blockOffX, cellOffX, modX, blockOffY, cellOffY, modY: Integer;
945
  blockID, cellID: Cardinal;
946
  emptyBits: TBits;
947
  bitMask: array of TBits;
948
  mapTile: TMapCell;
949
  statics: TStaticItemList;
950
  operations: TList;
951
  clients: array of record
952
    NetState: TNetState;
953
    Blocks: TBlockCoordsArray;
954
  end;
955
  netState: TNetState;
956
  subscriptions: TLinkedList;
957
  subscriptionItem: PLinkedItem;
958
  cmOperation: TLSCopyMove;
959
  additionalAffectedBlocks: TBits;
960
begin
961
  if not ValidateAccess(ANetState, alAdministrator) then Exit;
962
  Writeln(TimeStamp, ANetState.Account.Name, ' begins large scale operation');
963
  CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssOther,
964
    Format('%s is performing large scale operations ...', [ANetState.Account.Name])));
965

  
966
  //Bitmask
967
  emptyBits := TBits.Create(64);
968
  SetLength(bitMask, FWidth * FHeight);
969
  for i := Low(bitMask) to High(bitMask) do
970
    bitMask[i] := TBits.Create(64);
971
  //'additionalAffectedBlocks' is used to store whether a certain block was
972
  //touched during an operation which was designated to another block (for
973
  //example by moving items with an offset). This is (indirectly) merged later
974
  //on.
975
  additionalAffectedBlocks := TBits.Create(FWidth * FHeight);
976

  
977
  areaCount := ABuffer.ReadByte;
978
  SetLength(areaInfo, areaCount);
979
  for i := 0 to areaCount - 1 do
980
  begin
981
    areaInfo[i].Left := Max(ABuffer.ReadWord, 0);
982
    areaInfo[i].Top := Max(ABuffer.ReadWord, 0);
983
    areaInfo[i].Right := Min(ABuffer.ReadWord, FCellWidth - 1);
984
    areaInfo[i].Bottom := Min(ABuffer.ReadWord, FCellHeight - 1);
985
    for x := areaInfo[i].Left to areaInfo[i].Right do
986
      for y := areaInfo[i].Top to areaInfo[i].Bottom do
987
      begin
988
        blockID := (x div 8) * FHeight + (y div 8);
989
        cellID := (y mod 8) * 8 + (x mod 8);
990
        bitMask[blockID].Bits[cellID] := True;
991
      end;
992
  end;
993
  
994
  //client blocks
995
  SetLength(clients, 0);
996
  CEDServerInstance.TCPServer.IterReset;
997
  while CEDServerInstance.TCPServer.IterNext do
998
  begin
999
    netState := TNetState(CEDServerInstance.TCPServer.Iterator.UserData);
1000
    if netState <> nil then
1001
    begin
1002
      SetLength(clients, Length(clients) + 1);
1003
      clients[High(clients)].NetState := netState;
1004
      SetLength(clients[High(clients)].Blocks, 0);
1005
    end;
1006
  end;
1007

  
1008
  operations := TList.Create;
1009
  
1010
  cmOperation := nil;
1011
  if ABuffer.ReadBoolean then
1012
  begin
1013
    cmOperation := TLSCopyMove.Init(ABuffer, Self);
1014
    if (cmOperation.OffsetX <> 0) or (cmOperation.OffsetY <> 0) then
1015
    begin
1016
      operations.Add(cmOperation);
1017

  
1018
      if cmOperation.OffsetX > 0 then
1019
      begin
1020
        blockOffX := FWidth - 1;
1021
        cellOffX := 7;
1022
        modX := -1;
1023
      end else
1024
      begin
1025
        blockOffX := 0;
1026
        cellOffX := 0;
1027
        modX := 1;
1028
      end;
1029

  
1030
      if cmOperation.OffsetY > 0 then
1031
      begin
1032
        blockOffY := FHeight - 1;
1033
        cellOffY := 7;
1034
        modY := -1;
1035
      end else
1036
      begin
1037
        blockOffY := 0;
1038
        cellOffY := 0;
1039
        modY := 1;
1040
      end;
1041
    end else
1042
      FreeAndNil(cmOperation);
1043
  end;
1044
  if cmOperation = nil then
1045
  begin
1046
    blockOffX := 0;
1047
    cellOffX := 0;
1048
    modX := 1;
1049
    blockOffY := 0;
1050
    cellOffY := 0;
1051
    modY := 1;
1052
  end;
1053
  if ABuffer.ReadBoolean then operations.Add(TLSSetAltitude.Init(ABuffer, Self));
1054
  if ABuffer.ReadBoolean then operations.Add(TLSDrawTerrain.Init(ABuffer, Self));
1055
  if ABuffer.ReadBoolean then operations.Add(TLSDeleteStatics.Init(ABuffer, Self));
1056
  if ABuffer.ReadBoolean then operations.Add(TLSInsertStatics.Init(ABuffer, Self));
1057
  
1058
  FRadarMap.BeginUpdate;
1059
  for blockX := 0 to FWidth - 1 do
1060
  begin
1061
    realBlockX := blockOffX + modX * blockX;
1062
    for blockY := 0 to FHeight - 1 do
1063
    begin
1064
      realBlockY := blockOffY + modY * blockY;
1065
      blockID := (realBlockX * FHeight) + realBlockY;
1066
      if bitMask[blockID].Equals(emptyBits) then Continue;
1067
      
1068
      for cellY := 0 to 7 do
1069
      begin
1070
        realCellY := cellOffY + modY * cellY;
1071
        for cellX := 0 to 7 do
1072
        begin
1073
          realCellX := cellOffX + modX * cellX;
1074
          if bitMask[blockID].Bits[(realCellY * 8) + realCellX] then
1075
          begin
1076
            x := realBlockX * 8 + realCellX;
1077
            y := realBlockY * 8 + realCellY;
1078
            mapTile := GetMapCell(x, y);
1079
            statics := GetStaticList(x, y);
1080
            for i := 0 to operations.Count - 1 do
1081
              TLargeScaleOperation(operations.Items[i]).Apply(mapTile, statics,
1082
                additionalAffectedBlocks);
1083
            SortStaticsList(statics);
1084
              
1085
            UpdateRadar(x, y);
1086
          end;
1087
        end;
1088
      end;
1089

  
1090
      //Find out, which clients are affected by which blocks.
1091
      //This is used to efficiently update the block subscriptions.
1092
      subscriptions := FBlockSubscriptions[realBlockY * FWidth + realBlockX];
1093
      for i := Low(clients) to High(clients) do
1094
      begin
1095
        subscriptionItem := nil;
1096
        while subscriptions.Iterate(subscriptionItem) do
1097
        begin
1098
          if TNetState(subscriptionItem^.Data) = clients[i].NetState then
1099
          begin
1100
            SetLength(clients[i].Blocks, Length(clients[i].Blocks) + 1);
1101
            with clients[i].Blocks[High(clients[i].Blocks)] do
1102
            begin
1103
              X := realBlockX;
1104
              Y := realBlockY;
1105
            end;
1106
            Break;
1107
          end;
1108
        end;
1109
      end;
1110
      
1111
    end;
1112
  end;
1113
  
1114
  //additional blocks
1115
  for blockX := 0 to FWidth - 1 do
1116
  begin
1117
    for blockY := 0 to FHeight - 1 do
1118
    begin
1119
      blockID := (blockX * FHeight) + blockY;
1120
      if bitMask[blockID].Equals(emptyBits) and additionalAffectedBlocks[blockID] then
1121
      begin
1122
        //Update the information, which client is affected on which subscribed
1123
        //block.
1124
        subscriptions := FBlockSubscriptions[blockY * FWidth + blockX];
1125
        for i := Low(clients) to High(clients) do
1126
        begin
1127
          subscriptionItem := nil;
1128
          while subscriptions.Iterate(subscriptionItem) do
1129
          begin
1130
            if TNetState(subscriptionItem^.Data) = clients[i].NetState then
1131
            begin
1132
              SetLength(clients[i].Blocks, Length(clients[i].Blocks) + 1);
1133
              with clients[i].Blocks[High(clients[i].Blocks)] do
1134
              begin
1135
                X := blockX;
1136
                Y := blockY;
1137
              end;
1138
              Break;
1139
            end;
1140
          end;
1141
        end;
1142
        
1143
        UpdateRadar(blockX * 8, blockY * 8);
1144
        
1145
      end;
1146
    end;
1147
  end;
1148
  
1149
  //clean up
1150
  for i := Low(bitMask) to High(bitMask) do
1151
    bitMask[i].Free;
1152
  emptyBits.Free;
1153
  additionalAffectedBlocks.Free;
1154
  
1155
  for i := 0 to operations.Count - 1 do
1156
    TLargeScaleOperation(operations.Items[i]).Free;
1157
  operations.Free;
1158
  
1159
  //Update clients
1160
  FRadarMap.EndUpdate;
1161
  for i := Low(clients) to High(clients) do
1162
  begin
1163
    if Length(clients[i].Blocks) > 0 then
1164
    begin
1165
      CEDServerInstance.SendPacket(clients[i].NetState, TCompressedPacket.Create(
1166
        TBlockPacket.Create(clients[i].Blocks, nil)));
1167
      clients[i].NetState.LastAction := Now;
1168
    end;
1169
  end;
1170

  
1171
  CEDServerInstance.SendPacket(nil, TServerStatePacket.Create(ssRunning));
1172
  Writeln(TimeStamp, 'Large scale operation ended.');
1173
end;
1174

  
1175
end.
1176

  
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 ULandscape;
27

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

  
30
interface
31

  
32
uses
33
  SysUtils, Classes, math, UGenericIndex, UMap, UStatics, UWorldItem, UMulBlock,
34
  UTileDataProvider, URadarMap,
35
  UCacheManager, ULinkedList, UBufferedStreams,
36
  UEnhancedMemoryStream, UPacketHandlers, UPackets, UNetState, UEnums;
37

  
38
type
39
  PRadarBlock = ^TRadarBlock;
40
  TRadarBlock = array[0..7, 0..7] of Word;
41
  TBlockSubscriptions = array of TLinkedList;
42

  
43
  { TSeperatedStaticBlock }
44

  
45
  TSeperatedStaticBlock = class(TStaticBlock)
46
    constructor Create(AData: TStream; AIndex: TGenericIndex; AX, AY: Word); overload;
47
    constructor Create(AData: TStream; AIndex: TGenericIndex); overload;
48
    destructor Destroy; override;
49
  protected
50
    FTiledataProvider: TTiledataProvider;
51
  public
52
    { Fields }
53
    Cells: array[0..63] of TStaticItemList;
54
    property TiledataProvider: TTiledataProvider read FTiledataProvider
55
      write FTiledataProvider;
56

  
57
    { Methods }
58
    function Clone: TSeperatedStaticBlock; override;
59
    function GetSize: Integer; override;
60
    procedure RebuildList;
61
  end;
62
  
63
  { TBlock }
64

  
65
  TBlock = class
66
    constructor Create(AMap: TMapBlock; AStatics: TSeperatedStaticBlock);
67
    destructor Destroy; override;
68
  protected
69
    FMapBlock: TMapBlock;
70
    FStaticBlock: TSeperatedStaticBlock;
71
  public
72
    property Map: TMapBlock read FMapBlock;
73
    property Static: TSeperatedStaticBlock read FStaticBlock;
74
  end;
75

  
76
  TBlockCache = specialize TCacheManager<TBlock>;
77

  
78
  { TLandscape }
79

  
80
  TLandscape = class
81
    constructor Create(AMap, AStatics, AStaIdx, ATiledata, ARadarCol: string;
82
      AWidth, AHeight: Word; var AValid: Boolean);
83
    constructor Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
84
      ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
85
    destructor Destroy; override;
86
  protected
87
    FWidth: Word;
88
    FHeight: Word;
89
    FCellWidth: Word;
90
    FCellHeight: Word;
91
    FMap: TStream;
92
    FStatics: TStream;
93
    FStaIdx: TStream;
94
    FTiledata: TStream;
95
    FTiledataProvider: TTiledataProvider;
96
    FOwnsStreams: Boolean;
97
    FRadarMap: TRadarMap;
98
    FBlockCache: TBlockCache;
99
    FBlockSubscriptions: TBlockSubscriptions;
100
    procedure OnRemoveCachedObject(ABlock: TBlock);
101
    function GetMapCell(AX, AY: Word): TMapCell;
102
    function GetStaticList(AX, AY: Word): TStaticItemList;
103
    function GetBlockSubscriptions(AX, AY: Word): TLinkedList;
104

  
105
    procedure OnDrawMapPacket(ABuffer: TEnhancedMemoryStream;
106
      ANetState: TNetState);
107
    procedure OnInsertStaticPacket(ABuffer: TEnhancedMemoryStream;
108
      ANetState: TNetState);
109
    procedure OnDeleteStaticPacket(ABuffer: TEnhancedMemoryStream;
110
      ANetState: TNetState);
111
    procedure OnElevateStaticPacket(ABuffer: TEnhancedMemoryStream;
112
      ANetState: TNetState);
113
    procedure OnMoveStaticPacket(ABuffer: TEnhancedMemoryStream;
114
      ANetState: TNetState);
115
    procedure OnHueStaticPacket(ABuffer: TEnhancedMemoryStream;
116
      ANetState: TNetState);
117
    procedure OnLargeScaleCommandPacket(ABuffer: TEnhancedMemoryStream;
118
      ANetState: TNetState);
119
  public
120
    property Width: Word read FWidth;
121
    property Height: Word read FHeight;
122
    property CellWidth: Word read FCellWidth;
123
    property CellHeight: Word read FCellHeight;
124
    property MapCell[X, Y: Word]: TMapCell read GetMapCell;
125
    property StaticList[X, Y: Word]: TStaticItemList read GetStaticList;
126
    property BlockSubscriptions[X, Y: Word]: TLinkedList read GetBlockSubscriptions;
127
    property TiledataProvider: TTiledataProvider read FTiledataProvider;
128

  
129
    function GetMapBlock(AX, AY: Word): TMapBlock;
130
    function GetStaticBlock(AX, AY: Word): TSeperatedStaticBlock;
131
    function LoadBlock(AX, AY: Word): TBlock;
132

  
133
    procedure UpdateRadar(AX, AY: Word);
134
    function GetEffectiveAltitude(ATile: TMapCell): ShortInt;
135
    function GetLandAlt(AX, AY: Word; ADefault: ShortInt): ShortInt;
136
    procedure SortStaticsList(AStatics: TStaticItemList);
137

  
138
    procedure Flush;
139
    procedure SaveBlock(AWorldBlock: TWorldBlock);
140
    function Validate: Boolean;
141
  end;
142
  
143
  TStaticInfo = packed record
144
    X: Word;
145
    Y: Word;
146
    Z: ShortInt;
147
    TileID: Word;
148
    Hue: Word;
149
  end;
150
  TAreaInfo = packed record
151
    Left: Word;
152
    Top: Word;
153
    Right: Word;
154
    Bottom: Word;
155
  end;
156
  TWorldPoint = packed record
157
    X: Word;
158
    Y: Word;
159
  end;
160
  
161
function PointInArea(AArea: TAreaInfo; AX, AY: Word): Boolean; inline;
162

  
163
implementation
164

  
165
uses
166
  UCEDServer, UConnectionHandling, UConfig, ULargeScaleOperations, Logging;
167

  
168
function GetID(AX, AY: Word): Integer;
169
begin
170
  Result := ((AX and $7FFF) shl 15) or (AY and $7FFF);
171
end;
172

  
173
function PointInArea(AArea: TAreaInfo; AX, AY: Word): Boolean;
174
begin
175
  Result := InRange(AX, AArea.Left, AArea.Right) and
176
            InRange(AY, AArea.Top, AArea.Bottom);
177
end;
178

  
179
{ TSeperatedStaticBlock }
180

  
181
constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex;
182
  AX, AY: Word);
183
var
184
  i: Integer;
185
  item: TStaticItem;
186
  block: TMemoryStream;
187
begin
188
  inherited Create;
189
  FItems := TStaticItemList.Create(False);
190

  
191
  FX := AX;
192
  FY := AY;
193

  
194
  for i := 0 to 63 do
195
    Cells[i] := TStaticItemList.Create(True);
196

  
197
  if (AData <> nil) and (AIndex.Lookup > 0) and (AIndex.Size > 0) then
198
  begin
199
    AData.Position := AIndex.Lookup;
200
    block := TMemoryStream.Create;
201
    block.CopyFrom(AData, AIndex.Size);
202
    block.Position := 0;
203
    for i := 1 to (AIndex.Size div 7) do
204
    begin
205
      item := TStaticItem.Create(Self, block, AX, AY);
206
      Cells[(item.Y mod 8) * 8 + (item.X mod 8)].Add(item);
207
    end;
208
    block.Free;
209
  end;
210
end;
211

  
212
constructor TSeperatedStaticBlock.Create(AData: TStream; AIndex: TGenericIndex);
213
begin
214
  Create(AData, AIndex, 0, 0);
215
end;
216

  
217
destructor TSeperatedStaticBlock.Destroy;
218
var
219
  i: Integer;
220
begin
221
  FreeAndNil(FItems);
222

  
223
  for i := 0 to 63 do
224
    FreeAndNil(Cells[i]);
225

  
226
  inherited Destroy;
227
end;
228

  
229
function TSeperatedStaticBlock.Clone: TSeperatedStaticBlock;
230
begin
231
  raise Exception.Create('TSeperatedStaticBlock.Clone is not implemented (yet).');
232
  Result := nil;
233
end;
234

  
235
function TSeperatedStaticBlock.GetSize: Integer;
236
begin
237
  RebuildList;
238
  Result := inherited GetSize;
239
end;
240

  
241
procedure TSeperatedStaticBlock.RebuildList;
242
var
243
  i, j, solver: Integer;
244
begin
245
  FItems.Clear;
246
  solver := 0;
247
  for i := 0 to 63 do
248
  begin
249
    if Cells[i] <> nil then
250
    begin
251
      for j := 0 to Cells[i].Count - 1 do
252
      begin
253
        FItems.Add(Cells[i].Items[j]);
254
        if Cells[i].Items[j].TileID < FTiledataProvider.StaticCount then
255
        begin
256
          Cells[i].Items[j].UpdatePriorities(
257
            FTiledataProvider.StaticTiles[Cells[i].Items[j].TileID], solver);
258
        end else
259
          Logger.Send([lcLandscape, lcServer, lcError], 'Cannot find Tiledata ' +
260
            'for the Static Item with ID $%x.', [Cells[i].Items[j].TileID]);
261
        Inc(solver);
262
      end;
263
    end;
264
  end;
265
  Sort;
266
end;
267

  
268
{ TBlock }
269

  
270
constructor TBlock.Create(AMap: TMapBlock; AStatics: TSeperatedStaticBlock);
271
begin
272
  inherited Create;
273
  FMapBlock := AMap;
274
  FStaticBlock := AStatics;
275
end;
276

  
277
destructor TBlock.Destroy;
278
begin
279
  FreeAndNil(FMapBlock);
280
  FreeAndNil(FStaticBlock);
281
  inherited Destroy;
282
end;
283

  
284
{ TLandscape }
285

  
286
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata,
287
  ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
288
var
289
  map, statics, staidx, tiledata: TStream;
290
begin
291
  Write(TimeStamp, 'Loading Map');
292
  map := TFileStream.Create(AMap, fmOpenReadWrite);
293
  Write(', Statics');
294
  statics := TFileStream.Create(AStatics, fmOpenReadWrite);
295
  Write(', StaIdx');
296
  staidx := TBufferedReader.Create(TFileStream.Create(AStaIdx, fmOpenReadWrite), True);
297
  Writeln(', Tiledata');
298
  tiledata := TFileStream.Create(ATiledata, fmOpenRead or fmShareDenyWrite);
299
  Create(map, statics, staidx, tiledata, ARadarCol, AWidth, AHeight, AValid);
300
  FOwnsStreams := True;
301
end;
302

  
303
constructor TLandscape.Create(AMap, AStatics, AStaIdx, ATiledata: TStream;
304
  ARadarCol: string; AWidth, AHeight: Word; var AValid: Boolean);
305
var
306
  blockID: Integer;
307
begin
308
  inherited Create;
309
  FWidth := AWidth;
310
  FHeight := AHeight;
311
  FCellWidth := FWidth * 8;
312
  FCellHeight := FHeight * 8;
313
  FMap := AMap;
314
  FStatics := AStatics;
315
  FStaIdx := AStaIdx;
316
  FTiledata := ATiledata;
317
  FOwnsStreams := False;
318
  AValid := Validate;
319
  if AValid then
320
  begin
321
    Write(TimeStamp, 'Creating Cache');
... This diff was truncated because it exceeds the maximum size that can be displayed.

Also available in: Unified diff