XProfan

English

have jetz time again a Kollisionsroutine with the car prepares.
first thing becomes the Kollisionsrechteck with IntersectRect(rectangle1#,rectangle2#,rectangle3#) quizzed.
If the Variable colli&=1 then go The Pixel to colour quizzed.
almost everything pure Profanbefehle without hinterecken.
with Profan2Cpp becomes it Real quick.
it go too The Rechteckdaten outputted which from the both Kollionsrechtecken formed becomes.
Can too yet well to that evaluate take.

this bitmap_header is me another bisschen To long.
How can there what simple kurzes reinsetzen? gives the for yet a Profanbefehl?

mfg
Compile Mark Separation

 $H Windows.ph
declare x1!,y1!,dx!,dy!,winkel!,y&,z&,z1&,z2&,z3&,groesse&
declare hWin&,hwin1&,hintergr&,hintergr1&,block&,hintergrauto&
declare width&,height&,ende&,bild_auto&,wert&
declare bmi# ,ogl_rgb#,b#,rechteck1#,rechteck2#,rechteck3#
declare xb1&,yb1&,xb2&,yb2&,xd&,yd&,colli&,xx1&,yy1&
groesse&=64*64*4
dim b#,groesse&
dim ogl_rgb#,groesse&
wert&=groesse&
ende&=1
Window 20,20-800,600
Cls @RGB(220,220,220)
hWin& = @Create(text, %hwnd, Test1, 10, 10, 64,64)
hWin1& = @Create(text,%hwnd, Test2, 200, 10,500,500)
hintergr&=create(hnewpic,500,500,$00ffff)
hintergr1&=create(hnewpic,500,500,$00ffff)
block&=create(hnewpic,64,64,$00ff00)
bild_auto&=create(hnewpic,64,64,$00ff00)
STRUCT rect = x&,y&,w&,h&
DIM rechteck1#, rect
DIM rechteck2#, rect
DIM rechteck3#, rect
oGL(Init, hwin&, 0,0, 0, 0)
oGL(PosMode, 1)
bild_auto& = Create(hnewPic,64,64,0 )
var tex.auto& = oGL(LoadTextureBMP,auto1.bmp,1)
mcls 64,64
height&=64
width&=64
bitmap_header
drawglscene
drawglscene
oglzubmp
dx!=100
dy!=100
drawscene

WHILE ende&

    sleep 1

    if isKey(81)

        winkel!=winkel!+1.0
        drawglscene
        oglzubmp
        drawscene

    endif

    if isKey(69)

        winkel!=winkel!-1.0
        drawglscene
        oglzubmp
        drawscene

    endif

    if isKey(87)

        y1!=Sin((-winkel!)/180.0*pi())*2
        x1!=Cos((-winkel!)/180.0*pi())*2
        dx!=dx!-x1!
        dy!=dy!-y1!
        drawglscene
        oglzubmp
        drawscene

    endif

    if isKey(83)

        y1!=Sin((-winkel!)/180.0*pi())*2
        x1!=Cos((-winkel!)/180.0*pi())*2
        dx!=dx!+x1!
        dy!=dy!+y1!
        drawglscene
        oglzubmp
        drawscene

    endif

    collision
    StartPaint %hwnd
    DrawText 10,300,(Format$(######0      ,colli&))
    DrawText 10,320,(Format$(######0      ,z&))
    DrawText 10,350,w +(Format$(######0      ,xd&))
    DrawText 70,350,h +(Format$(######0      ,yd&))
    DrawText 10,380,x +(Format$(######0      ,rechteck1#.x&))
    DrawText 70,380,y +(Format$(######0      ,rechteck1#.y&))
    DrawText 10,410,x1 +(Format$(######0      ,rechteck1#.w&))
    DrawText 70,410,y1 +(Format$(######0      ,rechteck1#.h&))
    endpaint

ENDWHILE

end

proc collision

    With rechteck1#

        .x& = 0
        .y& = 0
        .w& = 0
        .h& = 0

    EndWith

    With rechteck2#

        .x& = dx!
        .y& = dy!
        .w& = dx!+64
        .h& = dy!+64

    EndWith

    With rechteck3#

        .x& = 300
        .y& = 200
        .w& = 364
        .h& = 264

    EndWith

    colli&=~IntersectRect(rechteck1#,rechteck2#,rechteck3#)
    xb1&=rechteck1#.x&-300
    yb1&=rechteck1#.y&-200
    xb2&=rechteck1#.w&-300
    yb2&=rechteck1#.h&-200
    xd&=xb2&-xb1&
    yd&=yb2&-yb1&

    if colli&=1

        pixelausgabe

    endif

endproc

proc pixelausgabe

    ~GetDIBits(%hdc,hintergrauto&,0,64,b#,bmi#,0)

    whileloop 0,wert&,4

        z&=0
        z1&=byte(b#,&loop)
        z2&=byte(b#,&loop+2)

        if (z1& > 200) or (z2& > 200)

            z&=255
            break

        endif

    endwhile

endproc

proc oglzubmp

    ogl(glReadPixels,0,0,64,64,~GL_BGRA,~GL_UNSIGNED_BYTE,ogl_rgb#)
    ~setDIBits(%hdc,bild_auto&,0,64,ogl_rgb#,bmi#,0)
    startpaint -1
    drawpic bild_auto&,0,0;-1
    endpaint

endproc

proc drawglscene

    OGL(Clear)
    OGL(origin,0,0,-1.11)
    OGL(texture,tex.auto&,1)
    OGL(rotate,0,0,winkel!)
    OGL(quad,0.7,0.7)
    OGL(show)

endproc

proc drawscene

    startpaint hintergr&
    drawpic hintergr1&,0,0;0
    drawpic block&,300,200;0
    mcopybmp 0,0 - 64,64 > dx!,dy!,-1
    endpaint
    startpaint hwin1&
    drawpic hintergr&,0,0;0
    endpaint
    hintergrauto&=create(hpiccopy,hintergr&,300,200,64,64)
    startpaint hwin&
    drawpic hintergrauto&,0,100;0
    endpaint

endproc

proc bitmap_header

    def &BI_RGB 0
    def &DIB_RGB_COLORS 0
    struct BITMAPINFOHEADER =
    biSize&, biWidth&, biHeight&, biPlanes%, biBitCount%, biCompression&,
    biSizeImage&, biXPelsPerMeter&, biYPelsPerMeter&, biClrUsed&, biClrImportant&
    dim bmi#,BITMAPINFOHEADER
    clear bmi#

    with bmi#

        .biSize&        = sizeof(bmi#)
        .biWidth&       = width&
        .biHeight&      = height&
        .biPlanes%      = 1
        .biBitCount%    = 32
        .biCompression& = &BI_RGB
        .biSizeImage&   = ((.biWidth& * .biBitCount%  8 - 1) | 3 + 1) * endwith

endproc

too again The ASM-routine installed to that evaluate the Pixelfarbe.
Runs with Profan2Cpp and the Xpia:
Compile Mark Separation

 $H windows.ph
declare x1!,y1!,dx!,dy!,winkel!,y&,z&,groesse&
declare hWin&,hwin1&,hintergr&,hintergr1&,block&,hintergrauto&
declare width&,height&,ende&,bild_auto&
declare bmi# ,ogl_rgb#,b#,rectangle1#,rectangle2#,rectangle3#
declare xb1&,yb1&,xb2&,yb2&,xd&,yd&,colli&,xx1&,yy1&
groesse&=64*64*4
dim b#,groesse&
dim ogl_rgb#,groesse&

If 0

    AsmStart rgb_farbe

        Parameters b#,groesse&
        LOCAL r :BYTE
        LOCAL g :BYTE
        LOCAL b :BYTE
        LOCAL n :DWORD
        mov eax,para2
        mov n,eax
        mov ecx,0
        mov ebx,para1

        .while ecx<=n

            mov al,[ebx+ecx]
            mov r,al
            mov al,[ebx+ecx+1]
            mov g,al
            mov al,[ebx+ecx+2]
            mov b,al
            mov al,b

            .if al>252

                mov eax,255
                .break

            .endif

            mov al,g

            .if al>252

                mov eax,255
                .break

            .endif

            mov al,r

            .if al>252

                mov eax,255
                .break

            .endif

            add ecx,4

        .endw

    AsmEnd(z&)

endif

ende&=1
Window 20,20-800,600
Cls @RGB(220,220,220)
hWin& = @Create(Text, %hwnd, Test1, 10, 10, 64,64)
hWin1& = @Create(Text,%hwnd, Test2, 200, 10,500,500)
hintergr&=create(hnewpic,500,500,$00ffff)
hintergr1&=create(hnewpic,500,500,$00ffff)
block&=create(hnewpic,64,64,$00f000)
bild_auto&=create(hnewpic,64,64,$00ff00)
oGL(Init, hwin&, 0,0, 0, 0)
oGL(PosMode, 1)
bild_auto& = Create(hnewPic,64,64,0 )
var tex.auto& = oGL(LoadTextureBMP,car1.bmp,1)
STRUCT rect = x&,y&,w&,h&
DIM rectangle1#, rect
DIM rectangle2#, rect
DIM rectangle3#, rect
mcls 64,64
height&=64
width&=64
bitmap_header
drawglscene
drawglscene
oglzubmp
dx!=100
dy!=100
drawscene

WHILE ende&

    sleep 1

    if isKey(81)

        winkel!=winkel!+1.0
        drawglscene
        oglzubmp
        drawscene

    endif

    if isKey(69)

        winkel!=winkel!-1.0
        drawglscene
        oglzubmp
        drawscene

    endif

    if isKey(87)

        y1!=Sin((-winkel!)/180.0*pi())*2
        x1!=Cos((-winkel!)/180.0*pi())*2
        dx!=dx!-x1!
        dy!=dy!-y1!
        drawglscene
        oglzubmp
        drawscene

    endif

    if isKey(83)

        y1!=Sin((-winkel!)/180.0*pi())*2
        x1!=Cos((-winkel!)/180.0*pi())*2
        dx!=dx!+x1!
        dy!=dy!+y1!
        drawglscene
        oglzubmp
        drawscene

    endif

    collision
    StartPaint %hwnd
    DrawText 10,300,(stature$(######0      ,colli&))
    DrawText 10,320,(stature$(######0      ,z&))
    endpaint

ENDWHILE

end

proc collision

    With rectangle1#

        .x& = 0
        .y& = 0
        .w& = 0
        .h& = 0

    EndWith

    With rectangle2#

        .x& = dx!
        .y& = dy!
        .w& = dx!+64
        .h& = dy!+64

    EndWith

    With rectangle3#

        .x& = 300
        .y& = 200
        .w& = 364
        .h& = 264

    EndWith

    colli&=~IntersectRect(rectangle1#,rectangle2#,rectangle3#)

    if colli&=1

        pixelausgabe

    endif

endproc

proc pixelausgabe

    ~GetDIBits(%hdc,hintergrauto&,0,64,b#,bmi#,0)
    z&=Call(xpia_getprocaddressm(xpia_hmodule&,rgb_farbe),b#,groesse&)

endproc

proc oglzubmp

    ogl(glReadPixels,0,0,64,64,~GL_BGRA,~GL_UNSIGNED_BYTE,ogl_rgb#)
    ~setDIBits(%hdc,bild_auto&,0,64,ogl_rgb#,bmi#,0)
    startpaint -1
    drawpic bild_auto&,0,0;-1
    endpaint

endproc

proc drawglscene

    OGL(Clear)
    OGL(origin,0,0,-1.11)
    OGL(texture,tex.auto&,1)
    OGL(rotate,0,0,winkel!)
    OGL(quad,0.7,0.7)
    OGL(show)

endproc

proc drawscene

    startpaint hintergr&
    drawpic hintergr1&,0,0;0
    drawpic block&,300,200;0
    mcopybmp 0,0 - 64,64 > dx!,dy!,-1
    endpaint
    startpaint hwin1&
    drawpic hintergr&,0,0;0
    endpaint
    hintergrauto&=create(hpiccopy,hintergr&,300,200,64,64)
    startpaint hwin&
    drawpic hintergrauto&,0,100;0
    endpaint

endproc

proc bitmap_header

    def &BI_RGB 0
    def &DIB_RGB_COLORS 0
    struct BITMAPINFOHEADER =
    biSize&, biWidth&, biHeight&, biPlanes%, biBitCount%, biCompression&,
    biSizeImage&, biXPelsPerMeter&, biYPelsPerMeter&, biClrUsed&, biClrImportant&
    dim bmi#,BITMAPINFOHEADER
    clear bmi#

    with bmi#

        .biSize&        = sizeof(bmi#)
        .biWidth&       = width&
        .biHeight&      = height&
        .biPlanes%      = 1
        .biBitCount%    = 32
        .biCompression& = &BI_RGB
        .biSizeImage&   = ((.biWidth& * .biBitCount%  8 - 1) | 3 + 1) * abs(.biHeight&)

    endwith

endproc

auto1.bmp	13 kB

Hochgeladen:	03/06/09

Downloadcounter:
		Download

03/06/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

now have I The extended on various forms, not only on one Viereck
have it here with a circle tested.

The Kollisionsblockkreis is green for car.
The Maskenblock of it is blue, left in the Image to control.

whom Maskenblock read I in a Memory-Variable c#.

with the Profanbefehl intersect(r, r1#, r2#) read I first thing from , whether a block touched becomes.
then read I The mask from , where The Maskenfarbe blue starting. If the Maskenfarbe blue found is, read I above whom point from whether since the colour the car befindet.

and with Profan2Cpp is it a true Wonne, from the speed since. If one then again a ASM-routine to Auswertung dazwischenhängt becomes it even faster.
Compile Mark Separation

 $H Windows.ph
declare x1!,y1!,dx!,dy!,winkel!,y&,z&,z1&,z2&,z3&,groesse&
declare hWin&,hwin1&,hintergr&,hintergr1&,block&,blockhingr&,hintergrauto&
declare width&,height&,ende&,bild_auto&,wert&
declare bmi# ,ogl_rgb#,b#,c#,r1#,r2#
r1# = new(xpRect)
r2# = new(xpRect)
groesse&=64*64*4
dim b#,groesse&
dim c#,groesse&
dim ogl_rgb#,groesse&
wert&=groesse&
ende&=1
Window 20,20-800,600
Cls @RGB(220,220,220)
hWin& = @Create(text, %hwnd, Test1, 10, 10, 64,64)
hWin1& = @Create(text,%hwnd, Test2, 200, 10,500,500)
hintergr&=create(hnewpic,500,500,$00ffff)
hintergr1&=create(hnewpic,500,500,$00ffff)
block&=create(hnewpic,64,64,$000000)
blockhingr&=create(hnewpic,64,64,$000000)
bild_auto&=create(hnewpic,64,64,$00ff00)
startpaint blockhingr&
UsePen 0,1,@RGB(0,0,255)
UseBrush 1,@RGB(0,0,255)
Ellipse 10,10 - 50,50
endpaint
startpaint hwin&
drawpic blockhingr&,10,250;-1
endpaint
startpaint block&
UsePen 0,1,@RGB(0,255,0)
UseBrush 1,@RGB(0,255,0)
Ellipse 10,10 - 50,50
endpaint
oGL(Init, hwin&, 0,0, 0, 0)
oGL(PosMode, 1)
bild_auto& = Create(hnewPic,64,64,0 )
var tex.auto& = oGL(LoadTextureBMP,auto1.bmp,1)
mcls 64,64
height&=64
width&=64
bitmap_header
~GetDIBits(%hdc,blockhingr&,0,64,c#,bmi#,0)
drawglscene
drawglscene
oglzubmp
dx!=100
dy!=100
r2#.posx! = 300
r2#.posy! = 200
r2#.x! = 64
r2#.y! = 64
drawscene

WHILE ende&

    sleep 1

    if isKey(81)

        winkel!=winkel!+1.0
        drawglscene
        oglzubmp
        drawscene

    endif

    if isKey(69)

        winkel!=winkel!-1.0
        drawglscene
        oglzubmp
        drawscene

    endif

    if isKey(87)

        y1!=Sin((-winkel!)/180.0*pi())*2
        x1!=Cos((-winkel!)/180.0*pi())*2
        dx!=dx!-x1!
        dy!=dy!-y1!
        drawglscene
        oglzubmp
        drawscene

    endif

    if isKey(83)

        y1!=Sin((-winkel!)/180.0*pi())*2
        x1!=Cos((-winkel!)/180.0*pi())*2
        dx!=dx!+x1!
        dy!=dy!+y1!
        drawglscene
        oglzubmp
        drawscene

    endif

    if intersect(r, r1#, r2#)=1

        pixelausgabe

    endif

    StartPaint %hwnd
    DrawText 10,200,(Format$(######0      ,z&))
    endpaint

ENDWHILE

end

proc pixelausgabe

    ~GetDIBits(%hdc,hintergrauto&,0,64,b#,bmi#,0)

    whileloop 0,wert&,4

        z&=0
        z1&=byte(c#,&loop)

        if z1& > 240

            z1&=byte(b#,&loop)
            z2&=byte(b#,&loop+2)

            if (z1& > 200) or (z2& > 200)

                z&=255
                break

            endif

        ENDIF

    endwhile

endproc

proc oglzubmp

    ogl(glReadPixels,0,0,64,64,~GL_BGRA,~GL_UNSIGNED_BYTE,ogl_rgb#)
    ~setDIBits(%hdc,bild_auto&,0,64,ogl_rgb#,bmi#,0)
    startpaint -1
    drawpic bild_auto&,0,0;-1
    endpaint

endproc

proc drawglscene

    OGL(Clear)
    OGL(origin,0,0,-1.11)
    OGL(texture,tex.auto&,1)
    OGL(rotate,0,0,winkel!)
    OGL(quad,0.7,0.7)
    OGL(show)

endproc

proc drawscene

    startpaint hintergr&
    drawpic hintergr1&,0,0;0
    drawpic block&,300,200;-1
    mcopybmp 0,0 - 64,64 > dx!,dy!,-1
    r1#.posx! = dx!
    r1#.posy! = dy!
    r1#.x! = 64
    r1#.y! = 64
    endpaint
    startpaint hwin1&
    drawpic hintergr&,0,0;0
    endpaint
    hintergrauto&=create(hpiccopy,hintergr&,300,200,64,64)
    startpaint hwin&
    drawpic hintergrauto&,0,100;0
    endpaint

endproc

proc bitmap_header

    def &BI_RGB 0
    def &DIB_RGB_COLORS 0
    struct BITMAPINFOHEADER =
    biSize&, biWidth&, biHeight&, biPlanes%, biBitCount%, biCompression&,
    biSizeImage&, biXPelsPerMeter&, biYPelsPerMeter&, biClrUsed&, biClrImportant&
    dim bmi#,BITMAPINFOHEADER
    clear bmi#

    with bmi#

        .biSize&        = sizeof(bmi#)
        .biWidth&       = width&
        .biHeight&      = height&
        .biPlanes%      = 1
        .biBitCount%    = 32
        .biCompression& = &BI_RGB
        .biSizeImage&   = ((.biWidth& * .biBitCount%  8 - 1) | 3 + 1) * abs>(.biHeight&)

    endwith

endproc

03/07/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Jac
de
Lad

at that Perform the Codes crashes my system komplet ex.

Profan² 2.6 bis XProfan 11.1+XPSE+XPIA+XPRR (und irgendwann XIDE)
Core2Duo E8500/T2250, 8192/1024 MB, Radeon HD4850/Radeon XPress 1250, Vista64/XP

03/07/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

The likes well XProfan not....

must on 32bit in the graphic walk.
is with XProfan11.1 prepares.

I type, the your The OGL-command of XProfan not Edit can.
look there once.
did you know at all OGL?

car1.bmp must You of supra yet reinladen.

its nothing besonderes drin everything harmless XProfan11-command, except :

ogl(glReadPixels,0,0,64,64,~ GL_BGRA,~GL_UNSIGNED_BYTE,ogl_ rgb#)
~setDIBits(%hdc,bild_auto&,0,6 4,ogl_rgb#,bmi#,0)

the likes well your not, time Roland informieren.

or I buy you whom computer ex...to that first ...1 Euro.

I can even Profan2Cpp kompilieren. have Borland c 5.5.
Runs Supi...

And if Profan2Cpp so durchläuft, then is it waterproof.

mfg

03/07/09 ▲

Vollständiges Quote

Absatzweise Quote Zeilenweise Quote

Sebastian
König

in the code is so far I the see objectively one small Error, the to a crash lead can, but not must (I had the same trouble already in another Thread hingewiesen. here's it the
Compile Mark Separation

whileloop 0,wert&,4re>

with the always one small Piece over The Bereichsgrenze (wert& = groesse&) out red becomes...

Konkret: in the last Schleifendurchlauf has &loop the value groesse&, the &loop + something with whom Zugriffen can then Problems make.

MfG

Sebastian

Nachtrag:
Peter Bierbachh

and with Profan2Cpp is it a true Wonne, from the speed since.
[...]
And if Profan2Cpp so durchläuft, then is it waterproof.

thanks!