X-Git-Url: https://deadsoftware.ru/gitweb?p=cavecraft.git;a=blobdiff_plain;f=src%2Fphy.pas;h=2b795c4d8bc3524aac4cbec37b4e4f385d3bf073;hp=431f18034826a9fc28e56ff6b1c9cedc39e0a947;hb=90bc20fc7666db31948953ec7ae11f6f5f90f509;hpb=f92b5193f873a667d40bdca3faa6c002014ac309

diff --git a/src/phy.pas b/src/phy.pas
index 431f180..2b795c4 100644
--- a/src/phy.pas
+++ b/src/phy.pas
@@ -1,340 +1,280 @@
-unit phy;
+unit Phy;
 
 interface
- procedure loadObject(_x, _y, _w, _h, _velx, _vely:integer; _jmp:boolean);
 
- function isSolid(x, y, velx, vely:integer):boolean;
+  function IsSolid(x, y : integer) : boolean;
+  function RayTraced(x1, y1, x2, y2 : integer) : boolean;
+  function AreaWithBlock(block, x, y, w, h : integer) : boolean;
+  function IntersectRects(x1, y1, w1, h1, x2, y2, w2, h2 : integer) : boolean;
 
- function mapCollType(_type, x, y, w, h:integer):boolean;
+  procedure SetObject(_x, _y, _w, _h, _vx, _vy : integer; _jmp : boolean);
+  procedure Jump(vel : integer);
+  procedure Step(gravity : boolean);
 
- function CollTwoObj(x1,y1,w1,h1,x2,y2,w2,h2:integer):boolean;
-
- procedure jumpObj(vel:integer);
- procedure calc(gravity:boolean);
-
- function getX:integer;
- function getY:integer;
- function getVelX:integer;
- function getVelY:integer;
- function getJmp:boolean;
-
- function canSeeObj(x1, y1, x2, y2:integer):boolean;
+  function GetX : integer;
+  function GetY : integer;
+  function GetVX : integer;
+  function GetVY : integer;
+  function GetGCV : integer;
+  function GetJump : boolean;
 
 implementation
- uses items_store, maps, vars;
- const
-  MAX_VELY=32;
-  TILE_SIZE=16;
- var
-  x, y, w, h, velx, vely:integer;
-  jmp:boolean;
-
-function CollTwoObj(x1,y1,w1,h1,x2,y2,w2,h2:integer):boolean;
- begin
-  if (x1+w1>x2) and (x1<x2+w2) and (y1+h1>y2) and (y1<y2+h2) then
-   CollTwoObj:=true;
- end;
-
- procedure loadObject(_x, _y, _w, _h, _velx, _vely:integer; _jmp:boolean);
-  begin
-   x:=_x;
-   y:=_y;
-   w:=_w;
-   h:=_h;
-   velx:=_velx;
-   vely:=_vely;
-   jmp:=_jmp;
-  end;
 
- function mapBoundCheck(x, y : Integer) : Boolean;
-   begin
-     mapBoundCheck := (x < 0) or (x > MAP_W * TILE_SIZE);
-   end;
+  uses items_store, maps, vars;
 
- function onMapObjectCheck(x, y, w, h : Integer) : Boolean;
-   begin
-     onMapObjectCheck := mapBoundCheck(x, y) or mapBoundCheck(x + w, y + h);
-   end;
-
- function isSolid(x, y, velx, vely:integer):boolean;
-   begin
-     isSolid := getBlockColl(getMap(x, y)) <> 0;
-   end;
+  const
+    maxVelocity = 32;
+    tileSize = 16;
 
- function mapColl(x, y, w, h, velx, vely:integer):boolean;
-   var
-    i, j:integer;
-    minx, miny, maxx, maxy:integer;
-   begin
-     if onMapObjectCheck(x, y, w, h) then
-       begin
-         mapColl := true;
-         exit;
-       end;
-
-     minx:=x div TILE_SIZE;
-     miny:=y div TILE_SIZE;
-     maxx:=(x+w-1) div TILE_SIZE;
-     maxy:=(y+h-1) div TILE_SIZE;
-     for i:=minx to maxx do
-     for j:=miny to maxy do
-       begin
-         if isSolid(i, j, velx, vely) then
-           begin
-             mapColl:=true;
-             exit;
-           end;
-       end;
-  end;
-
- function canSeeObj(x1, y1, x2, y2:integer):boolean;
   var
