src/phy.pas

   1 unit phy;
   2
   3 interface
   4  procedure loadObject(_x, _y, _w, _h, _velx, _vely:integer; _jmp:boolean);
   5
   6  function isSolid(x, y, velx, vely:integer):boolean;
   7
   8  function mapCollType(_type, x, y, w, h:integer):boolean;
   9
  10  function CollTwoObj(x1,y1,w1,h1,x2,y2,w2,h2:integer):boolean;
  11
  12  procedure jumpObj(vel:integer);
  13  procedure calc(gravity:boolean);
  14
  15  function getX:integer;
  16  function getY:integer;
  17  function getVelX:integer;
  18  function getVelY:integer;
  19  function getJmp:boolean;
  20
  21  function canSeeObj(x1, y1, x2, y2:integer):boolean;
  22
  23 implementation
  24  uses items_store, maps;
  25  const
  26   MAX_VELY=32;
  27   TILE_SIZE=16;
  28  var
  29   x, y, w, h, velx, vely:integer;
  30   jmp:boolean;
  31
  32 function CollTwoObj(x1,y1,w1,h1,x2,y2,w2,h2:integer):boolean;
  33  begin
  34   if (x1+w1>x2) and (x1<x2+w2) and (y1+h1>y2) and (y1<y2+h2) then
  35    CollTwoObj:=true;
  36  end;
  37
  38  procedure loadObject(_x, _y, _w, _h, _velx, _vely:integer; _jmp:boolean);
  39   begin
  40    x:=_x;
  41    y:=_y;
  42    w:=_w;
  43    h:=_h;
  44    velx:=_velx;
  45    vely:=_vely;
  46    jmp:=_jmp;
  47   end;
  48
  49  function isSolid(x, y, velx, vely:integer):boolean;
  50   begin
  51    if getBlockColl(getMap(x, y))<>0 then
  52     isSolid:=true;
  53   end;
  54
  55  function mapColl(x, y, w, h, velx, vely:integer):boolean;
  56   var
  57    i, j:integer;
  58    minx, miny, maxx, maxy:integer;
  59   begin
  60    minx:=x div TILE_SIZE;
  61    miny:=y div TILE_SIZE;
  62    maxx:=(x+w-1) div TILE_SIZE;
  63    maxy:=(y+h-1) div TILE_SIZE;
  64    for i:=minx to maxx do
  65    for j:=miny to maxy do
  66     begin
  67      if isSolid(i, j, velx, vely) then
  68       begin
  69        mapColl:=true;
  70        exit;
  71       end;
  72     end;
  73  end;
  74
  75  function canSeeObj(x1, y1, x2, y2:integer):boolean;
  76   var
  77    deltax, deltay:integer;
  78    signx, signy:integer;
  79    error, error2:integer;
  80   begin
  81    x1:=x1/TILE_SIZE;
  82    y1:=y1/TILE_SIZE;
  83    x2:=x2/TILE_SIZE;
  84    y2:=y2/TILE_SIZE;
  85
  86    deltax:=abs(x2-x1);
  87    deltay:=abs(y2-y1);
  88
  89    if x1<x2 then
  90     signx:=1;
  91    else
  92     signx:=-1;
  93
  94    if y1<y2 then
  95     signy:=1;
  96    else
  97     signy:=-1;
  98
  99    error:=deltaX-deltaY;
 100
 101    while((x1<>x2) or (y1<>y2)) do
 102     begin
 103      if isSolid(x1, y1, 0, 0) then
 104       exit;
 105
 106      error2:=error<<1;
 107      if error2>-deltaY then
 108       begin
 109        error:=error-deltaY;
 110        x1:=x1+signX;
 111       end;
 112
 113      if error2<deltaX then
 114       begin
 115        error:=error+deltaX;
 116        y1:=y1+signY;
 117       end;
 118     end;
 119    canSeeObj:=true;
 120   end;
 121
 122  function mapCollType(_type, x, y, w, h:integer):boolean;
 123   var
 124    i, j:integer;
 125    minx, miny, maxx, maxy:integer;
 126   begin
 127    minx:=x div TILE_SIZE;
 128    miny:=y div TILE_SIZE;
 129    maxx:=(x+w-1) div TILE_SIZE;
 130    maxy:=(y+h-1) div TILE_SIZE;
 131    for i:=minx to maxx do
 132    for j:=miny to maxy do
 133     begin
 134      if getMap(i, j)=_type then
 135       begin
 136        mapCollType:=true;
 137        exit;
 138       end;
 139     end;
 140  end;
 141
 142  procedure calcGravity;
 143   var
 144    i:integer;
 145   begin
 146    vely:=vely+1;
 147    if vely>MAX_VELY then
 148     vely:=MAX_VELY;
 149
 150    jmp:=false;
 151
 152    if vely>0 then
 153     for i:=1 to vely do
 154      begin
 155       y:=y+1;
 156       if mapColl(x, y, w, h, velx, vely) then
 157        begin
 158         y:=y-1;
 159         vely:=0;
 160         jmp:=true;
 161         break;
 162        end;
 163      end;
 164    else
 165     for i:=1 to abs(vely) do
 166      begin
 167       y:=y-1;
 168       if mapColl(x, y, w, h, velx, vely) then
 169        begin
 170         y:=y+1;
 171         vely:=0;
 172         jmp:=false;
 173         break;
 174        end;
 175      end;
 176   end;
 177
 178  function fixVYup:boolean;
 179   begin
 180    if (vely>-5) and
 181       (mapCollType(49, x, y, w, h) or
 182        mapCollType(103, x, y, w, h) or
 183        mapCollType(108, x, y, w, h)) then
 184         vely:=vely-2;
 185    else
 186    if (vely>-4) and
 187       (mapCollType(50, x, y, w, h) or
 188        mapCollType(51, x, y, w, h)) then
 189         vely:=vely-2;
 190    else
 191     fixVYup:=true;
 192   end;
 193
 194  procedure fixVYdown;
 195   begin
 196    if (vely>5) and
 197       (mapCollType(49, x, y, w, h) or
 198        mapCollType(103, x, y, w, h)) then
 199         vely:=5;
 200    else
 201    if (vely>4) and
 202       (mapCollType(50, x, y, w, h) or
 203        mapCollType(51, x, y, w, h)) then
 204         vely:=4;
 205   end;
 206
 207  procedure jumpObj(vel:integer);
 208   begin
 209    if fixVYup then
 210    if jmp then
 211     begin
 212      vely:=-vel;
 213      jmp:=false;
 214     end;
 215   end;
 216
 217  procedure calcX;
 218   var
 219    i:integer;
 220   begin
 221    if velx>0 then
 222     for i:=1 to velx do
 223      begin
 224       x:=x+1;
 225       if mapColl(x, y, w, h, velx, vely) then
 226        begin
 227         x:=x-1;
 228         velx:=0;
 229         break;
 230        end;
 231      end;
 232    else
 233    if velx<0 then
 234     for i:=1 to abs(velx) do //there for-downto-do have a bug!
 235      begin
 236       x:=x-1;
 237       if mapColl(x, y, w, h, velx, vely) then
 238        begin
 239         x:=x+1;
 240         velx:=0;
 241         break;
 242        end;
 243      end;
 244
 245    if velx>0 then
 246     velx:=velx-1;
 247    else
 248    if velx<0 then
 249     velx:=velx+1;
 250   end;
 251
 252  procedure calcY;
 253   var
 254    i:integer;
 255   begin
 256    if vely>0 then
 257     for i:=1 to vely do
 258      begin
 259       y:=y+1;
 260       if mapColl(x, y, w, h, velx, vely) then
 261        begin
 262         y:=y-1;
 263         vely:=0;
 264         break;
 265        end;
 266      end;
 267    else
 268    if vely<0 then
 269     for i:=1 to abs(vely) do //there for-downto-do have a bug!
 270      begin
 271       y:=y-1;
 272       if mapColl(x, y, w, h, velx, vely) then
 273        begin
 274         y:=y+1;
 275         velx:=0;
 276         break;
 277        end;
 278      end;
 279
 280    if vely>0 then
 281     vely:=vely-1;
 282    else
 283    if vely<0 then
 284     vely:=vely+1;
 285   end;
 286
 287  function getX:integer;
 288   begin
 289    getX:=x;
 290   end;
 291
 292  function getY:integer;
 293   begin
 294    getY:=y;
 295   end;
 296
 297  function getVelX:integer;
 298   begin
 299    getVelX:=velx;
 300   end;
 301
 302  function getVelY:integer;
 303   begin
 304    getVelY:=vely;
 305   end;
 306
 307  function getJmp:boolean;
 308   begin
 309    getJmp:=jmp;
 310   end;
 311
 312  procedure calc(gravity:boolean);
 313   begin
 314    calcX;
 315
 316    if gravity then
 317     begin
 318       calcGravity;
 319       fixVYdown;
 320     end;
 321    else
 322     calcY;
 323   end;
 324
 325 end.