XProfan

'----------------------------------------------------------
' Kollision zweier por ihre Endpunkte gegebenen Strecken
' Der Schnittpunkt el zugehörigen Geraden se ermittelt,
' aber sólo entonces suscrito, si se 'el Klingen kreuzen'.
'----------------------------------------------------------
' Freeware como Demo, 2012-05 by Zorro Pájaro carpintero, Wien
' Nutzung en alleinige Gefahr des Anwenders/el Anwenderin!
'----------------------------------------------------------
Windowstyle 16 | 64
Ventana 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
declarar w&,w!,d!' Winkel en Grad & Rad, Dicke
declarar xo!,xu!,yo!,yu!,xo2!,xu2!,yo2!,yu2!'Streckenfilter
declarar x!,y!,tmp!
declarar x1!,y1!, x2!,y2!, x3!,y3!, x4!,y4!
declarar k2!,m2!, k4!,m4!, nenner!,r!
r!=100' Zorros Rumfuchtel-Reichweite ;-)
' 2-Punkte-Gerade g1
x1!=0:y1!=0'Dummy. P1 y P4 später winkelgesteuert
x2!=-150:y2!=11
' 2-Punkte-Gerade g2
x3!= 80:y3!=-80
x4!= 60:y4!=30
Begin:

whileloop 0,360,6

    w&=&Loop:w!=f!*w&
    waitinput 60
    caso %key=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!

    if nenner!<>0

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

        if k2!<>0

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

        endif

    endif

    ' Gráficos
    cls
    Lin x2!,y2!, x1!,y1! ,2
    Lin x4!,y4!, x3!,y3! ,2

    if touch()

        beep
        Pnt x!,y!,3

    endif

endwhile

goto "Begin"

proc Lin

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

ENDPROC

proc Pnt:parámetros 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
    caso x1!>xo!:xo!=x1!
    caso x2!>xo!:xo!=x2!
    caso x3!>xo!:xo!=x3!
    caso x4!>xo!:xo!=x4!
    xu!=10^30
    caso x1!>xo!:xo!=x1!
    caso x2!<xu!:xu!=x2!
    caso x3!<xu!:xu!=x3!
    caso x4!<xu!:xu!=x4!
    xo2!=-1*10^30
    caso (x1!<xo!) and (xo2!<x1!):xo2!=x1!
    caso (x2!<xo!) and (xo2!<x2!):xo2!=x2!
    caso (x3!<xo!) and (xo2!<x3!):xo2!=x3!
    caso (x4!<xo!) and (xo2!<x4!):xo2!=x4!
    xu2!=10^30
    caso (x1!>xu!) and (xu2!>x1!):xu2!=x1!
    caso (x2!>xu!) and (xu2!>x2!):xu2!=x2!
    caso (x3!>xu!) and (xu2!>x3!):xu2!=x3!
    caso (x4!>xu!) and (xu2!>x4!):xu2!=x4!
    yo!=-1*10^30
    caso y1!>yo!:yo!=y1!
    caso y2!>yo!:yo!=y2!
    caso y3!>yo!:yo!=y3!
    caso y4!>yo!:yo!=y4!
    yu!=10^30
    caso y2!<yu!:yu!=y2!
    caso y3!<yu!:yu!=y3!
    caso y4!<yu!:yu!=y4!
    yo2!=-1*10^30
    caso (y1!<yo!) and (yo2!<y1!):yo2!=y1!
    caso (y2!<yo!) and (yo2!<y2!):yo2!=y2!
    caso (y3!<yo!) and (yo2!<y3!):yo2!=y3!
    caso (y4!<yo!) and (yo2!<y4!):yo2!=y4!
    yu2!=10^30
    caso (y1!>yu!) and (yu2!>y1!):yu2!=y1!
    caso (y2!>yu!) and (yu2!>y2!):yu2!=y2!
    caso (y3!>yu!) and (yu2!>y3!):yu2!=y3!
    caso (y4!>yu!) and (yu2!>y4!):yu2!=y4!
    locate 5,0:imprimir xo!,xo2!,x1!,xu2!,xu!:imprimir yo!,yo2!,y1!,yu2!,yu!
    caso (x!>=xu2!) and (x!<=xo2!) and (y!>=yu2!) and (y!<=yo2!):tmp&=1
    volver tmp&

ENDPROC