DEADSOFTWARE

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