Leikkaavatko ympyrä ja jana?

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
User avatar
SPuntte
Tech Developer
Tech Developer
Posts: 650
Joined: Mon Aug 27, 2007 9:51 pm
Location: Helsinki, Finland
Contact:

Leikkaavatko ympyrä ja jana?

Post by SPuntte » Wed Feb 27, 2008 11:06 am

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
CoolBasic henkilökuntaa
Tech-kehittäjä
CoolBasic Classic, Cool VES

CoolPhysicsEngine | MissileSystem | Jana-ympyrä -törmäys | cbSimpleTexture | CoolCPLX

User avatar
MaGetzUb
Guru
Posts: 1715
Joined: Sun Sep 09, 2007 12:35 pm
Location: Alavus

Re: Leikkaavatko ympyrä ja jana?

Post by MaGetzUb » Wed Feb 27, 2008 9:14 pm

Hyvä funktio, kiitos. Itse nyt kun paljastan niin tarvitsin tätä omaan WayPoint funktioon, jonka piti postata tänne foorumille. :D
Solar Eclipse
Meneillä olevat Projektit:
We're in a simulation, and God is trying to debug us.

User avatar
Someday coder
Active Member
Posts: 106
Joined: Wed Jul 30, 2008 5:04 pm

Re: Leikkaavatko ympyrä ja jana?

Post by Someday coder » Mon Aug 04, 2008 4:19 pm

Kiitos tästä tarpeeseen tuli :P

Post Reply