src/drop.mpsrc

   1 unit drop;
   2
   3 interface
   4  var
   5   drp_phy, drw_drp, ref_drp:boolean;
   6
   7  function max:integer;
   8  function getX(i:integer):integer;
   9  function getY(i:integer):integer;
  10  function getW:integer;
  11  function getH:integer;
  12  function getItem(i:integer):integer;
  13  function getSum(i:integer):integer;
  14  procedure setItem(val, i:integer);
  15  procedure setSum(val, i:integer);
  16  function isNull(i:integer):boolean;
  17  procedure fixNull(i:integer);
  18
  19  procedure draw(camx, camy:integer);
  20  procedure calcPhy;
  21  procedure reflux;
  22
  23  procedure create(item, sum, x, y:integer);
  24  procedure resetData;
  25  procedure saveData;
  26  procedure loadData;
  27
  28 implementation
  29
  30   uses phy, jsr75i, vars, items_store, func, ItemsLogic;
  31
  32  const
  33   MAX_DROP=255;
  34   DROP_W=8;
  35   DROP_H=8;
  36  var
  37   drop_x, drop_y, drop_vely: array [0..MAX_DROP] of integer;
  38   drop_item, drop_sum: array [0..MAX_DROP] of integer;
  39
  40   old_drop, ref_drp_count:integer;
  41
  42  function max:integer;
  43   begin
  44    max:=MAX_DROP;
  45   end;
  46
  47  function getX(i:integer):integer;
  48   begin
  49    getX:=drop_x[i];
  50   end;
  51
  52  function getY(i:integer):integer;
  53   begin
  54    getY:=drop_y[i];
  55   end;
  56
  57  function getW:integer;
  58   begin
  59    getW:=DROP_W;
  60   end;
  61
  62  function getH:integer;
  63   begin
  64    getH:=DROP_H;
  65   end;
  66
  67  function getItem(i:integer):integer;
  68   begin
  69    getItem:=drop_item[i];
  70   end;
  71
  72  function getSum(i:integer):integer;
  73   begin
  74    getSum:=drop_sum[i];
  75   end;
  76
  77  procedure setItem(val, i:integer);
  78   begin
  79    drop_item[i]:=val;
  80   end;
  81
  82  procedure setSum(val, i:integer);
  83   begin
  84    drop_sum[i]:=val;
  85   end;
  86
  87  function isNull(i:integer):boolean;
  88   begin
  89    if (drop_item[i]<1) or (drop_sum[i]<1) then
  90     isNull:=true;
  91   end;
  92
  93  procedure fixNull(i:integer);
  94   begin
  95    if isNull(i) then
  96     begin
  97      drop_item[i]:=0;
  98      drop_sum[i]:=0;
  99     end;
 100   end;
 101
 102  procedure create(item, sum, x, y:integer);
 103   var
 104    i:integer;
 105   begin
 106    for i:=0 to MAX_DROP do
 107     if isNull(i) then
 108      begin
 109       drop_item[i]:=item;
 110       drop_sum[i]:=sum;
 111       drop_x[i]:=x;
 112       drop_y[i]:=y;
 113       drop_vely[i]:=0;
 114       exit;
 115      end;
 116
 117   drop_item[old_drop]:=item;
 118   drop_sum[old_drop]:=sum;
 119   drop_x[old_drop]:=x;
 120   drop_y[old_drop]:=y;
 121   drop_vely[old_drop]:=0;
 122
 123   old_drop:=old_drop+1;
 124   if old_drop>MAX_DROP then
 125    old_drop:=0;
 126  end;
 127
 128  procedure calcPhy;
 129   var
 130    i:integer;
 131   begin
 132    if drp_phy then
 133     for i:=0 to MAX_DROP do
 134      if isNull(i)=false then
 135       begin
 136        Phy.SetObject(drop_x[i], drop_y[i], DROP_W, DROP_H, 0, drop_vely[i], false);
 137        Phy.Step(true);
 138        drop_x[i]:=Phy.GetX;
 139        drop_y[i]:=Phy.GetY;
 140        drop_vely[i]:=Phy.GetVY;
 141       end;
 142   end;
 143
 144   procedure draw(camx, camy : integer);
 145     var
 146      i : integer;
 147     begin
 148       if not drw_drp then exit;
 149       for i:=0 to 255 do if IsNull(i) = false then begin
 150         ItemsLogic.DrawSmall(drop_item[i], drop_x[i] - camx, drop_y[i] - camy);
 151       end;
 152     end;
 153
 154  procedure reflux;
 155   var
 156    i:integer;
 157   begin
 158    if ref_drp then
 159     begin
 160      for i:=ref_drp_count+1 to MAX_DROP do
 161       if (isNull(ref_drp_count) and isNull(i))=false then
 162        if (drop_item[ref_drp_count]=drop_item[i]) and (drop_x[ref_drp_count]=drop_x[i]) and (drop_y[ref_drp_count]=drop_y[i]) then
 163         begin
 164          drop_sum[ref_drp_count]:=drop_sum[ref_drp_count]+drop_sum[i];
 165          drop_item[i]:=0;
 166          drop_sum[i]:=0;
 167         end;
 168
 169     ref_drp_count:=ref_drp_count+1;
 170     if ref_drp_count>MAX_DROP then ref_drp_count:=0;
 171    end;
 172   end;
 173
 174  procedure resetData;
 175   var
 176    i:integer;
 177   begin
 178    for i:=0 to MAX_DROP do
 179     begin
 180      drop_item[i]:=0;
 181      drop_sum[i]:=0;
 182      drop_x[i]:=0;
 183      drop_y[i]:=0;
 184      drop_vely[i]:=0;
 185     end;
 186   end;
 187
 188  procedure saveData;
 189   var
 190    i:integer;
 191   begin
 192    for i:=0 to MAX_DROP do
 193     begin
 194      write_byte(drop_item[i]);
 195      writeint(drop_sum[i]);
 196      writeint(drop_x[i]);
 197      writeint(drop_y[i]);
 198      write_byte(drop_vely[i]);
 199     end;
 200   end;
 201
 202  procedure loadData;
 203   var
 204    i:integer;
 205   begin
 206    for i:=0 to MAX_DROP do
 207     begin
 208      drop_item[i]:=read_byte;
 209      drop_sum[i]:=ReadInt;
 210      drop_x[i]:=ReadInt;
 211      drop_y[i]:=ReadInt;
 212      drop_vely[i]:=read_byte;
 213     end;
 214   end;
 215
 216 end.