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);//ель
21 uses maps
, randoms
, vars
, func
, player
, chest
, items_store
, Items
, Blocks
;
23 function rnd_min
:integer;
28 procedure create_bonus_chest(chx
,chy
:integer);
33 if ((getmonth(time
)=0) and (getday(time
)<3)) or ((getmonth(time
)=11) and (getday(time
)>29)) then
39 setmapinfo(31,chx
,chy
);
40 id
:=chest
.create(chx
,chy
);
42 for ix
:=1 to rnd(10)+1 do
47 chest
.setItem(127 ,l
, id
);
48 chest
.setSum(rnd(6)+1, l
, id
);
52 chest
.setItem(9 ,l
, id
);
53 chest
.setSum(rnd(4)+1, l
, id
);
57 chest
.setItem(4 ,l
, id
);
58 chest
.setSum(rnd(4)+1, l
, id
);
62 chest
.setItem(131 ,l
, id
);
63 chest
.setSum(60, l
, id
);
67 chest
.setItem(132 ,l
, id
);
68 chest
.setSum(132, l
, id
);
72 chest
.setItem(141 ,l
, id
);
73 chest
.setSum(60, l
, id
);
77 chest
.setItem(142 ,l
, id
);
78 chest
.setSum(132, l
, id
);
82 chest
.setItem(147 ,l
, id
);
83 chest
.setSum(60, l
, id
);
87 chest
.setItem(201 ,l
, id
);
88 chest
.setSum(rnd(16), l
, id
);
110 if bon_chest
then create_bonus_chest(get_spawn_x
,get_spawn_y
+1);
121 if getmap(ix
,iy
)<>0 then setcolor(0,0,0); else setcolor(255,255,255);
128 procedure gencave(xx
,yy
:integer);
131 mask
:array [0..63,0..63] of boolean;
138 while (ix
>=0) and (ix
<=63) and (iy
>=0) and (iy
<=63) do
142 if (ix
>=0) and (ix
<=63) and (iy
>=0) and (iy
<=63) then mask
[ix
,iy
]:=false;
147 if mask
[ix
,iy
]=true then
148 if mask
[ix
-1,iy
]=false then
149 if mask
[ix
+1,iy
]=false then
156 if mask
[ix
,iy
]=false then setmap(0,xx
+ix
,yy
+iy
);
160 procedure genportal(xx
,yy
:integer);
165 setmap(118,xx
+3,yy
+1);
167 setmap(118,xx
+3,yy
+2);
169 setmap(118,xx
+3,yy
+3);
170 setmap(10,xx
+1,yy
+4);
171 setmap(10,xx
+2,yy
+4);
172 setmap(110,xx
+1,yy
+1);
173 setmap(110,xx
+2,yy
+1);
174 setmap(110,xx
+1,yy
+2);
175 setmap(110,xx
+2,yy
+2);
176 setmap(110,xx
+1,yy
+3);
177 setmap(110,xx
+2,yy
+3);
180 procedure genportal_big(xx
,yy
:integer);
187 setmap(118,xx
+3,yy
+1);
189 setmap(118,xx
+3,yy
+2);
191 setmap(118,xx
+3,yy
+3);
193 setmap(10,xx
+1,yy
+4);
194 setmap(10,xx
+2,yy
+4);
195 setmap(10,xx
+3,yy
+4);
196 setmap(110,xx
+1,yy
+1);
197 setmap(110,xx
+2,yy
+1);
198 setmap(110,xx
+1,yy
+2);
199 setmap(110,xx
+2,yy
+2);
200 setmap(110,xx
+1,yy
+3);
201 setmap(110,xx
+2,yy
+3);
204 procedure surprisechest(x
,y
:integer);
208 id
:=chest
.create(x
, y
);
211 for ix
:=1 to rnd(8) do
216 chest
.setItem(162 ,l
, id
);
217 chest
.setSum(rnd(5), l
, id
);
221 chest
.setItem(165 ,l
, id
);
222 chest
.setSum(rnd(6), l
, id
);
226 chest
.setItem(181 ,l
, id
);
227 chest
.setSum(rnd(2), l
, id
);
231 chest
.setItem(182 ,l
, id
);
232 chest
.setSum(rnd(2), l
, id
);
236 chest
.setItem(176 ,l
, id
);
237 chest
.setSum(rnd(32), l
, id
);
241 chest
.setItem(183 ,l
, id
);
242 chest
.setSum(rnd(10)+1, l
, id
);
246 chest
.setItem(186 ,l
, id
);
247 chest
.setSum(1, l
, id
);
252 procedure genwood1(xx
,yy
:integer);//дуб
260 setmap(21,xx
-1,yy
-3);
261 setmap(21,xx
-1,yy
-4);
262 setmap(21,xx
+1,yy
-3);
263 setmap(21,xx
+1,yy
-4);
266 procedure genwood2(xx
,yy
:integer);//берёза
274 setmap(112,xx
-1,yy
-3);
275 setmap(112,xx
-1,yy
-4);
276 setmap(112,xx
+1,yy
-3);
277 setmap(112,xx
+1,yy
-4);
280 procedure genwood3(xx
,yy
:integer);//ель
285 setmap(87,xx
-1,yy
-4); setmap(87,xx
,yy
-4); setmap(87,xx
+1,yy
-4);
287 setmap(87,xx
-1,yy
-2); setmap(86,xx
,yy
-2); setmap(87,xx
+1,yy
-2);
288 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);
290 time
:=getcurrenttime
;
291 if ((getmonth(time
)=0) and (getday(time
)<3)) or ((getmonth(time
)=11) and (getday(time
)>29)) then
293 if rnd(3)=1 then surprisechest(xx
-1,yy
);
294 if rnd(3)=1 then surprisechest(xx
+1,yy
);
298 procedure genfungus1(xx
,yy
:integer);//красный гриб
300 setmap(88,xx
-1,yy
-4); setmap(88,xx
,yy
-4); setmap(88,xx
+1,yy
-4);
301 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);
302 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);
307 procedure genfungus2(xx
,yy
:integer);//коричневый гриб
309 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);
316 procedure gencactus(xx
,yy
:integer);
323 procedure gencane(xx
,yy
:integer);
330 procedure treasurechest(x
,y
:integer);
334 id
:=chest
.create(x
, y
);
335 debug('Treasure Chest');
337 for ix
:=1 to rnd(8) do
340 if rnd(22)=rnd(22) then
342 chest
.setItem(161 ,l
, id
);
343 chest
.setSum(rnd(4)+1, l
, id
);
345 if rnd(11)=rnd(11) then
347 chest
.setItem(164 ,l
, id
);
348 chest
.setSum(rnd(4)+1, l
, id
);
350 if rnd(11)=rnd(11) then
352 chest
.setItem(183 ,l
, id
);
353 chest
.setSum(rnd(4)+1, l
, id
);
355 if rnd(11)=rnd(11) then
357 chest
.setItem(167 ,l
, id
);
358 chest
.setSum(rnd(4)+1, l
, id
);
360 if rnd(11)=rnd(11) then
362 chest
.setItem(171 ,l
, id
);
363 chest
.setSum(1, l
, id
);
365 if rnd(4)=rnd(4) then
367 chest
.setItem(220 ,l
, id
);
368 chest
.setSum(rnd(8)+8, l
, id
);
373 procedure genteasures(xx
,yy
:integer);
380 setmap(0,xx
+ix
,yy
+iy
);
385 setmap(12,xx
+ix
,yy
+6);
387 setmap(12,xx
+6,yy
+ix
);
390 setmap(76,xx
+3,yy
+5);
391 setmapinfo(1,xx
+3,yy
+5);
394 treasurechest(xx
+1,yy
+5);
397 treasurechest(xx
+5,yy
+5);
400 procedure genrude(t
,r
,xx
,yy
,xxx
,yyy
:integer);
407 if getmap(xx
+ix
,yy
+iy
)=3 then if rnd(r
+1)-1=0 then setmap(t
,xx
+ix
,yy
+iy
);
411 // Генерирует чанки руды в камне типа block с максимальной вероятность percent процентов
412 // Начиная с уровня starty и размером не более maxsize*maxsize
413 // С ростом глубины вероятность растёт
414 procedure GenOreChunks(block
, percent
, starty
, maxsize
: Integer);
418 x
, y
, i
, j
: Integer;
420 for x
:= 0 to MAP_W
do
421 for y
:= starty
to MAP_H
do
422 if RandomBoolean(y
* percent
* preq
/ MAP_H
, 100 * preq
) then
423 for i
:= 0 to rnd(maxsize
) - 1 do
424 for j
:= 0 to rnd(maxsize
) - 1 do
425 if RandomBoolean(50, 100) and (GetMap(x
+ i
, y
+ j
) = 3) then
426 SetMap(block
, x
+ i
, y
+ j
);
429 procedure genallrudes
;
432 GenOreChunks(19, 1, 111, 3);
434 GenOreChunks(16, 2, 95, 3);
435 (* Лазуритовая руда *)
436 GenOreChunks(54, 2, 107, 3);
438 GenOreChunks(20, 2, 107, 3);
440 GenOreChunks(17, 3, 63, 3);
442 GenOreChunks(18, 4, 0, 6);
444 GenOreChunks(8, 2, 0, 6);
446 GenOreChunks(8, 2, 0, 6);
449 procedure dec_0(ix
,iy
:integer);
454 if t
=0 then setmap(22,ix
,iy
); else
455 if t
=1 then setmap(23,ix
,iy
); else
456 if t
=2 then setmap(24,ix
,iy
); else
457 if t
=3 then setmap(25,ix
,iy
); else
458 if (t
>3) and (t
<8) then setmap(57,ix
,iy
); else
459 if t
=8 then genwood1(ix
,iy
); else
460 if t
=9 then genwood2(ix
,iy
); else
461 if t
=10 then setmap(66,ix
,iy
); else
462 if t
=11 then setmap(73,ix
,iy
); else
463 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
467 procedure dec_1(ix
,iy
:integer);
472 if t
=0 then setmap(58,ix
,iy
); else
473 if t
=1 then gencactus(ix
,iy
); else
474 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
478 procedure dec_2(ix
,iy
:integer);
483 if t
=0 then setmap(22,ix
,iy
); else
484 if t
=1 then setmap(23,ix
,iy
); else
485 if t
=2 then genwood1(ix
,iy
); else
486 if t
=3 then genwood2(ix
,iy
); else
487 if t
=4 then genwood3(ix
,iy
); else
488 if t
=5 then setmap(66,ix
,iy
); else
492 procedure dec_3(ix
,iy
:integer);
497 if t
=1 then setmap(24,ix
,iy
); else
498 if t
=2 then setmap(25,ix
,iy
); else
499 if t
=3 then genfungus1(ix
,iy
); else
500 if t
=4 then genfungus2(ix
,iy
); else
510 if getmap(ix
,iy
)<>0 then
512 if (getBiomMap(ix
)=0) then
515 if (getmap(ix
,iy
+1)=2) and (getmap(ix
,iy
)=0) then dec_0(ix
,iy
);
518 if (getBiomMap(ix
)=1) then
521 if (getmap(ix
,iy
+1)=7) and (getmap(ix
,iy
)=0) then dec_1(ix
,iy
);
524 if (getBiomMap(ix
)=2) then
527 if (getmap(ix
,iy
+1)=48) and (getmap(ix
,iy
)=0) then dec_2(ix
,iy
);
530 if (getBiomMap(ix
)=3) then
533 if (getmap(ix
,iy
+1)=74) and (getmap(ix
,iy
)=0) then dec_3(ix
,iy
);
548 if rnd(5)=rnd(6) then g
:=not g
;
550 if (getmap(ix
,iy
)=2) or (getmap(ix
,iy
)=48) or (getmap(ix
,iy
)=74) then
553 for i
:=0 to rnd(4) do setmap(64,ix
,iy
+i
);
554 else setmap(1,ix
,iy
);
557 if (getmap(ix
,iy
)=7) then
560 for i
:=0 to rnd(4) do setmap(64,ix
,iy
+i
);
563 if getmap(ix
,iy
)<>0 then break
;
564 if iy
>=63 then if getmap(ix
,iy
)=0 then setmap(50,ix
,iy
);
568 procedure minechest(x
,y
:integer);
572 id
:=chest
.create(x
,y
);
574 for ix
:=1 to rnd(6)+4 do
577 if rnd(75)=rnd(75) then
579 chest
.setItem(Items
.pickaxe3
,l
, id
);
580 chest
.setSum(Items
.GetMaximum(Items
.pickaxe3
), l
, id
);
582 if rnd(25)=rnd(25) then
584 chest
.setItem(162 ,l
, id
);
585 chest
.setSum(rnd(2)+1, l
, id
);
587 if rnd(15)=rnd(15) then
589 chest
.setItem(165 ,l
, id
);
590 chest
.setSum(rnd(3)+1, l
, id
);
592 if rnd(15)=rnd(15) then
594 chest
.setItem(166 ,l
, id
);
595 chest
.setSum(rnd(6)+4, l
, id
);
597 if rnd(15)=rnd(15) then
599 chest
.setItem(161 ,l
, id
);
600 chest
.setSum(rnd(6)+4, l
, id
);
602 if rnd(15)=rnd(15) then
604 chest
.setItem(160 ,l
, id
);
605 chest
.setSum(rnd(6)+3, l
, id
);
607 if rnd(15)=rnd(15) then
609 chest
.setItem(164 ,l
, id
);
610 chest
.setSum(rnd(5)+1, l
, id
);
612 if rnd(4)=rnd(4) then
614 chest
.setItem(220 ,l
, id
);
615 chest
.setSum(rnd(8)+8, l
, id
);
620 procedure minestruc0(x
,y
:integer);
628 if rnd(8)=0 then setmap(26,x
+1,y
+1);
631 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
634 procedure minestruc1(x
,y
:integer);
642 if rnd(8)=0 then setmap(59,x
,y
);
643 if rnd(8)=0 then setmap(59,x
+2,y
);
648 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
651 procedure minestruc2(x
,y
:integer);
659 if rnd(8)=0 then setmap(59,x
+1,y
);
667 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
670 procedure minestruc3(x
,y
:integer);
681 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
684 procedure genmines(x
,y
:integer);
686 mask
:array[0..15,0..15] of integer;
693 for iy
:=rnd(8)+8 downto rnd(8) do
694 for ix
:=rnd(8) to rnd(8)+8 do
698 if mask
[ix
-1,iy
]=-1 then mask
[ix
,iy
]:=rnd(3); else
699 if mask
[ix
-1,iy
]=0 then if rnd(16)=5 then mask
[ix
,iy
]:=2; else mask
[ix
,iy
]:=1; else
700 if mask
[ix
-1,iy
]=1 then mask
[ix
,iy
]:=0; else
701 if mask
[ix
-1,iy
]=2 then mask
[ix
,iy
]:=rnd(3); else
702 if mask
[ix
-1,iy
]=3 then mask
[ix
,iy
]:=rnd(3);
705 if mask
[ix
,iy
]=0 then
707 if rnd(16)=0 then mask
[ix
,iy
]:=3;
711 for iy
:=15 downto 0 do
714 if rnd(16)=0 then by
:=rnd_min
;;
715 if mask
[ix
,iy
]=0 then minestruc0(x
+(3*ix
),y
+(4*iy
+by
)); else
716 if mask
[ix
,iy
]=1 then minestruc1(x
+(3*ix
),y
+(4*iy
+by
)); else
717 if mask
[ix
,iy
]=2 then minestruc2(x
+(3*ix
),y
+(4*iy
+by
)); else
718 if mask
[ix
,iy
]=3 then minestruc3(x
+(3*ix
),y
+(4*iy
+by
));
722 function get_up(Xi
:integer):integer;
726 for iy
:=127 downto 0 do
727 if getmap(xi
,iy
)=0 then begin get_up
:=iy
; break
; end;
730 function get_down(Xi
:integer):integer;
735 if getmap(xi
,iy
)=0 then begin get_down
:=iy
; break
; end;
738 procedure gensoulsand(gx
,gy
:integer;);
742 for ix2
:=gx
-2-rnd(3) to gx
+2+rnd(3) do
743 for iy2
:=gy
-1-rnd(2) to gy
+1+rnd(2) do
744 setmap(rnd_pr(80,113,getmap(ix2
,iy2
)),ix2
,iy2
);
747 procedure genglowstone(gx
,gy
:integer;);
751 for ix2
:=gx
-1-rnd(2) to gx
+1+rnd(2) do
752 for iy2
:=gy
-1-rnd(2) to gy
+rnd(2) do
753 setmap(rnd_pr(85,111,getmap(ix2
,iy2
)),ix2
,iy2
);
758 ix
,iy
,h
,wtd
,ty
,ga
,tmp
:integer;
763 if (getmap(ix
,iy
)<>10) or (getmap(ix
,iy
)<>110) then
771 if (wtd
>0) and (wtd
<30) then h
:=h
+1;
772 if (wtd
>29) and (wtd
<60) then h
:=h
-1;
773 if wtd
=0 then h
:=h
+(2+rnd(3));
774 if wtd
=99 then h
:=h
-(2+rnd(3));
779 for iy
:=h
-10-(1-rnd(3)) to h
+rnd(2) do
788 if getmap(ix
,iy
)=0 then setmap(51,ix
,iy
);
791 for ix
:=1 to rnd(3)+3 do begin iy
:=rnd(256); debug('SoulSand'); gensoulsand(iy
,get_up(iy
)); end;
792 for ix
:=1 to rnd(4)+7 do begin iy
:=rnd(256); debug('GlowStone - '+iy
); genglowstone(iy
,get_down(iy
)); end;
799 player
.setX(get_spawn_x
*16+4);
800 player
.setY((get_up(get_spawn_x
)-1)*16);
801 setmap(109,get_spawn_x
,get_up(get_spawn_x
)+1);
802 setmap(0,get_spawn_x
,get_up(get_spawn_x
));
803 setmap(0,get_spawn_x
,get_up(get_spawn_x
)-1);
804 genportal_big(get_spawn_x
-2,(get_up(get_spawn_x
)-1)-2);
809 ix
,iy
,h
,wtd
,ty
,ga
,tmp
:integer;
820 if (wtd
>0) and (wtd
<30) then h
:=h
+1;
821 if (wtd
>29) and (wtd
<60) then h
:=h
-1;
822 if wtd
=0 then h
:=h
+(2+rnd(3));
823 if wtd
=99 then h
:=h
-(2+rnd(3));
826 if wtd
=rnd(100) then begin ty
:=rnd(4); debug('Biome:'+ty
); end;
829 if getBackMap(ix
)>63 then
835 if iy
=h
then setmap(2,ix
,iy
);
836 if (iy
>h
) and (iy
<h
+4) then setmap(1,ix
,iy
);
837 if iy
>h
+3 then setmap(3,ix
,iy
);
841 if (iy
>=h
) and (iy
<=h
+1) then setmap(7,ix
,iy
);
842 if iy
=h
+2 then setmap(rnd_pr(50,56,7),ix
,iy
);
843 if iy
=h
+3 then setmap(56,ix
,iy
);
844 if iy
>h
+3 then setmap(3,ix
,iy
);
848 if iy
=h
then setmap(48,ix
,iy
);
849 if (iy
>h
) and (iy
<h
+4) then setmap(1,ix
,iy
);
850 if iy
>h
+3 then setmap(3,ix
,iy
);
854 if iy
=h
then setmap(74,ix
,iy
);
855 if (iy
>h
) and (iy
<h
+4) then setmap(1,ix
,iy
);
856 if iy
>h
+3 then setmap(3,ix
,iy
);
863 for ix
:=1 to rnd(4)+1 do begin debug('Cave'); gencave(rnd(256),64-rnd(10)); end;
865 for ix
:=1 to rnd(3) do begin debug('Mine'); genmines(rnd(256),rnd(64)+64); end;
867 for ix
:=1 to rnd(4) do begin debug('Treasure'); genteasures(rnd(256),rnd(64)+64); end;
872 for iy
:=117 to 127 do
874 if getmap(ix
,iy
)=0 then setmap(51,ix
,iy
);
881 if getBiomMap(ix
)=2 then
883 if getmap(ix
,iy
)<>0 then
885 if getmap(ix
,iy
)=50 then setmap(62,ix
,iy
); else
886 if (getmap(ix
,iy
)<>22) and (getmap(ix
,iy
)<>23) then setmap(63,ix
,iy
-1);
891 for ix
:=0 to 255 do setmap(6,ix
,127);
893 if bon_chest
then create_bonus_chest(get_spawn_x
,get_spawn_y
+1);
897 debug('World Generated!');