-   deltax, deltay:integer;
-   signx, signy:integer;
-   error, error2:integer;
-  begin
-   x1:=x1/TILE_SIZE;
-   y1:=y1/TILE_SIZE;
-   x2:=x2/TILE_SIZE;
-   y2:=y2/TILE_SIZE;
-  
-   deltax:=abs(x2-x1);
-   deltay:=abs(y2-y1);
+    x, y, w, h, vx, vy, gcv : integer;
+    jmp : boolean;
 
-   if x1<x2 then
-    signx:=1;
-   else
-    signx:=-1;
+  function IntersectRects(x1, y1, w1, h1, x2, y2, w2, h2 : integer) : boolean;
+    begin
+      result := (x1 + w1 > x2) and (x1 < x2 + w2) and (y1 + h1 > y2) and (y1 < y2 + h2);
+    end;
 
-   if y1<y2 then
-    signy:=1;
-   else
-    signy:=-1;
+  procedure SetObject(x_, y_, w_, h_, vx_, vy_ : integer; jmp_ : boolean);
+    begin
+      x := x_;
+      y := y_;
+      w := w_;
+      h := h_;
+      vx := vx_;
+      vy := vy_;
+      jmp := jmp_;
+    end;
 
-   error:=deltaX-deltaY;
+  function MapBoundCheck(x, y : Integer) : Boolean;
+    begin
+      result := (x < 0) or (x > MAP_W * tileSize);
+    end;
 
-   while((x1<>x2) or (y1<>y2)) do
+  function OnMapObjectCheck(x, y, w, h : Integer) : Boolean;
     begin
-     if isSolid(x1, y1, 0, 0) then
-      exit;
-
-     error2:=error<<1;
-     if error2>-deltaY then
-      begin
-       error:=error-deltaY;
-       x1:=x1+signX;
-      end;
+      result := MapBoundCheck(x, y) or MapBoundCheck(x + w, y + h);
+    end;
 
-     if error2<deltaX then
-      begin
-       error:=error+deltaX;
-       y1:=y1+signY;
-      end;
+  function IsSolid(x, y : integer) : boolean;
+    begin
+      isSolid := GetBlockColl(getMap(x, y)) <> 0;
     end;
-   canSeeObj:=true;
-  end;
 
- function mapCollType(_type, x, y, w, h:integer):boolean;
-  var
-   i, j:integer;
-   minx, miny, maxx, maxy:integer;
-  begin
-   minx:=x div TILE_SIZE;
-   miny:=y div TILE_SIZE;
-   maxx:=(x+w-1) div TILE_SIZE;
-   maxy:=(y+h-1) div TILE_SIZE;
-   for i:=minx to maxx do
-   for j:=miny to maxy do
+  function MapColl(x, y, w, h : integer) : boolean;
+    var
+      i, j : integer;
+      minx, miny, maxx, maxy : integer;
     begin
-     if getMap(i, j)=_type then
-      begin
-       mapCollType:=true;
-       exit;
+      if OnMapObjectCheck(x, y, w, h) then begin
+        MapColl := true;
+        exit;
       end;
+
+      minx := x div tileSize;
+      miny := y div tileSize;
+      maxx := (x + w - 1) div tileSize;
+      maxy := (y + h - 1) div tileSize;
+
+      for j := miny to maxy do
+        for i := minx to maxx do
+          if IsSolid(i, j) then begin
+            MapColl:=true;
+            exit;
+          end;
     end;
- end;
 
