Revision 13:c78b5eafa10e Server/URadarMap.pas

b/Server/URadarMap.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 2007 Andreas Schneider
25
 *)
26
unit URadarMap;
27

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

  
30
interface
31

  
32
uses
33
  Classes, SysUtils, UConfig, UNetState, UEnhancedMemoryStream, UEnums;
34
  
35
type
36

  
37
  TRadarColorArray = array of Word;
38

  
39
  { TRadarMap }
40

  
41
  TRadarMap = class(TObject)
42
    constructor Create(AMap, AStatics, AStaIdx: TStream; AWidth, AHeight: Word;
43
      ARadarCol: string);
44
    destructor Destroy; override;
45
  protected
46
    FWidth: Word;
47
    FHeight: Word;
48
    FRadarColors: TRadarColorArray;
49
    FRadarMap: TRadarColorArray;
50
    FPackets: TList;
51
    FPacketSize: Cardinal;
52
    procedure OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
53
      ANetState: TNetState);
54
  public
55
    procedure Update(AX, AY, ATileID: Word);
56
    procedure BeginUpdate;
57
    procedure EndUpdate;
58
  end;
59

  
60
implementation
61

  
62
uses
63
  UPacket, UPackets, UPacketHandlers, UCEDServer, crc;
64

  
65
type
66
  TMulIndex = packed record
67
    Position: Cardinal;
68
    Size: Cardinal;
69
    Userdata: Cardinal;
70
  end;
71
  TMapCell = packed record
72
    TileID: Word;
73
    Altitude: ShortInt;
74
  end;
75
  TStaticItem = packed record
76
    TileID: Word;
77
    X, Y: Byte;
78
    Z: ShortInt;
79
    Hue: Word;
80
  end;
81
  
82
  { TRadarChecksumPacket }
83

  
84
  TRadarChecksumPacket = class(TPacket)
85
    constructor Create(ARadarMap: TRadarColorArray);
86
  end;
87
  
88
  { TRadarMapPacket }
89

  
90
  TRadarMapPacket = class(TPacket)
91
    constructor Create(ARadarMap: TRadarColorArray);
92
  end;
93
  
94
  { TUpdateRadarPacket }
95

  
96
  TUpdateRadarPacket = class(TPacket)
97
    constructor Create(AX, AY, AColor: Word);
98
  end;
99

  
100
{ TRadarChecksumPacket }
101

  
102
constructor TRadarChecksumPacket.Create(ARadarMap: TRadarColorArray);
103
var
104
  checksum: Cardinal;
105
begin
106
  inherited Create($0D, 0);
107
  FStream.WriteByte($01);
108
  checksum := crc32(0, nil, 0);
