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