- procedure calcGravity;
-  var
-   i:integer;
-  begin
-   vely:=vely+1;
-   if vely>MAX_VELY then
-    vely:=MAX_VELY;
-
-   jmp:=false;
-
-   if vely>0 then
-    for i:=1 to vely do
-     begin
-      y:=y+1;
-      if mapColl(x, y, w, h, velx, vely) then
-       begin
-        y:=y-1;
-        vely:=0;
-        jmp:=true;
-        break;
+ function RayTraced(x1, y1, x2, y2 : integer) : boolean;
+   var
+     deltax, deltay : integer;
+     signx, signy : integer;
+     error, error2 : integer;
+   begin
+     x1 := x1 / tileSize;
+     y1 := y1 / tileSize;
+     x2 := x2 / tileSize;
+     y2 := y2 / tileSize;
+  
+     deltax := Abs(x2 - x1);
+     deltay := Abs(y2 - y1);
+
+     if x1 < x2 then signx := 1 else signx := -1;
+     if y1 < y2 then signy := 1 else signy := -1;
+     error := deltaX - deltaY;
+
+     while (x1 <> x2) or (y1 <> y2) do begin
+       if IsSolid(x1, y1) then exit;
+
+       error2 := error << 1;
+       if error2 > -deltaY then begin
+         error := error - deltaY;
+         x1 := x1 + signX;
        end;
-     end;
-   else
-    for i:=1 to abs(vely) do
-     begin
-      y:=y-1;
-      if mapColl(x, y, w, h, velx, vely) then
-       begin
-        y:=y+1;
-        vely:=0;
-        jmp:=false;
-        break;
+
+       if error2 < deltaX then begin
+         error := error + deltaX;
+         y1 := y1 + signY;
        end;
      end;
-  end;
 
- function fixVYup:boolean;
-  begin
-   if (vely>-5) and
-      (mapCollType(49, x, y, w, h) or 
-       mapCollType(103, x, y, w, h) or
-       mapCollType(108, x, y, w, h)) then
-        vely:=vely-2;
-   else
-   if (vely>-4) and
-      (mapCollType(50, x, y, w, h) or 
-       mapCollType(51, x, y, w, h)) then
-        vely:=vely-2;
-   else
-    fixVYup:=true;
-  end;
+     result := true;
+   end;
 
- procedure fixVYdown;
-  begin
-   if (vely>5) and
-      (mapCollType(49, x, y, w, h) or 
-       mapCollType(103, x, y, w, h)) then
-        vely:=5;
-   else
-   if (vely>4) and
-      (mapCollType(50, x, y, w, h) or 
-       mapCollType(51, x, y, w, h)) then
-        vely:=4;
-  end;
+  function AreaWithBlock(block, x, y, w, h : integer) : boolean;
+    var
+      i, j : integer;
+      minx, miny, maxx, maxy : integer;
+    begin
+      minx := x div tileSize;
+      miny := y div tileSize;
+      maxx := (x + w - 1) div tileSize;
+      maxy := (y + h - 1) div tileSize;
+      for j := miny to maxy do
+        for i := minx to maxx do
+          if GetMap(i, j) = block then begin
+            result := true;
+            exit;
+          end;
+    end;
 
- procedure jumpObj(vel:integer);
-  begin
-   if fixVYup then
-   if jmp then
+  function Signum(x : integer) : integer;
     begin
-     vely:=-vel;
-     jmp:=false;
+      if x > 0 then Signum := 1
+      else if x < 0 then Signum := -1
+      else Signum := 0
     end;
-  end;
 
- procedure calcX;
-  var
-   i:integer;
-  begin
-   if velx>0 then
-    for i:=1 to velx do
-     begin
-      x:=x+1;
-      if mapColl(x, y, w, h, velx, vely) then
-       begin
-        x:=x-1;
-        velx:=0;
-        break;
-       end;
-     end;
-   else
-   if velx<0 then
-    for i:=1 to abs(velx) do //there for-downto-do have a bug!
-     begin
-      x:=x-1;
-      if mapColl(x, y, w, h, velx, vely) then
-       begin
-        x:=x+1;
-        velx:=0;
-        break;
-       end;
-     end;
+  procedure CalcGravity;
+    var
+      vec : integer;
+      i : integer;
+    begin
+      gcv := 0;
+      jmp := false;
+      vy := vy + 1;
+      if vy > maxVelocity then vy := maxVelocity;
+
+      i := Abs(vy);
+      vec := Signum(vy);
+      while (i > 0) and not MapColl(x, y + vec, w, h) do begin
+        y := y + vec;
+        i := i - 1;
+      end;
+      if i > 0 then begin
+        vy := 0;
+        gcv := i * vec;
+        jmp := true;
+      end;
+    end;
 
