fb:porticula NoPaste
collision.bi
Uploader: | flo |
Datum/Zeit: | 15.12.2007 15:22:34 |
'irgendwo hier drin steckt der fehler xD
declare sub xstop (byref object as TPhysics)
declare sub ystop (byref object as TPhysics)
declare sub collisionstop (byref object as TPhysics)
declare sub aua (byref object1 as TPhysics,byref object2 as TPhysics)
declare sub schlagtest (byref object1 as TPhysics, byref object2 as TPhysics)
dim shared as integer bx,by
sub collisionstop (byref object as TPhysics)
dim as byte rstop,lstop,ustop,dstop
with object
bx=fix(fix(.x)/xlen)+1
by=fix(fix(.y)/ylen)+1
dim as double dx,dy,xcnt,ycnt,xtemp,ytemp
dx=fix(.x)-fix(.xalt) '.width-1
dy=fix(.y)-fix(.yalt) '.height-1
'logge str(dx)+"||"+str(dy)
if dx<>0 and dy <> 0 then
if abs(dx)>abs(dy) then
logge "dx>dy"
for xcnt=0 to dx step sgn(dx)
ytemp=xcnt/dx*dy+.yalt
xtemp=xcnt+.xalt
bx=fix(xtemp/xlen)+1
by=fix(ytemp/ylen)+1
if block (bx,by) or block (bx+1,by) or block (bx,by-1) or block(bx+1,by-1) then
xcnt=xcnt-sgn(dx)
ytemp=xcnt/dx*dy+.y
xtemp=xcnt+.x
.x=xtemp
.y=ytemp
bx=fix((xtemp+sgn(dx))/xlen)+1
by=fix(ytemp/ylen)+1
if block (bx,by) or block (bx+1,by) or block (bx,by-1) or block(bx+1,by-1) then .vx=0:.ax=0':.x=.x-sgn(dx)
bx=fix(xtemp/xlen)+1
by=fix((ytemp+sgn(dy))/ylen)+1
if block (bx,by) or block (bx+1,by) or block (bx,by-1) or block(bx+1,by-1) then .vy=0:.ay=0':.y=.y-sgn(dy)
exit for
end if
next
else
logge "dy>dx"
for ycnt=0 to dy step sgn(dy)
xtemp=ycnt/dy*dx+.xalt
ytemp=ycnt+.yalt
bx=fix(xtemp/xlen)+1
by=fix(ytemp/ylen)+1
if block (bx,by) or block (bx+1,by) or block (bx,by-1) or block(bx+1,by-1) then
ycnt=ycnt-sgn(dy)
xtemp=ycnt/dx*dy+.xalt
ytemp=ycnt+.yalt
.x=xtemp
.y=ytemp
bx=fix((xtemp+sgn(dx))/xlen)+1
by=fix(ytemp/ylen)+1
if block (bx,by) or block (bx+1,by) or block (bx,by-1) or block(bx+1,by-1) then object.vx=0:object.ax=0':.x=.x-sgn(dx)
bx=fix(xtemp/xlen)+1
by=fix((ytemp+sgn(dy))/ylen)+1
logge str(bx)+"|"+str(by)
if block (bx,by) or block (bx+1,by) or block (bx,by-1) or block(bx+1,by-1) then object.vy=0:object.ay=0':.y=.y-sgn(dy)
exit for
end if
next
end if
else
if dx=0 and dy <>0 then
logge "dx=0"
for ycnt=0 to dy step sgn (dy)
ytemp=ycnt+.yalt
bx=fix(.x/xlen)+1
by=fix(ytemp/ylen)+1
if block (bx,by) or block (bx+1,by) or block (bx,by-1) or block(bx+1,by-1) then
object.vy=0:object.ay=0
.y=ytemp-sgn(dy)
exit for
end if
next
else
if dx<>0 and dy=0 then
logge "dy=0"
for xcnt=0 to dx step sgn (dx)
xtemp=xcnt+.xalt
bx=fix(xtemp/xlen)+1
by=fix(.y/ylen)+1
if block (bx,by) or block (bx+1,by) or block (bx,by-1) or block(bx+1,by-1) then
object.vx=0:object.ax=0
.x=xtemp-sgn(dx)
exit for
end if
next
end if
end if
end if
if .ay=0 then
if block(bx,by+1)=0 and block (bx+1,by+1)=0 then .ay=gravity
end if
end with
end sub
sub xstop (byref object as TPhysics)
with object
if (Block(bx+1,by) =-1 or Block (bx+1,by-1)=-1) then
.x=bx*xlen-xlen-1
.ax=0:.vxalt=0
if .stupid then .vx=-.vx else .vx=0
bx=fix(fix(.x)/xlen)+1
end if
if (Block(bx,by) =-1 or Block (bx,by-1)=-1) then
.x=bx*xlen+1
.ax=0:.vxalt=0
if .stupid then .vx=-.vx else .vx=0
bx=fix(fix(.x)/xlen)+1
end if
end with
end sub
sub flachxstop (byref object as TPhysics)
with object
if Block(bx+1,by) =-1 then
.x=bx*xlen-xlen-1
.ax=0:.vxalt=0
if .stupid then .vx=-.vx:.vxvorher=.vx else .vx=0
bx=fix(fix(.x)/xlen)+1
end if
if Block(bx,by) =-1 then
.x=bx*xlen+1
.ax=0:.vxalt=0
if .stupid then .vx=-.vx:.vxvorher=.vx else .vx=0
bx=fix(fix(.x)/xlen)+1
end if
end with
end sub
sub ystop (byref object as TPhysics)
with object
if (Block(bx,by-1) =-1 or Block (bx+1,by-1)=-1) and .vy<0 then
.y=by*ylen
.vy=0:.ay=gravity:.vyalt=0
by=fix(fix(.y)/ylen)+1
end if
if (Block(bx,by) =-1 or Block (bx+1,by)=-1) and .vy>0 then
.y=by*ylen-ylen-1
.vy=0:.ay=0:.vyalt=0
by=fix(fix(.y)/ylen)+1
end if
end with
end sub
sub flachcollisionstop (byref object as TPhysics)
with object
bx=fix(fix(.x)/xlen)+1
by=fix(fix(.y)/ylen)+1
if .vx<>0 then
flachxstop object
bx=fix(fix(.x)/xlen)+1
.obx=bx
elseif bx=.obx and by<>.oby then
ystop object
by=fix(fix(.y)/ylen)+1
.oby=by
end if
.obx=bx:.oby=by
if .ay=0 then
if block(bx,by+1)=0 and block (bx+1,by+1)=0 then .ay=gravity:.vxvorher=.vx:.vx=0 else .vx=.vxvorher
end if
end with
end sub
sub aua (byref object1 as TPhysics,byref object2 as TPhysics)
dim as double x11,x21,y11,y21,x12,x22,y12,y22
with object1
select case .direction
case 0: x11=.x+.xplus:x21=.x+.width-.xminus
case 1: x11=.x+.xminus:x21=.x+.width-.xplus
end select
with object2
select case .direction
case 0: x12=.x+.xplus:x22=.x+.width-.xminus
case 1: x12=.x+.xminus:x22=.x+.width-.xplus
end select
end with
'locate 3,1:?fix(x11),fix(x21),fix(x12),fix(x22)
if .height>object2.height then
if (object2.y<=.y and object2.y >= .y-.height) or (object2.y-object2.height<=.y and object2.y-object2.height>= .y-.height) then
if x11+x21>x12+x22 then
if (x12>x11 and x12<x21) or (x22>x11 and x22<x21) then
if .unverwundbarende =0 then .unverwundbarende=timer+.unverwundbartime: .energy-=1
end if
else
if (x11>x12 and x11<x22) or (x21>x12 and x21<x22) then
if .unverwundbarende =0 then .unverwundbarende=timer+.unverwundbartime: .energy-=1
end if
end if
end if
else
if (.y<=object2.y and .y >= object2.y-object2.height) or (.y-.height<=object2.y and .y-.height >= object2.y-object2.height) then
if x11+x21>x12+x22 then
if (x12>x11 and x12<x21) or (x22>x11 and x22<x21) then
if .unverwundbarende =0 then .unverwundbarende=timer+.unverwundbartime: .energy-=1
end if
else
if (x11>x12 and x11<x22) or (x21>x12 and x21<x22) then
if .unverwundbarende =0 then .unverwundbarende=timer+.unverwundbartime: .energy-=1
end if
end if
end if
end if
end with
end sub
sub schlagtest (byref object1 as TPhysics, byref object2 as TPhysics)
dim as double x11,x21,y11,y21,x12,x22,y12,y22
with object1
select case .direction
case 0: x11=.x+.xplus:x21=.x+.width
case 1: x11=.x:x21=.x+.width-.xplus
end select
with object2
select case .direction
case 0: x12=.x+.xplus:x22=.x+.width-.xminus
case 1: x12=.x+.xminus:x22=.x+.width-.xplus
end select
end with
'locate 3,1:?fix(x11),fix(x21),fix(x12),fix(x22)
if (.direction=0 and x21<x22) or (.direction=1 and x11>y12) then
if .height>object2.height then
if (object2.y<=.y and object2.y >= .y-.height) or (object2.y-object2.height<=.y and object2.y-object2.height>= .y-.height) then
if x11+x21>x12+x22 then
if (x12>x11 and x12<x21) or (x22>x11 and x22<x21) then
if object2.unverwundbarende =0 then object2.unverwundbarende=timer+object2.unverwundbartime: object2.energy-=1
end if
else
if (x11>x12 and x11<x22) or (x21>x12 and x21<x22) then
if object2.unverwundbarende =0 then object2.unverwundbarende=timer+object2.unverwundbartime: object2.energy-=1
end if
end if
end if
else
if (.y<=object2.y and .y >= object2.y-object2.height) or (.y-.height<=object2.y and .y-.height >= object2.y-object2.height) then
if x11+x21>x12+x22 then
if (x12>x11 and x12<x21) or (x22>x11 and x22<x21) then
if object2.unverwundbarende =0 then object2.unverwundbarende=timer+object2.unverwundbartime: object2.energy-=1
end if
else
if (x11>x12 and x11<x22) or (x21>x12 and x21<x22) then
if object2.unverwundbarende =0 then object2.unverwundbarende=timer+object2.unverwundbartime: object2.energy-=1
end if
end if
end if
end if
end if
end with
end sub