Leikkaavatko ympyrä ja jana?

[SPuntte]

Postasin joku päivä sitten ongelmat-osioon funktion, joka tarkistaa leikkaavatko ympyrä ja jana toisensa (tai tarkkaanottaen, onko jana ympyrän tangenttina taikka ainakin osittain sen sisällä). Siellä ehdotettiin, että tästä kannattaisi lisätä esimerkkikoodeihin. Tässä se siis tulee. Jos löytyy bugeja (en ole testannut maailma-koordinaateilla) tai optimoitavaa, hihkaiskaa ihmeessä.

En jaksa enää uudestaan selitellä funktion toimintaperiaatetta kokonaisuudessaan. Se yhdistelee pythagoraan lausetta, vektorien pistetulon ominaisuuksia ja "pisteen etäisyys suorasta" -kaavaa. Kiinnostuneiden kannattaa vilkaista tämä.

Esimerkki sisältyy, kommentoinnit (muutettu alkuperäisestä) suomeksi:

Code: Select all

Randomize Timer()
x1 = Rand(50, 350)
y1 = Rand(50, 250)
x2 = Rand(50, 350)
y2 = Rand(50, 250)
rad = Rand(20, 50)

ShowMouse OFF

Repeat
    Color 255, 255, 255
    Text 5, 5, "Ympyrän ja janan leikkaus: " + CircleToLineSegIsect(MouseX(), MouseY(), rad, x1, y1, x2, y2)
    Text 5, 17, "Ympyän keskipisteen etäisyys suorasta: " + PointToLineDist(mouseX(), mousey(), x1, y1, x2, y2)
    Text 5, 40, "Välilyönti arpoo arvot uudelleen"
    Line x1, y1, x2, y2
    
    Color 255, 0, 0
    Dot MouseX(), MouseY()
    Circle2(MouseX(), MouseY(), rad, OFF)
    
    If KeyHit(CBkeySpace) Then
        x1 = Rand(50, 350)
        y1 = Rand(50, 250)
        x2 = Rand(50, 350)
        y2 = Rand(50, 250)
        rad = Rand(10, 50)
    EndIf
    
    DrawScreen
Forever

//CircleToLineSegIsect
//
//Palauttaa:
//  TRUE (1) kun:
//      Ympyrä [keskipiste = (cx, cy); säde = r]
//      leikkaa janan, joka kulkee pisteiden (l1x, l1y) & (l2x, l2y) kaitta
//  FALSE (0) muulloin
Function CircleToLineSegIsect(cx#, cy#, r#, l1x#, l1y#, l2x#, l2y#)
    //Ympyrän keskipisteen ja (ainakin toisen) janan päätepisteen etäisyys < r
    //-> leikkaus
    If Distance(cx, cy, l1x, l1y) <= r Or Distance(cx, cy, l2x, l2y) <= r Then Return True
    
    //Vektorit (janan vektori ja vektorit janan päätepisteistä ympyrän keskipisteeseen)
    SegVecX# = l2x - l1x 
    SegVecY# = l2y - l1y
    
    PntVec1X# = cx - l1x
    PntVec1Y# = cy - l1y
    
    PntVec2X# = cx - l2x
    PntVec2Y# = cy - l2y
    
    //Em. vektorien pistetulot
    dp1# =  SegVecX * PntVec1X + SegVecY * PntVec1Y
    dp2# = -SegVecX * PntVec2X - SegVecY * PntVec2Y
    
    //Tarkistaa onko toisen pistetulon arvo 0
    //tai molempien merkki sama
    If dp1 = 0 Or dp2 = 0 Then
    ElseIf (dp1 > 0 And dp2 > 0) Or (dp1 < 0 And dp2 < 0) Then
    Else
        //Ei kumpikaan -> ei leikkausta
        Return False
    EndIf
    
    //Janan päätepisteiden kautta kulkevan suoran 'yhtälö' (ax + by + c = 0)
    a# =   (l2y - l1y) / (l2x - l1x)
    b# = - 1
    c# = - (l2y - l1y) / (l2x - l1x) * l1x + l1y
    
    //Ympyrän keskipisteen etäisyys suorasta
    d# = Abs(a * cx + b * cy + c) / Sqrt(a * a + b * b)
    
    //Ympyrä on liian kaukana
    //-> ei leikkausta
    If d > r Then Return False
    
    //Jos päästään tänne saakka, ympyrä ja jana leikkaavat (tai ovat sisäkkäin)
    Return True
EndFunction

//PointToLineDist
//
//Palauttaa:
//  Etäisyyden
//  pisteestä (px, py)
//  suoraan, joka kulkee pisteiden (l1x, l1y) & (l2x, l2y) kautta
Function PointToLineDist(px#, py#, l1x#, l1y#, l2x#, l2y#)
    //Suoran yhtälö
    a# =  (l2y - l1y) / (l2x - l1x)
    b# = -1
    c# = -(l2y - l1y) / (l2x - l1x) * l1x + l1y
    
    //Etäisyys
    d# = Abs(a * px + b * py + c) / Sqrt(a * a + b * b)
    
    Return d
EndFunction

//Palauttaa argumentin etumerkin (-1, 0 tai 1)
Function Sign(val)
    If val > 0 Then
        Return 1
    ElseIf val < 0 Then
        Return -1
    Else
        Return 0
    EndIf
EndFunction

//Piirtää ympyrän, jonka keskipisteenä on annetut x ja y
Function Circle2(x#, y#, r#, fill=0)
    Circle x - r, y - r, r * 2, fill
EndFunction

[MaGetzUb]

Hyvä funktio, kiitos. Itse nyt kun paljastan niin tarvitsin tätä omaan WayPoint funktioon, jonka piti postata tänne foorumille.

[Someday coder]

Kiitos tästä tarpeeseen tuli :P