Revision 119:66352054ce4d UOLib/UMap.pas

b/UOLib/UMap.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 UMap;
27

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

  
30
interface
31

  
32
uses
33
  SysUtils, Classes, fgl, UMulBlock, UWorldItem;
34

  
35
const
36
  MapCellSize = 3;
37
  MapBlockSize = 4 + (64 * MapCellSize);
38

  
39
type
40

  
41
  { TMapCell }
42

  
43
  TMapCell = class(TWorldItem)
44
    constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
45
    constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
46
  protected
47
    FIsGhost: Boolean;
48
    FGhostZ: ShortInt;
49
    FGhostID: Word;
50
    function GetTileID: Word; override;
51
    function GetZ: ShortInt; override;
52
  public
53
    property Altitude: ShortInt read GetZ write SetZ;
54
    property IsGhost: Boolean read FIsGhost write FIsGhost;
55
    property GhostZ: ShortInt read FGhostZ write FGhostZ;
56
    property GhostID: Word write FGhostID;
57

  
58
    function Clone: TMapCell; override;
59
    function GetSize: Integer; override;
60
    procedure Write(AData: TStream); override;
61
  end;
62

  
63
  TMapCellList = specialize TFPGObjectList<TMapCell>;
64

  
65
  { TMapBlock }
66

  
67
  TMapBlock = class(TWorldBlock)
68
    constructor Create(AData: TStream; AX, AY: Word); overload;
69
    constructor Create(AData: TStream); overload;
70
    destructor Destroy; override;
71
  protected
72
    FHeader: LongInt;
73
  public
74
    Cells: array[0..63] of TMapCell;
75
    property Header: LongInt read FHeader write FHeader;
76
    function Clone: TMapBlock; override;
77
    function GetSize: Integer; override;
78
    procedure Write(AData: TStream); override;
79
  end;
80

  
81
function GetMapCellOffset(ABlock: Integer): Integer;
82

  
83
implementation
84

  
85
function GetMapCellOffset(ABlock: Integer): Integer;
86
var
87
  group, tile: Integer;
88
begin
89
  group := ABlock div 64;
90
  tile := ABlock mod 64;
91

  
92
  Result := group * MapBlockSize + 4 + tile * MapCellSize;
93
end;
94

  
95
{ TMapCell }
96

  
97
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
98
begin
99
  inherited Create(AOwner);
100

  
101
  FX := AX;
102
  FY := AY;
103
  if AData <> nil then
104
  begin
105
    AData.Read(FTileID, SizeOf(Word));
106
    AData.Read(FZ, SizeOf(ShortInt));
107
  end;
108

  
109
  FIsGhost := False;
110

  
111
  InitOriginalState;
112
end;
113

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

  
119
function TMapCell.GetTileID: Word;
120
begin
121
  if FIsGhost then
122
    Result := FGhostID
123
  else
124
    Result := FTileID;
125
end;
126

  
127
function TMapCell.GetZ: ShortInt;
128
begin
129
  if FIsGhost then
130
    Result := FGhostZ
131
  else
132
    Result := FZ;
133
end;
134

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

  
144
procedure TMapCell.Write(AData: TStream);
145
begin
146
  AData.Write(FTileID, SizeOf(Word));
147
  AData.Write(FZ, SizeOf(ShortInt));
148
end;
149

  
150
function TMapCell.GetSize: Integer;
151
begin
152
  Result := MapCellSize;
153
end;
154

  
155
{ TMapBlock }
156

  
157
constructor TMapBlock.Create(AData: TStream; AX, AY: Word);
158
var
159
  iX, iY: Integer;
160
  buffer: TMemoryStream;
161
begin
162
  inherited Create;
163
  FX := AX;
164
  FY := AY;
165
  try
166
    buffer := nil;
167
    if Assigned(AData) then
168
    begin
169
      buffer := TMemoryStream.Create;
170
      buffer.CopyFrom(AData, 196);
171
      buffer.Position := 0;
172
      buffer.Read(FHeader, SizeOf(LongInt));
173
    end;
174
    for iY := 0 to 7 do
175
      for iX := 0 to 7 do
176
        Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY);
177
  finally
178
    if Assigned(buffer) then FreeAndNil(buffer);
179
  end;
180
end;
181

  
182
constructor TMapBlock.Create(AData: TStream);
183
begin
184
  Create(AData, 0, 0);
185
end;
186

  
187
destructor TMapBlock.Destroy;
188
var
189
  i: Integer;
190
begin
191
  for i := 0 to 63 do
192
    Cells[i].Free;
193
  inherited;
194
end;
195

  
196
function TMapBlock.Clone: TMapBlock;
197
var
198
  i: Integer;
199
begin
200
  Result := TMapBlock.Create(nil);
201
  Result.FX := FX;
202
  Result.FY := FY;
203
  for i := 0 to 63 do
204
    Result.Cells[i] := Cells[i].Clone;
205
end;
206

  
207
procedure TMapBlock.Write(AData: TStream);
208
var
209
  i: Integer;
210
begin
211
  AData.Write(FHeader, SizeOf(LongInt));
212
  for i := 0 to 63 do
213
    Cells[i].Write(AData);
214
end;
215

  
216
function TMapBlock.GetSize: Integer;
217
begin
218
  Result := MapBlockSize;
219
end;
220

  
221
end.
222

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

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

  
30
interface
31

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

  
35
const
36
  MapCellSize = 3;
