DEADSOFTWARE

Remove ascii crap
[cavecraft.git] / src / CAVE.mpsrc
1 program CAVE;
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;
37 const
38 version_map = 9;
40 var
41 keymode,updx,updy:integer;
42 seed,nextseed:integer;
43 free_ram:real;
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;
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;
64 msg:array [0..4] of string;
65 msg_time:array[0..4] of integer;
66 last_sleep_x,last_sleep_y:integer;
68 ifminimap:boolean;
69 gt:integer;
71 del,dt,time:integer;
73 deb:boolean;
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;
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;
99 procedure proc_fps;
100 begin
101 dt:=GetRelativeTimeMs - time;
102 time:=GetRelativeTimeMs;
103 fps:=1000/dt;
104 end;
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;
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;
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;
136 for ix := 0 to 8 do
137 back[ix]:=no;
139 player.freeSkin;
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;
150 for ix := 0 to 15 do
151 light[ix] := no;
153 Particles.FreeTextures;
154 Mobs.FreeTextures;
156 sky := no;
157 sun := no;
158 moon := no;
159 sign_im := no;
161 for ix := 0 to CONST_MAX_CURS do
162 LoadCurImg(no, ix);
164 //resetVirtualKeyboard(-1);
165 end;
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;
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;
201 console.exec('textures.cfg', 'AUTO');
203 Player.LoadSkin('char_ani.png', path);
204 Mobs.LoadTextures(path);
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);
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
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
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
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);
235 if load_minimap_tex then gui[16]:=ld_tex('mapbg.png',path,'gui/');
237 for ix:=0 to 9 do tue[ix]:=rotate_image_from_image(im,16*ix,40,16,16,0);
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;
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;
253 Particles.LoadTextures(path);
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);
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);
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;
275 //load_virt_tex(ld_tex('touch.png',path,'gui/'));
276 end;
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;
292 camx:=0;
293 camy:=0;
294 curx:=0;
295 cury:=0;
297 player.setX(0);
298 player.setY(0);
299 last_sleep_x:=0;
300 last_sleep_y:=0;
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;
314 osadki:=false;
316 //anim_del2:=0;
318 Inv.ResetData;
319 Chest.ResetData;
320 Furnace.ResetData;
321 Drop.ResetData;
322 Mobs.ResetData;
323 Particles.ResetData;
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;
337 for ix:=0 to 31 do
338 begin
339 b_sign[ix]:=false;
340 t_sign[ix]:='';
341 end;
343 for ix:=0 to CONST_MAX_LAYERS do
344 ClearLayer(ix);
345 end;
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;
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;
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;
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;
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;
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;
410 write_byte(id);
411 write_byte(s-1);
413 i:=i+s;
414 until i>32767;
415 end;
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;
428 write_byte(id);
429 write_byte(s-1);
431 i:=i+s;
432 until i>32767;
433 end;
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);
446 i:=i+s+1;
447 until i>32767;
448 end;
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);
461 i:=i+s+1;
462 until i>32767;
463 end;
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;
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;
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;
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;
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;
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;
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;
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;
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('www.deadsoftware.ru',getWidth/2-80,(getHeight/2)+(getimageheight(dead)/2));
692 drawfonttext('Loading...',(getWidth/2)-(40),getHeight-8);
693 drawVideo;
694 delay(500);
695 end;
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;
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;
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;
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;
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;
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;
818 for ix:=0 to getWidth/16 do
819 for iy:=0 to getHeight/16 do
820 drawimage(im,ix*16,iy*16);
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);
831 drawVideo;
832 delay(1);
833 until false;
834 end;
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;
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];
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;
932 for ix:=0 to getWidth/16 do
933 for iy:=0 to getHeight/16 do
934 drawimage(im,ix*16,iy*16);
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);
945 drawVideo;
946 delay(1);
948 until false;
949 end;
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!');
964 if file_exists('/'+sd+'/cavecraft/saves')<>1 then
965 if create_folder('/'+sd+'/cavecraft/saves')=1 then debug('/saves created!');
967 if file_exists('/'+sd+'/cavecraft/screenshots')<>1 then
968 if create_folder('/'+sd+'/cavecraft/screenshots')=1 then debug('/screenshots created!');
970 if file_exists('/'+sd+'/cavecraft/texturepacks')<>1 then
971 if create_folder('/'+sd+'/cavecraft/texturepacks')=1 then debug('/texturepacks created!');
973 deleteRecordStore('SD');
974 rs:=openRecordStore('SD');
975 t:=addRecordStoreEntry(rs,sd);
976 closeRecordStore(rs);
977 end;
978 end;
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;
1002 if file_exists('/'+sd+'/cavecraft')<>1 then
1003 if create_folder('/'+sd+'/cavecraft')=1 then debug('/cavecraft created!');
1005 if file_exists('/'+sd+'/cavecraft/saves')<>1 then
1006 if create_folder('/'+sd+'/cavecraft/saves')=1 then debug('/saves created!');
1008 if file_exists('/'+sd+'/cavecraft/screenshots')<>1 then
1009 if create_folder('/'+sd+'/cavecraft/screenshots')=1 then debug('/screenshots created!');
1011 if file_exists('/'+sd+'/cavecraft/texturepacks')<>1 then
1012 if create_folder('/'+sd+'/cavecraft/texturepacks')=1 then debug('/texturepacks created!');
1014 rs:=openRecordStore('TX');
1015 ss:=readRecordStoreEntry(rs,1);
1016 closeRecordStore(rs);
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;
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;
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);
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);
1137 drawVideo;
1138 delay(1);
1139 until false;
1140 end;
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;
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+'/','');
1173 if file_exists('/'+sd+'/cavecraft/saves/'+names[cur_name]+'/player.dat')=1 then
1174 mm_t_b:=true; else mm_t_b:=false;
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;
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+'/','');
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+'/','');
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;
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);
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;
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;
1290 drawVideo;
1291 delay(1);
1292 until false;
1293 end;
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');
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;
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);
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;
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);
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;
1396 drw_btn('Done',0,m_cur,32,1);
1397 drw_btn('Back',1,m_cur,32,1);
1399 drawVideo;
1400 delay(1);
1401 until false;
1402 end;
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;
1482 for ix:=0 to getWidth/16 do
1483 for iy:=0 to getHeight/16 do
1484 drawimage(bg[0],ix*16,iy*16);
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);
1496 drawVideo;
1497 delay(1);
1498 until false;
1499 end;
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;
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);
1515 for ix:=0 to getWidth/16 do
1516 for iy:=0 to 1 do
1517 drawimage(bg[0],ix*16,iy*16);
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);
1523 setclip(0,32,getWidth,(getHeight/16-4)*16);
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);
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);
1545 setclip(0,0,getWidth,getHeight);
1547 drw_btn('Back',0,0,getHeight-getHeight/2-16-6,1);
1549 drawVideo;
1550 delay(1);
1551 until false;
1552 end;
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;
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);
1568 for ix:=0 to getWidth/16 do
1569 for iy:=0 to 1 do
1570 drawimage(bg[0],ix*16,iy*16);
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);
1576 setclip(0,32,getWidth,(getHeight/16-4)*16);
1578 drw_txt('Developers:',cur,0,1);
1579 drw_txt('DeaDDooMER - Programmer',cur,1,0);
1580 drw_txt('fred-boy - Programmer',cur,2,0);
1581 drw_txt('Andrey59 - Programmer',cur,3,0);
1582 drw_txt('YuRaNnNzZZ - Artist',cur,4,0);
1583 drw_txt('SashaG - Artist and idea generator',cur,5,0);
1584 drw_txt('BaJleHTiH - Artist and tester',cur,6,0);
1585 drw_txt('AgressoR - Tester',cur,7,0);
1586 drw_txt('volya - Tester',cur,8,0);
1587 drw_txt('abadon - Tester',cur,9,0);
1588 drw_txt('Monogrom - Tester',cur,10,0);
1589 drw_txt('Kalter - Tester',cur,11,0);
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);
1599 drw_txt('Site: www.deadsoftware.ru',cur,21,0);
1600 drw_txt('DeaDSoftWare 2012-2014',cur,22,0);
1602 drw_txt('Hello! :D',cur,100,1);
1604 setclip(0,0,getWidth,getHeight);
1606 drw_btn('Back',0,0,getHeight-getHeight/2-16-6,1);
1608 drawVideo;
1609 delay(1);
1610 until false;
1611 end;
1613 function sm_siz:integer;
1614 begin
1615 sm_siz:=(getWidth+getHeight)/5;
1616 end;
1618 function sm_siz4:integer;
1619 begin
1620 sm_siz4:=sm_siz/4;
1621 end;
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;
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;
1689 draw_menu_back;
1691 drawimage(cavelogo,(getWidth/2)-(getimagewidth(cavelogo)/2),0);
1692 setcolor(255,255,0);
1694 DrawFontTextSpec(splash, (getWidth/2)-(length(splash)*FONT_SYM_SIZE/2), spl_y, FONT_YELLOW_COLOR, true);
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);
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);
1707 drawVideo;
1708 maxfps;
1709 until false;
1710 end;
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);
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
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;
1735 setBlock:=true;
1736 end;
1737 end;
1738 end;
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;
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;
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;
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;
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);
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;
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;
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;
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;
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;
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;
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;
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;
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);
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;
2002 // debug
2003 // drawimage(light[getmaplight(player.getX div 16, player.getY div 16)], 0, 0);
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);
2016 if keymode=1 then
2017 drawimage(gui[0],curx*16-camx,cury*16-camy);
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;*/
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);
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;
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);
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;
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;
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;
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;
2156 procedure resetToolProgerss;
2157 begin
2158 toolus:=0;
2159 toolind:=0;
2160 end;
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);
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;
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;
2192 if Items.GetType(item) = Items.tool then begin
2193 Inv.SetSum(Inv.GetSum(invcur) - 1, invcur);
2194 Inv.FixNull(invcur);
2195 end;
2197 toolus:=0;
2198 toolind:=0;
2199 end;
2200 end;
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;
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;
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);
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;
2229 procedure rt_usetools;
2230 var
2231 x, y:integer;
2232 begin
2233 x:=player.getX;
2234 y:=player.getY;
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;
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;
2245 usetools(invslot, curx, cury);
2246 end;
2248 procedure rt_usemob;
2249 var
2250 x, y:integer;
2251 begin
2252 x:=player.getX;
2253 y:=player.getY;
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;
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;
2264 //usemob(curx,cury);
2265 end;
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;
2274 procedure rt_useblock;
2275 var
2276 x, y:integer;
2277 begin
2278 x:=player.getX;
2279 y:=player.getY;
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;
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;
2290 actionUse(invslot, curx, cury);
2291 end;
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;}
2325 drop.resetData;
2326 gennether;
2327 //netherspawn;
2328 end;
2329 end;
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;
2350 procedure plr_is_dead_hardcore;
2351 begin
2352 keymode:=0;
2353 toolus:=0;
2354 toolind:=0;
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);
2367 drw_btn('Delete world',0,0,0,1);
2369 drawVideo;
2370 delay(1);
2371 until false;
2373 end;
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;
2441 draw;
2443 drawfonttext('You died!',getwidth/2-32,getheight/2-16);
2445 drw_btn('Respawn',0,m_cur,0,1);
2446 drw_btn('Main menu',1,m_cur,0,1);
2448 drawVideo;
2449 delay(1);
2450 until false;
2451 end;
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);
2490 drawVideo;
2491 delay(1);
2492 until false;
2493 end;
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;
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;
2512 procedure keyConsole;
2513 begin
2514 if clickedKey(KEY_CHAT) then
2515 SetTimer(1000,T_CONSOLE);
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;
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;
2544 procedure keyhandler;
2545 begin
2546 updateKeys;
2548 if WindowKeyHanler then
2549 begin
2550 if keymode=0 then
2551 begin
2552 keyInventory;
2553 keyFastInv;
2554 keyConsole;
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;
2563 if clickedKey(KEY_PLR_USE) then
2564 rt_usemob;
2566 if clickedKey(KEY_MENU) then
2567 fast_menu;
2569 if clickedKey(KEY_PLR_ATTACK) then
2570 if rt_useweap=false then
2571 debug('useweap');
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;
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;
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;
2625 if clickedKey(KEY_PLR_EDITMODE) then
2626 keymode:=0;
2628 if clickedKey(KEY_PLR_USE) then
2629 actionUse(invslot, curx, cury);
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;
2642 if clickedKey(KEY_MENU) then
2643 fast_menu;
2644 end;
2646 end;
2648 end;
2650 procedure phyhandler;
2651 var
2652 i:integer;
2653 begin
2654 Player.CalcPhysics;
2655 Mobs.UpdatePhy;
2656 Drop.CalcPhy;
2657 end;
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;
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;
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;
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;
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;
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;
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;
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;
2790 hunger_and_air;
2792 if hunger<0 then hunger:=0;
2793 if air<0 then air:=0;
2795 fps_t:=fps;
2796 if fps_t<1 then fps_t:=1;
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;
2819 drop.reflux;
2820 player.getDrop;
2822 game_time:=game_time+(600000 div (fps_t*1000));
2824 // Ускорение игрового времени в 10 раз
2825 // game_time := game_time + (600000 div (fps_t*100));
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;
2835 tim := 10000 * getimagewidth(sky) / 600000 * game_time / 10000;
2836 global_light := effects.get(sky, tim, 1, 1) div 16;
2838 if clock_stage<>game_time div 75000 then begin clock_stage:=clock_stage+1; if clock_stage>7 then clock_stage:=0; end;
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;
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;
2848 if Random(20) = Random(20) then Particles.Create(Particles.bubble, x, y);
2850 if gamemode=1 then begin hp:=666; hunger:=666; end;
2852 if inv.getItem(invslot)=186 then
2853 ifminimap:=true;
2854 else