Mercurial > rg

comparison level.pas @ 0:62966dd383ed default tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
initial
author Radomir Dopieralski <sheep-devel@sheep.art.pl>
date Sun, 08 Dec 2013 19:39:15 +0100
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:62966dd383ed
1 { Level generating routines. }
2
3 {$Q+R+}
4
5 UNIT Level;
6
7 INTERFACE
8 USES Global;
9
10 PROCEDURE GenerateLevel;
11
12 IMPLEMENTATION
13
14 USES Console, Items, Creature;
15
16 CONST GEN_EMPTY=0; { level generator values }
17 GEN_DOOR=1;
18 GEN_OCCUPY=2;
19
20 TYPE TmpMap=ARRAY[0..MAPXSIZE,0..MAPYSIZE] OF BYTE;
21
22 VAR gen: TmpMap;
23 m: TmpMap;
24
25 PROCEDURE ClearMap;
26 VAR x,y: INTEGER;
27 m: pMap;
28 nothing: TileDef;
29 BEGIN
30 nothing:=FindTile(0);
31 GetMap(playchr^.x,playchr^.y)^.crt:=NIL;
32 FOR y:=0 TO MAPYSIZE DO
33 FOR x:=0 TO MAPXSIZE DO BEGIN
34 m:=GetMap(x,y);
35 IF m^.slt<>NIL THEN BEGIN
36 Dispose(m^.slt);
37 m^.slt:=NIL;
38 END;
39 IF m^.crt<>NIL THEN BEGIN
40 Dispose(m^.crt);
41 m^.crt:=NIL;
42 END;
43 m^.flg:=[];
44 m^.ter:=nothing;
45 END;
46 allmonsters:=NIL;
47 END;
48
49 PROCEDURE GenMap;
50 VAR x,y: INTEGER;
51 BEGIN
52 FOR y:=0 TO MAPYSIZE DO
53 FOR x:=0 TO MAPXSIZE DO BEGIN
54 GetMap(x,y)^.ter:=FindTile(m[x,y]);
55 END;
56 END;
57
58 PROCEDURE GenBack(lev: pLevel);
59 VAR r,i,s,x,y,a,b: INTEGER;
60 frak: TmpMap;
61
62 BEGIN
63 FOR y:=0 TO MAPYSIZE DO
64 FOR x:=0 TO MAPXSIZE DO m[x,y]:=lev^.back[0];
65 END;
66
67 PROCEDURE Erode(lev:pLevel);
68 VAR x,y,r: INTEGER;
69 BEGIN
70 FOR y:=0 TO MAPYSIZE DO
71 FOR x:=0 TO MAPXSIZE DO
72 IF lev^.erosion>Random(100) THEN BEGIN
73 r:=FindTile(m[x,y])^.dst;
74 IF r>0 THEN m[x,y]:=r;
75 END;
76 END;
77
78
79 PROCEDURE GenLevel(lev:pLevel);
80
81 VAR r,i,j,p,x1,y1,x,y: INTEGER;
82 door: BYTE;
83 rom: pRoom;
84 place: BYTE;
85 pmap: tmpmap;
86 tmpplaces: Places;
87
88 FUNCTION TryRoom(x,y: INTEGER; rom: pRoom): BOOLEAN;
89 VAR x1,y1: INTEGER;
90
91
92 BEGIN
93 IF rom=NIL THEN Exit;
94 TryRoom:=FALSE;
95 FOR y1:=0 TO 15 DO FOR x1:=0 TO 15 DO
96 IF (rom^.map[x1,y1]<>GEN_EMPTY) THEN BEGIN
97 IF (NOT InMap(x+x1,y+y1)) THEN Exit;
98 IF (gen[x+x1,y+y1]=GEN_OCCUPY) THEN Exit;
99 END;
100 TryRoom:=TRUE;
101 END;
102
103 PROCEDURE RotateRoom(rom:pRoom);
104 VAR x,y: INTEGER;
105 tmp: ARRAY[0..15,0..15] OF BYTE;
106 BEGIN
107 FOR y:=0 TO 15 DO
108 FOR x:=0 TO 15 DO
109 tmp[x,y]:=rom^.map[y,15-x];
110 FOR y:=0 TO 15 DO
111 FOR x:=0 TO 15 DO
112 rom^.map[x,y]:=tmp[x,y];
113 END;
114
115 PROCEDURE PutDoor(x,y:INTEGER);
116 VAR p: INTEGER;
117
118 BEGIN
119 gen[x,y]:=GEN_OCCUPY;
120 IF door=0 THEN Exit;
121 m[x,y]:=door;
122 END;
123
124
125 PROCEDURE PutRoom(x,y: INTEGER; rom: pRoom);
126 VAR x1,y1: INTEGER;
127 BEGIN
128 IF rom=NIL THEN Exit;
129 IF tmpplaces[place].qnt>0 THEN Dec(tmpplaces[place].qnt);
130 door:=tmpplaces[place].dor;
131 FOR y1:=0 TO 15 DO FOR x1:=0 TO 15 DO
132 IF InMap(x+x1,y+y1) AND (gen[x+x1,y+y1]<>GEN_OCCUPY) THEN BEGIN
133 CASE rom^.map[x1,y1] OF
134 GEN_EMPTY: {nothing};
135 GEN_OCCUPY: gen[x+x1,y+y1]:=GEN_EMPTY;
136 GEN_DOOR: IF gen[x+x1,y+y1]=GEN_EMPTY THEN BEGIN
137 gen[x+x1,y+y1]:=GEN_DOOR;
138 pmap[x+x1,y+y1]:=place;
139 END ELSE BEGIN
140 IF (ROOM_EASYDOOR IN rom^.flg) AND (gen[x+x1,y+y1]=GEN_DOOR) THEN PutDoor(x+x1,y+y1) ELSE
141 gen[x+x1,y+y1]:=GEN_OCCUPY;
142 END;
143 ELSE BEGIN
144 gen[x+x1,y+y1]:=GEN_OCCUPY;
145 m[x+x1,y+y1]:=rom^.map[x1,y1];
146 END;
147 END;
148 END;
149 END;
150
151
152 PROCEDURE NextRoom(x,y: INTEGER);
153 VAR a: INTEGER;
154 BEGIN
155 a:=place;
156 place:=pmap[x1,y1];
157 REPEAT
158 Inc(a);
159 IF a>MAXROOMS THEN a:=1;
160 UNTIL (tmpplaces[place].con[a]<>0) AND (tmpplaces[tmpplaces[place].con[a]].qnt<>0);
161
162 place:=tmpplaces[place].con[a];
163 rom:=FindRoom(tmpplaces[place].rom);
164
165 a:=Random(100);
166 IF (a<70) THEN RotateRoom(rom);
167 END;
168
169 PROCEDURE RandomRoom(x,y: INTEGER);
170 VAR a: INTEGER;
171 BEGIN
172 place:=pmap[x1,y1];
173 a:=Random(MAXROOMS)+1;
174 WHILE (tmpplaces[place].con[a]=0) OR (tmpplaces[tmpplaces[place].con[a]].qnt=0) DO BEGIN
175 Inc(a);
176 IF a>MAXROOMS THEN a:=1;
177 END;
178
179 place:=tmpplaces[place].con[a];
180 rom:=FindRoom(tmpplaces[place].rom);
181
182 a:=Random(100);
183 IF (a<70) THEN RotateRoom(rom);
184 END;
185
186 FUNCTION PickRoom: BOOLEAN;
187 VAR i,j,k,l: INTEGER;
188 BEGIN
189 place:=pmap[x1,y1];
190 door:=tmpplaces[place].dor;
191
192 PickRoom:=FALSE;
193
194 IF tmpplaces[place].con[1]=0 THEN Exit;
195
196 { IF (gen[x1+1,y1]<>GEN_EMPTY) AND
197 (gen[x1-1,y1]<>GEN_EMPTY) AND
198 (gen[x1,y1+1]<>GEN_EMPTY) AND
199 (gen[x1,y1-1]<>GEN_EMPTY) THEN Exit;}
200
201 PickRoom:=TRUE;
202
203 RandomRoom(x1,y1);
204
205
206 FOR k:=1 TO 4 DO BEGIN
207 x:=Random(15);
208 y:=Random(15);
209
210 FOR j:=1 TO 2 DO BEGIN
211 i:=0;
212 REPEAT
213 Inc(x);
214 IF x>15 THEN BEGIN
215 x:=0;
216 Inc(y);
217 IF y>15 THEN y:=0;
218 END;
219 Inc(i);
220 IF (i>200) THEN BEGIN
221 NextRoom(x1,y1);
222 x:=Random(15);
223 y:=Random(15);
224 END;
225 UNTIL (rom^.map[x,y]=GEN_DOOR);
226 IF TryRoom(x1-x,y1-y,rom) THEN Exit;
227 RotateRoom(rom);
228 END;
229 NextRoom(x1,y1);
230 END;
231 PickRoom:=FALSE;
232 END;
233
234
235 BEGIN
236 tmpplaces:=lev^.rooms;
237
238 FOR y:=0 TO MAPYSIZE DO
239 FOR x:=0 TO MAPXSIZE DO BEGIN
240 gen[x,y]:=GEN_EMPTY;
241 pmap[x,y]:=0;
242 END;
243
244 place:=1;
245 rom:=FindRoom(tmpplaces[place].rom);
246 door:=rom^.dor;
247
248
249 Msg('@cTrying first room...');
250 REPEAT
251
252 x:=Random(MAPXSIZE);
253 dec(x,8);
254 y:=Random(MAPYSIZE);
255 dec(y,8);
256 Msg(Concat('@cx=',Num(x),';y=',Num(y)));
257 UNTIL TryRoom(x,y,rom);
258 Msg('@cPutting first room...');
259
260 PutRoom(x,y,rom);
261
262
263 Msg('@cFirst room put...');
264
265 REPEAT
266
267 x1:=Random(MAPXSIZE);
268 y1:=Random(MAPYSIZE);
269
270 i:=0;
271 r:=Random(4);
272 CASE r OF
273 0:WHILE gen[x1,y1]<>GEN_DOOR DO BEGIN
274 Inc(x1);
275 IF x1>MAPXSIZE-1 THEN BEGIN
276 x1:=1;
277 Inc(y1);
278 IF y1>MAPYSIZE-1 THEN y1:=1;
279 END;
280 Inc(i);
281 IF i>MAPXSIZE*MAPYSIZE THEN BEGIN
282
283 Exit;
284 END;
285 END;
286 1:WHILE gen[x1,y1]<>GEN_DOOR DO BEGIN
287 Dec(x1);
288 IF x1<1 THEN BEGIN
289 x1:=MAPXSIZE-1;
290 Dec(y1);
291 IF y1<1 THEN y1:=MAPYSIZE-1;
292 END;
293 Inc(i);
294 IF i>MAPXSIZE*MAPYSIZE THEN BEGIN
295
296 Exit;
297 END;
298 END;
299 2:WHILE gen[x1,y1]<>GEN_DOOR DO BEGIN
300 Inc(y1);
301 IF y1>MAPYSIZE-1 THEN BEGIN
302 y1:=1;
303 Inc(x1);
304 IF x1>MAPXSIZE-1 THEN x1:=1;
305 END;
306 Inc(i);
307 IF i>MAPXSIZE*MAPYSIZE THEN BEGIN
308
309 Exit;
310 END;
311 END;
312 3: WHILE gen[x1,y1]<>GEN_DOOR DO BEGIN
313 Dec(y1);
314 IF y1<1 THEN BEGIN
315 y1:=MAPYSIZE-1;
316 Dec(x1);
317 IF x1<1 THEN x1:=MAPXSIZE-1;
318 END;
319 Inc(i);
320 IF i>MAPXSIZE*MAPYSIZE THEN BEGIN
321
322 Exit;
323 END;
324 END;
325 END;
326
327 Msg('@cPicking room...');
328
329 IF PickRoom THEN BEGIN
330 Msg('@cPutting room...');
331 PutDoor(x1,y1);
332 PutRoom(x1-x,y1-y,rom);
333 END ELSE BEGIN
334 gen[x1,y1]:=GEN_EMPTY;
335 END;
336
337 UNTIL FALSE;
338 END;
339
340
341 PROCEDURE GenerateLevel;
342 VAR x,y,i,a,b: INTEGER;
343 l: pLevel;
344 p: pCreat;
345 BEGIN
346 ClearMap;
347 l:=FindLevel(pc.lev);
348 Msg(Replace(msgs[12],'@v',l^.name));
349 GenBack(l);
350 Msg('@cGenerated back...');
351 GenLevel(l);
352 Msg('@cGenerated rooms...');
353 Erode(l);
354 Msg('@cEroded...');
355 GenMap;
356
357 FOR y:=0 TO MAPYSIZE DO
358 FOR x:=0 TO MAPXSIZE DO BEGIN
359 IF (TILE_ENTER IN GetMap(x,y)^.ter^.flg) THEN BEGIN
360 p:=playchr;
361 MoveMonster(x,y,p);
362 END;
363 END;
364 Inc(pc.lev);
365 END;
366
367
368 END.