8 procedure genworld
;//Вызывается из главного модуля для начала генерации мира
11 procedure genportal(xx
,yy
:integer);
12 function get_up(Xi
:integer):integer;
14 procedure genwood1(xx
,yy
:integer);//дуб
15 procedure genwood2(xx
,yy
:integer);//берёза
16 procedure genwood3(xx
,yy
:integer);//ель
20 uses maps
,randoms
,vars
,items
,func
, player
, chest
, items_store
;
22 function rnd_min
:integer;
27 procedure create_bonus_chest(chx
,chy
:integer);
32 if ((getmonth(time
)=0) and (getday(time
)<3)) or ((getmonth(time
)=11) and (getday(time
)>29)) then
38 setmapinfo(31,chx
,chy
);
39 id
:=chest
.create(chx
,chy
);
41 for ix
:=1 to rnd(10)+1 do
46 chest
.setItem(127 ,l
, id
);
47 chest
.setSum(rnd(6)+1, l
, id
);
51 chest
.setItem(9 ,l
, id
);
52 chest
.setSum(rnd(4)+1, l
, id
);
56 chest
.setItem(4 ,l
, id
);
57 chest
.setSum(rnd(4)+1, l
, id
);
61 chest
.setItem(131 ,l
, id
);
62 chest
.setSum(60, l
, id
);
66 chest
.setItem(132 ,l
, id
);
67 chest
.setSum(132, l
, id
);
71 chest
.setItem(141 ,l
, id
);
72 chest
.setSum(60, l
, id
);
76 chest
.setItem(142 ,l
, id
);
77 chest
.setSum(132, l
, id
);
81 chest
.setItem(147 ,l
, id
);
82 chest
.setSum(60, l
, id
);
86 chest
.setItem(201 ,l
, id
);
87 chest
.setSum(rnd(16), l
, id
);
109 if bon_chest
then create_bonus_chest(get_spawn_x
,get_spawn_y
+1);
120 if getmap(ix
,iy
)<>0 then setcolor(0,0,0); else setcolor(255,255,255);
127 procedure gencave(xx
,yy
:integer);
130 mask
:array [0..63,0..63] of boolean;
137 while (ix
>=0) and (ix
<=63) and (iy
>=0) and (iy
<=63) do
141 if (ix
>=0) and (ix
<=63) and (iy
>=0) and (iy
<=63) then mask
[ix
,iy
]:=false;
146 if mask
[ix
,iy
]=true then
147 if mask
[ix
-1,iy
]=false then
148 if mask
[ix
+1,iy
]=false then
155 if mask
[ix
,iy
]=false then setmap(0,xx
+ix
,yy
+iy
);
159 procedure genportal(xx
,yy
:integer);
164 setmap(118,xx
+3,yy
+1);
166 setmap(118,xx
+3,yy
+2);
168 setmap(118,xx
+3,yy
+3);
169 setmap(10,xx
+1,yy
+4);
170 setmap(10,xx
+2,yy
+4);
171 setmap(110,xx
+1,yy
+1);
172 setmap(110,xx
+2,yy
+1);
173 setmap(110,xx
+1,yy
+2);
174 setmap(110,xx
+2,yy
+2);
175 setmap(110,xx
+1,yy
+3);
176 setmap(110,xx
+2,yy
+3);
179 procedure genportal_big(xx
,yy
:integer);
186 setmap(118,xx
+3,yy
+1);
188 setmap(118,xx
+3,yy
+2);
190 setmap(118,xx
+3,yy
+3);
192 setmap(10,xx
+1,yy
+4);
193 setmap(10,xx
+2,yy
+4);
194 setmap(10,xx
+3,yy
+4);
195 setmap(110,xx
+1,yy
+1);
196 setmap(110,xx
+2,yy
+1);
197 setmap(110,xx
+1,yy
+2);
198 setmap(110,xx
+2,yy
+2);
199 setmap(110,xx
+1,yy
+3);
200 setmap(110,xx
+2,yy
+3);
203 procedure surprisechest(x
,y
:integer);
207 id
:=chest
.create(x
, y
);
210 for ix
:=1 to rnd(8) do
215 chest
.setItem(162 ,l
, id
);
216 chest
.setSum(rnd(5), l
, id
);
220 chest
.setItem(165 ,l
, id
);
221 chest
.setSum(rnd(6), l
, id
);
225 chest
.setItem(181 ,l
, id
);
226 chest
.setSum(rnd(2), l
, id
);
230 chest
.setItem(182 ,l
, id
);
231 chest
.setSum(rnd(2), l
, id
);
235 chest
.setItem(176 ,l
, id
);
236 chest
.setSum(rnd(32), l
, id
);
240 chest
.setItem(183 ,l
, id
);
241 chest
.setSum(rnd(10)+1, l
, id
);
245 chest
.setItem(186 ,l
, id
);
246 chest
.setSum(1, l
, id
);
251 procedure genwood1(xx
,yy
:integer);//дуб
259 setmap(21,xx
-1,yy
-3);
260 setmap(21,xx
-1,yy
-4);
261 setmap(21,xx
+1,yy
-3);
262 setmap(21,xx
+1,yy
-4);
265 procedure genwood2(xx
,yy
:integer);//берёза
273 setmap(112,xx
-1,yy
-3);
274 setmap(112,xx
-1,yy
-4);
275 setmap(112,xx
+1,yy
-3);
276 setmap(112,xx
+1,yy
-4);
279 procedure genwood3(xx
,yy
:integer);//ель
284 setmap(87,xx
-1,yy
-4); setmap(87,xx
,yy
-4); setmap(87,xx
+1,yy
-4);
286 setmap(87,xx
-1,yy
-2); setmap(86,xx
,yy
-2); setmap(87,xx
+1,yy
-2);
287 setmap(87,xx
-2,yy
-1); setmap(87,xx
-1,yy
-1); setmap(86,xx
,yy
-1); setmap(87,xx
+1,yy
-1); setmap(87,xx
+2,yy
-1);
289 time
:=getcurrenttime
;
290 if ((getmonth(time
)=0) and (getday(time
)<3)) or ((getmonth(time
)=11) and (getday(time
)>29)) then
292 if rnd(3)=1 then surprisechest(xx
-1,yy
);
293 if rnd(3)=1 then surprisechest(xx
+1,yy
);
297 procedure genfungus1(xx
,yy
:integer);//красный гриб
299 setmap(88,xx
-1,yy
-4); setmap(88,xx
,yy
-4); setmap(88,xx
+1,yy
-4);
300 setmap(88,xx
-2,yy
-3); setmap(88,xx
-1,yy
-3); setmap(88,xx
,yy
-3); setmap(88,xx
+1,yy
-3); setmap(88,xx
+2,yy
-3);
301 setmap(88,xx
-2,yy
-2); setmap(88,xx
-1,yy
-2); setmap(88,xx
,yy
-2); setmap(88,xx
+1,yy
-2); setmap(88,xx
+2,yy
-2);
306 procedure genfungus2(xx
,yy
:integer);//коричневый гриб
308 setmap(90,xx
-2,yy
-4); setmap(90,xx
-1,yy
-4); setmap(90,xx
,yy
-4); setmap(90,xx
+1,yy
-4); setmap(90,xx
+2,yy
-4);
315 procedure gencactus(xx
,yy
:integer);
322 procedure gencane(xx
,yy
:integer);
329 procedure treasurechest(x
,y
:integer);
333 id
:=chest
.create(x
, y
);
334 debug('Treasure Chest');
336 for ix
:=1 to rnd(8) do
339 if rnd(22)=rnd(22) then
341 chest
.setItem(161 ,l
, id
);
342 chest
.setSum(rnd(4)+1, l
, id
);
344 if rnd(11)=rnd(11) then
346 chest
.setItem(164 ,l
, id
);
347 chest
.setSum(rnd(4)+1, l
, id
);
349 if rnd(11)=rnd(11) then
351 chest
.setItem(183 ,l
, id
);
352 chest
.setSum(rnd(4)+1, l
, id
);
354 if rnd(11)=rnd(11) then
356 chest
.setItem(167 ,l
, id
);
357 chest
.setSum(rnd(4)+1, l
, id
);
359 if rnd(11)=rnd(11) then
361 chest
.setItem(171 ,l
, id
);
362 chest
.setSum(1, l
, id
);
364 if rnd(4)=rnd(4) then
366 chest
.setItem(220 ,l
, id
);
367 chest
.setSum(rnd(8)+8, l
, id
);
372 procedure genteasures(xx
,yy
:integer);
379 setmap(0,xx
+ix
,yy
+iy
);
384 setmap(12,xx
+ix
,yy
+6);
386 setmap(12,xx
+6,yy
+ix
);
389 setmap(76,xx
+3,yy
+5);
390 setmapinfo(1,xx
+3,yy
+5);
393 treasurechest(xx
+1,yy
+5);
396 treasurechest(xx
+5,yy
+5);
399 procedure genrude(t
,r
,xx
,yy
,xxx
,yyy
:integer);
406 if getmap(xx
+ix
,yy
+iy
)=3 then if rnd(r
+1)-1=0 then setmap(t
,xx
+ix
,yy
+iy
);
410 // Генерирует чанки руды в камне типа block с максимальной вероятность percent процентов
411 // Начиная с уровня starty и размером не более maxsize*maxsize
412 // С ростом глубины вероятность растёт
413 procedure GenOreChunks(block
, percent
, starty
, maxsize
: Integer);
417 x
, y
, i
, j
: Integer;
419 for x
:= 0 to MAP_W
do
420 for y
:= starty
to MAP_H
do
421 if RandomBoolean(y
* percent
* preq
/ MAP_H
, 100 * preq
) then
422 for i
:= 0 to rnd(maxsize
) - 1 do
423 for j
:= 0 to rnd(maxsize
) - 1 do
424 if RandomBoolean(50, 100) and (GetMap(x
+ i
, y
+ j
) = 3) then
425 SetMap(block
, x
+ i
, y
+ j
);
428 procedure genallrudes
;
431 GenOreChunks(19, 1, 111, 3);
433 GenOreChunks(16, 2, 95, 3);
434 (* Лазуритовая руда *)
435 GenOreChunks(54, 2, 107, 3);
437 GenOreChunks(20, 2, 107, 3);
439 GenOreChunks(17, 3, 63, 3);
441 GenOreChunks(18, 4, 0, 6);
443 GenOreChunks(8, 2, 0, 6);
445 GenOreChunks(8, 2, 0, 6);
448 procedure dec_0(ix
,iy
:integer);
453 if t
=0 then setmap(22,ix
,iy
); else
454 if t
=1 then setmap(23,ix
,iy
); else
455 if t
=2 then setmap(24,ix
,iy
); else
456 if t
=3 then setmap(25,ix
,iy
); else
457 if (t
>3) and (t
<8) then setmap(57,ix
,iy
); else
458 if t
=8 then genwood1(ix
,iy
); else
459 if t
=9 then genwood2(ix
,iy
); else
460 if t
=10 then setmap(66,ix
,iy
); else
461 if t
=11 then setmap(73,ix
,iy
); else
462 if t
>11 then begin if (getmap(ix
-1,iy
+1)=50) or (getmap(ix
+1,iy
+1)=50) then gencane(ix
,iy
); end; else
466 procedure dec_1(ix
,iy
:integer);
471 if t
=0 then setmap(58,ix
,iy
); else
472 if t
=1 then gencactus(ix
,iy
); else
473 if t
>2 then begin if (getmap(ix
-1,iy
+1)=50) or (getmap(ix
+1,iy
+1)=50) then gencane(ix
,iy
); end; else
477 procedure dec_2(ix
,iy
:integer);
482 if t
=0 then setmap(22,ix
,iy
); else
483 if t
=1 then setmap(23,ix
,iy
); else
484 if t
=2 then genwood1(ix
,iy
); else
485 if t
=3 then genwood2(ix
,iy
); else
486 if t
=4 then genwood3(ix
,iy
); else
487 if t
=5 then setmap(66,ix
,iy
); else
491 procedure dec_3(ix
,iy
:integer);
496 if t
=1 then setmap(24,ix
,iy
); else
497 if t
=2 then setmap(25,ix
,iy
); else
498 if t
=3 then genfungus1(ix
,iy
); else
499 if t
=4 then genfungus2(ix
,iy
); else
509 if getmap(ix
,iy
)<>0 then
511 if (getBiomMap(ix
)=0) then
514 if (getmap(ix
,iy
+1)=2) and (getmap(ix
,iy
)=0) then dec_0(ix
,iy
);
517 if (getBiomMap(ix
)=1) then
520 if (getmap(ix
,iy
+1)=7) and (getmap(ix
,iy
)=0) then dec_1(ix
,iy
);
523 if (getBiomMap(ix
)=2) then
526 if (getmap(ix
,iy
+1)=48) and (getmap(ix
,iy
)=0) then dec_2(ix
,iy
);
529 if (getBiomMap(ix
)=3) then
532 if (getmap(ix
,iy
+1)=74) and (getmap(ix
,iy
)=0) then dec_3(ix
,iy
);
547 if rnd(5)=rnd(6) then g
:=not g
;
549 if (getmap(ix
,iy
)=2) or (getmap(ix
,iy
)=48) or (getmap(ix
,iy
)=74) then
552 for i
:=0 to rnd(4) do setmap(64,ix
,iy
+i
);
553 else setmap(1,ix
,iy
);
556 if (getmap(ix
,iy
)=7) then
559 for i
:=0 to rnd(4) do setmap(64,ix
,iy
+i
);
562 if getmap(ix
,iy
)<>0 then break
;
563 if iy
>=63 then if getmap(ix
,iy
)=0 then setmap(50,ix
,iy
);
567 procedure minechest(x
,y
:integer);
571 id
:=chest
.create(x
,y
);
573 for ix
:=1 to rnd(6)+4 do
576 if rnd(75)=rnd(75) then
578 chest
.setItem(133 ,l
, id
);
579 chest
.setSum(getItemMax(133), l
, id
);
581 if rnd(25)=rnd(25) then
583 chest
.setItem(162 ,l
, id
);
584 chest
.setSum(rnd(2)+1, l
, id
);
586 if rnd(15)=rnd(15) then
588 chest
.setItem(165 ,l
, id
);
589 chest
.setSum(rnd(3)+1, l
, id
);
591 if rnd(15)=rnd(15) then
593 chest
.setItem(166 ,l
, id
);
594 chest
.setSum(rnd(6)+4, l
, id
);
596 if rnd(15)=rnd(15) then
598 chest
.setItem(161 ,l
, id
);
599 chest
.setSum(rnd(6)+4, l
, id
);
601 if rnd(15)=rnd(15) then
603 chest
.setItem(160 ,l
, id
);
604 chest
.setSum(rnd(6)+3, l
, id
);
606 if rnd(15)=rnd(15) then
608 chest
.setItem(164 ,l
, id
);
609 chest
.setSum(rnd(5)+1, l
, id
);
611 if rnd(4)=rnd(4) then
613 chest
.setItem(220 ,l
, id
);
614 chest
.setSum(rnd(8)+8, l
, id
);
619 procedure minestruc0(x
,y
:integer);
627 if rnd(8)=0 then setmap(26,x
+1,y
+1);
630 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
633 procedure minestruc1(x
,y
:integer);
641 if rnd(8)=0 then setmap(59,x
,y
);
642 if rnd(8)=0 then setmap(59,x
+2,y
);
647 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
650 procedure minestruc2(x
,y
:integer);
658 if rnd(8)=0 then setmap(59,x
+1,y
);
666 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
669 procedure minestruc3(x
,y
:integer);
680 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
683 procedure genmines(x
,y
:integer);
685 mask
:array[0..15,0..15] of integer;
692 for iy
:=rnd(8)+8 downto rnd(8) do
693 for ix
:=rnd(8) to rnd(8)+8 do
697 if mask
[ix
-1,iy
]=-1 then mask
[ix
,iy
]:=rnd(3); else
698 if mask
[ix
-1,iy
]=0 then if rnd(16)=5 then mask
[ix
,iy
]:=2; else mask
[ix
,iy
]:=1; else
699 if mask
[ix
-1,iy
]=1 then mask
[ix
,iy
]:=0; else
700 if mask
[ix
-1,iy
]=2 then mask
[ix
,iy
]:=rnd(3); else
701 if mask
[ix
-1,iy
]=3 then mask
[ix
,iy
]:=rnd(3);
704 if mask
[ix
,iy
]=0 then
706 if rnd(16)=0 then mask
[ix
,iy
]:=3;
710 for iy
:=15 downto 0 do
713 if rnd(16)=0 then by
:=rnd_min
;;
714 if mask
[ix
,iy
]=0 then minestruc0(x
+(3*ix
),y
+(4*iy
+by
)); else
715 if mask
[ix
,iy
]=1 then minestruc1(x
+(3*ix
),y
+(4*iy
+by
)); else
716 if mask
[ix
,iy
]=2 then minestruc2(x
+(3*ix
),y
+(4*iy
+by
)); else
717 if mask
[ix
,iy
]=3 then minestruc3(x
+(3*ix
),y
+(4*iy
+by
));
721 function get_up(Xi
:integer):integer;
725 for iy
:=127 downto 0 do
726 if getmap(xi
,iy
)=0 then begin get_up
:=iy
; break
; end;
729 function get_down(Xi
:integer):integer;
734 if getmap(xi
,iy
)=0 then begin get_down
:=iy
; break
; end;
737 procedure gensoulsand(gx
,gy
:integer;);
741 for ix2
:=gx
-2-rnd(3) to gx
+2+rnd(3) do
742 for iy2
:=gy
-1-rnd(2) to gy
+1+rnd(2) do
743 setmap(rnd_pr(80,113,getmap(ix2
,iy2
)),ix2
,iy2
);
746 procedure genglowstone(gx
,gy
:integer;);
750 for ix2
:=gx
-1-rnd(2) to gx
+1+rnd(2) do
751 for iy2
:=gy
-1-rnd(2) to gy
+rnd(2) do
752 setmap(rnd_pr(85,111,getmap(ix2
,iy2
)),ix2
,iy2
);
757 ix
,iy
,h
,wtd
,ty
,ga
,tmp
:integer;
762 if (getmap(ix
,iy
)<>10) or (getmap(ix
,iy
)<>110) then
770 if (wtd
>0) and (wtd
<30) then h
:=h
+1;
771 if (wtd
>29) and (wtd
<60) then h
:=h
-1;
772 if wtd
=0 then h
:=h
+(2+rnd(3));
773 if wtd
=99 then h
:=h
-(2+rnd(3));
778 for iy
:=h
-10-(1-rnd(3)) to h
+rnd(2) do
787 if getmap(ix
,iy
)=0 then setmap(51,ix
,iy
);
790 for ix
:=1 to rnd(3)+3 do begin iy
:=rnd(256); debug('SoulSand'); gensoulsand(iy
,get_up(iy
)); end;
791 for ix
:=1 to rnd(4)+7 do begin iy
:=rnd(256); debug('GlowStone - '+iy
); genglowstone(iy
,get_down(iy
)); end;
798 player
.setX(get_spawn_x
*16+4);
799 player
.setY((get_up(get_spawn_x
)-1)*16);
800 setmap(109,get_spawn_x
,get_up(get_spawn_x
)+1);
801 setmap(0,get_spawn_x
,get_up(get_spawn_x
));
802 setmap(0,get_spawn_x
,get_up(get_spawn_x
)-1);
803 genportal_big(get_spawn_x
-2,(get_up(get_spawn_x
)-1)-2);
808 ix
,iy
,h
,wtd
,ty
,ga
,tmp
:integer;
819 if (wtd
>0) and (wtd
<30) then h
:=h
+1;
820 if (wtd
>29) and (wtd
<60) then h
:=h
-1;
821 if wtd
=0 then h
:=h
+(2+rnd(3));
822 if wtd
=99 then h
:=h
-(2+rnd(3));
825 if wtd
=rnd(100) then begin ty
:=rnd(4); debug('Biome:'+ty
); end;
828 if getBackMap(ix
)>63 then
834 if iy
=h
then setmap(2,ix
,iy
);
835 if (iy
>h
) and (iy
<h
+4) then setmap(1,ix
,iy
);
836 if iy
>h
+3 then setmap(3,ix
,iy
);
840 if (iy
>=h
) and (iy
<=h
+1) then setmap(7,ix
,iy
);
841 if iy
=h
+2 then setmap(rnd_pr(50,56,7),ix
,iy
);
842 if iy
=h
+3 then setmap(56,ix
,iy
);
843 if iy
>h
+3 then setmap(3,ix
,iy
);
847 if iy
=h
then setmap(48,ix
,iy
);
848 if (iy
>h
) and (iy
<h
+4) then setmap(1,ix
,iy
);
849 if iy
>h
+3 then setmap(3,ix
,iy
);
853 if iy
=h
then setmap(74,ix
,iy
);
854 if (iy
>h
) and (iy
<h
+4) then setmap(1,ix
,iy
);
855 if iy
>h
+3 then setmap(3,ix
,iy
);
862 for ix
:=1 to rnd(4)+1 do begin debug('Cave'); gencave(rnd(256),64-rnd(10)); end;
864 for ix
:=1 to rnd(3) do begin debug('Mine'); genmines(rnd(256),rnd(64)+64); end;
866 for ix
:=1 to rnd(4) do begin debug('Treasure'); genteasures(rnd(256),rnd(64)+64); end;
871 for iy
:=117 to 127 do
873 if getmap(ix
,iy
)=0 then setmap(51,ix
,iy
);
880 if getBiomMap(ix
)=2 then
882 if getmap(ix
,iy
)<>0 then
884 if getmap(ix
,iy
)=50 then setmap(62,ix
,iy
); else
885 if (getmap(ix
,iy
)<>22) and (getmap(ix
,iy
)<>23) then setmap(63,ix
,iy
-1);
890 for ix
:=0 to 255 do setmap(6,ix
,127);
892 if bon_chest
then create_bonus_chest(get_spawn_x
,get_spawn_y
+1);
896 debug('World Generated!');