src/CAVE.mpsrc

   1 program CAVE;
   2
   3 uses
   4  sign,
   5  jsr75i,
   6  drop,
   7  invui,
   8  vars,
   9  randoms,
  10  memory,
  11  worldgen,
  12  canvas,
  13  items,
  14  safeload,
  15  mobs,
  16  console,
  17  effects,
  18  particles,
  19  keyboard,
  20  maps,
  21  phy,
  22  utils,
  23  func,
  24  CellUI,
  25  furnace,
  26  player,
  27  items_logic,
  28  chest,
  29  inv,
  30  items_store,
  31  video;
  32
  33 const
  34   version_map = 9;
  35
  36 var
  37  keymode,updx,updy:integer;
  38  seed,nextseed:integer;
  39  free_ram:real;
  40
  41  light:array [0..15] of image;
  42  bg:array[0..1] of image;
  43  osad:array [0..1,0..7] of image;
  44  back:array [0..8] of image;
  45  gui:array [0..34] of image;
  46  tue:array [0..9] of image;
  47
  48  sign_im:image;
  49  sky:image;
  50  sun:image;
  51  moon:image;
  52  moon_phase:integer;
  53  toolus,toolind:integer;
  54  osadki_ani:integer;
  55  sav_fl:string;
  56  global_light:integer;
  57  world_typ:integer;
  58  float:image;
  59
  60  msg:array [0..4] of string;
  61  msg_time:array[0..4] of integer;
  62  last_sleep_x,last_sleep_y:integer;
  63
  64  ifminimap:boolean;
  65  gt:integer;
  66
  67  del,dt,time:integer;
  68
  69  deb:boolean;
  70
  71 procedure newworld;
  72  var
  73   ix,iy:integer;
  74  begin
  75   if nextseed=0 then seed:=getrelativetimems; else seed:=nextseed;
  76   nextseed:=0;
  77   srand(seed);
  78   if world_typ=0 then genworld;
  79   else
  80   if world_typ=1 then genflat;
  81   world_typ:=0;
  82   player.setX(get_spawn_x*16+4);
  83   player.setY(get_spawn_y*16);
  84   pl_world:=0;
  85  end;
  86
  87 procedure drwrect(x,y,w,h,t:integer);
  88  var
  89   i:integer;
  90  begin
  91   for i:=0 to t do
  92   drawrect(x+i,y+i,w-i*2,h-i*2);
  93  end;
  94
  95 procedure proc_fps;
  96  begin
  97   dt:=GetRelativeTimeMs - time;
  98   time:=GetRelativeTimeMs;
  99   fps:=1000/dt;
 100  end;
 101
 102 procedure maxfps;
 103  begin
 104   if fps<s_max_fps then if del>0 then del:=del-1;
 105   if fps>s_max_fps then if del<200 then del:=del+1;
 106   delay(del);
 107  end;
 108
 109 procedure ClearTextures;
 110   var
 111     no : image;
 112     ix, iy, iz : integer;
 113   begin
 114     bg[0] := no;
 115     bg[1] := no;
 116     float := no;
 117     compas := no;
 118     for ix := 0 to 7 do
 119       clock[ix] := no;
 120
 121     for ix := 0 to maxBlockTex do
 122       begin
 123         tex[ix] := no;
 124         tex8[ix] := no;
 125       end;
 126     for ix := 0 to maxItemTex do
 127       begin
 128         item[ix] := no;
 129         item8[ix] := no;
 130       end;
 131
 132     for ix := 0 to 8 do
 133       back[ix]:=no;
 134
 135     player.freeSkin;
 136
 137     for ix := 0 to 34 do
 138       gui[ix] := no;
 139     for ix := 0 to 9 do
 140       tue[ix] := no;
 141     for ix := 0 to 7 do
 142       osad[0, ix] := no;
 143     for ix := 0 to 7 do
 144       osad[1, ix] := no;
 145
 146     for ix := 0 to 15 do
 147       light[ix] := no;
 148
 149     Particles.FreeTextures;
 150     Mobs.FreeTextures;
 151
 152     sky := no;
 153     sun := no;
 154     moon := no;
 155     sign_im := no;
 156
 157     for ix := 0 to CONST_MAX_CURS do
 158       LoadCurImg(no, ix);
 159
 160     //resetVirtualKeyboard(-1);
 161   end;
 162
 163 procedure create_msg(s:string);
 164  var
 165   i,t:integer;
 166  begin
 167   for i:=3 downto 0 do
 168    begin
 169     if i=0 then break;
 170     msg_time[i]:=msg_time[i-1];
 171     msg[i]:=msg[i-1];
 172    end;
 173   msg_time[0]:=getrelativetimems;
 174   msg[0]:=s;
 175  end;
 176
 177 procedure loadtexture(path:string);
 178  var
 179   ix,iy,iz:integer;
 180   im:image;
 181  begin
 182   cleartextures;
 183   im:=ld_tex('background.png',path,'title/');
 184   for ix:=0 to 1 do
 185   bg[ix]:=rotate_image_from_image(im,ix*16,0,16,16,0);
 186   float:=ld_tex('float.png',path,'gui/');
 187   compas:=ld_tex('compass.png',path,'gui/');
 188   im:=ld_tex('clock.png',path,'gui/');
 189   for ix:=0 to 7 do
 190    clock[ix]:=rotate_image_from_image(im,ix*16,0,16,16,0);
 191   if load_back_tex then
 192    begin
 193     im:=ld_tex('back.png',path,'');
 194     for ix:=0 to 8 do back[ix]:=rotate_image_from_image(im,ix*16,0,16,16,0);
 195    end;
 196
 197   console.exec('textures.cfg', 'AUTO');
 198
 199   Player.LoadSkin('char_ani.png', path);
 200   Mobs.LoadTextures(path);
 201
 202   im:=ld_tex('gui.png',path,'gui/');
 203   gui[0]:=rotate_image_from_image(im,0,0,16,16,0);
 204   LoadCurImg(gui[0], CUR_SELECT1);
 205   gui[1]:=rotate_image_from_image(im,0,16,168,21,0);
 206   gui[3]:=rotate_image_from_image(im,16,0,16,16,0);
 207   LoadCurImg(gui[3], CUR_SELECT2);
 208   gui[6]:=rotate_image_from_image(im,0,56,120,12,0);
 209   gui[7]:=rotate_image_from_image(im,0,68,120,12,0);
 210   gui[8]:=rotate_image_from_image(im,0,80,120,12,0);
 211   gui[13]:=rotate_image_from_image(im,1,93,9,9,0);//hp
 212   gui[14]:=rotate_image_from_image(im,12,93,9,9,0);//hp
 213   gui[15]:=rotate_image_from_image(im,23,93,9,9,0);//hp
 214   gui[17]:=rotate_image_from_image(im,120,56,18,18,0);
 215
 216   gui[26]:=rotate_image_from_image(im,89,93,9,9,0);//hunger
 217   gui[27]:=rotate_image_from_image(im,100,93,9,9,0);//hunger
 218   gui[28]:=rotate_image_from_image(im,111,93,9,9,0);//hunger
 219
 220   gui[29]:=rotate_image_from_image(im,67,93,9,9,0);//air
 221   gui[30]:=rotate_image_from_image(im,78,93,9,9,0);//air
 222
 223   gui[31]:=rotate_image_from_image(im,122,93,9,9,0);//hp hardcore
 224   gui[32]:=rotate_image_from_image(im,133,93,9,9,0);//hp hardcore
 225   gui[33]:=rotate_image_from_image(im,144,93,9,9,0);//hp hardcore
 226
 227   gui[20]:=rotate_image_from_image(im,121,75,9,13,0);
 228   gui[21]:=rotate_image_from_image(im,130,75,9,13,0);
 229   gui[22]:=rotate_image_from_image(im,0,103,120,12,0);
 230
 231   if load_minimap_tex then gui[16]:=ld_tex('mapbg.png',path,'gui/');
 232
 233   for ix:=0 to 9 do tue[ix]:=rotate_image_from_image(im,16*ix,40,16,16,0);
 234
 235   if load_weather_tex then
 236    begin
 237     im:=ld_tex('rain.png',path,'terrain/');
 238     for ix:=0 to 7 do osad[0,ix]:=rotate_image_from_image(im,16*ix,0,16,16,0);
 239     im:=ld_tex('snow.png',path,'terrain/');
 240     for ix:=0 to 7 do osad[1,ix]:=rotate_image_from_image(im,16*ix,0,16,16,0);
 241    end;
 242
 243   if load_light_tex then
 244    begin
 245     im:=ld_tex('light.png',path,'terrain/');
 246     for ix:=0 to 15 do light[ix]:=rotate_image_from_image(im,16*ix,0,16,16,0);
 247    end;
 248
 249   Particles.LoadTextures(path);
 250
 251   im:=ld_tex('partition.png',path,'gui/');
 252   gui[18]:=rotate_image_from_image(im,0,0,84,42,0);
 253   gui[19]:=rotate_image_from_image(im,0,42,4,4,0);
 254
 255   if load_sky_siz<=0 then
 256    sky:=ld_tex('sky.png',path,'terrain/');
 257   else
 258    sky:=resize_image(ld_tex('sky.png',path,'terrain/'),load_sky_siz,2);
 259
 260   if load_sm=1 then
 261    begin
 262     sun:=ld_tex('sun.png',path,'terrain/');
 263     moon:=ld_tex('moon_phase_0.png',path,'terrain/moon_phases/');
 264    end; else
 265   if load_sm=2 then
 266    begin
 267     sun:=resize_image(ld_tex('sun.png',path,'terrain/'),(getWidth+getHeight)/5,(getWidth+getHeight)/5);
 268     moon:=resize_image(ld_tex('moon_phase_0.png',path,'terrain/moon_phases/'),(getWidth+getHeight)/5,(getWidth+getHeight)/5);
 269     end;
 270
 271   //load_virt_tex(ld_tex('touch.png',path,'gui/'));
 272  end;
 273
 274 procedure cleargame;
 275  var
 276   ix,iy:integer;
 277  begin
 278   jmp:=false;
 279   keymode:=0;
 280   updx:=0;
 281   updy:=0;
 282   toolus:=0;
 283   toolind:=0;
 284   osadki_ani:=0;
 285   global_light:=15;
 286   pl_world:=0;
 287
 288   camx:=0;
 289   camy:=0;
 290   curx:=0;
 291   cury:=0;
 292
 293   player.setX(0);
 294   player.setY(0);
 295   last_sleep_x:=0;
 296   last_sleep_y:=0;
 297
 298   fly:=false;
 299   game_time:=0;
 300   clock_stage:=0;
 301   hp:=20;
 302   hunger:=20;
 303   air:=21;
 304   moon_phase:=0;
 305   posi:=0;
 306   velx:=0;
 307   vely:=0;
 308   invslot:=0;
 309
 310   osadki:=false;
 311
 312   //anim_del2:=0;
 313
 314   Inv.ResetData;
 315   Chest.ResetData;
 316   Furnace.ResetData;
 317   Drop.ResetData;
 318   Mobs.ResetData;
 319   Particles.ResetData;
 320
 321   for ix:=0 to 255 do
 322    begin
 323     setBackMap(0, ix);
 324     setBiomMap(0, ix);
 325     for iy:=0 to 127 do
 326      begin
 327       setmap(0,ix,iy);
 328       setmapinfo(0,ix,iy);
 329       setmaplight(0,ix,iy);
 330      end;
 331    end;
 332
 333   for ix:=0 to 31 do
 334    begin
 335     b_sign[ix]:=false;
 336     t_sign[ix]:='';
 337    end;
 338
 339   for ix:=0 to CONST_MAX_LAYERS do
 340    ClearLayer(ix);
 341  end;
 342
 343 procedure drw_load_line(s:string;percent:integer);
 344  var
 345   ix,iy:integer;
 346  begin
 347   for ix:=0 to getWidth/16 do
 348   for iy:=0 to getHeight/16 do
 349   drawimage(bg[0],ix*16,iy*16);
 350   drawfonttext(s,(getWidth/2)-(length(s)*8/2),(getHeight/2)-8);
 351   setcolor(128,128,128);
 352   fillrect(getwidth/2-50,getheight/2+6,100,3);
 353   setcolor(128,255,128);
 354   fillrect(getwidth/2-50,getheight/2+6,percent,3);
 355   drawfonttext(integertostring(percent)+'%',getwidth/2-(length(integertostring(percent)+'%')*8)/2,getheight/2+12);
 356   drawVideo;
 357  end;
 358
 359 function getFlatMap(i:integer):integer;
 360  var
 361   ix, iy:integer;
 362  begin
 363   iy:=i div 256;
 364   ix:=i-iy*256;
 365   getFlatMap:=getmap(ix,iy);
 366  end;
 367
 368 procedure setFlatMap(n, i:integer);
 369  var
 370   ix, iy:integer;
 371  begin
 372   iy:=i div 256;
 373   ix:=i-iy*256;
 374   setmap(n,ix,iy);
 375  end;
 376
 377 function getFlatMapInfo(i:integer):integer;
 378  var
 379   ix, iy:integer;
 380  begin
 381   iy:=i div 256;
 382   ix:=i-iy*256;
 383   getFlatMapInfo:=getmapinfo(ix,iy);
 384  end;
 385
 386 procedure setFlatMapInfo(n, i:integer);
 387  var
 388   ix, iy:integer;
 389  begin
 390   iy:=i div 256;
 391   ix:=i-iy*256;
 392   setmapinfo(n,ix,iy);
 393  end;
 394
 395 procedure SaveMapRLE;
 396  var
 397   i:integer;
 398   id, s:integer;
 399  begin
 400   repeat
 401    id:=getFlatMap(i);
 402    for s:=0 to 255 do
 403     if (id<>getFlatMap(i+s)) or (i+s>32767) then
 404      break;
 405
 406    write_byte(id);
 407    write_byte(s-1);
 408
 409    i:=i+s;
 410   until i>32767;
 411  end;
 412
 413 procedure SaveMapInfoRLE;
 414  var
 415   i:integer;
 416   id, s:integer;
 417  begin
 418   repeat
 419    id:=getFlatMapInfo(i);
 420    for s:=0 to 255 do
 421     if (id<>getFlatMapInfo(i+s)) or (i+s>32767) then
 422      break;
 423
 424    write_byte(id);
 425    write_byte(s-1);
 426
 427    i:=i+s;
 428   until i>32767;
 429  end;
 430
 431 procedure LoadMapRLE;
 432  var
 433   i:integer;
 434   id, s, j:integer;
 435  begin
 436   repeat
 437     id:=read_byte;
 438     s:=read_byte;
 439     for j:=0 to s do
 440      setFlatMap(id, i+j);
 441
 442     i:=i+s+1;
 443   until i>32767;
 444  end;
 445
 446 procedure LoadMapInfoRLE;
 447  var
 448   i:integer;
 449   id, s, j:integer;
 450  begin
 451   repeat
 452     id:=read_byte;
 453     s:=read_byte;
 454     for j:=0 to s do
 455      setFlatMapInfo(id, i+j);
 456
 457     i:=i+s+1;
 458   until i>32767;
 459  end;
 460
 461 procedure saveworld(path:string);
 462  var
 463   ix,iy:integer;
 464   world_name:string;
 465  begin
 466    if pl_world=0 then world_name:='world.sav';
 467     else
 468    if pl_world=1 then world_name:='nether.sav';
 469    if file_exists(path)<>1 then if create_folder(path)=1 then debug('Folder created!');
 470    if file_exists(path+world_name)>0 then delete_file(path+world_name);
 471    if file_exists(path+world_name)<>1 then file_create(path+world_name);
 472    if open_file(path+world_name)=1 then
 473     begin
 474      writeint(player.getX);
 475      writeint(player.getY);
 476      //Matrix
 477      SaveMapRLE;
 478      SaveMapInfoRLE;
 479      drw_load_line('Background',50);
 480      //Background and biomes
 481      for ix:=0 to 255 do
 482       begin
 483        write_byte(getBackMap(ix));
 484        write_byte(getBiomMap(ix));
 485       end;
 486
 487      drw_load_line('Chests', 55);
 488      Chest.SaveData;
 489      drw_load_line('Furnaces', 60);
 490      Furnace.SaveData;
 491      drw_load_line('Mobs', 70);
 492      Mobs.SaveData;
 493      drw_load_line('Drop', 80);
 494      Drop.SaveData;
 495      drw_load_line('Particles', 85);
 496      Particles.SaveData;
 497
 498      drw_load_line('Other', 90);
 499      write_byte(updx);
 500      write_byte(updy);
 501      writebool(osadki);
 502      write_byte(osadki_ani);
 503      write_byte(global_light);
 504      writebool(fly);
 505      writeint(game_time);
 506      write_byte(clock_stage);
 507      for ix:=0 to 31 do
 508       begin
 509        writebool(b_sign[ix]);
 510        writestr(t_sign[ix]);
 511       end;
 512      flush;
 513      drw_load_line('Ready',100);
 514      if close_file(path+world_name)=1 then debug('World Saved!');
 515     end;
 516  end;
 517
 518 procedure savegame(path:string);
 519  var
 520   ix,iy:integer;
 521  begin
 522    drw_load_line('Basic',0);
 523    if file_exists(path+'player.dat')=1 then delete_file(path+'player.dat');
 524    if file_exists(path)<>1 then if create_folder(path)=1 then debug('Folder created!');
 525    if file_exists(path+'player.dat')<>1 then file_create(path+'player.dat');
 526    if open_file(path+'player.dat')=1 then
 527     begin
 528      //Head
 529      write_byte(version_map);
 530      write_byte(gamemode);
 531      writebool(cheats);
 532      writeint(seed);
 533      write_byte(pl_world);
 534      //Player
 535       writeint(last_sleep_x);
 536       writeint(last_sleep_y);
 537       write_byte(velx);
 538       write_byte(vely);
 539       write_byte(invslot);
 540       write_byte(posi);
 541       write_byte(hp);
 542       write_byte(hunger);
 543       write_byte(moon_phase);
 544       writebool(jmp);
 545       inv.saveData;
 546        if close_file(path+'player.dat')=1 then debug('Saved!');
 547        drw_load_line('Matrix',10);
 548        saveworld(path);
 549     end;
 550 end;
 551
 552
 553 function version_err(ver:integer):boolean;
 554  var
 555   ix,iy:integer;
 556  begin
 557   for ix:=0 to getWidth/16 do
 558   for iy:=0 to getHeight/16 do
 559    begin
 560     drawimage(bg[0],ix*16,iy*16);
 561    end;
 562   if version_map=ver then version_err:=true; else
 563   if version_map>ver then
 564    begin
 565     drawfonttext('Old save format!',(getWidth/2)-60,(getHeight/2)-4);
 566     drawVideo;
 567     delay(3000);
 568     version_err:=false;
 569    end; else
 570   if version_map<ver then
 571    begin
 572     drawfonttext('New save format!',(getWidth/2)-60,(getHeight/2)-4);
 573     drawVideo;
 574     delay(3000);
 575     version_err:=false;
 576    end;
 577  end;
 578
 579
 580 function loadworld(path:string):boolean;
 581  var
 582   ix,iy,ver:integer;
 583   world_name:string;
 584  begin
 585    if pl_world=0 then world_name:='world.sav';
 586     else
 587    if pl_world=1 then world_name:='nether.sav';
 588    if file_exists(path)=1 then
 589     begin
 590      if file_exists(path+world_name)=1 then
 591       begin
 592        if open_file(path+world_name)=1 then
 593     begin
 594     player.setX(readint);
 595     player.setY(readint);
 596      //Matrix
 597      LoadMapRLE;
 598      LoadMapInfoRLE;
 599      drw_load_line('Background',50);
 600      //Background and biomes
 601      for ix:=0 to 255 do
 602       begin
 603        setBackMap(read_byte, ix);
 604        setBiomMap(read_byte, ix);
 605       end;
 606      drw_load_line('Chests', 55);
 607      Chest.LoadData;
 608      drw_load_line('Furnaces', 60);
 609      Furnace.LoadData;
 610      Mobs.LoadData;
 611      drw_load_line('Drop', 80);
 612      Drop.LoadData;
 613      drw_load_line('Particles', 85);
 614      Particles.LoadData;
 615
 616      drw_load_line('Other',90);
 617      updx:=read_byte;
 618      updy:=read_byte;
 619      osadki:=readbool;
 620      osadki_ani:=read_byte;
 621      global_light:=read_byte;
 622      fly:=readbool;
 623      game_time:=readint;
 624      clock_stage:=read_byte;
 625      for ix:=0 to 31 do
 626       begin
 627        b_sign[ix]:=readbool;
 628        t_sign[ix]:=readstr;
 629       end;
 630      drw_load_line('Ready',100);
 631      ///////////////////////
 632      if close_file(path+world_name)=1 then begin loadworld:=true; debug('World loaded!'); end;
 633        end; else begin loadworld:=false; debug('File not opened!'); end;
 634       end; else begin loadworld:=false; debug('File not exists!'); end;
 635     end; else begin loadworld:=false; debug('Folder not exists!'); end;
 636  end;
 637
 638 function loadgame(path:string):boolean;
 639 var
 640   ix,iy,ver:integer;
 641  begin
 642    drw_load_line('Basic',0);
 643    if file_exists(path)=1 then
 644     begin
 645      if file_exists(path+'player.dat')=1 then
 646       begin
 647        if open_file(path+'player.dat')=1 then
 648     begin
 649      //Head
 650      ver:=read_byte;
 651      if version_err(ver)=false then
 652       begin
 653        if close_file(path+'player.dat')=1 then loadgame:=false;
 654        exit;
 655       end;
 656      gamemode:=read_byte;
 657      cheats:=readbool;
 658      seed:=readint;
 659      pl_world:=read_byte;
 660      //Player;
 661       last_sleep_x:=readint;
 662       last_sleep_y:=readint;
 663       velx:=read_byte;
 664       vely:=read_byte;
 665       invslot:=read_byte;
 666       posi:=read_byte;
 667       hp:=read_byte;
 668       hunger:=read_byte;
 669       moon_phase:=read_byte;
 670       jmp:=readbool;
 671       inv.loadData;
 672        drw_load_line('Matrix',10);
 673        if  close_file(path+'player.dat')=1 then loadgame:=loadworld(path);
 674        end; else loadgame:=false;
 675       end; else loadgame:=false;
 676     end; else loadgame:=false;
 677 end;
 678
 679 procedure drawdeadlogo;
 680  var
 681   dead:image;
 682  begin
 683   setcolor(0,0,0);
 684   fillrect(0,0,getWidth,getHeight);
 685   dead:=loadimage('/dl');
 686   drawimage(dead,(getWidth/2)-(getimagewidth(dead)/2),(getHeight/2)-(getimageheight(dead)/2));
 687   drawfonttext(#119+#119+#119+#46+#100+#101+#97+#100+#115+#111+#102+#116+#119+#97+#114+#101+#46+#114+#117,getWidth/2-80,(getHeight/2)+(getimageheight(dead)/2));
 688   drawfonttext('Loading...',(getWidth/2)-(40),getHeight-8);
 689   drawVideo;
 690   delay(500);
 691  end;
 692
 693 procedure newgame;
 694  var
 695   ix,iy:integer;
 696  begin
 697   for ix:=0 to getWidth/16 do
 698    for iy:=0 to getHeight/16 do
 699     begin
 700      drawimage(bg[0],ix*16,iy*16);
 701     end;
 702   drawfonttext('Generation World...',(getWidth/2)-(76),(getHeight/2)-4);
 703   drawVideo;
 704   delay(1);
 705   cleargame;
 706   game_time:=45000;
 707   newworld;
 708   //if s_spawn_mob then begin if pl_world=0 then begin megaspawn; end; else begin netherspawn; end; end;
 709   if gamemode=1 then fly:=true else fly:=false;
 710   debug('New game!');
 711  end;
 712
 713 function gettext(text,text_f:string; max,typ:integer;):string;
 714  var
 715   textField_id:integer;
 716   exitCmd,cli:command;
 717  begin
 718   clearForm;
 719   exitCmd:=createCommand('Ok',CM_OK,1);
 720   showForm;
 721   addCommand(exitCmd);
 722   textField_id:=formAddTextField(text,text_f,max,typ);
 723   drawVideo;
 724   delay(100);
 725   repeat
 726    cli:=getClickedCommand;
 727   until cli=exitCmd;
 728   gettext:=formGetText(textField_id);
 729   showCanvas;
 730  end;
 731
 732 procedure drw_btn(text:string; cur,ccur,h,ty:integer);
 733  var
 734   m_x,m_y,i:integer;
 735  begin
 736   m_x:=(getWidth/2)-(120/2);
 737   m_y:=h+((getHeight/2))-((getimageheight(gui[7])-2*cur)/2)+((getimageheight(gui[7])+2)*cur);
 738   if ty=0 then
 739    begin
 740     if ccur=cur then drawimage(gui[22],m_x+i*4,m_y); else drawimage(gui[6],m_x+i*8,m_y);
 741    end; else
 742   if ty=1 then
 743    begin
 744     if ccur=cur then drawimage(gui[8],m_x+i*8,m_y); else drawimage(gui[7],m_x+i*8,m_y);
 745    end;
 746   setclip(0,0,getwidth,getheight);
 747   m_x:=(getWidth/2)-(length(text)*8/2);
 748   m_y:=h+((getHeight/2))-((getimageheight(gui[7])-2*cur)/2)+((getimageheight(gui[7])+2)*cur)+((getimageheight(gui[7])-8)/2);
 749   drawfonttext(text,m_x,m_y);
 750  end;
 751
 752 procedure drw_txt(str:string; xx,n,t:integer);
 753  var
 754   m_x,m_y:integer;
 755  begin
 756   m_x:=(getWidth/2)-(length(str)*8/2);
 757   m_y:=xx+32+(8*n);
 758   if t=0 then drawfonttext(str,0,m_y); else
 759   if t=1 then drawfonttext(str,m_x,m_y);
 760  end;
 761
 762 function pos_end(s:string; c:char):integer;
 763  var
 764   i:integer;
 765  begin
 766   for i:=length(s)-1 downto 0 do
 767    begin
 768     if getchar(s,i)=c then
 769      begin
 770       pos_end:=i;
 771       exit;
 772      end;
 773    end;
 774   pos_end:=-1;
 775  end;
 776
 777 function getroot(cancel_b:boolean):string;
 778  var
 779   m_cur,max_r,pars,ix,iy:integer;
 780   rr:string;
 781   im:image;
 782   roots:array [0..15] of string;
 783  begin
 784   im:=rotate_image_from_image(ld_tex('background.png','/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/','title/'),16,0,16,16,0);
 785   rr:=get_roots;
 786   if cancel_b then roots[0]:='<CANCEL>';
 787   if cancel_b then max_r:=1; else max_r:=0;
 788   while pos(rr,'|')<>-1 do
 789    begin
 790     pars:=pos(rr,'|');
 791     roots[max_r]:=copy(rr,0,pars-1);
 792     rr:=copy(rr,pars+1,length(rr));
 793     max_r:=max_r+1;
 794    end;
 795    max_r:=max_r-1;
 796   repeat
 797    updateKeys;
 798    if clickedKey(KEY_FM_UP) then begin m_cur:=m_cur-1; if m_cur<0 then m_cur:=max_r; end;
 799    if clickedKey(KEY_FM_DOWN) then begin m_cur:=m_cur+1; if m_cur>max_r then m_cur:=0; end;
 800    if clickedKey(KEY_FM_SELECT) then
 801     begin
 802      if (m_cur=0) and (cancel_b) then
 803       begin
 804        getroot:='';
 805        exit;
 806       end;
 807      else
 808       begin
 809        getroot:=roots[m_cur];
 810        exit;
 811       end;
 812     end;
 813
 814    for ix:=0 to getWidth/16 do
 815    for iy:=0 to getHeight/16 do
 816     drawimage(im,ix*16,iy*16);
 817
 818    setcolor(0,0,0);
 819    fillrect(0,m_cur*8,getWidth-1,8);
 820    for ix:=0 to max_r do
 821     begin
 822      drawfonttext(roots[ix],0,ix*8);
 823     end;
 824    setcolor(255,255,255);
 825    drawrect(0,m_cur*8,getWidth-1,8);
 826
 827    drawVideo;
 828    delay(1);
 829   until false;
 830  end;
 831
 832 function filemanager(cancel_b:boolean):string;
 833  var
 834   m_cur,ix,iy,max_r,pars:integer;
 835   im:image;
 836   last,rr,root,path:string;
 837   names:array [0..255] of string;
 838  begin
 839   im:=rotate_image_from_image(ld_tex('background.png','/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/','title/'),16,0,16,16,0);
 840   names[0]:='<..>';
 841   names[1]:='<OK>';
 842   root:=getroot(cancel_b);
 843   if root='' then
 844    begin
 845     filemanager:='';
 846     exit;
 847    end;
 848   path:=root;
 849   if cancel_b then names[2]:='<CANCEL>';
 850   rr:=get_dirs(path);
 851   if cancel_b then max_r:=3; else max_r:=2;
 852   while pos(rr,'|')<>-1 do
 853    begin
 854     pars:=pos(rr,'|');
 855     names[max_r]:=copy(rr,0,pars-1);
 856     rr:=copy(rr,pars+1,length(rr));
 857     max_r:=max_r+1;
 858    end;
 859    max_r:=max_r-1;
 860
 861   repeat
 862    updateKeys;
 863    if clickedKey(KEY_FM_UP) then begin m_cur:=m_cur-1; if m_cur<0 then m_cur:=max_r; end;
 864    if clickedKey(KEY_FM_DOWN) then begin m_cur:=m_cur+1; if m_cur>max_r then m_cur:=0; end;
 865    if clickedKey(KEY_FM_SELECT) then
 866     begin
 867      if m_cur=0 then
 868       begin
 869        debug('path:'+path);
 870        debug('lol:'+pos_end(path,'/'));
 871        if (path=root) or (path=root+'/') then
 872         begin
 873          root:=getroot(cancel_b);
 874          if root='' then
 875           begin
 876            filemanager:='';
 877            exit;
 878           end;
 879          path:=root;
 880         end;
 881        else
 882         begin
 883          path:=copy(path,0,pos_end(path,'/'));
 884          if cancel_b then names[2]:='<CANCEL>';
 885          rr:=get_dirs(path);
 886          if cancel_b then max_r:=3; else max_r:=2;
 887           while pos(rr,'|')<>-1 do
 888            begin
 889             pars:=pos(rr,'|');
 890             names[max_r]:=copy(rr,0,pars-1);
 891             rr:=copy(rr,pars+1,length(rr));
 892             max_r:=max_r+1;
 893            end;
 894           max_r:=max_r-1;
 895         end;
 896       end; else
 897      if m_cur=1 then
 898       begin
 899        debug('<OK>');
 900        filemanager:=path;
 901        exit;
 902       end; else
 903      if (m_cur=2) and (cancel_b) then
 904       begin
 905        debug('<CANCEL>');
 906        filemanager:='';
 907        exit;
 908       end; else
 909      begin
 910       path:=path+'/'+names[m_cur];
 911
 912       if cancel_b then names[2]:='<CANCEL>';
 913       rr:=get_dirs(path);
 914       if cancel_b then max_r:=3; else max_r:=2;
 915       while pos(rr,'|')<>-1 do
 916        begin
 917         pars:=pos(rr,'|');
 918         names[max_r]:=copy(rr,0,pars-1);
 919         rr:=copy(rr,pars+1,length(rr));
 920         max_r:=max_r+1;
 921        end;
 922       max_r:=max_r-1;
 923       m_cur:=0;
 924       debug('path:'+path);
 925      end;
 926     end;
 927
 928    for ix:=0 to getWidth/16 do
 929    for iy:=0 to getHeight/16 do
 930     drawimage(im,ix*16,iy*16);
 931
 932    setcolor(0,0,0);
 933    fillrect(0,m_cur*8,getWidth-1,8);
 934    for ix:=0 to max_r do
 935     begin
 936      drawfonttext(names[ix],0,ix*8);
 937     end;
 938    setcolor(255,255,255);
 939    drawrect(0,m_cur*8,getWidth-1,8);
 940
 941   drawVideo;
 942   delay(1);
 943
 944   until false;
 945  end;
 946
 947 procedure setsd(cancel_b:boolean);
 948  var
 949   s:string;
 950   t:integer;
 951   rs:recordstore;
 952  begin
 953   s:=filemanager(cancel_b);
 954   if s<>'' then
 955    begin
 956     sd:=s;
 957     if file_exists('/'+sd+'/cavecraft')<>1 then
 958      if create_folder('/'+sd+'/cavecraft')=1 then debug('/cavecraft created!');
 959
 960     if file_exists('/'+sd+'/cavecraft/saves')<>1 then
 961      if create_folder('/'+sd+'/cavecraft/saves')=1 then debug('/saves created!');
 962
 963     if file_exists('/'+sd+'/cavecraft/screenshots')<>1 then
 964      if create_folder('/'+sd+'/cavecraft/screenshots')=1 then debug('/screenshots created!');
 965
 966     if file_exists('/'+sd+'/cavecraft/texturepacks')<>1 then
 967      if create_folder('/'+sd+'/cavecraft/texturepacks')=1 then debug('/texturepacks created!');
 968
 969     deleteRecordStore('SD');
 970     rs:=openRecordStore('SD');
 971     t:=addRecordStoreEntry(rs,sd);
 972     closeRecordStore(rs);
 973    end;
 974  end;
 975
 976 procedure start_uu;
 977  var
 978   rs:recordstore;
 979   ss:string;
 980  begin
 981   drawdeadlogo;
 982   //Load SD
 983   rs:=openRecordStore('SD');
 984   sd:=readRecordStoreEntry(rs,1);
 985   closeRecordStore(rs);
 986   console.exec('autoexec.cfg', 'AUTO');
 987   if sd='' then
 988    begin
 989     init_touch;
 990     if touchscreen then
 991      load_key_tex:=1;
 992     else
 993      load_key_tex:=0;
 994     //load_virt_tex(loadimage('/gui/touch.png'));
 995     setsd(false);
 996    end;
 997
 998   if file_exists('/'+sd+'/cavecraft')<>1 then
 999    if create_folder('/'+sd+'/cavecraft')=1 then debug('/cavecraft created!');
1000
1001   if file_exists('/'+sd+'/cavecraft/saves')<>1 then
1002    if create_folder('/'+sd+'/cavecraft/saves')=1 then debug('/saves created!');
1003
1004   if file_exists('/'+sd+'/cavecraft/screenshots')<>1 then
1005    if create_folder('/'+sd+'/cavecraft/screenshots')=1 then debug('/screenshots created!');
1006
1007   if file_exists('/'+sd+'/cavecraft/texturepacks')<>1 then
1008    if create_folder('/'+sd+'/cavecraft/texturepacks')=1 then debug('/texturepacks created!');
1009
1010   rs:=openRecordStore('TX');
1011   ss:=readRecordStoreEntry(rs,1);
1012   closeRecordStore(rs);
1013
1014   if ss<>'' then
1015    begin
1016     tex_pack:=ss;
1017     LoadDrawFont('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/');
1018     loadtexture('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/');
1019    end;
1020   else
1021    begin
1022     LoadDrawFont('/');
1023     loadtexture('/');
1024    end;
1025  end;
1026
1027 function question(text:string):boolean;
1028  var
1029   ix,iy,m_cur:integer;
1030  begin
1031   repeat
1032    updateKeys;
1033    if clickedKey(KEY_MENU_UP) then begin m_cur:=m_cur-1; if m_cur<0 then m_cur:=1; end;
1034    if clickedKey(KEY_MENU_DOWN) then begin m_cur:=m_cur+1; if m_cur>1 then m_cur:=0; end;
1035    if clickedKey(KEY_MENU_SELECT) then begin if m_cur=0 then question:=true; else question:=false; exit; end;
1036    for ix:=0 to getwidth/16 do for iy:=0 to getheight/16 do drawimage(bg[0],ix*16,iy*16);
1037    drawfonttext(text,getwidth/2-(length(text)*8)/2,getheight/2-16);
1038    drw_btn('Yes',0,m_cur,0,1);
1039    drw_btn('No',1,m_cur,0,1);
1040    drawVideo;
1041    delay(1);
1042   until false;
1043  end;
1044
1045 function menu_game_new:boolean;
1046  var
1047   m_cur,tmp_gm,ix,iy,lol:integer;
1048   tmp_cheats,tmp_bon_chest:boolean;
1049   newgametxt:array[0..4] of string;
1050   name,tmp:string;
1051  begin
1052   m_cur:=-2;
1053   newgametxt[0]:='Survival';
1054   newgametxt[1]:='Creative';
1055   newgametxt[2]:='Hardcore';
1056   newgametxt[3]:='Normal';
1057   newgametxt[4]:='Flat';
1058   name:='New World';
1059   repeat
1060    updateKeys;
1061    if clickedKey(KEY_MENU_UP) then begin m_cur:=m_cur-1; if m_cur<-2 then m_cur:=5; end;
1062    if clickedKey(KEY_MENU_DOWN) then begin m_cur:=m_cur+1; if m_cur>5 then m_cur:=-2; end;
1063    if clickedKey(KEY_MENU_SELECT) then
1064     begin
1065      if m_cur=-2 then
1066       begin
1067        name:=gettext('Name:',name,10,TF_ANY);
1068       end; else
1069      if m_cur=-1 then
1070       begin
1071        tmp_gm:=tmp_gm+1; if tmp_gm>2 then tmp_gm:=0;
1072        if tmp_gm=0 then tmp_cheats:=false;
1073        if tmp_gm=1 then tmp_cheats:=true;
1074        if tmp_gm=2 then begin tmp_cheats:=false; tmp_bon_chest:=false; end;
1075       end; else
1076      if m_cur=0 then
1077       begin
1078        nextseed:=stringtointeger(gettext('Seed:',''+nextseed,10,TF_NUMERIC));
1079       end; else
1080      if m_cur=1 then
1081       begin
1082        world_typ:=world_typ+1;
1083        if world_typ>1 then world_typ:=0;
1084       end; else
1085      if m_cur=2 then
1086       begin
1087        if tmp_gm<2 then tmp_cheats:= not tmp_cheats;
1088       end; else
1089      if m_cur=3 then
1090       begin
1091        if tmp_gm<2 then tmp_bon_chest:= not tmp_bon_chest;
1092       end; else
1093      if m_cur=4 then
1094       begin
1095        gamemode:=tmp_gm;
1096        cheats:=tmp_cheats;
1097        bon_chest:=tmp_bon_chest;
1098        tmp:=name;
1099        while file_exists('/'+sd+'/cavecraft/saves/'+name)=1 do
1100         begin
1101          lol:=lol+1;
1102          name:=tmp+' '+lol;
1103         end;
1104        sav_fl:=name;
1105        newgame;
1106        menu_game_new:=true;
1107        break;
1108       end; else
1109      if m_cur=5 then
1110       begin
1111        break;
1112       end; else
1113     end;
1114    for ix:=0 to getWidth/16 do
1115    for iy:=0 to getHeight/16 do
1116     drawimage(bg[0],ix*16,iy*16);
1117
1118    drw_btn('Name:'+name,-2,m_cur,0,1);
1119    drw_btn('Mode:'+newgametxt[tmp_gm],-1,m_cur,0,1);
1120    drw_btn('Seed:'+nextseed,0,m_cur,0,1);
1121    drw_btn('Type:'+newgametxt[world_typ+3],1,m_cur,0,1);
1122    if tmp_gm<2 then
1123     drw_btn('Cheats:'+tmp_cheats,2,m_cur,0,1);
1124    else
1125     drw_btn('Cheats:'+tmp_cheats,2,m_cur,0,0);
1126    if tmp_gm<2 then
1127     drw_btn('Chest:'+tmp_bon_chest,3,m_cur,0,1);
1128    else
1129     drw_btn('Chest:'+tmp_bon_chest,3,m_cur,0,0);
1130    drw_btn('Create',4,m_cur,0,1);
1131    drw_btn('Cancel',5,m_cur,0,1);
1132
1133    drawVideo;
1134    delay(1);
1135   until false;
1136  end;
1137
1138 procedure deleteworld(path:string);
1139  begin
1140     if file_exists(path+'player.dat')=1 then delete_file(path+'player.dat');
1141     if file_exists(path+'world.sav')=1 then delete_file(path+'world.sav');
1142     if file_exists(path+'nether.sav')=1 then delete_file(path+'nether.sav');
1143     if file_exists(path+'pic.png')=1 then delete_file(path+'pic.png');
1144     if file_exists(path)=1 then delete_file(path);
1145     if file_exists(path)=0 then debug('World deleted!');
1146  end;
1147
1148 function menu_game:boolean;
1149  var
1150   ix,iy,pars,max_r,cur_name,m_cur:integer;
1151   mm_t_b:boolean;
1152   im_game:image;
1153   rr:string;
1154   names:array[0..255] of string;
1155  begin
1156   rr:=get_dirs('/'+sd+'/cavecraft/saves/');
1157   while pos(rr,'|')<>-1 do
1158    begin
1159     pars:=pos(rr,'|');
1160     names[max_r]:=copy(rr,0,pars-1);
1161     rr:=copy(rr,pars+1,length(rr));
1162     if file_exists('/'+sd+'/cavecraft/saves/'+names[max_r]+'/player.dat')=1 then max_r:=max_r+1;
1163    end;
1164    max_r:=max_r-1;
1165    if file_exists('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/pic.png')=1 then
1166       im_game:=safely_load_image_fs('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/pic.png');
1167       else im_game:=ld_tex('maps.png','/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/','');
1168
1169    if file_exists('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/player.dat')=1 then
1170       mm_t_b:=true; else mm_t_b:=false;
1171
1172   repeat
1173    updateKeys;
1174    if clickedKey(KEY_MENU_UP) then
1175     begin
1176      m_cur:=m_cur-1;
1177      if m_cur<0 then m_cur:=3;
1178     end;
1179    if clickedKey(KEY_MENU_DOWN) then
1180     begin
1181      m_cur:=m_cur+1;
1182      if m_cur>3 then m_cur:=0;
1183     end;
1184
1185    if (max_r >= 0) and clickedKey(KEY_MENU_LEFT) then
1186     begin
1187      cur_name:=cur_name-1;
1188      if cur_name<0 then cur_name:=0;
1189      if file_exists('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/pic.png')=1 then
1190       im_game:=safely_load_image_fs('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/pic.png');
1191      else im_game:=ld_tex('maps.png','/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/','');
1192
1193      if file_exists('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/player.dat')=1 then
1194     end;
1195    if (max_r >= 0) and clickedKey(KEY_MENU_RIGHT) then
1196     begin
1197      cur_name:=cur_name+1;
1198      if cur_name>max_r then cur_name:=max_r;
1199      if file_exists('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/pic.png')=1 then
1200       im_game:=safely_load_image_fs('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/pic.png');
1201       else im_game:=ld_tex('maps.png','/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/','');
1202
1203      if file_exists('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/player.dat')=1 then
1204     end;
1205    if clickedKey(KEY_MENU_SELECT) then
1206     begin
1207      if m_cur=0 then
1208       begin
1209        if max_r>-1 then
1210        if loadgame('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/') then
1211         begin
1212          sav_fl:=names[cur_name];
1213          menu_game:=true;
1214          break;
1215         end;
1216       end; else
1217      if m_cur=1 then
1218       begin
1219        if menu_game_new then begin menu_game:=true; break; end;
1220       end; else
1221      if m_cur=2 then
1222       begin
1223        debug('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/');
1224        if max_r>-1 then
1225        if question('Are you sure?')=true then deleteworld('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/');
1226        cur_name:=0;
1227        max_r:=0;
1228        rr:=get_dirs('/'+sd+'/cavecraft/saves/');
1229        while pos(rr,'|')<>-1 do
1230         begin
1231          pars:=pos(rr,'|');
1232          names[max_r]:=copy(rr,0,pars-1);
1233          rr:=copy(rr,pars+1,length(rr));
1234          max_r:=max_r+1;
1235         end;
1236        max_r:=max_r-1;
1237        if file_exists('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/pic.png')=1 then
1238       im_game:=safely_load_image_fs('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/pic.png');
1239       else im_game:=ld_tex('maps.png','/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/','');
1240       end; else
1241      if m_cur=3 then
1242       begin
1243        break;
1244       end;
1245     end;
1246
1247    for ix:=0 to getWidth/16 do
1248    for iy:=1 to 7 do
1249     drawimage(bg[1],ix*16,iy*16);
1250    for ix:=0 to getWidth/16 do
1251     drawimage(bg[0],ix*16,0);
1252    for ix:=0 to getWidth/16 do
1253    for iy:=8 to getHeight/16 do
1254     drawimage(bg[0],ix*16,iy*16);
1255
1256    if max_r>-1 then
1257     begin
1258      setcolor(0,0,0);
1259      fillrect(32,24,getWidth-64,96);
1260      setclip(32,24,getWidth-64,96);
1261      drawimage(im_game,(getWidth/2)-(32),32);
1262      drawfonttext(names[cur_name],(getWidth/2)-(length(names[cur_name])*8/2),104);
1263      setclip(0,0,getWidth,getHeight);
1264      setcolor(128,128,128);
1265      drawrect(32,24,getWidth-64,96);
1266      if cur_name>0 then drawimage(gui[20],0,58);
1267      if cur_name<max_r then drawimage(gui[21],getWidth-9,58);
1268     end;
1269    else
1270     begin
1271      setcolor(0,0,0);
1272      fillrect(32,24,getWidth-64,96);
1273      setclip(32,24,getWidth-64,96);
1274      drawfonttext('No saves!',(getWidth/2)-(length('No saves!')*8/2),104);
1275      setclip(0,0,getWidth,getHeight);
1276      setcolor(128,128,128);
1277      drawrect(32,24,getWidth-64,96);
1278     end;
1279
1280    if mm_t_b then drw_btn('Play',0,m_cur,32,1); else drw_btn('Play',0,m_cur,32,0);
1281    drw_btn('Create new',1,m_cur,32,1);
1282    if mm_t_b then drw_btn('Delete',2,m_cur,32,1); else drw_btn('Delete',2,m_cur,32,0);
1283    drw_btn('Back',3,m_cur,32,1);
1284    if not mm_t_b then cur_name:=cur_name+1;
1285
1286    drawVideo;
1287    delay(1);
1288   until false;
1289  end;
1290
1291 procedure menu_tex;
1292  var
1293   ix,iy,pars,max_r,cur_name,m_cur,t:integer;
1294   im_game:image;
1295   rr:string;
1296   names:array[0..255] of string;
1297   rs:recordstore;
1298  begin
1299   rr:=get_dirs('/'+sd+'/cavecraft/texturepacks/');
1300   names[0]:='Default';
1301   max_r:=1;
1302   while pos(rr,'|')<>-1 do
1303    begin
1304     pars:=pos(rr,'|');
1305     names[max_r]:=copy(rr,0,pars-1);
1306     rr:=copy(rr,pars+1,length(rr));
1307     max_r:=max_r+1;
1308    end;
1309    max_r:=max_r-1;
1310    im_game:=loadimage('/pack.png');
1311
1312   repeat
1313    updateKeys;
1314    if clickedKey(KEY_MENU_UP) then
1315     begin
1316      m_cur:=m_cur-1;
1317      if m_cur<0 then m_cur:=1;
1318     end;
1319    if clickedKey(KEY_MENU_DOWN) then
1320     begin
1321      m_cur:=m_cur+1;
1322      if m_cur>1 then m_cur:=0;
1323     end;
1324
1325    if clickedKey(KEY_MENU_LEFT) then
1326     begin
1327      cur_name:=cur_name-1;
1328      if cur_name<0 then cur_name:=0;
1329      im_game:=ld_tex('pack.png','/'+sd+'/cavecraft/texturepacks/'+names[cur_name]+'/','');
1330     end;
1331    if clickedKey(KEY_MENU_RIGHT) then
1332     begin
1333      cur_name:=cur_name+1;
1334      if cur_name>max_r then cur_name:=max_r;
1335      im_game:=ld_tex('pack.png','/'+sd+'/cavecraft/texturepacks/'+names[cur_name]+'/','');
1336     end;
1337    if clickedKey(KEY_MENU_SELECT) then
1338     begin
1339     if m_cur=0 then begin
1340      if cur_name>0 then
1341       begin
1342        debug("Select TexturePack @ /" + sd + "/cavecraft/texturepacks/" + names[cur_name]);
1343        tex_pack:=names[cur_name];
1344        LoadDrawFont('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/');
1345        loadtexture('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/');
1346        deleteRecordStore('TX');
1347        rs:=openRecordStore('TX');
1348        t:=addRecordStoreEntry(rs,tex_pack);
1349        closeRecordStore(rs);
1350
1351        LoadDrawFont('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/');
1352        loadtexture('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/');
1353       end;
1354      else
1355       begin
1356        debug("Cancel Select TecturePack");
1357        tex_pack:='';
1358        loadtexture('/');
1359        deleteRecordStore('TX');
1360        rs:=openRecordStore('TX');
1361        t:=addRecordStoreEntry(rs,'');
1362        closeRecordStore(rs);
1363       end;
1364     end;
1365     if m_cur=1 then break;
1366      break;
1367     end;
1368
1369    for ix:=0 to getWidth/16 do
1370    for iy:=1 to 7 do
1371     drawimage(bg[1],ix*16,iy*16);
1372    for ix:=0 to getWidth/16 do
1373     drawimage(bg[0],ix*16,0);
1374    for ix:=0 to getWidth/16 do
1375    for iy:=8 to getHeight/16 do
1376     drawimage(bg[0],ix*16,iy*16);
1377
1378    if max_r>-1 then
1379     begin
1380      setcolor(0,0,0);
1381      fillrect(32,24,getWidth-64,96);
1382      setclip(32,24,getWidth-64,96);
1383      drawimage(im_game,(getWidth/2)-(32),32);
1384      drawfonttext(names[cur_name],(getWidth/2)-(length(names[cur_name])*8/2),104);
1385      setclip(0,0,getWidth,getHeight);
1386      setcolor(128,128,128);
1387      drawrect(32,24,getWidth-64,96);
1388      if cur_name>0 then drawimage(gui[20],0,58);
1389      if cur_name<max_r then drawimage(gui[21],getWidth-9,58);
1390     end;
1391
1392    drw_btn('Done',0,m_cur,32,1);
1393    drw_btn('Back',1,m_cur,32,1);
1394
1395    drawVideo;
1396    delay(1);
1397   until false;
1398  end;
1399
1400 procedure menu_sett;
1401 var
1402   ix,iy,m_cur:integer;
1403  begin
1404   m_cur:=-3;
1405   repeat
1406    updateKeys;
1407    if clickedKey(KEY_MENU_UP) then
1408     begin
1409      m_cur:=m_cur-1;
1410      if m_cur<-3 then m_cur:=5;
1411     end;
1412    if clickedKey(KEY_MENU_DOWN) then
1413     begin
1414      m_cur:=m_cur+1;
1415      if m_cur>5 then m_cur:=-3;
1416     end;
1417    if clickedKey(KEY_MENU_SELECT) then
1418     begin
1419      if m_cur=-3 then
1420       begin
1421        light_type:=light_type+1;
1422        if light_type>2 then light_type:=0;
1423       end; else
1424      if m_cur=-2 then
1425       begin
1426        ifosad:=not ifosad;
1427       end; else
1428      if m_cur=-1 then
1429       begin
1430        Particles.enabled := not Particles.enabled;
1431       end; else
1432      if m_cur=0 then
1433       begin
1434        drawgui:=not drawgui;
1435       end; else
1436      if m_cur=1 then
1437       begin
1438        if question('Are you sure?')=true then
1439         begin
1440          if load_key_tex=0 then
1441           begin
1442            load_key_tex:=1;
1443            init_touch;
1444            //load_virt_tex(ld_tex('touch.png','/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/','gui/'));
1445           end;
1446          else
1447          if load_key_tex=1 then
1448           begin
1449            load_key_tex:=0;
1450            resetVirtualKeyboard(-1);
1451           end;
1452         end;
1453       end;
1454      if m_cur=2 then
1455       begin
1456        s_jpeg_quality:=stringtointeger(gettext('JPEG quality:',''+s_jpeg_quality,3,TF_NUMERIC));
1457        if s_jpeg_quality>100 then s_jpeg_quality:=100; else
1458        if s_jpeg_quality<0 then s_jpeg_quality:=0;
1459       end; else
1460      if m_cur=3 then
1461       begin
1462        setsd(true);
1463       end; else
1464      if m_cur=4 then
1465       begin
1466        deleteRecordStore('S');
1467        deleteRecordStore('SD');
1468        deleteRecordStore('TX');
1469        halt;
1470       end; else
1471      if m_cur=5 then
1472       begin
1473        save_settings;
1474        break;
1475       end; else
1476     end;
1477
1478    for ix:=0 to getWidth/16 do
1479    for iy:=0 to getHeight/16 do
1480     drawimage(bg[0],ix*16,iy*16);
1481
1482    drw_btn('Light:'+light_type,-3,m_cur,0,1);
1483    drw_btn('Weather:'+ifosad,-2,m_cur,0,1);
1484    drw_btn('Particles:' + Particles.enabled, -1, m_cur, 0, 1);
1485    drw_btn('Hide GUI:'+not drawgui,0,m_cur,0,1);
1486    drw_btn('Touch:'+(load_key_tex>0),1,m_cur,0,1);
1487    drw_btn('JPEG:'+s_jpeg_quality,2,m_cur,0,1);
1488    drw_btn('Set Root',3,m_cur,0,1);
1489    drw_btn('Reset',4,m_cur,0,1);
1490    drw_btn('Back',5,m_cur,0,1);
1491
1492    drawVideo;
1493    delay(1);
1494   until false;
1495  end;
1496
1497 procedure menu_help;
1498  var
1499   ix,iy,cur:integer;
1500  begin
1501   repeat
1502    updateKeys;
1503    if clickedKey(KEY_MENU_SELECT) then break;
1504    if pressedKey(KEY_MENU_UP) then cur:=cur+1;
1505    if pressedKey(KEY_MENU_DOWN) then cur:=cur-1;
1506
1507    for ix:=0 to getWidth/16 do
1508    for iy:=2 to (getHeight/16)-2 do
1509     drawimage(bg[1],ix*16,iy*16);
1510
1511    for ix:=0 to getWidth/16 do
1512    for iy:=0 to 1 do
1513     drawimage(bg[0],ix*16,iy*16);
1514
1515    for ix:=0 to getWidth/16 do
1516    for iy:=(getHeight/16)-2 to getHeight/16 do
1517     drawimage(bg[0],ix*16,iy*16);
1518
1519    setclip(0,32,getWidth,(getHeight/16-4)*16);
1520
1521    drw_txt('Controls:',cur,0,1);
1522    drw_txt('Left - Move left',cur,1,0);
1523    drw_txt('Right - Move right',cur,2,0);
1524    drw_txt('Up - Jump',cur,3,0);
1525    drw_txt('Down - Put a block under you',cur,4,0);
1526    drw_txt('1 - Inventory',cur,5,0);
1527    drw_txt('Duble 1 - Craft',cur,6,0);
1528    drw_txt('3 - Use block',cur,7,0);
1529    drw_txt('7 - Debug info',cur,8,0);
1530    drw_txt('Hold 7 - Console',cur,9,0);
1531    drw_txt('9 - Pause',cur,10,0);
1532    drw_txt('*, # - Browse inventory',cur,11,0);
1533    drw_txt('0 - Edit mode',cur,12,0);
1534
1535    drw_txt('In inventory/chest:',cur,14,1);
1536    drw_txt('3 - Enject object',cur,15,0);
1537    drw_txt('Hold 3 - Enject stack',cur,16,0);
1538    drw_txt('5 - Move the stack',cur,17,0);
1539    drw_txt('Hold 5 - Divide stack',cur,18,0);
1540
1541    setclip(0,0,getWidth,getHeight);
1542
1543    drw_btn('Back',0,0,getHeight-getHeight/2-16-6,1);
1544
1545    drawVideo;
1546    delay(1);
1547   until false;
1548  end;
1549
1550 procedure menu_about;
1551  var
1552   ix,iy,cur:integer;
1553  begin
1554   repeat
1555    updateKeys;
1556    if clickedKey(KEY_MENU_SELECT) then break;
1557    if pressedKey(KEY_MENU_UP) then cur:=cur+1;
1558    if pressedKey(KEY_MENU_DOWN) then cur:=cur-1;
1559
1560    for ix:=0 to getWidth/16 do
1561    for iy:=2 to (getHeight/16)-2 do
1562     drawimage(bg[1],ix*16,iy*16);
1563
1564    for ix:=0 to getWidth/16 do
1565    for iy:=0 to 1 do
1566     drawimage(bg[0],ix*16,iy*16);
1567
1568    for ix:=0 to getWidth/16 do
1569    for iy:=(getHeight/16)-2 to getHeight/16 do
1570     drawimage(bg[0],ix*16,iy*16);
1571
1572    setclip(0,32,getWidth,(getHeight/16-4)*16);
1573
1574    drw_txt('Developers:',cur,0,1);
1575    drw_txt(#68+#101+#97+#68+#68+#111+#111+#77+#69+#82+' - Programmer',cur,1,0);//dead
1576    drw_txt(#102+#114+#101+#100+#45+#98+#111+#121+' - Programmer',cur,2,0);//fred-boy
1577    drw_txt(#65+#110+#100+#114+#101+#121+#53+#57+' - Programmer',cur,3,0);//andrey59
1578    drw_txt(#89+#117+#82+#97+#78+#110+#78+#122+#90+#90+' - Artist',cur,4,0);//yura
1579    drw_txt(#83+#97+#115+#104+#97+#71+' - Artist and idea generator',cur,5,0);//sasha
1580    drw_txt(#66+#97+#74+#108+#101+#72+#84+#105+#72+' - Artist and tester',cur,6,0);//valentin
1581    drw_txt(#65+#103+#114+#101+#115+#115+#111+#82+' - Tester',cur,7,0);//agressor
1582    drw_txt(#118+#111+#108+#121+#97+#95+#110+#97+#115+#116+#97+#110+#101+' - Tester',cur,8,0);//volya
1583    drw_txt(#97+#98+#97+#100+#111+#110+' - Tester',cur,9,0);//abadon
1584    drw_txt(#77+#111+#110+#111+#103+#114+#111+#109+' - Tester',cur,10,0);//monogrom
1585    drw_txt(#75+#97+#108+#116+#101+#114+' - Tester',cur,11,0);//kalter
1586
1587    drw_txt('Thanks:',cur,12,1);
1588    drw_txt('Piligrim and 0vZ - Lib_jsr75i',cur,13,0);
1589    drw_txt('Piligrim - Lib_effects',cur,14,0);
1590    drw_txt('Kurdt - Lib_canvas',cur,15,0);
1591    drw_txt('ViNT - Lib_png and Lib_bmp',cur,16,0);
1592    drw_txt('aleshka - Lib_jpeg',cur,17,0);
1593    drw_txt('Roman_V - Lib_safeload',cur,18,0);
1594
1595    drw_txt('Site: '+#104+#116+#116+#112+#58+#47+#47+#100+#101+#97+#100+#115+#111+#102+#116+#119+#97+#114+#101+#46+#114+#117,cur,21,0);
1596    drw_txt(#68+#101+#97+#68+#83+#111+#102+#116+#87+#97+#114+#101+' 2012-'+getyear(getcurrenttime),cur,22,0);
1597
1598    drw_txt('Hello! :D',cur,100,1);
1599
1600    setclip(0,0,getWidth,getHeight);
1601
1602    drw_btn('Back',0,0,getHeight-getHeight/2-16-6,1);
1603
1604    drawVideo;
1605    delay(1);
1606   until false;
1607  end;
1608
1609 function sm_siz:integer;
1610  begin
1611   sm_siz:=(getWidth+getHeight)/5;
1612  end;
1613
1614 function sm_siz4:integer;
1615  begin
1616   sm_siz4:=sm_siz/4;
1617  end;
1618
1619 procedure draw_menu_back;
1620  var
1621   ix, iy:integer;
1622  begin
1623   for ix:=0 to getWidth/16 do
1624   for iy:=0 to getHeight/16 do
1625    drawimage(bg[0],ix*16,iy*16);
1626  end;
1627
1628 procedure menu;
1629  var
1630   m_cur,ix,iy,iz:integer;
1631   key,spl_i:integer;
1632   splash:string;
1633   res:resource;
1634   time:integer;
1635   cavelogo:image;
1636   spl_y,spl_del:integer;
1637   spl_y_b:boolean;
1638  begin
1639   cavelogo:=ld_tex('cavelogo.png','/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/','title/');
1640   splash:='#ERROR';
1641   spl_y:=getimageheight(cavelogo);
1642   spl_y_b:=true;
1643   spl_del:=getrelativetimems;
1644   res:=openResource('/title/splashes.txt');
1645   if ResourceAvailable(res) then
1646    begin
1647     spl_i:=stringtointeger(readline(res));
1648     iy:=random(spl_i-1)+1;
1649     debug('SPLASH #'+iy);
1650     for ix:=1 to iy do
1651      splash:=readline(res);
1652     closeresource(res);
1653    end;
1654   time:=getcurrenttime;
1655   if (getmonth(time)=5) and (getday(time)=7) then splash:='Happy birthday, DeaDDooMER!';
1656   if ((getmonth(time)=0) and (getday(time)<3)) or ((getmonth(time)=11) and (getday(time)>29)) then splash:='Happy New Year!';
1657   repeat
1658    proc_fps;
1659    updateKeys;
1660    if clickedKey(KEY_MENU_UP) then
1661     begin
1662      m_cur:=m_cur-1;
1663      if m_cur<0 then m_cur:=5;
1664     end;
1665    if clickedKey(KEY_MENU_DOWN) then
1666     begin
1667      m_cur:=m_cur+1;
1668      if m_cur>5 then m_cur:=0;
1669     end;
1670    if clickedKey(KEY_MENU_SELECT) then
1671     begin
1672      if m_cur=0 then begin if menu_game then break; end;
1673       else
1674      if m_cur=1 then menu_tex;
1675       else
1676      if m_cur=2 then menu_sett;
1677       else
1678      if m_cur=3 then menu_help;
1679       else
1680      if m_cur=4 then menu_about;
1681       else
1682      if m_cur=5 then begin save_settings; halt; end;
1683     end;
1684
1685    draw_menu_back;
1686
1687    drawimage(cavelogo,(getWidth/2)-(getimagewidth(cavelogo)/2),0);
1688    setcolor(255,255,0);
1689
1690    DrawFontTextSpec(splash, (getWidth/2)-(length(splash)*FONT_SYM_SIZE/2), spl_y, FONT_YELLOW_COLOR, true);
1691
1692    if spl_y_b then begin if getrelativetimems-spl_del>64 then begin spl_y:=spl_y+1; spl_del:=getrelativetimems; end; if spl_y>getimageheight(cavelogo)+2 then spl_y_b:=false; end;
1693    if not spl_y_b then begin if getrelativetimems-spl_del>64 then begin spl_y:=spl_y-1; spl_del:=getrelativetimems; end; if spl_y<getimageheight(cavelogo)+1 then spl_y_b:=true; end;
1694    drawfonttext(version,0,getHeight-8);
1695
1696    drw_btn('Singleplayer',0,m_cur,0,1);
1697    drw_btn('Texture Packs',1,m_cur,0,1);
1698    drw_btn('Options',2,m_cur,0,1);
1699    drw_btn('Help',3,m_cur,0,1);
1700    drw_btn('About',4,m_cur,0,1);
1701    drw_btn('Quit Game',5,m_cur,0,1);
1702
1703    drawVideo;
1704    maxfps;
1705   until false;
1706  end;
1707
1708 function setBlock(invcur, x, y:integer):boolean;
1709  var
1710   item, sum, block, sblock:integer;
1711  begin
1712   item:=inv.getItem(invcur);
1713   sum:=inv.getSum(invcur);
1714   block:=getMap(x, y);
1715   sblock:=getItemInfo(item);
1716
1717   if getItemType(item)=ITEM_TYPE_BLOCK then
1718   if inv.isNull(invcur)=false then
1719   if getBlockSet(block)=true then
1720  // if (coll_xy(x, y)=false) or (getBlockColl(item)=0) then
1721    begin
1722     if set_block_code(sblock, x, y)=false then
1723      begin
1724
1725       setmap(sblock, x, y);
1726       if gamemode<>1 then
1727        begin
1728         inv.setSum(inv.getSum(invcur)-1, invcur);
1729         inv.fixNull(invcur);
1730        end;
1731
1732       setBlock:=true;
1733      end;
1734    end;
1735  end;
1736
1737 procedure fishing;
1738  var
1739   x, y:integer;
1740  begin
1741   x:=player.getX;
1742   y:=player.getY;
1743   if (getrelativetimems-fish_time>5000) and (getmap(fx,fy)=50) then
1744    begin
1745     if (random(3)=2) and (getmap(fx,fy)=50) then
1746      begin
1747       drop.create(210,1,x,y);
1748       fish:=false;
1749      end;
1750     inv.setSum(inv.getSum(invslot)-1, invslot);
1751     inv.fixNull(invslot);
1752     fish:=false;
1753    end; else
1754   if (getrelativetimems-fish_time<5000) and (getmap(fx,fy)=50) and (fish=true) then
1755    begin
1756     if getmap(fx,fy-1)=50 then fy:=fy-1;
1757    end;
1758  end;
1759
1760 procedure drawminimap;
1761  var
1762   ix,iy,tmp_gx,tmp_gy,minx,miny,maxx,maxy,loc_camx,loc_camy,x,y:integer;
1763  begin
1764   x:=player.getX;
1765   y:=player.getY;
1766   if load_minimap_tex then
1767    begin
1768     tmp_gx:=(getWidth/2)-(getimagewidth(gui[16])/2);
1769     tmp_gy:=(getHeight/2)-(getimageheight(gui[16])/2);
1770    end;
1771   else
1772    begin
1773     tmp_gx:=(getWidth/2)-(64/2);
1774     tmp_gy:=(getHeight/2)-(64/2);
1775    end;
1776
1777   loc_camx:=(x+4)-(864/2);
1778   loc_camy:=(y+4)-(864/2);
1779   if loc_camx<0 then loc_camx:=0;
1780   if loc_camx>4096-864 then loc_camx:=4096-864;
1781   if loc_camy<0 then loc_camy:=0;
1782   if loc_camy>2048-864 then loc_camy:=2048-864;
1783   minx:=loc_camx/16;
1784   miny:=loc_camy/16;
1785   maxx:=(loc_camx+864)/16;
1786   maxy:=(loc_camy+864)/16;
1787   if minx<0 then minx:=0;
1788   if miny<0 then miny:=0;
1789   if maxx>255 then maxx:=255;
1790   if maxy>127 then maxy:=127;
1791
1792   if load_minimap_tex then
1793    drawimage(gui[16],tmp_gx,tmp_gy);
1794   else
1795    begin
1796     setcolor(214,190,150);
1797     fillrect(tmp_gx,tmp_gy,64,64);
1798    end;
1799
1800   for ix:=minx to maxx do
1801   for iy:=miny to maxy do
1802    begin
1803     if (getmap(ix,iy)=1) or (getmap(ix,iy)=2) or (getmap(ix,iy)=74) then setcolor(121,85,58); else
1804     if (getmap(ix,iy)=4) or (getmap(ix,iy)=9) or (getmap(ix,iy)=11) or (getmap(ix,iy)=28) or (getmap(ix,iy)=29) or ((getmap(ix,iy)>=77) and (getmap(ix,iy)<=86)) or ((getmap(ix,iy)>=88) and (getmap(ix,iy)<=101)) then setcolor(188,152,98); else
1805     if (getmap(ix,iy)=50) or (getmap(ix,iy)=62) then setcolor(38,92,255); else
1806     if getmap(ix,iy)=51 then setcolor(255,0,0); else
1807     if (getmap(ix,iy)=61) or (getmap(ix,iy)=32) then setcolor(255,255,255); else
1808     setcolor(127,127,127);
1809
1810     if (getmap(ix,iy)<>0) then plot(tmp_gx+4+ix-minx,tmp_gy+4+iy-miny);
1811    end;
1812   setcolor(0,0,255);
1813  end;
1814
1815 procedure draw_sign;
1816  var
1817   tmp:string;
1818   str:array[0..3] of string;
1819   i,j,tmp_gx,tmp_gy:integer;
1820  begin
1821   if load_gui_tex then
1822    begin
1823     tmp_gx:=(getWidth/2)-(getimagewidth(sign_im)/2);
1824     tmp_gy:=(getHeight/2)-(getimageheight(sign_im)/2);
1825    end;
1826   else
1827    begin
1828     tmp_gx:=(getWidth/2)-(120/2);
1829     tmp_gy:=(getHeight/2)-(60/2);
1830    end;
1831
1832   tmp:=t_sign[getmapinfo(curx,cury)];
1833   while pos(tmp,#13)<>-1 do
1834    begin
1835     i:=pos(tmp,#13);
1836     str[j]:=copy(tmp,0,i);
1837     tmp:=copy(tmp,i+1,length(tmp));
1838     j:=j+1;
1839    end;
1840
1841   if load_gui_tex then
1842    drawimage(sign_im,tmp_gx,tmp_gy);
1843   else
1844    begin
1845     setcolor(159,132,77);
1846     fillrect(tmp_gx,tmp_gy,120,60);
1847    end;
1848
1849   drawfonttext(str[0],tmp_gx+(120/2)-(length(str[0])*8/2),tmp_gy+(60/4/2)+4);
1850   drawfonttext(str[1],tmp_gx+(120/2)-(length(str[1])*8/2),tmp_gy+(60/4/2)+8+4);
1851   drawfonttext(str[2],tmp_gx+(120/2)-(length(str[2])*8/2),tmp_gy+(60/4/2)+16+4);
1852   drawfonttext(str[3],tmp_gx+(120/2)-(length(str[3])*8/2),tmp_gy+(60/4/2)+24+4);
1853  end;
1854
1855 procedure draw_back(ix,iy:integer);
1856  begin
1857   if getBiomMap(ix)=0 then
1858    begin
1859     if (getBackMap(ix)=iy) then drawimage(back[0],(ix*16)-camx,(iy*16)-camy); else
1860     if (getBackMap(ix)+1=iy) then drawimage(back[1],(ix*16)-camx,(iy*16)-camy); else
1861     if (getBackMap(ix)+2=iy) then drawimage(back[1],(ix*16)-camx,(iy*16)-camy); else
1862     if (getBackMap(ix)+3=iy) then drawimage(back[1],(ix*16)-camx,(iy*16)-camy); else
1863     if (getBackMap(ix)<iy) then drawimage(back[2],(ix*16)-camx,(iy*16)-camy);
1864    end; else
1865   if getBiomMap(ix)=1 then
1866    begin
1867     if (getBackMap(ix)=iy) then drawimage(back[4],(ix*16)-camx,(iy*16)-camy); else
1868     if (getBackMap(ix)+1=iy) then drawimage(back[4],(ix*16)-camx,(iy*16)-camy); else
1869     if (getBackMap(ix)+2=iy) then drawimage(back[6],(ix*16)-camx,(iy*16)-camy); else
1870     if (getBackMap(ix)+3=iy) then drawimage(back[6],(ix*16)-camx,(iy*16)-camy); else
1871     if (getBackMap(ix)<iy) then drawimage(back[2],(ix*16)-camx,(iy*16)-camy);
1872    end; else
1873   if getBiomMap(ix)=2 then
1874    begin
1875     if (getBackMap(ix)=iy) then drawimage(back[5],(ix*16)-camx,(iy*16)-camy); else
1876     if (getBackMap(ix)+1=iy) then drawimage(back[1],(ix*16)-camx,(iy*16)-camy); else
1877     if (getBackMap(ix)+2=iy) then drawimage(back[1],(ix*16)-camx,(iy*16)-camy); else
1878     if (getBackMap(ix)+3=iy) then drawimage(back[1],(ix*16)-camx,(iy*16)-camy); else
1879     if (getBackMap(ix)<iy) then drawimage(back[2],(ix*16)-camx,(iy*16)-camy);
1880    end; else
1881   if getBiomMap(ix)=3 then
1882    begin
1883     if (getBackMap(ix)=iy) then drawimage(back[7],(ix*16)-camx,(iy*16)-camy); else
1884     if (getBackMap(ix)+1=iy) then drawimage(back[1],(ix*16)-camx,(iy*16)-camy); else
1885     if (getBackMap(ix)+2=iy) then drawimage(back[1],(ix*16)-camx,(iy*16)-camy); else
1886     if (getBackMap(ix)+3=iy) then drawimage(back[1],(ix*16)-camx,(iy*16)-camy); else
1887     if (getBackMap(ix)<iy) then drawimage(back[2],(ix*16)-camx,(iy*16)-camy);
1888    end; else
1889   if getBiomMap(ix)=4 then
1890    begin
1891     drawimage(back[8],(ix*16)-camx,(iy*16)-camy);
1892    end;
1893  end;
1894
1895 procedure draw;
1896  var
1897   ix,iy,iz,minx,miny,maxx,maxy,tmp_ax,tim,smy,pa_xo, x, y:integer;
1898  begin
1899   x:=player.getX;
1900   y:=player.getY;
1901   {===================[sky]===================}
1902   tim:=10000*getimagewidth(sky)/600000*game_time/10000;
1903   setcolor(effects.get(sky,tim,0,1),effects.get(sky,tim,0,2),effects.get(sky,tim,0,3));
1904   fillrect(0,0,getWidth,getHeight);
1905   srand(seed);
1906   if drw_stars then
1907    begin
1908     setcolor(effects.get(sky,tim,2,1),effects.get(sky,tim,2,2),effects.get(sky,tim,2,3));
1909     smy:=10000*getWidth*2/600000*game_time/10000;
1910     for iz:=1 to getWidth do
1911      begin
1912       ix:=rnd(getWidth*2)-getWidth+smy;
1913       if ix>getWidth then ix:=ix-getWidth*2;
1914       iy:=rnd(getHeight);
1915      if (ix>-1) and (ix<getWidth) then plot(ix,iy);
1916      end;
1917    end;
1918
1919   if drw_sm then
1920    begin
1921     if load_sm>0 then
1922      begin
1923       smy:=10000*(getWidth+getimagewidth(sun))/300000*game_time/10000;
1924       drawimage(sun,smy-getimagewidth(sun),getHeight/2-getimageheight(sun)/2);
1925      end;
1926     else
1927      begin
1928       setcolor(255,213,74);
1929       smy:=10000*(getWidth+sm_siz)/300000*game_time/10000;
1930       fillrect(smy-sm_siz+sm_siz4,getHeight/2-sm_siz/2+sm_siz4,sm_siz-sm_siz4,sm_siz-sm_siz4);
1931      end;
1932
1933     if load_sm>0 then
1934      begin
1935       smy:=10000*(getWidth+getimagewidth(moon))/300000*(game_time-300000)/10000;
1936       drawimage(moon,smy-getimagewidth(moon),getHeight/2-getimageheight(moon)/2);
1937      end;
1938     else
1939      begin
1940       setcolor(175,184,204);
1941       smy:=10000*(getWidth+sm_siz)/300000*(game_time-300000)/10000;
1942       fillrect(smy-sm_siz+sm_siz4,getHeight/2-sm_siz/2+sm_siz4,sm_siz-sm_siz4,sm_siz-sm_siz4);
1943      end;
1944    end;
1945   {===================[camera]===================}
1946   camx:=(x+4)-(getWidth/2);
1947   camy:=(y+4)-(getHeight/2);
1948   if camx<0 then camx:=0;
1949   if camx>4096-getWidth then camx:=4096-getWidth;
1950   if camy>2048-getHeight then camy:=2048-getHeight;
1951   {===================[max_draw]===================}
1952   minx:=camx/16;
1953   miny:=camy/16;
1954   maxx:=(camx+getWidth)/16;
1955   maxy:=(camy+getHeight)/16;
1956   if minx<0 then minx:=0;
1957   if miny<0 then miny:=0;
1958   if maxx>255 then maxx:=255;
1959   if maxy>127 then maxy:=127;
1960   {===================[draw_back]===================}
1961   for ix:=minx to maxx do
1962   for iy:=miny to maxy do
1963    begin
1964     if ifosad then if (getBackMap(ix)>=iy) and (osadki=true) and getBlockTrans(getmap(ix,iy)) then
1965      begin
1966       if getBiomMap(ix)=0 then drawimage(osad[0,osadki_ani],(ix*16)-camx,(iy*16)-camy);
1967        else
1968       if getBiomMap(ix)=2 then drawimage(osad[1,osadki_ani],(ix*16)-camx,(iy*16)-camy);
1969        else
1970       if getBiomMap(ix)=3 then drawimage(osad[0,osadki_ani],(ix*16)-camx,(iy*16)-camy);
1971      end;
1972     if drw_back then
1973      if getBlockTrans(getmap(ix,iy)) then
1974       draw_back(ix,iy);
1975
1976     if getBlockFore(getmap(ix,iy))=false then
1977      draw_block(ix,iy);
1978    end;
1979   {===================[drop]===================}
1980   Drop.Draw(camx, camy);
1981   {===================[particles]===================}
1982   Particles.Draw(camx, camy);
1983   {===================[player]===================}
1984   Player.Draw(camx, camy);
1985   {===================[mobs]===================}
1986   Mobs.Draw(camx, camy);
1987   {===================[draw_blocks]===================}
1988   for ix:=minx to maxx do
1989   for iy:=miny to maxy do
1990     begin
1991       if getBlockFore(getmap(ix, iy)) then
1992         draw_block(ix, iy);
1993
1994       setcolor(0, 0, 0);
1995       if light_type = 1 then
1996         begin
1997           if getmaplight(ix,iy) = 0 then
1998             fillrect((ix * 16) - camx, (iy * 16) - camy, 16, 16);
1999         end;
2000       else if light_type = 2 then
2001         begin
2002           if getmaplight(ix, iy) < 15 then
2003              drawimage(light[getmaplight(ix, iy)], (ix * 16) - camx, (iy * 16) - camy);
2004         end;
2005      end;
2006
2007    // debug
2008    // drawimage(light[getmaplight(player.getX div 16, player.getY div 16)], 0, 0);
2009
2010    if (toolus > 0) and (toolind < 10) and (getmap(curx,cury) > 0) then
2011      begin
2012        if toolind > 9 then
2013          toolind:=9;
2014        drawimage(tue[toolind], curx * 16 - camx, cury * 16 - camy);
2015      end;
2016   {===================[gui]===================}
2017   if drawgui then
2018    begin
2019     tmp_ax:=(getWidth/2)-(getImageWidth(gui[1])/2);
2020
2021     if keymode=1 then
2022      drawimage(gui[0],curx*16-camx,cury*16-camy);
2023
2024     DrawWindows;
2025     /*if keymode=2 then
2026      if gamemode<>1 then
2027       DrawPlayerInventory;
2028      else
2029       drawinv_c; else
2030     if keymode=3 then drawcraft; else
2031     if keymode=4 then drawchest; else
2032     if keymode=5 then draw_sign; else
2033     if keymode=6 then drawfurnace; else
2034     if ifminimap then drawminimap;*/
2035
2036     drawimage(gui[1],tmp_ax,0);
2037     for ix:=0 to 8 do
2038      begin
2039       drawItem(inv.getItem(ix), inv.getSum(ix), (ix*16)+tmp_ax+ix*2+4, 1, true);
2040      end;
2041     drawimage(gui[17],(invslot*16)+tmp_ax+invslot*2+2,0);
2042
2043     if gamemode<>1 then
2044      begin
2045       if gamemode=0 then
2046        begin
2047         for ix:=0 to (hp div 2)-1 do drawimage(gui[13],ix*9,getHeight-9);
2048         if (hp mod 2)<>0 then begin drawimage(gui[14],ix*9,getHeight-9); ix:=ix+1 end;
2049         for ix:=ix to 9 do drawimage(gui[15],ix*9,getHeight-9);
2050        end; else
2051       if gamemode=2 then
2052        begin
2053         for ix:=0 to (hp div 2)-1 do drawimage(gui[31],ix*9,getHeight-9);
2054         if (hp mod 2)<>0 then begin drawimage(gui[32],ix*9,getHeight-9); ix:=ix+1 end;
2055         for ix:=ix to 9 do drawimage(gui[33],ix*9,getHeight-9);
2056        end;
2057
2058       for ix:=0 to (hunger div 2)-1 do drawimage(gui[26],ix*9,getHeight-18);
2059       if (hunger mod 2)<>0 then begin drawimage(gui[27],ix*9,getHeight-18); ix:=ix+1 end;
2060       for ix:=ix to 9 do drawimage(gui[28],ix*9,getHeight-18);
2061
2062       if getmap((x+4)/16,y/16)=50 then
2063         begin
2064             for ix:=0 to (air div 2)-1 do drawimage(gui[29],ix*9,getHeight-27);
2065             if (air mod 2)<>0 then begin drawimage(gui[30],ix*9,getHeight-27); ix:=ix+1 end;
2066         end;
2067      end;
2068
2069     for ix:=0 to 3 do
2070      begin
2071       drawfonttext(msg[ix],0,getHeight-20-ix*9);
2072       if getrelativetimems-msg_time[ix]>5000 then msg[ix]:='';
2073      end;
2074    end;
2075  end;
2076
2077 procedure load_moon(path:string;phase:integer);
2078  var
2079   no:image;
2080  begin
2081   moon:=no;
2082     if load_sm=1 then
2083      begin
2084       moon:=ld_tex('moon_phase_'+phase+'.png',path,'terrain/moon_phases/');
2085      end; else
2086     if load_sm=2 then
2087      begin
2088       moon:=resize_image(ld_tex('moon_phase_'+phase+'.png',path,'terrain/moon_phases/'),(getWidth+getHeight)/5,(getWidth+getHeight)/5);
2089      end;
2090  end;
2091
2092 procedure sleep;
2093  var
2094   i,ix,iy:integer;
2095  begin
2096   if game_time>300000 then
2097    begin
2098     if load_light_tex then
2099      begin
2100       keymode:=0;
2101       i:=15;
2102       while i>0 do
2103        begin
2104         for iy:=0 to getheight/16 do
2105          for ix:=0 to getwidth/16 do
2106           drawimage(light[i],ix*16,iy*16);
2107         i:=i-1;
2108         drawVideo;
2109         delay(100);
2110        end;
2111       moon_phase:=moon_phase+1;
2112       if moon_phase>7 then moon_phase:=0;
2113       load_moon('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/',moon_phase);
2114       game_time:=50000;
2115       last_sleep_x:=curx;
2116       last_sleep_y:=cury-1;
2117       i:=1;
2118       while i<15 do
2119        begin
2120         draw;
2121         for iy:=0 to getheight/16 do
2122          for ix:=0 to getwidth/16 do
2123           drawimage(light[i],ix*16,iy*16);
2124         i:=i+1;
2125         drawVideo;
2126         delay(100);
2127        end;
2128      end;
2129     else
2130      begin
2131       keymode:=0;
2132       i:=0;
2133       while i<=getheight do
2134        begin
2135         setcolor(0,0,0);
2136         fillrect(0,0,getwidth,i);
2137         i:=i+5;
2138         drawVideo;
2139         delay(50);
2140        end;
2141       moon_phase:=moon_phase+1;
2142       if moon_phase>7 then moon_phase:=0;
2143       load_moon('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/',moon_phase);
2144       game_time:=50000;
2145       last_sleep_x:=curx;
2146       last_sleep_y:=cury-1;
2147       i:=0;
2148       while i<=getheight do
2149        begin
2150         draw;
2151         setcolor(0,0,0);
2152         fillrect(0,i,getwidth,getheight);
2153         i:=i+5;
2154         drawVideo;
2155         delay(50);
2156        end;
2157      end;
2158    end; else create_msg('You can sleep only at night');
2159  end;
2160
2161 procedure resetToolProgerss;
2162  begin
2163   toolus:=0;
2164   toolind:=0;
2165  end;
2166
2167 procedure usetools(invcur, x, y:integer);
2168  var
2169   item, sum, block:integer;
2170  begin
2171   block:=getmap(x, y);
2172   item:=inv.getItem(invcur);
2173   sum:=inv.getSum(invcur);
2174
2175   if gamemode=1 then
2176    destroy_block_cr(block, x, y);
2177   else
2178   if (block>0) then
2179    begin
2180     if (getItemType(item)=ITEM_TYPE_TOOL) and (getBlockTool(block)=getToolType(item)) then
2181      toolus:=toolus+getToolSpeed(item);
2182     else
2183      toolus:=toolus+1;
2184
2185     if toolus>=getBlockHP(block) then
2186      begin
2187       if ((getItemType(item)=ITEM_TYPE_TOOL) and (getBlockTool(block)=getToolType(item)) and (getToolLvl(item)>=getBlockLvl(block))) or (getBlockLvl(block)<=0) then
2188        begin
2189         setMap(0, x, y);
2190         destroy_block_1(block, x, y);
2191         setMapInfo(0, x, y);
2192        end;
2193       else
2194        begin
2195         setMap(0, x, y);
2196         destroy_block_0(block, x, y);
2197         setMapInfo(0, x, y);
2198        end;
2199
2200       if getItemType(item)=ITEM_TYPE_TOOL then
2201        begin
2202         inv.setSum(inv.getSum(invcur)-1, invcur);
2203         inv.fixNull(invcur);
2204        end;
2205
2206       toolus:=0;
2207       toolind:=0;
2208      end;
2209    end;
2210
2211   if (toolus>0) and (toolus<=getBlockHP(block)) then
2212    toolind:=((toolus*100) div getBlockHP(block)) div 10;
2213  end;
2214
2215 function rt_useweap:boolean;
2216  var
2217   x, y, w, h, i, damg:integer;
2218   item:integer;
2219  begin
2220   x:=player.getX;
2221   y:=player.getY;
2222   w:=player.getW;
2223   h:=player.getH;
2224   item:=inv.getItem(invslot);
2225
2226   if getItemType(item)=1 then
2227    damg:=getToolDamg(item);
2228   else
2229    damg:=1;
2230
2231   if posi=0 then
2232    i:=Mobs.findAndHit(damg, x-TILE_SIZE, y, TILE_SIZE+(w/2), h, -2, -3);
2233   else
2234    i:=Mobs.findAndHit(damg, x+(w/2), y, TILE_SIZE+(w/2), h, 2, -3);
2235
2236   if i<>-1 then
2237    begin
2238     inv.setSum(inv.getSum(invslot)-1, invslot);
2239     inv.fixNull(invslot);
2240     rt_useweap:=true;
2241    end;
2242  end;
2243
2244 procedure rt_usetools;
2245  var
2246   x, y:integer;
2247  begin
2248   x:=player.getX;
2249   y:=player.getY;
2250
2251   if posi=0 then curx:=(x div 16)-1; else curx:=(x div 16)+1;
2252   cury:=y div 16;
2253   if getmap(curx,cury)=0 then cury:=cury+1;
2254
2255   if curx<0 then curx:=0;
2256   if curx>255 then curx:=255;
2257   if cury<0 then cury:=0;
2258   if cury>127 then cury:=127;
2259
2260   usetools(invslot, curx, cury);
2261  end;
2262
2263 procedure rt_usemob;
2264  var
2265   x, y:integer;
2266  begin
2267   x:=player.getX;
2268   y:=player.getY;
2269
2270   if posi=0 then curx:=(x div 16)-1; else curx:=(x div 16)+1;
2271   cury:=y div 16;
2272   if getmap(curx,cury)=0 then cury:=cury+1;
2273
2274   if curx<0 then curx:=0;
2275   if curx>255 then curx:=255;
2276   if cury<0 then cury:=0;
2277   if cury>127 then cury:=127;
2278
2279   //usemob(curx,cury);
2280  end;
2281
2282 procedure actionUse(invcur, x, y:integer);
2283  begin
2284   if setBlock(invcur, x, y)=false then
2285   if useBlock(invcur, x, y) then
2286    if useItem(invcur, x, y) then
2287  end;
2288
2289 procedure rt_useblock;
2290  var
2291   x, y:integer;
2292  begin
2293   x:=player.getX;
2294   y:=player.getY;
2295
2296   if posi=0 then curx:=(x div 16)-1; else curx:=(x div 16)+1;
2297   cury:=y div 16;
2298   if getmap(curx,cury)=0 then cury:=cury+1;
2299
2300   if curx<0 then curx:=0;
2301   if curx>255 then curx:=255;
2302   if cury<0 then cury:=0;
2303   if cury>127 then cury:=127;
2304
2305   actionUse(invslot, curx, cury);
2306  end;
2307
2308 procedure go_to_nether;
2309  var
2310   ix:integer;
2311  begin
2312   portal_time:=getrelativetimems;
2313   savegame('/'+sd+'/cavecraft/saves/'+sav_fl+'/');
2314   pl_world:=1;
2315   drw_load_line('Matrix',10);
2316   if loadworld('/'+sd+'/cavecraft/saves/'+sav_fl+'/')=true then
2317    begin
2318     player.setX(get_spawn_x*16+4);
2319     player.setY((get_up(get_spawn_x)-1)*16);
2320    end;
2321   else
2322    begin
2323     {for ix:=0 to 31 do
2324      begin
2325       mob[ix].m_type:=0;
2326       mob[ix].m_x:=0;
2327       mob[ix].m_y:=0;
2328       mob[ix].m_posi:=0;
2329       mob[ix].m_velx:=0;
2330       mob[ix].m_vely:=0;
2331       mob[ix].m_ani:=0;
2332       mob[ix].m_min_vely:=0;
2333       mob[ix].m_hp:=0;
2334       mob[ix].m_del:=0;
2335       mob[ix].m_fall:=false;
2336       mob[ix].m_jmp:=false;
2337       mob[ix].m_velani:=false;
2338     end;}
2339
2340    drop.resetData;
2341    gennether;
2342    //netherspawn;
2343   end;
2344  end;
2345
2346 procedure go_to_world;
2347  begin
2348   portal_time:=getrelativetimems;
2349   savegame('/'+sd+'/cavecraft/saves/'+sav_fl+'/');
2350   pl_world:=0;
2351   drw_load_line('Matrix',10);
2352   if loadworld('/'+sd+'/cavecraft/saves/'+sav_fl+'/')=true then
2353    begin
2354     pl_world:=0;
2355    end;
2356   else
2357    begin
2358     debug('ERROR!!!');
2359     pl_world:=0;
2360     genworld;
2361     //megaspawn;
2362    end;
2363  end;
2364
2365 procedure plr_is_dead_hardcore;
2366  begin
2367   keymode:=0;
2368   toolus:=0;
2369   toolind:=0;
2370
2371   repeat
2372   updateKeys;
2373   if clickedKey(KEY_MENU_SELECT) then
2374    begin
2375     deleteworld('/'+sd+'/cavecraft/saves/'+sav_fl+'/');
2376     menu;
2377     exit;
2378    end;
2379   draw;
2380   drawfonttext('You died!',getwidth/2-32,getheight/2-16);
2381
2382   drw_btn('Delete world',0,0,0,1);
2383
2384    drawVideo;
2385    delay(1);
2386   until false;
2387
2388  end;
2389
2390 procedure plr_is_dead;
2391  var
2392   m_cur:integer;
2393   x, y:integer;
2394  begin
2395   x:=player.getX;
2396   y:=player.getY;
2397   keymode:=0;
2398   toolus:=0;
2399   toolind:=0;
2400   repeat
2401    updateKeys;
2402    if clickedKey(KEY_MENU_UP) then
2403     begin
2404      m_cur:=m_cur-1;
2405      if m_cur<0 then m_cur:=1;
2406     end;
2407    if clickedKey(KEY_MENU_DOWN) then
2408     begin
2409      m_cur:=m_cur+1;
2410      if m_cur>1 then m_cur:=0;
2411     end;
2412    if clickedKey(KEY_MENU_SELECT) then
2413     begin
2414      if m_cur=0 then
2415       begin
2416       if pl_world=0 then
2417        begin
2418         if last_sleep_x=0 then
2419          begin
2420           x:=get_spawn_x*16+4;
2421           y:=get_spawn_y*16;
2422          end; else
2423           begin
2424            x:=last_sleep_x*16+4;
2425            y:=last_sleep_y*16;
2426           end;
2427        end; else
2428         if pl_world=1 then
2429          begin
2430           go_to_world;
2431           if last_sleep_x=0 then
2432            begin
2433             x:=get_spawn_x*16+4;
2434             y:=get_spawn_y*16;
2435            end; else
2436             begin
2437              x:=last_sleep_x*16+4;
2438              y:=last_sleep_y*16;
2439             end;
2440          end;
2441        player.setX(x);
2442        player.setY(y);
2443        posi:=0;
2444        curx:=0;
2445        cury:=0;
2446        vely:=0;
2447        jmp:=false;
2448        hp:=20;
2449        hunger:=20;
2450        exit;
2451       end;
2452      else
2453      if m_cur=1 then begin menu; exit; end;
2454     end;
2455
2456    draw;
2457
2458    drawfonttext('You died!',getwidth/2-32,getheight/2-16);
2459
2460    drw_btn('Respawn',0,m_cur,0,1);
2461    drw_btn('Main menu',1,m_cur,0,1);
2462
2463    drawVideo;
2464    delay(1);
2465   until false;
2466  end;
2467
2468 procedure fast_menu;
2469  var
2470   m_cur,i:integer;
2471  begin
2472   repeat
2473    updateKeys;
2474    if clickedKey(KEY_MENU_UP) then begin m_cur:=m_cur-1; if m_cur<0 then m_cur:=3; end;
2475    if clickedKey(KEY_MENU_DOWN) then begin m_cur:=m_cur+1; if m_cur>3 then m_cur:=0; end;
2476    if clickedKey(KEY_MENU_SELECT) then
2477     begin
2478      if m_cur=0 then
2479       begin
2480        exit;
2481       end; else
2482      if m_cur=1 then
2483       begin
2484        savegame('/'+sd+'/cavecraft/saves/'+sav_fl+'/');
2485        exit;
2486       end; else
2487      if m_cur=2 then
2488       begin
2489        menu_sett;
2490       end; else
2491      if m_cur=3 then
2492       begin
2493        //clear_gui(keymode);
2494        menu;
2495        exit;
2496       end;
2497     end;
2498    draw;
2499    drawfonttext('Game menu',getwidth/2-36,getheight/2-20);
2500    drw_btn('Back to Game',0,m_cur,0,1);
2501    drw_btn('Save Game',1,m_cur,0,1);
2502    drw_btn('Options',2,m_cur,0,1);
2503    drw_btn('Quit to Title',3,m_cur,0,1);
2504
2505    drawVideo;
2506    delay(1);
2507   until false;
2508  end;
2509
2510 procedure keyFastInv;
2511  begin
2512   if clickedKey(KEY_FASTINV_NEXT) then
2513    begin
2514     invslot:=invslot-1;
2515     if invslot<0 then
2516     invslot:=8;
2517    end;
2518
2519   if clickedKey(KEY_FASTINV_PREV) then
2520    begin
2521     invslot:=invslot+1;
2522     if invslot>8 then
2523      invslot:=0;
2524    end;
2525  end;
2526
2527 procedure keyConsole;
2528  begin
2529   if clickedKey(KEY_CHAT) then
2530    SetTimer(1000,T_CONSOLE);
2531
2532   if pressedKey(KEY_CHAT) then
2533    begin
2534     if GetTimer(T_CONSOLE)=TIMER_OK then
2535      begin
2536       call_console;
2537       ResetTimer(T_CONSOLE);
2538      end;
2539    end;
2540   else
2541    begin
2542     if GetTimer(T_CONSOLE)>TIMER_OK then
2543      begin
2544       deb:= not deb;
2545       ResetTimer(T_CONSOLE);
2546      end;
2547    end;
2548  end;
2549
2550 procedure keyInventory;
2551  begin
2552   if clickedKey(KEY_PLR_OPENINV) then
2553    if gamemode<>1 then
2554     OpenPlayerInventory;
2555    else
2556     OpenCreativeWindow;
2557  end;
2558
2559 procedure keyhandler;
2560  begin
2561   updateKeys;
2562
2563   if WindowKeyHanler then
2564    begin
2565     if keymode=0 then
2566      begin
2567       keyInventory;
2568       keyFastInv;
2569       keyConsole;
2570
2571       if clickedKey(KEY_PLR_EDITMODE) then
2572        begin
2573         keymode:=1;
2574         curx:=player.getX div 16;
2575         cury:=player.getY div 16;
2576        end;
2577
2578       if clickedKey(KEY_PLR_USE) then
2579        rt_usemob;
2580
2581       if clickedKey(KEY_MENU) then
2582        fast_menu;
2583
2584       if clickedKey(KEY_PLR_ATTACK) then
2585        if rt_useweap=false then
2586         debug('useweap');
2587
2588       if pressedKey(KEY_PLR_ATTACK) then
2589        begin
2590         rt_usetools;
2591         playAnim(ANIM_HAND);
2592        end;
2593       else
2594        begin
2595         resetToolProgerss;
2596         cancelAnim(ANIM_HAND);
2597        end;
2598
2599       if pressedKey(KEY_PLR_UP) then
2600        player.gotoUP;
2601       if pressedKey(KEY_PLR_DOWN) then
2602        player.gotoDOWN;
2603       if pressedKey(KEY_PLR_LEFT) then
2604        player.gotoLEFT;
2605       if pressedKey(KEY_PLR_RIGHT) then
2606        player.gotoRIGHT;
2607      end;
2608     else
2609     if keymode=1 then
2610      begin
2611       keyInventory;
2612       keyFastInv;
2613       keyConsole;
2614
2615       if clickedKey(KEY_PLR_UP) then
2616        begin
2617         cury:=cury-1;
2618         if cury<0 then
2619          cury:=0;
2620        end;
2621       if clickedKey(KEY_PLR_DOWN) then
2622        begin
2623         cury:=cury+1;
2624         if cury>127 then
2625          cury:=127;
2626        end;
2627       if clickedKey(KEY_PLR_LEFT) then
2628        begin
2629         curx:=curx-1;
2630         if curx<0 then
2631          curx:=0;
2632        end;
2633       if clickedKey(KEY_PLR_RIGHT) then
2634        begin
2635         curx:=curx+1;
2636         if curx>255 then
2637          curx:=255;
2638        end;
2639
2640       if clickedKey(KEY_PLR_EDITMODE) then
2641        keymode:=0;
2642
2643       if clickedKey(KEY_PLR_USE) then
2644        actionUse(invslot, curx, cury);
2645
2646       if pressedKey(KEY_PLR_ATTACK) then
2647        begin
2648         usetools(invslot, curx, cury);
2649         playAnim(ANIM_HAND);
2650        end;
2651       else
2652        begin
2653         resetToolProgerss;
2654         cancelAnim(ANIM_HAND);
2655        end;
2656
2657       if clickedKey(KEY_MENU) then
2658        fast_menu;
2659      end;
2660
2661    end;
2662
2663  end;
2664
2665 procedure phyhandler;
2666  var
2667   i:integer;
2668  begin
2669   Player.CalcPhysics;
2670   Mobs.UpdatePhy;
2671   Drop.CalcPhy;
2672  end;
2673
2674 procedure light_fillrect(l,x,y,r:integer);
2675  var
2676   ix,iy,ym,yp,xm,xp:integer;
2677  begin
2678   ym:=y-r;
2679   yp:=y+r;
2680   xm:=x-r;
2681   xp:=x+r;
2682   for ix:=xm to xp do
2683   for iy:=ym to yp do
2684    setmaplight(getmaplight(ix,iy)+l,ix,iy);
2685  end;
2686
2687 procedure light_rect(l,x,y,r:integer);
2688  var
2689   ix,iy,ym,yp,xm,xp:integer;
2690  begin
2691   ym:=y-r;
2692   yp:=y+r;
2693   xm:=x-r;
2694   xp:=x+r;
2695   for ix:=xm to xp do
2696    begin
2697     setmaplight(getmaplight(ix,ym)+l,ix,ym);
2698     setmaplight(getmaplight(ix,yp)+l,ix,yp);
2699    end;
2700   for iy:=ym+1 to yp-1 do
2701    begin
2702     setmaplight(getmaplight(xm,iy)+l,xm,iy);
2703     setmaplight(getmaplight(xp,iy)+l,xp,iy);
2704    end;
2705  end;
2706
2707 procedure calc_light(m,x,y:integer);
2708  var
2709   ix,iy,l,ss,sf:integer;
2710  begin
2711   if light_type=1 then light_fillrect(m,x,y,m/2); else
2712   for l:=m downto 1 do
2713    begin
2714     if ss mod 2=0 then light_rect(l,x,y,ss/2);
2715     ss:=ss+1;
2716    end;
2717  end;
2718
2719 procedure calc_sun(ix,m:integer);
2720  var
2721   iy,ss:integer;
2722  begin
2723   ss:=m;
2724   for iy:=0 to 127 do
2725    begin
2726     setmaplight(ss,ix,iy);
2727     if ss=0 then break;
2728     ss:=ss-getBlockTr(getmap(ix,iy));
2729     if ss<0 then ss:=0;
2730    end;
2731   for iy:=iy+1 to 127 do
2732    begin
2733     setmaplight(0,ix,iy);
2734    end;
2735  end;
2736
2737 procedure kill_plr;
2738  var
2739   i:integer;
2740  begin
2741  hp:=0;
2742  for i:=0 to INV_SIZE do
2743   begin
2744    if inv.isNull(i)=false then
2745     player.dropItem(inv.getItem(i), inv.getSum(i));
2746    inv.setItem(0, i);
2747    inv.setSum(0, i);
2748   end;
2749   if gamemode<2 then plr_is_dead; else plr_is_dead_hardcore;
2750  end;
2751
2752 procedure hunger_and_air;
2753  var
2754   x, y:integer;
2755  begin
2756   x:=player.getX;
2757   y:=player.getY;
2758    if gamemode<>1 then
2759     begin
2760      if getrelativetimems-hung_time>=90000/(gamemode+1) then
2761       begin
2762        hung_time:=getrelativetimems;
2763        hunger:=hunger-1;
2764       end;
2765      if getrelativetimems-hp_time>=5000*(gamemode+1) then
2766       begin
2767        if hunger>16 then
2768         begin
2769          hp_time:=getrelativetimems;
2770          hp:=hp+1;
2771          if hp>20 then hp:=20;
2772         end; else
2773        if hunger<1 then
2774         begin
2775          hp_time:=getrelativetimems;
2776          hp:=hp-1;
2777          if hp<1 then if gamemode<2 then hp:=1;
2778         end;
2779       end;
2780
2781      if getmap((x+4)/16,y/16)=50 then
2782       begin
2783        if getrelativetimems-air_time>=500 then
2784         begin
2785          air:=air-1;
2786          air_time:=getrelativetimems;
2787          if air<1 then
2788           begin
2789            hp_time:=getrelativetimems;
2790            hp:=hp-2;
2791           end;
2792         end;
2793       end; else
2794        air:=21;
2795     end;
2796  end;
2797
2798 procedure game;
2799  var
2800   ix,iy,minx,maxx,miny,maxy,fps_t,tim, x, y:integer;
2801  begin
2802   x:=player.getX;
2803   y:=player.getY;
2804
2805   hunger_and_air;
2806
2807   if hunger<0 then hunger:=0;
2808   if air<0 then air:=0;
2809
2810   fps_t:=fps;
2811   if fps_t<1 then fps_t:=1;
2812
2813     if bl_ani5_d then
2814      if bl_ani5_v=false then
2815       begin
2816        bl_ani5:=bl_ani5+1;
2817        if bl_ani5>4 then
2818         begin
2819          bl_ani5:=4;
2820          bl_ani5_v:=not bl_ani5_v;
2821         end;
2822       end;
2823      else
2824       begin
2825        bl_ani5:=bl_ani5-1;
2826        if bl_ani5<0 then
2827         begin
2828          bl_ani5:=0;
2829          bl_ani5_v:=not bl_ani5_v;
2830         end;
2831       end;
2832      bl_ani5_d:=not bl_ani5_d;
2833
2834   drop.reflux;
2835   player.getDrop;
2836
2837   game_time:=game_time+(600000 div (fps_t*1000));
2838
2839 // Ускорение игрового времени в 10 раз
2840 //  game_time := game_time + (600000 div (fps_t*100));
2841
2842   if (game_time>600000) or (game_time<0) then
2843    begin
2844     game_time:=0;
2845     moon_phase:=moon_phase+1;
2846     if moon_phase>7 then moon_phase:=0;
2847     load_moon('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/',moon_phase);
2848    end;
2849
2850   tim := 10000 * getimagewidth(sky) / 600000 * game_time / 10000;
2851   global_light := effects.get(sky, tim, 1, 1) div 16;
2852
2853   if clock_stage<>game_time div 75000 then begin clock_stage:=clock_stage+1; if clock_stage>7 then clock_stage:=0; end;
2854
2855   if x<0 then x:=0;
2856   if x+8>4094 then x:=4086;
2857   if getBlockColl(getmap(x div 16, y div 16))>0 then hp:=hp-1;
2858   if random(4096)=random(4096) then begin osadki:=not osadki; end;
2859   osadki_ani:=osadki_ani+1;
2860   if osadki_ani>7 then osadki_ani:=0;
2861
2862   if Random(20) = Random(20) then Particles.Create(Particles.bubble, x, y);
2863
2864   if gamemode=1 then begin hp:=666; hunger:=666; end;
2865
2866   if inv.getItem(invslot)=186 then
2867    ifminimap:=true;
2868   else
2869    ifminimap:=false;
2870
2871   //if s_spawn_mob then if random(4096)=1547 then megaspawn;
2872
2873   Mobs.Update;
2874   Particles.Update;
2875
2876   if light_type>0 then
2877    begin
2878     minx:=camx/16-1;
2879     maxx:=(camx+getWidth)/16+1;
2880     if minx<0 then minx:=0;
2881     if maxx>255 then maxx:=255;
2882     for ix:=minx to maxx do calc_sun(ix,global_light);
2883    end;
2884
2885   minx:=camx/16-8;
2886   maxx:=(camx+getWidth)/16+16;
2887   miny:=camy/16-8;
2888   maxy:=(camy+getHeight)/16+16;
2889   if minx<0 then minx:=0;
2890   if maxx>255 then maxx:=255;
2891   if miny<0 then miny:=0;
2892   if maxy>127 then maxy:=127;
2893   for ix:=minx to maxx do
2894   for iy:=miny to maxy do
2895    begin
2896     if light_type=0 then setmaplight(15,ix,iy);
2897      else
2898     if light_type>0 then if getBlockLi(getmap(ix,iy))>0 then calc_light(getBlockLi(getmap(ix,iy)),ix,iy);
2899    end;
2900
2901   minx:=(camx/16)-((getwidth/2)/16);
2902   miny:=(camy/16)-((getheight/2)/16);
2903   maxx:=(camx+(getWidth+getWidth/2))/16;
2904   maxy:=(camy+(getHeight+getHeight/2))/16;
2905   if minx<0 then minx:=0;
2906   if miny<0 then miny:=0;
2907   if maxx>255 then maxx:=255;
2908   if maxy>127 then maxy:=127;
2909   if updx<minx then updx:=minx;
2910   if updy<miny then updy:=miny;
2911   if updx>maxx then updx:=minx;
2912   if updy>maxy then updy:=miny;
2913
2914   if bl_upd>0 then
2915    begin
2916     for ix:=0 to (((2*getWidth/16)*(2*getHeight/16))-1) div ((fps_t*bl_upd)) do
2917      begin
2918       updateBlock(updx, updy);
2919       updx:=updx+1;
2920       if updx>maxx then
2921        begin
2922         updx:=minx;
2923         updy:=updy+1;
2924         if updy>maxy then updy:=miny;
2925        end;
2926      end;
2927    end;
2928
2929     {if coll_bl(110)=true then
2930      begin
2931       if getrelativetimems-portal_time>5000 then
2932        begin
2933         if pl_world=0 then begin go_to_nether; portal_time:=getrelativetimems; end; else
2934         if pl_world=1 then begin go_to_world; portal_time:=getrelativetimems; end;
2935        end;
2936      end;
2937
2938   if coll_bl(51)=true then hp:=hp-1;
2939
2940   if coll_bl(59)=true then
2941    begin
2942     if vely<0 then vely:=-1;
2943      else
2944     if vely>0 then vely:=1;
2945    end;}
2946
2947   if gamemode<>1 then
2948    begin
2949     if hp>20 then hp:=20;
2950     if hunger>20 then hunger:=20;
2951    end;
2952
2953   if y>2048 then kill_plr;
2954   if (hp<1) and (gamemode<>1) then kill_plr;
2955   if fish=true then fishing;
2956
2957   if (fish=true) and (inv.getItem(invslot)<>152) then fish:=false;
2958
2959   //if (keymode>3) and (cury<(y div 16)-4) then begin clear_gui(keymode); keymode:=0; curx:=x div 16; cury:=y div 16; end;
2960
2961   if gamemode<>1 then
2962    begin
2963     if cury<(y div 16)-4 then cury:=(y div 16)-4;
2964     if cury>(y div 16)+5 then cury:=(y div 16)+5;
2965     if curx<(x div 16)-4 then curx:=(x div 16)-4;
2966     if curx>(x div 16)+4 then curx:=(x div 16)+4;
2967    end;
2968
2969   UpdateFurnaces;
2970  end;
2971
2972 procedure qt_start;
2973  var
2974   i:integer;
2975  begin
2976   drawgui:=true;
2977   LoadDrawFont('/'+sd+'/cavecraft/texturepacks/'+tex_pack+'/');
2978   drawdeadlogo;
2979   start_uu;
2980   if load_key_tex=1 then init_touch;
2981   for i:=0 to 4 do
2982    begin
2983     msg[i]:='';
2984     msg_time[i]:=getrelativetimems;
2985    end;
2986   InitMap(MAP_W, MAP_H);
2987   menu;
2988  end;
2989
2990 procedure draw_debug;
2991   var
2992     i : Integer;
2993   begin
2994     //drawfonttext('X:'+(x div 16-128),0,0);
2995     //drawfonttext('Y:'+integertostring(127-(y div 16)),0,8);
2996     drawfonttext('CURX:'+(curx-128),0,16);
2997     drawfonttext('CURY:'+cury,0,24);
2998     drawfonttext('UPDX:'+updx,0,32);
2999     drawfonttext('UPDY:'+updy,0,40);
3000     drawfonttext('FPS:'+fps,0,56);
3001     drawfonttext('Free RAM:'+free_ram/1024+' KB',0,64);
3002     drawfonttext('Total RAM:'+memory.get_totalmemory div 1024+' KB',0,72);
3003     drawfonttext('SEED:'+seed,0,88);
3004     drawfonttext('Game time:'+game_time,0,96);
3005     drawfonttext('Global light:' + global_light, 0, 104);
3006
3007     for i := 0 to 15 do
3008       drawImage(light[i], getWidth - 16, 16 * i);
3009   end;
3010
3011 begin
3012  qt_start;
3013  hung_time:=getrelativetimems;
3014  hp_time:=getrelativetimems;
3015  air_time:=getrelativetimems;
3016  portal_time:=getrelativetimems;
3017  repeat
3018   proc_fps;
3019   keyhandler;
3020   phyhandler;
3021   game;
3022   draw;
3023   drawfonttext(version,getWidth-(length(version)*8),getHeight-8);
3024   if getrelativetimems-msg_time[4]>500 then begin free_ram:=memory.get_freememory; if free_ram<0 then free_ram:=-free_ram; msg_time[4]:=getrelativetimems; end;
3025   if deb = true then
3026     draw_debug;
3027
3028   drawVideo;
3029   maxfps;
3030
3031  until false;
3032 end.