109
  checksum := crc32(checksum, @ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
110
  FStream.WriteCardinal(checksum);
111
end;
112

  
113
{ TRadarMapPacket }
114

  
115
constructor TRadarMapPacket.Create(ARadarMap: TRadarColorArray);
116
begin
117
  inherited Create($0D, 0);
118
  FStream.WriteByte($02);
119
  FStream.Write(ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
120
end;
121

  
122
{ TUpdateRadarPacket }
123

  
124
constructor TUpdateRadarPacket.Create(AX, AY, AColor: Word);
125
begin
126
  inherited Create($0D, 0);
127
  FStream.WriteByte($03);
128
  FStream.WriteWord(AX);
129
  FStream.WriteWord(AY);
130
  FStream.WriteWord(AColor);
131
end;
132

  
133
{ TRadarMap }
134

  
135
constructor TRadarMap.Create(AMap, AStatics, AStaIdx: TStream; AWidth,
136
  AHeight: Word; ARadarCol: string);
137
var
138
  radarcol: TFileStream;
139
  count, i, item, highestZ: Integer;
140
  staticsItems: array of TStaticItem;
141
  mapCell: TMapCell;
142
  index: TMulIndex;
143
begin
144
  radarcol := TFileStream.Create(ARadarCol, fmOpenRead);
145
  SetLength(FRadarColors, radarcol.Size div SizeOf(Word));
146
  radarcol.Read(FRadarColors[0], radarcol.Size);
147
  radarcol.Free;
148
  
149
  FWidth := AWidth;
150
  FHeight := AHeight;
151
  
152
  count := AWidth * AHeight;
153
  SetLength(FRadarMap, count);
154
  
155
  AMap.Position := 4;
156
  AStaIdx.Position := 0;
157

  
158
  for i := 0 to count - 1 do
159
  begin
160
    AMap.Read(mapCell, SizeOf(TMapCell));
161
    AMap.Seek(193, soFromCurrent);
162
    FRadarMap[i] := FRadarColors[mapCell.TileID];
163
    AStaIdx.Read(index, SizeOf(TMulIndex));
164
    if (index.Position < $FFFFFFFF) and (index.Size > 0) then
165
    begin
166
      AStatics.Position := index.Position;
167
      SetLength(staticsItems, index.Size div 7);
168
      AStatics.Read(staticsItems[0], index.Size);
169
      highestZ := mapCell.Altitude;
170
      for item := Low(staticsItems) to High(staticsItems) do
171
      begin
172
        if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and
173
          (staticsItems[item].Z >= highestZ) then
174
        begin
175
          highestZ := staticsItems[item].Z;
176
          FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000];
177
        end;
178
      end;
179
    end;
180
  end;
181
  
182
  FPackets := nil;
183
  
184
  RegisterPacketHandler($0D, TPacketHandler.Create(2, @OnRadarHandlingPacket));
185
  
186
  inherited Create;
187
end;
188

  
189
destructor TRadarMap.Destroy;
190
begin
191
  RegisterPacketHandler($0D, nil);
192
  inherited Destroy;
193
end;
194

  
195
procedure TRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
196
  ANetState: TNetState);
197
var
198
  subID: Byte;
199
begin
200
  if not ValidateAccess(ANetState, alView) then Exit;
201
  
202
  subID := ABuffer.ReadByte;
203
  case subID of
204
    $01: //request checksum
205
      begin
206
        CEDServerInstance.SendPacket(ANetState, TRadarChecksumPacket.Create(
207
          FRadarMap));
208
      end;
209
    $02: //request radarmap
210
      begin
211
        CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
212
          TRadarMapPacket.Create(FRadarMap)));
213
      end;
214
  end;
215
end;
216

  
217
procedure TRadarMap.Update(AX, AY, ATileID: Word);
218
var
219
  color: Word;
220
  block: Cardinal;
221
  packet: TPacket;
222
begin
223
  block := AX * FHeight + AY;
224
  color := FRadarColors[ATileID];
225
  if FRadarMap[block] <> color then
226
  begin
227
    FRadarMap[block] := color;
228
    packet := TUpdateRadarPacket.Create(AX, AY, color);
229
    if FPackets <> nil then
230
    begin
231
      FPackets.Add(packet);
232
      Inc(FPacketSize, packet.Stream.Size);
233
    end else
234
      CEDServerInstance.SendPacket(nil, packet);
235
  end;
236
end;
237

  
238
procedure TRadarMap.BeginUpdate;
239
begin
240
  if FPackets <> nil then Exit;
241
  FPackets := TList.Create;
242
  FPacketSize := 0;
243
end;
244

  
245
procedure TRadarMap.EndUpdate;
246
var
247
  completePacket: TPacket;
248
  i: Integer;
249
begin
250
  if FPackets = nil then Exit;
251
  completePacket := TCompressedPacket.Create(TRadarMapPacket.Create(FRadarMap));
252
  if completePacket.Stream.Size <= (FPacketSize div 4) * 5 then
253
  begin
254
    CEDServerInstance.SendPacket(nil, completePacket);
255
    for i := 0 to FPackets.Count - 1 do
256
      TPacket(FPackets.Items[i]).Free;
257
  end else
258
  begin
259
    for i := 0 to FPackets.Count - 1 do
260
      CEDServerInstance.SendPacket(nil, TPacket(FPackets.Items[i]));
261
    completePacket.Free;
262
  end;
263
  FreeAndNil(FPackets);
264
end;
265

  
266
end.
267

  
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 2007 Andreas Schneider
25
 *)
26
unit URadarMap;
27

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

  
30
interface
31

  
32
uses
33
  Classes, SysUtils, UConfig, UNetState, UEnhancedMemoryStream, UEnums;
