4 function get_spawn_x
:integer;//Возвращает блок по X где должен появиться игрок
5 function get_spawn_y
:integer;//Возвращает блок по Y где должен появиться игрок
6 procedure draw_block(xx
,yy
:integer);
7 procedure drawSmallItem(item
, x
, y
:integer);
8 procedure drawItem(item
, sum
, x
, y
:integer; indicator
:boolean;);
9 procedure LoadDrawFont(s
:string);
10 procedure DrawFontTextSpec(str
:string; x
, y
, color
:integer; spec
:boolean;);
11 procedure DrawFontText(str
:string; x
, y
:integer);
12 function ld_tex(name
,path
,folder
:string):image
;
13 function readint
:integer;
14 procedure writeint(intt
:integer);
15 procedure writebool(bo
:boolean);
16 function readbool
:boolean;
17 procedure writestr(s
:string);
18 function readstr
:string;
21 uses canvas
,imgcolor
,jsr75i
, vars
, safeload
, items
,maps
, items_store
;
23 //Загрузка изображения из текстурпака, ели такого нет, то происходит загрузка из архива игры
24 function ld_tex(name
,path
,folder
:string):image
;
28 if file_exists(path
+folder
+name
)=1 then
30 ld_tex
:=safely_load_image_fs(path
+folder
+name
);
31 end; else ld_tex
:=loadimage('/'+folder
+name
);
33 if tex_pack
='' then ld_tex
:=loadimage('/'+folder
+name
);
36 function readint
:integer;
40 b
:=b
or (read_uns_byte
<<24);
41 b
:=b
or (read_uns_byte
<<16);
42 b
:=b
or (read_uns_byte
<<8);
43 b
:=b
or (read_uns_byte
);
47 procedure writeint(intt
:integer);
49 write_byte((intt
>>24) and $FF);
50 write_byte((intt
>>16) and $FF);
51 write_byte((intt
>>8) and $FF);
52 write_byte((intt
) and $FF);
55 procedure writebool(bo
:boolean);
63 function readbool
:boolean;
65 readbool
:=read_byte
>0;
68 procedure writestr(s
:string);
72 for i
:=0 to length(s
) do
73 write_byte(ord(getChar(s
,i
)));
76 function readstr
:string;
89 //Получение точки спавна
90 function get_spawn_x
:integer;
92 get_spawn_x
:=(255 div 2);
95 function get_spawn_y
:integer;
100 if getmap(get_spawn_x
,iy
)<>0 then begin get_spawn_y
:=(iy
-2); break
; end;
103 procedure drawSmallItem(item
, x
, y
:integer);
105 if getItemTexType(item
)=0 then
106 drawimage(tex8
[getBlockTex(item
)], x
, y
);
108 if getItemTexType(item
)=1 then
109 drawimage(item8
[getItemTex(item
)], x
, y
);
112 procedure draw_block(xx
,yy
:integer);
114 if (getmap(xx
,yy
)=123) or (getmap(xx
,yy
)=124) then
116 setclip((xx
*16)-camx
,(yy
*16)-camy
,16,16);
117 if getmapinfo(xx
,yy
)<9 then drawimage(tex
[142],(xx
*16)-camx
,(yy
*16)-camy
+(16-getmapinfo(xx
,yy
)*2)); else
118 if getmapinfo(xx
,yy
)=9 then drawimage(tex
[143],(xx
*16)-camx
,(yy
*16)-camy
);
119 setclip(0,0,getwidth
,getheight
);
121 if (getmap(xx
,yy
)=92) or (getmap(xx
,yy
)=93) then
123 if (getBlockSet(getmap(xx
-1,yy
))=false) and (getBlockSet(getmap(xx
+1,yy
))=true) then setclip((xx
*16)-camx
,(yy
*16)-camy
,10,16); else
124 if (getBlockSet(getmap(xx
+1,yy
))=false) and (getBlockSet(getmap(xx
-1,yy
))=true) then setclip((xx
*16)-camx
+6,(yy
*16)-camy
,10,16); else
125 if (getBlockSet(getmap(xx
+1,yy
))=true) and (getBlockSet(getmap(xx
-1,yy
))=true) then setclip((xx
*16)-camx
+6,(yy
*16)-camy
,4,16);
126 drawimage(tex
[getBlockTex(getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
127 setclip(0,0,getwidth
,getheight
);
129 if getmap(xx
,yy
)=27 then
131 drawimage(tex
[getBlockTex(getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
132 if getmapinfo(xx
,yy
)<>0 then begin if random(8)<random(6) then begin setcolor(255,255,255); fillrect((xx
*16)-camx
,(yy
*16)-camy
,16,16); end; end;
134 if getmap(xx
,yy
)=50 then
136 drawimage(tex
[getBlockTex(getmap(xx
,yy
))+bl_ani5
],(xx
*16)-camx
,(yy
*16)-camy
);
138 if getmap(xx
,yy
)=51 then
140 drawimage(tex
[getBlockTex(getmap(xx
,yy
))+bl_ani5
],(xx
*16)-camx
,(yy
*16)-camy
);
142 if getmap(xx
,yy
)=110 then
144 drawimage(tex
[getBlockTex(getmap(xx
,yy
))+bl_ani5
],(xx
*16)-camx
,(yy
*16)-camy
);
146 /*if getmap(xx
,yy
)=106 then
148 if (furnace_gg
[getmapinfo(xx
,yy
)].f_gor
<15) or (furnace_gg
[getmapinfo(xx
,yy
)].f_got
>0) then
149 drawimage(tex
[134],xx
*16-camx
,yy
*16-camy
);
151 drawimage(tex
[get_block(0,getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
153 if getmap(xx
,yy
)=121 then
155 setclip((xx
*16)-camx
,(yy
*16)-camy
,getmapinfo(xx
,yy
),16);
156 drawimage(tex
[getBlockTex(getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
157 setclip(0,0,getWidth
,getHeight
);
159 if getmap(xx
,yy
)=122 then
161 drawimage(tex
[getBlockTex(getmap(xx
,yy
))+getmapinfo(xx
,yy
)],(xx
*16)-camx
,(yy
*16)-camy
);
163 if getmap(xx
,yy
)<>0 then
164 drawimage(tex
[getBlockTex(getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
167 procedure drawItem(item
, sum
, x
, y
:integer; indicator
:boolean;);
173 if getItemTexType(item
)=0 then
174 drawimage(tex
[getBlockTex(item
)], x
, y
);
176 if getItemTexType(item
)=1 then
177 drawimage(vars
.item
[getItemTex(item
)], x
, y
);
181 drawimage(compas
, x
, y
);
183 setclip(x
+2, y
+2, 12, 10);
185 drawline(get_spawn_x
*16-camx
, get_spawn_y
*16-camy
, x
+8, y
+7);
188 drawline(random(getWidth
), random(getHeight
), x
+8, y
+7);
189 setclip(0, 0, getWidth
, getheight
);
194 drawimage(clock
[clock_stage
], x
, y
);
198 if (sum
>1) and indicator
then
200 if getItemIndLine(item
) then
202 pa_xo
:=10000*16/getItemMax(item
)*sum
/10000;
207 drawline(x
, y
+14, x
+pa_xo
, y
+14);
210 if getItemIndNum(item
) then
211 drawfonttext(''+sum
, x
, y
+8);
216 //Загрузка шрифта из файла под именем s
217 procedure LoadDrawFont(s
:string);
222 im
:=ld_tex('default_font.png', s
, '');
223 for ix
:=0 to FONT_MAX_SYM
do
224 font
[ix
]:=rotate_image_from_image(im
, ix
*FONT_SYM_SIZE
, 0, FONT_SYM_SIZE
, FONT_SYM_SIZE
, 0);
227 //Рисование текста графическим шрифтом
228 procedure DrawFontTextSpec(str
:string; x
, y
, color
:integer; spec
:boolean;);
230 FONT_UNKNOWN_SYM
=$3F;
231 FONT_SPEC_SYM
=$FFA7;//UTF8
233 ch
, i
, spec_c
:integer;
236 for i
:=0 to length(str
)-1 do
238 ch
:=ord(getChar(str
, i
));
240 if (spec
) and (ch
=FONT_SPEC_SYM
) then
244 if i
<=length(str
)-2 then
246 ch
:=ord(getChar(str
, i
+1));
247 tch
:=getChar(UpCase(str
), i
);
298 ch
:=ord(getChar(str
, i
));
307 if ch
>FONT_MAX_SYM
then
308 ch
:=FONT_UNKNOWN_SYM
;
310 if color
=FONT_STD_COLOR
then
311 DrawImage(font
[ch
],x
+((i
-spec_c
)*FONT_SYM_SIZE
),y
);
313 DrawImage(ReplaceImgColor(font
[ch
], FONT_STD_COLOR
, color
), x
+((i
-spec_c
)*FONT_SYM_SIZE
), y
);
317 //Рисование текста графическим шрифтом со стандартным цветом
318 procedure DrawFontText(str
:string; x
, y
:integer);
320 DrawFontTextSpec(str
, x
, y
, FONT_STD_COLOR
, true);