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 procedure genallrudes
;
416 for iy
:=111 to 127 do
417 if (rnd_pr(1,1,0)=1) then
421 if getmap(ix
+iu
,iy
+iv
)=3 then setmap(rnd_pr(10,19,getmap(ix
+iu
,iy
+iv
)),ix
+iu
,iy
+iv
);
428 if (rnd_pr(3,1,0)=1) then
432 if (ix
+iu
<255) and (iy
+iv
<126) then
433 if getmap(ix
+iu
,iy
+iv
)=3 then setmap(rnd_pr(20,16,getmap(ix
+iu
,iy
+iv
)),ix
+iu
,iy
+iv
);
439 for iy
:=107 to 127 do
440 if (rnd_pr(2,1,0)=1) then
444 if (ix
+iu
<255) and (iy
+iv
<126) then
445 if getmap(ix
+iu
,iy
+iv
)=3 then setmap(rnd_pr(40,54,getmap(ix
+iu
,iy
+iv
)),ix
+iu
,iy
+iv
);
451 for iy
:=107 to 127 do
452 if (rnd_pr(2,1,0)=1) then
456 if (ix
+iu
<255) and (iy
+iv
<126) then
457 if getmap(ix
+iu
,iy
+iv
)=3 then setmap(rnd_pr(40,20,getmap(ix
+iu
,iy
+iv
)),ix
+iu
,iy
+iv
);
464 if (rnd_pr(4,1,0)=1) then
468 if (ix
+iu
<255) and (iy
+iv
<126) then
469 if getmap(ix
+iu
,iy
+iv
)=3 then setmap(rnd_pr(40,17,getmap(ix
+iu
,iy
+iv
)),ix
+iu
,iy
+iv
);
476 if (rnd_pr(6,1,0)=1) then
480 if (ix
+iu
<255) and (iy
+iv
<126) then
481 if getmap(ix
+iu
,iy
+iv
)=3 then setmap(rnd_pr(50,18,getmap(ix
+iu
,iy
+iv
)),ix
+iu
,iy
+iv
);
488 if (rnd_pr(2,1,0)=1) then
490 for iu
:=0 to rnd(5) do
491 for iv
:=0 to rnd(5) do
492 if (ix
+iu
<255) and (iy
+iv
<126) then
493 if getmap(ix
+iu
,iy
+iv
)=3 then setmap(rnd_pr(90,8,getmap(ix
+iu
,iy
+iv
)),ix
+iu
,iy
+iv
);
500 if (rnd_pr(1,1,0)=1) then
502 for iu
:=0 to rnd(5) do
503 for iv
:=0 to rnd(5) do
504 if (ix
+iu
<255) and (iy
+iv
<126) then
505 if getmap(ix
+iu
,iy
+iv
)=3 then setmap(rnd_pr(90,1,getmap(ix
+iu
,iy
+iv
)),ix
+iu
,iy
+iv
);
510 procedure dec_0(ix
,iy
:integer);
515 if t
=0 then setmap(22,ix
,iy
); else
516 if t
=1 then setmap(23,ix
,iy
); else
517 if t
=2 then setmap(24,ix
,iy
); else
518 if t
=3 then setmap(25,ix
,iy
); else
519 if (t
>3) and (t
<8) then setmap(57,ix
,iy
); else
520 if t
=8 then genwood1(ix
,iy
); else
521 if t
=9 then genwood2(ix
,iy
); else
522 if t
=10 then setmap(66,ix
,iy
); else
523 if t
=11 then setmap(73,ix
,iy
); else
524 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
528 procedure dec_1(ix
,iy
:integer);
533 if t
=0 then setmap(58,ix
,iy
); else
534 if t
=1 then gencactus(ix
,iy
); else
535 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
539 procedure dec_2(ix
,iy
:integer);
544 if t
=0 then setmap(22,ix
,iy
); else
545 if t
=1 then setmap(23,ix
,iy
); else
546 if t
=2 then genwood1(ix
,iy
); else
547 if t
=3 then genwood2(ix
,iy
); else
548 if t
=4 then genwood3(ix
,iy
); else
549 if t
=5 then setmap(66,ix
,iy
); else
553 procedure dec_3(ix
,iy
:integer);
558 if t
=1 then setmap(24,ix
,iy
); else
559 if t
=2 then setmap(25,ix
,iy
); else
560 if t
=3 then genfungus1(ix
,iy
); else
561 if t
=4 then genfungus2(ix
,iy
); else
571 if getmap(ix
,iy
)<>0 then
573 if (getBiomMap(ix
)=0) then
576 if (getmap(ix
,iy
+1)=2) and (getmap(ix
,iy
)=0) then dec_0(ix
,iy
);
579 if (getBiomMap(ix
)=1) then
582 if (getmap(ix
,iy
+1)=7) and (getmap(ix
,iy
)=0) then dec_1(ix
,iy
);
585 if (getBiomMap(ix
)=2) then
588 if (getmap(ix
,iy
+1)=48) and (getmap(ix
,iy
)=0) then dec_2(ix
,iy
);
591 if (getBiomMap(ix
)=3) then
594 if (getmap(ix
,iy
+1)=74) and (getmap(ix
,iy
)=0) then dec_3(ix
,iy
);
609 if rnd(5)=rnd(6) then g
:=not g
;
611 if (getmap(ix
,iy
)=2) or (getmap(ix
,iy
)=48) or (getmap(ix
,iy
)=74) then
614 for i
:=0 to rnd(4) do setmap(64,ix
,iy
+i
);
615 else setmap(1,ix
,iy
);
618 if (getmap(ix
,iy
)=7) then
621 for i
:=0 to rnd(4) do setmap(64,ix
,iy
+i
);
624 if getmap(ix
,iy
)<>0 then break
;
625 if iy
>=63 then if getmap(ix
,iy
)=0 then setmap(50,ix
,iy
);
629 procedure minechest(x
,y
:integer);
633 id
:=chest
.create(x
,y
);
635 for ix
:=1 to rnd(6)+4 do
638 if rnd(75)=rnd(75) then
640 chest
.setItem(133 ,l
, id
);
641 chest
.setSum(getItemMax(133), l
, id
);
643 if rnd(25)=rnd(25) then
645 chest
.setItem(162 ,l
, id
);
646 chest
.setSum(rnd(2)+1, l
, id
);
648 if rnd(15)=rnd(15) then
650 chest
.setItem(165 ,l
, id
);
651 chest
.setSum(rnd(3)+1, l
, id
);
653 if rnd(15)=rnd(15) then
655 chest
.setItem(166 ,l
, id
);
656 chest
.setSum(rnd(6)+4, l
, id
);
658 if rnd(15)=rnd(15) then
660 chest
.setItem(161 ,l
, id
);
661 chest
.setSum(rnd(6)+4, l
, id
);
663 if rnd(15)=rnd(15) then
665 chest
.setItem(160 ,l
, id
);
666 chest
.setSum(rnd(6)+3, l
, id
);
668 if rnd(15)=rnd(15) then
670 chest
.setItem(164 ,l
, id
);
671 chest
.setSum(rnd(5)+1, l
, id
);
673 if rnd(4)=rnd(4) then
675 chest
.setItem(220 ,l
, id
);
676 chest
.setSum(rnd(8)+8, l
, id
);
681 procedure minestruc0(x
,y
:integer);
689 if rnd(8)=0 then setmap(26,x
+1,y
+1);
692 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
695 procedure minestruc1(x
,y
:integer);
703 if rnd(8)=0 then setmap(59,x
,y
);
704 if rnd(8)=0 then setmap(59,x
+2,y
);
709 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
712 procedure minestruc2(x
,y
:integer);
720 if rnd(8)=0 then setmap(59,x
+1,y
);
728 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
731 procedure minestruc3(x
,y
:integer);
742 if getmap(x
+ix
,y
+3)=0 then setmap(4,x
+ix
,y
+3);
745 procedure genmines(x
,y
:integer);
747 mask
:array[0..15,0..15] of integer;
754 for iy
:=rnd(8)+8 downto rnd(8) do
755 for ix
:=rnd(8) to rnd(8)+8 do
759 if mask
[ix
-1,iy
]=-1 then mask
[ix
,iy
]:=rnd(3); else
760 if mask
[ix
-1,iy
]=0 then if rnd(16)=5 then mask
[ix
,iy
]:=2; else mask
[ix
,iy
]:=1; else
761 if mask
[ix
-1,iy
]=1 then mask
[ix
,iy
]:=0; else
762 if mask
[ix
-1,iy
]=2 then mask
[ix
,iy
]:=rnd(3); else
763 if mask
[ix
-1,iy
]=3 then mask
[ix
,iy
]:=rnd(3);
766 if mask
[ix
,iy
]=0 then
768 if rnd(16)=0 then mask
[ix
,iy
]:=3;
772 for iy
:=15 downto 0 do
775 if rnd(16)=0 then by
:=rnd_min
;;
776 if mask
[ix
,iy
]=0 then minestruc0(x
+(3*ix
),y
+(4*iy
+by
)); else
777 if mask
[ix
,iy
]=1 then minestruc1(x
+(3*ix
),y
+(4*iy
+by
)); else
778 if mask
[ix
,iy
]=2 then minestruc2(x
+(3*ix
),y
+(4*iy
+by
)); else
779 if mask
[ix
,iy
]=3 then minestruc3(x
+(3*ix
),y
+(4*iy
+by
));
783 function get_up(Xi
:integer):integer;
787 for iy
:=127 downto 0 do
788 if getmap(xi
,iy
)=0 then begin get_up
:=iy
; break
; end;
791 function get_down(Xi
:integer):integer;
796 if getmap(xi
,iy
)=0 then begin get_down
:=iy
; break
; end;
799 procedure gensoulsand(gx
,gy
:integer;);
803 for ix2
:=gx
-2-rnd(3) to gx
+2+rnd(3) do
804 for iy2
:=gy
-1-rnd(2) to gy
+1+rnd(2) do
805 setmap(rnd_pr(80,113,getmap(ix2
,iy2
)),ix2
,iy2
);
808 procedure genglowstone(gx
,gy
:integer;);
812 for ix2
:=gx
-1-rnd(2) to gx
+1+rnd(2) do
813 for iy2
:=gy
-1-rnd(2) to gy
+rnd(2) do
814 setmap(rnd_pr(85,111,getmap(ix2
,iy2
)),ix2
,iy2
);
819 ix
,iy
,h
,wtd
,ty
,ga
,tmp
:integer;
824 if (getmap(ix
,iy
)<>10) or (getmap(ix
,iy
)<>110) then
832 if (wtd
>0) and (wtd
<30) then h
:=h
+1;
833 if (wtd
>29) and (wtd
<60) then h
:=h
-1;
834 if wtd
=0 then h
:=h
+(2+rnd(3));
835 if wtd
=99 then h
:=h
-(2+rnd(3));
840 for iy
:=h
-10-(1-rnd(3)) to h
+rnd(2) do
849 if getmap(ix
,iy
)=0 then setmap(51,ix
,iy
);
852 for ix
:=1 to rnd(3)+3 do begin iy
:=rnd(256); debug('SoulSand'); gensoulsand(iy
,get_up(iy
)); end;
853 for ix
:=1 to rnd(4)+7 do begin iy
:=rnd(256); debug('GlowStone - '+iy
); genglowstone(iy
,get_down(iy
)); end;
860 player
.setX(get_spawn_x
*16+4);
861 player
.setY((get_up(get_spawn_x
)-1)*16);
862 setmap(109,get_spawn_x
,get_up(get_spawn_x
)+1);
863 setmap(0,get_spawn_x
,get_up(get_spawn_x
));
864 setmap(0,get_spawn_x
,get_up(get_spawn_x
)-1);
865 genportal_big(get_spawn_x
-2,(get_up(get_spawn_x
)-1)-2);
870 ix
,iy
,h
,wtd
,ty
,ga
,tmp
:integer;
881 if (wtd
>0) and (wtd
<30) then h
:=h
+1;
882 if (wtd
>29) and (wtd
<60) then h
:=h
-1;
883 if wtd
=0 then h
:=h
+(2+rnd(3));
884 if wtd
=99 then h
:=h
-(2+rnd(3));
887 if wtd
=rnd(100) then begin ty
:=rnd(4); debug('Biome:'+ty
); end;
890 if getBackMap(ix
)>63 then
896 if iy
=h
then setmap(2,ix
,iy
);
897 if (iy
>h
) and (iy
<h
+4) then setmap(1,ix
,iy
);
898 if iy
>h
+3 then setmap(3,ix
,iy
);
902 if (iy
>=h
) and (iy
<=h
+1) then setmap(7,ix
,iy
);
903 if iy
=h
+2 then setmap(rnd_pr(50,56,7),ix
,iy
);
904 if iy
=h
+3 then setmap(56,ix
,iy
);
905 if iy
>h
+3 then setmap(3,ix
,iy
);
909 if iy
=h
then setmap(48,ix
,iy
);
910 if (iy
>h
) and (iy
<h
+4) then setmap(1,ix
,iy
);
911 if iy
>h
+3 then setmap(3,ix
,iy
);
915 if iy
=h
then setmap(74,ix
,iy
);
916 if (iy
>h
) and (iy
<h
+4) then setmap(1,ix
,iy
);
917 if iy
>h
+3 then setmap(3,ix
,iy
);
924 for ix
:=1 to rnd(4)+1 do begin debug('Cave'); gencave(rnd(256),64-rnd(10)); end;
926 for ix
:=1 to rnd(3) do begin debug('Mine'); genmines(rnd(256),rnd(64)+64); end;
928 for ix
:=1 to rnd(4) do begin debug('Treasure'); genteasures(rnd(256),rnd(64)+64); end;
933 for iy
:=117 to 127 do
935 if getmap(ix
,iy
)=0 then setmap(51,ix
,iy
);
942 if getBiomMap(ix
)=2 then
944 if getmap(ix
,iy
)<>0 then
946 if getmap(ix
,iy
)=50 then setmap(62,ix
,iy
); else
947 if (getmap(ix
,iy
)<>22) and (getmap(ix
,iy
)<>23) then setmap(63,ix
,iy
-1);
952 for ix
:=0 to 255 do setmap(6,ix
,127);
954 if bon_chest
then create_bonus_chest(get_spawn_x
,get_spawn_y
+1);
958 debug('World Generated!');