d6fb2f37431ba2a338b4a21739727ee181e79929
14 s_jpeg_quality
:integer;
19 //s_particles:boolean; - module
23 load_back_tex
:boolean;
24 load_weather_tex
:boolean;
25 load_particles_tex
:boolean;
26 load_light_tex
:boolean;
29 menu_background
:integer;
31 load_minimap_tex
:boolean;
33 //load_key_tex:integer;
41 //max_particles:integer; - module
43 procedure save_settings
;
44 procedure load_settings
;
45 procedure call_console
;
46 procedure exec(s
, search
:string; acces
:boolean);
47 procedure addToLog(str
:string);
50 uses keyboard
,particles_store
,vars
,maps
,items
,canvas
,mob
,worldgen
,jsr75i
,particles
,func
, player
,sensor
, drop
, inv
, furnace
, items_store
, video
;
56 logSTR
: array [0..CON_LOG_SIZE
] of string;
60 EOFstr
, ENDstr
:boolean;
62 stack
: array [0..0] of integer;
63 stack_pointer
:integer;
65 autoexec_acces
:boolean;
68 procedure resetStack(size
:integer);
75 putstatic field
'console', 'stack', '[I';
79 procedure pushStack(i
:integer;);
81 stack
[stack_pointer
]:=i
;
82 stack_pointer
:=stack_pointer
+1;
85 function popStack
:integer;
87 stack_pointer
:=stack_pointer
-1;
88 popStack
:=stack
[stack_pointer
];
95 tmp
:=stack
[stack_pointer
-2];
96 stack
[stack_pointer
-2]:=stack
[stack_pointer
-1];
97 stack
[stack_pointer
-1]:=tmp
;
102 stack
[stack_pointer
]:=stack
[stack_pointer
-1];
103 stack_pointer
:=stack_pointer
+1;
106 procedure resetTmpImg
;
113 procedure addToLog(str
:string);
118 for i
:=CON_LOG_SIZE
-1 downto 0 do
119 logSTR
[i
+1]:=logSTR
[i
];
123 procedure setTexture(img
:image
; name
:string; i
:integer);
129 tex8
[i
]:=resize_image(img
, 8, 8);
135 item8
[i
]:=resize_image(img
, 8, 8);
141 addToLog('Error: unknown texture type "'+name
+'"');
144 procedure save_settings
;
149 deleteRecordStore('S');
150 rs
:=openRecordStore('S');
151 t
:=addRecordStoreEntry(rs
,version
);
152 t
:=addRecordStoreEntry(rs
,''+light_type
);
153 t
:=addRecordStoreEntry(rs
,''+ifosad
);
154 t
:=addRecordStoreEntry(rs
,''+s_particles
);
155 t
:=addRecordStoreEntry(rs
,''+drawgui
);
156 t
:=addRecordStoreEntry(rs
,''+s_jpeg_quality
);
157 t
:=addRecordStoreEntry(rs
,''+load_key_tex
);
158 closeRecordStore(rs
);
161 function sett_ld_bool(s
:string):boolean;
163 if s
='true' then sett_ld_bool
:=true;
166 procedure load_settings
;
170 rs
:=openRecordStore('S');
171 if readRecordStoreEntry(rs
,1)<>version
then
173 debug(readRecordStoreEntry(rs
,1));
174 closeRecordStore(rs
);
177 light_type
:=stringtointeger(readRecordStoreEntry(rs
,2));
178 ifosad
:=sett_ld_bool(readRecordStoreEntry(rs
,3));
179 s_particles
:=sett_ld_bool(readRecordStoreEntry(rs
,4));
180 drawgui
:=sett_ld_bool(readRecordStoreEntry(rs
,5));
181 s_jpeg_quality
:=stringtointeger(readRecordStoreEntry(rs
,6));
182 load_key_tex
:=stringtointeger(readRecordStoreEntry(rs
,7));
183 closeRecordStore(rs
);
186 function isEOS(c
:integer):boolean;
191 if (ch
=#
$0A) or (ch
=#
$0D) then
195 function isSpace(c
:integer;):boolean;
200 if ((ch
=' ') or (ch
=#
$09) or (ch
=#
$0B) or isEOS(c
)) then
204 function nextByte(res
:resource
):integer;
217 function ReadString(res
:resource
):string;
225 if EOFstr
or ENDstr
then
228 tmpstr
:=tmpstr
+chr(b
);
233 function nextChar
:integer;
238 if length(parseStr
)>0 then
240 i
:=ord(getChar(parseStr
, 0));
241 parseStr
:=copy(parseStr
, 1, length(parseStr
));
254 procedure clearSpaces
;
263 {Symbol ';' is one line commentary}
273 if isSpace(i
)=false then
276 parseStr
:=chr(i
)+parseStr
;
282 function nextWord
:string;
301 parseStr
:=chr(i
)+parseStr
;
310 function strToBool(str
:string):boolean;
319 if StringToInteger(str
)<>0 then
325 //Перевод строки в целое число. base - система счисления
326 function Str2Dec(str
:string; base
:integer;):integer;
333 if GetChar(str
, 0)='-' then
339 for i
:=i
to length(str
)-1 do
342 if ((ch
>='0') and (ch
<='9')) then
345 if ((ch
>='A') and (ch
<=chr($36+base
))) then
349 addToLog('Error! I cant decode "'+str
+'" -> "'+ch
+'"');
363 function getVar(name
:string):integer;
367 if name
='SCREEN_W' then
370 if name
='SCREEN_H' then
373 addToLog('Unknown variable "'+name
+'"');
376 procedure setVar(name
:string; value
:integer);
380 addToLog('I cant set variable "'+name
+'"');
383 function DecodeInt(str
:string):integer;
390 addToLog('DecodeInt getted null string!');
396 head
:=getchar(str
, 0);
397 num
:=copy(str
, 1, length(str
));
409 DecodeInt
:=getVar(num
);
411 if (head
='0') and (getchar(str
, 1)='X') then
413 DecodeInt
:=Str2Dec(copy(str
, 2, length(str
)), 16);
416 if (head
='0') and (length(str
)>1) then
418 DecodeInt
:=Str2Dec(num
, 8);
423 DecodeInt
:=Str2Dec(num
, 2);
426 if ((head
>='0') and (head
<='9')) or (head
='-') then
428 DecodeInt
:=Str2Dec(str
, 10);
432 addToLog('Error! I cant decode "'+str
+'"');
435 procedure exeCommand(str
:string);
437 com
, tmp
, tmp2
:string;
445 com
:=UpCase(nextWord
);
447 if (cheats
) or (autoexec_acces
) or (gamemode
=1) then
450 game_time
:=decodeInt(nextWord
);
453 fly
:=strToBool(nextWord
);
456 hp
:=decodeInt(nextWord
);
459 hunger
:=decodeInt(nextWord
);
462 player
.dropItem(decodeInt(nextWord
), decodeInt(nextWord
));
466 player
.setX(decodeInt(nextWord
));
467 player
.setY(decodeInt(nextWord
));
470 if com
='GAMEMODE' then
472 gamemode
:=decodeInt(nextWord
);
476 {if com='KILL_MOBS' then
485 player
.setX(get_spawn_x
*16+4);
486 player
.setY(get_spawn_y
*16);
489 {if com='SPAWN_MOBS' then
490 s_spawn_mob:=strToBool(nextWord);
492 {if com='SURVIVAL' then
505 if com
='CLEAR_INVENTORY' then
513 if com
='I_AM_CHEATER' then
515 if nextWord
=#
$36+#
$36+#
$36 then
524 if com
='WEATHER' then
525 osadki
:=strToBool(nextWord
);
527 {if com='MEGASPAWN' then
530 if com
='REF_DRP' then
531 ref_drp
:=strToBool(nextWord
);
534 bl_upd
:=decodeInt(nextWord
);
536 if com
='GET_DRP' then
537 s_get_drp
:=strToBool(nextWord
);
539 {if com='AI_UPD' then
540 ai_upd:=strToBool(nextWord);
542 if com
='PRT_UPD' then
543 particle_upd
:=strToBool(nextWord
);
545 if com
='MAX_FPS' then
546 s_max_fps
:=decodeInt(nextWord
); else
547 if com
='DRW_BACK' then
548 drw_back
:=strToBool(nextWord
);
550 {if com='DRW_MOBS' then
551 drw_mobs:=strToBool(nextWord);
553 if com
='DRP_PHY' then
554 drp_phy
:=strToBool(nextWord
);
557 drw_sm
:=strToBool(nextWord
);
561 s_jpeg_quality
:=decodeInt(nextWord
);
562 if s_jpeg_quality
>100 then
564 else if s_jpeg_quality
<0 then
568 if com
='LOAD_SM' then
569 load_sm
:=decodeInt(nextWord
);
571 if com
='S_WEATHER' then
572 ifosad
:=strToBool(nextWord
);
574 if com
='S_HIDE_GUI' then
575 drawgui
:=strToBool(nextWord
);
577 if com
='S_LIGHT' then
578 light_type
:=decodeInt(nextWord
);
580 if com
='S_PARTICLES' then
581 s_particles
:=strToBool(nextWord
);
583 if com
='LOAD_SKY' then
584 load_sky_siz
:=decodeInt(nextWord
);
586 {if com='LOAD_MOB_TEX' then
587 load_mob_tex:=strToBool(nextWord);
589 if com
='LOAD_BACK_TEX' then
590 load_back_tex
:=strToBool(nextWord
);
592 if com
='LOAD_WEATHER_TEX' then
593 load_weather_tex
:=strToBool(nextWord
);
595 if com
='LOAD_PARTICLES_TEX' then
596 load_particles_tex
:=strToBool(nextWord
);
598 if com
='LOAD_LIGHT_TEX' then
599 load_light_tex
:=strToBool(nextWord
);
601 if com
='LOAD_GUI_TEX' then
602 load_gui_tex
:=strToBool(nextWord
);
604 if com
='MENU_BACKGROUND' then
605 menu_background
:=decodeInt(nextWord
);
607 if com
='DRW_DRP' then
608 drw_drp
:=strToBool(nextWord
);
610 if com
='DRW_STARS' then
611 drw_stars
:=strToBool(nextWord
);
613 if com
='SV_SETT' then
616 if com
='LD_SETT' then
619 if com
='LOAD_MINIMAP_TEX' then
620 load_minimap_tex
:=strToBool(nextWord
);
622 if com
='MAX_PARTICLES' then
624 max_particles
:=decodeInt(nextWord
);
625 reset_particles(max_particles
+1);
631 exec(nextWord
, tmp
, autoexec_acces
);
634 if com
='RESET_ITEMS' then
636 resetItems(decodeInt(nextWord
)+1);
637 //addToLog('Max items: '+decodeInt(parsed_str[1]));
640 if com
='SET_ITEM' then
642 setItemData(decodeInt(nextWord
),
647 decodeInt(nextWord
));
650 if com
='RESET_BLOCKS' then
652 resetBlocks(decodeInt(nextWord
)+1);
653 //addToLog('Max blocks: '+decodeInt(parsed_str[1]));
656 if com
='SET_BLOCK' then
658 setBlockData(decodeInt(nextWord
),
666 decodeInt(nextWord
));
669 if com
='RESET_TOOLS' then
671 resetTools(decodeInt(nextWord
)+1);
672 //addToLog('Max tools: '+decodeInt(parsed_str[1]));
675 if com
='SET_TOOL' then
677 setToolData(decodeInt(nextWord
),
681 decodeInt(nextWord
));
684 if com
='RESET_FUELS' then
686 furnace
.setMaxFuel(decodeInt(nextWord
));
687 //addToLog('Max fuel: '+decodeInt(parsed_str[1]));
690 if com
='SET_FUEL' then
692 furnace
.initFuel(decodeInt(nextWord
),
694 decodeInt(nextWord
));
697 if com
='RESET_RECIPES' then
699 furnace
.setMaxRecipes(decodeInt(nextWord
));
700 //addToLog('Max recipes: '+decodeInt(parsed_str[1]));
703 if com
='SET_RECIPE' then
705 furnace
.initRecipe(decodeInt(nextWord
),
707 decodeInt(nextWord
));
710 if com
='RESET_CRAFTS' then
712 resetCrafts(decodeInt(nextWord
));
713 //addToLog('Max crafts: '+decodeInt(parsed_str[1]));
716 if com
='SET_CRAFT_IN' then
718 setCraftIn(decodeInt(nextWord
),
721 decodeInt(nextWord
));
724 if com
='SET_CRAFT_OUT' then
726 setCraftOUT(decodeInt(nextWord
),
729 decodeInt(nextWord
));
732 if com
='RESET_BLOCKS_TEX' then
734 initBlockTex(decodeInt(nextWord
));
737 if com
='RESET_ITEMS_TEX' then
739 initItemTex(decodeInt(nextWord
));
742 if com
='LOAD_TEX' then
743 regimg
:=ld_tex(nextWord
, '/'+sd
+'/cavecraft/', '');
745 if com
='RESET_TEX' then
748 if com
='SET_TEX' then
751 decodeInt(nextWord
));
752 if com
='SET_CANV_TEX' then
756 setTexture(rotate_image_from_image(regimg
,
766 if com
='SET_MAX_ITEM_LIST' then
767 setMaxItemList(decodeInt(nextWord
));
769 if com
='SET_ITEM_LIST' then
770 setItemList(decodeInt(nextWord
),
771 decodeInt(nextWord
));
773 if com
='BIND_KEY' then
776 for i
:=0 to MAX_KEY_BIND
do
777 keyboard
.bindKey(decodeInt(tmp
), i
, decodeInt(nextWord
));
781 resetStack(decodeInt(nextWord
));
784 pushStack(decodeInt(nextWord
));
796 pushStack(popStack
+popStack
);
801 pushStack(popStack
-i
);
805 pushStack(popStack
*popStack
);
810 pushStack(popStack
/i
);
816 pushStack(popStack
mod i
);
820 setVar(nextWord
, decodeInt(nextWord
));
823 setVar(nextWord
, popStack
);
825 if com
='MAX_VKEYS' then
826 resetVirtualKeyboard(decodeInt(nextWord
));
828 if com
='SET_VKEY' then
829 bindVKey(decodeInt(nextWord
),
832 decodeInt(nextWord
));
834 if com
='SET_RESOLUTION' then
835 initVideo(decodeInt(nextWord
), decodeInt(nextWord
), strToBool(nextWord
));
837 //addToLog('Unknown command "'+com+'"');
840 procedure call_console
;
844 exitCmd
, exeCmd
, Clicked
:command
;
848 setFont(FONT_FACE_SYSTEM
,FONT_STYLE_PLAIN
,FONT_SIZE_SMALL
);
853 exitCmd
:=createCommand('Exit', CM_EXIT
, 1);
854 exeCmd
:=createCommand('Execute', CM_OK
, 1);
858 commandTxt
:=formAddTextField('Enter command:', ''+lastCommand
, 32, TF_ANY
);
860 for i
:=0 to CON_LOG_SIZE
do
861 tmpid
:=formAddString(logSTR
[i
]+chr(10));
867 Clicked
:=getClickedCommand
;
868 if Clicked
=exitCmd
then
870 lastCommand
:=formGetText(commandTxt
);
875 if Clicked
=exeCmd
then
877 str
:=formGetText(commandTxt
);
887 procedure exec(s
, search
:string; acces
:boolean);
891 tmp_acces
, tmpEOF
:boolean;
893 tmp_acces
:=autoexec_acces
;
894 autoexec_acces
:=acces
;
896 search
:=UpCase(search
);
898 if search
='LOCAL' then
900 addToLog('Load file "'+s
+'" at LOCAL!');
901 res
:=OpenResource('/'+s
);
906 if open_file('/'+sd
+'/cavecraft/'+s
)=1 then
908 addToLog('Load file "'+s
+'" at SD!');
913 if search
='AUTO' then
915 addToLog('path "/'+sd
+'/cavecraft/'+s
+'"');
916 if file_exists('/'+sd
+'/cavecraft/'+s
)=1 then
918 if open_file('/'+sd
+'/cavecraft/'+s
)=1 then
920 addToLog('Load file "'+s
+'" at SD(AUTO)!');
926 addToLog('Load file "'+s
+'" at LOCAL(AUTO)!');
927 res
:=OpenResource('/'+s
);
932 addToLog('Unknown load type "'+search
+'", file "'+s
+'" not executed!');
933 autoexec_acces
:=tmp_acces
;
937 if ResourceAvailable(res
) then
939 str
:=ReadString(res
);
941 //addToLog('Exec: "'+str+'"');
946 addToLog('Execute file "'+s
+'" not found!');
949 autoexec_acces
:=tmp_acces
;