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