34
  
35
type
36

  
37
  TRadarColorArray = array of Word;
38

  
39
  { TRadarMap }
40

  
41
  TRadarMap = class(TObject)
42
    constructor Create(AMap, AStatics, AStaIdx: TStream; AWidth, AHeight: Word;
43
      ARadarCol: string);
44
    destructor Destroy; override;
45
  protected
46
    FWidth: Word;
47
    FHeight: Word;
48
    FRadarColors: TRadarColorArray;
49
    FRadarMap: TRadarColorArray;
50
    FPackets: TList;
51
    FPacketSize: Cardinal;
52
    procedure OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
53
      ANetState: TNetState);
54
  public
55
    procedure Update(AX, AY, ATileID: Word);
56
    procedure BeginUpdate;
57
    procedure EndUpdate;
58
  end;
59

  
60
implementation
61

  
62
uses
63
  UPacket, UPackets, UPacketHandlers, UCEDServer, crc;
64

  
65
type
66
  TMulIndex = packed record
67
    Position: Cardinal;
68
    Size: Cardinal;
69
    Userdata: Cardinal;
70
  end;
71
  TMapCell = packed record
72
    TileID: Word;
73
    Altitude: ShortInt;
74
  end;
75
  TStaticItem = packed record
76
    TileID: Word;
77
    X, Y: Byte;
78
    Z: ShortInt;
79
    Hue: Word;
80
  end;
81
  
82
  { TRadarChecksumPacket }
83

  
84
  TRadarChecksumPacket = class(TPacket)
85
    constructor Create(ARadarMap: TRadarColorArray);
86
  end;
87
  
88
  { TRadarMapPacket }
89

  
90
  TRadarMapPacket = class(TPacket)
91
    constructor Create(ARadarMap: TRadarColorArray);
92
  end;
93
  
94
  { TUpdateRadarPacket }
95

  
96
  TUpdateRadarPacket = class(TPacket)
97
    constructor Create(AX, AY, AColor: Word);
98
  end;
99

  
100
{ TRadarChecksumPacket }
101

  
102
constructor TRadarChecksumPacket.Create(ARadarMap: TRadarColorArray);
103
var
104
  checksum: Cardinal;
105
begin
106
  inherited Create($0D, 0);
107
  FStream.WriteByte($01);
108
  checksum := crc32(0, nil, 0);
