DEADSOFTWARE

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