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
;
30 //Debug("ld_tex (tex_pack:" + tex_pack + ") : " + path + n);
32 if file_exists(path
+ n
) = 1 then
33 ld_tex
:= safely_load_image_fs(path
+ n
);
35 ld_tex
:= loadimage('/' + n
);
38 function readint
:integer;
42 b
:=b
or (read_uns_byte
<<24);
43 b
:=b
or (read_uns_byte
<<16);
44 b
:=b
or (read_uns_byte
<<8);
45 b
:=b
or (read_uns_byte
);
49 procedure writeint(intt
:integer);
51 write_byte((intt
>>24) and $FF);
52 write_byte((intt
>>16) and $FF);
53 write_byte((intt
>>8) and $FF);
54 write_byte((intt
) and $FF);
57 procedure writebool(bo
:boolean);
65 function readbool
:boolean;
67 readbool
:=read_byte
>0;
70 procedure writestr(s
:string);
74 for i
:=0 to length(s
) do
75 write_byte(ord(getChar(s
,i
)));
78 function readstr
:string;
91 //Получение точки спавна
92 function get_spawn_x
:integer;
94 get_spawn_x
:=(255 div 2);
97 function get_spawn_y
:integer;
102 if getmap(get_spawn_x
,iy
)<>0 then begin get_spawn_y
:=(iy
-2); break
; end;
105 procedure drawSmallItem(item
, x
, y
:integer);
107 if getItemTexType(item
)=0 then
108 drawimage(tex8
[getBlockTex(item
)], x
, y
);
110 if getItemTexType(item
)=1 then
111 drawimage(item8
[getItemTex(item
)], x
, y
);
114 procedure draw_block(xx
,yy
:integer);
116 if (getmap(xx
,yy
)=123) or (getmap(xx
,yy
)=124) then
118 setclip((xx
*16)-camx
,(yy
*16)-camy
,16,16);
119 if getmapinfo(xx
,yy
)<9 then drawimage(tex
[142],(xx
*16)-camx
,(yy
*16)-camy
+(16-getmapinfo(xx
,yy
)*2)); else
120 if getmapinfo(xx
,yy
)=9 then drawimage(tex
[143],(xx
*16)-camx
,(yy
*16)-camy
);
121 setclip(0,0,getwidth
,getheight
);
123 if (getmap(xx
,yy
)=92) or (getmap(xx
,yy
)=93) then
125 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
126 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
127 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);
128 drawimage(tex
[getBlockTex(getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
129 setclip(0,0,getwidth
,getheight
);
131 if getmap(xx
,yy
)=27 then
133 drawimage(tex
[getBlockTex(getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
134 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;
136 if getmap(xx
,yy
)=50 then
138 drawimage(tex
[getBlockTex(getmap(xx
,yy
))+bl_ani5
],(xx
*16)-camx
,(yy
*16)-camy
);
140 if getmap(xx
,yy
)=51 then
142 drawimage(tex
[getBlockTex(getmap(xx
,yy
))+bl_ani5
],(xx
*16)-camx
,(yy
*16)-camy
);
144 if getmap(xx
,yy
)=110 then
146 drawimage(tex
[getBlockTex(getmap(xx
,yy
))+bl_ani5
],(xx
*16)-camx
,(yy
*16)-camy
);
148 /*if getmap(xx
,yy
)=106 then
150 if (furnace_gg
[getmapinfo(xx
,yy
)].f_gor
<15) or (furnace_gg
[getmapinfo(xx
,yy
)].f_got
>0) then
151 drawimage(tex
[134],xx
*16-camx
,yy
*16-camy
);
153 drawimage(tex
[get_block(0,getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
155 if getmap(xx
,yy
)=121 then
157 setclip((xx
*16)-camx
,(yy
*16)-camy
,getmapinfo(xx
,yy
),16);
158 drawimage(tex
[getBlockTex(getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
159 setclip(0,0,getWidth
,getHeight
);
161 if getmap(xx
,yy
)=122 then
163 drawimage(tex
[getBlockTex(getmap(xx
,yy
))+getmapinfo(xx
,yy
)],(xx
*16)-camx
,(yy
*16)-camy
);
165 if getmap(xx
,yy
)<>0 then
166 drawimage(tex
[getBlockTex(getmap(xx
,yy
))],(xx
*16)-camx
,(yy
*16)-camy
);
169 procedure drawItem(item
, sum
, x
, y
:integer; indicator
:boolean;);
175 if getItemTexType(item
)=0 then
176 drawimage(tex
[getBlockTex(item
)], x
, y
);
178 if getItemTexType(item
)=1 then
179 drawimage(vars
.item
[getItemTex(item
)], x
, y
);
183 drawimage(compas
, x
, y
);
185 setclip(x
+2, y
+2, 12, 10);
187 drawline(get_spawn_x
*16-camx
, get_spawn_y
*16-camy
, x
+8, y
+7);
190 drawline(random(getWidth
), random(getHeight
), x
+8, y
+7);
191 setclip(0, 0, getWidth
, getheight
);
196 drawimage(clock
[clock_stage
], x
, y
);
200 if (sum
>1) and indicator
then
202 if getItemIndLine(item
) then
204 pa_xo
:=10000*16/getItemMax(item
)*sum
/10000;
209 drawline(x
, y
+14, x
+pa_xo
, y
+14);
212 if getItemIndNum(item
) then
213 drawfonttext(''+sum
, x
, y
+8);
218 //Загрузка шрифта из файла под именем s
219 procedure LoadDrawFont(s
:string);
224 im
:=ld_tex('default_font.png', s
, '');
225 for ix
:=0 to FONT_MAX_SYM
do
226 font
[ix
]:=rotate_image_from_image(im
, ix
*FONT_SYM_SIZE
, 0, FONT_SYM_SIZE
, FONT_SYM_SIZE
, 0);
229 //Рисование текста графическим шрифтом
230 procedure DrawFontTextSpec(str
:string; x
, y
, color
:integer; spec
:boolean;);
232 FONT_UNKNOWN_SYM
=$3F;
233 FONT_SPEC_SYM
=$FFA7;//UTF8
235 ch
, i
, spec_c
:integer;
238 for i
:=0 to length(str
)-1 do
240 ch
:=ord(getChar(str
, i
));
242 if (spec
) and (ch
=FONT_SPEC_SYM
) then
246 if i
<=length(str
)-2 then
248 ch
:=ord(getChar(str
, i
+1));
249 tch
:=getChar(UpCase(str
), i
);
300 ch
:=ord(getChar(str
, i
));
309 if ch
>FONT_MAX_SYM
then
310 ch
:=FONT_UNKNOWN_SYM
;
312 if color
=FONT_STD_COLOR
then
313 DrawImage(font
[ch
],x
+((i
-spec_c
)*FONT_SYM_SIZE
),y
);
315 DrawImage(ReplaceImgColor(font
[ch
], FONT_STD_COLOR
, color
), x
+((i
-spec_c
)*FONT_SYM_SIZE
), y
);
319 //Рисование текста графическим шрифтом со стандартным цветом
320 procedure DrawFontText(str
:string; x
, y
:integer);
322 DrawFontTextSpec(str
, x
, y
, FONT_STD_COLOR
, true);