5 version
= 'BETA 9 DEV B12';
15 s_jpeg_quality
:integer;
20 //s_particles:boolean; - module
24 load_back_tex
:boolean;
25 load_weather_tex
:boolean;
26 load_particles_tex
:boolean;
27 load_light_tex
:boolean;
30 menu_background
:integer;
32 load_minimap_tex
:boolean;
34 //load_key_tex:integer;
42 //max_particles:integer; - module
44 procedure save_settings
;
45 procedure load_settings
;
46 procedure call_console
;
47 procedure exec(s
, search
:string; acces
:boolean);
48 procedure addToLog(str
:string);
51 uses keyboard
,particles_store
,vars
,maps
,items
,canvas
,mob
,worldgen
,jsr75i
,particles
,func
, player
,sensor
, drop
, inv
, furnace
, items_store
, video
;
57 logSTR
: array [0..CON_LOG_SIZE
] of string;
61 EOFstr
, ENDstr
:boolean;
63 stack
: array [0..0] of integer;
64 stack_pointer
:integer;
66 autoexec_acces
:boolean;
69 procedure resetStack(size
:integer);
76 putstatic field
'console', 'stack', '[I';
80 procedure pushStack(i
:integer;);
82 stack
[stack_pointer
]:=i
;
83 stack_pointer
:=stack_pointer
+1;
86 function popStack
:integer;
88 stack_pointer
:=stack_pointer
-1;
89 popStack
:=stack
[stack_pointer
];
96 tmp
:=stack
[stack_pointer
-2];
97 stack
[stack_pointer
-2]:=stack
[stack_pointer
-1];
98 stack
[stack_pointer
-1]:=tmp
;
103 stack
[stack_pointer
]:=stack
[stack_pointer
-1];
104 stack_pointer
:=stack_pointer
+1;
107 procedure resetTmpImg
;
114 procedure addToLog(str
:string);
119 for i
:=CON_LOG_SIZE
-1 downto 0 do
120 logSTR
[i
+1]:=logSTR
[i
];
124 procedure setTexture(img
:image
; name
:string; i
:integer);
130 tex8
[i
]:=resize_image(img
, 8, 8);
136 item8
[i
]:=resize_image(img
, 8, 8);
142 addToLog('Error: unknown texture type "'+name
+'"');
145 procedure save_settings
;
150 deleteRecordStore('S');
151 rs
:=openRecordStore('S');
152 t
:=addRecordStoreEntry(rs
,version
);
153 t
:=addRecordStoreEntry(rs
,''+light_type
);
154 t
:=addRecordStoreEntry(rs
,''+ifosad
);
155 t
:=addRecordStoreEntry(rs
,''+s_particles
);
156 t
:=addRecordStoreEntry(rs
,''+drawgui
);
157 t
:=addRecordStoreEntry(rs
,''+s_jpeg_quality
);
158 t
:=addRecordStoreEntry(rs
,''+load_key_tex
);
159 closeRecordStore(rs
);
162 function sett_ld_bool(s
:string):boolean;
164 if s
='true' then sett_ld_bool
:=true;
167 procedure load_settings
;
171 rs
:=openRecordStore('S');
172 if readRecordStoreEntry(rs
,1)<>version
then
174 debug(readRecordStoreEntry(rs
,1));
175 closeRecordStore(rs
);
178 light_type
:=stringtointeger(readRecordStoreEntry(rs
,2));
179 ifosad
:=sett_ld_bool(readRecordStoreEntry(rs
,3));
180 s_particles
:=sett_ld_bool(readRecordStoreEntry(rs
,4));
181 drawgui
:=sett_ld_bool(readRecordStoreEntry(rs
,5));
182 s_jpeg_quality
:=stringtointeger(readRecordStoreEntry(rs
,6));
183 load_key_tex
:=stringtointeger(readRecordStoreEntry(rs
,7));
184 closeRecordStore(rs
);
187 function isEOS(c
:integer):boolean;
192 if (ch
=#
$0A) or (ch
=#
$0D) then
196 function isSpace(c
:integer;):boolean;
201 if ((ch
=' ') or (ch
=#
$09) or (ch
=#
$0B) or isEOS(c
)) then
205 function nextByte(res
:resource
):integer;
218 function ReadString(res
:resource
):string;
226 if EOFstr
or ENDstr
then
229 tmpstr
:=tmpstr
+chr(b
);
234 function nextChar
:integer;
239 if length(parseStr
)>0 then
241 i
:=ord(getChar(parseStr
, 0));
242 parseStr
:=copy(parseStr
, 1, length(parseStr
));
255 procedure clearSpaces
;
264 {Symbol ';' is one line commentary}
274 if isSpace(i
)=false then
277 parseStr
:=chr(i
)+parseStr
;
283 function nextWord
:string;
302 parseStr
:=chr(i
)+parseStr
;
311 function strToBool(str
:string):boolean;
320 if StringToInteger(str
)<>0 then
326 //Перевод строки в целое число. base - система счисления
327 function Str2Dec(str
:string; base
:integer;):integer;
334 if GetChar(str
, 0)='-' then
340 for i
:=i
to length(str
)-1 do
343 if ((ch
>='0') and (ch
<='9')) then
346 if ((ch
>='A') and (ch
<=chr($36+base
))) then
350 addToLog('Error! I cant decode "'+str
+'" -> "'+ch
+'"');
364 function getVar(name
:string):integer;
368 if name
='SCREEN_W' then
371 if name
='SCREEN_H' then
374 addToLog('Unknown variable "'+name
+'"');
377 procedure setVar(name
:string; value
:integer);
381 addToLog('I cant set variable "'+name
+'"');
384 function DecodeInt(str
:string):integer;
391 addToLog('DecodeInt getted null string!');
397 head
:=getchar(str
, 0);
398 num
:=copy(str
, 1, length(str
));
410 DecodeInt
:=getVar(num
);
412 if (head
='0') and (getchar(str
, 1)='X') then
414 DecodeInt
:=Str2Dec(copy(str
, 2, length(str
)), 16);
417 if (head
='0') and (length(str
)>1) then
419 DecodeInt
:=Str2Dec(num
, 8);
424 DecodeInt
:=Str2Dec(num
, 2);
427 if ((head
>='0') and (head
<='9')) or (head
='-') then
429 DecodeInt
:=Str2Dec(str
, 10);
433 addToLog('Error! I cant decode "'+str
+'"');
436 procedure exeCommand(str
:string);
438 com
, tmp
, tmp2
:string;
446 com
:=UpCase(nextWord
);
448 if (cheats
) or (autoexec_acces
) or (gamemode
=1) then
451 game_time
:=decodeInt(nextWord
);
454 fly
:=strToBool(nextWord
);
457 hp
:=decodeInt(nextWord
);
460 hunger
:=decodeInt(nextWord
);
463 player
.dropItem(decodeInt(nextWord
), decodeInt(nextWord
));
467 player
.setX(decodeInt(nextWord
));
468 player
.setY(decodeInt(nextWord
));
471 if com
='GAMEMODE' then
473 gamemode
:=decodeInt(nextWord
);
477 {if com='KILL_MOBS' then
486 player
.setX(get_spawn_x
*16+4);
487 player
.setY(get_spawn_y
*16);
490 {if com='SPAWN_MOBS' then
491 s_spawn_mob:=strToBool(nextWord);
493 {if com='SURVIVAL' then
506 if com
='CLEAR_INVENTORY' then
514 if com
='I_AM_CHEATER' then
516 if nextWord
=#
$36+#
$36+#
$36 then
525 if com
='WEATHER' then
526 osadki
:=strToBool(nextWord
);
528 {if com='MEGASPAWN' then
531 if com
='REF_DRP' then
532 ref_drp
:=strToBool(nextWord
);
535 bl_upd
:=decodeInt(nextWord
);
537 if com
='GET_DRP' then
538 s_get_drp
:=strToBool(nextWord
);
540 {if com='AI_UPD' then
541 ai_upd:=strToBool(nextWord);
543 if com
='PRT_UPD' then
544 particle_upd
:=strToBool(nextWord
);
546 if com
='MAX_FPS' then
547 s_max_fps
:=decodeInt(nextWord
); else
548 if com
='DRW_BACK' then
549 drw_back
:=strToBool(nextWord
);
551 {if com='DRW_MOBS' then
552 drw_mobs:=strToBool(nextWord);
554 if com
='DRP_PHY' then
555 drp_phy
:=strToBool(nextWord
);
558 drw_sm
:=strToBool(nextWord
);
562 s_jpeg_quality
:=decodeInt(nextWord
);
563 if s_jpeg_quality
>100 then
565 else if s_jpeg_quality
<0 then
569 if com
='LOAD_SM' then
570 load_sm
:=decodeInt(nextWord
);
572 if com
='S_WEATHER' then
573 ifosad
:=strToBool(nextWord
);
575 if com
='S_HIDE_GUI' then
576 drawgui
:=strToBool(nextWord
);
578 if com
='S_LIGHT' then
579 light_type
:=decodeInt(nextWord
);
581 if com
='S_PARTICLES' then
582 s_particles
:=strToBool(nextWord
);
584 if com
='LOAD_SKY' then
585 load_sky_siz
:=decodeInt(nextWord
);
587 {if com='LOAD_MOB_TEX' then
588 load_mob_tex:=strToBool(nextWord);
590 if com
='LOAD_BACK_TEX' then
591 load_back_tex
:=strToBool(nextWord
);
593 if com
='LOAD_WEATHER_TEX' then
594 load_weather_tex
:=strToBool(nextWord
);
596 if com
='LOAD_PARTICLES_TEX' then
597 load_particles_tex
:=strToBool(nextWord
);
599 if com
='LOAD_LIGHT_TEX' then
600 load_light_tex
:=strToBool(nextWord
);
602 if com
='LOAD_GUI_TEX' then
603 load_gui_tex
:=strToBool(nextWord
);
605 if com
='MENU_BACKGROUND' then
606 menu_background
:=decodeInt(nextWord
);
608 if com
='DRW_DRP' then
609 drw_drp
:=strToBool(nextWord
);
611 if com
='DRW_STARS' then
612 drw_stars
:=strToBool(nextWord
);
614 if com
='SV_SETT' then
617 if com
='LD_SETT' then
620 if com
='LOAD_MINIMAP_TEX' then
621 load_minimap_tex
:=strToBool(nextWord
);
623 if com
='MAX_PARTICLES' then
625 max_particles
:=decodeInt(nextWord
);
626 reset_particles(max_particles
+1);
632 exec(nextWord
, tmp
, autoexec_acces
);
635 if com
='RESET_ITEMS' then
637 resetItems(decodeInt(nextWord
)+1);
638 //addToLog('Max items: '+decodeInt(parsed_str[1]));
641 if com
='SET_ITEM' then
643 setItemData(decodeInt(nextWord
),
648 decodeInt(nextWord
));
651 if com
='RESET_BLOCKS' then
653 resetBlocks(decodeInt(nextWord
)+1);
654 //addToLog('Max blocks: '+decodeInt(parsed_str[1]));
657 if com
='SET_BLOCK' then
659 setBlockData(decodeInt(nextWord
),
667 decodeInt(nextWord
));
670 if com
='RESET_TOOLS' then
672 resetTools(decodeInt(nextWord
)+1);
673 //addToLog('Max tools: '+decodeInt(parsed_str[1]));
676 if com
='SET_TOOL' then
678 setToolData(decodeInt(nextWord
),
682 decodeInt(nextWord
));
685 if com
='RESET_FUELS' then
687 furnace
.setMaxFuel(decodeInt(nextWord
));
688 //addToLog('Max fuel: '+decodeInt(parsed_str[1]));
691 if com
='SET_FUEL' then
693 furnace
.initFuel(decodeInt(nextWord
),
695 decodeInt(nextWord
));
698 if com
='RESET_RECIPES' then
700 furnace
.setMaxRecipes(decodeInt(nextWord
));
701 //addToLog('Max recipes: '+decodeInt(parsed_str[1]));
704 if com
='SET_RECIPE' then
706 furnace
.initRecipe(decodeInt(nextWord
),
708 decodeInt(nextWord
));
711 if com
='RESET_CRAFTS' then
713 resetCrafts(decodeInt(nextWord
));
714 //addToLog('Max crafts: '+decodeInt(parsed_str[1]));
717 if com
='SET_CRAFT_IN' then
719 setCraftIn(decodeInt(nextWord
),
722 decodeInt(nextWord
));
725 if com
='SET_CRAFT_OUT' then
727 setCraftOUT(decodeInt(nextWord
),
730 decodeInt(nextWord
));
733 if com
='RESET_BLOCKS_TEX' then
735 initBlockTex(decodeInt(nextWord
));
738 if com
='RESET_ITEMS_TEX' then
740 initItemTex(decodeInt(nextWord
));
743 if com
='LOAD_TEX' then
744 regimg
:=ld_tex(nextWord
, '/'+sd
+'/cavecraft/', '');
746 if com
='RESET_TEX' then
749 if com
='SET_TEX' then
752 decodeInt(nextWord
));
753 if com
='SET_CANV_TEX' then
757 setTexture(rotate_image_from_image(regimg
,
767 if com
='SET_MAX_ITEM_LIST' then
768 setMaxItemList(decodeInt(nextWord
));
770 if com
='SET_ITEM_LIST' then
771 setItemList(decodeInt(nextWord
),
772 decodeInt(nextWord
));
774 if com
='BIND_KEY' then
777 for i
:=0 to MAX_KEY_BIND
do
778 keyboard
.bindKey(decodeInt(tmp
), i
, decodeInt(nextWord
));
782 resetStack(decodeInt(nextWord
));
785 pushStack(decodeInt(nextWord
));
797 pushStack(popStack
+popStack
);
802 pushStack(popStack
-i
);
806 pushStack(popStack
*popStack
);
811 pushStack(popStack
/i
);
817 pushStack(popStack
mod i
);
821 setVar(nextWord
, decodeInt(nextWord
));
824 setVar(nextWord
, popStack
);
826 if com
='MAX_VKEYS' then
827 resetVirtualKeyboard(decodeInt(nextWord
));
829 if com
='SET_VKEY' then
830 bindVKey(decodeInt(nextWord
),
833 decodeInt(nextWord
));
835 if com
='SET_RESOLUTION' then
836 initVideo(decodeInt(nextWord
), decodeInt(nextWord
), strToBool(nextWord
));
838 //addToLog('Unknown command "'+com+'"');
841 procedure call_console
;
845 exitCmd
, exeCmd
, Clicked
:command
;
849 setFont(FONT_FACE_SYSTEM
,FONT_STYLE_PLAIN
,FONT_SIZE_SMALL
);
854 exitCmd
:=createCommand('Exit', CM_EXIT
, 1);
855 exeCmd
:=createCommand('Execute', CM_OK
, 1);
859 commandTxt
:=formAddTextField('Enter command:', ''+lastCommand
, 32, TF_ANY
);
861 for i
:=0 to CON_LOG_SIZE
do
862 tmpid
:=formAddString(logSTR
[i
]+chr(10));
868 Clicked
:=getClickedCommand
;
869 if Clicked
=exitCmd
then
871 lastCommand
:=formGetText(commandTxt
);
876 if Clicked
=exeCmd
then
878 str
:=formGetText(commandTxt
);
888 procedure exec(s
, search
:string; acces
:boolean);
892 tmp_acces
, tmpEOF
:boolean;
894 tmp_acces
:=autoexec_acces
;
895 autoexec_acces
:=acces
;
897 search
:=UpCase(search
);
899 if search
='LOCAL' then
901 addToLog('Load file "'+s
+'" at LOCAL!');
902 res
:=OpenResource('/'+s
);
907 if open_file('/'+sd
+'/cavecraft/'+s
)=1 then
909 addToLog('Load file "'+s
+'" at SD!');
914 if search
='AUTO' then
916 addToLog('path "/'+sd
+'/cavecraft/'+s
+'"');
917 if file_exists('/'+sd
+'/cavecraft/'+s
)=1 then
919 if open_file('/'+sd
+'/cavecraft/'+s
)=1 then
921 addToLog('Load file "'+s
+'" at SD(AUTO)!');
927 addToLog('Load file "'+s
+'" at LOCAL(AUTO)!');
928 res
:=OpenResource('/'+s
);
933 addToLog('Unknown load type "'+search
+'", file "'+s
+'" not executed!');
934 autoexec_acces
:=tmp_acces
;
938 if ResourceAvailable(res
) then
940 str
:=ReadString(res
);
942 //addToLog('Exec: "'+str+'"');
947 addToLog('Execute file "'+s
+'" not found!');
950 autoexec_acces
:=tmp_acces
;