Rev 23 | Rev 25 | Go to most recent revision | Only display areas with differences | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 23 | Rev 24 | ||
---|---|---|---|
1 | unit LevelFunctions; |
1 | unit LevelFunctions; |
2 | 2 | ||
3 | interface |
3 | interface |
4 | 4 | ||
5 | uses |
5 | uses |
6 | SysUtils, Dialogs, Functions, ExtCtrls, Classes, Math; |
6 | SysUtils, Dialogs, Functions, ExtCtrls, Classes, Math; |
7 | 7 | ||
8 | type |
8 | type |
9 | TCoord = record |
9 | TCoord = record |
10 | X: integer; |
10 | X: integer; |
11 | Y: integer; |
11 | Y: integer; |
12 | end; |
12 | end; |
13 | 13 | ||
14 | TFieldType = (ftUndefined, ftFullSpace, ftEmpty, ftRed, ftYellow, ftGreen); |
14 | TFieldType = (ftUndefined, ftFullSpace, ftEmpty, ftRed, ftYellow, ftGreen); |
15 | 15 | ||
16 | TFieldProperties = record |
- | |
17 | Typ: TFieldType; |
- | |
18 | Goal: Boolean; |
- | |
19 | end; |
- | |
20 | - | ||
21 | TGameMode = (gmUndefined, gmNormal, gmDiagonal); |
16 | TGameMode = (gmUndefined, gmNormal, gmDiagonal); |
22 | 17 | ||
23 | TRow = record |
- | |
24 | Indent: integer; |
- | |
25 | Fields: array of TFieldProperties; |
- | |
26 | end; |
- | |
27 | TLevelArray = array of TRow; |
- | |
28 | - | ||
29 | TLevelError = (leUndefined, leNone, leInvalidElement, leEmptyBoard, leRowInvalidLength, |
18 | TLevelError = (leUndefined, leNone, leInvalidElement, leEmptyBoard, leRowInvalidLength, |
30 | leUnsupportedVersion, leUnsupportedMode); |
19 | leUnsupportedVersion, leUnsupportedMode); |
31 | 20 | ||
32 | TLevel = class(TObject) |
- | |
33 | private |
- | |
34 | FStringList: TStringList; |
- | |
35 | procedure Load(ABoardFile: string); |
- | |
36 | function GetGameMode: TGameMode; |
- | |
37 | public |
- | |
38 | constructor Create(ABoardFile: string); |
- | |
39 | destructor Destroy; override; |
- | |
40 | function LevelStringToLevelArray(ShowErrors: boolean): TLevelArray; |
- | |
41 | function CheckLevelIntegrity: TLevelError; overload; |
- | |
42 | function CheckLevelIntegrity(ShowErrors: boolean): TLevelError; overload; |
- | |
43 | property GameMode: TGameMode read GetGameMode; |
- | |
44 | end; |
- | |
45 | - | ||
46 | TField = record |
21 | TField = record |
- | 22 | Indent: integer; |
|
47 | FieldType: TFieldType; |
23 | FieldType: TFieldType; |
48 | Goal: Boolean; |
24 | Goal: Boolean; |
49 | Panel: TPanel; |
25 | Panel: TPanel; |
50 | Stone: TImage; |
26 | Stone: TImage; |
51 | end; |
27 | end; |
52 | 28 | ||
53 | TGoalStatus = (gsUndefined, gsNoGoal, gsMultipleStonesRemaining, gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen, gsLastStoneOutsideGoal); |
29 | TGoalStatus = (gsUndefined, gsNoGoal, gsMultipleStonesRemaining, gsLastStoneInGoalRed, gsLastStoneInGoalYellow, gsLastStoneInGoalGreen, gsLastStoneOutsideGoal); |
54 | 30 | ||
55 | TFieldState = (fsUndefined, fsError, fsLocked, fsAvailable, fsStone); |
31 | TFieldState = (fsUndefined, fsLocked, fsAvailable, fsOccupied); |
56 | 32 | ||
57 | TPlayGroundMatrix = record |
33 | TPlayGroundMatrix = record |
58 | Fields: array of array of TField; |
34 | Fields: array of array of TField; |
59 | public |
35 | public |
60 | procedure InitFieldArray(width, height: integer); |
36 | procedure InitFieldArray(width, height: integer); |
61 | function MatrixHasGoal: boolean; |
37 | function MatrixHasGoal: boolean; |
62 | function GoalFieldType: TFieldType; |
38 | function GoalFieldType: TFieldType; |
63 | function MatrixWorth: integer; |
39 | function MatrixWorth: integer; |
64 | procedure ClearMatrix(FreeVCL: boolean); |
40 | procedure ClearMatrix(FreeVCL: boolean); |
65 | function CloneMatrix: TPlayGroundMatrix; |
41 | function CloneMatrix: TPlayGroundMatrix; |
66 | class function FieldState(t: TFieldType): TFieldState; overload; static; |
42 | class function FieldState(t: TFieldType): TFieldState; overload; static; |
67 | function FieldState(f: TField): TFieldState; overload; |
43 | function FieldState(f: TField): TFieldState; overload; |
68 | function FieldState(x, y: integer): TFieldState; overload; |
44 | function FieldState(x, y: integer): TFieldState; overload; |
69 | function CanJump(SourceX, SourceY, DestX, DestY: integer; DiagonalOK: boolean): boolean; overload; |
45 | function CanJump(SourceX, SourceY, DestX, DestY: integer; DiagonalOK: boolean): boolean; overload; |
- | 46 | function CanJump(Source, Dest: TCoord; DiagonalOK: boolean): boolean; overload; |
|
70 | function CanJump(SourceX, SourceY: integer; DiagonalOK: boolean): boolean; overload; |
47 | function CanJump(SourceX, SourceY: integer; DiagonalOK: boolean): boolean; overload; |
- | 48 | function CanJump(Source: TCoord; DiagonalOK: boolean): boolean; overload; |
|
71 | function CanJump(DiagonalOK: boolean): boolean; overload; |
49 | function CanJump(DiagonalOK: boolean): boolean; overload; |
72 | function IndexToCoord(index: integer): TCoord; |
50 | function IndexToCoord(index: integer): TCoord; |
73 | function CoordToIndex(coord: TCoord): integer; overload; |
51 | function CoordToIndex(coord: TCoord): integer; overload; |
74 | function CoordToIndex(x, y: integer): integer; overload; |
52 | function CoordToIndex(x, y: integer): integer; overload; |
75 | function Width: integer; |
53 | function Width: integer; |
76 | function Height: integer; |
54 | function Height: integer; |
77 | end; |
55 | end; |
78 | 56 | ||
- | 57 | TLevel = class(TObject) |
|
- | 58 | private |
|
- | 59 | FStringList: TStringList; |
|
- | 60 | procedure Load(ABoardFile: string); |
|
- | 61 | function GetGameMode: TGameMode; |
|
- | 62 | public |
|
- | 63 | constructor Create(ABoardFile: string); |
|
- | 64 | destructor Destroy; override; |
|
- | 65 | procedure FillPlaygroundMatrix(var matrix: TPlayGroundMatrix; ShowErrors: boolean); |
|
- | 66 | function CheckLevelIntegrity: TLevelError; overload; |
|
- | 67 | function CheckLevelIntegrity(ShowErrors: boolean): TLevelError; overload; |
|
- | 68 | property GameMode: TGameMode read GetGameMode; |
|
- | 69 | end; |
|
- | 70 | ||
79 | function FieldTypeWorth(t: TFieldType): integer; |
71 | function FieldTypeWorth(t: TFieldType): integer; |
80 | 72 | ||
81 | implementation |
73 | implementation |
82 | 74 | ||
83 | function FieldTypeWorth(t: TFieldType): integer; |
75 | function FieldTypeWorth(t: TFieldType): integer; |
84 | begin |
76 | begin |
85 | if t = ftGreen then result := 10 |
77 | if t = ftGreen then result := 10 |
86 | else if t = ftYellow then result := 20 |
78 | else if t = ftYellow then result := 20 |
87 | else if t = ftRed then result := 30 |
79 | else if t = ftRed then result := 30 |
88 | else result := 0; |
80 | else result := 0; |
89 | end; |
81 | end; |
90 | 82 | ||
91 | { TPlayGroundMatrix } |
83 | { TPlayGroundMatrix } |
92 | 84 | ||
93 | function TPlayGroundMatrix.MatrixHasGoal: boolean; |
85 | function TPlayGroundMatrix.MatrixHasGoal: boolean; |
94 | var |
86 | var |
95 | x, y: integer; |
87 | x, y: integer; |
96 | begin |
88 | begin |
97 | result := false; |
89 | result := false; |
98 | for x := Low(Fields) to High(Fields) do |
90 | for x := Low(Fields) to High(Fields) do |
99 | begin |
91 | begin |
100 | for y := Low(Fields[x]) to High(Fields[x]) do |
92 | for y := Low(Fields[x]) to High(Fields[x]) do |
101 | begin |
93 | begin |
102 | result := result or Fields[x,y].Goal; |
94 | result := result or Fields[x,y].Goal; |
103 | end; |
95 | end; |
104 | end; |
96 | end; |
105 | end; |
97 | end; |
106 | 98 | ||
107 | function TPlayGroundMatrix.GoalFieldType: TFieldType; |
99 | function TPlayGroundMatrix.GoalFieldType: TFieldType; |
108 | var |
100 | var |
109 | x, y: integer; |
101 | x, y: integer; |
110 | begin |
102 | begin |
111 | result := ftEmpty; // Damit der Compiler nicht meckert |
103 | result := ftEmpty; // Damit der Compiler nicht meckert |
112 | for x := Low(Fields) to High(Fields) do |
104 | for x := Low(Fields) to High(Fields) do |
113 | begin |
105 | begin |
114 | for y := Low(Fields[x]) to High(Fields[x]) do |
106 | for y := Low(Fields[x]) to High(Fields[x]) do |
115 | begin |
107 | begin |
116 | if Fields[x,y].Goal then result := Fields[x,y].FieldType |
108 | if Fields[x,y].Goal then result := Fields[x,y].FieldType |
117 | end; |
109 | end; |
118 | end; |
110 | end; |
119 | end; |
111 | end; |
120 | 112 | ||
121 | function TPlayGroundMatrix.Height: integer; |
113 | function TPlayGroundMatrix.Height: integer; |
122 | begin |
114 | begin |
123 | if Length(Fields) = 0 then |
115 | if Length(Fields) = 0 then |
124 | result := 0 |
116 | result := 0 |
125 | else |
117 | else |
126 | result := Length(Fields[0]); |
118 | result := Length(Fields[0]); |
127 | end; |
119 | end; |
128 | 120 | ||
129 | function TPlayGroundMatrix.IndexToCoord(index: integer): TCoord; |
121 | function TPlayGroundMatrix.IndexToCoord(index: integer): TCoord; |
130 | begin |
122 | begin |
131 | result.X := index mod Width; |
123 | result.X := index mod Width; |
132 | result.Y := index div Width; |
124 | result.Y := index div Width; |
133 | end; |
125 | end; |
134 | 126 | ||
135 | procedure TPlayGroundMatrix.InitFieldArray(width, height: integer); |
127 | procedure TPlayGroundMatrix.InitFieldArray(width, height: integer); |
136 | var |
128 | var |
137 | x, y: integer; |
129 | x, y: integer; |
138 | begin |
130 | begin |
139 | SetLength(Fields, width, height); |
131 | SetLength(Fields, width, height); |
140 | for x := Low(Fields) to High(Fields) do |
132 | for x := Low(Fields) to High(Fields) do |
141 | begin |
133 | begin |
142 | for y := Low(Fields[x]) to High(Fields[x]) do |
134 | for y := Low(Fields[x]) to High(Fields[x]) do |
143 | begin |
135 | begin |
144 | Fields[x,y].FieldType := ftUndefined; |
136 | Fields[x,y].FieldType := ftUndefined |
145 | end; |
137 | end; |
146 | end; |
138 | end; |
147 | end; |
139 | end; |
148 | 140 | ||
149 | function TPlayGroundMatrix.MatrixWorth: integer; |
141 | function TPlayGroundMatrix.MatrixWorth: integer; |
150 | var |
142 | var |
151 | x, y: integer; |
143 | x, y: integer; |
152 | begin |
144 | begin |
153 | result := 0; |
145 | result := 0; |
154 | for x := Low(Fields) to High(Fields) do |
146 | for x := Low(Fields) to High(Fields) do |
155 | begin |
147 | begin |
156 | for y := Low(Fields[x]) to High(Fields[x]) do |
148 | for y := Low(Fields[x]) to High(Fields[x]) do |
157 | begin |
149 | begin |
158 | Inc(result, FieldTypeWorth(Fields[x,y].FieldType)); |
150 | Inc(result, FieldTypeWorth(Fields[x,y].FieldType)); |
159 | end; |
151 | end; |
160 | end; |
152 | end; |
161 | end; |
153 | end; |
162 | 154 | ||
163 | function TPlayGroundMatrix.Width: integer; |
155 | function TPlayGroundMatrix.Width: integer; |
164 | begin |
156 | begin |
165 | result := Length(Fields); |
157 | result := Length(Fields); |
166 | end; |
158 | end; |
167 | 159 | ||
- | 160 | function TPlayGroundMatrix.CanJump(Source: TCoord; |
|
- | 161 | DiagonalOK: boolean): boolean; |
|
- | 162 | begin |
|
- | 163 | result := CanJump(Source.X, Source.Y, DiagonalOK); |
|
- | 164 | end; |
|
- | 165 | ||
- | 166 | function TPlayGroundMatrix.CanJump(Source, Dest: TCoord; |
|
- | 167 | DiagonalOK: boolean): boolean; |
|
- | 168 | begin |
|
- | 169 | result := CanJump(Source.X, Source.Y, Dest.X, Dest.Y, DiagonalOK); |
|
- | 170 | end; |
|
- | 171 | ||
168 | procedure TPlayGroundMatrix.ClearMatrix(FreeVCL: boolean); |
172 | procedure TPlayGroundMatrix.ClearMatrix(FreeVCL: boolean); |
169 | var |
173 | var |
170 | x, y: integer; |
174 | x, y: integer; |
171 | begin |
175 | begin |
- | 176 | if FreeVCL then |
|
- | 177 | begin |
|
172 | for x := Low(Fields) to High(Fields) do |
178 | for x := Low(Fields) to High(Fields) do |
173 | begin |
179 | begin |
174 | for y := Low(Fields[x]) to High(Fields[x]) do |
180 | for y := Low(Fields[x]) to High(Fields[x]) do |
175 | begin |
181 | begin |
176 | if FreeVCL then |
- | |
177 | begin |
- | |
178 | if Assigned(Fields[x,y].Stone) then Fields[x,y].Stone.Free; |
182 | if Assigned(Fields[x,y].Stone) then Fields[x,y].Stone.Free; |
179 | if Assigned(Fields[x,y].Panel) then Fields[x,y].Panel.Free; |
183 | if Assigned(Fields[x,y].Panel) then Fields[x,y].Panel.Free; |
180 | end; |
184 | end; |
181 | end; |
185 | end; |
182 | end; |
186 | end; |
183 | SetLength(Fields, 0, 0); |
187 | SetLength(Fields, 0, 0); |
184 | end; |
188 | end; |
185 | 189 | ||
186 | function TPlayGroundMatrix.CloneMatrix: TPlayGroundMatrix; |
190 | function TPlayGroundMatrix.CloneMatrix: TPlayGroundMatrix; |
187 | var |
191 | var |
188 | x, y: integer; |
192 | x, y: integer; |
189 | begin |
193 | begin |
190 | SetLength(result.Fields, Length(Fields)); |
194 | SetLength(result.Fields, Length(Fields)); |
191 | for x := Low(Fields) to High(Fields) do |
195 | for x := Low(Fields) to High(Fields) do |
192 | begin |
196 | begin |
193 | SetLength(result.Fields[x], Length(Fields[x])); |
197 | SetLength(result.Fields[x], Length(Fields[x])); |
194 | for y := Low(Fields[x]) to High(Fields[x]) do |
198 | for y := Low(Fields[x]) to High(Fields[x]) do |
195 | begin |
199 | begin |
196 | result.Fields[x,y].FieldType := Fields[x,y].FieldType; |
200 | result.Fields[x,y].FieldType := Fields[x,y].FieldType; |
197 | result.Fields[x,y].Goal := Fields[x,y].Goal; |
201 | result.Fields[x,y].Goal := Fields[x,y].Goal; |
198 | result.Fields[x,y].Panel := Fields[x,y].Panel; |
202 | result.Fields[x,y].Panel := Fields[x,y].Panel; |
199 | result.Fields[x,y].Stone := Fields[x,y].Stone; |
203 | result.Fields[x,y].Stone := Fields[x,y].Stone; |
200 | end; |
204 | end; |
201 | end; |
205 | end; |
202 | end; |
206 | end; |
203 | 207 | ||
204 | function TPlayGroundMatrix.CoordToIndex(x, y: integer): integer; |
208 | function TPlayGroundMatrix.CoordToIndex(x, y: integer): integer; |
205 | var |
- | |
206 | c: TCoord; |
- | |
207 | begin |
209 | begin |
208 | c.X := x; |
- | |
209 | c.Y := y; |
- | |
210 | result := CoordToIndex(c); |
210 | result := x + y * Width; |
211 | end; |
211 | end; |
212 | 212 | ||
213 | function TPlayGroundMatrix.CoordToIndex(coord: TCoord): integer; |
213 | function TPlayGroundMatrix.CoordToIndex(coord: TCoord): integer; |
214 | begin |
214 | begin |
215 | result := coord.X + coord.Y * Width; |
215 | result := CoordToIndex(coord.X, coord.Y); |
216 | end; |
216 | end; |
217 | 217 | ||
218 | class function TPlayGroundMatrix.FieldState(t: TFieldType): TFieldState; |
218 | class function TPlayGroundMatrix.FieldState(t: TFieldType): TFieldState; |
219 | begin |
219 | begin |
220 | result := fsError; |
220 | result := fsUndefined; |
221 | case t of |
221 | case t of |
222 | ftFullSpace: result := fsLocked; |
222 | ftFullSpace: result := fsLocked; |
223 | ftEmpty: result := fsAvailable; |
223 | ftEmpty: result := fsAvailable; |
224 | ftGreen: result := fsStone; |
224 | ftGreen: result := fsOccupied; |
225 | ftYellow: result := fsStone; |
225 | ftYellow: result := fsOccupied; |
226 | ftRed: result := fsStone; |
226 | ftRed: result := fsOccupied; |
227 | end; |
227 | end; |
228 | end; |
228 | end; |
229 | 229 | ||
230 | function TPlayGroundMatrix.FieldState(f: TField): TFieldState; |
230 | function TPlayGroundMatrix.FieldState(f: TField): TFieldState; |
231 | begin |
231 | begin |
232 | result := FieldState(f.FieldType); |
232 | result := FieldState(f.FieldType); |
233 | end; |
233 | end; |
234 | 234 | ||
235 | function TPlayGroundMatrix.FieldState(x, y: integer): TFieldState; |
235 | function TPlayGroundMatrix.FieldState(x, y: integer): TFieldState; |
236 | begin |
236 | begin |
237 | result := fsError; |
237 | result := fsUndefined; |
238 | if (x < Low(Fields)) or (x > High(Fields)) then exit; |
238 | if (x < Low(Fields)) or (x > High(Fields)) then exit; |
239 | if (y < Low(Fields[x])) or (y > High(Fields[x])) then exit; |
239 | if (y < Low(Fields[x])) or (y > High(Fields[x])) then exit; |
240 | 240 | ||
241 | result := FieldState(Fields[x,y]); |
241 | result := FieldState(Fields[x,y]); |
242 | end; |
242 | end; |
243 | 243 | ||
244 | function TPlayGroundMatrix.CanJump(SourceX, SourceY, DestX, DestY: integer; DiagonalOK: boolean): boolean; |
244 | function TPlayGroundMatrix.CanJump(SourceX, SourceY, DestX, DestY: integer; DiagonalOK: boolean): boolean; |
245 | begin |
245 | begin |
246 | result := false; |
246 | result := false; |
247 | 247 | ||
248 | // Check 1: Ist das Zielfeld überhaupt leer? |
248 | // Check 1: Ist das Zielfeld überhaupt leer? |
249 | if FieldState(DestX, DestY) <> fsAvailable then exit; |
249 | if FieldState(DestX, DestY) <> fsAvailable then exit; |
250 | 250 | ||
251 | // Check 2: Befindet sich ein Stein zwischen Source und Destination und ist der Abstand 2? |
251 | // Check 2: Befindet sich ein Stein zwischen Source und Destination und ist der Abstand 2? |
252 | if DiagonalOK then |
252 | if DiagonalOK then |
253 | begin |
253 | begin |
254 | if (SourceX-2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX-1, SourceY-1) = fsStone) then result := true; |
254 | if (SourceX-2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX-1, SourceY-1) = fsOccupied) then result := true; |
255 | if (SourceX-2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX-1, SourceY+1) = fsStone) then result := true; |
255 | if (SourceX-2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX-1, SourceY+1) = fsOccupied) then result := true; |
256 | if (SourceX+2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX+1, SourceY-1) = fsStone) then result := true; |
256 | if (SourceX+2 = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX+1, SourceY-1) = fsOccupied) then result := true; |
257 | if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX+1, SourceY+1) = fsStone) then result := true; |
257 | if (SourceX+2 = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX+1, SourceY+1) = fsOccupied) then result := true; |
258 | end; |
258 | end; |
259 | 259 | ||
260 | if (SourceX+2 = DestX) and (SourceY = DestY) and (FieldState(SourceX+1, SourceY ) = fsStone) then result := true; |
260 | if (SourceX+2 = DestX) and (SourceY = DestY) and (FieldState(SourceX+1, SourceY ) = fsOccupied) then result := true; |
261 | if (SourceX-2 = DestX) and (SourceY = DestY) and (FieldState(SourceX-1, SourceY ) = fsStone) then result := true; |
261 | if (SourceX-2 = DestX) and (SourceY = DestY) and (FieldState(SourceX-1, SourceY ) = fsOccupied) then result := true; |
262 | if (SourceX = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX , SourceY+1) = fsStone) then result := true; |
262 | if (SourceX = DestX) and (SourceY+2 = DestY) and (FieldState(SourceX , SourceY+1) = fsOccupied) then result := true; |
263 | if (SourceX = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX , SourceY-1) = fsStone) then result := true; |
263 | if (SourceX = DestX) and (SourceY-2 = DestY) and (FieldState(SourceX , SourceY-1) = fsOccupied) then result := true; |
264 | end; |
264 | end; |
265 | 265 | ||
266 | function TPlayGroundMatrix.CanJump(SourceX, SourceY: integer; DiagonalOK: boolean): boolean; |
266 | function TPlayGroundMatrix.CanJump(SourceX, SourceY: integer; DiagonalOK: boolean): boolean; |
267 | begin |
267 | begin |
268 | if FieldState(SourceX, SourceY) <> fsStone then |
268 | if FieldState(SourceX, SourceY) <> fsOccupied then |
269 | begin |
269 | begin |
270 | result := false; |
270 | result := false; |
271 | exit; |
271 | exit; |
272 | end; |
272 | end; |
273 | 273 | ||
274 | result := true; |
274 | result := true; |
275 | 275 | ||
276 | if CanJump(SourceX, SourceY, SourceX+2, SourceY, DiagonalOK) then exit; |
276 | if CanJump(SourceX, SourceY, SourceX+2, SourceY, DiagonalOK) then exit; |
277 | if CanJump(SourceX, SourceY, SourceX-2, SourceY, DiagonalOK) then exit; |
277 | if CanJump(SourceX, SourceY, SourceX-2, SourceY, DiagonalOK) then exit; |
278 | if CanJump(SourceX, SourceY, SourceX, SourceY+2, DiagonalOK) then exit; |
278 | if CanJump(SourceX, SourceY, SourceX, SourceY+2, DiagonalOK) then exit; |
279 | if CanJump(SourceX, SourceY, SourceX, SourceY-2, DiagonalOK) then exit; |
279 | if CanJump(SourceX, SourceY, SourceX, SourceY-2, DiagonalOK) then exit; |
280 | 280 | ||
281 | if DiagonalOK then |
281 | if DiagonalOK then |
282 | begin |
282 | begin |
283 | if CanJump(SourceX, SourceY, SourceX-2, SourceY-2, DiagonalOK) then exit; |
283 | if CanJump(SourceX, SourceY, SourceX-2, SourceY-2, DiagonalOK) then exit; |
284 | if CanJump(SourceX, SourceY, SourceX+2, SourceY-2, DiagonalOK) then exit; |
284 | if CanJump(SourceX, SourceY, SourceX+2, SourceY-2, DiagonalOK) then exit; |
285 | if CanJump(SourceX, SourceY, SourceX-2, SourceY+2, DiagonalOK) then exit; |
285 | if CanJump(SourceX, SourceY, SourceX-2, SourceY+2, DiagonalOK) then exit; |
286 | if CanJump(SourceX, SourceY, SourceX+2, SourceY+2, DiagonalOK) then exit; |
286 | if CanJump(SourceX, SourceY, SourceX+2, SourceY+2, DiagonalOK) then exit; |
287 | end; |
287 | end; |
288 | 288 | ||
289 | result := false; |
289 | result := false; |
290 | end; |
290 | end; |
291 | 291 | ||
292 | function TPlayGroundMatrix.CanJump(DiagonalOK: boolean): boolean; |
292 | function TPlayGroundMatrix.CanJump(DiagonalOK: boolean): boolean; |
293 | var |
293 | var |
294 | x, y: integer; |
294 | x, y: integer; |
295 | begin |
295 | begin |
296 | result := false; |
296 | result := false; |
297 | for x := Low(Fields) to High(Fields) do |
297 | for x := Low(Fields) to High(Fields) do |
298 | begin |
298 | begin |
299 | for y := Low(Fields[x]) to High(Fields[x]) do |
299 | for y := Low(Fields[x]) to High(Fields[x]) do |
300 | begin |
300 | begin |
301 | if CanJump(x, y, DiagonalOK) then |
301 | if CanJump(x, y, DiagonalOK) then |
302 | begin |
302 | begin |
303 | result := true; |
303 | result := true; |
304 | break; |
304 | break; |
305 | end; |
305 | end; |
306 | if result then break; |
306 | if result then break; |
307 | end; |
307 | end; |
308 | end; |
308 | end; |
309 | end; |
309 | end; |
310 | 310 | ||
311 | { TLevel } |
311 | { TLevel } |
312 | 312 | ||
313 | const NUM_HEADERS = 2; |
313 | const NUM_HEADERS = 2; |
314 | 314 | ||
315 | constructor TLevel.Create(ABoardFile: string); |
315 | constructor TLevel.Create(ABoardFile: string); |
316 | begin |
316 | begin |
317 | inherited Create; |
317 | inherited Create; |
318 | FStringList := TStringList.Create; |
318 | FStringList := TStringList.Create; |
319 | Load(ABoardFile); |
319 | Load(ABoardFile); |
320 | end; |
320 | end; |
321 | 321 | ||
322 | destructor TLevel.Destroy; |
322 | destructor TLevel.Destroy; |
323 | begin |
323 | begin |
324 | FreeAndNil(FStringList); |
324 | FreeAndNil(FStringList); |
325 | 325 | ||
326 | inherited; |
326 | inherited; |
327 | end; |
327 | end; |
328 | 328 | ||
329 | function TLevel.GetGameMode: TGameMode; |
329 | function TLevel.GetGameMode: TGameMode; |
330 | begin |
330 | begin |
331 | if LowerCase(FStringList.Strings[1]) = 'mode: normal' then |
331 | if LowerCase(FStringList.Strings[1]) = 'mode: normal' then |
332 | result := gmNormal |
332 | result := gmNormal |
333 | else if LowerCase(FStringList.Strings[1]) = 'mode: diagonal' then |
333 | else if LowerCase(FStringList.Strings[1]) = 'mode: diagonal' then |
334 | result := gmDiagonal |
334 | result := gmDiagonal |
335 | else |
335 | else |
336 | result := gmUndefined; |
336 | result := gmUndefined; |
337 | end; |
337 | end; |
338 | 338 | ||
339 | procedure TLevel.Load(ABoardFile: string); |
339 | procedure TLevel.Load(ABoardFile: string); |
340 | var |
340 | var |
341 | i: Integer; |
341 | i: Integer; |
342 | begin |
342 | begin |
343 | FStringList.Clear; |
343 | FStringList.Clear; |
344 | FStringList.LoadFromFile(ABoardFile); |
344 | FStringList.LoadFromFile(ABoardFile); |
345 | 345 | ||
346 | // Remove whitespaces and empty lines |
346 | // Remove whitespaces and empty lines |
347 | for i := FStringList.Count-1 downto NUM_HEADERS do |
347 | for i := FStringList.Count-1 downto NUM_HEADERS do |
348 | begin |
348 | begin |
349 | FStringList.Strings[i] := StringReplace(FStringList.Strings[i], ' ', '', [rfReplaceAll]); |
349 | FStringList.Strings[i] := StringReplace(FStringList.Strings[i], ' ', '', [rfReplaceAll]); |
350 | if FStringList.Strings[i] = '' then FStringList.Delete(i); |
350 | if FStringList.Strings[i] = '' then FStringList.Delete(i); |
351 | end; |
351 | end; |
352 | end; |
352 | end; |
353 | 353 | ||
354 | function TLevel.LevelStringToLevelArray(ShowErrors: boolean): TLevelArray; |
354 | procedure TLevel.FillPlaygroundMatrix(var matrix: TPlayGroundMatrix; ShowErrors: boolean); |
355 | var |
355 | var |
356 | i: integer; |
356 | i: integer; |
357 | t: TFieldType; |
357 | t: TFieldType; |
358 | err: TLevelError; |
358 | err: TLevelError; |
359 | y: Integer; |
359 | y: Integer; |
360 | x: Integer; |
360 | x: Integer; |
361 | Line: string; |
361 | Line: string; |
362 | lch, uch: char; |
362 | lch, uch: char; |
363 | ch: char; |
363 | ch: char; |
- | 364 | width: Integer; |
|
- | 365 | height: Integer; |
|
- | 366 | lineIndent: Integer; |
|
364 | begin |
367 | begin |
365 | // Zuerst nach Fehlern suchen |
368 | // Zuerst nach Fehlern suchen |
366 | err := CheckLevelIntegrity(ShowErrors); |
369 | err := CheckLevelIntegrity(ShowErrors); |
367 | if err <> leNone then exit; |
370 | if err <> leNone then exit; |
368 | 371 | ||
- | 372 | // Breite feststellen |
|
- | 373 | if FStringList.Count > NUM_HEADERS then |
|
- | 374 | begin |
|
- | 375 | Line := FStringList.Strings[NUM_HEADERS]; |
|
- | 376 | Line := StringReplace(Line, '.', '', [rfReplaceAll]); |
|
- | 377 | width := Length(Line); |
|
- | 378 | end |
|
- | 379 | else width := 0; |
|
- | 380 | ||
- | 381 | // Höhe feststellen |
|
- | 382 | height := FStringList.Count - NUM_HEADERS; |
|
- | 383 | ||
369 | // Nun Matrix aufbauen |
384 | // Nun Matrix aufbauen |
370 | SetLength(result, 0); |
385 | matrix.ClearMatrix(true); |
- | 386 | matrix.InitFieldArray(width, height); |
|
371 | for i := NUM_HEADERS to FStringList.Count-1 do |
387 | for i := NUM_HEADERS to FStringList.Count-1 do |
372 | begin |
388 | begin |
373 | y := i - NUM_HEADERS; |
389 | y := i - NUM_HEADERS; |
374 | 390 | ||
375 | SetLength(result, Length(result)+1); // add line to matrix |
- | |
376 | - | ||
377 | Line := FStringList.Strings[i]; |
391 | Line := FStringList.Strings[i]; |
378 | result[y].Indent := DotsAtBeginning(Line) - DotsAtEnd(Line); |
392 | lineIndent := DotsAtBeginning(Line) - DotsAtEnd(Line); |
379 | Line := StringReplace(Line, '.', '', [rfReplaceAll]); |
393 | Line := StringReplace(Line, '.', '', [rfReplaceAll]); |
380 | SetLength(result[y].Fields, Length(Line)); |
- | |
381 | 394 | ||
382 | for x := 0 to Length(Line)-1 do |
395 | for x := 0 to Length(Line)-1 do |
383 | begin |
396 | begin |
384 | ch := Line[x+1]; |
397 | ch := Line[x+1]; |
385 | lch := LowerCase(ch)[1]; |
398 | lch := LowerCase(ch)[1]; |
386 | uch := UpperCase(ch)[1]; |
399 | uch := UpperCase(ch)[1]; |
387 | 400 | ||
388 | t := ftUndefined; |
401 | t := ftUndefined; |
389 | case lch of |
402 | case lch of |
390 | '*': t := ftFullSpace; |
403 | '*': t := ftFullSpace; |
391 | 'e': t := ftEmpty; |
404 | 'e': t := ftEmpty; |
392 | 'r': t := ftRed; |
405 | 'r': t := ftRed; |
393 | 'y': t := ftYellow; |
406 | 'y': t := ftYellow; |
394 | 'g': t := ftGreen; |
407 | 'g': t := ftGreen; |
395 | end; |
408 | end; |
396 | 409 | ||
- | 410 | matrix.Fields[x,y].Indent := lineIndent; |
|
397 | result[y].Fields[x].Typ := t; |
411 | matrix.Fields[x,y].FieldType := t; |
398 | result[y].Fields[x].Goal := (ch = uch) and (ch <> lch); |
412 | matrix.Fields[x,y].Goal := (ch = uch) and (ch <> lch); |
399 | end; |
413 | end; |
400 | end; |
414 | end; |
401 | end; |
415 | end; |
402 | 416 | ||
403 | function TLevel.CheckLevelIntegrity(ShowErrors: boolean): TLevelError; |
417 | function TLevel.CheckLevelIntegrity(ShowErrors: boolean): TLevelError; |
404 | resourcestring |
418 | resourcestring |
405 | LNG_LVL_INVALID_ELEMENT = 'Level invalid: There are invalid elements in the file.'+#13#10#13#10+'Valid elements are r/R, y/Y, g/G, e/E, . and *.'; |
419 | LNG_LVL_INVALID_ELEMENT = 'Level invalid: There are invalid elements in the file.'+#13#10#13#10+'Valid elements are r/R, y/Y, g/G, e/E, . and *.'; |
406 | LNG_LVL_UNSUPPORTED_VERSION = 'Level format invalid: Version not supported.'; |
420 | LNG_LVL_UNSUPPORTED_VERSION = 'Level format invalid: Version not supported.'; |
407 | LNG_LVL_UNSUPPORTED_MODE = 'Level format invalid: Mode not supported.'; |
421 | LNG_LVL_UNSUPPORTED_MODE = 'Level format invalid: Mode not supported.'; |
408 | LNG_LVL_EMPTY_BOARD = 'Level invalid: Board is empty.'; |
422 | LNG_LVL_EMPTY_BOARD = 'Level invalid: Board is empty.'; |
409 | LNG_LVL_INVALID_LENGTH = 'Level invalid: Lines don''t have an equal amount of elements.'; |
423 | LNG_LVL_INVALID_LENGTH = 'Level invalid: Lines don''t have an equal amount of elements.'; |
410 | begin |
424 | begin |
411 | result := CheckLevelIntegrity; |
425 | result := CheckLevelIntegrity; |
412 | if ShowErrors then |
426 | if ShowErrors then |
413 | begin |
427 | begin |
414 | case result of |
428 | case result of |
415 | leNone: ; |
429 | leNone: ; |
416 | leInvalidElement: MessageDlg(LNG_LVL_INVALID_ELEMENT, mtError, [mbOk], 0); |
430 | leInvalidElement: MessageDlg(LNG_LVL_INVALID_ELEMENT, mtError, [mbOk], 0); |
417 | leUnsupportedVersion: MessageDlg(LNG_LVL_UNSUPPORTED_VERSION, mtError, [mbOk], 0); |
431 | leUnsupportedVersion: MessageDlg(LNG_LVL_UNSUPPORTED_VERSION, mtError, [mbOk], 0); |
418 | leUnsupportedMode: MessageDlg(LNG_LVL_UNSUPPORTED_MODE, mtError, [mbOk], 0); |
432 | leUnsupportedMode: MessageDlg(LNG_LVL_UNSUPPORTED_MODE, mtError, [mbOk], 0); |
419 | leEmptyBoard: MessageDlg(LNG_LVL_EMPTY_BOARD, mtError, [mbOk], 0); |
433 | leEmptyBoard: MessageDlg(LNG_LVL_EMPTY_BOARD, mtError, [mbOk], 0); |
420 | leRowInvalidLength: MessageDlg(LNG_LVL_INVALID_LENGTH, mtError, [mbOk], 0); |
434 | leRowInvalidLength: MessageDlg(LNG_LVL_INVALID_LENGTH, mtError, [mbOk], 0); |
421 | end; |
435 | end; |
422 | end; |
436 | end; |
423 | end; |
437 | end; |
424 | 438 | ||
425 | function TLevel.CheckLevelIntegrity: TLevelError; |
439 | function TLevel.CheckLevelIntegrity: TLevelError; |
426 | var |
440 | var |
427 | tmp: string; |
441 | tmp: string; |
428 | i: Integer; |
442 | i: Integer; |
429 | Line: string; |
443 | Line: string; |
430 | firstLine: string; |
444 | firstLine: string; |
431 | thisLine: string; |
445 | thisLine: string; |
432 | begin |
446 | begin |
433 | result := leNone; |
447 | result := leNone; |
434 | 448 | ||
435 | // Check 1: Ist der Header OK? |
449 | // Check 1: Ist der Header OK? |
436 | 450 | ||
437 | if LowerCase(FStringList.Strings[0]) <> 'version 2' then |
451 | if LowerCase(FStringList.Strings[0]) <> 'version 2' then |
438 | begin |
452 | begin |
439 | result := leUnsupportedVersion; |
453 | result := leUnsupportedVersion; |
440 | exit; |
454 | exit; |
441 | end; |
455 | end; |
442 | 456 | ||
- | 457 | if ((LowerCase(FStringList.Strings[1]) <> 'mode: normal') and |
|
443 | if ((LowerCase(FStringList.Strings[1]) <> 'mode: normal') and (LowerCase(FStringList.Strings[1]) <> 'mode: diagonal')) then |
458 | (LowerCase(FStringList.Strings[1]) <> 'mode: diagonal')) then |
444 | begin |
459 | begin |
445 | result := leUnsupportedMode; |
460 | result := leUnsupportedMode; |
446 | exit; |
461 | exit; |
447 | end; |
462 | end; |
448 | 463 | ||
449 | // Check 2: Ist das Brett leer? |
464 | // Check 2: Ist das Brett leer? |
450 | 465 | ||
451 | tmp := ''; |
466 | tmp := ''; |
452 | for i := NUM_HEADERS to FStringList.Count-1 do tmp := tmp + FStringList.Strings[i]; |
467 | for i := NUM_HEADERS to FStringList.Count-1 do tmp := tmp + FStringList.Strings[i]; |
453 | if Trim(StringReplace(tmp, '.', '', [rfReplaceAll])) = '' then |
468 | if Trim(StringReplace(tmp, '.', '', [rfReplaceAll])) = '' then |
454 | begin |
469 | begin |
455 | result := leEmptyBoard; |
470 | result := leEmptyBoard; |
456 | exit; |
471 | exit; |
457 | end; |
472 | end; |
458 | 473 | ||
459 | // Check 3: Geht das Level nicht in einem Quadrat oder Rechteck auf? |
474 | // Check 3: Geht das Level nicht in einem Quadrat oder Rechteck auf? |
460 | 475 | ||
461 | firstLine := StringReplace(FStringList.Strings[NUM_HEADERS], '.', '', [rfReplaceAll]); |
476 | firstLine := StringReplace(FStringList.Strings[NUM_HEADERS], '.', '', [rfReplaceAll]); |
462 | for i := NUM_HEADERS to FStringList.Count-1 do |
477 | for i := NUM_HEADERS to FStringList.Count-1 do |
463 | begin |
478 | begin |
464 | thisLine := StringReplace(FStringList.Strings[i], '.', '', [rfReplaceAll]); |
479 | thisLine := StringReplace(FStringList.Strings[i], '.', '', [rfReplaceAll]); |
465 | if Length(thisLine) <> Length(firstLine) then |
480 | if Length(thisLine) <> Length(firstLine) then |
466 | begin |
481 | begin |
467 | result := leRowInvalidLength; // at row y-NUM_HEADERS |
482 | result := leRowInvalidLength; // at row y = i-NUM_HEADERS |
468 | exit; |
483 | exit; |
469 | end; |
484 | end; |
470 | end; |
485 | end; |
471 | 486 | ||
472 | // Check 4: Gibt es ungültige Elemente in den Zeilen? |
487 | // Check 4: Gibt es ungültige Elemente in den Zeilen? |
473 | 488 | ||
474 | for i := NUM_HEADERS to FStringList.Count-1 do |
489 | for i := NUM_HEADERS to FStringList.Count-1 do |
475 | begin |
490 | begin |
476 | Line := FStringList.Strings[i]; |
491 | Line := FStringList.Strings[i]; |
477 | 492 | ||
478 | Line := StringReplace(Line, '.', '', [rfReplaceAll]); |
493 | Line := StringReplace(Line, '.', '', [rfReplaceAll]); |
479 | Line := StringReplace(Line, '*', '', [rfReplaceAll]); |
494 | Line := StringReplace(Line, '*', '', [rfReplaceAll]); |
480 | Line := StringReplace(Line, 'r', '', [rfReplaceAll, rfIgnoreCase]); |
495 | Line := StringReplace(Line, 'r', '', [rfReplaceAll, rfIgnoreCase]); |
481 | Line := StringReplace(Line, 'y', '', [rfReplaceAll, rfIgnoreCase]); |
496 | Line := StringReplace(Line, 'y', '', [rfReplaceAll, rfIgnoreCase]); |
482 | Line := StringReplace(Line, 'g', '', [rfReplaceAll, rfIgnoreCase]); |
497 | Line := StringReplace(Line, 'g', '', [rfReplaceAll, rfIgnoreCase]); |
483 | Line := StringReplace(Line, 'e', '', [rfReplaceAll, rfIgnoreCase]); |
498 | Line := StringReplace(Line, 'e', '', [rfReplaceAll, rfIgnoreCase]); |
484 | 499 | ||
485 | if Length(Line) > 0 then |
500 | if Length(Line) > 0 then |
486 | begin |
501 | begin |
487 | result := leInvalidElement; // at row y-NUM_HEADERS |
502 | result := leInvalidElement; // at row y = i-NUM_HEADERS |
488 | Exit; |
503 | Exit; |
489 | end; |
504 | end; |
490 | end; |
505 | end; |
491 | 506 | ||
492 | // Check 5: Kann im Level gesprungen werden? |
507 | // Check 5: Kann im Level gesprungen werden? |
493 | 508 | ||
494 | { Wird hier nicht abgeprüft, da dafür zuerst der PlayGround gebaut sein muss. |
509 | { Wird hier nicht abgeprüft, da dafür zuerst der PlayGround gebaut sein muss. |
495 | Es ist außerdem eher ein logischer Fehler, kein Fehler in der Levelstruktur! } |
510 | Es ist außerdem eher ein logischer Fehler, kein Fehler in der Levelstruktur! } |
496 | end; |
511 | end; |
497 | 512 | ||
498 | end. |
513 | end. |
499 | 514 |