Here is the source:
REBOL [
File: %line-intersection-demo.r
Date: 10-Jan-2004
Title: "Line Intersection Demo"
Purpose: {Demonstrate an algorithm used to detect an intersection between two line segments.}
Version: 1.0.1
Author: "Claude Precourt"
Acknowledgements: ["Paul Bourke"]
Web: http://astronomy.swin.edu.au/~pbourke/geometry/lineline2d/
]
line-intersect?: func [
"It determines if lines intescet"
pt1 [pair!] "First line start point"
pt2 [pair!] "First line end point"
pt3 [pair!] "Second line stard point"
pt4 [pair!] "Second line end point"
/local denom ua ub
][
denom: ((pt4/y - pt3/y) * (pt2/x - pt1/x)) - ((pt4/x - pt3/x) * (pt2/y - pt1/y))
if denom = 0 [print "lines are parallel" return false] ;; lines are parallel
ua: (((pt4/x - pt3/x) * (pt1/y - pt3/y)) - ((pt4/y - pt3/y) * (pt1/x - pt3/x))) / denom
ub: (((pt2/x - pt1/x) * (pt1/y - pt3/y)) - ((pt2/y - pt1/y) * (pt1/x - pt3/x))) / denom
either all [
ua >= 0
ua <= 1
ub >= 0
ub <= 1
] [return true][return false]
]
img-data: to-image layout [origin 0x0 box black 512x512]
view layout [
img: image img-data
across
button "Test" [
pt1: to-pair reduce [random 512 random 512]
pt2: to-pair reduce [random 512 random 512]
pt3: to-pair reduce [random 512 random 512]
pt4: to-pair reduce [random 512 random 512]
either line-intersect? pt1 pt2 pt3 pt4 [
pen-color: red
status-text/text: "YES"
][
pen-color: white
status-text/text: "NO"
]
img-data: to-image layout [origin 0x0
box black 512x512 effect [
draw [pen pen-color line pt1 pt2 line pt3 pt4]
]
]
img/image: img-data
show [img status-text]
]
button "Quit" [quit]
text bold " Intersection?"
status-text: text 150x24 "-"
]
No comments:
Post a Comment