Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
2x kollisionsengie, 2x funzt nicht
| Uploader: |  flo |
| Datum/Zeit: | 19.03.2008 14:30:23 |
'-----------die kranke, besser funktionierende:---------
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 bx1,by1,bx2,by2
sub collisionstop (byref object as TPhysics)
dim as byte rstop,lstop,ustop,dstop,fallen,i
with object
bx1=fix(fix(.x)/xlen)+1
by1=fix(fix(.y)/ylen)+1
bx2=fix(fix(.x+.width)/xlen)+1
by2=fix(fix(.y-.height)/ylen)+1
if (bx1<>.obx1 or bx2<>.obx2) and by1=.oby1 and by2=.oby2 then
xstop object
bx1=fix(fix(.x)/xlen)+1
bx2=fix(fix(.x+.width)/xlen)+1
.obx1=bx1
.obx2=bx2
elseif bx1=.obx1 and bx2=.obx2 and (by1<>.oby1 or by2<>.oby2) then
ystop object
by1=fix(fix(.y)/ylen)+1
by2=fix(fix(.y-.height)/ylen)+1
.oby1=by1
.oby2=by2
elseif (.obx1 <> bx1 or .obx2 <> bx2) and (.oby1 <> by1 or .oby2 <> by2) then
if bx1>.obx1 or bx2>.obx2 then
rstop=true
for i=by2 to by1
if (block(bx2,i).solid or (block(bx2,i).half and .stupid)) = false then rstop=false:exit for
next
'if (block (bx2,by1).solid or (block(bx2,by1).half and .stupid)) and (block (bx2,by2).solid or (block(bx2,by2).half and .stupid)) then rstop=true else rstop=false
elseif bx1<.obx1 or bx2<.obx2 then
lstop=true
for i=by2 to by1
if (block(bx1,i).solid or (block(bx1,i).half and .stupid)) = false then lstop=false:exit for
next
'if (block (bx1,by1).solid or (block(bx1,by1).half and .stupid)) and (block (bx1,by2).solid or (block(bx1,by2).half and .stupid)) then lstop=true else lstop=false
end if
if by1>.oby1 or by2>.oby2 then
dstop=true
for i=bx1 to bx2
if (block(i,by2).solid or (block(i,by2).half and .stupid))=false then dstop=false:exit for
next
'if (block(bx1,by1).solid or (block(bx1,by1).half and .stupid)) and (block (bx2,by1).solid or (block(bx2,by1).half and .stupid)) then dstop=true else dstop=false
elseif by1<.oby1 or by2<.oby2 then
ustop=true
for i=bx1 to bx2
if (block(i,by1).solid or (block(i,by1).half and .stupid))=false then ustop=false:exit for
next
'if (block(bx1,by2).solid or (block(bx1,by2).half and .stupid)) and (block (bx2,by2).solid or (block(bx2,by2).half and .stupid)) then ustop=true else ustop=false
end if
if rstop or lstop then xstop object
if ustop or dstop then ystop object
if (rstop=false and lstop=false and ustop=false and dstop=false) or ((rstop=true or lstop=true) and (ustop=true or dstop=true)) then
'hier: an koordinaten x,yalt bzw xalt,y block?
dim as byte xpech,ypech
xpech=false:ypech=false
'if bx1<.obx1 or bx2<.obx2 then
for i=bx1 to bx2 'pr�fen, ob an x,yalt was w�re
if (block(i,.oby1).solid or (block(i,.oby1).half and .stupid)) _
or (block(i,.oby2).solid or (block(i,.oby2).half and .stupid)) then
ypech=true
end if
next
for i=by2 to by1 'pr�fen, ob an xalt,y was w�re
if (block(.obx1,i).solid or (block(.obx1,i).half and .stupid)) _
or (block(.obx2,i).solid or (block(.obx2,i).half and .stupid)) then
xpech=true
end if
next
if ypech = false and xpech then .y=.yalt:by1=.oby1:by2=.oby2
if xpech = false and ypech then .x=.xalt:bx1=.obx1:bx2=.obx2
if abs(.vx)<abs(.vy) then
xstop object
ystop object
else
ystop object
xstop object
end if
rstop=0:lstop=0:ustop=0:dstop=0
end if
endif
.obx1=bx1:.oby1=by1
.obx2=bx2:.oby2=by2
if .ay=0 then
fallen=true
for i=bx1 to bx2
if (block(i,by1+1).solid=false and (block(i,by1+1).half=false or (not(.stupid))))=false then fallen=false
next
if fallen then .ay=gravity
'if (block(bx1,by1+1).solid =0 and (block(bx1,by1+1).half=0 or (not(.stupid)))) and (block (bx2,by1+1).solid=0 and (block (bx2,by1+1).half=0 or (not( .stupid)))) then .ay=gravity
end if
end with
end sub
'!!!
sub xstop (byref object as TPhysics)
dim as byte stopp,i
stopp=false
with object
for i=by2 to by1
if block(bx2,i).solid or (block(bx2,i).half and .stupid) then stopp=true:exit for
next
if stopp then
.x=bx2*xlen-.width-1-xlen'xlen-1
.ax=0':.vxalt=0
if .stupid then .vx=-.vx else .vx=0
bx1=fix(fix(.x)/xlen)+1
bx2=fix(fix(.x+.width)/xlen)+1
end if
stopp=false
for i=by2 to by1
if block(bx1,i).solid or (block(bx1,i).half and .stupid) then stopp=true:exit for
next
if stopp then
.x=bx1*xlen+1
.ax=0:'.vxalt=0
if .stupid then .vx=-.vx else .vx=0
bx1=fix(fix(.x)/xlen)+1
bx2=fix(fix(.x+.width)/xlen)+1
end if
end with
end sub
'sub flachxstop (byref object as TPhysics)
' with object
' if Block(bx+1,by).solid or Block(bx+1,by).half 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).solid or Block(bx,by).half 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)
dim as byte stopp,i
stopp=false
with object
for i=bx1 to bx2
'beep:end
if block (i,by2).solid or (block(i,by2).half and .stupid) then stopp=true:exit for
next
if stopp then
.y=by2*ylen+.height'+ylen
.vy=0:.ay=gravity':.vyalt=0
by1=fix(fix(.y)/ylen)+1
by2=fix(fix(.y-.height)/ylen)+1
end if
stopp=false
for i=bx1 to bx2
if block (i,by1).solid or (block(i,by1).half and .stupid) then stopp=true:exit for
next
if stopp then
.y=by1*ylen-ylen-1
.vy=0:.ay=0':.vyalt=0
by1=fix(fix(.y)/ylen)+1
by2=fix(fix(.y-.height)/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
'' end if
'
' if .ay=0 then
' if (block(bx,by+1).solid =0 and (block(bx,by+1).half=0 or (not(.stupid)))) and (block (bx+1,by+1).solid=0 and (block (bx+1,by+1).half=0 or (not( .stupid)))) 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 1: x11=.x+.xplus:x21=.x+.width-.xminus
case 0: 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 and object2.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 and object2.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 and object2.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 and object2.unverwundbarende=0 then .unverwundbarende=timer+.unverwundbartime: .energy-=1
end if
end if
end if
end if
end with
end sub
sub Feuerballaua (byref object1 as TPhysics,byref object2 as TFeuerball)
dim as double x11,x21,y11,y21,x12,x22,y12,y22
with object1
select case .direction
case 1: x11=.x+.xplus:x21=.x+.width-.xminus
case 0: x11=.x+.xminus:x21=.x+.width-.xplus
end select
with object2
x12=.x
x22=.x+.size
end with
'locate 3,1:?fix(x11),fix(x21),fix(x12),fix(x22)
if .height>object2.size then
if (object2.y<=.y and object2.y >= .y-.height) or (object2.y-object2.size<=.y and object2.y-object2.size>= .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.size) or (.y-.height<=object2.y and .y-.height >= object2.y-object2.size) 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 vogelaua (byref object1 as TPhysics,byref object2 as TVogel)
dim as TPhysics temp
with temp
.x=object2.x
.y=object2.y
.width=object2.width
.height=object2.height
.energy=object2.energy
end with
aua object1,temp
end sub
sub UpDownAua (byref object1 as TPhysics,byref object2 as TUpDown)
dim as TPhysics temp
with temp
.x=object2.x
.y=object2.y
.width=object2.width
.height=object2.height
.energy=object2.energy
end with
aua object1,temp
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 1: x11=.x:x21=.x+.width
case 0: x11=.x:x21=.x+.width
end select
with object2
select case .direction
case 0: x12=.x:x22=.x+.width
case 1: x12=.x:x22=.x+.width
end select
end with
'locate 3,1:?fix(x11),fix(x21),fix(x12),fix(x22)
if (.direction=1 and x21<x22) or (.direction=0 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
'-------------------------------------------
'--------die vielversprechende, aber nicht funzende-----------
'--------allerdings ne ältere version, da fedora meine datenpartition nich mounten will...
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