-   if velx>0 then
-    velx:=velx-1;
-   else
-   if velx<0 then
-    velx:=velx+1;
-  end;
+  function FixVYup : boolean;
+    begin
+      if (vy > -5) and
+         (AreaWithBlock(49, x, y, w, h) or
+         AreaWithBlock(103, x, y, w, h) or
+         AreaWithBlock(108, x, y, w, h))
+      then begin
+        vy := vy - 2;
+      end else if (vy > -4) and
+        (AreaWithBlock(50, x, y, w, h) or 
+        AreaWithBlock(51, x, y, w, h))
+      then begin
+        vy := vy - 2;
+      end else begin
+        result := true;
+      end;
+    end;
 
- procedure calcY;
-  var
-   i:integer;
-  begin
-   if vely>0 then
-    for i:=1 to vely do
-     begin
-      y:=y+1;
-      if mapColl(x, y, w, h, velx, vely) then
-       begin
-        y:=y-1;
-        vely:=0;
-        break;
-       end;
-     end;
-   else
-   if vely<0 then
-    for i:=1 to abs(vely) do //there for-downto-do have a bug!
-     begin
-      y:=y-1;
-      if mapColl(x, y, w, h, velx, vely) then
-       begin
-        y:=y+1;
-        velx:=0;
-        break;
-       end;
-     end;
+  procedure FixVYdown;
+    begin
+      if (vy > 5) and
+        (AreaWithBlock(49, x, y, w, h) or 
+        AreaWithBlock(103, x, y, w, h))
+      then begin
+        vy := 5;
+      end else if (vy > 4) and
+        (AreaWithBlock(50, x, y, w, h) or 
+         AreaWithBlock(51, x, y, w, h))
+      then begin
+        vy := 4;
+      end;
+    end;
 
-   if vely>0 then
-    vely:=vely-1;
-   else
-   if vely<0 then
-    vely:=vely+1;
-  end;
+  procedure Jump(vel : integer);
+    begin
+      if jmp and FixVYup then begin
+        vy := -vel;
+        jmp := false;
+      end;
+    end;
 
- function getX:integer;
-  begin
-   getX:=x;
-  end;
+  procedure CalcX;
+    var
+      vec : integer;
+      i : integer;
+    begin
+      i := Abs(vx);
+      vec := Signum(vx);
+      while (i > 0) and not MapColl(x + vec, y, w, h) do begin
+        x := x + vec;
+        i := i - 1;
+      end;
+      if i > 0 then vx := 0 else vx := vx - vec;
+    end;
 
- function getY:integer;
-  begin
-   getY:=y;
-  end;
+  procedure CalcY;
+    var
+      vec : integer;
+      i : integer;
+    begin
+      i := Abs(vy);
+      vec := Signum(vy);
+      while (i > 0) and not MapColl(x, y + vec, w, h) do begin
+        y := y + vec;
+        i := i - 1;
+      end;
+      if i > 0 then vy := 0 else vy := vy - vec;
+    end;
 
- function getVelX:integer;
-  begin
-   getVelX:=velx;
-  end;
+  function GetX : integer;
+    begin
+      result := x;
+    end;
 
- function getVelY:integer;
-  begin
-   getVelY:=vely;
-  end;
+  function GetY : integer;
+    begin
+      result := y;
+    end;
 
- function getJmp:boolean;
-  begin
-   getJmp:=jmp;
-  end;
+  function GetVX : integer;
+    begin
+      result := vx;
+    end;
+
+  function GetVY : integer;
+    begin
+      result := vy;
+    end;
 
- procedure calc(gravity:boolean);
-  begin
-   calcX;
+  function GetGCV : integer;
+    begin
+      result := gcv;
+    end;
 
-   if gravity then
+  function GetJump : boolean;
     begin
-      calcGravity;
-      fixVYdown;
+      result := jmp;
     end;
-   else 
-    calcY;
+
+  procedure Step(gravity : boolean);
+    begin
+      CalcX;
+      if gravity then begin
+        CalcGravity;
+        FixVYdown;
+      end else begin 
+        CalcY;
+      end;
   end;
 
 end.