109
  checksum := crc32(checksum, @ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
110
  FStream.WriteCardinal(checksum);
111
end;
112

  
113
{ TRadarMapPacket }
114

  
115
constructor TRadarMapPacket.Create(ARadarMap: TRadarColorArray);
116
begin
117
  inherited Create($0D, 0);
118
  FStream.WriteByte($02);
119
  FStream.Write(ARadarMap[0], Length(ARadarMap) * SizeOf(Word));
120
end;
121

  
122
{ TUpdateRadarPacket }
123

  
124
constructor TUpdateRadarPacket.Create(AX, AY, AColor: Word);
125
begin
126
  inherited Create($0D, 0);
127
  FStream.WriteByte($03);
128
  FStream.WriteWord(AX);
129
  FStream.WriteWord(AY);
130
  FStream.WriteWord(AColor);
131
end;
132

  
133
{ TRadarMap }
134

  
135
constructor TRadarMap.Create(AMap, AStatics, AStaIdx: TStream; AWidth,
136
  AHeight: Word; ARadarCol: string);
137
var
138
  radarcol: TFileStream;
139
  count, i, item, highestZ: Integer;
140
  staticsItems: array of TStaticItem;
141
  mapCell: TMapCell;
142
  index: TMulIndex;
143
begin
144
  radarcol := TFileStream.Create(ARadarCol, fmOpenRead);
145
  SetLength(FRadarColors, radarcol.Size div SizeOf(Word));
146
  radarcol.Read(FRadarColors[0], radarcol.Size);
147
  radarcol.Free;
148
  
149
  FWidth := AWidth;
150
  FHeight := AHeight;
151
  
152
  count := AWidth * AHeight;
153
  SetLength(FRadarMap, count);
154
  
155
  AMap.Position := 4;
156
  AStaIdx.Position := 0;
157

  
158
  for i := 0 to count - 1 do
159
  begin
160
    AMap.Read(mapCell, SizeOf(TMapCell));
161
    AMap.Seek(193, soFromCurrent);
162
    FRadarMap[i] := FRadarColors[mapCell.TileID];
163
    AStaIdx.Read(index, SizeOf(TMulIndex));
164
    if (index.Position < $FFFFFFFF) and (index.Size > 0) then
165
    begin
166
      AStatics.Position := index.Position;
167
      SetLength(staticsItems, index.Size div 7);
168
      AStatics.Read(staticsItems[0], index.Size);
169
      highestZ := mapCell.Altitude;
170
      for item := Low(staticsItems) to High(staticsItems) do
171
      begin
172
        if (staticsItems[item].X = 0) and (staticsItems[item].Y = 0) and
173
          (staticsItems[item].Z >= highestZ) then
174
        begin
175
          highestZ := staticsItems[item].Z;
176
          FRadarMap[i] := FRadarColors[staticsItems[item].TileID + $4000];
177
        end;
178
      end;
179
    end;
180
  end;
181
  
182
  FPackets := nil;
183
  
184
  RegisterPacketHandler($0D, TPacketHandler.Create(2, @OnRadarHandlingPacket));
185
  
186
  inherited Create;
187
end;
188

  
189
destructor TRadarMap.Destroy;
190
begin
191
  RegisterPacketHandler($0D, nil);
192
  inherited Destroy;
193
end;
194

  
195
procedure TRadarMap.OnRadarHandlingPacket(ABuffer: TEnhancedMemoryStream;
196
  ANetState: TNetState);
197
var
198
  subID: Byte;
199
begin
200
  if not ValidateAccess(ANetState, alView) then Exit;
201
  
202
  subID := ABuffer.ReadByte;
203
  case subID of
204
    $01: //request checksum
205
      begin
206
        CEDServerInstance.SendPacket(ANetState, TRadarChecksumPacket.Create(
207
          FRadarMap));
208
      end;
209
    $02: //request radarmap
210
      begin
211
        CEDServerInstance.SendPacket(ANetState, TCompressedPacket.Create(
212
          TRadarMapPacket.Create(FRadarMap)));
213
      end;
214
  end;
215
end;
216

  
217
procedure TRadarMap.Update(AX, AY, ATileID: Word);
218
var
219
  color: Word;
220
  block: Cardinal;
221
  packet: TPacket;
222
begin
223
  block := AX * FHeight + AY;
224
  color := FRadarColors[ATileID];
225
  if FRadarMap[block] <> color then
226
  begin
227
    FRadarMap[block] := color;
228
    packet := TUpdateRadarPacket.Create(AX, AY, color);
229
    if FPackets <> nil then
230
    begin
231
      FPackets.Add(packet);
232
      Inc(FPacketSize, packet.Stream.Size);
233
    end else
234
      CEDServerInstance.SendPacket(nil, packet);
235
  end;
236
end;
237

  
238
procedure TRadarMap.BeginUpdate;
239
begin
240
  if FPackets <> nil then Exit;
241
  FPackets := TList.Create;
242
  FPacketSize := 0;
243
end;
244

  
245
procedure TRadarMap.EndUpdate;
246
var
247
  completePacket: TPacket;
248
  i: Integer;
249
begin
250
  if FPackets = nil then Exit;
251
  completePacket := TCompressedPacket.Create(TRadarMapPacket.Create(FRadarMap));
252
  if completePacket.Stream.Size <= (FPacketSize div 4) * 5 then
253
  begin
254
    CEDServerInstance.SendPacket(nil, completePacket);
255
    for i := 0 to FPackets.Count - 1 do
256
      TPacket(FPackets.Items[i]).Free;
257
  end else
258
  begin
259
    for i := 0 to FPackets.Count - 1 do
260
      CEDServerInstance.SendPacket(nil, TPacket(FPackets.Items[i]));
261
    completePacket.Free;
262
  end;
263
  FreeAndNil(FPackets);
264
end;
265

  
266
end.
267

  

Also available in: Unified diff