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, vars;
  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 mapBoundCheck(x, y : Integer) : Boolean;
  50    begin
  51      mapBoundCheck := (x < 0) or (x > MAP_W * TILE_SIZE);
  52    end;
  53
  54  function onMapObjectCheck(x, y, w, h : Integer) : Boolean;
  55    begin
  56      onMapObjectCheck := mapBoundCheck(x, y) or mapBoundCheck(x + w, y + h);
  57    end;
  58
  59  function isSolid(x, y, velx, vely:integer):boolean;
  60    begin
  61      isSolid := getBlockColl(getMap(x, y)) <> 0;
  62    end;
  63
  64  function mapColl(x, y, w, h, velx, vely:integer):boolean;
  65    var
  66     i, j:integer;
  67     minx, miny, maxx, maxy:integer;
  68    begin
  69      if onMapObjectCheck(x, y, w, h) then
  70        begin
  71          mapColl := true;
  72          exit;
  73        end;
  74
  75      minx:=x div TILE_SIZE;
  76      miny:=y div TILE_SIZE;
  77      maxx:=(x+w-1) div TILE_SIZE;
  78      maxy:=(y+h-1) div TILE_SIZE;
  79      for i:=minx to maxx do
  80      for j:=miny to maxy do
  81        begin
  82          if isSolid(i, j, velx, vely) then
  83            begin
  84              mapColl:=true;
  85              exit;
  86            end;
  87        end;
  88   end;
  89
  90  function canSeeObj(x1, y1, x2, y2:integer):boolean;
  91   var
  92    deltax, deltay:integer;
  93    signx, signy:integer;
  94    error, error2:integer;
  95   begin
  96    x1:=x1/TILE_SIZE;
  97    y1:=y1/TILE_SIZE;
  98    x2:=x2/TILE_SIZE;
  99    y2:=y2/TILE_SIZE;
 100
 101    deltax:=abs(x2-x1);
 102    deltay:=abs(y2-y1);
 103
 104    if x1<x2 then
 105     signx:=1;
 106    else
 107     signx:=-1;
 108
 109    if y1<y2 then
 110     signy:=1;
 111    else
 112     signy:=-1;
 113
 114    error:=deltaX-deltaY;
 115
 116    while((x1<>x2) or (y1<>y2)) do
 117     begin
 118      if isSolid(x1, y1, 0, 0) then
 119       exit;
 120
 121      error2:=error<<1;
 122      if error2>-deltaY then
 123       begin
 124        error:=error-deltaY;
 125        x1:=x1+signX;
 126       end;
 127
 128      if error2<deltaX then
 129       begin
 130        error:=error+deltaX;
 131        y1:=y1+signY;
 132       end;
 133     end;
 134    canSeeObj:=true;
 135   end;
 136
 137  function mapCollType(_type, x, y, w, h:integer):boolean;
 138   var
 139    i, j:integer;
 140    minx, miny, maxx, maxy:integer;
 141   begin
 142    minx:=x div TILE_SIZE;
 143    miny:=y div TILE_SIZE;
 144    maxx:=(x+w-1) div TILE_SIZE;
 145    maxy:=(y+h-1) div TILE_SIZE;
 146    for i:=minx to maxx do
 147    for j:=miny to maxy do
 148     begin
 149      if getMap(i, j)=_type then
 150       begin
 151        mapCollType:=true;
 152        exit;
 153       end;
 154     end;
 155  end;
 156
 157  procedure calcGravity;
 158   var
 159    i:integer;
 160   begin
 161    vely:=vely+1;
 162    if vely>MAX_VELY then
 163     vely:=MAX_VELY;
 164
 165    jmp:=false;
 166
 167    if vely>0 then
 168     for i:=1 to vely do
 169      begin
 170       y:=y+1;
 171       if mapColl(x, y, w, h, velx, vely) then
 172        begin
 173         y:=y-1;
 174         vely:=0;
 175         jmp:=true;
 176         break;
 177        end;
 178      end;
 179    else
 180     for i:=1 to abs(vely) do
 181      begin
 182       y:=y-1;
 183       if mapColl(x, y, w, h, velx, vely) then
 184        begin
 185         y:=y+1;
 186         vely:=0;
 187         jmp:=false;
 188         break;
 189        end;
 190      end;
 191   end;
 192
 193  function fixVYup:boolean;
 194   begin
 195    if (vely>-5) and
 196       (mapCollType(49, x, y, w, h) or
 197        mapCollType(103, x, y, w, h) or
 198        mapCollType(108, x, y, w, h)) then
 199         vely:=vely-2;
 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:=vely-2;
 205    else
 206     fixVYup:=true;
 207   end;
 208
 209  procedure fixVYdown;
 210   begin
 211    if (vely>5) and
 212       (mapCollType(49, x, y, w, h) or
 213        mapCollType(103, x, y, w, h)) then
 214         vely:=5;
 215    else
 216    if (vely>4) and
 217       (mapCollType(50, x, y, w, h) or
 218        mapCollType(51, x, y, w, h)) then
 219         vely:=4;
 220   end;
 221
 222  procedure jumpObj(vel:integer);
 223   begin
 224    if fixVYup then
 225    if jmp then
 226     begin
 227      vely:=-vel;
 228      jmp:=false;
 229     end;
 230   end;
 231
 232  procedure calcX;
 233   var
 234    i:integer;
 235   begin
 236    if velx>0 then
 237     for i:=1 to velx do
 238      begin
 239       x:=x+1;
 240       if mapColl(x, y, w, h, velx, vely) then
 241        begin
 242         x:=x-1;
 243         velx:=0;
 244         break;
 245        end;
 246      end;
 247    else
 248    if velx<0 then
 249     for i:=1 to abs(velx) do //there for-downto-do have a bug!
 250      begin
 251       x:=x-1;
 252       if mapColl(x, y, w, h, velx, vely) then
 253        begin
 254         x:=x+1;
 255         velx:=0;
 256         break;
 257        end;
 258      end;
 259
 260    if velx>0 then
 261     velx:=velx-1;
 262    else
 263    if velx<0 then
 264     velx:=velx+1;
 265   end;
 266
 267  procedure calcY;
 268   var
 269    i:integer;
 270   begin
 271    if vely>0 then
 272     for i:=1 to vely do
 273      begin
 274       y:=y+1;
 275       if mapColl(x, y, w, h, velx, vely) then
 276        begin
 277         y:=y-1;
 278         vely:=0;
 279         break;
 280        end;
 281      end;
 282    else
 283    if vely<0 then
 284     for i:=1 to abs(vely) do //there for-downto-do have a bug!
 285      begin
 286       y:=y-1;
 287       if mapColl(x, y, w, h, velx, vely) then
 288        begin
 289         y:=y+1;
 290         velx:=0;
 291         break;
 292        end;
 293      end;
 294
 295    if vely>0 then
 296     vely:=vely-1;
 297    else
 298    if vely<0 then
 299     vely:=vely+1;
 300   end;
 301
 302  function getX:integer;
 303   begin
 304    getX:=x;
 305   end;
 306
 307  function getY:integer;
 308   begin
 309    getY:=y;
 310   end;
 311
 312  function getVelX:integer;
 313   begin
 314    getVelX:=velx;
 315   end;
 316
 317  function getVelY:integer;
 318   begin
 319    getVelY:=vely;
 320   end;
 321
 322  function getJmp:boolean;
 323   begin
 324    getJmp:=jmp;
 325   end;
 326
 327  procedure calc(gravity:boolean);
 328   begin
 329    calcX;
 330
 331    if gravity then
 332     begin
 333       calcGravity;
 334       fixVYdown;
 335     end;
 336    else
 337     calcY;
 338   end;
 339
 340 end.