src/furnace.mpsrc

   1 unit furnace;
   2
   3 interface
   4  const
   5   MAX_FURNACE=31;
   6   MAX_FURNACE_CELLS=2;
   7
   8   ITEM_IN_FIRE=9950; // <== Костыль "исправляющий" тайминги. Должно быть 10000.
   9
  10   FURNACE_IN=0;
  11   FURNACE_FUEL=1;
  12   FURNACE_OUT=2;
  13
  14   FURNACE_ERROR=-1;
  15
  16  procedure setMaxFuel(i:integer);
  17  procedure setMaxRecipes(i:integer);
  18  procedure initFuel(id, item, time:integer);
  19  procedure initRecipe(id, in_item, out_item:integer);
  20
  21  function getTime:integer;
  22  function startFuelTime(furid:integer):integer;
  23  function endFuelTime(furid:integer):integer;
  24  function startProgTime(furid:integer):integer;
  25  function endProgTime(furid:integer):integer;
  26  function FuelTime(i:integer):integer;
  27  function ProgTime(i:integer):integer;
  28
  29  function GetFurItem(cell, furid:integer;):integer;
  30  procedure SetFurItem(val, cell, furid:integer;);
  31  function GetFurSum(cell, furid:integer;):integer;
  32  procedure SetFurSum(val, cell, furid:integer;);
  33
  34  function CreateFurnace(x, y:integer;):integer;
  35  procedure DestroyFurnace(x, y:integer);
  36  procedure UpdateFurnaces;
  37
  38  function furnaceBurn(i:integer):boolean;
  39  function itemBurn(i:integer):boolean;
  40
  41  procedure SaveData;
  42  procedure LoadData;
  43  procedure ResetData;
  44
  45 implementation
  46  uses maps, drop, items_store, items, jsr75i, func;
  47
  48  var
  49   furnace_b: array [0..MAX_FURNACE] of boolean;
  50   furnace_item, furnace_sum: array [0..MAX_FURNACE, 0..MAX_FURNACE_CELLS] of integer;
  51   furnace_fstart, furnace_ftime, furnace_prstart: array [0..MAX_FURNACE] of integer;
  52
  53   time:integer;
  54   maxFuel, maxRecipe:integer;
  55   fuel_item, fuel_time: array [0..0] of integer;
  56   recept_in, recept_out: array [0..0] of integer;
  57
  58  function getTime:integer;
  59   begin
  60    getTime:=time;
  61   end;
  62
  63  procedure UpdateTime;
  64   begin
  65    time:=getRelativeTimeMs;
  66   end;
  67
  68  function startFuelTime(i:integer):integer;
  69   begin
  70    startFuelTime:=furnace_fstart[i];
  71   end;
  72
  73  function endFuelTime(i:integer):integer;
  74   begin
  75    endFuelTime:=furnace_fstart[i]+furnace_ftime[i];
  76   end;
  77
  78  function FuelTime(i:integer):integer;
  79   begin
  80    FuelTime:=furnace_ftime[i];
  81   end;
  82
  83  procedure updateFuelTime(fueltime, i:integer);
  84   begin
  85    furnace_fstart[i]:=getTime;
  86    furnace_ftime[i]:=fueltime;
  87   end;
  88
  89  function startProgTime(i:integer):integer;
  90   begin
  91    startProgTime:=furnace_prstart[i];
  92   end;
  93
  94  function endProgTime(i:integer):integer;
  95   begin
  96    endProgTime:=furnace_prstart[i]+ITEM_IN_FIRE;
  97   end;
  98
  99  function ProgTime(i:integer):integer;
 100   begin
 101    ProgTime:=ITEM_IN_FIRE;
 102   end;
 103
 104  procedure setMaxFuel(i:integer;);
 105   begin
 106    maxFuel:=i;
 107    i:=i+1;
 108    bytecode
 109     iload 0;
 110     newarray 10;
 111     putstatic field 'furnace', 'fuel_item', '[I';
 112    end;
 113    bytecode
 114     iload 0;
 115     newarray 10;
 116     putstatic field 'furnace', 'fuel_time', '[I';
 117    end;
 118   end;
 119
 120  procedure setMaxRecipes(i:integer);
 121   begin
 122    maxRecipe:=i;
 123    i:=i+1;
 124    bytecode
 125     iload 0;
 126     newarray 10;
 127     putstatic field 'furnace', 'recept_in', '[I';
 128    end;
 129    bytecode
 130     iload 0;
 131     newarray 10;
 132     putstatic field 'furnace', 'recept_out', '[I';
 133    end;
 134   end;
 135
 136  procedure initFuel(id, item, time:integer);
 137   begin
 138    fuel_item[id]:=item;
 139    fuel_time[id]:=time;
 140   end;
 141
 142  procedure initRecipe(id, in_item, out_item:integer);
 143   begin
 144    recept_in[id]:=in_item;
 145    recept_out[id]:=out_item;
 146   end;
 147
 148  procedure ResetProgress(furid:integer);
 149   begin
 150    furnace_prstart[furid]:=getTime;
 151   end;
 152
 153  function GetFurItem(cell, furid:integer;):integer;
 154   begin
 155    GetFurItem:=furnace_item[furid, cell];
 156   end;
 157
 158  procedure SetFurItem(val, cell, furid:integer;);
 159   begin
 160    furnace_item[furid, cell]:=val;
 161   end;
 162
 163  function GetFurSum(cell, furid:integer;):integer;
 164   begin
 165    GetFurSum:=furnace_sum[furid, cell];
 166   end;
 167
 168  procedure SetFurSum(val, cell, furid:integer;);
 169   begin
 170    furnace_sum[furid, cell]:=val;
 171   end;
 172
 173  function FurCellIsNull(cell, furid:integer;):boolean;
 174   begin
 175    if (GetFurItem(cell, furid)<1) or (GetFurSum(cell, furid)<1) then
 176     FurCellIsNull:=true;
 177   end;
 178
 179  procedure fixNull(cell, furid:integer;);
 180   begin
 181    if FurCellIsNull(cell, furid) then
 182     begin
 183      SetFurItem(0, cell, furid);
 184      SetFurSum(0, cell, furid);
 185     end;
 186   end;
 187
 188  function CreateFurnace(x, y:integer;):integer;
 189   var
 190    i, j:integer;
 191   begin
 192    for i:=0 to MAX_FURNACE do
 193     if furnace_b[i]=false then
 194      begin
 195       furnace_b[i]:=true;
 196       for j:=0 to MAX_FURNACE_CELLS do
 197        begin
 198         furnace_item[i, j]:=0;
 199         furnace_sum[i, j]:=0;
 200        end;
 201       furnace_fstart[i]:=getTime;
 202       furnace_ftime[i]:=0;
 203       furnace_prstart[i]:=getTime;
 204       setMapInfo(i, x, y);
 205       CreateFurnace:=i;
 206       exit;
 207      end;
 208    CreateFurnace:=FURNACE_ERROR;
 209   end;
 210
 211  function FindFuel(furid:integer):integer;
 212   var
 213    i:integer;
 214   begin
 215    if FurCellIsNull(FURNACE_FUEL, furid)=false then
 216     for i:=0 to maxFuel do
 217      if GetFurItem(FURNACE_FUEL, furid)=fuel_item[i] then
 218       begin
 219        FindFuel:=i;
 220        exit;
 221       end;
 222    FindFuel:=FURNACE_ERROR;
 223   end;
 224
 225  procedure DestroyFurnace(x, y:integer);
 226   var
 227    i, j:integer;
 228   begin
 229    i:=getMapInfo(x, y);
 230    furnace_b[i]:=false;
 231    for j:=0 to MAX_FURNACE_CELLS do
 232     begin
 233      if FurCellIsNull(j, i)=false then
 234       drop.create(furnace_item[i, j], furnace_sum[i, j], x*16+4, y*16+4)
 235      furnace_item[i, j]:=0;
 236      furnace_sum[i, j]:=0;
 237     end;
 238    furnace_fstart[i]:=getTime;
 239    furnace_ftime[i]:=0;
 240    furnace_prstart[i]:=getTime;
 241   end;
 242
 243  function GetReceptOut(in_item:integer;):integer;
 244   var
 245    i:integer;
 246   begin
 247    for i:=0 to maxRecipe do
 248     if in_item=recept_in[i] then
 249      begin
 250       GetReceptOut:=recept_out[i];
 251       exit;
 252      end;
 253    GetReceptOut:=FURNACE_ERROR;
 254   end;
 255
 256  function canUpdate(i:integer):boolean;
 257   var
 258    itemIN, itemOUT, sumOUT, recipeOUT:integer;
 259   begin
 260    fixNull(FURNACE_IN, i);
 261    fixNull(FURNACE_OUT, i);
 262
 263    itemIN:=GetFurItem(FURNACE_IN, i);
 264    itemOUT:=GetFurItem(FURNACE_OUT, i);
 265    sumOUT:=GetFurSum(FURNACE_OUT, i);
 266    recipeOUT:=GetReceptOut(itemIN);
 267
 268    if (itemIN<>0) and (recipeOUT<>FURNACE_ERROR) then
 269    if (itemOUT=0) or ((itemOUT=recipeOUT) and (sumOUT<getItemMax(itemOUT))) then
 270     canUpdate:=true;
 271   end;
 272
 273  function furnaceBurn(i:integer):boolean;
 274   begin
 275    if (getTime>=startFuelTime(i)) and (getTime<=endFuelTime(i)) then
 276     furnaceBurn:=true;
 277   end;
 278
 279  function itemBurn(i:integer):boolean;
 280   begin
 281    if FurCellIsNull(FURNACE_IN, i)=false then
 282    if (getTime>=startProgTime(i)) and (getTime<=endProgTime(i)) then
 283     itemBurn:=true;
 284   end;
 285
 286  procedure useFuel(i:integer;);
 287   var
 288    fuelid, item, sum:integer;
 289   begin
 290    fuelid:=FindFuel(i);
 291    item:=GetFurItem(FURNACE_FUEL, i);
 292    sum:=GetFurSum(FURNACE_FUEL, i);
 293
 294    if getItemDiv(item) then
 295     begin
 296      sum:=sum-1;
 297      if sum<0 then
 298       item:=0;
 299     end;
 300    else
 301     begin
 302      item:=0;
 303      sum:=0;
 304     end;
 305
 306    updateFuelTime(fuel_time[fuelid], i);
 307
 308    SetFurItem(item, FURNACE_FUEL, i);
 309    SetFurSum(sum, FURNACE_FUEL, i);
 310   end;
 311
 312  procedure createOutItem(i:integer);
 313   var
 314    itemIN, sumIN, itemOUT, sumOUT, recipeOUT:integer;
 315   begin
 316    itemIN:=GetFurItem(FURNACE_IN, i);
 317    sumIN:=GetFurSum(FURNACE_IN, i);
 318    itemOUT:=GetFurItem(FURNACE_OUT, i);
 319    sumOUT:=GetFurSum(FURNACE_OUT, i);
 320    recipeOUT:=GetReceptOut(itemIN);
 321
 322    if getItemDiv(itemIN) then
 323     begin
 324      sumIN:=sumIN-1;
 325      if sumIN<0 then
 326       itemIN:=0;
 327     end;
 328    else
 329     begin
 330      itemIN:=0;
 331      sumIN:=0;
 332     end;
 333
 334    itemOUT:=recipeOUT;
 335    sumOUT:=sumOUT+1;
 336
 337    SetFurItem(itemIN, FURNACE_IN, i);
 338    SetFurSum(sumIN, FURNACE_IN, i);
 339    SetFurItem(itemOUT, FURNACE_OUT, i);
 340    SetFurSum(sumOUT, FURNACE_OUT, i);
 341   end;
 342
 343  procedure UpdateFurnaces;
 344   var
 345    i, fuelid:integer;
 346   begin
 347    for i:=0 to MAX_FURNACE do
 348     if furnace_b[i] then
 349      if canUpdate(i) then
 350       begin
 351        if furnaceBurn(i) then
 352         begin
 353          if itemBurn(i)=false then
 354           begin
 355            createOutItem(i);
 356            ResetProgress(i);
 357           end;
 358         end;
 359        else
 360         begin
 361          fuelid:=FindFuel(i);
 362          if fuelid=FURNACE_ERROR then
 363           ResetProgress(i);
 364          else
 365           useFuel(i);
 366         end;
 367       end;
 368      else
 369       ResetProgress(i);
 370
 371    UpdateTime;
 372   end;
 373
 374   procedure SaveData;
 375     var
 376       i, j : Integer;
 377     begin
 378       for i := 0 to MAX_FURNACE do
 379         begin
 380           writebool(furnace_b[i]);
 381           for j := 0 to MAX_FURNACE_CELLS do
 382             begin
 383               write_byte(furnace_item[i, j]);
 384               writeint(furnace_sum[i, j]);
 385             end;
 386           writeint(furnace_fstart[i]);
 387           writeint(furnace_ftime[i]);
 388           writeint(furnace_prstart[i]);
 389         end;
 390     end;
 391
 392   procedure LoadData;
 393     var
 394       i, j : Integer;
 395     begin
 396       for i := 0 to MAX_FURNACE do
 397         begin
 398           furnace_b[i] := readbool;
 399           for j := 0 to MAX_FURNACE_CELLS do
 400             begin
 401               furnace_item[i, j] := read_byte;
 402               furnace_sum[i, j]  := readint;
 403             end;
 404           furnace_fstart[i]  := readint;
 405           furnace_ftime[i]   := readint;
 406           furnace_prstart[i] := readint;
 407         end;
 408     end;
 409
 410   procedure ResetData;
 411     var
 412       i, j : Integer;
 413     begin
 414       for i := 0 to MAX_FURNACE do
 415         begin
 416           furnace_b[i] := false;
 417           for j := 0 to MAX_FURNACE_CELLS do
 418             begin
 419               furnace_item[i, j] := 0;
 420               furnace_sum[i, j]  := 0;
 421             end;
 422           furnace_fstart[i]  := 0;
 423           furnace_ftime[i]   := 0;
 424           furnace_prstart[i] := 0;
 425         end;
 426     end;
 427
 428 end.