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  // Генерирует чанки руды в камне типа block с максимальной вероятность percent процентов
 411  // Начиная с уровня starty и размером не более maxsize*maxsize
 412  // С ростом глубины вероятность растёт
 413  procedure GenOreChunks(block, percent, starty, maxsize : Integer);
 414    const
 415      preq = 100000;
 416    var
 417      x, y, i, j : Integer;
 418    begin
 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);
 426    end;
 427
 428  procedure genallrudes;
 429   begin
 430    (* Алмазная руда *)
 431    GenOreChunks(19, 1, 111, 3);
 432    (* Золотая руда *)
 433    GenOreChunks(16, 2, 95, 3);
 434    (* Лазуритовая руда *)
 435    GenOreChunks(54, 2, 107, 3);
 436    (* Красная руда *)
 437    GenOreChunks(20, 2, 107, 3);
 438    (* Железная руда *)
 439    GenOreChunks(17, 3, 63, 3);
 440    (* Угольная руда *)
 441    GenOreChunks(18, 4, 0, 6);
 442    (* Гравий *)
 443    GenOreChunks(8, 2, 0, 6);
 444    (* Грязь *)
 445    GenOreChunks(8, 2, 0, 6);
 446   end;
 447
 448  procedure dec_0(ix,iy:integer);
 449   var
 450    t:integer;
 451   begin
 452    t:=rnd(30);
 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
 463    exit;
 464   end;
 465
 466  procedure dec_1(ix,iy:integer);
 467   var
 468    t:integer;
 469   begin
 470    t:=rnd(25);
 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
 474    exit;
 475   end;
 476
 477  procedure dec_2(ix,iy:integer);
 478   var
 479    t:integer;
 480   begin
 481    t:=rnd(30);
 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
 488    exit;
 489   end;
 490
 491  procedure dec_3(ix,iy:integer);
 492   var
 493    t:integer;
 494   begin
 495    t:=rnd(20);
 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
 500    exit;
 501   end;
 502
 503  procedure decorator;
 504   var
 505    ix,iy,t:integer;
 506   begin
 507    for ix:=0 to 255 do
 508    for iy:=0 to 127 do
 509    if getmap(ix,iy)<>0 then
 510     begin
 511      if (getBiomMap(ix)=0) then
 512       begin
 513        iy:=iy-1;
 514        if (getmap(ix,iy+1)=2) and (getmap(ix,iy)=0) then dec_0(ix,iy);
 515        break;
 516       end; else
 517      if (getBiomMap(ix)=1) then
 518       begin
 519        iy:=iy-1;
 520        if (getmap(ix,iy+1)=7) and (getmap(ix,iy)=0) then dec_1(ix,iy);
 521        break;
 522       end; else
 523      if (getBiomMap(ix)=2) then
 524       begin
 525        iy:=iy-1;
 526        if (getmap(ix,iy+1)=48) and (getmap(ix,iy)=0) then dec_2(ix,iy);
 527        break;
 528       end; else
 529      if (getBiomMap(ix)=3) then
 530       begin
 531        iy:=iy-1;
 532        if (getmap(ix,iy+1)=74) and (getmap(ix,iy)=0) then dec_3(ix,iy);
 533        break;
 534       end; else
 535      break;
 536       end;
 537   end;
 538
 539  procedure genwater;
 540   var
 541    ix,iy,i:integer;
 542    g:boolean;
 543   begin
 544    for ix:=0 to 255 do
 545    for iy:=0 to 127 do
 546     begin
 547      if rnd(5)=rnd(6) then g:=not g;
 548      if iy>63 then
 549       if (getmap(ix,iy)=2) or (getmap(ix,iy)=48) or (getmap(ix,iy)=74) then
 550        begin
 551         if g then
 552          for i:=0 to rnd(4) do setmap(64,ix,iy+i);
 553         else setmap(1,ix,iy);
 554         break;
 555        end; else
 556       if (getmap(ix,iy)=7) then
 557        begin
 558         if g then
 559          for i:=0 to rnd(4) do setmap(64,ix,iy+i);
 560         break;
 561        end;
 562      if getmap(ix,iy)<>0 then break;
 563      if iy>=63 then if getmap(ix,iy)=0 then setmap(50,ix,iy);
 564     end;
 565   end;
 566
 567  procedure minechest(x,y:integer);
 568   var
 569    ix,l,id:integer;
 570   begin
 571    id:=chest.create(x,y);
 572      setmap(28,x,y);
 573      for ix:=1 to rnd(6)+4 do
 574       begin
 575        l:=rnd(26);
 576        if rnd(75)=rnd(75) then
 577         begin
 578          chest.setItem(133 ,l, id);
 579          chest.setSum(getItemMax(133), l, id);
 580         end; else
 581        if rnd(25)=rnd(25) then
 582         begin
 583          chest.setItem(162 ,l, id);
 584          chest.setSum(rnd(2)+1, l, id);
 585         end; else
 586        if rnd(15)=rnd(15) then
 587         begin
 588          chest.setItem(165 ,l, id);
 589          chest.setSum(rnd(3)+1, l, id);
 590         end; else
 591        if rnd(15)=rnd(15) then
 592         begin
 593          chest.setItem(166 ,l, id);
 594          chest.setSum(rnd(6)+4, l, id);
 595         end; else
 596        if rnd(15)=rnd(15) then
 597         begin
 598          chest.setItem(161 ,l, id);
 599          chest.setSum(rnd(6)+4, l, id);
 600         end; else
 601        if rnd(15)=rnd(15) then
 602         begin
 603          chest.setItem(160 ,l, id);
 604          chest.setSum(rnd(6)+3, l, id);
 605         end; else
 606        if rnd(15)=rnd(15) then
 607         begin
 608          chest.setItem(164 ,l, id);
 609          chest.setSum(rnd(5)+1, l, id);
 610         end; else
 611        if rnd(4)=rnd(4) then
 612         begin
 613          chest.setItem(220 ,l, id);
 614          chest.setSum(rnd(8)+8, l, id);
 615         end;
 616       end;
 617   end;
 618
 619  procedure minestruc0(x,y:integer);
 620   var
 621    ix,iy:integer;
 622   begin
 623    for ix:=0 to 3 do
 624    for iy:=0 to 2 do
 625     setmap(0,x+ix,y+iy);
 626
 627    if rnd(8)=0 then setmap(26,x+1,y+1);
 628
 629    for ix:=0 to 3 do
 630     if getmap(x+ix,y+3)=0 then setmap(4,x+ix,y+3);
 631   end;
 632
 633  procedure minestruc1(x,y:integer);
 634   var
 635    ix,iy:integer;
 636   begin
 637    for ix:=0 to 2 do
 638    for iy:=0 to 2 do
 639     setmap(0,x+ix,y+iy);
 640
 641    if rnd(8)=0 then setmap(59,x,y);
 642    if rnd(8)=0 then setmap(59,x+2,y);
 643    setmap(4,x+1,y);
 644    setmap(93,x+1,y+1);
 645    setmap(93,x+1,y+2);
 646    for ix:=0 to 2 do
 647     if getmap(x+ix,y+3)=0 then setmap(4,x+ix,y+3);
 648   end;
 649
 650  procedure minestruc2(x,y:integer);
 651   var
 652    ix,iy:integer;
 653   begin
 654    for ix:=0 to 2 do
 655    for iy:=0 to 2 do
 656     setmap(0,x+ix,y+iy);
 657
 658    if rnd(8)=0 then setmap(59,x+1,y);
 659
 660    for iy:=0 to 2 do
 661     begin
 662      setmap(94,x,y+iy);
 663      setmap(94,x+2,y+iy);
 664     end;
 665    for ix:=0 to 2 do
 666     if getmap(x+ix,y+3)=0 then setmap(4,x+ix,y+3);
 667   end;
 668
 669  procedure minestruc3(x,y:integer);
 670   var
 671    ix,iy,id,l:integer;
 672   begin
 673    for ix:=0 to 2 do
 674    for iy:=0 to 2 do
 675     setmap(0,x+ix,y+iy);
 676
 677    minechest(x+1,y+2);
 678
 679    for ix:=0 to 2 do
 680     if getmap(x+ix,y+3)=0 then setmap(4,x+ix,y+3);
 681   end;
 682
 683  procedure genmines(x,y:integer);
 684   var
 685    mask:array[0..15,0..15] of integer;
 686    ix,iy,by:integer;
 687   begin
 688    for iy:=0 to 15 do
 689    for ix:=0 to 15 do
 690     mask[ix,iy]:=-1;
 691
 692    for iy:=rnd(8)+8 downto rnd(8) do
 693    for ix:=rnd(8) to rnd(8)+8 do
 694     begin
 695      if ix-1>=0 then
 696       begin
 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);
 702       end;
 703
 704      if mask[ix,iy]=0 then
 705       begin
 706        if rnd(16)=0 then mask[ix,iy]:=3;
 707       end;
 708     end;
 709
 710    for iy:=15 downto 0 do
 711    for ix:=0 to 15 do
 712     begin
 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));
 718     end;
 719   end;
 720
 721  function get_up(Xi:integer):integer;
 722   var
 723    iy:integer;
 724   begin
 725    for iy:=127 downto 0 do
 726     if getmap(xi,iy)=0 then begin get_up:=iy; break; end;
 727   end;
 728
 729  function get_down(Xi:integer):integer;
 730   var
 731    iy:integer;
 732   begin
 733    for iy:=2 to 127 do
 734   if getmap(xi,iy)=0 then begin get_down:=iy; break; end;
 735   end;
 736
 737   procedure gensoulsand(gx,gy:integer;);
 738   var
 739     ix2,iy2:integer;
 740   begin
 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);
 744   end;
 745
 746   procedure genglowstone(gx,gy:integer;);
 747   var
 748     ix2,iy2:integer;
 749   begin
 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);
 753   end;
 754
 755  procedure gennether;
 756   var
 757    ix,iy,h,wtd,ty,ga,tmp:integer;
 758   begin
 759    for ix:=0 to 255 do
 760    for iy:=1 to 126 do
 761     begin
 762      if (getmap(ix,iy)<>10) or (getmap(ix,iy)<>110) then
 763       setmap(109,ix,iy);
 764     end;
 765    h:=63;
 766    ty:=4;
 767    for ix:=0 to 255 do
 768     begin
 769      wtd:=rnd(100);
 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));
 774      if h<30 then h:=31;
 775      if h>70 then h:=69;
 776      setBiomMap(ty, ix);
 777      setBackMap(0, ix);
 778      for iy:=h-10-(1-rnd(3)) to h+rnd(2) do
 779       begin
 780         setmap(0,ix,iy);
 781       end;
 782     end;
 783
 784    for ix:=0 to 255 do
 785    for iy:=65 to 127 do
 786     begin
 787      if getmap(ix,iy)=0 then setmap(51,ix,iy);
 788     end;
 789
 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;
 792
 793    for ix:=0 to 255 do
 794    begin
 795      setmap(6,ix,127);
 796      setmap(6,ix,0);
 797    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);
 804   end;
 805
 806  procedure genworld;
 807   var
 808    ix,iy,h,wtd,ty,ga,tmp:integer;
 809   begin
 810    pl_world:=0;
 811    for ix:=0 to 255 do
 812    for iy:=0 to 127 do
 813    setmap(0,ix,iy);
 814    h:=63;
 815    ty:=rnd(4);
 816    for ix:=0 to 255 do
 817     begin
 818      wtd:=rnd(100);
 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));
 823      if h<0 then h:=0;
 824      if h>80 then h:=80;
 825      if wtd=rnd(100) then begin ty:=rnd(4); debug('Biome:'+ty); end;
 826      setBiomMap(ty, ix);
 827      setBackMap(h, ix);
 828      if getBackMap(ix)>63 then
 829       setBackMap(63, ix);
 830      for iy:=h to 127 do
 831       begin
 832        if ty=0 then
 833         begin
 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);
 837         end; else
 838        if ty=1 then
 839         begin
 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);
 844         end; else
 845        if ty=2 then
 846         begin
 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);
 850         end;  else
 851        if ty=3 then
 852         begin
 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);
 856         end;
 857       end;
 858     end;
 859
 860    genallrudes;
 861
 862    for ix:=1 to rnd(4)+1 do begin debug('Cave'); gencave(rnd(256),64-rnd(10)); end;
 863
 864    for ix:=1 to rnd(3) do begin debug('Mine'); genmines(rnd(256),rnd(64)+64); end;
 865
 866    for ix:=1 to rnd(4) do begin debug('Treasure'); genteasures(rnd(256),rnd(64)+64); end;
 867
 868    genwater;
 869
 870    for ix:=0 to 255 do
 871    for iy:=117 to 127 do
 872     begin
 873      if getmap(ix,iy)=0 then setmap(51,ix,iy);
 874     end;
 875
 876    decorator;
 877
 878    for ix:=0 to 255 do
 879     begin
 880      if getBiomMap(ix)=2 then
 881       for iy:=0 to 127 do
 882        if getmap(ix,iy)<>0 then
 883         begin
 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);
 886          break;
 887         end;
 888     end;
 889
 890    for ix:=0 to 255 do setmap(6,ix,127);
 891
 892    if bon_chest then create_bonus_chest(get_spawn_x,get_spawn_y+1);
 893
 894    //drawmap;
 895    delay(200);
 896    debug('World Generated!');
 897   end;
 898
 899 initialization
 900
 901 end.