Buchempfehlung
MySQL kurz & gut
MySQL kurz & gut
Das preiswerte Taschen- buch stellt MySQL-rele- vante Inhalte systematisch und knapp dar, sodass es sich optimal zum Nach- schlagen beim Pro- grammieren eignet. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

collision.bi

Uploader:Mitgliedflo
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