37
  MapBlockSize = 4 + (64 * MapCellSize);
38

  
39
type
40

  
41
  { TMapCell }
42

  
43
  TMapCell = class(TWorldItem)
44
    constructor Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word); overload;
45
    constructor Create(AOwner: TWorldBlock; AData: TStream); overload;
46
  protected
47
    FIsGhost: Boolean;
48
    FGhostZ: ShortInt;
49
    FGhostID: Word;
50
    function GetTileID: Word; override;
51
    function GetZ: ShortInt; override;
52
  public
53
    property Altitude: ShortInt read GetZ write SetZ;
54
    property IsGhost: Boolean read FIsGhost write FIsGhost;
55
    property GhostZ: ShortInt read FGhostZ write FGhostZ;
56
    property GhostID: Word write FGhostID;
57

  
58
    function Clone: TMapCell; override;
59
    function GetSize: Integer; override;
60
    procedure Write(AData: TStream); override;
61
  end;
62

  
63
  TMapCellList = specialize TFPGObjectList<TMapCell>;
64

  
65
  { TMapBlock }
66

  
67
  TMapBlock = class(TWorldBlock)
68
    constructor Create(AData: TStream; AX, AY: Word); overload;
69
    constructor Create(AData: TStream); overload;
70
    destructor Destroy; override;
71
  protected
72
    FHeader: LongInt;
73
  public
74
    Cells: array[0..63] of TMapCell;
75
    property Header: LongInt read FHeader write FHeader;
76
    function Clone: TMapBlock; override;
77
    function GetSize: Integer; override;
78
    procedure Write(AData: TStream); override;
79
  end;
80

  
81
function GetMapCellOffset(ABlock: Integer): Integer;
82

  
83
implementation
84

  
85
function GetMapCellOffset(ABlock: Integer): Integer;
86
var
87
  group, tile: Integer;
88
begin
89
  group := ABlock div 64;
90
  tile := ABlock mod 64;
91

  
92
  Result := group * MapBlockSize + 4 + tile * MapCellSize;
93
end;
94

  
95
{ TMapCell }
96

  
97
constructor TMapCell.Create(AOwner: TWorldBlock; AData: TStream; AX, AY: Word);
98
begin
99
  inherited Create(AOwner);
100

  
101
  FX := AX;
102
  FY := AY;
103
  if AData <> nil then
104
  begin
105
    AData.Read(FTileID, SizeOf(Word));
106
    AData.Read(FZ, SizeOf(ShortInt));
107
  end;
108

  
109
  FIsGhost := False;
110

  
111
  InitOriginalState;
112
end;
113

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

  
119
function TMapCell.GetTileID: Word;
120
begin
121
  if FIsGhost then
122
    Result := FGhostID
123
  else
124
    Result := FTileID;
125
end;
126

  
127
function TMapCell.GetZ: ShortInt;
128
begin
129
  if FIsGhost then
130
    Result := FGhostZ
131
  else
132
    Result := FZ;
133
end;
134

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

  
144
procedure TMapCell.Write(AData: TStream);
145
begin
146
  AData.Write(FTileID, SizeOf(Word));
147
  AData.Write(FZ, SizeOf(ShortInt));
148
end;
149

  
150
function TMapCell.GetSize: Integer;
151
begin
152
  Result := MapCellSize;
153
end;
154

  
155
{ TMapBlock }
156

  
157
constructor TMapBlock.Create(AData: TStream; AX, AY: Word);
158
var
159
  iX, iY: Integer;
160
  buffer: TMemoryStream;
161
begin
162
  inherited Create;
163
  FX := AX;
164
  FY := AY;
165
  try
166
    buffer := nil;
167
    if Assigned(AData) then
168
    begin
169
      buffer := TMemoryStream.Create;
170
      buffer.CopyFrom(AData, 196);
171
      buffer.Position := 0;
172
      buffer.Read(FHeader, SizeOf(LongInt));
173
    end;
174
    for iY := 0 to 7 do
175
      for iX := 0 to 7 do
176
        Cells[iY * 8 + iX] := TMapCell.Create(Self, buffer, AX * 8 + iX, AY * 8 + iY);
177
  finally
178
    if Assigned(buffer) then FreeAndNil(buffer);
179
  end;
180
end;
181

  
182
constructor TMapBlock.Create(AData: TStream);
183
begin
184
  Create(AData, 0, 0);
185
end;
186

  
187
destructor TMapBlock.Destroy;
188
var
189
  i: Integer;
190
begin
191
  for i := 0 to 63 do
192
    Cells[i].Free;
193
  inherited;
194
end;
195

  
196
function TMapBlock.Clone: TMapBlock;
197
var
198
  i: Integer;
199
begin
200
  Result := TMapBlock.Create(nil);
201
  Result.FX := FX;
202
  Result.FY := FY;
203
  for i := 0 to 63 do
204
    Result.Cells[i] := Cells[i].Clone;
205
end;
206

  
207
procedure TMapBlock.Write(AData: TStream);
208
var
209
  i: Integer;
210
begin
211
  AData.Write(FHeader, SizeOf(LongInt));
212
  for i := 0 to 63 do
213
    Cells[i].Write(AData);
214
end;
215

  
216
function TMapBlock.GetSize: Integer;
217
begin
218
  Result := MapBlockSize;
219
end;
220

  
221
end.
222

  

Also available in: Unified diff