src/func.mpsrc

   1 unit func;
   2
   3 interface
   4  function get_spawn_x:integer;//Возвращает блок по X где должен появиться игрок
   5  function get_spawn_y:integer;//Возвращает блок по Y где должен появиться игрок
   6  procedure draw_block(xx,yy:integer);
   7 (*
   8  procedure drawSmallItem(item, x, y:integer);
   9  procedure drawItem(item, sum, x, y:integer; indicator:boolean;);
  10 *)
  11  procedure LoadDrawFont(s:string);
  12  procedure DrawFontTextSpec(str:string; x, y, color:integer; spec:boolean;);
  13  procedure DrawFontText(str:string; x, y:integer);
  14 function ld_tex(name,path,folder:string):image;
  15 function readint:integer;
  16 procedure writeint(intt:integer);
  17 procedure writebool(bo:boolean);
  18 function readbool:boolean;
  19 procedure writestr(s:string);
  20 function readstr:string;
  21
  22 implementation
  23  uses canvas, imgcolor, jsr75i, vars, safeload, Blocks, maps, items_store;
  24
  25 //Загрузка текстуры с автоматическим выбором источника
  26 function ld_tex(name, path, folder : String) : Image;
  27   var
  28     n, p : String;
  29   begin
  30     n := folder + name;
  31
  32     //Debug("ld_tex (tex_pack:" + tex_pack +  ") : " + path + n);
  33
  34     if file_exists(path + n) = 1 then
  35       ld_tex := safely_load_image_fs(path + n);
  36     else
  37       ld_tex := loadimage('/' + n);
  38   end;
  39
  40 function readint:integer;
  41  var
  42   b:integer;
  43  begin
  44   b:=b or (read_uns_byte<<24);
  45   b:=b or (read_uns_byte<<16);
  46   b:=b or (read_uns_byte<<8);
  47   b:=b or (read_uns_byte);
  48   readint:=b;
  49  end;
  50
  51 procedure writeint(intt:integer);
  52  begin
  53   write_byte((intt>>24) and $FF);
  54   write_byte((intt>>16) and $FF);
  55   write_byte((intt>>8) and $FF);
  56   write_byte((intt) and $FF);
  57  end;
  58
  59 procedure writebool(bo:boolean);
  60  begin
  61   if bo=true then
  62    write_byte(1);
  63   else
  64    write_byte(0);
  65  end;
  66
  67 function readbool:boolean;
  68  begin
  69   readbool:=read_byte>0;
  70  end;
  71
  72 procedure writestr(s:string);
  73  var
  74   i:integer;
  75  begin
  76   for i:=0 to length(s) do
  77    write_byte(ord(getChar(s,i)));
  78  end;
  79
  80 function readstr:string;
  81  var
  82   i,b:integer;
  83   str:string;
  84  begin
  85   repeat
  86    b:=read_byte;
  87    if b=0 then break;
  88    str:=str+chr(b);
  89   until false;
  90   readstr:=str;
  91  end;
  92
  93 //Получение точки спавна
  94  function get_spawn_x:integer;
  95   begin
  96    get_spawn_x:=(255 div 2);
  97   end;
  98
  99  function get_spawn_y:integer;
 100   var
 101    iy:integer;
 102   begin
 103    for iy:=0 to 127 do
 104     if getmap(get_spawn_x,iy)<>0 then begin get_spawn_y:=(iy-2); break; end;
 105   end;
 106
 107 (*
 108  procedure drawSmallItem(item, x, y:integer);
 109   begin
 110    if getItemTexType(item)=0 then
 111     drawimage(tex8[getBlockTex(item)], x, y);
 112    else
 113    if getItemTexType(item)=1 then
 114     drawimage(item8[getItemTex(item)], x, y);
 115   end;
 116 *)
 117
 118  procedure draw_block(xx,yy:integer);
 119   begin
 120    if (getmap(xx,yy)=123) or (getmap(xx,yy)=124) then
 121     begin
 122      setclip((xx*16)-camx,(yy*16)-camy,16,16);
 123      if getmapinfo(xx,yy)<9 then drawimage(tex[142],(xx*16)-camx,(yy*16)-camy+(16-getmapinfo(xx,yy)*2)); else
 124      if getmapinfo(xx,yy)=9 then drawimage(tex[143],(xx*16)-camx,(yy*16)-camy);
 125      setclip(0,0,getwidth,getheight);
 126     end; else
 127    if (getmap(xx,yy)=92) or (getmap(xx,yy)=93) then
 128     begin
 129      if (Blocks.IsOverlapped(getmap(xx - 1, yy)) = false) and (Blocks.IsOverlapped(getmap(xx + 1, yy)) = true) then setclip((xx*16)-camx,(yy*16)-camy,10,16); else
 130      if (Blocks.IsOverlapped(getmap(xx + 1, yy)) = false) and (Blocks.IsOverlapped(getmap(xx - 1, yy)) = true) then setclip((xx*16)-camx+6,(yy*16)-camy,10,16); else
 131      if (Blocks.IsOverlapped(getmap(xx + 1, yy)) = true) and (Blocks.IsOverlapped(getmap(xx - 1, yy)) = true) then setclip((xx*16)-camx+6,(yy*16)-camy,4,16);
 132      drawimage(tex[getBlockTex(getmap(xx,yy))],(xx*16)-camx,(yy*16)-camy);
 133      setclip(0,0,getwidth,getheight);
 134     end; else
 135    if getmap(xx,yy)=27 then
 136     begin
 137      drawimage(tex[getBlockTex(getmap(xx,yy))],(xx*16)-camx,(yy*16)-camy);
 138      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;
 139     end; else
 140    if getmap(xx,yy)=50 then
 141     begin
 142      drawimage(tex[getBlockTex(getmap(xx,yy))+bl_ani5],(xx*16)-camx,(yy*16)-camy);
 143     end; else
 144    if getmap(xx,yy)=51 then
 145     begin
 146      drawimage(tex[getBlockTex(getmap(xx,yy))+bl_ani5],(xx*16)-camx,(yy*16)-camy);
 147     end; else
 148    if getmap(xx,yy)=110 then
 149     begin
 150      drawimage(tex[getBlockTex(getmap(xx,yy))+bl_ani5],(xx*16)-camx,(yy*16)-camy);
 151    end; else
 152    /*if getmap(xx,yy)=106 then
 153     begin
 154      if (furnace_gg[getmapinfo(xx,yy)].f_gor<15) or (furnace_gg[getmapinfo(xx,yy)].f_got>0) then
 155       drawimage(tex[134],xx*16-camx,yy*16-camy);
 156      else
 157       drawimage(tex[get_block(0,getmap(xx,yy))],(xx*16)-camx,(yy*16)-camy);
 158     end; else*/
 159    if getmap(xx,yy)=121 then
 160     begin
 161      setclip((xx*16)-camx,(yy*16)-camy,getmapinfo(xx,yy),16);
 162      drawimage(tex[getBlockTex(getmap(xx,yy))],(xx*16)-camx,(yy*16)-camy);
 163      setclip(0,0,getWidth,getHeight);
 164     end; else
 165    if getmap(xx,yy)=122 then
 166     begin
 167      drawimage(tex[getBlockTex(getmap(xx,yy))+getmapinfo(xx,yy)],(xx*16)-camx,(yy*16)-camy);
 168     end; else
 169    if getmap(xx,yy)<>0 then
 170     drawimage(tex[getBlockTex(getmap(xx,yy))],(xx*16)-camx,(yy*16)-camy);
 171   end;
 172
 173 (*
 174  procedure drawItem(item, sum, x, y:integer; indicator:boolean;);
 175   var
 176    pa_xo,ugol:integer;
 177   begin
 178    if sum>0 then
 179     begin
 180      if getItemTexType(item)=0 then
 181       drawimage(tex[getBlockTex(item)], x, y);
 182       else
 183      if getItemTexType(item)=1 then
 184       drawimage(vars.item[getItemTex(item)], x, y);
 185
 186      if item=216 then
 187       begin
 188        drawimage(compas, x, y);
 189        setcolor(255,0,0);
 190        setclip(x+2, y+2, 12, 10);
 191        if pl_world=0 then
 192         drawline(get_spawn_x*16-camx, get_spawn_y*16-camy, x+8, y+7);
 193         else
 194        if pl_world=1 then
 195         drawline(random(getWidth), random(getHeight), x+8, y+7);
 196        setclip(0, 0, getWidth, getheight);
 197       end;
 198      else
 199      if item=215 then
 200       begin
 201        drawimage(clock[clock_stage], x, y);
 202       end;
 203     end;
 204
 205    if (sum>1) and indicator then
 206     begin
 207      if getItemIndLine(item) then
 208       begin
 209        pa_xo:=10000*16/getItemMax(item)*sum/10000;
 210        if pa_xo<=3 then
 211         setcolor(255,0,0);
 212        else
 213         setcolor(0,255,0);
 214        drawline(x, y+14, x+pa_xo, y+14);
 215       end;
 216
 217      if getItemIndNum(item) then
 218       drawfonttext(''+sum, x, y+8);
 219     end;
 220   end;
 221 *)
 222
 223 //Загрузка шрифта из файла под именем s
 224 procedure LoadDrawFont(s:string);
 225  var
 226   ix:integer;
 227   im:image;
 228  begin
 229   im:=ld_tex('default_font.png', s, '');
 230   for ix:=0 to FONT_MAX_SYM do
 231    font[ix]:=rotate_image_from_image(im, ix*FONT_SYM_SIZE, 0, FONT_SYM_SIZE, FONT_SYM_SIZE, 0);
 232  end;
 233
 234 //Рисование текста графическим шрифтом
 235 procedure DrawFontTextSpec(str:string; x, y, color:integer; spec:boolean;);
 236  const
 237   FONT_UNKNOWN_SYM=$3F;
 238   FONT_SPEC_SYM=$FFA7;//UTF8
 239  var
 240   ch, i, spec_c:integer;
 241   tch:char;
 242  begin
 243   for i:=0 to length(str)-1 do
 244    begin
 245     ch:=ord(getChar(str, i));
 246
 247     if (spec) and (ch=FONT_SPEC_SYM) then
 248      begin
 249
 250       i:=i+1;
 251       if i<=length(str)-2 then
 252        begin
 253         ch:=ord(getChar(str, i+1));
 254         tch:=getChar(UpCase(str), i);
 255         if tch='0' then
 256          color:=$FF000000;
 257         else
 258         if tch='1' then
 259          color:=$FF0000AA;
 260         else
 261         if tch='2' then
 262          color:=$FF00AA00;
 263         else
 264         if tch='3' then
 265          color:=$FF00AAAA;
 266         else
 267         if tch='4' then
 268          color:=$FFAA0000;
 269         else
 270         if tch='5' then
 271          color:=$FFAA00AA;
 272         else
 273         if tch='6' then
 274          color:=$FFAA5500;
 275         else
 276         if tch='7' then
 277          color:=$FFAAAAAA;
 278         else
 279         if tch='8' then
 280          color:=$FF555555;
 281         else
 282         if tch='9' then
 283          color:=$FF5555FF;
 284         else
 285         if tch='A' then
 286          color:=$FF55FF55;
 287         else
 288         if tch='B' then
 289          color:=$FF55FFFF;
 290         else
 291         if tch='C' then
 292          color:=$FFFF5555;
 293         else
 294         if tch='D' then
 295          color:=$FFFF55FF;
 296         else
 297         if tch='E' then
 298          color:=$FFFFFF55;
 299         else
 300         if tch='F' then
 301          color:=$FFFFFFFF;
 302         else
 303          begin
 304           i:=i-2;
 305           ch:=ord(getChar(str, i));
 306           spec_c:=spec_c-2;
 307          end;
 308
 309         i:=i+1;
 310         spec_c:=spec_c+2;
 311        end;
 312      end;
 313
 314     if ch>FONT_MAX_SYM then
 315      ch:=FONT_UNKNOWN_SYM;
 316
 317     if color=FONT_STD_COLOR then
 318      DrawImage(font[ch],x+((i-spec_c)*FONT_SYM_SIZE),y);
 319     else
 320      DrawImage(ReplaceImgColor(font[ch], FONT_STD_COLOR, color), x+((i-spec_c)*FONT_SYM_SIZE), y);
 321    end;
 322  end;
 323
 324 //Рисование текста графическим шрифтом со стандартным цветом
 325 procedure DrawFontText(str:string; x, y:integer);
 326  begin
 327   DrawFontTextSpec(str, x, y, FONT_STD_COLOR, true);
 328  end;
 329
 330
 331 end.