src/phy.pas

   1 unit Phy;
   2
   3 interface
   4
   5   function IsSolid(x, y : integer) : boolean;
   6   function RayTraced(x1, y1, x2, y2 : integer) : boolean;
   7   function AreaWithBlock(block, x, y, w, h : integer) : boolean;
   8   function IntersectRects(x1, y1, w1, h1, x2, y2, w2, h2 : integer) : boolean;
   9
  10   procedure SetObject(_x, _y, _w, _h, _vx, _vy : integer; _jmp : boolean);
  11   procedure Jump(vel : integer);
  12   procedure Step(gravity : boolean);
  13
  14   function GetX : integer;
  15   function GetY : integer;
  16   function GetVX : integer;
  17   function GetVY : integer;
  18   function GetGCV : integer;
  19   function GetJump : boolean;
  20
  21 implementation
  22
  23   uses items_store, maps, vars;
  24
  25   const
  26     maxVelocity = 32;
  27     tileSize = 16;
  28
  29   var
  30     x, y, w, h, vx, vy, gcv : integer;
  31     jmp : boolean;
  32
  33   function IntersectRects(x1, y1, w1, h1, x2, y2, w2, h2 : integer) : boolean;
  34     begin
  35       result := (x1 + w1 > x2) and (x1 < x2 + w2) and (y1 + h1 > y2) and (y1 < y2 + h2);
  36     end;
  37
  38   procedure SetObject(x_, y_, w_, h_, vx_, vy_ : integer; jmp_ : boolean);
  39     begin
  40       x := x_;
  41       y := y_;
  42       w := w_;
  43       h := h_;
  44       vx := vx_;
  45       vy := vy_;
  46       jmp := jmp_;
  47     end;
  48
  49   function MapBoundCheck(x, y : Integer) : Boolean;
  50     begin
  51       result := (x < 0) or (x > MAP_W * tileSize);
  52     end;
  53
  54   function OnMapObjectCheck(x, y, w, h : Integer) : Boolean;
  55     begin
  56       result := MapBoundCheck(x, y) or MapBoundCheck(x + w, y + h);
  57     end;
  58
  59   function IsSolid(x, y : integer) : boolean;
  60     begin
  61       isSolid := GetBlockColl(getMap(x, y)) <> 0;
  62     end;
  63
  64   function MapColl(x, y, w, h : integer) : boolean;
  65     var
  66       i, j : integer;
  67       minx, miny, maxx, maxy : integer;
  68     begin
  69       if OnMapObjectCheck(x, y, w, h) then begin
  70         MapColl := true;
  71         exit;
  72       end;
  73
  74       minx := x div tileSize;
  75       miny := y div tileSize;
  76       maxx := (x + w - 1) div tileSize;
  77       maxy := (y + h - 1) div tileSize;
  78
  79       for j := miny to maxy do
  80         for i := minx to maxx do
  81           if IsSolid(i, j) then begin
  82             MapColl:=true;
  83             exit;
  84           end;
  85     end;
  86
  87  function RayTraced(x1, y1, x2, y2 : integer) : boolean;
  88    var
  89      deltax, deltay : integer;
  90      signx, signy : integer;
  91      error, error2 : integer;
  92    begin
  93      x1 := x1 / tileSize;
  94      y1 := y1 / tileSize;
  95      x2 := x2 / tileSize;
  96      y2 := y2 / tileSize;
  97
  98      deltax := Abs(x2 - x1);
  99      deltay := Abs(y2 - y1);
 100
 101      if x1 < x2 then signx := 1 else signx := -1;
 102      if y1 < y2 then signy := 1 else signy := -1;
 103      error := deltaX - deltaY;
 104
 105      while (x1 <> x2) or (y1 <> y2) do begin
 106        if IsSolid(x1, y1) then exit;
 107
 108        error2 := error << 1;
 109        if error2 > -deltaY then begin
 110          error := error - deltaY;
 111          x1 := x1 + signX;
 112        end;
 113
 114        if error2 < deltaX then begin
 115          error := error + deltaX;
 116          y1 := y1 + signY;
 117        end;
 118      end;
 119
 120      result := true;
 121    end;
 122
 123   function AreaWithBlock(block, x, y, w, h : integer) : boolean;
 124     var
 125       i, j : integer;
 126       minx, miny, maxx, maxy : integer;
 127     begin
 128       minx := x div tileSize;
 129       miny := y div tileSize;
 130       maxx := (x + w - 1) div tileSize;
 131       maxy := (y + h - 1) div tileSize;
 132       for j := miny to maxy do
 133         for i := minx to maxx do
 134           if GetMap(i, j) = block then begin
 135             result := true;
 136             exit;
 137           end;
 138     end;
 139
 140   function Signum(x : integer) : integer;
 141     begin
 142       if x > 0 then Signum := 1
 143       else if x < 0 then Signum := -1
 144       else Signum := 0
 145     end;
 146
 147   procedure CalcGravity;
 148     var
 149       vec : integer;
 150       i : integer;
 151     begin
 152       gcv := 0;
 153       jmp := false;
 154       vy := vy + 1;
 155       if vy > maxVelocity then vy := maxVelocity;
 156
 157       i := Abs(vy);
 158       vec := Signum(vy);
 159       while (i > 0) and not MapColl(x, y + vec, w, h) do begin
 160         y := y + vec;
 161         i := i - 1;
 162       end;
 163       if i > 0 then begin
 164         vy := 0;
 165         gcv := i * vec;
 166         jmp := true;
 167       end;
 168     end;
 169
 170   function FixVYup : boolean;
 171     begin
 172       if (vy > -5) and
 173          (AreaWithBlock(49, x, y, w, h) or
 174          AreaWithBlock(103, x, y, w, h) or
 175          AreaWithBlock(108, x, y, w, h))
 176       then begin
 177         vy := vy - 2;
 178       end else if (vy > -4) and
 179         (AreaWithBlock(50, x, y, w, h) or
 180         AreaWithBlock(51, x, y, w, h))
 181       then begin
 182         vy := vy - 2;
 183       end else begin
 184         result := true;
 185       end;
 186     end;
 187
 188   procedure FixVYdown;
 189     begin
 190       if (vy > 5) and
 191         (AreaWithBlock(49, x, y, w, h) or
 192         AreaWithBlock(103, x, y, w, h))
 193       then begin
 194         vy := 5;
 195       end else if (vy > 4) and
 196         (AreaWithBlock(50, x, y, w, h) or
 197          AreaWithBlock(51, x, y, w, h))
 198       then begin
 199         vy := 4;
 200       end;
 201     end;
 202
 203   procedure Jump(vel : integer);
 204     begin
 205       if jmp and FixVYup then begin
 206         vy := -vel;
 207         jmp := false;
 208       end;
 209     end;
 210
 211   procedure CalcX;
 212     var
 213       vec : integer;
 214       i : integer;
 215     begin
 216       i := Abs(vx);
 217       vec := Signum(vx);
 218       while (i > 0) and not MapColl(x + vec, y, w, h) do begin
 219         x := x + vec;
 220         i := i - 1;
 221       end;
 222       if i > 0 then vx := 0 else vx := vx - vec;
 223     end;
 224
 225   procedure CalcY;
 226     var
 227       vec : integer;
 228       i : integer;
 229     begin
 230       i := Abs(vy);
 231       vec := Signum(vy);
 232       while (i > 0) and not MapColl(x, y + vec, w, h) do begin
 233         y := y + vec;
 234         i := i - 1;
 235       end;
 236       if i > 0 then vy := 0 else vy := vy - vec;
 237     end;
 238
 239   function GetX : integer;
 240     begin
 241       result := x;
 242     end;
 243
 244   function GetY : integer;
 245     begin
 246       result := y;
 247     end;
 248
 249   function GetVX : integer;
 250     begin
 251       result := vx;
 252     end;
 253
 254   function GetVY : integer;
 255     begin
 256       result := vy;
 257     end;
 258
 259   function GetGCV : integer;
 260     begin
 261       result := gcv;
 262     end;
 263
 264   function GetJump : boolean;
 265     begin
 266       result := jmp;
 267     end;
 268
 269   procedure Step(gravity : boolean);
 270     begin
 271       CalcX;
 272       if gravity then begin
 273         CalcGravity;
 274         FixVYdown;
 275       end else begin
 276         CalcY;
 277       end;
 278   end;
 279
 280 end.