From 90bc20fc7666db31948953ec7ae11f6f5f90f509 Mon Sep 17 00:00:00 2001 From: DeaDDooMER Date: Fri, 8 Sep 2017 19:33:32 +0300 Subject: [PATCH] Small refactoring of physics module --- BUGS | 87 ++++---- src/drop.mpsrc | 10 +- src/mobs.pas | 33 ++- src/phy.pas | 526 ++++++++++++++++++++------------------------ src/player.mpsrc | 553 ++++++++++++++++++++--------------------------- 5 files changed, 522 insertions(+), 687 deletions(-) diff --git a/BUGS b/BUGS index a3ecce9..d57ab45 100644 --- a/BUGS +++ b/BUGS @@ -1,51 +1,38 @@ -(+) - Исправлено. Ну или типа того. -(*) - Не критично и/или слишком сложно что бы сделать по-быстрому. +- Реализованы не все мобы которые были + * Курица + * Корова + * Гриная корова + * Крипер + * Свинья + * Пигмен + * Овца + * Паук +- Добавить ещё мобов + * Спрут + * Пещерный паук +- Добавить эффекты при смерти мобов +- Мобы не дохнут от солнечного света +- Под водой скорость разлома блоков не уменьшается +- При создании мира с сундуком, оный может висеть в воздухе +- Иногда вместо травы генерируется грязь. (баг или фича - хз) +- Починить спавнеры +- Починить установку блока при прыжке +- По лестнице/воде можно лезть даже если она стоит выше игрока +- Даже в четвёртой альфе грибы генерировались в пещерах! Нужно вернуть! +- Предметы не сгорают в лаве (и никогда не сгорали, но всё же) +- Не сбрасывается анимация игрока при старте новой игры +- Кактусы не убивают -+ Можно выпасть за гранцу карты -+ Выпадение за карту после загрузки мира -+ Ломаются кактусы и снег на старте игры -Реализованы не все мобы которые были - + Зомби - Курица - Корова - Гриная корова - Крипер - Свинья - Пигмен - Овца - Паук -Зомби не может номально выпрыгнуть из воды -Мобы не дохнут от солнечного света -+ Убогая текстура дождя -* Медленное обновление падающих блоков -+ Какая-то фигня со светом на старте игры -+ У кого-то почему-то не масштабируется экран -От падения с высоты нет урона -Под водой скорость разлома блоков не уменьшается -* Не зажимаются две кнопки одновременно (это вообще решаемо?) -* В бете 8 была поддержка звука, надо вернуть. -* Запилить загрузку старых сохранений (см. cavecraft forever) -+ Софтклавиши для переключения предметов на ремне перепутаны -+ Печи и мобы не сохраняются и не загружаются (не забыть инкрементировать версию формата карт) -При создании мира с сундуком, оный может висеть в воздухе -+ Зависание при попытке листать пустой список сохранений -Иногда вместо травы генерируется грязь. (баг или фича - хз) -Перепроверить генерацию предметов в cокровищницах -Починить спавнеры -+ Уголь встречается на поверхности реже чем железо -Починить установку блока при прыжке -Перепроверить рост деревьев -+ Печь не светится когда работает -* Потеря контрастности при малом количестве источников света -+ Слишком много золота -* Курсор на ремне должен быть чётче -+ Один уголь выплавляет 7 предметов, хотя должно быть 8 -По лестнице можно лезть даже если она стоит выше игрока -+ Игрок возраждается в точке своей смерти, вместо точки спавна -+ От больших грибов больно уж чорные тени. У тыкв тоже надо поправить. -После удаления всех сохранений кнопки остаются на вид активными -Даже в четвёртой альфе грибы генерировались в пещерах! Нужно вернуть! -+ Текстурпаки вроде как не работают -+ Нужно автоматически генерировать манифест и jad -* Предметы не сгорают в лаве (и никогда не сгорали, но всё же) -Нужно избавиться от библеотек-блобов +- Запилить блочный формат сохранений с переменным числом записей и версионированием блоков. +- Перепроверить генерацию предметов в cокровищницах +- Перепроверить рост деревьев + +- Курсор на ремне должен быть чётче +- В бете 8 была поддержка звука, надо вернуть. +- Медленное обновление падающих блоков +- Потеря контрастности при малом количестве источников света +- После удаления всех сохранений кнопки остаются на вид активными + +- Запилить загрузку старых сохранений (см. cavecraft forever) +- Не зажимаются две кнопки одновременно (это вообще решаемо в MP?) +- Нужно избавиться от библеотек-блобов diff --git a/src/drop.mpsrc b/src/drop.mpsrc index a691f98..e6f95cd 100644 --- a/src/drop.mpsrc +++ b/src/drop.mpsrc @@ -131,11 +131,11 @@ implementation for i:=0 to MAX_DROP do if isNull(i)=false then begin - phy.loadObject(drop_x[i], drop_y[i], DROP_W, DROP_H, 0, drop_vely[i], false); - phy.calc(true); - drop_x[i]:=phy.getX; - drop_y[i]:=phy.getY; - drop_vely[i]:=phy.getVelY; + Phy.SetObject(drop_x[i], drop_y[i], DROP_W, DROP_H, 0, drop_vely[i], false); + Phy.Step(true); + drop_x[i]:=Phy.GetX; + drop_y[i]:=Phy.GetY; + drop_vely[i]:=Phy.GetVY; end; end; diff --git a/src/mobs.pas b/src/mobs.pas index c255d0e..519cf9c 100644 --- a/src/mobs.pas +++ b/src/mobs.pas @@ -44,16 +44,16 @@ implementation procedure UseObject(i : integer); begin - Phy.LoadObject(mx[i], my[i], tw[mtype[i]], th[mtype[i]], mvx[i], mvy[i], mjump[i]); + Phy.SetObject(mx[i], my[i], tw[mtype[i]], th[mtype[i]], mvx[i], mvy[i], mjump[i]); end; procedure UpdateObject(i : integer); begin mx[i] := Phy.GetX; my[i] := Phy.GetY; - mvx[i] := Phy.GetVelX; - mvy[i] := Phy.GetVelY; - mjump[i] := Phy.GetJmp; + mvx[i] := Phy.GetVX; + mvy[i] := Phy.GetVY; + mjump[i] := Phy.GetJump; end; procedure InitTab(typ, w, h, hp, jump : integer); @@ -93,13 +93,13 @@ implementation else if vec > 0 then x := (mx[i] + GetW(i) + 4) / 16; else x := (mx[i] + GetW(i) / 2) / 16; y := (my[i] + GetH(i) - 8) / 16; - result := Phy.IsSolid(x, y, mvx[i] + vec, mvy[i]); + result := Phy.IsSolid(x, y); end; procedure Swim(i, vec : integer); begin - if Phy.MapCollType(50, mx[i], my[i], GetW(i), GetH(i) / 2) or - Phy.MapCollType(51, mx[i], my[i], GetW(i), GetH(i) / 2) + if Phy.AreaWithBlock(50, mx[i], my[i], GetW(i), GetH(i) / 2) or + Phy.AreaWithBlock(51, mx[i], my[i], GetW(i), GetH(i) / 2) then begin if (vec <> 0) and IsSolidStep(i, vec) then mvy[i] := -10 else mvy[i] := -2; end; @@ -123,13 +123,13 @@ implementation procedure Jump(i, vec : integer); begin UseObject(i); - Phy.JumpObj(GetJumpHeight(i)); + Phy.Jump(GetJumpHeight(i)); UpdateObject(i); end; function CollisionWithPlayer(i : integer) : boolean; begin - result := CollTwoObj( + result := Phy.IntersectRects( mx[i], my[i], GetW(i), GetH(i), Player.GetX, Player.GetY, Player.GetW, Player.GetH ); @@ -141,10 +141,9 @@ implementation begin x := mx[i] + GetW(i) / 2; y := my[i] + GetH(i) / 2; - if mtype[i] = zomby then - begin - Drop.Create(Items.rottenMeat, x, y, Random(3)); - end; + if mtype[i] = zomby then begin + Drop.Create(Items.rottenMeat, x, y, Random(3)); + end; mtype[i] := none; end; @@ -180,7 +179,7 @@ implementation (* Вижу игрока - сразу агрюсь и бегу за ним некоторое время *) if (mpos[i] = 0) and (Player.GetX - mx[i] < 0) or (mpos[i] = 1) and (Player.GetX - mx[i] > 0) then - if Phy.CanSeeObj(mx[i], my[i], Player.GetX, Player.GetY) then + if Phy.RayTraced(mx[i], my[i], Player.GetX, Player.GetY) then begin mb[i] := angryTime; mc[i] := angry; @@ -206,7 +205,7 @@ implementation if mb[i] <= 0 then mc[i] := stay; end else if mc[i] = angry then begin if mb[i] <= 0 then begin - if Phy.CanSeeObj(mx[i], my[i], Player.GetX, Player.GetY) then begin + if Phy.RayTraced(mx[i], my[i], Player.GetX, Player.GetY) then begin (* Видижу игрока - устанавливаю время преследования *) mb[i] := angryTime; end else begin @@ -272,7 +271,7 @@ implementation i : integer; begin for i := 0 to lastMob do if mtype[i] <> none then - if CollTwoObj(x, y, w, h, mx[i], my[i], GetW(i), GetH(i)) then + if Phy.IntersectRects(x, y, w, h, mx[i], my[i], GetW(i), GetH(i)) then begin mvx[i] := mvx[i] + addvx; mvy[i] := mvy[i] + addvy; @@ -302,7 +301,7 @@ implementation for i := 0 to lastMob do begin UseObject(i); - Phy.Calc(true); + Phy.Step(true); UpdateObject(i); end; end; 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 (x1y2) and (y1 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) and (x1 < x2 + w2) and (y1 + h1 > y2) and (y1 < y2 + h2); + end; - if y1 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 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. diff --git a/src/player.mpsrc b/src/player.mpsrc index 1891939..812a2b4 100644 --- a/src/player.mpsrc +++ b/src/player.mpsrc @@ -1,368 +1,277 @@ unit player; interface - const - ANIM_HAND=0; - ANIM_LEGS=1; - - var - fly:boolean; - hp, hunger, air:integer; - posi:integer;//Сторона в которую повёрнут игрок - velx,vely:integer;//Переменные для физики игрока - jmp, an_pr:boolean; - s_get_drp:boolean; - invslot:integer; - - procedure setX(val:integer); - procedure setY(val:integer); - function getX:integer; - function getY:integer; - function getW:integer; - function getH:integer; - - procedure loadSkin(str, path:string); - procedure freeSkin; - procedure draw(camx, camy:integer); - procedure playAnim(anim:integer); - procedure cancelAnim(anim:integer); - - procedure dropItem(item, sum:integer); - procedure biteIt(hp : integer; vector : integer); - - procedure calcPhysics; - - procedure gotoUP; - procedure gotoDOWN; - procedure gotoLEFT; - procedure gotoRIGHT; - - procedure getDrop; + + const + ANIM_HAND=0; + ANIM_LEGS=1; + + var + fly : boolean; + hp, hunger, air : integer; + posi : integer; + velx, vely : integer; + jmp, an_pr : boolean; + s_get_drp : boolean; + invslot : integer; + + function GetX : integer; + function GetY : integer; + function GetW : integer; + function GetH : integer; + procedure SetX(val : integer); + procedure SetY(val : integer); + + procedure LoadSkin(str, path : string); + procedure FreeSkin; + procedure Draw(camx, camy : integer); + procedure PlayAnim(anim : integer); + procedure CancelAnim(anim : integer); + + procedure DropItem(item, sum : integer); + procedure BiteIt(hp : integer; vector : integer); + + procedure CalcPhysics; + + procedure GotoUP; + procedure GotoDOWN; + procedure GotoLEFT; + procedure GotoRIGHT; + + procedure GetDrop; implementation - uses func, phy, vars, Canvas, drop, items, jsr75i, inv; - const - PLAYER_W=8; - PLAYER_H=32; - PLAYER_SPEED=2; - - POSI_LEFT=0; - POSI_RIGHT=1; - PLAYER_ANIM_DEL=1; - var - plx, ply:integer; - - //Skin - PlayerBody: array [0..1] of image; - PlayerHand: array [0..1, 0..3] of image; - PlayerLegs: array [0..1, 0..2] of image; - animHand, animLegs, animDelay:integer; - - procedure setX(val:integer); - begin - plx:=val; - end; - - procedure setY(val:integer); - begin - ply:=val; - end; - - function getX:integer; - begin - getX:=plx; - end; - - function getY:integer; - begin - getY:=ply; - end; - - function getW:integer; - begin - getW:=PLAYER_W; - end; - - function getH:integer; - begin - getH:=PLAYER_H; - end; - - procedure setVelX(val:integer); - begin - velx:=val; - end; - - procedure setVelY(val:integer); - begin - vely:=val; - end; - - function getVelX:integer; - begin - getVelX:=velx; - end; - - function getVelY:integer; - begin - getVelY:=vely; - end; - - procedure setJmp(val:boolean); - begin - jmp:=val; - end; - - function getJmp:boolean; - begin - getJmp:=jmp; - end; - - procedure dropItem(item, sum:integer); - begin - if posi=POSI_LEFT then - drop.create(item, sum, getX-8, getY); - else - drop.create(item, sum, getX+getW, getY); - end; - - procedure loadSkin(str, path:string); + + uses func, phy, vars, Canvas, drop, items, jsr75i, inv; + + const + PLAYER_W=8; + PLAYER_H=32; + PLAYER_SPEED=2; + POSI_LEFT=0; + POSI_RIGHT=1; + PLAYER_ANIM_DEL=2; + jumpVelocity = 7; + var - im:image; - i:integer; - begin - im:=ld_tex(str, path, 'mobs/'); + plx, ply:integer; + playerBody: array [0..1] of image; + playerHand: array [0..1, 0..3] of image; + playerLegs: array [0..1, 0..2] of image; + animHand, animLegs, animDelay:integer; - PlayerBody[POSI_LEFT]:=rotate_image_from_image(im, 0, 0, 8, 20, 0); - PlayerBody[POSI_RIGHT]:=rotate_image_from_image(im, 8, 0, 8, 20, 0); + procedure SetX(val : integer); + begin + plx := val; + end; - PlayerHand[POSI_LEFT, 0]:=rotate_image_from_image(im, 40, 0, 4, 12, 0); - PlayerHand[POSI_RIGHT, 0]:=rotate_image_from_image(im, 44, 0, 4, 12, 0); + procedure SetY(val : integer); + begin + ply := val; + end; - for i:=1 to 3 do + function GetX : integer; begin - PlayerHand[POSI_LEFT, i]:=rotate_image_from_image(im, 16, (i-1)*6, 12, 6, 0); - PlayerHand[POSI_RIGHT, i]:=rotate_image_from_image(im, 28, (i-1)*6, 12, 6, 0); + result := plx; end; - for i:=0 to 2 do + function GetY : integer; begin - PlayerLegs[POSI_LEFT, i]:=rotate_image_from_image(im, i*12, 20, 12, 12, 0); - PlayerLegs[POSI_RIGHT, i]:=rotate_image_from_image(im, 36+i*12, 20, 12, 12, 0); + result := ply; end; - end; - procedure freeSkin; - var - i, j:integer; - nullimg:image; - begin - for i:=0 to 1 do + function GetW : integer; + begin + result := PLAYER_W; + end; + + function GetH : integer; + begin + result := PLAYER_H; + end; + + procedure SetVelX(val : integer); + begin + velx := val; + end; + + procedure SetVelY(val : integer); + begin + vely := val; + end; + + function GetVelX : integer; + begin + result := velx; + end; + + function GetVelY : integer; + begin + result := vely; + end; + + procedure SetJmp(val : boolean); + begin + jmp := val; + end; + + function GetJmp : boolean; + begin + result := jmp; + end; + + procedure DropItem(item, sum : integer); begin - PlayerBody[i]:=nullimg; - for j:=0 to 3 do - PlayerHand[i, j]:=nullimg; - for j:=0 to 2 do - PlayerLegs[i, j]:=nullimg; + if posi = POSI_LEFT then Drop.Create(item, sum, GetX - 8, GetY); + else Drop.Create(item, sum, GetX + GetW, GetY); end; - end; - procedure playAnim(anim:integer); - begin - if anim=ANIM_HAND then + procedure LoadSkin(str, path:string); + var + im : image; + i : integer; begin - animHand:=animHand+1; - if animHand>3 then - animHand:=1; + im := ld_tex(str, path, 'mobs/'); + playerBody[POSI_LEFT] := rotate_image_from_image(im, 0, 0, 8, 20, 0); + playerBody[POSI_RIGHT] := rotate_image_from_image(im, 8, 0, 8, 20, 0); + playerHand[POSI_LEFT, 0] := rotate_image_from_image(im, 40, 0, 4, 12, 0); + playerHand[POSI_RIGHT, 0] := rotate_image_from_image(im, 44, 0, 4, 12, 0); + for i := 1 to 3 do begin + playerHand[POSI_LEFT, i] := rotate_image_from_image(im, 16, (i - 1) * 6, 12, 6, 0); + playerHand[POSI_RIGHT, i] := rotate_image_from_image(im, 28, (i - 1) * 6, 12, 6, 0); + end; + for i:=0 to 2 do begin + playerLegs[POSI_LEFT, i] := rotate_image_from_image(im, i * 12, 20, 12, 12, 0); + playerLegs[POSI_RIGHT, i] := rotate_image_from_image(im, 36 + i * 12, 20, 12, 12, 0); + end; end; - else - if anim=ANIM_LEGS then + + procedure FreeSkin; + var + i, j : integer; + nullimg : image; begin - if animDelay=0 then - begin - animLegs:=animLegs+1; - if animLegs>2 then - animLegs:=0; + for i := 0 to 1 do begin + playerBody[i] := nullimg; + for j:=0 to 3 do playerHand[i, j] := nullimg; + for j:=0 to 2 do playerLegs[i, j] := nullimg; end; + end; - animDelay:=animDelay+1; - if animDelay>PLAYER_ANIM_DEL then - animDelay:=0; + procedure PlayAnim(anim : integer); + begin + if anim = ANIM_HAND then begin + animHand := animHand + 1; + if animHand > 3 then animHand:=1; + end else if anim = ANIM_LEGS then begin + if animDelay = 0 then begin + animLegs := animLegs + 1; + if animLegs > 2 then animLegs := 0; + end; + animDelay:=animDelay+1; + if animDelay > PLAYER_ANIM_DEL then animDelay := 0; + end; end; - end; - procedure cancelAnim(anim:integer); - begin - if anim=ANIM_HAND then + procedure CancelAnim(anim : integer); begin - animHand:=0; + if anim = ANIM_HAND then animHand := 0; + else if anim = ANIM_LEGS then animLegs := 0; end; - else - if anim=ANIM_LEGS then + + procedure Draw(camx, camy : integer); + var + x, y : integer; begin - animLegs:=0; + x := GetX; + y := GetY; + DrawImage(playerBody[posi], x - camx, y - camy); + DrawImage(playerLegs[posi, animLegs], x - 2 - camx, y + 20 - camy); + + if animHand = 0 then DrawSmallItem(Inv.GetItem(invslot), x - camx, y + 14 - camy); + else if posi = POSI_RIGHT then DrawSmallItem(Inv.GetItem(invslot), x + 10 - camx, y + 5 - camy + animHand); + else if posi = POSI_LEFT then DrawSmallItem(Inv.GetItem(invslot), x - 10 - camx, y + 5 - camy + animHand); + + if (animHand = 0) or (posi = POSI_RIGHT) then DrawImage(playerHand[posi, animHand], x + 2 - camx, y + 8 - camy); + else DrawImage(playerHand[posi, animHand], x - 6 - camx, y + 8 - camy); end; - end; - procedure draw(camx, camy:integer); - var - x, y:integer; - begin - x:=getX; - y:=getY; - - DrawImage(PlayerBody[posi], x-camx, y-camy); - DrawImage(PlayerLegs[posi, animLegs], x-2-camx, y+20-camy); - - if animHand=0 then - drawSmallItem(inv.getItem(invslot), x-camx, y+14-camy); - else - if posi=POSI_RIGHT then - drawSmallItem(inv.getItem(invslot), x+10-camx, y+5-camy+animHand); - else - if posi=POSI_LEFT then - drawSmallItem(inv.getItem(invslot), x-10-camx, y+5-camy+animHand); - - if (animHand=0) or (posi=POSI_RIGHT) then - DrawImage(PlayerHand[posi, animHand], x+2-camx, y+8-camy); - else - DrawImage(PlayerHand[posi, animHand], x-6-camx, y+8-camy); - end; - - procedure biteIt(damage : integer; vector : integer); - begin - hp := hp - damage; - end; + procedure BiteIt(damage : integer; vector : integer); + begin + hp := hp - damage; + velx := velx + vector; + end; -procedure loadPhy; - begin - phy.loadObject(getX, getY, getW, getH, getVelX, getVelY, getJmp); - end; - -procedure storePhy; - begin - setX(phy.getX); - setY(phy.getY); - setVelX(phy.getVelX); - setVelY(phy.getVelY); - setJmp(phy.getJmp); - end; - - //Player collision. -{function coll:boolean; - begin - coll:=CollObj(getX, getY, getW, getH); - end; - -//Player collision by block id. -function coll_bl(id:integer):boolean; - begin - coll_bl:=CollObjBlock(getX, getY, getW, getH, id); - end; - -//Player collision by XY. -function coll_xy(xx,yy:integer):boolean; - begin - coll_xy:=CollObjXY(getX, getY, getW, getH, xx, yy); - end; - -//Controll jump velocity -procedure jmp_ctrl; - begin - if (coll_bl(49)) or (coll_bl(103)) or (coll_bl(108)) then - vely:=5; - if (coll_bl(50)) or (coll_bl(51)) then - vely:=4; - if (coll_bl(0)) and (coll_bl(50) or coll_bl(51)) then - vely:=7; - end; - -//Controll fall velocity - procedure phy_ctrl; - begin - if (coll_bl(49)) or (coll_bl(103)) then - vely:=-5; - if (coll_bl(50)) or (coll_bl(51)) then - if vely<-4 then - vely:=-4; - end;} - - procedure calcPhysics; - var - old_vely:integer; - cl:boolean; - begin - loadPhy; - phy.calc(not fly); - storePhy; - - {if fly=false then + procedure LoadPhy; begin - old_vely:=vely; - calcGravY(getX, getY, getW, getH, CONST_PHY_ACC, vely, CONST_PHY_MAXVEL, jmp); - setY(PhyGetY); - vely:=PhyGetVelY; - jmp:=PhyGetJump; - cl:=PhyGetColl; - - if cl then - if old_vely<-10 then - hp:=(hp-(abs(old_vely)-10)); - end;} - end; - - procedure gotoUP; - begin - if fly then - setVelY(-PLAYER_SPEED); - else + Phy.SetObject(GetX, GetY, GetW, GetH, GetVelX, GetVelY, GetJmp); + end; + + procedure StorePhy; begin - loadPhy; - jumpObj(7); - storePhy; + SetX(Phy.GetX); + SetY(Phy.GetY); + SetVelX(Phy.GetVX); + SetVelY(Phy.GetVY); + SetJmp(Phy.GetJump); end; - end; - procedure gotoDOWN; - begin - if fly then - setVelY(PLAYER_SPEED); - end; + procedure CalcPhysics; + var + vel : integer; + begin + vel := vely; - procedure gotoLEFT; - begin - setVelX(-PLAYER_SPEED); + LoadPhy; + Phy.Step(not fly); + StorePhy; - posi:=POSI_LEFT; + if (vel > 0) and (Phy.GetGCV - vel < -10) then BiteIt(vel - 10, Random(5) - 2); + end; - if fly=false then - playAnim(ANIM_LEGS); - end; + procedure GotoUP; + begin + if fly then begin + SetVelY(-PLAYER_SPEED); + end else begin + LoadPhy; + Phy.Jump(jumpVelocity); + StorePhy; + end; + end; - procedure gotoRIGHT; - begin - setVelX(PLAYER_SPEED); + procedure GotoDOWN; + begin + if fly then SetVelY(PLAYER_SPEED); + end; - posi:=POSI_RIGHT; + procedure GotoLEFT; + begin + SetVelX(-PLAYER_SPEED); + posi := POSI_LEFT; + if not fly then PlayAnim(ANIM_LEGS); + end; - if fly=false then - playAnim(ANIM_LEGS); - end; + procedure GotoRIGHT; + begin + SetVelX(PLAYER_SPEED); + posi := POSI_RIGHT; + if not fly then playAnim(ANIM_LEGS); + end; - procedure getDrop; - var - i, maxd, sum:integer; - begin - maxd:=drop.max; - for i:=0 to maxd do - if drop.isNull(i)=false then - if CollTwoObj(getX, getY, getW, getH, drop.getX(i), drop.getY(i), drop.getW, drop.getH) then - begin - sum:=inv.giveItem(drop.getItem(i), drop.getSum(i)); - drop.setSum(sum, i); - drop.fixNull(i); + procedure GetDrop; + var + i, maxd, sum : integer; + begin + maxd := Drop.Max; + for i := 0 to maxd do if Drop.IsNull(i) = false then begin + if Phy.IntersectRects(GetX, GetY, GetW, GetH, Drop.GetX(i), Drop.GetY(i), Drop.GetW, Drop.GetH) then begin + sum:=inv.giveItem(drop.getItem(i), drop.getSum(i)); + drop.setSum(sum, i); + drop.fixNull(i); + end; end; - end; + end; initialization -- 2.29.2