XProfan

'----------------------------------------------------------
' Kollision zweier par ses Endpunkte gegebenen Strecken
' qui Schnittpunkt qui zugehörigen Geraden wird ermittelt,
' mais seulement ensuite gezeichnet, si sich 'qui Klingen kreuzen'.
'----------------------------------------------------------
' Freeware comme Demo, 2012-05 by Zorro Specht, vienne
' Nutzung sur alleinige péril des Anwenders/qui Anwenderin!
'----------------------------------------------------------
Windowstyle 16 | 64
Fenêtre 0,0-%maxx,%maxy-44
font 2:set("decimals",1):set("numwidth",6)
screen 800*2,680
var xm!= %maxx/2
var ym!=(%maxy-44)/2
var f!=pi()/180
declare w&,w!,d!' Winkel dans Grad & roue, Dicke
declare xo!,xu!,yo!,yu!,xo2!,xu2!,yo2!,yu2!'Streckenfilter
declare x!,y!,tmp!
declare x1!,y1!, x2!,y2!, x3!,y3!, x4!,y4!
declare k2!,m2!, k4!,m4!, nenner!,r!
r!=100' Zorros Rumfuchtel-Reichweite ;-)
' 2-Punkte-justement g1
x1!=0:y1!=0'Dummy. P1 et P4 später winkelgesteuert
x2!=-150:y2!=11
' 2-Punkte-justement g2
x3!= 80:y3!=-80
x4!= 60:y4!=30
Begin:

whileloop 0,360,6

    w&=&Boucle:w!=f!*w&
    waitinput 60
    cas %clé=27:end
    x1!=2*r!*cos(w!):y1!=r!*sin(-w!*2)
    x4!=r!*cos(3.4*-w!):y4!=2*r!*sin(2*w!)
    k2!=x2!-x1! : m2!=y2!-y1!
    k4!=x4!-x3! : m4!=y4!-y3!
    nenner! = k2!*m4! - k4!*m2!

    si nenner!<>0

        x!=( k2!*(x3!*y4!-x4!*y3!)+k4!*(x2!*y1!-x1!*y2!) ) / Nenner!

        si k2!<>0

            y!=m2!/k2!*(x!-x1!)+y1!

        endif

    endif

    ' Graphics
    cls
    Lin x2!,y2!, x1!,y1! ,2
    Lin x4!,y4!, x3!,y3! ,2

    si touch()

        beep
        Pnt x!,y!,3

    endif

endwhile

goto "Begin"

proc Lin

    parameters x2!,y2!,x1!,y1!,d!
    usepen 0,d!,rgb(200,0,0)
    Line xm!+x2!,(ym!-y2!) - (xm!+x1!),ym!-y1!

endproc

proc Pnt:parameters x!,y!,d!

    usepen 0,d!,rgb(200,0,0)
    rectangle xm!+x!+2+d!,(ym!-y!+2+d!) - (xm!+x!-2-d!),ym!-y!-2-d!

endproc

proc touch

    var tmp&=0
    xo!=-1*10^30
    cas x1!>xo!:xo!=x1!
    cas x2!>xo!:xo!=x2!
    cas x3!>xo!:xo!=x3!
    cas x4!>xo!:xo!=x4!
    xu!=10^30
    cas x1!>xo!:xo!=x1!
    cas x2!<xu!:xu!=x2!
    cas x3!<xu!:xu!=x3!
    cas x4!<xu!:xu!=x4!
    xo2!=-1*10^30
    cas (x1!<xo!) and (xo2!<x1!):xo2!=x1!
    cas (x2!<xo!) and (xo2!<x2!):xo2!=x2!
    cas (x3!<xo!) and (xo2!<x3!):xo2!=x3!
    cas (x4!<xo!) and (xo2!<x4!):xo2!=x4!
    xu2!=10^30
    cas (x1!>xu!) and (xu2!>x1!):xu2!=x1!
    cas (x2!>xu!) and (xu2!>x2!):xu2!=x2!
    cas (x3!>xu!) and (xu2!>x3!):xu2!=x3!
    cas (x4!>xu!) and (xu2!>x4!):xu2!=x4!
    yo!=-1*10^30
    cas y1!>yo!:yo!=y1!
    cas y2!>yo!:yo!=y2!
    cas y3!>yo!:yo!=y3!
    cas y4!>yo!:yo!=y4!
    yu!=10^30
    cas y2!<yu!:yu!=y2!
    cas y3!<yu!:yu!=y3!
    cas y4!<yu!:yu!=y4!
    yo2!=-1*10^30
    cas (y1!<yo!) and (yo2!<y1!):yo2!=y1!
    cas (y2!<yo!) and (yo2!<y2!):yo2!=y2!
    cas (y3!<yo!) and (yo2!<y3!):yo2!=y3!
    cas (y4!<yo!) and (yo2!<y4!):yo2!=y4!
    yu2!=10^30
    cas (y1!>yu!) and (yu2!>y1!):yu2!=y1!
    cas (y2!>yu!) and (yu2!>y2!):yu2!=y2!
    cas (y3!>yu!) and (yu2!>y3!):yu2!=y3!
    cas (y4!>yu!) and (yu2!>y4!):yu2!=y4!
    locate 5,0:imprimer xo!,xo2!,x1!,xu2!,xu!:imprimer yo!,yo2!,y1!,yu2!,yu!
    cas (x!>=xu2!) and (x!<=xo2!) and (y!>=yu2!) and (y!<=yo2!):tmp&=1
    return tmp&

endproc