src/worldgen.mpsrc

   1 //Thanks:
   2 //ZeroNoWing
   3 //Andrey59
   4
   5 unit worldgen;
   6
   7 interface
   8  procedure genworld;//Вызывается из главного модуля для начала генерации мира
   9  procedure gennether;
  10  procedure genflat;
  11  procedure genportal(xx,yy:integer);
  12  function get_up(Xi:integer):integer;
  13
  14  procedure genwood1(xx,yy:integer);//дуб
  15  procedure genwood2(xx,yy:integer);//берёза
  16  procedure genwood3(xx,yy:integer);//ель
  17
  18
  19 implementation
  20 uses maps,randoms,vars,items,func, player, chest, items_store;
  21
  22  function rnd_min:integer;
  23   begin
  24    rnd_min:=rnd(3)-1;
  25   end;
  26
  27 procedure create_bonus_chest(chx,chy:integer);
  28  var
  29    ix,l,id,time:integer;
  30  begin
  31   time:=getcurrenttime;
  32   if ((getmonth(time)=0) and (getday(time)<3)) or ((getmonth(time)=11) and (getday(time)>29)) then
  33    setmap(102,chx,chy);
  34   else
  35    setmap(28,chx,chy);
  36   setmap(26,chx-1,chy);
  37   setmap(26,chx+1,chy);
  38   setmapinfo(31,chx,chy);
  39   id:=chest.create(chx,chy);
  40   debug('Bonus Chest');
  41     for ix:=1 to rnd(10)+1 do
  42      begin
  43       l:=rnd(26);
  44       if rnd(2)=rnd(2) then
  45        begin
  46         chest.setItem(127 ,l, id);
  47         chest.setSum(rnd(6)+1, l, id);
  48        end; else
  49       if rnd(2)=rnd(2) then
  50        begin
  51         chest.setItem(9 ,l, id);
  52         chest.setSum(rnd(4)+1, l, id);
  53        end; else
  54       if rnd(2)=rnd(2) then
  55        begin
  56         chest.setItem(4 ,l, id);
  57         chest.setSum(rnd(4)+1, l, id);
  58        end; else
  59       if rnd(2)=rnd(2) then
  60        begin
  61         chest.setItem(131 ,l, id);
  62         chest.setSum(60, l, id);
  63        end; else
  64       if rnd(2)=rnd(2) then
  65        begin
  66         chest.setItem(132 ,l, id);
  67         chest.setSum(132, l, id);
  68        end;
  69       if rnd(2)=rnd(2) then
  70        begin
  71         chest.setItem(141 ,l, id);
  72         chest.setSum(60, l, id);
  73        end; else
  74       if rnd(2)=rnd(2) then
  75        begin
  76         chest.setItem(142 ,l, id);
  77         chest.setSum(132, l, id);
  78        end;
  79       if rnd(2)=rnd(2) then
  80        begin
  81         chest.setItem(147 ,l, id);
  82         chest.setSum(60, l, id);
  83        end; else
  84       if rnd(2)=rnd(2) then
  85        begin
  86         chest.setItem(201 ,l, id);
  87         chest.setSum(rnd(16), l, id);
  88        end;
  89      end;
  90  end;
  91
  92  procedure genflat;
  93   var
  94    ix,iy:integer;
  95   begin
  96    for ix:=0 to 255 do
  97     begin
  98      setmap(2,ix,121);
  99      setmap(1,ix,122);
 100      setmap(1,ix,123);
 101      setmap(3,ix,124);
 102      setmap(3,ix,125);
 103      setmap(3,ix,126);
 104      setmap(6,ix,127);
 105
 106      setBackMap(121, ix);
 107      setBiomMap(0, ix);
 108     end;
 109    if bon_chest then create_bonus_chest(get_spawn_x,get_spawn_y+1);
 110    delay(200);
 111   end;
 112
 113  procedure drawmap;
 114   var
 115    ix,iy:integer;
 116   begin
 117    for ix:=0 to 255 do
 118    for iy:=0 to 127 do
 119     begin
 120      if getmap(ix,iy)<>0 then setcolor(0,0,0); else setcolor(255,255,255);
 121      plot(ix,iy);
 122     end;
 123    repaint;
 124    delay(1);
 125   end;
 126
 127  procedure gencave(xx,yy:integer);
 128   var
 129    ix,iy:integer;
 130    mask:array [0..63,0..63] of boolean;
 131   begin
 132    for ix:=0 to 63 do
 133    for iy:=0 to 63 do
 134     mask[ix,iy]:=true;
 135    ix:=(63+1)/2-1;
 136    iy:=(63+1)/2-1;
 137    while (ix>=0) and (ix<=63) and (iy>=0) and (iy<=63) do
 138     begin
 139      ix:=ix+rnd_min;
 140      iy:=iy+rnd_min;
 141      if (ix>=0) and (ix<=63) and (iy>=0) and (iy<=63) then mask[ix,iy]:=false;
 142     end;
 143    for ix:=1 to 62 do
 144    for iy:=1 to 62 do
 145     begin
 146      if mask[ix,iy]=true then
 147       if mask[ix-1,iy]=false then
 148        if mask[ix+1,iy]=false then
 149        mask[ix,iy]:=false;
 150     end;
 151
 152    for ix:=0 to 63 do
 153    for iy:=0 to 63 do
 154     begin
 155      if mask[ix,iy]=false then setmap(0,xx+ix,yy+iy);
 156     end;
 157   end;
 158
 159  procedure genportal(xx,yy:integer);
 160   begin
 161    setmap(10,xx+1,yy);
 162    setmap(10,xx+2,yy);
 163    setmap(118,xx,yy+1);
 164    setmap(118,xx+3,yy+1);
 165    setmap(118,xx,yy+2);
 166    setmap(118,xx+3,yy+2);
 167    setmap(118,xx,yy+3);
 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);
 177   end;
 178
 179  procedure genportal_big(xx,yy:integer);
 180   begin
 181    setmap(10,xx,yy);
 182    setmap(10,xx+1,yy);
 183    setmap(10,xx+2,yy);
 184    setmap(10,xx+3,yy);
 185    setmap(118,xx,yy+1);
 186    setmap(118,xx+3,yy+1);
 187    setmap(118,xx,yy+2);
 188    setmap(118,xx+3,yy+2);
 189    setmap(118,xx,yy+3);
 190    setmap(118,xx+3,yy+3);
 191    setmap(10,xx,yy+4);
 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);
 201   end;
 202
 203  procedure surprisechest(x,y:integer);
 204   var
 205    ix,l,id:integer;
 206   begin
 207    id:=chest.create(x, y);
 208      debug('Surprise!');
 209      setmap(102,x,y);
 210      for ix:=1 to rnd(8) do
 211       begin
 212        l:=rnd(26);
 213        if rnd(22)=1 then
 214         begin
 215          chest.setItem(162 ,l, id);
 216          chest.setSum(rnd(5), l, id);
 217         end; else
 218        if rnd(11)=1 then
 219         begin
 220          chest.setItem(165 ,l, id);
 221          chest.setSum(rnd(6), l, id);
 222         end; else
 223        if rnd(11)=1 then
 224         begin
 225          chest.setItem(181 ,l, id);
 226          chest.setSum(rnd(2), l, id);
 227         end; else
 228        if rnd(11)=1 then
 229         begin
 230          chest.setItem(182 ,l, id);
 231          chest.setSum(rnd(2), l, id);
 232         end; else
 233        if rnd(11)=1 then
 234         begin
 235          chest.setItem(176 ,l, id);
 236          chest.setSum(rnd(32), l, id);
 237         end; else
 238        if rnd(11)=1 then
 239         begin
 240          chest.setItem(183 ,l, id);
 241          chest.setSum(rnd(10)+1, l, id);
 242         end; else
 243        if rnd(11)=1 then
 244         begin
 245          chest.setItem(186 ,l, id);
 246          chest.setSum(1, l, id);
 247         end;
 248       end;
 249   end;
 250
 251  procedure genwood1(xx,yy:integer);//дуб
 252   begin
 253    setmap(75,xx,yy);
 254    setmap(75,xx,yy-1);
 255    setmap(75,xx,yy-2);
 256    setmap(21,xx,yy-3);
 257    setmap(21,xx,yy-4);
 258    setmap(21,xx,yy-5);
 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);
 263   end;
 264
 265  procedure genwood2(xx,yy:integer);//берёза
 266   begin
 267    setmap(84,xx,yy);
 268    setmap(84,xx,yy-1);
 269    setmap(84,xx,yy-2);
 270    setmap(112,xx,yy-3);
 271    setmap(112,xx,yy-4);
 272    setmap(112,xx,yy-5);
 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);
 277   end;
 278
 279  procedure genwood3(xx,yy:integer);//ель
 280   var
 281    time:integer;
 282   begin
 283    setmap(87,xx,yy-5);
 284    setmap(87,xx-1,yy-4); setmap(87,xx,yy-4); setmap(87,xx+1,yy-4);
 285    setmap(86,xx,yy-3);
 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);
 288    setmap(86,xx,yy);
 289    time:=getcurrenttime;
 290    if ((getmonth(time)=0) and (getday(time)<3)) or ((getmonth(time)=11) and (getday(time)>29)) then
 291     begin
 292      if rnd(3)=1 then surprisechest(xx-1,yy);
 293      if rnd(3)=1 then surprisechest(xx+1,yy);
 294     end;
 295   end;
 296
 297  procedure genfungus1(xx,yy:integer);//красный гриб
 298   begin
 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);
 302    setmap(89,xx,yy-1);
 303    setmap(89,xx,yy);
 304   end;
 305
 306  procedure genfungus2(xx,yy:integer);//коричневый гриб
 307   begin
 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);
 309    setmap(91,xx,yy-3);
 310    setmap(91,xx,yy-2);
 311    setmap(91,xx,yy-1);
 312    setmap(91,xx,yy);
 313   end;
 314
 315  procedure gencactus(xx,yy:integer);
 316   begin
 317    setmap(30,xx,yy);
 318    setmap(30,xx,yy-1);
 319    setmap(30,xx,yy-2);
 320   end;
 321
 322  procedure gencane(xx,yy:integer);
 323   begin
 324    setmap(65,xx,yy);
 325    setmap(65,xx,yy-1);
 326    setmap(65,xx,yy-2);
 327   end;
 328
 329  procedure treasurechest(x,y:integer);
 330   var
 331    ix,l,id:integer;
 332   begin
 333    id:=chest.create(x, y);
 334      debug('Treasure Chest');
 335      setmap(28,x,y);
 336      for ix:=1 to rnd(8) do
 337       begin
 338        l:=rnd(26);
 339        if rnd(22)=rnd(22) then
 340         begin
 341          chest.setItem(161 ,l, id);
 342          chest.setSum(rnd(4)+1, l, id);
 343         end; else
 344        if rnd(11)=rnd(11) then
 345         begin
 346          chest.setItem(164 ,l, id);
 347          chest.setSum(rnd(4)+1, l, id);
 348         end; else
 349        if rnd(11)=rnd(11) then
 350         begin
 351          chest.setItem(183 ,l, id);
 352          chest.setSum(rnd(4)+1, l, id);
 353         end; else
 354        if rnd(11)=rnd(11) then
 355         begin
 356          chest.setItem(167 ,l, id);
 357          chest.setSum(rnd(4)+1, l, id);
 358         end; else
 359        if rnd(11)=rnd(11) then
 360         begin
 361          chest.setItem(171 ,l, id);
 362          chest.setSum(1, l, id);
 363         end; else
 364        if rnd(4)=rnd(4) then
 365         begin
 366          chest.setItem(220 ,l, id);
 367          chest.setSum(rnd(8)+8, l, id);
 368         end;
 369       end;
 370   end;
 371
 372  procedure genteasures(xx,yy:integer);
 373   var
 374    ix,iy:integer;
 375   begin
 376    for ix:=0 to 6 do
 377    for iy:=0 to 6 do
 378     begin
 379      setmap(0,xx+ix,yy+iy);
 380     end;
 381    for ix:=0 to 6 do
 382     begin
 383      setmap(12,xx+ix,yy);
 384      setmap(12,xx+ix,yy+6);
 385      setmap(12,xx,yy+ix);
 386      setmap(12,xx+6,yy+ix);
 387     end;
 388
 389    setmap(76,xx+3,yy+5);
 390    setmapinfo(1,xx+3,yy+5);
 391
 392    if rnd(2)=1 then
 393     treasurechest(xx+1,yy+5);
 394
 395    if rnd(2)=1 then
 396     treasurechest(xx+5,yy+5);
 397   end;
 398
 399  procedure genrude(t,r,xx,yy,xxx,yyy:integer);
 400   var
 401    ix,iy:integer;
 402   begin
 403    for ix:=0 to xxx do
 404    for iy:=0 to yyy do
 405     begin
 406       if getmap(xx+ix,yy+iy)=3 then if rnd(r+1)-1=0 then setmap(t,xx+ix,yy+iy);
 407     end;
 408   end;
 409
 410  procedure genallrudes;
 411   var
 412    ix,iy,iu,iv:integer;
 413   begin
 414    //алмазы
 415    for ix:=0 to 255 do
 416    for iy:=111 to 127 do
 417     if (rnd_pr(1,1,0)=1) then
 418      begin
 419       for iu:=0 to 2 do
 420       for iv:=0 to 2 do
 421        if getmap(ix+iu,iy+iv)=3 then setmap(rnd_pr(10,19,getmap(ix+iu,iy+iv)),ix+iu,iy+iv);
 422       ix:=ix+3;
 423      end;
 424
 425    //золото
 426    for ix:=0 to 255 do
 427    for iy:=95 to 127 do
 428     if (rnd_pr(3,1,0)=1) then
 429      begin
 430       for iu:=0 to 2 do
 431       for iv:=0 to 2 do
 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);
 434       ix:=ix+3;
 435      end;
 436
 437    //лазурит
 438    for ix:=0 to 255 do
 439    for iy:=107 to 127 do
 440     if (rnd_pr(2,1,0)=1) then
 441      begin
 442       for iu:=0 to 2 do
 443       for iv:=0 to 2 do
 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);
 446       ix:=ix+3;
 447      end;
 448
 449    //редстоун
 450    for ix:=0 to 255 do
 451    for iy:=107 to 127 do
 452     if (rnd_pr(2,1,0)=1) then
 453      begin
 454       for iu:=0 to 2 do
 455       for iv:=0 to 2 do
 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);
 458       ix:=ix+3;
 459      end;
 460
 461    //железо
 462    for ix:=0 to 255 do
 463    for iy:=63 to 127 do
 464     if (rnd_pr(4,1,0)=1) then
 465      begin
 466       for iu:=0 to 2 do
 467       for iv:=0 to 2 do
 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);
 470       ix:=ix+3;
 471      end;
 472
 473    //уголь
 474    for ix:=0 to 255 do
 475    for iy:=0 to 127 do
 476     if (rnd_pr(6,1,0)=1) then
 477      begin
 478       for iu:=0 to 2 do
 479       for iv:=0 to 2 do
 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);
 482       ix:=ix+3;
 483      end;
 484
 485    //гравий
 486    for ix:=0 to 255 do
 487    for iy:=63 to 126 do
 488     if (rnd_pr(2,1,0)=1) then
 489      begin
 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);
 494       ix:=ix+3;
 495      end;
 496
 497    //земля на камне
 498    for ix:=0 to 255 do
 499    for iy:=63 to 127 do
 500     if (rnd_pr(1,1,0)=1) then
 501      begin
 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);
 506       ix:=ix+3;
 507      end;
 508   end;
 509
 510  procedure dec_0(ix,iy:integer);
 511   var
 512    t:integer;
 513   begin
 514    t:=rnd(30);
 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
 525    exit;
 526   end;
 527
 528  procedure dec_1(ix,iy:integer);
 529   var
 530    t:integer;
 531   begin
 532    t:=rnd(25);
 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
 536    exit;
 537   end;
 538
 539  procedure dec_2(ix,iy:integer);
 540   var
 541    t:integer;
 542   begin
 543    t:=rnd(30);
 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
 550    exit;
 551   end;
 552
 553  procedure dec_3(ix,iy:integer);
 554   var
 555    t:integer;
 556   begin
 557    t:=rnd(20);
 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
 562    exit;
 563   end;
 564
 565  procedure decorator;
 566   var
 567    ix,iy,t:integer;
 568   begin
 569    for ix:=0 to 255 do
 570    for iy:=0 to 127 do
 571    if getmap(ix,iy)<>0 then
 572     begin
 573      if (getBiomMap(ix)=0) then
 574       begin
 575        iy:=iy-1;
 576        if (getmap(ix,iy+1)=2) and (getmap(ix,iy)=0) then dec_0(ix,iy);
 577        break;
 578       end; else
 579      if (getBiomMap(ix)=1) then
 580       begin
 581        iy:=iy-1;
 582        if (getmap(ix,iy+1)=7) and (getmap(ix,iy)=0) then dec_1(ix,iy);
 583        break;
 584       end; else
 585      if (getBiomMap(ix)=2) then
 586       begin
 587        iy:=iy-1;
 588        if (getmap(ix,iy+1)=48) and (getmap(ix,iy)=0) then dec_2(ix,iy);
 589        break;
 590       end; else
 591      if (getBiomMap(ix)=3) then
 592       begin
 593        iy:=iy-1;
 594        if (getmap(ix,iy+1)=74) and (getmap(ix,iy)=0) then dec_3(ix,iy);
 595        break;
 596       end; else
 597      break;
 598       end;
 599   end;
 600
 601  procedure genwater;
 602   var
 603    ix,iy,i:integer;
 604    g:boolean;
 605   begin
 606    for ix:=0 to 255 do
 607    for iy:=0 to 127 do
 608     begin
 609      if rnd(5)=rnd(6) then g:=not g;
 610      if iy>63 then
 611       if (getmap(ix,iy)=2) or (getmap(ix,iy)=48) or (getmap(ix,iy)=74) then
 612        begin
 613         if g then
 614          for i:=0 to rnd(4) do setmap(64,ix,iy+i);
 615         else setmap(1,ix,iy);
 616         break;
 617        end; else
 618       if (getmap(ix,iy)=7) then
 619        begin
 620         if g then
 621          for i:=0 to rnd(4) do setmap(64,ix,iy+i);
 622         break;
 623        end;
 624      if getmap(ix,iy)<>0 then break;
 625      if iy>=63 then if getmap(ix,iy)=0 then setmap(50,ix,iy);
 626     end;
 627   end;
 628
 629  procedure minechest(x,y:integer);
 630   var
 631    ix,l,id:integer;
 632   begin
 633    id:=chest.create(x,y);
 634      setmap(28,x,y);
 635      for ix:=1 to rnd(6)+4 do
 636       begin
 637        l:=rnd(26);
 638        if rnd(75)=rnd(75) then
 639         begin
 640          chest.setItem(133 ,l, id);
 641          chest.setSum(getItemMax(133), l, id);
 642         end; else
 643        if rnd(25)=rnd(25) then
 644         begin
 645          chest.setItem(162 ,l, id);
 646          chest.setSum(rnd(2)+1, l, id);
 647         end; else
 648        if rnd(15)=rnd(15) then
 649         begin
 650          chest.setItem(165 ,l, id);
 651          chest.setSum(rnd(3)+1, l, id);
 652         end; else
 653        if rnd(15)=rnd(15) then
 654         begin
 655          chest.setItem(166 ,l, id);
 656          chest.setSum(rnd(6)+4, l, id);
 657         end; else
 658        if rnd(15)=rnd(15) then
 659         begin
 660          chest.setItem(161 ,l, id);
 661          chest.setSum(rnd(6)+4, l, id);
 662         end; else
 663        if rnd(15)=rnd(15) then
 664         begin
 665          chest.setItem(160 ,l, id);
 666          chest.setSum(rnd(6)+3, l, id);
 667         end; else
 668        if rnd(15)=rnd(15) then
 669         begin
 670          chest.setItem(164 ,l, id);
 671          chest.setSum(rnd(5)+1, l, id);
 672         end; else
 673        if rnd(4)=rnd(4) then
 674         begin
 675          chest.setItem(220 ,l, id);
 676          chest.setSum(rnd(8)+8, l, id);
 677         end;
 678       end;
 679   end;
 680
 681  procedure minestruc0(x,y:integer);
 682   var
 683    ix,iy:integer;
 684   begin
 685    for ix:=0 to 3 do
 686    for iy:=0 to 2 do
 687     setmap(0,x+ix,y+iy);
 688
 689    if rnd(8)=0 then setmap(26,x+1,y+1);
 690
 691    for ix:=0 to 3 do
 692     if getmap(x+ix,y+3)=0 then setmap(4,x+ix,y+3);
 693   end;
 694
 695  procedure minestruc1(x,y:integer);
 696   var
 697    ix,iy:integer;
 698   begin
 699    for ix:=0 to 2 do
 700    for iy:=0 to 2 do
 701     setmap(0,x+ix,y+iy);
 702
 703    if rnd(8)=0 then setmap(59,x,y);
 704    if rnd(8)=0 then setmap(59,x+2,y);
 705    setmap(4,x+1,y);
 706    setmap(93,x+1,y+1);
 707    setmap(93,x+1,y+2);
 708    for ix:=0 to 2 do
 709     if getmap(x+ix,y+3)=0 then setmap(4,x+ix,y+3);
 710   end;
 711
 712  procedure minestruc2(x,y:integer);
 713   var
 714    ix,iy:integer;
 715   begin
 716    for ix:=0 to 2 do
 717    for iy:=0 to 2 do
 718     setmap(0,x+ix,y+iy);
 719
 720    if rnd(8)=0 then setmap(59,x+1,y);
 721
 722    for iy:=0 to 2 do
 723     begin
 724      setmap(94,x,y+iy);
 725      setmap(94,x+2,y+iy);
 726     end;
 727    for ix:=0 to 2 do
 728     if getmap(x+ix,y+3)=0 then setmap(4,x+ix,y+3);
 729   end;
 730
 731  procedure minestruc3(x,y:integer);
 732   var
 733    ix,iy,id,l:integer;
 734   begin
 735    for ix:=0 to 2 do
 736    for iy:=0 to 2 do
 737     setmap(0,x+ix,y+iy);
 738
 739    minechest(x+1,y+2);
 740
 741    for ix:=0 to 2 do
 742     if getmap(x+ix,y+3)=0 then setmap(4,x+ix,y+3);
 743   end;
 744
 745  procedure genmines(x,y:integer);
 746   var
 747    mask:array[0..15,0..15] of integer;
 748    ix,iy,by:integer;
 749   begin
 750    for iy:=0 to 15 do
 751    for ix:=0 to 15 do
 752     mask[ix,iy]:=-1;
 753
 754    for iy:=rnd(8)+8 downto rnd(8) do
 755    for ix:=rnd(8) to rnd(8)+8 do
 756     begin
 757      if ix-1>=0 then
 758       begin
 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);
 764       end;
 765
 766      if mask[ix,iy]=0 then
 767       begin
 768        if rnd(16)=0 then mask[ix,iy]:=3;
 769       end;
 770     end;
 771
 772    for iy:=15 downto 0 do
 773    for ix:=0 to 15 do
 774     begin
 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));
 780     end;
 781   end;
 782
 783  function get_up(Xi:integer):integer;
 784   var
 785    iy:integer;
 786   begin
 787    for iy:=127 downto 0 do
 788     if getmap(xi,iy)=0 then begin get_up:=iy; break; end;
 789   end;
 790
 791  function get_down(Xi:integer):integer;
 792   var
 793    iy:integer;
 794   begin
 795    for iy:=2 to 127 do
 796   if getmap(xi,iy)=0 then begin get_down:=iy; break; end;
 797   end;
 798
 799   procedure gensoulsand(gx,gy:integer;);
 800   var
 801     ix2,iy2:integer;
 802   begin
 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);
 806   end;
 807
 808   procedure genglowstone(gx,gy:integer;);
 809   var
 810     ix2,iy2:integer;
 811   begin
 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);
 815   end;
 816
 817  procedure gennether;
 818   var
 819    ix,iy,h,wtd,ty,ga,tmp:integer;
 820   begin
 821    for ix:=0 to 255 do
 822    for iy:=1 to 126 do
 823     begin
 824      if (getmap(ix,iy)<>10) or (getmap(ix,iy)<>110) then
 825       setmap(109,ix,iy);
 826     end;
 827    h:=63;
 828    ty:=4;
 829    for ix:=0 to 255 do
 830     begin
 831      wtd:=rnd(100);
 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));
 836      if h<30 then h:=31;
 837      if h>70 then h:=69;
 838      setBiomMap(ty, ix);
 839      setBackMap(0, ix);
 840      for iy:=h-10-(1-rnd(3)) to h+rnd(2) do
 841       begin
 842         setmap(0,ix,iy);
 843       end;
 844     end;
 845
 846    for ix:=0 to 255 do
 847    for iy:=65 to 127 do
 848     begin
 849      if getmap(ix,iy)=0 then setmap(51,ix,iy);
 850     end;
 851
 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;
 854
 855    for ix:=0 to 255 do
 856    begin
 857      setmap(6,ix,127);
 858      setmap(6,ix,0);
 859    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);
 866   end;
 867
 868  procedure genworld;
 869   var
 870    ix,iy,h,wtd,ty,ga,tmp:integer;
 871   begin
 872    pl_world:=0;
 873    for ix:=0 to 255 do
 874    for iy:=0 to 127 do
 875    setmap(0,ix,iy);
 876    h:=63;
 877    ty:=rnd(4);
 878    for ix:=0 to 255 do
 879     begin
 880      wtd:=rnd(100);
 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));
 885      if h<0 then h:=0;
 886      if h>80 then h:=80;
 887      if wtd=rnd(100) then begin ty:=rnd(4); debug('Biome:'+ty); end;
 888      setBiomMap(ty, ix);
 889      setBackMap(h, ix);
 890      if getBackMap(ix)>63 then
 891       setBackMap(63, ix);
 892      for iy:=h to 127 do
 893       begin
 894        if ty=0 then
 895         begin
 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);
 899         end; else
 900        if ty=1 then
 901         begin
 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);
 906         end; else
 907        if ty=2 then
 908         begin
 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);
 912         end;  else
 913        if ty=3 then
 914         begin
 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);
 918         end;
 919       end;
 920     end;
 921
 922    genallrudes;
 923
 924    for ix:=1 to rnd(4)+1 do begin debug('Cave'); gencave(rnd(256),64-rnd(10)); end;
 925
 926    for ix:=1 to rnd(3) do begin debug('Mine'); genmines(rnd(256),rnd(64)+64); end;
 927
 928    for ix:=1 to rnd(4) do begin debug('Treasure'); genteasures(rnd(256),rnd(64)+64); end;
 929
 930    genwater;
 931
 932    for ix:=0 to 255 do
 933    for iy:=117 to 127 do
 934     begin
 935      if getmap(ix,iy)=0 then setmap(51,ix,iy);
 936     end;
 937
 938    decorator;
 939
 940    for ix:=0 to 255 do
 941     begin
 942      if getBiomMap(ix)=2 then
 943       for iy:=0 to 127 do
 944        if getmap(ix,iy)<>0 then
 945         begin
 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);
 948          break;
 949         end;
 950     end;
 951
 952    for ix:=0 to 255 do setmap(6,ix,127);
 953
 954    if bon_chest then create_bonus_chest(get_spawn_x,get_spawn_y+1);
 955
 956    //drawmap;
 957    delay(200);
 958    debug('World Generated!');
 959   end;
 960
 961 initialization
 962
 963 end.