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=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 implementation
  42  uses maps, drop, items_store, items;
  43  var
  44   furnace_b: array [0..MAX_FURNACE] of boolean;
  45   furnace_item, furnace_sum: array [0..MAX_FURNACE, 0..MAX_FURNACE_CELLS] of integer;
  46   furnace_fstart, furnace_ftime, furnace_prstart: array [0..MAX_FURNACE] of integer;
  47
  48   time:integer;
  49   maxFuel, maxRecipe:integer;
  50   fuel_item, fuel_time: array [0..0] of integer;
  51   recept_in, recept_out: array [0..0] of integer;
  52
  53  function getTime:integer;
  54   begin
  55    getTime:=time;
  56   end;
  57
  58  procedure UpdateTime;
  59   begin
  60    time:=getRelativeTimeMs;
  61   end;
  62
  63  function startFuelTime(i:integer):integer;
  64   begin
  65    startFuelTime:=furnace_fstart[i];
  66   end;
  67
  68  function endFuelTime(i:integer):integer;
  69   begin
  70    endFuelTime:=furnace_fstart[i]+furnace_ftime[i];
  71   end;
  72
  73  function FuelTime(i:integer):integer;
  74   begin
  75    FuelTime:=furnace_ftime[i];
  76   end;
  77
  78  procedure updateFuelTime(fueltime, i:integer);
  79   begin
  80    furnace_fstart[i]:=getTime;
  81    furnace_ftime[i]:=fueltime;
  82   end;
  83
  84  function startProgTime(i:integer):integer;
  85   begin
  86    startProgTime:=furnace_prstart[i];
  87   end;
  88
  89  function endProgTime(i:integer):integer;
  90   begin
  91    endProgTime:=furnace_prstart[i]+ITEM_IN_FIRE;
  92   end;
  93
  94  function ProgTime(i:integer):integer;
  95   begin
  96    ProgTime:=ITEM_IN_FIRE;
  97   end;
  98
  99  procedure setMaxFuel(i:integer;);
 100   begin
 101    maxFuel:=i;
 102    i:=i+1;
 103    bytecode
 104     iload 0;
 105     newarray 10;
 106     putstatic field 'furnace', 'fuel_item', '[I';
 107    end;
 108    bytecode
 109     iload 0;
 110     newarray 10;
 111     putstatic field 'furnace', 'fuel_time', '[I';
 112    end;
 113   end;
 114
 115  procedure setMaxRecipes(i:integer);
 116   begin
 117    maxRecipe:=i;
 118    i:=i+1;
 119    bytecode
 120     iload 0;
 121     newarray 10;
 122     putstatic field 'furnace', 'recept_in', '[I';
 123    end;
 124    bytecode
 125     iload 0;
 126     newarray 10;
 127     putstatic field 'furnace', 'recept_out', '[I';
 128    end;
 129   end;
 130
 131  procedure initFuel(id, item, time:integer);
 132   begin
 133    fuel_item[id]:=item;
 134    fuel_time[id]:=time;
 135   end;
 136
 137  procedure initRecipe(id, in_item, out_item:integer);
 138   begin
 139    recept_in[id]:=in_item;
 140    recept_out[id]:=out_item;
 141   end;
 142
 143  procedure ResetProgress(furid:integer);
 144   begin
 145    furnace_prstart[furid]:=getTime;
 146   end;
 147
 148  function GetFurItem(cell, furid:integer;):integer;
 149   begin
 150    GetFurItem:=furnace_item[furid, cell];
 151   end;
 152
 153  procedure SetFurItem(val, cell, furid:integer;);
 154   begin
 155    furnace_item[furid, cell]:=val;
 156   end;
 157
 158  function GetFurSum(cell, furid:integer;):integer;
 159   begin
 160    GetFurSum:=furnace_sum[furid, cell];
 161   end;
 162
 163  procedure SetFurSum(val, cell, furid:integer;);
 164   begin
 165    furnace_sum[furid, cell]:=val;
 166   end;
 167
 168  function FurCellIsNull(cell, furid:integer;):boolean;
 169   begin
 170    if (GetFurItem(cell, furid)<1) or (GetFurSum(cell, furid)<1) then
 171     FurCellIsNull:=true;
 172   end;
 173
 174  procedure fixNull(cell, furid:integer;);
 175   begin
 176    if FurCellIsNull(cell, furid) then
 177     begin
 178      SetFurItem(0, cell, furid);
 179      SetFurSum(0, cell, furid);
 180     end;
 181   end;
 182
 183  function CreateFurnace(x, y:integer;):integer;
 184   var
 185    i, j:integer;
 186   begin
 187    for i:=0 to MAX_FURNACE do
 188     if furnace_b[i]=false then
 189      begin
 190       furnace_b[i]:=true;
 191       for j:=0 to MAX_FURNACE_CELLS do
 192        begin
 193         furnace_item[i, j]:=0;
 194         furnace_sum[i, j]:=0;
 195        end;
 196       furnace_fstart[i]:=getTime;
 197       furnace_ftime[i]:=0;
 198       furnace_prstart[i]:=getTime;
 199       setMapInfo(i, x, y);
 200       CreateFurnace:=i;
 201       exit;
 202      end;
 203    CreateFurnace:=FURNACE_ERROR;
 204   end;
 205
 206  function FindFuel(furid:integer):integer;
 207   var
 208    i:integer;
 209   begin
 210    if FurCellIsNull(FURNACE_FUEL, furid)=false then
 211     for i:=0 to maxFuel do
 212      if GetFurItem(FURNACE_FUEL, furid)=fuel_item[i] then
 213       begin
 214        FindFuel:=i;
 215        exit;
 216       end;
 217    FindFuel:=FURNACE_ERROR;
 218   end;
 219
 220  procedure DestroyFurnace(x, y:integer);
 221   var
 222    i, j:integer;
 223   begin
 224    i:=getMapInfo(x, y);
 225    furnace_b[i]:=false;
 226    for j:=0 to MAX_FURNACE_CELLS do
 227     begin
 228      if FurCellIsNull(j, i)=false then
 229       drop.create(furnace_item[i, j], furnace_sum[i, j], x*16+4, y*16+4)
 230      furnace_item[i, j]:=0;
 231      furnace_sum[i, j]:=0;
 232     end;
 233    furnace_fstart[i]:=getTime;
 234    furnace_ftime[i]:=0;
 235    furnace_prstart[i]:=getTime;
 236   end;
 237
 238  function GetReceptOut(in_item:integer;):integer;
 239   var
 240    i:integer;
 241   begin
 242    for i:=0 to maxRecipe do
 243     if in_item=recept_in[i] then
 244      begin
 245       GetReceptOut:=recept_out[i];
 246       exit;
 247      end;
 248    GetReceptOut:=FURNACE_ERROR;
 249   end;
 250
 251  function canUpdate(i:integer):boolean;
 252   var
 253    itemIN, itemOUT, sumOUT, recipeOUT:integer;
 254   begin
 255    fixNull(FURNACE_IN, i);
 256    fixNull(FURNACE_OUT, i);
 257
 258    itemIN:=GetFurItem(FURNACE_IN, i);
 259    itemOUT:=GetFurItem(FURNACE_OUT, i);
 260    sumOUT:=GetFurSum(FURNACE_OUT, i);
 261    recipeOUT:=GetReceptOut(itemIN);
 262
 263    if (itemIN<>0) and (recipeOUT<>FURNACE_ERROR) then
 264    if (itemOUT=0) or ((itemOUT=recipeOUT) and (sumOUT<getItemMax(itemOUT))) then
 265     canUpdate:=true;
 266   end;
 267
 268  function furnaceBurn(i:integer):boolean;
 269   begin
 270    if (getTime>=startFuelTime(i)) and (getTime<=endFuelTime(i)) then
 271     furnaceBurn:=true;
 272   end;
 273
 274  function itemBurn(i:integer):boolean;
 275   begin
 276    if FurCellIsNull(FURNACE_IN, i)=false then
 277    if (getTime>=startProgTime(i)) and (getTime<=endProgTime(i)) then
 278     itemBurn:=true;
 279   end;
 280
 281  procedure useFuel(i:integer;);
 282   var
 283    fuelid, item, sum:integer;
 284   begin
 285    fuelid:=FindFuel(i);
 286    item:=GetFurItem(FURNACE_FUEL, i);
 287    sum:=GetFurSum(FURNACE_FUEL, i);
 288
 289    if getItemDiv(item) then
 290     begin
 291      sum:=sum-1;
 292      if sum<0 then
 293       item:=0;
 294     end;
 295    else
 296     begin
 297      item:=0;
 298      sum:=0;
 299     end;
 300
 301    updateFuelTime(fuel_time[fuelid], i);
 302
 303    SetFurItem(item, FURNACE_FUEL, i);
 304    SetFurSum(sum, FURNACE_FUEL, i);
 305   end;
 306
 307  procedure createOutItem(i:integer);
 308   var
 309    itemIN, sumIN, itemOUT, sumOUT, recipeOUT:integer;
 310   begin
 311    itemIN:=GetFurItem(FURNACE_IN, i);
 312    sumIN:=GetFurSum(FURNACE_IN, i);
 313    itemOUT:=GetFurItem(FURNACE_OUT, i);
 314    sumOUT:=GetFurSum(FURNACE_OUT, i);
 315    recipeOUT:=GetReceptOut(itemIN);
 316
 317    if getItemDiv(itemIN) then
 318     begin
 319      sumIN:=sumIN-1;
 320      if sumIN<0 then
 321       itemIN:=0;
 322     end;
 323    else
 324     begin
 325      itemIN:=0;
 326      sumIN:=0;
 327     end;
 328
 329    itemOUT:=recipeOUT;
 330    sumOUT:=sumOUT+1;
 331
 332    SetFurItem(itemIN, FURNACE_IN, i);
 333    SetFurSum(sumIN, FURNACE_IN, i);
 334    SetFurItem(itemOUT, FURNACE_OUT, i);
 335    SetFurSum(sumOUT, FURNACE_OUT, i);
 336   end;
 337
 338  procedure UpdateFurnaces;
 339   var
 340    i, fuelid:integer;
 341   begin
 342    for i:=0 to MAX_FURNACE do
 343     if furnace_b[i] then
 344      if canUpdate(i) then
 345       begin
 346        if furnaceBurn(i) then
 347         begin
 348          if itemBurn(i)=false then
 349           begin
 350            createOutItem(i);
 351            ResetProgress(i);
 352           end;
 353         end;
 354        else
 355         begin
 356          fuelid:=FindFuel(i);
 357          if fuelid=FURNACE_ERROR then
 358           ResetProgress(i);
 359          else
 360           useFuel(i);
 361         end;
 362       end;
 363      else
 364       ResetProgress(i);
 365
 366    UpdateTime;
 367   end;
 368
 369 end.