unit Phy; interface 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; procedure SetObject(_x, _y, _w, _h, _vx, _vy : integer; _jmp : boolean); procedure Jump(vel : integer); procedure Step(gravity : 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 maxVelocity = 32; tileSize = 16; var x, y, w, h, vx, vy, gcv : integer; jmp : boolean; 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; 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; function MapBoundCheck(x, y : Integer) : Boolean; begin result := (x < 0) or (x > MAP_W * tileSize); end; function OnMapObjectCheck(x, y, w, h : Integer) : Boolean; begin result := MapBoundCheck(x, y) or MapBoundCheck(x + w, y + h); end; function IsSolid(x, y : integer) : boolean; begin isSolid := GetBlockColl(getMap(x, y)) <> 0; end; function MapColl(x, y, w, h : 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 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; 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; if error2 < deltaX then begin error := error + deltaX; y1 := y1 + signY; end; end; result := true; 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; function Signum(x : integer) : integer; begin if x > 0 then Signum := 1 else if x < 0 then Signum := -1 else Signum := 0 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; 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 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; procedure Jump(vel : integer); begin if jmp and FixVYup then begin vy := -vel; jmp := false; end; 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; 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 GetX : integer; begin result := x; end; function GetY : integer; begin result := y; end; function GetVX : integer; begin result := vx; end; function GetVY : integer; begin result := vy; end; function GetGCV : integer; begin result := gcv; end; function GetJump : boolean; begin result := jmp; end; procedure Step(gravity : boolean); begin CalcX; if gravity then begin CalcGravity; FixVYdown; end else begin CalcY; end; end; end.