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